The Trunk: System-eem.1041.mcz

Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.1041.mcz

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

Name: System-eem.1041
Author: eem
Time: 24 August 2018, 3:27:21.106494 pm
UUID: d696fe38-c1f1-f347-aa6a-9f53055d2306
Ancestors: System-eem.1040

Add the image side primitive error support for FFI exceptions.  See ExceptionInFFICallError's class comment for an example.

=============== Diff against System-eem.1040 ===============

Item was added:
+ PrimitiveError subclass: #ExceptionInFFICallError
+ instanceVariableNames: 'pc'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'System-Support'!
+
+ !ExceptionInFFICallError commentStamp: 'eem 8/24/2018 15:21' prior: 0!
+ An ExceptionInFFICallError is used to answer the exception code and program counter at which an exceprion occurred during an FFI call.  Note that such exceptions are only delivered under certain circumstances, by default if an FFI callout method includes an error code variable.  But the VM provides command-line arguments to override this behaviour, either to always deliver or never deliver such exceptions as primitive failures.  And support appeared in VMs from VMMaker.oscog-eem.2433 or later.
+
+ Instance Variables
+ pc: <Integer>
+
+ errorCode (inherited)
+ - the error code for the exception, which is platform-dependent.  e.g. on Win32 it is the ExceptionRecord->ExceptionCode, such as 16rC0000005, and on Unix it is SIGBUS, SIGILL, SIGSEGV et al.
+
+ pc
+ - the program counter of the instruction that raised an exception
+
+ Here is a small FFI example to provoke such an error.  Warning: this will crash the VM if either the VM is too old, or if ExternalFunction>>#invokeWithArguments: is lacking an error code, or if the handling has been overridden by the relevant VM command line argument.
+
+ | pt handleClass elf |
+ pt := Parser new parse: 'function <cdecl: void ''foo'' () error: ec> self ffiCallFailedWith: ec' class: UndefinedObject.
+ elf := pt encoder literals first.
+ handleClass := elf getHandle class.
+ ByteArray adoptInstance: elf getHandle. "otherwise ExternalHandle access fails cuz address not in heap"
+ Smalltalk wordSize = 8
+ ifTrue: [elf getHandle unsignedLongLongAt: 1 put: 17]
+ ifFalse: [elf getHandle unsignedLongAt: 1 put: 17].
+ handleClass adoptInstance: elf getHandle.
+ elf invoke
+ !

Item was added:
+ ----- Method: ExceptionInFFICallError>>isExceptionInFFICallError (in category 'testing') -----
+ isExceptionInFFICallError
+ "Answer if the receiver is an error object for an exception during an FFI call."
+ ^true!

Item was added:
+ ----- Method: ExceptionInFFICallError>>pc (in category 'accessing') -----
+ pc
+
+ ^ pc!

Item was added:
+ ----- Method: ExceptionInFFICallError>>pc: (in category 'accessing') -----
+ pc: anObject
+
+ pc := anObject.!

Item was changed:
  ----- Method: Object>>isPrimitiveError (in category '*system-support') -----
  isPrimitiveError
+ "Answer if the receiver is an error object returned by a primitive."
- "Answer a boolean indicating if the receiver is an error object returned by a primitive"
  ^false!

Item was added:
+ ----- Method: PrimitiveError>>isExceptionInFFICallError (in category 'testing') -----
+ isExceptionInFFICallError
+ "Answer if the receiver is an error object for an exception during an FFI call."
+ ^false!

Item was changed:
  ----- Method: PrimitiveError>>isPrimitiveError (in category 'testing') -----
  isPrimitiveError
+ "Answer if the receiver is an error object returned by a primitive."
- "Answer a boolean indicating if the receiver is an error object returned by a primitive"
  ^true!

