VM Maker: VMMaker.oscog-VB.2383.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-VB.2383.mcz

commits-2
 
VincentBlondeau uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-VB.2383.mcz

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

Name: VMMaker.oscog-VB.2383
Author: VB
Time: 12 May 2018, 10:21:38.92358 am
UUID: a0681b83-7110-3d47-9214-f4bcf9d4982a
Ancestors: VMMaker.oscog-VB.2382

Use methodReturn***:  instead of pop: + push***: in FilePlugin

=============== Diff against VMMaker.oscog-VB.2382 ===============

Item was changed:
  ----- Method: FilePlugin>>primitiveConnectToFile (in category 'file primitives') -----
  primitiveConnectToFile
  "Connect to the file with the supplied FILE* and writeFlag.
  FILE* must be supplied in a byte object (ByteArray) with the platform address size.
  writeFlag must be a boolean and compatible with the existing file access."
  | writeFlag cfileOop cfile filePointer |
  <var: 'cfile' type: #'void *'>
  <export: true>
  writeFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
  cfileOop := interpreterProxy stackValue: 1.
  cfile := self pointerFrom: cfileOop.
  interpreterProxy failed ifTrue: [
  "Ensure that the appropriate failure code has been set"
  ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  filePointer := self connectToFile: cfile write: writeFlag.
  interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnValue: filePointer]!
- [interpreterProxy pop: 3 "rcvr, name, writeFlag"
- thenPush: filePointer]!

Item was changed:
  ----- Method: FilePlugin>>primitiveConnectToFileDescriptor (in category 'file primitives') -----
  primitiveConnectToFileDescriptor
  "Connect to the existing file identified by fileDescriptor.
  fileDescriptor must be an integer.
  writeFlag is aboolean indicating whether to open in read or write mode and must be compatible with the existing file access."
  | writeFlag fdPointer fd filePointer |
  <var: 'fd' type: #int>
  <export: true>
  writeFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
  fdPointer := interpreterProxy stackValue: 1.
  (interpreterProxy isIntegerObject: fdPointer)
  ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument].
  fd := interpreterProxy integerValueOf: fdPointer.
  interpreterProxy failed ifTrue: [
  "Ensure that the appropriate failure code has been set"
  ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  filePointer := self connectToFd: fd write: writeFlag.
  interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnValue: filePointer]!
- [interpreterProxy pop: 3 "rcvr, name, writeFlag"
- thenPush: filePointer]!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileAtEnd (in category 'file primitives') -----
  primitiveFileAtEnd
  | file atEnd |
  <export: true>
  <var: 'file' type: 'SQFile *'>
  file := self fileValueOf: (interpreterProxy stackValue: 0).
  interpreterProxy failed
  ifFalse: [atEnd := self sqFileAtEnd: file].
  interpreterProxy failed
+ ifFalse: [interpreterProxy methodReturnBool: atEnd]!
- ifFalse: [interpreterProxy pop: 2. "rcvr, file"
- interpreterProxy pushBool: atEnd]!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileDescriptorType (in category 'file primitives') -----
  primitiveFileDescriptorType
  | fileType fd fdPointer |
  "Allow to test if the standard input/output files are from a console or not
  Return values:
  * -1 - Error
  * 0 - no console (windows only)
  * 1 - normal terminal (unix terminal / windows console)
  * 2 - pipe
  * 3 - file
  * 4 - cygwin terminal (windows only)"
  <var: 'fd' type: #int>
  <export: true>
  fdPointer := interpreterProxy stackValue: 0.
  (interpreterProxy isIntegerObject: fdPointer)
  ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument].
  fd := interpreterProxy integerValueOf: fdPointer.
  interpreterProxy failed ifTrue: [
  "Ensure that the appropriate failure code has been set"
  ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  fileType := self
  cCode: 'sqFileDescriptorType(fd)'
  inSmalltalk: [1].
+ interpreterProxy methodReturnInteger: fileType!
- interpreterProxy pop: 2.
- interpreterProxy pushInteger: fileType!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileGetPosition (in category 'file primitives') -----
  primitiveFileGetPosition
  | file position |
  <var: 'file' type: 'SQFile *'>
  <var: 'position' type: 'squeakFileOffsetType'>
  <export: true>
  file := self fileValueOf: (interpreterProxy stackValue: 0).
  interpreterProxy failed ifFalse: [position := self sqFileGetPosition: file].
  interpreterProxy failed ifFalse: [
+ interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: position)].!
- interpreterProxy pop: 2 thenPush: (interpreterProxy positive64BitIntegerFor: position)].!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileOpen (in category 'file primitives') -----
  primitiveFileOpen
  | writeFlag namePointer filePointer nameIndex nameSize |
  <var: 'nameIndex' type: 'char *'>
  <export: true>
  writeFlag := interpreterProxy
  booleanValueOf: (interpreterProxy stackValue: 0).
  namePointer := interpreterProxy stackValue: 1.
  (interpreterProxy isBytes: namePointer)
  ifFalse: [^ interpreterProxy primitiveFail].
  nameIndex := interpreterProxy firstIndexableField: namePointer.
  nameSize := interpreterProxy byteSizeOf: namePointer.
  filePointer := self fileOpenName: nameIndex size: nameSize write: writeFlag secure: true.
  interpreterProxy failed
