Fonto de Afera (parto 2: modjul-nomoj A-C)
Priskribo de la ĉi-paĝa enhavo
Tria parto de la fontoj de la biblioteko Afera por Abersoft Forth.
Etikedoj:
Fontkodo
\ afera.fsb
\ Main file of the Afera library for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015,2016 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Description
\ This is the main file of the Afera library.
\
\ It defines words required by other modules or that are
\ considered essential;
\
\ it patches the system with faster code that doesn't use
\ additional memory;
\
\ it fixes most of the known bugs of the system.
\ -----------------------------------------------------------
\ History
\ See at the end of the file.
\ -----------------------------------------------------------
\ Error messages
\ Abersoft Forth error messages are 0..24. Afera implements
\ the following new messages:
\
\ 25 Unsupported tape operation.
\ 26 Unsupported disk operation.
\ 27 Source file needed.
( CHAR [CHAR] , line comments)
." Afera" CR FORTH DEFINITIONS HEX
: CHAR ( "name" -- c ) BL WORD HERE 1+ C@ ;
: [CHAR] ( "name" -- c ) CHAR [COMPILE] LITERAL ; IMMEDIATE
: \ ( "ccc<newline>" -- )
IN @ C/L MOD C/L SWAP - IN +! ; IMMEDIATE
: .( ( "ccc<paren>" -- )
[CHAR] ) TEXT PAD COUNT TYPE ; IMMEDIATE
-->
( Bug fixes and patches)
\ ............................................
\ Fix the "11263" bug
\ The length of the RAM-disk must be 11264 (0x2C00), `HI LO -
\ 1+`, not 11263 (0x2BFF), `HI LO -`.
\ Length of the RAM-disk:
HI LO - 1+ CONSTANT /DISC
\ Patch the load tape header (no need to patch also the save
\ header, because the load header is copied to the save
\ header during the tape operations) and `INIT-DISC`:
/DISC DUP 75E6 0B + ! ' INIT-DISC 06 + !
\ ............................................
\ Fix the `2OVER` bug
\ `2OVER` must do `R> R>` at the end, not `>R >R`
\
\ As Don Thomasson's _Advanced Spectrum Forth_ (1984) says
\ (page 131), early versions of Abersoft Forth contained an
\ error in the word `2OVER`, that hangs the system. So just
\ in case:
' R> CFA ' 2OVER 0A + 2DUP ! 2+ !
\ ............................................
\ Fix the `EXIT` bug
\ `EXIT` must do `R> DROP`, not `>R DROP`
\
\ Even Don Thomasson's _Advanced Spectrum Forth_ (1984) shows
\ the wrong definition of `EXIT` (page 131)... and with the
\ following notice: "This word needs to be used with extreme
\ care." Indeed, because it crashes the system. The fix is
\ easy:
' R> CFA ' EXIT !
\ ............................................
\ Fix the `COLD` bug
\ The word `COLD` has a subtle bug: it inits `PREV` and `USE`
\ not with `FIRST`, the constant that holds the start address
\ of the first disk buffer, but with its default value! This
\ must be fixed in order to move the disk buffers (what does
\ the module <lowersys.fsb>).
\ Compile the patched version of `COLD`.
HERE ] EMPTY-BUFFERS FIRST USE ! FIRST PREV ! DR0
5E52 5E66 @ 6 + 10 CMOVE 5E4C @ 6CF8 ! ABORT [
\ XXX Space freed: 4 bytes at 0x6E06
\ Patch `COLD` and free the used space.
DUP ' COLD OVER HERE SWAP - CMOVE DP !
\ ............................................
\ Safer `MON`
\ The word `MON` does nothing when the address 0x5CB0
\ contains a value other than 0. It seems an undocumented way
\ to deactivate the exit to BASIC. 0x5CB0 is an unused
\ system variable in ZX Spectrum, except the +2A and +3
\ models, where it's NMIADD.
\ Make `MON` to return to BASIC, without checking NMIADD.
763D ' MON CFA !
\ ............................................
\ Fix the `0 MESSAGE` bug
\ The word `MESSAGE` does not print error message number 0
\ when `WARNING` is 1, in other words, when error messages
\ are the text of a line relative to screen 4. This
\ condition is in other fig-Forth implementations, but in
\ Abersoft Forth it can be regarded as a bug, because error
\ number 0 is used by the system ("Word not found"), and
\ therefore its text is not printed when `WARNING` is 1.
\
\ The following patch removes the buggy condition:
' NOOP CFA DUP 6F97 ! DUP 6F99 ! 6F9B !
\ ............................................
\ Fix the `GOVER` and `INVERSE` bug
\ The words `GOVER` and `INVERSE` use `!` twice in order to
\ update the system variable P FLAG (at 0x5C91), but this
\ variable ocuppies one byte, therefore `!` could corrupt the
\ next system variable, MEMBOT. `C!` must be used instead.
' C! CFA DUP DUP DUP 7E5B ! 7E71 ! 7E95 ! 7EAB !
\ ............................................
\ Fix the hardcoded addresses of the RAM-disk
\ Abersoft Forth uses the address returned by `LO` (the start
\ of the Forth RAM-disk, 0xD000) hardcoded as a literal
\ instead of calling `LO` (for words written in Forth) or
\ fetching the value from the pfa of `LO` (for words written
\ in Z80).
\
\ This is a problem for the module <hi-to.fsb>, that moves
\ the RAM-disk and changes the values of `LO` and `HI`.
\
\ A partial fix is provided here, just in case any other
\ future module needs to manipulate the RAM-disk addresses.
\ In `INIT-DISC`, change the literal 0xD000 to `LO`:
' INIT-DISC ' NOOP CFA OVER ! ' LO CFA SWAP 2+ !
\ Also the primitive word `(TAPE)` contais the hardcoded
\ address of the RAM-disk. It could be patched the following
\ way, converting `ld hl,0xD000` to `ld hl,(lo_pfa)`:
\ ' (TAPE) 5 + 2A OVER C! ' LO SWAP 1+ !
\ But there's a problem: the module <tape.fsb> patches the
\ address of that same Z80 instruction, `ld hl,0xD000` in
\ order to load from or save to tape other files than Forth
\ RAM-disks, therefore also the Z80 opcode would have to be
\ modified. It's easier to keep the original opcode and patch
\ only the value.
\ Also the tape headers (load header at 0x75E6, save header
\ at 0x75F7) must be patched, but that can be done only when
\ the new value of `LO` is known.
\ See the modules <hi-to.fsb> and <tape.fsb> for more
\ details.
\ ............................................
\ Cosmetic patches
\ No `CLS` in `INDEX`.
\ no `DECIMAL` in `LIST`
\ Smaller margin in `LIST`.
' NOOP CFA ' INDEX ! ' NOOP CFA ' LIST ! 2 ' LIST 23 + !
\ ............................................
\ Bugs not fixed yet
\ `MESSAGE` does not work with odd negative numbers: it
\ prints the contents of an unknown memory zone. The problem
\ is the calculation done by `(LINE)`. In fact `*/MOD`, `MOD`
\ and `/MOD`, with certain negative values, return different
\ results in Abersoft Forth and other Forth systems that have
\ been tested (some of them are fig-Forth). The problem
\ seems to be in Abersoft Forth's `U/MOD`, written in
\ assembler.
\
\ Sometimes the delete key causes invisible corruption of the
\ command line, and words written after it are not
\ recognized.
\
\ In certain cases, `PLOT` uses black ink and black paper
\ instead the color set by `INK` and `PAPER`. See
\ <color.fsb> for more details. The alternative definitions
\ provided in <color.fsb> and <plot.fsb> work fine, though
\ the cause of the original bug is not fully clear yet.
DECIMAL -->
( Data stack and conditional compilation)
HEX
\ ............................................
\ Data stack
\ pop hl / pop de / jp PUSHHL
CREATE NIP ( x1 x2 -- x2 ) E1 C, D1 C, C3 C, PUSHHL , SMUDGE
CREATE TUCK ( x1 x2 -- x2 x1 x2 )
\ SWAP OVER
\ pop hl / pop de / push hl / jp PUSHDE
E1 C, D1 C, E5 C, C3 C, PUSHDE , SMUDGE
: DEPTH ( -- n ) SP@ S0 @ - -2 / ;
\ ............................................
\ Conditional compilation
: [DEFINED] ( "name" -- f )
-FIND DUP IF NIP NIP THEN ; IMMEDIATE
: [UNDEFINED] ( "name" -- f )
[COMPILE] [DEFINED] 0= ; IMMEDIATE
\ The following words provide a simple alternative to
\ `[IF]`, `[ELSE]` and `[THEN]` (provided in a module).
: ?--> ( f -- ) IF [COMPILE] --> THEN ; IMMEDIATE
: ?\ ( f "ccc<newline>" -- ) IF [COMPILE] \
THEN ; IMMEDIATE DECIMAL -->
( .CPU .SYS .SYS-AUTHOR GREETING )
\ ............................................
\ Modified computer name
\ The original word `.CPU` prints "48K SPECTRUM ". It's
\ changed to the more proper "ZX Spectrum". Two bytes are
\ saved, and they are used to add `NOOP` at the end; it will
\ be substituted by `.CPUK` later, by the module <48kq.fsb>,
\ in order to show the memory of the specific model.
HEX HERE 0B C, 5A C, 58 C, BL C, 53 C, 70 C, 65 C, 63 C, 74 C,
72 C, 75 C, 6D C, ' NOOP CFA ,
DUP ' .CPU 2+ OVER HERE SWAP - CMOVE DP !
\ ............................................
\ New messages shown after a cold start.
: .SYS ( -- ) ." Spectrum fig-Forth" ;
: .SYS-AUTHOR ( -- )
\ <------------------------------>
." 1.1A (C) 1983 Abersoft" CR CR
." 1.1C Afera 1.2.0-dev.0+20200215" CR
." (C) 2015,2016,2020 Marcos Cruz" CR
." (programandala.net)" ;
\ <------------------------------>
: GREETING ( -- ) .SYS CR .SYS-AUTHOR CR ;
\ As the message shows, the current user version of the
\ fig-Forth implementation is "C". Store it into its
\ standard fig-Forth address.
43 0A +ORIGIN C! \ 0x43 = ASCII "C"
-->
( COLORS0 ABORT BOOT )
\ ............................................
\ New system colors: black background, green foreground.
: (COLORS0) ( -- )
0 PAPER 4 INK 0 BRIGHT 0 FLASH 0 INVERSE 0 BORDER ;
\ By storing a cfa of other word than `(COLORS0)` in the pfa
\ of `COLORS0`, the user can change the default system
\ colors.
: COLORS0 ( -- ) (COLORS0) ; : CLS0 ( -- ) COLORS0 CLS ;
\ ............................................
\ Patch `ABORT`
\ `ABORT` is patched for three reasons:
\
\ Execute `CLS0` instead of `CLS`; execute `GREETING` instead
\ of printing its own messages; and have a `NOOP` before
\ `QUIT`, to be patched by `TURNKEY`.
\
\ The original code was longer (57 bytes) than the original
\ one (18 bytes), because of the old messages.
' CLS0 CFA 6D60 ! ' GREETING CFA 6D62 ! ' FORTH CFA 6D64 !
' DEFINITIONS CFA 6D66 ! ' NOOP CFA 6D68 ! ' QUIT CFA 6D6A !
\ XXX Space freed: 39 bytes at 0x6D6C
\ Address of the user boot word compiled in `ABORT`.
6D68 CONSTANT BOOT DECIMAL -->
( Make the first screen usable )
\ As usual in Forth, Abersoft Forth doesn't allow to compile
\ sources from the first screen (number 0), by convention
\ reserved to comments. But that is an important waste of
\ memory with a 11-screen RAM-disk. This patch solves that
\ problem.
\
\ After the patch, screen numbers will be 1..11 instead of
\ 0..10. Or 1..16 after compiling the <16kramdisks.fsb>
\ module.
\ The only word that has to be patched is `R/W`, the
\ fig-Forth standard disk read/write linkage, a system
\ dependent word. Its definition in Abersoft Forth is the
\ following:
\ : R/W ( a n f -- )
\ \ a = source or destination block buffer
\ \ n = sequential block number on disk
\ \ f = 0 for disk write, 1 for read
\ >R B/BUF * LO +
\ DUP HI > LIT 6 ?ERROR \ out of upper bound?
\ R> \ disk read?
\ IF SWAP THEN B/BUF CMOVE ;
\ Bytes per screen (1024).
B/SCR B/BUF * CONSTANT /SCR
: DISC-BLOCK ( n -- a )
\ Calculate the address of disk block _n_ in the Forth RAM-
\ disk. Give error 6 when the requested disk block is out of
\ range.
\
\ This word works with the default 11-KiB RAM disk and also
\ with the 16-KiB paged RAM-disks that can be used with the
\ 128K model (installed by the module <16kramdisks.fsb>).
\
\ The disk block number is adjusted with `OFFSET`, because
\ the result address is the same, no matter what the current
\ drive is.
\ n = number of sequential disk block
\ a = address in the RAM-disk (when paged in)
OFFSET @ - B/BUF * DUP /SCR U< 6 ?ERROR
LO + /SCR - DUP HI > 6 ?ERROR ;
: (R/W) ( a1 a2 f -- )
\ Read to or write from the new RAM-disk.
\ a1 = buffer address
\ a2 = address in the RAM-disk
\ f = 0 for writing; 1 for reading
\ This word is created with `;S` and `NOOP` at the end in
\ order to make it easier for the module <16kramdisks.fsb> to
\ convert it into the 128K version, that needs four more
\ commands.
IF SWAP THEN B/BUF CMOVE [COMPILE] ;S NOOP NOOP NOOP ;
\ Compile the new code of `R/W`.
HERE ] >R DISC-BLOCK R> (R/W) ;S [
\ Patch `R/W` with the new code. Also update `BLK` to
\ prevent the current screen to be loaded twice, because of
\ the patch. Finally, free the dictionary space used by the
\ patch.
\
\ Warning: `CMOVE` and `B/SCR BLK +!` must be on the same
\ line, otherwise there's a chance they could be in different
\ blocks of the screen (in fig-Forth, each screen consists of
\ 8 128-byte blocks), what would cause trouble.
' R/W OVER SWAP OVER HERE SWAP - CMOVE B/SCR BLK +! DP !
\ Change the error 9 caused by `0 LOAD` ("Trying to load from
\ screen 0") to error 6 ("Out of RAM-disk range"), what seems
\ more logical now, because there's no screen 0 anymore.
6 ' LOAD 8 + ! DECIMAL -->
( Operators)
: BOUNDS ( a1 len1 -- a2 a1 ) OVER + SWAP ; HEX
\ pop hl / dec hl / jp PUSHHL
CREATE 1- ( n1 -- n2 ) E1 C, 2B C, C3 C, PUSHHL , SMUDGE
\ pop hl / dec hl / dec hl / jp PUSHHL
CREATE 2- ( n1 -- n2 ) E1 C, 2B C, 2B C, C3 C, PUSHHL , SMUDGE
\ Patch CFA to use the Z80 code of `2-`,
\ faster than the original colon definition `2 -`:
' 2- ' CFA CFA !
\ pop hl / add hl,hl / jp PUSHHL
CREATE 2* ( n1 -- n2 ) E1 C, 29 C, C3 C, PUSHHL , SMUDGE
CREATE 0<> ( n1 -- n2 ) \ 0= 0=
\ ld hl,0 / pop de / ld a,d / or e
21 C, 0 , D1 C, 78 02 + C, B0 03 + C,
\ jp z,pushhl / inc l / jp pushhl
CA C, PUSHHL , 2C C, C3 C, PUSHHL , SMUDGE
\ In Abersoft Forth `1+` and `2+` are colon words. The
\ following code patches the original definitions with 50%
\ faster Z80 code, without using dictionary space: The pfa of
\ the original words is 12 bytes long, enough for the new
\ code.
\
\ The new code can not be compiled directly into the
\ destination address, by pointing `DP` to the target pfa,
\ because `WORD` uses `HERE` as buffer (and first it does
\ `HERE 34 SPACES`), what would corrupt the dictionary.
\ That's why the code is compiled at `HERE` and then moved.
\ Beside, some of the words internally used during the
\ patching (`WORD` and others) call `1+` or `2+`. That's why
\ the original names can be "ticked" only before patching the
\ original code; and the new code, including the new cfa,
\ must overwrite the old definition in one single operation,
\ with `CMOVE`.
HERE ' 1+ ( a pfa ) DUP , \ the cfa will point to pfa:
\ pop hl / inc hl / jp PUSHHL
E1 C, 23 C, C3 C, PUSHHL ,
\ Overwrite the word and restore `DP`:
CFA OVER SWAP OVER HERE SWAP - CMOVE ( a ) DP !
HERE ' 2+ ( a pfa ) DUP , \ the cfa will point to pfa:
\ pop hl / inc hl / inc hl / jp PUSHHL
E1 C, 23 C, 23 C, C3 C, PUSHHL ,
\ Overwrite the word and restore `DP`:
CFA OVER SWAP OVER HERE SWAP - CMOVE ( a ) DP ! DECIMAL -->
( Screens and RAM-disks )
\ ............................................
\ Standard or common usage extensions
: THRU ( n1 n2 -- ) 1+ SWAP DO I LOAD LOOP ;
: +LOAD ( n -- ) BLK @ B/SCR / + LOAD ;
: +THRU ( n1 n2 -- ) 1+ SWAP DO I +LOAD LOOP ;
\ ............................................
\ Load from tape and compile Forth RAM-disks
\ The following words make it possible to chain several Forth
\ RAM-disk files from tape, allowing the automatic
\ compilation of sources larger than 11 blocks.
\ Read a new RAM-disk from tape and load screen 'n'.
: /RUNT ( n -- ) EMPTY-BUFFERS INIT-DISC LOADT LOAD ;
\ Read a new RAM-disk from tape and load its first screen.
: RUNT ( -- ) 1 /RUNT ;
\ Screens per drive (RAM-disk).
11 CONSTANT SCR/DR
\ DISC-SCR ( n -- a )
\
\ Address of screen n in the Forth RAM-disk; error 6 if not
\ in range.
\
\ n = 1..11 for 48K
\ 1..16 for 128K (with the <16kramdisks.fsb> installed)
: DISC-SCR ( n -- a )
1- DUP SCR/DR U< 0= 6 ?ERROR /SCR * LO + ;
\ ............................................
\ Required files
\ `NEEDS` is used in modules of the library that require
\ other modules. Without disk support, `NEEDS` causes an
\ error when the required word is not defined. With disk
\ support (currently only for G+DOS) the required file will
\ be loaded from disk into the RAM-disk and then compiled;
\ finally the previous contents of the RAM-disk will be
\ restored. Any level of nesting is possible.
\ (NEEDS-TAPE) ( f "filename" -- )
\
\ Tape version of `(NEEDS)`.
\
\ f = is there a word needed from the given filename?
\
\ If f is not zero stop with error 27 (source file needed),
\ because there's no way to load a specific file in a tape
\ based system; otherwise ignore the filename.
\
\ Error 27 is new, implemented by Afera. Error 0 (word not
\ found) could be used for `NEEDS`, but not for `?NEEDS`.
\ That's why a new error is defined for both cases.
: (NEEDS-TAPE) ( f "filename" -- ) 27 ?ERROR BL WORD ;
\ ?NEEDS ( f "filename" -- )
\
\ If f is not zero, load RAM-disk file "filename", else
\ remove the parameters. The loading works only with disks
\ drives, when the correspondent module is installed; the
\ default tape-only system will stop with an error.
\ This is used instead of `NEEDS` when the needed file
\ does not define a word it can be identified with. This
\ happens with modules that simply patch the system.
: ?NEEDS ( f "filename" -- ) (NEEDS-TAPE) ;
\ NEEDS ( "name" "filename" -- )
\ If "name" is not defined, load file "filename", if
\ possible; else remove the parameters. The loading works
\ only with disks drives, when the correspondent module is
\ installed; the default tape-only system will stop with an
\ error.
: NEEDS ( "name" "filename" -- )
[COMPILE] [UNDEFINED] ?NEEDS ;
-->
( EXTEND SYSTEM )
: EXTEND ( -- )
\ Change the `COLD` start parameters to extend the system to
\ its current state.
\ This word should be used especially when system words have
\ been patched with new words. Otherwise `COLD` would delete
\ the new words and the system would crash when their space
\ would be overwritten.
LATEST 12 +ORIGIN ! HERE 28 +ORIGIN ! HERE 30 +ORIGIN !
HERE FENCE ! ' FORTH 8 + 32 +ORIGIN ! ;
\ SYSTEM ( -- a len )
\
\ Prepare the system in order to save a copy. Return its
\ start address and length, to be used as parameters for the
\ tape or disk saving commands.
: SYSTEM ( -- a len ) EXTEND 0 +ORIGIN SIZE 10 + ;
\ TURNKEY ( cfa -- a len )
\
\ Prepare the system in order to save a copy that will
\ execute the given cfa after the ordinary boot process.
\ Return its start address and length, to be used as
\ parameters for the tape or disk saving commands.
: TURNKEY ( cfa -- a len ) BOOT ! SYSTEM ;
EXTEND CLS0 GREETING
\ -----------------------------------------------------------
\ History
\ 1985-1987:
\
\ Some words written to extend Abersoft Forth: `\`, `INVERT`,
\ `>=`, `<=`, `<>`, `SGN` (after the manual), `NOR`, `NAND`,
\ `NXOR`, `DEPTH`, `PICK`, `DRAWL`, `RDRAW`, `RDRAWL`...
\
\ 2015-03: Start of the Afera library. New words: `CHAR`,
\ `[CHAR]`, `PARSE-TEXT`, `PARSE-NAME`, `SLIT`, `S,`,
\ `SLITERAL`, `.(`, `(S)`, `S"`, `S'`, `TLOAD`, `RUNT`,
\ `BOUNDS`, `NIP`, `[DEFINED]`, `BYE`, `UDG!`, `AKEY`,
\ `THRU`, `+LOAD` (after Gforth), `+THRU` (after Gforth),
\ `RDROP`, `R@`, `RDEPTH`, `SGN`, `(after`, `Gforth)`,
\ `RECURSE`, `ROLL` (after Gforth), `XY>ATTRA`, `[DEFINED]`.
\
\ 2015-03-28:
\
\ The graphics and strings extensions are moved to their own
\ files. Fixes of Abersoft Forth's bugs: the RAM-disk length
\ and `EXIT`. Fix: `RDROP` was wrong. New: `/INIT-DISC`,
\ `TUCK`.
\
\ 2015-03-29:
\
\ `TRUE`, `FALSE`, `ON`, `OFF`, `-ROT`, `?EXIT` (after
\ Gforth), `ALIAS` (for code words only), `HERE:` (Afera
\ specific), `BUFFER:` (after Forth-2012). The renamings
\ (`BYE`, `-DUP`, `VLIST`) are moved to an own file.
\
\ 2015-03-30:
\
\ `.(` is moved from the strings module, in order to use it
\ at block headers. New: `MS`.
\
\ 2015-03-31:
\
\ New: `INKEY?`, `?RSTACK`.
\
\ Change: `TLOAD` is combined into `RUNT`.
\
\ Fix: Now `RUNT` clears the return stack.
\
\ Fix: `+LOAD`: the problem was `BLK` doesn't hold the block
\ number in Abersoft Forth: it has to be divided by `B/SCR`
\ (a constant that returns 8). The definitions of `LOAD` and
\ `-->`, from Don Thomasson's book "Spectrum Advanced Forth",
\ gave the definitive clue.
\
\ Change: simpler definitions of `>=` and `<=`; `NEGATE` is
\ removed because it already exists, but it's called `MINUS`.
\
\ 2015-04-01:
\
\ Change: Now `RUNT` halts if Break is pressed. The problem
\ was the Fuse emulator, when the TAP file is finished,
\ rewinds it, and this behaviour is not configurable.
\ Therefore loading a single module of the library was
\ impossible: it loaded itself in an endless loop. This
\ change solves this problem to some extent, while still
\ keeping `RUNT` for chain loading. A better solution is
\ searched.
\
\ New: Patches that make it possible to use the whole screen.
\
\ New: `RND`, adapted from Bertie, the demo program bundled
\ with Abersoft Forth.
\
\ 2015-04-02:
\
\ Fix: Now `AT` works on line 32. The solution was to use
\ `>CHAN` (conversion of `TCH` from Lennart Benschop's
\ Spectrum Forth-83) instead of. `EMIT`.
\
\ Improvement: `RUNT` checks `DEPTH` instead of the Break
\ key.
\
\ New: `VALUE`, `TO`, `[TO]` and `<TO>`.
\
\ 2015-04-03:
\
\ Improvement: `RUNT` checks also `BLK`; this make it
\ possible to use it manually to load the next RAM-disk.
\
\ Change: `CHAR` and `[CHAR]` are moved here from the strings
\ module.
\
\ 2015-04-08:
\
\ New (moved from the assembler): `2*`, `2-`, 1-`.
\
\ 2015-04-09:
\
\ New: `/BLOCK`.
\
\ Change: `AKEY` and `INKEY?` are moved to their own file
\ <key.fsb>.
\
\ 2015-04-15:
\
\ Change: `VALUE` and related words are moved to <value.fsb>;
\ all words related to whole screen support are moved to
\ <plusscreen.fsb>; `ALIAS` is moved to <alias.fsb>; `CELL`
\ and related words are moved to <cell.fsb>; `RUNT` and
\ `?RUNT` are moved to <runt.fsb>; `HERE:` and `BUFFER:` are
\ moved to <buffercol.fsb>.
\
\ 2015-04-16:
\
\ Change: `2*`, `2-`, `1-`, `PICK`, `NIP` and `TUCK` are
\ rewritten in Z80.
\
\ New: `2/`, written in Z80 (still not working fine with
\ negative numbers).
\
\ Change: `FALSE`, `TRUE`, `ON` and `OFF` are moved to
\ <flags.fsb>.
\
\ 2015-04-17: `RUNT` moved back; its current definition is
\ useful to write loaders.
\
\ 2015-04-21: New: `UNLOOP`.
\
\ 2015-04-23: New: `/RUNT`, as a factor of `RUNT`. Fix: `2/`
\ now works fine with negative numbers; the bug was a wrong
\ relative jump.
\
\ 2015-04-25: Change: `UNLOOP` and `-ROT` are rewritten in
\ Z80.
\
\ 2015-04-30: Change: `BLOCK>A` is renamed to `'BLOCK`.
\
\ 2015-05-02: Change: `[DEFINED]`, `[UNDEFINED]`, `?-->` and
\ `?;S` are moved here from the conditional compilation draft
\ module. Change: `-ROT`, `ROLL` and `PICK` are moved to
\ their own files.
\
\ 2015-05-03: New: 'RUNTS'. New: Patch to make screen #0
\ usable for compiling.
\
\ 2015-05-03: `UNLOOP` is moved to its own file.
\
\ 2015-05-05: `2/` and `2*` are moved to their own files.
\
\ 2015-05-06:
\
\ `1+` and `2+` are moved here from their own files, because
\ now they patch the original slower definitions without
\ using any dictionary space.
\
\ Change: `/BLOCK` is renamed as `/SCR`, to avoid confusion
\ with fig-Forth disk blocks.
\
\ New: `CFA` is patched with `2-`, for speed.
\
\ 2015-05-08: `RUNTS` is removed. The new modules
\ <loader.fsb>, <loaded.fsb> and <loaded_execute.fsb> make it
\ unnecessary.
\
\ 2015-05-10: Change: `'BLOCK` renamed to `'SCR`.
\
\ 2015-05-11: `SGN`, `RECURSE` and `?EXIT` are moved to their
\ own files.
\
\ 2015-05-12:
\
\ `<>`, is moved to its own file and rewritten in Z80. `?(`
\ is moved to drafts, because it can not work yet, without
\ `EVALUATE` or other method.
\
\ Change: `'SCR` renamed to `DISC-SCR`, after `DISC-BLOCK` in
\ the module <16kramdisks.fsb>.
\
\ 2015-05-13: `?;S` is moved to the drafts directory, until a
\ solution is found for it. Three unused operators are
\ removed.
\
\ New: Temporary version of `48K?` (memory paging can not be
\ used without <lowersys.fsb>). `GREETING` and related words.
\ `EXTEND` to protect the changes from `COLD`.
\
\ 2015-05-14: File renamed <afera.fsb>. Several changes. New
\ approach... The system will be lowered by default, in order
\ to use memory paging to detect the available memory.
\
\ 2015-05-15: Simpler `GREETING`.
\
\ 2015-05-17: `/INIT-DISC` is moved to drafts, it has not
\ been needed yet, it's not useful with tapes. `2*` is moved
\ back from is own files, it's needed by several important
\ modules. New: `0<>`. Improvement: simpler version of `\`,
\ copied from Matteo Vitturi's vForth (1990-2000). New:
\ `TURNKEY`.
\
\ 2015-05-18: `COLORS0` and `CLS0` are moved here from its
\ own file and modified.
\
\ 2015-05-19: The patches of `COLD` and `ABORT` have been
\ modified with a better approach. New: 'BOOT' returns the
\ address that holds the cfa of the user boot word, in the
\ pfa of `ABORT`.
\
\ 2015-06-02: Simpler method to create the patch of `R/W`,
\ with `]` and `[`.
\
\ 2015-06-19: Fix of Abersoft Forth's `0 MESSAGE` bug.
\
\ 2015-07-06: Improvement: `COLORS0` is factored to
\ `(COLORS0)` in order to make it configurable by the user.
\
\ 2015-07-14: Fix of Abersoft Forth's bug in `INVERSE` and
\ `GOVER`.
\
\ 2015-07-18: Fixed the hardcoded address of the RAM-disk in
\ `INIT-DISC` and `(TAPE)`. This problem was found during the
\ development of Tron 0xF
\ (http://programandala.net/en.program.tron_0xf.html).
\
\ 2015-07-18: Simpler method for patching `COLD`, with `]`
\ and `[`.
\
\ 2015-07-18: Fix: the user version was updated with decimal
\ numbers while the base was hexadecimal. This corrupted the
\ first byte of the init value of the user pointer variable,
\ at `HEX 10 +ORIGIN`, though there was no side effect
\ because Abersoft does not use it (the original fig-Forth
\ implementation does).
\
\ 2016-03-02: Fix: removed the `#vim` directive which
\ converted "\*" to the copyright symbol (code 127 of the ZX
\ Spectrum charset). This directive is supported only by fsb,
\ not by fsb2, which is currently used. "(c)" is used
\ instead.
\ -----------------------------------------------------------
\ vim: filetype=abersoftforthafera
.( AKEY )
\ akey.fsb
\ `AKEY`, an alternative `KEY` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Description
\ The `KEY` of Abersoft Forth shows the flashing cursor and
\ lets the user to change the input mode (C, L and G). But
\ that can be an inconvenient in certain cases, when the
\ actual pressed key is needed (even the codes that change the
\ input mode), and the cursor ruins the layout.
\
\ This module provides an alternative for such cases.
\ -----------------------------------------------------------
\ History
\ 2015-03: Code written in the main file of the library.
\ 2015-04-09: Code extracted from the main file of the
\ library. Moved to a keyboard module.
\ 2015-05-03: Code moved to its own file.
\ 2015-07-16: Rewritten with `INKEY?`.
\ -----------------------------------------------------------
\ Requirements
NEEDS INKEY? inkeyq
\ -----------------------------------------------------------
: AKEY ( -- c )
\ Wait for a key to be pressed and return its code,
\ whatever it is, without showing the cursor.
BEGIN INKEY? UNTIL ;
\ vim: filetype=abersoftforthafera
.( ALIAS)
\ alias.fsb
\ `ALIAS` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Code extracted from the main file of the
\ library.
\ -----------------------------------------------------------
: ALIAS ( pfa "name" -- )
\ Create the word "name" as an alias of the *code* word
\ whose pfa is given.
\ NOTE: This works only for code words.
\ XXX TODO make it work with any kind of word.
\ XXX OLD -- first version:
\ [COMPILE] : [COMPILE] ; LATEST PFA CFA ! ;
\ XXX second version,
\ the alias needs less space in the dictionary:
CREATE SMUDGE LATEST PFA CFA ! ;
\ XXX TODO Improved alternative:
\ : ALIAS ( pfa "name" -- )
\ \ Create the word "name" as an alias of the *code* word
\ \ whose pfa is given.
\ DUP DUP CFA @ = \ code word?
\ IF [COMPILE] : [COMPILE] ; LATEST PFA CFA !
\ \ XXX FIXME :
\ ELSE CREATE SMUDGE (;CODE)
\ 195 C, CFA , \ jp cfa
\ [COMPILE] ;
\ THEN ;
\ vim: filetype=abersoftforthafera
.( Assembler )
\ assembler.fsb
\ Assembler for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Coos Haak
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ This is a modified version of an assembler designed by Coos
\ Haak for his own Forth, and used by Lennart Benschop with his
\ Spectrum Forth-83 (1988).
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Differences from the original version
\ Beside converting the code from the Forth-83 Standard to
\ fig-Forth, some changes were done during the conversion:
\ Also the pair registers BC, DE and HL can be used.
\ Example: both `1 B LDP#` and `1 BC LDP#` are valid.
\ `(HL)` can be used instead of `M`.
\ Special mnemonic `0OUTBC` is provided.
\ The condition flag operator `NOT` is removed; the condition
\ flag `v` (synonym of `pe`) is removed. The condition flags
\ are completed, including their opposite versions.
\ Changed names:
\ `INC` --> `INCP`;
\ `INR` --> `INC`;
\ `DEC` --> `DECP`;
\ `DER` --> `DEC`.
\ The set of conditional calls and returns has been completed
\ (the original included only the generic `CALLC` and
\ `RETC`).
\ Comments have been added.
\ Case insensitive.
\ -----------------------------------------------------------
\ History
\ 2015-03-11: Start.
\
\ 2015-03-21: Fixes. `MACRO` restored back.
\
\ 2015-04-08: Moved to the main file of the library: `2*`,
\ `2-`, 1-`. Change: `INC` renamed to `INCP`; `INR` renamed
\ to `INC`; `DEC` renamed to `DECP`; `DER` renamed to `DEC`.
\
\ 2015-04-16: Simpler `END-CODE`: Old: `NEXT JP DECIMAL ?CSP
\ SMUDGE [COMPILE] [ ; IMMEDIATE`. New: `DECIMAL ?CSP SMUDGE
\ ;`, that's enough.
\
\ 2015-05-02: Code rearranged.
\
\ 2015-05-10: The lowercase words have been renamed with a
\ tick suffix, in order to make the assembler case
\ insensitive, because a library module can be used to make
\ the system case insensitive.
\
\ 2015-07-21: Fix: The hex number DE, used to define a
\ opcode, was mistaken as the DE register. '0DE' is used
\ instead.
\
\ 2015-09-23: Added `CALC` and `END-CALC` for the ROM
\ calculator, after the implementation in Solo Forth
\ (http://programandala.net/en.program.solo_forth.html).
\ Added stack comments to the control structures.
\
\ 2015-10-26: Modified the header after the format of all
\ other modules.
\ -----------------------------------------------------------
FORTH DEFINITIONS
: 8* 2* 2* 2* ;
-->
( Registers )
VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS HEX
0 CONSTANT B 1 CONSTANT C 2 CONSTANT D 3 CONSTANT E
4 CONSTANT H 5 CONSTANT L 6 CONSTANT M 7 CONSTANT A
0 CONSTANT BC 2 CONSTANT DE 4 CONSTANT HL
6 CONSTANT SP 6 CONSTANT AF 6 CONSTANT (HL)
DD CONSTANT IX-OP FD CONSTANT IY-OP
IX-OP VARIABLE XY : %X IX-OP XY ! ; : %Y IY-OP XY ! ;
: XY, XY @ C, ; : XL XY, L ; : XH XY, H ;
: IX IX-OP C, HL ; : IY IY-OP C, HL ;
: ?PAGE ( n -- n ) DUP 80 + FF SWAP U<
IF ." Branch too long" ABORT THEN ;
-->
( Words for defining the Z80 instructions)
: M1 ( n "name" -- )
\ 1-byte opcode without parameters.
<BUILDS C, DOES> C@ C, ;
: M2 ( n "name" -- )
\ 1-byte opcode with register encoded in bits 0-3.
<BUILDS C, DOES> C@ + C, ;
: M3 ( n "name" -- )
\ 1-byte opcode with register encoded in bits 3-5.
<BUILDS C, DOES> C@ SWAP 8* + C, ;
: M4 ( n "name" -- )
\ 1-byte opcode with 1-byte parameter.
<BUILDS C, DOES> C@ C, C, ;
: M5 ( n "name" -- )
\ 1-byte opcode with 2-byte parameter.
<BUILDS C, DOES> C@ C, , ;
: M6 ( n "name" -- )
\ Rotation of registers.
<BUILDS C, DOES> CB C, C@ + C, ;
-->
( Words for defining the Z80 instructions)
: M7 ( n "name" -- )
\ Bit manipulation of registers.
<BUILDS C, DOES> CB C, C@ + SWAP 8* + C, ;
: M8 ( n "name" -- )
\ 2-byte opcodes.
<BUILDS , DOES> @ , ;
: M9 ( n "name" -- )
\ Relative jumps.
<BUILDS C, DOES> C@ C, HERE 1+ - ?PAGE C, ;
: MA ( n "name" -- )
\ Index registers with register.
<BUILDS C, DOES> XY, C@ C, C, ;
: MB ( n "name" -- )
\ Rotation with index registers.
<BUILDS C, DOES> XY, CB C, C@ SWAP C, C, ;
: MC ( n "name" -- )
\ Bit manipulation with index registers.
<BUILDS C, DOES> XY, CB C, C@ ROT ROT C, 8* + C, ;
-->
( Opcodes )
00 M1 NOP 02 M3 STAP 03 M3 INCP 04 M3 INC 05 M3 DEC 07 M1 RLCA
08 M1 EXAF 09 M3 ADDP 0A M3 LDAP 0B M3 DECP 0F M1 RRCA
10 M9 DJNZ 17 M1 RLA 18 M9 JR 1F M1 RRA 20 M9 JRNZ 22 M5 STHL
27 M1 DAA 28 M9 JRZ 2A M5 LDHL 2F M1 CPL 30 M9 JRNC 32 M5 STA
37 M1 SCF 38 M9 JRC 3A M5 LDA 3F M1 CCF 76 M1 HALT 80 M2 ADD
88 M2 ADC 90 M2 SUB 98 M2 SBC B8 M2 CP C1 M3 POP C2 M5 JPNZ
C3 M5 JP C5 M3 PUSH C6 M4 ADD# C7 M2 RST C9 M1 RET CA M5 JPZ
CD M5 CALL CE M4 ADC# D2 M5 JPNC D3 M4 OUT 41 M3 OUTBC
D6 M4 SUB# D9 M1 EXX DA M5 JPC DB M4 IN 40 M3 INBC 0DE M4 SBC#
E2 M5 JPPO E3 M1 EXSP E6 M4 AND# E9 M1 JPHL EA M5 JPPE
EB M1 EXDE EE M4 XOR# F2 M5 JPP F3 M1 DI F6 M4 OR# F9 M1 LDSP
FA M5 JPM FB M1 EI FE M4 CP# 00 M6 RLC 08 M6 RRC 10 M6 RL
18 M6 RR 20 M6 SLA 28 M6 SRA 38 M6 SRL 40 M7 BIT 80 M7 RES
C0 M7 SET B0ED M8 LDIR B8ED M8 LDDR 44ED M8 NEG 57ED M8 LDAI
47ED M8 LDIA 56ED M8 IM1 5EED M8 IM2 B1ED M8 CPIR -->
( Opcodes)
: 0OUTBC ED C, 71 C, ;
: JPIX IX-OP C, JPHL ;
: LDP# ( 16b rps -- ) 8* 1+ C, , ;
: LDIX# ( 16b rps -- ) 8* 1+ C, , ; \ XXX TODO
: LD# ( 8b r -- ) 8* 06 + C, C, ;
: LD ( r1 r2 -- ) 8* 40 + + C, ;
: SBCP ED C, 8* 42 + C, ;
: ADCP ED C, 8* 4A + C, ;
: STP ED C, 8* 43 + C, , ;
: LDP ED C, 8* 4B + C, , ;
\ Macros
: CLR 0 SWAP LDP# ; : MOV 2DUP LD 1+ SWAP 1+ SWAP LD ;
\ ZX Spectrum specific
CF M4 HOOK \ RST 8
D7 M1 PRT \ RST 0x16
EF M1 CALC 38 M1 END-CALC -->
\ CALC = RST 0x28 (ROM calculator)
( Index register opcodes)
86 MA )ADD 8E MA )ADC 96 MA )SUB 9E MA )SBC A6 MA )AND
AE MA )XOR B6 MA )OR BE MA )CP 34 MA )INC 35 MA )DEC
06 MB )RLC 0E MB )RRC 16 MB )RL 1E MB )RR 26 MB )SLA
2E MB )SRA 3E MB )SRL 46 MC )BIT 86 MC )RES C6 MC )SET
: )LD XY, SWAP 8* 46 + C, C, ;
: )ST XY, SWAP 70 + C, C, ; : )LD# XY, 36 C, C, C, ;
: )LDP OVER 1+ OVER )LD 1+ )LD ;
: )STP OVER 1+ OVER )ST 1+ )ST ;
-->
( Condition codes, conditional RET and CALL)
\ Condition codes for relative jumps
20 CONSTANT Z 28 CONSTANT NZ 30 CONSTANT CY 38 CONSTANT NC
\ Condition codes for absolute jumps
C2 CONSTANT z' CA CONSTANT nz' D2 CONSTANT cy' DA CONSTANT nc'
E2 CONSTANT pe' EA CONSTANT po' F2 CONSTANT m' FA CONSTANT p'
\ Conditional RET
: ?RET 8 XOR 2- C, ;
: RETC cy' ?RET ; : RETNC nc' ?RET ;
: RETZ z' ?RET ; : RETNZ nz' ?RET ;
: RETM m' ?RET ; : RETP p' ?RET ;
: RETPE pe' ?RET ; : RETPO po' ?RET ;
\ Conditional CALL
: ?CALL 8 XOR 2+ C, , ;
: CALLC cy' ?CALL ; : CALLNC nc' ?CALL ;
: CALLZ z' ?CALL ; : CALLNZ nz' ?CALL ;
: CALLM m' ?CALL ; : CALLP p' ?CALL ;
: CALLPE pe' ?CALL ; : CALLPO po' ?CALL ;
-->
( Control structures and last opcodes)
\ Control structures created with relative jumps
: THEN 0A ?PAIRS HERE 1- OVER - ?PAGE SWAP C! ;
\ then ( orig cs-id -- )
: IF , HERE 1- 0A ;
\ if ( op -- orig cs-id )
: ELSE 0A ?PAIRS 18 IF ROT SWAP THEN 0A ;
\ else ( orig cs-id -- cs-id )
\ Note 0x18 is the opcode of `jr`.
: UNTIL , 0B ?PAIRS 1- HERE 1- SWAP OVER - ?PAGE SWAP C! ;
\ until ( dest cs-id op -- )
: BEGIN HERE 0B ;
\ begin ( -- dest cs-id )
: AGAIN 18 UNTIL ;
\ again ( dest cs-id -- )
\ Note 0x18 is the opcode of `jr`.
: DSZ 10 UNTIL ; : REPEAT 2SWAP AGAIN 2- THEN ;
\ dsz ( dest cs-id -- )
\ repeat ( dest cs-id1 orig cs-id2 )
: WHILE IF 2+ ;
\ while ( op -- orig cs-id )
\ Control structures created with absolute jumps
: if' C, HERE 0 , 08 ; : then' 08 ?PAIRS HERE SWAP ! ;
\ if' ( op -- orig cs-id )
\ then' ( orig cs-id -- )
: else' 08 ?PAIRS C3 if' ROT SWAP then' 08 ;
\ else' ( cs-id -- cs-id )
: begin' HERE 09 ; : until' C, 09 ?PAIRS , ;
\ begin' ( -- dest cs-id )
: while' if' 2+ ; : again' C3 until' ;
\ while' ( op -- orig cs-id )
\ until' ( -- cs-id op )
: repeat' 2SWAP again' 2- then' ;
\ repeat' ( dest cs-id1 orig cs-id2 )
\ Last opcodes
\ `AND`, `OR` and `XOR` are defined at the end, in order to
\ avoid name clashes with the Forth words that have the same
\ name:
A0 M2 AND B0 M2 OR A8 M2 XOR
: SUBP A AND SBCP ; : TST DUP A LD 1+ OR ; -->
( Defining words)
: END-CODE ( -- )
\ End the definition of an assembler word.
DECIMAL ?CSP SMUDGE ;
: ;C ( -- ) [COMPILE] END-CODE ; IMMEDIATE
FORTH DEFINITIONS
\ Macros \ XXX TODO -- test it
: MACRO ( "name -- ) [COMPILE] ASSEMBLER [COMPILE] : ;
: ENDM ( -- ) [COMPILE] ; ;
: ASM ( -- )
\ Enter assembler mode.
[COMPILE] ASSEMBLER HEX ASSEMBLER %X FORTH !CSP ;
: LABEL ( "name" -- )
\ Create a subroutine or data label.
VARIABLE -2 ALLOT ASM ;
: CODE ( "name" -- )
\ Create an assembler word.
CREATE ASM ;
\ XXX TODO check if `(;CODE)` works in Abersoft Forth
: ;CODE ( -- )
\ Add assembler code to a high level definition.
COMPILE (;CODE) ?CSP ASM [COMPILE] [ ; IMMEDIATE
DECIMAL
\ vim: filetype=abersoftforthafera
.( AT@ )
\ at-fetch.fsb
\ Current cursor position for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-27: Start.
: AT@ ( -- line col )
\ Line and column of the current print position.
\ System variable S_POSN:
\ 23688 = 33 minus column number for print position
\ 23689 = 24 minus line number for print position.
24 23689 C@ - 33 23688 C@ - ;
\ vim: filetype=abersoftforthafera
.( BANK )
\ bank.fsb
\ Memory bank paging for ZX Spectrum's Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Requirements
49152 R0 @ U< ?NEEDS lowersys
\ -----------------------------------------------------------
\ History
\ 2015-04-07: Start. Code adapted from Lennart Benschop's
\ Spectrum Forth-83.
\
\ 2015-04-08: The code can not work as is, because the stack
\ of Abersoft Forth is above 0xC000.
\
\ 2015-05-07: The code works with the new module that moves
\ the system below address 0xC000. The code moved to its own
\ file, separated from `48K?`.
\
\ 2015-05-11: Fix/Improvement: The status of the memory banks
\ is saved into the system variable BANKM.
\
\ 2015-05-12: Change: the range conversion `DUP 1 > + DUP 4 >
\ +` (from range 0..5 to 0,1,3,4,6,7) is removed.
\
\ 2015-05-13: New: `DI` and `EI`.
\
\ 2015-05-17: `?NEEDS` used.
\ -----------------------------------------------------------
\ Disable and enable interrupts.
HEX CREATE -INTERRUPTS ( -- ) F3 C, C3 C, NEXT , SMUDGE
CREATE +INTERRUPTS ( -- ) FB C, C3 C, NEXT , SMUDGE
5B5C CONSTANT SYS-BANKM 7FFD CONSTANT BANK1-PORT
: BANK ( n -- )
\ Page memory bank n at 0xC000..0xFFFF.
\ XXX OLD
\ DUP 1 > + DUP 4 > + \ convert range 0..5 to 0,1,3,4,6,7
-INTERRUPTS SYS-BANKM C@ \ get the saved status of BANKM
F8 AND OR \ modify only bits 0-2
DUP SYS-BANKM C! BANK1-PORT OUTP +INTERRUPTS ; DECIMAL
\ vim: filetype=abersoftforthafera
.( BASCALL )
\ bascall.fsb
\ A BASIC-call word for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop.
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-16: Start. Copy of the Spectrum Forth-83 code,
\ where the word is called `BCAL`. First changes.
\
\ 2015-07-19: Fully adapted. First working version. Improved
\ (it works with or without whole screen mode).
-->
( Return point from BASIC )
\ Patch the warm entry point to this routine:
HEX HERE 6 +ORIGIN !
\ If not back from BASIC, execute the ordinary warm entry.
\ The flag is hardcoded, and set by `BASCALL`.
HERE 1+ \ back_from_basic?: equ $+1
3E C, 00 C, \ ld a,0
A0 07 + C, \ and a ; Back from BASIC?
CA C, 6D93 , \ jp z,0x6D93 ; If not, jump to warm start.
\ Reset the "back from BASIC" flag.
\ xor a
\ ld (back_from_basic?),a
A8 07 + C, 32 C, DUP ,
ED C, 7B C, 5C3D , \ ld sp,(0x5C3D) ; Load ERR_SP
D1 C, \ pop de ; Remove error return address, discarded.
E1 C, \ pop hl ; Get old value of ERR_SP.
22 C, 5C3D , \ ld(0x5C3D),hl ; Restore old value of ERR_SP.
C1 C, \ pop bc ; Restore the Forth instruction pointer.
\ Restore the previous value of DF_SZ,
\ so we can use all 24 screen lines if the
\ whole screen mode (provided by the module
\ <plusscreen.fsb>) was active before calling BASIC.
HERE 3 + \ df_sz_backup: equ $+3
FD C, 36 C, 31 C, 00 C, \ ld (iy+0x31),0
C3 C, NEXT , \ jp next
DECIMAL -->
( BASCALL )
CREATE BASCALL ( n --- ) HEX
\ ( Compiling: a1 a2 -- )
\ a1 = back_from_basic?
\ a2 = df_sz_backup
\ Both addresses belong to the return point from BASIC
\ routine, defined in the previous screen.
\ Store the BASIC line number in NEWPPC, so BASIC will
\ execute this line next.
\ pop hl
\ ld (0x5C42),hl
E1 C, 22 C, 5C42 ,
\ Set NS_PPC to 0, so BASIC will use first statement in line.
\ xor a
\ ld (0x5C44),a
A8 07 + C, 32 C, 5C44 ,
\ Set the "back from BASIC" flag true
\ inc a
\ ld (back_from_basic?),a
3C C, 32 C, SWAP ,
\ Save the Forth instruction pointer.
C5 C, \ push bc
\ Save old value of ERR_SP.
\ ld hl,(0x5C3D)
\ push hl
2A C, 5C3D , E5 C,
\ Push warm entry point on stack,
\ so errors in BASIC will enter it.
\ ld hl,origin+4
\ push hl
21 C, 4 +ORIGIN , E5 C,
\ Save current stack pointer into ERR_SP.
ED C, 73 C, 5C3D , \ ld (0x5C3D),sp
\ BASIC needs DF_SZ to be 2, so we can't be on lowest 2
\ lines, what could happen if the whole screen mode provided
\ by the module <plusscreen.fsb> is active. If so, change the
\ current line to 3 (from the bottom).
\ ld a,(S_POSN) ; screen line number (from the bottom).
\ cp 3 ; below line 3?
\ jr nc,save_df_sz ; if not below 3, jump
3A C, 5C89 , FE C, 03 C, 30 C, 05 C,
\ ld a,3
\ ld (S_POSN),a
3E C, 03 C, 32 C, 5C89 ,
\ save_df_sz:
\ Save the current value of DF_SZ.
\ It will be restored after returning from BASIC.
\ This way `BASCALL` works with or without the whole screen
\ mode.
\ ld a,(DF_SZ)
\ ld (df_sz_backup),a
3A C, 5C6B , 32 C, ,
\ Set DF_SZ to 2 as is required in BASIC.
FD C, 36 C, 31 C, 02 C, \ ld (iy+31),2
\ Jump to STMT_RET in ROM, will execute next BASIC statement.
C3 C, 1B76 , \ jp 0x1B76
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera
.( [TRUE] [FALSE] )
\ bracket-flags.fsb
\ Immediante flags for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-18
0 CONSTANT [FALSE] IMMEDIATE
[FALSE] 0= CONSTANT [TRUE] IMMEDIATE
\ vim: filetype=abersoftforthafera
.( [IF] [ELSE] [THEN] )
\ bracket-if.fsb
\ Conditional compilation for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-28: Start, with code adapted from Forth 5mx
\ (http://programandala.net/en.program.forth_5mx.html), that
\ was already adapted from pForth.
\
\ 2015-04-08: Changes.
\
\ 2015-04-27: New: `?-->` and `?;S`, as a simple alternative
\ to the unfinished `[IF]`.
\ 2015-05-02: Change: `[DEFINED]`, `[UNDEFINED]`, `?-->` and
\ `?;S` are moved to the main file of the library.
\
\ 2015-05-15: New version, adapted from Albert van der
\ Horst's lina Forth.
\
\ 2015-05-17: `NEEDS` used.
\
\ 2015-06-04: `STR=` updated to `S=`.
\
\ 2015-10-30: Updated license.
\
\ 2015-11-18: Updated license.
\ -----------------------------------------------------------
\ Requirements
NEEDS S" strings
NEEDS S= s-equals
NEEDS PARSE-NAME strings
-->
( [IF] [ELSE] [THEN] )
: [ELSE] ( "..." -- )
1 BEGIN PARSE-NAME 2DUP SWAP C@ AND
WHILE 2DUP S" [IF]" S=
IF 2DROP 1+
ELSE 2DUP S" [ELSE]" S=
IF 2DROP 1- DUP IF 1+ THEN
ELSE S" [THEN]" S= IF 1- THEN
THEN
THEN -DUP 0= IF EXIT THEN
REPEAT 2DROP DROP ; IMMEDIATE
: [IF] ( "..." -- ) 0= IF [COMPILE] [ELSE] THEN ; IMMEDIATE
: [THEN] ( -- ) ; IMMEDIATE
\ vim: filetype=abersoftforthafera
.( HERE: BUFFER: )
\ buffercol.fsb
\ `BUFFER:` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-14: Extracted from the main file of the library.
\ -----------------------------------------------------------
: HERE: ( "name" -- )
\ Create a word for "name" that will return its pfa.
\ Right after the definition, the dictionary pointer
\ returns the pfa of "name".
\ This is syntactic sugar for a table definition whose
\ contents will be compiled on the fly.
0 VARIABLE -2 ALLOT ;
: BUFFER: ( u "name" -- ) \ Forth-2012
\ Create a word for "name" and allocate u bytes in its pfa.
\ "name" will return its pfa.
HERE: ALLOT ;
\ vim: filetype=abersoftforthafera
.( Case insensitive mode )
\ caseins.fsb
\ Case insensitive mode for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Requirements
NEEDS UPPERS uppers
\ -----------------------------------------------------------
\ History
\ 2015-05-06: First version.
\ 2015-05-18: `NEEDS` used.
\ -----------------------------------------------------------
: UPPER-WORD ( c -- )
\ Read the next text characters from the input stream being
\ interpreted, until a delimiter c is found, storing the
\ counted string, converted to uppercase, at the dictionary
\ pointer. This word does the same than `WORD` but it
\ converts the string to uppercase.
WORD HERE COUNT UPPERS ;
\ Patching `-FIND` this way, substituting its original `WORD`
\ with `UPPER-WORD`, is enough to make the system case
\ insensitive:
: +CASEINS ( -- )
\ Turn case insensitive mode on.
[ ' UPPER-WORD CFA ] LITERAL [ ' -FIND 2+ ] LITERAL ! ;
+CASEINS
: -CASEINS ( -- )
\ Turn case insensitive mode off.
[ ' WORD CFA ] LITERAL [ ' -FIND 2+ ] LITERAL ! ;
\ vim: filetype=abersoftforthafera
.( CELL CELL+ CELLS )
\ cell.fsb
\ `CELL` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Code extracted from the main file of the
\ library.
\
\ 2015-04-20: `CELL+` and `CELLS` are rewritten in machine
\ code.
\
\ 2015-05-06: `CELL+` executes the code of `2+`, already
\ rewritten in Z80. `CELLS+` already executed the code of
\ `2*`.
\ -----------------------------------------------------------
2 CONSTANT CELL
CREATE CELL+ ( n1 -- n2 )
SMUDGE
' 2+ LATEST PFA CFA ! \ execute the Z80 code of `2+`:
CREATE CELLS ( n1 -- n2 )
SMUDGE
' 2* LATEST PFA CFA ! \ execute the Z80 code of `2*`:
\ vim: filetype=abersoftforthafera
.( Faster color words )
\ color.fsb
\ Faster color words for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Description
\ This file patches `INK`, `PAPER`, `BRIGHT`, `FLASH`,
\ `INVERSE` and `GOVER` with faster code.
\
\ The original `INK` and `PAPER` are especially slow.
\ Beside, it seems the original `INK` has a bug that causes
\ `PLOT` to use 0 instead the proper attribute in most cases.
\
\ Note: The percentages show the execution time, compared to
\ the original word.
\ -----------------------------------------------------------
\ Documentation
\ (From the ZX Spectrum +3 manual transcribed by Russell
\ Marks et al.; and from the ZX Spectrum ROM disassembly.)
\ System variables:
\ 23693 = ATTR_P -- permanent colors
\ {fl}{br}{ paper }{ ink }
\ ___ ___ ___ ___ ___ ___ ___ ___
\ ATTR_P | | | | | | | | |
\ | | | | | | | | |
\ 23693 |___|___|___|___|___|___|___|___|
\ 7 6 5 4 3 2 1 0
\ 23694 = MASK_P -- permanent mask
\ MASK_P is used for transparent colours. Any bit that is 1
\ shows that the corresponding attribute is taken not from
\ ATTR_P but from what is already on the screen.
\ {fl}{br}{ paper }{ ink }
\ ___ ___ ___ ___ ___ ___ ___ ___
\ MASK_P | | | | | | | | |
\ | | | | | | | | |
\ 23694 |___|___|___|___|___|___|___|___|
\ 7 6 5 4 3 2 1 0
\ 23695 = ATTR_T -- temporary colors
\ {fl}{br}{ paper }{ ink }
\ ___ ___ ___ ___ ___ ___ ___ ___
\ ATTR_T | | | | | | | | |
\ | | | | | | | | |
\ 23695 |___|___|___|___|___|___|___|___|
\ 7 6 5 4 3 2 1 0
\ 23696 = MASK_T -- temporary mask
\ MASK_T is used for transparent colours. Any bit that is 1
\ shows that the corresponding attribute is taken not from
\ ATTR_T but from what is already on the screen.
\ {fl}{br}{ paper }{ ink }
\ ___ ___ ___ ___ ___ ___ ___ ___
\ MASK_T | | | | | | | | |
\ | | | | | | | | |
\ 23696 |___|___|___|___|___|___|___|___|
\ 7 6 5 4 3 2 1 0
\ P_FLAG holds the print flags. Even bits are the temporary
\ flags; odd bits are the permanent flags.
\ {paper9 }{ ink9 }{ inv1 }{ over1}
\ ___ ___ ___ ___ ___ ___ ___ ___
\ P_FLAG | | | | | | | | |
\ | p | t | p | t | p | t | p | t |
\ 23697 |___|___|___|___|___|___|___|___|
\ 7 6 5 4 3 2 1 0
\ -----------------------------------------------------------
\ History
\ 2015-04-18: First version. Faster `INK` and `PAPER`.
\
\ 2015-05-05:
\
\ Much faster `INK` and `PAPER`, by calling the ROM routine
\ at 0x1CAD (idea from Matteo Vitturi's v.Forth) and writting
\ the whole definition in Z80.
\
\ `BRIGHT`, `FLASH`, `INVERSE` and `GOVER` are rewritten in
\ Z80, after their original high level definitions.
\
\ All words patch their original definitions, so no memory is
\ used. The method used is the following:
\
\ 1) save `HERE`; 2) modify the cfa of the word to point to
\ its pfa; 3) compile the Z80 code in the dictionary; 4) move
\ the code to the patched word; 5) restore the original value
\ of `DP`.
\
\ It would be simpler to set `DP` to the pfa of the word to
\ patch, but it doesn't work because `WORD` does `HERE 34
\ BLANKS`, what corrupts the space ahead, the next word in
\ the dictionary.
\
\ 2015-07-13: Bug found and fixed:
\
\ `1 INVERSE` is deactivated by `INK` or `PAPER` when nothing
\ is printed between them. Examples:
\ 1 INVERSE 2 INK ." No inverse mode!"
\ 1 INVERSE 2 PAPER ." No inverse mode!"
\ This does not happen in Abersoft Forth. The Afera's
\ `INVERSE` does exactly the same than its Abersoft Forth
\ version, simply much faster. When the new definition of
\ `INVERSE` is omitted nothing changes. The problem is in the
\ improved definitions of `INK` and `PAPER`: they call the
\ ROM address 0x1CAD to set the permanent colors, what
\ includes the print flags (system variable 23697). Then the
\ bits that mark the temporary status of `inverse` and
\ `gover`, not changed by these words, overwrite the bits
\ that mark their permanent status. The solution was to
\ (re)set both bits.
\
\ Fix: `INVERSE`, `BRIGHT`, `FLASH` and `GOVER` checked the
\ lower 8 bits of the input flag. Now they check all the 16
\ bits.
\
\ Bug found and fixed:
\ ----
\ 2 ink 10 10 plot \ plots but...
\ 10 10 point . 1 \ ...with black ink! why?
\
\ 3 ink cr 10 10 plot \ it works with `cr` between
\
\ 3 ink
\ 10 10 plot \ it works also in two commands
\ ----
\ The color change required by `plot` is not effective until
\ something is printed. The problem is ATTR_T is not changed:
\ ----
\ 6 ink 23695 c@ 100 100 plot \ black ink, black paper plot!
\ . 0 \ content of ATTR_T
\ ----
\ This happens also with Abersoft Forth.
\ New versions of `INK` and `PAPER` are written. They change
\ the required bits of ATTR_T and ATTR_P directly, without
\ any ROM routine. Now they work as expected, and faster. The
\ only disadvantage is color 8 (contrast) and 9 (transparent)
\ are not supported. New words are required for that.
\
\ 2015-07-14: Bug found and fixed...: The new `INK` and
\ `PAPER` took the content of ATTR_T, modified it and used
\ the result to update both ATTR_T and ATTR_P. This overwrote
\ the effect of `FLASH` and `BRIGHT`, that only updated
\ ATTR_P. `FLASH` and `BRIGHT` have been modified to update
\ both variables.
\ -----------------------------------------------------------
-->
( INK )
\ XXX TODO -- Colors 8 (contrast) and 9 (transparent) are not
\ supported.
HEX HERE
' INK DUP CFA ! \ convert `INK` to a code word
\ ( b -- )
\ b = color value
D1 C, \ pop de
3A C, 5C8F , \ ld a,(23695) ; ATTR_T
E6 C, F8 C, \ and %11111000 ; remove the current ink
50 07 + C, \ ld d,a ; save the result
78 03 + C, \ ld a,e ; new ink
E6 C, 07 C, \ and %00000111 ; only the ink
B0 02 + C, \ or d ; combine with the current attr
32 C, 5C8F , \ ld (23695),a ; update ATTR_T
32 C, 5C8D , \ ld (23693),a ; update ATTR_P
C3 C, NEXT , \ jp next
DUP ' INK OVER HERE SWAP - CMOVE DP !
DECIMAL -->
( PAPER )
\ XXX TODO -- Colors 8 (contrast) and 9 (transparent) are not
\ supported.
HEX HERE
' PAPER DUP CFA ! \ convert `PAPER` to a code word
\ ( b -- )
\ b = color value
D1 C, \ pop de
3A C, 5C8F , \ ld a,(23695) ; ATTR_T
E6 C, C7 C, \ and %11000111 ; remove the current paper
50 07 + C, \ ld d,a ; save the result
78 03 + C, \ ld a,e ; new ink
E6 C, 38 C, \ and %00111000 ; only the paper
B0 02 + C, \ or d ; combine with the current attr
32 C, 5C8F , \ ld (23695),a ; update ATTR_T
32 C, 5C8D , \ ld (23693),a ; update ATTR_P
C3 C, NEXT , \ jp next
DUP ' PAPER OVER HERE SWAP - CMOVE DP !
DECIMAL -->
( BRIGHT )
HERE
\ ( f -- )
' BRIGHT DUP CFA ! \ convert `BRIGHT` to a code word
HEX
E1 C, \ pop hl
78 04 + C, \ ld a,h
B0 05 + C, \ or l
CA C, ' BRIGHT 11 + , \ jp z,turn_off
\ ; turn on
FD C, CB C, 53 C, C6 08 6 * + C, \ set 6,(iy+0x53) \ ATTR_P
FD C, CB C, 55 C, C6 08 6 * + C, \ set 6,(iy+0x55) \ ATTR_T
C3 C, NEXT , \ jp next
\ turn_off:
FD C, CB C, 53 C, 86 08 6 * + C, \ res 6,(iy+0x53) \ ATTR_P
FD C, CB C, 55 C, 86 08 6 * + C, \ res 6,(iy+0x55) \ ATTR_T
C3 C, NEXT , \ jp next
DUP ' BRIGHT OVER HERE SWAP - CMOVE DP ! DECIMAL -->
( FLASH )
HERE
' FLASH DUP CFA ! \ convert `FLASH` to a code word
\ ( f -- )
HEX
E1 C, \ pop hl
78 04 + C, \ ld a,h
B0 05 + C, \ or l
CA C, ' FLASH 11 + , \ jp z,turn_off
\ ; turn on
FD C, CB C, 53 C, C6 08 7 * + C, \ set 7,(iy+0x53) \ ATTR_P
FD C, CB C, 55 C, C6 08 7 * + C, \ set 7,(iy+0x55) \ ATTR_T
C3 C, NEXT , \ jp next
\ turn_off:
FD C, CB C, 53 C, 86 08 7 * + C, \ res 7,(iy+0x53) \ ATTR_P
FD C, CB C, 55 C, 86 08 7 * + C, \ res 7,(iy+0x55) \ ATTR_T
C3 C, NEXT , \ jp next
DUP ' FLASH OVER HERE SWAP - CMOVE DP ! DECIMAL -->
( GOVER )
\ Convert `GOVER` to a code word.
HERE ' GOVER DUP CFA ! ( f -- )
HEX
E1 C, \ pop hl
78 04 + C, \ ld a,h
B0 05 + C, \ or l
21 C, 5C91 , \ ld hl,23697 ; P_FLAG
CA C, ' GOVER 10 + , \ jp z,turn_off
\ ; turn on
CB C, C6 8 0 * + C, \ set 0,(hl) ; temporary
CB C, C6 8 1 * + C, \ set 1,(hl) ; permanent
C3 C, NEXT , \ jp next
\ turn_off:
CB C, 86 8 0 * + C, \ res 0,(hl) ; temporary
CB C, 86 8 1 * + C, \ res 1,(hl) ; permanent
C3 C, NEXT , \ jp next
DUP ' GOVER OVER HERE SWAP - CMOVE
DP ! DECIMAL -->
( INVERSE )
\ Convert `INVERSE` to a code word.
HERE ' INVERSE DUP CFA ! ( f -- )
HEX
E1 C, \ pop hl
78 04 + C, \ ld a,h
B0 05 + C, \ or l
21 C, 5C91 , \ ld hl,23697 ; P_FLAG
CA C, ' INVERSE 10 + , \ jp z,turn_off
\ ; turn on
CB C, C6 8 2 * + C, \ set 2,(hl) ; temporary
CB C, C6 8 3 * + C, \ set 3,(hl) ; permanent
C3 C, NEXT , \ jp next
\ turn_off:
CB C, 86 8 2 * + C, \ res 2,(hl) ; temporary
CB C, 86 8 3 * + C, \ res 3,(hl) ; permanent
C3 C, NEXT , \ jp next
DUP ' INVERSE OVER HERE SWAP - CMOVE
DP ! DECIMAL
( INK PAPER ) \ XXX OLD -- not used anymore
--> \ skip this screen, just in case
\ -----------------------------------------------------------
\ This version of `INK` causes strange problems (see note
\ 2015-07-13 in the history). Both `INK` and `PAPER` were
\ rewritten with a different approach.
\ -----------------------------------------------------------
HEX
HERE ' INK DUP CFA !
\ ( b -- ) \ 28%
\ b = color value
3E C, 10 C, D7 C, \ ld a,16 / rst 0x10
E1 C, 7D C, D7 C, \ pop hl / ld a,l / rst 0x10
CD C, 1CAD , \ call set-permanent-colors
C3 C, NEXT , \ jp next
DUP ' INK OVER HERE SWAP - CMOVE DP !
HERE ' PAPER DUP CFA !
\ ( b -- ) \ 17%
\ b = color value
3E C, 11 C, D7 C, \ ld a,17 / rst 0x10
E1 C, 7D C, D7 C, \ pop hl / ld a,l / rst 0x10
CD C, 1CAD , \ call set-permanent-colors
C3 C, NEXT , \ jp next
DUP ' PAPER OVER HERE SWAP - CMOVE DP !
DECIMAL
\ vim: filetype=abersoftforthafera
.( CONTINUED )
\ continued.fsb
\ `CONTINUED` for ZX Spectrum Abersoft Forth.
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-16: Written.
\ -----------------------------------------------------------
: CONTINUED ( n -- )
\ Continue interpretation at screen n.
\ Idea from the Forth-79 reference word set
\ (not part of the Forth-79 Standard).
\
\ The code is that of `LOAD` except
\ saving and restoring the current position.
\ In fact it could be a factor of `LOAD`.
0 IN ! B/SCR * BLK ! INTERPRET ;
\ vim: filetype=abersoftforthafera
.( 256-byte circular string buffer )
\ csb-256.fsb
\ Circular string buffer tool for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-05-17: Written.
\ 2015-05-18: `NEEDS`.
\ -----------------------------------------------------------
NEEDS ALLOT-CSB csb
256 ALLOT-CSB
\ vim: filetype=abersoftforthafera
.( Circular string buffer )
\ csb.fsb
\ Circular string buffer for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Requirements
NEEDS 2>R 2r
NEEDS 2R> 2r
NEEDS MOVE move
\ -----------------------------------------------------------
\ History
\ 2015-03-29: Written, adapted from csb8
\ (http://programandala.net/en.program.csb8.html), as part of
\ the module <strings.fsb>.
\
\ 2015-05-18: Moved to its own file. This way, applications
\ that just need transient strings do not waste the
\ dictionary space occupied by this code.
\
\ 2015-05-23: Requirements with `NEEDS`.
\ -----------------------------------------------------------
-->
( Circular string buffer -- core)
\ The parameters of the buffer are initialized with zero.
\ They will be updated when the buffer is created
\ by `ALLOT-CSB` or `USE-CSB`.
0 CONSTANT /CSB \ size
0 VARIABLE CSB-UNUSED \ unused space
0 CONSTANT CSB0 \ bottom address
: ?CSB ( len -- )
\ Make sure there's room for the given characters.
DUP CSB-UNUSED @ > IF /CSB CSB-UNUSED ! THEN
MINUS CSB-UNUSED +! ;
: ALLOCATE-STRING
\ Allocate space in the circular string buffer
\ for a string of the given length, and return
\ the free address.
( len -- ca ) ?CSB CSB0 CSB-UNUSED @ + ;
-->
( Circular string buffer -- interface)
: SET-CSB ( a len -- )
\ Use the given memory zone as circular string buffer.
DUP ' /CSB ! CSB-UNUSED ! ' CSB0 ! ;
: ALLOT-CSB ( len -- )
\ Create a circular string buffer of len bytes
\ in the dictionary and init it.
HERE OVER ALLOT SWAP SET-CSB ;
: SAVE-STRING ( ca1 len1 -- ca2 len1 )
\ Save a string into the circular string buffer
\ return it in its new address.
DUP ALLOCATE-STRING SWAP 2DUP 2>R MOVE 2R> ;
: SAVE-COUNTED-STRING ( ca1 len1 -- ca2 )
\ Save a string into the circular string buffer
\ as a counted string and return its new address.
DUP 1+ ALLOCATE-STRING DUP >R PLACE R> ;
\ vim: filetype=abersoftforthafera
.( CSWAP )
\ cswap.fsb
\ `CSWAP` for ZX Spectrum Abersoft Forth.
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-13: Adapted from Lennart Benschop's Spectrum
\ Forth-83.
\
\ 2015-04-17:
\
\ Renamed to `CSWAP`, after a Z80 fig-Forth implementation by
\ Dennis L. Wilson (1980). `><` is the name in the
\ "Uncontrolled Reference Words" of the Forth-83 Standard,
\ but `CSWAP` is clearer.
\
\ Converted from assembler to op-codes, to make it
\ independent from the assembler.
\ -----------------------------------------------------------
CREATE CSWAP ( n1 -- n2 )
\ Swap the low and high bytes within n1.
HEX
E1 C, \ pop hl
78 04 + C, \ ld a,h
60 05 + C, \ ld h,l
68 07 + C, \ ld l,a
C3 C, PUSHHL , \ jp PUSHHL
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera