The syntax checking routines
THE 'SEPARATOR' SUBROUTINE
This small subroutine tests whether the current character is a separator or a quote. It
returns with Zero flag set if it was a ";", "," or a """, with the first two A holds the
next character.
25A2 SEPARATOR CP 44,","
25A4 JR Z,#25AD,SEPAR_1 Jump if current character is a comma.
25A6 CP 59,";"
25A8 JR Z,#25AD,SEPAR_1 Jump if it is a semicolon.
25AA CP 34,"""
25AC RET Return with Zero set if it's a quote.
25AD SEPAR_1 RST #28,NEXT_C Get next character.
25AE LD (#3DEA),A
25B1 XOR A Set Zero flag.
25B2 LD A,(#3DEA)
25B5 RET
THE 'EVALUATE STRING EXPR.' SUBROUTINE
A call is made to the 'main' ROM 'EXPT_EXP' (class-0A) subroutine, to evaluate a string
expression. During runtime, the parameters of the string (start and length) are returned
in the DE and BC register pairs.
25B6 EXPT_STR RST #10,CALBAS Evaluate the string expression.
25B7 DEFW #1C8C,EXPT_EXP
25B9 RST #30,SYNTAX_Z
25BA RET Z Return if syntax is being checked.
25BB PUSH AF Save the character following the string
25BC RST #10,CALBAS and the zero flag.
25BD DEFW #2BF1,STK_FETCH Fetch the string parameters.
25BF POP AF
25C0 RET
THE 'EVAL. MICRODRIVE SYNTAX' SUBROUTINE
This subroutine is entered at 'MD_SYNTAX' or 'MD_SYNTAX1' depending upon whether or not
the character pointer is to be updated to the next character. A single character string
is evaluated, and its ASCII value is stored during runtime. If a separator isn't present
after the single character string, an error is given.
25C1 MD_SYNTAX RST #28,NEXT_C Next character.
25C2 MD_SYN1 CALL #25B6,EXPT_STR
25C5 JR Z,#25D9,MD_SYN2 Jump if syntax is being checked.
25C7 PUSH AF Save the character following the
25C8 LD A,C string. A holds string length low byte.
25C9 DEC A
25CA OR B Give an error if there isn't exactly
25CB JP NZ,#1658,REP_10 one character in the string.
25CE LD A,(DE) Fetch the channel specifier.
25CF RST #10,CALBAS Call 'ALPHA' to see if it's a valid
25D0 DEFW #2C8D,ALPHA letter.
25D2 JP NC,#1658,REP_10 Give error if not a valid letter.
25D5 LD (#3E04),A Store the specifier in the UFIA.
25D8 POP AF Restore next character.
25D9 MD_SYN2 CP 59,";"
25DB RET Z Return if it's a semicolon.
25DC CP 44,","
25DE RET Z Return if it's a comma.
25DF JP #1644,REP_0 Otherwise give error.
THE 'EVALUATE DEVICE NUMBER' SUBROUTINE
This subroutine is used to evaluate the device number.
25E2 EXPT_DEVN AND #DF Make upper case.
25E4 CP 80,"P"
25E6 JR NZ,#25F9,EXPT_DEVN1 Jump if the device wasn't "P".
25E8 RST #28,NEXT_C Next character.
25E9 CALL #2611,EXPT_NUM Get the program number.
25EC RET Z Return if syntax checking.
25ED PUSH AF
25EE LD A,(#3E01) Store program number.
25F1 LD (#3E02),A
25F4 CALL #2604,LAST_DRV Drive is last drive.
25F7 POP AF
25F8 RET
Now a check is made whether the last used device is wanted.
25F9 EXPT_DEVN1 RST #28,NEXT_C Get next character.
25FA EXPT_DEVN2 CP 42,"*"
25FC JR NZ,EXPT_NUM Jump if it wasn't a "*".
25FE RST #30,SYNTAX_Z
25FF CALL NZ,#2604,LAST_DRV Store last drive number during runtime.
2602 RST #28,NEXT_C Next character.
2603 RET
THE 'SET LAST DRIVE' SUBROUTINE
This subroutine is used whenever the last used drive is to be used again.
2604 LAST_DRV LD A,(#3DDA) Fetch current control port status.
2607 AND #01 Keep only drive select.
2609 ADD A,#01 A holds 1 for drive 2, 2 for drive 1.
260B XOR #03 1 becomes 2, 2 becomes 1.
260D LD (#3E01),A Store drive number.
2610 RET
THE 'EVALUATE NUMERIC EXPR.' SUBROUTINE
This subroutine is used to evaluate a single numeric expression. The result is returned
during runtime into the BC register pair and into UFIA1.
2611 EXPT_NUM RST #10,CALBAS Evaluate the expression by calling
2612 DEFW #1C82,EXPT_1NUM 'EXPT_1NUM' in the 'main' ROM.
2614 RST #30,SYNTAX_Z
2615 RET Z Return if syntax is being checked.
2616 PUSH AF
2617 RST #10,CALBAS Fetch the value from the calculator
2618 DEFW #1E99,FIND_INT2 stack.
261A LD A,C
261B LD (#3E01),A Store it in UFIA1.
261E POP AF
261F RET
THE 'EVALUATE 2ND FILENAME' SUBROUTINE
This routine evaluates the second filename of a BASIC command. Because 'EXP_F_NAME'
stores the filename in UFIA1, both UFIAS are swapped first,
then 'EXP_F_NAME' is called and an exit is made via 'SWAP_UFIAS' to get the UFIA's in
the right place again.
2620 EXPT_2FNAM CALL #2626,SWAP_UFIAS Swap UFIA1 and 2.
2623 CALL #2640,EXPT_FNAME Evaluate filename.
Exit via 'SWAP_UFIAS'.
THE 'SWAP UFIAS' SUBROUTINE
This subroutine swaps the contents of UFIA1 and UFIA2 in DFCA.
2626 SWAP_UFIAS PUSH AF
2627 PUSH BC
2628 PUSH DE
2629 PUSH HL
262A LD B,24 An UFIA is 24 bytes long.
262C LD DE,#3E01 Start of UFIA1.
262F LD HL,#3E1A Start of UFIA2.
2632 SWAP_LOOP LD A,(DE) Exchange the contents.
2633 LD C,(HL)
2634 EX DE,HL
2635 LD (DE),A
2636 LD (HL),C
2637 INC DE
2638 INC HL
2639 DJNZ #2632,SWAP_LOOP Repeat for all 24 bytes.
263B POP HL
263C POP DE
263D POP BC
263E POP AF
263F RET
THE 'EVALUATE A FILENAME' SUBROUTINE
A string expression is evaluated and, provided that the length is within the range 1..10
characters, is stored in UFIA1.
2640 EXPT_FNAME CALL #25B6,EXPT_STR Evaluate the string.
2643 RET Z Return if checking syntax.
2644 PUSH AF
2645 LD A,C
2646 OR B
2647 JP Z,#1654,REP_8 Give error with null string.
264A LD HL,10
264D SBC HL,BC
264F JP C,#1654,REP_8 Give error with string length > 10.
2652 LD HL,#3E05 Clear the filename and the directory
2655 LD A,11 description of UFIA1.
2657 CLR_FNAME LD (HL),32
2659 INC HL
265A DEC A
265B JR NZ,#2657,CLR_FNAME Repeat for all 11 bytes.
265D LD HL,#3E06 Copy the filename into UFIA1.
2660 EX DE,HL
2661 LDIR
2663 POP AF
2664 RET
THE 'EVALUATE PARAMETERS' SUBROUTINE
This very important subroutine is called to evaluate the syntax of the +D 'SAVE',
'LOAD', 'MERGE' and 'VERIFY' commands. The routine is entered with CH_ADD pointing to the
command; on exit during runtime UFIA1 is filled with the proper values.
2665 EXPT_PARMS RST #28,NEXT_C Get next character from BASIC line.
2666 CP 32," " Give an error with character codes
2668 JP C,#1644,REP_0 below 32, i.e. colour codes, etc.
266B CP 170,"SCREEN$"
266D JP Z,#301D,DUMP_SCR$ Jump with 'SCREEN$'.
2670 LD (#3E04),A Otherwise store it in DEV_TYPE1.
2673 CP 64,"@"
2675 JR NZ,#26AE,NOT_@ Jump if not a '@'.
Now deal with @.
2677 CALL #25E2,EXPT_DEVN Evaluate drive number.
267A CALL #25A2,SEPARATOR
267D JP NZ,#1648,REP_2 Give error if no separator was found.
2680 RST #10,CALBAS Call 'EXPT_1NUM' to evaluate the track
2681 DEFW #1C82,EXPT_1NUM number.
2683 CALL #25A2,SEPARATOR Test for another separator and give an
2686 JP NZ,#1648,REP_2 error if none found.
2689 RST #10,CALBAS Evaluate sector number.
268A DEFW #1C82,EXPT_1NUM
268C CALL #25A2,SEPARATOR Again a separator has to be found.
268F JP NZ,#1648,REP_2
2692 RST #10,CALBAS Evaluate address.
2693 DEFW #1C82,EXPT_1NUM
2695 CALL #3148,ST_END_RAM Confirm end of statement, and exit
during syntax checking.
2698 RST #10,CALBAS Fetch the address from the calculator
2699 DEFW #1E99,FIND_INT2 stack.
269B LD (#3E15),BC Store it in LENGTH1_2
269F RST #10,CALBAS Fetch sector.
26A0 DEFW #1E99,FIND_INT2
26A2 LD (#3E13),BC Store it in FILE_ADDR1
26A6 RST #10,CALBAS Fetch track.
26A7 DEFW #1E99,_FIND_INT2
26A9 LD (#3E11),BC Store it in LENGTH1_1
26AD RET Exit.
26AE NOT_@ CP 42,"*" Call 'MD_SYNTAX' if it was a "*".
26B0 CALL Z,#25C1,MD_SYNTAX
26B3 CALL #25E2,EXPT_DEVN Fetch device or program number.
26B6 CALL #25A2,SEPARATOR Test for a separator.
26B9 PUSH AF
26BA RST #30,SYNTAX_Z
26BB JR Z,#26D6,FILENAME Jump if syntax checking.
26BD LD A,(#3E04) Fetch device descriptor.
26C0 AND #DF Only capitals.
26C2 CP 68,"D"
26C4 JR Z,#26D1,NOT_@1 Jump if device is disk.
26C6 CP 77,"M"
26C8 JR Z,#26D1,NOT_@1 Or disk with Microdrive syntax.
26CA CP 80,"P"
26CC JR Z,#26DB,PARAMS Jump with program.
26CE JP NZ,#1658,REP_10 Give error with unknown device.
26D1 NOT_@1 POP AF Give error if no separator or quote
26D2 JP NZ,#1644,REP_0 found with devices "D" and "M".
26D5 PUSH AF Balance 'POP AF' below.
26D6 FILENAME POP AF
26D7 CALL Z,#2640,EXPT_FNAME Evaluate filename if necessary.
26DA PUSH AF Balance next instruction.
26DB PARAMS POP AF
26DC CP 13
26DE JP Z,#276F,NO_PARAMS Jump with ENTER.
26E1 CP 58,":"
26E3 JP Z,#276F,NO_PARAMS Jump with colon.
26E6 CP 204,"TO"
26E8 JP Z,#2308,TO Jump with 'TO'.
26EB CP 170,"SCREEN$"
26ED JP Z,#27A5,SCREEN$ Jump with 'SCREEN$'.
26F0 CP 175,"CODE"
26F2 JP Z,#27C0,CODE Jump with 'CODE'.
26F5 CP 228,"DATA"
26F7 JP Z,#281A,DATA Jump with 'DATA'.
26FA CP 202,"LINE"
26FC JP Z,#275F,LINE Jump with 'LINE'.
26FF AND #DF Only capitals.
2701 CP 83,"S"
2703 JR NZ,#270F,NOT_S Jump with other than 'S'.
2705 RST #28,NEXT_C Next character.
2706 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
2709 LD A,5 Signal '48K Snapshot'.
270B LD (#3E05),A
270E RET Finished.
270F NOT_S CP 75,"K"
2711 JR NZ,#271D,NOT_K Jump with other than 'K'.
2713 RST #28,NEXT_C Next character.
2714 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
2717 LD A,9 Signal '128K Snapshot'.
2719 LD (#3E05),A
271C RET Finished.
271D NOT_K CP 88,"X"
271F JP NZ,#1644,REP_0 Give error with other than 'X'.
2722 RST #28,NEXT_C Next character.
2723 CALL #25A2,SEPARATOR Jump if a separator found, there is
2726 JR Z,#2736,XFILE_1 more.
2728 CALL #1635,TEST_5 There must follow a address if SAVEing.
272B JP NZ,#1648,REP_2 Give error if SAVEing.
272E CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
2731 LD BC,#3BD6 Load address of execute file.
2734 JR #273F,XFILE_2 Jump forward.
A separator has been found, so there should follow an address.
2736 XFILE_1 RST #10,CALBAS Evaluate address.
2737 DEFW #1C82,EXPT_1NUM
2739 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
273C RST #10,CALBAS Fetch the address.
273D DEFW #1E99,FIND_INT2
273F XFILE_2 LD (#3E13),BC Store it in FILE_ADDR1
2743 LD BC,510 Length of execute file on double
2746 LD A,(#3DDA) density disks.
2749 AND #04
274B JR Z,#2750,XFILE_3 Jump if double density selected.
274D LD BC,254 Otherwise this is the length of the
execute file.
2750 XFILE_3 LD (#3E11),BC Store length in LENGTH1_1.
2754 LD A,3 File type is 'CODE'.
2756 LD (#3E10),A Store it in FILE_TYPE1.
2759 LD A,11 Signal 'Execute file'.
275B LD (#3E05),A Store in DIR_DESCR1
275E RET Finished.
Now deal with LINE. The +D allows LOAD, VERIFY and MERGE .. LINE to be entered as a
command but the LINE is completely ignored.
275F LINE RST #28,NEXT_C Advance CH_ADD.
2760 RST #10,CALBAS Evaluate autostart line number by
2761 DEFW #1C82,EXPT_1NUM calling 'EXPT_1NUM' in the 'main' ROM.
2763 CALL #3148,ST_END_RAM Confirm end of statement, and exit
during syntax checking.
2766 RST #10,CALBAS Fetch the autostart line number.
2767 DEFW #1E99,FIND_INT2
2769 LD (#3E17),BC Store it in AUTOSTART1.
276D JR #2772,PROG
If there are no parameters, as with a BASIC program, the syntax checking ends here.
276F NO_PARAMS CALL #3148,ST_END_RAM Confirm end of statement, exit when
syntax checking.
2772 PROG LD A,(#3E04)
2775 AND #DF Only capitals.
2777 CP 80,"P" Jump if the device wasn't "P", i.e. no
2779 JR NZ,#2782,PROG_1 program number was specified.
277B CALL #1635,TEST_5 'SAVE pn' is not supported, so give an
277E RET Z error if saving, otherwise return.
277F JP #1644,REP_0
2782 PROG_1 XOR A File type is 'BASIC'.
2783 LD (#3E10),A
2786 LD A,1 Signal 'BASIC file'.
2788 LD (#3E05),A
278B LD HL,(23641) Fetch (E_LINE), the first location past
the variables area.
278E LD DE,(23635) Fetch (PROG), the 'start' of the BASIC
2792 LD (#3E13),DE program and store it in FILE_ADDR1
2796 SCF Calculate ((E_LINE)-(PROG)-1), i.e. the
2797 SBC HL,DE length of the program and its
2799 LD (#3E11),HL variables. Store it in LENGTH1_1.
279C LD HL,(23627) Fetch (VARS) and calculate
279F SBC HL,DE (VARS)-(PROG), i.e. the length of the
program without its variables.
27A1 LD (#3E15),HL Store it into LENGTH1_2.
27A4 RET Finished.
If the token is SCREEN$, the parameters are entered directly into the file header.
27A5 SCREEN$ RST #28,NEXT_C Get the next character.
27A6 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
27A9 LD HL,6912 The size of the display file is stored
27AC LD (#3E11),HL into LENGTH1_1.
27AF LD HL,16384 The startaddress is stored into
27B2 LD (#3E13),HL FILE_ADDR1
27B5 LD A,3 File type is 'CODE'.
27B7 LD (#3E10),A
27BA LD A,7 Signal 'SCREEN$'.
27BC LD (#3E05),A
27BF RET
Now deal with CODE, three parameters are needed: "start", "length" and "execute
address". With LOAD there may be none, one, two or three parameters, but with SAVE at
least two parameters must be present.
27C0 CODE RST #28,NEXT_C Update CH_ADD.
27C1 CP 13 If there are no further parameters,
27C3 JR Z,#27C9,CODE_1 jump to use '0' as default value.
27C5 CP 58,":" Jump if there are parameters to be
27C7 JR NZ,#27D4,CODE_2 evaluated (i.e. the next character is
not a colon).
27C9 CODE_1 CALL #1635,TEST_5 'SAVE .. CODE' has to be followed by at
27CC JP NZ,#1648,REP_2 least two numbers, so give an error if
none present.
27CF RST #10,CALBAS A call to the 'main' ROM routine
27D0 DEFW #1CE6,USE_ZERO 'USE_ZERO' is made to use a value of
27D2 JR #27DC,CODE_3 zero as default.
It's likely that an address follows.
27D4 CODE_2 RST #10,CALBAS Use the 'main' ROM routine to evaluate
27D5 DEFW #1C82,EXPT_1NUM the first parameter.
27D7 CALL #25A2,SEPARATOR
27DA JR Z,#27E7,CODE_4 Jump if a separator is present.
27DC CODE_3 CALL #1635,TEST_5 Give an error if there isn't a second
27DF JP NZ,#1648,REP_2 number with 'SAVE .. CODE'.
27E2 RST #10,CALBAS Otherwise use zero as default.
27E3 DEFW #1CE6,USE_ZERO
27E5 JR #27EF,CODE_5
The length seems to be present also.
27E7 CODE_4 RST #10,CALBAS Evaluate the second parameter.
27E8 DEFW #1C82,EXPT_1NUM
27EA CALL #25A2,SEPARATOR Jump if a second separator is found.
27ED JR Z,#27F4,CODE_6
27EF CODE_5 RST #10,CALBAS Otherwise zero is default.
27F0 DEFW #1CE6,USE_ZERO
27F2 JR #27F7,CODE_7
There's even an execute address.
27F4 CODE_6 RST #10,CALBAS Evaluate the third parameter.
27F5 DEFW #1C82,EXPT_1NUM
27F7 CODE_7 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
27FA RST #10,CALBAS Fetch the "autoexecute" address from
27FB DEFW #1E99,FIND_INT2 the calculator stack and store it into
27FD LD (#3E17),BC AUTOSTART1
2801 RST #10,CALBAS Fetch the "length".
2802 DEFW #1E99,FIND_INT2
2804 LD (#3E11),BC Store it into LENGTH1_1
2808 RST #10,CALBAS Fetch the "start".
2809 DEFW #1E99,FIND_INT2
280B LD (#3E13),BC Store it into FILE_ADDR1
280E LD A,3 File type is 'CODE'.
2811 LD (#3E10),A
2814 LD A,4 Signal 'CODE file'.
2816 LD (#3E05),A
2819 RET Finished.
Finally the routine to evaluate DATA parameters.
281A DATA CALL #163A,TEST_6 Give an error if attempting to MERGE an
281D JP NZ,#1660,REP_14 array.
2820 RST #28,NEXT_C Next character.
2821 RST #10,CALBAS Call LOOK_VARS to look for the array
2822 DEFW #28B2,LOOK_VARS name.
2824 SET 7,C
2826 JR NC,#2833,DATA_1 Jump if handling an existing array or
if syntax checking.
2828 LD HL,#0000 Signal 'using a new array'.
282B CALL #1630,TEST_4
282E JR NZ,#284E,DATA_3 Jump if LOADing the array.
2830 JP #165A,REP_11 Otherwise give error 'Variable not
found'.
2833 DATA_1 JP NZ,#1644,REP_0 Give error if not an array variable.
NOTE: This test fails to exclude simple strings, but the 'bug' (present in the 'main'
ROM) is corrected at #283E.
2836 RST #30,SYNTAX_Z
2837 JR Z,#2860,DATA_5 Jump if syntax is being checked.
2839 CALL #1635,TEST_5
283C JR Z,#2843,DATA_2 Jump if LOADing.
283E BIT 7,(HL) Give an error if trying to SAVE a
2840 JP Z,#1644,REP_0 simple string.
2843 DATA_2 INC HL Point to the 'length' of the array.
2844 LD A,(HL) Store the length into LENGTH1_1.
2845 LD (#3E11),A
2848 INC HL
2849 LD A,(HL)
284A LD (#3E12),A
284D INC HL Advance to the start of the array.
284E DATA_3 LD A,C Store array name into LSB of LENGTH1_2.
284F LD (#3E15),A
2852 LD A,1 File type is 'NUM ARRAY'.
2854 BIT 6,C
2856 JR Z,#2859,DATA_4 Jump if really a numeric array.
2858 INC A File type is 'STR ARRAY'.
2859 DATA_4 LD (#3E10),A Store file type into FILE_TYPE1.
285C INC A Signal: (A=2) 'Numeric array',
285D LD (#3E05),A (A=3) 'String array'.
2860 DATA_5 EX DE,HL DE holds 'start' of the array (or #0000
with a 'new' array to be LOADed).
2861 RST #28,NEXT_C Next character.
2862 CP 41,")" Check that the ')' does exist.
2864 JP NZ,#1648,REP_2 Report an error if not.
2867 RST #28,NEXT_C Next character.
2868 CALL #3148,ST_END_RAM Confirm end of statement and exit
during syntax checking.
286B LD (#3E13),DE Store "start" of the array into
286F RET FILE_ADDR1 and exit.