[Vm-dev] VM Maker: VMMaker.oscog-eem.2162.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Mar 17 21:34:51 UTC 2017 

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!

More information about the Vm-dev mailing list