diff --git a/asm.jrt b/asm.jrt index 229e564..b56b39b 100755 --- a/asm.jrt +++ b/asm.jrt @@ -1,14 +1,4 @@ -var target -0x100 target ! -segalloc const tseg - -: @t tseg @far ; -: b@t tseg b@far ; -: !t tseg !far ; -: b!t tseg b!far ; -: +target! ( bytes -- prevtarget ) target @ dup >rot + target ! ; -: >t 1 +target! b!t ; -: w>t 2 +target! !t ; +( REQUIRES: defs.jrt, target.jrt ) var op-encode var lastop var lastlabel @@ -53,7 +43,7 @@ array oparg2 3 cells allot : encode-op ( -- ) op-encode @ execute 0 op-encode ! ; : check-encoded ( -- ) - target @ >r encode-op r encode-op ( patchid -- ) 0x13 set-oparg! @] ; : <: ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ; -: L: here create wordname lastlabel ! target @ , does> @ @+ ; +: L: here create wordname lastlabel ! 0 , target here cell - ! does> @ @+ ; : L@ [ ' ' , ] 2 cells + @ ; +( label redefinition - allows predefining labels when writing inline + assembly in the 'here' arena. ) +: L! [ ' ' , ] 2 cells + target swap ! ; : memreg create , does> @ oparg-base ! oparg-complete! ; 0 memreg BX+SI] 1 memreg BX+DI] 2 memreg BP+SI] 3 memreg BP+DI] @@ -204,7 +197,7 @@ var ignoreimm oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then then ; -: diffaddr ( opsize -- diff ) oparg-val @ swap target @ + - ; +: diffaddr ( opsize -- diff ) oparg-val @ swap target + - ; : oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ; : >short-jmp* ( op -- ) oparg-nearaddr? if 2 diffaddr dup byteval? oparg-mempatch? or @@ -236,14 +229,14 @@ var ignoreimm 1 :op LOOP 0xe2 >short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JMP + farptr? if 0x05 0xff >extmem* then 0xe9 >near-reljmp* 0xeb >short-jmp* 0xea >far-jmp* - farptr? if 0x05 0xff >extmem* then 0x04 0xff >extwreg|mem* ; 1 :op CALL - 0xe8 >near-reljmp* farptr? if 0x03 0xff >extmem* then + 0xe8 >near-reljmp* 0x02 0xff >extwreg|mem* ; ( four opcodes laid out next to each other: diff --git a/assemble.com b/assemble.com new file mode 100755 index 0000000..0961549 Binary files /dev/null and b/assemble.com differ diff --git a/assemble.jrt b/assemble.jrt new file mode 100755 index 0000000..1373d40 --- /dev/null +++ b/assemble.jrt @@ -0,0 +1,13 @@ +s" defs.jrt" loadfile +s" target.jrt" loadfile +s" asm.jrt" loadfile + +:init segalloc ' comseg redefine ; + +: writecom ( filename -- ) + overwrite >r 0x100 + begin dup target < while dup b@t r@ fputc 1+ repeat + drop r here 0x100 - 0x100 r@ fwrite r infile ! @@ -66,3 +66,7 @@ key const sp : redefine ( cp cpdeferred ) cell + ! ; : definition ( cpdeferred ) cell + @ ; +( minijort implementations of words defined in assembly in tinyjort ) +: >rot r 2dup r@ >rot t ) +dbg" core" + +: :ASM DEF target 2 + w>t ; + +: NEXT + LODSW + MOV BX AX + JMP @[ BX] ; + +L: $$CONST + INC BX INC BX + PUSH @[ BX] + NEXT + +: CONST DEF [ L@ $$CONST lit ] w>t w>t ; + +L@ $$CONST CONST $DOCONST +0 CONST 0 1 CONST 1 + +L: $$VAR + INC BX INC BX + PUSH BX + NEXT + +: ARRAY DEF [ L@ $$VAR lit ] w>t ; +: VAR, ARRAY w>t ; + +( "codepointer words" that evaluate to a pointer to the assembly - + useful to define things like $DOCOLON. ) +: :CP ARRAY ; +L@ $$VAR CONST $DOVAR + +:CP $DOCOLON + MOV @[ BP] SI + INC BP INC BP + INC BX INC BX + MOV SI BX + NEXT + +:ASM return + DEC BP DEC BP + MOV SI @[ BP] + NEXT + +:CP $DODEFERRED + INC BX INC BX + 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 + NEXT + +:ASM noop NEXT + +: DEFERRED DEF [ t& $DODEFERRED lit ] w>t [ ' '>t , ] ; + +:ASM INLINEDATA_ + LODSW + PUSH SI + MOV SI AX + NEXT + + +:ASM BZ_ + POP CX + JCXZ 0 @> + LODSW + NEXT +L: GOTO_IMPL 0 <: + LODSW + MOV SI AX + NEXT + +DEF GOTO_ L@ GOTO_IMPL w>t + +:ASM drop + POP AX + NEXT + +:ASM dup + POP AX + PUSH AX + PUSH AX + NEXT + +:ASM 2dup + POP AX + POP BX + PUSH BX + PUSH AX + PUSH BX + PUSH AX + NEXT + +:ASM 3dup + POP AX + POP BX + POP CX + PUSH CX + PUSH BX + PUSH AX + PUSH CX + PUSH BX + PUSH AX + NEXT + +:ASM swap + POP AX + POP BX + PUSH AX + PUSH BX + NEXT + +:ASM over + ( this costs 1 extra byte but should save 20 clock cycles ) + MOV BX SP + PUSH @[ 2 @+ SS: BX] +( POP AX + POP BX + PUSH BX + PUSH AX + PUSH BX ) + NEXT + +:ASM rot + POP AX + POP BX + POP CX + PUSH AX + PUSH CX + PUSH BX + NEXT + +:ASM terminate + MOV AH 0x4c # + MOV AL 0 # ( todo: pop? ) + INT 0x21 # + +:ASM execute + POP BX + JMP @[ BX] + +dbg" return stack" +:ASM >r + POP @[ BP] + INC BP INC BP + NEXT + +:ASM rot r 2dup r@ >rot r >r 2dup r@ >rot rswap r@ >rot r r >rot rot ; : 2drop drop drop ; -: negate 0 swap - ; -: abs dup 0 < if negate then ; - -: ~ -1 ^ ; -: f! ( b v flag -- ) - >rot >r r@ @ >rot ( val flag b r: v ) - if | else ~ & then rot ! ; : expile state if , else execute then ; +: ['] word lookup drop , ; immediate : :noname here $DOCOLON , ] ; @@ -36,46 +17,7 @@ : does> here 4 cells + lit ' finishcreate , ' return , ] ; immediate -: +towards ( from to -- from+-1 ) - over > if 1 + else 1 - then ; - -: for ( from to -- ) - ' >r , [ ' begin , ] ( from r: to ) - ' dup , ' r@ , ' != , [ ' while , ] - ' >r , ; immediate ( r: to from ) -: i ' r@ , ; immediate -: next - ' r , 1 lit ' >r , ; immediate - -: yield rswap ; -: done rdrop 0 >r rswap ; -: ;done ' done , [ ' [ , ] ; immediate -: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate -: more ' yield , [ ' repeat , ] ' rdrop , ; immediate -: break rswap rdrop :| yield done |; execute rswap ; - -: links begin yield @ dup not until drop ;done - -: min ( x y -- x|y ) 2dup > if swap then drop ; -: max ( x y -- x|y ) 2dup < if swap then drop ; - -: +!pos ( n var -- ) dup @ r >r r@ +! @ ; - -: lazy here $DODEFERRED , ' noop , ; -: >lazy! latest codepointer swap redefine ; - -: dbg" [ ' s" , ] :| type bl .s cr |; expile ; immediate +: dbg" ['] s" :| type bl .s cr |; expile ; immediate : .hexnib ( x -- ) dup 0 >= over 9 <= and if [ key 0 lit ] diff --git a/game.jrt b/game.jrt new file mode 100755 index 0000000..44cee71 --- /dev/null +++ b/game.jrt @@ -0,0 +1,9 @@ +s" zipoff.jrt" loadfile +s" text.jrt" loadfile + +key fill-page +nextline nextline nextline +t" Hello, inline assembler!" draw-text nextline +t" What a lovely day it is!" draw-text + + diff --git a/jort.com b/jort.com index 8d5ea91..a690dda 100755 Binary files a/jort.com and b/jort.com differ diff --git a/logic.jrt b/logic.jrt new file mode 100755 index 0000000..a3e014d --- /dev/null +++ b/logic.jrt @@ -0,0 +1,190 @@ +dbg" math" +:ASM + + POP AX POP BX + ADD AX BX + 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 + PUSH AX + NEXT + +:ASM /mod ( n1 n2 -- quotient remainder ) + POP BX POP AX + XOR DX DX + IDIV BX + PUSH AX + PUSH DX + NEXT + +:t / /mod drop ; +:t % /mod swap drop ; + +dbg" comparisons" +L: TRUE 0xffff w>t +L: FALSE 0 w>t +L: RETTRUE + PUSH TRUE + NEXT +L: RETFALSE + PUSH FALSE + NEXT + +:ASM not + POP AX + OR AX AX + JZ RETTRUE + JMP RETFALSE + +:ASM = + POP AX + POP BX + CMP AX BX + JZ RETTRUE + JMP RETFALSE + +:ASM < + POP AX + POP BX + CMP BX AX + JL RETTRUE + JMP RETFALSE + +:ASM > + POP AX + POP BX + CMP BX AX + JG RETTRUE + JMP RETFALSE + +:ASM and + POP AX + POP BX + OR AX AX + JZ RETFALSE + OR BX BX + JZ RETFALSE + JMP RETTRUE + +:ASM or + POP AX + POP BX + OR AX BX + JZ RETFALSE + JMP RETTRUE + +:t != = not ; +:t <= > not ; +:t >= < not ; + +dbg" bitwise" +:ASM & + POP AX + POP BX + AND AX BX + PUSH AX + NEXT + +:ASM | + POP AX + POP BX + OR AX BX + PUSH AX + NEXT + +:ASM ^ + POP AX + POP BX + XOR AX BX + PUSH AX + NEXT + +:ASM << ( val count ) + POP CX + POP AX + SHL AX CL + PUSH AX + NEXT + +:ASM >> ( val count ) + POP CX + POP AX + SHR AX CL + PUSH AX + NEXT + +dbg" mem" +:ASM @ + POP BX + PUSH @[ BX] + NEXT + +:ASM b@ + POP BX + MOV AL @[ BX] + CBW + PUSH AX + NEXT + +:ASM ub@ + POP BX + MOV AL @[ BX] + XOR AH AH + PUSH AX + NEXT + +:ASM @far + POP ES POP BX + PUSH @[ ES: BX] + NEXT + +:ASM b@far + POP ES POP BX + MOV AL @[ ES: BX] + CBW + PUSH AX + NEXT + +:ASM ! + POP BX + POP @[ BX] + NEXT + +:ASM b! + POP BX POP AX + MOV @[ BX] AL + NEXT + +:ASM !far + POP ES POP BX + POP @[ ES: BX] + NEXT + +:ASM b!far + POP ES POP BX POP AX + MOV @[ ES: BX] AL + NEXT + +:ASM +! + POP BX + POP AX + ADD AX @[ BX] + MOV @[ BX] AX + NEXT + diff --git a/lookup.jrt b/lookup.jrt deleted file mode 100755 index 470c6c1..0000000 --- a/lookup.jrt +++ /dev/null @@ -1,14 +0,0 @@ -:t entry= ( name len entry -- f ) - dup wordname swap wordlen t ] - ( fail ) [ patch!t swap patch!t ] drop drop 0 return - ( success ) [ patch!t ] drop drop 1 ; - -:t lookup ( name -- cp meta | name 0 ) - dup strlen over dictbucket - [ target @ ] @ dup . dup BZ_ [ patchpt ] - 3dup entry= BZ_ [ swap w>t ] - ( entry found ) >rot drop drop dup codepointer swap wordflags @ return - ( end of list ) [ patch!t ] drop drop 0 ; diff --git a/reasm.bat b/reasm.bat new file mode 100755 index 0000000..c61f5f9 --- /dev/null +++ b/reasm.bat @@ -0,0 +1,2 @@ +assemble.com < tinyjort.jrt +tinyjort.com < assemble.jrt diff --git a/rebuild.bat b/rebuild.bat new file mode 100755 index 0000000..8b25df3 --- /dev/null +++ b/rebuild.bat @@ -0,0 +1,6 @@ +minijort.exe < tinyboot.jrt +copy tinyjort.com jort.com +jort < assemble.jrt +assemble < tinyjort.jrt +fc /b jort.com tinyjort.com + diff --git a/target.jrt b/target.jrt new file mode 100755 index 0000000..152ffd6 --- /dev/null +++ b/target.jrt @@ -0,0 +1,37 @@ +defer target +defer target! +defer @t +defer b@t +defer !t +defer b!t + +: asm-here + ' here ' target redefine + ' here! ' target! redefine + ' @ ' @t redefine + ' b@ ' b@t redefine + ' ! ' !t redefine + ' b! ' b!t redefine ; + +segalloc const comseg +var comaddr +0x100 comaddr ! + +: asm-com + :| comaddr @ |; ' target redefine + :| comaddr ! |; ' target! redefine + :| comseg @far |; ' @t redefine + :| comseg b@far |; ' b@t redefine + :| comseg !far |; ' !t redefine + :| comseg b!far |; ' b!t redefine ; + +: +target! ( bytes -- prevtarget ) target dup >rot + target! ; +: >t 1 +target! b!t ; +: w>t 2 +target! !t ; + +asm-com + +: ALLOT ( n -- ) begin dup while 1- 0 >t repeat drop ; +: patchpt ( -- tptr ) target 0 w>t ; +: patch!t ( tptr -- ) target swap !t ; + diff --git a/text.jrt b/text.jrt new file mode 100755 index 0000000..80e0e8e --- /dev/null +++ b/text.jrt @@ -0,0 +1,47 @@ +0 VAR, textpage +0x0f VAR, textpen + +80 const pagew +25 const pageh + +0xb800 CONST TEXTMEM +: PREP-TEXTCOPY + MOV ES t& TEXTMEM @+ + MOV AH textpen @+ + MOV DI textpage @+ ; + +:ASM fill-page ( char -- ) + POP AX + PREP-TEXTCOPY + MOV CX pagew pageh * # + REPZ STOSW + NEXT + +0 VAR, textpos +: textx textpos @ pagew % ; +: texty textpos @ pagew / ; +: textx! texty pagew * + textpos ! ; +: texty! pagew * textx + textpos ! ; +: nextline texty 1+ pagew * textpos ! ; + +: PREP-TEXTCOPY-XY + PREP-TEXTCOPY + ADD SI textpos @+ ; + +:ASM draw-text ( s -- ) + MOV BX SI + POP SI + PREP-TEXTCOPY-XY +L: draw-next-char + LODSB + OR AL AL + JZ 0 @> + STOSW + JMP draw-next-char +0 <: + SUB DI textpage @+ + INC DI + MOV textpos @+ DI + MOV SI BX + NEXT + diff --git a/tinyboot.jrt b/tinyboot.jrt new file mode 100755 index 0000000..e199054 --- /dev/null +++ b/tinyboot.jrt @@ -0,0 +1,8 @@ +s" defs.jrt" loadfile +dbg" loading target.jrt" +s" target.jrt" loadfile +dbg" loading asm.jrt" +s" asm.jrt" loadfile +dbg" loading tinyjort.jrt" +s" tinyjort.jrt" loadfile + diff --git a/tinyjort.com b/tinyjort.com index 8d5ea91..2164fff 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index d0cad17..d06bead 100755 --- a/tinyjort.jrt +++ b/tinyjort.jrt @@ -1,8 +1,5 @@ -s" defs.jrt" loadfile -dbg" loading asm.jrt" -s" asm.jrt" loadfile - dbg" assembling..." + ( tinyjort calling convention: SP - data stack pointer, grows down BP - return stack pointer, grows up @@ -16,11 +13,6 @@ dbg" assembling..." JMP 9 @> -: NEXT - LODSW - MOV BX AX - JMP @[ BX] ; - ( dictionary format: DICTIONARY - an array of 16 pointers to linked lists of entries. The dictlist for a given word is chosen by taking the @@ -34,12 +26,12 @@ JMP 9 @> NAME - bytes ending in \0 CODE POINTER - pointer to machine code routine ) -: ALLOT ( n -- ) 0 for 0 >t next ; - -L: DICTIONARY 0x10 cells ALLOT -L: LATEST 0 w>t - 0x0f const BUCKETMASK +BUCKETMASK 1+ cells const LATESTOFF +LATESTOFF cell + const DICTSIZE +L: DICTIONARY DICTSIZE ALLOT + +L@ DICTIONARY LATESTOFF + const &LATEST : savelabel ( word -- ) ( dup type s" : " type ) @@ -47,12 +39,10 @@ L: LATEST 0 w>t : 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 ; -: 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 +: DEF target &LATEST !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 t drop drop drop 0 ; : t' word tlookup ; : t& t' cell + ; - -: :ASM DEF target @ 2 + w>t ; - -dbg" core" - -L: $$CONST - INC BX INC BX - PUSH @[ BX] - NEXT - -: CONST DEF [ L@ $$CONST lit ] w>t w>t ; - -L@ $$CONST CONST $DOCONST -L@ DICTIONARY CONST dictionary -L@ LATEST CONST &latest -0 CONST 0 1 CONST 1 - -L: $$VAR - INC BX INC BX - PUSH BX - NEXT - -: ARRAY DEF [ L@ $$VAR lit ] w>t ; -: VAR, ARRAY w>t ; - -( "codepointer words" that evaluate to a pointer to the assembly - - useful to define things like $DOCOLON. ) -: :CP ARRAY ; -L@ $$VAR CONST $DOVAR - -:CP $DOCOLON - MOV @[ BP] SI - INC BP INC BP - INC BX INC BX - MOV SI BX - NEXT - -:ASM return - DEC BP DEC BP - MOV SI @[ BP] - NEXT - -:CP $DODEFERRED - INC BX INC BX - 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 - NEXT - -:ASM noop NEXT - -( some helpers for making manually defining colon words less ugly ) : '>t t' w>t ; +s" coredefs.jrt" loadfile + : stch? ( str -- f ) ' @ , key lit ' = , ; immediate ( DOES NOT SUPPORT ARBITRARY IMMEDIATE WORDS. Supports [], comments, ; and numeric literals ONLY. You must use [ for anything fancy. ) -: :t DEF [ t& $DOCOLON lit ] w>t ] +: compt begin word dup stch? ; not while state if dup stch? [ if drop [ ' [ , ] else dup stch? ( if drop [ ' ( , ] else dup tlookup dup if w>t drop else drop number if [ t' LIT_ lit ] w>t w>t else type s" ?" type cr then then then then else - compileword then + expileword then repeat drop [ t' return lit ] w>t [ ' [ , ] ; +: :t DEF [ t& $DOCOLON lit ] w>t ] compt ; -: DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ; +s" logic.jrt" loadfile -:ASM INLINEDATA_ - LODSW - PUSH SI - MOV SI AX - NEXT - -:ASM BZ_ - POP CX - JCXZ 0 @> - LODSW - NEXT -L: GOTO_IMPL 0 <: - LODSW - MOV SI AX - NEXT - -DEF GOTO_ L@ GOTO_IMPL w>t - -:ASM drop - POP AX - NEXT - -:ASM dup - POP AX - PUSH AX - PUSH AX - NEXT - -:ASM 2dup - POP AX - POP BX - PUSH BX - PUSH AX - PUSH BX - PUSH AX - NEXT - -:ASM 3dup - POP AX - POP BX - POP CX - PUSH CX - PUSH BX - PUSH AX - PUSH CX - PUSH BX - PUSH AX - NEXT - -:ASM swap - POP AX - POP BX - PUSH AX - PUSH BX - NEXT - -:ASM over - ( this costs 1 extra byte but should save 20 clock cycles ) - MOV BX SP - PUSH @[ 2 @+ SS: BX] -( POP AX - POP BX - PUSH BX - PUSH AX - PUSH BX ) - NEXT - -:ASM rot - POP AX - POP BX - POP CX - PUSH AX - PUSH CX - PUSH BX - NEXT - -:ASM terminate - MOV AH 0x4c # - MOV AL 0 # ( todo: pop? ) - INT 0x21 # - -:ASM execute - POP BX - JMP @[ BX] - -dbg" math" -:ASM + - POP AX POP BX - ADD AX BX - 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 - PUSH AX - NEXT - -dbg" comparisons" -L: TRUE 0xffff w>t -L: FALSE 0 w>t -L: RETTRUE - PUSH TRUE - NEXT -L: RETFALSE - PUSH FALSE - NEXT - -:ASM not - POP AX - OR AX AX - JZ RETTRUE - JMP RETFALSE - -:ASM = - POP AX - POP BX - CMP AX BX - JZ RETTRUE - JMP RETFALSE - -:ASM < - POP AX - POP BX - CMP BX AX - JL RETTRUE - JMP RETFALSE - -:ASM > - POP AX - POP BX - CMP BX AX - JG RETTRUE - JMP RETFALSE - -:ASM and - POP AX - POP BX - OR AX AX - JZ RETFALSE - OR BX BX - JZ RETFALSE - JMP RETTRUE - -:ASM or - POP AX - POP BX - OR AX BX - JZ RETFALSE - JMP RETTRUE - -:t != = not ; -:t <= > not ; -:t >= < not ; - -dbg" bitwise" -:ASM & - POP AX - POP BX - AND AX BX - PUSH AX - NEXT - -:ASM | - POP AX - POP BX - OR AX BX - PUSH AX - NEXT - -:ASM ^ - POP AX - POP BX - XOR AX BX - PUSH AX - NEXT - -:ASM << ( val count ) - POP CX - POP AX - SHL AX CL - PUSH AX - NEXT - -:ASM >> ( val count ) - POP CX - POP AX - SHR AX CL - PUSH AX - NEXT - -dbg" mem" -:ASM @ - POP BX - PUSH @[ BX] - NEXT - -:ASM b@ - POP BX - MOV AL @[ BX] - CBW - PUSH AX - NEXT - -:ASM ub@ - POP BX - MOV AL @[ BX] - XOR AH AH - PUSH AX - NEXT - -:ASM @far - POP ES POP BX - PUSH @[ ES: BX] - NEXT - -:ASM b@far - POP ES POP BX - MOV AL @[ ES: BX] - CBW - PUSH AX - NEXT - -:ASM ! - POP BX - POP @[ BX] - NEXT - -:ASM b! - POP BX POP AX - MOV @[ BX] AL - NEXT - -:ASM !far - POP ES POP BX - POP @[ ES: BX] - NEXT - -:ASM b!far - POP ES POP BX POP AX - MOV @[ ES: BX] AL - NEXT - -:ASM +! - POP BX - POP AX - ADD AX @[ BX] - MOV @[ BX] AX - NEXT - -dbg" return stack" -:ASM >r - POP @[ BP] - INC BP INC BP - NEXT - -:ASM is broken -L: ASMEXEC - LEA BX 1 @> dbg" forward label?" - JMP @[ BX] -:ASM asmret - DEC BP DEC BP - MOV @[ BP] SI - RET -1 find-patch @ . 1 find-patch cell + @ . -1 <: -dbg" patched" - t& $DOCOLON w>t '>t >r '>t execute '>t t asmret -) dbg" allocation" + +BUCKETMASK CONST BUCKETMASK +LATESTOFF CONST LATESTOFF +DICTSIZE CONST DICTSIZE +L@ DICTIONARY CONST primary-dict +DEFERRED dictionary primary-dict +:t &latest dictionary LATESTOFF + ; + 0 VAR, &here :t here &here @ ; :t here! &here ! ; @@ -477,9 +99,11 @@ dbg" allocation" 2 CONST cell :t cells cell * ; -:t allot here + here! ; -:t , here ! cell allot ; -:t b, here b! 1 allot ; +:t allot [ target ] dup BZ_ [ patchpt ] 1- + 0 here b! here 1+ here! + GOTO_ [ swap w>t patch!t ] drop ; +:t , here ! here cell + here! ; +:t b, here b! here 1+ here! ; : t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ; dbg" i/o" @@ -542,7 +166,7 @@ DEFERRED emit console-emit :t bl LIT_ [ key w>t ] emit ; :t type - [ target @ ] dup b@ dup BZ_ [ patchpt ] + [ target ] dup b@ dup BZ_ [ patchpt ] emit 1+ GOTO_ [ swap w>t patch!t ] drop drop ; @@ -727,9 +351,9 @@ L: write-next-digit :t word, ( consume leading whitespace ) - 0 [ target @ ] drop key dup whitespace? not BZ_ [ w>t ] + 0 [ target ] drop key dup whitespace? not BZ_ [ w>t ] ( consume non-whitespace / eoi characters ) - [ target @ ] dup whitespace? over eoi? or + [ target ] dup whitespace? over eoi? or ( 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 @@ -742,7 +366,7 @@ dbg" compiler" :t wordname 2 cells + ; :t wordlen wordflags ub@ ; :t codepointer dup wordname swap wordlen + ( trailing null ) 1+ ; -:t dictbucket ( word -- p ) ub@ LIT_ [ BUCKETMASK w>t ] & cells dictionary + ; +:t dictbucket ( word -- p ) ub@ BUCKETMASK & cells dictionary + ; :t new-word ( set latest ) here latest! ( create entry ) 0 dup , , @@ -753,7 +377,7 @@ 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_ [ patchpt ] + 0 swap [ target ] dup b@ BZ_ [ patchpt ] 2inc GOTO_ [ swap w>t patch!t ] drop ; :ASM dict-lookup ( name dict -- cp meta | name 0 ) @@ -810,11 +434,12 @@ L: check-next-entry MOV SI DX ( restore SI ) NEXT -:t lookup dictionary dict-lookup ; +:t lookup-current dictionary dict-lookup ; +DEFERRED lookup lookup-current 0x100 CONST F_IMMEDIATE :t immediate latest wordflags dup @ F_IMMEDIATE | swap ! ; -: IMMEDIATE [ L@ LATEST lit ] @t cell + dup @t 0x100 | swap !t ; +: IMMEDIATE &LATEST @t cell + dup @t 0x100 | swap !t ; 0 VAR, &state :t state &state @ ; @@ -824,9 +449,13 @@ L: check-next-entry :t ; LIT_ return , [ '>t [ ] ; IMMEDIATE :t const new-word $DOCONST , , ; :t var new-word $DOVAR , 0 , ; +:t cp, , ; +:t lit LIT_ LIT_ , , ; +DEFERRED compileword cp, +DEFERRED compilenum lit :t interpretword ( cp meta -- ) F_IMMEDIATE & state not or - BZ_ [ patchpt ] execute return [ patch!t ] , ; -:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ; + BZ_ [ patchpt ] execute return [ patch!t ] compileword ; +:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] compilenum [ patch!t ] ; :t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ; DEFERRED err ?err @@ -847,14 +476,14 @@ DEFERRED err ?err :t checkstack underflow? BZ_ [ patchpt ] INLINEDATA_ [ patchpt t" underflow!" patch!t ] type cr [ patch!t ] ; -:t compileword ( word -- ) +:t expileword ( word -- ) lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] drop number BZ_ [ patchpt ] interpretnumber return [ patch!t ] err ; :t interpreter - [ target @ ] noop ( f28 ) word noop ( f2c ) dup b@ BZ_ - [ patchpt ] noop ( f36 ) compileword checkstack - GOTO_ [ swap w>t patch!t ] noop ( f40 ) drop ; + [ target ] word dup b@ BZ_ + [ patchpt ] expileword checkstack + GOTO_ [ swap w>t patch!t ] drop ; dbg" flow control words and misc." :t if LIT_ BZ_ , here 0 , ; IMMEDIATE @@ -867,8 +496,7 @@ dbg" flow control words and misc." :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 ( [ target ] key LIT_ [ key ) w>t ] = BZ_ [ w>t ] ; IMMEDIATE :t inline| LIT_ INLINEDATA_ , here 0 , ; :t |inline then ; @@ -876,12 +504,12 @@ dbg" flow control words and misc." :t :| inline| $DOCOLON , ; IMMEDIATE :t |; LIT_ return , |inline ; IMMEDIATE -:t s", [ target @ ] key dup LIT_ [ key " w>t ] != over 0 != and +:t s", [ target ] key dup LIT_ [ key " w>t ] != over 0 != and 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 -:t ' word lookup drop state BZ_ [ patchpt ] lit return [ patch!t ] ; IMMEDIATE +:t ' word lookup drop state BZ_ [ patchpt ] lit [ patch!t ] ; IMMEDIATE :t loadfp ( fp -- fp ) infile @ >r @@ -895,12 +523,26 @@ dbg" flow control words and misc." :t redefine ( cp cpdeferred ) cell + ! ; :t definition ( cpdeferred ) cell + @ ; -:t .s sp+ss swap >r 0x100 [ target @ ] 2 - dup r@ < BZ_ +:t .s sp+ss swap >r 0x100 [ target ] 2 - dup r@ < BZ_ ( past top of stack ) [ patchpt ] drop drop rdrop return [ patch!t ] 2dup swap @far . GOTO_ [ w>t ] ; -dbg" boot stub" -:t tinyjort interpreter terminate ; +:t compile-here + LIT_ cp, LIT_ compileword redefine + LIT_ lit LIT_ compilenum redefine ; + +0 VAR, initscripts +:t :init initscripts @ here initscripts ! , ] ; +: :INIT [ t& initscripts lit ] dup @t swap target swap !t w>t ] compt ; + +:t doinit initscripts @ + [ target ] dup BZ_ [ patchpt ] dup cell + >r @ GOTO_ [ swap w>t ] + [ patch!t ] drop ; + +DEFERRED main interpreter +:t tinyjort doinit main terminate ; + +dbg" boot" 9 <: ( actual entry point ) MOV SI t& tinyjort # @@ -913,9 +555,9 @@ dbg" boot stub" MOV BP 0x00 # NEXT -target @ t& &here !t +target t& &here !t dbg" Program assembled, saving tinyjort.com" s" tinyjort.com" overwrite -0x100 target @ :noname for i tseg b@far over fputc next ; execute -close +:noname >r 0x100 begin dup target < while dup b@t r@ fputc 1+ repeat drop + +L: RETFAR + target cell + w>t + target cell + w>t + MOV SI @[ -2 @+ BP] + PUSH @[ -4 @+ BP] + PUSH @[ -6 @+ BP] + SUB BP 6 # + RETF + +L: DOFAR + POP @[ 0 @+ BP] + POP @[ 2 @+ BP] + MOV @[ 4 @+ BP] SI + ADD BP 6 # + PUSH CS + POP DS + MOV SI L@ RETFAR # + POP BX + JMP @[ BX] + +array tdict DICTSIZE allot + +array &FARCALL L@ DOFAR , comseg , +asm-here +array $DOFAR + INC BX INC BX + PUSH @[ BX] + CALL FAR &FARCALL @+ + PUSH CS + POP DS + ( NEXT isn't defined yet ;_; ) + LODSW + MOV BX AX + JMP @[ BX] +asm-com + +: te word tdict dict-lookup interpretword ; immediate +: tlookup ( -- tcp ) word tdict dict-lookup drop cell + @ ; +: t' tlookup interpretnumber ; immediate +: t& tlookup cell + interpretnumber ; immediate +: t, tlookup state if lit ' w>t , else w>t then ; immediate +: '>t tlookup w>t ; + +: chained-lookup + primary-dict dict-lookup dup if return then drop tdict dict-lookup ; + +: tcomp| + ' lookup-current ' lookup redefine + ' tdict ' dictionary redefine + :| cell + @ w>t |; ' compileword redefine + :| t, LIT_ w>t |; ' compilenum redefine ; +: |tcomp + ' chained-lookup ' lookup redefine + ' primary-dict ' dictionary redefine + ' , ' compileword redefine + ' lit ' compilenum redefine ; + +|tcomp + +: DEF tcomp| new-word latest wordname lastlabel ! |tcomp $DOFAR , target , ; + +s" coredefs.jrt" loadfile + +: :timm tcomp| new-word immediate |tcomp $DOCOLON , ] ; +:timm [[ |tcomp ['] [ ; : ]] tcomp| ] ; +:timm ; t, return |tcomp ['] [ ; + +:timm ( ['] ( ; + +:timm if t, BZ_ patchpt ; +:timm else t, GOTO_ patchpt swap patch!t ; +:timm then patch!t ; + +:timm begin target ; +:timm while t, BZ_ patchpt ; +:timm repeat t, GOTO_ swap w>t patch!t ; +:timm again t, GOTO_ w>t ; +:timm until t, BZ_ w>t ; + +:timm s" t' INLINEDATA_ w>t patchpt + begin key dup [ key " lit ] != while >t repeat drop patch!t ; + +:timm :| t, INLINEDATA_ patchpt t, $DOCOLON ; +:timm |; t, return patch!t ; + +: :t DEF [ t& $DOCOLON lit ] w>t ]] ; +: CREATE DEF [ t& $DOCREATE lit ] w>t 0 w>t ; +: FINISHCREATE tcomp| latest |tcomp codepointer cell + @ cell + !t ; +: DOES> target lit ' FINISHCREATE , ' return , tcomp| ; immediate + +: t" target begin key dup [ key " lit ] != while >t repeat ; + +s" logic.jrt" loadfile +