Threaded code interpreter for 68K-compatible CPUs

threaded-code-interpreter.s

;; Threaded forth-like code interpreter
;; (c) 2022 Alexander Sharikhin
;; Licensed under Coffeeware License
;;
;; License:
;;
;; If you're using this part of code, I'd love to hear about it.
;; Let me know by sending email to anihirash(at)gmail.com
;;
;; I'm crazy about coffee. If you treat me a delicious coffee - it
;; will be awesome.
;;
;; You may use all data from this project as you want.
;;
;; But if you'll use parts of this project - please keep this info about my
;; love to coffee(or buy me a cup of coffee at least).



;; Small section about usage of interpreter.
;; Possibly, you'll let script something in your amiga code.
;; Place where you let scripting will looks like
;;
;; ... Your code was upper...
;; bsr eval
;; dc.l procedure_ptr
;; ... Your threaded procedures ptrs goes here ...
;; Exit
;; ... Your regular 68k asm goes next ...
;;
;; Procedure will looks like usual 68k procedure, except it will be ended
;; with 'Next' macro(not with RTS)
;;
;; To return from interpreted mode to usual 68k assembly use 'Exit' macro as procedure
;;
;; To make your life simpler - better make macroses that will write all links
;; to routines. If you want pass some arguments they can be placed after procedure
;; pointer(sorry, all data is long). To extract argument to register use 'GetArg' macro
;; but it will waste your A6 reg. Or write yourown code that will make this task in
;; acceptable way for you.

    section main,code_f
Next macro
    jmp eval
    endm
    
Exit macro
    dc.l ret
    endm

GetArg macro
    move.l (sp),a6
    move.l (a6)+,\1
    move.l  a6,(sp)
    endm

Loop macro
    dc.l i_loop, (\1-1)
    endm

ELoop macro
    dc.l i_eloop
    endm

;; SetWord
;;
;; Change variable in memory
;; Usage:
;;  SetWord var_ptr, $ffee
;; It will save to var_ptr value $ffee
SetWord macro
    dc.l i_set_word, \1, \2
    endm

;; SetLong
;;
;; Similar to SetWord but Long sized(32 bit)
SetLong macro
    dc.l i_set_long, \1, \2
    endm

AddWord macro
    dc.l i_add_word, \1, \2
    endm

SubWord macro
    dc.l i_sub_word, \1, \2
    endm

AddLong macro
    dc.l i_add_long, \1, \2
    endm

SubLong macro
    dc.l i_sub_long, \1, \2
    endm

;; Eval threaded code that will go after call of subroutine
eval:
;; Exit check. Remove if it ins't necessary
    btst #6,$bfe001
    beq  exit
;;  Interpreter part
    movea.l (sp),a5
    movea.l (a5),a6
    adda.l  #4,a5
    move.l  a5,(sp)
    jmp     (a6)
ret:
    rts

i_incr:
    add.l   #1,d7
    Next

i_loop:
    GetArg  d3
    move.l  a6,d0
    bsr     i_push
    move.l  d3,d0
    bsr     i_push
    Next

i_eloop:
    move.l i_sp,a6
    sub.l   #4,a6
    cmp.l   #0,(a6)
    beq    .exit
    bsr     i_pop
    move.l  d0,d3
    
    bsr     i_pop
    bsr     i_push
    move.l  d0,(sp)
    move.l  d3,d0
    sub.l   #1,d0
    bsr     i_push
    Next
.exit
    sub.l   #4,a6
    move.l  a6,i_sp
    Next

i_push:
    move.l  i_sp,a6
    move.l  d0,(a6)+
    move.l  a6,i_sp
    rts

i_pop:
    move.l  i_sp,a6
    move.l  -(a6),d0
    move.l  a6,i_sp
    rts

i_add_word:
    GetArg  a0
    GetArg  d0
    add.w   d0,(a0)
    Next

i_sub_word:
    GetArg  a0
    GetArg  d0
    sub.w   d0,(a0)
    Next

i_add_long:
    GetArg  a0
    GetArg  d0
    add.l   d0,(a0)
    Next

i_sub_long:
    GetArg  a0
    GetArg  d0
    sub.l   d0,(a0)
    Next

i_set_word:
    GetArg  a0
    GetArg  d0
    move.w  d0,(a0)
    Next

i_set_long:
    GetArg  a0
    GetArg  d0
    move.l  d0,(a0)
    Next

i_sp    dc.l    i_stack
    section interpreter_data,bss_f
i_stack ds.l    50