Item was changed:
  ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') -----
  recreateSpecialObjectsArray
  "Smalltalk recreateSpecialObjectsArray"
 
  "To external package developers:
  **** DO NOT OVERRIDE THIS METHOD.  *****
  If you are writing a plugin and need additional special object(s) for your own use,
  use addGCRoot() function and use own, separate special objects registry "
 
  "The Special Objects Array is an array of objects used by the Squeak virtual machine.
  Its contents are critical and accesses to it by the VM are unchecked, so don't even
  think of playing here unless you know what you are doing."
  | newArray |
  newArray := Array new: 60.
  "Nil false and true get used throughout the VM"
  newArray at: 1 put: nil.
  newArray at: 2 put: false.
  newArray at: 3 put: true.
  "This association holds the active process (a ProcessScheduler)"
  newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
  "Numerous classes below used for type checking and instantiation"
  newArray at: 5 put: Bitmap.
  newArray at: 6 put: SmallInteger.
  newArray at: 7 put: ByteString.
  newArray at: 8 put: Array.
  newArray at: 9 put: Smalltalk.
  newArray at: 10 put: BoxedFloat64.
  newArray at: 11 put: (self globals at: #Context).
  newArray at: 12 put: nil. "was BlockContext."
  newArray at: 13 put: Point.
  newArray at: 14 put: LargePositiveInteger.
  newArray at: 15 put: Display.
  newArray at: 16 put: Message.
  newArray at: 17 put: CompiledMethod.
  newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
  newArray at: 19 put: Semaphore.
  newArray at: 20 put: Character.
  newArray at: 21 put: #doesNotUnderstand:.
  newArray at: 22 put: #cannotReturn:.
  newArray at: 23 put: nil. "This is the process signalling low space."
  "An array of the 32 selectors that are compiled as special bytecodes,
  paired alternately with the number of arguments each takes."
  newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
  #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
  #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
  #~~ 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
  "An array of the 255 Characters in ascii order.
  Cog inlines table into machine code at: prim so do not regenerate it.
  This is nil in Spur, which has immediate Characters."
  newArray at: 25 put: (self specialObjectsArray at: 25).
  newArray at: 26 put: #mustBeBoolean.
  newArray at: 27 put: ByteArray.
  newArray at: 28 put: Process.
  "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
  newArray at: 29 put: self compactClassesArray.
  newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
  newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
  "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
  newArray at: 32 put: nil. "was the prototype Float"
  newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
  newArray at: 34 put: nil. "was the prototype Point"
  newArray at: 35 put: #cannotInterpret:.
  newArray at: 36 put: nil. "was the prototype MethodContext"
  newArray at: 37 put: BlockClosure.
  newArray at: 38 put: nil. "was the prototype BlockContext"
  "array of objects referred to by external code"
  newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
  newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
  newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
  newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
  newArray at: 43 put: LargeNegativeInteger.
  "External objects for callout.
  Note: Written so that one can actually completely remove the FFI."
  newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
  newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
  newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
  newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
  newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
  newArray at: 49 put: #aboutToReturn:through:.
  newArray at: 50 put: #run:with:in:.
  "51 reserved for immutability message"
  newArray at: 51 put: #attemptToAssign:withIndex:.
  newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
  #'bad argument' #'bad index'
  #'bad number of arguments'
  #'inappropriate operation'  #'unsupported operation'
  #'no modification' #'insufficient object memory'
  #'insufficient C memory' #'not found' #'bad method'
  #'internal error in named primitive machinery'
  #'object may move' #'resource limit exceeded'
  #'object is pinned' #'primitive write beyond end of object'
  #'object moved' #'object not pinned' #'callback error'),
+ {PrimitiveError new errorName: #'operating system error'; yourself.
+ ExceptionInFFICallError new errorName: #'exception in FFI call'; yourself}.
- {PrimitiveError new errorName: #'operating system error'; yourself}.
  "53 to 55 are for Alien"
  newArray at: 53 put: (self at: #Alien ifAbsent: []).
  newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
  newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
 
  "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
  newArray at: 56 put: nil.
 
  "reserved for foreign callback process"
  newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
 
  newArray at: 58 put: #unusedBytecode.
  "59 reserved for Sista counter tripped message"
  newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
  "60 reserved for Sista class trap message"
  newArray at: 60 put: #classTrapFor:.
 
  "Now replace the virtual machine's reference in one atomic operation"
  self specialObjectsArray becomeForward: newArray!

Item was changed:
  (PackageInfo named: 'System') postscript: 'UserInterfaceTheme cleanUp: true.
+ (UserInterfaceTheme named: UserInterfaceTheme current name) apply.
+ (Smalltalk primitiveErrorTable size >= 22
+  and: [(Smalltalk primitiveErrorTable at: 22) isPrimitiveError
+  and: [(Smalltalk primitiveErrorTable at: 22) isExceptionInFFICallError]]) ifFalse:
+ [Smalltalk recreateSpecialObjectsArray]'!
- (UserInterfaceTheme named: UserInterfaceTheme current name) apply.'!

On Fri, 24 Aug 2018, [hidden email] wrote:

> Eliot Miranda uploaded a new version of System to project The Trunk:
> http://source.squeak.org/trunk/System-eem.1041.mcz
>
> =============== Diff against System-eem.1040 ===============
>
> Item was changed:
>  (PackageInfo named: 'System') postscript: 'UserInterfaceTheme cleanUp: true.
> + (UserInterfaceTheme named: UserInterfaceTheme current name) apply.

Leaving the previous snippets in these scripts is dangerous. If it turns
out that these two lines cannot be applied more than once, or they don't
work anymore, then it will be really cumbersome to remove them once
another .mcm is created. I suggest they be removed before that happens
unless you're sure they are harmless.

Levente

> + (Smalltalk primitiveErrorTable size >= 22
> +  and: [(Smalltalk primitiveErrorTable at: 22) isPrimitiveError
> +  and: [(Smalltalk primitiveErrorTable at: 22) isExceptionInFFICallError]]) ifFalse:
> + [Smalltalk recreateSpecialObjectsArray]'!
> - (UserInterfaceTheme named: UserInterfaceTheme current name) apply.'!