Apple /// JIT WIP

src/inc/cmdsys.plh

@@ -55,7 +55,8 @@ import cmdsys
         byte jitsize
         byte refcons    // Apple /// specific
         byte devcons    // Apple /// specific
-        byte cmdparser
+        word jitc
+        word cmdparser
     end
     //
     // CMD exported functions

src/toolsrc/parse.c

@@ -1540,11 +1540,16 @@ int parse_defs(void)
     char c, *idstr;
     int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype;
     static char bytecode = 0;
-    if (scantoken == EXPORT_TOKEN)
+
+    switch (scantoken)
     {
-        if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN)
+        case CONST_TOKEN:
-            parse_error("Bad export definition");
+        case STRUC_TOKEN:
-        type = EXPORT_TYPE;
+            return parse_vars(GLOBAL_TYPE);
+        case EXPORT_TOKEN:
+            if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN)
+                parse_error("Bad export definition");
+            type = EXPORT_TYPE;
     }
     if (scantoken == DEF_TOKEN)
     {

src/toolsrc/parse.pla

@@ -1220,65 +1220,68 @@ def parse_defs
     word type, idstr, func_tag, idptr
 
     type = FUNC_TYPE
-    if token == EXPORT_TKN
+    when token
-        if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
+        is CONST_TKN
-        type = type | EXPORT_TYPE
+        is STRUC_TKN
-    fin
+            return parse_vars(GLOBAL_TYPE)
-    if token == DEF_TKN
+        is EXPORT_TKN
-        if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin
+            if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
-        lambda_cnt = 0
+            type = type | EXPORT_TYPE
-        cfnparms   = 0
+        is DEF_TKN
-        infuncvals = 1
+            if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin
-        infunc     = TRUE
+            lambda_cnt = 0
-        idstr      = tknptr
+            cfnparms   = 0
-        idlen      = tknlen
+            infuncvals = 1
-        init_idlocal
+            infunc     = TRUE
-        if scan == OPEN_PAREN_TKN
+            idstr      = tknptr
-            repeat
+            idlen      = tknlen
-                if scan == ID_TKN
+            init_idlocal
-                    cfnparms++
+            if scan == OPEN_PAREN_TKN
-                    new_idlocal(tknptr, tknlen, WORD_TYPE, 2)
+                repeat
-                    scan
+                    if scan == ID_TKN
-                fin
+                        cfnparms++
-            until token <> COMMA_TKN
+                        new_idlocal(tknptr, tknlen, WORD_TYPE, 2)
-            if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin
+                        scan
+                    fin
+                until token <> COMMA_TKN
+                if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin
+                scan
+            fin
+            if token == POUND_TKN
+                if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin
+                scan
+            fin
+            idptr = lookup_idglobal(idstr, idlen)
+            if idptr
+                if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin
+                if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin
+                func_tag = idptr=>idval
+                idptr=>idtype = idptr=>idtype | type
+            else
+                func_tag = new_tag(WORD_FIXUP)
+                new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals)
+            fin
+            emit_tag(func_tag)
+            new_dfd(func_tag)
+            while parse_vars(LOCAL_TYPE); nextln; loop
+            emit_enter(cfnparms)
+            prevstmnt = 0
+            while parse_stmnt; nextln; loop
+            infunc = FALSE
+            if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
             scan
-        fin
+            if prevstmnt <> RETURN_TKN
-        if token == POUND_TKN
+                if infuncvals; parse_warn("No return values"); fin
-            if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin
+                for cfnvals = infuncvals - 1 downto 0
-            scan
+                    emit_const(0)
-        fin
+                next
-        idptr = lookup_idglobal(idstr, idlen)
+                emit_leave
-        if idptr
+            fin
-            if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin
+            for cfnvals = 0 to lambda_cnt-1
-            if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin
+                emit_lambdafunc(lambda_tag[cfnvals], lambda_cparms[cfnvals], lambda_seq[cfnvals])
-            func_tag = idptr=>idval
+                new_dfd(lambda_tag[cfnvals])
-            idptr=>idtype = idptr=>idtype | type
-        else
-            func_tag = new_tag(WORD_FIXUP)
-            new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals)
-        fin
-        emit_tag(func_tag)
-        new_dfd(func_tag)
-        while parse_vars(LOCAL_TYPE); nextln; loop
-        emit_enter(cfnparms)
-        prevstmnt = 0
-        while parse_stmnt; nextln; loop
-        infunc = FALSE
-        if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
-        scan
-        if prevstmnt <> RETURN_TKN
-            if infuncvals; parse_warn("No return values"); fin
-            for cfnvals = infuncvals - 1 downto 0
-                emit_const(0)
             next
-            emit_leave
+    wend
-        fin
-        for cfnvals = 0 to lambda_cnt-1
-            emit_lambdafunc(lambda_tag[cfnvals], lambda_cparms[cfnvals], lambda_seq[cfnvals])
-            new_dfd(lambda_tag[cfnvals])
-        next
-    fin
     return token == EOL_TKN ?? TRUE :: FALSE
 end
 def parse_module#0

src/vmsrc/apple/plvm03.s

@@ -150,6 +150,7 @@ OPTBL   !WORD   CN,CN,CN,CN,CN,CN,CN,CN                                 ; 00 02
         !WORD   NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW                      ; 90 92 94 96 98 9A 9C 9E
         !WORD   BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR    ; A0 A2 A4 A6 A8 AA AC AE
         !WORD   ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW         ; B0 B2 B4 B6 B8 BA BC BE
+        !WORD   NATV                                                    ; C0
 ;*
 ;* SYSTEM INTERPRETER ENTRYPOINT
 ;*
@@ -182,6 +183,55 @@ XINTERP PLA
         DEY
         JMP     FETCHOP
 ;*
+;* JIT PROFILING ENTRY INTO INTERPRETER
+;*
+JITINTRP PLA
+        SEC
+        SBC     #$02            ; POINT TO DEF ENTRY
+        STA     TMPL
+        PLA
+        SBC     #$00
+        STA     TMPH
+        LDY     #$05
+        LDA     (TMP),Y         ; DEC JIT COUNT
+        SEC
+        SBC     #$01
+        STA     (TMP),Y
+        BEQ     RUNJIT
+        DEY                     ; INTERP BYTECODE AS USUAL
+        LDA     (TMP),Y
+        STA     IPH
+        DEY
+        LDA     (TMP),Y
+        STA     IPL
+        LDY     #$00
+        JMP     FETCHOP
+RUNJIT  LDA     JITCOMP
+        STA     SRCL
+        LDA     JITCOMP+1
+        STA     SRCH
+        DEY                     ; LDY     #$04
+        LDA     (SRC),Y
+        STA     IPH
+        DEY
+        LDA     (SRC),Y
+        STA     IPL
+        DEX                     ; ADD PARAMETER TO DEF ENTRY
+        LDA     TMPL
+        PHA                     ; AND SAVE IT FOR LATER
+        STA     ESTKL,X
+        LDA     TMPH
+        PHA
+        STA     ESTKH,X
+        LDY     #$00
+        JSR     FETCHOP         ; CALL JIT COMPILER
+        PLA
+        STA     TMPH
+        PLA
+        STA     TMPL
+        JMP     JMPTMP          ; RE-CALL ORIGINAL DEF ENTRY
+JITCOMP !WORD   0
+;*
 ;* INTERNAL DIVIDE ALGORITHM
 ;*
 _NEG    LDA     #$00
@@ -1369,6 +1419,17 @@ LEAVE   INY                     ;+INC_IP
         PLA
         STA     IFPH
 RET     RTS
+;*
+;* RETURN TO NATIVE CODE
+;*
+NATV    TYA                     ; FLATTEN IP
+        SEC
+        ADC     IPL
+        STA     TMPL
+        LDA     #$00
+        ADC     IPH
+        STA     TMPH
+        JMP     JMPTMP
 SOSCMD  =       *
         !SOURCE "vmsrc/apple/sossys.a"
 }

src/vmsrc/apple/soscmd.pla

@@ -1,5 +1,78 @@
 include "inc/cmdsys.plh"
 //
+// JIT compiler values
+//
+//
+// Indirect interpreter DEFinition entrypoint
+//
+struc t_defentry
+    byte interpjsr
+    word interpaddr
+    word bytecodeaddr
+    byte bytecodexbyte
+    byte callcount
+    byte bytecodesize
+end
+//
+// JIT compiler constants
+//
+const jitcomp     = $03E2
+const codemax     = $A000
+//
+// AUX bytecode interpreter entrypoint
+//
+word jitcodeptr
+word codeptr
+word interpentry
+//
+// COPY FROM EXT MEM TO MAIN MEM.
+//
+// XMEMCPY(DST, XSRC, SIZE)
+//
+asm defcpy(dst,defentry)#0
+        !SOURCE "vmsrc/plvmzp.inc"
+XPAGE   =       $1600
+SRCX    =       XPAGE+SRCH
+DSTX    =       XPAGE+DSTH
+
+//asm memxcpy(dst,src,size)#0
+        LDA     ESTKL,X
+        ORA     ESTKH,X
+        BEQ     CPYXMEX
+        LDY     #$00
+        STY     DSTL
+        LDA     ESTKH+2,X
+        CLC
+        ADC     #$60
+        STA     DSTH
+        LDA     ESTKL+2,X
+        CLC
+        ADC     #$7F
+        STA     DSTX
+        LDA     ESTKL+1,X
+        STA     SRCL
+        LDA     ESTKH+1,X
+        STA     SRCH
+        INC     ESTKH,X
+CPYXLP  LDA     (SRC),Y
+        STA     (DST),Y
+        INY
+        BNE     +
+        INC     DSTH
+        INC     SRCH
++       DEC     ESTKL,X
+        BNE     CPYXLP
+        DEC     ESTKH,X
+        BNE     CPYXLP
+        LDA     #$00
+        STA     DSTX
+CPYXMEX INX
+        INX
+        INX
+        RTS
+end
+include "libsrc/jitcore.pla"
+//
 // SOS routines
 // FILE I/O
 //
@@ -240,4 +313,8 @@ end
 // Save pointer to command line handler
 //
 cmdsys:cmdparser = @shell
+//
+// Install JIT compiler
+//
+cmdsys:jitc = @compiler
 done

src/vmsrc/apple/sossys.pla

@@ -34,10 +34,11 @@ word syspath
 word cmdlnptr
 word              = @execmod, @open, @close, @read, @write
 byte perr
-byte jitcount     = $10
+byte jitcount     = 45
-byte jitsize      = $FF
+byte jitsize      = 96
 byte refcons      = 0
 byte devcons      = 0
+word jitcomp      = 0
 word cmdparser
 //
 // String pool.