\ QUANTUM FORTH Z80 v2 \ Copyright (C) 1988 Marcos Cruz (programandala.net) \ Licencia/Permesilo/License: \ http://programandala.net/license \ http://programandala.net/es.programa.quantum_forth_z80.html \ 1988: Escrito para el Forth de Computer One de Sinclair QL. \ 2015-03-13: Convertido del formato de bloques original a fichero \ estándar. Textos y comentarios corregidos. Pequeños cambios de \ formato. \ Ejemplo de ensamblador \ 16384 ORG \ " QL" DEFM \ DI \ 23 # AA % 100101 DEFW \ B AND \ 3 A BIT \ EI \ 2 B RES \ 7 (IY+ 4 BIT \ 0 (IX+ -23 SET \ (IY+ 7 DEC \ 20 # FF DEFB \ THE_END \ HERRAMIENTAS ................................................. : TASK ; : .TIEMPO .DATE .TIME ; : GEMINI10X PRINTER 0 55 27 11 0 67 27 3 82 27 3 78 27 13 0 DO EMIT LOOP CONSOLE ; : LLIST ( P1,P2--) PRINTER .TIEMPO CR 1+ SWAP DO 16 0 DO I J DUP 0 <# # # # #> TYPE OVER 0 <# # # #> TYPE SPACE .LINE CR LOOP LOOP CR .TIEMPO CR CONSOLE ; \ MANEJO DE LA PILA ............................................ : DEPTH2/ DEPTH 2 / ; : VACIA_PILA S0 @ SP! ; : TEXTO->PILA DUP COUNT ROT + DO I C@ -1 +LOOP ; : GIRA_PILA PAD DEPTH2/ 1- 2DUP SWAP C! OVER + SWAP 1+ SWAP DO I C! -1 +LOOP PAD TEXTO->PILA ; \ MANEJO DE NÚMEROS DE 32 BITS ................................. : NUMERO BL WORD NUMBER ; : NUM NUMERO DROP DECIMAL ; \ VARIABLES Y CONSTANTES ....................................... VARIABLE DIR_ZX NUMERO 983040 2CONSTANT DIR0_QL \ BANDERAS ..................................................... : BANDERA CREATE 1 ALLOT DOES> ; BANDERA PASADA BANDERA LISTADO : PON-BANDERA SWAP C! ; : SI 1 PON-BANDERA ; : NO 0 PON-BANDERA ; \ FUNCIONES .................................................... : PASADA0? PASADA C@ 0= ; : LISTADO? LISTADO C@ ; : DIR_QL DIR0_QL DIR_ZX @ 0 D+ ; : $ DIR_ZX @ ; : 8* 8 * ; \ COMPRUEBA EN LA PASADA 0 ..................................... : COMPRUEBA 2DUP + DEPTH2/ 3 - 2DUP > 033 ?ERROR < 034 ?ERROR 2 * + DIR_ZX +! ; \ IMPRIMIR DIRECCIÓN Y CÓDIGO OBJETO ........................... : .DIR_ZX CR DIR_ZX @ DUP 0 <# # # # # # #> TYPE SPACE HEX 0 <# # # # # #> TYPE SPACE DECIMAL ; : .XX LISTADO? IF DUP HEX 0 <# # # #> TYPE DECIMAL ENDIF DIR_QL ; \ GUARDA EN LA PASADA 1 ........................................ : G, .XX C!L 1 DIR_ZX +! ; : G,, DUP 255 AND G, -8 ASHIFT 255 AND G, ; : GUARDA LISTADO? IF .DIR_ZX ENDIF SWAP >R DUP IF 0 DO G,, LOOP ELSE DROP ENDIF R> DUP IF 0 DO G, LOOP ENDIF ; \ OPCODE LISTO PARA GUARDAR .................................... : OPCODE PASADA0? IF COMPRUEBA ELSE GUARDA ENDIF VACIA_PILA ; : 20O 2 0 OPCODE ; : 21O 2 1 OPCODE ; : 30O 3 0 OPCODE ; : 40O 4 0 OPCODE ; \ ENSAMBLA/COMPILA ............................................. \ : COMPILA 2 LOAD ; \ obsoleto : ENSAMBLA 0 DIR_ZX ! PASADA NO CR ." QUANTUM FORTH Z80 por Marcos Cruz, 1988" CR ." Inicio ensamblado " .TIEMPO CR COMPILA ; \ CONTROL DE ETIQUETAS ......................................... : EQU PASADA0? IF CONSTANT ELSE DROP ENDIF ; : ? PASADA0? IF BL WORD ENDIF ; ( precede a las etiquetas) : ] $ EQU ; \ DIRECTIVAS TRANSPARENTES ..................................... : IDEFB DEPTH2/ 0 OPCODE ; : IDEFW DEPTH2/ 0 SWAP OPCODE ; : " 34 WORD TEXTO->PILA ; \ DIRECTIVAS DE ENSAMBLADOR .................................... : ORG $ - DUP 0< 38 ?ERROR DIR_ZX +! ; : DEFS DIR_ZX +! ; : DEFB GIRA_PILA IDEFB ; : DEFW GIRA_PILA IDEFW ; : DEFM IDEFB ; : THE_END PASADA0? IF ." Pasada 0 completa " .TIEMPO PASADA SI 0 DIR_ZX ! COMPILA ENDIF CR ." Pasada 1 completa " .TIEMPO CR CONSOLE DECIMAL QUIT ; \ COMANDOS DEL ENSAMBLADOR ..................................... : *S BEGIN ?TERMINAL UNTIL ; : *E CR CR CR ; : *H *E 34 WORD COUNT TYPE ; : *L+ LISTADO SI ; : *L- LISTADO NO ; \ OPERADORES Y SISTEMAS DE NUMERACIÓN .......................... : % BINARY NUM ; : # HEX NUM ; : && AND ; : || OR ; : XX XOR ; \ NEMÓNICOS TRANSPARENTES ...................................... : OO 1 0 OPCODE ; : OOXX 20O ; : JRXX SWAP $ 2+ - DUP 127 > 36 ?ERROR DUP -128 < 37 ?ERROR OOXX ; : OOXXXX 1 1 OPCODE ; : CBOO 203 20O ; : DDOO 221 20O ; : DDOOXX 221 30O ; : DDCBXXOO SWAP 203 221 40O ; : DDOOXXXX 221 21O ; : FDOO 253 20O ; : FDOOXX 253 30O ; : FDCBXXOO SWAP 203 253 40O ; : FDOOXXXX 253 21O ; : EDOO 237 20O ; : EDOOXXXX 237 21O ; \ REGISTROS SIMPLES ............................................ 256 CONSTANT B 257 CONSTANT C 258 CONSTANT D 259 CONSTANT E 260 CONSTANT H 261 CONSTANT L 262 CONSTANT (HL) 263 CONSTANT A 264 CONSTANT (IX+ 265 CONSTANT (IY+ 266 CONSTANT (IX) 267 CONSTANT (IY) : B- B - ; \ REGISTROS DOBLES ............................................. 268 CONSTANT AF 269 CONSTANT BC 270 CONSTANT DE 271 CONSTANT HL 272 CONSTANT SP 273 CONSTANT IX 274 CONSTANT IY 275 CONSTANT (C) : BC- BC - ; \ FLAGS ........................................................ 275 CONSTANT NZ 276 CONSTANT Z 277 CONSTANT NC 278 CONSTANT C 279 CONSTANT PO 280 CONSTANT PE 281 CONSTANT P 282 CONSTANT M : NZ- NZ - ; \ PROVOCAR ERRORES ............................................. : ERR_REGI 041 DUP ?ERROR ; : ERR_PIL 040 DUP ?ERROR ; : ?ERR_REG 0= 038 ?ERROR ; : ERR_REG 0 ?ERR_REG ; \ COMPROBAR RANGOS ............................................. : ENTRE? ( n,min,max--n,f) 2 PICK >= SWAP 2 PICK <= AND ; : A-(IY+? B (IY+ ENTRE? ; : A-L?ERR B A ENTRE? OVER (HL) <> AND ?ERR_REG ; : A-(HL)?ERR B A ENTRE? ?ERR_REG ; : BC-IY?ERR BC IY ENTRE? ?ERR_REG ; : HL-IY?ERR HL IY ENTRE? OVER SP <> AND ?ERR_REG ; : 0-7?ERR 0 7 ENTRE? NOT 39 ?ERROR ; : 8BITS? A-(IY+? IF 1 ELSE BC-IY?ERR 0 ENDIF ; : PORT?ERR 0 255 ENTRE? 044 ?ERROR ; \ ENTRADA/SALIDA ............................................... : IND 170 EDOO ; : INI 162 EDOO ; : INIR 172 EDOO ; : INDR 186 EDOO ; : OTDR 187 EDOO ; : OTIR 179 EDOO ; : OUTD 171 EDOO ; : OUTI 163 EDOO ; : IN DUP (C) = IF DROP A-L?ERR B- 8* 064 + EDOO ELSE SWAP A = ?ERR_REG 0 255 ENTRE? 43 ?ERROR 219 OOXX ENDIF ; : OUT IF ELSE SWAP A = IF PORT?ERR 211 211 OOXX ELSE ERR_REG ENDIF ENDIF ; \ GIROS/CAMBIOS ................................................ : CASE(RI+ CASE (IX+ OF DDCBXXOO ENDOF (IY+ OF FDCBXXOO ENDOF ERR_REGI ENDCASE ; : GIRO DEPTH2/ CASE 2 OF SWAP ( OPC_B,REG) A-(HL)?ERR B- ( OPC_B,NRE) + ( OPC_R) CBOO ENDOF 3 OF 6 + ( REG,DESP,OPC_R) ROT ( DESP,OPC_R,REG) CASE(RI+ ENDOF ERR_PIL ENDCASE ; : RL 016 GIRO ; : RLA 023 OO ; : RLC 000 GIRO ; : RLCA 007 OO ; : RLD 111 EDOO ; : RR 024 GIRO ; : RRA 031 OO ; : RRC 008 GIRO ; : RRCA 015 OO ; : RRD 103 EDOO ; : SLA 032 GIRO ; : SRA 040 GIRO ; : SRL 056 GIRO ; \ BITS ......................................................... : BSRT DEPTH2/ CASE 3 OF SWAP A-(HL)?ERR ( BIT,OPC_B,REG) B- ( BIT,OPC_B,NREG) + ( BIT,OPC_R) SWAP 0-7?ERR ( OPC_R,BIT) 8 * + ( OPC_RB) CBOO ENDOF 4 OF 6 + 3 ROLL 0-7?ERR ( REG,DESP,OPC_B,BIT) 8 * + ( REG,DESP,OPC_IB) ROT ( DESP,OPC_IB,REG) CASE(RI+ ENDOF ERR_PIL ENDCASE ; : BIT 064 BSRT ; : RES 128 BSRT ; : SET 192 BSRT ; \ CONTROL/ARITMÉTICA GENERAL ................................... : CCF 063 OO ; : CPL 047 OO ; : DAA 039 OO ; : DI 243 OO ; : EI 251 OO ; : HALT 118 OO ; : IM CASE 0 OF 070 EDOO ENDOF 1 OF 086 EDOO ENDOF 2 OF 094 EDOO ENDOF 42 DUP ?ERROR ENDCASE ; : NE 068 EDOO ; : NOP 000 OO ; : SCF 055 OO ; \ INTERCAMBIO/BLOQUES .......................................... : EX_DE,HL 235 OO ; : EX_AF,AF 008 OO ; : EXX 217 OO ; : EX(SP), HL-IY?ERR 227 SWAP CASE HL OF OO ENDOF IX OF DDOO ENDOF IY OF FDOO ENDOF ERR_REG ENDCASE ; : LDD 168 EDOO ; : LDDR 184 EDOO ; : LDI 160 EDOO ; : LDIR 176 EDOO ; : CPP 169 EDOO ; : CPDR 185 EDOO ; : CPI 161 EDOO ; : CPIR 177 EDOO ; \ LÓGICAS ...................................................... : LOGIC DEPTH2/ CASE 2 OF SWAP ( OPC_B,REG/N) DUP ( OPC_B,REG/N,REG/N) B < ( OPC_B,REG/N,FLAG) IF ( OPC_B,N) SWAP ( N,OPC_B) 070 + ( N,OPC_N) OOXX ELSE A-(HL)?ERR ( OPC_B,REG) B- + ( OPC_R) OO ENDIF ENDOF 3 OF ( REG,DESP,OPC_B) 6 + ( REG,DESP,OPC_I) ROT ( DESP,OPC_I,REG) CASE ( DESP,OPC_I) (IX+ OF DDOO ENDOF (IY+ OF FDOO ENDOF ERR_REGI ENDCASE ENDOF ERR_PIL ENDCASE ; : AND 160 LOGIC ; : CP 184 LOGIC ; : OR 176 LOGIC ; : XOR 168 LOGIC ; \ SALTOS, LLAMADAS Y RETORNOS .................................. : RST 8 / 0 7 ENTRE? 42 ?ERROR 8* 199 + OO ; : RETN 069 OO ; : RETI 077 OO ; : RET DEPTH2/ CASE 0 OF 201 OO ENDOF 1 OF FLAG?ERR NZ- 8* 192 + ENDOF ERR_PIL ENDCASE ; : JP DEPTH2/ CASE 1 OF 024 JRXX ENDOF 2 OF SWAP NZ C ENTRE? 43 ?ERROR NZ- 8* 032 + JRXX ENDOF ERR_PIL ENDCASE ; : JR DEPTH2/ CASE 1 OF DUP (HL) = IF DROP 233 OO ENDIF DUP (IX) = IF DROP 233 DDOO ENDIF DUP (IY) = IF DROP 233 FDOO ENDIF 195 OOXXXX ENDOF 2 OF SWAP FLAG? NZ- 8* 194 + OOXXXX ENDOF ERR_PIL ENDCASE ; : DJNZ 016 JRXX ; : CALL DEPTH2/ CASE 1 OF 205 OOXXXX ENDOF 2 OF SWAP FLAG? NZ- 8* 196 + OOXXXX ENDOF ERR_PIL ENDCASE ; \ PUSH/POP .................................................... : PUSHPOP ( REG,OPC_B) SWAP ( OPC_B,REG) CASE AF OF 241 + OO ENDOF BC OF 193 + OO ENDOF DE OF 209 + OO ENDOF HL OF 225 + OO ENDOF IX OF 225 + DDOO ENDOF IY OF 225 + FDOO ENDOF ERR_REG ENDCASE ; : PUSH 4 PUSHPOP ; : POP 0 PUSHPOP ; \ INC/DEC ...................................................... : ID08 ( REG,OPC_B) SWAP ( OPC_B,REG) A-(HL)?ERR B- 8 * + OO ; : ID16 ( REG,OPC_B) SWAP ( OPC_B,REG) DUP IX = IF DROP 032 + DDOO ENDIF DUP IY = IF DROP 032 + FDOO ENDIF BC-IY?ERR BC- 16 * + OO ; : IDCASE(RI+ ( REG_I,DESP,OPC_B) ROT ( DESP,OPC_B,REG_I) CASE (IX+ OF 053 + DDOOXX ENDOF (IY+ OF 053 + FDOOXX ENDOF ERR_REGI ENDCASE ; : DEC DEPTH2/ CASE 2 OF 0 IDCASE(RI+ ENDOF 1 OF 8BITS? IF 005 ID08 ELSE 011 ID16 ENDIF ENDOF ERR_PIL ENDCASE ; : INC DEPTH2/ CASE 2 OF 1 IDCASE(RI+ ENDOF 1 OF 8BITS? IF 004 ID08 ELSE 003 ID16 ENDIF ENDOF ERR_PIL ENDCASE ; \ ADD/ADC ...................................................... : ADD/C_A(RI+ ( REG1,RI+,DESP,OPC_B) 3 ROLL ACUMULADOR? ( RI+,DESP,OPC_B) 134 + ( RI+,DESP,OPC) ROT ( DESP,OPC,RI+) CASE (IX+ OF DDOO ENDOF (IY+ OF FDOO ENDOF ERR_REGI ENDCASE ; : ADD/C_16 ( REG2,OPC_B,REG1) ROT SWAP ( OPC_B,REG2,REG1) CASE HL OF CASE BC OF 009 + OO ENDOF DE OF 025 + OO ENDOF HL OF 041 + OO ENDOF SP OF 057 + OO ENDOF ERR_REG ENDCASE ENDOF IX OF CASE BC OF 009 + DDOO ENDOF DE OF 025 + DDOO ENDOF IX OF 041 + DDOO ENDOF SP OF 057 + DDOO ENDOF ERR_REG ENDCASE ENDOF IY OF CASE BC OF 009 + FDOO ENDOF DE OF 025 + FDOO ENDOF IY OF 041 + FDOO ENDOF SP OF 057 + FDOO ENDOF ERR_REG ENDCASE ENDOF ERR_REG ENDCASE ; : ADD/C_A ( REG2,OPC_B) SWAP ( OPC_B,REG2) A-(HL)? IF B- + OO ELSE 198 OOXX ENDIF ; : ADD/C ( ...OPC_B) DEPTH2/ CASE 3 OF ( REG1,REG2,OPC_B) ROT ( REG2,OPC_B,REG1) DUP A = IF DROP ADD/C_A ELSE ADD/C_16 ENDIF ENDOF 4 OF ( REG1,RI+,DESP,OPC_B) ADD/C_A(RI+ ENDOF ERR_PIL ENDCASE ; : ADD 000 ADD/C ; \ XXX TODO : ADC 000 ADD/C ; \ XXX TODO