wip

blk/328

@@ -1,14 +1,16 @@
 CODE S=
-    DE  POPqq,
-    HL  POPqq,
-    chkPS,
+    DE POPqq, HL POPqq, chkPS,
+    HL DECss, DE DECss,
+    LDA(DE),
+    (HL) CPr,
+    IFZ, ( same size? )
+        B A LDrr, ( loop A times )
         BEGIN,
+            HL INCss, DE INCss,
             LDA(DE),
             (HL) CPr,
             JRNZ, BREAK, ( not equal? break early. NZ is set. )
-        A ORr,   ( if our char is null, stop )
-        HL INCss,
-        DE INCss,
-    JRNZ, AGAIN,
+        DJNZ, AGAIN,
+    THEN,
     PUSHZ,
 ;CODE

blk/354

@@ -11,3 +11,4 @@
 : C!+ ( c a -- a+1 ) TUCK C! 1+ ;
 : C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
 : C!- ( c a -- a-1 ) TUCK C! 1- ;
+: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ;

blk/357

@@ -1,16 +1,11 @@
-: (parsed)      ( a -- n f )
-    DUP C@                        ( a c )
-    DUP '-' = IF
-        DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
+: _ ( a len -- n f )
+    OVER C@ ( a len c )
+    '-' = IF
+        1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n )
         - SWAP EXIT                    ( 0-n f )
-    THEN
-    0 SWAP _pdacc                 ( a r f )
-    ?DUP IF 2DROP 0 EXIT THEN
-    BEGIN                         ( a r )
-        SWAP 1+                   ( r a+1 )
-        DUP C@                    ( r a c )
-        ROT SWAP                  ( a r c )
-        _pdacc                    ( a r f )
-    ?DUP UNTIL
-    1 =         ( a r f )
-    ROT DROP    ( r f ) ;
+    THEN ( a len )
+    0 SWAP ( len ) 0 DO ( a r )
+        OVER I + C@ ( a r c ) _pdacc ( a r f )
+        IF DROP 0 UNLOOP EXIT THEN LOOP ( a r )
+    NIP 1 ;
+: (parsed) ( a -- n f ) DUP 1- C@ ( a l ) _ ;

blk/360

@@ -2,14 +2,9 @@
     ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
     DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
     ( We have "0x" prefix )
-    2+
-    0  ( a r )
-    BEGIN
-    SWAP C@+                            ( r a+1 c )
-    ?DUP NOT IF DROP 1 EXIT THEN        ( r, 1 )
-    _                                   ( r a n )
-    DUP 0< IF ROT 2DROP 0 EXIT THEN     ( a 0 )
-    ROT 16 * +                          ( a r*16+n )
-    AGAIN
-;
-
+    DUP 1- C@ ( a len )
+    0 SWAP ( len ) 2 DO ( a r )
+        OVER I + C@ ( a r c ) _ ( a r n )
+        DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
+        SWAP 4 LSHIFT + ( a r*16+n ) LOOP
+    NIP 1 ;

blk/362

@@ -2,15 +2,9 @@
     ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
     DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
     ( We have "0b" prefix )
-    2+
-    0  ( a r )
-    BEGIN
-    SWAP C@+                               ( r a+1 c )
-    ?DUP NOT IF DROP 1 EXIT THEN           ( r 1 )
-    _                                      ( r a n )
-    DUP 0< IF ROT 2DROP 0 EXIT THEN        ( a 0 )
-    ROT 2 * +                              ( a r*2+n )
-    AGAIN
-;
-
-
+    DUP 1- C@ ( a len )
+    0 SWAP ( len ) 2 DO ( a r )
+        OVER I + C@ ( a r c ) _ ( a r n )
+        DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
+        SWAP 1 LSHIFT + ( a r*2+n ) LOOP
+    NIP 1 ;

blk/367

@@ -0,0 +1,9 @@
+: IMMEDIATE
+    CURRENT @ 1-
+    DUP C@ 128 OR SWAP C! ;
+: IMMED? 1- C@ 0x80 AND ;
+: +! TUCK @ + SWAP ! ;
+: -^ SWAP - ;
+: / /MOD NIP ;
+: MOD /MOD DROP ;
+: ALLOT HERE +! ;

