From b9fb6a6226e6b37ad6856a626cea112fb9e4c089 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Sun, 5 Jul 2020 22:23:40 -0400 Subject: [PATCH] z80: move boot code around Bring native words together, make the next/exec/does/compiled cluster be at the beginning. Next step: bring find code into _find word. --- blk/284 | 29 ++++++++++++++--------------- blk/285 | 13 +++---------- blk/{300 => 286} | 4 ++-- blk/287 | 13 +++++++++++++ blk/{302 => 288} | 0 blk/{303 => 289} | 2 +- blk/{304 => 290} | 0 blk/297 | 16 ++++++++++++++++ blk/298 | 15 ++++++++++++--- blk/299 | 14 -------------- blk/301 | 13 ------------- blk/305 | 3 +-- 12 files changed, 62 insertions(+), 60 deletions(-) rename blk/{300 => 286} (81%) rename blk/{302 => 288} (100%) rename blk/{303 => 289} (90%) rename blk/{304 => 290} (100%) create mode 100644 blk/297 delete mode 100644 blk/299 delete mode 100644 blk/301 diff --git a/blk/284 b/blk/284 index 3c82601..6e54c41 100644 --- a/blk/284 +++ b/blk/284 @@ -1,15 +1,14 @@ -H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) -CODE (br) ( TODO: move with other native words ) -L1 BSET ( used in ?br and loop ) -PC ORG @ 0x3d + ! ( stable ABI JP ) - E 0 IY+ LDrIXY, D 1 IY+ LDrIXY, - DE ADDIYd, -;CODE -CODE (?br) -PC ORG @ 0x41 + ! ( stable ABI JP ) - HL POP, - HLZ, - JRZ, L1 BWR ( br + 1. False, branch ) - ( True, skip next 2 bytes and don't branch ) - IY INCd, IY INCd, -;CODE +PC ORG @ 1 + ! ( main ) +( STACK OVERFLOW PROTECTION: See B76 ) + SP PS_ADDR LDdn, IX RS_ADDR LDdn, +( LATEST is a label to the latest entry of the dict. It is + written at offset 0x08 by the process or person building + Forth. ) + BIN( @ 0x08 + LDHL(n), + SYSVARS 0x02 ( CURRENT ) + LD(n)HL, +HERESTART [IF] + HL HERESTART LDdn, +[THEN] + SYSVARS 0x04 + LD(n)HL, ( RAM+04 == HERE ) + DE BIN( @ 0x04 ( BOOT ) + LDdd(n), + JR, L1 FWR ( execute, B287 ) diff --git a/blk/285 b/blk/285 index 0b1f025..6eb87fb 100644 --- a/blk/285 +++ b/blk/285 @@ -1,10 +1,3 @@ -CODE (loop) -PC ORG @ 0x45 + ! ( stable ABI JP ) - 0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ ) - ( Jump if I <> I' ) - A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) - A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) - ( don't branch ) - IX DECd, IX DECd, IX DECd, IX DECd, - IY INCd, IY INCd, -;CODE +lblofl BSET ( abortUnderflow ) + DE BIN( @ 0x06 ( uflw ) + LDdd(n), + JR, L2 FWR ( execute, B287 ) diff --git a/blk/300 b/blk/286 similarity index 81% rename from blk/300 rename to blk/286 index 1c01020..c0c1d52 100644 --- a/blk/300 +++ b/blk/286 @@ -5,11 +5,11 @@ lblnext BSET PC ORG @ 0x1b + ! ( next ) ( Before we continue: are stacks within bounds? ) ( PS ) HL PS_ADDR LDdn, SP SUBHLd, - JRC, lblofl BWR ( abortUnderflow-B298 ) + JRC, lblofl BWR ( abortUnderflow-B285 ) ( RS ) IX PUSH, HL POP, DE RS_ADDR LDdn, DE SUBHLd, - JRC, lblofl BWR ( IX < RS_ADDR? abortUnderflow-B298 ) + JRC, lblofl BWR ( IX < RS_ADDR? abortUnderflow-B285 ) E 0 IY+ LDrIXY, D 1 IY+ LDrIXY, IY INCd, IY INCd, diff --git a/blk/287 b/blk/287 index e69de29..f372223 100644 --- a/blk/287 +++ b/blk/287 @@ -0,0 +1,13 @@ +lblexec BSET L1 FSET ( B284 ) L2 FSET ( B285 ) + ( DE -> wordref ) + ( When we have a BIN( offset, we need to adjust stable + ABI offsets. ) + BIN( @ [IF] + A XORr, D ORr, IFZ, D BIN( @ 256 / LDri, THEN, + [THEN] + LDA(DE), DE INCd, + A ORr, IFZ, EXDEHL, JP(HL), THEN, + A DECr, JRZ, L1 FWR ( compiled B289 ) + ( cell or does. push PFA ) DE PUSH, + A DECr, JRZ, lblnext BWR ( cell ) + ( continue to does ) diff --git a/blk/302 b/blk/288 similarity index 100% rename from blk/302 rename to blk/288 diff --git a/blk/303 b/blk/289 similarity index 90% rename from blk/303 rename to blk/289 index cf1c020..32b88d9 100644 --- a/blk/303 +++ b/blk/289 @@ -11,4 +11,4 @@ LDDE(HL), HL INCd, HL PUSH, IY POP, ( --> IP ) - JR, lblexec BWR ( execute-B301 ) + JR, lblexec BWR ( execute-B287 ) diff --git a/blk/304 b/blk/290 similarity index 100% rename from blk/304 rename to blk/290 diff --git a/blk/297 b/blk/297 new file mode 100644 index 0000000..d54ce12 --- /dev/null +++ b/blk/297 @@ -0,0 +1,16 @@ +( Native words ) +H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) +CODE (br) ( TODO: move with other native words ) +L1 BSET ( used in ?br and loop ) +PC ORG @ 0x3d + ! ( stable ABI JP ) + E 0 IY+ LDrIXY, D 1 IY+ LDrIXY, + DE ADDIYd, +;CODE +CODE (?br) +PC ORG @ 0x41 + ! ( stable ABI JP ) + HL POP, + HLZ, + JRZ, L1 BWR ( br + 1. False, branch ) + ( True, skip next 2 bytes and don't branch ) + IY INCd, IY INCd, +;CODE diff --git a/blk/298 b/blk/298 index 846e0be..9b42883 100644 --- a/blk/298 +++ b/blk/298 @@ -1,3 +1,12 @@ -lblofl BSET ( abortUnderflow ) - DE BIN( @ 0x06 ( uflw ) + LDdd(n), - JR, L2 FWR ( execute, B301 ) +CODE (loop) +PC ORG @ 0x45 + ! ( stable ABI JP ) + 0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ ) + ( Jump if I <> I' ) + A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) + A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) + ( don't branch ) + IX DECd, IX DECd, IX DECd, IX DECd, + IY INCd, IY INCd, +;CODE + + diff --git a/blk/299 b/blk/299 deleted file mode 100644 index 8649c03..0000000 --- a/blk/299 +++ /dev/null @@ -1,14 +0,0 @@ -PC ORG @ 1 + ! ( main ) -( STACK OVERFLOW PROTECTION: See B76 ) - SP PS_ADDR LDdn, IX RS_ADDR LDdn, -( LATEST is a label to the latest entry of the dict. It is - written at offset 0x08 by the process or person building - Forth. ) - BIN( @ 0x08 + LDHL(n), - SYSVARS 0x02 ( CURRENT ) + LD(n)HL, -HERESTART [IF] - HL HERESTART LDdn, -[THEN] - SYSVARS 0x04 + LD(n)HL, ( RAM+04 == HERE ) - DE BIN( @ 0x04 ( BOOT ) + LDdd(n), - JR, L1 FWR ( execute, B301 ) diff --git a/blk/301 b/blk/301 deleted file mode 100644 index 03867d3..0000000 --- a/blk/301 +++ /dev/null @@ -1,13 +0,0 @@ -lblexec BSET L1 FSET ( B299 ) L2 FSET ( B298 ) - ( DE -> wordref ) - ( We don't apply BIN( reliably on stable ABI stuff, we - might need to adjust addr. Ugly, but well... ) - BIN( @ [IF] - A XORr, D ORr, IFZ, D BIN( @ 256 / LDri, THEN, - [THEN] - LDA(DE), DE INCd, - A ORr, IFZ, EXDEHL, JP(HL), THEN, - A DECr, JRZ, L1 FWR ( compiled B303 ) - ( cell or does. push PFA ) DE PUSH, - A DECr, JRZ, lblnext BWR ( cell ) - ( continue to does, B302 ) diff --git a/blk/305 b/blk/305 index 2906ef3..37b3606 100644 --- a/blk/305 +++ b/blk/305 @@ -1,8 +1,7 @@ -( Native words ) CODE EXECUTE DE POP, chkPS, - JR, lblexec BWR ( execute-B301 ) + lblexec @ JP, CODE EXIT PC ORG @ 0x0d + ! ( stable ABI JP )