Fuente de Afera (parte 4: nombres de módulo H-N)
Descripción del contenido de la página
Quinta parte de las fuentes de la biblioteca Afera para Abersoft Forth.
Etiquetas:
Código fuente
.( Move the 11-KiB RAM-disk )
\ hi-to.fsb
\ Move the RAM-disk of 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 module increases the free dictionary space of Abersoft
\ Forth with 1 KiB, but only if the system has been
\ previously moved below 0xC000 by the module <lowersys.fsb>.
\ This module is most useful for a 48K Spectrum; the 128K
\ model can use the module <16kramdisks.fsb> instead, and get
\ 11 KiB of memory for the dictionary.
\
\ A detailed explanation follows.
\
\ The default value of `HI` (the highest address of the
\ 11-KiB RAM-disk) is 1 KiB below the top of memory. That
\ space is used only by the UDG (168 bytes); 856 bytes are
\ unused by the system.
\ Address Returned by Description
\ -------------- ----------- --------------------------
\ 0xFFFF (65535) Top of memory
\ 0xFF58 (65368) `UDG` User defined graphics
\ (168 bytes)
\ Unused space (856 bytes)
\ 0xFBFF (64511) `HI` End of screens area
\ (RAM-disk)
\ 0xD000 (53248) `LO` Start of screens area
\ (RAM-disk)
\ Of course the space above `HI` can be used by Forth
\ programs in any way, but it would be more useful as part of
\ the dictionary space.
\
\ This module is useful only after the module <lowersys.fsb>
\ has moved the system below 0xC000. Otherwise the freed
\ memory will not be available for the dictionary, but simply
\ moved down, between the RAM-disk and the disk buffers.
\
\ When compiling this module, the constant `NEW-HI` must be
\ the latest word defined. It must hold the new address of
\ `HI`. The modules <hi-to-top.fsb> and <hi-to-udg.fsb> do
\ that. See them for details.
\
\ WARNING: If `NEW-HI` is equal or greater than `UDG`, the
\ address of the user defined graphics will be changed to 0
\ (ROM). Then, in order to use them, the user must reserve
\ space for them in the dictionary and point the
\ correspondent system variable (0x5C7B) to it.
\ -----------------------------------------------------------
\ Requirements
49152 R0 @ U< ?NEEDS lowersys
\ The word `NEW-HI` is provided also by the module
\ <hi-to-udg.fsb>, but <hi-to-top.fsb> is used as
\ default.
NEEDS NEW-HI hi-to-top
\ -----------------------------------------------------------
\ History
\
\ 2015-05-15: Start. First working version..
\
\ 2015-05-17: `NEEDS` and `?NEEDS` used.
\
\ 2015-07-18: Fixed the hardcoded addresses of the RAM-disk
\ in `(TAPE)` and the tape headers. This problem was found
\ during the development of Tron 0xF
\ (http://programandala.net/en.program.tron_0xf.html).
\
\ 2015-10-26: Typo.
\ -----------------------------------------------------------
-->
( Main )
HEX
\ If the new location of the RAM-disk
\ overwrites the user defined graphics,
\ point them to 0 (ROM).
UDG NEW-HI U< ?\ 0 5C7B !
NEW-HI 1+ CONSTANT ABOVE-HI
ABOVE-HI /DISC - CONSTANT NEW-LO
NEW-HI HI - CONSTANT FREED
: HI>TOP ( -- )
\ Update `HI` and `LO`:
LO FREED + ' LO ! NEW-HI ' HI !
\ Patch `(TAPE)` and the tape headers
\ with the new value of `LO`:
LO [ ' (TAPE) 6 + ] LITERAL ! LO 75F3 ! LO 7604 ! ;
\ The origin and destination zones overlap, so `CMOVE>`
\ is the preferred method if available.
1 [DEFINED] CMOVE> ?\ 1+
+LOAD
DISC>TOP
FORGET NEW-HI DECIMAL
( Do it with CMOVE> )
: DISC>TOP ( -- )
LO ABOVE-HI /DISC - /DISC CMOVE>
HI>TOP ;
( Do it without CMOVE> )
\ The origin and destination zones overlap, so the 11 KiB are
\ moved by pieces of 512 bytes, from top to bottom.
512 CONSTANT /PIECE
/DISC /PIECE / CONSTANT PIECES
: PIECE ( n -- a1 a2 len )
/PIECE * >R HI R - ABOVE-HI R> - /PIECE ;
: DISC>TOP ( -- )
PIECES 0 DO I PIECE CMOVE LOOP
HI>TOP ;
\ vim: filetype=abersoftforthafera
.( The 11-KiB RAM-disk will be moved up to top of memory)
\ hi-to-top.fsb
\ Move the RAM-disk of ZX Spectrum Abersoft Forth to top
\ 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 module increases the free dictionary space of Abersoft
\ Forth with 1 KiB, but only if the system has been
\ previously moved below 0xC000 by the module <lowersys.fsb>.
\ This module is most useful for a 48K Spectrum; the 128K
\ model can use the module <16kramdisks.fsb> instead, and get
\ 11 KiB of memory for the dictionary.
\
\ WARNING: This module moves the RAM-disk to the top of
\ memory, overwritting the zone reserved to user defined
\ graphics (UDG), whose address will be changed to 0 (ROM).
\ Then, in order to use the them, the user must reserve space
\ for them in the dictionary and point the correspondent
\ system variable (0x5C7B) to it. The alternative module
\ <hi-to-udg.fsb> preserves the UDG.
\
\ This module must be loaded right before the module
\ <hi-to.fsb>. See <hi-to.fsb> for full details, including a
\ memory map.
\ -----------------------------------------------------------
HEX
FFFF CONSTANT NEW-HI
DECIMAL
\ vim: filetype=abersoftforthafera
.( The 11-KiB RAM-disk will be moved up below the UDG)
\ hi-to-udg.fsb
\ Move the RAM-disk of ZX Spectrum Abersoft Forth to UDG
\ 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 module increases the free dictionary space of Abersoft
\ Forth with 856 bytes, but only if the system has been
\ previously moved below 0xC000 by the module <lowersys.fsb>.
\ This module is most useful for a 48K Spectrum; the 128K
\ model can use the module <16kramdisks.fsb> instead, and get
\ 11 KiB of memory for the dictionary.
\
\ The alternative module <hi-to-top.fsb> overwrites the UDG
\ and frees 1 KiB of memory.
\
\ This module must be loaded right before <hi-to.fsb>. See
\ <hi-to.fsb> for full details, including a memory map.
\ -----------------------------------------------------------
UDG 1- CONSTANT NEW-HI
\ vim: filetype=abersoftforthafera
.( INKEY? )
\ inkeyq.fsb
\ `INKEY?` 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-31: 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.
\ -----------------------------------------------------------
: INKEY? ( -- c true | false )
\ If a key is pressed, return its code and a true flag;
\ otherwise return a false flag.
INKEY DUP 255 <> DUP 0= IF NIP THEN ;
\ INKEY DUP 255 <> DUP ?EXIT NIP ;
\ vim: filetype=abersoftforthafera
\ keyboard.fsb
\ Keyboard extensions 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
\ Some tools to manage key presses. An improved and detailed
\ implementation can be found in the Tron 0xF game
\ (http://programandala.net/en.program.tron_0xf.html).
\ -----------------------------------------------------------
\ History
\ 2015-03-21: Start: ports, key identifiers, key table,
\ 'pressed?', 'pressed'.
\
\ 2015-03-23: Fix: The 0x0A bit mask was used instead of
\ 0x10.
\
\ 2015-10-16: Fixed comment.
\
\ 2016-02-20: Changed the layout of the table.
\ -----------------------------------------------------------
-->
( Keyboard rows ports)
HEX
F7FE CONSTANT KEY-ROW-1-5 \ 1 to 5
FBFE CONSTANT KEY-ROW-Q-T \ Q to T
FDFE CONSTANT KEY-ROW-A-G \ A to G
FEFE CONSTANT KEY-ROW-CS-V \ Caps Shift to V
EFFE CONSTANT KEY-ROW-6-0 \ 6 to 0
DFFE CONSTANT KEY-ROW-Y-P \ Y to P
BFFE CONSTANT KEY-ROW-H-EN \ H to Enter
7FFE CONSTANT KEY-ROW-B-SP \ B to Space
-->
( Key identifiers)
01 KEY-ROW-1-5 2CONSTANT K-1
02 KEY-ROW-1-5 2CONSTANT K-2
04 KEY-ROW-1-5 2CONSTANT K-3
08 KEY-ROW-1-5 2CONSTANT K-4
10 KEY-ROW-1-5 2CONSTANT K-5
01 KEY-ROW-Q-T 2CONSTANT K-Q
02 KEY-ROW-Q-T 2CONSTANT K-W
04 KEY-ROW-Q-T 2CONSTANT K-E
08 KEY-ROW-Q-T 2CONSTANT K-R
10 KEY-ROW-Q-T 2CONSTANT K-T
01 KEY-ROW-A-G 2CONSTANT K-A
02 KEY-ROW-A-G 2CONSTANT K-S
04 KEY-ROW-A-G 2CONSTANT K-D
08 KEY-ROW-A-G 2CONSTANT K-F
10 KEY-ROW-A-G 2CONSTANT K-G -->
( Key identifiers)
01 KEY-ROW-CS-V 2CONSTANT K-CS
02 KEY-ROW-CS-V 2CONSTANT K-Z
04 KEY-ROW-CS-V 2CONSTANT K-X
08 KEY-ROW-CS-V 2CONSTANT K-C
10 KEY-ROW-CS-V 2CONSTANT K-V
01 KEY-ROW-6-0 2CONSTANT K-0
02 KEY-ROW-6-0 2CONSTANT K-9
04 KEY-ROW-6-0 2CONSTANT K-8
08 KEY-ROW-6-0 2CONSTANT K-7
10 KEY-ROW-6-0 2CONSTANT K-6
01 KEY-ROW-Y-P 2CONSTANT K-P
02 KEY-ROW-Y-P 2CONSTANT K-O
04 KEY-ROW-Y-P 2CONSTANT K-I
08 KEY-ROW-Y-P 2CONSTANT K-U
10 KEY-ROW-Y-P 2CONSTANT K-Y -->
( Key identifiers)
01 KEY-ROW-H-EN 2CONSTANT K-EN
02 KEY-ROW-H-EN 2CONSTANT K-L
04 KEY-ROW-H-EN 2CONSTANT K-K
08 KEY-ROW-H-EN 2CONSTANT K-J
10 KEY-ROW-H-EN 2CONSTANT K-H
01 KEY-ROW-B-SP 2CONSTANT K-SP
02 KEY-ROW-B-SP 2CONSTANT K-SS
04 KEY-ROW-B-SP 2CONSTANT K-M
08 KEY-ROW-B-SP 2CONSTANT K-N
10 KEY-ROW-B-SP 2CONSTANT K-B
DECIMAL -->
( Keys table manipulation -- slower )
\ ............................................
\ Method 1: more compact but slower
\ Every key identifier occupies 3 bytes in the table (total
\ size is 120 bytes)
\ 3 CONSTANT /K \ bytes per key definition in the keys table
\ Store a key definition into the keys table:
\ : K, ( bitmask port -- ) , C, ;
\ Fech a key definition from an element of the keys table:
\ : K@ ( a -- bitmask port ) DUP C@ SWAP 1+ @ ;
\ ............................................
\ Method 2: bigger but faster
\ With these words, every key identifier occupies 4 bytes
\ in the table (total size is 160 bytes)
4 CONSTANT /K \ bytes per key definition in the keys table
\ Store a key definition into the keys table:
: K, ( d -- ) , , ;
\ Fech a key definition from an element of the keys table:
: K@ ( a -- bitmask port ) 2@ ;
-->
( Keys table -- comon words and data )
40 CONSTANT KEYS
0 VARIABLE K-TABLE -2 ALLOT
K-1 K, K-2 K, K-3 K, K-4 K, K-5 K,
K-Q K, K-W K, K-E K, K-R K, K-T K,
K-A K, K-S K, K-D K, K-F K, K-G K,
K-CS K, K-Z K, K-X K, K-C K, K-V K,
K-0 K, K-9 K, K-8 K, K-7 K, K-6 K,
K-P K, K-O K, K-I K, K-U K, K-Y K,
K-EN K, K-L K, K-K K, K-J K, K-H K,
K-SP K, K-SS K, K-M K, K-N K, K-B K,
-->
( PRESSED? PRESSED )
: PRESSED? ( n1 n2 -- flag )
\ Is a key pressed?
\ n1 = key bit mask
\ n2 = keyboard row port
INP AND NOT ;
: PRESSED ( -- false | bitmask port true )
\ Return the key identifier of the first key
\ from the keys table that happens to be pressed.
0 \ false by default
[ K-TABLE KEYS /K * BOUNDS SWAP ] LITERAL LITERAL
DO I K@ PRESSED? IF DROP I K@ 1 LEAVE THEN
/K +LOOP ;
-->
( ONLY-ONE-PRESSED )
0. 2VARIABLE K-PRESSED
: ONLY-ONE-PRESSED ( -- false | bitmask port true )
\ XXX TODO finish
\ Return the key identifier of the key pressed,
\ if there's only one key pressed.
0. K-PRESSED 2! \ none by default
[ K-TABLE KEYS /K * BOUNDS SWAP ] LITERAL LITERAL
DO I K@ PRESSED?
IF K-PRESSED 2@ + IF
THEN
/K +LOOP
K-PRESSED 2@ 2DUP + IF 1 ELSE 2DROP 0 THEN
;
\ vim: filetype=abersoftforthafera
\ key_identifiers.fsb
\ Key identifiers 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-23: Written.
\
\ 2015-03-28: Converted to fsb format; file renamed.
\
\ 2015-05-02: Comments.
\ -----------------------------------------------------------
-->
( Load )
HEX
1 3 +THRU
DECIMAL
\ Every key is identified by a double constant that stores
\ the port of the key row and the key bitmask in its row.
( Rows 1-5 Q-T A-G )
01 F7FE 2CONSTANT K-1
02 F7FE 2CONSTANT K-2
04 F7FE 2CONSTANT K-3
08 F7FE 2CONSTANT K-4
10 F7FE 2CONSTANT K-5
01 FBFE 2CONSTANT K-Q
02 FBFE 2CONSTANT K-W
04 FBFE 2CONSTANT K-E
08 FBFE 2CONSTANT K-R
10 FBFE 2CONSTANT K-T
01 FDFE 2CONSTANT K-A
02 FDFE 2CONSTANT K-S
04 FDFE 2CONSTANT K-D
08 FDFE 2CONSTANT K-F
10 FDFE 2CONSTANT K-G
( Rows CS-V 0-9 P-Y )
01 FEFE 2CONSTANT K-CS
02 FEFE 2CONSTANT K-Z
04 FEFE 2CONSTANT K-X
08 FEFE 2CONSTANT K-C
10 FEFE 2CONSTANT K-V
01 EFFE 2CONSTANT K-0
02 EFFE 2CONSTANT K-9
04 EFFE 2CONSTANT K-8
08 EFFE 2CONSTANT K-7
10 EFFE 2CONSTANT K-6
01 DFFE 2CONSTANT K-P
02 DFFE 2CONSTANT K-O
04 DFFE 2CONSTANT K-I
08 DFFE 2CONSTANT K-U
10 DFFE 2CONSTANT K-Y
( Rows EN-H SP-B )
01 BFFE 2CONSTANT K-EN
02 BFFE 2CONSTANT K-L
04 BFFE 2CONSTANT K-K
08 BFFE 2CONSTANT K-J
10 BFFE 2CONSTANT K-H
01 7FFE 2CONSTANT K-SP
02 7FFE 2CONSTANT K-SS
04 7FFE 2CONSTANT K-M
08 7FFE 2CONSTANT K-N
10 7FFE 2CONSTANT K-B
\ vim: filetype=abersoftforthafera
.( Loaded )
\ loaded_execute.fsb
\ Part of a
\ tape source loader for ZX Spectrum Abersoft Forth
\ http://programandala.net/en.program.tron_0xf.html
\ 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 must be the last one to be loaded. It stores the
\ cfa of the latest word into the `LOADED' variable, what
\ causes the loader to stop and to execute it.
\
\ See <loader.fsb> for details.
\ -----------------------------------------------------------
\ History
\ 2015-05-08: Start.
\ 2015-07-14: Updated after the changes in <loader.fsb>.
\ -----------------------------------------------------------
LATEST PFA CFA LOADED !
\ vim: filetype=abersoftforthafera
.( Loaded )
\ loaded.fsb
\ Part of a
\ tape source loader for ZX Spectrum Abersoft Forth
\ http://programandala.net/en.program.tron_0xf.html
\ 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 must be the last one to be loaded. It simply
\ stores 1 into the `LOADED' variable, what causes the
\ loader to stop.
\
\ See <loader.fsb> for details.
\ -----------------------------------------------------------
\ History
\ 2015-05-08: Start.
\ 2015-07-14: Updated after the changes in <loader.fsb>.
\ -----------------------------------------------------------
1 LOADED !
\ vim: filetype=abersoftforthafera
.( Loaded )
\ loaded_quit.fsb
\ Part of a
\ tape source loader for ZX Spectrum Abersoft Forth
\ http://programandala.net/en.program.tron_0xf.html
\ 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 must be the last one to be loaded. It is an
\ alternative to <loaded.fsb>. See <loader.fsb> and
\ <loaded.fsb> for details.
\ -----------------------------------------------------------
\ History
\ 2015-05-09: Start.
\ -----------------------------------------------------------
RP! QUIT
\ vim: filetype=abersoftforthafera
--> \ loader.fsb
\ Part of a
\ tape source loader 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 module defines an executes a tape source loader. It is
\ intended to make it easy to load sources of any length, in
\ other words, TAP files that contain any number of Forth
\ RAM-disk files with sources to be compiled in certain
\ order.
\
\ The loader gets every RAM-disk file from tape and loads its
\ screen 1. The process repeats until the `LOADED?` variable
\ is not zero. The modules <loaded.fsb> or
\ <loaded_execute.fsb> can be used to stop the process.
\
\ In some cases <loaded.fsb> or <loaded_execute.fsb> can not
\ be used. For example, when the RAM-disk is used as storage
\ for binary data loaded from tape at the end of the sources.
\ Then the application itself must stop the loader at the end
\ of the compilation process: Setting `LOADED?` to 1 (stop)
\ or -1 (stop and execute the latest word defined) is enough;
\ an alternative method is to clear the return stack with
\ `RP!` and then execute the boot word.
\ Note: This file is the first one to be loaded, even before
\ the <afera.fsb>. That's why it can not use any word defined
\ by the Afera library, or use the first screen for code.
\ -----------------------------------------------------------
\ History
\ 2015-05-08: Start, based on the loader of Tron 0xF
\ (http://programandala.net/en.program.tron_0xf.html).
\
\ 2015-05-17: Fix: `LOADER` didn't reset `LOADED?` at the
\ start.
\
\ 2015-07-05: Fix: Typo.
\
\ 2015-07-14: Changed the name and usage of `LOADED`, in
\ order to make it more flexible. Now any word can be
\ executed, not just the latesonee.
\ -----------------------------------------------------------
( Library modules loader )
." Loader "
FORTH DEFINITIONS
0 VARIABLE LOADED
\ Flag: Have all sources been loaded?
\ It's set in the last source file.
\ Possible values:
\ 0 = keep on loading sources
\ 1 = stop the loader
\ cfa = stop the loader and execute the cfa
: LOADER ( -- )
\ Get and compile every RAM-disk from tape, until `LOADED?`
\ is on, and then, depending of its value, execute the latest
\ word defined.
\ XXX TMP benchmark -- reset the system frames counter
\ 0 23672 ! 0 23674 C!
0 LOADED !
BEGIN LOADED @ 0= WHILE
255 23692 C! ( avoid the "scroll?" prompt)
EMPTY-BUFFERS INIT-DISC LOADT 1 LOAD
REPEAT
\ XXX TMP benchmark -- result
\ 23672 @ 23674 C@ D. ." FRAMES" CR
\ LOADED @ -1 = IF RP! LATEST PFA CFA EXECUTE THEN ;
LOADED @ 1 - IF
RP! LOADED @ EXECUTE QUIT
THEN ;
LOADER
\ vim: filetype=abersoftforthafera
.( Logo-like graphics)
\ logo.fsb
\ Logo-like graphics for ZX Spectrum Abersoft Forth
\ Copyright (C) 1985,2009,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
\ 1985-05-20: First version.
\
\ 2009-05-27: Improved with the following words: `X!`, `Y!`,
\ `COORDS`, `X-COORD`, `Y-COORD, `RELATIVE`.
\
\ 2015-04-15: Included in the Afera library. `COORDS` is
\ renamed to `SYS-COORDS` after the current convention.
\
\ 2015-05-02: Improved with `MINUS` and conditional
\ compilation. `X-COORD` and `Y-COORD` renamed with the
\ "SYS-" prefix, after the current convention for system
\ variable aliases.
\ -----------------------------------------------------------
-->
( Coordinates )
\ Define the required system variables,
\ if needed.
[DEFINED] SYS-COORDS
?\ 23677 CONSTANT SYS-COORDS \ ZX Spectrum system variable
[DEFINED] SYS-X-COORDS
?\ SYS-COORDS CONSTANT SYS-X-COORD
[DEFINED] SYS-Y-COORD
?\ SYS-COORDS 1+ CONSTANT SYS-Y-COORD
: X@ ( -- b ) SYS-X-COORD C@ ;
: Y@ ( -- b ) SYS-Y-COORD C@ ;
: X! ( b -- ) SYS-X-COORD C! ;
: Y! ( b -- ) SYS-Y-COORD C! ;
-->
( Commands )
: RELATIVE ( x1 y1 -- x2 y2 ) Y@ + SWAP X@ + SWAP ;
: RDRAW ( x y -- ) RELATIVE DRAW ;
: SETXY ( x y -- ) RELATIVE PLOT ;
: RIGHT ( u -- ) 0 RDRAW ;
: LEFT ( u -- ) MINUS 0 RDRAW ;
: UP ( u -- ) 0 SWAP RDRAW ;
: DOWN ( u -- ) MINUS 0 SWAP RDRAW ;
: PAT ( x y -- ) Y! X! ;
: RPAT ( x y -- ) Y@ + Y! X@ + X! ;
: RPLOT ( u -- ) 0 SETXY ;
: LPLOT ( u -- ) MINUS 0 SETXY ;
: UPLOT ( u -- ) 0 SWAP SETXY ;
: DPLOT ( u -- ) MINUS 0 SWAP SETXY ;
\ vim: filetype=abersoftforthafera
\ lowerc.fsb
\ `LOWERC` 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-23: First version.
\ -----------------------------------------------------------
-->
.( LOWERC )
HEX
CREATE LOWERC ( c -- c' )
\ Convert an ASCII character to lowercase.
E1 C, \ pop hl
78 05 + C, \ ld a,l
FE C, 41 C, \ cp 'A'
38 C, 06 C, \ jr c,end
FE C, 5B C, \ cp 'Z'+1
30 C, 02 C, \ jr nc,end
E6 C, 20 C, \ or %00100000 ; set bit 5
\ end:
68 07 + C, \ ld l,a
C3 C, PUSHHL , \ jp PUSHHL
SMUDGE
DECIMAL
\ vim: filetype=abersoftforthafera
.( LOWERS )
\ lowers.fsb
\ `LOWERS` 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-06: First version.
\ -----------------------------------------------------------
: LOWERS ( ca len -- )
\ Convert a string to uppercase.
BOUNDS DO I C@ LOWERC I C! LOOP ;
\ vim: filetype=abersoftforthafera
.( Lower the system below 0xC000 )
\ lowersys.fsb
\ Move ZX Spectrum Abersoft Forth below address 0xC000
\ 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 is a fig-Forth system and so its memory map:
\ Address Returned by Description
\ -------------- ----------- --------------------------
\ 0xFFFF (65535) Top of memory
\ 0xFF58 (65368) `UDG` User defined graphics
\ Unused space (856 bytes)
\ 0xFBFF (64511) `HI` End of screens area
\ (RAM-disk)
\ 0xD000 (53248) `LO` Start of screens area
\ (RAM-disk)
\ 0xD000 (53248) `LIMIT` End of buffer area plus 1
\ 0xCBE0 (52192) `FIRST` Start of buffer area
\ (lowest buffer start)
\ 0xCBE0 (52192) `R0 @` Initial location (bottom)
\ of the return stack
\ (grows toward low memory)
\ ? `RP@` Return stack pointer
\ 0xCB40 (52032) `TIB @` Terminal input buffer
\ 0xCB40 (52032) `S0 @` Initial location (bottom)
\ of the data stack
\ (grows toward low memory)
\ ? `SP@` Data stack pointer
\ ... Free space
\ 0x819D (33181) `PAD` Text output buffer
\ 0x8159 (33113) `HERE` `WORD` buffer
\ 0x8159 (33113) `HERE` Dictionary pointer
\ 0x5E40 (24128) `0 +ORIGIN` Start of the system
\ The problem is the ZX Spectrum 128 models page the
\ additional RAM banks on the upper 16 KiB of the memory
\ (0xC000-0xFFFF). In order to use this extra memory, the
\ vital parts of the Forth system (the data stack, the
\ terminal input buffer, the return stack and the disk block
\ buffers) have to be moved below address 0xC000.
\ This module is useful for the ZX Spectrum 48 too, in
\ combination with the module <hi-to.fsb>, in order to get 1
\ KiB of additional memory for the Forth dictionary. See
\ <hi-to.fsb> for more details.
\ Important note:
\
\ With the new memory map, a stack overflow could corrupt the
\ dictionary below the stack, before `?STACK` can notice,
\ easier than with the original fig-Forth memory map. The
\ same can happen when a stack is empty.
\ -----------------------------------------------------------
\ History
\ 2015-05-06: Start.
\ 2015-05-07: Data stack, return stack and TIB are moved.
\ 2015-05-08: Block buffers are moved. `FREE` is patched.
\ 2015-07-17: Description completed with a mention to
\ <hi-to.fsb>.
\ -----------------------------------------------------------
\ To-do
\ XXX FIXME 2015-05-15
\
\ Everything works fine when this module is loaded with
\ `LOADER`; but when the module is loaded manually with
\ `RUNT` or `LOADT 1 LOAD`, a strange "OT? MSG # 0" error
\ always happens at the end, but with no `WHERE` parameters
\ on the stack...
\
\ The reason of this problem is still unknown. The contents
\ of the buffers are exactly the same at the end of the
\ proccess, and the pointers have been properly adapted.
\ -----------------------------------------------------------
-->
( Move the data stack )
\ Definition of `?STACK` in C. H. Ting's book _Systems Guide
\ to figFORTH_.
\ : ?STACK ( -- )
\ \ Issue error message
\ \ if the data stack is out of bounds.
\ SP@ S0 > \ out of upper bound?
\ 1 ?ERROR \ stack underflow
\ SP@ HERE 128 + < \ out of lower bound?
\ 7 ?ERROR \ stack overflow
\ ;
\ Definition of `?STACK` in Abersoft Forth.
\ : ?STACK ( -- )
\ \ Issue error message
\ \ if the data stack is out of bounds.
\ SP@ S0 @ SWAP U< \ out of upper bound?
\ 1 ?ERROR \ stack underflow
\ SP@ HERE 128 + < \ out of lower bound?
\ 7 ?ERROR \ stack overflow
\ ;
\ The lower bound has to be changed: instead of `HERE 128 +`
\ it must be the new fixed address.
\ -----------------------------------------------------------
HEX
\ The current dictionary pointer is both the start of the
\ patch and the new lower bound of the data stack.
HERE
\ Step 0: Compile the patch for `?STACK`.
\
\ The first `?ERROR` in `?STACK` is temporarily substituted
\ with `2DROP` to prevent a later error during the init of
\ the new data stack pointers.
' 2DROP CFA , ' SP@ CFA , ' LIT CFA , DUP ,
' < CFA , ' LIT CFA , 7 , ' ?ERROR CFA , ' ;S CFA ,
\ XXX Unused space: 4 bytes at 0x6C4B
\ Step 1: Copy the patch
DUP \ Origin: start of the compiled patch.
' ?STACK 0C + \ Destination: first `?ERROR` in `?STACK`.
OVER HERE SWAP - CMOVE \ Do it.
\ Step 2: Allocate space for the new data stack
\ (0x80 bytes minus the bytes reused from the patch).
80 HERE ROT - - ALLOT
\ Step 3: Init the new data stack pointers.
\ System addresses:
\ 0x5E06 holds `S0`.
\ 0x5E54 holds its initial value.
HERE DUP 5E06 ! 5E52 ! SP!
\ Step 4: Restore the first `?ERROR` of `?STACK`,
\ that was substituted by a `2DROP`.
' ?ERROR CFA ' ?STACK 0C + !
DECIMAL -->
( Move the terminal input buffer )
HEX
\ System addresses:
\ 0x5E0A holds the address of `TIB`.
\ 0x5E56 holds its initial value.
HERE DUP 5E0A ! 5E56 ! 52 ALLOT
DECIMAL -->
( Move the return stack -- old first method ) --> \ XXX OLD
\ XXX FIXME 2015-05-15
\
\ Stacks dont't match at the end: A 0x20 is added at the top,
\ no matter if the limit of the second loop is reduced.
HEX 80 ALLOT \ space for the new return stack
\ System addresses:
\ 0x5E08 holds `R0`.
\ 0x5E54 holds its initial value.
\ 0x5E54 is used only by `COLD`, so it's safe to change it
\ now; it will be used to update 0x5E08:
HERE 5E54 !
: TASK ;
[DEFINED] RDEPTH ?\ : RDEPTH ( -- u ) RP@ R0 @ - -2 / ;
0 VARIABLE SAVED \ Elements saved from the old return stack.
: R>R ( -- )
\ Move the old return stack to the new one.
\ Copy the contents of the old return stack
\ to the data stack
\ (the `LOOP` parameters must be preserved).
RDEPTH
\ XXX TMP for debugging
\ DUP CR ." RDEPTH before=" . ." RTOS=" R . CR
CR .RS
DUP SAVED ! 0 DO R> R> R> ROT ROT >R >R LOOP
\ Activate and clear the new return stack:
5E54 @ 5E08 ! RP!
\ Restore the contents of the old return stack
\ from the data stack to the new return stack
\ (the `LOOP` parameters must be preserved).
SAVED @ 0 DO R> R> ROT >R >R >R LOOP
\ XXX TMP for debugging
\ RDEPTH ." RDEPTH after=" . ." RTOS=" R . KEY DROP ;
CR .RS ;
R>R FORGET TASK DECIMAL -->
( Move the return stack -- second method )
\ This second method is simpler, faster, and works fine.
\ The new stack is an exact copy of the old one.
HEX 80 ALLOT HERE \ space for the new return stack
\ System addresses:
\ 0x5E68 holds the return stack pointer, returned by `RP@`
\ 0x5E08 holds `R0`
\ 0x5E54 holds the initial value of `R0`
: R>R ( a -- )
\ Move the old return stack to the new one.
\ a = top of the new return stack
\ Calculate the positive offset
\ from the old stack to the new one.
R0 @ OVER -
\ Move the contents of the old stack to the new one.
OVER 50 - R0 @ 50 - SWAP 50 CMOVE
\ Activate the new return stack,
\ updating the pointer with the offset.
RP@ SWAP - 5E68 !
\ Update `R0` and its default value.
DUP 5E54 ! 5E08 ! ;
R>R FORGET R>R DECIMAL -->
( Compare buffers ) --> \ XXX TMP for debugging
0 CONSTANT OLD-PREV 0 CONSTANT OLD-USE
LIMIT CONSTANT OLD-LIMIT FIRST CONSTANT OLD-FIRST
B/BUF 4 + CONSTANT /BUF
: .BUFFERS ( -- )
HEX #BUFF 0 DO
." Buffer " I . ." is at " FIRST I /BUF * + U. CR
LOOP DECIMAL ;
-->
( Compare buffers ) --> \ XXX TMP for debugging
: COMPARE ( n1 n2 -- ) 2DUP U. U. SWAP - . CR ;
: MISMATCH ( n -- )
DUP ." Mismatch at FIRST + " U. CR CR
FIRST OVER + 32 DUMP CR OLD-FIRST SWAP + 32 DUMP ;
: COMPARE-BUFFERS ( -- )
HEX CR ." new old offset" CR
." FIRST = " OLD-FIRST FIRST COMPARE
." LIMIT = " OLD-LIMIT LIMIT COMPARE
." PREV = " OLD-PREV PREV @ COMPARE
." USE = " OLD-USE USE @ COMPARE
LIMIT FIRST - 0 DO
FIRST I + C@ OLD-FIRST I + C@ - IF I MISMATCH LEAVE THEN
LOOP DECIMAL ; -->
( Move the disk block buffers and update FREE )
HERE \ address of the new buffers
DUP FIRST - \ negative offset from the old buffers
LIMIT FIRST - ALLOT \ space for the new buffers
: BUFFERS>BUFFERS ( -n a -- )
\ Move the disk buffers to their new position.
\ a = address of the new buffers
\ -n = offset from the old buffers to the new ones
\ Copy the disk buffers to the new address.
FIRST OVER LIMIT FIRST - CMOVE
\ Update their bound addresses.
( a ) DUP ' FIRST ! B/BUF 4 + #BUFF * + ' LIMIT !
\ XXX TMP -- for debugging
\ PREV @ ' OLD-PREV ! USE @ ' OLD-USE !
\ HEX CR ." PREV = " PREV @ U. ." USE = " USE @ U. CR
\ ." offset=" DUP . CR
\ Update the buffer pointers with the offset.
( -n ) DUP PREV +! USE +!
\ XXX TMP -- for debugging
\ ." PREV = " PREV @ U. ." USE = " USE @ U. CR
\ XXX OLD
\ Make this word to forget itself.
\ [ LATEST ] LITERAL DUP DP ! PFA LFA @ CURRENT @ !
\ XXX TMP -- for debugging
\ COMPARE-BUFFERS
; SWAP BUFFERS>BUFFERS FORGET BUFFERS>BUFFERS
\ The word `FREE` returns the free dictionary space,
\ according to the original memory map.
\
\ : FREE ( -- n ) SP@ HERE - ;
\
\ It has to be modified because the top limit of the free
\ dictionary space is not the stack pointer any more, but the
\ start of the RAM-disk, returned by `LO`.
' LO CFA ' FREE !
\ vim: filetype=abersoftforthafera
.( -ROT )
\ minus-rot.fsb
\ `-ROT` 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-29: Code written in the main file of the library.
\ 2015-04-25: Code rewritten in Z80.
\ 2015-05-02: Code moved to this file.
\ 2015-05-13: Faster and smaller code, copied from DZX-Forth
\ (http://programandala.net/en.program.dzx-forth.html).
\ -----------------------------------------------------------
CREATE -ROT ( x1 x2 x3 -- x3 x1 x2 )
\ ROT ROT
HEX
\ XXX OLD first version
\ D9 C, \ exx
\ C1 C, D1 C, E1 C, \ pop bc / pop de / pop hl
\ C5 C, E5 C, D5 C, \ push bc / push hl / push de
\ D9 C, \ exx
\ C3 C, NEXT , \ jp NEXT
\ Version copied from DZX-Forth.
E1 C, D1 C, \ pop hl / pop de
E3 C, \ ex (sp),hl
EB C, \ ex de,hl
C3 C, PUSHDE , \ jp PUSHDE
DECIMAL SMUDGE
\ vim: filetype=abersoftforthafera
.( CMOVE> MOVE )
\ move.fsb
\ `MOVE` and `CMOVE>` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1998 Phil Burk
\ 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-04-14: Code written as part of the strings module.
\
\ 2015-05-15: Code moved to an independent file.
\
\ 2015-10-26: Updated some comments.
\ -----------------------------------------------------------
-->
( CMOVE> )
HEX
CREATE CMOVE> ( ca1 ca2 u -- ) \ Forth-94
\ Note: Code adapted from Lennart Benschop's Spectrum
\ Forth-83.
\ exx / pop bc / pop de / pop hl
D9 C, C1 C, D1 C, E1 C,
\ ld a,c / or b / jr z,end
79 C, B0 C, 28 C, 8 C,
09 C, \ add hl,bc
2B C, \ dec hl
EB C, \ ex de,hl
09 C, \ add hl,bc
2B C, \ dec hl
EB C, \ ex de,hl
ED C, B8 C, \ lddr
\ end: / exx / jp NEXT
D9 C, C3 C, NEXT ,
SMUDGE DECIMAL -->
( MOVE )
: MOVE ( a1 a2 u -- ) \ Forth-94
\ Note: Code copied from Phil Burk's pForth (V19).
>R 2DUP - 0< IF R> CMOVE> ELSE R> CMOVE THEN ;
\ vim: filetype=abersoftforthafera
.( MS )
\ ms.fsb
\ `MS` 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-30: Code written in the main file of the library.
\
\ 2015-04-02: Code moved to a time extensions module.
\
\ 2015-07-16: Code moved to its own file. The temporary
\ version, that depends on the system frames counter and has
\ 20 ms precision, is substituted with code adapted from
\ DZX-Forth.
\
\ 2015-10-26: Improved some comments.
\ -----------------------------------------------------------
FORTH DEFINITIONS -->
( MS )
\ Note: Code adapted from DZX-Forth.
CREATE MS ( u -- ) HEX
\ Wait at least _u_ ms (milleseconds).
D1 C, \ pop de
HERE \ ms1:
78 03 + C, B0 02 + C,
\ ld a,e
\ or d
CA C, NEXT , \ jp z,next
21 C, 0004 , \ ld hl,4 ; MHz
29 C, 29 C, 29 C,
\ add hl,hl
\ add hl,hl
\ add hl,hl
HERE \ ms2:
E3 C, E3 C, E3 C, E3 C,
\ ex (sp),hl ; 19T
\ ex (sp),hl ; 19T
\ ex (sp),hl ; 19T
\ ex (sp),hl ; 19T
E5 C, E1 C, 2B C,
\ push hl ; 11T
\ pop hl ; 10T
\ dec hl ; 6T
3E C, 00 C, 78 05 + C, B0 04 + C,
\ ld a,0 ; 7T
\ ld a,l ; 4T
\ or h ; 4T
C2 C, , \ jp nz,ms2 ; 10T
1B C, \ dec de
C3 C, , \ jp ms1
SMUDGE DECIMAL
( MS ) \ XXX OLD -- first, temporary version
[DEFINED] SYS-FRAMES ?\ 23672 CONSTANT SYS-FRAMES
: MS ( u -- )
\ Wait at least _u_ ms (milliseconds), with 20 ms precision.
20 / SYS-FRAMES @ +
BEGIN DUP SYS-FRAMES @ U< UNTIL DROP ;
( MS ) \ XXX TODO -- alternative version
\ Note: Code from Matteo Vitturi's vForth, not adapted yet.
\ POP DE|
\ BEGIN,
\ LDI A'| 171 N,
\ BEGIN,
\ NOP
\ DEC A'|
\ -UNTIL,
\ DECX DE|
\ LD A'| D|
\ ORA E|
\ -UNTIL,
\ vim: filetype=abersoftforthafera
.( :NONAME )
\ noname.fsb
\ `:NONAME` 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: First draft.
\
\ 2015-05-04: First working version.
\
\ 2015-07-06: Bug found and fixed: the `SMUDGE` included to
\ compensate the `SMUDGE` done later by `;` made it
\ impossible to find the latest defined word during the
\ definition started by `:NONAME`. The solution is to patch
\ `;` and make `;` to unpatch itself every time. `;SMUDGE` is
\ written for that.
\ -----------------------------------------------------------
-->
( Patch ; )
: ;SMUDGE ( -- )
\ Called by `;` to do `SMUDGE`.
[ HERE ] \ Save the address of `SMUDGE`.
SMUDGE \ When patched by `:NONAME`, this is `NOOP`.
\ Unpatch a possible patch done by `:NONAME`,
\ using the saved address where `SMUDGE` was compiled:
[ ' SMUDGE CFA ] LITERAL LITERAL ! ;
\ Substitute the `SMUDGE` in `;` with `;SMUDGE`:
' ;SMUDGE CFA 25378 !
-->
( :NONAME )
: :NONAME ( -- cfa )
?EXEC CURRENT @ CONTEXT !
\ Deactivate the `SMUDGE` in `;SMUDGE`:
[ ' NOOP CFA ] LITERAL ' ;SMUDGE !
\ Create a code field of a colon definition:
HERE !CSP 25350 , \ 25350 = address of do_colon
] ;
\ vim: filetype=abersoftforthafera
\ notequals.fsb
\ `<>` 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-12: Extracted from the main file of the library and
\ rewritten in Z80.
\ -----------------------------------------------------------
-->
.( <> )
CREATE <> ( n1 n2 -- f )
\ = 0=
HEX
E1 C, \ pop hl
D1 C, \ pop de
A0 07 + C, \ and a ; reset cy flag
ED C, 52 C, \ sbc hl,de
78 04 + C, \ ld a,h
B0 05 + C, \ or l
CA C, PUSHHL , \ jp z,PUSHHL
21 C, 1 , \ ld hl,1
C3 C, PUSHHL , \ jp PUSHHL
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera