Historia de DZX-Forth en 2015-01
Descripción del contenido de la página
Historia del desarrollo en 2015-01 de DZX-Forth, un Forth para ZX Spectrum +3e.
2015-01-06
Soporte en interpret para números binarios con prefijo «%». Nueva palabra binary.
Encontrado y solucionado el fallo en interpret, que provocaba error de palabra no reconocida tras la ejecución de la palabra reconocida.
state? es renombrada como compiling? y reescrita para que sea más rápida. Nueva palabra executing?, complementaria de compiling?.
La antigua palabra not es eliminada; era la versión de Forth-79 (equivalente a 0=), no la de Forth-83 (complemento a uno).
compile, es convertida en un alias de , (coma), pues las comprobaciones que hacía ya no son necesarias.
Corregido fallo en la comprobación de la pila de retorno en la nueva versión de ?stack.
Eliminada la palabra cls en favor de page.
2015-01-10
Corregida la incoherencia en los nombres de las etiquetas de exit y (exit).
Corregido un fallo en ?comp: había desaparecido la llamada a 0= y por ello hacía lo mismo que ?exec.
Nuevo: cursor (provisional); -cursor para borrarlo.
Sigue habiendo un problema al crear nuevas palabras, no importa con qué palabra. La máquina se reinicia en (exit), habiendo llegado desde interpret.
2015-01-11
Nuevo: etiqueta para ensamblado condicional con que ahorrar memoria a cambio de reducir la velocidad.
Cambio: la palabra wfind es renombrada como wordlist-find, y convertida en pública.
Cambio: w>name cambia a wordlist>name.
2015-01-12
Corregido un error en la definición de unused, que provocaba el cuelgue; esto afectaba a todas las palabras que usan allot.
Corregido un error en .s.
Corregido un error en ctoggle, que provocaba que quedara la máscara en la pila.
Cambio: @execute ha sido modificada para hacer una ejecución incondicional. Su antigua función la hace ahora la nueva palabra @?execute: ejecuta la dirección solo si no es cero. Esto es más coherente con y más flexible.
Todo parece funcionar bien. Inicio de la versión A-01.
Primeros cambios para implementar el manejo de discos con +3DOS.
2015-01-13
Primeras palabras que funcionan llamando a +3DOS: set-user, get-user y restore-user (las originales de DX-Forth tenían nombres más crípticos).
Nuevas palabras: tib, y #tib a pesar de estar obsoletas en Forth actual (se pueden omitir con una etiqueta de configuración); dos-version, reescrita para +3DOS y renombrada (dosver en DX-Forth); dzx-forth devuelve su versión en el mismo formato que dosver; dos-error llama a throw con el código de error a partir de 1000; unused-disk (nombre provisional), devuelve el espacio libre en una unidad de disco; set-drive y get-drive.
interpret reconoce caracteres, con el formato de Forth-2012 (entre comillas simples).
Primeras modificaciones para crear una tabla de traducción de teclado que permita traducir cualquier código.
2015-01-14
Tabla de traducción de teclado implementada. La nueva palabra decode hace la traducción, llamada por key, que ha sido factorizada en (key) para hacerla configurable por la aplicación, como se pretende con todas las palabras de entrada y salida. La traducción de teclado permite hacer cualquier cambio de un código por otro, sin limitación: todo el rango de 0x00 a 0xFF. Se provee una tabla de traducción que permite acceder con solo la tecla Symbol Shift a los ocho signos ASCII que en Sinclair BASIC necesitan el modo extendido.
Inicio de la versión A-02.
Nuevas palabras: defer! y defer@, de Forth-2012:
; DEFER! ( xt1 xt2 -- ) 2012
_header _public,'DEFER!'
defer_store_:
call do_colon
if defer_uses_body
dw to_body_
else ; XXX TODO -- not used yet
dw one_plus_
endif
dw store_
dw paren_exit_
; DEFER@ ( xt -- ) 2012
_header _public,'DEFER@'
defer_fetch_:
; XXX TODO faster with ix?
pop de ; xt
if defer_uses_body
inc de ; address after the 'call' opcode
inc de
inc de ; pfa
else ; XXX TODO -- not used yet
inc de ; address after the 'jp' opcode
endif
ld a,(de)
ld l,a
inc de
ld a,(de)
ld h,a
jp push_hl
Reescrita la palabra alias, de Gforth, para hacerla independiente de aka. aka es menos versátil porque espera los dos parámetros en el flujo de entrada. Esto mismo hace synonym en el estándar Forth-2012, pero en orden inverso más claro (primero el nombre nuevo y después el existente). aka será convertida más adelante en synonym.
; ALIAS ( xt "newname" -- ) Gforth
; Note: alias doesn't copy the precedence bit of the xt
_header _public,'ALIAS'
alias_:
call do_colon
dw header_
dw c_lit_
db alias_mask
dw xnfa ; set the alias mask of the header
dw paren_exit_
Revisadas las palabras de conversión entre minúsculas y mayúsculas. Había un fallo en una.
Restaurado el comportamiento estándar de . (punto), que DX-Forth modificó para imprimir el número sin signo cuando la base no fuera decimal.
Nueva palabra: hex., tomada de Gforth, salvo que no imprime el prefijo «$»:
; HEX. ( n -- ) Gforth
; Note: taken from Gforth, except "$" prefix.
_header _public,'HEX.'
hex_dot_:
call do_colon
dw base_,fetch_
dw swap_,hex_,u_dot_
dw base_,store_
dw paren_exit_
save es renombrada como save-system.
Creada la primera palabra de +3DOS para manejo de ficheros: file-position:
; FILE-POSITION ( fid -- ud ior )
_header _public,'FILE-POSITION'
file_position_:
pop hl
push bc
ld b,l
ld ix,dos_get_position
call dos
pop bc
jr nc,file_position_.error
; ehl = position
push hl
ld d,0
push de
xor a ; no error
jp push_a
file_position_.error
; a = error code
push hl ; fake value
push hl ; fake value
call convert_dos_error_code
jp push_hl ; error code
(emit) es modificada para poder ser llamada en alto o bajo nivel:
; (EMIT) ( c -- )
_header _public,'(EMIT)'
paren_emit_:
pop hl
paren_emit_.l:
ld a,l
paren_emit_.a:
call emit_a
jp pause_
emit_l:
ld a,l
emit_a:
rst 0x10
ld a,0xff
ld(sys_scr_ct),a ; no "scroll?" message
ret
; EMIT ( c -- )
_header _public,'EMIT'
emit_:
call fetch_execute_
dw paren_emit_
at-xt y home (esta creada hace poco) son por ello corregidas. De hecho no funcionaban bien debido a la versión anterior de (emit):
; AT-XY ( u1 u2 -- )
; position cursor at col u1, row u2
_header _public,'AT-XY'
at_xy_:
if fast_emit
ld a,at_char
call emit_a
pop hl
call emit_l
pop hl
call emit_l
jp next
else
call do_colon
at_xy_.0:
dw c_lit_
db at_char
dw emit_,emit_,emit_
dw paren_exit_
endif
; HOME ( -- ) comus
; position cursor at col 0, row 0
_header _public,'HOME'
home_:
if fast_emit
if size_optimization
ld hl,0
push hl
push hl
jr at_xy_
else
ld a,at_char
call emit_a
xor a
call emit_a
xor a
call emit_a
jp next
endif
else
call do_colon
dw zero_,dup_
dw branch_,at_xy_.0
endif
Palabras para los colores, el brillo y la intermitencia:
; COLOR ( +n c -- )
; Print control char c, char +n and update the permanent attributes.
; This word was inspired by the 'COLOR' defining word from Lennart
; Benchsop's Spectrum Forth-83 (1988).
; XXX TODO don't print the codes, just change the variables...
_header _public,'COLOR'
color_:
pop hl
color_.l:
call emit_l
pop hl
call emit_l
ld a,(sys_attr_t)
ld (sys_attr_p),a
jp next
; PAPER ( n -- )
_header _public,'PAPER'
paper_:
ld l,paper_char
_jump color_.l
; INK ( n -- )
_header _public,'INK'
ink_:
ld l,ink_char
_jump color_.l
; BRIGHT ( n -- )
_header _public,'BRIGHT'
bright_:
ld l,bright_char
_jump color_.l
; FLASH ( n -- )
_header _public,'FLASH'
flash_:
ld l,flash_char
_jump color_.l
Y una palabra para poner los colores predeterminados, quitar el brillo, la intermitencia y demás. Entre los posibles nombres, tanto de palabras que tiene DX-Forth para gestionar el vídeo en CP/M como de palabras propias de Sinclair BASIC o habituales en los Forth de ZX Spectrum, finalmente (o momentáneamente) se llama «normal»:
; NORMAL ( -- )
_header _public,'NORMAL'
normal_:
call do_colon
dw c_lit_
db 7
dw dup_,border_,paper_
dw zero_,ink_
dw zero_,flash_
dw zero_,inverse_
dw zero_,overprint_
dw paren_exit_
2015-01-15
Programación de la primera palabra de acceso a disco, create-file... El manejo de ficheros apenas está comentado en DX-Forth, lo que dificulta la tarea. Probablemente la mayor parte del código original sea prescindible, pues las rutinas de +3DOS se ocupan de casi todo lo necesario. De momento, create-file no funciona bien si el método de acceso es distintode r/w.
; (CREATE-FILE) ( ca fam fid -- fid ior )
_header _public,'(CREATE-FILE)'
paren_create_file_:
; XXX INFORMER
; call do_colon
; dw drop_,drop_
; dw paren_exit_
; XXX INFORMER
; jp next
pop de ; e=fid
pop hl
ld d,l ; fam
pop hl ; ca
; XXX INFORMER
; ld a,l
; ld (sys_seed),a
; ld a,h
; ld (sys_seed+1),a
push de ; save fid (actually, fid + 256*fam)
push bc ; save Forth IP
ld b,e ; fid
ld c,d ; fam
ld d,2 ; create action: new file without header
ld e,4 ; open action: erase and create
ld ix,dos_open
call dos
pop bc ; restore Forth IP
; (sp) = fid + 256*fam
_jump_nc paren_create_file_.error
; no error
; (sp) = fid + 256*fam
pop hl ; l = fid
ld h,0
push hl ; fid
jp false_ ; no error
paren_create_file_.error
; (sp) = fid + 256*fam
; a = error code
call convert_dos_error_code
; hl = error code
jp push_hl
; ; XXX TMP
; filename
; ds filename_size
; ; XXX TMP
; ; ( a u -- a2 )
; _header _public,'n>f'
; n_to_f_
; ; Put a 0xFF at the end of the filename
; ; XXX experimental
; call do_colon
; dw c_lit_
; db 15
; dw min_
; dw plus_
; dw c_lit_
; db 0xFF
; dw swap_,c_store_
; dw lit_,filename
; dw paren_exit_
; CREATE-FILE ( ca u fam -- fid ior )
_header _public,'CREATE-FILE'
create_file_:
call do_colon
dw to_r_,to_fname_,one_plus_,from_r_
; ( ca2 fam )
dw get_file_handle_,question_dup_
dw branch_if_zero_,create_file_.no_file_handle
; ( ca2 fam fid )
dw paren_create_file_
dw paren_exit_
create_file_.no_file_handle
; ( ca2 fam )
dw drop_ ; leave only ca2, as an undefined fid
dw c_lit_
db 4 ; XXX TODO -- adapt this error code
dw to_ior_
dw paren_exit_
Nueva palabra: close-file.
; CLOSE-FILE ( fid -- ior )
_header _public,'CLOSE-FILE'
close_file_:
pop hl
push bc ; save Forth IP
ld b,l ; fid
ld ix,dos_close
call dos
pop bc ; restore Forth IP
back_from_dos:
jp c,false_ ; no error
; a = error code
call convert_dos_error_code
; hl = error code
jp push_hl
2015-01-16
Nueva palabra: delete-file. La rutina DOS_DELETE de +3DOS no está documentada en el manual publicado en wos, pero su dirección y parámetros son fácilmente adivinables:
; (DELETE-FILE) ( ca -- ior )
; ca = address of filename, with a trailing 0xFF
_header _public,'(DELETE-FILE)'
paren_delete_file_:
pop hl
ld ix,dos_delete
call do_dos
jr back_from_dos
; DELETE-FILE ( ca u -- ior )
; ca u = filename
_header _public,'DELETE-FILE'
delete_file_:
call do_colon
dw to_fname_,one_plus_
dw paren_delete_file_
dw paren_exit_
Nuevas palabras: cell, 4 y float.
El soporte para ficheros de bloques se convierte en opcional, con compilación condicional. Desactivar esta funcionalidad ahorra 1743 octetos. (Hacer lo mismo con el soporte para punto flotante ahorra 2336 octetos).
La palabra write-file ya funciona. Aún falta un método para añadir la cabecera a un fichero, al abrirlo, por lo que de momento los ficheros creados desde Forth no pueden ser cargados en memoria por Sinclair BASIC.
; (WRITE-FILE) ( ca len fid +n -- ior )
;
; +n = RAM bank paged at 0xC000..0xFFFF
_header _public,'(WRITE-FILE)'
parent_write_file_:
pop hl ; l = bank
ld a,l
paren_write_file_.bank_a:
call save_ip
ld c,a
pop hl
ld b,l ; fid
pop de ; len
pop hl ; ca
ld ix,dos_write
call dos
call restore_ip
_jump back_from_dos
; WRITE-FILE ( a u fid -- ior )
_header _public,'WRITE-FILE'
write_file_:
ld a,(sys_bankm)
and %111 ; current page for 0xC000..0xFFFF
_jump paren_write_file_.bank_a
La palabra UNNEST ha sido renombrada como RDROP, que el el nombre genérico y común de la operación. Sin embargo UNNEST ha sido recreada después como un alias, pues conviene que sus entradas en el glosario sean diferentes.
2015-01-17
Ya funciona WRITE-LINE también. Esta ha sido muy fácil, porque solo llama dos veces a WRITE-FILE. He añadido la posibilidad de configurar la cadena que se usa como final de línea. Esto permite crear ficheros de texto para otros sistemas operativos.
; NEW-LINE ( -- ca len ) ; XXX NEW
; After Gforth's 'newline', but configurable
; String used by 'WRITE-LINE' as end of line
_header _public,'NEW-LINE'
new_line_:
call do_two_constant
dw new_line_.string,1 ; address and length
new_line_.string:
db cr_char ; default
; WRITE-LINE ( ca u fileid -- ior )
; dup >r write-file ?dup if r> rdrop exit then
; new-line r> write-file
_header _public,'WRITE-LINE'
write_line_:
call do_colon
dw dup_,to_r_
dw write_file_
dw question_dup_
dw branch_if_0_,write_line_.end_of_line
dw r_drop_
dw paren_exit_
write_line_.end_of_line:
dw new_line_
dw from_r_
dw write_file_
dw paren_exit_
Y read-file:
; (READ-FILE) ( ca len fid +n -- ior )
;
; +n = RAM bank paged at 0xC000..0xFFFF
_header _public,'(READ-FILE)'
parent_read_file_:
pop hl ; l = bank
ld a,l
paren_read_file_.bank_a:
call save_ip
ld c,a
pop hl
ld b,l ; fid
pop de ; len
pop hl ; ca
push de ; len
ld ix,dos_read
call dos
pop hl ; len
call restore_ip
jr c,paren_read_file_.no_error
; error
; hl = len
; a = error code
; de = number of bytes remaining unread
push af
call hl_minus_de_to_hl
; hl = bytes actually read
pop af
cp 21 ; is it "bad parameter"? XXX TODO label
jr z, paren_read_file_.no_error
push hl
call convert_dos_error_code
jp push_a
paren_read_file_.no_error:
; no error
; hl = len
push hl
jp false_
; READ-FILE ( a u1 fid -- u2 ior )
_header _public,'READ-FILE'
read_file_:
ld a,(sys_bankm) ; XXX TODO factor out if size_optimization
and %111 ; current page for 0xC000..0xFFFF
_jump paren_read_file_.bank_a
Y open-file, que de momento creo con una copia del código de create-file, pues basta con cambiar los parámetros de llamada a +3DOS. El siguiente paso será extraer el código común y crear con él una palabra.
; (OPEN-FILE) ( ca fam fid -- fid ior )
_header _public,'(OPEN-FILE)'
paren_open_file_:
pop de ; e=fid
pop hl
ld d,l ; fam
pop hl ; ca
push de ; save fid (actually, fid + 256*fam)
push bc ; save Forth IP
ld b,e ; fid
ld c,d ; fam
ld d,0 ; create action: error, file does not exist
ld e,1 ; open action: position after the header ; XXX TODO configurable
ld ix,dos_open
call dos
pop bc ; restore Forth IP
; (sp) = fid + 256*fam
_jump_nc paren_open_file_.error
; no error
; (sp) = fid + 256*fam
pop hl ; l = fid
ld h,0
push hl ; fid
jp false_ ; no error
paren_open_file_.error
; (sp) = fid + 256*fam
; a = error code
call convert_dos_error_code
; hl = error code
jp push_hl
; OPEN-FILE ( ca len fam -- fid ior )
_header _public,'OPEN-FILE'
open_file_:
call do_colon
dw to_r_,to_fname_,one_plus_,from_r_
; ( ca2 fam )
;dw get_file_handle_
dw two_ ; XXX TMP
dw question_dup_
dw branch_if_zero_,open_file_.no_file_handle
; ( ca2 fam fid )
dw paren_open_file_
dw paren_exit_
open_file_.no_file_handle
; ( ca2 fam )
dw drop_ ; leave only ca2, as an undefined fid
dw c_lit_
db 4 ; XXX TODO -- adapt this error code
dw to_ior_
if debug?
dw paren_dot_quote_
dcs 'open_file error'
endif
dw paren_exit_
Todo funciona pero, aparte de las muchas palabras aún pendientes relacionadas con ficheros, hay dos cuestiones importantes por resolver:
- La asignación de identificadores de fichero, hecha por
get-file-handle, necesita una revisión y por ello aún no se usa, sino que se usa un valor constante. - Hace falta distinguir la creación y apertura de ficheros con y sin cabecera, quizá utilizando la palabra estándar
bin, u otra nueva, para modificar el modo de acceso.
Hago una limpieza de todo el código antiguo relacionado con manejo de ficheros. Esto ahorra alrededor de un kibiocteto.
Renombro token como parse-name, que es el que usan Gforth y el estándar Forth 2012 para esa función.
2015-01-21
La palabra de DX-Forthgetfh podría reescribirse de forma más sencilla, pues +3DOS hace innecesario mantener bloques de información sobre los ficheros abiertos. Como siempre en estos casos, le doy un nuevo nombre menos críptico y más homogéneo con el resto: file-id. Hice primero varios prototipos en Gforth:
#! /usr/bin/env gforth
\ 2015-01-21: Prototypes for DZX-Forth's file-ids.
15 constant max-file-id
max-file-id 1+ constant max-file-ids
create file-id-table max-file-ids allot
file-id-table max-file-ids erase
\ First version
: file-id ( -- fid true | false )
file-id-table max-file-ids 0
do
dup i + dup c@ 0=
if 0xFF swap c! drop i true unloop exit
then drop
loop drop false
;
\ Second version
: file-id ( -- fid true | false )
file-id-table max-file-ids bounds
do
i c@ 0=
if 0xFF i c! i file-id-table - true unloop exit then
loop false
;
\ Third version
: file-id ( -- fid true | false )
max-file-id
begin
dup file-id-table + dup ( fid a a )
c@
if drop 1- dup 0<
else 0xFF swap c! true exit then
until drop false
;
; FILE-ID ( -- fid true | false )
_header _public,'FILE-ID'
file_id_:
call do_colon
dw max_fcb_
file_id_.begin:
dw dup_
dw file_id_table_,plus_,dup_,c_fetch_
dw branch_if_0_,file_id_.found
dw drop_,one_minus_,dup_,zero_less_
; XXX TODO use '0>=' when available, and save one branch
dw branch_if_0_,file_id_.begin
dw branch_,file_id_.begin
file_id_.found:
dw c_lit_
db 0xFF
dw swap_,c_store_
dw true_
file_id_.end:
dw paren_exit_
2015-01-23
Nueva palabra s/r, para representar el método de acceso de ficheros con lectura compartida, propio de +3DOS.
; S/R ( -- fam )
;
; shared-read file access method
_header _public,'S/R'
shared_read_:
call do_byte_constant
db 5
Había un problema con create-file. Hago cada prueba siguiente tras un reinicio de la máquina, para estar seguro de que no hay números de fichero en uso u otras condiciones:
s" zx1" r/o create-file . . 1030 270 ( 30=access denied, file in use)
s" zx2" w/o create-file . . 0 15 ( 0=no error)
s" zx3" r/w create-file . . 0 15 ( 0=no error)
s" zx4" s/r create-file . . 1030 1295 ( 30=access denied, file in use)
El resultado prueba que +3DOS no puede crear ficheros nuevos como de solo lectura, de lectura compartida. Esto habrá que solucionarlo cambiando el modo de acceso y restableciéndolo tras la creación del fichero...
Implementada la palabra reposition-file:
; REPOSITION-FILE ( ud fid -- ior )
;
; ud = file pointer
;
; Note: the most significant byte of ud is ignored, because the file pointer
; range is 0x000000..0xFFFFFF (0..16777215).
_header _public,'REPOSITION-FILE'
reposition_file_:
pop hl
ld d,l ; fid
pop hl ; high 16-bit part of the file pointer
ld e,l ; actual most significant byte of the file pointer
pop hl ; low 16-bit part of the file pointer
push bc ; save the Forth IP
ld b,d ; fid
ld ix,dos_set_position
call dos
pop bc ; restore the Forth IP
jp back_from_dos
Implementada la palabra abandon-file, para facilitar el acceso a la rutina correspondiente de +3DOS:
; ABANDON-FILE ( fid -- ior )
_header _public,'ABANDON-FILE'
abandon_file_:
pop hl
push bc ; save the Forth IP
ld b,l ; fid
ld ix,dos_abandon
call dos
pop bc ; restore the Forth IP
_jump back_from_dos
Nueva palabra headed para modificar el método de acceso a los ficheros y permitir usar o no cabeceras de +3DOS:
; HEADED ( fam1 -- fam2 )
_header _public,'HEADED'
headed_:
pop hl
set 7,l
push hl
jp next
Las palabras (create-file) y (open-file) han sido modificadas para modificar sus acciones dependiendo de si headed ha sido ejecutado, así como para compartir código que tenían en común.
2015-01-24
Nueva versión de file-position, con un par de instrucciones menos y con la parte final, tras el regreso de la rutina de +3DOS, reutilizable:
; FILE-POSITION ( fid -- ud ior )
;
; ud = file pointer
;
; Note: the most significant byte of ud is zero, because the file pointer range
; is 0x000000..0xFFFFFF (0..16777215).
_header _public,'FILE-POSITION'
file_position_:
pop hl
push bc ; save the Forth IP
ld b,l ; fid
ld ix,dos_get_position
dos_ehl:
; Call a DOS routine that returns a number in EHL and, as usual, an error
; code in A. Leave EHL on the stack as a double number, and then A.
; Input:
; b = file number
; ix = DOS routine
; (sp) = Forth IP
; Output stack:
; ( d ior )
; Where d is the content of registers ehl
call dos
pop bc ; restore the Forth IP
; ehl = result
push hl ; low part
ld d,0
push de ; high part
jp back_from_dos
La palabra file-size es implementada así, aprovechando el código reutilizable de file-position:
; FILE-SIZE ( fid -- ud ior )
_header _public,'FILE-SIZE'
file_size_:
pop hl
push bc ; save the Forth IP
ld b,l ; fid
ld ix,dos_get_eof
jp dos_ehl
Primeras pruebas con las palabras de gestión de ficheros de bloques: open-block-file y block funcionan, pero todo el módulo necesita ser comprobado y probablemente simplificado.
Corregido un error en close-file, que dejaba en la pila el supuesto error 1000 en lugar de 0. Este error fue introducido al añadir el código que libera el identificador de fichero. La operación add hl,de modificaba la bandera de acarreo, que era comprobada al entrar en la rutina back_from_dos. Con unos cambios, queda así:
; CLOSE-FILE ( fid -- ior )
_header _public,'CLOSE-FILE'
close_file_:
pop hl
push hl ; save the fid
push bc ; save the Forth IP
ld b,l ; fid
ld ix,dos_close
call dos
pop bc ; restore the Forth IP
pop de ; restore the fid
_jump_nc back_from_dos.error
; no error; mark the file id as free
ld hl,file_id_table
add hl,de
ld (hl),0
jp false_
Primera versión de read-byte y write-byte, para acceder a las llamadas correspondientes de +3DOS:
; READ-BYTE ( fid -- b ior )
; XXX FIXME -- No EOF error: bytes 229 are read after the end of file (the byte
; used to format a disk).
_header _public,'READ-BYTE'
read_byte_:
pop hl
push bc ; save the Forth IP
ld b,l ; fid
ld ix,dos_byte_read
call dos
ld d,0
ld e,c ; byte
pop bc ; restore the Forth IP
push de ; byte
jp nc,dos_error_.a
jp zero_
; WRITE-BYTE ( b fid -- ior )
_header _public,'WRITE-BYTE'
write_byte_:
pop hl
pop de
push bc ; save the Forth IP
ld b,l ; fid
ld c,e ; byte
ld ix,dos_byte_write
call dos
pop bc ; restore the Forth IP
jp back_from_dos
Corregido un error en (read-file): el número de error de +3DOS no era convertido al formato del sistema.
Más cambios de nombres, para seguir unificándolos de acuerdo al criterio elegido: zbuf para a ser filename-buffers; lastfile se convierte en last-filename; >fname se llama ahora >filename-buffer.
Modifico la palabra filetype? y la renombro como filetype: ahora devuelve la cadena, no solo su longitud, lo cual es más versátil. Para adaptar las palabras que usaban la versión antigua basta añadir un nip.
Elimino la palabra .lastfile, que solo se usaba en operaciones interactivas relacionadas con ficheros de bloques, que serán eliminadas también.
Escribo rename-file:
; (RENAME-FILE) ( ca1 ca2 -- ior )
;
; ca1 = current filename, as a 0xFF-terminated string
; ca2 = new filename, as a 0xFF-terminated string
_header _public,'(RENAME-FILE)'
paren_rename_file_:
pop de
pop hl
ld ix,dos_rename
call do_dos
jp back_from_dos
; RENAME-FILE ( ca1 len1 ca2 len2 -- ior )
;
; ca1 len1 = current name
; ca2 len2 = new name
_header _public,'RENAME-FILE'
rename_file_:
call do_colon
dw to_filename_buffer_,one_plus_,to_r_
dw to_filename_buffer_,one_plus_,from_r_
dw paren_rename_file_
dw paren_exit_
Dado que +3DOS necesita la dirección del comienzo del nombre de fichero, terminado en 0xFF, la palabra >filename-buffer siempre necesita ir seguida de 1+. Será conveniente factorizar >filename-buffer para evitar 1+ en cada llamada.
Por otra parte, hay un problema pendiente: La dirección de la cadena devuelta por s" y otras palabras similares siempre es la misma, hay un único tampón para textos:
s" current" s" new" .s
Resultado en pantalla:
<4> 25733 7 25733 3 ok
Por supuesto, no hay problema cuando las cadenas son compiladas en el diccionario, dentro de una palabra:
: files s" current" s" new" ;
files .s
Resultado en pantalla:
<4> -18721 7 -18711 3 ok
Esta limitación impide de momento usar s" más de una vez en modo de interpretación (por ejemplo: s" old" s" new" rename-file) sin guardar antes la primera cadena en lugar seguro, por ejemplo así:
create filename1 16 allot
s" current" filename1 place
filename1 count s" new" rename-file
La solución será implementar un tampón circular de cadenas de texto integrado en el propio sistema, de longitud configurable. En su día escribí dos herramientas de este tipo en Forth: sbuffer y csb2.
Otro asunto pendiente: +string necesita unos cambios para recibir las cadenas en orden inverso en la pila, que es más lógico, pero en cualquier caso puede optimizarse haciendo que el código se modifique a sí mismo. La versión actual procedende de DX-Forth es:
; +STRING ( ca1 len1 ca2 len2 -- ca2 len3 )
;
; Append the string ca1 len1 to the end of string ca2 len2
; returning the resulting string ca2 len3. It is the programmer's
; responsibility to ensure sufficient room is available at ca2
; to hold both strings.
;
; Note: uses temp 1-3.
;
; 2swap swap 2over + 2 pick cmove +
;
; XXX TODO rename and change the order of parameters,
; or keep this word and do a wrapper with the parameters swapped.
_header _public,'+STRING'
plus_string_:
ld l,c
ld h,b
ld (t3),hl ; bsave
pop de
pop hl
ld (t2),hl ; ca2
add hl,de
ex de,hl
pop bc
add hl,bc
ld (t1),hl ; len3
pop hl
call move_block_downwards
ld hl,(t3) ; bsave
ld c,l
ld b,h
ld hl,t1
jp two_fetch_.hl
t1: ds cell
t2: ds cell
t3: ds cell
Tras unas modificaciones el código es más rápido, compacto y legible:
_header _public,'+STRING'
plus_string_:
; Save the Forth IP
ld l,c
ld h,b
ld (plus_string_.ip),hl
; Concatenate the strings
pop de
pop hl
ld (plus_string_.address),hl ; save ca2
add hl,de
ex de,hl
pop bc
add hl,bc
ld (plus_string_.length),hl ; save len3
pop hl
call move_block_downwards
; Restore the Forth IP
plus_string_.ip: equ $+1
ld bc,0
; Return the string
plus_string_.address: equ $+1
ld hl,0
push hl
plus_string_.length: equ $+1
ld hl,0
if size_optimization?
jp push_hl
else
push hl
jp next
endif
2015-01-26
El código relacionado con los números de coma flotante que aún era parcheado durante la ejecución (la inicialización; la identificación en el mensaje de arranque; y la comprobación de números en interpret) ha sido modificado para usar directamente el ensamblado condicional.
La palabra (-fp) es eliminada.
Corrijo un error recientemente introducido en last-filename.
Hay un problema en interpret: la pila se vacía durante la interpretación de un bloque. Esto impide usar load. Creo puntos nuevos deduración para rastrear el error, y una macro para facilitar la tarea:
_debug: macro message,flag
local show
show: defl false
if not nul flag
show: defl flag
endif
if debug? or show
dw cr_,paren_dot_quote_
_dcs message
dw cr_,dot_s_
dw cr_,paren_dot_quote_
_dcs "Press any key"
dw key_,drop_,cr_
endif
endm
Tras rastrear el código paso a paso descubro que las palabras de división no funcionan, no devuelven el resultado. Tras un nuevo rastreo, descubro el error en el código de más bajo nivel, en las rutinas matemáticas de división escritas en Z80: la causa era una confusión entre algunas de las etiquetas push_de y push_de_hl tras su conversión desde DX-Forth. Tras buscar las etiquetas en todo el código, corrijo también las palabras d2* y d2/, que sufrían el mismo problema aunque aún no había sido detectado.
Tras estas últimas correcciones, load funciona por fin. Ya es posible compilar código fuente de los ficheros de bloques, aunque hay una pega: las palabras de DX-Forth que fueron renombradas o eliminadas. Para las pruebas es necesario recrearlas como sinónimos o palabras inoperantes; más adelante podré reunirlas en un solo fichero para servir como capa de adaptación para cargar fuentes de DX-Forth. En todo caso las fuentes que DX-Forth incluye como ficheros de bloques serán adaptadas finalmente.
2015-01-28
Primera versión de una capa de compatibilidad para poder cargar fuentes de DX-Forth. Contiene alias del las palabras renombradas, y versiones inútiles o equivalentes de las que han cambiado de función o han sido eliminadas.
.( DX-Forth layer for DZX-Forth - block 1) cr
' .wid alias .voc
' >filename-buffer alias >fname
' compiling? alias state?
' cs0 alias cf0
' current-block-file alias loadfile
\ ' current-stream-file alias fname
' dos-version alias dosver
' file-id alias getfh
' filename-buffers alias zbuf
' last-filename alias lastfile
' load-file alias fload
' noop alias -caps immediate
' noop alias caps immediate
\ variable sys
-->
.( DX-Forth layer for DZX-Forth - block 2) cr
' noop alias system immediate
' noop alias application immediate
' page alias cls
' parse-filename alias getfilename
' parse-name alias token
' save-system alias save
\ ' set-fcb alias setfcb
' wordlist-find alias wfind
' wordlist>name alias w>name
: filetype? ( -- len ) filetype nip ;
' noop alias >drive
: path drop s" xxx" 0 ;
' open-block-file alias open
' here alias sys-vec \ fake
' drop alias remember
Tras lograr cargar el fichero de bloques tools.fb, que incluye la definición de las palabras necesarias para cargar ficheros fuente en formato normal, ya es posible usar include. Pero el primer intento falla. Hay que revisar todo el código de estas palabra para encontrar el motivo.
2015-01-29
Los ficheros de bloques lina (la versión de ciforth para Linux) tienen una peculiaridad: caracteres de salto de línea. Esto permite combinar las ventajas del formato de bloques (fácil implementación y rapidez de uso) con las ventajas de los ficheros de texto convencionales (edición más fácil y cómoda). Por otra parte, Gforth, a la hora de interpretar código fuente, trata los caracteres de final de línea, así como los tabuladores, como espacios, lo cual es muy flexible pues permite usar diferentes tipos de texto como código fuente.
Para implementar ambas características en DZX-Forth he escrito una palabra que traduce los caracteres de control citados a espacios, y que es llamada por (evaluate):
; (CONTROL>BL) ( ca len -- ca len )
;
; Change all end-of-word control chars (CR, LF, TAB)
; to spaces in the given text.
_header _public,'(CONTROL>BL)'
paren_control_to_bl_:
; XXX TODO -- other method faster than pop-push:
pop de
pop hl
push hl
push de
paren_control_to_bl_.begin:
; hl = pointer to current char
; de = remaining chars
ld a,d
or e
jp z,next
dec de
ld a,(hl)
cp cr_char
jp z, paren_control_to_bl_.space
paren_control_to_bl_.check_tab:
cp 9 ; standard TAB char (not ZX Spectrum TAB char)
jp z, paren_control_to_bl_.space
paren_control_to_bl_.check_lf:
cp lf_char
jp nz, paren_control_to_bl_.repeat
paren_control_to_bl_.space:
ld (hl),sp_char
paren_control_to_bl_.repeat:
inc hl
jp paren_control_to_bl_.begin
; CONTROL>BL ( ca len -- ca len )
;
; Convert end-of-word control chars (CR, LF, TAB) to spaces.
_header _public,'CONTROL>BL'
control_to_bl_:
call fetch_execute_
dw paren_control_to_bl_
Sin embargo este método tiene una desventaja: corrompe posibles caracteres de control empotrados en cadenas de caracteres. Estos caracteres no son habituales ni recomendables en un código fuente, pero aun así esa capa de traducción no parece una buena solución. Un método alternativo, más lento, sería añadir la detección de los caracteres de control al algoritmo de (interpret). En cualquier caso este comportamiento debe ser opcional.
Un pequeño cambio: sustituyo cada dp @ por here, pues es más lógico aunque sea más lento. Más adelante se podrá elegir uno u otro código según la opción de ensamblado size_optimization?.
Tras escribir un prototipo de tampón circular para cadenas de texto y probarlo en Gforth, lo traslado en DZX-Forth en alto nivel, pero más adelante la traduciré a ensamblador:
csb_size: equ 512
csb_unused: dw cbs_size
csb0: ds cbs_size
; CSB-UNUSED ( -- len )
_header _public,'CSB-UNUSED'
csb_unused_:
ld hl,(csb_unused)
jp push_hl
; CSB0 ( -- a )
_header _public,'CSB0'
csb0_:
ld hl,csb0
jp push_hl
; ?CSB ( len -- )
; Make sure there's room for the given characters.
_header _hidden,'?CSB'
question_csb_:
call do_colon
dw dup_,lit_,csb_unused,fetch_,greater_
dw branch_if_false_,question_csb_.enough
; not enough space; reset the pointer
dw lit_,cbs_size
dw lit_,csb_unused,store_
question_csb_.enough:
dw negate_,lit_,csb_unused,plus_store_
dw paren_exit_
; STRING-ALLOCATE ( len -- ca )
_header _hidden,'STRING-ALLOCATE'
string_allocate_:
call do_colon
dw question_csb_
dw csb0_,csb_unused_,plus_
dw paren_exit_
; SAVE-STRING ( ca1 len1 -- ca2 len1 )
_header _public,'SAVE-STRING'
save_string_:
call do_colon
dw dup_,string_allocate_,swap_
dw two_dup_,two_to_r_
dw move_,two_from_r_
dw paren_exit_
; SAVE-COUNTED-STRING ( ca1 len1 -- ca2 )
_header _public,'SAVE-COUNTED-STRING'
save_counted_string_:
call do_colon
dw dup_,one_plus_,string_allocate_
dw dup_,to_r_,place_,from_r_
dw paren_exit_
Los cambios necesarios para que parse y word y palabras relacionadas usen el tampón circular de texto son casi triviales. Por ahora esta característica es opcional, con ensamblado condicional, pero finalmente el sistema antiguo será eliminado, pues el tampón circular de texto no tiene ningún inconveniente: en caso necesario se puede reducir su tamaño hasta un límite en que funcionaría igual que el sistema anterior, como si el tampón no fuera circular.
2015-01-31
Primeros cambios para usar los códigos de error estándar a través de throw, en lugar de imprimir mensajes con abort". Por ejemplo, de esto:
; ?COMP ( -- )
; executing? abort" compilation only'
_header _public,'?COMP'
question_comp_:
call do_colon
dw executing?
dw paren_abort_quote_
_dcs 'compilation only'
dw paren_exit_
A esto:
; ?COMP ( -- )
; executing? -14 and throw
_header _public,'?COMP'
question_comp_:
call do_colon
dw executing?
dw lit_,-14 ; interpreting a compile-only word
dw and_,throw_
dw paren_exit_
El uso de throw permite atrapar los errores. Además se ahorra el espacio ocupado por los mensajes, aunque más adelante se implementará un sistema opcional para que throw los muestre.
Mejora en header: se distinguen los casos de que la longitud del nombre sea cero y de que sea mayor de lo permitido.