cleanup, flow control immediate words

asm.jrt

@@ -56,6 +56,7 @@ 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
@@ -236,6 +237,7 @@ 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*
@@ -311,7 +313,9 @@ var ignoreimm
     0 0xc6 >extbmem*
     0 0xc7 >extmem*
   then
-  oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then ;
+  oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then 
+  arg2 oparg-segreg? if oparg-val @ 0x8c arg1 >extwreg|mem* then ;
+
 2 :op ADD 0x00 >6group-math* 0 >grp1* ;
 2 :op ADC 0x10 >6group-math* 2 >grp1* ;
 2 :op AND 0x20 >6group-math* 4 >grp1* ;

boot.jor

@@ -1,5 +1,8 @@
 0 const 0
 1 const 1
+: 1+ 1 + ;
+: 1- 1 - ;
+
 2 const cell
 : cells cell * ;
 
@@ -7,11 +10,11 @@
 13 const '\r'
 key  const sp
 
-0x100 const F_IMMEDIATE
-
 : cr '\n' emit ;
 : bl sp emit ;
 
+0x100 const F_IMMEDIATE
+
 : if ' BZ_ , here 0 , ; immediate
 : else ' GOTO_ , 0 , here swap ! here cell - ; immediate
 : then here swap ! ; immediate

build.bat

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

debug.jrt

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

defs.jrt

@@ -58,8 +58,6 @@
 : break rswap rdrop :| yield done |; execute rswap ;
 
 : links begin yield @ dup not until drop ;done
-: files findfile begin dup while yield nextfile repeat drop ;done
-: .files files each type s"  " type more ;
 
 : min ( x y -- x|y ) 2dup > if swap then drop ;
 : max ( x y -- x|y ) 2dup < if swap then drop ;
@@ -83,5 +81,5 @@
   dup 0 >= over 9 <= and if [ key 0 lit ] 
   else 10 - [ key A lit ] then + emit ;
 : .bhex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ;
-: .hex dup 0xf000 & 12 >> .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ;
+: .hex dup 0xf000 & 12 >> 0x0f & .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ;
 

tinyjort.jrt

@@ -14,8 +14,8 @@ dbg" assembling..."
   increment the instruction pointer.
 )
 
-JMP 9 @>
+JMP dbg" JMP" 9 @>
-
+dbg" first jmp"
 : NEXT 
   LODSW
   MOV BX AX
@@ -43,10 +43,11 @@ L: LATEST 0 w>t
 
 : savelabel ( word -- )
   dup type s" : " type
-  here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ;
+  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 ;
+: strlen ( word -- len ) 0 swap begin dup b@ while swap 1+ swap 1+ repeat drop ;
-: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ;
+: str>t ( word -- ) begin dup b@ dup while >t 1+ repeat >t drop ;
+: patchpt ( -- tptr ) target @ 0 w>t ;
 : patch!t ( tptr -- ) target @ swap !t ;
 : link>t ( tptr-head -- ) dup @t swap patch!t w>t ;
 : DEF target @ [ L@ LATEST lit ] !t
@@ -57,7 +58,7 @@ L: LATEST 0 w>t
   cell + dup b@t <rot != if 2drop 0 return then cell + ( word tword )
   begin over b@ over b@t = while
     over b@ not if 2drop 1 return then ( 0 byte, matched )
-    1 + swap 1 + swap
+    1+ swap 1+ swap
   repeat 2drop 0 ;
 : tlookup ( word -- tcp )
   dup strlen over DICTLIST ( word len tptr-next-entry )
@@ -111,6 +112,14 @@ L@ $$VAR CONST $DOVAR
   MOV BX @[ BX]
   JMP @[ BX]
 
+:CP $DOCREATE
+  MOV @[ BP] SI
+  INC BP INC BP
+  INC BX INC BX
+  MOV SI BX
+  INC BX INC BX PUSH BX
+  NEXT
+
 :ASM LIT_
   LODSW
   PUSH AX
@@ -236,12 +245,20 @@ dbg" math"
   PUSH AX
   NEXT
 
+:ASM 1+
+  POP AX INC AX PUSH AX
+  NEXT
+
 :ASM -
   POP BX POP AX 
   SUB AX BX
   PUSH AX
   NEXT
 
+:ASM 1-
+  POP AX DEC AX PUSH AX
+  NEXT
+
 :ASM *
   POP BX POP AX 
   IMUL BX
@@ -260,7 +277,7 @@ L: RETFALSE
 
 :ASM not
   POP AX
-  CMP AX 0 #
+  OR AX AX
   JZ RETTRUE
   JMP RETFALSE
 
@@ -274,23 +291,23 @@ L: RETFALSE
 :ASM <
   POP AX
   POP BX
-  CMP AX BX
+  CMP BX AX
   JL RETTRUE
   JMP RETFALSE
 
 :ASM >
   POP AX
   POP BX
