VM Maker: VMMaker.oscog-eem.2162.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2162.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2162
Author: eem
Time: 17 March 2017, 2:33:43.955084 pm
UUID: 62e528cf-ac80-421c-9bd3-eb7f843200b6
Ancestors: VMMaker.oscog-eem.2161

InterpreterPrimitives:
Add a proper getenv: primitive, with full control for disabling from the SecurityPlugin.  Actual security plugin support required, which will be provided soon.  Clean up some of the SecurityPlugin accessors to avoid cCode:.  Fix mem:cp:y: for ByteArrays.

InterpreterProxy
Add stringForCString: to the API, now providing the cStringOrNullFor:/stringForCString: pair.

Fix primitiveDirectoryEntry simulation for PharoVM in the CogVMSimulator.

=============== Diff against VMMaker.oscog-eem.2161 ===============

Item was added:
+ ----- Method: CogVMSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag
+ <option: #PharoVM>
+ <var: 'entryName' type: 'char *'>
+
+ | modDateOop createDateOop nameString results |
+
+ results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 7.
+ nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
+ createDateOop := self positive32BitIntegerFor: createDate.
+ modDateOop := self positive32BitIntegerFor: modifiedDate.
+
+ 1 to: entryNameSize do:
+ [ :i |
+ objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
+
+ objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
+ objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
+ objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
+ dirFlag
+ ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
+ ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
+ objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
+ objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
+ symlinkFlag
+ ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ]
+ ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ].
+
+ ^ results!

Item was changed:
  ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  | name pathName arrayNilOrSymbol result |
  name := self stringOf: self stackTop.
  pathName := self stringOf: (self stackValue: 1).
 
- "temporary work-around to make it work in Pharo..."
- self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
-
  self successful ifFalse:
  [^self primitiveFail].
 
  arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
  arrayNilOrSymbol ifNil:
  [self pop: 3 thenPush: objectMemory nilObject.
  ^self].
  arrayNilOrSymbol isArray ifFalse:
  ["arrayNilOrSymbol ~~ #primFailed ifTrue:
  [self halt]. "
  self transcript show: name, ' NOT FOUND'.
  ^self primitiveFail].
 
  result := PharoVM
  ifTrue:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
