rearranging code, implementing "type", progress / debug output

tinyjort.jrt

@@ -60,6 +60,8 @@ L: LATEST 0 w>t
 
 : :ASM DEF target @ 2 + w>t ;
 
+dbg" core"
+
 L: $$CONST
   INC BX INC BX
   PUSH @[ BX]
@@ -97,7 +99,6 @@ L@ $$VAR CONST $DOVAR
 
 ( 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
@@ -130,72 +131,6 @@ L: GOTO_IMPL 0 <:
 
 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
@@ -239,6 +174,7 @@ L: fail-digit 0 <:
   POP BX
   JMP @[ BX]
 
+dbg" math"
 :ASM +
   POP AX POP BX 
   ADD AX BX
@@ -257,6 +193,7 @@ L: fail-digit 0 <:
   PUSH AX
   NEXT
 
+dbg" comparisons"
 L: TRUE 0xffff w>t
 L: FALSE 0 w>t
 L: RETTRUE
@@ -313,6 +250,7 @@ L: RETFALSE
 :t <= '>t > '>t not '>t return
 :t >= '>t < '>t not '>t return
 
+dbg" bitwise"
 :ASM &
   POP AX
   POP BX
@@ -348,6 +286,7 @@ L: RETFALSE
   PUSH AX
   NEXT
 
+dbg" mem"
 :ASM @
   POP BX
   MOV AX @[ BX]
@@ -401,6 +340,7 @@ L: RETFALSE
   MOV @[ ES: BX] AL
   NEXT
 
+dbg" return stack"
 :ASM >r
   POP AX
   MOV @[ BP] AX
@@ -429,6 +369,24 @@ L: RETFALSE
   MOV @[ -4 @+ BP] AX
   NEXT
 
+dbg" ASMEXEC"
+( usage: push a CP onto the stack, then CALL ASMEXEC.
+  will execute the word and then return to your assembly code. 
+  note that this will clobber AX and BX and possibly all other registers!! )
+( does not work - I think LEA @> 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 <r '>t asmret
+)
+dbg" allocation"
 0 VAR, &here
 :t here '>t &here '>t @ '>t return
 :t here! '>t &here '>t ! '>t return
@@ -446,6 +404,7 @@ L: RETFALSE
 :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
 
+dbg" i/o"
 :ASM overwrite
   MOV AH 0x3c #
   XOR CX CX ( non-system, non-hidden )
@@ -516,9 +475,116 @@ DEFERRED emit console-emit
    '>t fgetc '>t return
 DEFERRED key in-key
 
+dbg" number"
+L: BASE 10 w>t L: ISNEG? 0 >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
+  MOV BYTE ISNEG? AL
+L: next-digit
+  MOV BL AL
+  LODSB
+  XCHG AL BL
+  CMP BL 0 #
+  JZ 1 @> ( string end )
+  JCXZ 3 @> ( starts with negative? )
+L: parse-digit
+  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 )
+  CMP BYTE ISNEG? 0 #
+  JZ 1 @>
+  NEG AX
+1 <:
+  MOV SI DI
+  POP DX
+  PUSH AX
+  PUSH CX ( we know cx is nonzero and will be treated as true )
+  NEXT
+3 <: ( negative? )
+  CMP BL key - #  
+  JNZ parse-digit
+  CMP BYTE ISNEG? 0 #
+  JNZ fail-digit ( only one negative sign allowed )
+  MOV BYTE ISNEG? BL ( any nonzero value will do )
+  JMP next-digit
+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
+
+dbg" num>str"
+:ASM num>str
+  MOV DI t& &here @+
+  POP AX
+L: write-next-digit
+  XOR DX DX
+  MOV BX 10 #
+  IDIV BX
+  XCHG DX AX
+  ADD AX key 0 #
+  STOSB
+  XCHG DX AX
+  CMP AX 0 #
+  JNZ write-next-digit
+  XOR AX AX
+  STOSB ( trailing 0 )
+  PUSH t& &here @+
+  NEXT
+
+dbg" type"
+:t type target @ '>t dup '>t b@ '>t dup '>t BZ_ target @ 7 cells + w>t 
+   '>t emit '>t LIT_ 1 w>t '>t + '>t GOTO_ w>t '>t drop '>t drop '>t return
+dbg" ."
+:t . '>t num>str '>t type '>t LIT_ key  w>t '>t emit '>t return
+
+dbg" test"
 ( test program )
-ARRAY hex65 key 6 >t key 5 >t 0 >t   
+ARRAY hex65 key - >t 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
+L: test-word '>t hex65 '>t number '>t drop '>t . '>t terminate
 
 9 <: ( actual entry point )
   LEA SI test-word