Previous Next Contents Index
Miscalleneous routines I

THE 'TEST_BREAK' SUBROUTINE
The BREAK key is checked and the appropriate error is given if it is pressed.
This routine is also present in ROM at address #2181.

03FA TEST_BREAK LD   A,#7F
03FC            IN   A,(254)
03FE            RRA
03FF            RET  C                   Return if SPACE wasn't pressed.
0400            LD   A,#FE
0402            IN   A,(254)
0404            RRA
0405            RET  C                   Return if CAPS wasn't pressed.
0406            JP   #2926,REP_3

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. This routine is also present
in ROM (#2155).

0409 ST_END_RAM CALL #002C,GET_C_RAM     Get current character.
040C            CP   13
040E            JR   Z,#0415,TEST_RET    Jump if the statement ends with ENTER.
0410            CP   ":"                 Give an error if statement doesn't end
0412            JP   NZ,#2924,REP_2      with a colon.
0415 TEST_RET   RST  #30,SYNTAX_Z
0416            RET  NZ                  Return during runtime.
0417            JR   #0420,END1

THE 'RETURN TO THE INTERPRETER' ROUTINE
The control is returned to the BASIC interpreter for interpretation of the next
statement. Except when the network was served, then a return is made to #0394 in
'SERVE_PUP'.

0419 END        CALL #297B,JBORD_REST    Restore border color.
041C            CALL #09FB,TEST_SERV
041F            RET  NZ                  Exit if serving a pupil.
0420 END1       LD   SP,(23613)          Clear machine stack. (ERR_SP)
0424            LD   (IY+0),#FF          Clear error code. (ERR_NR)
0428            LD   HL,#1BF4            Return address to 'main' ROM is
042B            RST  #30,SYNTAX_Z        'STMT_NEXT' if syntax is being checked.
042C            JP   Z,#004F,UNPAGE_HL
042F            EI
0430            NOP
0431            NOP
0432            LD   HL,#1B76            Return address during runtime is
0435            JP   #004F,UNPAGE_HL     'STMT_RET'.

THE 'POKE @' COMMAND ROUTINE
The POKE @ command allows a value between 0 and 255 to be stored in the DISCiPLE
system variables. But if the value is between 256 and 65535 the POKE @ behaves as
a DPOKE. Because the DISCiPLE system vars have a offset of #0298 (or 664) this value
has to be subtracted if the POKE @ is to be made directly to the given address. So
POKE @60000-664,1000 to DPOKE 60000,1000.

0438 POKE@      RST  #28,NEXT_C_RAM      Get next character.
0439            CP   "@"
043B            JP   NZ,#2920,REP_0      If it isn't "@" give error.
043E            RST  #10,CALBAS          Evaluate the two following numeric
043F            DEFW #1C79,NEXT_2NUM     expressions.
0441            CALL #0409,ST_END_RAM    Confirm end of statement and exit
0444            RST  #10,CALBAS          during syntax checking.
0445            DEFW #1E99,FIND_INT2     Fetch value to be POKEd in BC.
0447            PUSH BC
0448            RST  #10,CALBAS
0449            DEFW #1E99,FIND_INT2     Fetch POKE address.
044B            LD   HL,#0298            Offset for DISCiPLE system variables.
044E            ADD  HL,BC
044F            POP  BC
0450            LD   (HL),C              POKE address,low byte.
0451            LD   A,B
0452            AND  A
0453            JP   Z,#0419,END         Exit if 8 bit value.
0456            INC  HL                  Otherwise POKE address+1,high byte
0457            LD   (HL),B              before exiting.
0458            JP   #0419,END

THE '"P" CHANNEL DATA' TABLE
Here follow the 5 bytes that compose a DISCiPLE "P" channel.

045B P_CHANNEL  DEFW #0008               Main ROM 'output' routine.
045D            DEFW #0008               Main ROM 'input' routine.
045F            DEFB "P"                 Channel "P" identifier.

THE 'TAKEOVER PRINTER' SUBROUTINE
If the printer is to be controlled by the DISCiPLE system, the following subroutine
copies the "P" channel data into the channel.

0460 TAKE_PRTR  LD   A,(#02A3)           (ZXPNT)
0463            AND  A                   Return if the printer isn't to be handled
0464            RET  NZ                  by the DISCiPLE.
0465            LD   HL,(23631)          Get address of channel data. (CHANS)
0468            LD   BC,15               Offset for channel "P".
046B            ADD  HL,BC
046C            EX   DE,HL
046D            LD   HL,#045B,P_CHANNEL
0470            LD   BC,5
0473            LDIR                     Copy the "P" channel data.
0475            RET

THE 'INIT PRINTER' SUBROUTINE
This subroutine initialises the printer, if it's to be handled by the DISCIPLE and if
it's attached, by sending the initialisation codes and the permanent setting codes as
mentioned in the 'Setup' program.

0476 INIT_PRTR  CALL #15E0,TEST_PRTR
0479            RET  C                   Exit if no printer connected or printer
047A            NOP                      not to be handled by DISCiPLE.
047B            LD   DE,#02AA            Send initialisation codes to printer.
047E            CALL #1779,PO_ESC_SEQ
0481            LD   DE,#02B2            Set character pitch.
0484            CALL #1779,PO_ESC_SEQ
0487            LD   DE,#02BA            Set line spacing to (#029F)/72 inch.
048A            CALL #1779,PO_ESC_SEQ
048D            LD   A,(#029F)
0490            CALL #1944,PNTP
0493            LD   DE,#02CA            Set other permanent printer settings.
0496            JP   #1779,PO_ESC_SEQ

THE 'CALBAS_2' ROUTINE
This routine calls the required 'main' ROM routine. It is an exact copy of the ROM
routine at #2190.

0499 CALBAS_2   LD   (#1AC5),DE          Free DE and HL.
049D            LD   (#1AC8),HL
04A0            POP  HL                  Get return address, points to address
04A1            LD   E,(HL)              of 'main' ROM routine to be called.
04A2            INC  HL                  Fetch address of routine to be called.
04A3            LD   D,(HL)
04A4            INC  HL
04A5            PUSH HL                  Restack return address.
04A6            LD   HL,#1DE5
04A9            LD   (HL),#47            Signal 'CALBAS executing'.
04AB            LD   HL,#0066            Return address to DISCiPLE system is
04AE            PUSH HL                  'NMI_RAM'.
04AF            PUSH DE                  Push address of routine to be called.
04B0            LD   HL,(#1AC8)          Restore HL and DE.
04B3            LD   DE,(#1AC5)
04B7            JP   #0050,UNPAGE_1      Do the CALBAS.

THE 'USR_0' ROUTINE CONTINUED
A jump is made to the RAM test and initialisation routine in the 'main' ROM. These
three instructions can also be found in ROM at #230C.

04BA USR_0_1    LD   DE,#FFFF            Top of possible RAM.
04BD            LD   HL,#11CB,START/NEW  The 'START/NEW' routine in 'main' ROM.
04C0            JP   #004F,UNPAGE_HL     Continue with USR 0 in 'main' ROM.
Previous Next Contents Index