Source of Afera (part 1: module names 0-9)
Description of the page content
Second part of the Afera library sources for Abersoft Forth.
Source code
.( Two 16-KiB RAM-disks )
\ 16kramdisks.fsb
\ Two 16-KiB RAM-disks 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
\ Abersoft Forth uses one 11-KiB RAM-disk at the top of the
\ memory map. This module, suitable only for ZX Spectrum
\ 128K (or later), modifies the system in order to use two
\ 16-KiB RAM-disks instead, using the additional memory
\ banks.
\
\ The 11 KiB of memory used by the original RAM-disk are
\ freed for the Forth dictionary.
\ -----------------------------------------------------------
\ Requirements
49152 R0 @ U< ?NEEDS lowersys
NEEDS BANK bank
\ -----------------------------------------------------------
\ History
\ 2015-05-11: Start.
\
\ 2015-05-12:
\
\ Fix: the second check was missing in `DISC-BLOCK`, what
\ caused `LIST` could be used with screen numbers greater
\ than 16.
\
\ Fix: Also `(TAPE)` needed a patch, the same way the module
\ <tape.fsb> does.
\
\ First working version.
\
\ Improvement: Second drive. The fig-Forth word `DR1` is
\ added.
\
\ Improvement: The contents of the old RAM-disk are moved to
\ the new one, thus the module must not quit after doing its
\ job, and other modules can be automatically loaded after
\ this one.
\
\ 2015-05-13: Change: The banks used are 4 and 6 (uncontended
\ memory) instead of 1 and 3 (contended memory).
\
\ 2015-05-17: Change: The banks used are 3 and 4. Simpler
\ calculation. Anyway, contended memory banks are different
\ in 128K and +3.
\
\ 2015-05-17: `NEEDS` and `?NEEDS` used. Improved: the
\ current permanent paper color is used to hide the screen
\ during the RAM-disk copying, instead of white; this way any
\ screen color set in the main file of the library will work.
\
\ 2015-06-02: Simpler method for patches, with `]` and `[`.
\
\ 2015-06-06: Fix: the patch of `R/W` can not use `]` and
\ `[`, because it's done in `INSTALL`, during compilation!
\
\ 2015-06-13: Fix: `DISC-BANK` did a wrong calculation. New:
\ `B/DR`.
\ -----------------------------------------------------------
\ TO-DO
\ `MESSAGE` would need a patch to get the messages always
\ from the first RAM-disk, not from the current one.
-->
( DISC DR1 DISC-BANK INIT-DISC )
0 CONSTANT B/DR \ blocks per drive (will be updated later)
: DR1 ( -- )
\ Select the second RAM-disk.
B/DR OFFSET ! ;
: DISC-BANK ( -- n )
\ Memory bank of the current RAM-disk.
1 OFFSET @ B/DR 1- > 2* + ;
: (INIT-DISC) ( -- )
\ Blank the current RAM-disk, that must be already paged in.
LO /DISC BLANKS ;
HERE
\ Compile the patch for `INIT-DISC`
\ (the original word occupies the same):
] DISC-BANK BANK (INIT-DISC) 0 BANK [
\ Move it:
DUP ' INIT-DISC OVER HERE SWAP - CMOVE
DP ! \ restore the disctionary pointer
-->
( LOADT SAVET VERIFY )
\ Patch the tape words to use the new RAM-disk.
: (BANK-TAPE) ( n -- )
\ Do a RAM-disk tape operation
\ with the proper memory bank paged in.
\ n = 0 for loading; 1 for saving; 2 for verifying
DISC-BANK BANK (TAPE) 0 BANK ;
' (BANK-TAPE) CFA ' LOADT 2+ !
' (BANK-TAPE) CFA ' SAVET 4 + !
' (BANK-TAPE) CFA ' VERIFY 2+ !
-->
( INSTALL -- part 1 )
HEX
: INSTALL ( -- )
\ Intall the two 16-KiB RAM-disks.
\
\ This long word, that forgets itself at the end, does all
\ operations that have to be done in one single step, while
\ no disk block is being interpreted, otherwise the system
\ could be affected. It includes also some simple patches
\ that could be done previously without risk, but that depend
\ on the new values of some constants, in order to use them
\ as literals, and those constants are modified here.
\ Update the length and bounds of the RAM-disk:
4000 ' /DISC ! \ 16 KiB length
C000 ' LO ! \ lowest address, when paged
LO /DISC + 1- ' HI ! \ highest address, when paged
\ Update the number of screens per drive (RAM-disk):
10 ' SCR/DR !
\ Update the number of blocks per drive (RAM-disk):
SCR/DR B/SCR * ' B/DR !
\ Make sure the buffers are empty before patching `R/W`:
EMPTY-BUFFERS
\ `(R/W)` was defined by the main file of the library,
\ with additional space required to patch it now
\ with the new code required by the 128K version.
HERE ' DISC-BANK CFA , ' BANK CFA , ' CMOVE CFA ,
' 0 CFA , ' BANK CFA ,
DUP ' (R/W) 08 + OVER HERE SWAP - CMOVE DP !
-->
( INSTALL -- part 2 )
\ The tape load header (pointed by IX before calling the ROM
\ routine) is at address 30182 (0x75E6). Its contents (after
\ fixing the length bug) are:
\ +00 : 3 (identifier of code file type)
\ +01 : "DISC " = 10-char filename, padded with spaces
\ +11 : 11264 (0x2C00) = length
\ +13 : 53248 (0xD0FF) = start address
\ +15 : " " (2 spaces) = not used for code files
\ Patch the tape load header
\ with the new length and start address:
/DISC 75E6 0B + ! LO 75E6 0D + !
\ Patch `(TAPE)` with the new default file start address:
LO 7619 !
\ The word `FREE` returns the free dictionary space. Its
\ original definition, according to the original memory map,
\ is:
\
\ : FREE ( -- n ) SP@ HERE - ;
\
\ After been patched by the module <lowersys.fsb>, its
\ definition is:
\
\ : FREE ( -- n ) LO HERE - ;
\
\ It has to be modified once more because now all RAM is
\ free, so '0' must be used instead of 'LO':
' 0 CFA ' FREE !
\ Move the contents of the old RAM-disk to the new one. This
\ makes it possible to use this module transparently, and
\ load other modules after it.
\
\ The first 6 KiB of the display (the bitmap) are used as a
\ buffer.
\ Save the display contents to bank 4.
4000 C000 1B00 4 BANK CMOVE 0 BANK
\ Set all the display attributes to the current permanent
\ paper color. This way display garbage caused by the
\ copying will not be seen.
\ 5C8D = system variable ATTR P (bits: 0-2=ink, 3-5=paper,
\ 6=bright, 7=flash)
5800 300 5C8D C@ 38 AND DUP 8 / + FILL
\ Copy the old RAM-disk (screens 1-6) to the display.
D000 4000 1800 CMOVE
\ Copy it from the display to the current RAM-disk bank.
4000 C000 1800 DISC-BANK BANK CMOVE 0 BANK
\ Copy the old RAM-disk (screens 7-11) to the display.
D000 1800 + 4000 1400 CMOVE
\ Copy it from the display to the current RAM-disk bank.
4000 C000 1800 + 1400 DISC-BANK BANK CMOVE 0 BANK
\ Restore the display contents from bank 4.
C000 4000 1B00 4 BANK CMOVE 0 BANK
\ Make this word to forget itself.
[ LATEST ] LITERAL DUP DP ! PFA LFA @ CURRENT @ !
\ System words have been patched with new ones,
\ therefore the changes must be protected.
EXTEND DECIMAL ; INSTALL
\ vim: filetype=abersoftforthafera
.( 2NIP )
\ 2nip.fsb
\ '2NIP` 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-13: Code copied from DZX-Forth
\ (http://programandala.net/en.program.dzx-forth.html).
CREATE 2NIP ( x1 x2 x3 x4 -- x3 x4 )
HEX E1 C, \ pop hl
D1 C, \ pop de
F1 C, \ pop af
F1 C, \ pop af
C3 C, PUSHDE , \ jp PUSHDE
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera
\ 2rdrop.fsb
\ `2RDROP` 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-10: Start. Written with conditional compilation to
\ reuse the code of `UNLOOP`, if present.
-->
.( 2RDROP )
CREATE 2RDROP ( R: x1 x2 -- )
SMUDGE
[UNDEFINED] UNLOOP \ if UNLOOP is not defined,
\ then ignore this line, that reuses its code and exit:
?\ ' UNLOOP ' 2RDROP CFA ! ;S
\ UNLOOP is not defined, so create new code:
HEX
2A C, 5E68 , \ ld hl,(RP) ; return stack pointer
23 C, \ inc hl
23 C, \ inc hl
23 C, \ inc hl
23 C, \ inc hl
22 C, 5E68 , \ ld (RP),hl ; update the pointer
C3 C, NEXT , \ jp NEXT
DECIMAL
\ vim: filetype=abersoftforthafera
.( 2R 2>R 2R> )
\ 2r.fsb
\ `2R`, `2>R` and `2R>` 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: First version written in the main file of the
\ library.
\
\ 2015-04-14: Code moved to <rstack.fsb> with all return
\ stack words.
\
\ 2015-05-10: Code moved to this file and rewritten in Z80.
\
\ 2015-10-26: Updated some comments.
\ -----------------------------------------------------------
\ Address of the return stack pointer, returned by `RP@`.
[DEFINED] RP ?\ HEX 5E68 CONSTANT RP DECIMAL
-->
( 2R )
CREATE 2R ( -- d ) ( R: d -- d )
HEX
D9 C, \ exx ; preserve bc
2A C, RP , \ ld hl,(RP) ; return stack pointer
4E C, 23 C, \ ld c,(hl) / inc hl
46 C, 23 C, \ ld b,(hl) / inc hl
5E C, 23 C, \ ld e,(hl) / inc hl
56 C, 23 C, \ ld d,(hl) / inc hl
D5 C, \ push de ; high part
C5 C, \ push bc ; low part
D9 C, \ exx ; restore bc
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL -->
\ XXX OLD -- High level version
\ : 2R ( -- d ) ( R: d -- d ) RP @ 2@ ;
( 2>R )
CREATE 2>R ( d -- ) ( R: -- d )
HEX
D9 C, \ exx ; preserve bc
C1 C, D1 C, \ pop bc / pop de
\ bc = low part, de = high part
2A C, RP , \ ld hl,(RP) ; return stack pointer
2B C, 70 02 + C, \ dec hl / ld (hl),d
2B C, 70 03 + C, \ dec hl / ld (hl),e
2B C, 70 00 + C, \ dec hl / ld (hl),b
2B C, 70 01 + C, \ dec hl / ld (hl),c
22 C, RP , \ ld (RP),hl ; update the pointer
D9 C, \ exx ; restore bc
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL -->
\ XXX OLD -- High level version
\ : 2>R ( d -- ) ( R: -- d )
\ COMPILE SWAP COMPILE >R COMPILE >R ; IMMEDIATE
( 2R> )
CREATE 2R> ( -- d ) ( R: d -- )
HEX
D9 C, \ exx ; preserve bc
2A C, RP , \ ld hl,(RP) ; return stack pointer
4E C, 23 C, \ ld c,(hl) / inc hl
46 C, 23 C, \ ld b,(hl) / inc hl
5E C, 23 C, \ ld e,(hl) / inc hl
56 C, 23 C, \ ld d,(hl) / inc hl
D5 C, \ push de ; high part
C5 C, \ push bc ; low part
22 C, RP , \ ld (RP),hl ; update the pointer
D9 C, \ exx ; restore bc
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL
\ XXX OLD -- High level version
\ : 2R> ( -- d ) ( R: d -- )
\ COMPILE R> COMPILE R> COMPILE SWAP ; IMMEDIATE
\ vim: filetype=abersoftforthafera
\ 2slash.fsb
\ `2/` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop
\ Copyright (C) 1985 Edmund Ramm
\ 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-16: Code written in the main file of the library,
\ adapted from code written by Edmund Ramm (1985-05-07) for
\ the Z80 fig-Forth implementation written by Dennis L.
\ Wilson (1980-09-07).
\
\ 2015-04-23: Code fixed. Negative numbers didn't work
\ because a wrong relative jump.
\
\ 2015-05-05: Extracted from the main file of the library.
\
\ 2015-08-12: New version, from Lennart Benschop's Spectrum
\ Forth-83 (1988).
-->
.( 2/ )
\ Code adapted from Lennart Benschop's Spectrum Forth-83
\ (1988).
CREATE 2/ ( n1 -- n2 )
HEX
E1 C, \ pop hl
CB C, 2C C, \ sra h
CB C, 1D C, \ rr l ; asr hl
C3 C, PUSHHL , \ jp PUSHHL
SMUDGE DECIMAL
\ XXX OLD -- previous version, adapted adapted from code
\ written by Edmund Ramm (1985).
\ CREATE 2/ ( n1 -- n2 )
\ HEX
\ E1 C, \ pop hl
\ CB C, 7C C, \ bit 7,h ; negative?
\ 18 C, 01 C, \ jr z,twosl1 ; no
\ 23 C, \ inc hl ; yes, add 1
\ \ twosl1:
\ CB C, 2C C, \ sra h
\ CB C, 1D C, \ rr l ; asr hl
\ C3 C, PUSHHL , \ jp PUSHHL
\ SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera
.( 48K? 128K? )
\ 48kq.fsb
\ Memory size checks for ZX Spectrum's Abersoft Forth
\ and related system patches
\ 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
NEEDS BANK bank
\ -----------------------------------------------------------
\ History
\ 2015-04-07: Start. Code adapted from Lennart Benschop's
\ Spectrum Forth-83.
\
\ 2015-05-07: Code moved to its own file, separated from
\ `BANK`.
\
\ 2015-05-11: New: `CPUK`, `.CPUK` and patch for `.CPU`.
\
\ 2015-05-14: Already integrated into the main file of the
\ library.
\
\ 2015-05-15: Restored.
\ -----------------------------------------------------------
HEX
: 48K? ( -- f )
\ Running on a 48K Spectrum?
\ An address in range 0xC000..0xFFFF is modified, then
\ checked after paging a different memory bank in, and
\ finally restored. If the contents of the address changed,
\ that means the paging had no effect, so it's a 48K.
\
\ This code was adapted from Lennart Benschop's Spectrum
\ Forth-83.
0 BANK FFFE @ 0 FFFE ! 1 BANK FFFE @ 1 FFFE !
0 BANK FFFE @ >R 1 BANK FFFE ! 0 BANK FFFE ! R> ;
: 128K? ( -- f ) 48K? 0= ;
DECIMAL -->
( CPUK .CPUK )
: CPUK ( -- n ) \ KiB of the machine.
48 128K? 80 * + ;
: .CPUK ( -- ) \ Print the computer family, 48K or 128K.
BASE @ DECIMAL SPACE CPUK 2 .R ." K" BASE ! ;
\ Substitute the temporary `NOOP` that was added after the
\ new message of `.CPU`:
' .CPUK CFA ' .CPU 14 + !
EXTEND \ protect the patches
\ vim: filetype=abersoftforthafera