ocaml/byterun/interp.a

;***********************************************************************/
;*                                                                     */
;*                           Objective Caml                            */
;*                                                                     */
;*            Damien Doligez, Projet Para, INRIA Rocquencourt          */
;*                                                                     */
;*  Copyright 1996 Institut National de Recherche en Informatique et   */
;*  en Automatique.  All rights reserved.  This file is distributed    */
;*  under the terms of the GNU Library General Public License.         */
;*                                                                     */
;***********************************************************************/

;* $Id$ */

;* The bytecode interpreter in 68000 assembly language */

  string asis
  print nopage
  case obj

; These constants must be kept in sync with the C code:

Caml_black equ $300
Double_array_tag equ 254
Double_tag equ 253
Closure_tag equ 250
Infix_tag equ 249
Val_unit equ 1
Val_false equ 1
Val_true    equ 3

  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, rotatecursor_flag): data
  import (process_event): code
  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

fatalmsg: record
          dc.b       'Fatal error in interp: bad opcode (%lx)', $0D, $00
endr

interprete proc export


; Register assignment:

; temp (caller-save)            A0
; temp (caller-save)            A1
accu_                    equ    A2
pc_                      equ    A3
sp_                      equ    A4
env_                     equ    A5
jtbl_                    equ    A6
; 68k stack pointer             A7

; temp (caller-save)            D0
; temp (callee-save)            D1
y_limit_reg              equ    D2
y_ptr_reg                equ    D3
; temp (callee-save)            D4
; temp (callee-save)            D5
saved_A5                 equ    D6
extra_args_              equ    D7


; stack, relative to A6

; raise_buf_               equ      -$40
; initial_sp_offset_       equ      -$44
; initial_external_raise_  equ      -$48
; initial_local_roots_     equ      -$4C
; (nothing)                equ      -$50  (was initial_callback_depth_)


; stack, relative to 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
; (nothing)              equ      $00  (was initial_callback_depth_)


; To call a C function, we must:
; 1. set A5 back to its normal value
; 2. put young_ptr and young_limit into the global variables

; Note that this file must be assembled with the option  "-model far",
; so access to global variables doesn't use A5.

 macro
   Call_setup
          EXG.L      saved_A5, 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      saved_A5, A5
 endm

; To call a C function that uses the Caml runtime globals
 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

; To call a GC function
 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

; Dispatch to the next byte-code instruction
 IF &DEBUG THEN
   macro
     Dispatch
          BRA.L      camldispatch
   endm
 ELSE
   macro
     Dispatch
          MOVE.L     (pc_)+, D0
          JMP        (jtbl_, D0.W)
   endm
 ENDIF

; Never executed unless something goes wrong
 macro
   NotReached
          BRA.W      fatal
 endm

; Add some NOPs between useful instructions (to catch bad byte-codes)

 macro
   NOPs &n
          DCB.W      &n, $4E71
 endm
 
 macro
   Spacer &n=$10
          NOPs       &n-2
          NotReached
 endm

; The normal end of an instruction
 macro
   Next &n=$10
          Dispatch
          Spacer     &n
 endm          

