Fuente de Afera (parte 5: nombres de módulo O-Z)
Descripción del contenido de la página
Sexta parte de las fuentes de la biblioteca Afera para Abersoft Forth.
Etiquetas:
Código fuente
.( PICK )
\ pick.fsb
\ `PICK` for ZX Spectrum Abersoft Forth
\ Copyright (C) 1987,2015 Marcos Cruz (programandala.net)
\ 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
\ 1987-01-09: First version.
\ 2015-03: Code included in the main file of the library.
\ 2015-04-16: Code rewritten in Z80.
\ 2015-05-02: Code moved to this file.
\ -----------------------------------------------------------
CREATE PICK ( u -- x )
\ 1+ 2 * SP@ + @
\ Adapted from the `PICK` written on 1985-05-07 by Edmund
\ Ramm for the Z80 fig-Forth implementation written by Dennis
\ L. Wilson (1980-09-07).
HEX
E1 C, 29 C, \ pop hl / add hl,hl
39 C, \ add hl,sp ; offset into stack
5E C, 23 C, 56 C, \ ld e,(hl) / inc hl / ld d,(hl)
EB C, C3 C, PUSHHL , \ ex de, hl / jp PUSHHL
SMUDGE
DECIMAL
\ vim: filetype=abersoftforthafera
\ plot.fsb
\ Faster `PLOT` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop.
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-05-01: Start.
\
\ 2015-05-04: Adapted from Lennart Benschop's Spectrum
\ Forth-83. Benchmark: it runs in 84% the time of the
\ original version. Change: Instead of creating a new word,
\ the cfa of the original word is patched with the address of
\ the new code.
\
\ 2015-05-06: New method: the original definition is
\ overwritten with the new code. No space used.
\ -----------------------------------------------------------
-->
.( Faster PLOT )
HEX HERE ' PLOT ( a pfa )
DUP , \ new code field, pointing to the current pfa
D9 C, \ exx
E1 C, \ pop hl
C1 C, \ pop bc
40 05 + C, \ ld b,l
DD C, E5 C, \ push ix
CD C, 22E5 , \ call 0x22E5 ; plot-sub
DD C, E1 C, \ pop ix
D9 C, \ exx
C3 C, NEXT , \ jp next
CFA OVER SWAP OVER HERE SWAP - CMOVE \ overwrite the word
( a ) DP ! \ restore the dictionary pointer
DECIMAL
\ vim: filetype=abersoftforthafera
.( Whole screen mode )
\ plusscreen.fsb
\ Whole screen mode for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Requirements
NEEDS AT@ at-fetch
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Code extracted from the main file of the
\ library.
\ 2015-04-19: The scroll control words are moved to
\ <scroll.fsb>.
\
\ 2015-05-02: No constant created for the system variable.
\
\ 2015-05-06: `AT` modified with `EXIT` instead of `ELSE`: 2
\ bytes saved, and faster.
\
\ 2015-05-19: Fix: Now `-SCREEN` changes the print position
\ if it at the lower part of the screen.
\ -----------------------------------------------------------
-->
( >CHAN )
CREATE >CHAN ( c -- )
\ Send the character with ASCII code c to the current channel.
\ This word is copied from `TOCH`, from Lennart Benschop's
\ Spectrum Forth-83. It is needed by the new version of `AT`,
\ because Abersoft Forth's `EMIT' changes the current
\ channel.
HEX
E1 C, \ pop hl
7D C, \ ld a,l
FD C, 36 C, 52 C, FF C, \ ld (iy+0x52),0xFF ; set SCR CT
D7 C, \ rst 0x10
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL
-->
( AT -- version 1 )
\ Finally, also `AT` must be patched. Its original
\ definition is the following (from Don Thomasson's book
\ "Advanced Spectrum Forth", page 127):
\ : AT ( line col -- )
\ ABS DUP 31 >
\ IF 2DROP
\ ELSE SWAP ABS DUP 21 >
\ IF 2DROP ELSE 22 EMIT EMIT EMIT THEN
\ THEN ;
\ The number 21 (0x15) must be changed to 23 (0x17):
\
\ HEX 17 7BFA ! DECIMAL
\
\ But it's not enough: line 23 needs special treatment. The
\ new version of `AT` is adapted from Lennart Benschop's
\ Spectrum Forth-83.
\ This version of `AT` is longer than the original one (62
\ bytes instead of 52). Otherwise it could be possible to
\ overwrite the original word.
: AT ( line col -- )
\ Adapted from Lennart Benschop's Spectrum Forth-83.
\ Warning: The system will crash if the coordinates are out
\ of screen. For the sake of speed, no check is done. A
\ wrapper secure word can be written if needed.
SWAP DUP 23 - \ not the last line?
IF 22 >CHAN >CHAN >CHAN EXIT THEN
\ Last line:
1- DUP >CHAN >CHAN 0 >CHAN CR
\ System variable:
\ address in display file of print position.
DUP 23684 +!
\ System variable:
\ 33 minus column number for print position.
33 SWAP - 23688 C! ;
-->
( AT -- version 2 ) --> \ XXX TODO
\ With a bit of factorization, the new word could fit the
\ original one.
\ 19 bytes:
: (AT) ( col line -- ) 22 >CHAN >CHAN >CHAN ;
\ 52 bytes: \ XXX TODO check
: NEW-AT ( line col -- )
\ Adapted from Lennart Benschop's Spectrum Forth-83.
\ Warning: The system will crash if the coordinates are
\ out of screen. For the sake of speed, no check is done.
\ A wrapper secure word can be written if needed.
SWAP DUP 23 - \ not the last line?
IF (AT) EXIT THEN
\ Last line:
1- DUP >CHAN >CHAN 0 >CHAN CR
\ System variable:
\ address in display file of print position.
DUP 23684 +!
\ System variable:
\ 33 minus column number for print position.
33 SWAP - 23688 C! ;
\ Overwrite the code of the original `AT` with the code
\ of `NEW-AT` and forget the word:
\ ' NEW-AT ' AT OVER HERE SWAP - CMOVE
\ FORGET NEW-AT
-->
( +SCREEN -SCREEN and patches )
\ 23659 is the address of the system variable DF SZ, that
\ holds the number of lines in the lower part of the screen
\ (2 by default):
: +SCREEN ( -- )
\ Turn whole screen mode on.
0 23659 C! ;
: -SCREEN ( -- )
\ Turn whole screen mode off.
\ Make sure the print position is above the lower part of the
\ screen. Otherwise the system will exit to BASIC with an
\ error "Out of screen", because of the way `EMIT` works.
AT@ SWAP 21 MIN SWAP AT
2 23659 C! ;
: SCREEN? ( -- f )
\ Is the whole screen mode on?
23659 C@ 0= ;
\ The DF SZ system variable must have its original value
\ restored before returning to BASIC, else the system will
\ crash.
: MON ( -- ) -SCREEN MON ;
\ The definition of `CLS` has to be patched: it calls the ROM
\ routine CLS (0x0D6B), but CL-ALL (0x0DAF) must be used
\ instead (otherwise the system will crash):
HEX 0DAF 75C0 ! DECIMAL
+SCREEN
\ vim: filetype=abersoftforthafera
.( Faster POINT )
\ point.fsb
\ Faster `POINT` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Description
\ The original code of `POINT` is slow: it makes sure the y
\ coordinate is less than 0xB0; then calls the ROM routine
\ POINT-SUB (0x22CE), that stores its result on the BASIC
\ calculator stack; then calls FIND-INT (0x1E94) to fetch the
\ result; finally, it doesn't jump directly to PUSHHL, but
\ first pushes HL and then jumps to NEXT...
\ This alternative is much faster because the y coordinate is
\ not forced (the program must do it, if needed); the
\ POINT-SUB ROM routine is replicated without using the BASIC
\ calculator stack at the end; and PUSHHL is used as Forth
\ re-entry point.
\ -----------------------------------------------------------
\ History
\
\ 2015-05-01: Start.
\
\ 2015-05-02: Tested.
\
\ 2015-05-04: Benchmark: it runs in 32% the time of the
\ original version. Change: Instead of creating a new word,
\ the cfa of the original word is patched with the address of
\ the new code.
\
\ 2015-05-06: Improved: There was no need to save the IX
\ register. The Y coordinate check is removed too. Finally,
\ the new code overwrites the original (formerly the code was
\ one byte bigger): no dictionary space is used. The
\ execution time is still almost the same, only one system
\ frame less.
\
\ 2015-07-05: Fix: the y coordinate was not converted at the
\ start.
\ -----------------------------------------------------------
-->
( Faster POINT -- part 1 )
HERE \ save the current dictionary pointer
\ POINT ( x y -- )
HEX
E1 C, \ pop hl ; l = y coordinate
D1 C, \ pop de ; e = x coordinate
C5 C, \ push bc ; save the Forth IP
40 05 + C, \ ld b,l ; b = y coordinate
48 03 + C, \ ld c,e ; c = x coordinate
\ ; C = x coordinate
\ ; B = y coordinate
3E C, AF C, \ ld a,175 ; max y coordinate
90 00 + C, \ sub b
CD C, 22AA 6 + , \ call PIXELADD ; +6 to skip BASIC error
\ ; HL = screen address
\ ; A = pixel position in HL
-->
( Faster POINT -- part 2 )
40 07 + C, \ ld b,a
04 C, \ inc b
7E C, \ ld a,(hl)
\ rotate:
07 C, \ rlca
10 C, FD C, \ djnz rotate
E6 C, 01 C, \ and 1
\ finish:
26 C, 00 C, \ ld h,0
68 07 + C, \ ld l,a
C1 C, \ pop bc
C3 C, PUSHHL , \ jp PUSHHL
DUP ' POINT OVER HERE SWAP - CMOVE \ move the code
DP ! DECIMAL \ restore the dictionary pointer
\ vim: filetype=abersoftforthafera
.( POSTPONE )
\ postpone.fsb
\ `POSTPONE` 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-07-14: Written.
\ -----------------------------------------------------------
: POSTPONE ( "name" -- )
-FIND 0= 0 ?ERROR ( pfa b ) \ error if not found
64 AND 0= \ non-immediate word?
IF COMPILE COMPILE THEN \ if so, compile `compile`
CFA , \ compile the cfa
; IMMEDIATE
\ vim: filetype=abersoftforthafera
\ prefixes.fsb
\ Number prefixes 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 provides some words to create number prefixes
\ for hex numbers, control charactes and ASCII characters.
\
\ Contrary to the other modules, the words are not compiled
\ when the module is loaded. The required code must be copied
\ and pasted into the user application.
\ -----------------------------------------------------------
\ History
\ 2015-05-01: Code taken from Albert van der Horst's lina
\ Forth.
\
\ 2015-05-07: New: Prefix "0x" for hex.
\
\ 2015-06-06: Improved: the current value of `WIDTH` is
\ preserved instead of using the default 0x1F.
\
\ 2015-10-26: Updated header and license info. Added `'.`,
\ reorganized the screens. Added description.
\
\ 2015-11-18: Updated header and license info. Added `NEEDS`.
\ -----------------------------------------------------------
( C>HEX )
\ Note: `C>HEX` is needed by `$..`, `$....`, `0x..` and
\ `0x....`.
HEX
: C>HEX ( c -- n )
\ Convert a character to its hexadecimal value.
30 - DUP 9 > IF 7 - THEN ;
DECIMAL
( $.. $.... )
NEEDS C>HEX prefixes
WIDTH @ 1 WIDTH !
: $..
\ Leave hex number; example: $0A leaves 0AH
HERE 2 + C@ C>HEX 10 * HERE 3 + C@ C>HEX + [COMPILE] LITERAL
; IMMEDIATE
: $....
\ Leave 16-bit hex number; example: $0AFF leaves 0AFFH
0 HERE 6 + HERE 2 + DO 10 * I C@ C>HEX + LOOP
[COMPILE] LITERAL
; IMMEDIATE
WIDTH ! DECIMAL
( 0x.. 0x.... )
NEEDS C>HEX prefixes
HEX WIDTH @ 2 WIDTH !
: 0x.. \ Leave hex number; example: 0x0A leaves 0AH
HERE 3 + C@ C>HEX 10 * HERE 4 + C@ C>HEX + [COMPILE] LITERAL
; IMMEDIATE
: 0x.... \ Leave hex number; example: 0x0AFF leaves 0AFFH
0 HERE 7 + HERE 3 + DO 10 * I C@ C>HEX + LOOP
[COMPILE] LITERAL
; IMMEDIATE
WIDTH ! DECIMAL
( ". )
HEX WIDTH @ 1 WIDTH !
: ".
\ Leave ASCII character; example: "A leaves 41H
HERE 2 + C@ [COMPILE] LITERAL ; IMMEDIATE
WIDTH ! DECIMAL
( '. )
HEX WIDTH @ 1 WIDTH !
: '.
\ Leave ASCII character; example: 'A leaves 41H
HERE 2 + C@ [COMPILE] LITERAL ; IMMEDIATE
WIDTH ! DECIMAL
( ^. )
HEX WIDTH @ 1 WIDTH !
: ^. \ Leave control character; example: ^A leaves 01H
HERE 2 + C@ 1F AND [COMPILE] LITERAL ; IMMEDIATE
WIDTH ! DECIMAL
\ vim: filetype=abersoftforthafera
.( ?EXIT )
\ qexit.fsb
\ `?EXIT` for ZX Spectrum's 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: Written, after Gforth.
\ 2015-05-11: Extracted from the main file of the library.
\ -----------------------------------------------------------
: ?EXIT ( f -- )
\ Exit the current word if the given flag is not zero.
[COMPILE] IF COMPILE EXIT [COMPILE] THEN ; IMMEDIATE
\ vim: filetype=abersoftforthafera
.( ?RSTACK )
\ qrstack.fsb
\ `?RSTACK` 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 of this code/file
\ 2015-03-31: Code written.
\ 2015-04-14: Code extracted from the main file of the library
\ to <rstack.fsb>.
\ 2015-05-03: Code moved to its own file <qrstack.fsb>.
\ -----------------------------------------------------------
: ?RSTACK ( -- )
\ Issue an error message
\ if the return stack is out of bounds.
\ Written after `?STACK`, as shown in Don Thomasson's book
\ "Spectrum Advanced Forth".
R0 @ RP@ U< 1 ?ERROR \ stack empty
RP@ @ S0 U< 7 ?ERROR ; \ stack full
\ vim: filetype=abersoftforthafera
.( Random number generator )
\ random.fsb
\ Random number generator for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015,2020 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-02: Start, with the code of `RND`, moved from the
\ main file of the library.
\
\ 2015-04-16: Reference of the Leo Brodie's implementation.
\
\ 2015-05-17: Reference of the Matteo Vitturi's
\ implementation.
\
\ 2015-07-04: The version based on Leo Brodie's code is the
\ default one.
\
\ 2015-10-26: Updated copyright notices and comments. Fixed
\ the default `RANDOM`.
\
\ 2020-02-16: Move the alternative implementations to
\ <random.vitturi.fsb> and <random.jones-steele.fsb>. Update
\ the source style.
\ -----------------------------------------------------------
\ Code adapted from Leo Brodie's "Starting Forth" (second
\ edition, 1987, chapter 10, page 235), and Gforth's
\ <random.fs>.
23670 CONSTANT SYS-SEED
: RND ( -- x ) SYS-SEED @ 31421 * 6927 + DUP SYS-SEED ! ;
: RANDOM ( n -- 0..n-1 ) RND U* NIP ;
: RANDOMIZE ( x -- ) SYS-SEED ! ;
\ vim: filetype=abersoftforthafera
.( Random number generator )
\ random.jones-steele.fsb
\ Random number generator for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015,2020 Marcos Cruz (programandala.net)
\ Copyright (C) 1983 John Jones-Steel
\ 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
\ 2020-02-16: Move from <random.fsb>. Add `RANDOMIZE`.
\ Update the source style.
\ -----------------------------------------------------------
\ Code from "Bertie", the demo program bundled with Abersoft
\ Forth (1983).
\ Copyright (C) 1983 John Jones-Steele
23670 CONSTANT SYS-SEED
: RND ( n1 -- n2 )
SYS-SEED @ 75 U* 75 0 D+
OVER OVER U< - - 1 - DUP SYS-SEED !
U* NIP ;
: RANDOMIZE ( x -- ) SYS-SEED ! ;
\ vim: filetype=abersoftforthafera
.( Random number generator )
\ random.vitturi.fsb
\ Random number generator for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015,2020 Marcos Cruz (programandala.net)
\ Copyright (C) 1990-2015 Matteo Vitturi
\ 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
\ 2020-02-16: Moved from <random.fsb>. Rename `SEED` to
\ `RANDOMIZE`. Update the source style.
\ -----------------------------------------------------------
\ Code from Matteo Vitturi's vForth 1.3 (1990-2015).
\ Copyright (C) 1990-2015 Matteo Vitturi
23670 CONSTANT SYS-SEED
: RND ( n1 -- n2 )
1+ 8195 23672 @ U* 1 0 D+
16383 U/ DROP DUP SYS-SEED !
SWAP MOD ;
: RANDOMIZE ( x -- ) SYS-SEED ! ;
\ vim: filetype=abersoftforthafera
.( RDEPTH )
\ rdepth.fsb
\ `RDEPTH` 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: Code 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 its own file.
\ -----------------------------------------------------------
: RDEPTH ( -- n )
RP@ R0 @ - -2 / ;
\ vim: filetype=abersoftforthafera
\ rdrop.fsb
\ `RDROP` 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: Code 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.
\ `EXIT` is patched to execute `RDROP`.
\
\ 2015-06-17: Fix: `EXIT` can not execute the code of
\ `RDROP`. `EXIT` is a colon definition, thus it removes its
\ own nesting; but `RDROP` is a primitive, thus it does not
\ adds a nesting level. The patch is removed.
\
\ 2015-07-12: Fix: `SMUDGE` was missing!
\ -----------------------------------------------------------
-->
.( RDROP )
CREATE RDROP ( -- ) ( R: x -- )
HEX
2A C, 5E68 , \ ld hl,(RP) ; return stack pointer
23 C, \ inc hl
23 C, \ inc hl
22 C, 5E68 , \ ld (RP),hl ; update the pointer
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera
.( RECURSE )
\ recurse.fsb
\ `RECURSE` for ZX Spectrum's 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: Written.
\ 2015-05-11: Extracted from the main file of the library.
: RECURSE ( -- )
\ Compile a call to the word being defined.
LATEST PFA CFA , ; IMMEDIATE
\ vim: filetype=abersoftforthafera
.( Renamings)
\ renamings.fsb
\ Renaming of some words 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 substitutes the names of three fig-Forth words
\ with their modern versions. No memory is used.
\ -----------------------------------------------------------
\ History
\ 2015-03: `BYE`.
\
\ 2015-03-29: Extracted from the main file of the library.
\ New: `WORDS`, `?DUP`.
\
\ 2015-06-13: Fix: the start bit was missing in the first
\ letter of the new names!
\ -----------------------------------------------------------
( MON>BYE )
: MON>BYE ( -- )
\ Rename `MON` to `BYE`:
[ -FIND MON ] 0= ?EXIT
' MON NFA 1+ [CHAR] B 128 + OVER C!
[CHAR] Y OVER 1+ C!
[CHAR] E 128 + SWAP 2+ C!
; MON>BYE FORGET MON>BYE
-->
( VLIST>WORDS )
: VLIST>WORDS ( -- )
\ Rename `VLIST` to `WORDS`:
[ -FIND MON ] 0= ?EXIT
[ -FIND VLIST ] 0= ?EXIT
' VLIST NFA 1+ [CHAR] W 128 + OVER C!
[CHAR] O OVER 1+ C!
[CHAR] R OVER 2+ C!
[CHAR] D OVER 3 + C!
[CHAR] S 128 + SWAP 4 + C!
; VLIST>WORDS FORGET VLIST>WORDS
-->
( -DUP>?DUP )
: -DUP>?DUP ( -- )
\ Rename `-DUP` to `?DUP`:
[ -FIND -DUP ] 0= ?EXIT
' -DUP NFA 1+ [CHAR] ? 128 + SWAP C!
; -DUP>?DUP FORGET -DUP>?DUP
\ vim: filetype=abersoftforthafera
.( ROLL )
\ roll.fsb
\ `ROLL` 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: Code written in the main file of the library,
\ using `RECURSE`, after the definition of `ROLL` in Gforth.
\ A faster version with `CMOVE` is unfinished.
\
\ 2015-05-02: Code moved to this file.
\
\ 2015-10-26: Reorganized the screens. Added `NEEDS`.
\ -----------------------------------------------------------
NEEDS RECURSE recurse
: ROLL ( xu xu-1 ... x0 u -- xu-1 ... x0 xu )
DUP 1 <
IF DROP
ELSE SWAP >R 1 - RECURSE R> SWAP
THEN ; ;S
\ XXX TODO -- In DZX-Forth
\ (http://programandala.net/en.program.dzx-forth.html)
\ there's a version written in Z80.
\ XXX OLD -- unfinished version
\ : ROLL ( xu xu-1 ... x0 u -- xu-1 ... x0 xu )
\ 2 * 4 + DUP SP@ + DUP @ ROT 1 - DUP 2 + ROT 2 -
\ CMOVE DROP ;
( Spectrum Forth-83 ROLL )
\ XXX TODO -- Compare with the version of DZX-Forth.
CODE ROLL ( u ---)
EXX \ Use shadow registers.
EXSP \ Operand now in HL
H INC
H ADDP \ Add 1 and multiply by 2.
H B LD
L C LD \ Byte count in BC = 2*(u+1)
SP ADDP \ Add to SP,
\ Address of cell to pick up and move to top.
M E LD
H INC
M D LD \ Read the cell that must be moved to top.
D PUSH \ Save it.
L E LD
( Spectrum Forth-83 ROLL )
H D LD
H DEC
H DEC \ Source address is destination address - 2.
B A LD
C OR
NZ IF \ Test for byte count zero is unnecessary
\ BC=2 even for 0 ROLL.
LDDR \ Move the remaining stack cells up.
THEN
H POP \ Get saved top.
B POP \ Remove junk cell.
EXSP \ Put top back.
EXX \ Back to normal registers
JPIX ;C
\ vim: filetype=abersoftforthafera
.( +SCROLL -SCROLL )
\ scroll.fsb
\ Scroll control 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-19: Code extracted from <plusscreen.fsb>.
\ 2015-05-04: The names are exchanged. More logical.
\ -----------------------------------------------------------
\ Two words to toggle the scroll prompt.
\ Note: 23692 is the system variable SCR CT.
: -SCROLL ( -- ) 0 23692 C! ;
: +SCROLL ( -- ) 255 23692 C! ;
\ vim: filetype=abersoftforthafera
.( S= )
\ s-equals.fsb
\ `S=` 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-07-16: Code moved from the <strings.fsb> module.
\ 2015-08-28: Typo.
\ -----------------------------------------------------------
\ Requirements
[DEFINED] LENGTHS ?-->
: LENGTHS ( ca1 len1 ca2 len2 -- ca1 len1 ca2 len2 len1 len2 )
2OVER NIP OVER ;
\ -----------------------------------------------------------
-->
( S= )
: S= ( ca1 len1 ca2 len2 -- f )
LENGTHS - \ different lengths?
IF 2DROP 2DROP FALSE EXIT
ELSE DROP [ CONTEXT @ EDITOR ] -TEXT [ CONTEXT ! ] 0= 0=
THEN ;
\ vim: filetype=abersoftforthafera
.( SGN )
\ sgn.fsb
\ `SGN` for ZX Spectrum's 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: Written.
\
\ 2015-05-11: Extracted from the main file of the library.
\ Modified to use `2*` if defined.
\
\ 2015-05-17: Updated: `2*` is part of the main file of the
\ library.
\ -----------------------------------------------------------
: SGN ( n1 -- -1|0|1 ) DUP IF 0< 2* 1+ THEN ;
\ vim: filetype=abersoftforthafera
( /LOADT )
\ slash-load-t.fsb
\ `/LOADT` tape extension for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-28: First working version, in the module
\ <tape.fsb>.
\
\ 2015-05-19: Moved to its own file.
\
\ 2015-10-26: Fixed comment. Renamed file.
\ -----------------------------------------------------------
NEEDS <TAPE tape
NEEDS S" strings
: /LOADT ( n -- )
\ Load the Forth RAM-disk from tape, at address of screen n.
\ Warning: the file will be loaded, no matter its length.
\ n = first screen
EMPTY-BUFFERS DISC-SCR 0 S" DISC" <TAPE ;
\ vim: filetype=abersoftforthafera
( /SAVET )
\ slash-save-t.fsb
\ `/SAVET` tape extension for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-28: First working version, in the module
\ <tape.fsb>.
\
\ 2015-05-19: Moved to its own file.
\
\ 2015-10-26: Fixed comment. File renamed.
\ -----------------------------------------------------------
NEEDS >TAPE tape
NEEDS S" strings
: /SAVET ( n1 n2 -- )
\ Save the Forth RAM-disk to tape,
\ from screen n1 to screen n2.
\ n1 = first screen
\ n2 = last screen
FLUSH 1+ DISC-SCR SWAP DISC-SCR
DUP ROT SWAP - S" DISC" >TAPE ;
\ vim: filetype=abersoftforthafera
.( S+ )
\ s-plus.fsb
\ String concatenation operator 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-18: Moved from the module <strings.fsb>.
\ -----------------------------------------------------------
\ Requirements
NEEDS MOVE move
NEEDS ALLOCATE-STRING csb
NEEDS PICK pick
[DEFINED] LENGTHS ?-->
: LENGTHS ( ca1 len1 ca2 len2 -- ca1 len1 ca2 len2 len1 len2 )
2OVER NIP OVER ;
\ -----------------------------------------------------------
-->
( SMOVE S+ )
: SMOVE ( ca1 len ca2 -- ) SWAP MOVE ;
: S+ ( ca1 len1 ca2 len2 -- ca3 len3 )
\ Append the string ca2 len2 to the end of string ca1 len1
\ returning the string ca3 len3.
LENGTHS + >R ( ca1 len2 ca2 len2 ) ( R: len3 )
R ALLOCATE-STRING >R ( R: len3 ca3 )
2 PICK R + ( ca1 len1 ca2 len2 len1+ca3 )
SMOVE ( ca1 len1 ) \ 2nd string to buffer
R SMOVE \ 1st string to buffer
R> R> ;
\ vim: filetype=abersoftforthafera
\ sqrt.fsb
\ 'SQRT` 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).
\ -----------------------------------------------------------
-->
.( SQRT )
: SQRT ( +n -- root rem )
\ 16-bit fast integer square root.
\ Return root and remainder, or 0 -1 if n is negative
\ From: Forth Dimensions 14/5
DUP 0<
IF DROP 0 -1 ELSE
0 SWAP 16384 ( 2^14 )
BEGIN
>R DUP 2 PICK - R - DUP 0<
IF DROP SWAP 2/
ELSE NIP SWAP 2/ R + THEN
SWAP R> 2/
2/ DUP 0=
UNTIL DROP
THEN ;
\ vim: filetype=abersoftforthafera
.( Strings )
\ strings.fsb
\ Strings for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ Requirements
NEEDS MOVE move
NEEDS FALSE flags
NEEDS 2>R 2r
NEEDS 2R> 2r
\ -----------------------------------------------------------
\ History
\ 2015-03: `CHAR`, `[CHAR]`, `PARSE-TEXT`, `PARSE-NAME`,
\ `SLIT`, `S,`, `SLITERAL`, `.(`, `(S)`, `S"`, `S'`.
\
\ 2015-03-28: File created with code extracted from the main
\ file of the library. New: `STR=`, after Gforth.
\
\ 2015-03-29: New: 'PLACE' and '+PLACE', after Gforth;
\ circular string buffer and related tools, adapted from csb8
\ (http://programandala.net/en.program.csb8.html).
\
\ 2015-03-30: `.(`is moved to the main extend module, in
\ order to use it at block headers.
\
\ 2015-03-31: New: `/STRING`.
\
\ 2015-04-03: Change: `CHAR` and `[CHAR]` are moved to the
\ main file of the library.
\
\ 2015-04-14: New: `CMOVE>`, `MOVE`.
\
\ 2015-05-15: `CMOVE>` and `MOVE` are moved to <move.fsb>.
\ `2>R` and `2>R` are already available and used.
\ Improvement: The circular string buffer is configurable; it
\ must be initialized.
\
\ 2015-05-17: `NEEDS` used.
\
\ 2015-05-18: The circular string buffer is moved to its own
\ file. This way, applications that just need transient
\ strings do not waste the dictionary space occupied by the
\ code of the buffer.
\
\ 2015-05-26: `STR=` is renamed as `S=`.
\
\ 2015-06-22: Fix: `S,` didn't compile the count byte.
\
\ 2015-07-16: `S=` is moved to its own file.
\
\ 2016-11-17: Fix `+PLACE`.
2 3 THRU
( PARSE-TEXT PARSE-NAME S, SLITERAL PLACE +PLACE /STRING )
: PARSE-TEXT ( c "ccc<c>" -- ca len ) TEXT PAD COUNT ;
: PARSE-NAME ( "name" -- ca len ) BL PARSE-TEXT ;
: SLIT ( -- ca len ) R COUNT DUP 1+ R> + >R ;
: S, ( ca len -- ) DUP C, SWAP HERE ROT DUP ALLOT CMOVE ;
: SLITERAL ( ca len -- ) COMPILE SLIT S, ; IMMEDIATE
: PLACE ( ca1 len1 ca2 ) 2DUP C! 1+ SWAP MOVE ;
: +PLACE ( ca1 len1 ca2 )
2DUP 2>R COUNT + SWAP MOVE 2R> DUP C@ ROT + SWAP C! ;
: /STRING ( ca1 len1 n -- ca2 len2 )
DUP >R - SWAP R> + SWAP ;
( S" S' )
\ XXX FIXME -- 2015-06-22: Empty strings' length is one,
\ because of `WORD`. A version that does not skips initial
\ delimiters is needed.
: (S) ( Compilation: c "ccc<c>" -- ) ( Run-time: -- ca len )
STATE @
IF COMPILE SLIT WORD HERE C@ 1+ ALLOT
ELSE PARSE-TEXT THEN ;
: S" ( Compilation: "ccc<">" -- ) ( Run-time: -- ca len )
[CHAR] " (S) ; IMMEDIATE
: S' ( Compilation: "ccc<'>" -- ) ( Run-time: -- ca len )
[CHAR] ' (S) ; IMMEDIATE
\ vim: filetype=abersoftforthafera
.( Tape extensions )
\ tape.fsb
\ Tape 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
\ Abersoft Forth only includes two tape words: `LOADT` and
\ `SAVET`, that load and save its 11-KiB RAM-disk with the
\ name "DISC". It includes no word to load or save any code
\ files, any name and size, what is especially useful in
\ order to include graphics or data during the compilation of
\ a Forth program.
\
\ This module defines `>TAPE` ("to tape") and `<TAPE` ("from
\ tape"). The approach used was to patch the tape load header
\ of Abersoft Forth, passed to the ROM routine, and restore
\ its default values after the operation.
\
\ Two more words, `/LOADT` and `/SAVET`, let improved
\ manipulation of the RAM-disk. As they are less needed, they
\ are defined in their own files, <slash-loadt.fsb> and
\ <slash-savet.fsb>.
\ -----------------------------------------------------------
\ Requirements
NEEDS S" strings
\ -----------------------------------------------------------
\ History
\ 2015-03-26: Start.
\
\ 2015-03-28: First working version.
\
\ 2015-04-23: Some comments are improved.
\
\ 2015-04-30: `'BLOCK` instead of `BLOCK>A`, after the change
\ in the main file of the library.
\
\ 2015-05-03: Simpler word names: no "MEM" affix.
\
\ 2015-05-08: Some words are renamed.
\
\ 2015-05-10: `INCLUDET` is removed; not useful with tapes.
\ `'SCR` instead of `'BLOCK`, after the change in the main
\ file of the library.
\
\ 2015-05-12: Change: `'SCR` renamed to `DISC-SCR`, after the
\ changes in the library.
\
\ 2015-05-17: `NEEDS` used. Some renamings, after the
\ changes in the library (common core words for some tape and
\ disk operations).
\
\ 2015-12-23: Fixed mistake in comment about the tape header.
\ -----------------------------------------------------------
\ Development documentation
\ Dictionary references from Don Thomasson's book
\ _Advanced Spectrum Forth_:
\
\ 340 (page 119): (TAPE)
\
\ pop hl
\ push bc
\ push ix
\ ld a,l ; 1=LOAD, 0=SAVE
\ ; this instruction is at 0x7618:
\ ld hl,D000 ; start address to save or load
\ ld ix,start-of-header-area
\ ; ld a,(5C72) ; XXX this is a mistake in the book
\ ; XXX fixed:
\ ld (5C74),A
\ call 075A
\ pop ix
\ pop bc
\ jp next1
\
\ 344 (page 120): LOADT
\
\ 1 (TAPE)
\ 345 (page 120): SAVET
\
\ 0 (TAPE)
\ The load header (pointed by IX before calling the ROM
\ routine) is at address 30182 (0x75E6). Its contents are:
\ +00 : 3 (identifier of code file type)
\ +01 : "DISC " = 10-char filename, padded with spaces
\ +11 : 11263 (0x2BFF) = length
\ +13 : 53248 (0xD0FF) = start address
\ +15 : " " (2 spaces) = not used for code files
\ The save header (pointed by the ROM routine, by adding 0x11
\ to IX) is right after the load header, at address 30199
\ (0x75F7).
\ -----------------------------------------------------------
2 4 THRU
( Headers )
30182 CONSTANT TAPE-LOAD-HEADER \ load header
17 CONSTANT /TAPE-HEADER \ header length
\ XXX OLD -- Save header, not needed.
\ TAPE-LOAD-HEADER /TAPE-HEADER + CONSTANT TAPE-SAVE-HEADER
10 CONSTANT /TAPE-FILENAME \ filename max length
: >TAPE-FILENAME ( a1 -- a2 ) 1+ ;
: >TAPE-LENGTH ( a1 -- a2 ) 11 + ;
: >TAPE-START ( a1 -- a2 ) 13 + ;
\ Keep a copy of both tape headers:
0 VARIABLE TAPE-HEADERS-BACKUP /TAPE-HEADER 2* 2- ALLOT
TAPE-LOAD-HEADER TAPE-HEADERS-BACKUP /TAPE-HEADER 2* CMOVE
( Tools )
\ Address of the file start address
\ in the code of the word `(TAPE)`:
30233 CONSTANT (TAPE)-START
: TAPE-RESTORE ( -- )
\ Restore the original contents of both tape headers:
TAPE-HEADERS-BACKUP TAPE-LOAD-HEADER /TAPE-HEADER 2* CMOVE
\ Unpatch `(TAPE)`
LO (TAPE)-START ! ;
: -TAPE-FILENAME ( -- )
\ Blank the filename of the load header.
TAPE-LOAD-HEADER >TAPE-FILENAME /TAPE-FILENAME BLANKS ;
\ XXX TODO use the file execution table
\ to share one word with the disk support?
: TAPE-FILENAME! ( ca len -- )
\ Store a filename into the load header.
-TAPE-FILENAME /TAPE-FILENAME MIN
TAPE-LOAD-HEADER >TAPE-FILENAME SWAP CMOVE ;
: ANY-TAPE-FILENAME ( -- )
\ Configure the load header to load any filename.
255 TAPE-LOAD-HEADER >TAPE-FILENAME C! ;
: TAPE-LENGTH! ( len -- )
\ Set the given code length for the next tape loading,
\ storing it into the load header.
TAPE-LOAD-HEADER >TAPE-LENGTH ! ;
: TAPE-START! ( a -- )
\ Set the given code start for the next tape loading,
\ storing it into the load header and patching
\ the code of the word `(TAPE)`.
DUP (TAPE)-START ! TAPE-LOAD-HEADER >TAPE-START ! ;
( <TAPE >TAPE )
: <TAPE ( a1 len1 ca2 len2 -- )
\ Load a file from tape.
\ a1 = destination
\ len1 = length (or zero if unspecified)
\ ca2 len2 = filename (len2 is zero if unspecified)
DUP IF TAPE-FILENAME! ELSE 2DROP ANY-TAPE-FILENAME THEN
TAPE-LENGTH! TAPE-START! 1 (TAPE) TAPE-RESTORE ;
: >TAPE ( a1 len1 ca2 len2 -- )
\ Save a memory region into a tape file.
\ a1 = start
\ len1 = length
\ ca2 len2 = filename
TAPE-FILENAME! TAPE-LENGTH! TAPE-START!
0 (TAPE) TAPE-RESTORE ;
\ vim: filetype=abersoftforthafera
\ time.fsb
\ Time 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.
\ -----------------------------------------------------------
\ History
\ 2015-07-02: Start, with the code of `MS`, moved from the
\ main file of the library.
\
\ 2015-04-03: New: `TIME@`, `TIME!` and `TIME0`.
\
\ 2015-07-16: Moved `MS` to its own file.
\ -----------------------------------------------------------
-->
.( Time extensions )
FORTH DEFINITIONS DECIMAL
[DEFINED] SYS-FRAMES ?\ 23672 CONSTANT SYS-FRAMES
: TIME@ ( -- d )
\ System frames counter (incremented every 20 ms).
SYS-FRAMES @ [ SYS-FRAMES 2+ ] LITERAL C@ ;
: TIME! ( d -- )
\ Set the system frames counter.
[ SYS-FRAMES 2+ ] LITERAL C! SYS-FRAMES ! ;
: TIME0 ( -- )
\ Reset the system frames counter.
0. TIME! ;
\ vim: filetype=abersoftforthafera
.( End transient code )
\ transient-end.fsb
\ Transient code tool for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-05-17: Start.
\ 2015-05-18: `NEEDS`.
\ -----------------------------------------------------------
NEEDS TRANSIENT[ transient
]TRANSIENT
\ vim: filetype=abersoftforthafera
.( TRANSIENT )
\ transient.fsb
\ Transient code for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1988 Lennart Benschop
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-15: Start. Code adapted from the <TASM> file of
\ Lennart Benschop's Spectrum Forth-83 (1988).
\
\ 2015-05-01: Rewritten. New approach to make it a generic
\ tool.
\
\ 2015-05-08: Improved to work also when the system has been
\ lowered below 0xC000 by the module <lowersys.fsb>.
\
\ 2015-05-09: The unlinking done by `-TRANSIENT` was fixed
\ and adapted to fig-Forth with the help of Lennart Benschop.
\ -----------------------------------------------------------
-->
( TRANSIENT -- variables )
0 VARIABLE OLD-DP
0 VARIABLE OLD-LATEST
0 VARIABLE OLD-VOC-LINK
-->
( TRANSIENT -- main )
: TRANSIENT[ ( u -- )
\ Start transient code, reserving u bytes for it (including
\ dictionary space and data stack).
\
\ This word must be used before compiling the transient code.
\ The compiled size of the transient code must be known in
\ advance, and sum say 128 bytes to it for the data stack.
\
\ Note: Adding data stack space to u is unnecessary when the
\ system has been lowered below 0xC000 by the <lowersys.fsb>
\ module.
HERE OLD-DP !
LATEST OLD-LATEST !
VOC-LINK @ OLD-VOC-LINK !
\ The free dictionary space top limit is `SP@` in the
\ standard memory map. But when the system has been lowered
\ by the module <lowersys.fsb>, it's `LO` instead (the start
\ of RAM-disk). And when the system uses 16-KiB RAM-disks,
\ the limit is the top of the memory. `FREE` is used to get
\ the current value, because the first word compiled in its
\ pfa returns the top address `SP@`, `LO` or `0`).
' FREE @ EXECUTE
SWAP - DP ! ;
: ]TRANSIENT ( -- )
\ End the transient code.
\
\ This word must be used after compiling the transient code.
OLD-DP @ DP ! ;
: -TRANSIENT ( -- )
\ Remove the transient code, unlinking the dictionary space
\ that was reserved for it.
\
\ This word must be used when the transient code is not going
\ to be used any more.
OLD-VOC-LINK @ VOC-LINK !
\ Store the nfa of the latest word created
\ before compiling the transient code,
\ into the lfa of the first word created
\ after the transient code was finished
\ by `]TRANSIENT`.
OLD-LATEST @ OLD-DP @ PFA LFA ! ;
\ vim: filetype=abersoftforthafera
.( Remove transient code )
\ transient-remove.fsb
\ Transient code tool for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-05-17: Start.
\ 2015-05-18: `NEEDS`.
\ -----------------------------------------------------------
NEEDS TRANSIENT[ transient
-TRANSIENT
\ vim: filetype=abersoftforthafera
.( 4096 bytes for transient code )
\ transient-start-4096.fsb
\ Transient code tool for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-05-17: Written.
\ 2015-05-18: `NEEDS`.
\ -----------------------------------------------------------
NEEDS TRANSIENT[ transient
4096 TRANSIENT[
\ vim: filetype=abersoftforthafera
\ traverse.fsb
\ Faster `TRAVERSE` 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 patches `TRAVERSE`, originally written in
\ Forth, with much faster Z80 code. But in practice, because
\ of the usage of this word, the speed gain is unimportant.
\ -----------------------------------------------------------
\ History
\ 2015-05-06: First version.
\
\ 2015-10-26: Added description.
\ -----------------------------------------------------------
-->
.( Faster TRAVERSE )
HERE ' TRAVERSE ( a pfa )
DUP , \ the new cfa points to the code at pfa
\ TRAVERSE ( a1 n -- a2 )
\ n = 1 | -1
HEX
D1 C, \ pop de
E1 C, \ pop hl
\ do:
19 C, \ add hl,de
CB C, 46 8 7 * + C, \ bit 7,(hl)
CA C, ' TRAVERSE 2+ , \ jp z,do
C3 C, PUSHHL , \ jp PUSHHL
CFA OVER SWAP OVER HERE SWAP - CMOVE \ overwrite the word
( a ) DP ! \ restore the dictionary pointer
\ vim: filetype=abersoftforthafera
.( UDG! )
\ udg-store.fsb
\ `UDG!` 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
\ `UDG!` defines UDG graphics with data in the usual order
\ (top row first). This makes same things easier. When binary
\ is used, the graphic can be shown in the source code.
\ -----------------------------------------------------------
\ History
\ 2015-03: Code written.
\
\ 2015-03-28: Code moved from the main file of the library
\ to <graphics.fsb>.
\
\ 2015-04-22: Code moved to its own file.
\
\ 2015-05-08: Description.
\ -----------------------------------------------------------
: UDG! ( b0..b7 c -- )
\ Store the given 8 bytes into the UDG char c.
\ b0 = first (top) scan
\ b7 = last (bottom) scan
\ c = 144..164
144 - 8 * UDG + 1 - DUP 8 + DO I C! -1 +LOOP ;
\ vim: filetype=abersoftforthafera
\ unloop.fsb
\ `UNLOOP` 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-21: First high level version written in the main
\ file of the library. 2015-04-21: First draft in Z80.
\
\ 2015-04-25: First working version in Z80.
\
\ 2015-05-03: Code moved to its own file.
\
\ 2015-05-10: Conditional compilation to reuse the code of
\ `2RDROP`, if present.
\ -----------------------------------------------------------
-->
.( UNLOOP )
CREATE UNLOOP ( R: x1 x2 -- )
\ Discard the loop control parameters for the current nesting
\ level. An `UNLOOP` is required for each nesting level
\ before the definition may be exited with `EXIT`.
\
\ In fig-Forth, the top of the return stack is the loop
\ index, and the value below it is the loop limit.
\
\ A high level version of `UNLOOP` would need to preserve the
\ return address of the word:
\
\ R> R> DROP R> DROP >R
\
\ But the low level version doesn't.
SMUDGE
[UNDEFINED] 2RDROP \ if 2RDROP is not defined,
\ then ignore this line, that reuses its code and exit:
?\ ' 2RDROP ' UNLOOP CFA ! ;S
\ 2RDROP 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
\ upperc.fsb
\ `UPPERC` 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.
\ -----------------------------------------------------------
-->
.( UPPERC )
HEX
CREATE UPPERC ( c -- c' )
\ Convert an ASCII character to uppercase.
E1 C, \ pop hl
78 05 + C, \ ld a,l
FE C, 61 C, \ cp 'a'
38 C, 06 C, \ jr c,end
FE C, 7B C, \ cp 'z'+1
30 C, 02 C, \ jr nc,end
E6 C, DF C, \ and %11011111 ; reset bit 5
\ end:
68 07 + C, \ ld l,a
C3 C, PUSHHL , \ jp PUSHHL
SMUDGE
DECIMAL
\ vim: filetype=abersoftforthafera
.( UPPERS )
\ uppers.fsb
\ `UPPERS` 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.
\
\ 2015-05-18: Added `NEEDS`.
\ -----------------------------------------------------------
\ Requirements
NEEDS UPPERC upperc
\ -----------------------------------------------------------
: UPPERS ( ca len -- )
\ Convert a string to uppercase.
\ XXX FIXME -- use `?DO` when available
BOUNDS DO I C@ UPPERC I C! LOOP ;
\ vim: filetype=abersoftforthafera
.( VALUE )
\ value.fsb
\ `VALUE` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Code extracted from the main file of the
\ library.
\
\ 2015-04-21: Fix: `[TO]` does not need to compile `LITERAL`,
\ because in fig-Forth `'` compiles its result.
\
\ 2015-04-30: Three alternative non-parsing versions.
\
\ 2015-07-07: Simplified: removed `[TO]` and `<TO>` from the
\ default parsing version. Updated and tested de version with
\ `DEFER`.
\
\ 2015-09-08: Fixed stack comments.
\
\ 2015-10-27: Updated license info.
\
\ 2015-10-28: Modified comment.
\
\ 2015-11-18: Updated header and license info.
\ -----------------------------------------------------------
2 LOAD
( VALUE with parsing and state-smart TO )
\ This implementation, with parsing and state-smart `TO`,
\ conforms to ANS Forth. ANS Forth explicitly requires that
\ `TO` must parse.
\ 45 bytes of dictionary space are used.
: VALUE ( n "name" -- ) CONSTANT ;
: TO ( Interpretation: n "name" -- )
( Compilation: "name" -- )
[COMPILE] ' STATE @ IF COMPILE ! ELSE ! THEN
; IMMEDIATE
( VALUE with non-parsing TO -- version with flag )
\ This non-parsing alternative implementation is taken from
\ Albert van der Horst's lina Forth.
\ 85 bytes of dictionary space are used.
0 VARIABLE TO-MESSAGE
: FROM ( -- ) 0 TO-MESSAGE ! ;
: TO ( -- ) 1 TO-MESSAGE ! ;
: VALUE ( n "name" -- )
<BUILDS , DOES> TO-MESSAGE @ IF ! ELSE @ THEN FROM ;
( VALUE with non-parsing TO -- version with EXECUTE )
\ This non-parsing alternative implementation is a modified
\ version of the lina implementation above.
\ 82 bytes of dictionary space are used.
0 VARIABLE (VALUE)
: FROM ( -- ) ' @ CFA (VALUE) ! ; FROM
: TO ( -- ) ' ! CFA (VALUE) ! ;
: VALUE ( n "name" -- )
<BUILDS , DOES> (VALUE) @ EXECUTE FROM ;
( VALUE with non-parsing TO -- version with DEFER )
\ This non-parsing alternative implementation is a modified
\ version of the lina implementation above.
\ 84 bytes of dictionary space are used.
DEFER (VALUE)
: FROM ( -- ) ' @ CFA ' (VALUE) DEFER! ; FROM
: TO ( -- ) ' ! CFA ' (VALUE) DEFER! ;
: VALUE ( n "name" -- )
<BUILDS , DOES> (VALUE) FROM ;
\ vim: filetype=abersoftforthafera