-  CMP AX BX
+  CMP BX AX
   JG RETTRUE
   JMP RETFALSE
 
 :ASM and
   POP AX
   POP BX
-  CMP AX 0 #
+  OR AX AX
   JZ RETFALSE
-  CMP BX 0 #
+  OR BX BX
   JZ RETFALSE
   JMP RETTRUE
 
@@ -393,6 +410,13 @@ dbg" mem"
   MOV @[ ES: BX] AL
   NEXT
 
+:ASM +!
+  POP BX
+  POP AX
+  ADD AX @[ BX]
+  MOV @[ BX] AX
+  NEXT
+
 dbg" return stack"
 :ASM >r
   POP @[ BP]
@@ -453,6 +477,7 @@ dbg" allocation"
 :t allot here + here! ;
 :t , here ! cell allot ;
 :t b, here b! 1 allot ;
+: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
 
 dbg" i/o"
 :ASM overwrite
@@ -498,7 +523,7 @@ dbg" i/o"
 
 -1 CONST EOF
 0 VAR, fbuffer
-: skip>t 1 + cells target @ + w>t ;
+: 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 ;
@@ -511,6 +536,14 @@ dbg" i/o"
   NEXT
 DEFERRED emit console-emit
 
+:t cr 10 emit 13 emit ;
+:t bl LIT_ [ key  w>t ] emit ;
+
+:t type 
+   [ target @ ] dup b@ dup BZ_ [ patchpt ] 
+   emit 1+ GOTO_ [ swap w>t patch!t ]
+   drop drop ;
+
 :ASM console-key
   MOV AH 8 #
   INT 0x21 #
@@ -518,10 +551,23 @@ DEFERRED emit console-emit
   PUSH AX
   NEXT
 
+127 const INBUFSIZE
+INBUFSIZE CONST INBUFSIZE
+ARRAY inbuf INBUFSIZE 1+ ALLOT
+t& inbuf VAR, inptr
+:t buf-key inptr @ b@ dup BZ_ [ patchpt ] inptr @ 1+ inptr ! [ patch!t ] ;
+
 0 VAR, infile ( 0 is a predefined file handle meaning stdin )