+ ifFalse: [interpreterProxy methodReturnValue: filePointer]
- ifFalse: [interpreterProxy pop: 3 "rcvr, name, writeFlag"
- thenPush: filePointer]
  !

Item was changed:
  ----- Method: FilePlugin>>primitiveFileOpenNew (in category 'file primitives') -----
  primitiveFileOpenNew
  | namePointer filePointer nameIndex nameSize |
  <var: 'nameIndex' type: 'char *'>
  <export: true>
  namePointer := interpreterProxy stackValue: 0.
  (interpreterProxy isBytes: namePointer)
  ifFalse: [^ interpreterProxy primitiveFail].
  nameIndex := interpreterProxy firstIndexableField: namePointer.
  nameSize := interpreterProxy byteSizeOf: namePointer.
  filePointer := self fileOpenNewName: nameIndex size: nameSize secure: true.
  interpreterProxy failed
  ifFalse: [
+ interpreterProxy methodReturnValue: filePointer]
- interpreterProxy
- pop: 2 "rcvr, name"
- thenPush: filePointer]
  !

Item was changed:
  ----- Method: FilePlugin>>primitiveFileReadWithPinning (in category 'file primitives') -----
  primitiveFileReadWithPinning
  "This version of primitiveFileRead is for garbage collectors that support pinning."
  | count startIndex array file slotSize elementSize bytesRead |
  <inline: true>
  <var: 'file' type: #'SQFile *'>
  <var: 'count' type: #'size_t'>
  <var: 'startIndex' type: #'size_t'>
  <var: 'slotSize' type: #'size_t'>
  <var: 'elementSize' type: #'size_t'>
  count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
  startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1).
    array := interpreterProxy stackValue: 2.
  file := self fileValueOf: (interpreterProxy stackValue: 3).
 
  (interpreterProxy failed
  "buffer can be any indexable words or bytes object except CompiledMethod"
  or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  slotSize := interpreterProxy slotSizeOf: array.
  (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
 
  "Note: adjust startIndex for zero-origin byte indexing"
  elementSize := slotSize = 0
  ifTrue: [1]
  ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize].
  bytesRead := self
  sqFile: file
  Read: count * elementSize
  Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
  At: startIndex - 1 * elementSize.
  interpreterProxy failed ifFalse:
  [interpreterProxy
+ methodReturnValue: (interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!
- pop: 5 "pop rcvr, file, array, startIndex, count"
- thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileReadWithoutPinning (in category 'file primitives') -----
  primitiveFileReadWithoutPinning
  "This version of primitiveFileRead is for garbage collectors without support for pinning."
  | retryCount count startIndex array file elementSize bytesRead |
  <inline: true>
  <var: 'file' type: #'SQFile *'>
  <var: 'count' type: #'size_t'>
  <var: 'startIndex' type: #'size_t'>
  <var: 'elementSize' type: #'size_t'>
  retryCount := 0.
  count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
  startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
   
  [array := interpreterProxy stackValue: 2.
  file := self fileValueOf: (interpreterProxy stackValue: 3).
 
  (interpreterProxy failed
  "buffer can be any indexable words or bytes object except CompiledMethod"
  or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
  (startIndex >= 1
   and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
 
  "Note: adjust startIndex for zero-origin indexing"
  bytesRead := self
  sqFile: file
  Read: count * elementSize
  Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
  At: (startIndex - 1) * elementSize.
  interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
  and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
  [interpreterProxy
  tenuringIncrementalGC;
  primitiveFailFor: PrimNoErr].
  interpreterProxy failed ifFalse:
  [interpreterProxy
+ methodReturnValue: (interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!
- pop: 5 "pop rcvr, file, array, startIndex, count"
- thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileSize (in category 'file primitives') -----
  primitiveFileSize
  | file size |
  <var: 'file' type: 'SQFile *'>
  <var: 'size' type: 'squeakFileOffsetType'>
  <export: true>
  file := self fileValueOf: (interpreterProxy stackValue: 0).
  interpreterProxy failed ifFalse:[size := self sqFileSize: file].
  interpreterProxy failed ifFalse: [
+ interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: size)].!
- interpreterProxy pop: 2 thenPush: (interpreterProxy positive64BitIntegerFor: size)].!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
  primitiveFileStdioHandles
  "Answer an Array of file handles for standard in, standard out and standard error,
  with nil in entries that are unvailable, e.g. because the platform does not provide
  standard error, etc.  Fail if there are no standard i/o facilities on the platform or
  if the security plugin denies access or if memory runs out."
  | fileRecords result validMask |
  <export: true>
  <var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
  sHFAfn ~= 0 ifTrue:
  [(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrUnsupported]].
  self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
  validMask := self sqFileStdioHandlesInto: fileRecords.
  validMask = 0 ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrUnsupported].
  result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
  result = nil ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  interpreterProxy pushRemappableOop: result.
  0 to: 2 do:
  [:index|
  (validMask bitAnd: (1 << index)) ~= 0 ifTrue:
  [result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
  result = nil ifTrue:
  [interpreterProxy popRemappableOop.
  ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  interpreterProxy storePointer: index ofObject: interpreterProxy topRemappableOop withValue: result.
  self
  cCode:
  [self mem: (interpreterProxy firstIndexableField: result)
  cp: (self addressOf: (fileRecords at: index))
  y: self fileRecordSize]
  inSmalltalk:
  [(interpreterProxy firstIndexableField: result)
  unitSize: interpreterProxy wordSize;
  at: 0 put: (fileRecords at: index + 1)]]].
  "In the non-Spur threaded VM ensure the handles are old, so that sqFileReadIntoAt is unaffected
   by incremental GCs.  See platforms/Cross/plugins/FilePlugin/sqFilePluginBasicPrims.c.  The Spur
   VM uses pinning, so it doesn't need the GC."
  self cppIf: COGMTVM
  ifTrue: [self cppIf: SPURVM
  ifTrue: []
  ifFalse: [interpreterProxy fullGC]].
  result := interpreterProxy popRemappableOop.
+ interpreterProxy methodReturnValue: result!
- interpreterProxy pop: 1 thenPush: result!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileWrite (in category 'file primitives') -----
  primitiveFileWrite
  | count startIndex array file slotSize elementSize bytesWritten |
  <var: 'file' type: 'SQFile *'>
  <var: 'count' type: 'size_t'>
  <var: 'startIndex' type: 'size_t'>
  <var: 'slotSize' type: #'size_t'>
  <var: 'elementSize' type: #'size_t'>
  <export: true>
  count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
  startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1).
  array := interpreterProxy stackValue: 2.
  file := self fileValueOf: (interpreterProxy stackValue: 3).
 
  (interpreterProxy failed
  "buffer can be any indexable words or bytes object except CompiledMethod"
  or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  slotSize := interpreterProxy slotSizeOf: array.
  (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
 
  "Note: adjust startIndex for zero-origin byte indexing"
  elementSize := slotSize = 0
  ifTrue: [1]
  ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize].
  bytesWritten := self
  sqFile: file
  Write: count * elementSize
  From: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
  At: startIndex - 1 * elementSize.
  interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnValue: (interpreterProxy integerObjectOf: bytesWritten // elementSize)]!
- [interpreterProxy pop: 5 thenPush: (interpreterProxy integerObjectOf: bytesWritten // elementSize)]!

Item was changed:
  ----- Method: FilePlugin>>primitiveHasFileAccess (in category 'security primitives') -----
  primitiveHasFileAccess
  |  hasAccess |
  <export: true>
  "If the security plugin can be loaded, use it to check .
  If not, assume it's ok"
  sHFAfn ~= 0
  ifTrue: [hasAccess := self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]]
  ifFalse: [hasAccess := true].
+ interpreterProxy methodReturnBool: hasAccess!
- interpreterProxy pop: 1.
- interpreterProxy pushBool: hasAccess!