diff --git a/asm.jrt b/asm.jrt index 21f8f51..b0f5b1f 100755 --- a/asm.jrt +++ b/asm.jrt @@ -56,6 +56,7 @@ array oparg2 3 cells allot target @ >r encode-op 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* ; diff --git a/boot.jor b/boot.jor index a63697f..5d0076d 100755 --- a/boot.jor +++ b/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 diff --git a/build.bat b/build.bat index 7e9a847..1e0a872 100755 --- a/build.bat +++ b/build.bat @@ -1,3 +1,2 @@ minijort < tinyjort.jrt - - +copy tinyjort.com jort.com diff --git a/debug.jrt b/debug.jrt new file mode 100755 index 0000000..b3000f2 --- /dev/null +++ b/debug.jrt @@ -0,0 +1,3 @@ +s" defs.jrt" loadfile +dbg" debugging!" + diff --git a/defs.jrt b/defs.jrt index f0737f0..f3c74d2 100755 --- a/defs.jrt +++ b/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 ; diff --git a/jort.com b/jort.com new file mode 100755 index 0000000..5075528 Binary files /dev/null and b/jort.com differ diff --git a/tinyjort.com b/tinyjort.com index 3eb0a75..5075528 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index c762f83..e2933f4 100755 --- a/tinyjort.jrt +++ b/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 ; -: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t 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 ; +: 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 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 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 in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ; -DEFERRED key in-key +:t stdin-key + buf-key dup BZ_ [ 1 skip>t ] return drop + ( 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 @ ] - dup b@ dup BZ_ [ 6 skip>t ] - emit 1 + GOTO_ [ w>t ] - drop drop ; -:t . num>str type LIT_ [ key w>t ] emit ; +:t . num>str type bl ; :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 dup >r here! execute 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 ?err ( word -- ) type LIT_ [ key ? w>t ] emit 13 emit ; +:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ; +: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 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 )