PAGE 01 DAI FIRMWARE 0E602-0E79C V1.1 002 ORG :E602 003 * 004 * 005 * 006 ******************** 007 * RUN SCREEN ERROR * 008 ******************** 009 * 010 * Entry: A: Error code: 01: Off screen. 011 * 02: Colour not available. 012 E602 FE01 SCRER CPI :01 Code is 1? 013 E604 3E11 MVI A,:11 014 E606 CAF5D9 JZ :D9F5 Then run error 'OFF SCREEN' 015 E609 3E10 MVI A,:10 Else: run error 016 E60B C3F5D9 JMP :D9F5 'COLOUR NOT AVAILABLE' 017 * 018 *********************** 019 * RUN basiccmd COLORT * 020 *********************** 021 * 022 E60E CD1CE6 RCOLT CALL :E61C Get colours in scratch area 023 E611 EF RST 5 Set text colours 024 E612 06 DATA :06 025 E613 B7 ORA A No special action 026 E614 C9 RET 027 * 028 *********************** 029 * RUN basiccmd COLORG * 030 *********************** 031 * 032 E615 CD1CE6 RCOLG CALL :E61C Get colours in scratch area 033 E618 EF RST 5 Set graphic colours 034 E619 1B DATA :1B 035 E61A B7 ORA A No special action 036 E61B C9 RET 037 * 038 *********************************** 039 * GET 4 COLOURS INTO SCRATCH AREA * 040 *********************************** 041 * 042 * Colour data from a program line are stored in 043 * scratch area SCOLT/SCOLG (#0119-011C). 044 * 045 * Exit: HL: Points to start scratch area. 046 * 047 E61C 211901 R4COL LXI H,:0119 Startaddr SCOLT/SCOLG area 048 E61F E5 PUSH H 049 E620 3E0F R4C10 MVI A,:0F 050 E622 CD43E7 CALL :E743 Get one colour (0-15) 051 E625 77 MOV M,A Store it in scratch area 052 E626 23 INX H 053 E627 7D MOV A,L 054 E628 FE1D CPI :1D 4 colours done? 055 E62A C220E6 JNZ :E620 Next if not 056 E62D E1 POP H 057 E62E C9 RET 058 * 059 ******************** 060 * RUN basiccmd DIM * 061 ******************** 062 * 063 * Entry: BC: points to program line. PAGE 02 DAI FIRMWARE 0E602-0E79C V1.1 064 * 065 E62F 0A RDIM LDAX B Get nr of items 066 E630 03 INX B 067 E631 B7 RDM05 ORA A 068 E632 C8 RZ Abort if no items or ready 069 E633 3D DCR A Item count 070 E634 F5 PUSH PSW Preserve count 071 E635 CD5AE9 CALL :E95A Get pnr to array in HL; 072 type in A 073 E638 E5 PUSH H Preserve pntr 074 E639 CD5CCE CALL :CE5C Erase array if existing 075 E63C E630 ANI :30 Get type only 076 E63E 110400 LXI D,:0004 Length array element if 077 FPT/INT 078 E641 FE20 CPI :20 String type? 079 E643 C248E6 JNZ :E648 Jump if not 080 E646 1E02 MVI E,:02 Length STR array element 081 E648 0A RDM10 LDAX B Get number of elements 082 E649 03 INX B 083 E64A 67 MOV H,A ) In H and in L 084 E64B 6F MOV L,A ) 085 E64C EB XCHG 086 087 * Calculate total required length: 088 089 E64D CD4FE7 RDM20 CALL :E74F Get length next dimension 090 E650 F5 PUSH PSW Remember it 091 E651 3C INR A Length +1 092 E652 CDF0ED CALL :EDF0 Calc reqd space 093 E655 DA15DA JC :DA15 Run error 'NUMBER OUT 094 OF RANGE' if total space 095 > 64K 096 E658 15 DCR D nr of elements -1 097 E659 C24DE6 JNZ :E64D Next element if not ready 098 099 * Find space in heap: 100 101 E65C 25 DCR H 102 E65D 24 INR H 103 E65E FA15DA JM :DA15 Run error 'NUMBER OUT OF 104 RANGE' if > 32K reserved 105 E661 19 DAD D 106 E662 23 INX H Size of space reqd in HL 107 E663 D5 PUSH D 108 E664 EB XCHG 109 E665 CD8BE6 CALL :E68B Get space of size needed 110 E668 D1 POP D 111 E669 73 MOV M,E Store nr of elements 112 E66A 19 DAD D Last element 113 114 * Elements into heap: 115 116 E66B F1 RDM30 POP PSW Get length 1 element 117 E66C 77 MOV M,A Store it in memory 118 E66D 2B DCX H 119 E66E 1D DCR E 120 E66F C26BE6 JNZ :E66B Next element to memory 121 * 122 E672 EB XCHG 123 E673 E1 POP H Get pntr to array 124 E674 73 MOV M,E ) 125 E675 23 INX H ) Set pointer PAGE 03 DAI FIRMWARE 0E602-0E79C V1.1 126 E676 72 MOV M,D ) 127 E677 F1 POP PSW Get item count in A 128 E678 C331E6 JMP :E631 Next item 129 * 130 **************************** 131 * part of RUN TALK (0EE94) * 132 **************************** 133 * 134 * Entry: A: Code for osc.channel SHR 1. 135 * 136 E67B 29 MPT47 DAD H 137 E67C 119402 RTK50 LXI D,:0294 Addr volumes osc. 0,1 138 E67F E601 ANI :01 Code SHR 1 only 139 E681 83 ADD E 140 E682 5F MOV E,A DE=#0294 for osc.0,1; 141 DE=#0295 for osc.2,N 142 E683 7C MOV A,H Get mask 143 E684 2F CMA Complement it 144 E685 EB XCHG Mask + vol in DE, addr 145 POR0M/POR1M in HL 146 E686 A6 ANA M Part to be preserved from 147 old POR0M/POR1M 148 E687 B3 ORA E Add new volume 149 E688 C340EA JMP :EA40 Continu 150 * 151 ********************** 152 * REQUEST HEAP SPACE * 153 ********************** 154 * 155 * Part of Run 'DIM' (0E665). 156 * Requests space from Heap and fills it with 157 * zeroes. 158 * 159 * Entry: DE: Size needed. 160 * Exit: HL: Points to data area (after length 161 * bytes). 162 * AFDE corrupted. 163 * 164 E68B 15 ZHREQ DCR D 165 E68C 14 INR D 166 E68D FA15DA JM :DA15 Run error 'NUMBER OUT OF 167 RANGE' if >32K reqd 168 E690 CDC5D1 CALL :D1C5 Run Heap request 169 E693 23 INX H 170 E694 23 INX H HL pnts after length byte 171 E695 E5 PUSH H 172 E696 EB XCHG Start data area in DE 173 E697 19 DAD D End area in HL 174 E698 AF XRA A 175 E699 CD7CDE CALL :DE7C Load bank with '0' 176 E69C E1 POP H 177 E69D C9 RET 178 * 179 ******************* 180 * RUN basiccmd UT * 181 ******************* 182 * 183 * Valid as direct command only. 184 * 185 E69E AF RUT XRA A 186 E69F 32B902 STA :02B9 Enable complete keyb scan 187 E6A2 CF RST 1 Go to utility PAGE 04 DAI FIRMWARE 0E602-0E79C V1.1 188 E6A3 09 DATA :09 189 * 190 ********************** 191 * RUN basiccmd CALLM * 192 ********************** 193 * 194 E6A4 21B3E6 RCALM LXI H,:E6B3 Returnaddr from Utility 195 E6A7 E5 PUSH H on stack 196 E6A8 CDF8E6 CALL :E6F8 Get UT addr in HL 197 E6AB E5 PUSH H UT addr on stack 198 E6AC 0A LDAX B Get next expr 199 E6AD FEFF CPI :FF End marker? 200 E6AF C263E9 JNZ :E963 If not: Get varptr of given 201 variable in HL, T/L in A 202 E6B2 03 INX B 203 E6B3 B7 RCM10 ORA A No special action 204 E6B4 C9 RET On entry: Goto UT addr 205 On exit: Back to Basic 206 monitor 207 * 208 ********************** 209 * RUN basiccmd CLEAR * 210 ********************** 211 * 212 * 213 ************* 214 * RUN CLEAR * 215 ************* 216 * 217 * Routine is completely modified. 218 * Max. useable heap space in V1.0 was #7FFF-4. 219 * Now it is #7FFF. 220 * Doesnot set up anymore a complete new heap, but 221 * just empties heap and symboltable entries and 222 * shifts the program to after the new heap. 223 * 224 E6B5 CDF8E6 RCLEAR CALL :E6F8 ] Get reqd space in HL 225 E6B8 E5 PUSH H ] Preserve it 226 E6B9 7C MOV A,H ] Get hibyte in A 227 E6BA 2B DCX H ] 228 E6BB 2B DCX H ] 229 E6BC 2B DCX H ] 230 E6BD 2B DCX H ] Reqd space -4 231 E6BE B4 ORA H ] 232 E6BF FA15DA JM :DA15 ] Run 'NUMBER OUT OF RANGE' 233 error if < 4 or > 32K. 234 E6C2 D1 POP D ] Get reqd space in DE 235 E6C3 2A9D02 LHLD :029D ] Get old heapsize 236 E6C6 EB XCHG ] 237 E6C7 229D02 SHLD :029D ] Store new heapsize 238 E6CA C314D2 JMP :D214 ] 239 E6CD FF DATA :FF ] 240 * 241 ****************************** 242 * Run basiccmds TRON - TROFF * 243 ****************************** 244 * 245 * Sets or resets the trace flag. 246 * 247 * RTRON: Set trace flag. 248 * RTROF: Reset trace flag. 249 * PAGE 05 DAI FIRMWARE 0E602-0E79C V1.1 250 * Entry: none. 251 * Exit: Z=1: Flag reset. 252 * Z=0: Flag set. 253 * 254 E6CE 3EFF RTRON MVI A,:FF 255 E6D0 321501 RTR10 STA :0115 Set trace flag 256 E6D3 B7 ORA A No special action 257 E6D4 C9 RET 258 * 259 E6D5 AF RTROF XRA A 260 E6D6 C3D0E6 JMP :E6D0 Reset trace flag 261 * 262 ******************* 263 * READ LINENUMBER * 264 ******************* 265 * 266 * Entry: BC: Points to linenumber. 267 * Exit: Z=0: Linenumber in HL. 268 * Z=1: HL preserved. 269 * BC updated, DE preserved, AF corrupted. 270 * 271 E6D9 E5 RLN PUSH H 272 E6DA 0A LDAX B 273 E6DB 03 INX B 274 E6DC 67 MOV H,A ) 275 E6DD 0A LDAX B ) Get linenr in HL 276 E6DE 03 INX B ) 277 E6DF 6F MOV L,A ) 278 E6E0 B4 ORA H 279 E6E1 CAE5E6 JZ :E6E5 Abort if linenr is 0 280 E6E4 E3 XTHL Linenr on stack 281 E6E5 E1 RLN10 POP H Old HL or linenr in HL 282 E6E6 C9 RET 283 * 284 ********************************************* 285 * READ LINENUMBER AND FIND IT IN TEXTBUFFER * 286 ********************************************* 287 * 288 * Entry: BC: Points to linenumber. 289 * Exit: BC updated, DE preserved, AF corrupted 290 * (RLNF) or preserved (RLNFI). 291 * HL: Points to 1st linenr >= reqd. number. 292 * CY=1: Linenumber found. 293 * CY=0: Not found. 294 * 295 E6E7 CDD9E6 RLNF CALL :E6D9 Get linenr in HL 296 E6EA C3F6CA JMP :CAF6 Find it in textbuffer 297 298 * Idem as RLNF, but with error reporting: 299 300 E6ED F5 RLNFI PUSH PSW 301 E6EE CDE7E6 CALL :E6E7 Read linenr and find it 302 E6F1 3E04 MVI A,:04 303 E6F3 D2F5D9 JNC :D9F5 Run error 'UNDEFINED NUMBER' 304 if not found 305 E6F6 F1 POP PSW 306 E6F7 C9 RET 307 * 308 ******************************************* 309 * RUN A INT EXPRESSION WITH 2-BYTE RESULT * 310 ******************************************* 311 * PAGE 06 DAI FIRMWARE 0E602-0E79C V1.1 312 * Evaluates a 16-bit INT expression (in range 0- 313 * FFFF). The result is in HL. 314 * 315 * Entry: BC: Points to expression. 316 * Exit: HL: Result. 317 * BC updated, AFDE corrupted. 318 * 319 E6F8 F5 REXI2 PUSH PSW 320 E6F9 D5 PUSH D 321 E6FA CD19E8 CALL :E819 Eval arguments in num expr 322 Result in MACC or in WORKE 323 E6FD 7C MOV A,H 324 E6FE B5 ORA L 325 E6FF CA10E7 JZ :E710 Jump if result in MACC 326 327 * If result in WORKE: 328 329 E702 7E MOV A,M ) 330 E703 23 INX H ) Check if > 2 bytes 331 E704 B6 ORA M ) 332 E705 C215DA JNZ :DA15 Then run error 'NUMBER OUT 333 OF RANGE' 334 E708 23 INX H 335 E709 7E MOV A,M ) 336 E70A 23 INX H ) Get result in HL 337 E70B 6E MOV L,M ) 338 E70C 67 MOV H,A ) 339 E70D D1 POP D 340 E70E F1 POP PSW 341 E70F C9 RET 342 343 * If result in MACC: 344 345 E710 C5 RX210 PUSH B 346 E711 E7 RST 4 Copy MACC to reg A,B,C,D 347 E712 15 DATA :15 348 E713 B0 ORA B Check if > 2 bytes 349 E714 C215DA JNZ :DA15 Then run error 'NUMBER OUT 350 OF RANGE' 351 E717 6A MOV L,D ) Result in HL 352 E718 61 MOV H,C ) 353 E719 C1 POP B 354 E71A D1 POP D 355 E71B F1 POP PSW 356 E71C C9 RET 357 * 358 ******************************* 359 * RUN A 1-BYTE INT EXPRESSION * 360 ******************************* 361 * 362 * Evaluates a 8-bit INT expression (range 0- 363 * FF). Result in A. 364 * 365 * Entry: BC: Points to expression. 366 * Exit: A: Result. 367 * BC updated, DEHL preserved. 368 * 369 E71D D5 REXI1 PUSH D 370 E71E E5 PUSH H 371 E71F CD19E8 CALL :E819 Eval arguments in num expr 372 Result in MACC or WORKE 373 E722 7C MOV A,H PAGE 07 DAI FIRMWARE 0E602-0E79C V1.1 374 E723 B5 ORA L 375 E724 CA36E7 JZ :E736 If HL=0: Get result frm MACC 376 377 * Result in WORKE: 378 379 E727 7E MOV A,M ) 380 E728 23 INX H ) 381 E729 B6 ORA M ) Check if > 1 byte 382 E72A 23 INX H ) 383 E72B B6 ORA M ) 384 E72C C215DA JNZ :DA15 Then run error 'NUMBER OUT 385 OF RANGE' 386 E72F 23 INX H 387 E730 7E MOV A,M Get result in A 388 E731 E1 POP H 389 E732 D1 POP D 390 E733 C9 RET 391 392 * If result in MACC (also entry from REXF1): 393 394 E734 D5 RX110 PUSH D 395 E735 E5 PUSH H 396 E736 E1 RX120 POP H 397 E737 C5 PUSH B 398 E738 E7 RST 4 Copy MACC to reg A,B,C,D 399 E739 15 DATA :15 400 E73A B0 ORA B ) Check if > 1 byte 401 E73B B1 ORA C ) 402 E73C C215DA JNZ :DA15 Then run error 'NUMBER OUT 403 OF RANGE' 404 E73F 7A MOV A,D Get result in A 405 E740 C1 POP B 406 E741 D1 POP D 407 E742 C9 RET 408 * 409 ************************************************ 410 * RUN 1-BYTE INT EXPRESSION WITH LIMITED RANGE * 411 ************************************************ 412 * 413 * Entry: BC: Points to expression. 414 * A: Range of arguments (<=FE). 415 * Exit: BC updated, DEHL preserved, F corrupted. 416 * A: Result. 417 * 418 E743 D5 REXIL PUSH D 419 E744 57 MOV D,A Argument range in D 420 E745 CD1DE7 CALL :E71D Get value of argument in A 421 E748 14 INR D 422 E749 BA CMP D Out of range ? Then run 423 E74A D215DA JNC :DA15 error 'NUMBER OUT OF RANGE' 424 E74D D1 POP D 425 E74E C9 RET 426 * 427 ********************************************* 428 * CHECK VARIABLE TYPE AND GET ITS INT VALUE * 429 ********************************************* 430 * 431 * Entry: BC: Points to expression. 432 * Exit: Error: If string type. 433 * If OK: Value in A (FPT: converted to INT). 434 * BC updated, DEHL preserved. 435 * PAGE 08 DAI FIRMWARE 0E602-0E79C V1.1 436 E74F 0A REX1 LDAX B Get var. type byte 437 E750 03 INX B 438 E751 FE20 CPI :20 String type? 439 E753 CA1ADA JZ :DA1A Then run error 'TYPE 440 MISMATCH' 441 E756 FE10 CPI :10 INT type? 442 E758 CA1DE7 JZ :E71D Then get value in A 443 444 * If FPT: 445 446 E75B CD08E8 REXF1 CALL :E808 Get value in MACC 447 E75E E7 RST 4 Change it to INT 448 E75F 48 DATA :48 449 E760 C334E7 JMP :E734 Get value in A 450 * 451 *======================================* 452 * RUN EXPRESSIONS WITH OPERATOR PREFIX * 453 *======================================* 454 * 455 * #E763-EBED evaluate logical, FPT, INT or STR 456 * expressions in 'operator prefix' format. 457 * 458 * Register allocation during operation: 459 * INT/FPT: D=0: MACC empty. 460 * E: Operator. 461 * HL=0: Result in MACC. 462 * HL<>0: HL points to result. 463 * STR: HL: Points to string. 464 * E: Type of string (constant [0], 465 * variable [1], temporary [2]). 466 * 467 ********************************* 468 * EVALUATE A LOGICAL EXPRESSION * 469 ********************************* 470 * 471 E763 1600 REXPL MVI D,:00 MACC free 472 E765 0A LDAX B Get byte 473 E766 E660 ANI :60 474 E768 FE40 CPI :40 String ? 475 E76A CABDE7 JZ :E7BD Then jump 476 E76D 0A LDAX B Get byte 477 E76E E61F ANI :1F 478 E770 FE18 CPI :18 Relational operator? 479 E772 DA50E8 JC :E850 If not: eval expr which 480 begins with num operator 481 E775 03 INX B 482 E776 FE1A CPI :1A Bracket? 483 E778 CA63E7 JZ :E763 Then ignore it 484 485 * Logical AND or OR: 486 487 E77B F5 PUSH PSW Preserve type of operation 488 E77C CD63E7 CALL :E763 Get 1st operand 489 E77F F5 PUSH PSW Preserve it 490 E780 CD63E7 CALL :E763 Get 2nd operand 491 E783 D1 POP D 1st operand in D 492 E784 F5 PUSH PSW Preserve 2nd operand 493 E785 A2 ANA D AND operation 494 E786 5F MOV E,A Result in E 495 E787 F1 POP PSW 2nd operand in A 496 E788 B2 ORA D OR operation 497 E789 57 MOV D,A Result in D PAGE 09 DAI FIRMWARE 0E602-0E79C V1.1 498 E78A F1 POP PSW Type of operation in F 499 E78B 7A MOV A,D Result OR in A 500 E78C EA90E7 JPE :E790 Quit if OR 501 E78F 7B MOV A,E Result AND in A 502 E790 C9 RXL10 RET 503 * 504 ****************************** 505 * EVALUATE STRING EXPRESSION * 506 ****************************** 507 * 508 * This routine returns temporary strings before 509 * they are really free. 510 * The heap is cleared if it is a temporary string. 511 * 512 * Entry: BC: Points to expression. 513 * Exit: BC updated, AFD corrupted. 514 * HL: Points to string. 515 * E: Status. 516 * 517 E791 CD9DE7 REXSR CALL :E79D Evaluate string expr 518 E794 7B MOV A,E Get status 519 E795 FE02 CPI :02 Temporary ? 520 E797 E5 PUSH H 521 E798 CC87D1 CZ :D187 Then clear heap entry 522 E79B E1 POP H 523 E79C C9 RET 524 * 525 * 526 * 527 E79D END *************************** * S Y M B O L T A B L E * *************************** MPT47 E67B R4C10 E620 R4COL E61C RCALM E6A4 RCLEAR E6B5 RCM10 E6B3 RCOLG E615 RCOLT E60E RDIM E62F RDM05 E631 RDM10 E648 RDM20 E64D RDM30 E66B REX1 E74F REXF1 E75B REXI1 E71D REXI2 E6F8 REXIL E743 REXPL E763 REXSR E791 RLN E6D9 RLN10 E6E5 RLNF E6E7 RLNFI E6ED RTK50 E67C RTR10 E6D0 RTROF E6D5 RTRON E6CE RUT E69E RX110 E734 RX120 E736 RX210 E710 RXL10 E790 SCRER E602 ZHREQ E68B