Fuente de Afera (parte 3: nombres de módulo D-G)
Descripción del contenido de la página
Cuarta parte de las fuentes de la biblioteca Afera para Abersoft Forth.
Etiquetas:
Código fuente
.( DECODE )
\ decode.fsb
\ `DECODE` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1984 EHR
\ Copyright (C) 1982 Robert Dudley Ackerman
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Adapted and deeply modified from:
\ Z80 CP/M fig-Forth 1.1g (adaptative version by EHR).
\ Original code by Robert Dudley Ackerman, published in
\ Forth Dimensions IV,#2 p28 (1982-07);
\ modified by Dennis L. Wilson.
\ 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 RECURSE recurse
\ -----------------------------------------------------------
\ History
\ 2015-04-17: Code copied and adapted from Z80 CP/M fig-Forth
\ 1.1g. It works fine.
\
\ 2015-05-03: Improvement: The current address is shown, in
\ hex. Clearer instructions.
\
\ 2015-05-04: No hex forced, the current base is used.
\
\ 2015-05-07:
\
\ The code that handles the special decoding cases and the
\ key selection have been rewritten with `CASE` structures,
\ easier to read, maintain and extend.
\
\ The check that prevented from decoding `ERROR` has been
\ removed.
\
\ Improvement: The destination address of branches is shown
\ after the relative value.
\
\ The main code has been divided in smaller pieces, easier to
\ understand and maintain.
\
\ 2015-05-13: Fix: the address shown at the left of the colon
\ was the last value of `DECODE-ADDRESS`. Now it's the nfa of
\ the definition. The check in `INDENT` is removed.
\
\ 2015-05-17: `NEEDS` used. Improved with run-time and
\ shorter instructions.
\ -----------------------------------------------------------
-->
( DECODE -- variables, indentation and pause control )
FORTH DEFINITIONS DECIMAL
0 VARIABLE DECODE-LEVEL \ depth of nesting
0 VARIABLE DECODE-ADDRESS \ in the word being decoded
: INDENT ( -- )
CR DECODE-ADDRESS @ U. DECODE-LEVEL @ 2 * SPACES ;
: INDENT+ ( -- ) 1 DECODE-LEVEL +! INDENT ;
-->
( DECODE -- Special cases )
: DECODE-COMPILE ( a1 -- a2 ) 2+ DUP @ 2+ NFA ID. ;
: DECODE-LITERAL ( a1 -- a2 ) 2+ DUP @ . ;
: DECODE-BRANCH ( a1 -- a2 )
DECODE-LITERAL ." \ to " DUP DUP @ + U. ;
: DECODE-DOT-QUOTE ( a1 -- a2 )
2+ DUP COUNT TYPE DUP C@ + 1 - ;
-->
( DECODE -- Special cases dispatcher )
: DECODE-SPECIAL-CASES ( a1 -- a1 | a2 )
DUP @ CASE
[ ' COMPILE CFA ] LITERAL OF DECODE-COMPILE ENDOF
[ ' LIT CFA ] LITERAL OF DECODE-LITERAL ENDOF
[ ' BRANCH CFA ] LITERAL OF DECODE-BRANCH ENDOF
[ ' 0BRANCH CFA ] LITERAL OF DECODE-BRANCH ENDOF
[ ' (LOOP) CFA ] LITERAL OF DECODE-BRANCH ENDOF
[ ' (+LOOP) CFA ] LITERAL OF DECODE-BRANCH ENDOF
[ ' (.") CFA ] LITERAL OF DECODE-DOT-QUOTE ENDOF
ENDCASE ;
-->
( DECODE -- checks of the main code )
: DECODE-END? ( cfa -- f )
\ Is the given cfa the end of a definition?
DUP ' ;S CFA = SWAP ' (;CODE) CFA = OR ;
: COLON-PFA? ( pfa -- f )
\ Is the given pfa a colon definition?
CFA @ ' : CFA @ = ;
-->
( DECODE -- main code )
: (DECODE) ( pfa --- )
\ Decode the definition at the given pfa.
DUP COLON-PFA? IF
DUP NFA DECODE-ADDRESS ! INDENT ." : " DUP NFA ID.
BEGIN ( pfa+n ) DUP DECODE-ADDRESS !
DUP @ DUP ( pfa+n cfa cfa ) DECODE-END? 0=
\ ( pfa+n cfa f )
WHILE \ high level & NOT end of colon definition
\ ( pfa+n cfa )
( pfa+n cfa ) 2+ ( pfa+n pfa' ) DUP INDENT+ NFA ID.
KEY CASE [CHAR] Q OF SP! QUIT ENDOF \ Q
BL OF DROP ENDOF \ Space
SWAP RECURSE \ Default
ENDCASE DECODE-SPECIAL-CASES
2+ -1 DECODE-LEVEL +!
REPEAT INDENT 2+ NFA ID. \ show the last word
ELSE ." Not a colon definition." THEN DROP ; -->
( DECODE -- interface )
: DECODE-USAGE ( -- )
\ <------------------------------>
CR ." Keys: Space=more, Q=quit, other=deeper." CR ;
: DECODE ( "name" -- )
DECODE-USAGE
-FIND IF DROP 0 DECODE-LEVEL ! (DECODE)
ELSE ." Not Found" THEN ;
\ vim: filetype=abersoftforthafera
.( DEFER )
\ defer.fsb
\ Deferred words for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-03-28: Start.
\
\ 2015-04-02: Fix.
\
\ 2015-07-04: Typo. Simpler `ACTION-OF`.
\
\ 2015-07-07: Revised, tested, fixed, simplified (removed
\ `[IS]` and `<IS>`), documented.
\
\ 2015-10-26: Improved and fixed some comments.
\
\ 2016-01-25: Layout.
\ -----------------------------------------------------------
-->
( Create and fetch deferred words )
: (DEFER) ( -- )
\ Default behaviour of an uninitialized deferred word:
\ "Definition not finished".
20 ERROR ;
: DEFER ( "name" -- )
\ Create a deferred word.
\ Note: using `:` and `;` is more compact and faster
\ than using `<BUILDS` and `DOES>` in this case.
[COMPILE] : COMPILE (DEFER) [COMPILE] ; ;
: DEFER@ ( pfa -- cfa )
\ pfa = parameter field address of a deferred word
\ cfa = code field address the deferred word
\ is set to execute
@ ;
: DEFERS ( "name" -- )
\ Compile the present contents of the deferred word "name"
\ into the current definition. I.e. this produces static
\ binding as if "name" was not deferred.
[COMPILE] ' DEFER@ , ; IMMEDIATE
: ACTION-OF ( Interpretation: "name" -- cfa )
( Compilation: "name" -- )
( Runtime: -- cfa )
\ "name" = name of a deferred word
\ cfa = code field address the deferred word
\ is set to execute
[COMPILE] ' STATE @ IF COMPILE DEFER@
ELSE DEFER@ THEN ; IMMEDIATE
-->
( Set deferred words -- version with CFA )
\ This version uses a cfa (code field address) to set the
\ deferred words. This version seems a better compromise than
\ the pfa version (see next screen), therefore it's loaded by
\ default.
\
\ Note: Since fig-Forth's `'` returns a pfa (parameter field
\ address) `CFA` must be used to convert it to the
\ correspondent cfa required by `IS` or `DEFER!`. `:NONAME`
\ returns a cfa (see the module <noname.fsb>), so it can be
\ used directly with `IS` and `DEFER!`.
\
\ Usage examples:
\ DEFER MYWORD
\
\ ' WHATEVER-0 CFA IS MYWORD
\ MYWORD \ execute WHATEVER-0
\
\ ' WHATEVER-1 CFA ' MYWORD DEFER!
\ MYWORD \ execute WHATEVER-1
\
\ :NONAME WHATEVER-2 ; IS MYWORD
\ MYWORD \ execute WHATEVER-2
\
\ :NONAME WHATEVER-3 ; ' MYWORD DEFER!
\ MYWORD \ execute WHATEVER-3
: DEFER! ( cfa pfa -- ) ! ;
: IS ( Interpretation: cfa "name" -- )
( Compilation: "name" -- )
[COMPILE] ' STATE @ IF COMPILE DEFER! ELSE DEFER! THEN
; IMMEDIATE
( Set deferred words -- version with PFA )
\ This version uses a pfa (parameter field address) to set
\ the deferred words.
\
\ Note: Since `:NONAME` is written after ANS Forth and so it
\ returns a cfa (see the module <noname.fsb>), `2+` must be
\ used to convert it to the pfa required by `IS`.
\
\ Usage examples:
\ DEFER MYWORD
\
\ ' WHATEVER-0 IS MYWORD
\ MYWORD \ execute WHATEVER-0
\
\ ' WHATEVER-1 ' MYWORD DEFER!
\ MYWORD \ execute WHATEVER-1
\
\ :NONAME WHATEVER-2 ; 2+ IS MYWORD
\ MYWORD \ execute WHATEVER-2
\
\ :NONAME WHATEVER-3 ; 2+ ' MYWORD DEFER!
\ MYWORD \ execute WHATEVER-3
: DEFER! ( pfa1 pfa2 -- ) SWAP CFA SWAP ! ;
: IS ( Interpretation: cfa "name" -- )
( Compilation: "name" -- )
[COMPILE] ' STATE @ IF COMPILE DEFER! ELSE DEFER! THEN
; IMMEDIATE
\ vim: filetype=abersoftforthafera
\ dminus.fsb
\ `D-` 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.
\ -----------------------------------------------------------
\ Description
\ In fig-Forth `DMINUS D+` can be used instead of `D-`,
\ but `D-` is faster.
\ -----------------------------------------------------------
\ History
\ 2015-04-18: Code adapted from Lennart Benschop's Spectrum
\ Forth-83.
\
\ 2015-06-06: New version compiled directly with opcodes,
\ without the assembler.
\
\ 2015-10-26: Fixed the layout.
\ -----------------------------------------------------------
-->
( D- ) \ version compiled with opcodes
CREATE D- ( d1 d2 -- d3 )
HEX D9 C, \ exx
C1 C, \ pop bc
D1 C, \ pop de
E1 C, \ pop hl
E3 C, \ ex (sp),hl
A0 07 + C, \ and a
ED C, 52 C, \ sbc hl,de
E3 C, \ ex (sp),hl
A0 07 + C, \ and a
ED C, 42 C, \ sbc hl,bc
E5 C, \ push hl
D9 C, \ exx
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL
( D- ) \ assembler version
NEEDS CODE assembler
CODE D- ( d1 d2 -- d3 )
EXX
BC POP
DE POP
HL POP
EXSP
DE SUBP
EXSP
BC SBCP
HL PUSH
EXX
NEXT JP
END-CODE
\ vim: filetype=abersoftforthafera
.( .RS )
\ dot-rs.fsb
\ `.RS` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ 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-15: Written after the code of `.S`.
[DEFINED] RDEPTH
?\ : RDEPTH ( -- u ) RP@ R0 @ - -2 / ;
: .RS ( -- )
RDEPTH 2- DUP
S->D <# [CHAR] > HOLD #S [CHAR] < HOLD #> TYPE SPACE
IF RP@ 2- R0 @ 2- DO I @ . -2 +LOOP THEN ;
\ vim: filetype=abersoftforthafera
.( .S )
\ dot-s.fsb
\ `.S` for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ Copyright (C) 1990-2013 Matteo Vitturi
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ 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: First version.
\ 2015-04-14: Second version, from Matteo Vitturi's vForth.
\ 2015-04-19: Combined version.
\ 2015-10-26: Updated header.
\ -----------------------------------------------------------
: .S ( -- )
DEPTH
DUP S->D <# [CHAR] > HOLD #S [CHAR] < HOLD #> TYPE SPACE
\ First version:
\ DEPTH -DUP IF 0 DO DEPTH I - 1 - PICK . LOOP THEN
\ Second version, from Matteo Vitturi's vForth:
\ SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP
\ Combined version:
IF SP@ 2- S0 @ 2- DO I @ . -2 +LOOP THEN
;
\ vim: filetype=abersoftforthafera
.( .VOCS )
\ dot-vocs.fsb
\ `.VOCS` for ZX Spectrum Abersoft Forth
\ Copyright (C) 1990-2013 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
\ 2015-04-17: Copied from Mateo Vitturi's v.Forth 1.3
\ (1990-2013).
\ -----------------------------------------------------------
: .VOCS ( -- )
CR ." Current " CURRENT @ 4 - NFA ID.
CR ." Context " CONTEXT @ 4 - NFA ID. ;
\ vim: filetype=abersoftforthafera
.( DUMP )
\ dump.fsb
\ `DUMP` 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 CSWAP cswap
\ -----------------------------------------------------------
\ History
\ 2015-03-26: Start. Copied from Lennart Benschop's Spectrum
\ Forth-83.
\
\ 2015-03-28: Simple version as a temporary alternative,
\ until `?DO` is defined.
\
\ 2015-04-17: The code from ZX Spectrum Forth-83 has been
\ adapted, with `IF ... DO` instead of `?DO`.
\
\ 2015-04-20: Fix in `H.`.
\
\ 2015-05-17: `NEEDS` used.
\ -----------------------------------------------------------
-->
( BS H. STYPE )
: BS ( -- ) 8 EMIT ;
: H. ( n -- )
\ Print n in hexadecimal with four digits.
BASE @ HEX SWAP S->D <# # # # # #> TYPE SPACE BASE ! ;
HEX
: STYPE ( ca len -- )
0 2DUP - IF
DO
DUP C@ 7F AND DUP BL < IF DROP [CHAR] . THEN EMIT 1+
LOOP
ELSE 2DROP THEN DROP ;
DECIMAL -->
( DUMP )
: DUMP ( a len -- )
7 + -8 AND 8 / 0
2DUP - IF
DO
CR DUP H.
8 0 DO
I OVER + @ CSWAP H.
2 +LOOP
DUP BS 8 STYPE
?TERMINAL IF LEAVE THEN
8 + LOOP
ELSE 2DROP THEN DROP ;
\ vim: filetype=abersoftforthafera
\ flags.fsb
\ Boolean flags for ZX Spectrum Abersoft Forth
\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\ This file is part of
\ Afera (Abersoft Forth Extensions, Resources and Addons)
\ http://programandala.net/en.program.afera.html
\ Copying and distribution of this file, with or without
\ modification, are permitted in any medium without royalty
\ provided the copyright notice and this notice are
\ preserved. This file is offered as-is, without any
\ warranty.
\ -----------------------------------------------------------
\ History
\ 2015-04-16: Extracted from the main file of the library.
\ `ON` and `OFF` are rewritten in Z80.
\
\ 2015-04-23: Faster and smaller version of `OFF`.
\ -----------------------------------------------------------
-->
.( FALSE TRUE )
0 CONSTANT FALSE
FALSE 0= CONSTANT TRUE
-->
.( ON OFF )
CREATE ON ( a -- ) HEX
\ TRUE SWAP !
E1 C, \ pop hl
36 C, 01 C, \ ld (hl),1 ; 10T
23 C, \ inc hl ; 06T
36 C, 00 C, \ ld (hl),0 ; 10T
C3 C, NEXT , \ jp NEXT
SMUDGE
CREATE OFF ( a -- )
\ FALSE SWAP !
E1 C, \ pop hl
A8 07 + C, \ xor a ; 04T
70 07 + C, \ ld (hl),a ; 07T
23 C, \ inc hl ; 06T
70 07 + C, \ ld (hl),a ; 07T
C3 C, NEXT , \ jp NEXT
SMUDGE DECIMAL
\ vim: filetype=abersoftforthafera
.( G+DOS -- part 1 )
\ gplusdos_1.fsb
\ G+DOS support for ZX Spectrum Abersoft Forth (part 1)
\ Copyright (C) 1988,1994,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 CODE assembler
\ -----------------------------------------------------------
\ History
\ 2015-03-13: Start, based on code already written in 1988
\ and 1994.
\
\ 2015-04-01: Checks.
\
\ 2015-04-02: First succesful compilation, after some fixes
\ in the assembler. Some words renamed. New: alternative
\ words that don't use `?ERROR` but return the error
\ parameters.
\
\ 2015-04-07: Renamed to <gdos.fsb> (formerly
\ <gplusdos.fsb>).
\
\ 2015-04-14: New: the list of hooks has been completed;
\ `GDOS?` and `G+DOS?+'.
\
\ 2015-04-16: Change: `GDOS?` and `G+DOS?+' are removed. It
\ doesn't worth the effort to make the code compatible with
\ both GDOS and G+DOS, because all low level operations
\ should be duplicated. Even the word `GDOS?` should use a
\ different port to page the interface out, DISCiPLE or +D,
\ depending on its own result! Only G+DOS will be supported.
\ File renamed to <g+dos_1.fsb>.
\
\ 2015-05-08: Renamed to <gplusdos_1.fsb>, because of an
\ issue with Makefile.
\
\ 2015-05-12: Improvement: `DEVICE` is not a variable to
\ update UFIA with anymore, but the address of the
\ correspondent byte in UFIA, faster and shorter.
\ -----------------------------------------------------------
FORTH DEFINITIONS DECIMAL
10 CONSTANT /FILENAME \ max filename length
1 VARIABLE DRIVE
\ G+DOS addresses (in it own paged memory).
HEX 3E01 CONSTANT UFIA1 DECIMAL
\ 3E1A CONSTANT UFIA2
2 6 THRU
( UFIA: User File Information Area)
24 CONSTANT /UFIA /UFIA BUFFER: UFIA UFIA /UFIA ERASE
\ Note: The original field names are used, except `DEVICE`,
\ whose original name is "LSTR1".
UFIA CONSTANT DSTR1 \ drive: 1 or 2
UFIA 1+ CONSTANT FSTR1 \ program number
UFIA 2+ CONSTANT SSTR1 \ stream number
UFIA 3 + CONSTANT DEVICE \ device: "D" or "d"
UFIA 4 + CONSTANT NSTR1 \ directory description
UFIA 5 + CONSTANT NSTR2 \ file name
UFIA 15 + CONSTANT HD00 \ file type
UFIA 16 + CONSTANT HD0B \ file length
UFIA 18 + CONSTANT HD0D \ file start address
\ XXX OLD -- not needed
\ UFIA 20 + CONSTANT HD0F \ BASIC length without variables
\ UFIA 22 + CONSTANT HD11 \ BASIC autorun line
CHAR d DEVICE C! \ "d" or "D"
2 SSTR1 C! \ stream 2
\ These variables hold a copy of the HD0B and HD0D UFIA
\ fields. They are used by `(<DISK)`.
0 VARIABLE FILE-LENGTH
0 VARIABLE FILE-ADDRESS
( File types, directory descriptions and hook codes)
\ XXX TODO Move all this constants to another file, as
\ reference. They ocuppy a lot and most of them are not
\ necessary.
\ File types
0 CONSTANT BASIC-FILETYPE 1 CONSTANT DATA-ARRAY-FILETYPE
2 CONSTANT STRING-ARRAY-FILETYPE 3 CONSTANT CODE-FILETYPE
\ Directory descriptions
01 CONSTANT BASIC-FILE 02 CONSTANT DATA-ARRAY
03 CONSTANT STRING-ARRAY 04 CONSTANT CODE-FILE
05 CONSTANT SNAPSHOT-48K 06 CONSTANT MICRODRIVE-FILE
07 CONSTANT SCREENS$-FILE 08 CONSTANT SPECIAL-FILE
09 CONSTANT SNAPSHOT-128K 10 CONSTANT OPENTYPE-FILE
11 CONSTANT EXECUTE-FILE HEX
\ Hook codes
33 CONSTANT HXFER 34 CONSTANT OFSM 35 CONSTANT HOFLE
36 CONSTANT SBYT 37 CONSTANT HSVBK 38 CONSTANT CFSM
39 CONSTANT PNTP 3A CONSTANT COPS 3B CONSTANT HGFLE
3C CONSTANT LBYT 3D CONSTANT HLDBK 3E CONSTANT WSAD
3F CONSTANT SAD 40 CONSTANT REST 41 CONSTANT HERAZ
42 CONSTANT COPS2 43 CONSTANT PCAT 44 CONSTANT HRSAD
45 CONSTANT HWSAD 46 CONSTANT OTFOC 47 CONSTANT PATCH DECIMAL
( Error checking)
\ G+DOS Error codes and messages.
\ Most of them are useless for this implementation.
\ 0x00 'Nonsense in G+DOS'
\ 0x01 'Nonsense in GNOS'
\ 0x02 'Statement END error'
\ 0x03 'BREAK requested'
\ 0x04 ',SECTOR error'
\ 0x05 'FORMAT data lost'
\ 0x06 'CHECK DISC in drive'
\ 0x07 'No "+ SYS " file'
\ 0x08 'Invalid FILE NAME'
\ 0x09 'Invalid STATION'
\ 0x0A 'Invalid DEVICE'
\ 0x0B 'VARIABLE not found'
\ 0x0C 'VERIFY failed'
\ 0x0D 'Wrong FILE type'
\ 0x0E 'MERGE error'
\ 0x0F 'CODE error'
\ 0x10 'PUPIL set'
\ 0x11 'Invalid CODE'
\ 0x12 'Reading a WRITE file'
\ 0x13 'Writing a READ file'
\ 0x14 'O.K. G+DOS'
\ 0x15 'Network OFF'
\ 0x16 'Wrong DRIVE'
\ 0x17 'Disc WRITE protected'
\ 0x18 'Not enough SPACE on disc'
\ 0x19 'Directory FULL'
\ 0x1A 'File NOT FOUND'
\ 0x1B 'END of file'
\ 0x1C 'File NAME used'
\ 0x1D 'NO G+DOS loaded'
\ 0x1E 'STREAM used'
\ 0x1F 'CHANNEL used'
: IOR>ERROR ( ior -- f n )
\ Convert a DOS ior to a Forth error number.
\ ior = the AF register returned by a DOS command:
\ bit 0 = set: error
\ bits 8-14 = error code
\ bit 15 = set: ZX Spectrum error; unset: DOS error
\ f = error?
\ n = error number:
\ n<0 = ZX Spectrum error number (negative)
\ n>99 = DOS error number (plus 100)
DUP 1 AND \ error?
SWAP 255 / \ error code
DUP 128 AND \ ZX Spectrum error?
IF MINUS ELSE 100 + THEN ;
: ?DOS-ERROR ( ior -- )
\ ior = the AF register returned by a DOS command:
\ bit 0 = set: error
\ bits 8-14 = error code
\ bit 15 = set: ZX Spectrum error; unset: DOS error
IOR>ERROR ?ERROR ;
( Drive)
\ XXX TODO -- Make this compatible with `DRIVE`, the variable
\ used by the tape and disk common words.
CODE DRIVE@ ( -- n )
\ Get the current drive (1 or 2).
BC PUSH IX PUSH \ save the Forth registers
PATCH HOOK
\ 3E01 LDA \ XXX OLD
3ACE LDA \ XXX NEW
\ XXX TODO check this method:
\ bit 0 of 3DD1
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
0 H LD# A L LD PUSHHL JP END-CODE
CODE DRIVE! ( n -- )
\ Set the current drive (1 or 2).
HL POP
BC PUSH IX PUSH \ save the Forth registers
\ XXX OLD
\ HL PUSH
\ PATCH HOOK HL POP L A LD 3E01 STA
\ E7 OUT \ page +D out
\ XXX NEW
L A LD 21 HOOK
IX POP BC POP \ restore the Forth registers
NEXT JP END-CODE
( UFIA manipulation)
: -FILENAME ( -- )
\ Blank the filename in UFIA.
NSTR2 /FILENAME BLANKS ;
: FILENAME! ( ca len -- )
\ Store a filename into UFIA.
\ ca len = filename
-FILENAME /FILENAME MIN NSTR2 SWAP CMOVE ;
: >UFIA ( a1 len1 ca2 len2 -- )
\ Set the UFIA.
\ a1 len1 = memory region
\ ca2 len2 = filename
3 HD00 C! 4 NSTR1 C! \ code filetype and dir description
FILENAME!
DUP HD0B ! FILE-LENGTH !
DUP HD0D ! FILE-ADDRESS !
DRIVE @ DSTR1 C! ;
: FILENAME>UFIA ( ca len -- )
0 0 2SWAP >UFIA ;
\ vim: filetype=abersoftforthafera
.( G+DOS -- part 2 )
\ gplusdos_2.fsb
\ G+DOS support for ZX Spectrum Abersoft Forth (part 2)
\ Copyright (C) 1988,1994,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 CODE assembler
\ -----------------------------------------------------------
\ Note
\ "DISC" in Forth words means the Forth RAM-disk, after the
\ name used by Abersoft Forth's documentation and vocabulary,
\ e.g. `INIT-DISC`.
\
\ "DISK" means always a G+DOS disk.
\
\ In the comments of this library, "disc" is not used, and
\ the Abersoft Forth RAM-disk is always called "RAM-disk".
\ -----------------------------------------------------------
\ Requirements
\ This module needs the circular string buffer, part of the
\ module <strings.fsb>. But `NEEDS` can not be used yet
\ because it must be defined later.
[UNDEFINED] SAVE-STRING 0 ?ERROR
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Extracted from <gdos_1.fsb>.
\
\ 2015-04-16: File renamed to <g+dos_2.fsb>.
\
\ 2015-04-30: New version of `RUND` and new word `/RUND`,
\ after the tape versions `RUNT` and `/RUNT`. `'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: Renamed to <gplusdos_2.fsb>, because of an
\ issue with Makefile. Some words are renamed.
\
\ 2015-05-10: `'BLOCK` changed to `'SCR`, after the changes
\ in the library.
\
\ 2015-05-12:
\
\ The "RAM-" prefix is removed from the RAM-disk words, after
\ the changes in the library. Minor fixes: `EMPTY-BUFFERS`
\ instead of `FLUSH`; parameter of `/RUND`.
\
\ Fix: `(<DISK)`. The problem was the specified parameters,
\ stored in UFIA, are always overwritten by the file header.
\ Now they are saved apart and a calculation is done to
\ decide which start address and file length must be used.
\
\ Change: `'SCR` renamed to `DISC-SCR`, after the changes in
\ the library.
\
\ 2015-05-17: New: `FILE?`. Some renamings, after the changes
\ in the library (common core words for some tape and disk
\ operations).
\
\ 2015-05-18: New: support for 16-KiB RAM-disks in memory
\ banks.
\
\ 2015-05-20: The `CAT` code, still under development, is
\ moved to its own file.
\
\ 2015-08-28: Typo.
\ -----------------------------------------------------------
2 10 THRU
( Save a file)
CODE (>FILE) ( -- ior )
\ Save a file to disk using the data hold in UFIA.
BC PUSH IX PUSH \ save the Forth registers
UFIA IX LDP#
HOFLE HOOK \ open the file and create its header
NC IF \ no error?
HD0D DE LDP \ start
HD0B BC LDP \ length
HSVBK HOOK \ save to file
NC IF \ no error?
CFSM HOOK \ close the file
THEN
THEN IX POP BC POP \ restore the Forth registers
AF PUSH \ ior
NEXT JP
END-CODE
( Load a file -- part 1 )
CODE (<FILE) ( -- ior )
\ Load a file from disk, using the data hold in UFIA, the
\ file header and the parameters specified by the high level
\ command.
BC PUSH IX PUSH \ save the Forth registers
UFIA IX LDP# HGFLE HOOK \ get the file
NC IF \ no error? -- load the file header:
\ Load the file header
HD00 DE LDP# 9 B LD# \ destination and count
BEGIN
LBYT HOOK \ load byte and store it in A
DE STAP DE INCP \ update destination and count
DSZ
( Load a file -- part 2 )
\ The start address and length specified
\ in the command are used by default instead
\ of those stored in the file header.
FILE-ADDRESS DE LDP
FILE-LENGTH BC LDP
BC TST \ is the length zero?
\ If so, use the length of the file header instead:
Z IF HD0B BC LDP THEN
\ Load the file data
HLDBK HOOK
THEN
IX POP BC POP \ restore the Forth registers
AF PUSH \ ior
NEXT JP
END-CODE
( Delete a file)
CODE (-FILE) ( -- ior )
\ Delete a disk file using the data hold in UFIA.
BC PUSH IX PUSH \ save the Forth registers
UFIA IX LDP#
HERAZ HOOK \ erase the file
IX POP BC POP \ restore the Forth registers
AF PUSH
NEXT JP
END-CODE
( Forth RAM-disk)
: DISC>UFIA ( ca len -- ) LO 0 2SWAP >UFIA ;
\ `DISC-FILENAME` keeps the address and length of the latest
\ RAM-disk loaded. It is updated by `LOADD?` and used by
\ `(NEEDS-DISK)` to implement nested requirements between
\ modules.
0. 2VARIABLE DISC-FILENAME
\ When the system has been lowered below 0xC000 by
\ <lowersys.fsb>, in order to use the memory banks, and the
\ 16-KiB RAM-disks have been installed by <16kramdisks.fsb>,
\ the G+DOS words that manage the Forth RAM-disk must include
\ the commands to switch the memory banks.
\
\ A flag is calculated to be used by `SAVED?` and `LOAD?`
\ during compilation. Every word needs to check the flag
\ twice. The flag can not be put on the stack and duplicated,
\ because it would be consumed during the compilation, what
\ would make `;` to stop with an error 20 (definition not
\ finished). The variable `X1`, only used by `DRAW`, is used
\ as a temporary storage.
HEX
R0 @ C000 U< \ Has the system been lowered below 0xC000
/DISC 4000 = AND \ and the 16-KiB RAM-disks installed?
0= X1 ! \ No? Save it into a temporary storage.
DECIMAL
\ XXX TODO -- Use a different address to store the flag. One
\ of the planned modules removes `DRAW` and its variables
\ from the dictionary and redefines it in Z80.
( Forth RAM-disk -- user interface)
\ DISC>UFIA ( ca len -- )
\
\ Init the User File Information Area to load or save the
\ Forth RAM-disk. Zero length is specified, what will make
\ `(<FILE)` to use the length of the file header.
\
\ ca1 len1 = filename
: SAVED? ( ca len -- f n )
\ Save the Forth RAM-disk to disk
\ (word named after Abersoft Forth's `SAVET`).
\ ca len = filename
\ f = error?
\ n = error
\ During compilation, as a temporary solution,
\ `X1` holds a flag: Use the original RAM-disk?
DISC>UFIA [ X1 @ ] ?\ DISC-BANK BANK
(>FILE) [ X1 @ ] ?\ 0 BANK
IOR>ERROR ;
\ SAVED ( ca len -- )
\
\ Save the Forth RAM-disk to disk
\ (word named after Abersoft Forth's `SAVET`).
\ ca len = filename
: SAVED ( ca len -- ) SAVED? ?ERROR ;
\ The latest filename used to load a RAM-disk is saved by
\ `LOADD?` (the lowest level word) into the circular string
\ buffer and its address and length are stored into a double
\ variable.
: LOADD? ( ca len -- f n )
\ Load a Forth RAM-disk from disk.
\ (word named after Abersoft Forth's `LOADT`).
\ ca len = filename
\ f = error?
\ n = error
\ During compilation, as a temporary solution,
\ `X1` holds a flag: Use the original RAM-disk?
SAVE-STRING 2DUP DISC-FILENAME 2!
DISC>UFIA [ X1 @ ] ?\ DISC-BANK BANK
(<FILE) [ X1 @ ] ?\ 0 BANK
IOR>ERROR ;
\ LOADD ( ca len -- )
\
\ Load a Forth RAM-disk from disk.
\ (word named after Abersoft Forth's `LOADT`).
\ ca len = filename
: LOADD ( ca len -- ) LOADD? ?ERROR ;
: /RUND ( ca len n -- )
\ Read a new RAM-disk from disk and load block 'n'.
\ ca len = filename
>R EMPTY-BUFFERS INIT-DISC LOADD R> LOAD ;
\ RUND ( ca len -- )
\
\ Read a new RAM-disk from disk and load its first block.
\ ca len = filename
: RUND ( ca len -- ) 1 /RUND ;
( User interface: ordinary files )
: <FILE? ( a1 len1 ca2 len2 -- f n )
\ Load a file from disk.
\ a1 len1 = memory region to load
\ ca2 len2 = filename
\ f = error?
\ n = error
>UFIA (<FILE) IOR>ERROR ;
: <FILE ( a1 len1 ca2 len2 -- )
\ Load a file from disk.
\ a1 len1 = memory region to load
\ ca2 len2 = filename
<FILE? ?ERROR ;
: >FILE? ( ca1 len1 ca2 len2 -- f n )
\ Save a file to disk.
\ a1 len1 = memory region to save
\ ca2 len2 = filename
\ f = error?
\ n = error
>UFIA (>FILE) IOR>ERROR ;
: >FILE ( ca1 len1 ca2 len2 -- )
\ Save a file to disk.
\ a1 len1 = memory region to save
\ ca2 len2 = filename
>FILE? ?ERROR ;
: -FILE? ( ca len -- f n )
\ Delete a disk file.
\ ca len = filename
\ f = error?
\ n = error
FILENAME>UFIA (-FILE) IOR>ERROR ;
: -FILE ( ca len -- )
\ Delete a disk file.
\ ca len = filename
-FILE? ?ERROR ;
( FILE? )
CODE (FILE?) ( -- f )
\ XXX FIXME this changes the current drive to 2! why?
BC PUSH IX PUSH \ save the Forth registers
PATCH HOOK
NSTR2 IX LDP# 1146 CALL
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
0 HL LDP# PUSHHL JPNZ
HL INCP PUSHHL JP
END-CODE
: FILE? ( ca len -- f ) FILENAME! (FILE?) ;
\ CODE DISK-CAPACITY ( -- n )
\ \ n = tracks (+128 if double sided)
\ \
\ \ XXX OLD -- not useful, it just reads the DOS variable at
\ \ 0x2001 or 0x2002, depending on the current drive.
\ PATCH HOOK
\ 0985 CALL
\ E7 OUT \ page +D out
\ 0 H LD# A L LD PUSHHL JP
\ END-CODE
( User interface: screens of the Forth RAM-disk )
: (/LOADD) ( n ca len -- a len1 ca2 len2 )
\ Prepare the parameters to load a RAM-disk from disk,
\ at address of screen n.
\ Warning: the file will be loaded, no matter its length.
\ n = first block (1..11)
ROT FLUSH DISC-SCR 0 2SWAP ;
: /LOADD ( n ca len -- )
\ Load a RAM-disk from disk, at address of screen n.
\ Warning: the file will be loaded, no matter its length.
\ n = first screen (1..11)
(/LOADD) <FILE ;
: /LOADD? ( n ca len -- error? error )
\ Load a RAM-disk from disk, at address of screen n.
\ Warning: the file will be loaded, no matter its length.
\ n = first screen (1..11)
(/LOADD) <FILE? ;
: (/SAVED) ( n1 n2 ca len -- ca len ca2 len2 )
\ Prepare the parameters to save a RAM-disk to disk,
\ from screen n1 to screen n2.
\ n1 = first screen (1..11)
\ n2 = last screen (1..11)
\ ca len = filename
\ ca2 len2 = memory zone
2SWAP 1+ DISC-SCR SWAP DISC-SCR DUP ROT SWAP - 2SWAP ;
: /SAVED ( n1 n2 ca len -- )
\ Save a RAM-disk to disk, from block n1 to block n2.
\ n1 = first block (1..11)
\ n2 = last block (1..11)
\ ca len = filename
(/SAVED) >FILE ;
: /SAVED? ( n1 n2 ca len -- error? error )
\ Save a RAM-disk to disk, from block n1 to block n2.
\ n1 = first block (1..11)
\ n2 = last block (1..11)
\ ca len = filename
(/SAVED) >FILE? ;
\ vim: filetype=abersoftforthafera
.( G+DOS -- part 3 )
\ gplusdos_3.fsb
\ G+DOS support for ZX Spectrum Abersoft Forth (part 3)
\ 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.
\ -----------------------------------------------------------
\ Note
\ "DISC" in Forth words means the Forth RAM-disk, after the
\ name used by Abersoft Forth's documentation and vocabulary,
\ e.g. `INIT-DISC`.
\
\ "DISK" means always a G+DOS disk.
\
\ In the comments of this library, "disc" is not used, and
\ the Abersoft Forth RAM-disk is always called "RAM-disk".
\ -----------------------------------------------------------
\ Requirements
\ `NEEDS` can not be used yet because it's defined in this
\ module...
[UNDEFINED] 2>R 0 ?ERROR
[UNDEFINED] 2R> 0 ?ERROR
\ -----------------------------------------------------------
\ History
\ 2015-05-17: Start.
\ 2015-05-18: Fix.
\ -----------------------------------------------------------
-->
( NEEDS-DISK )
\ XXX TODO
\ (NEEDS-DISK) ( f "filename" -- )
\
\ Disk version of `(NEEDS)`.
\
\ f = is there a word needed from the given filename?
\ XXX FIXME -- This can not work with several nesting levels.
\ The buffers must be emptied at the start and the current
\ block must be refreshed at the end. (new code required to
\ do it) .
\ XXX TODO -- Already solved? Try it.
: (NEEDS-DISK) ( f "filename" -- )
BL WORD IF
DISC-FILENAME 2@ 2>R OFFSET @ >R
HERE COUNT RUND
R> OFFSET ! 2R> EMPTY-BUFFERS LOADD
EMPTY-BUFFERS BLK @ BLOCK DROP
THEN ;
' (NEEDS-DISK) CFA ' ?NEEDS !
\ vim: filetype=abersoftforthafera
.( G+DOS -- CAT )
\ gplusdos_cat.fsb
\ G+DOS `CAT` 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 CODE assembler
\ -----------------------------------------------------------
\ Note
\ "DISC" in Forth words means the Forth RAM-disk, after the
\ name used by Abersoft Forth's documentation and vocabulary,
\ e.g. `INIT-DISC`.
\
\ "DISK" means always a G+DOS disk.
\
\ In the comments of this library, "disc" is not used, and
\ the Abersoft Forth RAM-disk is always called "RAM-disk".
\ -----------------------------------------------------------
\ History
\ 2015-05-20: Extracted from <gplusdos_2.fsb>. Finished.
\
\ 2015-08-27: Typo.
\ -----------------------------------------------------------
-->
( CAT ACAT )
CODE (CAT) ( n -- )
AF POP
BC PUSH IX PUSH \ save the Forth registers
AF PUSH PATCH HOOK
\ Copy Forth UFIA to G+DOS UFIA1.
UFIA HL LDP# UFIA1 DE LDP# /UFIA BC LDP# LDIR
HL POP L A LD \ CAT type: 2=compact;4=detailed
24B5 CALL \ CAT_RUN
168E CALL \ BORD_REST = restore the border
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
NEXT JP END-CODE
\ CAT ( ca len -- )
\
\ Show a disk catologue using the given wild-card filename.
\ See the +D manual for wild-card syntax.
\
\ The catalogue can be printed out on a printer by storing
\ the number 3 into SSTR1 (a field of UFIA that holds the
\ stream number to use) before doing `CAT`. The default value
\ is 2 (screen) and should be restored. Example:
\
\ 3 SSTR1 C! S" FORTH?.*" CAT 2 SSTR C!
: CAT ( ca len -- ) FILENAME>UFIA 4 (CAT) ;
\ ACAT ( ca len -- )
\
\ A variant of `CAT` that shows an abbreviated catalogue.
: ACAT ( ca len -- ) FILENAME>UFIA 2 (CAT) ;
DECIMAL
\ vim: filetype=abersoftforthafera
.( G+DOS support -- +D memory)
\ gplusdos_mem.fsb
\ G+DOS support for ZX Spectrum Abersoft Forth (+D memory)
\ Copyright (C) 1988,1994,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 words to use the memory of the +D
\ interface: ROM 0x0000..0x1FFFF; RAM 0x2000..0x3FFFF.
\ -----------------------------------------------------------
\ Requirements
NEEDS CODE assembler
\ -----------------------------------------------------------
\ History
\ 2015-05-19: Start.
\ -----------------------------------------------------------
2 5 THRU
( DOSC@ )
CODE DOSC@ ( a -- b )
\ Fetch the content of +D memory address.
HL POP
BC PUSH IX PUSH \ save the Forth registers
HL PUSH
PATCH HOOK
HL POP
(HL) A LD 0 H LD# A L LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
PUSHHL JP
END-CODE
( DOS@ )
CODE DOS@ ( a -- n )
\ Fetch the content of +D memory address.
HL POP
BC PUSH IX PUSH \ save the Forth registers
HL PUSH
PATCH HOOK
HL POP (HL) E LD HL INCP (HL) D LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
DE PUSH
NEXT JP
END-CODE
( DOSC! )
CODE DOSC! ( b a -- )
\ Store b into the +D memory address a.
HL POP DE POP
BC PUSH IX PUSH \ save the Forth registers
DE PUSH HL PUSH
PATCH HOOK
HL POP DE POP E (HL) LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
NEXT JP
END-CODE
( DOS! )
CODE DOS! ( n a -- )
\ Store n into the +D memory address a.
HL POP DE POP
BC PUSH IX PUSH \ save the Forth registers
DE PUSH HL PUSH
PATCH HOOK
HL POP DE POP E (HL) LD HL INCP D (HL) LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
NEXT JP
END-CODE
\ vim: filetype=abersoftforthafera
.( G+DOS support -- DOS variables)
\ gplusdos_vars.fsb
\ G+DOS support for ZX Spectrum Abersoft Forth (DOS vars)
\ Copyright (C) 1988,1994,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 words to manage the G+DOS system
\ variables.
\ -----------------------------------------------------------
\ Requirements
NEEDS CODE assembler
\ -----------------------------------------------------------
\ History
\ 2015-04-15: Start.
\
\ 2015-04-16: File renamed to <g+dos_vars.fsb>.
\
\ 2015-05-08: Renamed to <gplusdos_vars.fsb>, because of an
\ issue with Makefile.
\
\ 2015-05-17: `DOSC@` and `DOSC!`are finished.
\ -----------------------------------------------------------
\ Address of the G+DOS vars in its own memory.
8192 CONSTANT DOS-VARS
2 5 THRU
( DOSVARC@ )
CODE DOSVARC@ ( n -- b )
\ Fetch the content of G+DOS variable n.
HL POP
BC PUSH IX PUSH \ save the Forth registers
HL PUSH
PATCH HOOK
HL POP DOS-VARS DE LDP# DE ADDP
(HL) A LD 0 D LD# A E LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
DE PUSH
NEXT JP
END-CODE
( DOSVAR@ )
CODE DOSVAR@ ( n1 -- n2 )
\ Fetch the content of G+DOS variable n1.
HL POP
BC PUSH IX PUSH \ save the Forth registers
HL PUSH
PATCH HOOK
HL POP DOS-VARS DE LDP# DE ADDP
(HL) E LD HL INCP (HL) D LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
DE PUSH
NEXT JP
END-CODE
( DOSVARC! )
CODE DOSVARC! ( b n -- )
\ Store b into the G+DOS variable n.
HL POP DE POP
BC PUSH IX PUSH \ save the Forth registers
DE PUSH HL PUSH
PATCH HOOK
HL POP DOS-VARS DE LDP# DE ADDP DE POP
E (HL) LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
NEXT JP
END-CODE
( DOSVAR! )
CODE DOSVAR! ( n1 n2 -- )
\ Store n1 into the G+DOS variable n2.
HL POP DE POP
BC PUSH IX PUSH \ save the Forth registers
DE PUSH HL PUSH
PATCH HOOK
HL POP DOS-VARS DE LDP# DE ADDP DE POP
E (HL) LD HL INCP D (HL) LD
E7 OUT \ page +D out
IX POP BC POP \ restore the Forth registers
NEXT JP
END-CODE
\ vim: filetype=abersoftforthafera
\ graphics.fsb
\ Graphic extensions for ZX Spectrum Abersoft Forth
\ Copyright (C) 1985-1987,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: Code extracted from the main file of the
\ library.
\
\ 2015-04-22: `UDG!` is moved to its own file
\ <udg-store.fsb>.
\
\ 2015-10-26: Updated header.
\ -----------------------------------------------------------
-->
.( Graphic extensions )
FORTH DEFINITIONS DECIMAL
\ System variables and addresses
23677 CONSTANT SYS-COORDS \ ZX Spectrum system variable
SYS-COORDS CONSTANT X-COORD
SYS-COORDS 1+ CONSTANT Y-COORD
22528 CONSTANT ATTRIBUTES
: DRAWL ( x1 y1 x2 y2 -- )
\ Draw a line from x1 y1 to x2 y2
2SWAP PLOT DRAW ;
: RDRAW ( inc-x inc-y -- )
\ Draw a line from the current plot position
Y-COORD C@ + SWAP X-COORD C@ + SWAP DRAW ;
: RDRAWL ( x y inc-x inc-y -- )
\ Draw a line from x1 y1
2SWAP PLOT RDRAW ;
: XY>ATTRA ( x y -- a )
\ Convert a pixel coordinate to its attribute address.
\ XXX TODO Rewrite in Z80, using the ROM routine.
175 SWAP - 8 / 32 * SWAP 8 / + ATTRIBUTES + ;
\ vim: filetype=abersoftforthafera