QL80
Descripción del contenido de la página
Ensamblador de Z80 escrito en SuperBASIC para la Sinclair QL.
Etiquetas:
Utilicé QL80 durante varios años para programar la aventura Finen per Imago. Cuando QL80 aún se llamaba Quantum Z80, Salvador Merino lo utilizó para ensamblar su Forth para Z88.
Código fuente
REMark ---------------------------------------------------------------
REMark QL80
REMark ---------------------------------------------------------------
:
REMark versión: / versio: / version: 0.40
:
REMark Ensamblador de Z80 para el ordenador Sinclair QL
REMark Z80-asemblilo por la komputilo Sinclair QL
REMark Z80 assembler for the Sinclair QL computer
:
REMark Copyright (C) 1992 Marcos Cruz (http://programandala.net)
REMark Licencia/Permesilo/License: http://programandala.net/license
:
REMark Límites de esta versión:
REMark Cxiversiaj limoj:
REMark Limits of this version:
:
REMark - 4095 etiquetas de 6 letras, que empiecen por mayúscula
REMark - 32768 líneas de programa fuente
REMark - 10 parámetros como máximo en DEFB y DEFW
REMark - 136 columnas como mínimo en impresora para los listados
REMark - no puede emplearse el punto y coma dentro de las cadenas
REMark - lista las etiquetas por orden de creación, no alfabético
:
REMark Herramientas usadas: / Uzitaj iloj: / Toolkits used:
:
REMark Care/QJUMP Toolkit II 2.11
REMark TURBO Toolkit 1.32
REMark TURBO Compiler 1.09
:
REMark ---------------------------------------------------------------
:
REMark (1.00)
REMark 1988
REMark Intento de hacer un ensamblador en Forth
REMark que traduzca lenguaje ensamblador del Z80 escrito
REMark de forma totalmente estándar en un fichero de texto
REMark Abandonado debido a las complicaciones:
REMark pantallas del Forth, tratamiento de ficheros, cadenas...
:
REMark (2.00)
REMark 1988
REMark En SuperBasic
REMark Intento de hacer un ensamblador que interprete
REMark los nemónicos Z80 como órdenes de Basic
:
REMark (3.00)
REMark 1988
REMark Intento de ensamblador en Forth que lea
REMark una versión especial de ensamblador de Z80, adaptada
REMark a la sintaxis del Forth: los nemónicos son palabras,
REMark el programa está escrito en pantallas de Forth, etc.
REMark Abandonado antes de ser totalmente depurado
REMark por no poder usarlo para compilar Z80 estándar
:
REMark (4.00)
REMark 1988
REMark Primera versión esquelética en SuperBasic con plantemientos
REMark totalmente tradicionales: dos pasadas
:
REMark (4.44)
REMark 1988 06
:
REMark (6.30) 0.00
REMark 1988
REMark Primera versión realmente utilizable, después de
REMark sucesivas búsquedas de errores
:
REMark (6.40) 0.01
REMark 1988
REMark - Detecta etiquetas con más de seis caracteres y da error
:
REMark (7.00) 0.02
REMark - Reconoce cadenas de un carácter en las expresiones
:
REMark (8.00) 0.10
REMark - Crea fichero objeto con cabecera para enviar al Spectrum
REMark - Emplea la parte superior de la pantalla, no la inferior
REMark - Emplea más órdenes del Toolkit II, y menos del Turbo Toolkit
REMark - Muestra correctamente la línea, en caso de error
REMark - Corregido error al calcular "dir_vale", en "localiza_etiqueta%"
:
REMark (9.00) 0.20
REMark - Lista todos los errores posibles sin detener el ensamblado
REMark - Añadido el procedimiento "lista_error"
REMark - Cita línea del módulo en la que se produce cada error
REMark - Corregido error de "RETurn" en "ex%"
REMark - Añadida comparación de parámetros en la primera pasada en "RET"
REMark - Si se agota el espacio para las etiquetas, le añade la memoria libre
:
REMark (9.01) 0.21
REMark 1989 04 17
REMark - Corregida columna de impresión del nombre del módulo actual
REMark - Inicializada variable "fin_cadena_no_encontrado" en "interpreta"
:
REMark (10.00) 0.22
REMark - Eliminado el tratamiento final de error en la ventana
REMark - Trasladado "bifurca_a_nemónico%" al interior de "ensambla"
REMark para conseguir un poco más de velocidad
REMark - Corregidos un par de parámetros positivos de llamada a "lista_error"
REMark - Cambiadas comparaciones "IF x=0" a "IF NOT(x)", para mayor velocidad
REMark - Eliminada inicialización "fichero_fuente$=OPT_CMD$"
REMark - Ajustes para acelerar la impresión en la ventana
REMark - Tinta blanca sobre papel negro
REMark - Correcta colocación de la ventana y del borde
REMark - Eliminada instrucción "MODE 4"
REMark - Empleada "n_" como índice de bucles, en vez de "n" y "n_par"
REMark - Eliminadas "n_pendiente" y "n_eti" del "IMPLICIT%", que no se usaban
REMark - Antigua variable "fin_cadena_no_encontrado" convertida en entera
REMark - Trasladado "ensambla" al interior de "bucle_principal"
REMark - Añadidos los procedimientos
REMark - "borra_ventana"
REMark - "muestra_error"
REMark - "pausa"
REMark - "escribe_nombre_fichero"
REMark - Trasladado "guarda_etiqueta%" al interior de "ensambla"
REMark - Trasladado "coge_etiqueta%" al interior de "interpreta"
REMark - Traladado "interpreta" al interior de "ensambla"
REMark - Eliminada comprobación de longitud en "localiza_etiqueta%"
REMark - Eliminadas instrucciones "TRA", residuos de versiones antiguas
REMark - Perfeccionado y corregido el procedimiento "lista_error"
REMark - Añadido el recuento de líneas del fichero fuente principal
REMark - Trasladado el código de "DEFM" al interior de "ensambla"
REMark - Trasladado el código de "*F" al interior de "ensambla"
:
REMark (10.01) 0.23
REMark - "org_inicial" se inicializa con 0 en lugar de con 25000
REMark - Permite espacios intermedios entre los elementos de las
REMark expresiones numéricas a interpretar, y avisa de ellos
REMark - Añadidos los procedimientos
REMark - "lista_aviso"
REMark - "lista_mensaje"
REMark - Reseteada "núm_líneas_mód%" dentro del bucle "pasada"
REMark - Preparada la ventana de ensamblado tras inicializar las
REMark variables y flags, en lugar de antes
REMark - Si se agota el espacio de etiquetas, detiene el ensamblado
:
REMark (10.02) 0.24
REMark - Corregido error en "*L+", que se producía al no haberse
REMark abierto fichero de salida
REMark - Incluido, para lo anterior, el flag "listar_fuente%"
REMark - Corregido error en la petición de dispositivo de salida,
REMark donde se saltaba a "lista_error" en vez de a "muestra_error"
:
REMark (10.10) 0.25
REMark - Permite elegir si se crea el fichero objeto con cabecera especial
REMark para ser enviado al Spectrum directamente
REMark - Para ello se crea el flag "fichero_objeto_Spectrum%"
REMark - Si se responde en blanco a las preguntas "S/N", se considera "n"
REMark - Las instrucciones de apertura del fichero objeto han sido sacadas
REMark de la sección REMAINDER del SELECT de errores y colocadas detrás
REMark de la estructura REPEAT
:
REMark (10.11) 0.26
REMark - Los créditos del programa están cifrados,
REMark para que no puedan ser alterados
REMark - Nueva función "descifrado$" y nuevas variables:
REMark "texto_c$" y "texto_d$"
:
REMark (10.20) 0.27
REMark - La opción de no crear código objeto ha sido eliminada,
REMark con lo cual la ejecución es algo más rápida
:
REMark (10.21) 0.28
REMark 1990 01
REMark - Se ha añadido un cierre de fichero objeto en el caso de
REMark finalizar el ensamblado con error, que faltaba
:
REMark (11.00) 0.30
REMark 1990 12 -> 1991 01
REMark - El nombre pasa a ser "QL-Z80" en lugar de "Quantum Z80"
REMark - Se puede elegir la lengua de trabajo entre:
REMark Español, Esperanto, English
REMark - Corregidas dos errores ortográficos: "Lineas" por "Líneas"
REMark - Los mensajes de error aparecen en la lengua de trabajo
:
REMark (11.10) 0.31
REMark 1991 10
REMark - Corregida la inicialización de la variable
REMark "fichero_objeto_spectrum%", que quedaba a cero si la
REMark lengua de trabajo no era el castellano
REMark - El procedimiento "pausa" siempre hace una pausa infinita
REMark - El número máximo de etiquetas es 4095, para que su espacio
REMark no pase de 32768 bytes, y poder emplear MOD en
REMark el procedimiento "localiza_etiqueta%"
REMark - La validez de la etiqueta encontrada en "localiza_etiqueta%"
REMark se combrueba con MOD, para mayor velocidad
REMark - Corregida la falta de la palabra "líneas" en la lengua de
REMark trabajo en la ventana informativa final
REMark - El número de errores final aparece en la lengua de trabajo
REMark - Eliminados "peekw" y "pokew" en favor de PEEK y POKE_W
REMark - Eliminada "texto1$" por redundante e innecesaria
REMark - Añadido REMAINDER que faltaba en "error_en_lengua$"
REMark - Revisados todos los textos, especialmente en esperanto
REMark - La variable "segundos%" pasa a ser real, para evitar
REMark el límite de 9 horas de ensamblado
:
REMark (11.20) 0.32
REMark 1991 12 29
REMark - Reconoce IF, ELSE y ENDIF para controlar el ensamblado
REMark - Permite hasta 36 caracteres en nombres de ficheros
REMark - Corregido error, sustituido "S" por sí$
REMark - No altera el nombre de fichero fuente si no acaba en "_asm"
REMark - Pide el idioma mediante EDIT$, para no perder el cursor
:
REMark (11.21) 0.33
REMark 1992 01 07
REMark - Corregido error que se producía al responder en blanco
REMark a la elección de lengua de trabajo (la tarea se borraba)
REMark - Actualizados los títulos de crédito
REMark - Alterado el procedimiento "descifrado$" para compatibilizarlo
REMark con el programa codificador Nomkasxilo 1.00
REMark (se ha invertido el bucle que examina el texto)
REMark - El nombre pasa a ser simplemente QL80 en vez de QL-Z80
:
REMark (11.30) 0.40
REMark 1992 04 05
REMark - Cierra el fichero objeto aun si no tiene cabecera de Spectrum
REMark - Corregidos graves errores en el ensamblado condicional; ahora:
REMark 1) DEFM y *F no actúan cuando ensamblar%=0
REMark 2) IF no actúa cuando ensamblar%=0
REMark 3) ELSE y ENDIF actúan siempre, aun cuando ensamblar%=0
REMark 4) Si ensamblar%=0, no se leen las etiquetas
REMark 5) Si ensamblar%=0, no se examinan los parámetros de los
REMark comandos que deben o pueden llevarlos
REMark - Cambiado el nombre de ensamblando% a ensamblado%, más adecuado
REMark - Añadida la función mayúsculas$, para comprobar mejor la extensión
REMark del nombre del fichero fuente, _asm o _ASM
REMark - Cambiada la traducción "fronto" por "dosierkapo"
REMark - Añadido el procedimiento abre_ventanas
:
REMark 0.50
REMark 1996
REMark cosas a medio hacer:
REMark COSAS POR HACER:
REMark PRIORITARIAS
REMark - Nueva interfaz, a modo de las ventanas del Pointer Environment
REMark - Crear ficheros objeto para Spectrum también en formato TAP
REMark - Dividir el programa en módulos
REMark para hacerlo más fácil de editar y mantener, ya que la velocidad
REMark no es un problema con la QXL
REMark - Revisar y normalizar el uso de extensiones de Turbo y TK2
REMark SECUNDARIAS
REMark - Eliminar límite de 4096 etiquetas
REMark - Listar etiquetas por orden alfabético
REMark - Eliminar límite de 32768 líneas de código fuente
REMark - Eliminar límite de 10 parámetros en DEFB y DEFW
REMark - Decidir sobre los idiomas de trabajo
REMark - La variable segundos puede ser entera de nuevo,
REMark ya que el límite de 9 horas de ensamblado es suficiente
REMark DIFíCILES
REMark - Reconocer el punto y coma en los parámetros
REMark - Permitir etiquetas de longitud variable
REMark - Permitir cualquier combinación de espacios y tabuladores como separadaores
:
REMark Abreviaturas en nombres de variables
REMark ant antigua/o
REMark dir dirección
REMark dis dispositivo
REMark exp expresión
REMark h_ high, parte alta de un valor de 16 bits
REMark l_ low, parte baja de un valor de 16 bits
REMark len longitud de una cadena
REMark lon longitud
REMark máx máximo/a
REMark mód módulo
REMark n_ índice de bucle
REMark núm número
REMark org origen, dirección del código objeto en el Spectrum
REMark p_ parámetro de entrada en una función
REMark par parámetro
REMark pri primera/o
REMark últ último/a
:
REMark Variables enteras implícitas
IMPLICIT% n_, n_parámetro, n_nemónico, pasada, registro1, registro2, tipo1, núm_par, n_par, operación, pseudo_nemónico, tipo_elemento, cód_letra, flag_error, ctexto, lengua
:
REMark Bucle principal -----------------------------------------------
:
REPeat bucle_principal
CLEAR:REMark si no, el espacio libre de la tarea se va reduciendo
REMark Constantes y variables inicializadas
últ_nemónico%=78:REMark 75 en v11.10
últ_parámetro%=30
núm_máx_parámetros%=10
lon_nombre%=36:REMark 32 en v11.10
lon_máx_línea%=115:REMark 136, menos lo que añade el ensamblado
lon_media_línea%=20:REMark longitud media de las líneas
lon_parámetro%=lon_máx_línea%-12
bytes_máx_listados%=4
REMark Cadenas
DIM fichero_fuente$(lon_nombre%)
DIM módulo_fuente$(lon_nombre%)
DIM fichero_objeto$(lon_nombre%)
DIM dis_listado$(lon_nombre%)
DIM dis_errores$(lon_nombre%)
DIM código_objeto$(bytes_máx_listados%*2)
DIM línea$(lon_máx_línea%)
DIM línea_original$(lon_máx_línea%)
DIM línea_anterior$(lon_máx_línea%)
DIM etiqueta$(6)
DIM comando$(4)
DIM parámetros$(lon_parámetro%)
DIM un_parámetro$(lon_parámetro%)
DIM elemento$(lon_parámetro%)
DIM letra$(1)
DIM comillas$(1)
DIM plural$(2)
DIM texto_c$(80)
DIM texto$(60):REMark para guardar el texto en la lengua en uso
DIM texto2$(60):REMark para guardar el texto en la lengua en uso
DIM sí$(1)
DIM no$(1)
REMark Matrices
DIM tipo_par%(núm_máx_parámetros%)
DIM valor_par%(núm_máx_parámetros%)
DIM identificador_par%(núm_máx_parámetros%)
DIM valor_exp(núm_máx_parámetros%)
DIM nemónico$(últ_nemónico%,4)
DIM nemónico%(últ_nemónico%,2)
REMark nemónico%(n,0)=identificador
REMark nemónico%(n,1)=número mínimo de parámetros
REMark nemónico%(n,2)=número máximo de parámetros
RESTORE
FOR n_=0 TO últ_nemónico%
READ nemónico%(n_,0),nemónico$(n_),nemónico%(n_,1),nemónico%(n_,2)
END FOR n_
DIM parámetro$(últ_parámetro%,lon_parámetro%)
DIM parámetro%(últ_parámetro%,2)
REMark parámetro%(n,0)=identificador
REMark parámetro%(n,1)=tipo
REMark parámetro%(n,2)=valor
FOR n_=0 TO últ_parámetro%
READ parámetro%(n_,0),parámetro$(n_),parámetro%(n_,1),parámetro%(n_,2)
END FOR n_
REMark Canales
ventana%=4
fichero_fuente%=5
fichero_objeto%=6
dis_listado%=7
dis_errores%=8
REMark Pantalla
abre_ventanas
pausa
REMark Elegir lengua de trabajo
REPeat elige_lengua
CLS#ventana%
PRINT#ventana%," 1=Español 2=Esperanto 3=English ?: ";
letra$=EDIT$(#ventana%,"2",1)
IF LEN(letra$) AND letra$ INSTR "123":EXIT elige_lengua
END REPeat elige_lengua
lengua=letra$
SELect ON lengua
=1:sí$="S":no$="N":REMark Español
=2:sí$="J":no$="N":REMark Esperanto
=3:sí$="Y":no$="N":REMark English
END SELect
REPeat ensambla
REMark Inicializar variables previas al ensamblado
flag_error=0
línea$=""
núm_errores%=0
ensamblado%=0:REMark indicador de ensamblado aún no comenzado
REMark Pedir nombre de fichero fuente
abierto_fichero_fuente%=0
REPeat pide_fichero_fuente
CLS#ventana%
SELect ON lengua
=1:texto$="Fichero fuente"
=2:texto$="Asembla dosiero"
=3:texto$="Source file"
END SELect
PRINT#ventana%," ";texto$;": ";
fichero_fuente$=EDIT$(#ventana%,fichero_fuente$,lon_nombre%)
IF fichero_fuente$="":EXIT ensambla
REMark Detectar errores
flag_fichero=DEVICE_STATUS(fichero_fuente$)
SELect ON flag_fichero
=-8,-20
REMark Abrir fichero fuente
OPEN_IN#fichero_fuente%,fichero_fuente$
abierto_fichero_fuente%=1
lon_fichero_fuente=FLEN(#fichero_fuente%)
núm_líneas%=lon_fichero_fuente/lon_media_línea%
EXIT pide_fichero_fuente
=-3,-6,-7,-9,-11,-12,-16
muestra_error flag_fichero
=REMAINDER
muestra_error -7:REMark no encontrado
END SELect
NEXT pide_fichero_fuente
END REPeat pide_fichero_fuente
REMark Pedir tipo de fichero objeto
REPeat pide_tipo_fichero_objeto
CLS#ventana%
SELect ON lengua
=1:texto$="¿Cabecera para"
=2:texto$="Dosierkapo por"
=3:texto$="Header for"
END SELect
PRINT#ventana%," ";texto$;" ZX Spectrum? ";
letra$=EDIT$(#ventana%,sí$,1)
IF letra$==sí$ OR letra$==no$:EXIT pide_tipo_fichero_objeto
END REPeat pide_tipo_fichero_objeto
fichero_objeto_Spectrum%=LEN(letra$)&&(letra$==sí$)
bytes_objeto=0:REMark inicializar contador de bytes objeto
IF mayúsculas$(fichero_fuente$(LEN(fichero_fuente$)-3 TO))="_ASM"
fichero_objeto$="ram1"&fichero_fuente$(5 TO LEN(fichero_fuente$)-3)
ELSE
fichero_objeto$="ram1"&fichero_fuente$(5 TO)&"_"
END IF
IF fichero_objeto_Spectrum%
fichero_objeto$=fichero_objeto$&"SpectrumCODE"
ELSE
fichero_objeto$=fichero_objeto$&"Z80"
END IF
REMark Pedir fichero objeto
REPeat pide_fichero_objeto
CLS#ventana%
SELect ON lengua
=1:texto$="Fichero objeto"
=2:texto$="Masxinkoda dosiero"
=3:texto$="Object file"
END SELect
PRINT#ventana%," ";texto$;": ";
fichero_objeto$=EDIT$(#ventana%,fichero_objeto$,lon_nombre%)
IF fichero_objeto$="":EXIT ensambla
REMark Detectar errores
flag_fichero=DEVICE_STATUS(fichero_objeto$)
SELect ON flag_fichero
=-3,-6,-7,-9,-11,-12,-16,-20
muestra_error flag_fichero
NEXT pide_fichero_objeto
END SELect
EXIT pide_fichero_objeto
END REPeat pide_fichero_objeto
OPEN_OVER#fichero_objeto%,fichero_objeto$
IF fichero_objeto_Spectrum%
REMark - procedimiento abre_ventanas
REMark Poner cabecera para enviar después el código al Spectrum
BPUT#fichero_objeto%,3,0,0,0,0,255,255,255,255
END IF
REMark Pedir número máximo de etiquetas
dir_zona_etiquetas=0
núm_máx_etiquetas%=1+INT(núm_líneas%/8.3)
REPeat pide_núm_máx_etiquetas
CLS#ventana%
SELect ON lengua
=1:texto$="Número máximo de etiquetas"
=2:texto$="Plej da etikedoj"
=3:texto$="Largest number of labels"
END SELect
PRINT#ventana%," ";texto$;": ";
núm_máx_etiquetas%=EDIT%(#ventana%,INT(núm_máx_etiquetas%),4)
IF núm_máx_etiquetas%<1 OR núm_máx_etiquetas>4095:EXIT ensambla
lon_zona_etiquetas=núm_máx_etiquetas%*8
IF lon_zona_etiquetas>(PEEK_L(163856)-PEEK_L(163852))
muestra_error -3:REMark sin memoria
NEXT pide_núm_máx_etiquetas
END IF
EXIT pide_núm_máx_etiquetas
END REPeat pide_núm_máx_etiquetas
dir_zona_etiquetas=ALCHP(lon_zona_etiquetas)
REMark Pedir dispositivo de errores
REPeat pide_dis_errores
CLS#ventana%
SELect ON lengua
=1:texto$="Listado de errores hacia"
=2:texto$="Erarlisto al"
=3:texto$="List of errors to"
END SELect
PRINT#ventana%," ";texto$;": ";
dis_errores$=EDIT$(#ventana%,"ser1",lon_nombre%)
IF dis_errores$="":EXIT ensambla
flag_fichero=DEVICE_STATUS(dis_errores$)
SELect ON flag_fichero
=-3,-6,-7,-9,-11,-12,-16,-20
muestra_error flag_fichero
=REMAINDER
REMark Abrir dispositivo de listado errores
OPEN_OVER#dis_errores%,dis_errores$
abierto_dis_errores%=1
EXIT pide_dis_errores
END SELect
NEXT pide_dis_errores
END REPeat pide_dis_errores
REMark Pedir listado fuente S/N
REPeat pide_listado_fuente
CLS#ventana%
SELect ON lengua
=1:texto$="Listado fuente"
=2:texto$="Asembla printajxo"
=3:texto$="Source list"
END SELect
PRINT#ventana%," ";texto$;"? ";
letra$=EDIT$(#ventana%,no$,1)
IF letra$==sí$ OR letra$==no$:EXIT pide_listado_fuente
END REPeat pide_listado_fuente
listado_fuente%=(letra$==sí$):REMark flag invariable
listar_fuente%=listado_fuente%:REMark flag variable durante el ensamblado, según los pseudonemónicos "*L-" y "*L+"
REMark Pedir listado de etiquetas S/N
REPeat pide_listado_etiquetas
CLS#ventana%
SELect ON lengua
=1:texto$="Listado de etiquetas"
=2:texto$="Etikedlisto"
=3:texto$="Label list"
END SELect
PRINT#ventana%," ";texto$;"? ";
letra$=EDIT$(#ventana%,no$,1)
IF letra$==sí$ OR letra$==no$:EXIT pide_listado_etiquetas
END REPeat pide_listado_etiquetas
listado_etiquetas%=(letra$==sí$)
REMark Pedir fichero de listado
abierto_dis_listado%=0
IF listado_fuente% OR listado_etiquetas%
REPeat pide_dis_listado
CLS#ventana%
SELect ON lengua
=1:texto$="Dispositivo de salida"
=2:texto$="Listkanalo"
=3:texto$="Output device"
END SELect
PRINT#ventana%," ";texto$;": ";
dis_listado$=EDIT$(#ventana%,dis_listado$,lon_nombre%)
IF dis_listado$="":EXIT ensambla
flag_fichero=DEVICE_STATUS(dis_listado$)
SELect ON flag_fichero
=-3,-6,-7,-9,-11,-12,-16,-20
muestra_error flag_fichero
=REMAINDER
REMark Abrir dispositivo de listado
OPEN_OVER#dis_listado%,dis_listado$
abierto_dis_listado%=1
EXIT pide_dis_listado
END SELect
END REPeat pide_dis_listado
END IF
REMark Pedir confirmación
REPeat pide_confirmación
CLS#ventana%
SELect ON lengua
=1:texto$="¿Todo correcto"
=2:texto$="Cxio en ordo"
=3:texto$="All right"
END SELect
PRINT#ventana%," ";texto$;"? ";
letra$=EDIT$(#ventana%,sí$,1)
IF letra$==sí$ OR letra$==no$:EXIT pide_confirmación
END REPeat pide_confirmación
IF letra$==no$:EXIT ensambla
REMark Inicializar variables para el ensamblado
org_inicial=0:REMark dirección de origen por defecto
núm_líneas_fuente%=0:REMark número de líneas del fichero fuente principal
núm_etiquetas%=0
ensamblando_módulo%=0
es_un_registro%=0
era_índice%=0
hay_pendiente%=0
listar_línea_anterior%=1
ensamblado%=1:REMark indicar que comienza el ensamblado
ensamblar%=1:REMark situación inicial activa de la bandera de IF
módulo_fuente$=fichero_fuente$
REMark Preparar la pantalla
borra_ventana
SELect ON lengua
=1:texto$="Pasada"
=2:texto$="Pasxo"
=3:texto$="Pass"
END SELect
PRINT#ventana%," ";texto$
SELect ON lengua
=1:texto$="Línea"
=2:texto$="Linio"
=3:texto$="Line"
END SELect
AT#ventana%,0,10
PRINT#ventana%,texto$
SELect ON lengua
=1:texto$="Ensamblando"
=2:texto$="Elasemble"
=3:texto$="Assembling"
END SELect
AT#ventana%,0,22
PRINT#ventana%,texto$;":"
escribe_nombre_fichero
REMark Realizar el ensamblado
tiempo_inicio=DATE
FOR pasada=1 TO 0 STEP -1
núm_líneas_mód%=0
AT#ventana%,0,8
PRINT#ventana%,2-pasada
SET_POSITION#fichero_fuente%,0
dir_org=org_inicial
núm_líneas%=0:REMark número de líneas total de todos los ficheros
AT#ventana%,0,16:PRINT#ventana%," ":REMark borrar no. línea
REPeat ensambla_módulo
REPeat lee_línea
REMark Leer línea y quitarle comentarios
IF EOF(#fichero_fuente%):EXIT lee_línea
INPUT#fichero_fuente%,línea_original$
línea$=línea_original$
IF listar_fuente%
IF NOT(pasada)
REMark segunda pasada
lista_línea_anterior
REMark Preparar listado de la línea actual
dir_org_anterior=dir_org
listar_dir_anterior%=1
código_objeto$=""
bytes_listados%=0
línea_anterior$=línea_original$
END IF
END IF
núm_líneas%=núm_líneas%+1
núm_líneas_mód%=núm_líneas_mód%+1
AT#ventana%,0,16
PRINT#ventana%,núm_líneas%
hasta%=";" INSTR línea$
IF hasta%
IF hasta%=1:listar_dir_anterior%=0:NEXT lee_línea
línea$=línea$(1 TO hasta%-1)
END IF
len_línea%=LEN(línea$)
REMark ** IF NOT(len_línea%):listar_dir_anterior%=0:NEXT lee_línea
REMark Separar etiqueta
hay_etiqueta%=0
IF pasada
REMark primera pasada
IF ensamblar%
etiqueta$=línea$(1 TO 6)&" "
IF etiqueta$(1 TO 6)<>" "
REMark la etiqueta no está en blanco
IF localiza_etiqueta%=-7
REMark la etiqueta no existía antes
REMark Guardar la etiqueta
IF núm_etiquetas%=núm_máx_etiquetas%
lista_error -3:REMark sin memoria
EXIT ensambla
END IF
POKE$ dir_etiqueta,etiqueta$
POKE_W dir_etiqueta+6,dir_org
núm_etiquetas%=núm_etiquetas%+1
dir_etiqueta_nueva=dir_etiqueta:REMark guardar posición
hay_etiqueta%=1
ELSE
REMark la etiqueta ya existía
lista_error -8:REMark ya existe
END IF
END IF
END IF
END IF
REMark Separar comando
hay_comando%=0
núm_par=0
IF len_línea%>7
REMark la línea es mayor que la zona de etiquetas
línea$=línea$&" ":REMark añadir dos espacios al final
hasta%=" " INSTR línea$(8 TO)+7
IF hasta%>8
REMark hay algo en la zona de comandos
comando$=línea$(8 TO hasta%-1)
parámetros$=línea$(hasta%+1 TO)
IF comando$<>FILL$(" ",LEN(comando$))
REMark el comando no está en blanco
REMark Buscar comando en la lista de nemónicos
FOR n_nemónico=0 TO últ_nemónico%
IF comando$=nemónico$(n_nemónico)
núm_mín_par%=nemónico%(n_nemónico,1)
núm_máx_par%=nemónico%(n_nemónico,2)
hay_comando%=1
EXIT n_nemónico
END IF
END FOR n_nemónico
IF hay_comando%
SELect ON n_nemónico
=3
IF ensamblar%
REMark DEFM
bytes%=0
IF parámetros$(1)<>'"'
lista_error -15:REMark parámetro incorrecto
ELSE
len_un_parámetro%=LEN(parámetros$)
REPeat corta_cadena
IF parámetros$(len_un_parámetro%)<>" ":EXIT corta_cadena
len_un_parámetro%=len_un_parámetro%-1
parámetros$=parámetros$(1 TO len_un_parámetro%)
END REPeat corta_cadena
IF parámetros$(len_un_parámetro%)<>'"'
lista_error -15:REMark parámetro incorrecto
ELSE
IF pasada
bytes%=len_un_parámetro%-2
ELSE
FOR n_=2 TO len_un_parámetro%-1
pokea CODE(parámetros$(n_))
END FOR n_
bytes%=n_-1
END IF
END IF
END IF
END IF
=75
REMark *F
IF ensamblar%
hasta%=" " INSTR parámetros$
IF hasta%=1
lista_error -15:REMark parámetro incorrecto
EXIT ensambla
END IF
parámetros$=parámetros$(1 TO hasta%-1)
IF ensamblando_módulo%:
lista_error -8:REMark ya existe
ELSE
posición_fuente=POSITION(#fichero_fuente%)
flag_fichero=DEVICE_STATUS(parámetros$)
SELect ON flag_fichero
=-8,-20
REMark Cambiar fichero fuente
CLOSE#fichero_fuente%
módulo_fuente$=parámetros$
núm_líneas_fuente%=núm_líneas_mód%:REMark guardar líneas del fichero fuente principal
núm_líneas_mód%=0:REMark inicializar cuenta de líneas del nuevo módulo
OPEN_IN#fichero_fuente%,módulo_fuente$
ensamblando_módulo%=1
escribe_nombre_fichero
listar_dir_anterior%=0
=-3,-6,-7,-9,-11,-12,-16
lista_error flag_fichero
=REMAINDER
lista_error -7:REMark no encontrado
END SELect
END IF
bytes%=0
END IF
=REMAINDER
IF núm_mín_par% OR núm_máx_par%
IF ensamblar%
REMark Leer parámetros
IF parámetros$<>FILL$(" ",LEN(parámetros$))
no_quedan_parámetros%=0
REPeat separa_parámetros
hasta%="," INSTR parámetros$
IF hasta%
IF hasta%=1
lista_error -21:REMark línea incorrecta
NEXT lee_línea
END IF
un_parámetro$=parámetros$(1 TO hasta%-1)
len_un_parámetro%=LEN(un_parámetro$)
parámetros$=parámetros$(hasta%+1 TO)
ELSE
un_parámetro$=parámetros$
len_un_parámetro%=LEN(un_parámetro$)
REPeat corta_un_parámetro
IF un_parámetro$(len_un_parámetro%)<>" ":EXIT corta_un_parámetro
IF len_un_parámetro%=1:EXIT corta_un_parámetro
un_parámetro$=un_parámetro$(1 TO len_un_parámetro%-1)
len_un_parámetro%=len_un_parámetro%-1
END REPeat corta_un_parámetro
no_quedan_parámetros%=1
END IF
IF núm_par>núm_máx_par%
lista_error -21:REMark línea incorrecta
END IF
REMark Estudiar el parámetro
IF len_un_parámetro%<5
FOR n_parámetro=0 TO últ_parámetro%
IF un_parámetro$=parámetro$(n_parámetro)
es_un_registro%=1
EXIT n_parámetro
END IF
END FOR n_parámetro
END IF
IF es_un_registro%
es_un_registro%=0
identificador_par%(núm_par)=parámetro%(n_parámetro,0)
tipo_par%(núm_par)=parámetro%(n_parámetro,1)
valor_par%(núm_par)=parámetro%(n_parámetro,2)
núm_par=núm_par+1
ELSE
entre_paréntesis%=0
IF un_parámetro$(1)="("
IF un_parámetro$(len_un_parámetro%)=")":entre_paréntesis%=1
END IF
IF entre_paréntesis%
IF un_parámetro$(4) INSTR "+-"
IF un_parámetro$(2 TO 3)="IX"
era_índice%=22:REMark (IX)
ELSE
IF un_parámetro$(2 TO 3)="IY"
era_índice%=23:REMark (IY)
END IF
END IF
END IF
un_parámetro$=un_parámetro$(2 TO len_un_parámetro%-1)
len_un_parámetro%=len_un_parámetro%-2
END IF
IF era_índice%
identificador_par%(núm_par)=parámetro%(era_índice%,0)
tipo_par%(núm_par)=parámetro%(era_índice%,1)
valor_par%(núm_par)=parámetro%(era_índice%,2)
era_índice%=0
núm_par=núm_par+1
un_parámetro$=un_parámetro$(3 TO)
len_un_parámetro%=len_un_parámetro%-2
núm_máx_par%=núm_máx_par%+1
END IF
REMark Interpretar la expresión
hay_pendiente%=0
letra%=0
valor_expresión=0
operación=1:REMark suma por defecto
REPeat interpreta_expresión
fin_cadena_no_encontrado%=0:REMark resetear flag especial de cadenas
elemento$=""
REMark Buscar comienzo del elemento
REPeat busca_elemento
letra%=letra%+1
IF letra%>len_un_parámetro%
lista_error -17:REMark expresión errónea
RETurn
END IF
letra$=un_parámetro$(letra%)
cód_letra=CODE(letra$)
SELect ON cód_letra
=65 TO 90
REMark "A...Z" etiqueta
tipo_elemento=0
elemento$=letra$
EXIT busca_elemento
=48 TO 57
REMark "0...9" número decimal
tipo_elemento=1
elemento$=letra$
EXIT busca_elemento
=35
REMark "#" número hexadecimal
tipo_elemento=2
EXIT busca_elemento
=43
REMark "+" suma, número positivo
operación=1:REMark suma
NEXT busca_elemento
=45
REMark "-" resta, número negativo
operación=2:REMark resta
NEXT busca_elemento
=37
REMark "%" número binario
tipo_elemento=3
EXIT busca_elemento
=34,39
tipo_elemento=5
comillas$=letra$
fin_cadena_no_encontrado%=1
EXIT busca_elemento
=36
REMark "$" contador de programa
tipo_elemento=4
EXIT busca_elemento
=32
REMark espacio
IF pasada
REMark primera pasada
lista_aviso -17:REMark expresión errónea
PRINT#dis_errores%,"(Espacio innecesario ignorado)"
END IF
NEXT busca_elemento
=REMAINDER
lista_error -17:REMark expresión errónea
EXIT interpreta_expresión
END SELect
END REPeat busca_elemento
REMark Coger el resto del elemento
REPeat coge_elemento
letra%=letra%+1
IF letra%>len_un_parámetro%:EXIT coge_elemento
letra$=un_parámetro$(letra%)
IF fin_cadena_no_encontrado%
IF letra$=comillas$
fin_cadena_no_encontrado%=0
NEXT coge_elemento:REMark para que no se sumen las comillas
END IF
ELSE
nueva_operación%=letra$ INSTR "+-*/"
IF nueva_operación%:EXIT coge_elemento
END IF
elemento$=elemento$&letra$
END REPeat coge_elemento
REMark Calcular el valor del elemento
SELect ON tipo_elemento
=0
REMark se trata de una etiqueta
REMark Buscar la etiqueta entre las ya existentes
etiqueta$=elemento$&" "
flag_error=localiza_etiqueta%
SELect ON flag_error
=-8
REMark se encontró la etiqueta
REMark Coger su valor, en dos pasos
REMark (de este modo se evita el signo)
h_=PEEK(dir_etiqueta+6)
valor_elemento=256*h_+PEEK(dir_etiqueta+7)
=-7
REMark la etiqueta no existe
IF NOT(pasada)
REMark segunda pasada
lista_error -7:REMark no encontrado
PRINT#dis_errores%,etiqueta$
END IF
hay_pendiente%=1:REMark aviso para un posible EQU
valor_elemento=0
END SELect
=1
REMark se trata de un número decimal
valor_elemento=elemento$
=2
REMark se trata de un número hexadecimal
valor_elemento=HEX(elemento$)
=3
REMark se trata de un número binario
valor_elemento=BIN(elemento$)
=5
REMark se trata de una cadena
IF LEN(elemento$)<>1
lista_error -17:REMark expresión errónea
END IF
valor_elemento=CODE(elemento$)
=4
REMark se trata del contador de programa
IF LEN(elemento$)>1
lista_error -17:REMark expresión errónea
END IF
valor_elemento=dir_org
END SELect
SELect ON operación
=1
REMark suma
valor_expresión=valor_expresión+valor_elemento
=2
REMark resta
valor_expresión=valor_expresión-valor_elemento
=3
REMark producto
valor_expresión=valor_expresión*valor_elemento
=4
REMark división
valor_expresión=valor_expresión/valor_elemento
END SELect
IF valor_expresión<-32768 OR valor_expresión>65535
lista_error -4:REMark fuera de rango
valor_expresión=0
END IF
IF letra%>=len_un_parámetro%
EXIT interpreta_expresión
END IF
operación=nueva_operación%
END REPeat interpreta_expresión
tipo_par%(núm_par)=128+entre_paréntesis%
identificador_par%(núm_par)=-1:REMark borrar
valor_exp(núm_par)=valor_expresión
núm_par=núm_par+1
END IF
IF no_quedan_parámetros%:EXIT separa_parámetros
END REPeat separa_parámetros
IF núm_par<núm_mín_par%
lista_error -21:REMark línea incorrecta
NEXT lee_línea
END IF
ELSE
IF núm_mín_par%
lista_error -21:REMark línea incorrecta
NEXT lee_línea
END IF
END IF
END IF
ELSE
REMark no tiene que haber parámetros
IF parámetros$<>FILL$(" ",LEN(parámetros$))
lista_error -21:REMark línea incorrecta
NEXT lee_línea
END IF
END IF
pseudo_nemónico=nemónico%(n_nemónico,0)
IF ensamblar%
SELect ON pseudo_nemónico
= 1:bytes%=ld%:REMark LD
=48:bytes%=call%:REMark CALL
=52:bytes%=jr%:REMark JR
=66:bytes%=defb%:REMark DEFB
=67:bytes%=defw%:REMark DEFW
=50:bytes%=jp%:REMark JP
=19:bytes%=logicarit%(182,0):REMark CP
=74:bytes%=push_pop%(0):REMark POP
=73:bytes%=push_pop%(4):REMark PUSH
=15:bytes%=inc_dec%(0):REMark INC
=51:bytes%=ret_%:REMark RET
=18:bytes%=logicarit%(158,0):REMark AND
=45:bytes%=bits%(62):REMark BIT
=39:bytes%=equ%:REMark EQU
= 0:bytes%=logicarit%(166,0):REMark XOR
=14:bytes%=inc_dec%(1):REMark DEC
=13:bytes%=add%:REMark ADD
=49:bytes%=djnz%:REMark DJNZ
= 3:bytes%=nemónico1%(217):REMark EXX
= 2:bytes%=ex%:REMark EX
=17:bytes%=logicarit%(142,0):REMark SUB
= 7:bytes%=nemónico_ed%(176):REMark LDIR
=44:bytes%=giros%(54):REMark SRL
=46:bytes%=bits%(126):REMark RES
=68:bytes%=defs%:REMark DEFS
=55:bytes%=rst%:REMark RST
=11:bytes%=nemónico_ed%(177):REMark CPIR
=26:bytes%=nemónico1%(118):REMark HALT
=27:bytes%=im%:REMark IM
=20:bytes%=logicarit%(174,0):REMark OR
=29:bytes%=nemónico1%(0):REMark NOP
=30:bytes%=nemónico1%(55):REMark SCF
=36:bytes%=giros%(22):REMark RR
=64:bytes%=org%:REMark ORG
=53:bytes%=nemónico_ed%(77):REMark RETI
=47:bytes%=bits%(190):REMark SET
=24:bytes%=nemónico1%(243):REMark DI
=25:bytes%=nemónico1%(251):REMark EI
= 4:bytes%=nemónico_ed%(168):REMark LDD
= 5:bytes%=nemónico_ed%(184):REMark LDDR
= 6:bytes%=nemónico_ed%(160):REMark LDI
= 8:bytes%=nemónico_ed%(169):REMark CPD
= 9:bytes%=nemónico_ed%(185):REMark CPDR
=10:bytes%=nemónico_ed%(161):REMark CPI
=12:bytes%=adc_sbc%(0):REMark ADC
=16:bytes%=adc_sbc%(16):REMark SBC
=21:bytes%=nemónico1%(63):REMark CCF
=22:bytes%=nemónico1%(47):REMark CPL
=23:bytes%=nemónico1%(39):REMark DAA
=28:bytes%=nemónico_ed%(68):REMark NEG
=31:bytes%=giros%(14):REMark RL
=32:bytes%=nemónico1%(23):REMark RLA
=33:bytes%=giros%(-2):REMark RLC
=34:bytes%=nemónico1%(7):REMark RLCA
=35:bytes%=nemónico_ed%(111):REMark RLD
=37:bytes%=nemónico1%(31):REMark RRA
=38:bytes%=giros%(6):REMark RRC
=40:bytes%=nemónico1%(15):REMark RRCA
=41:bytes%=nemónico_ed%(103):REMark RRD
=42:bytes%=giros%(30):REMark SLA
=43:bytes%=giros%(38):REMark SRA
=54:bytes%=nemónico_ed%(69):REMark RETN
=56:bytes%=in%:REMark IN
=61:bytes%=out%:REMark OUT
=69:bytes%=comando_listado%(1):REMark *L+
=70:bytes%=comando_listado%(0):REMark *L-
=76:bytes%=comando_if%:REMark IF
=77:ensamblar%=NOT ensamblar%:REMark ELSE
bytes%=0
=57:bytes%=nemónico_ed%(170):REMark IND
=58:bytes%=nemónico_ed%(162):REMark INI
=59:bytes%=nemónico_ed%(172):REMark INIR
=60:bytes%=nemónico_ed%(186):REMark INDR
=62:bytes%=nemónico_ed%(171):REMark OUTD
=63:bytes%=nemónico_ed%(163):REMark OUTI
=71:bytes%=nemónico_ed%(187):REMark OTDR
=72:bytes%=nemónico_ed%(179):REMark OTIR
END SELect
ELSE
REMark el ensamblado está desactivado por IF
SELect ON pseudo_nemónico
=77:ensamblar%=NOT ensamblar%:REMark ELSE
bytes%=0
=78:ensamblar%=1:REMark ENDIF
bytes%=0
END SELect
END IF
END SELect
dir_org=dir_org+bytes%
ELSE
REMark nemónico no reconocido
lista_error -12:REMark nombre incorrecto
NEXT lee_línea
END IF
ELSE
REMark nemónico en blanco
IF parámetros$<>FILL$(" ",LEN(parámetros$))
lista_error -21:REMark línea incorrecta
NEXT lee_línea
END IF
END IF
END IF
END IF
IF NOT(hay_comando%):listar_dir_anterior%=0
END REPeat lee_línea
REMark se terminaron las líneas del fichero fuente
IF listar_fuente%
REMark Listar la última línea si acabamos la segunda pasada
IF NOT(pasada):lista_línea_anterior
END IF
REMark Volver al fichero principal, si es preciso
IF ensamblando_módulo%
REMark estábamos ensamblando un módulo
CLOSE#fichero_fuente%
OPEN_IN#fichero_fuente%,fichero_fuente$
SET_POSITION#fichero_fuente%,posición_fuente
núm_líneas_mód%=núm_líneas_fuente%:REMark recuperar líneas...
REMark ...del fichero fuente principal, guardadas en comando_fichero%
módulo_fuente$=fichero_fuente$
ensamblando_módulo%=0
escribe_nombre_fichero
NEXT ensambla_módulo
END IF
EXIT ensambla_módulo
END REPeat ensambla_módulo
REMark Inicializar variables para listado en la segunda pasada
listar_dir_anterior%=0
código_objeto$=""
bytes_listados%=0
línea_anterior$=""
IF núm_errores%:EXIT ensambla
END FOR pasada
EXIT ensambla
END REPeat ensambla
REMark Final
BEEP 2500,10
borra_ventana
IF abierto_fichero_fuente%:CLOSE#fichero_fuente%
IF dir_zona_etiquetas:RECHP dir_zona_etiquetas
IF núm_errores%
SELect ON lengua
=1:texto$="error":plural$="es":texto2$="en la pasada"
=2:texto$="eraro":plural$="j":texto2$="en pasxo"
=3:texto$="error":plural$="s":texto2$="in pass"
END SELect
IF núm_errores%=1:plural$=""
PRINT#dis_errores%,\núm_errores%!texto$;plural$!texto2$!2-pasada
CLOSE#fichero_objeto%
ELSE
REMark no hubo error alguno
IF ensamblado%
REMark el ensamblado se realizó
IF fichero_objeto_Spectrum%
REMark Rellenar cabecera del fichero
h_bytes=INT(bytes_objeto/256)
l_bytes=bytes_objeto-256*h_bytes
BPUT#fichero_objeto%\1,l_bytes,h_bytes:REMark número de bytes
h_org=INT(org_inicial/256)
l_org=org_inicial-256*h_org
BPUT#fichero_objeto%\3,l_org,h_org:REMark dirección destino
END IF
CLOSE#fichero_objeto%
REMark Mostrar resultados
SELect ON lengua
=1:texto$="Etiquetas":texto2$="Líneas"
=2:texto$="Etikedoj":texto2$="Linioj"
=3:texto$="Labels":texto2$="Lines"
END SELect
PRINT#ventana%,!texto$;"=";núm_etiquetas%;
PRINT#ventana%,!texto2$;"=";núm_líneas%;
segundos=DATE-tiempo_inicio
IF segundos
SELect ON lengua
=1:texto$="Líneas/minuto":texto2$="Minutos"
=2:texto$="Linioj/minuto":texto2$="Minutoj"
=3:texto$="Lines/minute":texto2$="Minutes"
END SELect
PRINT#ventana%,!texto$;"=";60*(núm_líneas% DIV segundos);
PRINT#ventana%;!texto2$;"=";segundos DIV 60;",";segundos MOD 60
END IF
IF listado_etiquetas%
SELect ON lengua
=1:texto$="Listando etiquetas"
=2:texto$="Listante etikedojn"
=3:texto$="Listing labels"
END SELect
AT#ventana%,0,55
PRINT#ventana%,texto$;"...";
CLS#ventana%,4
PRINT#dis_listado%,\
FOR n_=0 TO núm_etiquetas%-1
dir_etiqueta=dir_zona_etiquetas+8*n_
valor_etiqueta=256*PEEK(dir_etiqueta+6)+PEEK(dir_etiqueta+7)
PRINT#dis_listado%,PEEK$(dir_etiqueta,6);
PRINT_USING#dis_listado%,"######",valor_etiqueta;
PRINT#dis_listado%,!HEX$(valor_etiqueta,16);" ";
IF (n_&&3)=3:PRINT#dis_listado%
END FOR n_
PRINT#dis_listado%
AT#ventana%,0,55
CLS#ventana%,4
END IF
pausa
END IF
END IF
IF abierto_dis_listado%:CLOSE#dis_listado%
CLOSE#dis_errores%
END REPeat bucle_principal
:
REMark Procedimientos y funciones auxiliares ------------------------
:
DEFine PROCedure lista_error(núm_error%)
SELect ON lengua
=1,3:texto$="ERROR"
=2:texto$="ERARO"
END SELect
PRINT#dis_errores%,\texto$;
lista_mensaje núm_error%
núm_errores%=núm_errores%+1
END DEFine lista_error
:
DEFine PROCedure lista_aviso(núm_error%)
SELect ON lengua
=1:texto$="AVISO"
=2:texto$="AVERTO"
=3:texto$="WARNING"
END SELect
PRINT#dis_errores%,\texto$;
lista_mensaje núm_error%
END DEFine lista_aviso
:
DEFine PROCedure lista_mensaje(núm_error%)
SELect ON lengua
=1:texto$="en la línea":texto2$="del módulo"
=2:texto$="en linio":texto2$="de modjulo"
=3:texto$="in the line":texto2$="of the module"
END SELect
PRINT#dis_errores%,!texto$!núm_líneas_mód%!texto2$!módulo_fuente$
PRINT#dis_errores%,línea_original$
PRINT#dis_errores%,error_en_lengua$(núm_error%)
END DEFine lista_mensaje
:
DEFine PROCedure muestra_error(núm_error%)
REMark Muestra error, no de ensamblado, en la ventana
borra_ventana
PRINT#ventana%," ";error_en_lengua$(núm_error%)
pausa
END DEFine lista_error
:
DEFine FuNction error_en_lengua$(núm_error%)
LOCal núm_error
núm_error=ABS(núm_error%)
SELect ON lengua
=1
SELect ON núm_error
=1:texto$="No finalizado"
=2:texto$="Tarea inválida"
=3:texto$="Sin memoria"
=4:texto$="Fuera de rango"
=5:texto$="Búfer lleno"
=6:texto$="Canal no abierto"
=7:texto$="No encontrado"
=8:texto$="Ya existe"
=9:texto$="En uso"
=10:texto$="Fin de fichero"
=11:texto$="Disco/Cartucho lleno"
=12:texto$="Nombre incorrecto"
=13:texto$="Error de transmisión"
=14:texto$="Fallo en inicialización"
=15:texto$="Parámetro incorrecto"
=16:texto$="Medio incorrecto"
=17:texto$="Expresión errónea"
=18:texto$="Desbordamiento"
=19:texto$="No implementado"
=20:texto$="Sólo lectura"
=21:texto$="Línea incorrecta"
=REMAINDER :texto$="Error "&núm_error
END SELect
=2
SELect ON núm_error
=1:texto$="Ne finita"
=2:texto$="Nevalida tasko"
=3:texto$="Sen memoro"
=4:texto$="Preter rango"
=5:texto$="Bufro plena"
=6:texto$="Kanalo ne malfermita"
=7:texto$="Ne trovita"
=8:texto$="Jam ekzistas"
=9:texto$="Uzata"
=10:texto$="Fino de dosiero"
=11:texto$="Plena disko aux bendo"
=12:texto$="Erara nomo"
=13:texto$="Elsendad-eraro"
=14:texto$="Malsukceso dum formatado"
=15:texto$="Erara parametro"
=16:texto$="Disko aux bendo difektita"
=17:texto$="Erara esprimo"
=18:texto$="Preterrangigxo"
=19:texto$="Ankoraux ne estigita"
=20:texto$="Nur legebla"
=21:texto$="Erara linio"
=REMAINDER :texto$="Eraro "&núm_error
END SELect
=3
SELect ON núm_error
=1:texto$="Not complete"
=2:texto$="Invalid job"
=3:texto$="Out of memory"
=4:texto$="Out of range"
=5:texto$="Buffer full"
=6:texto$="Channel not found"
=7:texto$="Not found"
=8:texto$="Already exists"
=9:texto$="In use"
=10:texto$="End of file"
=11:texto$="Drive full"
=12:texto$="Bad name"
=13:texto$="Xmit error"
=14:texto$="Format failed"
=15:texto$="Bad parameter"
=16:texto$="Bad medium"
=17:texto$="Error in expression"
=18:texto$="Overflow"
=19:texto$="Not implemented (yet)"
=20:texto$="Read only"
=21:texto$="Bad line"
=REMAINDER :texto$="Error "&núm_error
END SELect
END SELect
RETurn texto$
END DEFine error_en_lengua$
:
DEFine PROCedure pausa
AT#ventana%,0,81
CURSEN#ventana%
letra$=INKEY$(#ventana%,-1)
CURDIS#ventana%
END DEFine pausa
:
DEFine PROCedure abre_ventanas
OPEN#ventana%,con_504x14a4x0
PAPER#ventana%,0
INK#ventana%,7
borra_ventana
PRINT#ventana%," QL80 0.40 (k) 1992 far Marcos Cruz"
END DEFine ventanas
:
DEFine PROCedure borra_ventana
CLS#ventana%
BORDER#ventana%,2,7,0
END DEFine borra_ventana
:
DEFine PROCedure escribe_nombre_fichero
AT#ventana%,0,36
IF ensamblando_módulo%
PRINT#ventana%,módulo_fuente$
ELSE
PRINT#ventana%,fichero_fuente$
END IF
CLS#ventana%,4
END DEFine
:
DEFine PROCedure lista_línea_anterior
IF listar_línea_anterior%
REMark hay que listar la línea anterior
IF listar_dir_anterior%
REMark hay que listar la dirección de la línea anterior
PRINT_USING#dis_listado%,"#####",dir_org_anterior;
PRINT#dis_listado%," ";HEX$(dir_org_anterior,16);" ";
ELSE
REMark no hay que listar la dirección de la línea aterior
PRINT#dis_listado%," ";
END IF
PRINT#dis_listado%,código_objeto$;
PRINT#dis_listado%,FILL$(" ",9-2*bytes_listados%);línea_anterior$
ELSE
listar_línea_anterior%=1
END IF
END DEFine lista_línea_anterior
:
DEFine FuNction localiza_etiqueta%
REMark Entrada
REMark etiqueta$=etiqueta a localizar, al menos de 6 caracteres
REMark Local
REMark dir_etiquetas=dirección inicial de búsqueda
REMark lon_etiquetas=longitud de la zona de búsqueda
REMark dir_vale=cálculo intermedio
REMark Salida si se encuentra la etiqueta
REMark RETURN -8
REMark dir_etiqueta=dirección de la etiqueta en la zona
REMark Salida si no se encuentra la etiqueta
REMark RETURN -7
REMark dir_etiqueta=primera dirección libre en la zona
etiqueta$=etiqueta$(1 TO 6)
dir_etiquetas=dir_zona_etiquetas
lon_etiquetas=núm_etiquetas%*8+1
REPeat busca_etiqueta
dir_etiqueta=SEARCH_MEMORY(dir_etiquetas,lon_etiquetas,etiqueta$)
IF dir_etiqueta
IF (dir_etiqueta-dir_zona_etiquetas) MOD 8
dir_etiquetas=dir_etiqueta+1
lon_etiquetas=lon_etiquetas-dir_etiquetas+dir_zona_etiquetas
IF lon_etiquetas>7:NEXT busca_etiqueta
ELSE
RETurn -8:REMark ya existe
END IF
END IF
dir_etiqueta=dir_zona_etiquetas+núm_etiquetas%*8
RETurn -7:REMark no encontrado
END REPeat busca_etiqueta
END DEFine localiza_etiqueta%
:
DEFine FuNction descifrado$(texto_c$)
LOCal texto_d$(80)
texto_d$="":REMark texto descifrado
FOR n_=1 TO LEN(texto_c$)
texto_d$=texto_d$&CHR$(CODE(texto_c$(n_))^^255^^(LEN(texto_c$)-n_+1))
END FOR n_
RETurn texto_d$
END DEFine descifrado$
:
DEFine FuNction mayúsculas$(texto$)
LOCal ctexto
FOR n_=1 TO LEN(texto$)
ctexto=CODE(texto$(n_))
SELect ON ctexto
=97 TO 122:texto$(n_)=CHR$(CODE(texto$(n_))-32)
=137:texto$(n_)="Ñ"
=135:texto$(n_)="Ü"
END SELect
END FOR n_
RETurn texto$
END DEFine mayúsculas$
:
REMark Comandos del ensamblador -------------------------------------
:
DEFine FuNction comando_listado%(p_flag):REMark *L+ y *L-
IF NOT(pasada)
REMark segunda pasada
IF listado_fuente%
listar_fuente%=p_flag:listar_dir_anterior%=0
END IF
listar_línea_anterior%=0
END IF
RETurn 0
END DEFine comando_listado%
:
DEFine FuNction comando_if%:REMark IF
IF es_exp_sin_paréntesis%(0)
ensamblar%=valor_exp(0)&&1
ELSE
lista_error -15:REMark parámetro incorrectro
END IF
RETurn 0
END DEFine comando_if%
:
REMark Pseudonemónicos ----------------------------------------------
:
DEFine FuNction defb%:REMark DEFB
IF NOT(pasada)
REMark segunda pasada
FOR n_=0 TO núm_par-1
IF es_exp_sin_paréntesis%(n_)
byte=valor_exp(n_)
IF vale_byte%
pokea byte
ELSE
lista_error -4:REMark fuera de rango
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END FOR n_
END IF
RETurn núm_par
END DEFine defb%
:
DEFine FuNction defs%:REMark DEFS
IF pasada
IF es_exp_sin_paréntesis%(0)
valor=valor_exp(0)
IF dir_org+valor<65536:RETurn valor
lista_error -4:REMark fuera de rango
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
RETurn 0
END IF
valor=valor_exp(0)
IF fichero_objeto%:FOR byte=1 TO valor:pokea 0:REMark rellenar
RETurn valor
END DEFine defs%
:
DEFine FuNction defw%:REMark DEFW
IF NOT(pasada)
REMark segunda pasada
FOR n_=0 TO núm_par-1
IF es_exp_sin_paréntesis%(n_)
pokeaw valor_exp(n_)
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END FOR n_
END IF
RETurn 2*núm_par
END DEFine defw%
:
DEFine FuNction equ%:REMark EQU
IF pasada
REMark primera pasada
IF hay_etiqueta%
IF hay_pendiente%:
lista_error -7:REMark no encontrado
ELSE
IF es_exp_sin_paréntesis%(0)
POKE_W dir_etiqueta_nueva+6,valor_exp(0)
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
ELSE
lista_error -21:REMark línea incorrecta
END IF
ELSE
IF listado_fuente%:dir_org_anterior=valor_exp(0)
END IF
RETurn 0
END DEFine equ%
:
DEFine FuNction org%:REMark ORG
IF pasada
REMark primera pasada
IF es_exp_sin_paréntesis%(0)
IF dir_org=org_inicial:org_inicial=valor_exp(0)
dir_org=valor_exp(0)
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
ELSE
valor=valor_exp(0)
IF fichero_objeto%:FOR byte=1 TO valor-dir_org:pokea 0
dir_org=valor
END IF
RETurn 0
END DEFine org%
:
REMark Nemónicos multiuso -------------------------------------------
:
DEFine FuNction adc_sbc%(p_opcode%):REMark ADC y SBC
REMark Nemónico p_opcode%
REMark -------- ---------
REMark ADC 0
REMark SBC 16
registro1=identificador_par%(0)
IF pasada
REMark primera pasada
IF registro1=1:RETurn logicarit%(0,1):REMark ADC/SBC A,?
RETurn 2:REMark ADC/SBC HL,rr
END IF
REMark segunda pasada
SELect ON registro1
=1:RETurn logicarit%(134+p_opcode%,1):REMark ADD/SBC A,?
=15
REMark ADC/SBC HL,rr
p_opcode%=74-p_opcode%/2
registro2=identificador_par%(1)
SELect ON registro2
=13:pokea_ed p_opcode% :RETurn 2:REMark ADC/SBC HL,BC
=14:pokea_ed p_opcode%+16:RETurn 2:REMark ADC/SBC HL,DE
=15:pokea_ed p_opcode%+32:RETurn 2:REMark ADC/SBC HL,HL
=16:pokea_ed p_opcode%+48:RETurn 2:REMark ADC/SBC HL,SP
END SELect
END SELect
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine adc_sbc%
:
DEFine FuNction bits%(p_opcode%):REMark BIT, SET y RES
REMark Nemónico p_opcode%
REMark -------- ---------
REMark BIT 62
REMark SET 126
REMark RES 190
IF pasada
REMark primera pasada
IF núm_par=3:RETurn 4:REMark BIT b,(Ir+n)
RETurn 2:REMark BIT b,r/(HL)
END IF
REMark segunda pasada
IF es_exp_sin_paréntesis%(0)
bit=valor_exp(0)
IF bit>7
lista_error -4:REMark fuera de rango
bit=0
END IF
registro2=identificador_par%(1)
SELect ON núm_par
=2
REMark BIT b,r/(HL)
IF entre_A_y_HL%(1)
pokea_cb p_opcode%+valor_par%(1)+8*bit
RETurn 2
END IF
=3
REMark BIT b,(Ir+n)
desplazamiento=valor_exp(2)
IF vale_desplazamiento%
SELect ON registro2
=9 :pokea 221:REMark (IX)
=11:pokea 253:REMark (IY)
END SELect
pokea_cb desplazamiento
pokea p_opcode%+8*(bit+1)
RETurn 4
END IF
END SELect
END IF
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine bits%
:
DEFine FuNction giros%(p_opcode%)
REMark Nemónico p_opcode%
REMark -------- ---------
REMark RLC -2
REMark RRC 6
REMark RL 14
REMark RR 22
REMark SLA 30
REMark SRA 38
REMark SRL 54
IF pasada:RETurn 2*núm_par:REMark primera pasada
REMark segunda pasada
registro1=identificador_par%(0)
SELect ON núm_par
=1
REMark GIRO r
IF entre_A_y_HL%(0)
pokea_cb p_opcode%+valor_par%(0)
RETurn 2
END IF
=2
REMark GIRO (Ir+n)
desplazamiento=valor_exp(1)
IF vale_desplazamiento%
SELect ON registro1
=9 :pokea 221:REMark (IX)
=11:pokea 253:REMark (IY)
END SELect
pokea_cb desplazamiento
pokea p_opcode%+8
RETurn 4
END IF
lista_error -4:REMark fuera de rango
=REMAINDER
lista_error -15:REMark parámetro incorrecto
END SELect
RETurn 0
END DEFine giros%
:
DEFine FuNction inc_dec%(p_opcode%)
REMark Nemónico p_opcode%
REMark -------- ---------
REMark INC 0
REMark DEC 1
IF pasada
REMark primera pasada
IF núm_par=2:RETurn 3:REMark INC/DEC (Ir+n)
registro1=identificador_par%(0)
SELect ON registro1
=17:RETurn 2:REMark IX
=18:RETurn 2:REMark IY
END SELect
RETurn 1:REMark INC/DEC rr/r
END IF
REMark segunda pasada
SELect ON núm_par
=1
IF entre_A_y_HL%(0)
REMark INC/DEC r
pokea 4+p_opcode%+8*(valor_par%(0)-2)
RETurn 1
END IF
REMark INC/DEC rr
registro1=identificador_par%(0)
SELect ON registro1
=13 TO 16
REMark INC/DEC BC/DE/HL/SP
pokea 3+8*p_opcode%+16*valor_par%(0)
RETurn 1
=17
REMark INC/DEC IX
pokea_dd 3+8*p_opcode%+16*valor_par%(0)
RETurn 2
=18
REMark INC/DEC IY
pokea_fd 3+8*p_opcode%+16*valor_par%(0)
RETurn 2
END SELect
=2
REMark INC/DEC (Ir+n)
desplazamiento=valor_exp(1)
IF vale_desplazamiento%
registro1=identificador_par%(0)
SELect ON registro1
=9 :pokea_dd 52+p_opcode%:REMark (IX)
=11:pokea_fd 52+p_opcode%:REMark (IY)
END SELect
pokea desplazamiento
RETurn 3
END IF
lista_error -4:REMark fuera de rango
=REMAINDER
lista_error -15:REMark parámetro incorrecto
END SELect
RETurn 0
END DEFine inc_dec%
:
DEFine FuNction logicarit%(p_opcode%,p_par1%)
REMark Nemónico p_opcode%,p_par1%
REMark -------- -----------------
REMark ADD A, 126,1
REMark ADC A, 134,1
REMark SUB 142,0
REMark SBC A, 150,1
REMark AND 158,0
REMark XOR 166,0
REMark CP 182,0
IF pasada
REMark primera pasada
IF núm_par=2+p_par1%:RETurn 3:REMark NEMO-A (Ir+n)
IF es_exp_sin_paréntesis%(p_par1%):RETurn 2:REMark NEMO-A n
RETurn 1:REMark NEMO-A r/(HL)
END IF
REMark segunda pasada
SELect ON núm_par
=1+p_par1%
REMark NEMO-A r/(HL)/n
IF es_exp_sin_paréntesis%(p_par1%)
REMark NEMO-A n
byte=valor_exp(p_par1%)
IF vale_byte%
pokea p_opcode%+72
pokea byte
RETurn 2
END IF
lista_error -4:REMark fuera de rango
ELSE
IF entre_A_y_HL%(p_par1%)
REMark NEMO-A r/(HL)
pokea p_opcode%+valor_par%(p_par1%)
RETurn 1
END IF
END IF
=2+p_par1%
REMark NEMO-A (Ir+n)
desplazamiento=valor_exp(1+p_par1%)
IF vale_desplazamiento%
registro1=identificador_par%(p_par1%)
SELect ON registro1
=9 :pokea_dd p_opcode%+8:REMark (IX)
=11:pokea_fd p_opcode%+8:REMark (IY)
END SELect
pokea desplazamiento
RETurn 3
END IF
lista_error -4:REMark fuera de rango
=REMAINDER
lista_error -15:REMark parámetro incorrecto
END SELect
RETurn 0
END DEFine logicarit%
:
DEFine FuNction nemónico1%(p_opcode%)
IF pasada:RETurn 1:REMark primera pasada
REMark segunda pasada
pokea p_opcode%
RETurn 1
END DEFine nemónico1%
:
DEFine FuNction nemónico_ed%(p_opcode%)
IF pasada:RETurn 2:REMark primera pasada
REMark segunda pasada
pokea_ed p_opcode%
RETurn 2
END DEFine nemónico_ed%
:
DEFine FuNction push_pop%(p_opcode%)
REMark Nemónico p_opcode%
REMark -------- ---------
REMark POP 0
REMark PUSH 4
registro1=identificador_par%(0)
IF pasada
REMark primera pasada
IF núm_par<>1:lista_error -15:REMark parámetro incorrecto
IF registro1=17 OR registro1=18:RETurn 2:REMark PUSH/POP IX/IY
RETurn 1:REMark PUSH/POP rr
END IF
REMark segunda pasada
SELect ON registro1
=22:pokea 241+p_opcode%:RETurn 1:REMark AF
=13:pokea 193+p_opcode%:RETurn 1:REMark BC
=14:pokea 209+p_opcode%:RETurn 1:REMark DE
=15:pokea 225+p_opcode%:RETurn 1:REMark HL
=17:pokea_dd 225+p_opcode%:RETurn 2:REMark IX
=18:pokea_fd 225+p_opcode%:RETurn 2:REMark IY
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
RETurn 0
END DEFine push_pop%
:
REMark Nemónicos concretos -----------------------------------------
:
DEFine FuNction add%:REMark ADD
registro1=identificador_par%(0)
IF pasada
REMark primera pasada
IF registro1=1:RETurn logicarit%(126,1):REMark ADD A,?
IF núm_par<>2
lista_error -15:REMark parámetro incorrecto
RETurn 0
END IF
IF registro1=15:RETurn 1:REMark ADD HL,rr
RETurn 2:REMark ADD Ir,nn
END IF
REMark segunda pasada
SELect ON registro1
=1:RETurn logicarit%(126,1):REMark ADD A,?
=15
REMark ADD HL,rr
registro2=identificador_par%(1)
SELect ON registro2
=13:pokea 9 :RETurn 1:REMark ADD HL,BC
=14:pokea 25:RETurn 1:REMark ADD HL,DE
=15:pokea 41:RETurn 1:REMark ADD HL,HL
=16:pokea 57:RETurn 1:REMark ADD HL,SP
END SELect
=17,18
REMark ADD IX/IY,rr
SELect ON registro1
=17:pokea 221:REMark ADD IX,rr
=18:pokea 253:REMark ADD IY,rr
END SELect
registro2=identificador_par%(1)
SELect ON registro2
=13:pokea 9 :RETurn 2:REMark ADD IX/IY,BC
=14:pokea 25:RETurn 2:REMark ADD IX/IY,DE
=17:IF registro1=17:pokea 41:RETurn 2:REMark ADD IX,IX
=18:IF registro1=18:pokea 41:RETurn 2:REMark ADD IY,IY
=16:pokea 57:RETurn 2:REMark ADD IX/IY,SP
END SELect
END SELect
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine add%
:
DEFine FuNction call%:REMark CALL
IF pasada:RETurn 3:REMark primera pasada
REMark segunda pasada
SELect ON núm_par
=1
REMark CALL nn
IF es_exp_sin_paréntesis%(0)
pokea 205
pokeaw valor_exp(0)
RETurn 3
END IF
=2
REMark CALL cc,nn
IF es_condición%(0)
IF es_exp_sin_paréntesis%(1)
pokea 196+8*valor_par%(0)
pokeaw valor_exp(1)
RETurn 3
END IF
END IF
END SELect
lista_error -15:REMark parámetro incorrecto
RETurn 3
END DEFine call%
:
DEFine FuNction djnz%:REMark DJNZ
IF pasada
REMark primera pasada
IF núm_par<>1:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
IF es_exp_sin_paréntesis%(0)
desplazamiento=valor_exp(0)-dir_org-2
IF vale_desplazamiento%
pokea 16
pokea desplazamiento
ELSE
lista_error -4:REMark fuera de rango
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
RETurn 2
END DEFine djnz%
:
DEFine FuNction ex%:REMark EX
registro2=identificador_par%(1)
IF pasada
REMark primera pasada
IF núm_par=2
IF registro2=17 OR registro2=18:RETurn 2:REMark EX ?,IX/IY
RETurn 1:REMark EX ?,?
END IF
ELSE
REMark segunda pasada
registro1=identificador_par%(0)
SELect ON registro1
=14
REMark EX DE,?
IF registro2=15:pokea 235:RETurn 1:REMark EX DE,HL
=22
REMark EX AF,?
IF registro2=23:pokea 8:RETurn 1:REMark EX AF,AF'
=19
REMark EX (SP),?
SELect ON registro2
=15:pokea 227:RETurn 1:REMark EX (SP),HL
=17:pokea_dd 227:RETurn 2:REMark EX (SP),IX
=18:pokea_fd 227:RETurn 2:REMark EX (SP),IY
END SELect
END SELect
END IF
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine ex%
:
DEFine FuNction im%:REMark IM
IF pasada
REMark primera pasada
IF núm_par<>1:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
IF es_exp_sin_paréntesis%(0)
valor=valor_exp(0)
SELect ON valor
=2:pokea_ed 94
=0:pokea_ed 70
=1:pokea_ed 86
=REMAINDER :lista_error -4:REMark fuera de rango
END SELect
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
RETurn 2
END DEFine im%
:
DEFine FuNction in%:REMark IN
IF pasada
REMark primera pasada
IF núm_par<>1:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
IF entre_A_y_L%(0)
REMark IN r,?
IF NOT(identificador_par%(1))
REMark IN r,(C)
pokea_ed 64+8*(valor_par%(0)-2)
ELSE
IF es_exp_con_paréntesis%(1)
REMark IN r,(n)
IF identificador_par%(0)=1
REMark IN A,(n)
byte=valor_exp(1)
IF vale_byte%
pokea 219
pokea byte
ELSE
lista_error -4:REMark fuera de rango
END IF
END IF
END IF
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
RETurn 2
END DEFine in%
:
DEFine FuNction jp%:REMark JP
IF pasada
REMark primera pasada
IF núm_par=2:RETurn 3:REMark JP cc,nn
IF es_exp_sin_paréntesis%(0):RETurn 3:REMark JP nn
IF identificador_par%(0)=8:RETurn 1:REMark JP (HL)
RETurn 2:REMark JP (IX)/(IY)
END IF
REMark segunda pasada
SELect ON núm_par
=1
IF es_exp_sin_paréntesis%(0)
REMark JP nn
pokea 195
pokeaw valor_exp(0)
RETurn 3
END IF
IF es_tipo%(0,17)
REMark JP (rr)
registro1=identificador_par%(0)
SELect ON registro1
=8 :pokea 233 :RETurn 1:REMark JP (HL)
=9 :pokea_dd 233:RETurn 2:REMark JP (IX)
=11:pokea_fd 233:RETurn 2:REMark JP (IY)
END SELect
END IF
=2
REMark ¿JP cc,nn?
IF es_condición%(0)
IF es_exp_sin_paréntesis%(1)
pokea 194+8*valor_par%(0)
pokeaw valor_exp(1)
RETurn 3
END IF
END IF
END SELect
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine jp%
:
DEFine FuNction jr%:REMark JR
IF NOT(pasada)
REMark segunda pasada
SELect ON núm_par
=1
IF es_exp_sin_paréntesis%(0)
REMark JR nn
desplazamiento=valor_exp(0)-dir_org-2
IF vale_desplazamiento%
pokea 24
pokea desplazamiento
ELSE
lista_error -4:REMark fuera de rango
END IF
END IF
=2
IF es_condición%(0)
REMark JR cc,nn
IF es_exp_sin_paréntesis%(1)
valor%=valor_par%(0)
IF valor%<4
desplazamiento=valor_exp(1)-dir_org-2
IF vale_desplazamiento%
pokea 32+8*valor%
pokea desplazamiento
ELSE
lista_error -4:REMark fuera de rango
END IF
END IF
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END SELect
END IF
RETurn 2
END DEFine jr%
:
DEFine FuNction ld%:REMark LD
IF pasada
REMark primera pasada
IF núm_par=3
IF es_exp_sin_paréntesis%(2):RETurn 4:REMark LD (Ir+n),n
RETurn 3:REMark LD r,(Ir+n)/(Ir+n),r
END IF
IF núm_par<>2
lista_error -15:REMark parámetro incorrecto
RETurn 0
END IF
tipo1=tipo_par%(0)&&153
SELect ON tipo1
=8
REMark LD r,?
IF entre_A_y_L%(0)
IF identificador_par%(0)=1
REMark LD A,?
IF es_exp_con_paréntesis%(1):RETurn 3:REMark LD A,(nn)
registro2=identificador_par%(1)
SELect ON registro2
=20,21:RETurn 1:REMark LD A,(BC)/(DE)
=10,12:RETurn 2:REMark LD A,I/R
END SELect
END IF
IF es_exp_sin_paréntesis%(1):RETurn 2:REMark LD r,n
RETurn 1:REMark LD r,r
END IF
RETurn 2:REMark LD I/R,A
=16
REMark LD rr,?
IF es_exp_sin_paréntesis%(1)
REMark LD rr,nn
registro1=identificador_par%(0)
SELect ON registro1=17,18:RETurn 4:REMark LD IX/IY,nn
RETurn 3
END IF
IF es_exp_con_paréntesis%(1)
REMark LD rr,(nn)
IF identificador_par%(0)=15:RETurn 3:REMark LD HL,(nn)
RETurn 4
END IF
REMark LD SP,?
IF identificador_par%(1)=15:RETurn 1:REMark LD SP,HL
REMark LD SP,IX/IY
RETurn 2
=129
REMark LD (nn),?
registro2=identificador_par%(1)
SELect ON registro2=1,15:RETurn 3:REMark LD (nn),A/HL
RETurn 4
=17
REMark LD (rr),?
IF es_exp_sin_paréntesis%(1):RETurn 2:REMark LD (HL),nn
RETurn 1
=REMAINDER
lista_error -15:REMark parámetro incorrecto
RETurn 0
END SELect
END IF
REMark segunda pasada
registro1=identificador_par%(0)
IF núm_par=3
REMark carga con registros índices
IF es_exp_sin_paréntesis%(2)
REMark LD (Ir+n),n
desplazamiento=valor_exp(1)
IF vale_desplazamiento%
byte=valor_exp(2)
IF vale_byte%
SELect ON registro1
=9 :pokea_dd 54:REMark (IX)
=11:pokea_fd 54:REMark (IY)
END SELect
pokea desplazamiento
pokea byte
END IF
ELSE
lista_error -4:REMark fuera de rango
END IF
RETurn 4
ELSE
IF entre_A_y_L%(2)
REMark LD (Ir+n),r
desplazamiento=valor_exp(1)
IF vale_desplazamiento%
SELect ON registro1
=9 :pokea 221:REMark (IX)
=11:pokea 253:REMark (IY)
END SELect
pokea 110+valor_par%(2)
pokea desplazamiento
ELSE
lista_error -4:REMark fuera de rango
END IF
RETurn 3
END IF
IF entre_A_y_L%(0)
REMark LD r,(Ir+n)
desplazamiento=valor_exp(2)
IF vale_desplazamiento%
registro2=identificador_par%(1)
SELect ON registro2
=9 :pokea 221:REMark (IX)
=11:pokea 253:REMark (IY)
END SELect
pokea 70+(valor_par%(0)-2)*8
pokea desplazamiento
ELSE
lista_error -4:REMark fuera de rango
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
RETurn 3
END IF
END IF
tipo1=tipo_par%(0)&&153
SELect ON tipo1
=8
REMark LD r,?
registro2=identificador_par%(1)
IF entre_A_y_L%(0)
IF registro1=1
REMark LD A,?
IF es_exp_con_paréntesis%(1)
REMark LD A,(nn)
pokea 58
pokeaw valor_exp(1)
RETurn 3
END IF
SELect ON registro2
=20:pokea 10:RETurn 1:REMark LD A,(BC)
=21:pokea 26:RETurn 1:REMark LD A,(DE)
=12:pokea_ed 95:RETurn 2:REMark LD A,R
=10:pokea_ed 87:RETurn 2:REMark LD A,I
END SELect
END IF
IF es_exp_sin_paréntesis%(1)
REMark LD r,n
byte=valor_exp(1)
IF vale_byte%
pokea 6+(valor_par%(0)-2)*8
pokea byte
ELSE
lista_error -4:REMark fuera de rango
END IF
RETurn 2
END IF
REMark LD r,?
IF registro2=8
REMark LD r,(HL)
pokea 70+(valor_par%(0)-2)*8
RETurn 1
END IF
IF entre_A_y_L%(1)
REMark LD r,r
pokea 64+(valor_par%(0)-2)*8+valor_par%(1)-2
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
RETurn 1
END IF
REMark ¿ LD I/R,A ?
IF registro2=1
REMark LD ?,A
SELect ON registro1
=10:pokea_ed 71:REMark LD I,A
=12:pokea_ed 79:REMark LD R,A
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
END IF
RETurn 2
=16
REMark LD rr,?
IF es_exp_sin_paréntesis%(1)
REMark LD rr,nn
registro1=identificador_par%(0)
SELect ON registro1
=15:pokea 33 :REMark LD HL,nn
=14:pokea 17 :REMark LD DE,nn
=13:pokea 1 :REMark LD BC,nn
=17
REMark LD IX,nn
pokea_dd 33
pokeaw valor_exp(1)
RETurn 4
=18
REMark LD IY,nn
pokea_fd 33
pokeaw valor_exp(1)
RETurn 4
=16:pokea 49 :REMark LD SP,nn
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
pokeaw valor_exp(1)
RETurn 3
END IF
IF es_exp_con_paréntesis%(1)
REMark LD rr,(nn)
registro1=identificador_par%(0)
SELect ON registro1
=15
REMark LD HL,(nn)
pokea 42
pokeaw valor_exp(1)
RETurn 3
=14:pokea_ed 91 :REMark LD DE,(nn)
=13:pokea_ed 75 :REMark LD BC,(nn)
=17:pokea_dd 42 :REMark LD IX,(nn)
=18:pokea_fd 42 :REMark LD IY,(nn)
=16:pokea_ed 123:REMark LD SP,(nn)
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
pokeaw valor_exp(1)
RETurn 4
END IF
IF registro1=16
REMark LD SP,?
registro2=identificador_par%(1)
SELect ON registro2
=15:pokea 249 :RETurn 1:REMark LD SP,HL
=17:pokea_dd 249:REMark LD SP,IX
=18:pokea_fd 249:REMark LD SP,IY
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
END IF
RETurn 2
=129
REMark LD (nn),?
dirección=valor_exp(0)
registro2=identificador_par%(1)
SELect ON registro2
=1
REMark LD (nn),A
pokea 50
pokeaw dirección
RETurn 3
=15
REMark LD (nn),HL
pokea 34
pokeaw dirección
RETurn 3
=14:pokea_ed 83 :REMark LD (nn),DE
=13:pokea_ed 67 :REMark LD (nn),BC
=17:pokea_dd 34 :REMark LD (nn),IX
=18:pokea_fd 34 :REMark LD (nn),IY
=16:pokea_ed 115:REMark LD (nn),SP
=REMAINDER :lista_error -15:REMark parámetro incorrecto
END SELect
pokeaw dirección
RETurn 4
=17
REMark LD (rr),?
registro1=identificador_par%(0)
SELect ON registro1
=8
REMark LD (HL),?
IF es_exp_sin_paréntesis%(1)
REMark LD (HL),n
byte=valor_exp(1)
IF vale_byte%
pokea 54
pokea byte
ELSE
lista_error -4:REMark parámetro incorrecto
END IF
RETurn 2
END IF
IF entre_A_y_L%(1):pokea 110+valor_par%(1):RETurn 1:REMark LD (HL),r
=21
REMark LD (DE),?
IF identificador_par%(1)=1:pokea 18:RETurn 1:REMark LD (DE),A
=20
REMark LD (BC),?
IF identificador_par%(1)=1:pokea 2:RETurn 1:REMark LD (BC),A
END SELect
END SELect
lista_error -15:REMark parámetro incorrecto
RETurn 0
END DEFine ld%
:
DEFine FuNction out%:REMark OUT
IF pasada
REMark primera pasada
IF núm_par<>2:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
IF es_exp_con_paréntesis%(0)
REMark OUT (n),?
IF identificador_par%(1)=1
REMark OUT (n),A
byte=valor_exp(0)
IF vale_byte%
pokea 211
pokea byte
ELSE
lista_error -4:REMark fuera de rango
END IF
END IF
ELSE
REMark OUT ?
IF NOT(identificador_par%(0))
REMark OUT (C),?
IF entre_A_y_L%(1)
REMark OUT (C),A/B/C/D/E/H/L
pokea_ed 65+8*(valor_par%(1)-2)
END IF
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
END IF
RETurn 2
END DEFine out%
:
DEFine FuNction ret_%:REMark RET
IF pasada
REMark primera pasada
IF núm_par>1:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
SELect ON núm_par
=0:pokea 201:REMark RET
=1
IF es_condición%(0)
REMark RET cc
pokea 192+8*valor_par%(0)
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END SELect
END IF
RETurn 1
END DEFine ret_%
:
DEFine FuNction rst%:REMark RST
IF pasada
REMark primera pasada
IF núm_par<>1:lista_error -15:REMark parámetro incorrecto
ELSE
REMark segunda pasada
IF es_exp_sin_paréntesis%(0)
valor=valor_exp(0)
IF valor>56 OR valor MOD 8:lista_error -4:REMark fuera de rango
pokea 199+valor
ELSE
lista_error -15:REMark parámetro incorrecto
END IF
END IF
RETurn 1
END DEFine rst%
:
REMark Creación del código objeto ----------------------------------
:
DEFine PROCedure pokea_cb(p_byte)
pokea 203:REMark #CB
pokea p_byte
END DEFine
:
DEFine PROCedure pokea_dd(p_byte)
pokea 221:REMark #DD
pokea p_byte
END DEFine pokea_dd
:
DEFine PROCedure pokea_ed(p_byte)
pokea 237:REMark #ED
pokea p_byte
END DEFine pokea_ed
:
DEFine PROCedure pokea_fd(p_byte)
pokea 253:REMark #FD
pokea p_byte
END DEFine pokea_fd
:
DEFine PROCedure pokeaw(p_dir)
h_dir=INT(p_dir/256)
pokea p_dir-h_dir*256
pokea h_dir
END DEFine pokeaw
:
DEFine PROCedure pokea(p_byte)
PRINT#fichero_objeto%,CHR$(p_byte);
bytes_objeto=bytes_objeto+1
IF listar_fuente%
REMark Comprobar ancho del código
IF bytes_listados%<bytes_máx_listados%
código_objeto$=código_objeto$&HEX$(p_byte,8)
bytes_listados%=bytes_listados%+1
END IF
END IF
END DEFine pokea
:
REMark Funciones para comprobar rangos -----------------------------
:
DEFine FuNction vale_desplazamiento%
REMark Entrada
REMark desplazamiento
RETurn desplazamiento>-129 AND desplazamiento<128
END DEFine vale_desplazamiento%
:
DEFine FuNction vale_byte%
REMark Entrada
REMark byte
RETurn byte>65407 OR byte<256
END DEFine vale_byte%
:
DEFine FuNction entre_A_y_HL%(p_núm_par%)
identificador%=identificador_par%(p_núm_par%)
RETurn identificador%>0 AND identificador%<9
END DEFine entre_A_y_HL%
:
DEFine FuNction entre_A_y_L%(p_núm_par%)
identificador%=identificador_par%(p_núm_par%)
RETurn identificador%>0 AND identificador%<8
END DEFine entre_A_y_L%
:
REMark Funciones para comprobar pseudoparámetros -------------------
:
DEFine FuNction es_exp_sin_paréntesis%(p_núm_par%)
RETurn (tipo_par%(p_núm_par%)&&129)=128
END DEFine es_exp_sin_paréntesis%
:
DEFine FuNction es_exp_con_paréntesis%(p_núm_par%)
RETurn (tipo_par%(p_núm_par%)&&129)=129
END DEFine es_exp_con_paréntesis%
:
DEFine FuNction es_tipo%(p_par,p_tipo)
RETurn (tipo_par%(p_par)&&p_tipo)=p_tipo
END DEFine es_tipo%
:
DEFine FuNction es_condición%(p_núm_par%)
RETurn tipo_par%(p_núm_par%)&&2
END DEFine es_condición%
:
REMark Datas -------------------------------------------------------
:
REMark Comandos
REMark identificador,"nombre",parámetros mínimos,parámetros máximos
:
DATA 1,"LD",2,2
DATA 48,"CALL",1,2
DATA 52,"JR",1,2
DATA 65,"DEFM",1,1
DATA 66,"DEFB",1,30
DATA 67,"DEFW",1,30
DATA 50,"JP",1,2
DATA 19,"CP",1,1
DATA 74,"POP",1,1
DATA 73,"PUSH",1,1
DATA 15,"INC",1,1
DATA 51,"RET",0,1
DATA 18,"AND",1,1
DATA 45,"BIT",2,2
DATA 39,"EQU",1,1
DATA 0,"XOR",1,1
DATA 14,"DEC",1,1
DATA 13,"ADD",2,2
DATA 49,"DJNZ",1,1
DATA 3,"EXX",0,0
DATA 2,"EX",2,2
DATA 17,"SUB",1,1
DATA 7,"LDIR",0,0
DATA 44,"SRL",1,1
DATA 46,"RES",2,2
DATA 68,"DEFS",1,1
DATA 55,"RST",1,1
DATA 11,"CPIR",0,0
DATA 26,"HALT",0,0
DATA 27,"IM",1,1
DATA 20,"OR",1,1
DATA 29,"NOP",0,0
DATA 30,"SCF",0,0
DATA 36,"RR",1,1
DATA 64,"ORG",1,1
DATA 53,"RETI",0,0
DATA 47,"SET",2,2
DATA 24,"DI",0,0
DATA 25,"EI",0,0
DATA 4,"LDD",0,0
DATA 5,"LDDR",0,0
DATA 6,"LDI",0,0
DATA 8,"CPD",0,0
DATA 9,"CPDR",0,0
DATA 10,"CPI",0,0
DATA 12,"ADC",2,2
DATA 16,"SBC",2,2
DATA 21,"CCF",0,0
DATA 22,"CPL",0,0
DATA 23,"DAA",0,0
DATA 28,"NEG",0,0
DATA 31,"RL",1,1
DATA 32,"RLA",0,0
DATA 33,"RLC",1,1
DATA 34,"RLCA",0,0
DATA 35,"RLD",0,0
DATA 37,"RRA",0,0
DATA 38,"RRC",1,1
DATA 40,"RRCA",0,0
DATA 41,"RRD",0,0
DATA 42,"SLA",1,1
DATA 43,"SRA",1,1
DATA 54,"RETN",0,0
DATA 56,"IN",2,2
DATA 57,"IND",0,0
DATA 58,"INI",0,0
DATA 59,"INIR",0,0
DATA 60,"INDR",0,0
DATA 61,"OUT",2,2
DATA 62,"OUTD",0,0
DATA 63,"OUTI",0,0
DATA 69,"*L+",0,0
DATA 70,"*L-",0,0
DATA 71,"OTDR",0,0
DATA 72,"OTIR",0,0
DATA 75,"*F",1,1
DATA 76,"IF",1,1
DATA 77,"ELSE",0,0
DATA 78,"ENDIF",0,0
:
REMark Parámetros
REMark identificador,"nombre",tipo,valor
REMark Significado de los bits del identificador
REMark 0 ¿entre paréntesis? (tanto registros como expresiones)
REMark 1 ¿condición?
REMark 2
REMark 3 ¿registro de 8 bits?
REMark 4 ¿registro de 16 bits?
REMark 5
REMark 6
REMark 7 ¿expresión? (para las expresiones numéricas)
:
DATA 1,"A",8,9
DATA 15,"HL",16,2
DATA 24,"NZ",2,0
DATA 3,"C",10,3
DATA 25,"Z",2,1
DATA 13,"BC",16,0
DATA 2,"B",8,2
DATA 14,"DE",16,1
DATA 8,"(HL)",17,8
DATA 17,"IX",16,2
DATA 22,"AF",16,0
DATA 6,"H",8,6
DATA 21,"(DE)",17,1
DATA 5,"E",8,5
DATA 7,"L",8,7
DATA 26,"NC",2,2
DATA 4,"D",8,4
DATA 12,"R",8,0
DATA 19,"(SP)",17,0
DATA 10,"I",8,0
DATA 16,"SP",16,3
DATA 18,"IY",16,2
DATA 9,"(IX)",17,0
DATA 11,"(IY)",17,0
DATA 20,"(BC)",17,0
DATA 23,"AF'",16,0
DATA 0,"(C)",9,0
DATA 27,"PO",2,4
DATA 28,"PE",2,5
DATA 29,"P",2,6
DATA 30,"M",2,7
: