DISCiPLE Forth
Description of the page content
Addon for Abersoft Forth, to use the DISCiPLE disk interface.
I wrote this Forth program to be able to use the ZX Spectrum's DISCiPLE disk interface with Abersoft Forth. I used technical information from the DISCiPLE's manual, and some tips from the Abersoft Forth's manual. The program includes some words to make it easier to write words in Z80 machine code.
The user interface words are LOADD and SAVED (to load and save the RAM disk using DISCiPLE'S disks; the original tape words are LOADT and SAVET) and SAVE-SYSTEM (to save the whole Forth system into a disk).
The source is provided in plain text format, so it can not be used directly in Forth Abersoft. The comments are in Spanish.
Source code
Version 1
\ DISCiPLE Forth (versión 1)
\ Extensiones para usar la interfaz de disco DISCiPLE
\ con Abersoft Forth, en una Sinclair ZX Spectrum
\ Copyright (C) 1988 Marcos Cruz (programandala.net)
\ Licencia/Permesilo/License:
\ http://programandala.net/licencia
FORTH DEFINITIONS
\ -----------------------------
\ Ensamblador de Z80
: CODE CREATE ;
HEX
: PUSH
DD C, E5 C, \ PUSH IX
C5 C, \ PUSH BC
;
: POP
C1 C, \ POP BC
DD C, E1 C, \ POP IX
;
: END-CODE
C3 C, NEXT , \ JP NEXT
SMUDGE \ hacer accesible la última palabra creada
;
\ -----------------------------
\ DISCiPLE
DECIMAL
1 VARIABLE DRIVE \ unidad de disco en curso
0 VARIABLE UFIA 22 ALLOT \ "User Information File Array" del Disciple
UFIA CONSTANT DSTR1 \ número de unidad de disco
UFIA 1+ CONSTANT FSTR1
UFIA 2+ CONSTANT SSTR1
UFIA 3 + CONSTANT LSTR1 \ dispositivo
UFIA 4 + CONSTANT NSTR1 \ descripción en el directorio
UFIA 5 + CONSTANT NSTR2 \ nombre del fichero
UFIA 15 + CONSTANT HD00 \ tipo de fichero
UFIA 16 + CONSTANT HD0B \ longitud
UFIA 18 + CONSTANT HD0D \ dirección
UFIA 20 + CONSTANT HD0F
UFIA 22 + CONSTANT HD11
: INIT_UFIA ( longitud, dirección, descripción --)
NSTR1 C! \ descripción del fichero en el directorio
HD0D ! \ dirección de comienzo
HD0B ! \ octetos de longitud
DRIVE @ DSTR1 C! \ inicializar el número de unidad
100 LSTR1 C! \ dispositivo: "d" (disco)
NSTR2 10 BLANKS \ limpiar el nombre del fichero
3 HD00 C! \ tipo de fichero: CODE
BL WORD HERE \ leer el nombre del fichero
COUNT \ convertirlo a cadena contada
10 MAX \ truncar su longitud si es preciso
NSTR2 SWAP CMOVE \ moverlo a su sitio en UFIA
;
: ?ERRORD
\ el DISCiPLE devuelve el flag CY (registro F) a 1 si ha habido error,
\ y el número de éste en el registro A
\ si el error es del Spectrum, el bit 7 de A está alzado
DUP \ AF AF --
1 AND \ AF ´error? --
SWAP \ ´error? AF --
255 / \ ´error? error --
DUP \ ´error? error error --
128 AND \ ´error? error ´del Spectrum? --
IF \ error del S.O. del Spectrum
-1 * \ distinguirlo de los errores del Forth
ELSE \ error del S.O. del DISCiPLE
100 + \ distinguirlo de los errores del Forth
ENDIF
?ERROR \ actuar si ha habido error
\ los errores del Spectrum conservan su código, pero negativo
\ los errores del DISCiPLE conservan el suyo, pero se les suma 100
;
HEX
CODE SAVED_CODE
PUSH \ salvar los registros
DD C, 21 C, UFIA , \ LD IX,UFIA
CF C, \ RST 8 ;llamar al DOS
35 C, \ DEFB #35 ;abrir el fichero
38 C, 0E C, \ JR C,FINAL ;salir si hubo error
ED C, 5B C, HD0D , \ LD DE,(HD0D)
ED C, 4B C, HD0B , \ LD BC,(HD0B)
CF C, \ RST 8 ;llamar al DOS
37 C, \ DEFB #37 ;salvar el fichero
38 C, 02 C, \ JR C,FINAL ;salir si hubo error
CF C, \ RST 8 ;llamar al DOS
38 C, \ DEFB #38 ;cerrar el fichero
/ FINAL
POP \ recuperar los registros
F5 C, \ PUSH AF ;devolver un posible error
END-CODE
CODE LOADD_CODE
PUSH \ salvar los registros
DD C, 21 C, UFIA , \ LD IX,UFIA
CF C, \ RST 8 ;llamar al DOS
3B C, \ DEFB #3b ;enganche HGFLE
38 C, 15 C, \ JR C,FINAL ;salir si hubo error
\ leer la cabecera del fichero:
11 C, HD00 , \ LD DE,HD00 ;inicio de la cabecera
06 C, 09 C, \ LD B,9 ;contador de octetos
\ BUCLE
CF C, \ RST 8 ;llamar al DOS
3C C, \ DEFB #3C ;enganche LBYT, cargar octeto
12 C, \ LD (DE),A ;guardar el octeto
13 C, \ INC DE ;siguiente posición
10 C, FA C, \ DJNZ BUCLE ;seguir hasta terminar B
\ cargar el fichero a la memoria:
ED C, 5B C, HD0D , \ LD DE,(HD0C)
ED C, 4B C, HD0B , \ LD BC,(HD0B)
CF C, \ RST 8 ;llamar al DOS
3D C, \ DEFB #3D ;enganche HLDBK, cargar
POP \ recuperar los registros
\ FINAL
F5 C, \ PUSH AF ;devolver un posible error
END-CODE
DECIMAL
: DISCIPLE ( bandera --)
FLUSH \ salvar los búferes modificados
11264 53248 8 INIT_UFIA \ inicializar los datos del fichero
CASE
0 OF LOADD_CODE ENDOF \ cargar el disco RAM del disco
1 OF SAVED_CODE ENDOF \ salvar el disco RAM al disco
ENDCASE
?ERRORD \ comprobar si ha habido errores
;
\ -----------------------------
\ Interfaz de usuario
: LOADD 0 DISCIPLE ; \ cargar
: SAVED 1 DISCIPLE ; \ salvar
: SAVE-SYSTEM ( <filename> --)
\ Escrita según la información de la página 12 del manual de Abersoft Forth.
SIZE 10 + \ longitud del sistema
[COMPILE] FORTH DEFINITIONS \ vocabulario inicial del sistema
DECIMAL \ base numérica inicial
LATEST 12 +ORIGIN ! \ inicializar...
HERE 28 +ORIGIN !
HERE 30 +ORIGIN ! \ ...direcciones del sistema
HERE FENCE ! \ proteger las últimas palabras contra FORGET
' FORTH 8 + 32 +ORIGIN !
24063 3 INIT_UFIA
;
Version 2
\ DISCiPLE Forth (versión 2)
\ Extensiones para usar la interfaz de disco DISCiPLE
\ con Abersoft Forth, en una Sinclair ZX Spectrum
\ Copyright (C) 1994 Marcos Cruz (programandala.net)
\ Licencia/Permesilo/License:
\ http://programandala.net/licencia
\ 1994-01
FORTH DEFINITIONS HEX
\ -----------------------------
\ Ensamblador de Z80
: CODE
CREATE
DD C, E5 C, ( PUSH IX)
C5 C, ( PUSH BC)
;
: END-CODE
C1 C, ( POP BC)
DD C, E1 C, ( POP IX)
C3 C, NEXT , ( JP NEXT)
SMUDGE
;
\ -----------------------------
\ DISCiPLE
VOCABULARY DISCIPLE
DISCIPLE DEFINITIONS DECIMAL
1 VARIABLE DRIVE ( número de unidad de disco)
0 VARIABLE UFIA 22 ALLOT ( "User File Information Area")
UFIA CONSTANT DSTR1 \ unidad de disco, 1 ó 2
UFIA 1+ CONSTANT FSTR1 \ número de programa
UFIA 2+ CONSTANT SSTR1 \ número de corriente
UFIA 3 + CONSTANT LSTR1 \ dispositivo, D o d
UFIA 4 + CONSTANT NSTR1 \ descripción del directorio
UFIA 5 + CONSTANT NSTR2 \ nombre del fichero
UFIA 15 + CONSTANT HD00 \ tipo de fichero
UFIA 16 + CONSTANT HD0B \ longitud del fichero
UFIA 18 + CONSTANT HD0D \ dirección inicial del fichero
UFIA 20 + CONSTANT HD0F \ longitud del fichero sin variables (BASIC)
UFIA 22 + CONSTANT HD11 \ línea de autoejecución del BASIC
: INIT_UFIA ( inicio long descrip_dir -- )
( Inicializar contenido de UFIA:)
NSTR1 C!
HD0B !
HD0D !
\ parámetros fijos
DRIVE @ DSTR1 C!
100 LSTR1 C!
NSTR2 10 BLANKS
3 HD00 C!
( Guardar nombre del fichero:)
BL WORD HERE COUNT 10 MAX
NSTR2 SWAP CMOVE
;
: ?ERROR_D ( AF --)
( el registro AF del Z80 contiene después de la ejecución de)
( un comando de enganche del GDOS lo siguiente:)
( bit CY, el bit 0 de F, alzado si se ha producido un error)
( bits 0-6 de A= código de error)
( bit 7 de A activo = el error se refiere al Spectrum y no al GDOS)
DUP
1 AND ( aislar el bit CY de F)
SWAP
255 / ( aislar el código de error en A)
DUP
128 AND
IF
-1 * ( error del Spectrum)
ELSE
100 + ( error del GDOS)
ENDIF
?ERROR
;
CODE (SAVE_D) ( -- ¿error?)
( Abrir fichero y crear cabecera:)
DD C, 21 C, DSTR1 , ( LD IX,DSTR1)
CF C, ( RST 8)
35 C, ( DEFB #35)
38 C, 0E C, ( JR C, final, si hubo error)
( Salvar el bloque de memoria al disco:)
ED C, 5B C, HD0D , ( LD DE,[HD0D])
ED C, 4B C, HD0B , ( LD BC,[HD0B])
CF C, ( RST 8)
37 C, ( DEFB #37)
38 C, 02 C, ( JR C, final, si hubo error)
( Cerrar el fichero:)
CF C, ( RST 8)
38 C, ( DEFB #38)
( final)
POP
F5 C, ( PUSH AF)
( bit 0 de F = ¿error?)
( bits 0-6 de A = código de error)
( si el bit 7 de A es 1, el código)
( de error se refiere)
( al Spectrum, no al DISCiPLE)
END-CODE
CODE (LOAD_D) ( -- error?)
( Abrir fichero y crear cabecera:)
DD C, 21 C, DSTR1 , ( LD IX,DSTR1)
CF C, ( RST 8)
3B C, ( DEFB #3B)
38 C, 15 C, ( JR C, final, si hubo error)
( Cargar la cabecera del fichero:)
11 C, HD00 , ( LD DE,HD00)
06 C, 09 C, ( LD B,9)
( bucle)
CF C, ( RST 8)
3C C, ( DEFB #3C)
12 C, ( LD [DE],A)
13 C, ( INC DE)
10 C, FA C, ( DJNZ bucle)
( Cargar el fichero del disco:)
ED C, 5B C, HD0D , ( LD DE,[HD0D])
ED C, 4B C, HD0B , ( LD BC,[HD0B])
CF C, ( RST 8)
3D C, ( DEFB #3D)
( final)
POP
F5 C, ( PUSH AF)
( bit 0 de F = ¿error?)
( bits 0-6 de A = código de error)
( si el bit 7 de A es 1, el código)
( de error se refiere)
( al Spectrum, no al DISCiPLE)
END-CODE
CODE (ERASE_D) ( -- error?)
( Borrar el fichero del disco:)
DD C, 21 C, UFIA , ( LD IX,UFIA)
CF C, ( RST 8)
41 C, ( DEFB #41)
POP
F5 C, ( PUSH AF)
( bit 0 de F = ¿error?)
( bits 0-6 de A = código de error)
( si el bit 7 de A es 1, el código)
( de error se refiere)
( al Spectrum, no al DISCiPLE)
END-CODE
: DISCIPLE ( n --)
FLUSH
53248 11264 8 INIT_UFIA
DUP 1 =
IF
DROP (SAVE_D)
ELSE
2 =
IF (ERASE_D) ELSE (LOAD_D) ENDIF
ENDIF
?ERROR_D
;
: SAVE_D
1 DISCIPLE
;
: LOAD_D
0 DISCIPLE
;
: ERASE_D
2 DISCIPLE
;
: SAVE-SYSTEM
LATEST 12 +ORIGIN !
HERE 28 +ORIGIN !
HERE 30 +ORIGIN !
HERE FENCE !
' FORTH 8 + 32 +ORIGIN !
ZXZX SIZE 4 INIT_UFIA \ ZXZX ? versión en pruebas
(SAVE_D) ?ERROR_D
;