-
Notifications
You must be signed in to change notification settings - Fork 65
/
StackInterpreterPrimitives.class.st
4250 lines (3560 loc) · 161 KB
/
StackInterpreterPrimitives.class.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Class {
#name : #StackInterpreterPrimitives,
#superclass : #StackInterpreter,
#pools : [
'LibFFIConstants',
'VMBasicConstants'
],
#category : #'VMMaker-Interpreter'
}
{ #category : #initialization }
StackInterpreterPrimitives >> allocateParameters: anInteger using: allocationBlock [
<inline: #always>
anInteger = 0 ifTrue: [ ^ nil ].
^ self
cCode: [ allocationBlock value: anInteger ]
inSmalltalk: [ CArrayAccessor on: (Array new: anInteger) ]
]
{ #category : #'primitive support' }
StackInterpreterPrimitives >> cloneContext: aContext [
| sz cloned spouseFP sp |
<var: #spouseFP type: #'char *'>
<var: #sp type: #'sqInt'>
sz := objectMemory numSlotsOf: aContext.
cloned := objectMemory eeInstantiateMethodContextSlots: sz.
cloned ~= 0 ifTrue:
[0 to: StackPointerIndex do:
[:i|
objectMemory
storePointerUnchecked: i
ofObject: cloned
withValue: (self instVar: i ofContext: aContext)].
MethodIndex to: ReceiverIndex do:
[:i|
objectMemory
storePointerUnchecked: i
ofObject: cloned
withValue: (objectMemory fetchPointer: i ofObject: aContext)].
(self isStillMarriedContext: aContext)
ifTrue:
[spouseFP := self frameOfMarriedContext: aContext.
sp := (self stackPointerIndexForFrame: spouseFP) - 1.
0 to: sp do:
[:i|
objectMemory
storePointerUnchecked: i + CtxtTempFrameStart
ofObject: cloned
withValue: (self temporary: i in: spouseFP)]]
ifFalse:
[sp := (self fetchStackPointerOf: aContext) - 1.
0 to: sp do:
[:i|
objectMemory
storePointerUnchecked: i + CtxtTempFrameStart
ofObject: cloned
withValue: (objectMemory fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]]].
^cloned
]
{ #category : #ffi }
StackInterpreterPrimitives >> doPrimitiveSameThreadCallout [
"Actual primitive implementation of primitiveSameThreadCallout.
Because of Slang restrictions, making FFI optional requires cutting the primitive in two different methods. Otherwise slang will unconditionally do all local declarations which may refer to invalid types if FFI is not enabled.
Method primitiveSameThreadCallout checks if the feature is available. If so, it calls this method."
<inline: false>
<option: #FEATURE_FFI>
| externalFunction cif PARAM_EXTERNALFUNCTION PARAM_ARGUMENTS argumentsArrayOop argumentSize parameters returnHolder |
<var: #parameters type: #'void **'>
<var: #returnHolder type: #'void *'>
<var: #externalFunction type: #'void *'>
PARAM_EXTERNALFUNCTION := 1.
PARAM_ARGUMENTS := 0.
"1. Obtain externalFunction and extract the CIF"
externalFunction := self getHandler: (self stackValue: PARAM_EXTERNALFUNCTION).
self failed
ifTrue: [
self logDebug: 'Invalid External Function Argument'.
^ self primitiveFailFor: PrimErrBadArgument ].
cif := self getHandlerAsCif:(objectMemory
fetchPointer: 1
ofObject: (self stackValue: PARAM_EXTERNALFUNCTION)).
self failed
ifTrue: [
self logDebug: 'Invalid CIF in ExternalFunction'.
^ self primitiveFailFor: PrimErrBadArgument ].
" 2. Prepare Arguments:
- Verify Arguments is an Array
- Allocate space for all the arguments in the stack and a holder for the return, and the parameters' pointer C array
- Marshall arguments and store in the parameter array."
argumentsArrayOop := self stackValue: PARAM_ARGUMENTS.
(objectMemory isArray: argumentsArrayOop)
ifFalse: [
self logDebug: 'Argument Array is not an Array'.
^ self primitiveFailFor: PrimErrBadArgument ].
argumentSize := cif numberArguments.
(objectMemory slotSizeOf: argumentsArrayOop) = argumentSize
ifFalse: [
self logDebug: 'Argument Array size mismatch'.
^ self primitiveFailFor: PrimErrBadArgument ].
parameters := self allocateParameters: argumentSize
using: [:aSize | self alloca: (self sizeof: #'void*') * aSize ].
0 to: argumentSize - 1 do: [ :i |
| argType argHolder |
argType := cif argTypeAt: i.
argHolder := self alloca: argType size.
parameters at: i put: argHolder.
self marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType type withSize: argType size.
self failed
ifTrue: [
self logDebug: 'Could not convert argument index: %d' _: i + 1.
^ self primitiveFailFor: PrimErrBadArgument ]].
returnHolder := self alloca: cif returnType size.
" 3. Call and then return
- Call
- Marshall Argument and push it to the stack
- Return"
self
ffi_call: cif
_: externalFunction
_: returnHolder
_: parameters.
self marshallAndPushReturnValueFrom: returnHolder ofType: cif returnType poping: 3.
]
{ #category : #ffi }
StackInterpreterPrimitives >> doPrimitiveWorkerCallout [
"Actual primitive implementation of primitiveWorkerCallout.
Because of Slang restrictions, making FFI optional requires cutting the primitive in two different methods. Otherwise slang will unconditionally do all local declarations which may refer to invalid types if FFI is not enabled.
Method primitiveWorkerCallout checks if the feature is available. If so, it calls this method."
<inline: false>
<option: #FEATURE_THREADED_FFI>
<export: true>
| externalFunction cif PARAM_EXTERNALFUNCTION PARAM_ARGUMENTS PARAM_SEMAPHORE_INDEX PARAM_RECEIVER argumentsArrayOop argumentSize parameters returnHolder primitiveReceiver worker semaphoreIndex task |
<var: #parameters type: #'void **'>
<var: #returnHolder type: #'void *'>
<var: #task type: #'WorkerTask *'>
<var: #externalFunction type: #'void *'>
PARAM_RECEIVER := 3.
PARAM_EXTERNALFUNCTION := 2.
PARAM_ARGUMENTS := 1.
PARAM_SEMAPHORE_INDEX := 0.
"1. Obtain externalFunction and extract the CIF"
externalFunction := self getHandler: (self stackValue: PARAM_EXTERNALFUNCTION).
self failed
ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
cif := self getHandlerAsCif:(objectMemory
fetchPointer: 1
ofObject: (self stackValue: PARAM_EXTERNALFUNCTION)).
self failed
ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
" 2. Obtain the semaphore index"
semaphoreIndex := self stackIntegerValue: PARAM_SEMAPHORE_INDEX.
self failed
ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
" 3. Obtain the receiver and extract the worker "
primitiveReceiver := self stackValue: PARAM_RECEIVER.
worker := self getWorkerFromAddress: (self getHandler: primitiveReceiver).
self failed
ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
" 4. Prepare Arguments:
- Verify Arguments is an Array
- Allocate space for all the arguments in the stack and a holder for the return, and the parameters' pointer C array
- Marshall arguments and store in the parameter array."
argumentsArrayOop := self stackValue: PARAM_ARGUMENTS.
(objectMemory isArray: argumentsArrayOop)
ifFalse: [ ^ self primitiveFailFor: PrimErrBadArgument ].
argumentSize := cif numberArguments.
(objectMemory slotSizeOf: argumentsArrayOop) = argumentSize
ifFalse: [ ^ self primitiveFailFor: PrimErrBadArgument ].
parameters := self allocateParameters: argumentSize using: [ :aSize |
self calloc: aSize _: (self sizeof: #'void*')].
0 to: argumentSize - 1 do: [ :i |
| argType argHolder |
argType := cif argTypeAt: i.
argHolder := self malloc: argType size.
parameters at: i put: argHolder.
self marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType type withSize: argType size.
self failed
ifTrue: [
self freeArgumentsArray: parameters count: argumentSize.
^ self primitiveFailFor: PrimErrBadArgument ]].
cif returnType size > 0
ifTrue: [returnHolder := self malloc: (cif returnType size max: BytesPerWord)]
ifFalse: [returnHolder := nil].
" 5. Create the worker task and enqueue it"
task := self worker_task_new: externalFunction _: cif _: parameters _: returnHolder _: semaphoreIndex.
self worker_dispatch_callout: worker _: task.
self pop: 4 thenPush: (objectMemory newExternalAddressWithValue: (self cCoerce: task asInteger to: 'void*'))
]
{ #category : #ffi }
StackInterpreterPrimitives >> doPrimitiveWorkerExtractReturnValue [
"Actual primitive implementation of primitiveWorkerExtractReturnValue.
Because of Slang restrictions, making FFI optional requires cutting the primitive in two different methods. Otherwise slang will unconditionally do all local declarations which may refer to invalid types if FFI is not enabled.
Method primitiveWorkerExtractReturnValue checks if the feature is available. If so, it calls this method."
<inline: false>
<option: #FEATURE_THREADED_FFI>
| returnHolder task PARAM_RECEIVER PARAM_TASK_ADDRESS worker taskAddress primitiveReceiver |
<var: #returnHolder type: #'void *'>
<var: #task type: #'WorkerTask *'>
<var: #worker type: #'Worker *'>
PARAM_RECEIVER := 1.
PARAM_TASK_ADDRESS := 0.
"1. Extract Task address and worker"
taskAddress := self readAddress: (self stackValue: PARAM_TASK_ADDRESS).
primitiveReceiver := self stackValue: PARAM_RECEIVER.
worker := self getWorkerFromAddress: (self getHandler: primitiveReceiver).
self failed
ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
"2. Get the returnHolder from the task"
task := self getTaskFromAddress: taskAddress.
task ifNil: [ ^ self primitiveFailFor: PrimErrBadReceiver ].
returnHolder := task returnHolderAddress.
"3. Marshall the return value and push it in the stack"
self
marshallAndPushReturnValueFrom: returnHolder
ofType: task cif returnType
poping: 2.
"4. Free the task."
task freeTask.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> ffi_call: aCif _: externalFunctionAddress _: returnHolder _: parameters [
<doNotGenerate>
libFFI ffiCall: aCif _: externalFunctionAddress _: returnHolder _: parameters
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> field: index ofFrame: theFP [
"Arrange to answer naked frame pointers for unmarried
senders to avoid reifying contexts in the search."
<var: #theFP type: #'char *'>
<inline: false>
| callerFP |
<var: #callerFP type: #'char *'>
^index caseOf:
{[SenderIndex] -> [callerFP := self frameCallerFP: theFP.
callerFP = 0
ifTrue: [self frameCallerContext: theFP]
ifFalse: [(self frameHasContext: callerFP)
ifTrue: [self assert: (self checkIsStillMarriedContext: (self frameContext: callerFP) currentFP: nil).
self frameContext: callerFP]
ifFalse: [callerFP asInteger]]].
[StackPointerIndex] -> [ConstZero].
[InstructionPointerIndex] -> [ConstZero].
[MethodIndex] -> [self frameMethodObject: theFP].
[ClosureIndex] -> [(self frameIsBlockActivation: theFP)
ifTrue: [self frameStackedReceiver: theFP
numArgs: (self frameNumArgs: theFP)]
ifFalse: [objectMemory nilObject]].
[ReceiverIndex] -> [self frameReceiver: theFP] }
otherwise:
[self assert: (index - CtxtTempFrameStart between: 0 and: (self stackPointerIndexForFrame: theFP)).
self temporary: index - CtxtTempFrameStart in: theFP]
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> fieldOrSenderFP: index ofContext: contextObj [
"Arrange to answer naked frame pointers for unmarried
senders to avoid reifying contexts in the search."
<inline: false>
| tempIndex spouseFP |
<var: #spouseFP type: #'char *'>
tempIndex := index - CtxtTempFrameStart.
(self isStillMarriedContext: contextObj) ifFalse:
[^tempIndex >= (self fetchStackPointerOf: contextObj)
ifTrue: [objectMemory nilObject]
ifFalse: [self fetchPointer: index ofObject: contextObj]].
spouseFP := self frameOfMarriedContext: contextObj.
tempIndex >= (self stackPointerIndexForFrame: spouseFP) ifTrue:
[^objectMemory nilObject].
^self field: index ofFrame: spouseFP
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> fieldsInFrame: theFP [
<var: #theFP type: #'char *'>
^CtxtTempFrameStart + (self stackPointerIndexForFrame: theFP)
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> frameIsMarked: theFPInt [
^((stackPages unsignedLongAt: theFPInt + FoxFrameFlags) bitAnd: 2) ~= 0
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> freeArgumentsArray: arguments count: count [
0 to: count - 1 do: [ :i |
(arguments at: i) ifNotNil: [ :aPtr |
arguments at: i put: nil.
self free: aPtr ]].
self free: arguments.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> getHandler: anOop [
<api>
<returnTypeC: #'void *'>
((objectMemory isPointers: anOop) not or: [ (objectMemory slotSizeOf: anOop) < 1 ])
ifTrue: [ self primitiveFail. ^ nil ].
^ self readAddress: (objectMemory fetchPointer: 0 ofObject: anOop)
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> getHandlerAsCif: anOop [
^ self
cCode: [ self cCoerce: (self getHandler: anOop) to: 'ffi_cif *' ]
inSmalltalk: [ libFFI cifAtAddress: (self getHandler: anOop)]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> getTaskFromAddress: anInteger [
^ self
cCode: [ self cCoerce: anInteger to: #'WorkerTask *' ]
inSmalltalk: [ libFFI testWorker tasks detect: [ :e | e asInteger = anInteger ] ]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> getWorkerFromAddress: anInteger [
^ self
cCode: [ self cCoerce: anInteger to: #'Worker *' ]
inSmalltalk: [
self assert: anInteger = libFFI testWorker asInteger.
libFFI testWorker ]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> ioLoadModule: moduleNameString OfLength: moduleNameStringSize [
<doNotGenerate>
^0
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> ioLoadSymbol: functionNameIndex OfLength: functionLength FromModule: moduleHandle [
<doNotGenerate>
^0
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> isAppropriateForCopyObject: oop [
(objectMemory isPointersNonImm: oop) ifFalse:
[^false].
(objectMemory isContext: oop) ifTrue:
[^(self isStillMarriedContext: oop) not].
"Note there is no version in CoInterpreterPrimtiives such as
(objectMemory isCompiledMethod: oop) ifTrue:
[^(self methodHasCogMethod: oop) not].
because isPointersNonImm: excludes compiled methods and the
copy loop in primitiveCopyObject cannot handle compiled methods."
^true
]
{ #category : #ffi }
StackInterpreterPrimitives >> loadModuleByName: moduleNameOop [
<returnTypeC: #'void*'>
<var: #moduleNameString type: #'char*'>
| moduleNameString moduleNameStringSize |
moduleNameString := objectMemory firstIndexableField: moduleNameOop.
moduleNameStringSize := objectMemory byteSizeOf: moduleNameOop.
^ self ioLoadModule: moduleNameString OfLength: moduleNameStringSize
]
{ #category : #logging }
StackInterpreterPrimitives >> logDebug: aString [
<doNotGenerate>
aString traceCr.
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> markFrame: theFPInt [
stackPages
unsignedLongAt: theFPInt + FoxFrameFlags
put: ((stackPages unsignedLongAt: theFPInt + FoxFrameFlags) bitOr: 2)
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallAndPushReturnValueFrom: returnHolder ofType: ffiType poping: argumentsAndReceiverCount [
<option: #FEATURE_FFI>
<var: #ffiType type: #'ffi_type *'>
[ ffiType type ]
caseOf: {
[ FFI_TYPE_SINT8 ] -> [ self pop: argumentsAndReceiverCount thenPushInteger: (objectMemory readSINT8AtPointer: returnHolder) ].
[ FFI_TYPE_SINT16 ] -> [ self pop: argumentsAndReceiverCount thenPushInteger: (objectMemory readSINT16AtPointer: returnHolder) ].
[ FFI_TYPE_SINT32 ] -> [ self
pop: argumentsAndReceiverCount
thenPush: (objectMemory signed32BitIntegerFor: (objectMemory readSINT32AtPointer: returnHolder)) ].
[ FFI_TYPE_SINT64 ] -> [ self
pop: argumentsAndReceiverCount
thenPush: (objectMemory signed64BitIntegerFor: (objectMemory readSINT64AtPointer: returnHolder)) ].
[ FFI_TYPE_UINT8 ] -> [ self pop: argumentsAndReceiverCount thenPushInteger: (objectMemory readUINT8AtPointer: returnHolder) ].
[ FFI_TYPE_UINT16 ] -> [ self pop: argumentsAndReceiverCount thenPushInteger: (objectMemory readUINT16AtPointer: returnHolder) ].
[ FFI_TYPE_UINT32 ] -> [ self
pop: argumentsAndReceiverCount
thenPush: (objectMemory positive32BitIntegerFor: (objectMemory readUINT32AtPointer: returnHolder)) ].
[ FFI_TYPE_UINT64 ] -> [ self
pop: argumentsAndReceiverCount
thenPush: (objectMemory positive64BitIntegerFor: (objectMemory readUINT64AtPointer: returnHolder)) ].
[ FFI_TYPE_POINTER ] -> [ self pop: argumentsAndReceiverCount thenPush: (objectMemory newExternalAddressWithValue: (objectMemory readPointerAtPointer: returnHolder)) ].
[ FFI_TYPE_STRUCT ] -> [ self pop: argumentsAndReceiverCount thenPush: (self newByteArrayWithStructContent: returnHolder size: ffiType size) ].
[ FFI_TYPE_FLOAT ] -> [ self pop: argumentsAndReceiverCount thenPushFloat: (objectMemory readFloat32AtPointer: returnHolder) ].
[ FFI_TYPE_DOUBLE ] -> [ self pop: argumentsAndReceiverCount thenPushFloat: (objectMemory readFloat64AtPointer: returnHolder) ].
[ FFI_TYPE_VOID ] -> [ self pop: argumentsAndReceiverCount - 1 "Pop the arguments leaving the receiver" ]}
otherwise: [ self primitiveFailFor: PrimErrBadArgument ]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType withSize: argTypeSize [
<option: #FEATURE_FFI>
[ argType ]
caseOf:
{([ FFI_TYPE_POINTER ]
-> [ self marshallPointerFrom: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_STRUCT ]
-> [ self marshallStructFrom: argumentsArrayOop at: i into: argHolder withSize: argTypeSize ]).
([ FFI_TYPE_FLOAT ]
-> [ self marshallFloatFrom: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_DOUBLE ]
-> [ self marshallDoubleFrom: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_SINT8 ]
-> [ self marshallSInt8From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_UINT8 ]
-> [ self marshallUInt8From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_SINT16 ]
-> [ self marshallSInt16From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_UINT16 ]
-> [ self marshallUInt16From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_SINT32 ]
-> [ self marshallSInt32From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_UINT32 ]
-> [ self marshallUInt32From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_SINT64 ]
-> [ self marshallSInt64From: argumentsArrayOop at: i into: argHolder ]).
([ FFI_TYPE_UINT64 ]
-> [ self marshallUInt64From: argumentsArrayOop at: i into: argHolder ])}
otherwise: [ self primitiveFailFor: PrimErrBadArgument ]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallDoubleFrom: argumentArrayOop at: index into: holder [
| doubleHolder |
doubleHolder := self cCoerce: holder to: #'double *'.
doubleHolder at: 0 put: (self fetchFloat: index ofObject: argumentArrayOop ).
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallFloatFrom: argumentArrayOop at: index into: holder [
| floatHolder |
floatHolder := self cCoerce: holder to: #'float *'.
floatHolder at: 0 put: (self fetchFloat: index ofObject: argumentArrayOop ).
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallPointerFrom: argumentArrayOop at: index into: holder [
| pointerHolder externalAddress |
pointerHolder := self cCoerce: holder to: #'void **'.
externalAddress := objectMemory fetchPointer: index ofObject: argumentArrayOop.
pointerHolder at: 0 put: (self readAddress: externalAddress).
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallSInt16From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self fetchInteger: index ofObject: argumentArrayOop.
value > INT16_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
value < INT16_MIN ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'int16_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallSInt32From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self signed32BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop).
self failed ifTrue: [ ^self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'int32_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallSInt64From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self signed64BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop).
self failed ifTrue: [ ^ self ].
intHolder := self cCoerce: holder to: #'int64_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallSInt8From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self fetchInteger: index ofObject: argumentArrayOop.
value > INT8_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
value < INT8_MIN ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'int8_t *'.
intHolder at: 0 put: (self fetchInteger: index ofObject: argumentArrayOop ).
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallStructFrom: argumentsArrayOop at: index into: holder withSize: typeSize [
| address srcPtr oop |
oop := objectMemory fetchPointer: index ofObject: argumentsArrayOop.
(objectMemory fetchClassOf: oop) = objectMemory classExternalAddress
ifTrue: [
address := self readAddress: oop.
address = 0 ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]]
ifFalse: [
(objectMemory fetchClassOf: oop) = objectMemory classByteArray
ifFalse: [ ^ self primitiveFailFor: PrimErrBadArgument ].
address := objectMemory firstIndexableField: oop ].
srcPtr := objectMemory cCoerce: address to: 'void *'.
self
cCode: [ objectMemory memcpy: holder _: srcPtr _: typeSize ]
inSmalltalk: [
holder object
replaceFrom: 1 to: typeSize
with: (objectMemory cCoerce: srcPtr to: 'char *') startingAt: 0]
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallUInt16From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self fetchInteger: index ofObject: argumentArrayOop.
value < 0 ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
value > UINT16_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'uint16_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallUInt32From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self positive32BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop).
self failed ifTrue: [ ^self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'uint32_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallUInt64From: argumentArrayOop at: index into: holder [
| intHolder value |
value := self positive64BitValueOf:( objectMemory fetchPointer: index ofObject: argumentArrayOop ).
self failed
ifTrue: [ ^ self ].
intHolder := self cCoerce: holder to: #'uint64_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> marshallUInt8From: argumentArrayOop at: index into: holder [
| intHolder value oop |
oop := objectMemory fetchPointer: index ofObject: argumentArrayOop.
value := (objectMemory isCharacterObject: oop)
ifTrue: [ objectMemory characterValueOf: oop ]
ifFalse: [ objectMemory integerValueOf: oop ].
value < 0 ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
value > UINT8_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ].
intHolder := self cCoerce: holder to: #'uint8_t *'.
intHolder at: 0 put: value.
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> maybeExternalAddressOf: rcvr startingAt: byteOffset size: byteSize [
"Return an int of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr.
If the rcvr is an ExternalAddress the initial address is its contents. If the receiver is a byte array, the address is inside the byte array"
| rcvrClass rcvrSize addr |
(objectMemory isBytes: rcvr) ifFalse:[^self primitiveFail].
(byteOffset > 0) ifFalse:[^ self primitiveFail].
rcvrClass := objectMemory fetchClassOf: rcvr.
rcvrSize := objectMemory byteSizeOf: rcvr.
rcvrClass = objectMemory classExternalAddress ifTrue:[
rcvrSize = BytesPerWord ifFalse:[^self primitiveFail].
addr := objectMemory fetchPointer: 0 ofObject: rcvr.
addr = 0 ifTrue: [ ^ 0 ].
] ifFalse:[
(byteOffset+byteSize-1 <= rcvrSize)
ifFalse:[ ^ 0].
addr := self cCoerce: (objectMemory firstIndexableField: rcvr) to: #'sqIntptr_t'.
].
addr := addr + byteOffset - 1.
^ addr
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> newByteArrayWithStructContent: aPointer size: sizeToCopy [
| oop targetPointer |
oop := objectMemory instantiateClass: objectMemory classByteArray indexableSize: sizeToCopy.
targetPointer := objectMemory firstIndexableField: oop.
self memcpy: targetPointer _: aPointer _: sizeToCopy.
^ oop
]
{ #category : #'primitive support' }
StackInterpreterPrimitives >> noInlineLoadFloatOrIntFrom: floatOrInt [
<inline: #never>
^objectMemory loadFloatOrIntFrom: floatOrInt
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> pathTo: goal using: anArray followWeak: followWeak [
"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error:
PrimErrBadArgument if stack is not an Array
PrimErrBadIndex if search overflows stack
PrimErrNotFound if goal cannot be found"
<var: #index type: #sqInt> "beware, must be signed"
| current index next stackSize stackp freeStartAtStart |
(objectMemory isArray: anArray) ifFalse:
[^PrimErrBadArgument].
self assert: objectMemory allObjectsUnmarked.
freeStartAtStart := objectMemory freeStart. "check no allocations during search"
objectMemory beRootIfOld: anArray. "so no store checks are necessary on stack"
stackSize := objectMemory lengthOf: anArray.
objectMemory mark: anArray.
"no need. the current context is not reachable from the active process (suspendedContext is nil)"
"objectMemory mark: self activeProcess."
current := objectMemory specialObjectsOop.
objectMemory mark: current.
index := objectMemory lengthOf: current.
stackp := 0.
[[(index := index - 1) >= -1] whileTrue:
[(stackPages couldBeFramePointer: current)
ifTrue:
[next := index >= 0
ifTrue: [self field: index ofFrame: (self cCoerceSimple: current to: #'char *')]
ifFalse: [objectMemory nilObject]]
ifFalse:
[index >= 0
ifTrue:
[next := (objectMemory isContextNonImm: current)
ifTrue: [self fieldOrSenderFP: index ofContext: current]
ifFalse: [objectMemory fetchPointer: index ofObject: current]]
ifFalse:
[next := objectMemory fetchClassOfNonImm: current]].
(stackPages couldBeFramePointer: next)
ifTrue: [self assert: (self isFrame: (self cCoerceSimple: next to: #'char *')
onPage: (stackPages stackPageFor: (self cCoerceSimple: next to: #'char *')))]
ifFalse: [self assert: (self checkOkayOop: next)].
next = goal ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory storePointer: stackp ofObject: anArray withValue: current.
self pruneStack: anArray stackp: stackp.
^0].
((objectMemory isNonIntegerObject: next)
and: [(stackPages couldBeFramePointer: next)
ifTrue: [(self frameIsMarked: next) not]
ifFalse:
[(objectMemory isMarked: next) not
and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
and: [followWeak or: [(objectMemory isWeakNonImm: next) not]]]]])
ifTrue:
[stackp + 2 > stackSize ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory nilFieldsOf: anArray.
^PrimErrBadIndex]. "PrimErrNoMemory ?"
objectMemory
storePointerUnchecked: stackp ofObject: anArray withValue: current;
storePointerUnchecked: stackp + 1 ofObject: anArray withValue: (objectMemory integerObjectOf: index).
stackp := stackp + 2.
(stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
ifTrue:
[self markFrame: next.
index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
ifFalse:
[objectMemory mark: next.
(objectMemory isCompiledMethod: next)
ifTrue: [index := (objectMemory literalCountOf: next) + LiteralStart]
ifFalse: [index := objectMemory lengthOf: next]].
current := next]].
current = objectMemory specialObjectsOop ifTrue:
[self assert: freeStartAtStart = objectMemory freeStart.
self unmarkAfterPathTo.
objectMemory nilFieldsOf: anArray.
^PrimErrNotFound].
index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: anArray).
current := objectMemory fetchPointer: stackp - 2 ofObject: anArray.
stackp := stackp - 2] repeat
]
{ #category : #'ffi - helpers' }
StackInterpreterPrimitives >> popSameThreadCalloutSuspendedProcess [
| aProcess |
aProcess := objectMemory splObj: SuspendedProcessInCallout.
aProcess = objectMemory nilObject
ifTrue: [ self error: 'SameThreadCalloutSuspendedProcessStack is empty' ].
objectMemory
splObj: SuspendedProcessInCallout
put: (objectMemory fetchPointer: NextLinkIndex ofObject: aProcess).
objectMemory storePointer: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject.
^ aProcess
]
{ #category : #'system control primitives' }
StackInterpreterPrimitives >> primitiveAllVMParameters: paramsArraySize [
"See primitiveVMParameter method comment"
| result |
result := objectMemory
eeInstantiateClassIndex: objectMemory arrayClassIndexPun
format: objectMemory arrayFormat
numSlots: paramsArraySize.
1 to: paramsArraySize do: [ :index |
objectMemory
storePointerUnchecked: index - 1
ofObject: result
withValue: ((self primitiveGetVMParameter: index) ifNil: [
objectMemory nilObject ]) ].
objectMemory beRootIfOld: result.
self methodReturnValue: result
]
{ #category : #'object access primitives' }
StackInterpreterPrimitives >> primitiveClone [
"Return a shallow copy of the receiver.
Special-case non-single contexts (because of context-to-stack mapping).
Can't fail for contexts cuz of image context instantiation code (sigh)."
<maycallback>
| rcvr newCopy |
rcvr := self stackTop.
(objectMemory isImmediate: rcvr)
ifTrue:
[newCopy := rcvr]
ifFalse:
[(objectMemory isContextNonImm: rcvr)
ifTrue:
[newCopy := self cloneContext: rcvr]
ifFalse:
[(argumentCount = 0
or: [(objectMemory isForwarded: rcvr) not])
ifTrue: [newCopy := objectMemory clone: rcvr]
ifFalse: [newCopy := 0]].
newCopy = 0 ifTrue:
[^self primitiveFailFor: PrimErrNoMemory]].
self pop: argumentCount + 1 thenPush: newCopy
]
{ #category : #'indexing primitives' }
StackInterpreterPrimitives >> primitiveContextAt [
"Special version of primitiveAt for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
index := self stackTop.
(objectMemory isIntegerObject: index) ifFalse:
[self primitiveFailFor: PrimErrBadArgument.
^self].
index := objectMemory integerValueOf: index.
aContext := self stackValue: 1.
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[value := self stObject: aContext at: index.
self successful ifTrue:
[self pop: argumentCount + 1 thenPush: value].
^self].
self writeBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
stSize := self fetchStackPointerOf: aContext.
(index between: 1 and: stSize) ifFalse:
[self primitiveFailFor: PrimErrBadIndex.
^self].
value := self subscript: aContext with: (index + fixedFields) format: fmt.
self pop: argumentCount + 1 thenPush: value.
^self].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
[self primitiveFailFor: PrimErrBadIndex.
^self].
value := self temporary: index - 1 in: spouseFP.
self pop: argumentCount + 1 thenPush: value
]
{ #category : #'indexing primitives' }
StackInterpreterPrimitives >> primitiveContextAtPut [
"Special version of primitiveAtPut for accessing contexts.
Written to be varargs for use from mirror primitives."
| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
<inline: false>
<var: #spouseFP type: #'char *'>
value := self stackTop.
index := self stackValue: 1.
aContext := self stackValue: 2.
(objectMemory isIntegerObject: index) ifFalse:
[self primitiveFailFor: PrimErrBadArgument.
^self].
"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
hdr := objectMemory baseHeader: aContext.
index := objectMemory integerValueOf: index.
(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
[^self primitiveFailFor: PrimErrBadReceiver ].
self writeBackHeadFramePointers.
(self isStillMarriedContext: aContext) ifFalse:
[fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: aContext format: fmt.
fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
stSize := self fetchStackPointerOf: aContext.
(index between: 1 and: stSize) ifFalse:
[self primitiveFailFor: PrimErrBadIndex.
^self].
self subscript: aContext with: (index + fixedFields) storing: value format: fmt.
self pop: argumentCount + 1 thenPush: value.
^self].
spouseFP := self frameOfMarriedContext: aContext.
(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
[self primitiveFailFor: PrimErrBadIndex.
^self].
self temporary: index - 1 in: spouseFP put: value.
self pop: argumentCount + 1 thenPush: value
]
{ #category : #'indexing primitives' }
StackInterpreterPrimitives >> primitiveContextSize [
"Special version of primitiveSize for accessing contexts.
Written to be varargs for use from mirror primitives."
| rcvr sz hdr fmt totalLength fixedFields |
<inline: false>
<druidExitPoint>
rcvr := self stackTop.
hdr := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: rcvr format: fmt.
fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
(objectMemory isContextHeader: hdr)
ifTrue:
[self writeBackHeadFramePointers.
sz := self stackPointerForMaybeMarriedContext: rcvr]
ifFalse: [sz := totalLength - fixedFields].
self pop: argumentCount + 1 thenPush: (objectMemory integerObjectOf: sz)
]
{ #category : #'indexing primitives' }
StackInterpreterPrimitives >> primitiveContextXray [
"Lift the veil from a context and answer an integer describing its interior state.
Used for e.g. VM tests so they can verify they're testing what they think they're testing.
0 implies a vanilla heap context.
Bit 0 = is or was married to a frame
Bit 1 = is still married to a frame
Bit 2 = frame is executing machine code
Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
Bit 4 = method is currently compiled to machine code"
| context flags |
context := self stackTop.
(self isMarriedOrWidowedContext: context)
ifTrue:
[(self checkIsStillMarriedContext: context currentFP: framePointer)
ifTrue: [flags := 3]
ifFalse: [flags := 1]]