Miscalleneous routines I
THE '"P" CHANNEL DATA' TABLE
Here follow the '5' bytes that compose the +D "P" channel.
0407 P_CHANNEL DEFW #0008
0409 DEFW #0008
040B DEFB "P"
THE 'TAKEOVER PRINTER' SUBROUTINE
If the printer is to be controlled by the +D system, the following subroutine copies the
"P" channel data into the channel.
040C TAKE_PRTR CALL #0527,SYSTEM_Z
040F CALL Z,#208C,JPRTR
0412 LD A,(#200B) (ZXPNT)
0415 BIT 0,A
0417 RET NZ Return if the printer isn't to be
0418 AND A handled by the +D.
0419 CALL NZ,#0433,INIT_PRT1 If necessary initialize printer.
041C LD HL,(23631) Get address of channel data. (CHANS)
041F LD BC,15 Offset for channel "P".
0422 ADD HL,BC
0423 EX DE,HL
0424 LD HL,#0407,P_CHANNEL
0427 LD BC,5
042A LDIR Copy the "P" channel data.
042C RET
THE 'INIT PRINTER' SUBROUTINE
This subroutine initialises the printer, if it's to be handled by the +D and if it's
attached, by sending the initialisation codes and the permanent setting codes as
mentioned in the 'Setup' program.
042D INIT_PRTR LD A,(#200B)
0430 BIT 0,A Exit if printer not to be handled
0432 RET NZ by +D.
0433 INIT_PRT1 XOR A
0434 LD (#200B),A
0437 IN A,(247)
0439 BIT 7,A
043B RET NZ Exit if the printer is busy.
043C LD DE,#2012,INIT_PRT Send initialisation codes to printer.
043F CALL #140B,PO_ESC_SEQ
0442 LD DE,#201A,CHAR_PITCH Set character pitch.
0445 CALL #140B,PO_ESC_SEQ
0448 LD DE,#2022,N/72_LSPC Set line spacing to (#2007)/72 inch.
044B CALL #140B,PO_ESC_SEQ
044E LD A,(#2007)
0451 CALL #15C9,PNTP
0454 LD DE,#2032,INIT_PRT2 Set other permanent printer settings.
0457 JP #140B,PO_ESC_SEQ
THE 'CHECK SYSTEM CHECKSUM' ROUTINE
This subroutine calculates the checksum of the system file in RAM. Its is used to check
if the system isn't corrupted.
045A SYSTEM_OK XOR A
045B PUSH AF Calculate checksum.
045C LD HL,#2080
045F LD BC,#197F
0462 SYS_OK1 POP AF
0463 ADD A,(HL)
0464 PUSH AF
0465 INC HL
0466 DEC BC
0467 LD A,B
0468 OR C
0469 JR NZ,#0462,SYS_OK1
046B POP AF
046C CP (HL) Exit with Zero set if checksums
046D RET match.
THE 'END OF STATEMENT' ROUTINE
After the syntax of the 'new' commands has been checked, a jump is made here to confirm
that the statement is finished. An error report is given if it isn't finished. A return
to the calling routine is made only during runtime, otherwise the control returns to the
'main' ROM interpreter.
046E ST_END CALL #002C,GET_C Get current character.
0471 CP 13
0473 JR Z,#047A,ST_END1 Jump if the statement ends with ENTER.
0475 CP 58,":" Give an error if statement doesn't end
0477 JP NZ,#1648,REP_2 with a colon.
047A ST_END1 RST #30,SYNTAX_Z
047B RET NZ Return during runtime.
THE 'RETURN TO THE INTERPRETER' ROUTINE
The control is returned to the BASIC interpreter for interpretation of the next
statement.
047C END LD SP,(23613) Clear machine stack. (ERR_SP)
0480 LD (IY+0),#FF Clear error code. (ERR_NR)
0484 LD HL,#1BF4,STMT_NEXT Return address to 'main' ROM is
0487 RST #30,SYNTAX_Z 'STMT_NEXT' if syntax is being checked.
0488 JP Z,#004F,UNPAGE_HL
048B CALL #168E,BORD_REST Restore border color.
048E CALL #0497,TST_BREAK Test for BREAK.
0491 LD HL,#1B7D,STMT_R_1 Return address during runtime is
0494 JP #004F,UNPAGE_HL 'STMT_R_1'.
THE 'TEST_BREAK' SUBROUTINE
The BREAK key is checked and the appropriate error is given if it is pressed.
0497 TST_BREAK LD A,#7F
0499 IN A,(254)
049B RRA
049C RET C Return if SPACE wasn't pressed.
049D LD A,#FE
049F IN A,(254)
04A1 RRA
04A2 RET C Return if CAPS wasn't pressed.
04A3 JP #164A,REP_3
THE 'CALBAS_2' ROUTINE
This routine calls the required 'main' ROM routine.
04A6 CALBAS_2 LD (#3AC5),DE Free DE and HL.
04AA LD (#3AC8),HL
04AD POP HL Get return address, points to address
04AE LD E,(HL) of 'main' ROM routine to be called.
04AF INC HL Fetch address of routine to be called.
04B0 LD D,(HL)
04B1 INC HL
04B2 PUSH HL Restack return address.
04B3 LD HL,#3DE5
04B6 LD (HL),#47 Signal 'CALBAS executing'.
04B8 LD HL,#0066 Return address to +D system is
04BB PUSH HL 'NMI_RAM'.
04BC PUSH DE Push address of routine to be called.
04BD LD HL,(#3AC8) Restore HL and DE.
04C0 LD DE,(#3AC5)
04C4 JP #0050,UNPAGE_1 Do the CALBAS.
THE 'POKE @' COMMAND ROUTINE
The POKE @ command allows a value between 0 and 255 to be stored in the +D system
variables. But if the value is between 256 and 65535 the POKE @ behaves as a DPOKE.
Because the +D system vars have a offset of #2000 (or 8192) this value has to be
subtracted if the POKE @ is to be made directly to the given address. So POKE
@60000-8192,1000 to DPOKE 60000,1000.
04C7 POKE@ CALL #0527,SYSTEM_Z Maybe there is an alternative routine
04CA CALL Z,#2089,JPOKE in the system file.
04CD RST #28,NEXT_C Get next character.
04CE CP 64,"@"
04D0 JP NZ,#1644,REP_0 If it isn't "@" give error.
04D3 RST #10,CALBAS Evaluate the two following numeric
04D4 DEFW #1C79,NEXT_2NUM expressions.
04D6 CALL #046E,ST_END Confirm end of statement and exit
04D9 RST #10,CALBAS during syntax checking.
04DA DEFW #1E99,FIND_INT2 Fetch value to be POKEd in BC.
04DC PUSH BC
04DD RST #10,CALBAS
04DE DEFW #1E99,FIND_INT2 Fetch POKE address.
04E0 LD HL,#2000 Offset for +D system variables.
04E3 ADD HL,BC
04E4 POP BC
04E5 LD (HL),C POKE address,low byte.
04E6 LD A,B
04E7 AND A
04E8 JP Z,#047C,END Exit if 8 bit value.
04EB INC HL Otherwise POKE address+1,high byte
04EC LD (HL),B before exiting.
04ED JP #047C,END
THE 'SPECTRUM ERROR' ROUTINE
This routine must be entered with the error code in (ERR_NR), and does the same as the
'main' ROM 'ERROR' restart, except when error messages are to be supressed. This is
indicated by a non zero value in 23728.
04F0 SPEC_ERR LD HL,(#3DD6) Fetch D_CH_ADD.
04F3 LD (23645),HL Restore CH_ADD.
04F6 LD (23647),HL Restore X_PTR.
04F9 SPEC_ERR1 LD HL,#0058
04FC RST #30,SYNTAX_Z RETurn to #58, which is in ERROR_2, in
04FD JP Z,#004F,UNPAGE_HL the Spectrum ROM when checking syntax.
0500 LD A,(23728)
0503 AND A Also RETurn to #58 in 'main' ROM when
0504 JP Z,#004F,UNPAGE_HL error messages aren't to be supressed.
0507 SET 7,(IY+0) Otherwise signal 'Spectrum error'.
050B LD HL,#1B7D,STMT_R_1 And RETurn to STMT_R_1 in the Spectrum
050E JP #004F,UNPAGE_HL ROM.
THE 'RESTORE PRINTER BUFFER' SUBROUTINE
This subroutine restores the printer buffers 10 bytes which were destroyed by the
'?_ROMBANK' subroutine.
0511 REST_PBUF LD HL,#3BE6
0514 LD DE,23296
0517 LD BC,10
051A LDIR
051C RET
THE 'DETERMINE 48K OR 128K ROM' ROUTINE
This small routine is copied to 23296, it returns with the Zero flag set if address
#0001 in the 'main' ROM contains 175, that is when the 48K ROM bank is paged in.
051D DET_ROM OUT (231),A Page +D out.
051F LD A,(#0001)
0522 CP 175
0524 JP #0066,NMI Page +D in.
THE 'SYSTEM_Z' SUBROUTINE
This subroutine returns with the Zero flag set when the system file is present in RAM.
0527 SYSTEM_Z LD (#3DEA),A
052A LD A,(#3DE4)
052D CP #44
052F LD A,(#3DEA)
0532 RET
THE 'POWER_UP2' ROUTINE
The routine continues, with the proper register contents, in the 'main' ROM 'START/NEW'
routine.
0533 POWER_UP2 LD A,#02 Red instead of black border.
0535 OUT (254),A
0537 LD A,#3F Set interrupt vector.
0539 LD I,A
053B NOP
053C NOP
053D NOP
053E NOP
053F NOP
0540 NOP
0541 NOP
0542 NOP
0543 LD HL,#7FFF The stackpointer has to point into RAM,
0546 LD SP,HL otherwise: trouble (for the
UNPAGE_HL routine).
0547 IM 1 Set interrupt mode 1.
0549 XOR A Restore registers for 'main' ROM
054A LD DE,#FFFF 'START/NEW'.
054D LD HL,#11CB
0550 JP #004F,UNPAGE_HL Jump to 'START/NEW' in the 'main' ROM.