blk/368

@@ -1,12 +0,0 @@
-: +! TUCK @ + SWAP ! ;
-: [entry] ( w -- )
-    H@ SWAP
-    BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP
-    H@ SWAP - ( sz )
-    ( write prev value )
-    H@ CURRENT @ - ,
-    C, ( write size )
-    H@ CURRENT !
-;
-
-: (entry) WORD [entry] ;

blk/369

@@ -1,11 +1,12 @@
-: IMMEDIATE
-    CURRENT @ 1-
-    DUP C@ 128 OR SWAP C! ;
-: IMMED? 1- C@ 0x80 AND ;
-: -^ SWAP - ;
-: / /MOD NIP ;
-: MOD /MOD DROP ;
-: ALLOT HERE +! ;
-: CREATE (entry) 11 ( 11 == cellWord ) C, ;
-: VARIABLE CREATE 2 ALLOT ;
-: LEAVE R> R> DROP I 1- >R >R ;
+: '? WORD FIND ;
+: '
+    '? (?br) [ 4 , ] EXIT
+    LIT< (wnf) FIND DROP EXECUTE
+;
+: ROLL
+    ?DUP NOT IF EXIT THEN
+    1+ DUP PICK          ( n val )
+    SWAP 2 * (roll)      ( val )
+    NIP ;
+: 2OVER 3 PICK 3 PICK ;
+: 2SWAP 3 ROLL 3 ROLL ;

blk/370

@@ -1,12 +1,14 @@
-: '? WORD FIND ;
-: '
-    '? (?br) [ 4 , ] EXIT
-    LIT< (wnf) FIND DROP EXECUTE
-;
-: ROLL
-    ?DUP NOT IF EXIT THEN
-    1+ DUP PICK          ( n val )
-    SWAP 2 * (roll)      ( val )
-    NIP ;
-: 2OVER 3 PICK 3 PICK ;
-: 2SWAP 3 ROLL 3 ROLL ;
+: MOVE ( a1 a2 u -- )
+    ( u ) 0 DO ( a1 a2 )
+        SWAP C@+ ( a2 a1+1 x )
+        ROT C!+ ( a1+1 a2+1 )
+    LOOP 2DROP ;
+: MOVE- ( a1 a2 u -- )
+    TUCK + 1- ( a1 u a2+u-1 )
+    ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
+    ROT ( u ) 0 DO ( a2 a1 )
+        C@- ( a2 a1-1 x )
+        ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
+    LOOP 2DROP ;
+: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
+: PREV 3 - DUP @ - ;

blk/371

@@ -1,14 +1,10 @@
-: MOVE ( a1 a2 u -- )
-    ( u ) 0 DO ( a1 a2 )
-        SWAP C@+ ( a2 a1+1 x )
-        ROT C!+ ( a1+1 a2+1 )
-    LOOP 2DROP ;
-: MOVE- ( a1 a2 u -- )
-    TUCK + 1- ( a1 u a2+u-1 )
-    ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
-    ROT ( u ) 0 DO ( a2 a1 )
-        C@- ( a2 a1-1 x )
-        ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
-    LOOP 2DROP ;
-: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
-: PREV 3 - DUP @ - ;
+: [entry] ( w -- )
+    1- C@+ ( w+1 len ) TUCK MOVE, ( len )
+    ( write prev value )
+    H@ CURRENT @ - ,
+    C, ( write size )
+    H@ CURRENT !
+;
+: (entry) WORD [entry] ;
+: CREATE (entry) 11 ( 11 == cellWord ) C, ;
+: VARIABLE CREATE 2 ALLOT ;

emul/stage.c

@@ -42,7 +42,8 @@ static uint8_t iord_stdio()
 
 static void iowr_stdio(uint8_t val)
 {
-    // we don't output stdout in stage0
+    // uncomment when you need to debug staging
+    // putc(val, stderr);
 }
 
 static void iowr_here(uint8_t val)