From bd38d80f9c5fd5cf67eb3623c28aac2d2f812a56 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Fri, 15 May 2020 22:44:49 -0400 Subject: [PATCH] Move Cross-compiled core from B390 to B350 and renamed it "Core words". Also, reworded the presentation. --- blk/001 | 2 +- blk/350 | 16 ++++++++++++++++ blk/351 | 16 ++++++++++++++++ blk/352 | 9 +++++++++ blk/353 | 15 +++++++++++++++ blk/354 | 12 ++++++++++++ blk/{395 => 355} | 0 blk/356 | 11 +++++++++++ blk/357 | 16 ++++++++++++++++ blk/358 | 11 +++++++++++ blk/359 | 8 ++++++++ blk/360 | 15 +++++++++++++++ blk/{401 => 361} | 0 blk/{402 => 362} | 0 blk/{403 => 363} | 0 blk/{404 => 364} | 0 blk/{405 => 365} | 0 blk/{406 => 366} | 0 blk/{407 => 367} | 0 blk/{408 => 368} | 0 blk/{409 => 369} | 0 blk/{410 => 370} | 0 blk/{411 => 371} | 0 blk/{412 => 372} | 0 blk/{413 => 373} | 0 blk/{414 => 374} | 0 blk/{416 => 376} | 0 blk/{417 => 377} | 0 blk/{418 => 378} | 0 blk/{420 => 380} | 0 blk/{421 => 381} | 0 blk/{422 => 382} | 0 blk/{423 => 383} | 0 blk/{424 => 384} | 0 blk/{425 => 385} | 0 blk/{426 => 386} | 0 blk/{427 => 387} | 0 blk/{428 => 388} | 0 blk/{429 => 389} | 0 blk/390 | 23 ++++++++++------------- blk/391 | 27 ++++++++++++--------------- blk/392 | 24 +++++++++++++++--------- blk/393 | 31 ++++++++++++++++--------------- blk/394 | 16 ++++------------ blk/396 | 25 ++++++++++++++----------- blk/397 | 31 +++++++++++++++---------------- blk/398 | 23 +++++++++++++---------- blk/399 | 17 +++++++++-------- blk/400 | 26 +++++++++++--------------- blk/430 | 11 ----------- blk/431 | 13 ------------- blk/432 | 15 --------------- blk/433 | 16 ---------------- blk/434 | 4 ---- blk/436 | 14 -------------- blk/437 | 15 --------------- blk/438 | 14 -------------- blk/439 | 9 --------- blk/440 | 11 ----------- blk/618 | 4 ++-- emul/xcomp.fs | 4 ++-- recipes/sms/xcomp.fs | 4 ++-- recipes/ti84/xcomp.fs | 4 ++-- recipes/trs80/xcomp.fs | 4 ++-- 64 files changed, 259 insertions(+), 257 deletions(-) create mode 100644 blk/350 create mode 100644 blk/351 create mode 100644 blk/352 create mode 100644 blk/353 create mode 100644 blk/354 rename blk/{395 => 355} (100%) create mode 100644 blk/356 create mode 100644 blk/357 create mode 100644 blk/358 create mode 100644 blk/359 create mode 100644 blk/360 rename blk/{401 => 361} (100%) rename blk/{402 => 362} (100%) rename blk/{403 => 363} (100%) rename blk/{404 => 364} (100%) rename blk/{405 => 365} (100%) rename blk/{406 => 366} (100%) rename blk/{407 => 367} (100%) rename blk/{408 => 368} (100%) rename blk/{409 => 369} (100%) rename blk/{410 => 370} (100%) rename blk/{411 => 371} (100%) rename blk/{412 => 372} (100%) rename blk/{413 => 373} (100%) rename blk/{414 => 374} (100%) rename blk/{416 => 376} (100%) rename blk/{417 => 377} (100%) rename blk/{418 => 378} (100%) rename blk/{420 => 380} (100%) rename blk/{421 => 381} (100%) rename blk/{422 => 382} (100%) rename blk/{423 => 383} (100%) rename blk/{424 => 384} (100%) rename blk/{425 => 385} (100%) rename blk/{426 => 386} (100%) rename blk/{427 => 387} (100%) rename blk/{428 => 388} (100%) rename blk/{429 => 389} (100%) delete mode 100644 blk/430 delete mode 100644 blk/431 delete mode 100644 blk/432 delete mode 100644 blk/433 delete mode 100644 blk/434 delete mode 100644 blk/436 delete mode 100644 blk/437 delete mode 100644 blk/438 delete mode 100644 blk/439 delete mode 100644 blk/440 diff --git a/blk/001 b/blk/001 index 82c2ef6..202fd2b 100644 --- a/blk/001 +++ b/blk/001 @@ -5,7 +5,7 @@ MASTER INDEX 120 Linker 140 Addressed devices 150 Extra words 200 Z80 assembler 260 Cross compilation -280 Z80 boot code 390 Cross-compiled core +280 Z80 boot code 350 Core words 490 TRS-80 Recipe 520 Fonts 550 TI-84+ Recipe 580 RC2014 Recipe 620 Sega Master System Recipe diff --git a/blk/350 b/blk/350 new file mode 100644 index 0000000..7083c02 --- /dev/null +++ b/blk/350 @@ -0,0 +1,16 @@ +Core words + +This section contains arch-independent core words of Collapse +OS. Those words are written in a way that make them entirely +cross-compilable (see B260). When building Collapse OS, these +words come right after the boot binary (B280). + +Because this unit is designed to be cross-compiled, things are +a little weird. It is compiling in the context of a full +Forth interpreter with all bells and whistles (and z80 +assembler), but it has to obey strict rules: + +1. Although it cannot compile a word that isn't defined yet, + it can still execute an immediate from the host system. + + (cont.) diff --git a/blk/351 b/blk/351 new file mode 100644 index 0000000..d1e0f66 --- /dev/null +++ b/blk/351 @@ -0,0 +1,16 @@ +2. Immediate words that have been cross compiled *cannot* be + used. Only immediates from the host system can be used. +3. If an immediate word compiles words, it can only be words + that are part of the stable ABI. + +All of this is because when cross compiling, all atom ref- +erences are offsetted to the target system and are thus +unusable directly. For the same reason, any reference to a word +in the host system will obviously be wrong in the target +system. More details in B260. + + + + + + (cont.) diff --git a/blk/352 b/blk/352 new file mode 100644 index 0000000..f80571b --- /dev/null +++ b/blk/352 @@ -0,0 +1,9 @@ +This unit is loaded in two "low" and "high" parts. The low part +is the biggest chunk and has the most definitions. The high +part is the "sensitive" chunk and contains "LITN", ":" and ";" +definitions which, once defined, kind of make any more defs +impossible. + +The gap between these 2 parts is the ideal place to put device +driver code. Load the low part with "353 LOAD", the high part +with "380 LOAD" diff --git a/blk/353 b/blk/353 new file mode 100644 index 0000000..d176462 --- /dev/null +++ b/blk/353 @@ -0,0 +1,15 @@ +: RAM+ [ RAMSTART LITN ] + ; +: BIN+ [ BIN( @ LITN ] + ; +: HERE 0x04 RAM+ ; +: CURRENT* 0x51 RAM+ ; +: CURRENT CURRENT* @ ; + +( w -- a f ) +: FIND CURRENT @ SWAP _find ; + +: QUIT + (resRS) + 0 0x08 RAM+ ! ( 08 == C<* override ) + LIT< (main) FIND DROP EXECUTE +; +1 25 LOADR+ ( xcomp core low ) diff --git a/blk/354 b/blk/354 new file mode 100644 index 0000000..99faa9c --- /dev/null +++ b/blk/354 @@ -0,0 +1,12 @@ +: ABORT (resSP) QUIT ; +: ERR LIT< (print) FIND IF EXECUTE THEN ABORT ; +: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; +: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ; +: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ; +: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ; +: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ; +: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; +: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; +: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ; +: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; +: C!- ( c a -- a-1 ) SWAP OVER C! 1- ; diff --git a/blk/395 b/blk/355 similarity index 100% rename from blk/395 rename to blk/355 diff --git a/blk/356 b/blk/356 new file mode 100644 index 0000000..0cface1 --- /dev/null +++ b/blk/356 @@ -0,0 +1,11 @@ +( parsed is tight, all comments ahead. We read the first char + outside of the loop because it *has* to be nonzero, which + means _pdacc *has* to return 0. + + Then, we check for '-'. If we get it, we advance by one, + recurse and invert result. + + We loop until _pdacc is nonzero, which means either WS or + non-digit. 1 means WS, which means parsing was a success. + -1 means non-digit, which means we have a non-decimal. ) + diff --git a/blk/357 b/blk/357 new file mode 100644 index 0000000..92dde38 --- /dev/null +++ b/blk/357 @@ -0,0 +1,16 @@ +: (parsed) ( a -- n f ) + DUP C@ ( a c ) + DUP '-' = IF + DROP 1+ ( a+1 ) (parsed) 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 0 ) + DROP 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 ) ; diff --git a/blk/358 b/blk/358 new file mode 100644 index 0000000..d7cb9b0 --- /dev/null +++ b/blk/358 @@ -0,0 +1,11 @@ +( strings being sent to parse routines are always null + terminated ) + +: (parsec) ( a -- n f ) + ( apostrophe is ASCII 39 ) + DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f ) + NOT IF 0 EXIT THEN ( a 0 ) + ( surrounded by apos, good, return ) + 1+ C@ 1 ( n 1 ) +; + diff --git a/blk/359 b/blk/359 new file mode 100644 index 0000000..1b5d0e8 --- /dev/null +++ b/blk/359 @@ -0,0 +1,8 @@ +( returns negative value on error ) +: _ ( c -- n ) + DUP '0' '9' =><= IF '0' - EXIT THEN + DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN + DROP -1 ( bad ) +; + + diff --git a/blk/360 b/blk/360 new file mode 100644 index 0000000..e400a39 --- /dev/null +++ b/blk/360 @@ -0,0 +1,15 @@ +: (parseh) ( a -- n f ) + ( '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 2DROP 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 +; + diff --git a/blk/401 b/blk/361 similarity index 100% rename from blk/401 rename to blk/361 diff --git a/blk/402 b/blk/362 similarity index 100% rename from blk/402 rename to blk/362 diff --git a/blk/403 b/blk/363 similarity index 100% rename from blk/403 rename to blk/363 diff --git a/blk/404 b/blk/364 similarity index 100% rename from blk/404 rename to blk/364 diff --git a/blk/405 b/blk/365 similarity index 100% rename from blk/405 rename to blk/365 diff --git a/blk/406 b/blk/366 similarity index 100% rename from blk/406 rename to blk/366 diff --git a/blk/407 b/blk/367 similarity index 100% rename from blk/407 rename to blk/367 diff --git a/blk/408 b/blk/368 similarity index 100% rename from blk/408 rename to blk/368 diff --git a/blk/409 b/blk/369 similarity index 100% rename from blk/409 rename to blk/369 diff --git a/blk/410 b/blk/370 similarity index 100% rename from blk/410 rename to blk/370 diff --git a/blk/411 b/blk/371 similarity index 100% rename from blk/411 rename to blk/371 diff --git a/blk/412 b/blk/372 similarity index 100% rename from blk/412 rename to blk/372 diff --git a/blk/413 b/blk/373 similarity index 100% rename from blk/413 rename to blk/373 diff --git a/blk/414 b/blk/374 similarity index 100% rename from blk/414 rename to blk/374 diff --git a/blk/416 b/blk/376 similarity index 100% rename from blk/416 rename to blk/376 diff --git a/blk/417 b/blk/377 similarity index 100% rename from blk/417 rename to blk/377 diff --git a/blk/418 b/blk/378 similarity index 100% rename from blk/418 rename to blk/378 diff --git a/blk/420 b/blk/380 similarity index 100% rename from blk/420 rename to blk/380 diff --git a/blk/421 b/blk/381 similarity index 100% rename from blk/421 rename to blk/381 diff --git a/blk/422 b/blk/382 similarity index 100% rename from blk/422 rename to blk/382 diff --git a/blk/423 b/blk/383 similarity index 100% rename from blk/423 rename to blk/383 diff --git a/blk/424 b/blk/384 similarity index 100% rename from blk/424 rename to blk/384 diff --git a/blk/425 b/blk/385 similarity index 100% rename from blk/425 rename to blk/385 diff --git a/blk/426 b/blk/386 similarity index 100% rename from blk/426 rename to blk/386 diff --git a/blk/427 b/blk/387 similarity index 100% rename from blk/427 rename to blk/387 diff --git a/blk/428 b/blk/388 similarity index 100% rename from blk/428 rename to blk/388 diff --git a/blk/429 b/blk/389 similarity index 100% rename from blk/429 rename to blk/389 diff --git a/blk/390 b/blk/390 index 430b8c9..498ec64 100644 --- a/blk/390 +++ b/blk/390 @@ -1,14 +1,11 @@ -Cross-compiled core +( Initializes the readln subsystem ) +: RDLN$ + H@ 0x32 ( IN(* ) RAM+ ! + ( plus 2 for extra bytes after buffer: 1 for + the last typed 0x0a and one for the following NULL. ) + IN) IN( - ALLOT + (infl) + ['] RDLN< 0x0c RAM+ ! + 1 0x06 RAM+ ! ( 06 == C @ >R ( save restorable variables to RSP ) + 0x08 RAM+ @ >R ( 08 == C<* override ) + 0x06 RAM+ @ >R ( CR ( boot ptr ) + BLK@ + BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) + ['] (boot<) 0x08 RAM+ ! + 1 0x06 RAM+ ! ( 06 == C 0x2e RAM+ ! R> 0x06 RAM+ ! + I 0x08 RAM+ @ = IF ( nested load ) + R> DROP ( C<* ) R> BLK@ + ELSE ( not nested ) + R> 0x08 RAM+ ! R> DROP ( BLK> ) + THEN ; diff --git a/blk/394 b/blk/394 index 99faa9c..db838a0 100644 --- a/blk/394 +++ b/blk/394 @@ -1,12 +1,4 @@ -: ABORT (resSP) QUIT ; -: ERR LIT< (print) FIND IF EXECUTE THEN ABORT ; -: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; -: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ; -: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ; -: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ; -: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ; -: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; -: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; -: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ; -: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; -: C!- ( c a -- a-1 ) SWAP OVER C! 1- ; +: LOAD+ BLK> @ + LOAD ; +( b1 b2 -- ) +: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; +: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; diff --git a/blk/396 b/blk/396 index 0cface1..c03e900 100644 --- a/blk/396 +++ b/blk/396 @@ -1,11 +1,14 @@ -( parsed is tight, all comments ahead. We read the first char - outside of the loop because it *has* to be nonzero, which - means _pdacc *has* to return 0. - - Then, we check for '-'. If we get it, we advance by one, - recurse and invert result. - - We loop until _pdacc is nonzero, which means either WS or - non-digit. 1 means WS, which means parsing was a success. - -1 means non-digit, which means we have a non-decimal. ) - +: (main) INTERPRET BYE ; +: BOOT + 0x02 RAM+ CURRENT* ! + CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) + 0 0x08 RAM+ ! ( 08 == C<* override ) + 0 0x53 RAM+ ! ( 53 == (emit) override ) + 0 0x55 RAM+ ! ( 55 == (key) override ) + 0 0x0a RAM+ ! ( NLPTR ) + ( 0c == C<* ) + ['] (boot<) 0x0c RAM+ ! + ( boot< always has a char waiting. 06 == CR H@ ; IMMEDIATE +: LOOP COMPILE (loop) H@ - , ; IMMEDIATE +( LEAVE is implemented in low xcomp ) +: LITN 32 , , ( 32 == NUMBER ) ; +( gets its name at the very end. can't comment afterwards ) +: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE +: _ ( : will get its name almost at the very end ) + (entry) + [ 14 ( == compiledWord ) LITN ] C, + BEGIN + WORD FIND + IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN + ELSE ( maybe number ) (parse) LITN THEN + AGAIN ; diff --git a/blk/398 b/blk/398 index d7cb9b0..77d6f42 100644 --- a/blk/398 +++ b/blk/398 @@ -1,11 +1,14 @@ -( strings being sent to parse routines are always null - terminated ) - -: (parsec) ( a -- n f ) - ( apostrophe is ASCII 39 ) - DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f ) - NOT IF 0 EXIT THEN ( a 0 ) - ( surrounded by apos, good, return ) - 1+ C@ 1 ( n 1 ) -; +: IF ( -- a | a: br cell addr ) + COMPILE (?br) H@ 2 ALLOT ( br cell allot ) +; IMMEDIATE +: THEN ( a -- | a: br cell addr ) + DUP H@ -^ SWAP ( a-H a ) ! +; IMMEDIATE +: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) + COMPILE (br) + 2 ALLOT + DUP H@ -^ SWAP ( a-H a ) + ! + H@ 2- ( push a. -2 for allot offset ) +; IMMEDIATE diff --git a/blk/399 b/blk/399 index 1b5d0e8..0f2a5e5 100644 --- a/blk/399 +++ b/blk/399 @@ -1,8 +1,9 @@ -( returns negative value on error ) -: _ ( c -- n ) - DUP '0' '9' =><= IF '0' - EXIT THEN - DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN - DROP -1 ( bad ) -; - - +: BEGIN H@ ; IMMEDIATE +: AGAIN COMPILE (br) H@ - , ; IMMEDIATE +: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE +: [ INTERPRET ; IMMEDIATE +: ] R> DROP ; +: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE +: LITA 36 , , ; +: COMPILE ' LITA ['] , , ; IMMEDIATE +: [COMPILE] ' , ; IMMEDIATE diff --git a/blk/400 b/blk/400 index e400a39..8a6db82 100644 --- a/blk/400 +++ b/blk/400 @@ -1,15 +1,11 @@ -: (parseh) ( a -- n f ) - ( '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 2DROP 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 -; - +( ';' can't have its name right away because, when created, it + is not an IMMEDIATE yet and will not be treated properly by + xcomp. ) +: _ + ['] EXIT , + R> DROP ( exit : ) +; IMMEDIATE +: ['] ' LITA ; IMMEDIATE +';' X' _ 4 - C! ( give ; its name ) +':' X' _ 4 - C! ( give : its name ) +'(' X' _ 4 - C! diff --git a/blk/430 b/blk/430 deleted file mode 100644 index 498ec64..0000000 --- a/blk/430 +++ /dev/null @@ -1,11 +0,0 @@ -( Initializes the readln subsystem ) -: RDLN$ - H@ 0x32 ( IN(* ) RAM+ ! - ( plus 2 for extra bytes after buffer: 1 for - the last typed 0x0a and one for the following NULL. ) - IN) IN( - ALLOT - (infl) - ['] RDLN< 0x0c RAM+ ! - 1 0x06 RAM+ ! ( 06 == C @ >R ( save restorable variables to RSP ) - 0x08 RAM+ @ >R ( 08 == C<* override ) - 0x06 RAM+ @ >R ( CR ( boot ptr ) - BLK@ - BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) - ['] (boot<) 0x08 RAM+ ! - 1 0x06 RAM+ ! ( 06 == C 0x2e RAM+ ! R> 0x06 RAM+ ! - I 0x08 RAM+ @ = IF ( nested load ) - R> DROP ( C<* ) R> BLK@ - ELSE ( not nested ) - R> 0x08 RAM+ ! R> DROP ( BLK> ) - THEN ; diff --git a/blk/434 b/blk/434 deleted file mode 100644 index db838a0..0000000 --- a/blk/434 +++ /dev/null @@ -1,4 +0,0 @@ -: LOAD+ BLK> @ + LOAD ; -( b1 b2 -- ) -: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; -: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; diff --git a/blk/436 b/blk/436 deleted file mode 100644 index c03e900..0000000 --- a/blk/436 +++ /dev/null @@ -1,14 +0,0 @@ -: (main) INTERPRET BYE ; -: BOOT - 0x02 RAM+ CURRENT* ! - CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) - 0 0x08 RAM+ ! ( 08 == C<* override ) - 0 0x53 RAM+ ! ( 53 == (emit) override ) - 0 0x55 RAM+ ! ( 55 == (key) override ) - 0 0x0a RAM+ ! ( NLPTR ) - ( 0c == C<* ) - ['] (boot<) 0x0c RAM+ ! - ( boot< always has a char waiting. 06 == CR H@ ; IMMEDIATE -: LOOP COMPILE (loop) H@ - , ; IMMEDIATE -( LEAVE is implemented in low xcomp ) -: LITN 32 , , ( 32 == NUMBER ) ; -( gets its name at the very end. can't comment afterwards ) -: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE -: _ ( : will get its name almost at the very end ) - (entry) - [ 14 ( == compiledWord ) LITN ] C, - BEGIN - WORD FIND - IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN - ELSE ( maybe number ) (parse) LITN THEN - AGAIN ; diff --git a/blk/438 b/blk/438 deleted file mode 100644 index 77d6f42..0000000 --- a/blk/438 +++ /dev/null @@ -1,14 +0,0 @@ -: IF ( -- a | a: br cell addr ) - COMPILE (?br) H@ 2 ALLOT ( br cell allot ) -; IMMEDIATE -: THEN ( a -- | a: br cell addr ) - DUP H@ -^ SWAP ( a-H a ) ! -; IMMEDIATE -: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) - COMPILE (br) - 2 ALLOT - DUP H@ -^ SWAP ( a-H a ) - ! - H@ 2- ( push a. -2 for allot offset ) -; IMMEDIATE - diff --git a/blk/439 b/blk/439 deleted file mode 100644 index 0f2a5e5..0000000 --- a/blk/439 +++ /dev/null @@ -1,9 +0,0 @@ -: BEGIN H@ ; IMMEDIATE -: AGAIN COMPILE (br) H@ - , ; IMMEDIATE -: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE -: [ INTERPRET ; IMMEDIATE -: ] R> DROP ; -: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE -: LITA 36 , , ; -: COMPILE ' LITA ['] , , ; IMMEDIATE -: [COMPILE] ' , ; IMMEDIATE diff --git a/blk/440 b/blk/440 deleted file mode 100644 index 8a6db82..0000000 --- a/blk/440 +++ /dev/null @@ -1,11 +0,0 @@ -( ';' can't have its name right away because, when created, it - is not an IMMEDIATE yet and will not be treated properly by - xcomp. ) -: _ - ['] EXIT , - R> DROP ( exit : ) -; IMMEDIATE -: ['] ' LITA ; IMMEDIATE -';' X' _ 4 - C! ( give ; its name ) -':' X' _ 4 - C! ( give : its name ) -'(' X' _ 4 - C! diff --git a/blk/618 b/blk/618 index eabcb41..2a1e41e 100644 --- a/blk/618 +++ b/blk/618 @@ -6,9 +6,9 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM 212 LOAD ( z80 assembler ) 262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides ) -282 LOAD ( boot.z80 ) 393 LOAD ( xcomp core low ) +282 LOAD ( boot.z80 ) 353 LOAD ( xcomp core low ) 582 LOAD ( acia ) -420 LOAD ( xcomp core high ) +380 LOAD ( xcomp core high ) (entry) _ ( Update LATEST ) PC ORG @ 8 + ! diff --git a/emul/xcomp.fs b/emul/xcomp.fs index 82ead99..786c693 100644 --- a/emul/xcomp.fs +++ b/emul/xcomp.fs @@ -6,7 +6,7 @@ 270 LOAD ( xcomp overrides ) 282 LOAD ( boot.z80 ) -393 LOAD ( xcomp core low ) +353 LOAD ( xcomp core low ) : (emit) 0 PC! ; : (key) 0 PC@ ; : EFS@ @@ -23,7 +23,7 @@ LOOP ; -420 LOAD ( xcomp core high ) +380 LOAD ( xcomp core high ) (entry) _ ( Update LATEST ) PC ORG @ 8 + ! diff --git a/recipes/sms/xcomp.fs b/recipes/sms/xcomp.fs index 7318f3d..52eddc9 100644 --- a/recipes/sms/xcomp.fs +++ b/recipes/sms/xcomp.fs @@ -23,11 +23,11 @@ RETN, 0x98 ZFILL, ( 0x100 ) CURRENT @ XCURRENT ! 0x100 BIN( ! 282 LOAD ( boot.z80 ) -393 LOAD ( xcomp core low ) +353 LOAD ( xcomp core low ) CREATE ~FNT CPFNT7x7 623 628 LOADR ( VDP ) 632 637 LOADR ( PAD ) -420 LOAD ( xcomp core high ) +380 LOAD ( xcomp core high ) (entry) _ ( Update LATEST ) PC ORG @ 8 + ! diff --git a/recipes/ti84/xcomp.fs b/recipes/ti84/xcomp.fs index 8313ea2..5a0569e 100644 --- a/recipes/ti84/xcomp.fs +++ b/recipes/ti84/xcomp.fs @@ -60,11 +60,11 @@ CURRENT @ XCURRENT ! 0x100 BIN( ! 282 LOAD ( boot.z80 ) -393 LOAD ( xcomp core low ) +353 LOAD ( xcomp core low ) CREATE ~FNT CPFNT3x5 555 560 LOADR ( LCD low ) 566 570 LOADR ( KBD low ) -420 LOAD ( xcomp core high ) +380 LOAD ( xcomp core high ) (entry) _ ( Update LATEST ) PC ORG @ 8 + ! diff --git a/recipes/trs80/xcomp.fs b/recipes/trs80/xcomp.fs index e69a94a..48fb3ba 100644 --- a/recipes/trs80/xcomp.fs +++ b/recipes/trs80/xcomp.fs @@ -7,9 +7,9 @@ RS_ADDR 0x80 - CONSTANT RAMSTART 0x3000 BIN( ! 282 LOAD ( boot.z80 ) -393 LOAD ( xcomp core low ) +353 LOAD ( xcomp core low ) 492 LOAD ( trs80 ) -420 LOAD ( xcomp core high ) +380 LOAD ( xcomp core high ) (entry) _ ( Update LATEST ) PC ORG @ 8 + !