PAGE 01 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 002 ORG :E5BC 003 * 004 * 005 * 006 ************************************** 007 * ENCODE VARIABLE OR ARRAY REFERENCE * 008 ************************************** 009 * 010 * L3E85: Reference to a variable or an array with 011 * arguments. 012 * L3E86: Reference to an array without arguments. 013 * 014 * Entry: D : Code: 00: Reference to a value (array 015 * with arguments or variable). 016 * FF: Array name without arguments. 017 * C : Next position in input. 018 * HL: 1st free position in EBUF. 019 * Exit: C,HL updated, AF preserved. 020 * DE: Offset to symbol table (to T/L byte). 021 * B : T/L byte of name. 022 * 023 E5BC 1600 L3E85 MVI D,:00 024 E5BE F5 EVR10 PUSH PSW 025 E5BF D5 PUSH D 026 E5C0 CDD2DD CALL :DDD2 Get 1st char from line, 027 neglect tab + space 028 E5C3 CD02DE CALL :DE02 Check if char is upper case 029 E5C6 D20BDA JNC :DA0B Run 'SYNTAX ERROR' if not 030 E5C9 E5 PUSH H 031 E5CA F5 PUSH PSW Save 1st char 032 033 * Check if name is a BASIC command: 034 035 E5CB 1E02 MVI E,:02 Nr of info bytes -1 036 E5CD 21BFCB LXI H,:CBBF Addr command table 037 E5D0 CD34CA CALL :CA34 Find instr in table. On 038 exit, HL points to string 039 or after it if not found 040 E5D3 7E MOV A,M ) 041 E5D4 E63F ANI :3F ) Check if end table reached 042 E5D6 FE25 CPI :25 ) 043 E5D8 C20BDA JNZ :DA0B Run 'SYNTAX ERROR' if name 044 is a command 045 E5DB B7 ORA A 046 047 * Check if name is a BASIC function: 048 049 E5DC CDFDE6 CALL :E6FD Find var.name in input 050 E5DF 21E6CF LXI H,:CFE6 Addr function table 051 E5E2 CD5ACA CALL :CA5A Find function in table 052 E5E5 DA0BDA JC :DA0B Run 'SYNTAX ERROR' if name 053 is a function 054 055 * Check type marker in input: 056 057 E5E8 0C INR C Points to next char in input 058 E5E9 1E02 MVI E,:02 2 bytes in symtab for STR 059 E5EB 2620 MVI H,:20 String type byte 060 E5ED FE24 CPI :24 061 E5EF CA0EE6 JZ :E60E Jump if STR ('$') 062 E5F2 1E04 MVI E,:04 4 byte in symtab for INT/FPT 063 E5F4 2610 MVI H,:10 INT type byte PAGE 02 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 064 E5F6 FE25 CPI :25 065 E5F8 CA0EE6 JZ :E60E Jump if INT ('%') 066 E5FB 2600 MVI H,:00 FPT type byte 067 E5FD FE21 CPI :21 068 E5FF CA0EE6 JZ :E60E Jump if FPT ('!') 069 070 * If no type marker given: 071 072 E602 F1 POP PSW Get 1st byte var.name 073 E603 213402 LXI H,:0234 Baseaddr IMPTAB 074 E606 CD30DE CALL :DE30 Calc offset addr in HL 075 E609 66 MOV H,M Get type marker in H 076 E60A 0D DCR C 077 E60B C30FE6 JMP :E60F 078 079 * Handle type marker: 080 081 E60E F1 L3E87 POP PSW Get 1st byte of name 082 E60F 7C L3E88 MOV A,H type in A 083 E610 B2 ORA D OR type (high nibble) with 084 length (low nibble) 085 E611 57 MOV D,A T/L on name in D 086 E612 E1 POP H 087 E613 F1 POP PSW Get code 00/FF in A 088 E614 E5 PUSH H 089 E615 CD18E0 CALL :E018 ) Update EBUF pointer 090 E618 CD18E0 CALL :E018 ) 2 positions 091 E61B B7 ORA A Flags on code 092 E61C CA26E6 JZ :E626 Jump if value 093 094 * If name: 095 096 E61F 7A MOV A,D Get T/L byte of name 097 E620 F640 ORI :40 Set bit 6 (array) 098 E622 57 MOV D,A Preserve it 099 E623 C32EE6 JMP :E62E 100 101 * If value: 102 103 E626 CDE0DD L3E89 CALL :DDE0 Get char from line 104 E629 FE28 CPI :28 '(' ? 105 E62B CC53E6 CZ :E653 Then encode arguments 106 * 107 E62E E3 L3E90 XTHL 108 E62F E5 PUSH H 109 E630 7A MOV A,D Get T/L byte on name 110 E631 E630 ANI :30 Type only 111 E633 323601 STA :0136 Set type latest expression 112 E636 D5 PUSH D Preserve T/L name 113 E637 CD57CA CALL :CA57 Find variable in symtab 114 E63A D1 POP D Get T/L name 115 E63B D47DE6 CNC :E67D Insert variable in symtab 116 if it is a new one 117 E63E 42 MOV B,D T/L name in B 118 E63F EB XCHG Var.addr in symtab in DE 119 E640 2AA102 LHLD :02A1 Get startaddr symtab 120 E643 EB XCHG in DE; var.addr in HL 121 E644 CD1ADE CALL :DE1A Calc offset from begin 122 symtab in HL 123 E647 EB XCHG Offset in DE 124 E648 E1 POP H Retrieve EBUF pntr 125 E649 7A MOV A,D Hibyte offset in A PAGE 03 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 126 E64A F640 ORI :40 Set bit 6 (array) 127 E64C 77 MOV M,A Hibyte offset in EBUF 128 E64D 23 INX H 129 E64E 73 MOV M,E Lobyte offset in EBUF 130 E64F 23 INX H 131 E650 E1 POP H 132 E651 F1 POP PSW 133 E652 C9 RET 134 * 135 * ENCODE ARRAY ARGUMENTS: 136 * 137 * An arguments list is encoded into EBUF. 138 * Format: 139 * nr of arg / type of arg / code for expr/ 140 * < type of arg / code for expr >. 141 * 142 * Entry: D : T/L byte of variable name. 143 * C : Points to '(' of argument list for 144 * array in input. 145 * HL: 1st free position EBUF. 146 * Exit: D : 'Subscripted' flag. 147 * E : Nr of bytes in symtab (02). 148 * C,HL updated. B preserved. A=D. 149 * 150 E653 1E00 EVR50 MVI E,:00 Parameter count 151 E655 E5 PUSH H 152 E656 CD18E0 CALL :E018 Update EBUF pointer 153 E659 1C EVR55 INR E Parameter count +1 154 E65A 0C INR C Skip 'C' or ',' 155 E65B D5 PUSH D 156 E65C CDB2E3 CALL :E3B2 Encode non-boolean expr 157 preceeded by its type 158 E65F D1 POP D 159 E660 CDD2DD CALL :DDD2 Get char from line, neglect 160 tab + space 161 E663 FE2C CPI :2C 162 E665 CA59E6 JZ :E659 Get next parameter if it 163 is ',' 164 E668 FE29 CPI :29 165 E66A C20BDA JNZ :DA0B Run 'SYNTAX ERROR' if 166 not ')' 167 E66D 0C INR C Skip ')' 168 E66E E3 XTHL Get old EBUF pntr 169 E66F 73 MOV M,E Parameter count into EBUF 170 E670 E1 POP H 171 E671 1E02 MVI E,:02 2 bytes space in symtab 172 E673 7A MOV A,D 173 E674 F640 ORI :40 Set type is array 174 E676 57 MOV D,A Set flag 'subscripted' 175 E677 C9 RET 176 * 177 ************************ 178 * ENCODE AN ARRAY NAME * 179 ************************ 180 * 181 E678 16FF EARRN MVI D,:FF Code for name only 182 E67A C3BEE5 JMP :E5BE Encode array name 183 * 184 ***************************************** 185 * INSERT A NEW VARIABLE IN SYMBOL TABLE * 186 ***************************************** 187 * PAGE 04 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 188 * The variable name is inserted in the symbol table 189 * and the value is cleared. 190 * 191 * Entry: See CABB. 192 * Exit: HL: Points to 2nd T/L byte of entry. 193 * AF corrupted, BCDE preserved. 194 * 195 E67D CDB8CA EVARI CALL :CAB8 Insert var.name in symtab 196 E680 E5 PUSH H 197 E681 23 INX H HL pnts after 2nd T/L byte 198 of entry 199 E682 7A MOV A,D Get T/L of name 200 E683 E640 ANI :40 201 E685 C295E6 JNZ :E695 Jump if array type 202 203 * If number type: 204 205 E688 7A MOV A,D Get T/L of name 206 E689 E630 ANI :30 207 E68B FE20 CPI :20 208 E68D CA95E6 JZ :E695 Jump if string type 209 E690 CD9ECB CALL :CB9E Clear value in symtab 210 E693 E1 POP H 211 E694 C9 RET 212 213 * If string/array type: 214 215 E695 3600 EVI10 MVI M,:00 ) Clear pointer in symbtab 216 E697 23 INX H ) 217 E698 3600 MVI M,:00 ) 218 E69A E1 POP H 219 E69B C9 RET 220 * 221 ***************************** 222 * STORE QUOTED TEXT IN EBUF * 223 ***************************** 224 * 225 E69C 3618 L3E96 MVI M,:18 Code for quoted string (#18) 226 into EBUF 227 E69E CD18E0 CALL :E018 Update EBUF pointer 228 E6A1 1EFF MVI E,:FF Text must end with '"' 229 E6A3 C3B5E6 JMP :E6B5 Into common end 230 * 231 ********************************* 232 * STORE UNQUOTED STRING IN EBUF * 233 ********************************* 234 * 235 E6A6 1E01 L3E97 MVI E,:01 Text must end with ',' 236 E6A8 3619 MVI M,:19 Code for unquoted string 237 (#19) into EBUF 238 E6AA CD18E0 CALL :E018 Update EBUF pointer 239 E6AD C3B5E6 JMP :E6B5 Into common end 240 * 241 ************************ 242 * STORE TEXT INTO EBUF * 243 ************************ 244 * 245 * Text in DATA, REM and '***' statements is moved 246 * into the EBUF. 247 * 248 E6B0 CDD2DD L3E98 CALL :DDD2 Get char from line, neglect 249 tab + space PAGE 05 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 250 E6B3 1E02 MVI E,:02 Text must end with CR 251 Into common end 252 * 253 ************************************* 254 * COMMON END TEXT ENCODING ROUTINES * 255 ************************************* 256 * 257 * Entry: C : Points to 1st actual character to be 258 * stored. 259 * HL: Points to place for length byte in EBUF 260 * E : Handling switch: 261 * > 1: (but <#80): Text must end with CR 262 * = 1: Text will end with ',' (',' is no 263 * inserted into EBUF). 264 * <= 0: Text will end at '"' ('"' is not 265 * inserted into the EBUF). 266 * Exit: C : Points beyond text in input. 267 * HL: Points beyond stored text in EBUF. 268 * D : Length of stored text. 269 * A : Character which marks end of text. 270 * B preserved, E corrupted. 271 * 272 E6B5 E5 L3E99 PUSH H 273 E6B6 CD18E0 CALL :E018 Update EBUF pointer 274 E6B9 1600 MVI D,:00 Set length is 0 275 E6BB CDE0DD L3E100 CALL :DDE0 Get char from line 276 E6BE FE0D CPI :0D 277 E6C0 CADBE6 JZ :E6DB Jump if char is 'CR' 278 E6C3 FE2C CPI :2C 279 E6C5 CAE3E6 JZ :E6E3 Jump if char is ',' 280 E6C8 0C L3E101 INR C 281 E6C9 FE22 CPI :22 282 E6CB C2D3E6 JNZ :E6D3 Jump if char is not '"' 283 E6CE 1D DCR E 284 E6CF FADFE6 JM :E6DF If done: store length in 285 EBUF, quit 286 E6D2 1C INR E 287 288 * Character into EBUF: 289 290 E6D3 77 L3E102 MOV M,A Load char in EBUF 291 E6D4 CD18E0 CALL :E018 Update EBUF pointer 292 E6D7 14 INR D 293 E6D8 C3BBE6 JMP :E6BB Get next char 294 295 * If 'CR': 296 297 E6DB 1D L3E103 DCR E 298 E6DC FA0BDA JM :DA0B If E >= #80: Run 'SYNTAX 299 ERROR' 300 E6DF E3 L3E104 XTHL 301 E6E0 72 MOV M,D Length in EBUF entry 302 E6E1 E1 POP H 303 E6E2 C9 RET 304 305 * If ',': 306 307 E6E3 1D L3E105 DCR E 308 E6E4 CADFE6 JZ :E6DF If E=0: Store length in 309 EBUF, quit 310 E6E7 C3ABE8 JMP :E8AB incr E, get next char 311 * PAGE 06 DAI FIRMWARE 3E5BC-3E6FC V1.0 Rev.1 312 ******************************************** 313 * FIND BINARY OR UNITARY OPERATOR IN TABLE * 314 ******************************************** 315 * 316 * Entry/exit: See #3E6F6. 317 * 318 E6EA E5 L3E106 PUSH H 319 E6EB 2191CF LXI H,:CF91 Startaddr table 320 E6EE 1E00 L3E107 MVI E,:00 321 E6F0 CD34CA CALL :CA34 Find instr in table 322 E6F3 7E MOV A,M Get code from table 323 E6F4 E1 POP H 324 E6F5 C9 RET 325 * 326 ************************************* 327 * FIND AN UNITARY OPERATOR IN TABLE * 328 ************************************* 329 * 330 * Routine looks for a init. string beginning at 331 * C in table. 332 * 333 * Entry: C : Points to input. 334 * Exit: CY=0: Not found: 335 * C : Points to 1st valid character 336 * after entry address. 337 * A : Contains code info 0. 338 * DE = 0, BHL preserved. 339 * CY=1: Found: 340 * C : Points beyond string found. 341 * A : Code byte from table. 342 * DE = 0, BHL preserved. 343 * 344 E6F6 E5 L3E108 PUSH H 345 E6F7 21D8CF LXI H,:CFD8 Startaddr table 346 E6FA C3EEE6 JMP :E6EE Into previous routine 347 * 348 * 349 * 350 E6FD END *************************** * S Y M B O L T A B L E * *************************** EARRN E678 EVARI E67D EVI10 E695 EVR10 E5BE EVR50 E653 EVR55 E659 L3E100 E6BB L3E101 E6C8 L3E102 E6D3 L3E103 E6DB L3E104 E6DF L3E105 E6E3 L3E106 E6EA L3E107 E6EE L3E108 E6F6 L3E85 E5BC L3E87 E60E L3E88 E60F L3E89 E626 L3E90 E62E L3E96 E69C L3E97 E6A6 L3E98 E6B0 L3E99 E6B5