DISCiPLE Forth

Description of the page content

Addon for Abersoft Forth, to use the DISCiPLE disk interface.

Tags:

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
  ;

Downloads