bugfixes and cleanup; use tinyjort to bootstrap itself!

asm.jrt

@@ -56,7 +56,6 @@ array oparg2 3 cells allot
   target @ >r encode-op <r target @ = 
   if s" invalid argument types" operror then ; 
 : oparg-complete!
-  dbg" oparg-complete!"
   opargs-remaining @ dup if
     1 - dup opargs-remaining !
     if   arg2
@@ -237,7 +236,6 @@ var ignoreimm
 1 :op LOOP   0xe2 >short-jmp* ;
 1 :op JCXZ   0xe3 >short-jmp* ;
 1 :op JMP
-  dbg" JMP!"
   0xe9 >near-reljmp*
   0xeb >short-jmp*
   0xea >far-jmp*

build.bat

@@ -1,2 +1,2 @@
-minijort < tinyjort.jrt
+jort.com < tinyjort.jrt
 copy tinyjort.com jort.com

debug.jrt

@@ -1,3 +0,0 @@
-s" defs.jrt" loadfile
-dbg" debugging!"
-

tinyjort.jrt

@@ -14,8 +14,8 @@ dbg" assembling..."
   increment the instruction pointer.
 )
 
-JMP dbg" JMP" 9 @>
-dbg" first jmp"
+JMP 9 @>
+
 : NEXT 
   LODSW
   MOV BX AX
@@ -42,7 +42,7 @@ L: LATEST 0 w>t
 0x0f const BUCKETMASK
 
 : savelabel ( word -- )
-  dup type s" : " type
+  ( dup type s" : " type )
   here swap begin dup b@ dup while b, 1+ repeat b, drop lastlabel ! ;
 : DICTLIST ( word -- tptr ) b@ BUCKETMASK & cells [ L@ DICTIONARY lit ] + ;
 : strlen ( word -- len ) 0 swap begin dup b@ while swap 1+ swap 1+ repeat drop ;
@@ -52,7 +52,7 @@ L: LATEST 0 w>t
 : link>t ( tptr-head -- ) dup @t swap patch!t w>t ;
 : DEF target @ [ L@ LATEST lit ] !t
       word dup savelabel dup DICTLIST link>t dup strlen w>t str>t
-      target @ cell + .hex cr ;
+      ( target @ cell + .hex cr ) ;
 
 : WORD= ( word len tptr -- f ) 
   cell + dup b@t <rot != if 2drop 0 return then cell + ( word tword )
@@ -81,6 +81,7 @@ L: $$CONST
 L@ $$CONST CONST $DOCONST
 L@ DICTIONARY CONST dictionary
 L@ LATEST CONST &latest
+0 CONST 0 1 CONST 1
 
 L: $$VAR
   INC BX INC BX
@@ -116,7 +117,7 @@ L@ $$VAR CONST $DOVAR
   MOV @[ BP] SI
   INC BP INC BP
   INC BX INC BX
-  MOV SI BX
+  MOV SI @[ BX]
   INC BX INC BX PUSH BX
   NEXT
 
@@ -125,6 +126,8 @@ L@ $$VAR CONST $DOVAR
   PUSH AX
   NEXT
 
+:ASM noop NEXT
+
 ( some helpers for making manually defining colon words less ugly )
 : '>t t' w>t ;
 
@@ -523,10 +526,9 @@ dbg" i/o"
 
 -1 CONST EOF
 0 VAR, fbuffer
-: skip>t 1+ cells target @ + w>t ;
 :t fgetc ( fp -- c )
   1 fbuffer <rot fread fbuffer ub@
-  fcount @ not BZ_ [ 2 skip>t ] drop EOF ;
+  fcount @ not BZ_ [ patchpt ] drop EOF [ patch!t ] ;
 :t fputc ( c fp -- ) swap fbuffer b! 1 fbuffer <rot fwrite ;
 
 :ASM console-emit
@@ -559,7 +561,7 @@ t& inbuf VAR, inptr
 
 0 VAR, infile ( 0 is a predefined file handle meaning stdin )
 :t stdin-key 
