ocaml/byterun/interp.a

1390 lines
36 KiB
Plaintext

***********************************************************************/
* */
* Objective Caml */
* */
* Damien Doligez, Projet Para, INRIA Rocquencourt */
* */
* Copyright 1996 Institut National de Recherche en Informatique et */
* en Automatique. Distributed only by permission. */
* */
***********************************************************************/
* $Id$ */
* The bytecode interpreter in 68000 assembly language */
string asis
print nopage
case obj
import (LMODT, LDIVT, ULMULT) : code
import (extern_sp, atom_table, local_roots, stack_high) : data
import (external_raise) : data
import (__setjmp) : code
import (exn_bucket, young_ptr, young_limit) : data
import (minor_collection, modify) : code
import (global_data, heap_start, heap_end, page_table, gc_phase): data
import (darken): code
import (young_start, young_end, ref_table_ptr, ref_table_limit): data
import (realloc_ref_table): code
import (trapsp): data
import (longjmp): code
import (stack_threshold): data
import (realloc_stack): code
import (something_to_do, force_major_slice, pending_signal): data
import (signal_handlers, have_to_interact): data
import (rotatecursor_action): code
import (cprim): data
import (raise_zero_divide, fatal_error_arg): code
import (thread_code): code
import (instr_table, instr_base): data
import (callback_depth): data
import (disasm_instr): code ; debug
GBLA &DEBUG
&DEBUG SETA &FINDSYM(&SYSGLOBAL, 'DEBUG')
IF &DEBUG THEN
machine mc68020
print push,off
include 'Types.a'
print pop
ENDIF
msg record
dc.b 'Fatal error in interp: bad opcode (%lx)', $0D, $00
endr
interprete proc export
accu_ equ A2
pc_ equ A3
sp_ equ A4
env_ equ A5
jtbl_ equ A6
y_ptr_reg equ D1
y_limit_reg equ D2
; saved A5 D6
extra_args_ equ D7
; pile: relatif a A6
; raise_buf_ equ -$40
; initial_sp_offset_ equ -$44
; initial_external_raise_ equ -$48
; initial_local_roots_ equ -$4C
; (slot vide) equ -$50 (was: initial_callback_depth_)
; pile: relatif a A7
local_var_size_ equ $50
raise_buf_ equ $10
initial_sp_offset_ equ $0C
initial_external_raise_ equ $08
initial_local_roots_ equ $04
;(slot vide) equ $00
; temporaires: A0 A1 D0 D3 D4 D5 (D3, D4, D5 sont callee-save)
; stack: A7
; Pour appeler une fonction, il faut
; 1. remettre A5 dans son etat normal
; 2. remettre young_ptr et young_limit dans les globaux
macro
Call_setup
EXG.L D6, A5
MOVE.L y_ptr_reg, (young_ptr).L
MOVE.L y_limit_reg, (young_limit).L
endm
macro
Call_restore
MOVE.L (young_limit).L, y_limit_reg
MOVE.L (young_ptr).L, y_ptr_reg
EXG.L D6, A5
endm
IF &DEBUG THEN
macro
Udispatch
BRA.L camldispatch
endm
ELSE
macro
Udispatch ; Dispatch, no spacer
MOVE.L (pc_)+, D0
JMP (jtbl_, D0.W)
endm
ENDIF
; L'interprete commence ici.
; _Debugger
MOVEM.L D3-D7/A2-A6,-(A7) ; 10 registres
LEA.L -local_var_size_(A7), A7
Call_restore
MOVE.L local_var_size_+4*10+$4(A7), D0 ; code
BNE.S noinit ; == NULL => init
LEA.L table(PC), A0
MOVE.L A0, (instr_table).L
CLR.L (instr_base).L
MOVEQ.L #1, D0
Call_setup ; 2eme copie: "lbl_1B88"
LEA.L local_var_size_(A7), A7
MOVEM.L (A7)+, D3-D7/A2-A6
RTS
noinit: MOVEA.L local_var_size_+4*10+$4(A7), A0 ; code
CMPI.L #133, (A0)
BHI.S nothread ; deja tresse
MOVE.L local_var_size_+4*10+$8(A7), -(A7) ; argument 1 (size)
MOVE.L local_var_size_+4*10+$8(A7), -(A7) ; argument 0 (code)
Call_setup
JSR (thread_code).L
Call_restore
LEA.L $8(A7), A7
nothread: LEA.L i_start(PC), jtbl_
ADDA.L #$8000, jtbl_
MOVE.L (local_roots).L, initial_local_roots_(A7)
MOVE.L (stack_high).L, D0
SUB.L (extern_sp).L, D0
MOVE.L D0, initial_sp_offset_(A7)
MOVE.L (external_raise).L, initial_external_raise_(A7)
ADDQ.L #1, (callback_depth).L
PEA.L raise_buf_(A7)
Call_setup
JSR (__setjmp).L
Call_restore
ADDQ.L #4, A7
TST.L D0
BEQ.S lbl_78 ; endif
MOVE.L initial_local_roots_(A7), (local_roots).L
MOVEA.L (exn_bucket).L, accu_
JMP i_RAISE-i_base(jtbl_)
lbl_78: LEA.L raise_buf_(A7), A0
MOVE.L A0, (external_raise).L
MOVEA.L (extern_sp).L, sp_
MOVEA.L local_var_size_+4*10+4(A7), pc_ ; argument 0 (code)
CLR.L extra_args_
LEA.L (atom_table+4).L, env_
MOVEA.W #1, accu_
Udispatch
; Table pour thread_code
macro
Make_table
lcla &i
&i seta 0
while &i < 133 do
DC.L i_&i - i_base
&i seta &i + 1
endw
endm
table: Make_table
; Remplissage
macro
Spacer &n
actr 1500
lcla &i
&i seta 0
while &i < &n - 15 do
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
NOP
&i seta &i + 16
endw
while &i < &n do
NOP
&i seta &i + 1
endw
endm
macro
Dispatch ; Dispatch and spacer
Udispatch
Spacer 16
BRA.W fatal
endm
macro
Nodispatch ; spacer without dispatch
Spacer 16
BRA.W fatal
endm
; 64k dans lesquels on branche directement.
i_start: Spacer 16384
i_base: Spacer 256
fatal: MOVE.L -4(pc_), -(A7)
PEA.L (msg).L
Call_setup
JSR (fatal_error_arg).L
; Call_restore never reached
; ADDQ.L #8, A7
Spacer 256
Nodispatch
macro
ACC &n
MOVEA.L 4*&n(sp_), accu_
Dispatch
endm
i_0: ACC 0
i_1: ACC 1
i_2: ACC 2
i_3: ACC 3
i_4: ACC 4
i_5: ACC 5
i_6: ACC 6
i_7: ACC 7
; ACC
i_8: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (sp_, D0.L), accu_
Dispatch
; PUSH
i_9: MOVE.L accu_, -(sp_)
Dispatch
; PUSHACC0 ; identique a PUSH
i_10: MOVE.L accu_, -(sp_)
Dispatch
macro
PUSHACC &n
MOVE.L accu_, -(sp_)
MOVEA.L 4*&n(sp_), accu_
Dispatch
endm
i_11: PUSHACC 1
i_12: PUSHACC 2
i_13: PUSHACC 3
i_14: PUSHACC 4
i_15: PUSHACC 5
i_16: PUSHACC 6
i_17: PUSHACC 7
; PUSHACC
i_18: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (sp_, D0.L), accu_
Dispatch
; POP
i_19: MOVE.L (pc_)+, D0
ASL.L #2, D0
ADDA.L D0, sp_
Dispatch
; ASSIGN
i_20: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVE.L accu_, (sp_, D0.L)
MOVEA.W #1, accu_
Dispatch
macro
ENVACC &n
MOVEA.L 4*&n(env_), accu_
Dispatch
endm
i_21: ENVACC 1
i_22: ENVACC 2
i_23: ENVACC 3
i_24: ENVACC 4
; ENVACC
i_25: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (env_, D0.L), accu_
Dispatch
macro
PUSHENVACC &n
MOVE.L accu_, -(sp_)
MOVEA.L 4*&n(env_), accu_
Dispatch
endm
i_26: PUSHENVACC 1
i_27: PUSHENVACC 2
i_28: PUSHENVACC 3
i_29: PUSHENVACC 4
; PUSHENVACC
i_30: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (env_, D0.L), accu_
Dispatch
; PUSH_RETADDR
i_31: MOVE.L extra_args_, D0
ASL.L #1, D0
ADDQ.L #1, D0
MOVE.L D0, -(sp_)
MOVE.L env_, -(sp_)
MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L pc_, D0
ADDQ.L #4, pc_
MOVE.L D0, -(sp_)
Dispatch
; APPLY
i_32: MOVE.L (pc_), extra_args_
SUBQ.L #1, extra_args_
MOVEA.L (accu_), pc_
MOVEA.L accu_, env_
BRA chk_stks
Nodispatch
macro
APPLY &n
LEA.L -$0C(sp_), A0
if &n = 2 then
MOVE.L (sp_)+, (A0)+
elseif &n = 3 then
MOVE.L (sp_)+, (A0)+
MOVE.L (sp_)+, (A0)+
endif
MOVE.L (sp_), (A0)+
LEA.L -4*&n-8(sp_), sp_
MOVE.L pc_, (A0)+
MOVE.L env_, (A0)+
ASL.L #1, extra_args_
ADDQ.L #1, extra_args_
MOVE.L extra_args_, (A0)
MOVEA.L (accu_), pc_
MOVEA.L accu_, env_
MOVEQ #&n-1, extra_args_
BRA chk_stks
Nodispatch
endm
i_33: APPLY 1
i_34: APPLY 2
i_35: APPLY 3
; APPTERM
i_36: MOVE.L (pc_)+, D3 ; nargs = D3
ADD.L D3, extra_args_
SUBQ.L #1, extra_args_
MOVE.L (pc_), D0 ; slotsize = D0
SUB.L D3, D0
ASL.L #2, D0
LEA.L (sp_, D0.L), A0 ; newsp = A0
ASL.L #2, D3 ; i = D3/4
BRA.S lbl_46E
lbl_452: MOVE.L (sp_, D3.L), (A0, D3.L)
lbl_46E: SUBQ.L #4, D3
BPL.S lbl_452
MOVEA.L A0, sp_
MOVEA.L (accu_), pc_
MOVEA.L accu_, env_
BRA chk_stks
Nodispatch
macro
APPTERM &n
MOVEA.L sp_, A0
MOVE.L (pc_), D0
ASL.L #2, D0
ADDA.L D0, sp_
if &n = 3 then
MOVE.L 8(A0), -(sp_)
MOVE.L 4(A0), -(sp_)
elseif &n = 2 then
MOVE.L 4(A0), -(sp_)
endif
MOVE.L (A0), -(sp_)
MOVEA.L (accu_), pc_
MOVEA.L accu_, env_
if &n > 1 then
ADDQ.L #&n-1, extra_args_
endif
BRA chk_stks
Nodispatch
endm
i_37: APPTERM 1
i_38: APPTERM 2
i_39: APPTERM 3
; RETURN
i_40: MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L D0, sp_
TST.L extra_args_
BLE.S lbl_562
SUBQ.L #1, extra_args_
MOVEA.L (accu_), pc_
MOVEA.L accu_, env_
Udispatch
lbl_562: MOVEA.L (sp_)+, pc_
MOVEA.L (sp_)+, env_
MOVE.L (sp_)+, extra_args_
ASR.L #1, extra_args_
Dispatch
; RESTART
i_41: MOVE.L -4(env_), D5 ; D5 = num_args
LSR.L #8, D5
LSR.L #2, D5
SUBQ.L #2, D5
MOVE.L D5, D0
ASL.L #2, D0 ; D0 = i*4
SUB.L D0, sp_
BRA.S lbl_5B6
lbl_598: MOVE.L 8(env_, D0.L), (sp_, D0.L)
lbl_5B6: SUBQ.L #4, D0
BPL.S lbl_598
MOVEA.L 4(env_), env_
ADD.L D5, extra_args_
Dispatch
macro
Setup_for_gc
MOVE.L env_, -(sp_)
MOVE.L accu_, -(sp_)
MOVE.L sp_, (extern_sp).L
endm
macro
Restore_after_gc
MOVEA.L (sp_)+, accu_
MOVEA.L (sp_)+, env_
endm
; Alloc_small [#],size, [#],tag, result
; entree: size = taille en octets AVEC HEADER
; tag = la valeur du tag + $0300
; result = registre d'adresse ou mettre le resultat
; '#' indique un immediat, (vide) indique un registre
; Tous les registres sont preserves sauf A0, A1, D0
; &size et &tag sont ecrases si ce sont des registres
macro
Alloc_small &sizetype, &size, &tagtype, &tag, &result
MOVEA.L y_ptr_reg, &result
SUBA.L &sizetype.&size, &result
CMPA.L y_limit_reg, &result
BCC.S @OK
if &tagtype = '' then
MOVE.L &tag, -(A7)
endif
if &sizetype = '' then
MOVE.L &size, -(A7)
endif
Setup_for_gc
Call_setup
JSR (minor_collection).L
Call_restore
Restore_after_gc
if &sizetype = '' then
MOVE.L (A7)+, &size
endif
if &tagtype = '' then
MOVE.L (A7)+, &tag
endif
MOVEA.L y_ptr_reg, &result
SUBA.L &sizetype.&size, &result
@OK: MOVE.L &result, y_ptr_reg
if &sizetype = '' then
SUBQ.L #4, &size
LSL.L #8, &size
OR.W &tagtype.&tag, &size
MOVE.L &size, (&result)+
elseif &tagtype = '' then
ORI.W #(&size-4) << 8, &tag
MOVE.L &tag, (&result)+
else
MOVE.L #((&size-4)<<8) + &tag, (&result)+
endif
endm
; GRAB
i_42: MOVE.L (pc_)+, D3 ; D3 = required
CMP.L extra_args_, D3
BGT.S i_42x
SUB.L D3, extra_args_
Udispatch
i_42x: MOVE.L extra_args_, D4 ; extra_args_ = num_args
ADDQ.L #4, D4
LSL.L #2, D4
Alloc_small ,D4, #,$3FA, accu_
MOVE.L env_, 4(accu_)
LEA.L 8(accu_), A0
lbl_658: MOVE.L (sp_)+, (A0)+
lbl_676: SUBQ.L #1, extra_args_
BPL.S lbl_658
LEA.L -$0C(pc_), A0
MOVE.L A0, (accu_)
MOVEA.L (sp_)+, pc_
MOVEA.L (sp_)+, env_
MOVE.L (sp_)+, extra_args_
ASR.L #1, extra_args_
Dispatch
; CLOSURE
i_43: MOVE.L (pc_)+, D5
BLE.S lbl_6C8
MOVE.L accu_, -(sp_)
lbl_6C8: MOVE.L D5, D0
ASL.L #2, D0
ADDQ.L #8, D0
Alloc_small ,D0, #,$3FA, accu_
MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L pc_, D0
MOVEA.L accu_, A0
MOVE.L D0, (A0)+
ADDQ.L #4, pc_
BRA.S lbl_766
lbl_746: MOVE.L (sp_)+, (A0)+
lbl_766: SUBQ.L #1, D5
BPL.S lbl_746
Dispatch
; CLOSUREREC
i_44: MOVE.L (pc_)+, D4
MOVE.L (pc_)+, D5
BLE.S lbl_792
MOVE.L accu_, -(sp_)
lbl_792: MOVE.L D4, D0
ASL.L #1, D0
ADD.L D5, D0
ASL.L #2, D0
Alloc_small ,D0, #,$3FA, accu_
MOVEA.L accu_, A0
MOVE.L D4, D0
ASL.L #3, D0
SUBQ.L #4, D0
ADDA.L D0, A0
MOVE.L D5, D0
BRA.S lbl_800
lbl_799: MOVE.L (sp_)+, (A0)+
lbl_800: SUBQ.L #1, D0
BPL.S lbl_799
MOVE.L accu_, A0
MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L pc_, D0
MOVE.L D0, (A0)+
MOVE.L accu_, -(sp_)
MOVEQ.L #1, D0
BRA.S lbl_838
lbl_818: MOVE.L D0, D3
ASL.L #8, D3
ASL.L #3, D3
ADD.W #$3F9, D3
MOVE.L D3, (A0)+
MOVE.L A0, -(sp_)
MOVE.L D0, D3
ASL.L #2, D3
MOVE.L (pc_, D3), D3
ASL.L #2, D3
ADD.L pc_, D3
MOVE.L D3, (A0)+
ADDQ.L #1, D0
lbl_838: CMP.L D4, D0
BMI.S lbl_818
ASL.L #2, D4
ADDA.L D4, pc_
Dispatch
; OFFSETCLOSUREM2
i_45: MOVE.L env_, accu_
SUBQ.L #8, accu_
Dispatch
; OFFSETCLOSURE0
i_46: MOVE.L env_, accu_
Dispatch
; OFFSETCLOSURE2
i_47: MOVE.L env_, accu_
ADDQ.L #8, accu_
Dispatch
; OFFSETCLOSURE
i_48: MOVE.L (pc_)+, D0
ASL.L #2, D0
ADD.L env_, D0
MOVE.L D0, accu_
Dispatch
; PUSHOFFSETCLOSUREM2
i_49: MOVE.L accu_, -(sp_)
MOVE.L env_, accu_
SUBQ.L #8, accu_
Dispatch
; PUSHOFFSETCLOSURE0
i_50: MOVE.L accu_, -(sp_)
MOVE.L env_, accu_
Dispatch
; PUSHOFFSETCLOSURE2
i_51: MOVE.L accu_, -(sp_)
MOVE.L env_, accu_
ADDQ.L #8, accu_
Dispatch
; PUSHOFFSETCLOSURE
i_52: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
ADD.L env_, D0
MOVE.L D0, accu_
Dispatch
; GETGLOBAL
i_53: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (global_data).L, A0
MOVEA.L (A0, D0.L), accu_
Dispatch
; PUSHGETGLOBAL
i_54: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2,D0
MOVEA.L (global_data).L, A0
MOVEA.L (A0, D0.L), accu_
Dispatch
; GETGLOBALFIELD
i_55: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (global_data).L, A0
MOVEA.L (A0, D0.L), A0
MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (A0, D0.L), accu_
Dispatch
; PUSHGETGLOBALFIELD
i_56: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (global_data).L, A0
MOVEA.L (A0, D0.L), A0
MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (A0, D0.L), accu_
Dispatch
; SETGLOBAL
i_57: MOVE.L accu_, -(A7)
MOVE.L (pc_)+, D0
ASL.L #2,D0
MOVEA.L (global_data).L, A0
PEA.L (A0, D0.L)
Call_setup
JSR (modify).L
Call_restore
ADDQ.L #8, A7
MOVEA.W #1, accu_
Dispatch
; ATOM0
i_58: LEA.L (atom_table+4).L, accu_
Dispatch
; ATOM
i_59: MOVE.L (pc_)+, D0
ASL.L #2, D0
LEA.L (atom_table+4).L, accu_
ADDA.L D0, accu_
Dispatch
; PUSHATOM0
i_60: MOVE.L accu_, -(sp_)
LEA.L (atom_table+4).L, accu_
Dispatch
; PUSHATOM
i_61: MOVE.L accu_, -(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
LEA.L (atom_table+4).L, accu_
ADDA.L D0, accu_
Dispatch
; MAKEBLOCK
i_62: MOVE.L (pc_)+, D4 ; wosize = D4
MOVE.L (pc_)+, D3 ; tag = D3
ORI.W #$0300, D3
MOVE.L D4, D0
ADDQ.L #1, D0
LSL.L #2, D0
Alloc_small ,D0, ,D3, A0
MOVE.L accu_, (A0)
MOVEA.L A0, accu_
ADDQ.L #4, A0
BRA.S lbl_A62
lbl_A4C: MOVE.L (sp_)+, (A0)+
lbl_A62: SUBQ.L #1, D4
BHI.S lbl_A4C
Dispatch
macro
MAKEBLOCK &n
MOVE.L (pc_)+, D0
ORI.W #$0300, D0
Alloc_small #,4*&n+4, ,D0, A0
MOVE.L accu_, (A0)
if &n = 2 then
MOVE.L (sp_)+, 4(A0)
elseif &n = 3 then
MOVE.L (sp_)+, 4(A0)
MOVE.L (sp_)+, 8(A0)
endif
MOVEA.L A0, accu_
Dispatch
endm
i_63: MAKEBLOCK 1
i_64: MAKEBLOCK 2
i_65: MAKEBLOCK 3
; MAKEFLOATBLOCK
i_66: MOVE.L (pc_)+, D5
MOVE.L D5, D0
ASL.L #3, D0
ADDQ.L #4, D0
Alloc_small ,D0, #,$3FE, A0
MOVE.L A0, A1
MOVE.L (accu_)+, (A1)+
MOVE.L (accu_), (A1)+
MOVEA.L A0, accu_
BRA.S lbl_66a
lbl_66b: MOVE.L (sp_)+, A0
MOVE.L (A0)+, (A1)+
MOVE.L (A0), (A1)+
lbl_66a: SUBQ.L #1, D5
BNE.S lbl_66b
Dispatch
macro
GETFIELD &n
MOVEA.L 4*&n(accu_), accu_
Dispatch
endm
i_67: GETFIELD 0
i_68: GETFIELD 1
i_69: GETFIELD 2
i_70: GETFIELD 3
; GETFIELD
i_71: MOVE.L (pc_)+, D0
ASL.L #2, D0
MOVEA.L (accu_, D0.L), accu_
Dispatch
; GETFLOATFIELD
i_72: Alloc_small #,$C, #,$3FD, A0
MOVE.L (pc_)+, D0
ASL.L #3, D0
MOVE.L (accu_, D0), (A0)
MOVE.L 4(accu_, D0), 4(A0)
MOVEA.L A0, accu_
Dispatch
; SETFIELD0
i_73: MOVEA.L accu_, A1 ; A1 = modify_dest
; modify_newval = *sp++
BRA lbl_mod
Nodispatch
macro
SETFIELD &n
LEA.L 4*&n(accu_), A1 ; A1 = modify_dest
; modify_newval = *sp++
BRA lbl_mod
Nodispatch
endm
i_74: SETFIELD 1
i_75: SETFIELD 2
i_76: SETFIELD 3
; SETFIELD
i_77: MOVE.L (pc_)+, D0
ASL.L #$2, D0
LEA.L (accu_, D0.L), A1 ; A1 = modify_dest
; modify_newval = *sp++
BRA lbl_mod
Nodispatch
; SETFLOATFIELD
i_78: MOVEA.L (sp_)+, A0
MOVE.L (pc_)+, D0
ASL.L #3, D0
ADDA.L D0, accu_
MOVE.L (A0)+, (accu_)+
MOVE.L (A0), (accu_)
MOVEA.W #1, accu_ ; i_CONST0
Dispatch
; VECTLENGTH
i_79: MOVE.L -4(accu_), D0
LSR.L #8, D0
LSR.L #1, D0
CMP.B #$FE, -1(accu_)
BNE.S lbl_79a
LSR.L #1, D0
lbl_79a: ORI.B #1, D0
MOVEA.L D0, accu_
Dispatch
; GETVECTITEM
i_80: MOVE.L (sp_)+, D0
ASR.L #1, D0
ASL.L #2, D0
MOVEA.L (accu_, D0.L), accu_
Dispatch
; SETVECTITEM
i_81: MOVE.L (sp_)+, D0
ASR.L #1, D0
ASL.L #2, D0
LEA.L (accu_, D0.L), A1 ; A1 = modify_dest
; modify_newval = *sp++
BRA lbl_mod
Nodispatch
; GETSTRINGCHAR
i_82: MOVE.L (sp_)+, D3
ASR.L #1, D3
CLR.L D0
MOVE.B (accu_, D3.L), D0
ASL.L #1, D0
ADDQ.L #1, D0
MOVEA.L D0, accu_
Dispatch
; SETSTRINGCHAR
i_83: MOVE.L (sp_)+, D0
ASR.L #1, D0
MOVE.L (sp_)+, D3
ASR.L #1, D3
MOVE.B D3, (accu_, D0.L)
MOVEA.W #1, accu_
Dispatch
; BRANCH
i_BRANCH:
i_84: MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L D0, pc_
Dispatch
; BRANCHIF
i_85: CMPA.W #1, accu_
BNE.S i_BRANCH
ADDQ.L #4, pc_
Dispatch
; BRANCHIFNOT
i_86: CMPA.W #1, accu_
BEQ.S i_BRANCH
ADDQ.L #4, pc_
Dispatch
; SWITCH
i_87: CLR.L D5
MOVE.W (pc_)+, D5
CLR.L D3
MOVE.W (pc_)+, D3
MOVE.L accu_, D0
BTST.L #0, D0
BNE.S lbl_F9C
CLR.L D0
MOVE.B -1(accu_), D0
ADD.L D0, D3
LSL.L #2, D3
MOVE.L (pc_, D3.L), D0
ASL.L #2, D0
ADD.L D0, pc_
Udispatch
lbl_F9C: MOVE.L accu_, D0
ASR.L #1, D0
CMP.L D0, D3
BLS.S lbl_FC6
ASL.L #2, D0
MOVE.L (pc_, D0.L), D0
ASL.L #2, D0
ADD.L D0, pc_
Udispatch
lbl_FC6: ADD.L D5, D3
LSL.L #2, D3
ADDA.L D3, pc_
Dispatch
; BOOLNOT
i_88: MOVEQ #4, D0
SUB.L accu_, D0
MOVEA.L D0, accu_
Dispatch
; PUSHTRAP
i_89: MOVE.L extra_args_, D0
ASL.L #1, D0
ADDQ.L #1, D0
MOVE.L D0, -(sp_)
MOVE.L env_, -(sp_)
MOVE.L (trapsp).L, -(sp_)
MOVE.L (pc_), D0
ASL.L #2, D0
ADD.L pc_, D0
ADDQ.L #4, pc_
MOVE.L D0, -(sp_)
MOVE.L sp_, (trapsp).L
Dispatch
; POPTRAP
i_90: MOVE.L 4(sp_), (trapsp).L
LEA.L $10(sp_), sp_
Dispatch
; RAISE XXX debugger stuff not implemented
i_RAISE
i_91: MOVEA.L (trapsp).L, sp_
MOVEA.L (stack_high).L, A0
MOVE.L initial_sp_offset_(A7), D0
SUBA.L D0, A0
CMPA.L sp_, A0
BHI.S lbl_1080
MOVE.L accu_, (exn_bucket).L
MOVE.L initial_external_raise_(A7), D3
MOVE.L D3, (external_raise).L
SUBQ.L #1, (callback_depth).L
PEA.L (1).W
MOVE.L D3, -(A7)
Call_setup
JSR (longjmp).L
Call_restore
ADDQ.L #8, A7
lbl_1080: MOVEA.L (sp_)+, pc_
MOVE.L (sp_)+, (trapsp).L
MOVEA.L (sp_)+, env_
MOVE.L (sp_)+, extra_args_
ASR.L #1, extra_args_
Dispatch
; CHECK_SIGNALS
i_CHECK_SIGNALS:
i_92: TST.L (something_to_do).L
BNE.S i_92a
Udispatch
i_92a: CLR.L (something_to_do).L
TST.L (force_major_slice).L
BEQ.S lbl_1116
Setup_for_gc
Call_setup
JSR (minor_collection).L
Call_restore
Restore_after_gc
lbl_1116: MOVE.L (pending_signal).L, D5
CLR.L (pending_signal).L
TST.L D5
BEQ.S lbl_1168
ASL.L #1, extra_args_
ADDQ.L #1, extra_args_
MOVE.L extra_args_, -(sp_)
MOVE.L env_, -(sp_)
MOVE.L pc_, -(sp_)
ASL.L #1, D5
ADDQ.L #1, D5
MOVE.L D5, -(sp_)
ASR.L #1, D5
ASL.L #2, D5
MOVEA.L (signal_handlers).L, A0
MOVEA.L (A0, D5.L), env_
MOVEA.L (env_), pc_
CLR.L extra_args_
lbl_1168: TST.L (have_to_interact).L
BNE.S interact
Udispatch
interact: CLR.L (have_to_interact).L
CLR.L -(A7)
Call_setup
JSR (rotatecursor_action).L
Call_restore
ADDQ.L #4, A7
Dispatch
macro
Setup_for_c_call
MOVE.L env_, -(sp_)
MOVE.L sp_, (extern_sp).L
endm
macro
Restore_after_c_call
MOVEA.L (extern_sp).L, sp_
MOVEA.L (sp_)+, env_
endm
macro
C_CALL &n
lcla &p
Setup_for_c_call
&p seta &n-1
while &p > 0 do
MOVE.L &p*4(sp_), -(A7)
&p seta &p-1
endw
MOVE.L accu_, -(A7)
MOVE.L (pc_)+, D0
ASL.L #2, D0
LEA.L (cprim).L, A0
MOVEA.L (A0, D0.L), A0
Call_setup
JSR (A0)
Call_restore
if &n <= 2 then
ADDQ.L #&n*4, A7
else
LEA.L &n*4(A7), A7
endif
MOVEA.L D0, accu_
Restore_after_c_call
if &n > 1 then
LEA.L &n*4-4(sp_), sp_
endif
Dispatch
endm
i_93: C_CALL 1
i_94: C_CALL 2
i_95: C_CALL 3
i_96: C_CALL 4
i_97: C_CALL 5
; C_CALLN
i_98: MOVE.L (pc_)+, D4
MOVE.L accu_, -(sp_)
Setup_for_c_call
MOVE.L D4, -(A7)
PEA.L 4(sp_)
MOVE.L (pc_)+, D0
ASL.L #2, D0
LEA.L (cprim).L, A0
MOVEA.L (A0, D0.L), A0
Call_setup
JSR (A0)
Call_restore
ADDQ.L #8, A7
MOVEA.L D0, accu_
Restore_after_c_call
ASL.L #2, D4
ADDA.L D4, sp_
Dispatch
macro
CONST &n
MOVEA.W #&n*2+1, accu_
Dispatch
endm
i_CONST0:
i_99: CONST 0
i_CONST1:
i_100: CONST 1
i_101: CONST 2
i_102: CONST 3
; CONSTINT
i_103: MOVEA.L (pc_)+, A0
LEA.L 1(A0, A0.L), accu_
Dispatch
macro
PUSHCONST &n
MOVE.L accu_, -(sp_)
CONST &n
endm
i_104: PUSHCONST 0
i_105: PUSHCONST 1
i_106: PUSHCONST 2
i_107: PUSHCONST 3
; PUSHCONSTINT
i_108: MOVE.L accu_, -(sp_)
MOVEA.L (pc_)+, A0
LEA.L 1(A0, A0.L), accu_
Dispatch
; NEGINT
i_109: MOVEQ.L #2, D0
SUB.L accu_, D0
MOVEA.L D0, accu_
Dispatch
; ADDINT
i_110: ADDA.L (sp_)+, accu_
SUBQ.L #1, accu_
Dispatch
; SUBINT
i_111: SUBA.L (sp_)+, accu_
ADDQ.L #1, accu_
Dispatch
; MULINT
i_112: MOVE.L accu_, D0
ASR.L #1, D0
Call_setup
MOVE.L (sp_)+, D1
ASR.L #1, D1
JSR (ULMULT).L
Call_restore
ASL.L #1, D0
ADDQ.L #1, D0
MOVEA.L D0, accu_
Dispatch
; DIVMODINT { DIV | MOD }
macro
DIVMODINT &op
MOVE.L (sp_)+, D4
ASR.L #1, D4
BNE.S @ok
Setup_for_c_call
Call_setup
JSR (raise_zero_divide).L
Call_restore
@ok MOVE.L accu_, D0
ASR.L #1, D0
Call_setup
MOVE.L D4, D1
JSR (L&op.T).L
Call_restore
ASL.L #1, D0
ADDQ.L #1, D0
MOVEA.L D0, accu_
Dispatch
endm
i_113: DIVMODINT DIV
i_114: DIVMODINT MOD
; ANDINT
i_115: MOVE.L accu_, D0
AND.L (sp_)+, D0
MOVEA.L D0, accu_
Dispatch
; ORINT
i_116: MOVE.L accu_, D0
OR.L (sp_)+, D0
MOVEA.L D0, accu_
Dispatch
; XORINT
i_117: MOVE.L accu_, D0
MOVE.L (sp_)+, D3
EOR.L D3, D0
ADDQ.L #1, D0
MOVEA.L D0, accu_
Dispatch
; SHIFTINT { LSL | LSR | ASR }
macro
SHIFTINT &op
MOVE.L accu_, D0
SUBQ.L #1, D0
MOVE.L (sp_)+, D3
ASR.L #1, D3
&op..L D3, D0
ORI.B #1, D0
MOVEA.L D0, accu_
Dispatch
endm
i_118: SHIFTINT LSL
i_119: SHIFTINT LSR
i_120: SHIFTINT ASR
macro
INT_COMPARE &tst
CMPA.L (sp_)+, accu_
B&tst i_CONST1
MOVEA.W #1, accu_
Dispatch
endm
i_121: INT_COMPARE EQ
i_122: INT_COMPARE NE
i_123: INT_COMPARE LT
i_124: INT_COMPARE LE
i_125: INT_COMPARE GT
i_126: INT_COMPARE GE
; OFFSETINT
i_127: MOVE.L (pc_)+, D0
ASL.L #1, D0
ADDA.L D0, accu_
Dispatch
; OFFSETREF
i_128: MOVE.L (pc_)+, D0
ASL.L #1, D0
ADD.L D0, (accu_)
MOVEA.W #1, accu_
Dispatch
; GETMETHOD
i_129: MOVEA.L (sp_), A0 ; sp[0]
MOVEA.L (A0), A0 ; Field (sp[0], 0)
MOVE.L accu_, D3
MOVEQ #$12, D0
ASR.L D0, D3
LSL.L #2, D3 ; (accu >> 16) / sizeof (value) * 4
MOVEA.L (A0, D3.L), A0 ; Field (Field (sp[0], 0), (accu >> 16) / sizeof (value))
MOVE.L accu_, D0
ANDI.L #$03FC, D0 ; ((accu / sizeof (value)) & 0xFF) * 4
MOVEA.L (A0, D0.L), accu_ ; Field (Field (Field (...)...)...)
Dispatch
; STOP
i_130: MOVE.L initial_external_raise_(A7), (external_raise).L
MOVE.L sp_, (extern_sp).L
SUBQ.L #1, (callback_depth).L
MOVE.L accu_, D0
BRA lbl_1B88
Nodispatch
; EVENT XXX pas implemente
i_131: Dispatch
; BREAK XXX pas implemente
i_132: Dispatch
IF NOT &DEBUG THEN
Spacer 11486 ; complete a 64k
ENDIF
BRA fatal
lbl_mod: MOVE.L (A1), D5 ; A1 = modify_dest; D5 = _old_
MOVE.L (sp_)+, D4 ; D4 = modify_newval
MOVE.L D4, (A1)
CMPA.L (heap_start).L, A1
BCS i_CONST0 ; A1 < heap_start
CMPA.L (heap_end).L, A1 ; A1 >= heap_end
BCC i_CONST0
MOVE.L A1, D3
ASR.L #8, D3
ASR.L #4, D3
MOVEA.L (page_table).L, A0
TST.B (A0, D3.L)
BEQ i_CONST0 ; page_table[Page(A1)] = 0
TST.L (gc_phase).L
BNE.S lbl_CC2
MOVE.L A1, D3 ; A1 est caller-save
MOVE.L D5, -(A7)
Call_setup
JSR (darken).L
Call_restore
ADDQ.L #4 ,A7
MOVEA.L D3, A1 ; A1 est caller-save
lbl_CC2: BTST.L #0, D4
BNE i_CONST0
CMP.L (young_start).L, D4
BLS i_CONST0
CMP.L (young_end).L, D4
BCC i_CONST0
BTST.L #0, D5
BNE.S lbl_D00
CMP.L (young_start).L, D5
BLS.S lbl_D00
CMP.L (young_end).L, D5
BCS i_CONST0
lbl_D00: MOVEA.L (ref_table_ptr).L, A0
MOVE.L A1, (A0)+
MOVE.L A0, (ref_table_ptr).L
CMPA.L (ref_table_limit).L, A0
BCS i_CONST0
Call_setup
JSR (realloc_ref_table).L
Call_restore
BRA i_CONST0
chk_stks: CMPA.L (stack_threshold).L, sp_
BCC i_CHECK_SIGNALS
MOVE.L sp_, (extern_sp).L
Call_setup
JSR (realloc_stack).L
Call_restore
MOVE.L (extern_sp).L, sp_
BRA i_CHECK_SIGNALS
lbl_1B88: Call_setup ; 2eme copie: "init"
LEA.L local_var_size_(A7), A7
MOVEM.L (A7)+, D3-D7/A2-A6
RTS
dc.b $80 + 10, 'interprete', 0
dc.w 0
IF &DEBUG THEN
camldispatch:
ADDQ.L #1, (dcounter).L
BNE.S nobreak
_Debugger
nobreak: BRA.S notrace
Call_setup
MOVE.L pc_, -(A7)
JSR (disasm_instr).L
ADDQ.L #4, A7
Call_restore
notrace: MOVE.L (pc_)+, D0
JMP (jtbl_, D0.W)
RTS
dc.b $80 + 12, 'camldispatch', 0
dc.w 0
DATA
dcounter: dc.l 0
ENDIF
endproc ; interprete
end