Expanded Forth kernel with simple test program

.gitignore

@@ -1,4 +1,5 @@
 *.bak
 *.obj
 *.dsk
+errors.txt
 

tinyjort.jrt

@@ -7,10 +7,12 @@ s" asm.jrt" loadfile
   SI - instruction pointer
   BX - W register - code pointer for current word
 
-  all other registers can and will be clobbered
+  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 0x1000 @+
+JMP 9 @>
 
 : NEXT 
   LODSW
@@ -42,11 +44,17 @@ L: LATEST 0 w>t
 : 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 ) ;
+: WORD= ( word len tptr -- f ) 
-: t' word dup strlen over DICTLIST @t ( word len tptr )
+  3 + dup b@t <rot != if 2drop 0 return then 1 + ( word tword )
-  begin dup @t while 3dup WORD= if 5 + + swap drop return then repeat
+  begin over b@ over b@t = while 
+    over b@ not if 2drop 1 return then ( 0 byte, matched )
+    1 + swap 1 + swap
+  repeat 2drop 0 ;
+
+: t' word dup strlen over DICTLIST ( word len tptr-next-entry )
+  begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat
   drop drop drop 0 ;
-;
+
 : :ASM DEF target @ 2 + w>t ;
 
 L: $$CONST
@@ -107,7 +115,121 @@ L: GOTO_IMPL 0 <:
 
 DEF GOTO_ L@ GOTO_IMPL w>t
 
-( 0x1000 target ! )
+L: BASE 10 w>t
+:ASM number ( str -- num 1 | str 0 )
+  ( AX - current number
+    BX - saved IP, as SI will be clobbered by LODSB
+    CX - current digit count, used to detect 0x prefix
+    DX - clobbered by IMUL 
+    SI - remainder of string to be parsed )
+  MOV BX SI ( save IP )
+  POP SI
+  PUSH SI
+  MOV BASE 10 #
+  
+  XOR AX AX
+  XOR CX CX
+L: next-digit
+  IMUL BASE
+  MOV BL AL
+  LODSB
+  CMP AL 0 #
+  JZ 1 @> ( string end )
+  CMP AL key 9 #
+  JG 2 @> ( hex or fail )
+  SUB AL key 0 #
+  JL 0 @> ( not a number )
+L: parsed-digit
+  ADD BL AL
+  ADC AH 0 #
+  INC CX
+  JMP next-digit
+L: fail-digit 0 <:
+  MOV SI BX
+  PUSH 0 #
+  NEXT
+1 <: ( string end )
+  JCXZ fail-digit ( empty string is not zero )
+  MOV SI BX
+  POP DX
+  PUSH AX
+  PUSH 1 #
+  NEXT
+2 <: ( hex or fail )
+  CMP AL key x ( lowercase x )
+  JNZ 0 @>
+  CMP CX 1 # ( x is second character )
+  JNZ 1 @>
+  CMP BL 0 # ( first character was a 0 ) 
+  JNZ 2 @>
+  MOV BASE 16 #
+  JMP next-digit
+0 <: 1 <: 2 <: ( actual parsing of hex digit )
+  SUB AL key A #
+  JL fail-digit
+  ADD AL 10 #
+  CMP AL BASE
+  JL parsed-digit
+  SUB AL key a key A - 10 - #
+  JL fail-digit
+  ADD AL 10 #
+  CMP AL 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 <rot
+  POP AX
+  POP BX
+  POP CX
+  PUSH BX
+  PUSH AX
+  PUSH CX
+  NEXT
+
+:ASM emit
+  MOV AH 5 #
+  POP DX
+  INT 0x21 #
+  NEXT
+
+:ASM terminate
+  MOV AH 0x4c #
+  MOV AL 0 # ( todo: pop )
+  INT 0x21 #
+
+( test program )
+ARRAY hex65 key 0 >t key x >t key 6 >t key 5 >t 0 >t   
+L: test-word L@ $$COLON w>t t' hex65 w>t t' emit w>t t' terminate w>t
+
+9 <: ( actual entry point )
+  LEA SI test-word
+  ( TODO: configure stacks )
+  NEXT  
 
 .s