+ posixPermissions: (arrayNilOrSymbol at: 6 ifAbsent: [8r644]) isSymlink: (arrayNilOrSymbol at: 7 ifAbsent: [false])]
- posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
  ifFalse:
  [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
  createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
  isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
  self pop: 3 thenPush: result!

Item was changed:
  VMClass subclass: #InterpreterPrimitives
+ instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields newFinalization sHEAFn'
- instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields newFinalization'
  classVariableNames: 'CrossedX EndOfRun MillisecondClockMask'
  poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMStackFrameOffsets'
  category: 'VMMaker-Interpreter'!
 
  !InterpreterPrimitives commentStamp: 'eem 12/11/2012 17:11' prior: 0!
  InterpreterPrimitives implements most of the VM's core primitives.  It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters.
 
  Instance Variables
  argumentCount: <Integer>
  messageSelector: <Integer>
  newMethod: <Integer>
  nextProfileTick: <Integer>
  objectMemory: <ObjectMemory> (simulation only)
  preemptionYields: <Boolean>
  primFailCode: <Integer>
  profileMethod: <Integer>
  profileProcess: <Integer>
  profileSemaphore: <Integer>
 
  argumentCount
  - the number of arguments of the current message
 
  messageSelector
  - the oop of the selector of the current message
 
  newMethod
  - the oop of the result of looking up the current message
 
  nextProfileTick
  - the millisecond clock value of the next profile tick (if profiling is in effect)
 
  objectMemory
  - the memory manager and garbage collector that manages the heap
 
  preemptionYields
  - a boolean controlling the process primitives.  If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue.  If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities.
 
  primFailCode
  - primtiive success/failure flag, 0 for success, otherwise the reason code for failure
 
  profileMethod
  - the oop of the method at the time nextProfileTick was reached
 
  profileProcess
  - the oop of the activeProcess at the time nextProfileTick was reached
 
  profileSemaphore
  - the oop of the semaphore to signal when nextProfileTick is reached
  !

Item was added:
+ ----- Method: InterpreterPrimitives class>>declareCVarsIn: (in category 'C translation') -----
+ declareCVarsIn: aCCodeGen
+ aCCodeGen var: 'sHEAFn' declareC: 'int (*sHEAFn)() = 0' "the hasEnvironmentAccess function"!

Item was changed:
  ----- Method: InterpreterPrimitives>>cStringOrNullFor: (in category 'primitive support') -----
  cStringOrNullFor: oop
  "Answer either a malloced string with the null-terminated contents of oop if oop is a string,
  or the null pointer if oop is nil, or fail.  It is the client's responsibility to free the string later."
  <api>
  <returnTypeC: #'char *'>
+ <inline: false>
  | isString len cString |
  <var: 'cString' type: #'char *'>
  isString := self isInstanceOfClassByteString: oop.
  isString ifFalse:
  [oop ~= objectMemory nilObject ifTrue:
  [self primitiveFailFor: PrimErrBadArgument].
  ^0].
  len := objectMemory lengthOf: oop.
  len = 0 ifTrue:
  [^0].
  cString := self malloc: len + 1.
  cString ifNil:
  [self primitiveFailFor: PrimErrNoCMemory.
  ^0].
  self mem: cString cp: (objectMemory firstIndexableField: oop) y: len.
+ cString at: (self cCode: [len] inSmalltalk: [len + 1]) put: 0.
- cString at: len put: 0.
  ^cString!

Item was added:
+ ----- Method: InterpreterPrimitives>>getenv: (in category 'simulation support') -----
+ getenv: aByteStringOrByteArray
+ <doNotGenerate>
+ <primitive: 'primitiveGetenv' module: '' error: ec>
+ ec == #'bad argument' ifTrue:
+ [aByteStringOrByteArray isString ifFalse:
+ [^self getenv: aByteStringOrByteArray asString]].
+ self primitiveFail!

Item was added:
+ ----- Method: InterpreterPrimitives>>initializeInterpreter: (in category 'initialization') -----
+ initializeInterpreter: bytesToShift
+ sHEAFn := self ioLoadFunction: 'secHasEnvironmentAccess' From: 'SecurityPlugin'!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveGetenv (in category 'other primitives') -----
+ primitiveGetenv
+ "Access to environment variables via getenv.  No putenv or setenv as yet."
+ | var result |
+ <export: true>
+ <var: #var type: #'char *'>
+ <var: #result type: #'char *'>
+ sHEAFn ~= 0 ifTrue: "secHasEnvironmentAccess"
+ [self sHEAFn ifFalse: [^self primitiveFailFor: PrimErrInappropriate]].
+ var := self cStringOrNullFor: self stackTop.
+ var = 0 ifTrue:
+ [self successful ifTrue:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ ^self].
+ result := self getenv: (self cCode: [var] inSmalltalk: [var allButLast]).
+ self free: var.
+ result ~= 0 ifTrue:
+ [result := objectMemory stringForCString: result.
+ result ifNil:
+ [^self primitiveFailFor: PrimErrNoMemory]].
+ self assert: primFailCode = 0.
+ self pop: 2 thenPush: (result = 0 ifTrue: [objectMemory nilObject] ifFalse: [result])!

Item was added:
+ ----- Method: InterpreterPrimitives>>sHEAFn (in category 'simulation support') -----
+ sHEAFn
+ <doNotGenerate>
+ self break.
+ ^true!

Item was added:
+ ----- Method: InterpreterProxy>>cStringOrNullFor: (in category 'testing') -----
+ cStringOrNullFor: oop
+ "Answer either a malloced string with the null-terminated contents of oop if oop is a string,
+ or the null pointer if oop is nil, or fail.  It is the client's responsibility to free the string later."
+ <returnTypeC: #'char *'>
+ oop isString ifTrue: [^oop] ifFalse: [self primitiveFail. ^0]!

Item was added:
+ ----- Method: InterpreterProxy>>stringForCString: (in category 'testing') -----
+ stringForCString: aCString
+ "Answer a ByteString object containing the bytes (possibly UTF-8?) in the null-terminated C string aCString."
+ <var: #aCString type: #'char *'>
+ self notYetImplemented!

Item was changed:
  ----- Method: SecurityPlugin>>secCanRenameImage (in category 'exported functions') -----
  secCanRenameImage
  <export: true>
+ ^self ioCanRenameImage!
- ^self cCode: [self ioCanRenameImage] inSmalltalk: [true]!

Item was changed:
  ----- Method: SecurityPlugin>>secCanWriteImage (in category 'exported functions') -----
  secCanWriteImage
  <export: true>
+ ^self ioCanWriteImage!
- ^self cCode: 'ioCanWriteImage()'!

Item was changed:
  ----- Method: SecurityPlugin>>secDisableFileAccess (in category 'exported functions') -----
  secDisableFileAccess
  <export: true>
+ ^self ioDisableFileAccess!
- ^self cCode: 'ioDisableFileAccess()'!

Item was changed:
  ----- Method: SecurityPlugin>>secDisableSocketAccess (in category 'exported functions') -----
  secDisableSocketAccess
  <export: true>
+ ^self ioDisableSocketAccess!
- ^self cCode: 'ioDisableSocketAccess()'!

Item was added:
+ ----- Method: SecurityPlugin>>secHasEnvironmentAccess (in category 'exported functions') -----
+ secHasEnvironmentAccess
+ <export: true>
+ ^self ioHasEnvironmentAccess!

Item was changed:
  ----- Method: SecurityPlugin>>secHasFileAccess (in category 'exported functions') -----
  secHasFileAccess
  <export: true>
+ ^self ioHasFileAccess!
- ^self cCode: 'ioHasFileAccess()'!

Item was changed:
  ----- Method: SecurityPlugin>>secHasSocketAccess (in category 'exported functions') -----
  secHasSocketAccess
  <export: true>
+ ^self ioHasSocketAccess!
- ^self cCode: 'ioHasSocketAccess()'!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift
  "Initialize Interpreter state before starting execution of a new image."
  interpreterProxy := self sqGetInterpreterProxy.
  self dummyReferToProxy.
  objectMemory initializeObjectMemory: bytesToShift.
  self checkAssumedCompactClasses.
  self initializeExtraClassInstVarIndices.
  method := newMethod := objectMemory nilObject.
  self cCode: '' inSmalltalk:
  [breakSelectorLength ifNil:
  [breakSelectorLength := objectMemory minSmallInteger]].
  methodDictLinearSearchLimit := 8.
  self initialCleanup.
  LowcodeVM ifTrue: [ self setupNativeStack ].
  profileSemaphore := profileProcess := profileMethod := objectMemory nilObject.
  interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  [globalSessionID = 0] whileTrue:
  [globalSessionID := self
  cCode: [(self time: #NULL) + self ioMSecs]
+ inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
+ super initializeInterpreter: bytesToShift.!
- inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]]!

Item was changed:
  ----- Method: VMClass>>mem:cp:y: (in category 'C library simulation') -----
  mem: dString cp: sString y: bytes
  <doNotGenerate>
  "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
  (dString isString or: [sString isString]) ifFalse:
  [| destAddress sourceAddress |
+ dString class == ByteArray ifTrue:
+ [ByteString adoptInstance: dString.
+ ^[self mem: dString cp: sString y: bytes] ensure:
+ [ByteArray adoptInstance: dString]].
  destAddress := dString asInteger.
  sourceAddress := sString asInteger.
  self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
  or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
  dString isString
  ifTrue:
  [1 to: bytes do:
  [:i| | v |
  v := sString isString
  ifTrue: [sString at: i]
  ifFalse: [Character value: (self byteAt: sString + i - 1)].
  dString at: i put: v]]
  ifFalse:
  [1 to: bytes do:
  [:i| | v |
  v := sString isString
  ifTrue: [(sString at: i) asInteger]
  ifFalse: [self byteAt: sString + i - 1].
  self byteAt: dString + i - 1 put: v]].
  ^dString!