-( TODO: whoops, this always calls fgetc, which works way better )
+:t stdin-key 
-:t in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ;
+   buf-key dup BZ_ [ 1 skip>t ] return drop
-DEFERRED key in-key
+   ( if buffer is empty, refresh from file )
+   INBUFSIZE inbuf 0 fread
+   ( if there's any more data, start returning it )
+   fcount @ dup BZ_ [ patchpt ] inbuf + 0 swap b! inbuf inptr ! buf-key return
+   ( otherwise, EOF ) [ patch!t ] drop EOF ;
+:t file-key infile @ dup BZ_ [ patchpt ] fgetc return 
+   [ patch!t ] drop stdin-key ;
+DEFERRED key file-key
 
 dbg" parsing"
 L: BASE 10 w>t L: ISNEG? 0 >t
@@ -546,7 +592,7 @@ L: next-digit
   MOV BL AL
   LODSB
   XCHG AL BL
-  CMP BL 0 #
+  OR BL BL
   JZ 1 @> ( string end )
   JCXZ 3 @> ( starts with negative? )
 L: parse-digit
@@ -587,7 +633,7 @@ L: fail-digit 0 <:
   JNZ 0 @>
   CMP CX 1 # ( x is second character )
   JNZ 1 @>
-  CMP AX 0 # ( first character was a 0 ) 
+  OR AX AX ( first character was a 0 ) 
   JNZ 2 @>
   MOV BASE 16 #
   JMP next-digit
@@ -597,7 +643,7 @@ L: fail-digit 0 <:
   ADD BL 10 #
   CMP BL BASE
   JL parsed-digit
-  SUB BL key a key A - 10 - #
+  SUB BL key a key A - 10 + #
   JL fail-digit
   ADD BL 10 #
   CMP BL BASE
@@ -607,9 +653,11 @@ L: fail-digit 0 <:
 L: DECDIVISORS 1 w>t 10 w>t 100 w>t 1000 w>t 10000 w>t
 L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
 :ASM num>str
+  MOV AX DS
+  MOV ES AX
   MOV DI L@ NUMBUF #
   POP AX
-  CMP AX 0 #
+  OR AX AX
   JGE 0 @>
   MOV BYTE @[ DI] key - #
   NEG AX
@@ -622,7 +670,7 @@ L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
 L: write-next-digit
   XOR DX DX
   IDIV @[ BX+SI]
-  CMP AX 0 #
+  OR AX AX
   JNZ 1 @>
   JCXZ 0 @> ( unconditionally write a zero )
   DEC CX ( if we haven't written any digits this will hit 0 on the ones place )
@@ -643,11 +691,7 @@ L: write-next-digit
   PUSH DI
   NEXT
 
-:t type [ target @ ]
+:t . num>str type bl ;
-   dup b@ dup BZ_ [ 6 skip>t ] 
-   emit 1 + GOTO_ [ w>t ]
-   drop drop ;
-:t . num>str type LIT_ [ key  w>t ] emit ;
 
 :ASM whitespace?
   POP AX
@@ -668,7 +712,7 @@ L: write-next-digit
 
 :ASM eoi? ( end of input )
   POP AX
-  CMP AX 0 # ( null )
+  OR AX AX ( null )
   JZ 0 @>
   CMP AX -1 # ( EOF )
   JNZ 1 @>
@@ -687,31 +731,32 @@ L: write-next-digit
   ( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return
   ( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ;
 ARRAY wordbuf 48 ALLOT
-:t redir-here ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
+:t redir-, ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
-:t word LIT_ word, wordbuf redir-here ;
+:t tmp-, ( cp -- buf ) here redir-, ;
+:t word LIT_ word, wordbuf redir-, ;
 
 dbg" compiler"
 :t wordflags cell + ;
 :t wordname 2 cells + ;
 :t wordlen wordflags ub@ ;
-:t codepointer dup wordname swap wordlen + ( trailing null ) 1 + ;
+:t codepointer dup wordname swap wordlen + ( trailing null ) 1+ ;
 :t dictbucket ( word -- p ) ub@ LIT_ [ BUCKETMASK w>t ] & cells dictionary + ;
 :t new-word
    ( set latest ) here latest!
    ( create entry ) 0 dup , ,
-   ( save word + calc length ) here word, here swap -
+   ( save word + calc length ) here word, here swap - 1- ( ignore null )
    ( save length ) latest wordflags !
    ( find bucket ) latest wordname dictbucket
    ( link to prev ) dup @ latest !
    ( link bucket to new ) latest swap ! ;
-:t 2inc ( x y -- x+1 y+1 ) 1 + swap 1 + 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 ;
 
-: patchpt target @ 0 w>t ;
-
 :ASM dict-lookup ( name dict -- cp meta | name 0 )
+  MOV AX DS
+  MOV ES AX
   POP BX ( dictionary )
   POP DI ( name )
   ( strlen - in DI: str, out CX: len, clobbers AX )
@@ -733,7 +778,7 @@ dbg" compiler"
 
 L: check-next-entry
   MOV BX @[ BX]
-  CMP BX 0 #
+  OR BX BX
   JZ 0 @>
   CMP CL @[ 2 @+ BX]
   JNZ check-next-entry
@@ -779,8 +824,9 @@ L: check-next-entry
 :t var new-word $DOVAR , 0 , ;
 :t interpretword ( cp meta -- ) F_IMMEDIATE & state not or
    BZ_ [ patchpt ] execute return [ patch!t ] , ;
-:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ , , [ patch!t ] ;
+:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ;
-:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit 13 emit ;
+:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ;
+
 DEFERRED err ?err
 :t compileword ( word -- )
   lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] 
@@ -790,13 +836,57 @@ DEFERRED err ?err
   [ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ]
   [ patch!t ] drop ;
 
+dbg" flow control words and misc."
+:t if LIT_ BZ_ , here 0 , ; IMMEDIATE
+:t else LIT_ GOTO_ , 0 , here swap ! here cell - ; IMMEDIATE
+:t then here swap ! ; IMMEDIATE
+
+:t begin here ; IMMEDIATE
+:t while LIT_ BZ_ , here 0 , ; IMMEDIATE
+:t repeat LIT_ GOTO_ , swap , here swap ! ; IMMEDIATE
+:t again LIT_ GOTO_ , , ; IMMEDIATE
+:t until LIT_ BZ_ , , ; IMMEDIATE
+
+:t lit LIT_ LIT_ , , ;
+:t ( [ target @ ] key LIT_ [ key ) w>t ] = BZ_ [ w>t ] ; IMMEDIATE
+
+:t inline| LIT_ INLINEDATA_ , here 0 , ;
+:t |inline then ;
+
+:t :| inline| $DOCOLON , ; IMMEDIATE
+: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 ]
+       drop 0 b, ;
+:t s" state BZ_ [ patchpt ] inline| s", |inline return [ patch!t ]
+    LIT_ s", tmp-, ; IMMEDIATE
+:t ' word lookup drop state BZ_ [ patchpt ] lit return [ patch!t ] ; IMMEDIATE
+
+:t loadfp ( fp -- fp )
+  infile @ >r
+  infile !
+  interpreter
+  infile @
+  <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
+      2dup swap @far . GOTO_ [ w>t ] ;
+
 dbg" boot stub"
 :ASM debug NEXT
-: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
-ARRAY input t" 1 2 + ."
-t& input VAR, inptr
-:t keyinput inptr @ b@ dup . dup BZ_ [ patchpt ] inptr @ 1 + inptr ! [ patch!t ] ;
-( t' keyinput t& key !t )
 :t tinyjort interpreter terminate ;
 
 9 <: ( actual entry point )