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 SI - instruction pointer BX - W register - code pointer for current word all other registers can and will be clobbered. DF must be cleared before calling NEXT, as LODSW is used to increment the instruction pointer. ) 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 first character of the word and taking its first 4 bits. Entry: LINK - pointer to next word in the dictionary FLAGS - byte LENGTH - byte NAME - bytes ending in \0 CODE POINTER - pointer to machine code routine ) L: DICTIONARY 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t L: LATEST 0 w>t : savelabel ( word -- ) here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; : DICTLIST ( word -- tptr ) b@ 0x0f & 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 ; : link>t ( tptr-head -- ) dup @t swap target @ swap !t w>t ; : DEF word dup savelabel dup DICTLIST link>t 0 >t dup strlen >t str>t ; : WORD= ( word len tptr -- f ) 3 + dup b@t t ; L: $$CONST INC BX INC BX PUSH @[ BX] NEXT : CONST DEF [ L@ $$CONST lit ] w>t w>t ; L@ DICTIONARY CONST dictionary L@ LATEST CONST &latest 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 @[ BP] SI NEXT ( some helpers for making manually defining colon words slightly less ugly ) : '>t t' w>t ; : @>t t& @t w>t ; : :t DEF [ t& $DOCOLON lit ] w>t ; :CP $DODEFERRED INC BX INC BX MOV BX @[ BX] JMP @[ BX] : DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ; :ASM LIT_ LODSW PUSH AX NEXT :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 L: BASE 10 w>t :ASM number ( str -- num 1 | str 0 ) ( AX - current number BH - 0 BL - current character CX - current digit count, used to detect 0x prefix DX - clobbered by IMUL SI - remainder of string to be parsed DI - saved IP, as SI will be clobbered by LODSB ) MOV DI SI ( save IP ) POP SI PUSH SI MOV BASE 10 # XOR AX AX XOR BX BX XOR CX CX L: next-digit MOV BL AL LODSB XCHG AL BL CMP BL 0 # JZ 1 @> ( string end ) CMP BL key 9 # JG 2 @> ( hex or fail ) SUB BL key 0 # JL 0 @> ( not a number ) L: parsed-digit IMUL BASE ADD AX BX INC CX JMP next-digit L: fail-digit 0 <: MOV SI DI XOR CX CX PUSH CX NEXT 1 <: ( string end ) JCXZ fail-digit ( empty string is not zero ) MOV SI DI POP DX PUSH AX PUSH CX ( we know cx is nonzero and will be treated as true ) NEXT 2 <: ( hex or fail ) CMP BL key x # ( lowercase x ) JNZ 0 @> CMP CX 1 # ( x is second character ) JNZ 1 @> CMP AX 0 # ( first character was a 0 ) JNZ 2 @> MOV BASE 16 # JMP next-digit 0 <: 1 <: 2 <: ( actual parsing of hex digit ) SUB BL key A # JL fail-digit ADD BL 10 # CMP BL BASE JL parsed-digit SUB BL key a key A - 10 - # JL fail-digit ADD BL 10 # CMP BL BASE JL parsed-digit JMP fail-digit :ASM drop POP AX NEXT :ASM dup POP AX PUSH AX PUSH AX NEXT :ASM swap POP AX POP BX PUSH AX PUSH BX NEXT :ASM over POP AX POP BX POP BX POP AX POP BX NEXT :ASM t L: FALSE 0 w>t L: RETTRUE PUSH TRUE NEXT L: RETFALSE PUSH FALSE NEXT :ASM not POP AX CMP AX FALSE JZ RETTRUE JMP RETFALSE :ASM = POP AX POP BX CMP AX BX JZ RETTRUE JMP RETFALSE :ASM < POP AX POP BX CMP AX BX JL RETTRUE JMP RETFALSE :ASM > POP AX POP BX CMP AX BX JG RETTRUE JMP RETFALSE :ASM and POP AX POP BX CMP AX FALSE JZ RETFALSE CMP BX FALSE JZ RETFALSE JMP RETTRUE :ASM or POP AX POP BX OR AX BX JZ RETFALSE JMP RETTRUE :t != '>t = '>t not '>t return :t <= '>t > '>t not '>t return :t >= '>t < '>t not '>t return :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 >> POP CX POP AX SHR AX CL PUSH AX NEXT :ASM @ POP BX MOV AX @[ BX] PUSH AX 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 MOV AX @[ ES: BX] PUSH AX NEXT :ASM b@far POP ES POP BX MOV AL @[ ES: BX] CBW PUSH AX NEXT :ASM ! POP BX POP AX MOV @[ BX] AX NEXT :ASM b! POP BX POP AX MOV @[ BX] AL NEXT :ASM !far POP ES POP BX POP AX MOV @[ ES: BX] AX NEXT :ASM b!far POP ES POP BX POP AX MOV @[ ES: BX] AL NEXT :ASM >r POP AX MOV @[ BP] AX INC BP INC BP NEXT :ASM t &here '>t @ '>t return :t here! '>t &here '>t ! '>t return 0xffff CONST there :t latest '>t &latest '>t @ '>t return :t latest! '>t &latest '>t ! '>t return 0 VAR, lastseg :t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t + '>t dup '>t lastseg '>t ! '>t return 2 CONST cell :t allot '>t here '>t + '>t here! '>t return :t , '>t here '>t ! '>t cell '>t allot '>t return :t b, '>t here '>t b! '>t LIT_ 1 w>t '>t allot '>t return :ASM overwrite MOV AH 0x3c # XOR CX CX ( non-system, non-hidden ) POP DX ( filename ptr ) INT 0x21 # PUSH AX NEXT :ASM open MOV AH 0x3d # MOV AL 2 # ( read/write access, allow child inheritance ) POP DX ( filename ptr ) INT 0x21 # PUSH AX NEXT :ASM close MOV AH 0x3e # POP BX INT 0x21 # NEXT 0 VAR, fcount :ASM fread MOV AH 0x3f # POP BX ( fp ) POP DX ( buffer ) POP CX ( length ) INT 0x21 # MOV t& fcount @+ AX ( save number of bytes read ) NEXT :ASM fwrite MOV AH 0x40 # POP BX ( fp ) POP DX ( buffer ) POP CX ( length ) INT 0x21 # MOV t& fcount @+ AX ( save number of bytes written ) NEXT -1 CONST EOF 0 VAR, fbuffer :t fgetc '>t LIT_ 1 w>t '>t fbuffer '>t t fread '>t fbuffer '>t ub@ '>t fcount '>t @ '>t not '>t BZ_ target @ 3 cells + w>t '>t drop '>t EOF '>t return :t fputc '>t swap '>t fbuffer '>t b! '>t LIT_ 1 w>t '>t fbuffer '>t t fwrite '>t return :ASM console-emit MOV AH 2 # POP DX INT 0x21 # NEXT DEFERRED emit console-emit :ASM console-key MOV AH 8 # INT 0x21 # XOR AH AH PUSH AX NEXT 0 VAR, infile ( 0 is a predefined file handle meaning stdin ) :t in-key '>t infile '>t @ '>t dup '>t BZ_ target @ 4 cells + w>t '>t drop '>t console-key '>t return '>t fgetc '>t return DEFERRED key in-key ( test program ) ARRAY hex65 key 6 >t key 5 >t 0 >t L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t 9 <: ( actual entry point ) LEA SI test-word PUSH CS POP AX ADD AX 4096 # MOV SS AX MOV t& lastseg @+ AX MOV SP 0xfe # MOV BP 0x00 # NEXT 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