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