forked from dolphinsmalltalk/DolphinVM
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ExternalCall.asm
2112 lines (1631 loc) · 65.2 KB
/
ExternalCall.asm
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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Dolphin Smalltalk
;;
;; External call function. Dynamically invoke external functions, converting
;; and pushing 32-bit values from objects on the Smalltalk stack
;;
INCLUDE IstAsm.Inc
.LISTALL
.LALL
.CODE FFI_SEG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Imports
NewExternalStructurePointer EQU ?NewPointer@ExternalStructure@@SIPAV?$TOTE@X@@PAV?$TOTE@VBehavior@@@@PAX@Z
extern NewExternalStructurePointer:near32
NewExternalStructure EQU ?New@ExternalStructure@@SIPAV?$TOTE@X@@PAV?$TOTE@VBehavior@@@@PAX@Z
extern NewExternalStructure:near32
extern NewUnsigned:near32
extern NewSigned:near32
NewStringWithLen EQU ?NewWithLen@String@@SIPAV?$TOTE@VString@@@@PBDI@Z
extern NewStringWithLen:near32
NewStringFromWide EQU ?NewFromWide@String@@SIPAV?$TOTE@VString@@@@PB_W@Z
extern NewStringFromWide:near32
NewBSTR EQU ?NewBSTR@@YIPAV?$TOTE@VExternalAddress@@@@PBD@Z
extern NewBSTR:near32
NewBSTRFromWide EQU ?NewBSTR@@YIPAV?$TOTE@VExternalAddress@@@@PB_W@Z
extern NewBSTRFromWide:near32
NewGUID EQU ?NewGUID@@YIPAV?$TOTE@VVariantByteObject@@@@PAU_GUID@@@Z
extern NewGUID:near32
NewSigned64 EQU ?NewSigned64@Integer@@SGI_J@Z
extern NewSigned64:near32
NewUnsigned64 EQU ?NewUnsigned64@Integer@@SGI_K@Z
extern NewUnsigned64:near32
NewDWORD EQU ?NewDWORD@Interpreter@@SIPAV?$TOTE@VVariantByteObject@@@@KPAV?$TOTE@VBehavior@@@@@Z
extern NewDWORD:near32
SysFreeString EQU _SysFreeString@4
extern SysFreeString:near32
SysAllocString EQU _SysAllocString@4
extern SysAllocString:near32
REQUESTCOMPLETION EQU ?OnCallReturned@OverlappedCall@@AAEXXZ
extern REQUESTCOMPLETION:near32
; We need to test the structure type specially
ArgSTRUCT EQU 50
extern primitiveFailure0:near32
extern primitiveFailure1:near32
extern primitiveFailure2:near32
atoi PROTO C :DWORD
GetProcAddress PROTO STDCALL :HINSTANCE, :LPCSTR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Exports
public primitiveDLL32Call
public primitiveVirtualCall
public callExternalFunction
public @asyncDLL32Call@16
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Call Descriptor layout
CallDescriptor STRUCT 1t
m_proc DWORD ?
m_callConv BYTE ?
m_argsLen BYTE ? ; Length of the argument types part of the descriptor
m_returnParm BYTE ? ; Return type parameter literal frame index (if required)
m_return BYTE ? ; Return type
m_args BYTE 0t DUP (?) ; Argument types
CallDescriptor ENDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Macros
;; We'll use the accumulator to hold the argument we're currently processing
ARG EQU eax
RESULTR EQU a
RESULT EQU eax ; by convention EAX used for return value/result
RESULTB EQU al
RESULTW EQU ax
ASSUME eax:DWORD
;; And the ECX register as a general temp
TEMP EQU ecx
TEMPB EQU cl
TEMPW EQU cx
TEMP2 EQU edx
DESCRIPTOR EQU ebx
;; And the _IP register as the loop counter
INDEX EQU edi
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; These must all be different
ASSERTNEQU %_SP, %ARG
ASSERTNEQU %_SP, %INDEX
ASSERTNEQU %_SP, %TEMP
ASSERTNEQU %_SP, %TEMP2
ASSERTNEQU %_SP, %DESCRIPTOR
ASSERTNEQU %TEMP, %ARG
ASSERTNEQU %TEMP, %INDEX
ASSERTNEQU %TEMP, %TEMP2
ASSERTNEQU %TEMP, %DESCRIPTOR
ASSERTNEQU %TEMP2, %ARG
ASSERTNEQU %TEMP2, %INDEX
ASSERTNEQU %TEMP2, %TEMP
ASSERTNEQU %TEMP2, %DESCRIPTOR
ASSERTNEQU %INDEX, %ARG
ASSERTNEQU %INDEX, %TEMP
ASSERTNEQU %INDEX, %TEMP2
ASSERTNEQU %INDEX, %DESCRIPTOR
ASSERTEQU %RESULT, <eax> ; We rely on this convention when answering the result
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
primitiveVirtualCall PROC
ASSUME edx:DWORD
ASSUME ecx:PTR CompiledMethod
; We must save down IP, as we're going to overwrite it, and because it may
; be required if a callback into Smalltalk results
StoreIPRegister
mov eax, edx
neg eax
lea eax, [_SP+eax*OOPSIZE] ; EAX now points at receiver in stack
mov eax, [eax] ; load receiver from stack into EAX
ASSUME eax:PTR OTE
test [eax].m_flags, MASK m_pointer
jz @F
; TODO: Could the receiver ever be an immutable object here?
cmp [eax].m_size, OOPSIZE ; Must contain at least one pointer/address
mov eax, [eax].m_location
ASSUME eax:PTR ExternalStructure
jb primitiveFailure0
mov eax, [eax].m_contents
test al, 1
jnz primitiveFailure0
ASSUME eax:PTR OTE
test [eax].m_flags, MASK m_pointer
jnz primitiveFailure0
@@:
ASSUME eax:PTR OTE ; At this point, EAX is OTE of 'this' pointer
;; The primitive can no longer fail due to simple reasons, so start pushing args for call helper
push 0 ; ARG6: Overlapped? (no)
push OFFSET INTERPCONTEXT ; ARG5: Pointer to interpreters thread context
push ecx ; ARG4: Ptr to method
mov ecx, [ecx].m_aLiterals[0*OOPSIZE] ; Get descriptor Oop into ecx
ASSUME ecx:PTR OTE
mov ecx, [ecx].m_location
ASSUME ecx:PTR CallDescriptor ; ECX points at the descriptor
push ecx ; ARG3: descriptor
push edx ; ARG2: arg count
; edx now free for other purposes
ASSUME edx:NOTHING
; At this point EAX is the Oop of a byte object
mov edx, [eax].m_oteClass
mov eax, [eax].m_location
ASSUME eax:PTR ByteArray
mov edx, (OTE PTR[edx]).m_location
ASSUME edx:PTR Behavior
.IF ([edx].m_instanceSpec & MASK m_indirect)
mov eax, (ExternalAddress PTR[eax]).m_pointer
; .ELSE
; add eax, HEADERSIZE
.ENDIF
mov ecx, [ecx].m_proc ; Get virtual call offset out of descriptor
ASSUME ecx:NOTHING
mov eax, DWORD PTR[eax] ; Load address of virtual function table from object
push DWORD PTR[eax+ecx] ; ARG1: Address of virtual function at offset in table
call callExternalFunction
ret
ASSUME eax:NOTHING
ASSUME edx:NOTHING
primitiveVirtualCall ENDP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A fastcall function (ecx is pMethod, edx is argCount)
;; There is also an extra argument on the stack (the thread context) which we just
;; let pass through
@asyncDLL32Call@16:
asyncDLL32Call PROC STDCALL PUBLIC USES edi esi ebx,
pOverlapped:DWORD,
callContext:PTR InterpreterRegisters
ASSUME ecx:PTR CompiledMethod
ASSUME edx:DWORD
mov eax, callContext ; Load pointer to context from stack top
ASSUME eax:PTR InterpreterRegisters
push pOverlapped ; ARG6: Overlapped? (yes)
push eax ; ARG5: Pointer to thread context already atop of stack
push ecx ; ARG4: Ptr to compiled method (may need literals)
; Needed to push args from process stack
mov _SP, [eax].m_stackPointer
ASSUME eax:NOTHING ; No longer required
mov ecx, [ecx].m_aLiterals[0*OOPSIZE] ; Get descriptor Oop into ecx
mov ecx, (OTE PTR[ecx]).m_location ; ObjectMemory::GetObj
lea ecx, (ByteArray PTR[ecx]).m_elements ; ecx points at the descriptor bytes
push ecx ; ARG3: argTypes
mov eax, DWORD PTR[ecx] ; Get proc address out of descriptor cache
test eax, eax ; Zero?
push edx ; ARG2: argCount
jnz @F
call getProcAddress ; Cache value 0, so lookup the proc address
test eax, eax ; Returns null if not a valid proc name
jnz @F ; ?Valid proc name, if so jump to call
int 3 ; What to do here?
; Invalid proc name, GetProcAddress returned failed
add esp, 16 ; Remove args pushed for aborted call
jmp primitiveFailure1
@@:
push eax ; ARG1: cached proc address
call callExternalFunction
StoreSPRegister
ret ; eax will be non-zero as otherwise we'd not be here
asyncDLL32Call ENDP
getProcAddress PROC
ASSUME ecx:PTR CallDescriptor ; ecx points at descriptor bytes
push ebx ; Save EBX
mov ebx, ecx ; Save for later in safe register
ASSUME ebx:PTR CallDescriptor ; ebx now points at descriptor bytes
ASSUME ecx:NOTHING ; Now free to re-use ECX
; Get receiver from under args and extract the handle
mov eax, _SP
lea ecx, [edx*OOPSIZE] ; Offset of receiver down stack
sub eax, ecx ; eax now points at receiver in stack
; Get address of proc name in the descriptor into eax
; N.B. Arg Count cannot be greater than 255
mov dl, [ebx].m_argsLen
lea edx, DWORD PTR [ebx].m_args[edx]
mov eax, [eax] ; Load receiver Oop from stack
mov eax, (OTE PTR[eax]).m_location
mov eax, (ExternalLibrary PTR[eax]).m_handle ; Get handle Oop from receiver
mov eax, (OTE PTR[eax]).m_location
; Prepare for call to GetProcAddress
push edx ; Push address of proc name
push (ExternalHandle PTR[eax]).m_handle ; Push DLL handle for call to GetProcAddress
INVOKE atoi, edx
test eax, eax ; atoi() returned 0?
jz @F ; Yes, not an ordinal
mov [esp+4], eax ; Store down ordinal value instead
@@:
call GetProcAddress
mov [ebx].m_proc, eax ; Save down into cache
pop ebx ; restore EBX
ret ; Proc address in EAX
getProcAddress ENDP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A fastcall function (ecx is pMethod, edx is argCount)
primitiveDLL32Call PROC
ASSUME ecx:PTR CompiledMethod
ASSUME edx:DWORD
; We must save down IP/SP, as we're going to overwrite IP, and because they may
; be required if a callback into Smalltalk results
StoreInterpreterRegisters
push 0 ; ARG6: Overlapped? (no)
push OFFSET INTERPCONTEXT ; ARG5: Pointer to interpreters thread context
push ecx ; ARG4: Ptr to compiled method (may need literals)
mov ecx, [ecx].m_aLiterals[0*OOPSIZE] ; Get descriptor Oop into ecx
mov ecx, (OTE PTR[ecx]).m_location ; ObjectMemory::GetObj
lea ecx, (ByteArray PTR[ecx]).m_elements ; ecx points at the descriptor bytes
push ecx ; ARG3: argTypes
mov eax, DWORD PTR[ecx] ; Get proc address out of descriptor cache
test eax, eax ; Zero?
push edx ; ARG2: argCount
jnz @F ; Non-zero cache, no need to lookup the proc address
call getProcAddress ; Cache value 0, so lookup the proc address
test eax, eax ; Returns null if not a valid proc name
jnz @F ; ?Valid proc name, is so jump to call
; Invalid proc name, GetProcAddress returned 0
add esp, 20 ; Remove args pushed for aborted call
jmp primitiveFailure1
@@:
push eax ; ARG1: cached proc address
call callExternalFunction
ret
primitiveDLL32Call ENDP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Process the next argument
;
LoopNext MACRO
ASSUME INDEX:DWORD
ASSUME ARG:Oop
ASSUME _SP:PTR Oop
ASSUME TEMP:DWORD
dec INDEX ; i--
js performCall ; No more args to push
xor TEMP, TEMP
mov TEMPB, ([DESCRIPTOR].m_args[INDEX]) ; Load arg type from descriptor
mov ARG, [_SP]
sub _SP, OOPSIZE ; Point at next arg in stack
jmp pushOopTable[TEMP*SIZEOF DWORD]
ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Push the specified value on the stack (32-bit) and process the next arg
;
PushLoopNext MACRO arg
; pushes <arg> (contains 32-bit value from conversion case)
push arg
LoopNext
ENDM
_AnswerResult MACRO
ASSERTEQU %_IP, <edi> ; May need to visit this if changed
ASSERTNEQU %_IP, %RESULT
ASSERTNEQU %TEMP, %RESULT
ASSERTEQU %RESULT, <eax>
;; Pop the arguments as the last action
mov edx, argCount
ASSUME edx:DWORD
mov ecx, callContext
ASSUME ecx:PTR InterpreterRegisters
shl edx, 2
; Reload interpreter context registers
mov _IP, [ecx].m_instructionPointer
mov _SP, [ecx].m_stackPointer
mov _BP, [ecx].m_basePointer
ASSUME ecx:NOTHING
sub _SP, edx ; Pop off the arguments, AFTER A COMPLETED CALL
mov [_SP], RESULT ; Answer the result
ENDM
AnswerResult MACRO
_AnswerResult
ret
ENDM
AddResultToZct MACRO
AddToZct <a>, _SP
ENDM
AnswerObjectResult MACRO
ASSUME eax:PTR OTE
_AnswerResult
AddResultToZct
ret
ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Answer an Integer result (could be SmallInteger, or a NEW LargeInteger)
;
AnswerOopResult MACRO
ASSUME eax:Oop ;; EAX contains SmallInteger or OTE*
ASSERTEQU %RESULT, <eax>
_AnswerResult
.IF (!(al & 1))
AddResultToZct
.ENDIF
ret
ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Invoke any function, pushing args from the Smalltalk stack according to the
;; argTypes descriptor. Fail if argument coercion fails, or if a function returns
;; an HRESULT failure code.
;;
;; This function should not be called from C++
;; It modifies:
;; _SP (pops args, or on unwind loads from global)
;; _IP (reloads from interpreter register, value may change on unwind)
;; _BP (ditto)
;;
; N.B. I NO LONGER SAVE DOWN ESP, RELYING ON IT BEING RESET FROM EBP ON RETURN
; THIS MEANS THAT ANYTHING PUSHED BEFORE THE CALL MAY NOT BE ACCESSIBLE AFTER IT
; AS IF ITS A CDECL CALL (OR A CALL FAILURE) IT WILL STILL BE UNDERNEATH THE
; ARGUMENTS. FOR THIS REASON IT IS NECESSARY TO USE BP BASED ADDRESS TO SAVE THE
; ACTIVE FRAME (RATHER THAN JUST PUSHING IT ON THE STACK). IF YOU WANT TO SAVE
; THINGS ON THE STACK, THEN YOU MUST REINSTATE THE SAVING AND RESTORING OF ESP
; TO A VARIABLE REFERENCEABLE OFF EBP
callExternalFunction PROC NEAR STDCALL,
pProc:PTR DWORD,
argCount:DWORD,
argTypes:PTR CallDescriptor,
method:PTR CompiledMethod,
callContext:PTR InterpreterRegisters,
pOverlapped:DWORD
; We need EBP based address for these as we'll be modifying ESP
LOCAL activeFrame:PStackFrame, returnStructure:PTR DWORD ;, savedSP:PTR DWORD
; Save off active frame, etc
mov eax, callContext
mov DESCRIPTOR, argTypes ; N.B. DESTROY VALUE OF _BP SO MUST RELOAD
ASSUME DESCRIPTOR:PTR CallDescriptor ; Use _IP to point at arg type in descriptor
mov eax, (InterpreterRegisters PTR[eax]).m_pActiveFrame
mov returnStructure, 0
mov activeFrame, eax
cmp [DESCRIPTOR].m_return, 40
je retStruct ; If not returning a >8 byte struct, then no need to make space for return on stack
cmp [DESCRIPTOR].m_return, ArgSTRUCT
jne @F
retStruct:
; We're going to overwrite ECX and EDX so we mustn't ovewrite the one register we've established
ASSERTNEQU %DESCRIPTOR, <ecx>
ASSERTNEQU %DESCRIPTOR, <edx>
;; Returning a 9+ byte structure by value, so we must make space for it on the stack!
xor ecx, ecx
mov cl, [DESCRIPTOR].m_returnParm ; Get return parm literal frame index into ECX
; N.B. Before we need the INDEX, we'll use it as a temp
mov edx, [method] ; Load the method (NOT Interpreter::m_pMethod)
ASSUME edx:PTR CompiledMethod
mov edx, [edx].m_aLiterals[ecx*OOPSIZE] ; Load literal from frame
ASSUME edx:PTR OTE ; Now we have the ExternalStructure class in ecx
mov edx, [edx].m_location ; TEMP is pointer to class of object
ASSUME edx:PTR Behavior
mov cx, [edx].m_instanceSpec.m_extraSpec
sub esp, ecx ; Make the space
mov returnStructure, esp ; Save down the address for push as hidden parm
@@:
; FROM NOW ON WE RESPECT USE OF THE REGISTER DEFINES FOR SAFETY
ASSERTNEQU %INDEX, %DESCRIPTOR
movzx INDEX, [DESCRIPTOR].m_argsLen ; Get the length of the argument descriptor
LoopNext ; Process the first arg
performCall:
mov eax, returnStructure
test eax, eax
jz @F ; If not returning a >8 byte struct, then no need pass hidden parameter
; Push the extra hidden parm which points at the buffer for the return value
push eax
@@:
call DWORD PTR pProc ; Perform the actual call. Win32 exception may occur (e.g. GP fault)
ASSERTNEQU %TEMP, eax ; These registers potentially contain the return value
ASSERTNEQU %TEMP, edx
cmp pOverlapped, 0
jz @F
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handle overlapped call return
; Save the return value
push eax
push edx
mov ecx, pOverlapped ;; thiscall calling convention has "this" in ecx
call REQUESTCOMPLETION ;; Will not return if thread is unwound
pop edx
pop eax
jmp returnSwitch
@@:
;; If not overlapped, must test for unwind
mov TEMP, callContext ; Get the current interpreter context
mov TEMP, (InterpreterRegisters PTR[TEMP]).m_pActiveFrame
cmp TEMP, activeFrame ; Is it still the active frame
jne unwindExit ; If not an unwind has been requested as this process had an error
returnSwitch:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Dispatch via the return type lookup table
;
; N.B. CERTAIN RETURN ROUTINES ASSUME THAT TEMP IS CLEARED HERE AND LOAD ONLY THE BOTTOM BYTE!!
;
xor TEMP, TEMP
mov TEMPB, [DESCRIPTOR].m_return
jmp [returnOopTable+TEMP*SIZEOF DWORD]
unwindExit:
mov eax, callContext
ASSUME eax:PTR InterpreterRegisters
; Reload interpreter context registers - we must load them all (they'll have changed)
mov _SP, [eax].m_stackPointer
mov _IP, [eax].m_instructionPointer
mov _BP, [eax].m_basePointer
ASSUME eax:NOTHING
; We succeed so as not to run Smalltalk code after primitive (eax MUST be non-zero, but also a valid SmallInteger value)
mov eax, 1
ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typed pointer argument. Currently not implemented to do anything interesting.
;; Could access the class from the literal frame and compare it. We could then
;; implement a less complex coercion as we could be more strict about the allowable
;; argument types.
ExtCallArgCOMPTR:
ExtCallArgLP:
dec INDEX ; Ignore the argument type (could validate here)
; Deliberately drop through
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is one of the most complex types because we must allow
;; SmallIntegers
;; Nil
;; Byte objects (whose address is passed)
;; Indirection byte objects (whose contents are passed)
;; Pointer objects whose first instance variable is a SmallInteger
;; or byte object
;;
ExtCallArgLPVOID:
ASSUME ARG:Oop
sar ARG, 1 ; Commonly pass SmallIntegers, so try to convert
jc pushLPVOIDLoopNext ; Yes, just push its integer value
sal ARG, 1 ; No, revert to Oop
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it a pointer object
jz @F ; No, skip to byte object handling
cmp ARG, [oteNil] ; OK its pointers, but is it nil?
mov TEMP, [ARG].m_size ; Preload size
je pushNil ; Yes, push as NULL
and TEMP, 7fffffffh
cmp TEMP, OOPSIZE ; Must have at least one inst var?
; Ok, it might still be an object whose first inst var might be an address
mov ARG, [ARG].m_location ; Ptr to object now in ARG
ASSUME ARG:PTR ExternalStructure
jl preCallFail ; No, not big enough (zero inst vars)
mov ARG, [ARG].m_contents ; OK, so lets see if first inst var is the 'address' we seek
sar ARG, 1 ; First of all, is it a SmallInteger
jc pushLPVOIDLoopNext ; Yes, push that as the address
ASSUME ARG:PTR OTE ; No, its an object
sal ARG, 1 ; so revert to OTE
test [ARG].m_flags, MASK m_pointer ; Is it bytes?
jne preCallFail ; No, inst var not a byte object, which exhausts all the options
; Drop though to byte object handling...
@@:
; Byte object handling
mov TEMP, [ARG].m_oteClass ; Get oop of class of bytes into TEMP
ASSUME TEMP:PTR OTE
mov ARG, [ARG].m_location ; Get ptr to byte object into ARG
ASSUME ARG:PTR ByteArray ; We know we've got a byte object now
; add ARG, HEADERSIZE ; ARG now points at first non-header byte of object
mov TEMP, [TEMP].m_location ; TEMP is ptr to class of object
ASSUME TEMP:PTR Behavior
test [TEMP].m_instanceSpec, MASK m_indirect ; Is it an indirection class?
jz pushLPVOIDLoopNext ; No, push pointer to object itself if not indirection
mov ARG, DWORD PTR[ARG] ; Yes, perform implicit indirection for ExternalAddresses (etc)
pushLPVOIDLoopNext:
ASSUME ARG:PTR BYTE ; On entry ARG contains the pointer we're pushing
PushLoopNext <ARG> ; else push pointer out of object
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simple. Permit only Characters
extCallArgCHAR:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
test ARG, 1 ; Is it a SmallInteger?
jnz preCallFail ; Yes, not valid (only Characters)
ASSUME ARG:PTR OTE ; No, its an object of unknown type
mov TEMP, [ARG].m_oteClass
ASSUME TEMP:PTR OTE
mov ARG, [ARG].m_location
cmp TEMP, [Pointers.ClassCharacter] ; Is it a Character?
jne preCallFail ; No? Fail it
ASSUME ARG:PTR Character ; Yes
mov ARG, [ARG].m_asciiValue ; Load ascii value from Char
ASSUME ARG:DWORD
sar ARG, 1 ; Convert to 32-bit int
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simple permit only SmallIntegers in the range 0..255
extCallArgBYTE:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is is a SmallInteger?
jnc preCallFail ; No, fail it
ASSUME ARG:DWORD ; Yes, integer value now in ARG
cmp ARG, 0ffH ; 0..255?
ja preCallFail ; No too big (or negative), fail it
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simple - permit only SmallIntegers in the range -128..127
extCallArgSBYTE:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger
jnc preCallFail ; No fail it
ASSUME ARG:DWORD ; Yes, integer value now in ARG
cmp ARG, 127 ; Too large positively?
jg preCallFail ; Yes, fail it
cmp ARG, -128 ; Too large negatively?
jl preCallFail ; Yes, fail it
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; #word - permit only SmallIntegers in the range 0..65535, and two byte objects
extCallArgWORD:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger
jnc @F ; Not Smallinteger, try for byte object/nil
ASSUME ARG:DWORD ; Yes, integer value now in ARG
cmp ARG, 65535 ; 0..65535
ja preCallFail ; No, too big (or negative)
PushLoopNext <ARG>
@@:
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it pointers?
mov TEMP, [ARG].m_size
jnz tryNil ; Yes, probably fail, but could be nil (passes as 0)
and TEMP, 7fffffffh ; Ignore immutability bit
cmp TEMP, SIZEOF WORD ; Consists of two bytes only?
mov ARG, [ARG].m_location
ASSUME ARG:PTR ByteArray ; Yes, its a byte object
jne preCallFail ; No, wrong size
movzx ARG, WORD PTR([ARG].m_elements) ; Yes, zero extend to 32-bit value
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; #sword - permit SmallIntegers in the range 0..65535, and two byte objects
extCallArgSWORD:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger
jnc @F ; Not Smallinteger, try for byte object/nil
ASSUME ARG:DWORD ; Yes, integer value now in ARG
cmp ARG, -32768
jl preCallFail ; Too large negatively
cmp ARG, 32767
jg preCallFail ; Too large positively
PushLoopNext <ARG>
@@:
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it pointers?
mov TEMP, [ARG].m_size
jnz tryNil ; Yes, probably fail, but could be nil (passes as 0)
and TEMP, 7fffffffh
cmp TEMP, SIZEOF WORD ; Consists of two bytes only?
mov ARG, [ARG].m_location
ASSUME ARG:PTR ByteArray ; Yes, its a byte object
jne preCallFail ; No, wrong size
movsx ARG, WORD PTR([ARG].m_elements) ; Sign extend to 32-bit value in ECX
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Assume that most commonly SmallInteger will be passed, so shift in anticipation
; of that.
extCallArgINTPTR:
extCallArgSDWORD:
extCallArgHRESULT:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger?
.IF (!CARRY?)
; Try for byte object/nil
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it pointers?
mov TEMP, [ARG].m_size
jnz tryNil ; Yes, probably fail, but could be nil (passes as 0)
and TEMP, 7fffffffh ; ignore immutability bit
cmp TEMP, SIZEOF DWORD ; Consists of four bytes only?
mov ARG, [ARG].m_location
ASSUME ARG:PTR LargeInteger ;
jne preCallFail ; No, wrong size
;; LargeInteger case requires no special treatment because 4-byte LIs have
;; same range and representation as a 2's complement SDWORD
; Get the value out of the large integer
mov ARG, [ARG].m_digits[0] ; Load the value
ASSUME ARG:DWORD
.ENDIF
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Push 32-bit two's complement integer as unsigned value
;
; N.B. This should be similar to the above, except that it permits a wider
; range of positive large integers.
;
extCallArgUINTPTR:
extCallArgDWORD:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger?
.IF (!CARRY?)
; Try for byte object/nil
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it pointers?
jnz tryNil ; Yes, probably fail, but could be nil (passes as 0)
mov TEMP, [ARG].m_size
and TEMP, 7fffffffh ; Mask out the immutability bit
mov ARG, [ARG].m_location
ASSUME ARG:PTR LargeInteger
cmp TEMP, SIZEOF DWORD ; Consists of four bytes only?
je @F ; Yes, correct size
; Might still be an acceptable positive LargeInteger value
cmp TEMP, SIZEOF QWORD ; Consists of eight bytes only?
jne preCallFail ; No, wrong size
; Now we need to check that the high dword is zero
cmp [ARG].m_digits[SIZEOF DWORD], 0
jnz preCallFail ; Top dword not 0, so can't be 32-bit
@@:
; Get the value out of the large integer
mov ARG, [ARG].m_digits[0] ; Load the value
ASSUME ARG:DWORD
.ENDIF
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Push any 32-bit value as if it is some unsigned handle
;
extCallArgHANDLE:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Is it a SmallInteger?
jc pushHANDLELoopNext ; Yes, push integer value now in ARG and continue
; Try for byte object/nil
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
test [ARG].m_flags, MASK m_pointer ; Is it pointers?
jnz tryNil ; Yes, probably fail, but could be nil (passes as 0)
mov TEMP, [ARG].m_size
and TEMP, 7fffffffh ; Mask out the immutability (sign) bit
mov ARG, [ARG].m_location
ASSUME ARG:PTR LargeInteger
cmp TEMP, SIZEOF DWORD ; Consists of four bytes only?
je @F ; Yes, correct size
cmp TEMP, SIZEOF QWORD ; Consists of eight bytes only?
jne preCallFail ; No, wrong size
; Now we need to check that the high dword is zero
cmp [ARG].m_digits[SIZEOF DWORD], 0
jnz preCallFail ; Top dword not 0, so can't be 32-bit
@@:
mov ARG, [ARG].m_digits[0] ; Load the value
ASSUME ARG:DWORD
pushHANDLELoopNext:
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
extCallArgBOOL:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; SmallInteger?
jc pushBoolLoopNext ; SmallIntegers acceptable for boolean args
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
; Convert true to -1
.IF (ARG == [oteTrue])
mov ARG, 1 ; Pass true as 1
.ELSE
; Convert false to 0
cmp ARG, [oteFalse]
jne preCallFail ; Not either true or false, so fail it
xor ARG, ARG ; Pass false as 0
.ENDIF
pushBoolLoopNext:
PushLoopNext <ARG>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
extCallArgDATE:
extCallArgDOUBLE:
ASSUME ARG:Oop ; ARG is input Oop from dispatch loop
sar ARG, 1 ; Often pass SmallInteger?
jnc @F ; but not this time
ASSUME ARG:DWORD
sub esp, SIZEOF QWORD ; Make space on stack for double
mov [esp], ARG ; We must store down integer into mem before converting
fild DWORD PTR[esp] ; load int from stack to FP stack
fstp QWORD PTR[esp] ; store back as double
LoopNext ; we've nothing further to push
@@:
; Not a SmallInteger
sal ARG, 1 ; Revert to OTE
ASSUME ARG:PTR OTE
mov TEMP, [ARG].m_size
.IF ([ARG].m_flags & MASK m_pointer)
and TEMP, 7fffffffh ; Ignore the immutability bit
cmp TEMP, OOPSIZE
mov ARG, [ARG].m_location ; Load ptr to object into ARG
ASSUME ARG:PTR Object ;
jl preCallFail ; Not big enough - must have at least one inst var
ASSUME ARG:PTR ExternalStructure ; OK so it appears to be an external structure
mov ARG, [ARG].m_contents ; Get contents bytes into ARG
ASSUME ARG:Oop
test ARG, 1 ; Contents is immediate object
jnz preCallFail ; Yes, fail it
ASSUME ARG:PTR OTE ; No, ARG is OTE of object
test [ARG].m_flags, MASK m_pointer ; Contents bytes or pointers?
jnz preCallFail ; Inst var not a byte object, fail it
; Now we've got a byte object, needs to be handled differently if it is an indirection
mov TEMP2, [ARG].m_oteClass ; Get the class of the bytes into TEMP2
ASSUME TEMP2:PTR OTE
mov TEMP2, [TEMP2].m_location
ASSUME TEMP2:PTR Behavior ; TEMP2 is pointer to class of byte object
.IF ([TEMP2].m_instanceSpec & MASK m_indirect) ; Is it an indirection class?
mov ARG, [ARG].m_location
ASSUME ARG:PTR ExternalAddress
mov ARG, [ARG].m_pointer
;; ARG is pointing at the bytes to push
ASSUME ARG:PTR DWORD
push [ARG+SIZEOF DWORD] ; Push second DWORD of double value
push [ARG] ; Push first DWORD of double value
LoopNext ; and loop (nothing further to push)
.ELSE
ASSUME ARG:PTR OTE
mov TEMP, [ARG].m_size
and TEMP, 7fffffffh ; Ignore immutability (sign) bit
mov ARG, [ARG].m_location
cmp TEMP, SIZEOF QWORD
jl preCallFail
.ENDIF
.ELSE
ASSUME ARG:PTR OTE
mov TEMP, [ARG].m_oteClass
ASSUME TEMP:PTR OTE
mov ARG, [ARG].m_location ; Load ptr to argument bytes
ASSUME ARG:PTR Object ;