; The Alloc_small macro from memory.h
; Alloc_small [#],bhsize, [#],tag_col, result
; input: bhsize = size in bytes including header
;        tag_col = Caml_black + (value of the tag)
;        result = address register for the result
; '#' specifies a constant, (emtpy) specifies a register

; All register are preserved except A0, A1, D0, D1,
; and &bhsize, &tag_col if they are registers.
 macro
   Alloc_small &sizetype, &bhsize, &tagtype, &tag_col, &result
          MOVEA.L    y_ptr_reg, &result
          SUBA.L     &sizetype.&bhsize, &result
          CMPA.L     y_limit_reg, &result
          BCC.S      @nogc
    IF &tagtype = '' THEN
          MOVE.L     &tag_col, -(A7)
    ENDIF
    IF &sizetype = '' THEN
          MOVE.L     &bhsize, -(A7)
    ENDIF
          Setup_for_gc
          Call_setup
          JSR        (minor_collection).L
          Call_restore
          Restore_after_gc
    IF &sizetype = '' THEN
          MOVE.L     (A7)+, &bhsize
    ENDIF
    IF &tagtype = '' THEN
          MOVE.L     (A7)+, &tag_col
    ENDIF
          MOVEA.L    y_ptr_reg, &result
          SUBA.L     &sizetype.&bhsize, &result
@nogc:    MOVE.L     &result, y_ptr_reg
    IF &sizetype = '' THEN
          SUBQ.L     #4, &bhsize
          LSL.L      #8, &bhsize
          OR.W       &tagtype.&tag_col, &bhsize
          MOVE.L     &bhsize, (&result)+
    ELSEIF &tagtype = '' THEN
          ORI.L      #(&bhsize-4) << 8, &tag_col
          MOVE.L     &tag_col, (&result)+
    ELSE
          MOVE.L     #((&bhsize-4)<<8) + &tag_col, (&result)+
    ENDIF
 endm


; The threaded-code interpreter starts here.

          ; _Debugger
          MOVEM.L    D3-D7/A2-A6,-(A7)                  ; 10 registers
          LEA.L      -local_var_size_(A7), A7
          Call_restore

          MOVE.L     local_var_size_+4*10+4(A7), D0     ; argument 0 (prog)
          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

; return from the threaded-code interpreter
 macro
   interprete_return
     gbla &section
          Call_setup
          LEA.L      local_var_size_(A7), A7
          MOVEM.L    (A7)+, D3-D7/A2-A6
          RTS

          dc.b       $80 + 11, 'interprete', $30 + &section
&section seta &section + 1
 endm

          interprete_return

noinit:   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      no_jmp
          MOVE.L     initial_local_roots_(A7), (local_roots).L
          MOVEA.L    (exn_bucket).L, accu_
          JMP        raise_exception-i_base(jtbl_)
no_jmp:   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 (prog)
          CLR.L      extra_args_
          LEA.L      (atom_table+4).L, env_
          MOVEA.W    #1, accu_
          Dispatch

; Table of instruction addresses for the thread_code function
 macro
   Make_table
     lcla &i
     WHILE &i < 133 DO
          DC.L       i_&i - i_base
&i     seta &i+1
     ENDW
 endm

table:    Make_table

; A 64k-sized chunk of memory where we branch directly
i_start:  NOPs       $4000

i_base:   NOPs       $100

fatal:    MOVE.L     -4(pc_), -(A7)
          PEA.L      (fatalmsg).L
          Call_setup
          JSR        (fatal_error_arg).L
          ;NotReached

          Spacer     $100

 macro
   ACC &n
          MOVEA.L    4*&n(sp_), accu_
          Next
 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

; The code for PUSH is duplicated everywhere
 macro
   _PUSH
          MOVE.L     accu_, -(sp_)
 endm

i_9:      ; PUSH
i_10:     ; PUSHACC0
          _PUSH
          Next

 macro
   PUSHACC &n
          _PUSH
          MOVEA.L    4*&n(sp_), accu_
          Next
 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

i_18:     ; PUSHACC
          _PUSH
          ; fall through

i_8:      ; ACC
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (sp_, D0.L), accu_
          Next

i_19:     ; POP
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          ADDA.L     D0, sp_
          Next

i_20:     ; ASSIGN
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVE.L     accu_, (sp_, D0.L)
          MOVEA.W    #1, accu_
          Next

 macro
   ENVACC &n
          MOVEA.L    4*&n(env_), accu_
          Next
 endm

i_21:     ENVACC 1
i_22:     ENVACC 2
i_23:     ENVACC 3
i_24:     ENVACC 4

 macro
   PUSHENVACC &n
          _PUSH
          ENVACC &n
 endm

i_26:     PUSHENVACC 1
i_27:     PUSHENVACC 2
i_28:     PUSHENVACC 3
i_29:     PUSHENVACC 4

i_30:     ; PUSHENVACC
          _PUSH
          ; fall through

i_25:     ; ENVACC
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (env_, D0.L), accu_
          Next

i_31:     ; PUSH_RETADDR
          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
          MOVE.L     D0, -(sp_)
          ADDQ.L     #4, pc_
          Next

i_32:     ; APPLY
          MOVE.L     (pc_), extra_args_
          SUBQ.L     #1, extra_args_
          MOVEA.L    (accu_), pc_
          MOVEA.L    accu_, env_
          BRA        check_stacks
          Spacer

 macro
   APPLY &n
          LEA.L      -$0C(sp_), A0
          MOVEA.L    A0, A1
     lcla &i
     WHILE &i < &n-1 DO
          MOVE.L     (sp_)+, (A0)+
&i     seta &i+1
     ENDW
          MOVE.L     (sp_), (A0)+
          MOVEA.L    A1, 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        check_stacks
          Spacer
 endm

i_33:     APPLY 1
i_34:     APPLY 2
i_35:     APPLY 3

i_36:     ; APPTERM
          MOVE.L     (pc_)+, D1             ; D1 = nargs
          MOVE.L     (pc_), D0              ; D0 = slotsize
          ADD.L      D1, extra_args_
          SUBQ.L     #1, extra_args_
          SUB.L      D1, D0                 ; D0 = slotsize - nargs
          ASL.L      #2, D0
          LEA.L      (sp_, D0.L), A0        ; A0 = newsp
          ASL.L      #2, D1                 ; D1 = 4*i
          BRA.S      i_36b
i_36a:    MOVE.L     (sp_, D1.L), (A0, D1.L)
i_36b:    SUBQ.L     #4, D1
          BPL.S      i_36a                  ; >= 0
          MOVEA.L    A0, sp_
          MOVEA.L    (accu_), pc_
          MOVEA.L    accu_, env_
          BRA        check_stacks
          Spacer

 macro
   APPTERM &n
          MOVEA.L    sp_, A0
          MOVE.L     (pc_), D0
          ASL.L      #2, D0
          ADDA.L     D0, sp_
     lcla &i
&i   seta &n-1
     WHILE &i >= 0 DO
          MOVE.L     4*&i(A0), -(sp_)
&i     seta &i-1
     ENDW
          MOVEA.L    (accu_), pc_
          MOVEA.L    accu_, env_
     IF &n > 1 THEN
          ADDQ.L     #&n-1, extra_args_
     ENDIF
          BRA        check_stacks
          Spacer
 endm

i_37:     APPTERM 1
i_38:     APPTERM 2
i_39:     APPTERM 3

i_40:     ; RETURN
          MOVE.L     (pc_), D0
          ASL.L      #2, D0
          ADD.L      D0, sp_
          TST.L      extra_args_
          BLE.S      i_40a
          SUBQ.L     #1, extra_args_
          MOVEA.L    (accu_), pc_
          MOVEA.L    accu_, env_
          Next
i_40a:    MOVEA.L    (sp_)+, pc_
          MOVEA.L    (sp_)+, env_
          MOVE.L     (sp_)+, extra_args_
          ASR.L      #1, extra_args_
          Next

i_41:     ; RESTART
          MOVE.L     -4(env_), D5
          LSR.L      #8, D5
          LSR.L      #2, D5
          SUBQ.L     #2, D5                 ; D5 = num_args
          MOVE.L     D5, D0
          ASL.L      #2, D0                 ; D0 = i*4
          SUB.L      D0, sp_
          BRA.S      i_41b
i_41a:    MOVE.L     8(env_, D0.L), (sp_, D0.L)
i_41b:    SUBQ.L     #4, D0
          BPL.S      i_41a
          MOVEA.L    4(env_), env_
          ADD.L      D5, extra_args_
          Next

i_42:     ; GRAB
          MOVE.L     (pc_)+, D0                   ; D0 = required
          CMP.L      extra_args_, D0
          BGT.S      i_42a
          SUB.L      D0, extra_args_
          Next
i_42a:    MOVE.L     extra_args_, D4              ; extra_args_ = num_args - 1
          ADDQ.L     #4, D4                       ; num_args + 2 + 1(hd)
          LSL.L      #2, D4
          Alloc_small ,D4, #,Caml_black+Closure_tag, accu_
          MOVE.L     env_, 4(accu_)
          LEA.L      8(accu_), A0
i_42b:    MOVE.L     (sp_)+, (A0)+
          SUBQ.L     #1, extra_args_
          BPL.S      i_42b
          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

i_43:     ; CLOSURE
          MOVE.L     (pc_)+, D5                   ; D5 = nvars
          BLE.S      i_43a
          MOVE.L     accu_, -(sp_)
i_43a:    MOVE.L     D5, D0
          ADDQ.L     #2, D0                       ; D0 = 1 + nvars + 1(hd)
          ASL.L      #2, D0
          Alloc_small ,D0, #,Caml_black+Closure_tag, 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      i_43c
i_43b:    MOVE.L     (sp_)+, (A0)+
i_43c:    SUBQ.L     #1, D5
          BPL.S      i_43b                        ; >= 0
          Dispatch

i_44:     ; CLOSUREREC
          MOVE.L     (pc_)+, D4                   ; D4 = nfuncs
          MOVE.L     (pc_)+, D5                   ; D5 = nvars
          BLE.S      i_44a
          MOVE.L     accu_, -(sp_)
i_44a:    MOVE.L     D4, D0
          ASL.L      #1, D0
          ADD.L      D5, D0
          ASL.L      #2, D0
          Alloc_small ,D0, #,Caml_black+Closure_tag, accu_
          MOVEA.L    accu_, A0
          MOVE.L     D4, D0
          ASL.L      #3, D0
          SUBQ.L     #4, D0
          ADDA.L     D0, A0                       ; A0 = p
          MOVE.L     D5, D0
          BRA.S      i_44c
i_44b:    MOVE.L     (sp_)+, (A0)+
i_44c:    SUBQ.L     #1, D0
          BPL.S      i_44b                        ; >= 0
          MOVE.L     accu_, A0                    ; A0 = p
          MOVE.L     (pc_), D0
          ASL.L      #2, D0
          ADD.L      pc_, D0
          MOVE.L     D0, (A0)+
          MOVE.L     accu_, -(sp_)
          MOVEQ.L    #1, D0                       ; D0 = i
          BRA.S      i_44e
i_44d:    MOVE.L     D0, D1
          ASL.L      #8, D1
          ASL.L      #3, D1
          ADD.W      #Caml_black+Infix_tag, D1
          MOVE.L     D1, (A0)+
          MOVE.L     A0, -(sp_)
          MOVE.L     D0, D1
          ASL.L      #2, D1
          MOVE.L     (pc_, D1), D1
          ASL.L      #2, D1
          ADD.L      pc_, D1
          MOVE.L     D1, (A0)+
          ADDQ.L     #1, D0
i_44e:    CMP.L      D4, D0
          BMI.S      i_44d                        ; D0 < D4
          ASL.L      #2, D4
          ADDA.L     D4, pc_
          Next

i_52:     ; PUSHOFFSETCLOSURE
          _PUSH
          ; fall through

i_48:     ; OFFSETCLOSURE
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          ADD.L      env_, D0
          MOVE.L     D0, accu_
          Next

i_49:     ; PUSHOFFSETCLOSUREM2
          _PUSH
          ; fall through

i_45:     ; OFFSETCLOSUREM2
          MOVE.L     env_, accu_
          SUBQ.L     #8, accu_
          Next

i_50:     ; PUSHOFFSETCLOSURE0
          _PUSH
          ; fall through

i_46:     ; OFFSETCLOSURE0
          MOVE.L     env_, accu_
          Next

i_51:     ; PUSHOFFSETCLOSURE2
          _PUSH
          ; fall through

i_47:     ; OFFSETCLOSURE2
          MOVE.L     env_, accu_
          ADDQ.L     #8, accu_
          Next

i_54:     ; PUSHGETGLOBAL
          _PUSH
          ; fall through

i_53:     ; GETGLOBAL
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (global_data).L, A0
          MOVEA.L    (A0, D0.L), accu_
          Next

i_56:     ; PUSHGETGLOBALFIELD
          _PUSH
          ; fall through

i_55:     ; GETGLOBALFIELD
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (global_data).L, A0
          MOVEA.L    (A0, D0.L), accu_
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (accu_, D0.L), accu_
          Next

i_57:     ; SETGLOBAL
          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    #Val_unit, accu_
          Next

i_60:     ; PUSHATOM0
          _PUSH
          ; fall through

i_58:     ; ATOM0
          LEA.L      (atom_table+4).L, accu_
          Next

i_61:     ; PUSHATOM
          _PUSH
          ; fall through

i_59:     ; ATOM
          LEA.L      (atom_table+4).L, accu_
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          ADDA.L     D0, accu_
          Next

i_62:     ; MAKEBLOCK
          MOVE.L     (pc_)+, D4         ; D4 = wosize
          MOVE.L     (pc_)+, D1         ; D1 = tag
          ORI.W      #Caml_black, D1    ; D1 = tag + Caml_black
          MOVE.L     D4, D0
          ADDQ.L     #1, D0             ; D0 = whsize
          LSL.L      #2, D0             ; D0 = bhsize
          Alloc_small ,D0, ,D1, A0      ; A0 = block
          MOVE.L     accu_, (A0)
          MOVEA.L    A0, accu_
          ADDQ.L     #4, A0
          BRA.S      i_62b
i_62a:    MOVE.L     (sp_)+, (A0)+
i_62b:    SUBQ.L     #1, D4
          BHI.S      i_62a              ; > 0
          Next

 macro
   MAKEBLOCK &n
          MOVE.L     (pc_)+, D0
          ORI.W      #$0300, D0
          Alloc_small #,4*&n+4, ,D0, A0
          MOVE.L     accu_, (A0)
          MOVEA.L    A0, accu_
          ADDQ.L     #4, A0
     lcla &i
&i   seta 1
     WHILE &i < &n DO
          MOVE.L     (sp_)+, (A0)+
&i     seta &i+1
     ENDW
          Next
 endm

i_63:     MAKEBLOCK 1
i_64:     MAKEBLOCK 2
i_65:     MAKEBLOCK 3

i_66:     ; MAKEFLOATBLOCK
          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_66b
lbl_66a:  MOVE.L     (sp_)+, A0
          MOVE.L     (A0)+, (A1)+
          MOVE.L     (A0), (A1)+
lbl_66b:  SUBQ.L     #1, D5
          BHI.S      lbl_66a            ; > 0
          Next

 macro
   GETFIELD &n
          MOVEA.L    4*&n(accu_), accu_
          Next
 endm

i_67:     GETFIELD   0
i_68:     GETFIELD   1
i_69:     GETFIELD   2
i_70:     GETFIELD   3

i_71:     ; GETFIELD
          MOVE.L     (pc_)+, D0
          ASL.L      #2, D0
          MOVEA.L    (accu_, D0.L), accu_
          Next

i_72:     ; GETFLOATFIELD
          Alloc_small #,$C, #,Caml_black+Double_tag, 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_
          Next

; Here, modify_l takes modify_dest in accu_ and modify_newval on the stack.

i_73:     ; SETFIELD0
modify_l: MOVE.L     (sp_)+, -(A7)                ; modify_newval
          MOVE.L     accu_, -(A7)                 ; modify_dest
          Call_setup
          JSR        (modify).L
          Call_restore
          ADDQ.L     #8, A7
          MOVE.W     #Val_unit, accu_
          Next       $100                         ; avoid short branch warning

 macro
   SETFIELD &n
          LEA.L      4*&n(accu_), accu_           ; accu_ = modify_dest
          BRA.W      modify_l
          Spacer
 endm

i_74:     SETFIELD 1
i_75:     SETFIELD 2
i_76:     SETFIELD 3

i_77:     ; SETFIELD
          MOVE.L     (pc_)+, D0
          ASL.L      #$2, D0
          LEA.L      (accu_, D0.L), accu_         ; accu_ = modify_dest
          BRA        modify_l
          Spacer

i_78:     ; SETFLOATFIELD
          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    #Val_unit, accu_
          Next

i_79:     ; VECTLENGTH
          MOVE.L     -4(accu_), D0
          LSR.L      #8, D0
          LSR.L      #1, D0
          CMP.B      #Double_array_tag, -1(accu_)
          BNE.S      lbl_79a
          LSR.L      #1, D0
lbl_79a:  ORI.B      #1, D0
          MOVEA.L    D0, accu_
          Next

i_80:     ; GETVECTITEM
          MOVE.L     (sp_)+, D0
          ASR.L      #1, D0
          ASL.L      #2, D0
          MOVEA.L    (accu_, D0.L), accu_
          Next

i_81:     ; SETVECTITEM
          MOVE.L     (sp_)+, D0
          ASR.L      #1, D0
          ASL.L      #2, D0
          LEA.L      (accu_, D0.L), accu_       ; accu_ = modify_dest
          BRA        modify_l
          Spacer

i_82:     ; GETSTRINGCHAR
          MOVE.L     (sp_)+, D1
          ASR.L      #1, D1
          CLR.L      D0
          MOVE.B     (accu_, D1.L), D0
          ASL.L      #1, D0
          ADDQ.L     #1, D0
          MOVEA.L    D0, accu_
          Next

i_83:     ; SETSTRINGCHAR
          MOVE.L     (sp_)+, D0
          ASR.L      #1, D0
          MOVE.L     (sp_)+, D1
          ASR.L      #1, D1
          MOVE.B     D1, (accu_, D0.L)
          MOVEA.W    #1, accu_
          Next

i_84:     ; BRANCH
i_BRANCH: MOVE.L     (pc_), D0
          ASL.L      #2, D0
          ADDA.L     D0, pc_
          Next

i_85:     ; BRANCHIF
          CMPA.W     #Val_false, accu_
          BNE.S      i_BRANCH
          ADDQ.L     #4, pc_
          Next

i_86:     ; BRANCHIFNOT
          CMPA.W     #Val_false, accu_
          BEQ.S      i_BRANCH
          ADDQ.L     #4, pc_
          Next

i_87:     ; SWITCH
          CLR.L      D5
          MOVE.W     (pc_)+, D5                 ; D5 = sizes >> 16
          CLR.L      D1
          MOVE.W     (pc_)+, D1                 ; D1 = sizes & 0xFFFF
          MOVE.L     accu_, D0
          BTST.L     #0, D0
          BNE.S      i_87a
          CLR.L      D0
          MOVE.B     -1(accu_), D0              ; D0 = index
          ADD.L      D0, D1
          LSL.L      #2, D1
          MOVE.L     (pc_, D1.L), D0            ; D0
          ASL.L      #2, D0
          ADD.L      D0, pc_
          Next
i_87a:    ASR.L      #1, D0
          CMP.L      D0, D1
          BLS.S      i_87b
          ASL.L      #2, D0
          MOVE.L     (pc_, D0.L), D0            ; D0 = pc[index]
          ASL.L      #2, D0
          ADD.L      D0, pc_
          Next
i_87b:    ADD.L      D5, D1
          LSL.L      #2, D1
          ADDA.L     D1, pc_
          Next

i_88:     ; BOOLNOT
          MOVEQ      #Val_false + Val_true, D0
          SUB.L      accu_, D0
          MOVEA.L    D0, accu_
          Next

i_89:     ; PUSHTRAP
          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
          MOVE.L     D0, -(sp_)
          MOVE.L     sp_, (trapsp).L
          ADDQ.L     #4, pc_
          Next

i_90:     ; POPTRAP
          TST.L      (something_to_do).L
          BEQ.S      i_90a
          SUBQ.L     #4, pc_
          BRA        process_signals
i_90a:    MOVE.L     4(sp_), (trapsp).L
          LEA.L      $10(sp_), sp_
          Next

i_91:     ; RAISE                         XXX debugger stuff not implemented
raise_exception:
          MOVEA.L    (trapsp).L, sp_
          MOVEA.L    (stack_high).L, A0
          SUBA.L     initial_sp_offset_(A7), A0
          CMPA.L     sp_, A0
          BHI.S      i_91a
          MOVE.L     initial_external_raise_(A7), (external_raise).L
          SUBQ.L     #1, (callback_depth).L
          MOVE.L     accu_, D0
          ORI.L      #2, D0                     ; Make_exception_result
          interprete_return
i_91a:    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_stacks:
          CMPA.L     (stack_threshold).L, sp_
          BCC.S      stack_ok
          MOVE.L     sp_, (extern_sp).L
          Call_setup
          JSR        (realloc_stack).L
          Call_restore
          MOVE.L     (extern_sp).L, sp_
stack_ok: ; fall through

i_92:     ; CHECK_SIGNALS
          TST.L      (something_to_do).L
          BNE.S      process_signals
          Next
process_signals:
          ASL.L      #1, extra_args_           ; begin Setup_for_event
          ADDQ.L     #1, extra_args_
          MOVE.L     extra_args_, -(sp_)
          MOVE.L     env_, -(sp_)
          MOVE.L     pc_, -(sp_)
          MOVE.L     #Val_unit, -(sp_)
          MOVE.L     #Val_unit, -(sp_)
          MOVE.L     accu_, -(sp_)
          MOVE.L     sp_, (extern_sp).L        ; end Setup_for_event
          Call_setup
          JSR        (process_event).L
          Call_restore
          MOVE.L     (extern_sp).L, sp_        ; begin Restore_after_event
          MOVE.L     (sp_)+, accu_
          ADDQ.L     #8, sp_
          MOVE.L     (sp_)+, pc_
          MOVE.L     (sp_)+, env_
          MOVE.L     (sp_)+, extra_args_
          ASR.L      #1, extra_args_           ; end Restore_after_event
          Next

 macro
   C_CALL &n
          Setup_for_c_call
     lcla &i
&i   seta &n-1
     WHILE &i > 0 DO
          MOVE.L     4*&i(sp_), -(A7)
&i     seta &i-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
          LEA.L      &n*4(A7), A7
          MOVEA.L    D0, accu_
          Restore_after_c_call
      IF &n > 1 THEN
          LEA.L      4*(&n-1)(sp_), sp_
      ENDIF
          Next
 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

i_98:     ; C_CALLN
          MOVE.L     (pc_)+, D4                 ; D4 = nargs
          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_
          Next

 macro
   CONST &n
          MOVEA.W    #2*&n+1, accu_
          Next
 endm

i_99:     CONST 0
i_100:    CONST 1
i_101:    CONST 2
i_102:    CONST 3

 macro
   PUSHCONST &n
          _PUSH
          CONST &n
 endm

i_104:    PUSHCONST 0
i_105:    PUSHCONST 1
i_106:    PUSHCONST 2
i_107:    PUSHCONST 3

i_108:    ; PUSHCONSTINT
          _PUSH
          ; fall through

i_103:    ; CONSTINT
          MOVEA.L    (pc_)+, A0
          LEA.L      1(A0, A0.L), accu_
          Next

i_109:    ; NEGINT
          MOVEQ.L    #2, D0
          SUB.L      accu_, D0
          MOVEA.L    D0, accu_
          Next

i_110:    ; ADDINT
          ADDA.L     (sp_)+, accu_
          SUBQ.L     #1, accu_
          Next

i_111:    ; SUBINT
          SUBA.L     (sp_)+, accu_
          ADDQ.L     #1, accu_
          Next

i_112:    ; MULINT
          MOVE.L     accu_, D0
          ASR.L      #1, D0
          MOVE.L     (sp_)+, D1
          ASR.L      #1, D1
          Call_setup
          JSR        (ULMULT).L
          Call_restore
          ASL.L      #1, D0
          ADDQ.L     #1, D0
          MOVEA.L    D0, accu_
          Next

 macro
   DIVMODINT  &op                          ; op in {DIV, MOD}
          MOVE.L     (sp_)+, D1
          ASR.L      #1, D1
          BNE.S      @nonzero
          Setup_for_c_call
          Call_setup
          ; _Debugger
          JSR        (raise_zero_divide).L
          NotReached
@nonzero: MOVE.L     accu_, D0
          ASR.L      #1, D0
          Call_setup
          JSR        (L&op.T).L
          Call_restore
          ASL.L      #1, D0
          ADDQ.L     #1, D0
          MOVEA.L    D0, accu_
          Next
 endm

i_113:    DIVMODINT  DIV
i_114:    DIVMODINT  MOD

i_115:    ; ANDINT
          MOVE.L     accu_, D0
          AND.L      (sp_)+, D0
          MOVEA.L    D0, accu_
          Dispatch

i_116:    ; ORINT
          MOVE.L     accu_, D0
          OR.L       (sp_)+, D0
          MOVEA.L    D0, accu_
          Dispatch

i_117:    ; XORINT
          MOVE.L     accu_, D0
          MOVE.L     (sp_)+, D1
          EOR.L      D1, D0
          ADDQ.L     #1, D0
          MOVEA.L    D0, accu_
          Dispatch

 macro
   SHIFTINT &op                         ; op in {LSL, LSR, ASR}
          MOVE.L     accu_, D0
          SUBQ.L     #1, D0
          MOVE.L     (sp_)+, D1
          ASR.L      #1, D1
          &op..L     D1, D0
          ORI.B      #1, D0
          MOVEA.L    D0, accu_
          Next
 endm

i_118: SHIFTINT LSL
i_119: SHIFTINT LSR
i_120: SHIFTINT ASR

 macro
   Integer_comparison &tst
          CMPA.L     (sp_)+, accu_
          B&tst..S   @true
          MOVEA.W    #Val_false, accu_
          Next
@true     MOVEA.W    #Val_true, accu_
          Next
 endm

i_121:    Integer_comparison EQ
i_122:    Integer_comparison NE
i_123:    Integer_comparison LT
i_124:    Integer_comparison LE
i_125:    Integer_comparison GT
i_126:    Integer_comparison GE

i_127:    ; OFFSETINT
          MOVE.L     (pc_)+, D0
          ASL.L      #1, D0
          ADDA.L     D0, accu_
          Next

i_128:    ; OFFSETREF
          MOVE.L     (pc_)+, D0
          ASL.L      #1, D0
          ADD.L      D0, (accu_)
          MOVEA.W    #Val_unit, accu_
          Next

i_129:    ; ISINT
          MOVE.L     accu_, D0
          AND.L      #1, D0
          LSL.L      #1, D0
          OR.L       #1, D0
          MOVEA.L    D0, accu_
          Next

i_130:    ; GETMETHOD
          MOVEA.L    (sp_), A0         ; sp[0]
          MOVEA.L    (A0), A0          ; Field (sp[0], 0)
          MOVE.L     accu_, D1
          MOVEQ      #$12, D0
          ASR.L      D0, D1
          LSL.L      #2, D1            ; (accu >> 16) / sizeof (value) * 4
          MOVEA.L    (A0, D1.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 (...)...)...)
          Next

; STOP
i_131:    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
          interprete_return
          Spacer

i_132:    ; EVENT                          XXX debugger stuff not implemented
          Next

i_133:    ; BREAK                          XXX debugger stuff not implemented
          Next

 IF NOT &DEBUG THEN
          Spacer     i_base+$4000-*        ; fill the 64k bytes
 ENDIF

          RTS
          dc.b       $80 + 11, 'interpreteX'


 IF &DEBUG THEN

camldispatch:
          ADDQ.L     #1, (dcounter).L
          BNE.S      nobreak
          _Debugger
nobreak:  BRA.S      notrace
          MOVE.L     pc_, -(A7)
          Call_setup
          JSR        (disasm_instr).L
          Call_restore
          ADDQ.L     #4, A7
notrace:  MOVE.L     (pc_)+, D0
          JMP        (jtbl_, D0.W)

          RTS
          dc.b       $80 + 12, 'camldispatch'

          DATA
dcounter: dc.l       0

 ENDIF


 endproc ; interprete

 end