'From Squeak3.1alpha of 7 March 2001 [latest update: #4347] on 11 December 2001 at 11:36:25 am'! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 13:49'! primitiveFileGetPosition | file position | self var: 'file' declareC: 'SQFile *file'. self var: 'position' type: 'off_t'. self export: true. file _ self fileValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifFalse: [position _ self sqFileGetPosition: file]. interpreterProxy failed ifFalse: [ interpreterProxy pop: 2. interpreterProxy push: (interpreterProxy positive64BitIntegerFor: position)].! ! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 22:37'! primitiveFileRead | count startIndex array file byteSize arrayIndex bytesRead | self var: 'file' declareC: 'SQFile *file'. self var: 'arrayIndex' type:'char *'. self var: 'count' type:'size_t'. self var: 'startIndex' type:'size_t'. self var: 'byteSize' type:'size_t'. self export: true. count _ interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). startIndex _ interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1). array _ interpreterProxy stackValue: 2. file _ self fileValueOf: (interpreterProxy stackValue: 3). "buffer can be any indexable words or bytes object except CompiledMethod" (interpreterProxy isWordsOrBytes: array) ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy isWords: array) ifTrue: [ byteSize _ 4 ] ifFalse: [ byteSize _ 1 ]. ((startIndex >= 1) and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:[^interpreterProxy primitiveFail]. arrayIndex _ interpreterProxy firstIndexableField: array. "Note: adjust startIndex for zero-origin indexing" bytesRead _ self sqFile: file Read: (count * byteSize) Into: (self cCoerce: arrayIndex to: 'int') At: ((startIndex - 1) * byteSize). interpreterProxy failed ifFalse:[ interpreterProxy pop: 5. "pop rcvr, file, array, startIndex, count" interpreterProxy pushInteger: bytesRead // byteSize. "push # of elements read" ].! ! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 23:19'! primitiveFileSetPosition | newPosition file | self var: 'file' declareC: 'SQFile *file'. self var: 'newPosition' type: 'off_t'. self export: true. newPosition _ interpreterProxy positive64BitValueOf: (interpreterProxy stackValue: 0). file _ self fileValueOf: (interpreterProxy stackValue: 1). interpreterProxy failed ifFalse:[ self sqFile: file SetPosition: newPosition ]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 2 "pop position, file; leave rcvr on stack" ].! ! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 13:49'! primitiveFileSize | file size | self var: 'file' declareC: 'SQFile *file'. self var: 'size' type: 'off_t'. self export: true. file _ self fileValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifFalse:[size _ self sqFileSize: file]. interpreterProxy failed ifFalse: [ interpreterProxy pop: 2. interpreterProxy push: (interpreterProxy positive64BitIntegerFor: size)].! ! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 13:51'! primitiveFileTruncate | truncatePosition file | self var: 'file' declareC: 'SQFile *file'. self var: 'truncatePosition' type: 'off_t'. self export: true. truncatePosition _ interpreterProxy positive64BitValueOf: (interpreterProxy stackValue: 0). file _ self fileValueOf: (interpreterProxy stackValue: 1). interpreterProxy failed ifFalse:[ self sqFile: file Truncate: truncatePosition ]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 2 "pop position, file; leave rcvr on stack" ].! ! !FilePlugin methodsFor: 'file primitives' stamp: 'JMM 11/8/2001 16:15'! primitiveFileWrite | count startIndex array file byteSize arrayIndex bytesWritten | self var: 'file' declareC: 'SQFile *file'. self var: 'arrayIndex' type: 'char *'. self var: 'count' type: 'size_t'. self var: 'startIndex' type: 'size_t'. self var: 'byteSize' type: 'size_t'. self export: true. count _ interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). startIndex _ interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1). array _ interpreterProxy stackValue: 2. file _ self fileValueOf: (interpreterProxy stackValue: 3). "buffer can be any indexable words or bytes object except CompiledMethod" (interpreterProxy isWordsOrBytes: array) ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy isWords: array) ifTrue: [ byteSize _ 4 ] ifFalse: [ byteSize _ 1 ]. ((startIndex >= 1) and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:[^interpreterProxy primitiveFail]. interpreterProxy failed ifFalse:[ arrayIndex _ interpreterProxy firstIndexableField: array. "Note: adjust startIndex for zero-origin indexing" bytesWritten _ self sqFile: file Write: (count * byteSize) From: (self cCoerce: arrayIndex to: 'int') At: ((startIndex - 1) * byteSize). ]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 5. "pop rcvr, file, array, startIndex, count" interpreterProxy pushInteger: bytesWritten // byteSize. "push # of elements written" ].! ! !FilePlugin methodsFor: 'directory primitives' stamp: 'JMM 11/8/2001 21:56'! makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize | modDateOop createDateOop nameString results stringPtr fileSizeOop | self var: 'entryName' declareC: 'char *entryName'. self var: 'stringPtr' declareC:'char *stringPtr'. self var: 'fileSize' declareC:'off_t fileSize'. "allocate storage for results, remapping newly allocated oops in case GC happens during allocation" interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5). interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).. interpreterProxy pushRemappableOop: (interpreterProxy positive32BitIntegerFor: createDate). interpreterProxy pushRemappableOop: (interpreterProxy positive32BitIntegerFor: modifiedDate). interpreterProxy pushRemappableOop: (interpreterProxy positive64BitIntegerFor: fileSize). fileSizeOop _ interpreterProxy popRemappableOop. modDateOop _ interpreterProxy popRemappableOop. createDateOop _ interpreterProxy popRemappableOop. nameString _ interpreterProxy popRemappableOop. results _ interpreterProxy popRemappableOop. "copy name into Smalltalk string" stringPtr _ interpreterProxy firstIndexableField: nameString. 0 to: entryNameSize - 1 do: [ :i | stringPtr at: i put: (entryName at: i). ]. interpreterProxy storePointer: 0 ofObject: results withValue: nameString. interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop. interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop. dirFlag ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ] ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ]. interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop. ^ results! ! !FilePlugin methodsFor: 'directory primitives' stamp: 'JMM 11/8/2001 21:54'! primitiveDirectoryLookup | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize sCLPfn okToList | self var: 'entryName' declareC: 'char entryName[256]'. self var: 'pathNameIndex' type: 'char *'. self var: 'fileSize' type: 'off_t'. self export: true. index _ interpreterProxy stackIntegerValue: 0. pathName _ interpreterProxy stackValue: 1. (interpreterProxy isBytes: pathName) ifFalse: [^ interpreterProxy primitiveFail]. pathNameIndex _ interpreterProxy firstIndexableField: pathName. pathNameSize _ interpreterProxy byteSizeOf: pathName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCLPfn _ interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'. sCLPfn ~= 0 ifTrue: [okToList _ self cCode: ' ((int (*) (char *, int)) sCLPfn)(pathNameIndex, pathNameSize)'] ifFalse: [okToList _ true]. okToList ifTrue: [status _ self cCode: 'dir_Lookup( (char *) pathNameIndex, pathNameSize, index, entryName, &entryNameSize, &createDate, &modifiedDate, &dirFlag, &fileSize)'] ifFalse: [status _ DirNoMoreEntries]. interpreterProxy failed ifTrue: [^ nil]. status = DirNoMoreEntries ifTrue: ["no more entries; return nil" interpreterProxy pop: 3. "pop pathName, index, rcvr" interpreterProxy push: interpreterProxy nilObject. ^ nil]. status = DirBadPath ifTrue: [^ interpreterProxy primitiveFail]. "bad path" interpreterProxy pop: 3. "pop pathName, index, rcvr" interpreterProxy push: (self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize)! ! !Interpreter methodsFor: 'primitive support' stamp: 'JMM 12/10/2001 03:11'! positive64BitIntegerFor: integerValue | newLargeInteger value check | "Note - integerValue is interpreted as POSITIVE, eg, as the result of Bitmap>at:, or integer>bitAnd:." self var: 'integerValue' type: 'squeakInt64'. self cCode: 'check = integerValue >> 32'. check = 0 ifTrue: [^self positive32BitIntegerFor: integerValue]. newLargeInteger _ self instantiateSmallClass: (self splObj: ClassLargePositiveInteger) sizeInBytes: 12 fill: 0. 0 to: 7 do: [:i | self cCode: 'value = ( integerValue >> (i * 8)) & 255'. self storeByte: i ofObject: newLargeInteger withValue: value]. ^ newLargeInteger! ! !Interpreter methodsFor: 'primitive support' stamp: 'JMM 11/19/2001 16:23'! positive64BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive ST integer or a eight-byte LargePositiveInteger." | sz value | self returnTypeC: 'squeakInt64'. self var: 'value' type: 'squeakInt64'. (self isIntegerObject: oop) ifTrue: [ value _ self integerValueOf: oop. value < 0 ifTrue: [^ self primitiveFail]. ^ value]. self assertClassOf: oop is: (self splObj: ClassLargePositiveInteger). successFlag ifFalse: [^ self primitiveFail]. sz _ self lengthOf: oop. sz > 8 ifTrue: [^ self primitiveFail]. value _ 0. 0 to: sz - 1 do: [:i | value _ value + ((self cCoerce: (self fetchByte: i ofObject: oop) to: 'squeakInt64') << (i*8))]. ^value.! ! !Interpreter methodsFor: 'primitive support' stamp: 'JMM 12/10/2001 03:12'! signed64BitIntegerFor: integerValue "Return a Large Integer object for the given integer value" | newLargeInteger value largeClass intValue check | self inline: false. self var: 'integerValue' type: 'squeakInt64'. self var: 'value' type: 'squeakInt64'. integerValue < 0 ifTrue:[ largeClass _ self classLargeNegativeInteger. value _ 0 - integerValue] ifFalse:[ largeClass _ self classLargePositiveInteger. value _ integerValue]. self cCode: 'check = value >> 32'. check = 0 ifTrue: [^self signed32BitIntegerFor: integerValue]. newLargeInteger _ self instantiateSmallClass: largeClass sizeInBytes: 12 fill: 0. 0 to: 7 do: [:i | self cCode: 'intValue = ( value >> (i * 8)) & 255'. self storeByte: i ofObject: newLargeInteger withValue: intValue]. ^ newLargeInteger! ! !Interpreter methodsFor: 'primitive support' stamp: 'JMM 11/19/2001 16:22'! signed64BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive ST integer or a eight-byte LargeInteger." | sz value largeClass negative | self inline: false. self returnTypeC: 'squeakInt64'. self var: 'value' type: 'squeakInt64'. (self isIntegerObject: oop) ifTrue: [^self cCoerce: (self integerValueOf: oop) to: 'squeakInt64']. largeClass _ self fetchClassOf: oop. largeClass = self classLargePositiveInteger ifTrue:[negative _ false] ifFalse:[largeClass = self classLargeNegativeInteger ifTrue:[negative _ true] ifFalse:[^self primitiveFail]]. sz _ self lengthOf: oop. sz > 8 ifTrue: [^ self primitiveFail]. value _ 0. 0 to: sz - 1 do: [:i | value _ value + ((self cCoerce: (self fetchByte: i ofObject: oop) to: 'squeakInt64') << (i*8))]. negative ifTrue:[^0 - value] ifFalse:[^value]! ! !Interpreter methodsFor: 'image save/restore' stamp: 'JMM 11/8/2001 16:53'! checkImageVersionFrom: f startingAt: imageOffset "Read and verify the image file version number and return true if the the given image file needs to be byte-swapped. As a side effect, position the file stream just after the version number of the image header. This code prints a warning and does a hard-exit if it cannot find a valid version number." "This code is based on C code by Ian Piumarta." | version firstVersion | self var: #f declareC: 'sqImageFile f'. self var: #imageOffset declareC: 'off_t imageOffset'. "check the version number" self sqImageFile: f Seek: imageOffset. version _ firstVersion _ self getLongFromFile: f swap: false. (self readableFormat: version) ifTrue: [^ false]. "try with bytes reversed" self sqImageFile: f Seek: imageOffset. version _ self getLongFromFile: f swap: true. (self readableFormat: version) ifTrue: [^ true]. "Note: The following is only meaningful if not reading an embedded image" imageOffset = 0 ifTrue:[ "try skipping the first 512 bytes (prepended by certain Mac file transfer utilities)" self sqImageFile: f Seek: 512. version _ self getLongFromFile: f swap: false. (self readableFormat: version) ifTrue: [^ false]. "try skipping the first 512 bytes with bytes reversed" self sqImageFile: f Seek: 512. version _ self getLongFromFile: f swap: true. (self readableFormat: version) ifTrue: [^ true]]. "hard failure; abort" self print: 'This interpreter (vers. '. self printNum: self imageFormatVersion. self print: ' cannot read image file (vers. '. self printNum: firstVersion. self cr. self print: 'Hit CR to quit'. self getchar. self ioExit. ! ! !Interpreter methodsFor: 'image save/restore' stamp: 'JMM 11/8/2001 16:54'! readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory." "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command." "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!" | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize | self var: #f declareC: 'sqImageFile f'. self var: #headerStart declareC: 'off_t headerStart'. self var: #dataSize declareC: 'size_t dataSize'. self var: #imageOffset declareC: 'off_t imageOffset'. swapBytes _ self checkImageVersionFrom: f startingAt: imageOffset. headerStart _ (self sqImageFilePosition: f) - 4. "record header start position" headerSize _ self getLongFromFile: f swap: swapBytes. dataSize _ self getLongFromFile: f swap: swapBytes. oldBaseAddr _ self getLongFromFile: f swap: swapBytes. specialObjectsOop _ self getLongFromFile: f swap: swapBytes. lastHash _ self getLongFromFile: f swap: swapBytes. savedWindowSize _ self getLongFromFile: f swap: swapBytes. fullScreenFlag _ self getLongFromFile: f swap: swapBytes. extraVMMemory _ self getLongFromFile: f swap: swapBytes. lastHash = 0 ifTrue: [ "lastHash wasn't stored (e.g. by the cloner); use 999 as the seed" lastHash _ 999]. "decrease Squeak object heap to leave extra memory for the VM" heapSize _ self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'. "compare memory requirements with availability". minimumMemory _ dataSize + 100000. "need at least 100K of breathing room" heapSize < minimumMemory ifTrue: [ GenerateBrowserPlugin ifTrue: [ self plugInNotifyUser: 'The amount of memory specified by the ''memory'' EMBED tag is not enough for the installed Squeak image file.'. ^ nil] ifFalse: [self error: 'Insufficient memory for this image']]. "allocate a contiguous block of memory for the Squeak heap" memory _ self cCode: '(unsigned char *) sqAllocateMemory(minimumMemory, heapSize)'. memory = nil ifTrue: [ GenerateBrowserPlugin ifTrue: [ self plugInNotifyUser: 'There is not enough memory to give Squeak the amount specified by the ''memory'' EMBED tag.'. ^ nil] ifFalse: [self error: 'Failed to allocate memory for the heap']]. memStart _ self startOfMemory. memoryLimit _ (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety" endOfMemory _ memStart + dataSize. "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. "read in the image in bulk, then swap the bytes if necessary" bytesRead _ self cCode: 'sqImageFileRead(memory, sizeof(unsigned char), dataSize, f)'. bytesRead ~= dataSize ifTrue: [ GenerateBrowserPlugin ifTrue: [ self plugInNotifyUser: 'Squeak had problems reading its image file.'. self plugInShutdown. ^ nil] ifFalse: [self error: 'Read failed or premature end of image file']]. swapBytes ifTrue: [self reverseBytesInImage]. "compute difference between old and new memory base addresses" bytesToShift _ memStart - oldBaseAddr. self initializeInterpreter: bytesToShift. "adjusts all oops to new location" ^ dataSize ! ! !Interpreter methodsFor: 'image save/restore' stamp: 'JMM 11/8/2001 16:55'! writeImageFileIO: imageBytes | headerStart headerSize f bytesWritten sCWIfn okToWrite | self var: #f declareC: 'sqImageFile f'. self var: #headerStart declareC: 'off_t headerStart'. "If the security plugin can be loaded, use it to check for write permission. If not, assume it's ok" sCWIfn _ self ioLoadFunction: 'setCanWriteImage' From: 'SecurityPlugin'. sCWIfn ~= 0 ifTrue:[okToWrite _ self cCode:' ((int (*) (void)) sCWIfn)()'. okToWrite ifFalse:[^self primitiveFail]]. "local constants" headerStart _ 0. headerSize _ 64. "header size in bytes; do not change!!" f _ self cCode: 'sqImageFileOpen(imageName, "wb")'. f = nil ifTrue: [ "could not open the image file for writing" self success: false. ^ nil]. headerStart _ self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'. self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'. "position file to start of header" self sqImageFile: f Seek: headerStart. self putLong: (self imageFormatVersion) toFile: f. self putLong: headerSize toFile: f. self putLong: imageBytes toFile: f. self putLong: (self startOfMemory) toFile: f. self putLong: specialObjectsOop toFile: f. self putLong: lastHash toFile: f. self putLong: (self ioScreenSize) toFile: f. self putLong: fullScreenFlag toFile: f. self putLong: extraVMMemory toFile: f. 1 to: 7 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros" successFlag ifFalse: [ "file write or seek failure" self cCode: 'sqImageFileClose(f)'. ^ nil]. "position file after the header" self sqImageFile: f Seek: headerStart + headerSize. "write the image data" bytesWritten _ self cCode: 'sqImageFileWrite(memory, sizeof(unsigned char), imageBytes, f)'. self success: bytesWritten = imageBytes. self cCode: 'sqImageFileClose(f)'. ! ! !InterpreterProxy methodsFor: 'converting' stamp: 'JMM 11/8/2001 15:26'! positive64BitIntegerFor: integerValue integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue > 0 ifTrue:[integerValue] ifFalse:[ (1 bitShift: 64) + integerValue]! ! !InterpreterProxy methodsFor: 'converting' stamp: 'JMM 11/8/2001 15:27'! positive64BitValueOf: oop oop isInteger ifFalse:[self error:'Not an integer object']. oop < 0 ifTrue:[self primitiveFail. ^0] ifFalse:[^oop]! ! !InterpreterProxy methodsFor: 'converting' stamp: 'JMM 11/8/2001 15:27'! signed64BitIntegerFor: integerValue integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue! ! !InterpreterProxy methodsFor: 'converting' stamp: 'JMM 11/8/2001 15:27'! signed64BitValueOf: oop oop isInteger ifFalse:[self error:'Not an integer object']. ^oop! !