From 503dbe9a2c1affc581d605a60bb1f94c62cc4d7a Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Wed, 22 Apr 2020 21:19:12 -0400 Subject: [PATCH] Copy boot.z80 to blkfs --- blk/001 | 3 +-- blk/064 | 10 +++++----- blk/075 | 2 +- blk/076 | 6 ++++++ blk/087 | 8 ++++---- blk/102 | 4 ++-- blk/280 | 16 ++++++++++++++++ blk/281 | 7 +++++++ blk/282 | 1 + blk/283 | 15 +++++++++++++++ blk/284 | 12 ++++++++++++ blk/285 | 6 ++++++ blk/286 | 13 +++++++++++++ blk/287 | 14 ++++++++++++++ blk/288 | 16 ++++++++++++++++ blk/289 | 16 ++++++++++++++++ blk/290 | 4 ++++ blk/291 | 16 ++++++++++++++++ blk/292 | 16 ++++++++++++++++ blk/293 | 16 ++++++++++++++++ blk/294 | 16 ++++++++++++++++ blk/295 | 16 ++++++++++++++++ blk/296 | 7 +++++++ blk/297 | 13 +++++++++++++ blk/298 | 7 +++++++ blk/299 | 14 ++++++++++++++ blk/300 | 16 ++++++++++++++++ blk/301 | 12 ++++++++++++ blk/302 | 16 ++++++++++++++++ blk/303 | 5 +++++ blk/304 | 16 ++++++++++++++++ blk/305 | 9 +++++++++ blk/306 | 11 +++++++++++ blk/307 | 13 +++++++++++++ blk/308 | 10 ++++++++++ blk/309 | 11 +++++++++++ blk/310 | 16 ++++++++++++++++ blk/311 | 15 +++++++++++++++ blk/312 | 8 ++++++++ blk/313 | 11 +++++++++++ blk/314 | 14 ++++++++++++++ blk/315 | 12 ++++++++++++ blk/316 | 12 ++++++++++++ blk/317 | 8 ++++++++ blk/318 | 15 +++++++++++++++ blk/319 | 16 ++++++++++++++++ blk/320 | 16 ++++++++++++++++ blk/321 | 15 +++++++++++++++ blk/322 | 16 ++++++++++++++++ blk/323 | 14 ++++++++++++++ blk/324 | 15 +++++++++++++++ blk/325 | 16 ++++++++++++++++ blk/326 | 13 +++++++++++++ blk/327 | 14 ++++++++++++++ blk/328 | 16 ++++++++++++++++ blk/329 | 16 ++++++++++++++++ blk/330 | 16 ++++++++++++++++ blk/331 | 14 ++++++++++++++ blk/332 | 14 ++++++++++++++ blk/333 | 16 ++++++++++++++++ forth/blk.fs | 3 +++ 61 files changed, 720 insertions(+), 14 deletions(-) create mode 100644 blk/076 create mode 100644 blk/280 create mode 100644 blk/281 create mode 100644 blk/282 create mode 100644 blk/283 create mode 100644 blk/284 create mode 100644 blk/285 create mode 100644 blk/286 create mode 100644 blk/287 create mode 100644 blk/288 create mode 100644 blk/289 create mode 100644 blk/290 create mode 100644 blk/291 create mode 100644 blk/292 create mode 100644 blk/293 create mode 100644 blk/294 create mode 100644 blk/295 create mode 100644 blk/296 create mode 100644 blk/297 create mode 100644 blk/298 create mode 100644 blk/299 create mode 100644 blk/300 create mode 100644 blk/301 create mode 100644 blk/302 create mode 100644 blk/303 create mode 100644 blk/304 create mode 100644 blk/305 create mode 100644 blk/306 create mode 100644 blk/307 create mode 100644 blk/308 create mode 100644 blk/309 create mode 100644 blk/310 create mode 100644 blk/311 create mode 100644 blk/312 create mode 100644 blk/313 create mode 100644 blk/314 create mode 100644 blk/315 create mode 100644 blk/316 create mode 100644 blk/317 create mode 100644 blk/318 create mode 100644 blk/319 create mode 100644 blk/320 create mode 100644 blk/321 create mode 100644 blk/322 create mode 100644 blk/323 create mode 100644 blk/324 create mode 100644 blk/325 create mode 100644 blk/326 create mode 100644 blk/327 create mode 100644 blk/328 create mode 100644 blk/329 create mode 100644 blk/330 create mode 100644 blk/331 create mode 100644 blk/332 create mode 100644 blk/333 diff --git a/blk/001 b/blk/001 index ab3a24a..60d2274 100644 --- a/blk/001 +++ b/blk/001 @@ -3,8 +3,7 @@ MASTER INDEX 3 Usage 30 Dictionary 70 Implementation notes 100 Block editor 200 Z80 assembler 260 Cross compilation - - +280 Z80 boot code diff --git a/blk/064 b/blk/064 index 77fab41..2256262 100644 --- a/blk/064 +++ b/blk/064 @@ -1,10 +1,10 @@ Disk -BLK> -- a Address of the current block variable. -LIST n -- Prints the contents of the block n on screen in the - form of 16 lines of 64 columns. -LOAD n -- Interprets Forth code from block n - +BLK> -- a Address of the current block variable. +LIST n -- Prints the contents of the block n on screen + in the form of 16 lines of 64 columns. +LOAD n -- Interprets Forth code from block n +LOADR n1 n2 -- Load block range between n1 and n2, inclusive. diff --git a/blk/075 b/blk/075 index 6093b13..1ab2441 100644 --- a/blk/075 +++ b/blk/075 @@ -13,4 +13,4 @@ This return stack contain "Interpreter pointers", that is a pointer to the address of a word, as seen in a compiled list of words. - + (cont.) diff --git a/blk/076 b/blk/076 new file mode 100644 index 0000000..60e7f8b --- /dev/null +++ b/blk/076 @@ -0,0 +1,6 @@ +STACK OVERFLOW PROTECTION: To avoid having to check for stack +underflow after each pop operation (which can end up being +prohibitive in terms of costs), we give ourselves a nice 6 +bytes buffer. 6 bytes because we seldom have words requiring +more than 3 items from the stack. Then, at each "exit" call we +check for stack underflow. diff --git a/blk/087 b/blk/087 index 834b840..c550602 100644 --- a/blk/087 +++ b/blk/087 @@ -5,10 +5,10 @@ null-terminated string. Upon execution, the address of that null-terminated string is pushed on the PSP and IP is advanced to the address following the null. - - - - +Also note that word routines references in wordrefs are 1b. +This means that all word routine reference must live below +0x100 in boot binary. This is why numberWord and addrWord are +squeezed where they are. diff --git a/blk/102 b/blk/102 index bde0c81..7d40afa 100644 --- a/blk/102 +++ b/blk/102 @@ -1,10 +1,10 @@ -103 LOAD 104 LOAD 105 LOAD +103 105 LOADR : BROWSE 100 _LIST BEGIN KEY CASE - 'Q' OF DROP EXIT ENDOF + 'Q' OF EXIT ENDOF 'B' OF B ENDOF 'N' OF N ENDOF _NUM diff --git a/blk/280 b/blk/280 new file mode 100644 index 0000000..52b3fef --- /dev/null +++ b/blk/280 @@ -0,0 +1,16 @@ +Z80 boot code + +This assembles the boot binary. It requires the Z80 assembler +(B200) and cross compilation setup (B260). + +On top of that, it requires RAMSTART to be defined as the +beginning address of RAM. This is where system variables are +placed. HERE is then placed at RAM+80 (ref B80). + +We also need RS_ADDR to be set to the bottom address of the +Return Stack. + +RESERVED REGISTERS: At all times, IX points to RSP TOS and IY +is IP. SP points to PSP TOS, but you can still use the stack\ +in native code. you just have to make sure you've restored it +before "next". (cont.) diff --git a/blk/281 b/blk/281 new file mode 100644 index 0000000..0a2d910 --- /dev/null +++ b/blk/281 @@ -0,0 +1,7 @@ +(cont.) STABLE ABI: The boot binary starts with a list of +references. The address of these references have to stay to +those addresses. The rest of the Collapse OS code depend on it. +In fact, up until 0x67, the (?br) wordref, pretty much +everything has to stay put. + +To assemble, run "282 LOAD". diff --git a/blk/282 b/blk/282 new file mode 100644 index 0000000..53eef2e --- /dev/null +++ b/blk/282 @@ -0,0 +1 @@ +283 333 LOADR diff --git a/blk/283 b/blk/283 new file mode 100644 index 0000000..cc6f5f2 --- /dev/null +++ b/blk/283 @@ -0,0 +1,15 @@ +H@ ORG ! +0 JPnn, ( 00, main ) 0 JPnn, ( 03, find ) +NOP, NOP, ( 06, unused ) NOP, NOP, ( 08, LATEST ) +NOP, ( 0a, unused ) 0 JPnn, ( 0b, cellWord ) +0 JPnn, ( 0e, compiledWord ) 0 JPnn, ( 11, pushRS ) +0 JPnn, ( 14, popRS ) +EXDEHL, JP(HL), NOP, ( 17, nativeWord ) +0 JPnn, ( 1a, next ) 0 JPnn, ( 1d, chkPS ) +NOP, NOP, ( 20, numberWord ) NOP, NOP, ( 22, litWord ) +NOP, NOP, ( 24, addrWord ) NOP, NOP, ( 26, unused ) +RAMSTART 0x4e + JPnn, ( 28, RST 28 ) +0 JPnn, ( 2b, doesWord ) NOP, NOP, ( 2e, unused ) +RAMSTART 0x4e + JPnn, ( RST 30 ) +0 JPnn, ( 33, execute ) NOP, NOP, ( unused ) +RAMSTART 0x4e + JPnn, ( RST 38 ) diff --git a/blk/284 b/blk/284 new file mode 100644 index 0000000..be95eef --- /dev/null +++ b/blk/284 @@ -0,0 +1,12 @@ +( BOOT DICT: There are only 3 words in the boot dict, but + these words' offset need to be stable, so they're part of + the "stable ABI" ) +'E' A, 'X' A, 'I' A, 'T' A, +0 A,, ( prev ) +4 A, +H@ XCURRENT ! ( set current tip of dict, 0x42 ) + 0x17 A, ( nativeWord ) + 0x14 CALLnn, ( popRS ) + HL PUSHqq, IY POPqq, ( --> IP ) + JPNEXT, + diff --git a/blk/285 b/blk/285 new file mode 100644 index 0000000..49d4fb4 --- /dev/null +++ b/blk/285 @@ -0,0 +1,6 @@ +CODE (br) ( 0x53 ) +L2 BSET ( used in CBR ) + E 0 IY+ LDrIXY, + D 1 IY+ LDrIXY, + DE ADDIYss, + JPNEXT, diff --git a/blk/286 b/blk/286 new file mode 100644 index 0000000..39dc7c7 --- /dev/null +++ b/blk/286 @@ -0,0 +1,13 @@ +CODE (?br) ( 0x67 ) + HL POPqq, + chkPS, + A H LDrr, + L ORr, + JRZ, L2 BWR ( BR + 2. False, branch ) + ( True, skip next 2 bytes and don't branch ) + IY INCss, + IY INCss, + JPNEXT, + +( END OF STABLE ABI ) + diff --git a/blk/287 b/blk/287 new file mode 100644 index 0000000..9bd42f8 --- /dev/null +++ b/blk/287 @@ -0,0 +1,14 @@ +( See B85 for word routine impl notes ) +PC ORG @ 0x20 + ! ( numberWord ) +PC ORG @ 0x24 + ! ( addrWord ) +( This is not a word, but a number literal. This works a bit + differently than others: PF means nothing and the actual + number is placed next to the numberWord reference in the + compiled word list. What we need to do to fetch that number + is to play with the IP. ) + E 0 IY+ LDrIXY, + D 1 IY+ LDrIXY, + IY INCss, + IY INCss, + DE PUSHqq, + JPNEXT, diff --git a/blk/288 b/blk/288 new file mode 100644 index 0000000..b6333a3 --- /dev/null +++ b/blk/288 @@ -0,0 +1,16 @@ +PC ORG @ 0x22 + ! ( litWord ) +( Like numberWord, but instead of being followed by a 2 bytes + number, it's followed by a null-terminated string. When + called, puts the string's address on PS ) + IY PUSHqq, HL POPqq, ( <-- IP ) + HL PUSHqq, + ( skip to null char ) + A XORr, ( look for null ) + B A LDrr, + C A LDrr, + CPIR, + ( CPIR advances HL regardless of comparison, so goes one + char after NULL. This is good, because that's what we + want... ) + HL PUSHqq, IY POPqq, ( --> IP ) + JPNEXT, diff --git a/blk/289 b/blk/289 new file mode 100644 index 0000000..10b05ca --- /dev/null +++ b/blk/289 @@ -0,0 +1,16 @@ +( Name of BOOT word ) +L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, 0 A, + +PC ORG @ 1 + ! ( main ) +( STACK OVERFLOW PROTECTION: See B76 ) + SP 0xfffa LDddnn, + RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP ) + IX RS_ADDR LDddnn, +( HERE begins at RAMEND ) + HL RAMSTART 0x80 + LDddnn, + RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE ) +( LATEST is a label to the latest entry of the dict. It is + written at offset 0x08 by the process or person building + Forth. ) + 0x08 LDHL(nn), + RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT cont. ) diff --git a/blk/290 b/blk/290 new file mode 100644 index 0000000..9d29ae6 --- /dev/null +++ b/blk/290 @@ -0,0 +1,4 @@ + EXDEHL, + HL L1 @ LDddnn, + 0x03 CALLnn, ( 03 == find ) + 0x33 JPnn, ( 33 == execute ) diff --git a/blk/291 b/blk/291 new file mode 100644 index 0000000..0ab0445 --- /dev/null +++ b/blk/291 @@ -0,0 +1,16 @@ +PC ORG @ 4 + ! ( find ) +( Find the entry corresponding to word name where (HL) points + to in dictionary having its tip at DE and sets DE to point + to that entry. Z if found, NZ if not. ) + BC PUSHqq, + HL PUSHqq, + ( First, figure out string len ) + BC 0 LDddnn, + A XORr, + CPIR, + ( C has our length, negative, -1 ) + A C LDrr, + NEG, + A DECr, + ( special case. zero len? we never find anything. ) + JRZ, L1 FWR ( fail-B296 ) ( cont. ) diff --git a/blk/292 b/blk/292 new file mode 100644 index 0000000..51e1b0c --- /dev/null +++ b/blk/292 @@ -0,0 +1,16 @@ + C A LDrr, ( C holds our length ) +( Let's do something weird: We'll hold HL by the *tail*. + Because of our dict structure and because we know our + lengths, it's easier to compare starting from the end. + Currently, after CPIR, HL points to char after null. Let's + adjust. Because the compare loop pre-decrements, instead + of DECing HL twice, we DEC it once. ) + HL DECss, + BEGIN, ( inner ) + ( DE is a wordref, first step, do our len correspond? ) + HL PUSHqq, ( --> lvl 1 ) + DE PUSHqq, ( --> lvl 2 ) + DE DECss, + LDA(DE), + 0x7f ANDn, ( remove IMMEDIATE flag ) + C CPr, ( cont. ) diff --git a/blk/293 b/blk/293 new file mode 100644 index 0000000..80b2f7a --- /dev/null +++ b/blk/293 @@ -0,0 +1,16 @@ + JRNZ, L2 FWR ( loopend ) + ( match, let's compare the string then ) + DE DECss, ( Skip prev field. One less because we ) + DE DECss, ( pre-decrement ) + B C LDrr, ( loop C times ) + BEGIN, ( loop ) + ( pre-decrement for easier Z matching ) + DE DECss, + HL DECss, + LDA(DE), + (HL) CPr, + JRNZ, L3 FWR ( loopend ) + DJNZ, AGAIN, ( loop ) + L2 FSET L3 FSET ( loopend ) + + ( cont. ) diff --git a/blk/294 b/blk/294 new file mode 100644 index 0000000..8d4c58d --- /dev/null +++ b/blk/294 @@ -0,0 +1,16 @@ +( At this point, Z is set if we have a match. In all cases, + we want to pop HL and DE ) + DE POPqq, ( <-- lvl 2 ) + HL POPqq, ( <-- lvl 1 ) + JRZ, L2 FWR ( end-B296, match? we're done! ) + ( no match, go to prev and continue ) + HL PUSHqq, ( --> lvl 1 ) + DE DECss, + DE DECss, + DE DECss, ( prev field ) + DE PUSHqq, ( --> lvl 2 ) + EXDEHL, + E (HL) LDrr, + HL INCss, + D (HL) LDrr, + ( cont. ) diff --git a/blk/295 b/blk/295 new file mode 100644 index 0000000..d33893a --- /dev/null +++ b/blk/295 @@ -0,0 +1,16 @@ + ( DE contains prev offset ) + HL POPqq, ( <-- lvl 2 ) + ( HL is prev field's addr. Is offset zero? ) + A D LDrr, + E ORr, + IFNZ, + ( get absolute addr from offset ) + ( carry cleared from "or e" ) + DE SBCHLss, + EXDEHL, ( result in DE ) + THEN, + HL POPqq, ( <-- lvl 1 ) + JRNZ, AGAIN, ( inner-B292, try to match again ) + ( Z set? end of dict, unset Z ) + + ( cont. ) diff --git a/blk/296 b/blk/296 new file mode 100644 index 0000000..11cceb6 --- /dev/null +++ b/blk/296 @@ -0,0 +1,7 @@ + L1 FSET ( fail ) + A XORr, + A INCr, + L2 FSET ( end ) + HL POPqq, + BC POPqq, + RET, diff --git a/blk/297 b/blk/297 new file mode 100644 index 0000000..79ff1b1 --- /dev/null +++ b/blk/297 @@ -0,0 +1,13 @@ +PC ORG @ 0x12 + ! ( pushRS ) + IX INCss, + IX INCss, + 0 IX+ L LDIXYr, + 1 IX+ H LDIXYr, + RET, + +PC ORG @ 0x15 + ! ( popRS ) + L 0 IX+ LDrIXY, + H 1 IX+ LDrIXY, + IX DECss, + IX DECss, + RET, diff --git a/blk/298 b/blk/298 new file mode 100644 index 0000000..5714b62 --- /dev/null +++ b/blk/298 @@ -0,0 +1,7 @@ +'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A, +L2 BSET ( abortUnderflow ) + HL PC 7 - LDddnn, + DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT ) + 0x03 CALLnn, ( find ) + 0x33 JPnn, ( 33 == execute ) + diff --git a/blk/299 b/blk/299 new file mode 100644 index 0000000..295934b --- /dev/null +++ b/blk/299 @@ -0,0 +1,14 @@ +PC ORG @ 0x1e + ! ( chkPS ) + HL PUSHqq, + RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP ) +( We have the return address for this very call on the stack + and protected registers. Let's compensate ) + HL DECss, + HL DECss, + HL DECss, + HL DECss, + SP SUBHLss, + HL POPqq, + CNC RETcc, ( INITIAL_SP >= SP? good ) + JR, L2 BWR ( abortUnderflow-B298 ) + diff --git a/blk/300 b/blk/300 new file mode 100644 index 0000000..4ef0561 --- /dev/null +++ b/blk/300 @@ -0,0 +1,16 @@ +PC ORG @ 0x1b + ! ( next ) +( This routine is jumped to at the end of every word. In it, + we jump to current IP, but we also take care of increasing + it by 2 before jumping. ) + ( Before we continue: are stacks within bounds? ) + 0x1d CALLnn, ( chkPS ) + ( check RS ) + IX PUSHqq, HL POPqq, + DE RS_ADDR LDddnn, + DE SUBHLss, + JRC, L2 BWR ( IX < RS_ADDR? abortUnderflow-B298 ) + E 0 IY+ LDrIXY, + D 1 IY+ LDrIXY, + IY INCss, + IY INCss, + ( continue to execute ) diff --git a/blk/301 b/blk/301 new file mode 100644 index 0000000..aa6d312 --- /dev/null +++ b/blk/301 @@ -0,0 +1,12 @@ +L3 BSET +PC ORG @ 0x34 + ! ( execute ) + ( DE points to wordref ) + EXDEHL, + E (HL) LDrr, + D 0 LDrn, + EXDEHL, + ( HL points to code pointer ) + DE INCss, + ( DE points to PFA ) + JP(HL), + diff --git a/blk/302 b/blk/302 new file mode 100644 index 0000000..1d4708c --- /dev/null +++ b/blk/302 @@ -0,0 +1,16 @@ +L1 BSET +PC ORG @ 0x0f + ! ( compiledWord ) +( 1. Push current IP to RS + 2. Set new IP to the second atom of the list + 3. Execute the first atom of the list. ) + IY PUSHqq, HL POPqq, ( <-- IP ) + 0x11 CALLnn, ( 11 == pushRS ) + EXDEHL, ( HL points to PFA ) + ( While we increase, dereference into DE for execute call + later. ) + E (HL) LDrr, + HL INCss, + D (HL) LDrr, + HL INCss, + HL PUSHqq, IY POPqq, ( --> IP ) + JR, L3 BWR ( execute-B301 ) diff --git a/blk/303 b/blk/303 new file mode 100644 index 0000000..9ec293e --- /dev/null +++ b/blk/303 @@ -0,0 +1,5 @@ +PC ORG @ 0x0c + ! ( cellWord ) +( Pushes PFA directly ) + DE PUSHqq, + JPNEXT, + diff --git a/blk/304 b/blk/304 new file mode 100644 index 0000000..87bbec8 --- /dev/null +++ b/blk/304 @@ -0,0 +1,16 @@ +PC ORG @ 0x2c + ! ( doesWord ) +( The word was spawned from a definition word that has a + DOES>. PFA+2 (right after the actual cell) is a link to the + slot right after that DOES>. Therefore, what we need to do + push the cell addr like a regular cell, then follow the + linkfrom the PFA, and then continue as a regular + compiledWord. ) + DE PUSHqq, ( like a regular cell ) + EXDEHL, + HL INCss, + HL INCss, + E (HL) LDrr, + HL INCss, + D (HL) LDrr, + JR, L1 BWR ( compiledWord-B302 ) + diff --git a/blk/305 b/blk/305 new file mode 100644 index 0000000..49be451 --- /dev/null +++ b/blk/305 @@ -0,0 +1,9 @@ +( Core words ) +( KEY and EMIT are not defined here. There're + expected to be defined in platform-specific code. ) + + +CODE EXECUTE + DE POPqq, + chkPS, + JR, L3 BWR ( execute-B301 ) diff --git a/blk/306 b/blk/306 new file mode 100644 index 0000000..25ba6e4 --- /dev/null +++ b/blk/306 @@ -0,0 +1,11 @@ +( a b c -- b c a ) +CODE ROT + HL POPqq, ( C ) + DE POPqq, ( B ) + BC POPqq, ( A ) + chkPS, + DE PUSHqq, ( B ) + HL PUSHqq, ( C ) + BC PUSHqq, ( A ) +;CODE + diff --git a/blk/307 b/blk/307 new file mode 100644 index 0000000..fe3500a --- /dev/null +++ b/blk/307 @@ -0,0 +1,13 @@ +( a -- a a ) +CODE DUP + HL POPqq, ( A ) + chkPS, + HL PUSHqq, ( A ) + HL PUSHqq, ( A ) +;CODE + +( a -- ) +CODE DROP + HL POPqq, +;CODE + diff --git a/blk/308 b/blk/308 new file mode 100644 index 0000000..67dd0ce --- /dev/null +++ b/blk/308 @@ -0,0 +1,10 @@ +( a b -- b a ) +CODE SWAP + HL POPqq, ( B ) + DE POPqq, ( A ) + chkPS, + HL PUSHqq, ( B ) + DE PUSHqq, ( A ) +;CODE + + diff --git a/blk/309 b/blk/309 new file mode 100644 index 0000000..84754f4 --- /dev/null +++ b/blk/309 @@ -0,0 +1,11 @@ +( a b -- a b a ) +CODE OVER + HL POPqq, ( B ) + DE POPqq, ( A ) + chkPS, + DE PUSHqq, ( A ) + HL PUSHqq, ( B ) + DE PUSHqq, ( A ) +;CODE + + diff --git a/blk/310 b/blk/310 new file mode 100644 index 0000000..b1eef80 --- /dev/null +++ b/blk/310 @@ -0,0 +1,16 @@ +CODE PICK + HL POPqq, + chkPS, + ( x2 ) + L SLAr, H RLr, + SP ADDHLss, + C (HL) LDrr, + HL INCss, + B (HL) LDrr, + ( check PS range before returning ) + EXDEHL, + RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP ) + DE SUBHLss, + CC L2 @ JPccnn, ( abortUnderflow-B298 ) + BC PUSHqq, +;CODE diff --git a/blk/311 b/blk/311 new file mode 100644 index 0000000..73125da --- /dev/null +++ b/blk/311 @@ -0,0 +1,15 @@ +( Low-level part of ROLL. Example: + "1 2 3 4 4 (roll)" --> "1 3 4 4". No sanity checks, never + call with 0. ) +CODE (roll) + HL POPqq, + B H LDrr, + C L LDrr, + SP ADDHLss, + HL INCss, + D H LDrr, + E L LDrr, + HL DECss, + HL DECss, + LDDR, +;CODE diff --git a/blk/312 b/blk/312 new file mode 100644 index 0000000..554a599 --- /dev/null +++ b/blk/312 @@ -0,0 +1,8 @@ +( a b -- ) +CODE 2DROP + HL POPqq, + HL POPqq, + chkPS, +;CODE + + diff --git a/blk/313 b/blk/313 new file mode 100644 index 0000000..2e72338 --- /dev/null +++ b/blk/313 @@ -0,0 +1,11 @@ +CODE S0 + RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP ) + HL PUSHqq, +;CODE + +CODE 'S + HL 0 LDddnn, + SP ADDHLss, + HL PUSHqq, +;CODE + diff --git a/blk/314 b/blk/314 new file mode 100644 index 0000000..0f42c34 --- /dev/null +++ b/blk/314 @@ -0,0 +1,14 @@ +CODE AND + HL POPqq, + DE POPqq, + chkPS, + A E LDrr, + L ANDr, + L A LDrr, + A D LDrr, + H ANDr, + H A LDrr, + HL PUSHqq, +;CODE + + diff --git a/blk/315 b/blk/315 new file mode 100644 index 0000000..e78e6ce --- /dev/null +++ b/blk/315 @@ -0,0 +1,12 @@ +CODE OR + HL POPqq, + DE POPqq, + chkPS, + A E LDrr, + L ORr, + L A LDrr, + A D LDrr, + H ORr, + H A LDrr, + HL PUSHqq, +;CODE diff --git a/blk/316 b/blk/316 new file mode 100644 index 0000000..c5695ea --- /dev/null +++ b/blk/316 @@ -0,0 +1,12 @@ +CODE XOR + HL POPqq, + DE POPqq, + chkPS, + A E LDrr, + L XORr, + L A LDrr, + A D LDrr, + H XORr, + H A LDrr, + HL PUSHqq, +;CODE diff --git a/blk/317 b/blk/317 new file mode 100644 index 0000000..6962d0a --- /dev/null +++ b/blk/317 @@ -0,0 +1,8 @@ +CODE NOT + HL POPqq, + chkPS, + A L LDrr, + H ORr, + PUSHZ, +;CODE + diff --git a/blk/318 b/blk/318 new file mode 100644 index 0000000..a84b8b6 --- /dev/null +++ b/blk/318 @@ -0,0 +1,15 @@ +CODE + + HL POPqq, + DE POPqq, + chkPS, + DE ADDHLss, + HL PUSHqq, +;CODE + +CODE - + DE POPqq, + HL POPqq, + chkPS, + DE SUBHLss, + HL PUSHqq, +;CODE diff --git a/blk/319 b/blk/319 new file mode 100644 index 0000000..49ac4fa --- /dev/null +++ b/blk/319 @@ -0,0 +1,16 @@ +CODE * ( DE * BC -> DE (high) and HL (low) ) + DE POPqq, BC POPqq, chkPS, + HL 0 LDddnn, + A 0x10 LDrn, +( loop ) + HL ADDHLss, + E RLr, D RLr, + JRNC, 4 A, ( noinc ) + BC ADDHLss, + JRNC, 1 A, ( noinc ) + DE INCss, +( noinc ) + A DECr, + JRNZ, -14 A, ( loop ) + HL PUSHqq, +;CODE diff --git a/blk/320 b/blk/320 new file mode 100644 index 0000000..4b58b72 --- /dev/null +++ b/blk/320 @@ -0,0 +1,16 @@ +( Borrowed from http://wikiti.brandonw.net/ ) +( Divides AC by DE and places the quotient in AC and the + remainder in HL ) +CODE /MOD + DE POPqq, + BC POPqq, + chkPS, + A B LDrr, + B 16 LDrn, + HL 0 LDddnn, + + + + + + ( cont. ) diff --git a/blk/321 b/blk/321 new file mode 100644 index 0000000..521b9ab --- /dev/null +++ b/blk/321 @@ -0,0 +1,15 @@ + BEGIN, ( loop ) + SCF, + C RLr, + RLA, + HL ADCHLss, + DE SBCHLss, + IFC, + DE ADDHLss, + C DECr, + THEN, + DJNZ, AGAIN, ( loop ) + B A LDrr, + HL PUSHqq, + BC PUSHqq, +;CODE diff --git a/blk/322 b/blk/322 new file mode 100644 index 0000000..076a17c --- /dev/null +++ b/blk/322 @@ -0,0 +1,16 @@ +CODE ! + HL POPqq, + DE POPqq, + chkPS, + (HL) E LDrr, + HL INCss, + (HL) D LDrr, +;CODE +CODE @ + HL POPqq, + chkPS, + E (HL) LDrr, + HL INCss, + D (HL) LDrr, + DE PUSHqq, +;CODE diff --git a/blk/323 b/blk/323 new file mode 100644 index 0000000..746d380 --- /dev/null +++ b/blk/323 @@ -0,0 +1,14 @@ +CODE C! + HL POPqq, + DE POPqq, + chkPS, + (HL) E LDrr, +;CODE + +CODE C@ + HL POPqq, + chkPS, + L (HL) LDrr, + H 0 LDrn, + HL PUSHqq, +;CODE diff --git a/blk/324 b/blk/324 new file mode 100644 index 0000000..7e732d4 --- /dev/null +++ b/blk/324 @@ -0,0 +1,15 @@ +CODE PC! + BC POPqq, + HL POPqq, + chkPS, + L OUT(C)r, +;CODE + +CODE PC@ + BC POPqq, + chkPS, + H 0 LDrn, + L INr(C), + HL PUSHqq, +;CODE + diff --git a/blk/325 b/blk/325 new file mode 100644 index 0000000..1fae0c3 --- /dev/null +++ b/blk/325 @@ -0,0 +1,16 @@ +CODE I + L 0 IX+ LDrIXY, + H 1 IX+ LDrIXY, + HL PUSHqq, +;CODE +CODE I' + L 2 IX- LDrIXY, + H 1 IX- LDrIXY, + HL PUSHqq, +;CODE +CODE J + L 4 IX- LDrIXY, + H 3 IX- LDrIXY, + HL PUSHqq, +;CODE + diff --git a/blk/326 b/blk/326 new file mode 100644 index 0000000..11caee5 --- /dev/null +++ b/blk/326 @@ -0,0 +1,13 @@ +CODE >R + HL POPqq, + chkPS, + ( 17 == pushRS ) + 17 CALLnn, +;CODE + +CODE R> + ( 20 == popRS ) + 20 CALLnn, + HL PUSHqq, +;CODE + diff --git a/blk/327 b/blk/327 new file mode 100644 index 0000000..94c2e81 --- /dev/null +++ b/blk/327 @@ -0,0 +1,14 @@ +CODE BYE + HALT, +;CODE + +CODE (resSP) + ( INITIAL_SP == RAM+0 ) + SP RAMSTART LDdd(nn), +;CODE + +CODE (resRS) + IX RS_ADDR LDddnn, +;CODE + + diff --git a/blk/328 b/blk/328 new file mode 100644 index 0000000..b8f3ed0 --- /dev/null +++ b/blk/328 @@ -0,0 +1,16 @@ +CODE S= + DE POPqq, + HL POPqq, + chkPS, + BEGIN, ( loop ) + LDA(DE), + (HL) CPr, + JRNZ, L1 FWR ( not equal? break early to "end". + NZ is set. ) + A ORr, ( if our char is null, stop ) + HL INCss, + DE INCss, + JRNZ, AGAIN, ( loop ) +L1 FSET ( end ) + PUSHZ, +;CODE diff --git a/blk/329 b/blk/329 new file mode 100644 index 0000000..82c89a4 --- /dev/null +++ b/blk/329 @@ -0,0 +1,16 @@ +CODE CMP + HL POPqq, + DE POPqq, + chkPS, + DE SUBHLss, + BC 0 LDddnn, + IFNZ, ( < or > ) + BC INCss, + IFNC, ( < ) + BC DECss, + BC DECss, + THEN, + THEN, + BC PUSHqq, +;CODE + diff --git a/blk/330 b/blk/330 new file mode 100644 index 0000000..7629b60 --- /dev/null +++ b/blk/330 @@ -0,0 +1,16 @@ +CODE _find ( cur w -- a f ) + HL POPqq, ( w ) + DE POPqq, ( cur ) + chkPS, + ( 3 == find ) + 3 CALLnn, + IFNZ, + ( not found ) + HL PUSHqq, + PUSH0, + JPNEXT, + THEN, + ( found ) + DE PUSHqq, + PUSH1, +;CODE diff --git a/blk/331 b/blk/331 new file mode 100644 index 0000000..c617fa3 --- /dev/null +++ b/blk/331 @@ -0,0 +1,14 @@ +CODE (im1) + IM1, + EI, +;CODE + +CODE 0 PUSH0, ;CODE +CODE 1 PUSH1, ;CODE + +CODE -1 + HL -1 LDddnn, + HL PUSHqq, +;CODE + + diff --git a/blk/332 b/blk/332 new file mode 100644 index 0000000..5e9418f --- /dev/null +++ b/blk/332 @@ -0,0 +1,14 @@ +CODE 1+ + HL POPqq, + chkPS, + HL INCss, + HL PUSHqq, +;CODE + +CODE 1- + HL POPqq, + chkPS, + HL DECss, + HL PUSHqq, +;CODE + diff --git a/blk/333 b/blk/333 new file mode 100644 index 0000000..8cdfa42 --- /dev/null +++ b/blk/333 @@ -0,0 +1,16 @@ +CODE 2+ + HL POPqq, + chkPS, + HL INCss, + HL INCss, + HL PUSHqq, +;CODE + +CODE 2- + HL POPqq, + chkPS, + HL DECss, + HL DECss, + HL PUSHqq, +;CODE + diff --git a/forth/blk.fs b/forth/blk.fs index 7e9d610..fa2fb19 100644 --- a/forth/blk.fs +++ b/forth/blk.fs @@ -86,3 +86,6 @@ R> DROP ( BLK> ) THEN ; + +( b1 b2 -- ) +: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;