;; -*- Mode: Irken -*-

(require "lib/enum.scm")

(make-enum mode
  (constant0  #x0)
  (constant1  #x1)
  (constant2  #x2)
  (constant4  #x3)
  (conaddr1   #x5)
  (conaddr2   #x6)
  (conaddr4   #x7)
  (stack0     #x8) ;; push or pop
  (local1     #x9)
  (local2     #xa)
  (local4     #xb)
  (ram1       #xd)
  (ram2       #xe)
  (ram4       #xf)
  )

(make-enum opcode
  (nop            #x00)
  (add            #x10)
  (sub            #x11)
  (mul            #x12)
  (div            #x13)
  (mod            #x14)
  (neg            #x15)
  (bitand         #x18)
  (bitor          #x19)
  (bitxor         #x1A)
  (bitnot         #x1B)
  (shiftl         #x1C)
  (sshiftr        #x1D)
  (ushiftr        #x1E)
  (jump           #x20)
  (jz             #x22)
  (jnz            #x23)
  (jeq            #x24)
  (jne            #x25)
  (jlt            #x26)
  (jge            #x27)
  (jgt            #x28)
  (jle            #x29)
  (jltu           #x2A)
  (jgeu           #x2B)
  (jgtu           #x2C)
  (jleu           #x2D)
  (call           #x30)
  (return         #x31)
  (catch          #x32)
  (throw          #x33)
  (tailcall       #x34)
  (copy           #x40)
  (copys          #x41)
  (copyb          #x42)
  (sexs           #x44)
  (sexb           #x45)
  (aload          #x48)
  (aloads         #x49)
  (aloadb         #x4A)
  (aloadbit       #x4B)
  (astore         #x4C)
  (astores        #x4D)
  (astoreb        #x4E)
  (astorebit      #x4F)
  (stkcount       #x50)
  (stkpeek        #x51)
  (stkswap        #x52)
  (stkroll        #x53)
  (stkcopy        #x54)
  (streamchar     #x70)
  (streamnum      #x71)
  (streamstr      #x72)
  (streamunichar  #x73)
  (gestalt        #x100)
  (debugtrap      #x101)
  (getmemsize     #x102)
  (setmemsize     #x103)
  (jumpabs        #x104)
  (random         #x110)
  (setrandom      #x111)
  (quit           #x120)
  (verify         #x121)
  (restart        #x122)
  (save           #x123)
  (restore        #x124)
  (saveundo       #x125)
  (restoreundo    #x126)
  (protect        #x127)
  (hasundo        #x128)
  (discardundo    #x129)
  (glk            #x130)
  (getstringtbl   #x140)
  (setstringtbl   #x141)
  (getiosys       #x148)
  (setiosys       #x149)
  (linearsearch   #x150)
  (binarysearch   #x151)
  (linkedsearch   #x152)
  (callf          #x160)
  (callfi         #x161)
  (callfii        #x162)
  (callfiii       #x163)
  (mzero          #x170)
  (mcopy          #x171)
  (malloc         #x178)
  (mfree          #x179)
  (accelfunc      #x180)
  (accelparam     #x181)
  (numtof         #x190)
  (ftonumz        #x191)
  (ftonumn        #x192)
  (ceil           #x198)
  (floor          #x199)
  (fadd           #x1A0)
  (fsub           #x1A1)
  (fmul           #x1A2)
  (fdiv           #x1A3)
  (fmod           #x1A4)
  (sqrt           #x1A8)
  (exp            #x1A9)
  (log            #x1AA)
  (pow            #x1AB)
  (sin            #x1B0)
  (cos            #x1B1)
  (tan            #x1B2)
  (asin           #x1B3)
  (acos           #x1B4)
  (atan           #x1B5)
  (atan2          #x1B6)
  (jfeq           #x1C0)
  (jfne           #x1C1)
  (jflt           #x1C2)
  (jfle           #x1C3)
  (jfgt           #x1C4)
  (jfge           #x1C5)
  (jisnan         #x1C8)
  (jisinf         #x1C9)
  (numtod         #x200)
  (dtonumz        #x201)
  (dtonumn        #x202)
  (ftod           #x203)
  (dtof           #x204)
  (dceil          #x208)
  (dfloor         #x209)
  (dadd           #x210)
  (dsub           #x211)
  (dmul           #x212)
  (ddiv           #x213)
  (dmodr          #x214)
  (dmodq          #x215)
  (dsqrt          #x218)
  (dexp           #x219)
  (dlog           #x21A)
  (dpow           #x21B)
  (dsin           #x220)
  (dcos           #x221)
  (dtan           #x222)
  (dasin          #x223)
  (dacos          #x224)
  (datan          #x225)
  (datan2         #x226)
  (jdeq           #x230)
  (jdne           #x231)
  (jdlt           #x232)
  (jdle           #x233)
  (jdgt           #x234)
  (jdge           #x235)
  (jdisnan        #x238)
  (jdisinf        #x239)
  )

(define arity-table (make-vector #x240 0))

(datatype argmode
  (:load)
  (:store)
  )

(defmacro argmodes/make
  (argmodes/make) -> (list:nil)
  (argmodes/make <L> modes ...) -> (list:cons (argmode:load)  (argmodes/make modes ...))
  (argmodes/make <S> modes ...) -> (list:cons (argmode:store) (argmodes/make modes ...))
  )

(defmacro argmode-table/make
  (argmode-table/make)                      -> (tree:empty)
  (argmode-table/make (name modes ...) ...) -> (tree/make magic-cmp (((%%constructor opcode name)) (argmodes/make modes ...)) ...)
  )

(define opcode-table
  (argmode-table/make
   (nop)
   (add L L S)
   (sub L L S)
   (mul L L S)
   (div L L S)
   (mod L L S)
   (bitand L L S)
   (bitor L L S)
   (bitxor L L S)
   (shiftl L L S)
   (sshiftr L L S)
   (ushiftr L L S)
   (neg L S)
   (bitnot L S)
   (jump L)
   (jumpabs L)
   (jz L L)
   (jnz L L)
   (jeq L L L)
   (jne L L L)
   (jlt L L L)
   (jge L L L)
   (jgt L L L)
   (jle L L L)
   (jltu L L L)
   (jgeu L L L)
   (jgtu L L L)
   (jleu L L L)
   (call L L S)
   (return L)
   (catch S L)
   (throw L L)
   (tailcall L L)
   (sexb L S)
   (sexs L S)
   (copy L S)
   (copys L S)
   (copyb L S)
   (aload L L S)
   (aloads L L S)
   (aloadb L L S)
   (aloadbit L L S)
   (astore L L L)
   (astores L L L)
   (astoreb L L L)
   (astorebit L L L)
   (stkcount S)
   (stkpeek L S)
   (stkswap)
   (stkroll L L)
   (stkcopy L)
   (streamchar L)
   (streamunichar L)
   (streamnum L)
   (streamstr L)
   (getstringtbl L)
   (getiosys S S)
   (setiosys L L)
   (random L S)
   (setrandom L)
   (verify S)
   (restart)
   (save L S)
   (restore L S)
   (saveundo S)
   (restoreundo S)
   (hasundo S)
   (discardundo)
   (protect L L)
   (quit)
   (gestalt L L S)
   (debugtrap L)
   (getmemsize S)
   (setmemsize L S)
   (linearsearch L L L L L L L S)
   (binarysearch L L L L L L L S)
   (linkedsearch L L L L L L S)
   (glk L L S)
   (callf L S)
   (callfi L L S)
   (callfii L L L S)
   (callfiii L L L L S)
   (mzero L L)
   (mcopy L L L)
   (malloc L S)
   (mfree L)
   (accelfunc L L)
   (accelparam L L)
   ;; no float support
   ))

(define (opcode->argmodes op)
  (match (tree/member opcode-table magic-cmp op) with
    (maybe:yes modes) -> modes
    (maybe:no) -> (raise (:UnknownOpcode op))
    ))

(tree/inorder
 (lambda (k v)
   (set! arity-table[(opcode->int k)] (length v)))
 opcode-table)