-   buf-key dup BZ_ [ 1 skip>t ] return drop
+   buf-key dup BZ_ [ patchpt ] return [ patch!t ] drop
    ( if buffer is empty, refresh from file )
    INBUFSIZE inbuf 0 fread
    ( if there's any more data, start returning it )
@@ -728,7 +730,7 @@ L: write-next-digit
   0 [ target @ ] drop key dup whitespace? not BZ_ [ w>t ]
   ( consume non-whitespace / eoi characters )
   [ target @ ] dup whitespace? over eoi? or
-  ( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return
+  ( if whitespace or eoi, end ) BZ_ [ patchpt ] drop 0 b, return [ patch!t ]
   ( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ;
 ARRAY wordbuf 48 ALLOT
 :t redir-, ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
@@ -751,8 +753,8 @@ dbg" compiler"
    ( link bucket to new ) latest swap ! ;
 :t 2inc ( x y -- x+1 y+1 ) 1+ swap 1+ swap ;
 :t strlen ( name -- len )
-   0 swap [ target @ ] dup b@ BZ_ [ 3 skip>t ]
-   2inc GOTO_ [ w>t ] drop ;
+   0 swap [ target @ ] dup b@ BZ_ [ patchpt ]
+   2inc GOTO_ [ swap w>t patch!t ] drop ;
 
 :ASM dict-lookup ( name dict -- cp meta | name 0 )
   MOV AX DS
@@ -828,13 +830,31 @@ L: check-next-entry
 :t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ;
 
 DEFERRED err ?err
+:ASM sp+ss
+  PUSH SP
+  PUSH SS
+  NEXT
+
+:ASM underflow?
+  CMP SP 0x100 #
+  JLE 0 @>
+  MOV SP 0x100 #
+  PUSH TRUE
+  NEXT
+0 <:
+  PUSH FALSE
+  NEXT
+
+:t checkstack underflow? BZ_ [ patchpt ] 
+   INLINEDATA_ [ patchpt t" underflow!" patch!t ] type cr [ patch!t ] ;
 :t compileword ( word -- )
   lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] 
   drop number BZ_ [ patchpt ] interpretnumber return [ patch!t ]
   err ;
 :t interpreter 
-  [ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ]
-  [ patch!t ] drop ;
+  [ target @ ] noop ( f28 ) word noop ( f2c ) dup b@ BZ_ 
+  [ patchpt ] noop ( f36 ) compileword checkstack 
+  GOTO_ [ swap w>t patch!t ] noop ( f40 ) drop ;
 
 dbg" flow control words and misc."
 :t if LIT_ BZ_ , here 0 , ; IMMEDIATE
@@ -857,7 +877,7 @@ dbg" flow control words and misc."
 :t |; LIT_ return , |inline ; IMMEDIATE
 
 :t s", [ target @ ] key dup LIT_ [ key " w>t ] != over 0 != and
-       BZ_ [ 3 skip>t ] b, GOTO_ [ w>t ]
+       BZ_ [ patchpt ] b, GOTO_ [ swap w>t patch!t ]
        drop 0 b, ;
 :t s" state BZ_ [ patchpt ] inline| s", |inline return [ patch!t ]
     LIT_ s", tmp-, ; IMMEDIATE
@@ -871,22 +891,15 @@ dbg" flow control words and misc."
   <r infile ! ;
 :t loadfile ( filename -- ) open loadfp close ;
 
-:t noop ;
 :t defer new-word $DODEFERRED , LIT_ noop , ;
 :t redefine ( cp cpdeferred ) cell + ! ;
 :t definition ( cpdeferred ) cell + @ ;
 
-:ASM sp+ss
-  PUSH SP
-  PUSH SS
-  NEXT
-
 :t .s sp+ss swap >r 0x100 [ target @ ] 2 - dup r@ < BZ_ 
-      ( past top of stack ) [ 4 skip>t ] drop drop rdrop return
+      ( past top of stack ) [ patchpt ] drop drop rdrop return [ patch!t ]
       2dup swap @far . GOTO_ [ w>t ] ;
 
 dbg" boot stub"
-:ASM debug NEXT
 :t tinyjort interpreter terminate ;
 
 9 <: ( actual entry point )