+Lee Stewart Posted July 27, 2023 Share Posted July 27, 2023 (edited) First of all, MPY is much more expensive than CLR---not sure it would be better. Secondly, if your code would actually run, it won't work because the last statement has no effect on FAC+6. The autoincrement occurs after the MPY. This should do it: MPY *R3+,*R3+ More importantly (per @Asmusr’s comment below), it will not work because the destination operand must be a register proper. ...lee Edited July 29, 2023 by Lee Stewart CORRECTIONS 1 Quote Link to comment Share on other sites More sharing options...
Asmusr Posted July 28, 2023 Share Posted July 28, 2023 MPY *R3,*R3+ is not valid. The second operand must be a register. 4 Quote Link to comment Share on other sites More sharing options...
RXB Posted October 9, 2023 Share Posted October 9, 2023 ZOOM today I was explaining the problem with RXB 2024 using the % symbol in ROM to indicate a Integer Whole Number. Like B%=10 would Integer 10 and not like normal XB would be B=10 but 10 would be a 8 byte Floating Point number i.e. >40 >0A >00 >00 >00 >00 >00 >00 Anyway look at the code in XB ROM at line 382 you see % in the mix with other symbols uncer CPNIL and at line 405 you see % is CPNIL so you would think if you change CPNIL to someplace else it would go that to that address, but it never does. Why? Well at 3932 you see it just only goes to B *R7 and never gets past that point. If I change CPNIL it just crashes everthing. If you see a way to make this work let me know! Spoiler 99/4 ASSEMBLER GVWITES PAGE 0001 0001 ************************************************************ 0003 0004 7016 CNS EQU >7016 * GROM ADDRESS'S 0005 7492 PWRZZ EQU >7492 * 0006 76C2 LOGZZ EQU >76C2 * 0007 75CA EXPZZ EQU >75CA * 0008 783A SQRZZ EQU >783A * 0009 78B2 COSZZ EQU >78B2 * 0010 78C0 SINZZ EQU >78C0 * 0011 7940 TANZZ EQU >7940 * 0012 797C ATNZZ EQU >797C * 0013 79EC GRINT EQU >79EC * 0014 7A90 ROLOUT EQU >7A90 * 0015 7AC4 ROLIN EQU >7AC4 * 0016 7B88 CRUNCH EQU >7B88 * 0017 7F6E PUTCHR EQU >7F6E * 0018 * 0019 * NOTE RXB CHANGE: All lables with $ changed to Z 0020 * LPAR$ is now LPARZ or WARN$$ is now WARNZZ 0021 * this was to use same names as GPL source 0022 * 0023 ************************************************************ 0025 0026 * 0027 6000 LWCNS EQU >6000 0028 * 0029 4000 WRVDP EQU >4000 Write enable for VDP 0030 8800 XVDPRD EQU >8800 Read VDP data 0031 8C00 XVDPWD EQU >8C00 Write VDP data 0032 9800 XGRMRD EQU >9800 Read GROM data 0033 0402 GRMWAX EQU >9C02->9800 Write GROM address 0034 0002 GRMRAX EQU >9802->9800 Read GROM address 0035 0400 GRMWDX EQU >9C00->9800 GROM write data 0036 * 0037 CB00 KEYTAB EQU >CB00 ADDRESS OF KEYWORD TABLE GROM 0038 * 0039 7D00 NEGPAD EQU >7D00 0040 * 0041 8300 PAD EQU >8300 0042 8301 PAD1 EQU >8301 0043 8302 PAD2 EQU >8302 0044 8303 PAD3 EQU >8303 0045 8304 PABPTR EQU >8304 0046 8306 PAD6 EQU >8306 0047 8306 CCPPTR EQU >8306 0048 8308 PAD8 EQU >8308 0049 8308 CCPADR EQU >8308 0050 830A RAMPTR EQU >830A 0051 830A CALIST EQU RAMPTR 0052 830C PADC EQU >830C 0053 830C BYTE EQU >830C 0054 8310 PROAZ EQU >8310 0055 8310 VAR5 EQU PROAZ 0056 8312 PZ EQU >8312 0057 8312 LINUM EQU PZ 0058 8314 OEZ EQU >8314 0059 8316 QZ EQU >8316 0060 8316 XFLAG EQU QZ 0061 8316 VAR9 EQU QZ 99/4 ASSEMBLER EQUATES PAGE 0002 0062 8317 DSRFLG EQU >8317 0063 8317 FORNET EQU DSRFLG 0064 8318 STRSP EQU >8318 0065 831A CZ EQU >831A 0066 831A STREND EQU CZ 0067 831A WSM EQU CZ 0068 831C SREF EQU >831C * Temporary string pointer 0069 831C WSM2 EQU SREF * Temporary string pointer 0070 831E WSM4 EQU >831E * Start of current statement 0071 831E SMTSRT EQU WSM4 * Start of current statement 0072 8320 WSM6 EQU >8320 * Screen address 0073 8320 VARW EQU WSM6 * Screen address 0074 8321 VARW1 EQU >8321 0075 8322 ERRCOD EQU >8322 * Return error code from ALC 0076 8322 WSM8 EQU ERRCOD * Return error code from ALC 0077 8323 ERRCO1 EQU >8323 0078 8324 STVSPT EQU >8324 * Value-stack base 0079 8326 RTNADD EQU >8326 0080 8328 NUDTAB EQU >8328 0081 832A VARA EQU >832A * Ending display location 0082 832C PGMPTR EQU >832C * Program text pointer 0083 832D PGMPT1 EQU >832D 0084 832E EXTRAM EQU >832E * Line number table pointer 0085 832F EXTRM1 EQU >832F 0086 8330 STLN EQU >8330 * Start of line number table 0087 8332 ENLN EQU >8332 * End of line number table 0088 8334 DATA EQU >8334 * Data pointer for READ 0089 8336 LNBUF EQU >8336 * Line table pointer for READ 0090 8338 INTRIN EQU >8338 * Add of intrinsic poly constant 0091 833A SUBTAB EQU >833A * Subprogram symbol table 0092 833E SYMTAB EQU >833E * Symbol table pointer 0093 833F SYMTA1 EQU >833F 0094 8340 FREPTR EQU >8340 * Free space pointer 0095 8342 CHAT EQU >8342 * Current charater/token 0096 8343 BASE EQU >8343 * OPTION BASE value 0097 8344 PRGFLG EQU >8344 * Program/imperative flag 0098 8345 FLAG EQU >8345 * General 8-bit flag 0099 8346 BUFLEV EQU >8346 * Crunch-buffer destruction level 0100 8348 LSUBP EQU >8348 * Last subprogram block on stack 0101 834A FAC EQU >834A * Floating-point ACcurmulator 0102 834B FAC1 EQU >834B 0103 834C FAC2 EQU >834C 0104 834D FAC3 EQU >834D 0105 834E FAC4 EQU >834E 0106 834F FAC5 EQU >834F 0107 8350 FAC6 EQU >8350 0108 8351 FAC7 EQU >8351 0109 8352 FAC8 EQU >8352 0110 8353 FAC9 EQU >8353 0111 8354 FAC10 EQU >8354 0112 8354 FLTNDX EQU FAC10 0113 8354 FDVSR EQU FAC10 0114 8355 FAC11 EQU >8355 0115 8355 SCLEN EQU FAC11 0116 8355 FDVSR1 EQU FAC11 0117 8356 FAC12 EQU >8356 0118 8356 FDVSR2 EQU FAC12 0119 8357 FAC13 EQU >8357 0120 8358 FAC14 EQU >8358 99/4 ASSEMBLER EQUATES PAGE 0003 0121 8359 FAC15 EQU >8359 0122 835A FAC16 EQU >835A 0123 835C FDVSR8 EQU >835C * Floating-point ARGument 0124 835C ARG EQU FDVSR8 * Floating-point ARGument 0125 835D ARG1 EQU >835D 0126 835E ARG2 EQU >835E 0127 835F ARG3 EQU >835F 0128 8360 ARG4 EQU >8360 0129 8364 ARG8 EQU >8364 0130 8365 ARG9 EQU >8365 0131 8366 ARG10 EQU >8366 0132 836B FAC33 EQU >836B 0133 836C TEMP2 EQU >836C 0134 836C FLTERR EQU TEMP2 0135 836D TYPE EQU >836D 0136 836E VSPTR EQU >836E * Value stack pointer 0137 836F VSPTR1 EQU >836F 0138 8372 STKDAT EQU >8372 0139 8373 STKADD EQU >8373 0140 8373 STACK EQU >8373 0141 8374 PLAYER EQU >8374 0142 8375 KEYBRD EQU >8375 0143 8375 SIGN EQU KEYBRD 0144 8376 JOYY EQU >8376 * Exponent in floating-point 0145 8376 EXP EQU JOYY 0146 8377 JOYX EQU >8377 0147 8378 RANDOM EQU >8378 0148 8379 TIME EQU >8379 0149 837A MOTION EQU >837A 0150 837B VDPSTS EQU >837B 0151 837C STATUS EQU >837C 0152 837D CHRBUF EQU >837D 0153 837E YPT EQU >837E 0154 837F XPT EQU >837F 0155 8384 RAMTOP EQU >8384 0156 8389 RAMFLG EQU >8389 * ERAM flag 0157 83BA STKEND EQU >83BA 0158 83AE STND12 EQU STKEND-12 0159 83C0 CRULST EQU >83C0 0160 83CB SAVEG EQU >83CB 0161 83D2 SADDR EQU >83D2 0162 83D4 RAND16 EQU >83D4 0163 * 0164 83E0 WS EQU >83E0 0165 83E1 R0LB EQU >83E1 0166 83E3 R1LB EQU >83E3 0167 83E5 R2LB EQU >83E5 0168 83E7 R3LB EQU >83E7 0169 83E9 R4LB EQU >83E9 0170 83EB R5LB EQU >83EB 0171 83ED R6LB EQU >83ED 0172 83EF R7LB EQU >83EF 0173 83F1 R8LB EQU >83F1 0174 83F3 R9LB EQU >83F3 0175 83F5 R10LB EQU >83F5 0176 83F7 R11LB EQU >83F7 0177 83F9 R12LB EQU >83F9 0178 83FB R13LB EQU >83FB 0179 83FD R14LB EQU >83FD 99/4 ASSEMBLER EQUATES PAGE 0004 0180 83FF R15LB EQU >83FF 0181 * 0182 * VDP variables 0183 0376 SYMBOL EQU >0376 * Saved symbol table pointer 0184 038A ERRLN EQU >038A * On-error line pointer 0185 0392 TABSAV EQU >0392 * Saved main symbol table ponter 0186 03C0 VROAZ EQU >03C0 * Temporary VDP Roll Out Area 0187 03DC FPSIGN EQU >03DC 0188 0820 CRNBUF EQU >0820 * CRuNch BUFfer address 0189 08BE CRNEND EQU >08BE * CRuNch buffer END 0190 ************************************************************ 0191 6000 AORG >6000 0193 0194 * PAGE SELECTOR FOR PAGE 1 0195 6000 PAGE1 EQU $ >6000 0196 6000 0002 C2 DATA 2 0 0197 * PAGE SELECTOR FOR PAGE 2 0198 6002 PAGE2 EQU $ >6002 0199 6002 00 C7 BYTE >00 0200 6003 07 CBH7 BYTE >07 2 0201 6004 0A CBHA BYTE >0A 0202 6005 94 CBH94 BYTE >94 4 0203 6006 0028 C40 DATA 40 6 0204 6008 0064 C100 DATA 100 8 0205 600A 1000 C1000 DATA >1000 A 0206 600C 0000 DATA 0 C 0207 600E 4001 FLTONE DATA >4001 E 0208 ************************************************************ 0209 * XML table number 7 for Extended Basic - must have 0210 * it's origin at >6010 0211 ************************************************************ 0212 * 0 1 2 3 4 5 6 0213 6010 619C DATA COMPCG,GETSTG,MEMCHG,CNSSEL,PARSEG,CONTG,EXECG 6012 61A2 6014 72CE 6016 6070 6018 6470 601A 64C4 601C 6500 0214 * 7 8 9 A B C D 0215 601E 61BA DATA VPUSHG,VPOP,PGMCH,SYMB,SMBB,ASSGNV,FBSYMB 6020 6C2A 6022 6410 6024 61B4 6026 61A8 6028 61AE 602A 618C 0216 * E F 0217 602C 6EE2 DATA SPEED,CRNSEL 602E 6076 0218 ************************************************************ 0219 * XML table number 8 for Extended Basic - must have 0220 * it's origin at >6030 0221 ************************************************************ 0222 * 0 1 2 3 4 5 6 7 0223 6030 74AA DATA CIF,CONTIN,RTNG,SCROLL,IO,GREAD,GWRITE,DELREP 6032 65CC 6034 6630 6036 7ADA 99/4 ASSEMBLER XML359 PAGE 0005 6038 7B48 603A 7EB4 603C 7ED8 603E 7EF4 0224 * 8 9 A B C D E 0225 6040 7F7E DATA MVDN,MVUP,VGWITE,GVWITE,GREAD1,GWITE1,GDTECT 6042 6F98 6044 7FC0 6046 7FDA 6048 7EA6 604A 7ECA 604C 6050 0226 * F 0227 604E 7C56 DATA PSCAN 0228 0229 * Determine if and how much ERAM is present 0230 6050 D80B GDTECT MOVB R11,@PAGE1 First enable page 1 ROM 6052 6000 0231 *----------------------------------------------------------- 0232 * Replace following line 6/16/81 0233 * (Extended Basic must be made to leave enough space at 0234 * top of RAM expansion for the "hooks" left by the 99/4A 0235 * for TIBUG.) 0236 * SETO R0 Start at >FFFF 0237 * with 0238 * LI R0,>FFE7 Start at >FFE7 0239 ************************************************************ 0240 * RXB 2020 change for PRAM command 0241 6054 C020 MOV @RAMTOP,R0 PRAM sets RAMTOP value 6056 8384 0242 *----------------------------------------------------------- 0243 6058 D40B MOVB R11,*R0 Write a byte of data 0244 605A 940B CB R11,*R0 Read and compare the data 0245 605C 1306 JEQ DTECT2 If matches-found ERAM top 0246 *----------------------------------------------------------- 0247 * Change the following line 6/16/81 0248 * AI R0,->2000 Else drop down 8K 0249 605E 0200 LI R0,>DFFF Else drop down 8K 6060 DFFF 0250 *----------------------------------------------------------- 0251 6062 D40B MOVB R11,*R0 Write a byte of data 0252 6064 940B CB R11,*R0 Read and compare the data 0253 6066 1301 JEQ DTECT2 If matches-found ERAM top 0254 6068 04C0 CLR R0 No match so no ERAM 0255 606A C800 DTECT2 MOV R0,@RAMTOP Set the ERAM top 606C 8384 0256 606E 045B RT And return to GPL 0257 6070 0202 CNSSEL LI R2,CNS 6072 7016 0258 6074 1002 JMP PAGSEL 0259 6076 0202 CRNSEL LI R2,CRUNCH 6078 7B88 0260 * Select page 2 for CRUNCH and CNS 0261 607A 05E0 PAGSEL INCT @STKADD Get space on subroutine stack 607C 8373 0262 607E D1E0 MOVB @STKADD,R7 Get stack pointer 6080 8373 0263 6082 0987 SRL R7,8 Shift to use as offset 0264 6084 D9CB MOVB R11,@PAD(R7) Save return addr to GPL interp 99/4 ASSEMBLER XML359 PAGE 0006 6086 8300 0265 6088 D9E0 MOVB @R11LB,@PAD1(R7) 608A 83F7 608C 8301 0266 608E D80B MOVB R11,@PAGE2 Select page 2 6090 6002 0267 6092 0692 BL *R2 Do the conversion 0268 6094 D80B MOVB R11,@PAGE1 Reselect page 1 6096 6000 0269 6098 D1E0 MOVB @STKADD,R7 Get subroutine stack pointer 609A 8373 0270 609C 0660 DECT @STKADD Decrement pointer 609E 8373 0271 60A0 0987 SRL R7,8 Shift to use as offset 0272 60A2 D2E7 MOVB @PAD(R7),R11 Restore return address 60A4 8300 0273 60A6 D827 MOVB @PAD1(R7),@R11LB 60A8 8301 60AA 83F7 0274 60AC 045B RT Return to GPL interpeter 0275 60AE D7E0 GETCH MOVB @R6LB,*R15 60B0 83ED 0276 60B2 1000 NOP 0277 60B4 D7C6 MOVB R6,*R15 0278 60B6 0586 INC R6 0279 60B8 D220 MOVB @XVDPRD,R8 60BA 8800 0280 60BC 0988 GETCH1 SRL R8,8 0281 60BE 045B RT 0282 60C0 DB46 GETCHG MOVB R6,@GRMWAX(R13) 60C2 0402 0283 60C4 DB60 MOVB @R6LB,@GRMWAX(R13) 60C6 83ED 60C8 0402 0284 60CA 0586 INC R6 0285 60CC D21D MOVB *R13,R8 0286 60CE 10F6 JMP GETCH1 0287 60D0 D236 GETCGR MOVB *R6+,R8 0288 60D2 10F4 JMP GETCH1 0289 * 0290 60D6 CBHFF EQU $+2 0291 60D4 0205 POPSTK LI R5,-8 60D6 FFF8 0292 60D8 D7E0 MOVB @VSPTR1,*R15 60DA 836F 0293 60DC 0206 LI R6,ARG 60DE 835C 0294 60E0 D7E0 MOVB @VSPTR,*R15 60E2 836E 0295 60E4 A805 A R5,@VSPTR 60E6 836E 0296 60E8 DDA0 STKMOV MOVB @XVDPRD,*R6+ 60EA 8800 0297 60EC 0585 INC R5 0298 60EE 16FC JNE STKMOV 0299 60F0 045B RT 0300 * 0301 60F2 05E0 PUTSTK INCT @STKADD 60F4 8373 99/4 ASSEMBLER XML359 PAGE 0007 0302 60F6 D120 MOVB @STKADD,R4 60F8 8373 0303 60FA 0984 SRL R4,8 0304 60FC D92D MOVB @GRMRAX(13),@PAD(R4) 60FE 0002 6100 8300 0305 6102 D92D MOVB @GRMRAX(13),@PAD1(R4) 6104 0002 6106 8301 0306 6108 0624 DEC @PAD(R4) 610A 8300 0307 610C 045B RT 0308 * 0309 610E D120 GETSTK MOVB @STKADD,R4 6110 8373 0310 6112 0984 SRL R4,8 0311 6114 0660 DECT @STKADD 6116 8373 0312 6118 DB64 MOVB @PAD(R4),@GRMWAX(R13) 611A 8300 611C 0402 0313 611E DB64 MOVB @PAD1(R4),@GRMWAX(R13) 6120 8301 6122 0402 0314 6124 045B RT 0315 ************************************************************ 0316 6126 AORG >6126 0318 0319 0F64 ROUNUP EQU >0F64 Uses XML >01 Rounding of floating point 0320 0D42 SCOMPB EQU >0D42 Set SCOMP with direct return without GPL 0321 12B8 CFI EQU >12B8 CFI (XML >12) 0322 0E8C SMULT EQU >0E8C SMUL (XML >0D) 0323 0FF4 FDIV EQU >0FF4 FDIV (XML >09) 0324 0FC2 OVEXP EQU >0FC2 Overflow (XML >04) 0325 0E88 FMULT EQU >0E88 FMUL (XML >08) 0326 0D74 SSUB EQU >0D74 SSUB (XML >0C) 0327 0D80 FADD EQU >0D80 FADD (XML >06) 0328 0FF8 SDIV EQU >0FF8 SDIV (XML >0E) 0329 0D7C FSUB EQU >0D7C FSUB (XML (>07) 0330 0D84 SADD EQU >0D84 SADD (XML >0B) 0331 0FB2 ROUNU EQU >0FB2 Rounding with digit number in >8354 (XML 0332 006A RESET EQU >006A Clear condition bit in GPL status (GPL i 0333 0070 NEXT EQU >0070 GPL interpreter 0334 11B2 CSN01 EQU >11B2 CSN (XML >10) (Without R3 loaded with >1 0335 0D3A FCOMP EQU >0D3A FCOMP (XML >0A) 0336 6126 C0CB FCOMPB MOV R11,R3 0337 6128 0460 B @FCOMP+22 612A 0D50 0338 187C GETV EQU >187C Read 1 byte from VDP, Entry over data ad 0339 1880 GETV1 EQU >1880 Same >187C but does not fetch address, i 0340 1E8C SAVREG EQU >1E8C Set substack pointer and Basic byte 0341 1E90 SAVRE2 EQU >1E90 Same >1E8C but does not set R8 into >834 0342 1E7A SETREG EQU >1E7A Substack pointer in R9 and actual Basic 0343 18AA STVDP3 EQU >18AA Write R6 in VDP (R1=Address+3), 0344 * used for variable table and string point 0345 18AE STVDP EQU >18AE Write R6 in VDP (R1=Address+3), 0346 * used for variable table and string point 0347 15E0 FBS EQU >15E0 Pointer fetch var list 0348 15E6 FBS001 EQU >15E6 Fetch length byte 99/4 ASSEMBLER REFS359 PAGE 0008 0349 ************************************************************ 0350 0351 612C AORG >612C 0353 0354 * 0355 * The CHARACTER PROPERTY TABLE 0356 * There is a one-byte entry for every character code 0357 * in the range LLC(lowest legal character) to 0358 * HLC(highest legal character), inclusive. 0359 0020 LLC EQU >20 0360 0000 CPNIL EQU >00 " $ % ' ? 0361 0002 CPDIG EQU >02 digit (0-9) 0362 0004 CPNUM EQU >04 digit, period, E 0363 0008 CPOP EQU >08 1 char operators(!#*+-/<=>^ ) 0364 0010 CPMO EQU >10 multiple operator ( : ) 0365 0020 CPALPH EQU >20 A-Z, @, _ 0366 0040 CPBRK EQU >40 ( ) , ; 0367 0080 CPSEP EQU >80 space 0368 0022 CPALNM EQU CPALPH+CPDIG alpha-digit 0369 *----------------------------------------------------------- 0370 * Following lines are for adding lowercase character set in 0371 * 99/4A, 5/12/81 0372 0001 CPLOW EQU >01 a-z 0373 0023 CPULNM EQU CPALNM+CPLOW Alpha(both upper and lower)+ 0374 * digit-legal variable character 0375 0021 CPUL EQU CPALPH+CPLOW Alpha(both upper and lower) 0376 *----------------------------------------------------------- 0377 610C CPTBL EQU $-LLC 0378 612C 80 BYTE CPSEP SPACE 0379 612D 08 BYTE CPOP ! EXCLAMATION POINT 0380 612E 00 BYTE CPNIL " QUOTATION MARKS 0381 612F 08 BYTE CPOP # NUMBER SIGN 0382 6130 00 BYTE CPNIL $ DOLLAR SIGN 0383 6131 00 BYTE CPNIL % PERCENT 0384 6132 08 BYTE CPOP & AMPERSAND 0385 6133 00 BYTE CPNIL ' APOSTROPHE 0386 6134 40 BYTE CPBRK ( LEFT PARENTHESIS 0387 6135 40 BYTE CPBRK ) RIGHT PARENTHESIS 0388 6136 08 BYTE CPOP * ASTERISK 0389 6137 0C BYTE CPOP+CPNUM + PLUS 0390 6138 40 BYTE CPBRK , COMMA 0391 6139 0C BYTE CPOP+CPNUM - MINUS 0392 613A 04 BYTE CPNUM . PERIOD 0393 613B 08 BYTE CPOP / SLANT 0394 613C 06 BYTE CPNUM+CPDIG 0 ZERRO 0395 613D 06 BYTE CPNUM+CPDIG 1 ONE 0396 613E 06 BYTE CPNUM+CPDIG 2 TWO 0397 613F 06 BYTE CPNUM+CPDIG 3 THREE 0398 6140 06 BYTE CPNUM+CPDIG 4 FOUR 0399 6141 06 BYTE CPNUM+CPDIG 5 FIVE 0400 6142 06 BYTE CPNUM+CPDIG 6 SIX 0401 6143 06 BYTE CPNUM+CPDIG 7 SEVEN 0402 6144 06 BYTE CPNUM+CPDIG 8 EIGHT 0403 6145 06 BYTE CPNUM+CPDIG 9 NINE 0404 6146 10 LBCPMO BYTE CPMO : COLON 0405 6147 40 BYTE CPBRK : SEMICOLON 0406 6148 08 BYTE CPOP < LESS THAN 0407 6149 08 BYTE CPOP = EQUALS 0408 614A 08 BYTE CPOP > GREATER THAN 99/4 ASSEMBLER CPT PAGE 0009 0409 614B 00 BYTE CPNIL ? QUESTION MARK 0410 614C 20 BYTE CPALPH @ COMMERCIAL AT 0411 614D 20 BYTE CPALPH A UPPERCASE A 0412 614E 20 BYTE CPALPH B UPPERCASE B 0413 614F 20 BYTE CPALPH C UPPERCASE C 0414 6150 20 BYTE CPALPH D UPPERCASE D 0415 6151 24 BYTE CPALPH+CPNUM E UPPERCASE E 0416 6152 20 BYTE CPALPH F UPPERCASE F 0417 6153 20 BYTE CPALPH G UPPERCASE G 0418 6154 20 BYTE CPALPH H UPPERCASE H 0419 6155 20 BYTE CPALPH I UPPERCASE I 0420 6156 20 BYTE CPALPH J UPPERCASE J 0421 6157 20 BYTE CPALPH K UPPERCASE K 0422 6158 20 BYTE CPALPH L UPPERCASE L 0423 6159 20 BYTE CPALPH M UPPERCASE M 0424 615A 20 BYTE CPALPH N UPPERCASE N 0425 615B 20 BYTE CPALPH O UPPERCASE O 0426 615C 20 BYTE CPALPH P UPPERCASE P 0427 615D 20 BYTE CPALPH Q UPPERCASE Q 0428 615E 20 BYTE CPALPH R UPPERCASE R 0429 615F 20 BYTE CPALPH S UPPERCASE S 0430 6160 20 BYTE CPALPH T UPPERCASE T 0431 6161 20 BYTE CPALPH U UPPERCASE U 0432 6162 20 BYTE CPALPH V UPPERCASE V 0433 6163 20 BYTE CPALPH W UPPERCASE W 0434 6164 20 BYTE CPALPH X UPPERCASE X 0435 6165 20 BYTE CPALPH Y UPPERCASE Y 0436 6166 20 BYTE CPALPH Z UPPERCASE Z 0437 6167 20 BYTE CPALPH [ LEFT SQUARE BRACKET 0438 6168 20 BYTE CPALPH \ REVERSE SLANT 0439 6169 20 BYTE CPALPH ] RIGHT SQUARE BRACKET 0440 616A 08 BYTE CPOP ^ CIRCUMFLEX 0441 616B 20 BYTE CPALPH _ UNDERLINE 0442 *----------------------------------------------------------- 0443 * Following "`" and lowercase characters are for 0444 * adding lowercase character set in 99/4A, 5/12/81 0445 *----------------------------------------------------------- 0446 616C 00 BYTE CPNIL ` GRAVE ACCENT 0447 616D 21 BYTE CPALPH+CPLOW a LOWERCASE a 0448 616E 21 BYTE CPALPH+CPLOW b LOWERCASE b 0449 616F 21 BYTE CPALPH+CPLOW c LOWERCASE c 0450 6170 21 BYTE CPALPH+CPLOW d LOWERCASE d 0451 6171 21 BYTE CPALPH+CPLOW e LOWERCASE e 0452 6172 21 BYTE CPALPH+CPLOW f LOWERCASE f 0453 6173 21 BYTE CPALPH+CPLOW g LOWERCASE g 0454 6174 21 BYTE CPALPH+CPLOW h LOWERCASE h 0455 6175 21 BYTE CPALPH+CPLOW i LOWERCASE i 0456 6176 21 BYTE CPALPH+CPLOW j LOWERCASE j 0457 6177 21 BYTE CPALPH+CPLOW k LOWERCASE k 0458 6178 21 BYTE CPALPH+CPLOW l LOWERCASE l 0459 6179 21 BYTE CPALPH+CPLOW m LOWERCASE m 0460 617A 21 BYTE CPALPH+CPLOW n LOWERCASE n 0461 617B 21 BYTE CPALPH+CPLOW o LOWERCASE o 0462 617C 21 BYTE CPALPH+CPLOW p LOWERCASE p 0463 617D 21 BYTE CPALPH+CPLOW q LOWERCASE q 0464 617E 21 BYTE CPALPH+CPLOW r LOWERCASE r 0465 617F 21 BYTE CPALPH+CPLOW s LOWERCASE s 0466 6180 21 BYTE CPALPH+CPLOW t LOWERCASE t 0467 6181 21 BYTE CPALPH+CPLOW u LOWERCASE u 99/4 ASSEMBLER CPT PAGE 0010 0468 6182 21 BYTE CPALPH+CPLOW v LOWERCASE v 0469 6183 21 BYTE CPALPH+CPLOW w LOWERCASE w 0470 6184 21 BYTE CPALPH+CPLOW x LOWERCASE x 0471 6185 21 BYTE CPALPH+CPLOW y LOWERCASE y 0472 6186 21 BYTE CPALPH+CPLOW z LOWERCASE z 0473 0474 EVEN 0475 ************************************************************ 0476 6188 AORG >6188 0478 0479 * General Basic support routines (not includeing PARSE) 0480 0481 * 0482 0503 ERRBS EQU >0503 BAD SUBSCRIPT ERROR CODE 0483 0603 ERRTM EQU >0603 ERROR STRING/NUMBER MISMATCH 0484 * 0485 6188 6500 STCODE DATA >6500 0486 618A 0006 C6 DATA >0006 0487 * 0488 * Entry to find Basic symbol table entry for GPL 0489 * 0490 618C 06A0 FBSYMB BL @FBS Search the symbol table 618E 15E0 0491 6190 006A DATA RESET If not found - condition reset 0492 6192 F820 SET SOCB @BIT2,@STATUS Set GPL condition 6194 62AB 6196 837C 0493 6198 0460 B @NEXT If found - condition set 619A 0070 0494 * GPL entry for COMPCT to take advantage of common code 0495 619C 0206 COMPCG LI R6,COMPCT Address of COMPCT 619E 73D8 0496 61A0 100E JMP SMBB10 Jump to set up 0497 * GPL entry for GETSTR to take advantage of common code 0498 61A2 0206 GETSTG LI R6,GETSTR Address of MEMCHK 61A4 736C 0499 61A6 100B JMP SMBB10 Jump to set up 0500 * GPL entry for SMB to take advantage of common code 0501 61A8 0206 SMBB LI R6,SMB Address of SMB routine 61AA 61DC 0502 61AC 1008 JMP SMBB10 Jump to set up 0503 * GPL entry for ASSGNV to take advantage of common code 0504 61AE 0206 ASSGNV LI R6,ASSG Address of ASSGNV routine 61B0 6334 0505 61B2 1005 JMP SMBB10 Jump to set up 0506 * GPL entry for SMB to take advantage of common code 0507 61B4 0206 SYMB LI R6,SYM Address of SYM routine 61B6 6312 0508 61B8 1002 JMP SMBB10 Jump to set up 0509 * GPL entry for SMB to take advantage of common code 0510 61BA 0206 VPUSHG LI R6,VPUSH Address of VPUSH routine 61BC 6BAA 0511 61BE C1CB SMBB10 MOV R11,R7 Save return address 0512 61C0 06A0 BL @PUTSTK Save current GROM address 61C2 60F2 0513 61C4 06A0 BL @SETREG Set up Basic registers 61C6 1E7A 0514 61C8 05C9 INCT R9 Get space on subroutine stack 0515 61CA C647 MOV R7,*R9 Save the return address 99/4 ASSEMBLER BASSUP PAGE 0011 0516 61CC 0696 BL *R6 Branch and link to the routine 0517 61CE C1D9 MOV *R9,R7 Get return address 0518 61D0 0649 DECT R9 Restore subroutine stack 0519 61D2 06A0 BL @SAVREG Save registers for GPL 61D4 1E8C 0520 61D6 06A0 BL @GETSTK Restore GROM address 61D8 610E 0521 61DA 0457 B *R7 Return to GPL 0522 ************************************************************ 0523 * Subroutine to find the pointer to variable space of each 0524 * element of symbol table entry. Decides whether symbol 0525 * table entry pointed to by FAC, FAC+1 is a simple variable 0526 * and returns proper 8-byte block in FAC through FAC7 0527 ************************************************************ 0528 61DC 05C9 SMB INCT R9 Get space on subroutine stack 0529 61DE C64B MOV R11,*R9 Save return address 0530 61E0 C820 MOV @FAC,@FAC4 Copy pointer to table entry 61E2 834A 61E4 834E 0531 61E6 A820 A @C6,@FAC4 Add 6 so point a value space 61E8 618A 61EA 834E 0532 61EC 06A0 BL @GETV Get 1st byte of table entry 61EE 187C 0533 61F0 834A DATA FAC Pointer is in FAC 0534 * 0535 61F2 C101 MOV R1,R4 Copy for later use. 0536 61F4 C081 MOV R1,R2 Copy for later use. 0537 61F6 0A21 SLA R1,2 Check for UDF entry 0538 61F8 1821 JOC BERMUV If UDF - then error 0539 61FA C104 MOV R4,R4 Check for string. 0540 61FC 1102 JLT SMB02 Skip if it is string. 0541 61FE 04E0 CLR @FAC2 Clear for numeric case. 6200 834C 0542 * 0543 * In case of subprogram call check if parameter is shared by 0544 * it's calling program. 0545 * 0546 6202 0A11 SMB02 SLA R1,1 Check for the shared bit. 0547 6204 1705 JNC SMB04 If it is not shared skip. 0548 6206 06A0 BL @GET Get the value space pointer 6208 6C9A 0549 620A 834E DATA FAC4 in the symbol table. 0550 620C C801 MOV R1,@FAC4 Store the value space address. 620E 834E 0551 * 0552 * Branches to take care of string and array cases. 0553 * Only the numeric variable case stays on. 0554 * 0555 6210 D104 SMB04 MOVB R4,R4 R4 has header byte information 0556 6212 1116 JLT SMBO50 Take care of string. 0557 6214 0A54 SMB05 SLA R4,5 Get only the dimension number. 0558 6216 09D4 SRL R4,13 0559 6218 162A JNE SMBO20 go to array case. 0560 * 0561 * Numeric ERAM cases are special. 0562 * If it is shared get the actual v.s. address from ERAM. 0563 * Otherwise get it from VDP RAM. 0564 * 99/4 ASSEMBLER BASSUP PAGE 0012 0565 621A D120 MOVB @RAMTOP,R4 Check for ERAM. 621C 8384 0566 621E 130B JEQ SMBO10 Yes ERAM case. 0567 6220 0A32 SLA R2,3 R2 has a header byte. 0568 6222 1704 JNC SMB06 Shared bit is not ON. 0569 6224 06A0 BL @GETG Get v.s. pointer from ERAM 6226 6CCA 0570 6228 834E DATA FAC4 0571 622A 1003 JMP SMB08 0572 622C 06A0 SMB06 BL @GET Not shared. 622E 6C9A 0573 6230 834E DATA FAC4 Get v.s. address from VDP RAM. 0574 * 0575 6232 C801 SMB08 MOV R1,@FAC4 Store it in FAC4 area. 6234 834E 0576 * 0577 * Return from the SMB routine. 0578 * 0579 6236 C2D9 SMBO10 MOV *R9,R11 Restore return address 0580 6238 0649 DECT R9 Restore stack 0581 623A 045B RT And return 0582 623C 0460 BERMUV B @ERRMUV * INCORRECT NAME USAGE 623E 6970 0583 * 0584 * Start looking for the real address of the symbol. 0585 * 0586 6240 0288 SMBO50 CI R8,LPARZ*256 String - now string array? 6242 B700 0587 6244 13E7 JEQ SMB05 Yes, process as an array 0588 6246 C820 SMB51 MOV @STCODE,@FAC2 String ID code in FAC2 6248 6188 624A 834C 0589 624C C820 MOV @FAC4,@FAC Get string pointer address 624E 834E 6250 834A 0590 6252 06A0 BL @GET Get exact pointer to string 6254 6C9A 0591 6256 834A DATA FAC 0592 * 0593 6258 C801 MOV R1,@FAC4 Save pointer to string 625A 834E 0594 625C C0C1 MOV R1,R3 Was it a null? 0595 625E 1304 JEQ SMB57 Length is 0 - so is null 0596 6260 0603 DEC R3 Otherwise point at length byte 0597 6262 06A0 BL @GETV1 Get the string length 6264 1880 0598 6266 0981 SRL R1,8 Shift for use as double 0599 6268 C801 SMB57 MOV R1,@FAC6 Put into FAC entry 626A 8350 0600 626C 10E4 JMP SMBO10 And return 0601 * 0602 * Array cases are taken care of here. 0603 * 0604 626E C804 SMBO20 MOV R4,@FAC2 Now have a dimension counter 6270 834C 0605 * that is initilized to maximum 0606 * *FAC+4,FAC+5 already points to 1st dimension maximum in 0607 * in symbol table. 0608 6272 04C2 CLR R2 Clear index accumulator 99/4 ASSEMBLER BASSUP PAGE 0013 0609 6274 C802 SMBO25 MOV R2,@FAC6 Save accumulator in FAC 6276 8350 0610 6278 06A0 BL @PGMCHR Get next character 627A 6C74 0611 627C 06A0 BL @PSHPRS PUSH and PARSE subscript 627E 6B9C 0612 6280 B7 BYTE LPARZ,0 Up to a left parenthesis or le 6281 00 0613 * 0614 6282 9820 CB @FAC2,@STCODE Dimension can't be a string 6284 834C 6286 6188 0615 6288 1441 JHE ERRT It is - so error 0616 * Now do float to interger conversion of dimension 0617 628A 04E0 CLR @FAC10 Assume no error 628C 8354 0618 628E 06A0 BL @CFI Gets 2 byte integer in FAC,FAC 6290 12B8 0619 6292 D120 MOVB @FAC10,R4 Error on conversion? 6294 8354 0620 6296 1636 JNE ERR3 Yes, error BAD SUBSCRIPT 0621 6298 C160 MOV @FAC,R5 Save index just read 629A 834A 0622 629C 06A0 BL @VPOP Restore FAC block 629E 6C2A 0623 62A0 06A0 BL @GET Get next dimension maximum 62A2 6C9A 0624 62A4 834E DATA FAC4 FAC4 points into symbol table 0625 * 0626 62A6 8045 C R5,R1 Subscript less-then maximum? 0627 62A8 1B2D JH ERR3 No, index out of bounds 0628 62AB BIT2 EQU $+1 Constant >20 (Opcode is >D120) 0629 62AA D120 MOVB @BASE,R4 Fetch option base to check low 62AC 8343 0630 62AE 1303 JEQ SMBO40 If BASE=0, INDEX=0 is ok 0631 62B0 0605 DEC R5 Adjust BASE 1 index 0632 62B2 1128 JLT ERR3 If subscript was =0 then error 0633 62B4 1001 JMP SMBO41 Accumulate the subscripts 0634 62B6 0581 SMBO40 INC R1 Adjust size if BASE=0 0635 62B8 3860 SMBO41 MPY @FAC6,R1 R1,R2 has ACCUM*MAX dimension 62BA 8350 0636 62BC A085 A R5,R2 Add latest to accumulator 0637 62BE 05E0 INCT @FAC4 Increment dimension max pointe 62C0 834E 0638 62C2 0620 DEC @FAC2 Decrement remaining-dim count 62C4 834C 0639 62C6 1305 JEQ SMBO70 All dimensions handled ->done 0640 62C8 0288 CI R8,COMMAZ*256 Otherwise, must be at a comma 62CA B300 0641 62CC 13D3 JEQ SMBO25 We are, so loop for more 0642 62CE 0460 ERR1 B @ERRSYN Not a comma, so SYNTAX ERROR 62D0 664E 0643 * 0644 * At this point the required number of dimensions have been 0645 * scanned. 0646 * R2 Contains the index 0647 * R4 Points to the first array element or points to the 0648 * address in ERAM where the first array element is. 0649 62D2 0288 SMBO70 CI R8,RPARZ*256 Make sure at a right parenthes 99/4 ASSEMBLER BASSUP PAGE 0014 62D4 B600 0650 62D6 16FB JNE ERR1 Not, so error 0651 62D8 06A0 BL @PGMCHR Get nxt token 62DA 6C74 0652 62DC 06A0 BL @GETV Now check string or numeric 62DE 187C 0653 62E0 834A DATA FAC array by checking s.t. 0654 * 0655 62E2 110C JLT SMB71 If MSB set is a string array 0656 62E4 0A32 SLA R2,3 Numeric, multiply by 8 0657 62E6 D0E0 MOVB @RAMTOP,R3 Does ERAM exist? 62E8 8384 0658 62EA 1305 JEQ SMBO71 No 0659 62EC 06A0 BL @GET Yes, get the content of value 62EE 6C9A 0660 62F0 834E DATA FAC4 pointer 0661 * 0662 62F2 C801 MOV R1,@FAC4 Put it in FAC4 62F4 834E 0663 62F6 A802 SMBO71 A R2,@FAC4 Add into values pointer 62F8 834E 0664 62FA 109D JMP SMBO10 And return in the normal way 0665 62FC 0A12 SMB71 SLA R2,1 String, multiply by 2 0666 62FE A802 A R2,@FAC4 Add into values pointer 6300 834E 0667 6302 10A1 JMP SMB51 And build the string FAC entry 0668 6304 0200 ERR3 LI R0,ERRBS Bad subscript return vector 6306 0503 0669 6308 0460 ERRX B @ERR Exit to GPL 630A 6652 0670 630C 0200 ERRT LI R0,ERRTM String/number mismatch vector 630E 0603 0671 6310 10FB JMP ERRX Use the long branch 0672 ************************************************************ 0673 * Subroutine to put symbol name into FAC and to call FBS to 0674 * find the symbol table for the symbol 0675 ************************************************************ 0676 6312 04E0 SYM CLR @FAC15 Clear the caharacter counter 6314 8359 0677 6316 0202 LI R2,FAC Copying string into FAC 6318 834A 0678 631A C04B MOV R11,R1 Save return address 0679 *----------------------------------------------------------- 0680 * Fix "A long constant in a variable field in INPUT, 0681 * ACCEPT, LINPUT, NEXT and READ etc. may crash the 0682 * sytem" bug, 5/22/81 0683 * Insert the following 2 lines 0684 631C D208 MOVB R8,R8 0685 631E 11D7 JLT ERR1 If token 0686 6320 DC88 SYM1 MOVB R8,*R2+ Save the character 0687 6322 05A0 INC @FAC15 Count it 6324 8359 0688 6326 06A0 BL @PGMCHR Get next character 6328 6C74 0689 632A 15FA JGT SYM1 Still characters in the name 0690 632C 06A0 BL @FBS Got name, now find s.t. entry 632E 15E0 0691 6330 62CE DATA ERR1 Return vector if not found 0692 * 99/4 ASSEMBLER BASSUP PAGE 0015 0693 6332 0451 B *R1 Return to caller if found 0694 ************************************************************ 0695 * ASSGNV, callable from GPL or 9900 code, to assign a value 0696 * to a symbol (strings and numerics) . If numeric, the 0697 * 8 byte descriptor is in the FAC. The descriptor block 0698 * (8 bytes) for the destination variable is on the stack. 0699 * There are two types of descriptor entries which are 0700 * created by SMB in preparation for ASSGNV, one for 0701 * numerics and one for strings. 0702 * NUMERIC 0703 * +-------------------------------------------------------+ 0704 * |S.T. ptr | 00 | |Value ptr | | 0705 * +-------------------------------------------------------+ 0706 * STRING 0707 * +-------------------------------------------------------+ 0708 * |Value ptr| 65 | |String ptr|String length | 0709 * +-------------------------------------------------------+ 0710 * 0711 * CRITICAL NOTE: Becuase of the BL @POPSTK below, if a 0712 * string entry is popped and a garbage collection has taken 0713 * place while the entry was pushed on the stack, and the 0714 * entry was a permanent string the pointer in FAC4 and FAC5 0715 * will be messed up. A BL @VPOP would have taken care of 0716 * the problem but would have taken a lot of extra code. 0717 * Therefore, at ASSG50-ASSG54 it is assumed that the 0718 * previous value assigned to the destination variable has 0719 * been moved and the pointer must be reset by going back to 0720 * the symbol table and getting the correct value pointer. 0721 ************************************************************ 0722 6334 C28B ASSG MOV R11,R10 Save the retun address 0723 6336 06A0 BL @ARGTST Check arg and variable type 6338 6B6E 0724 633A 02CC STST R12 Save status of type 0725 633C 06A0 BL @POPSTK Pop destination descriptor 633E 60D4 0726 * into ARG 0727 6340 0A3C SLA R12,3 Variable type numeric? 0728 6342 1745 JNC ASSG70 Yes, handle it as such 0729 * Assign a string to a string variable 0730 6344 C060 MOV @ARG4,R1 Get destination pointer 6346 8360 0731 * Dest have non-null value? 0732 6348 130B JEQ ASSG54 No, null->never assigned 0733 * Previously assigned - Must first free the old value 0734 634A 06A0 BL @GET Correct for POPSTK above 634C 6C9A 0735 634E 835C DATA ARG Pointer is in ARG 0736 * 0737 6350 C801 MOV R1,@ARG4 Correct ARG+4,5 too 6352 8360 0738 *----------------------------------------------------------- 0739 * Fix "Assigning a string to itself when memory is full can 0740 * destroy the string" bug, 5/22/81 0741 * Add the following 2 lines and the label ASSG80 0742 6354 8801 C R1,@FAC4 Do not do anything in assign- 6356 834E 0743 * ing a string to itself case 0744 6358 1317 JEQ ASSG80 Detect A$=A$ case, exit 0745 *----------------------------------------------------------- 99/4 ASSEMBLER BASSUP PAGE 0016 0746 635A 04C6 CLR R6 Clear for zeroing backpointer 0747 635C 06A0 BL @STVDP3 Free the string 635E 18AA 0748 6360 C120 ASSG54 MOV @FAC6,R4 Is source string a null? 6362 8350 0749 6364 130C JEQ ASSG57 Yes, handle specially 0750 6366 C0E0 MOV @FAC,R3 Get address of source pointer 6368 834A 0751 636A 0283 CI R3,>001C Got a temporay string? 636C 001C 0752 636E 160D JNE ASSG56 No, more complicated 0753 6370 C120 MOV @FAC4,R4 Pick up direct ptr to string 6372 834E 0754 * Common string code to set forward and back pointers 0755 6374 C1A0 ASSG55 MOV @ARG,R6 Ptr to symbol table pointer 6376 835C 0756 6378 C044 MOV R4,R1 Pointer to source string 0757 637A 06A0 BL @STVDP3 Set the backpointer 637C 18AA 0758 637E C060 ASSG57 MOV @ARG,R1 Address of symbol table ptr 6380 835C 0759 6382 C184 MOV R4,R6 Pointer to string 0760 6384 06A0 BL @STVDP Set the forward pointer 6386 18AE 0761 6388 045A ASSG80 B *R10 Done, return 0762 * Symbol-to-symbol assigments of strings 0763 * Must create copy of string 0764 638A C820 ASSG56 MOV @FAC6,@BYTE Fetch length for GETSTR 638C 8350 638E 830C 0765 * NOTE: FAC through FAC+7 cannot be destroyed 0766 * address^of string length^of string 0767 6390 06A0 BL @VPUSH So save it on the stack 6392 6BAA 0768 6394 C80A MOV R10,@FAC Save return link in FAC since 6396 834A 0769 * GETSTR does not destroy FAC 0770 6398 06A0 BL @GETSTR Call GPL to do the GETSTR 639A 736C 0771 639C C2A0 MOV @FAC,R10 Restore return link 639E 834A 0772 63A0 06A0 BL @VPOP Pop the source info back 63A2 6C2A 0773 * Set up to copy the source string into destination 0774 63A4 C0E0 MOV @FAC4,R3 R3 is now copy-from 63A6 834E 0775 63A8 C160 MOV @SREF,R5 R5 is now copy-to 63AA 831C 0776 63AC C105 MOV R5,R4 Save for pointer setting 0777 * Registers to be used in the copy 0778 * R1 - Used for a buffer 0779 * R3 - Copy-from address 0780 * R2 - # of bytes to be moved 0781 * R5 - copy-to address 0782 63AE C0A0 MOV @FAC6,R2 Fetch the length of the string 63B0 8350 0783 63B2 0265 ORI R5,WRVDP Enable the VDP write 63B4 4000 0784 63B6 06A0 ASSG59 BL @GETV1 Get the character 99/4 ASSEMBLER BASSUP PAGE 0017 63B8 1880 0785 63BA D7E0 MOVB @R5LB,*R15 Load out destination address 63BC 83EB 0786 63BE 0583 INC R3 Increment the copy-from 0787 63C0 D7C5 MOVB R5,*R15 1st byte of address to 0788 63C2 0585 INC R5 Increment for next character 0789 63C4 D801 MOVB R1,@XVDPWD Put the character out 63C6 8C00 0790 63C8 0602 DEC R2 Decrement count, finished? 0791 63CA 15F5 JGT ASSG59 No, loop for more 0792 63CC 10D3 JMP ASSG55 Yes, now set pointers 0793 * Code to copy a numeric value into the symbol table 0794 63CE 0202 ASSG70 LI R2,8 Need to assign 8 bytes 63D0 0008 0795 63D2 C160 MOV @ARG4,R5 Destination pointer(R5) 63D4 8360 0796 * from buffer(R4), (R2)bytes 0797 63D6 C0E0 MOV @RAMTOP,R3 Does ERAM exist? 63D8 8384 0798 63DA 160C JNE ASSG77 Yes, write to ERAM 0799 * No, write to VDP 0800 63DC D7E0 MOVB @R5LB,*R15 Load out 2nd byte of address 63DE 83EB 0801 63E0 0265 ORI R5,WRVDP Enable the write to the VDP 63E2 4000 0802 63E4 D7C5 MOVB R5,*R15 Load out 1st byte of address 0803 63E6 0204 LI R4,FAC Source is FAC 63E8 834A 0804 63EA D834 ASSG75 MOVB *R4+,@XVDPWD Move a byte 63EC 8C00 0805 63EE 0602 DEC R2 Decrement the counter, done? 0806 63F0 15FC JGT ASSG75 No, loop for more 0807 63F2 045A B *R10 Yes, return to the caller 0808 63F4 0204 ASSG77 LI R4,FAC Source is in FAC 63F6 834A 0809 63F8 DD74 ASSG79 MOVB *R4+,*R5+ Move a byte 0810 63FA 0602 DEC R2 Decrement the counter, done? 0811 63FC 15FD JGT ASSG79 No, loop for more 0812 63FE 045A B *R10 Yes, return to caller 0813 * Check for required token 0814 6400 D01D SYNCHK MOVB *R13,R0 Read required token 0815 * 0816 6402 9800 CB R0,@CHAT Have the required token? 6404 8342 0817 6406 1304 JEQ PGMCH Yes, read next character 0818 6408 06A0 BL @SETREG Error return requires R8/R9 se 640A 1E7A 0819 640C 0460 B @ERRSYN * SYNTAX ERROR 640E 664E 0820 * PGMCH - GPL entry point for PGMCHR to set up register 0821 6410 C30B PGMCH MOV R11,R12 Save return address 0822 6412 06A0 BL @PGMCHR Get the next character 6414 6C74 0823 6416 D808 MOVB R8,@CHAT Put it in for GPL 6418 8342 0824 641A 045C B *R12 Return to GPL 0825 641C 045B RT And return to the caller 0826 641E C13B PUTV MOV *R11+,R4 0827 6420 C114 MOV *R4,R4 99/4 ASSEMBLER BASSUP PAGE 0018 0828 6422 D7E0 PUTV1 MOVB @R4LB,*R15 6424 83E9 0829 6426 0264 ORI R4,WRVDP 6428 4000 0830 642A D7C4 MOVB R4,*R15 0831 642C 1000 NOP 0832 642E D801 MOVB R1,@XVDPWD 6430 8C00 0833 6432 045B RT 0834 * MOVFAC - copies 8 bytes from VDP(@FAC4) or ERAM(@FAC4) 0835 * to FAC 0836 6434 C060 MOVFAC MOV @FAC4,R1 Get pointer to source 6436 834E 0837 6438 0202 LI R2,8 8 byte values 643A 0008 0838 643C 0203 LI R3,FAC Destination is FAC 643E 834A 0839 6440 C020 MOV @RAMTOP,R0 Does ERAM exist? 6442 8384 0840 6444 160A JNE MOVFA2 Yes, from ERAM 0841 * No, from VDP RAM 0842 6446 06C1 SWPB R1 0843 6448 D7C1 MOVB R1,*R15 Load 2nd byte of address 0844 644A 06C1 SWPB R1 0845 644C D7C1 MOVB R1,*R15 Load 1st byte of address 0846 644E 0205 LI R5,XVDPRD 6450 8800 0847 6452 DCD5 MOVF1 MOVB *R5,*R3+ Move a byte 0848 6454 0602 DEC R2 Decrement counter, done? 0849 6456 15FD JGT MOVF1 No, loop for more 0850 6458 045B RT Yes, return to caller 0851 645A DCF1 MOVFA2 MOVB *R1+,*R3+ 0852 645C 0602 DEC R2 0853 645E 16FD JNE MOVFA2 0854 6460 045B RT 0855 6462 045B RT And return to caller 0856 ************************************************************ 0857 6464 AORG >6464 0859 0860 * BASIC PARSE CODE 0861 * REGISTER USAGE 0862 * RESERVED FOR GPL INTERPRETER R13, R14, R15 0863 * R13 contains the read address for GROM 0864 * R14 is used in BASSUP/10 for the VDPRAM pointer 0865 * RESERVED IN BASIC SUPPORT 0866 * R8 MSB current character (like CHAT in GPL) 0867 * R8 LSB zero 0868 * R10 read data port address for program data 0869 * ALL EXITS TO GPL MUST GO THROUGH "NUDG05" 0870 * 0871 0872 * ~~~TOKENS~~~ 0873 0081 ELSEZ EQU >81 ELSE 0874 0082 SSEPZ EQU >82 STATEMENT SEPERATOR 0875 0083 TREMZ EQU >83 TAIL REMARK 0876 0084 IFZ EQU >84 IF 0877 0085 GOZ EQU >85 GO 0878 0086 GOTOZ EQU >86 GOTO 0879 0087 GOSUBZ EQU >87 GOSUB 99/4 ASSEMBLER PARSES PAGE 0019 0880 008E BREAKZ EQU >8E BREAK 0881 0096 NEXTZ EQU >96 NEXT 0882 00A1 SUBZ EQU >A1 SUB 0883 00A5 ERRORZ EQU >A5 ERROR 0884 00A6 WARNZ EQU >A6 WARNING 0885 00B0 THENZ EQU >B0 THEN 0886 00B1 TOZ EQU >B1 TO 0887 00B3 COMMAZ EQU >B3 COMMA 0888 00B6 RPARZ EQU >B6 RIGHT PARENTHESIS ) 0889 00B7 LPARZ EQU >B7 LEFT PARENTHESIS ( 0890 00BA ORZ EQU >BA OR 0891 00BB ANDZ EQU >BB AND 0892 00BC XORZ EQU >BC XOR 0893 00BD NOTZ EQU >BD NOT 0894 00BE EQZ EQU >BE EQUAL (=) 0895 00C0 GTZ EQU >C0 GREATER THEN (>) 0896 00C1 PLUSZ EQU >C1 PLUS (+) 0897 00C2 MINUSZ EQU >C2 MINUS (-) 0898 00C4 DIVIZ EQU >C4 DIVIDE (/) 0899 00C5 EXPONZ EQU >C5 EXPONENT 0900 00C7 STRINZ EQU >C7 STRING 0901 00C9 LNZ EQU >C9 LINE NUMBER 0902 00CB ABSZ EQU >CB ABSOLUTE 0903 00D1 SGNZ EQU >D1 SIGN 0904 * 0905 6464 0018 C24 DATA 24 CONSTANT 24 0906 6466 65A6 EXRTNA DATA EXRTN RETURN FOR EXEC 0907 * 0908 6468 0200 ERRSO LI R0,>0703 Issue STACK OVERFLOW message 646A 0703 0909 646C 0460 B @ERR 646E 6652 0910 * 0911 * GRAPHICS LANGUAGE ENTRY TO PARSE 0912 * 0913 6470 06A0 PARSEG BL @SETREG Set up registers for Basic 6472 1E7A 0914 6474 D2ED MOVB @GRMRAX(R13),R11 Get GROM address High byte 6476 0002 0915 6478 D82D MOVB @GRMRAX(R13),@R11LB Get GROM addres low byte 647A 0002 647C 83F7 0916 647E 060B DEC R11 R11-1 0917 * 0918 * 9900 ENTRY TO PARSE 0919 * 0920 6480 05C9 PARSE INCT R9 R11+2 Get room for return address 0921 6482 0289 CI R9,STKEND Stack full? 6484 83BA 0922 6486 1BF0 JH ERRSO Yes, too many levels deep 0923 6488 C64B MOV R11,*R9 Save the return address 0924 648A D1C8 P05 MOVB R8,R7 R8=CHAT Test for token beginning 0925 648C 1102 JLT P10 If token, then look it up 0926 648E 0460 B @PSYM If not token is a symbol 6490 6884 0927 6492 06A0 P10 BL @PGMCHR Get next character 6494 6C74 0928 6496 0977 SRL R7,7 Change last character to offse 0929 6498 0227 AI R7,->B7*2 Check for legal NUD 99/4 ASSEMBLER PARSES PAGE 0020 649A FE92 0930 649C 0287 CI R7,NTABLN Within the legal NUD address? 649E 0056 0931 64A0 1B22 JH CONT15 No, check for legal LED 0932 64A2 C1E7 MOV @NTAB(R7),R7 Get NUD address 64A4 69FE 0933 64A6 1525 JGT B9900 If 9900 code 0934 64A8 P17 EQU $ R7 contains offset into nudtab 0935 64A8 0247 ANDI R7,>7FFF If GPL code, get rid of MSB 64AA 7FFF 0936 64AC A1E0 A @NUDTAB,R7 Add in table address 64AE 8328 0937 64B0 06A0 NUDG05 BL @SAVREG Restore GPL pointers 64B2 1E8C 0938 64B4 DB47 MOVB R7,@GRMWAX(R13) Write out new GROM address 64B6 0402 0939 64B8 06C7 SWPB R7 Bare the LSB 0940 64BA DB47 MOVB R7,@GRMWAX(R13) Put it out too 64BC 0402 0941 64BE 0460 B @RESET Go back to GPL interpreter 64C0 006A 0942 64C2 10F2 P17L JMP P17 0943 * 0944 * CONTINUE ROUTINE FOR PARSE 0945 * 0946 64C4 06A0 CONTG BL @SETREG GPL entry-set Basic registers 64C6 1E7A 0947 64C8 C199 CONT MOV *R9,R6 Get last address from stack 0948 64CA 1506 JGT CONT10 9900 code if not negative 0949 64CC DB46 MOVB R6,@GRMWAX(R13) Write out new GROM address 64CE 0402 0950 64D0 06C6 SWPB R6 Bare the second byte 0951 64D2 DB46 MOVB R6,@GRMWAX(R13) Put it out too 64D4 0402 0952 64D6 C18D MOV R13,R6 Set up to test precedence 0953 64D8 9216 CONT10 CB *R6,R8 Test precedence 0954 64DA 1411 JHE NUDNDL Have parsed far enough->return 0955 64DC 0978 SRL R8,7 Make into table offset 0956 64DE 0228 AI R8,->B8*2 Minimum token for a LED (*2) 64E0 FE90 0957 64E2 0288 CI R8,LTBLEN Maximum token for a LED (*2) 64E4 001C 0958 64E6 1B09 CONT15 JH NOLEDL If outside legal LED range-err 0959 64E8 C1E8 MOV @LTAB(R8),R7 Pick up address of LED handler 64EA 6A54 0960 64EC 04C8 CLR R8 Clear 'CHAT' for getting new 0961 64EE 06A0 BL @PGMCHR Get next character 64F0 6C74 0962 64F2 0457 B9900 B *R7 Go to the LED handler 0963 64F4 0649 NUDE10 DECT R9 Back up subroutine stack 0964 64F6 0587 INC R7 Skip over precedence 0965 64F8 10DB JMP NUDG05 Goto code to return to GPL 0966 64FA 0460 NOLEDL B @NOLED 64FC 664E 0967 64FE 1073 NUDNDL JMP NUDND1 0968 * Execute one or more lines of Basic 0969 6500 EXECG EQU $ GPL entry point for execution 0970 6500 06A0 BL @SETREG Set up registers 6502 1E7A 99/4 ASSEMBLER PARSES PAGE 0021 0971 6504 04E0 CLR @ERRCOD Clear the return code 6506 8322 0972 6508 D020 MOVB @PRGFLG,R0 Imperative statement? 650A 8344 0973 650C 131A JEQ EXEC15 Yes, handle it as such 0974 * Loop for each statement in the program 0975 650E EXEC10 EQU $ 0976 650E D020 MOVB @FLAG,R0 Now test for trace mode 6510 8345 0977 6512 0A30 SLA R0,3 Check the trace bit in FLAG 0978 6514 115F JLT TRACL If set->display line number 0979 6516 C820 EXEC11 MOV @EXTRAM,@PGMPTR Get text pointer 6518 832E 651A 832C 0980 651C 0660 DECT @PGMPTR Back to the line # to check 651E 832C 0981 * break point 0982 6520 06A0 BL @PGMCHR Get the first byte of line # 6522 6C74 0983 6524 02C0 STST R0 Save status for breakpnt check 0984 6526 05A0 INC @PGMPTR Get text pointer again 6528 832C 0985 652A 06A0 BL @PGMCHR Go get the text pointer 652C 6C74 0986 652E 06C8 SWPB R8 Save 1st byte of text pointer 0987 6530 06A0 BL @PGMCHR Get 2nd byte of text pointer 6532 6C74 0988 6534 06C8 SWPB R8 Put text pointer in order 0989 6536 C808 MOV R8,@PGMPTR Set new text pointer 6538 832C 0990 653A 04C8 CLR R8 Clean up the mess 0991 653C 0A20 SLA R0,2 Check breakpoint status 0992 653E 1101 JLT EXEC15 If no breakpoint set - count 0993 6540 177A JNC BRKPNT If breakpoint set-handle it 0994 6542 EXEC15 EQU $ 0995 6544 C3 EQU $+2 Constant data 3 0996 6545 CB3 EQU $+3 Constant byte 3 0997 6542 0300 LIMI 3 Let interrupts loose 6544 0003 0998 6548 C0 EQU $+2 Constant data 0 0999 6546 0300 LIMI 0 Shut down interrupts 6548 0000 1000 654A 04E0 CLR @>83D6 Reset VDP timeout 654C 83D6 1001 654E 020C LI R12,>24 Load console KBD address in CR 6550 0024 1002 6552 30E0 LDCR @C0,3 Select keyboard section 6554 6548 1003 6556 020C LI R12,6 Read address 6558 0006 1004 655A 3600 STCR R0,8 SCAN the keyboard 1005 655C 2420 CZC @C1000,R0 Shift-key depressed? 655E 600A 1006 6560 160A JNE EXEC16 No, execute the Basic statemen 1007 6562 020C LI R12,>24 Test column 3 of keyboard 6564 0024 1008 6566 30E0 LDCR @CB3,3 Select keyboard section 6568 6545 1009 656A 020C LI R12,6 Read address 99/4 ASSEMBLER PARSES PAGE 0022 656C 0006 1010 656E 3600 STCR R0,8 SCAN the keyboard 1011 6570 2420 CZC @C1000,R0 Shift-C depressed? 6572 600A 1012 6574 132E JEQ BRKP1L Yes, so take Basic breakpoint 1013 6576 C820 EXEC16 MOV @PGMPTR,@SMTSRT Save start of statement 6578 832C 657A 831E 1014 657C 05C9 INCT R9 Get subroutine stack space 1015 657E C660 MOV @EXRTNA,*R9 Save the GPL return address 6580 6466 1016 6582 06A0 BL @PGMCHR Now get 1st character of stmt 6584 6C74 1017 6586 1320 JEQ EXRTN3 If EOL after EOS 1018 6588 1102 EXEC17 JLT EXEC20 If top bit set->keyword 1019 658A 0460 B @NLET If not->fake a 'LET' stmt 658C 6948 1020 658E C1C8 EXEC20 MOV R8,R7 Save 1st token so can get 2nd 1021 6590 05A0 INC @PGMPTR Increment the perm pointer 6592 832C 1022 6594 D21A MOVB *R10,R8 Read the character 1023 6596 0977 SRL R7,7 Convert 1st to table offset 1024 6598 0227 AI R7,->AA*2 Check for legal stmt token 659A FEAC 1025 659C 1558 JGT ERRONE Not in range -> error 1026 659E C1E7 MOV @STMTTB(R7),R7 Get address of stmt handler 65A0 69FC 1027 65A2 118F JLT P17L If top bit set -> GROM code 1028 65A4 0457 B *R7 If 9900 code, goto it! 1029 65A6 83 EXRTN BYTE >83 Unused bytes for data constant 1030 65A7 65 CBH65 BYTE >65 since NUDEND skips precedence 1031 65A8 0288 CI R8,SSEPZ*256 EOS only? 65AA 8200 1032 65AC 13CA JEQ EXEC15 Yes, continue on this line 1033 65AE D020 EXRTN2 MOVB @PRGFLG,R0 Did we execute an imperative 65B0 8344 1034 65B2 1351 JEQ EXEC50 Yes, so return to top-level 1035 65B4 6820 S @C4,@EXTRAM No, so goto the next line 65B6 6A80 65B8 832E 1036 65BA 8820 C @EXTRAM,@STLN Check to see if end of program 65BC 832E 65BE 8330 1037 65C0 14A6 JHE EXEC10 No, so loop for the next line 1038 65C2 1049 JMP EXEC50 Yes, so return to top-level 1039 * 1040 * STMT handler for :: 1041 * 1042 65C4 D208 SMTSEP MOVB R8,R8 EOL? 1043 65C6 16E0 JNE EXEC17 NO, there is another stmt 1044 65C8 0649 EXRTN3 DECT R9 YES 1045 65CA 10F1 JMP EXRTN2 Jump back into it 1046 * Continue after a breakpoint 1047 65CC 06A0 CONTIN BL @SETREG Set up Basic registers 65CE 1E7A 1048 65D0 10B8 EXC15L JMP EXEC15 Continue execution 1049 65D2 1038 BRKP1L JMP BRKPN1 1050 65D4 104E TRACL JMP TRACE 1051 * Test for required End-Of-Statement 99/4 ASSEMBLER PARSES PAGE 0023 1052 65D6 D208 EOL MOVB R8,R8 EOL reached? 1053 65D8 1306 JEQ NUDND1 Yes 1054 65DA 0288 CI R8,TREMZ*256 Higher then tail remark token? 65DC 8300 1055 65DE 1B37 JH ERRONE Yes, its an error 1056 65E0 0288 CI R8,ELSEZ*256 Tail, ssep or else? 65E2 8100 1057 65E4 1A34 JL ERRONE No, error 1058 * 1059 * Return from call to PARSE 1060 * (entered from CONT) 1061 * 1062 65E6 C1D9 NUDND1 MOV *R9,R7 Get the return address 1063 65E8 1185 JLT NUDE10 If negative - return to GPL 1064 65EA 0649 DECT R9 Back up the subroutine stack 1065 65EC 0467 B @2(R7) And return to caller 65EE 0002 1066 * (Skip the precedence word) 1067 65F0 D208 NUDEND MOVB R8,R8 Check for EOL 1068 65F2 13F9 JEQ NUDND1 If EOL 1069 65F4 0288 NUDND2 CI R8,STRINZ*256 Lower than a string? 65F6 C700 1070 65F8 1A08 JL NUDND4 Yes 1071 65FA 0288 CI R8,LNZ*256 Higher than a line #? 65FC C900 1072 65FE 1315 JEQ SKPLN Skip line numbers 1073 6600 1A0B JL SKPSTR Skip string or numeric 1074 6602 06A0 NUDND3 BL @PGMCHR Read next character 6604 6C74 1075 6606 13EF JEQ NUDND1 If EOL 1076 6608 10F5 JMP NUDND2 Continue scan of line 1077 660A 0288 NUDND4 CI R8,TREMZ*256 Higher than a tail remark? 660C 8300 1078 660E 1BF9 JH NUDND3 Yes 1079 6610 0288 CI R8,SSEPZ*256 Lower then stmt sep(else)? 6612 8200 1080 6614 1AF6 JL NUDND3 Yes 1081 6616 10E7 JMP NUDND1 TREM or SSEP 1082 6618 06A0 SKPSTR BL @PGMCHR 661A 6C74 1083 661C 06C8 SWPB R8 Prepare to add 1084 661E A808 A R8,@PGMPTR Skip it 6620 832C 1085 6622 04C8 CLR R8 Clear lower byte 1086 6624 06A0 SKPS01 BL @PGMCHR Get next token 6626 6C74 1087 6628 10E3 JMP NUDEND Go on 1088 662A 05E0 SKPLN INCT @PGMPTR Skip line number 662C 832C 1089 662E 10FA JMP SKPS01 Go on 1090 * 1091 * Return from "CALL" to GPL 1092 6630 06A0 RTNG BL @SETREG Set up registers again 6632 1E7A 1093 6634 10D8 JMP NUDND1 And jump back into it! 1094 ************************************************************ 1095 * Handle Breakpoints 1096 6636 D020 BRKPNT MOVB @FLAG,R0 Check flag bits 6638 8345 99/4 ASSEMBLER PARSES PAGE 0024 1097 663A 0A10 SLA R0,1 Check bit 6 for breakpoint 1098 663C 11C9 JLT EXC15L If set then ignore breakpoint 1099 663E 0200 BRKPN2 LI R0,BRKFL 6640 0001 1100 6642 1007 JMP EXIT Return to top-level 1101 6644 D020 BRKPN1 MOVB @FLAG,R0 Move flag bits 6646 8345 1102 6648 0A10 SLA R0,1 Check bit 6 for breakpoint 1103 664A 1195 JLT EXEC16 If set then ignore breakpoint 1104 664C 10F8 JMP BRKPN2 Bit not set 1105 * 1106 * Error handling from 9900 code 1107 * 1108 664E ERRSYN EQU $ These all issue same message 1109 664E ERRONE EQU $ 1110 664E NONUD EQU $ 1111 664E NOLED EQU $ 1112 664E 0200 LI R0,ERRSN *SYNTAX ERROR return code 6650 0003 1113 6652 EXIT EQU $ 1114 6652 C800 ERR MOV R0,@ERRCOD Load up return code for GPL 6654 8322 1115 * General return to GPL portion of Basic 1116 6656 C1E0 EXEC50 MOV @RTNADD,R7 Get return address 6658 8326 1117 665A 0460 B @NUDG05 Use commond code to link back 665C 64B0 1118 * Handle STOP and END statements 1119 STOP 1120 665E 0649 END DECT R9 Pop last call to PARSE 1121 6660 10FA JMP EXEC50 Jump to return to top-level 1122 * Error codes for return to GPL 1123 0003 ERRSN EQU >0003 ERROR SYNTAX 1124 0103 ERROM EQU >0103 ERROR OUT OF MEMORY 1125 0203 ERRIOR EQU >0203 ERROR INDEX OUT OF RANGE 1126 0303 ERRLNF EQU >0303 ERROR LINE NOT FOUND 1127 0403 ERREX EQU >0403 ERROR EXECUTION 1128 * >0004 WARNING NUMERIC OVERFLOW 1129 0001 BRKFL EQU >0001 BREAKPOINT RETURN VECTOR 1130 0005 ERROR EQU >0005 ON ERROR 1131 0006 UDF EQU >0006 FUNCTION REFERENCE 1132 0007 BREAK EQU >0007 ON BREAK 1133 0008 CONCAT EQU >0008 CONCATENATE (&) STRINGS 1134 0009 WARN EQU >0009 ON WARNING 1135 * Warning routine (only OVERFLOW) 1136 6662 C820 WARNZZ MOV @C4,@ERRCOD Load warning code for GPL 6664 6A80 6666 8322 1137 6668 020B LI R11,CONT-2 To optimize for return 666A 64C6 1138 * Return to GPL as a CALL 1139 666C 05C9 CALGPL INCT R9 Get space on subroutine stack 1140 666E C64B MOV R11,*R9 Save return address 1141 6670 10F2 JMP EXEC50 And go to GPL 1142 * Trace a line (Call GPL routine) 1143 6672 C820 TRACE MOV @C2,@ERRCOD Load return vector 6674 6000 6676 8322 1144 6678 020B LI R11,EXEC11-2 Set up for return to execute 99/4 ASSEMBLER PARSES PAGE 0025 667A 6514 1145 667C 10F7 JMP CALGPL Call GPL to display line # 1146 * Special code to handle concatenate (&) 1147 667E 0200 CONC LI R0,CONCAT Go to GPL to handle it 6680 0008 1148 6682 10E7 JMP EXIT Exit to GPL interpeter 1149 ************************************************************ 1150 * NUD routine for a numeric constant 1151 * NUMCON first puts pointer to the numeric string into 1152 * FAC12 for CSN, clears the error byte (FAC10) and then 1153 * converts from a string to a floating point number. Issues 1154 * warning if necessary. Leaves value in FAC 1155 ************************************************************ 1156 6684 C820 NUMCON MOV @PGMPTR,@FAC12 Set pointer for CSN 6686 832C 6688 8356 1157 668A 06C8 SWPB R8 Swap to get length into LSB 1158 668C A808 A R8,@PGMPTR Add to pointer to check end 668E 832C 1159 6690 04E0 CLR @FAC10 Assume no error 6692 8354 1160 6694 06A0 BL @SAVRE2 Save registers 6696 1E90 1161 6698 0203 LI R3,GETCH Adjustment for ERAM in order 669A 60AE 1162 669C D120 MOVB @RAMFLG,R4 to call CSN 669E 8389 1163 66A0 1302 JEQ NUMC49 1164 66A2 0203 LI R3,GETCGR 66A4 60D0 1165 66A6 06A0 NUMC49 BL @CSN01 Convert String to Number 66A8 11B2 1166 66AA 06A0 BL @SETREG Restore registers 66AC 1E7A 1167 66AE 8820 C @FAC12,@PGMPTR Check to see if all converted 66B0 8356 66B2 832C 1168 66B4 16CC JNE ERRONE If not - error 1169 66B6 06A0 BL @PGMCHR Now get next char from program 66B8 6C74 1170 66BA D020 MOVB @FAC10,R0 Get an overflow on conversion? 66BC 8354 1171 66BE 16D1 JNE WARNZZ Yes, have GPL issue warning 1172 66C0 0460 B @CONT Continue the PARSE 66C2 64C8 1173 * 1174 * ON ERROR, ON WARNING and ON BREAK 1175 66C4 0200 ONERR LI R0,ERROR ON ERROR code 66C6 0005 1176 66C8 10C4 JMP EXIT Return to GPL code 1177 66CA 0200 ONWARN LI R0,WARN ON WARNING code 66CC 0009 1178 66CE 10C1 JMP EXIT Return to GPL code 1179 66D0 0200 ONBRK LI R0,BREAK ON BREAK code 66D2 0007 1180 66D4 10BE JMP EXIT Return to GPL code 1181 * 1182 * NUD routine for "GO" 1183 * 99/4 ASSEMBLER PARSES PAGE 0026 1184 66D6 04C3 GO CLR R3 Dummy "ON" index for common 1185 66D8 1020 JMP ON30 Merge into "ON" code 1186 * 1187 * NUD ROUTINE FOR "ON" 1188 * 1189 66DA 0288 ON CI R8,WARNZ*256 On warning? 66DC A600 1190 66DE 13F5 JEQ ONWARN Yes, goto ONWARN 1191 66E0 0288 CI R8,ERRORZ*256 On error? 66E2 A500 1192 66E4 13EF JEQ ONERR Yes, got ONERR 1193 66E6 0288 CI R8,BREAKZ*256 On break? 66E8 8E00 1194 66EA 13F2 JEQ ONBRK Yes, goto ONBRK 1195 * 1196 * Normal "ON" statement 1197 * 1198 66EC 06A0 BL @PARSE PARSE the index value 66EE 6480 1199 66F0 B3 BYTE COMMAZ Stop on a comma or less 1200 66F1 66 CBH66 BYTE >66 Unused byte for constant 1201 66F2 06A0 BL @NUMCHK Ensure index is a number 66F4 6B92 1202 66F6 04E0 CLR @FAC10 Assume no error in CFI 66F8 8354 1203 66FA 06A0 BL @CFI Convert Floating to Integer 66FC 12B8 1204 66FE D020 MOVB @FAC10,R0 Test error code 6700 8354 1205 6702 1603 JNE GOTO90 If overflow, BAD VALUE 1206 6704 C0E0 MOV @FAC,R3 Get the index 6706 834A 1207 6708 1503 JGT ON20 Must be positive 1208 670A 0200 GOTO90 LI R0,ERRIOR Negative, BAD VALUE 670C 0203 1209 670E 10A1 GOTO95 JMP ERR Jump to error handler 1210 6710 ON20 EQU $ Now check GO TO/SUB 1211 6710 0288 CI R8,GOZ*256 Bare "GO" token? 6712 8500 1212 6714 1608 JNE ON40 No, check other possibilities 1213 6716 06A0 BL @PGMCHR Yes, get next token 6718 6C74 1214 671A 0288 ON30 CI R8,TOZ*256 "GO TO" ? 671C B100 1215 671E 1365 JEQ GOTO50 Yes, handle GO TO like GOTO 1216 6720 0288 CI R8,SUBZ*256 "GO SUB" ? 6722 A100 1217 6724 1005 JMP ON50 Merge to common code to test 1218 6726 0288 ON40 CI R8,GOTOZ*256 "GOTO" ? 6728 8600 1219 672A 135F JEQ GOTO50 Yes, go handle it 1220 672C 0288 CI R8,GOSUBZ*256 "GOSUB" ? 672E 8700 1221 6730 168E ON50 JNE ERRONE No, so is an error 1222 6732 06A0 BL @PGMCHR Get next token 6734 6C74 1223 6736 1002 JMP GOSUB2 Goto gosub code 1224 6738 108A ERR1B JMP ERRONE Issue error message 1225 * NUD routine for "GOSUB" 99/4 ASSEMBLER PARSES PAGE 0027 1226 673A 04C3 GOSUB CLR R3 Dummy index for "ON" code 1227 * Common GOSUB code 1228 673C GOSUB2 EQU $ Now build a FAC entry 1229 673C 0201 LI R1,FAC Optimize to save bytes 673E 834A 1230 6740 CC43 MOV R3,*R1+ Save the "ON" index 1231 * in case of garbage collection 1232 6742 DC60 MOVB @CBH66,*R1+ Indicate GOSUB entry on stack 6744 66F1 1233 6746 0581 INC R1 Skip FAC3 1234 6748 C460 MOV @PGMPTR,*R1 Save current ptr w/in line 674A 832C 1235 674C 05F1 INCT *R1+ Skip line # to correct place 1236 674E C460 MOV @EXTRAM,*R1 Save current line # pointer 6750 832E 1237 6752 06A0 BL @VPUSH Save the stack entry 6754 6BAA 1238 6756 C0E0 MOV @FAC,R3 Restore the "ON" index 6758 834A 1239 675A 1001 JMP GOTO20 Jump to code to find the line 1240 * NUD routine for "GOTO" 1241 675C 04C3 GOTO CLR R3 Dummy index for "ON" code 1242 * Common (ON) GOTO/GOSUB THEN/ELSE code to fine line 1243 * 1244 * Get line number from program 1245 675E 0288 GOTO20 CI R8,LNZ*256 Must have line number token 6760 C900 1246 6762 16EA JNE ERR1B Don't, so error 1247 6764 06A0 GETL10 BL @PGMCHR Get MSB of the line number 6766 6C74 1248 6768 D008 MOVB R8,R0 Save it 1249 676A 06A0 BL @PGMCHR Read the character 676C 6C74 1250 676E 0603 DEC R3 Decrement the "ON" index 1251 6770 1534 JGT GOTO40 Loop if not there yet 1252 * 1253 * Find the program line 1254 * 1255 6772 C060 MOV @STLN,R1 Get into line # table 6774 8330 1256 6776 D0A0 MOVB @RAMFLG,R2 Check ERAM flag to see where? 6778 8389 1257 677A 1310 JEQ GOTO31 From VDP, go handle it 1258 677C C081 MOV R1,R2 Copy address 1259 677E 8801 GOT32 C R1,@ENLN Finished w/line # table? 6780 8332 1260 6782 1422 JHE GOTO34 Yes, so line doesn't exist 1261 6784 D0F2 MOVB *R2+,R3 2nd byte match? 1262 6786 0243 ANDI R3,>7FFF Reset possible breakpoint 6788 7FFF 1263 678A 9003 CB R3,R0 Compare 1st byte of #, Match? 1264 678C 1605 JNE GOT35 Not a match, so move on 1265 678E 9232 CB *R2+,R8 2nd byte match? 1266 6790 131E JEQ GOTO36 Yes, line is found! 1267 6792 05C2 GOT33 INCT R2 Skip line pointer 1268 6794 C042 MOV R2,R1 Advance to next line in table 1269 6796 10F3 JMP GOT32 Go back for more 1270 6798 D0F2 GOT35 MOVB *R2+,R3 Skip 2nd byte of line # 1271 679A 10FB JMP GOT33 And jump back in 99/4 ASSEMBLER PARSES PAGE 0028 1272 679C D7E0 GOTO31 MOVB @R1LB,*R15 Get the data from the VDP 679E 83E3 1273 67A0 0202 LI R2,XVDPRD Load up to read data 67A2 8800 1274 67A4 D7C1 MOVB R1,*R15 Write out MSB of address 1275 67A6 8801 GOTO32 C R1,@ENLN Finished w/line # table 67A8 8332 1276 67AA 140E JHE GOTO34 Yes, so line doesn't exist 1277 67AC D0D2 MOVB *R2,R3 Save in temporary place for 1278 * breakpoint checking 1279 67AE 0243 ANDI R3,>7FFF Reset possible breakpoint 67B0 7FFF 1280 67B2 9003 CB R3,R0 Compare 1st byte of #, Match? 1281 67B4 1607 JNE GOTO35 Not a match, so move on 1282 67B6 9212 CB *R2,R8 2nd byte match? 1283 67B8 130A JEQ GOTO36 Yes, line is found! 1284 67BA D0D2 GOTO33 MOVB *R2,R3 Skip 1st byte of line pointer 1285 67BC 0221 AI R1,4 Advance to next line in table 67BE 0004 1286 67C0 D0D2 MOVB *R2,R3 Skip 1nd byte of line pointer 1287 67C2 10F1 JMP GOTO32 Go back for more 1288 67C4 D0D2 GOTO35 MOVB *R2,R3 Skip 2nd byte of line # 1289 67C6 10F9 JMP GOTO33 And jump back in 1290 67C8 0200 GOTO34 LI R0,ERRLNF LINE NOT FOUND error vector 67CA 0303 1291 67CC 10A0 JMP GOTO95 Jump for error exit 1292 67CE 05C1 GOTO36 INCT R1 Adjust to line pointer 1293 67D0 C801 MOV R1,@EXTRAM Save for execution of the line 67D2 832E 1294 67D4 0649 DECT R9 Pop saved link to goto 1295 67D6 0460 B @EXEC10 Reenter EXEC code directly 67D8 650E 1296 67DA 06A0 GOTO40 BL @PGMCHR Get next token 67DC 6C74 1297 67DE 06A0 BL @EOSTMT Premature end of statement? 67E0 6862 1298 67E2 1393 JEQ GOTO90 Yes =>BAD VALUE for index 1299 67E4 0288 CI R8,COMMAZ*256 Comma next ? 67E6 B300 1300 67E8 1603 JNE ERR1C No, error 1301 67EA 06A0 GOTO50 BL @PGMCHR Yes, get next character 67EC 6C74 1302 67EE 10B7 JMP GOTO20 And check this index value 1303 67F0 10A3 ERR1C JMP ERR1B Linking becuase long-distance 1304 67F2 0200 ERR51 LI R0,>0903 RETURN WITHOUT GOSUB 67F4 0903 1305 67F6 108B JMP GOTO95 Exit to GPL 1306 * NUD entry for "RETURN" 1307 67F8 8820 RETURN C @VSPTR,@STVSPT Check bottom of stack 67FA 836E 67FC 8324 1308 67FE 12F9 JLE ERR51 Error -> RETURN WITHOUT GOSUB 1309 6800 06A0 BL @VPOP Pop entry 6802 6C2A 1310 6804 9820 CB @CBH66,@FAC2 Check ID for a GOSUB entry 6806 66F1 6808 834C 1311 680A 160B JNE RETU30 Check for ERROR ENTRY 1312 * 99/4 ASSEMBLER PARSES PAGE 0029 1313 * Have a GOSUB entry 1314 * 1315 680C 06A0 BL @EOSTMT Must have EOS after return 680E 6862 1316 6810 16F3 JNE RETURN Not EOS, then error return? 1317 6812 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6814 834E 6816 832C 1318 6818 C820 MOV @FAC6,@EXTRAM Get return line pointer 681A 8350 681C 832E 1319 681E 0460 B @SKPS01 Go adjust it and get back 6820 6624 1320 * Check ERROR entry 1321 6822 9820 RETU30 CB @CBH69,@FAC2 ERROR ENTRY? 6824 6A9B 6826 834C 1322 6828 1307 JEQ RETU40 Yes, take care of error entry 1323 682A 9820 CB @CBH6A,@FAC2 Subprogram entry? 682C 6860 682E 834C 1324 6830 16E3 JNE RETURN No, look some more 1325 6832 06A0 BL @VPUSH Push it back. Keep information 6834 6BAA 1326 6836 10DD JMP ERR51 RETURN WITHOUT GOSUB error 1327 * 1328 * Have an ERROR entry 1329 * RETURN, RETURN line #, RETURN or RETURN NEXT follows. 1330 * 1331 6838 04C3 RETU40 CLR R3 In case of a line number 1332 683A 0288 CI R8,LNZ*256 Check for a line number 683C C900 1333 683E 1392 JEQ GETL10 Yes, treat like GOTO 1334 6840 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6842 834E 6844 832C 1335 6846 C820 MOV @FAC6,@EXTRAM Get return line pointer 6848 8350 684A 832E 1336 684C 06A0 BL @EOSTMT EOL now? 684E 6862 1337 6850 1305 JEQ BEXC15 Yes, treat like GOSUB rtn. 1338 6852 0288 CI R8,NEXTZ*256 NEXT now? 6854 9600 1339 6856 16CC JNE ERR1C No, so its an error 1340 6858 0460 B @SKPS01 Yes, so execute next statement 685A 6624 1341 685C 0460 BEXC15 B @EXEC15 Execute next line 685E 6542 1342 6860 6A CBH6A BYTE >6A Subprogram call stack ID 1343 EVEN 1344 ************************************************************ 1345 * EOSTMT - Check for End-Of-STateMenT 1346 * Returns with condition '=' if EOS 1347 * else condition '<>' if not EOS 1348 ************************************************************ 1349 6862 D208 EOSTMT MOVB R8,R8 EOL or non-token? 1350 6864 1305 JEQ EOSTM1 EOL-return condition '=' 1351 6866 1504 JGT EOSTM1 Non-token return condition '<> 99/4 ASSEMBLER PARSES PAGE 0030 1352 6868 0288 CI R8,TREMZ*256 In the EOS range (>81 to >83)? 686A 8300 1353 686C 1B01 JH EOSTM1 No, return condition '<>' 1354 686E 8208 C R8,R8 Yes, force condition to '=' 1355 6870 045B EOSTM1 RT 1356 ************************************************************ 1357 * EOLINE - Tests for End-Of-LINE; either a >00 or a 1358 * '!' 1359 * Returns with condition '=' if EOL else condition 1360 * '<>' if not EOL 1361 ************************************************************ 1362 6872 D208 EOLINE MOVB R8,R8 EOL? 1363 6874 1302 JEQ EOLNE1 Yes, return with '=' set 1364 6876 0288 CI R8,TREMZ*256 Set condition on a tall remark 6878 8300 1365 687A 045B EOLNE1 RT And return 1366 687C 0200 SYMB20 LI R0,UDF Long distance 687E 0006 1367 6880 0460 B @GOTO95 6882 670E 1368 * NUD for a symbol (variable) 1369 6884 06A0 PSYM BL @SYM Get symbol table entry 6886 6312 1370 6888 06A0 BL @GETV Get 1st byte of entry 688A 187C 1371 688C 834A DATA FAC SYM left pointer in FAC 1372 * 1373 688E 0A11 SLA R1,1 UDF reference? 1374 6890 11F5 JLT SYMB20 Yes, special code for it 1375 6892 06A0 BL @SMB No, get value space pointer 6894 61DC 1376 6896 9820 CB @FAC2,@CBH65 String reference? 6898 834C 689A 65A7 1377 689C 1302 JEQ SYMB10 Yes, special code for it 1378 689E 06A0 BL @MOVFAC No, numeric ->copy into FAC 68A0 6434 1379 68A2 0460 SYMB10 B @CONT And continue the PARSE 68A4 64C8 1380 * Statement entry for IF statement 1381 68A6 06A0 IF BL @PARSE Evaluate the expression 68A8 6480 1382 68AA B3 BYTE COMMAZ Stop on a comma 1383 68AB 67 CBH67 BYTE >67 Unused byte for a constant 1384 68AC 06A0 BL @NUMCHK Ensure the value is a number 68AE 6B92 1385 68B0 04C3 CLR R3 Create a dummy "ON" index 1386 68B2 0288 CI R8,THENZ*256 Have a "THEN" token 68B4 B000 1387 68B6 169C JNE ERR1C No, error 1388 68B8 0520 NEG @FAC Test if condition true i.e. <> 68BA 834A 1389 68BC 1610 JNE IFZ10 True - branch to the special # 1390 68BE 06A0 BL @PGMCHR Advance to line number token 68C0 6C74 1391 68C2 0288 CI R8,LNZ*256 Have the line # token? 68C4 C900 1392 68C6 1619 JNE IFZ20 No, must look harder for ELSE 1393 68C8 05E0 INCT @PGMPTR Skip the line number 99/4 ASSEMBLER PARSES PAGE 0031 68CA 832C 1394 68CC 06A0 BL @PGMCHR Get next token 68CE 6C74 1395 68D0 0288 IFZ5 CI R8,ELSEZ*256 Test if token is ELSE 68D2 8100 1396 68D4 1304 JEQ IFZ10 We do! So branch to the line # 1397 68D6 0460 B @EOL We don't, so better be EOL 68D8 65D6 1398 68DA 0460 GETL1Z B @GETL10 Get 1st token of clause 68DC 6764 1399 68DE 06A0 IFZ10 BL @PGMCHR Get 1st token of clause 68E0 6C74 1400 68E2 0288 CI R8,LNZ*256 Line # token? 68E4 C900 1401 68E6 13F9 JEQ GETL1Z Yes, go there 1402 68E8 06A0 BL @EOSTMT EOS? 68EA 6862 1403 68EC 1381 JEQ1C JEQ ERR1C Yes, its an error 1404 68EE 0208 LI R8,SSEPZ*256 Cheat to do a continue 68F0 8200 1405 68F2 0620 DEC @PGMPTR Back up to get 1st character 68F4 832C 1406 68F6 0460 B @CONT Continue on 68F8 64C8 1407 * 1408 * LOOK FOR AN ELSE CLAUSE SINCE THE CONDITION WAS FALSE 1409 * 1410 68FA 0203 IFZ20 LI R3,1 IF/ELSE pair counter 68FC 0001 1411 68FE 06A0 BL @EOLINE Trap out EOS following THEN/EL 6900 6872 1412 6902 13F4 JEQ JEQ1C error 1413 6904 0288 IFZ25 CI R8,ELSEZ*256 ELSE? 6906 8100 1414 6908 1603 JNE IFZ27 If not 1415 690A 0603 DEC R3 Matching ELSE? 1416 690C 13E8 JEQ IFZ10 Yes, do it 1417 690E 100F JMP IFZ35 No, go on 1418 6910 0288 IFZ27 CI R8,IFZ*256 Check for it 6912 8400 1419 6914 1602 JNE IFZ28 Not an IF 1420 6916 0583 INC R3 Increment nesting level 1421 6918 100A JMP IFZ35 And go on 1422 691A 0288 IFZ28 CI R8,STRINZ*256 Lower than string? 691C C700 1423 691E 1A04 JL IFZ30 Yes 1424 6920 0288 CI R8,LNZ*256 Higher or = to a line # 6922 C900 1425 6924 1307 JEQ IFZ40 = line # 1426 6926 1A09 JL IFZ50 Skip strings and numerics 1427 6928 06A0 IFZ30 BL @EOLINE EOL? 692A 6872 1428 692C 13D1 JEQ IFZ5 Yes, done scanning 1429 692E 06A0 IFZ35 BL @PGMCHR Get next character 6930 6C74 1430 6932 10E8 JMP IFZ25 And go on 1431 * 1432 * SKIP LINE #'s 1433 * 99/4 ASSEMBLER PARSES PAGE 0032 1434 6934 05E0 IFZ40 INCT @PGMPTR Skip the line # 6936 832C 1435 6938 10FA JMP IFZ35 Go on 1436 * 1437 * SKIP STRINGS AND NUMERICS 1438 * 1439 693A 06A0 IFZ50 BL @PGMCHR Get # of bytes to skip 693C 6C74 1440 693E 06C8 SWPB R8 Swap for add 1441 6940 A808 A R8,@PGMPTR Skip it 6942 832C 1442 6944 04C8 CLR R8 Clear LSB of R8 1443 6946 10F3 JMP IFZ35 1444 ************************************************************ 1445 1447 1448 ************************************************************ 1449 * 'LET' statement handler 1450 * Assignments are done bye putting an entry on the stack 1451 * for the destination variable and getting the source value 1452 * into the FAC. Multiple assignments are handled by the 1453 * stacking the variable entrys and then looping for the 1454 * assignments. Numeric assignments pose no problems, 1455 * strings are more complicated. String assignments are done 1456 * by assigning the source string to the last variable 1457 * specified in the list and changing the FAC entry so that 1458 * the string assigned to the next-to-the-last variable 1459 * comes from the permanent string belonging to the variable 1460 * just assigned. 1461 * e.g. A$,B$,C$="HELLO" 1462 * 1463 * C$-------"HELLO" (source string) 1464 * 1465 * B$-------"HELLO" (copy from CZ's string) 1466 * 1467 * A$-------"HELLO" (copy from BZ's string) 1468 ************************************************************ 1469 6948 04E0 NLET CLR @PAD Counter for multiple assign's 694A 8300 1470 694C 06A0 NLET05 BL @SYM Get symbol table address 694E 6312 1471 *----------------------------------------------------------- 1472 * The following code has been taken out for checking is 1473 * inserted in SMB 5/22/81 1474 * BL @GETV Get first byte of entry 1475 * DATA FAC SYM left pointer in FAC 1476 * SLA R1,1 Test if a UDF 1477 * JLT ERRMUV Is a UDF - so error 1478 *----------------------------------------------------------- 1479 6950 06A0 BL @SMB Get value space pointer 6952 61DC 1480 6954 06A0 BL @VPUSH Push s.t. pointer on stack 6956 6BAA 1481 6958 05A0 INC @PAD Count the variable 695A 8300 1482 695C 0288 CI R8,EQZ*256 Is the token an '='? 695E BE00 1483 6960 130B JEQ NLET10 Yes, go into assignment loop 1484 6962 0288 CI R8,COMMAZ*256 Must have a comma now 99/4 ASSEMBLER PARSES2 PAGE 0033 6964 B300 1485 6966 161E JNE ERR1CZ Didn't - so error 1486 6968 06A0 BL @PGMCHR Get next token 696A 6C74 1487 696C 15EF JGT NLET05 If legal symbol character 1488 696E 101A JMP ERR1CZ If not - error 1489 6970 0200 ERRMUV LI R0,>0D03 MULTIPLY USED VARIABLE 6972 0D03 1490 6974 0460 B @ERR 6976 6652 1491 6978 06A0 NLET10 BL @PGMCHR Get next token 697A 6C74 1492 697C 06A0 BL @PARSE PARSE the value to assign 697E 6480 1493 6980 83 BYTE TREMZ Parse to the end of statement 1494 6981 65 STCOD2 BYTE >65 Wasted byte (STCODE copy) 1495 * Loop for assignments 1496 6982 06A0 NLET15 BL @ASSG Assign the value to the symbol 6984 6334 1497 6986 0620 DEC @PAD One less to assign, done? 6988 8300 1498 698A 130A JEQ LETCON Yes, branch out 1499 698C 9820 CB @FAC2,@STCOD2 String or numeric? 698E 834C 6990 6981 1500 6992 16F7 JNE NLET15 Numeric, just loop for more 1501 6994 C806 MOV R6,@FAC4 Get pointer to new string 6996 834E 1502 6998 C820 MOV @ARG,@FAC Get pointer to last s.t. entry 699A 835C 699C 834A 1503 699E 10F1 JMP NLET15 Now loop to assign more 1504 69A0 0460 LETCON B @EOL Yes, continue the PARSE 69A2 65D6 1505 69A4 0460 ERR1CZ B @ERR1C For long distance jump 69A6 67F0 1506 69A8 664E DATA NONUD (SPARE) >80 1507 69AA 664E DATA NONUD ELSE >81 1508 69AC 65C4 DATA SMTSEP :: >82 1509 69AE 65E6 DATA NUDND1 ! >83 1510 69B0 68A6 DATA IF IF >84 1511 69B2 66D6 DATA GO GO >85 1512 69B4 675C DATA GOTO GOTO >86 1513 69B6 673A DATA GOSUB GOSUB >87 1514 69B8 67F8 DATA RETURN RETURN >88 1515 69BA 65F0 DATA NUDEND DEF >89 1516 69BC 65F0 DATA NUDEND DIM >8A 1517 69BE 665E DATA END END >8B 1518 69C0 7000 DATA NFOR FOR >8C 1519 69C2 6948 DATA NLET LET >8D 1520 69C4 8002 DATA >8002 BREAK >8E 1521 69C6 8004 DATA >8004 UNBREAK >8F 1522 69C8 8006 DATA >8006 TRACE >90 1523 69CA 8008 DATA >8008 UNTRACE >91 1524 69CC 8016 DATA >8016 INPUT >92 1525 69CE 65E6 DATA NUDND1 DATA >93 1526 69D0 8012 DATA >8012 RESTORE >94 1527 69D2 8014 DATA >8014 RANDOMIZE >95 1528 69D4 7230 DATA NNEXT NEXT >96 99/4 ASSEMBLER PARSES2 PAGE 0034 1529 69D6 800A DATA >800A READ >97 1530 69D8 665E DATA STOP STOP >98 1531 69DA 8032 DATA >8032 DELETE >99 1532 69DC 65E6 DATA NUDND1 REM >9A 1533 69DE 66DA DATA ON ON >9B 1534 69E0 800C DATA >800C PRINT >9C 1535 69E2 750A DATA CALL CALL >9D 1536 69E4 65F0 DATA NUDEND OPTION >9E 1537 69E6 8018 DATA >8018 OPEN >9F 1538 69E8 801A DATA >801A CLOSE >A0 1539 69EA 665E DATA STOP SUB >A1 1540 69EC 8034 DATA >8034 DISPLAY >A2 1541 69EE 65E6 DATA NUDND1 IMAGE >A3 1542 69F0 8024 DATA >8024 ACCEPT >A4 1543 69F2 664E DATA NONUD ERROR >A5 1544 69F4 664E DATA NONUD WARNING >A6 1545 69F6 78D2 DATA SUBXIT SUBEXIT >A7 1546 69F8 78D2 DATA SUBXIT SUBEND >A8 1547 69FA 800E DATA >800E RUN >A9 1548 69FC 8010 STMTTB DATA >8010 LINPUT >AA 1549 69FE 6E68 NTAB DATA NLPR LEFT PARENTHISIS >B7 1550 6A00 664E DATA NONUD CONCATENATE >B8 1551 6A02 664E DATA NONUD SPARE >B9 1552 6A04 664E DATA NONUD AND >BA 1553 6A06 664E DATA NONUD OR >BB 1554 6A08 664E DATA NONUD XOR >BC 1555 6A0A 6E2E DATA O0NOT NOT >BD 1556 6A0C 664E DATA NONUD = >BE 1557 6A0E 664E DATA NONUD < >BF 1558 6A10 664E DATA NONUD > >C0 1559 6A12 6E96 DATA NPLUS + >C1 1560 6A14 6E82 DATA NMINUS - >C2 1561 6A16 664E DATA NONUD * >C3 1562 6A18 664E DATA NONUD / >C4 1563 6A1A 664E DATA NONUD ^ >C5 1564 6A1C 664E DATA NONUD INTEGER >C6 1565 6A1E 7442 DATA NSTRCN QUOTED STRING >C7 1566 6A20 6684 DATA NUMCON UNQUOTED STRING/NUMERIC >C8 1567 6A22 664E DATA NONUD LINE NUMBER >C9 1568 6A24 8026 DATA >8026 EOF >CA 1569 6A26 6CFA DATA NABS ABS >CB 1570 6A28 6D16 DATA NATN ATN >CC 1571 6A2A 6D1C DATA NCOS COS >CD 1572 6A2C 6D22 DATA NEXP EXP >CE 1573 6A2E 6D28 DATA NINT INT >CF 1574 6A30 6D2E DATA NLOG LOG >D0 1575 6A32 6D34 DATA NSGN SGN >D1 1576 6A34 6D64 DATA NSIN SIN >D2 1577 6A36 6D6A DATA NSQR SQR >D3 1578 6A38 6D70 DATA NTAN TAN >D4 1579 6A3A 8036 DATA >8036 LEN >D5 1580 6A3C 8038 DATA >8038 CHRZ >D6 1581 6A3E 803A DATA >803A RND >D7 1582 6A40 8030 DATA >8030 SEGZ >D8 1583 6A42 802A DATA >802A POS >D9 1584 6A44 802C DATA >802C VAL >DA 1585 6A46 802E DATA >802E STR >DB 1586 6A48 8028 DATA >8028 ASC >DC 1587 6A4A 801C DATA >801C PI >DD 99/4 ASSEMBLER PARSES2 PAGE 0035 1588 6A4C 8000 DATA >8000 REC >DE 1589 6A4E 801E DATA >801E MAX >DF 1590 6A50 8020 DATA >8020 MIN >E0 1591 6A52 8022 DATA >8022 RPTZ >E1 1592 0056 NTABLN EQU $-NTAB 1593 6A54 667E LTAB DATA CONC & >B8 1594 6A56 664E DATA NOLED SPARE >B9 1595 6A58 6E1C DATA O0OR OR >BA 1596 6A5A 6DFA DATA O0AND AND >BB 1597 6A5C 6E50 DATA O0XOR XOR >BC 1598 6A5E 664E DATA NOLED NOT >BD 1599 6A60 6A8E DATA EQUALS = >BE 1600 6A62 6A70 DATA LESS < >BF 1601 6A64 6A7E DATA GREATR > >C0 1602 6A66 6B1E DATA PLUS + >C1 1603 6A68 6B4A DATA MINUS - >C2 1604 6A6A 6B56 DATA TIMES * >C3 1605 6A6C 6B62 DATA DIVIDE / >C4 1606 6A6E 6CE2 DATA LEXP ^ >C5 1607 001C LTBLEN EQU $-LTAB 1608 ************************************************************ 1609 * Relational operators 1610 * Logical conparisons encode the type of comparison and use 1611 * common code to PARSE the expression and set the status 1612 * bits. 1613 * 1614 * The types of legal comparisons are: 1615 * 0 EQUAL 1616 * 1 NOT EQUAL 1617 * 2 LESS THAN 1618 * 3 LESS OR EQUAL 1619 * 4 GREATER THAN 1620 * 5 GREATER THAN OR EQUAL 1621 * 1622 * This code is saved on the subroutine stack 1623 ************************************************************ 1624 6A70 0202 LESS LI R2,2 LESS-THAN code for common rtn 6A72 0002 1625 6A74 0288 CI R8,GTZ*256 Test for '>' token 6A76 C000 1626 6A78 1604 JNE LT10 Jump if not 1627 6A7A 0642 DECT R2 Therefore, NOT-EQUAL code 1628 6A7C 1005 JMP LT15 Jump to common 1629 6A80 C4 EQU $+2 Constant 4 1630 6A7E 0202 GREATR LI R2,4 GREATER-THEN code for common 6A80 0004 1631 6A82 0288 LT10 CI R8,EQZ*256 Test for '=' token 6A84 BE00 1632 6A86 1605 JNE LTST01 Jump if '>=' 1633 6A88 06A0 LT15 BL @PGMCHR Must be plain old '>' or '<' 6A8A 6C74 1634 6A8C 1001 JMP LEDLE Jump to test 1635 6A8E 0702 EQUALS SETO R2 Equal bit for common routine 1636 6A90 0582 LEDLE INC R2 Sets to zero 1637 6A92 05C9 LTST01 INCT R9 Get room on stack for code 1638 6A94 C642 MOV R2,*R9 Save status matching code 1639 6A96 06A0 BL @PSHPRS Push 1st arg and PARSE the 2nd 6A98 6B9C 1640 6A9A C0 BYTE GTZ Parse to a '>' 99/4 ASSEMBLER PARSES2 PAGE 0036 1641 6A9B 69 CBH69 BYTE >69 Used in RETURN routine 1642 6A9C C119 MOV *R9,R4 Get the type code from stack 1643 6A9E 0649 DECT R9 Reset subroutine stack pointer 1644 6AA0 D324 MOVB @LTSTAB(R4),R12 Get address bias to baranch to 6AA2 6ADA 1645 6AA4 088C SRA R12,8 Right justify 1646 6AA6 06A0 BL @ARGTST Test for matching arguments 6AA8 6B6E 1647 6AAA 131A JEQ LTST20 Handle strings specially 1648 6AAC 06A0 BL @SCOMPB Floating point comparison 6AAE 0D42 1649 6AB0 046C LTST15 B @LTSTXX(R12) Interpret the status by code 6AB2 6AB4 1650 6AB4 LTSTXX EQU $ 1651 6AB4 1504 LTSTGE JGT LTRUE Test if GREATER or EQUAL 1652 6AB6 1303 LTSTEQ JEQ LTRUE Test if EQUAL 1653 6AB8 04C4 LFALSE CLR R4 FALSE is a ZERO 1654 6ABA 1003 JMP LTST90 Put it into FAC 1655 6ABC 13FD LTSTNE JEQ LFALSE Test if NOT-EQUAL 1656 6ABE 0204 LTRUE LI R4,>BFFF TRUE is a minus-one 6AC0 BFFF 1657 6AC2 0203 LTST90 LI R3,FAC Store result in FAC 6AC4 834A 1658 6AC6 CCC4 MOV R4,*R3+ Exp & 1st byte of manitissa 1659 6AC8 04F3 CLR *R3+ ZERO the remaining digits 1660 6ACA 04F3 CLR *R3+ ZERO the remaining digits 1661 6ACC 04F3 CLR *R3+ ZERO the remaining digits 1662 6ACE 1039 JMP LEDEND Jump to end of LED routine 1663 6AD0 13F6 LTSTLE JEQ LTRUE Test LESS-THAN or EQUAL 1664 6AD2 11F5 LTSTLT JLT LTRUE Test LESS-THEN 1665 6AD4 10F1 JMP LFALSE Jump to false 1666 6AD6 15F3 LTSTGT JGT LTRUE Test GREATER-THAN 1667 6AD8 10EF JMP LFALSE Jump to false 1668 * Data table for offsets for types 1669 6ADA 02 LTSTAB BYTE LTSTEQ-LTSTXX EQUAL (0) 1670 6ADB 08 BYTE LTSTNE-LTSTXX NOT EQUAL (1) 1671 6ADC 1E BYTE LTSTLT-LTSTXX LESS THEN (2) 1672 6ADD 1C BYTE LTSTLE-LTSTXX LESS or EQUAL (3) 1673 6ADE 22 BYTE LTSTGT-LTSTXX GREATER THEN (4) 1674 6ADF 00 BYTE LTSTGE-LTSTXX GREATER or EQUAL (5) 1675 6AE0 C2A0 LTST20 MOV @FAC4,R10 Pointer to string1 6AE2 834E 1676 6AE4 D1E0 MOVB @FAC7,R7 R7 = string2 length 6AE6 8351 1677 6AE8 06A0 BL @VPOP Get LH arg back 6AEA 6C2A 1678 6AEC C120 MOV @FAC4,R4 Pointer to string2 6AEE 834E 1679 6AF0 D1A0 MOVB @FAC7,R6 R6 = string2 length 6AF2 8351 1680 6AF4 D146 MOVB R6,R5 R5 will contain shorter length 1681 6AF6 91C6 CB R6,R7 Compare the 2 lengths 1682 6AF8 1101 JLT CSTR05 Jump if length2 < length1 1683 6AFA D147 MOVB R7,R5 Swap if length1 > length2 1684 6AFC 0985 CSTR05 SRL R5,8 Shift for speed and test zero 1685 6AFE 130D JEQ CSTR20 If ZERO-set status with length 1686 6B00 C0CA CSTR10 MOV R10,R3 Current character location 1687 6B02 058A INC R10 Increment pointer 1688 6B04 06A0 BL @GETV1 Get from VDP 99/4 ASSEMBLER PARSES2 PAGE 0037 6B06 1880 1689 6B08 D001 MOVB R1,R0 And save for comparison 1690 6B0A C0C4 MOV R4,R3 Current char location in ARG 1691 6B0C 0584 INC R4 Increment pointer 1692 6B0E 06A0 BL @GETV1 Get from VDP 6B10 1880 1693 6B12 9001 CB R1,R0 Compare the characters 1694 6B14 16CD JNE LTST15 Return with status if <> 1695 6B16 0605 DEC R5 Otherwise, decrement counter 1696 6B18 15F3 JGT CSTR10 And loop for each character 1697 6B1A 91C6 CSTR20 CB R6,R7 Status set by length compare 1698 6B1C 10C9 JMP LTST15 Return to do test of status 1699 * ARITHMETIC FUNCTIONS 1700 6B1E 06A0 PLUS BL @PSHPRS Push left arg and PARSE right 6B20 6B9C 1701 6B22 C2 BYTE MINUSZ,0 Stop on a minus!!!!!!!!!!!!!!! 6B23 00 1702 6B24 0202 LI R2,SADD Address of add routine 6B26 0D84 1703 6B28 04E0 LEDEX CLR @FAC10 Clear error code 6B2A 8354 1704 6B2C 06A0 BL @ARGTST Make sure both numerics 6B2E 6B6E 1705 6B30 132E JEQ ARGT05 If strings, error 1706 6B32 06A0 BL @SAVREG Save registers 6B34 1E8C 1707 6B36 0692 BL *R2 Do the operation 1708 6B38 06A0 BL @SETREG Restore registers 6B3A 1E7A 1709 6B3C D0A0 MOVB @FAC10,R2 Test for overflow 6B3E 8354 1710 6B40 1602 JNE LEDERR If overflow ->error 1711 6B42 0460 LEDEND B @CONT Continue the PARSE 6B44 64C8 1712 6B46 0460 LEDERR B @WARNZZ Overflow - issue warning 6B48 6662 1713 6B4A 06A0 MINUS BL @PSHPRS Push left arg and PARSE right 6B4C 6B9C 1714 6B4E C2 BYTE MINUSZ,0 Parse to a minus 6B4F 00 1715 6B50 0202 LI R2,SSUB Address of subtract routine 6B52 0D74 1716 6B54 10E9 JMP LEDEX Common code for the operation 1717 6B56 06A0 TIMES BL @PSHPRS Push left arg and PARSE right 6B58 6B9C 1718 6B5A C4 BYTE DIVIZ,0 Parse to a divide!!!!!!!!!!!!! 6B5B 00 1719 6B5C 0202 LI R2,SMULT Address of multiply routine 6B5E 0E8C 1720 6B60 10E3 JMP LEDEX Common code for the operation 1721 6B62 06A0 DIVIDE BL @PSHPRS Push left arg and PARSE right 6B64 6B9C 1722 6B66 C4 BYTE DIVIZ,0 Parse to a divide 6B67 00 1723 6B68 0202 LI R2,SDIV Address of divide routine 6B6A 0FF8 1724 6B6C 10DD JMP LEDEX Common code for the operation 1725 ************************************************************ 1726 * Test arguments on both the stack and in the FAC 99/4 ASSEMBLER PARSES2 PAGE 0038 1727 * Both must be of the same type 1728 * CALL: 1729 * BL @ARGTST 1730 * JEQ If string 1731 * JNE If numeric 1732 ************************************************************ 1733 6B6E C1A0 ARGTST MOV @VSPTR,R6 Get stack pointer 6B70 836E 1734 6B72 05C6 INCT R6 1735 6B74 D7E0 MOVB @R6LB,*R15 Load 2nd byte of stack address 6B76 83ED 1736 6B78 1000 NOP Kill some time 1737 6B7A D7C6 MOVB R6,*R15 Load 1st byte of stack address 1738 6B7C 1000 NOP Kill some time 1739 6B7E 9820 CB @XVDPRD,@CBH65 String in operand 1? 6B80 8800 6B82 65A7 1740 6B84 1606 JNE ARGT10 No, numeric 1741 6B86 9820 CB @FAC2,@CBH65 Yes, is other the same? 6B88 834C 6B8A 65A7 1742 6B8C 1306 JEQ ARGT20 Yes, do string comparison 1743 6B8E 0460 ARGT05 B @ERRT Data types don't match 6B90 630C 1744 NUMCHK 1745 6B92 9820 ARGT10 CB @FAC2,@CBH65 2nd operand can't be string 6B94 834C 6B96 65A7 1746 6B98 13FA JEQ ARGT05 If so, error 1747 6B9A 045B ARGT20 RT Ok, so return with status 1748 * VPUSH followed by a PARSE 1749 6B9C 05C9 PSHPRS INCT R9 Get room on stack 1750 6B9E 0289 CI R9,STKEND Stack full? 6BA0 83BA 1751 6BA2 1B41 JH VPSH27 Yes, error 1752 6BA4 C64B MOV R11,*R9 Save return on stack 1753 6BA6 020B LI R11,P05 Optimize for the parse 6BA8 648A 1754 * Stack VPUSH routine 1755 6BAA 0200 VPUSH LI R0,8 Pushing 8 byte entries 6BAC 0008 1756 6BAE A800 A R0,@VSPTR Update the pointer 6BB0 836E 1757 6BB2 C060 MOV @VSPTR,R1 Now get the new pointer 6BB4 836E 1758 6BB6 D7E0 MOVB @R1LB,*R15 Write new address to VDP chip 6BB8 83E3 1759 6BBA 0261 ORI R1,WRVDP Enable the write 6BBC 4000 1760 6BBE D7C1 MOVB R1,*R15 Write 1st byte of address 1761 6BC0 0201 LI R1,FAC Source is FAC 6BC2 834A 1762 6BC4 D831 VPSH15 MOVB *R1+,@XVDPWD Move a byte 6BC6 8C00 1763 6BC8 0600 DEC R0 Decrement the count, done? 1764 6BCA 15FC JGT VPSH15 No, more to move 1765 6BCC C00B MOV R11,R0 Save the return address 1766 6BCE 9820 CB @FAC2,@CBH65 Pushing a string entry? 6BD0 834C 99/4 ASSEMBLER PARSES2 PAGE 0039 6BD2 65A7 1767 6BD4 160E JNE VPSH20 No, so done 1768 6BD6 C1A0 MOV @VSPTR,R6 Entry on stack 6BD8 836E 1769 6BDA 0226 AI R6,4 Pointer to the string is here 6BDC 0004 1770 6BDE C060 MOV @FAC,R1 Get the string's owner 6BE0 834A 1771 6BE2 0281 CI R1,>001C Is it a tempory string? 6BE4 001C 1772 6BE6 1605 JNE VPSH20 No, so done 1773 6BE8 C060 VPSH19 MOV @FAC4,R1 Get the address of the string 6BEA 834E 1774 6BEC 1302 JEQ VPSH20 If null string, nothing to do 1775 6BEE 06A0 BL @STVDP3 Set the backpointer 6BF0 18AA 1776 6BF2 C060 VPSH20 MOV @VSPTR,R1 Check for buffer-zone 6BF4 836E 1777 6BF8 C16 EQU $+2 1778 6BF6 0221 AI R1,16 Correct by 16 6BF8 0010 1779 6BFA 8801 C R1,@STREND At least 16 bytes between stac 6BFC 831A 1780 * and string space? 1781 6BFE 1236 JLE VPOP18 Yes, so ok 1782 6C00 05C9 INCT R9 No, save return address 1783 6C02 C640 MOV R0,*R9 on stack 1784 6C04 06A0 BL @COMPCT Do the garbage collection 6C06 73D8 1785 6C08 C019 MOV *R9,R0 Restore return address 1786 6C0A 0649 DECT R9 Fix subroutine stack pointer 1787 6C0C C060 MOV @VSPTR,R1 Get value stack pointer 6C0E 836E 1788 6C10 0221 AI R1,16 Buffer zone 6C12 0010 1789 6C14 8801 C R1,@STREND At least 16 bytes now? 6C16 831A 1790 6C18 1229 JLE VPOP18 Yes, so ok 1791 6C1A 0200 VPSH23 LI R0,ERROM No, so MEMORY FULL error 6C1C 0103 1792 6C1E 06A0 VPSH25 BL @SETREG In case of GPL call 6C20 1E7A 1793 6C22 0460 B @ERR 6C24 6652 1794 6C26 0460 VPSH27 B @ERRSO STACK OVERFLOW 6C28 6468 1795 * Stack VPOP routine 1796 6C2A 0202 VPOP LI R2,FAC Destination in FAC 6C2C 834A 1797 6C2E C060 MOV @VSPTR,R1 Get stack pointer 6C30 836E 1798 6C32 8801 C R1,@STVSPT Check for stack underflow 6C34 8324 1799 6C36 121B JLE VPOP20 Yes, error 1800 6C38 D7E0 MOVB @R1LB,*R15 Write 2nd byte of address 6C3A 83E3 1801 6C3C 0200 LI R0,8 Popping 8 bytes 6C3E 0008 1802 6C40 D7C1 MOVB R1,*R15 Write 1st byte of address 99/4 ASSEMBLER PARSES2 PAGE 0040 1803 6C42 6800 S R0,@VSPTR Adjust stack pointer 6C44 836E 1804 6C46 DCA0 VPOP10 MOVB @XVDPRD,*R2+ Move a byte 6C48 8800 1805 6C4A 0600 DEC R0 Decrement the counter, done? 1806 6C4C 15FC JGT VPOP10 No, finish the work 1807 6C4E C00B MOV R11,R0 Save return address 1808 6C50 9820 CB @FAC2,@CBH65 Pop a string? 6C52 834C 6C54 65A7 1809 6C56 160A JNE VPOP18 No, so done 1810 6C58 04C6 CLR R6 For backpointer clear 1811 6C5A C0E0 MOV @FAC,R3 Get string owner 6C5C 834A 1812 6C5E 0283 CI R3,>001C Pop a temporary? 6C60 001C 1813 6C62 13C2 JEQ VPSH19 Yes, must free it 1814 6C64 06A0 BL @GET1 No, get new pointer from s.t. 6C66 6C9E 1815 6C68 C801 MOV R1,@FAC4 Set new pointer to string 6C6A 834E 1816 6C6C 0450 VPOP18 B *R0 And return 1817 6C6E 0200 VPOP20 LI R0,ERREX * SYNTAX ERROR 6C70 0403 1818 6C72 10D5 JMP VPSH25 1819 * The returned status reflects the character 1820 * RAMFLG = >00 | No ERAM or imperative statements 1821 * >FF | With ERAM and a program is being run 1822 6C74 D220 PGMCHR MOVB @RAMFLG,R8 Test ERAM flag 6C76 8389 1823 6C78 160A JNE PGMC10 ERAM and a program is being ru 1824 * Next label is for entry from SUBPROG. 1825 6C7A D7E0 PGMSUB MOVB @PGMPT1,*R15 Write 2nd byte of address 6C7C 832D 1826 6C7E 020A LI R10,XVDPRD Read data address 6C80 8800 1827 6C82 D7E0 MOVB @PGMPTR,*R15 Write 1st byte of address 6C84 832C 1828 6C86 05A0 INC @PGMPTR Increment the perm pointer 6C88 832C 1829 6C8A D21A MOVB *R10,R8 Read the character 1830 6C8C 045B RT And return 1831 6C8E C2A0 PGMC10 MOV @PGMPTR,R10 6C90 832C 1832 6C92 05A0 INC @PGMPTR 6C94 832C 1833 6C96 D23A MOVB *R10+,R8 Write 2nd byte of a address 1834 6C98 045B RT 1835 ************************************************************ 1836 6C9A AORG >6C9A 1838 1839 * (VDP to VDP) or (RAM to RAM) 1840 * GET,GET1 : Get two bytes of data from VDP 1841 * : R3 : address in VDP 1842 * : R1 : where the one byte data stored 1843 * PUT1 : Put two bytes of data into VDP 1844 * : R4 : address on VDP 1845 * : R1 : data 1846 * GETG,GETG2 : Get two bytes of data from ERAM 99/4 ASSEMBLER GETPUTS PAGE 0041 1847 * : R3 : address on ERAM 1848 * : R1 : where the two byte data stored 1849 * PUTG2 : Put two bytes of data into ERAM 1850 * : R4 : address on ERAM 1851 * : R1 : data 1852 * PUTVG1 : Put one byte of data into ERAM 1853 * : R4 : address in ERAM 1854 * : R1 : data 1855 1856 * Get two bytes from RAM(R3) into R1 1857 6C9A C0FB GET MOV *R11+,R3 1858 6C9C C0D3 MOV *R3,R3 1859 6C9E D7E0 GET1 MOVB @R3LB,*R15 6CA0 83E7 1860 6CA2 D7C3 MOVB R3,*R15 1861 6CA4 1000 NOP 1862 6CA6 D060 MOVB @XVDPRD,R1 6CA8 8800 1863 6CAA D820 MOVB @XVDPRD,@R1LB 6CAC 8800 6CAE 83E3 1864 6CB0 045B RT 1865 * Put two bytes from R1 to RAM(R4) 1866 6CB2 D7E0 PUT1 MOVB @R4LB,*R15 6CB4 83E9 1867 6CB6 0264 ORI R4,WRVDP 6CB8 4000 1868 6CBA D7C4 MOVB R4,*R15 1869 6CBC 1000 NOP 1870 6CBE D801 MOVB R1,@XVDPWD 6CC0 8C00 1871 6CC2 D820 MOVB @R1LB,@XVDPWD 6CC4 83E3 6CC6 8C00 1872 6CC8 045B RT 1873 * Get two bytes from ERAM(R3) to R1 1874 6CCA C0FB GETG MOV *R11+,R3 1875 6CCC C0D3 MOV *R3,R3 1876 6CCE GETG2 EQU $ 1877 6CCE D073 MOVB *R3+,R1 1878 6CD0 D813 MOVB *R3,@R1LB 6CD2 83E3 1879 6CD4 0603 DEC R3 1880 6CD6 045B RT 1881 * Put two bytes from R1 to ERAM(R4) 1882 6CD8 PUTG2 EQU $ 1883 6CD8 DD01 MOVB R1,*R4+ 1884 6CDA D520 MOVB @R1LB,*R4 6CDC 83E3 1885 6CDE 0604 DEC R4 Preserve R4 1886 6CE0 045B RT 1887 ************************************************************ 1888 1889 6CE2 AORG >6CE2 1891 1892 6CE2 9820 LEXP CB @FAC2,@CBH63 Must have a numeric 6CE4 834C 6CE6 6D05 1893 6CE8 1B39 JH ERRSNM Don't, so error 99/4 ASSEMBLER NUD359 PAGE 0042 1894 6CEA 06A0 BL @PSHPRS Push 1st and parse 2nd 6CEC 6B9C 1895 6CEE C5 BYTE EXPONZ,0 Up to another wxpon or less 6CEF 00 1896 6CF0 06A0 BL @STKCHK Make sure room on stack 6CF2 6DC0 1897 6CF4 0202 LI R2,PWRZZ Address of power routine 6CF6 7492 1898 6CF8 1049 JMP COMM05 Jump into common routine 1899 * ABS 1900 6CFA 0288 NABS CI R8,LPARZ*256 Must have a left parenthesis 6CFC B700 1901 6CFE 1630 JNE SYNERR If not, error 1902 6D00 06A0 BL @PARSE Parse the argument 6D02 6480 1903 6D04 CB BYTE ABSZ Up to another ABS 1904 6D05 63 CBH63 BYTE >63 Use the wasted byte 1905 6D06 9820 CB @FAC2,@CBH63 Must have numeric arg 6D08 834C 6D0A 6D05 1906 6D0C 1B27 JH ERRSNM If not, error 1907 6D0E 0760 ABS @FAC Take the absolute value 6D10 834A 1908 6D12 0460 BCONT B @CONT And continue 6D14 64C8 1909 * ATN 1910 6D16 0202 NATN LI R2,ATNZZ Load up arctan address 6D18 797C 1911 6D1A 102C JMP COMMON Jump into common rountine 1912 * COS 1913 6D1C 0202 NCOS LI R2,COSZZ Load up cosine address 6D1E 78B2 1914 6D20 1029 JMP COMMON Jump into common routine 1915 * EXP 1916 6D22 0202 NEXP LI R2,EXPZZ Load up exponential address 6D24 75CA 1917 6D26 1026 JMP COMMON Jump into common routine 1918 * INT 1919 6D28 0202 NINT LI R2,GRINT Load up greatest integer addre 6D2A 79EC 1920 6D2C 1023 JMP COMMON Jump into common routine 1921 * LOG 1922 6D2E 0202 NLOG LI R2,LOGZZ Load up logarithm code 6D30 76C2 1923 6D32 1020 JMP COMMON Jump to common routine 1924 * SGN 1925 6D34 0288 NSGN CI R8,LPARZ*256 Must have left parenthesis 6D36 B700 1926 6D38 1613 JNE SYNERR If not, error 1927 6D3A 06A0 BL @PARSE Parse the argument 6D3C 6480 1928 6D3E D1 BYTE SGNZ,0 Up to another SGN 6D3F 00 1929 6D40 9820 CB @FAC2,@CBH63 Must have a numeric arg 6D42 834C 6D44 6D05 1930 6D46 1B0A JH ERRSNM If not, error 1931 6D48 0204 LI R4,>4001 Floating point one 6D4A 4001 99/4 ASSEMBLER NUD359 PAGE 0043 1932 6D4C C020 MOV @FAC,R0 Check status 6D4E 834A 1933 6D50 13E0 JEQ BCONT If 0, return 0 1934 6D52 1502 JGT BLTST9 If positive, return +1 1935 6D54 0460 B @LTRUE If negative, return -1 6D56 6ABE 1936 6D58 0460 BLTST9 B @LTST90 Sets up the FAC w/R4 and 0s 6D5A 6AC2 1937 6D5C 0460 ERRSNM B @ERRT STRING-NUMBER MISMATCH 6D5E 630C 1938 6D60 0460 SYNERR B @ERRONE SYNTAX ERROR 6D62 664E 1939 * SIN 1940 6D64 0202 NSIN LI R2,SINZZ Load up sine address 6D66 78C0 1941 6D68 1005 JMP COMMON Jump into common routine 1942 * SQR 1943 6D6A 0202 NSQR LI R2,SQRZZ Load up square-root address 6D6C 783A 1944 6D6E 1002 JMP COMMON Jump into common routine 1945 * TAN 1946 6D70 0202 NTAN LI R2,TANZZ Load up tangent address 6D72 7940 1947 6D74 06A0 COMMON BL @STKCHK Make sure room on stacks 6D76 6DC0 1948 6D78 0288 CI R8,LPARZ*256 Must have left parenthesis 6D7A B700 1949 6D7C 16F1 JNE SYNERR If not, error 1950 6D7E 05C9 INCT R9 Get space on subroutine stack 1951 6D80 C642 MOV R2,*R9 Put address of routine on stac 1952 6D82 06A0 BL @PARSE Parse the argument 6D84 6480 1953 6D86 FF BYTE >FF,0 To end of the arg 6D87 00 1954 6D88 C099 MOV *R9,R2 Get address of function back 1955 6D8A 0649 DECT R9 Decrement subroutine stack 1956 6D8C 9820 COMM05 CB @FAC2,@CBH63 Must have a numeric arg 6D8E 834C 6D90 6D05 1957 6D92 1BE4 JH ERRSNM If not, error 1958 6D94 04E0 CLR @FAC10 Assume no error or warning 6D96 8354 1959 6D98 06A0 BL @SAVREG Save Basic registers 6D9A 1E8C 1960 6D9C C802 MOV R2,@PAGE2 Select page 2 6D9E 6002 1961 6DA0 0692 BL *R2 Evaluate the function 1962 6DA2 C802 MOV R2,@PAGE1 Reselect Page 1 6DA4 6000 1963 6DA6 06A0 BL @SETREG Set registers up again 6DA8 1E7A 1964 6DAA D020 MOVB @FAC10,R0 Check for error or warning 6DAC 8354 1965 6DAE 13B1 JEQ BCONT If not error, continue 1966 6DB0 0990 SRL R0,9 Check for warning 1967 6DB2 1304 JEQ PWARN Warning, issue it 1968 6DB4 0200 LI R0,>0803 BAD ARGUMENT code 6DB6 0803 1969 6DB8 0460 B @ERR 99/4 ASSEMBLER NUD359 PAGE 0044 6DBA 6652 1970 6DBC 0460 PWARN B @WARNZZ Issue the warning message 6DBE 6662 1971 6DC0 0289 STKCHK CI R9,STND12 Enough room on the subr stack? 6DC2 83AE 1972 6DC4 1B18 JH BSO No, memory full error 1973 6DC6 C020 MOV @VSPTR,R0 Get the value stack pointer 6DC8 836E 1974 6DCA 0220 AI R0,48 Buffer-zone of 48 bytes 6DCC 0030 1975 6DCE 8800 C R0,@STREND Room between stack & strings 6DD0 831A 1976 6DD2 1A0E JL STKRTN Yes, return 1977 6DD4 05C9 INCT R9 Get space on subr stack 1978 6DD6 CE4B MOV R11,*R9+ Save return address 1979 6DD8 CE42 MOV R2,*R9+ Save COMMON function code 1980 6DDA C640 MOV R0,*R9 Save v-stack pointer+48 1981 6DDC 06A0 BL @COMPCT Do a garbage collection 6DDE 73D8 1982 6DE0 8819 C *R9,@STREND Enough space now? 6DE2 831A 1983 6DE4 1406 JHE BMF No, MEMORY FULL error 1984 6DE6 0649 DECT R9 Decrement stack pointer 1985 6DE8 C099 MOV *R9,R2 Restore COMMON function code 1986 6DEA 0649 DECT R9 Decrement stack pointer 1987 6DEC C2D9 RETRN MOV *R9,R11 Restore return address 1988 6DEE 0649 DECT R9 Decrement stack pointer 1989 6DF0 045B STKRTN RT 1990 6DF2 0460 BMF B @VPSH23 * MEMORY FULL 6DF4 6C1A 1991 6DF6 0460 BSO B @ERRSO * STACK OVERFLOW 6DF8 6468 1992 ************************************************************ 1993 * LED routine for AND, OR, NOT, and XOR 1994 ************************************************************ 1995 6DFA 06A0 O0AND BL @PSHPRS Push L.H. and PARSE R.H. 6DFC 6B9C 1996 6DFE BB BYTE ANDZ,0 Stop on AND or less 6DFF 00 1997 6E00 06A0 BL @CONVRT Convert both to integers 6E02 6E9E 1998 6E04 0560 INV @FAC Complement L.H. 6E06 834A 1999 6E08 4820 SZC @FAC,@ARG Perform the AND 6E0A 834A 6E0C 835C 2000 6E0E C820 O0AND1 MOV @ARG,@FAC Put back in FAC 6E10 835C 6E12 834A 2001 6E14 06A0 O0AND2 BL @CIF Convert back to floating 6E16 74AA 2002 6E18 0460 B @CONT Continue 6E1A 64C8 2003 6E1C 06A0 O0OR BL @PSHPRS Push L.H. and PARSE R.H. 6E1E 6B9C 2004 6E20 BA BYTE ORZ,0 Stop on OR or less 6E21 00 2005 6E22 06A0 BL @CONVRT Convert both to integers 6E24 6E9E 99/4 ASSEMBLER NUD359 PAGE 0045 2006 6E26 E820 SOC @FAC,@ARG Perform the OR 6E28 834A 6E2A 835C 2007 6E2C 10F0 JMP O0AND1 Convert to floating and done 2008 6E2E 06A0 O0NOT BL @PARSE Parse the arg 6E30 6480 2009 6E32 BD BYTE NOTZ,0 Stop on NOT or less 6E33 00 2010 6E34 9820 CB @FAC2,@CBH63 Get a numeric back? 6E36 834C 6E38 6D05 2011 6E3A 1B49 JH ERRSN1 No, error 2012 6E3C 04E0 CLR @FAC10 Clear for CFI 6E3E 8354 2013 6E40 06A0 BL @CFI Convert to Integer 6E42 12B8 2014 6E44 D020 MOVB @FAC10,R0 Check for an error 6E46 8354 2015 6E48 168B JNE SYNERR Error 2016 6E4A 0560 INV @FAC Perform the NOT 6E4C 834A 2017 6E4E 10E2 JMP O0AND2 Convert to floating and done 2018 6E50 06A0 O0XOR BL @PSHPRS Push L.H. and PARSE R.H. 6E52 6B9C 2019 6E54 BC BYTE XORZ,0 Stop on XOR or less 6E55 00 2020 6E56 06A0 BL @CONVRT Convert both to integer 6E58 6E9E 2021 6E5A C020 MOV @ARG,R0 Get R.H. into register 6E5C 835C 2022 6E5E 2820 XOR @FAC,R0 Do the XOR 6E60 834A 2023 6E62 C800 MOV R0,@FAC Put result back in FAC 6E64 834A 2024 6E66 10D6 JMP O0AND2 Convert and continue 2025 ************************************************************ 2026 * NUD for left parenthesis 2027 ************************************************************ 2028 6E68 0288 NLPR CI R8,RPARZ*256 Have a right paren already? 6E6A B600 2029 6E6C 1332 JEQ ERRSY1 If so, syntax error 2030 6E6E 06A0 BL @PARSE Parse inside the parenthesises 6E70 6480 2031 6E72 B7 BYTE LPARZ,0 Up to left parenthesis or less 6E73 00 2032 6E74 0288 CI R8,RPARZ*256 Have a right parenthesis now? 6E76 B600 2033 6E78 162C JNE ERRSY1 No, so error 2034 6E7A 06A0 BL @PGMCHR Get next token 6E7C 6C74 2035 6E7E 0460 BCON1 B @CONT And continue 6E80 64C8 2036 ************************************************************ 2037 * NUD for unary minus 2038 ************************************************************ 2039 6E82 06A0 NMINUS BL @PARSE Parse the expression 6E84 6480 2040 6E86 C2 BYTE MINUSZ,0 Up to another minus 6E87 00 99/4 ASSEMBLER NUD359 PAGE 0046 2041 6E88 0520 NEG @FAC Make it negative 6E8A 834A 2042 6E8C 9820 NMIN10 CB @FAC2,@CBH63 Must have a numeric 6E8E 834C 6E90 6D05 2043 6E92 1B1D JH ERRSN1 If not, error 2044 6E94 10F4 JMP BCON1 Continue 2045 ************************************************************ 2046 * NUD for unary plus 2047 ************************************************************ 2048 6E96 06A0 NPLUS BL @PARSE Parse the expression 6E98 6480 2049 6E9A C1 BYTE PLUSZ,0 6E9B 00 2050 6E9C 10F7 JMP NMIN10 Use common code 2051 ************************************************************ 2052 * CONVRT - Takes two arguments, 1 form FAC and 1 from the 2053 * top of the stack and converts them to integer 2054 * from floating point, issuing appropriate errors 2055 ************************************************************ 2056 6E9E 05C9 CONVRT INCT R9 2057 6EA0 C64B MOV R11,*R9 SAVE RTN ADDRESS 2058 6EA2 06A0 BL @ARGTST ARGS MUST BE SAME TYPE 6EA4 6B6E 2059 6EA6 1313 JEQ ERRSN1 AND NON-STRING 2060 6EA8 04E0 CLR @FAC10 FOR CFI ERROR CODE 6EAA 8354 2061 6EAC 06A0 BL @CFI CONVERT R.H. ARG 6EAE 12B8 2062 6EB0 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EB2 8354 2063 6EB4 160A JNE ERRBV YES 2064 6EB6 C820 MOV @FAC,@ARG MOVE TO GET L.H. ARG 6EB8 834A 6EBA 835C 2065 6EBC 06A0 BL @VPOP GET L.H. BACK 6EBE 6C2A 2066 6EC0 06A0 BL @CFI CONVERT L.H. 6EC2 12B8 2067 6EC4 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EC6 8354 2068 6EC8 1391 JEQ RETRN No, get rtn off stack and rtn 2069 * Yes, issue error 2070 6ECA 0460 ERRBV B @GOTO90 BAD VALUE 6ECC 670A 2071 6ECE 0460 ERRSN1 B @ERRT STRING NUMBER MISMATCH 6ED0 630C 2072 6ED2 0460 ERRSY1 B @ERRONE SYNTAX ERROR 6ED4 664E 2073 ************************************************************ 2074 6ED6 AORG >6ED6 2076 2077 2078 6ED6 0460 BSYNCH B @SYNCHK 6ED8 6400 2079 6EDA 0460 BERSYN B @ERRSYN 6EDC 664E 2080 6EDE 0460 BERSNM B @ERRT 6EE0 630C 99/4 ASSEMBLER SPEEDS PAGE 0047 2081 6EE2 D01D SPEED MOVB *R13,R0 Read XML code 2082 6EE4 0980 SRL R0,8 Shift for word value 2083 6EE6 13F7 JEQ BSYNCH 0 is index for SYNCHK 2084 6EE8 0600 DEC R0 Not SYNCHK, check further 2085 6EEA 1344 JEQ PARCOM 1 is index for PARCOM 2086 6EEC 0600 DEC R0 Not PARCOM, check further 2087 6EEE 1320 JEQ RANGE 2 is index for RANGE 2088 * All otheres assumed to be SEETWO 2089 ************************************************************ 2090 * Find the line specified by the number in FAC 2091 * Searches the table from low address (high number) to 2092 * high address (low number). 2093 ************************************************************ 2094 6EF0 020A SEETWO LI R10,SET Assume number will be found 6EF2 6192 2095 6EF4 0207 LI R7,GET1 Assume reading from the VDP 6EF6 6C9E 2096 6EF8 D020 MOVB @RAMTOP,R0 But correct 6EFA 8384 2097 6EFC 1302 JEQ SEETW2 If 2098 6EFE 0207 LI R7,GETG2 ERAM is present 6F00 6CCE 2099 6F02 C0E0 SEETW2 MOV @ENLN,R3 Get point to start from 6F04 8332 2100 6F06 0223 AI R3,-3 Get into table 6F08 FFFD 2101 6F0A 0697 SEETW4 BL *R7 Read the number from table 2102 6F0C 0241 ANDI R1,>7FFF Throw away possible breakpoint 6F0E 7FFF 2103 6F10 8801 C R1,@FAC Match the number needed? 6F12 834A 2104 6F14 130A JEQ SEETW8 Yes, return with condition set 2105 6F16 1B07 JH SEETW6 No, and also passed it =>retur 2106 6F18 0223 AI R3,-4 No, but sitll might be there 6F1A FFFC 2107 6F1C 8803 C R3,@STLN Reached end of table? 6F1E 8330 2108 6F20 14F4 JHE SEETW4 No, so check further 2109 6F22 C0E0 MOV @STLN,R3 End of table, default to last 6F24 8330 2110 6F26 020A SEETW6 LI R10,RESET Indicate not found 6F28 006A 2111 6F2A C803 SEETW8 MOV R3,@EXTRAM Put pointer in for GPL 6F2C 832E 2112 6F2E 045A B *R10 Return with condition 2113 6F30 C30B RANGE MOV R11,R12 Save return address 2114 6F32 9820 CB @FAC2,@CBH63 Have a numeric 6F34 834C 6F36 6D05 2115 6F38 1BD2 JH BERSNM Otherwise string number mismat 2116 6F3A 04E0 CLR @FAC10 Assume no conversion error 6F3C 8354 2117 6F3E 06A0 BL @CFI Convert from float to integer 6F40 12B8 2118 6F42 D020 MOVB @FAC10,R0 Get an error? 6F44 8354 2119 6F46 160E JNE RANERR Yes, indicate it 2120 6F48 D01D MOVB *R13,R0 Read lower limit 2121 6F4A 0980 SRL R0,8 Shift for word compare 99/4 ASSEMBLER SPEEDS PAGE 0048 2122 6F4C D05D MOVB *R13,R1 Read 1st byte of upper limit 2123 6F4E 06C1 SWPB R1 Kill time 2124 6F50 D05D MOVB *R13,R1 Read 2nd byte of upper limit 2125 6F52 06C1 SWPB R1 Restore upper limit 2126 6F54 C0A0 MOV @FAC,R2 Get the value 6F56 834A 2127 6F58 1105 JLT RANERR If negative, error 2128 6F5A 8002 C R2,R0 Less then low limit? 2129 6F5C 1103 JLT RANERR Yes, error 2130 6F5E 8042 C R2,R1 Greater then limit? 2131 6F60 1B01 JH RANERR Yes, error 2132 6F62 045C B *R12 All ok, so return 2133 6F64 06A0 RANERR BL @SETREG Set up registers for error 6F66 1E7A 2134 6F68 0460 B @GOTO90 * BAD VALUE 6F6A 670A 2135 * Make sure at a left parenthesis 2136 6F6C 9820 LPAR CB @CHAT,@LBLPZ At a left parenthesis 6F6E 8342 6F70 6F81 2137 6F72 16B3 JNE BERSYN No, syntax error 2138 * Parse up to a comma and insure at a comma 2139 6F74 06A0 PARCOM BL @PUTSTK Save GROM address 6F76 60F2 2140 6F78 06A0 BL @SETREG Set up R8/R9 6F7A 1E7A 2141 6F7C 06A0 BL @PARSE Parse the next item 6F7E 6480 2142 6F80 B3 BYTE COMMAZ Up to a comma 2143 6F81 B7 LBLPZ BYTE LPARZ 2144 6F82 0288 CI R8,COMMAZ*256 End on a comma? 6F84 B300 2145 6F86 16A9 JNE BERSYN No, syntax error 2146 6F88 06A0 BL @PGMCHR Yes, get character after it 6F8A 6C74 2147 6F8C 06A0 BL @SAVREG Save R8/R9 for GPL 6F8E 1E8C 2148 6F90 06A0 BL @GETSTK Restore GROM address 6F92 610E 2149 6F94 0460 B @RESET Return to GPL reset 6F96 006A 2150 ************************************************************ 2151 6F98 AORG >6F98 2153 2154 * (RAM to RAM) 2155 * WITH ERAM : Move the contents in ERAM FROM a higher 2156 * address to a lower address 2157 * ARG : byte count 2158 * VAR9 : source address 2159 * PAD : destination address 2160 2161 6F98 C060 MVUP MOV @ARG,R1 Get byte count 6F9A 835C 2162 6F9C C0E0 MOV @VAR9,R3 Get source 6F9E 8316 2163 6FA0 C160 MOV @PAD,R5 Get destination 6FA2 8300 2164 6FA4 DD73 MVUP05 MOVB *R3+,*R5+ Move a byte 2165 6FA6 0601 DEC R1 Decrement the counter 99/4 ASSEMBLER MVUPS PAGE 0049 2166 6FA8 16FD JNE MVUP05 Loop if more to move 2167 6FAA 045B RT 2168 ************************************************************ 2169 2170 6FAC AORG >6FAC 2172 2173 * Get a non-space character 2174 6FAC C00B GETNB MOV R11,R0 Save return address 2175 6FAE 06A0 GETNB1 BL @GETCHR Get next character 6FB0 6FBA 2176 6FB2 0281 CI R1,' '*256 Space character? 6FB4 2000 2177 6FB6 13FB JEQ GETNB1 Yes, get next character 2178 6FB8 0450 B *R0 No, return character condition 2179 * Get the next character 2180 6FBA 8820 GETCHR C @VARW,@VARA End of line? 6FBC 8320 6FBE 832A 2181 6FC0 1B0E JH GETCH2 Yes, return condition 2182 6FC2 D7E0 MOVB @VARW1,*R15 No, write LSB of VDP address 6FC4 8321 2183 6FC6 0201 LI R1,>A000 Negative screen offset (->60) 6FC8 A000 2184 6FCA D7E0 MOVB @VARW,*R15 Write MSB of VDP address 6FCC 8320 2185 6FCE 05A0 INC @VARW Increment read-from pointer 6FD0 8320 2186 6FD2 B060 AB @XVDPRD,R1 Read and remove screen offset 6FD4 8800 2187 6FD6 0281 CI R1,>1F00 Read an edge character? 6FD8 1F00 2188 6FDA 13EF JEQ GETCHR Yes, skip it 2189 6FDC 045B RT Return 2190 6FDE 04C1 GETCH2 CLR R1 Indicate end of line 2191 6FE0 045B RT Return 2192 *----------------------------------------------------------- 2193 * Remove this routine from CRUNCH because CRUNCH is running 2194 * out of space 5/11/81 2195 *----------------------------------------------------------- 2196 * Calculate and put length of string/number into 2197 * length byte 2198 6FE2 C0CB LENGTH MOV R11,R3 Save retun address 2199 6FE4 C020 MOV @RAMPTR,R0 Save current crunch pointer 6FE6 830A 2200 6FE8 C200 MOV R0,R8 Put into r8 for PUTCHR below 2201 6FEA 6205 S R5,R8 Calculate length of string 2202 6FEC 0608 DEC R8 RAMPTR is post-incremented 2203 6FEE C805 MOV R5,@RAMPTR Address of length byte 6FF0 830A 2204 6FF2 06A0 BL @PUTCHR Put the length in 6FF4 7F6E 2205 6FF6 C800 MOV R0,@RAMPTR Restore crunch pointer 6FF8 830A 2206 6FFA 0453 B *R3 And return 2207 * FILL IN BYTES OF MODULE WITH COPY OF ORIGINAL? 2208 6FFC 0000 DATA >0000 2209 6FFE EF71 DATA >EF71 ????? 2210 ************************************************************ 2211 7000 AORG >7000 99/4 ASSEMBLER FORNEXTS PAGE 0050 2213 2214 ************************************************************ 2215 * FOR statement 2216 * Builds up a stack entry for the FOR statement. Checks the 2217 * syntax of a FOR statement and also checks to see if the 2218 * loop is executed at all. The loop is not executed if the 2219 * limit of the FOR is > then initial value and the step is 2220 * positive of the limit of the FOR is < then initial value 2221 * and the step is negative. 2222 * 2223 * A stack entry for a 'FOR' statement looks like: 2224 * 2225 * +-------------------------------------------------------+ 2226 * | PTR TO S.T. | >67 | | Value Space | BUFLEV | 2227 * | ENTRY | | | Pointer | | 2228 * | ------------------------------------------------------| 2229 * | FOR line # | FOR line | | 2230 * | table ptr | pointer | | 2231 * |-------------------------------------------------------| 2232 * | Increment Value | 2233 * |-------------------------------------------------------| 2234 * | Limit | 2235 * +-------------------------------------------------------+ 2236 ************************************************************ 2237 7000 D208 NFOR MOVB R8,R8 EOL? 2238 7002 1501 JGT NFOR1 If symbol name, ok 2239 7004 107C JMP ERRCDT If EOL or Token, error 2240 7006 06A0 NFOR1 BL @SYM Get pointer to s.t. entry 7008 6312 2241 700A 06A0 BL @GETV Get 1st byte of symbol 700C 187C 2242 700E 834A DATA FAC entry 2243 * 2244 7010 0241 ANDI R1,>C700 Check string, function & array 7012 C700 2245 7014 1670 JNE BERMUW If andy of the above, error 2246 7016 0288 CI R8,EQZ*256 Must have '=' 7018 BE00 2247 701A 1671 JNE ERRCDT If not, error 2248 701C 06A0 BL @SMB Get index's value space 701E 61DC 2249 7020 04E0 CLR @FAC2 Dummy entry ID on the stack 7022 834C 2250 7024 C820 MOV @BUFLEV,@FAC6 Save buffer level 7026 8346 7028 8350 2251 * 2252 * Search stack for another FOR entry with the same loop 2253 * variable. If one is found, remove it. 2254 * 2255 702A C0E0 MOV @VSPTR,R3 Copy stack pointer 702C 836E 2256 * 2257 * See if end of stack 2258 702E 8803 NFOR1A C R3,@STVSPT Check stack underflow 7030 8324 2259 7032 1228 JLE NFOR1E Finished with stack scan 2260 * See if FOR entry 2261 7034 06A0 BL @GET1 Get pointer to s.t. entry 99/4 ASSEMBLER FORNEXTS PAGE 0051 7036 6C9E 2262 7038 C001 MOV R1,R0 Move it to use later 2263 703A D060 MOVB @XVDPRD,R1 Read stack ID 703C 8800 2264 703E 9801 CB R1,@CBH67 Is stack entry a FOR? 7040 68AB 2265 7042 1606 JNE NFOR1B No, 8 byte regular entry 2266 * Compare loop variables 2267 7044 8800 C R0,@FAC Loop variables match? 7046 834A 2268 7048 1309 JEQ NFOR1C Yes 2269 704A 0223 AI R3,-32 Skip this FOR entry 704C FFE0 2270 704E 10EF JMP NFOR1A Loop 2271 7050 9801 NFOR1B CB R1,@CCBH6A Hit a subprogram entry? 7052 70AF 2272 7054 1317 JEQ NFOR1E Yes, don't scan anymore 2273 7056 0223 AI R3,-8 Skip 8 byte stack entry 7058 FFF8 2274 705A 10E9 JMP NFOR1A Loop 2275 * Found matching loop variable, move stack down 32 bytes 2276 705C C0A0 NFOR1C MOV @VSPTR,R2 Copy stack pointer 705E 836E 2277 7060 6083 S R3,R2 Calculate # of bytes to move 2278 7062 130D JEQ NFOR1D 0 bytes, skip move 2279 7064 C103 MOV R3,R4 Destination pointer 2280 7066 0224 AI R4,-24 Place to move to 7068 FFE8 2281 706C C8 EQU $+2 2282 706A 0223 AI R3,8 Point at entry above FOR entry 706C 0008 2283 706E 06A0 NFOR1F BL @GETV1 Get the byte 7070 1880 2284 7072 06A0 BL @PUTV1 Put the byte 7074 6422 2285 7076 0583 INC R3 Inc From pointer 2286 7078 0584 INC R4 Inc To pointer 2287 707A 0602 DEC R2 Decrement counter 2288 707C 16F8 JNE NFOR1F Loop if not done 2289 707E 6820 NFOR1D S @C32,@VSPTR Adjust top of stack 7080 7196 7082 836E 2290 * Now put new FOR entry on stack 2291 7084 06A0 NFOR1E BL @VPUSH Reserve space for limit 7086 6BAA 2292 7088 06A0 BL @VPUSH increment, 708A 6BAA 2293 708C 06A0 BL @VPUSH and 2nd info entry 708E 6BAA 2294 7090 D820 MOVB @CBH67,@FAC2 FOR ID on stack 7092 68AB 7094 834C 2295 7096 06A0 BL @PGMCHR Get next character 7098 6C74 2296 709A 06A0 BL @PSHPRS Push symbol I.D. entry 709C 6B9C 2297 709E B1 BYTE TOZ Parse the initial value 2298 709F 63 CCBH63 BYTE >63 Wasted byte (CBH63) 2299 70A0 0288 CI R8,TOZ*256 TO? 99/4 ASSEMBLER FORNEXTS PAGE 0052 70A2 B100 2300 70A4 162C JNE ERRCDT No, error 2301 70A6 06A0 BL @PGMCHR 70A8 6C74 2302 70AA 06A0 BL @PSHPRS Push initial and get limit 70AC 6B9C 2303 70AE B2 BYTE STEPZ 2304 70AF 6A CCBH6A BYTE >6A Wasted byte (CBA6A) 2305 70B0 9820 CB @CCBH63,@FAC2 If a string value 70B2 709F 70B4 834C 2306 70B6 1A1D JL BERR6 Its an error 2307 70B8 6820 S @C40,@VSPTR 70BA 6006 70BC 836E 2308 70BE 06A0 BL @VPUSH Push the limit 70C0 6BAA 2309 70C2 06A0 BL @EOSTMT At the end of statement? 70C4 6862 2310 70C6 131D JEQ NFOR2 Yes, default incr to 1 2311 70C8 0288 CI R8,STEPZ*256 STEP? 70CA B200 2312 70CC 1618 JNE ERRCDT No, Its an error 2313 70CE A820 A @C32,@VSPTR Corrrect stack pointer 70D0 7196 70D2 836E 2314 70D4 06A0 BL @PGMCHR 70D6 6C74 2315 70D8 06A0 BL @PARSE Get the increment 70DA 6480 2316 70DC 83 BYTE TREMZ,0 70DD 00 2317 70DE 6820 S @C32,@VSPTR Get stack to needed place 70E0 7196 70E2 836E 2318 70E4 C020 MOV @FAC,R0 Can't have zero increment 70E6 834A 2319 70E8 1308 JEQ ERRBV2 If 0, its an error 2320 70EA 9820 CB @CCBH63,@FAC2 Can't have zero increment 70EC 709F 70EE 834C 2321 70F0 140F JHE NFOR3 If numeric, ok 2322 70F2 0460 BERR6 B @ERRT * STRING NUMBER MISMATCH 70F4 630C 2323 70F6 0460 BERMUW B @ERRMUV * MULTIPLY USED VARIABLE 70F8 6970 2324 70FA 0460 ERRBV2 B @GOTO90 70FC 670A 2325 70FE 0460 ERRCDT B @ERRSYN 7100 664E 2326 7102 0200 NFOR2 LI R0,FAC 7104 834A 2327 7106 CC20 MOV @FLTONE,*R0+ Put a floating one in 7108 600E 2328 710A 04F0 CLR *R0+ 2329 710C 04F0 CLR *R0+ 2330 710E 04D0 CLR *R0 2331 7110 06A0 NFOR3 BL @VPUSH Push the step 7112 6BAA 99/4 ASSEMBLER FORNEXTS PAGE 0053 2332 7114 0201 LI R1,FAC Optimize to save bytes 7116 834A 2333 7118 CC60 MOV @EXTRAM,*R1+ Save line # pointer 711A 832E 2334 711C C460 MOV @PGMPTR,*R1 Save ptr w/in the line 711E 832C 2335 7120 0611 DEC *R1 Back up so get last character 2336 7122 06A0 BL @VPUSH Push it too! 7124 6BAA 2337 7126 A820 A @H16,@VSPTR Point to initial value 7128 7156 712A 836E 2338 712C 06A0 BL @VPOP Get initial value 712E 6C2A 2339 7130 06A0 BL @ASSG Assign it 7132 6334 2340 7134 A820 A @C8,@VSPTR Restore to top of entry 7136 706C 7138 836E 2341 * Check to see if execute loop at all 2342 713A 06A0 BL @VPOP Get ptr to value 713C 6C2A 2343 713E 06A0 BL @MOVFAC Get value 7140 6434 2344 7142 6820 S @H16,@VSPTR Point at limit 7144 7156 7146 836E 2345 7148 06A0 BL @SCOMPB Compare them 714A 0D42 2346 * VSPTR is now below the FOR entry 2347 714C 02C4 STST R4 Save the status 2348 714E 1309 JEQ NFOR03 IF = 2349 7150 C0E0 MOV @VSPTR,R3 7152 836E 2350 7156 H16 EQU $+2 2351 7154 0223 AI R3,16 7156 0010 2352 7158 06A0 BL @GETV1 Check negative step 715A 1880 2353 715C 1107 JLT NFOR05 If a decrement 2354 715E 0A14 SLA R4,1 Check out of limit 2355 7160 1507 JGT NFOR07 Out of limit 2356 7162 A820 NFOR03 A @C32,@VSPTR Leave the entry on 7164 7196 7166 836E 2357 7168 0460 B @CONT <<<<<<< Result is w/in limit 716A 64C8 2358 716C 0A14 NFOR05 SLA R4,1 Check out of limit 2359 716E 15F9 JGT NFOR03 Result is w/in limit 2360 * Initial value is not within the limit. Therefore, the loop 2361 * is not executed at all. Must skip the code in the body of 2362 * the loop 2363 7170 0203 NFOR07 LI R3,1 FOR/NEXT pair counter 7172 0001 2364 7174 06A0 NFOR09 BL @EOLINE Check end of line 7176 6872 2365 7178 1338 JEQ NFOR13 Is end of line 2366 717A 06A0 BL @PGMCHR Get 1st token on line 717C 6C74 99/4 ASSEMBLER FORNEXTS PAGE 0054 2367 717E 0288 NFOR10 CI R8,NEXTZ*256 If NEXT 7180 9600 2368 7182 1618 JNE NFOR11 If not 2369 7184 0603 DEC R3 Decrement counter 2370 7186 162B JNE NFOR12 If NOT matching next 2371 7188 06A0 BL @PGMCHR Get 1st char of loop variable 718A 6C74 2372 * Check is added in SYM 5/26/81 2373 * JLT ERRCDT If token 2374 718C 06A0 BL @SYM Get s.t. pointer to check matc 718E 6312 2375 7190 C0E0 MOV @VSPTR,R3 Correct to top of entry 7192 836E 2376 7196 C32 EQU $+2 2377 7194 0223 AI R3,32 7196 0020 2378 7198 06A0 BL @GET1 Get pointer 719A 6C9E 2379 719C 8801 C R1,@FAC Match? 719E 834A 2380 71A0 1605 JNE ERRFNN No match 2381 71A2 0460 B @CONT Continue <<<<<<<< THE WAY 71A4 64C8 2382 71A6 A820 ERRFN A @C4,@EXTRAM 71A8 6A80 71AA 832E 2383 71AC 0200 ERRFNN LI R0,>0B03 FOR NEXT NESTING 71AE 0B03 2384 71B0 0460 B @ERR 71B2 6652 2385 71B4 0288 NFOR11 CI R8,SUBZ*256 Hit a SUB? 71B6 A100 2386 71B8 13F9 JEQ ERRFNN Yes, can't find matching next 2387 71BA 0288 CI R8,FORZ*256 FOR? 71BC 8C00 2388 71BE 1601 JNE NFOR20 No, Check some more 2389 71C0 0583 INC R3 Increment depth 2390 71C2 0288 NFOR20 CI R8,LNZ*256 Line number token? 71C4 C900 2391 71C6 1602 JNE NFOR30 No, Check some more 2392 71C8 05E0 INCT @PGMPTR Skip the line number 71CA 832C 2393 71CC 0288 NFOR30 CI R8,STRINZ*256 String? 71CE C700 2394 71D0 1606 JNE NFOR12 No, Check end of statement 2395 71D2 06A0 BL @PGMCHR Yes, get string length 71D4 6C74 2396 71D6 06C8 SWPB R8 Put the length in R8 2397 71D8 A808 A R8,@PGMPTR Skip that many length 71DA 832C 2398 71DC 04C8 CLR R8 Clear next crunched code 2399 71DE 06A0 NFOR12 BL @PGMCHR Read next crunched code 71E0 6C74 2400 71E2 06A0 BL @EOSTMT Check EOS (includes EOL) 71E4 6862 2401 71E6 16ED JNE NFOR20 Check for line # or string 2402 71E8 10C5 JMP NFOR09 Is EOS or EOL 2403 71EA D020 NFOR13 MOVB @PRGFLG,R0 If imperative w/out match 71EC 8344 99/4 ASSEMBLER FORNEXTS PAGE 0055 2404 71EE 13DE JEQ ERRFNN Its an error 2405 71F0 6820 S @C4,@EXTRAM Goto next line 71F2 6A80 71F4 832E 2406 71F6 8820 C @EXTRAM,@STLN Hit end of program? 71F8 832E 71FA 8330 2407 71FC 1AD4 JL ERRFN Yes, can't match the next 2408 71FE C820 MOV @EXTRAM,@PGMPTR Set PGMPTR to get new PGMPTR 7200 832E 7202 832C 2409 7204 06A0 BL @PGMCHR Get 7206 6C74 2410 7208 D808 MOVB R8,@PGMPTR new 720A 832C 2411 720C D81A MOVB *R10,@PGMPT1 PGMPTR 720E 832D 2412 7210 06A0 BL @PGMCHR Get next line 7212 6C74 2413 7214 06A0 BL @EOSTMT Check EOS or EOL 7216 6862 2414 7218 13AD JEQ NFOR09 Is EOS or EOL 2415 721A 10B1 JMP NFOR10 Keep looping 2416 * NEXT4 and NEXT2A were moved from in-line to here in an 2417 * effort to make the "normal" path through the NEXT code as 2418 * straight-line as possible. 2419 721C 6820 NEXT4 S @C24,@VSPTR LOOP VARIABLES DON'T MATCH 721E 6464 7220 836E 2420 7222 1008 JMP NEXT2 2421 7224 06A0 NEXT2B BL @VPUSH Keep stack information 7226 6BAA 2422 7228 0200 NEXT2A LI R0,>0C03 NEXT WITHOUT FOR 722A 0C03 2423 722C 0460 B @ERR 722E 6652 2424 ************************************************************ 2425 * NEXT statement handler - find the matching FOR statement 2426 * on the stack, add the increment to the current value of 2427 * the index variable and check to see if execute the loop 2428 * again. If loop-variable's value is still within bounds, 2429 * goto the top of the loop, otherwise, flush the FOR entry 2430 * off the stack and continue with the statement following 2431 * the NEXT statement. 2432 ************************************************************ 2433 7230 06A0 NNEXT BL @SYM GET S.T. I.D. 7232 6312 2434 * MOV @FAC,R4 SYM/FBSYMB leaves value in R4 2435 7234 8820 NEXT2 C @VSPTR,@STVSPT CHECK FOR BOTTOM OF STACK 7236 836E 7238 8324 2436 723A 12F6 JLE NEXT2A IF AT BOTTOM -> NEXT W/OUT FOR 2437 723C 06A0 BL @VPOP GET 'FOR' ENTRY OFF STACK 723E 6C2A 2438 7240 9820 CB @FAC2,@CBH67 CHECK FOR 'FOR' ENTRY 7242 834C 7244 68AB 2439 7246 16EE JNE NEXT2B Is not a 'FOR' entry, error 2440 7248 8804 C R4,@FAC CHECK IF MATCHING 'FOR' ENTRY 99/4 ASSEMBLER FORNEXTS PAGE 0056 724A 834A 2441 724C 16E7 JNE NEXT4 Is not a match, so check more 2442 724E C0E0 MOV @VSPTR,R3 Check BUFLEV for match 7250 836E 2443 7252 0223 AI R3,14 Point at the BUFLEV in stack 7254 000E 2444 7256 06A0 BL @GET1 Read it 7258 6C9E 2445 725A 8801 C R1,@BUFLEV SAME LEVEL? 725C 8346 2446 725E 16A6 JNE ERRFNN NO, ITS AN ERROR 2447 7260 6820 S @C8,@VSPTR 7262 706C 7264 836E 2448 7266 06A0 BL @MOVFAC GET INDEX VALUE 7268 6434 2449 726A 06A0 BL @SAVREG SAVE BASIC REGISTERS 726C 1E8C 2450 726E 06A0 BL @SADD ADD IN THE INCREMENT 7270 0D84 2451 7272 06A0 BL @SETREG RESTORE BASIC REGS 7274 1E7A 2452 7276 A820 A @C24,@VSPTR 7278 6464 727A 836E 2453 727C 06A0 BL @ASSG SAVE NEW INDEX VALUE 727E 6334 2454 7280 6820 S @H16,@VSPTR POINT TO THE LIMIT 7282 7156 7284 836E 2455 7286 06A0 BL @SCOMPB TEST W/IN LIMIT 7288 0D42 2456 728A 02C4 STST R4 SAVE RESULT OF COMPARE 2457 728C 1309 JEQ NEXT5 IF = DO LAST LOOP 2458 728E C0E0 MOV @VSPTR,R3 CHECK FOR A DECREMENT 7290 836E 2459 7292 0223 AI R3,16 Point at increment/decrement 7294 0010 2460 7296 06A0 BL @GETV1 Get 1st byte and set condition 7298 1880 2461 729A 1116 JLT NEXT6 If was a decrement 2462 729C 0A14 SLA R4,1 Check if out of limit 2463 729E 1512 JGT NEXT8 Out of limit 2464 72A0 A820 NEXT5 A @C32,@VSPTR Point to 'FOR' I.D. entry 72A2 7196 72A4 836E 2465 72A6 C0E0 MOV @VSPTR,R3 GOTO TOP OF 'FOR' LOOP 72A8 836E 2466 72AA 0223 AI R3,-8 Point to old EXTRAM 72AC FFF8 2467 72AE 06A0 BL @GET1 Get new EXTRAM 72B0 6C9E 2468 72B2 C801 MOV R1,@EXTRAM Put it in 72B4 832E 2469 72B6 05C3 INCT R3 POINT AT OLD PGMPTR 2470 72B8 06A0 BL @GET1 Get old PGMPTR 72BA 6C9E 2471 72BC C801 MOV R1,@PGMPTR Put it in 72BE 832C 99/4 ASSEMBLER FORNEXTS PAGE 0057 2472 72C0 06A0 BL @PGMCHR Get 1st token in line 72C2 6C74 2473 72C4 0460 NEXT8 B @CONT Continue on 72C6 64C8 2474 * TEST LIMIT FOR DECREMENT 2475 72C8 0A14 NEXT6 SLA R4,1 Check if out of limit 2476 72CA 15EA JGT NEXT5 If within limit, continue 2477 72CC 10FB JMP NEXT8 Continue PARSE 2478 ************************************************************ 2479 72CE AORG >72CE 2481 2482 ************************************************************ 2483 * MEMORY CHECK ROUTINE 2484 * It checks to see if there is enough room to insert a 2485 * symbol table entry or a P.A.B. into the VDP between the 2486 * static symbol table/PAB area and the dymamic string area. 2487 * If there is not it attempts to move the string space down 2488 * (to lower address) and then insert the needed area 2489 * between the two. NOTE: it may invoke COMPCT to do a 2490 * garbage collection. If there is not enough space after 2491 * COMPCT then issues *MEMORY FULL* message. 2492 * 2493 * INPUT: # of bytes needed in FAC, FAC+1 2494 * USES: R0, R12 as temporaries as well as R0 - R6 when 2495 * invoking COMPCT 2496 ************************************************************ 2497 72CE 06A0 MEMCHG BL @MEMCHK GPL entry point 72D0 72D8 2498 72D2 6192 DATA SET If NOT enough memory 2499 72D4 0460 B @RESET If enough memory 72D6 006A 2500 72D8 C30B MEMCHK MOV R11,R12 Save return address 2501 72DA C020 MOV @FREPTR,R0 GET BEGINNING OF S.T. FREE SPA 72DC 8340 2502 72DE 6020 S @STRSP,R0 CALCULATE SIZE OF GAP 72E0 8318 2503 72E2 8020 C @FAC,R0 ENOUGH SPACE ALREADY? 72E4 834A 2504 72E6 1A3C JL MEMC08 YES - DONE - RTN 2505 72E8 06A0 BL @COMPCT NO - COMPACITFY STRING SPACE 72EA 73D8 2506 72EC C020 MOV @STREND,R0 GET STRING FREE SPACE 72EE 831A 2507 72F0 6020 S @VSPTR,R0 CALCULATE SIZE OF GAP 72F2 836E 2508 72F4 0220 AI R0,-64 VSPTR OFFSET TOO 72F6 FFC0 2509 72F8 C2A0 MOV @FAC,R10 GET TOTAL # NEEDED BACK 72FA 834A 2510 72FC 8280 C R0,R10 ENOUGH ROOM NOW? 2511 72FE 1A32 JL MEMERR NO - *MEMORY FULL* 2512 * 2513 * Now move the DYNAMIC STRING AREA DOWN IN MEMORY 2514 * 2515 7300 C020 MOV @STRSP,R0 CALCULATE # OF BYTES 7302 8318 2516 7304 C0A0 MOV @STREND,R2 Beginning of move address 7306 831A 2517 7308 6002 S R2,R0 in the total string space 99/4 ASSEMBLER STRINGS PAGE 0058 2518 730A 680A S R10,@STREND SET FREE PTR(COPY-TO ADDRESS) 730C 831A 2519 730E C000 MOV R0,R0 NO BYTES TO MOVE? 2520 7310 130D JEQ MEMC04 RIGHT 2521 7312 C0C2 MOV R2,R3 ADDRESS FOR GETV 2522 7314 0583 INC R3 2523 7316 C120 MOV @STREND,R4 ADDRESS FOR PUTV 7318 831A 2524 731A 0584 INC R4 2525 731C 06A0 MEMC03 BL @GETV1 GET THE BYTE 731E 1880 2526 7320 06A0 BL @PUTV1 PUT THE BYTE 7322 6422 2527 7324 0583 INC R3 INC THE FROM 2528 7326 0584 INC R4 INC THE TO 2529 7328 0600 DEC R0 DEC THE COUNT 2530 732A 15F8 JGT MEMC03 IF NOT DONE 2531 * MOVE IT 2532 732C 680A MEMC04 S R10,@STRSP SET NEW STRIG SPACE PTR 732E 8318 2533 * 2534 * NOW FIX UP STRING PTRS 2535 * 2536 7330 C020 MOV @STRSP,R0 GET BEGINNING OF STRING SPACE 7332 8318 2537 7334 8020 MEMC05 C @STREND,R0 FINISHED? 7336 831A 2538 7338 1413 JHE MEMC08 YES 2539 733A 04C1 CLR R1 CLEAR LOWER BYTE 2540 733C C0C0 MOV R0,R3 FOR GETV 2541 733E 06A0 BL @GETV1 GET LENGTH BYTE 7340 1880 2542 7342 06C1 SWPB R1 SWAP FOR ADD 2543 7344 6001 S R1,R0 POINT AT BEGINNING OF STRING 2544 7346 C0C0 MOV R0,R3 FOR THE GETV1 BELOW 2545 7348 0223 AI R3,-3 POINT AT THE BACKPOITER 734A FFFD 2546 734C 06A0 BL @GET1 GET THE BACK POINTER 734E 6C9E 2547 * BOTH BYTES 2548 7350 C041 MOV R1,R1 FREE STRING? 2549 7352 1303 JEQ MEMC06 YES 2550 7354 C180 MOV R0,R6 PTR TO STRING FOR STVDP 2551 7356 06A0 BL @STVDP SET FORWARD PTR 7358 18AE 2552 735A 0220 MEMC06 AI R0,-4 NOW POINT AT NEXT LENGTH 735C FFFC 2553 735E 10EA JMP MEMC05 CONTINUE ON 2554 7360 046C MEMC08 B @2(R12) Return with space allocated 7362 0002 2555 7364 C31C MEMERR MOV *R12,R12 Pick up error return address 2556 7366 045C B *R12 * MEMORY FULL(prescan time) 2557 7368 0460 ERRMEM B @VPSH23 * MEMORY FULL(execution tiem) 736A 6C1A 2558 ************************************************************ 2559 * GETSTR - Checks to see if there is enough space in the 2560 * string area to allocate a string, if there is it 2561 * allocates it. If there is not it does a garbage 2562 * collection and once again checks to see if there 99/4 ASSEMBLER STRINGS PAGE 0059 2563 * is enough room. If so it allocates it, if not it 2564 * issues a *MEMORY FULL* message. 2565 * 2566 * INPUT : # of bytes needed in @BYTE 2567 * OUTPUT: Pointer to new string in @SREF 2568 * Both length bytes in place & zeroed Breakpointer 2569 * @STREND points 1st free byte(new) 2570 * 2571 * USES : R0 - R6 Temporaries 2572 * 2573 * Note : COMPCT allows a buffer zone of 8 stack entries 2574 * above what is there when COMPCT is called. This 2575 * should allow enough space to avoid a collision 2576 * between the string space and the stack. If 2577 * garbage begins to appear in the string space 2578 * that can't be accounted for, the buffer zone 2579 * will be increased. 2580 ************************************************************ 2581 736C C020 GETSTR MOV @BYTE,R0 GET # OF BYTES NEEDED 736E 830C 2582 7370 C30B MOV R11,R12 SAVE RTN ADDRESS 2583 7372 8C30 C *R0+,*R0+ ADJUST FOR BACKPTR & 2 LENGTHS 2584 * (INCREMENT BY 4) 2585 7374 C060 MOV @STREND,R1 CHECK IF ENOUGH ROOM 7376 831A 2586 7378 6040 S R0,R1 BY ADVANCING THE FREE PTR 2587 737A C0A0 MOV @VSPTR,R2 GET VALUE STACK PTR 737C 836E 2588 737E 0222 AI R2,64 ALLOW BUFFER ZONE 7380 0040 2589 7382 8081 C R1,R2 ENOUGH SPACE? 2590 7384 1B0E JH GETS10 YES, ALL IS WELL 2591 7386 06A0 BL @COMPCT NO, COMPACTIFY 7388 73D8 2592 738A C0A0 MOV @VSPTR,R2 GET VALUE STACK POINTER 738C 836E 2593 738E 0222 AI R2,64 ALLOW BUFFER ZONE 7390 0040 2594 7392 C020 MOV @BYTE,R0 GET # OF BYTES BACK 7394 830C 2595 7396 8C30 C *R0+,*R0+ INCREMENT BY 4 2596 7398 C060 MOV @STREND,R1 GET NEW END OF STRING SPACE 739A 831A 2597 739C 6040 S R0,R1 ADVANCE IT 2598 739E 8081 C R1,R2 ENOUGH SPACE NOW? 2599 73A0 12E3 JLE ERRMEM NO, *MEMORY FULL* 2600 73A2 0220 GETS10 AI R0,-4 GET EXACT LENGTH BACK 73A4 FFFC 2601 73A6 D060 MOVB @R0LB,R1 STORE ENTRY LENGTH 73A8 83E1 2602 73AA 06A0 BL @PUTV PUT THE ENDING LENGTH 73AC 641E 2603 73AE 831A DATA STREND BYTE IN THE STRING 2604 73B0 6800 S R0,@STREND PT AT FIRST BYTE OF STRING 73B2 831A 2605 73B4 C820 MOV @STREND,@SREF POINT SREF AT THE STRING 73B6 831A 73B8 831C 2606 73BA 0620 DEC @STREND POINT AT LEADING LENGTH BYTE 99/4 ASSEMBLER STRINGS PAGE 0060 73BC 831A 2607 73BE 06A0 BL @PUTV PUT THE LEADING LENGTH BYTE IN 73C0 641E 2608 73C2 831A DATA STREND THE STRING 2609 73C4 0660 DECT @STREND POINT AT BACKPOINTER 73C6 831A 2610 73C8 04C6 CLR R6 ZERO FOR THE BACKPOINTER 2611 73CA C060 MOV @STREND,R1 ADDR OR THE BACKPOINTER 73CC 831A 2612 73CE 06A0 BL @STVDP CLEAR THE BACKPOINTER 73D0 18AE 2613 73D2 0620 DEC @STREND POINT AT 1ST FREE BYTE 73D4 831A 2614 73D6 045C B *R12 ALL DONE 2615 ************************************************************ 2616 * COMPCT - Is the string garbage collection routine. It can 2617 * be invoked by GETSTR or MEMCHK. It copies all 2618 * used strings to the top of the string space 2619 * suppressing out all of the unused strings 2620 * INPUT : None 2621 * OUTPUT: UPDATED @STRSP AND @STREND 2622 * USES : R0-R6 AS TEMPORARIES 2623 ************************************************************ 2624 73D8 C1CB COMPCT MOV R11,R7 Save rtn address 2625 73DA C020 MOV @FREPTR,R0 Get pointer to free space 73DC 8340 2626 73DE C160 MOV @STRSP,R5 Get pointer to string space 73E0 8318 2627 73E2 C800 MOV R0,@STRSP Set new string space pointer 73E4 8318 2628 73E6 0585 INC R5 Compensate for decrement 2629 73E8 0605 COMP03 DEC R5 Point at length of string 2630 73EA 8160 C @STREND,R5 At end of string space? 73EC 831A 2631 73EE 1A03 JL COMP05 No, check this string for copy 2632 73F0 C800 MOV R0,@STREND Yes, set end of free space 73F2 831A 2633 73F4 0457 B *R7 Return to caller 2634 73F6 C085 COMP05 MOV R5,R2 Copy ptr to end in case moved 2635 73F8 C0C5 MOV R5,R3 Copy ptr to end in read length 2636 73FA 06A0 BL @GETV1 Read the length byte 73FC 1880 2637 73FE D181 MOVB R1,R6 Put it in R6 for address 2638 7400 0986 SRL R6,8 Need in LSB for word 2639 7402 6146 S R6,R5 Point at the string start 2640 7404 0225 AI R5,-3 Point at the back pointer 7406 FFFD 2641 7408 C0C5 MOV R5,R3 Set up for GETV 2642 740A 06A0 BL @GET1 Get the backpointer 740C 6C9E 2643 740E C041 MOV R1,R1 Is this string garbage? 2644 7410 13EB JEQ COMP03 Yes, just ignore it 2645 * PERTINENT REGISTERS AT THIS POINT 2646 * R0 - is where the sting will end 2647 * R6 - # of bytes to be moved(does not) 2648 * include lengths and backpointer 2649 * R2 - points at trailing length byte of string 2650 * to be moved 2651 * IN GENERAL : MOVE (R6) BYTES FROM VDP(R2-R6) TO VDP(R0-R6) 99/4 ASSEMBLER STRINGS PAGE 0061 2652 * VDP(R0-R6) moving backwards i.e. the last 2653 * byte of the entry is moved first, then the 2654 * next to the last byte... 2655 7412 8DB6 C *R6+,*R6+ INCR by 4 to include overhead 2656 7414 C0C2 MOV R2,R3 Restore ptr to end of string 2657 7416 C100 MOV R0,R4 Get ptr to end of string space 2658 7418 06A0 COMP10 BL @GETV1 Read a byte 741A 1880 2659 741C 06A0 BL @PUTV1 Write a byte 741E 6422 2660 7420 0603 DEC R3 Decrement source pointer 2661 7422 0604 DEC R4 Decrement destination pointer 2662 7424 0606 DEC R6 Decrement the counter 2663 7426 15F8 JGT COMP10 Loop if not finished 2664 7428 0244 ANDI R4,>3FFF Delete VDP write-enable & reg 742A 3FFF 2665 742C C004 MOV R4,R0 Set new free space pointer 2666 742E 0584 INC R4 Point at backpointer just move 2667 7430 C0C4 MOV R4,R3 Copy pointer to read it 2668 7432 06A0 BL @GET1 Get the backpointer 7434 6C9E 2669 * R1 now contains the address of the forward pointer 2670 7436 C183 MOV R3,R6 Address of the string entry 2671 7438 0226 AI R6,3 Point at the string itself 743A 0003 2672 * R6 now contains the address of the string 2673 743C 06A0 BL @STVDP Reset the forward pointer 743E 18AE 2674 7440 10D3 JMP COMP03 Loop for next string 2675 ************************************************************ 2676 * NSTRCN - Nud for string constants 2677 * Copies the string into the string space and sets 2678 * up the FAC with a string entry of the following 2679 * form: 2680 * 2681 * +-------+-----+----+------------+-----------+ 2682 * | >001C | >65 | XX | Pointer | Length of | 2683 * | | | | to string | string | 2684 * +-------+-----+----+------------+-----------+ 2685 * FAC +2 +3 +4 +6 2686 ************************************************************ 2687 7442 06C8 NSTRCN SWPB R8 2688 7444 C808 MOV R8,@FAC6 Save length 7446 8350 2689 7448 C808 MOV R8,@BYTE For GETSTR 744A 830C 2690 744C 06C8 SWPB R8 2691 744E 06A0 BL @GETSTR Get result string 7450 736C 2692 7452 0200 LI R0,>001C Get address of SREF 7454 001C 2693 7456 0201 LI R1,FAC Optimize to save bytes 7458 834A 2694 745A CC40 MOV R0,*R1+ Indicate temporary string 2695 745C DC60 MOVB @CBH65,*R1+ Indicate a string 745E 65A7 2696 7460 DC40 MOVB R0,*R1+ Byte is not used 2697 7462 C460 MOV @SREF,*R1 Save pointer to string 7464 831C 99/4 ASSEMBLER STRINGS PAGE 0062 2698 7466 C0A0 MOV @BYTE,R2 Get number of bytes to copy in 7468 830C 2699 746A 1318 JEQ NSTR20 If none to copy 2700 746C C111 MOV *R1,R4 Get pointer to destination 2701 746E C0E0 MOV @PGMPTR,R3 Get pointer to source 7470 832C 2702 7472 D020 MOVB @RAMFLG,R0 ERAM or VDP? 7474 8389 2703 7476 1609 JNE NSTR10 ERAM 2704 * Get the string from VDP 2705 7478 06A0 NSTR05 BL @GETV1 Get a byte 747A 1880 2706 747C 06A0 BL @PUTV1 Put a byte 747E 6422 2707 7480 0583 INC R3 Next in source 2708 7482 0584 INC R4 Next in destination 2709 7484 0602 DEC R2 1 less to move 2710 7486 16F8 JNE NSTR05 If more to move, do it 2711 7488 1009 JMP NSTR20 Else if done, exit 2712 748A D7E0 NSTR10 MOVB @R4LB,*R15 Write 2nd byte of VDP address 748C 83E9 2713 748E 0264 ORI R4,WRVDP Enable VDP write 7490 4000 2714 7492 D7C4 MOVB R4,*R15 Write 1st byte of VDP address 2715 7494 D833 NSTR15 MOVB *R3+,@XVDPWD Move byte from ERAM to VDP 7496 8C00 2716 7498 0602 DEC R2 1 less to move 2717 749A 16FC JNE NSTR15 If ont done, loop for more 2718 749C A820 NSTR20 A @FAC6,@PGMPTR Skip the string 749E 8350 74A0 832C 2719 74A2 06A0 BL @PGMCHR Get character following string 74A4 6C74 2720 74A6 0460 B @CONT And continue on 74A8 64C8 2721 ************************************************************ 2722 74AA AORG >74AA 2724 2725 ************************************************************ 2726 * CIF - Convert integer to floating 2727 * Assume that the value in the FAC is an integer 2728 * and converts it into an 8 byte floating point 2729 * value 2730 ************************************************************ 2731 74AA 0204 CIF LI R4,FAC Will convert into the FAC 74AC 834A 2732 74AE C014 MOV *R4,R0 Get integer into register 2733 74B0 C184 MOV R4,R6 Copy pointer to FAC to clear i 2734 74B2 04F6 CLR *R6+ Clear FAC & FAC+1 2735 74B4 04F6 CLR *R6+ In case had a string in FAC 2736 74B6 C140 MOV R0,R5 Is integer equal to zero? 2737 74B8 1323 JEQ CIFRT Yes, zero result and return 2738 74BA 0740 ABS R0 Get ABS value of ARG 2739 74BC 0203 LI R3,>40 Get exponent bias 74BE 0040 2740 74C0 04F6 CLR *R6+ Clear words in result that 2741 74C2 04D6 CLR *R6 might not get a value 2742 74C4 0280 CI R0,100 Is integer less than 100? 74C6 0064 99/4 ASSEMBLER CIFS PAGE 0063 2743 74C8 1A13 JL CIF02 Yes, just put in 1st fraction 2744 * part 2745 74CA 0280 CI R0,10000 No, is ARG less then 100^2? 74CC 2710 2746 74CE 1A08 JL CIF01 Yes, just 1 division necessary 2747 * No, 2 divisions are necessary 2748 74D0 0583 INC R3 Add 1 to exponent for 1st 2749 74D2 C040 MOV R0,R1 Put # in low order word for th 2750 * divide 2751 74D4 04C0 CLR R0 Clear high order word for the 2752 * divide 2753 74D6 3C20 DIV @C100,R0 Divide by the radix 74D8 6008 2754 74DA D920 MOVB @R1LB,@3(R4) ~@ Move the radix digit in 74DC 83E3 74DE 0003 2755 74E0 0583 CIF01 INC R3 Add 1 to exponent for divide 2756 74E2 C040 MOV R0,R1 Put in low order for divide 2757 74E4 04C0 CLR R0 Clear high order for divide 2758 74E6 3C20 DIV @C100,R0 Divide by the radix 74E8 6008 2759 74EA D920 MOVB @R1LB,@2(R4) ~@ Put next radix digit in 74EC 83E3 74EE 0002 2760 74F0 D920 CIF02 MOVB @R0LB,@1(R4) ~@ Put highest order radix digit 74F2 83E1 74F4 0001 2761 74F6 D520 MOVB @R3LB,*R4 Put exponent in 74F8 83E7 2762 74FA 0545 INV R5 Is result positive? 2763 74FC 1101 JLT CIFRT Yes, sign is correct 2764 74FE 0514 NEG *R4 No, make it negative 2765 7500 045B CIFRT RT 2766 ************************************************************ 2767 2768 7502 AORG >7502 2770 2771 7502 A000 CONTAD DATA >A000 Address of a continue stmt 2772 A026 GPLIST EQU >A026 GPL subprogram linked list 2773 2774 00C8 UNQSTZ EQU >C8 Unquoted string token 2775 2776 7504 8000 INUSE DATA >8000 In-use flag 2777 7506 4000 FNCFLG DATA >4000 User-defined function flag 2778 7508 2000 SHRFLG DATA >2000 Shared-value flag 2779 * 2780 * ERROR CODES 2781 * 2782 1203 ERRSND EQU >1203 * SUBEND NOT IN SUBPROGRAM 2783 0F03 ERRREC EQU >0F03 * RECURSIVE SUBPROGRAM CALL 2784 0E03 ERRIAL EQU >0E03 * INCORRECT ARGUMENT LIST 2785 1103 ERROLP EQU >1103 * ONLY LEGAL IN A PROGRAM 2786 2787 ************************************************************ 2788 * CALL - STATEMENT EXECUTION 2789 * Finds the subprogram specified in the subprogram table, 2790 * evaluates and assigns any arguments to the formal 2791 * parameters, builds the stack block, and transfers control 2792 * into the subprogram. 99/4 ASSEMBLER SUBPROGS PAGE 0064 2793 * General register usage: 2794 * R0 - R6 Temporaries 2795 * R7 Pointer into formals in subprogram name entry 2796 * R8 Character returned by PGMCHR 2797 * R9 Subroutine stack 2798 * R10 Temporary 2799 * R11 Return link 2800 * R12 Temporary 2801 * R13 GROM read-data address 2802 * R14 Interpreter flags 2803 * R15 VDP write-address address 2804 ************************************************************ 2805 750A 06A0 CALL BL @PGMCHR Skip UNQSTZ & get name length 750C 6C74 2806 750E D808 MOVB R8,@FAC15 Save lengthfor FBS 7510 8359 2807 7512 D108 MOVB R8,R4 For the copies to be made 2808 7514 0984 SRL R4,8 below 2809 7516 C020 MOV @PGMPTR,R0 Get pointer to name 7518 832C 2810 751A D060 MOVB @RAMFLG,R1 ERAM or VDP? 751C 8389 2811 751E 130D JEQ CALL04 VDP 2812 * ERAM, must copy into VDP 2813 7520 C140 MOV R0,R5 Pointer to string in ERAM 2814 7522 0200 LI R0,CRNBUF Destination in VDP 7524 0820 2815 7526 C0C4 MOV R4,R3 Length for this move 2816 7528 D7E0 MOVB @R0LB,*R15 Load out the VDP write address 752A 83E1 2817 752C 0260 ORI R0,WRVDP Enable the VDP write 752E 4000 2818 7530 D7C0 MOVB R0,*R15 Second byte of VDP write 2819 7532 D835 CALL02 MOVB *R5+,@XVDPWD Move a byte 7534 8C00 2820 7536 0603 DEC R3 One less byte to move 2821 7538 16FC JNE CALL02 Loop if not done 2822 753A A804 CALL04 A R4,@PGMPTR Skip over the name 753C 832C 2823 753E 0201 LI R1,FAC Destination in CPU 7540 834A 2824 7542 D7E0 MOVB @R0LB,*R15 Load out VDP read address 7544 83E1 2825 7546 0240 ANDI R0,>3FFF Kill VDP write-enable 7548 3FFF 2826 754A D7C0 MOVB R0,*R15 Both bytes 2827 754C 1000 NOP Don't go to fast for it 2828 754E DC60 CALL06 MOVB @XVDPRD,*R1+ Move a byte 7550 8800 2829 7552 0604 DEC R4 One less bye to move 2830 7554 16FC JNE CALL06 Loop if not done 2831 7556 C120 MOV @SUBTAB,R4 Get beginning of subpgm table 7558 833A 2832 755A 133C JEQ SCAL89 If table empty, search in GPL 2833 755C 06A0 BL @FBS001 Search subprogram table 755E 15E6 2834 7560 75D4 DATA SCAL89 If not found, search in GPL 2835 * Pointer to table entry returned in both R4 and FAC 2836 7562 06A0 BL @PGMCHR Get next token 99/4 ASSEMBLER SUBPROGS PAGE 0065 7564 6C74 2837 7566 C0C4 MOV R4,R3 Duplicate pointer for GETV 2838 7568 06A0 BL @GETV1 Get flag byte 756A 1880 2839 756C 1130 JLT SCAL90 If attempted recursive call 2840 756E 0A11 SLA R1,1 Check for BASIC/GPL program 2841 7570 1106 JLT GPLSU GPL subprogram 2842 7572 D2E0 MOVB @PRGFLG,R11 Imperative call to BASIC sub? 7574 8344 2843 7576 1614 JNE SCAL01 No, OK-handle BASIC subprogram 2844 7578 0200 LI R0,ERROLP Can't call a BASIC sub 757A 1103 2845 757C 102D JMP SCAL91 imperatively 2846 * 2847 * Handle a GPL subprogram 2848 * 2849 757E 05C9 GPLSU INCT R9 2850 7580 CE60 MOV @CONTAD,*R9+ Put address of a cont on stack 7582 7502 2851 7584 C64D MOV R13,*R9 Save address for real BASIC 2852 7586 0223 AI R3,6 Now set up new environment 7588 0006 2853 758A 06A0 BL @GET1 Get access address of GPL subp 758C 6C9E 2854 758E DB41 MOVB R1,@GRMWAX(R13) Load out the address into GRO 7590 0402 2855 7592 06C1 SWPB R1 Need to kill time here 2856 7594 DB41 MOVB R1,@GRMWAX(R13) Next byte also 7596 0402 2857 7598 06A0 BL @SAVREG Restore registers to GPL 759A 1E8C 2858 759C 0460 B @RESET And enter the routine 759E 006A 2859 * 2860 * Execute BASIC subprogram 2861 * 2862 75A0 SCAL01 EQU $ 2863 *----------------------------------------------------------- 2864 * Fix "An error happened in a CALL statement keeps its 2865 * in-use flag set" bug. 5/12/81 2866 * Move the following 3 lines after finishing processing 2867 * the parameter list, before entering the subprogram. 2868 * SRL R1,1 Restore mode to original form 2869 * SOCB @INUSE,R1 Set the in-use flag bit 2870 * BL @PUTV1 Put the byte back 2871 * Save the pointer to table entry for setting in-use flag 2872 * later. 2873 * $$$$$$$ USE VDP(0374) 2 BYTES AS TEMPRORARY HERE 2874 75A0 0204 LI R4,>0374 R4: address register for PUT1 75A2 0374 2875 75A4 C043 MOV R3,R1 R1: data register for PUT1 2876 75A6 06A0 BL @PUT1 Save the pointer to table 75A8 6CB2 2877 * entry in VDP temporary 2878 *----------------------------------------------------------- 2879 75AA C303 MOV R3,R12 Save subtable address 2880 75AC 04E0 CLR @FAC2 Indicate non-special entry 75AE 834C 2881 75B0 06A0 BL @VPUSH Push subprogram entry on stack 99/4 ASSEMBLER SUBPROGS PAGE 0066 75B2 6BAA 2882 75B4 C10C MOV R12,R4 Restore sub table address 2883 75B6 C1C4 MOV R4,R7 2884 75B8 0227 AI R7,6 Point to 1st argument in list 75BA 0006 2885 75BC C0C7 MOV R7,R3 Formals' pointer 2886 75BE 06A0 BL @GET1 Check to see if any 75C0 6C9E 2887 75C2 C041 MOV R1,R1 Any args? 2888 75C4 133F JEQ SCAL32 None, jump forward 2889 75C6 0288 CI R8,LPARZ*256 Must see a left parenthesis 75C8 B700 2890 75CA 1640 JNE SCAL34 If not, error 2891 75CC 1013 JMP SCAL08 Jump into argument loop 2892 75CE 0200 SCAL90 LI R0,ERRREC * RECURSIVE SUBPROGRAM CALL 75D0 0F03 2893 75D2 1002 JMP SCAL91 2894 75D4 0200 SCAL89 LI R0,>000A GPL check for DSR subprogram 75D6 000A 2895 75D8 0460 SCAL91 B @ERR 75DA 6652 2896 75DC 1031 SCAL93 JMP SCAL12 Going down! 2897 75DE 06A0 SCAL05 BL @POPSTK Short stack pop routine 75E0 60D4 2898 75E2 C1E0 MOV @ARG4,R7 To quickly restore R7 75E4 8360 2899 75E6 05C7 INCT R7 To account for SCAL80 2900 75E8 0288 SCAL06 CI R8,RPARZ*256 Actual list ended? 75EA B600 2901 75EC 132D JEQ SCAL30 Actuals all scanned 2902 75EE 0288 CI R8,COMMAZ*256 Must see a comma then 75F0 B300 2903 75F2 1626 JNE SCAL12 Didn't, so error 2904 * Scan next actual. Check if it is just a name 2905 75F4 C820 SCAL08 MOV @PGMPTR,@ERRCOD Save text ptr in case of expr 75F6 832C 75F8 8322 2906 75FA 06A0 BL @PGMCHR Get next character 75FC 6C74 2907 75FE 1179 JLT SCAL40 No, so must be an expression 2908 7600 C307 MOV R7,R12 Save formals pointer 2909 7602 06A0 BL @SYM Read name & see if recognized 7604 6312 2910 7606 06A0 BL @GETV Check function flag 7608 187C 2911 760A 834A DATA FAC 2912 760C C1CC MOV R12,R7 Restore formals pointer first 2913 760E 2460 CZC @FNCFLG,R1 User-defined function? 7610 7506 2914 7612 166F JNE SCAL40 Yes, pass by value 2915 7614 0288 CI R8,LPARZ*256 Complex type? 7616 B700 2916 7618 1620 JNE SCAL15 No 2917 761A 06A0 BL @PGMCHR Check if formal entry 761C 6C74 2918 761E 0288 CI R8,RPARZ*256 FOO() ? 7620 B600 2919 7622 1319 JEQ SCAL14 Yes, handle it as such 2920 7624 0288 CI R8,COMMAZ*256 or FOO(,...) ? 99/4 ASSEMBLER SUBPROGS PAGE 0067 7626 B300 2921 7628 1613 JNE SCAL35 No, an array element FOO(I... 2922 762A 06A0 SCAL10 BL @PGMCHR Formal array, scan to end 762C 6C74 2923 762E 06A0 BL @EOSTMT Check if end-of-statement 7630 6862 2924 7632 1306 JEQ SCAL12 Premature end of statement 2925 7634 0288 CI R8,COMMAZ*256 Another comma? 7636 B300 2926 7638 13F8 JEQ SCAL10 Yes, continue on to end 2927 763A 0288 CI R8,RPARZ*256 End yet? 763C B600 2928 763E 130B JEQ SCAL14 Yes, merge in below 2929 7640 0460 SCAL12 B @ERRONE * SYNTAX ERROR 7642 664E 2930 7644 0460 SCAL32 B @SCAL62 Going down! 7646 77B8 2931 7648 0460 SCAL30 B @SCAL60 764A 77B4 2932 764C 0460 SCAL34 B @SCAL88 764E 7878 2933 7650 0460 SCAL35 B @SCAL50 7652 7744 2934 7654 10C9 SCAL37 JMP SCAL06 2935 * 2936 * Here for Scalers/Arrays by Reference 2937 7656 06A0 SCAL14 BL @PGMCHR Pass the right parenthesis 7658 6C74 2938 765A 0288 SCAL15 CI R8,COMMAZ*256 Just a name? 765C B300 2939 765E 1303 JEQ SCAL16 Yes 2940 7660 0288 CI R8,RPARZ*256 Start an expression? 7662 B600 2941 7664 1646 JNE SCAL40 Yes, name starts an expression 2942 7666 06A0 SCAL16 BL @GETV Get mode of name 7668 187C 2943 766A 834A DATA FAC Ptr to s.t. entry left by SYM 2944 766C D081 MOVB R1,R2 Save for check below 2945 766E 06A0 BL @SCAL80 And fetch next formal info 7670 787E 2946 7672 D042 MOVB R2,R1 Copy for this check 2947 7674 0241 ANDI R1,>C700 for the comparison 7676 C700 2948 7678 C006 MOV R6,R0 Use a temporary rgister 2949 767A 0240 ANDI R0,>C700 for the comparison 767C C700 2950 767E 8001 C R1,R0 Must be exact match 2951 7680 16E5 JNE SCAL34 Else can't pass by reference 2952 7682 E1A0 SOC @SHRFLG,R6 Set the shared symbol flag 7684 7508 2953 7686 D046 MOVB R6,R1 Load up for PUTV 2954 7688 C105 MOV R5,R4 Address to put the flag 2955 768A 06A0 BL @PUTV1 Set the flag in the s.t. entry 768C 6422 2956 768E 0244 ANDI R4,>3FFF Kill VDP write-enable bit 7690 3FFF 2957 * 2958 * The following section finds actual's value space address 2959 * and puts it in R1. 99/4 ASSEMBLER SUBPROGS PAGE 0068 2960 * FAC contains the symbol table's address. 2961 * If actual is NOT shared....................... 2962 * Symbol table's address+6 will point to the value space 2963 * except for numeric ERAM cae. In a numeric ERAM case 2964 * GET1 to get pointer to the ERAM value space. 2965 * If actual is SHARED........................ 2966 * GET1 to get the pointer in symbol table's address+6 2967 * In a numeric ERAM case, GETG to get the indirect point 2968 * to the actual's vlaue space pointer after GET1 is call 2969 * 2970 7692 C060 MOV @FAC,R1 Ptr to actual s.t. entry 7694 834A 2971 7696 0221 AI R1,6 Ptr to actuals value space 7698 0006 2972 769A 0246 ANDI R6,>8700 Keep info on string or array 769C 8700 2973 769E 0242 ANDI R2,>2000 Is actual shared? 76A0 2000 2974 76A2 130C JEQ SCAL23 No, use it 2975 76A4 C0C1 MOV R1,R3 Else look further 2976 76A6 06A0 BL @GET1 Get the true pointer 76A8 6C9E 2977 76AA D186 MOVB R6,R6 Array or string? 2978 76AC 160F JNE SCAL24 Yes, both are special cases 2979 76AE D0A0 MOVB @RAMTOP,R2 ERAM present? 76B0 8384 2980 76B2 130C JEQ SCAL24 No ERAM, so skip 2981 * Numeric variable, shared, ERAM. 2982 76B4 C0C1 MOV R1,R3 Get ptr to original from ERAM 2983 76B6 06A0 BL @GETG2 Get indirect pointer 76B8 6CCE 2984 76BA 1008 JMP SCAL24 2985 * Shared bit is NOT on. 2986 76BC D186 SCAL23 MOVB R6,R6 Check for array or string 2987 76BE 1606 JNE SCAL24 Yes, take what's in there 2988 76C0 D0A0 MOVB @RAMTOP,R2 ERAM exists? 76C2 8384 2989 76C4 1303 JEQ SCAL24 No 2990 76C6 C0C1 MOV R1,R3 Numeric and ERAM case 2991 76C8 06A0 BL @GET1 Get ERAM value space address 76CA 6C9E 2992 * R4 pointing to value space of 2993 76CC 0224 SCAL24 AI R4,6 subprogram's symbol table 76CE 0006 2994 76D0 D186 MOVB R6,R6 Array or string case? 2995 76D2 160C JNE SCAL26 Yes, so just put ptr in VDP 2996 * Here check for ERAM program and if ERAM then copy the 2997 * address of shared value space into corresponding value 2998 * space in ERAM 2999 76D4 D1A0 MOVB @RAMTOP,R6 Get the ERAM flag 76D6 8384 3000 76D8 1309 JEQ SCAL26 If no ERAM, simple case 3001 76DA C181 MOV R1,R6 Keep shared value space addres 3002 76DC C0C4 MOV R4,R3 Put ptr in value space in ERAM 3003 76DE 06A0 BL @GET1 Get value space address in ERA 76E0 6C9E 3004 76E2 C101 MOV R1,R4 Copy address into R4 for PUTG2 3005 76E4 C046 MOV R6,R1 Get the value to put in ERAM 3006 76E6 06A0 BL @PUTG2 Write it into ERAM 99/4 ASSEMBLER SUBPROGS PAGE 0069 76E8 6CD8 3007 76EA 10B4 JMP SCAL37 Loop for next argument 3008 76EC 06A0 SCAL26 BL @PUT1 Set symbol indirect link 76EE 6CB2 3009 76F0 10B1 JMP SCAL37 And loop for next arg 3010 * 3011 * Here to pass an expression by value 3012 * 3013 76F2 C820 SCAL40 MOV @ERRCOD,@PGMPTR Restore text pointer 76F4 8322 76F6 832C 3014 76F8 C807 MOV R7,@FAC4 Save formals pointer 76FA 834E 3015 76FC 04E0 CLR @FAC2 Don't let VPUSH mess up 76FE 834C 3016 7700 06A0 SCAL42 BL @PGMCHR Set up for the parse 7702 6C74 3017 * Save formals ptr & SUBTAB ptr and evaluate the expression 3018 7704 06A0 BL @PSHPRS 7706 6B9C 3019 7708 B6 BYTE RPARZ Stop on an rpar or comma 3020 7709 6A DCBH6A BYTE >6A (CBH6A copy) 3021 770A 06A0 BL @POPSTK Restore formals pointer 770C 60D4 3022 770E A820 A @C16,@VSPTR But keep it on stack 7710 6BF8 7712 836E 3023 7714 06A0 BL @VPUSH Save parse result 7716 6BAA 3024 7718 C1E0 MOV @ARG4,R7 Restore formals pointer 771A 8360 3025 771C 06A0 BL @SCAL80 And fetch next formal's info 771E 787E 3026 7720 C805 MOV R5,@FAC Set up for assignment 7722 834A 3027 7724 06A0 BL @SMB Get value space 7726 61DC 3028 7728 6820 S @C16,@VSPTR Get to s.t. info 772A 6BF8 772C 836E 3029 772E 06A0 BL @VPUSH Set up for ASSG 7730 6BAA 3030 7732 A820 A @C8,@VSPTR Get back to parse result 7734 706C 7736 836E 3031 7738 06A0 BL @VPOP Get parse result back 773A 6C2A 3032 773C 06A0 BL @ASSG Assign the value to the formal 773E 6334 3033 7740 0460 B @SCAL05 And go back for more 7742 75DE 3034 * 3035 * Here for array elements 3036 * 3037 7744 0620 SCAL50 DEC @PGMPTR Restore text pointer to lpar 7746 832C 3038 7748 020B LI R11,FAC2 Optimize to save 774A 834C 3039 774C 04FB CLR *R11+ Don't let VPUSH mess up (FAC2) 99/4 ASSEMBLER SUBPROGS PAGE 0070 3040 774E CEC7 MOV R7,*R11+ Save formals pointer (FAC4) 3041 7750 C6E0 MOV @ERRCOD,*R11 For save on stack (FAC6) 7752 8322 3042 7754 06A0 BL @VPUSH Save the info 7756 6BAA 3043 7758 0208 LI R8,LPARZ*256 Load up R8 with the lpar again 775A B700 3044 775C C820 MOV @FAC,@PAD Save ptr to s.t. entry 775E 834A 7760 8300 3045 7762 06A0 BL @SMB Check if name or expression 7764 61DC 3046 7766 0288 CI R8,COMMAZ*256 7768 B300 3047 776A 1309 JEQ SCAL54 Name if ended on a comma 3048 776C 0288 CI R8,RPARZ*256 776E B600 3049 7770 1306 JEQ SCAL54 or rpar 3050 7772 06A0 BL @VPOP Get saved info back 7774 6C2A 3051 7776 C820 MOV @FAC6,@PGMPTR Else expr, Restore test pointe 7778 8350 777A 832C 3052 777C 10C1 JMP SCAL42 And handle like an expression 3053 * 3054 * Passing array elements by reference 3055 777E 06A0 SCAL54 BL @POPSTK Restore symbol pointer 7780 60D4 3056 7782 C1E0 MOV @ARG4,R7 7784 8360 3057 7786 06A0 BL @SCAL80 Get next formal's info 7788 787E 3058 778A 06A0 BL @GETV Check actualOs mode 778C 187C 3059 778E 8300 DATA PAD Get back header information 3060 7790 0241 ANDI R1,>C000 Throw away all but string & fu 7792 C000 3061 7794 9046 CB R6,R1 Check mode match (string/num) 3062 7796 1612 JNE JNE88 Don't, so error 3063 * Can set bit in R1 since MSB (R1)=MSB (R6) 3064 7798 F060 SOCB @SHRFLG,R1 Set the share flag 779A 7508 3065 779C C105 MOV R5,R4 Address for PUTV 3066 779E 06A0 BL @PUTV1 Put it in the s.t. entry 77A0 6422 3067 77A2 0244 ANDI R4,>3FFF Kill VDP write, enable bit 77A4 3FFF 3068 77A6 C060 MOV @FAC,R1 Assuming string, ref link=@FAC 77A8 834A 3069 77AA D186 MOVB R6,R6 Check if it is a string 3070 77AC 118F JLT SCAL24 If so, go set ref. link 3071 77AE C060 MOV @FAC4,R1 Numeric, ref. link=@FAC4(v.s.) 77B0 834E 3072 77B2 108C JMP SCAL24 Now set the link and go on 3073 * 3074 * Here when done parsing actuals 3075 * 3076 77B4 06A0 SCAL60 BL @PGMCHR Pass the right parenthesis 77B6 6C74 99/4 ASSEMBLER SUBPROGS PAGE 0071 3077 77B8 06A0 SCAL62 BL @EOSTMT Must be at end of statement 77BA 6862 3078 77BC 165D JNE88 JNE SCAL88 If not, error 3079 77BE C0C7 MOV R7,R3 Formals must also have ended 3080 77C0 05C7 INCT R7 3081 77C2 C807 MOV R7,@FAC Keep R7, POPSTK destorys R7 77C4 834A 3082 77C6 06A0 BL @GET1 Get the last arg address 77C8 6C9E 3083 77CA C041 MOV R1,R1 Formals end? 3084 77CC 1655 JNE SCAL88 Didn't, so error 3085 * 3086 * Now set up the stack entry 3087 * 3088 77CE 06A0 BL @VPUSH Check if enough room for push 77D0 6BAA 3089 77D2 6820 S @C8,@VSPTR Get back right pointer 77D4 706C 77D6 836E 3090 77D8 06A0 BL @POPSTK Retrieve ptr to subprog s.t. 77DA 60D4 3091 77DC 020C LI R12,FAC For code optimization 77DE 834A 3092 77E0 C04C MOV R12,R1 Store following data in FAC 3093 77E2 C81C MOV *R12,@ARG2 Save new environment pointer 77E4 835E 3094 * 3095 * First push entry. PGMCHR, EXTRAM, SYMTAB and RAM(SYNBOL) 3096 * 3097 77E6 0200 LI R0,PGMPTR Optimize 77E8 832C 3098 77EA CC70 MOV *R0+,*R1+ Text pointer PGMPTR 3099 77EC CC70 MOV *R0+,*R1+ Line table pointer EXTRAM 3100 77EE CC60 MOV @SYMTAB,*R1+ Symbol table pointer 77F0 833E 3101 77F2 0203 LI R3,SYMBOL Put address of SYMBOL 77F4 0376 3102 77F6 06A0 BL @GET1 Get RAM(SYMBOL) in REG1 77F8 6C9E 3103 77FA C801 MOV R1,@FAC6 Move to FAC area 77FC 8350 3104 77FE 06A0 BL @VPUSH Save first entry 7800 6BAA 3105 * 3106 * Push second entry. Subprogram table pointer, >6A on warnin 3107 * bits and @LSUBP in the second stack. 3108 7802 C10C MOV R12,R4 Going to build entry in FAC 3109 7804 CD20 MOV @ARG,*R4+ Subprogram table entry pointer 7806 835C 3110 7808 DD20 MOVB @DCBH6A,*R4+ >6A = Stack ID 780A 7709 3111 780C D0A0 MOVB @FLAG,R2 Warning/break bits 780E 8345 3112 7810 0242 ANDI R2,>0600 Mask off other bits 7812 0600 3113 7814 DD02 MOVB R2,*R4+ Put bits in stack entry 3114 7816 C820 MOV @LSUBP,@FAC6 Last subprogram block on stack 7818 8348 781A 8350 99/4 ASSEMBLER SUBPROGS PAGE 0072 3115 781C 06A0 BL @VPUSH Push final entry 781E 6BAA 3116 7820 C820 MOV @VSPTR,@LSUBP Set bottom of stack for the su 7822 836E 7824 8348 3117 * 3118 * Now build the new environment by modifying PGMCHR, 3119 * EXTRAM and pointer to sub's symbol table. 3120 7826 0200 LI R0,PGMPTR Optimization 7828 832C 3121 782A D7E0 MOVB @ARG3,*R15 2nd byte of address 782C 835F 3122 782E 0201 LI R1,XVDPRD Optimize to save bytes 7830 8800 3123 7832 D7E0 MOVB @ARG2,*R15 1st byte of address 7834 835E 3124 7836 0204 LI R4,4 Need 4 bytes 7838 0004 3125 783A DC11 SCAL70 MOVB *R1,*R0+ Read EXTRAM and PGMPTR 3126 783C 0604 DEC R4 3127 783E 16FD JNE SCAL70 3128 7840 D811 MOVB *R1,@SYMTAB New SYMTAB 7842 833E 3129 7844 0204 LI R4,SYMBOL 7846 0376 3130 7848 D811 MOVB *R1,@SYMTA1 784A 833F 3131 784C C060 MOV @SYMTAB,R1 784E 833E 3132 7850 06A0 BL @PUT1 New RAM(SYMBOL) 7852 6CB2 3133 7854 04E0 CLR @ERRCOD Clean up our mess 7856 8322 3134 7858 06A0 BL @PGMCHR Get the next token into R8 785A 6C74 3135 *----------------------------------------------------------- 3136 * Fix "A error happened in a CALL statement keeps it 3137 * "in-use flag set" bug, 5/23/81 3138 * Insert following lines: 3139 785C 0203 LI R3,>0374 Restore the pointer to table 785E 0374 3140 * entry from VDP temporary, R3: address reg. for GET1 3141 7860 06A0 BL @GET1 7862 6C9E 3142 7864 C0C1 MOV R1,R3 Get flag byte 3143 7866 06A0 BL @GETV1 7868 1880 3144 786A F060 SOCB @INUSE,R1 Set the in-use flag bit 786C 7504 3145 786E C103 MOV R3,R4 ?????????????????????????????? 3146 7870 06A0 BL @PUTV1 Put the byte back 7872 6422 3147 *----------------------------------------------------------- 3148 7874 0460 B @NUDEND Enter the subprogram 7876 65F0 3149 7878 0200 SCAL88 LI R0,ERRIAL * INCORRECT ARGUMENT LIST 787A 0E03 3150 787C 1062 JMP $+>C6 Jump to B @ERR 3151 ************************************************************ 99/4 ASSEMBLER SUBPROGS PAGE 0073 3152 * Fetch next formal and prop for adjustment 3153 * Register modification 3154 * R5 Address of s.t. entry (formal's entry) 3155 * R6 Header byte of formal's entry 3156 * R7 Updated formal's pointer 3157 * Destroys: R1, R2, R3, R4, R11, R12 3158 ************************************************************ 3159 787E C30B SCAL80 MOV R11,R12 Save return address 3160 7880 C0C7 MOV R7,R3 Fetch symbol pointer 3161 7882 05C7 INCT R7 Point to next formal 3162 7884 06A0 BL @GET1 Fetch s.t. pointer 7886 6C9E 3163 7888 C0C1 MOV R1,R3 Set condition & put in place 3164 788A 13F6 JEQ SCAL88 If to many actuals 3165 788C C101 MOV R1,R4 Save for below 3166 788E C141 MOV R1,R5 Save for return 3167 7890 06A0 BL @GET1 Get header bytes 7892 6C9E 3168 7894 2060 COC @SHRFLG,R1 Shared? 7896 7508 3169 7898 1313 JEQ SCAL82 Yes, reset flag and old value 3170 789A C181 MOV R1,R6 Save for return & test string 3171 789C 1101 JLT SCAL81 If it is a string, then SCAL81 3172 789E 045C B *R12 Return 3173 78A0 0223 SCAL81 AI R3,6 Is string, point at value ptr 78A2 0006 3174 78A4 06A0 BL @GET1 Get the value pointer 78A6 6C9E 3175 78A8 C101 MOV R1,R4 Null value? 3176 78AA 1312 JEQ SCAL86 Yes 3177 78AC 04C1 CLR R1 No, must free current string 3178 78AE 0224 AI R4,-3 Point at the backpointer 78B0 FFFD 3179 78B2 06A0 BL @PUT1 Clear the backpointer 78B4 6CB2 3180 78B6 C103 MOV R3,R4 3181 78B8 04C1 SCAL84 CLR R1 Needed for entry from below 3182 78BA 06A0 BL @PUT1 Clear the forward pointer 78BC 6CB2 3183 78BE 045C B *R12 Just return 3184 78C0 0241 SCAL82 ANDI R1,>DFFF Reset the share flag 78C2 DFFF 3185 78C4 06A0 BL @PUTV1 Put it there 78C6 6422 3186 78C8 0224 AI R4,6 Point at ref pointer 78CA 0006 3187 78CC C181 MOV R1,R6 Set for return 3188 78CE 11F4 JLT SCAL84 If string clear ref pointer 3189 78D0 045C SCAL86 B *R12 Return 3190 ************************************************************ 3191 * Execute a SUBEXIT or SUBEND 3192 ************************************************************ 3193 78D2 C160 SUBXIT MOV @LSUBP,R5 Check for subprogram on stack 78D4 8348 3194 78D6 1333 JEQ SCAL98 Not one, so error 3195 78D8 8805 C R5,@VSPTR Extra check on stack pointer 78DA 836E 3196 78DC 1B30 JH SCAL98 Pointers are messed up, error 3197 78DE 06A0 SBXT05 BL @VPOP Get stack entry 99/4 ASSEMBLER SUBPROGS PAGE 0074 78E0 6C2A 3198 78E2 9820 CB @FAC2,@DCBH6A Reached the subprogram entry? 78E4 834C 78E6 7709 3199 78E8 16FA JNE SBXT05 Not yet 3200 * 3201 * Reached the subprogram stack entry. Get information FAC 3202 * area has subprograms table pointer, >6A, on warning bits 3203 * and LSUBP 3204 78EA 020C LI R12,FAC Optimize for the copies 78EC 834A 3205 78EE C00C MOV R12,R0 For this copy 3206 78F0 C0F0 MOV *R0+,R3 Subprogram pointer 3207 78F2 06A0 BL @GETV1 Get header byte in subprogram 78F4 1880 3208 78F6 5060 SZCB @INUSE,R1 Reset the in-use bit 78F8 7504 3209 78FA C103 MOV R3,R4 3210 78FC 06A0 BL @PUTV1 Put it back 78FE 6422 3211 7900 C070 MOV *R0+,R1 On warning bits 3212 7902 D120 MOVB @FLAG,R4 Get the current flag 7904 8345 3213 7906 0244 ANDI R4,>F900 Trash current warning bits 7908 F900 3214 790A F120 SOCB @R1LB,R4 OR the old ones back in 790C 83E3 3215 790E D804 MOVB R4,@FLAG And put flag back 7910 8345 3216 7912 05C0 INCT R0 There is one word empty 3217 7914 C830 MOV *R0+,@LSUBP Last subprogram block on stack 7916 8348 3218 * 3219 * Second subprogram stack entry. Restore pointers. FAC area 3220 * has PGMPTR, EXTRAM, SYMTAB, RAM(SYMBOL) 3221 7918 06A0 BL @VPOP Get second entry 791A 6C2A 3222 791C C00C MOV R12,R0 Put FAC in R0. (optimization) 3223 791E 0201 LI R1,PGMPTR For optimization 7920 832C 3224 7922 C470 MOV *R0+,*R1 Restore text pointer PGMPTR 3225 7924 0631 DEC *R1+ Save code to decrement it 3226 7926 CC70 MOV *R0+,*R1+ Line table pointer EXTRAM 3227 7928 C830 MOV *R0+,@SYMTAB Restore symbol table pointer 792A 833E 3228 792C C070 MOV *R0+,R1 Restore permanent s.t. pointer 3229 792E 0204 LI R4,SYMBOL Place in VDP 7930 0376 3230 7932 06A0 BL @PUT1 Put it out there 7934 6CB2 3231 7936 06A0 BL @PGMCHR Load R8 with EOS/EOL & go on 7938 6C74 3232 793A 0460 B @EOL 793C 65D6 3233 793E 0200 SCAL98 LI R0,ERRSND * SUBEND NOT IN SUBPROGRAM 7940 1203 3234 7942 0460 B @ERR 7944 6652 3235 ************************************************************ 99/4 ASSEMBLER SUBPROGS PAGE 0075 3236 3237 3239 3240 ************************************************************ 3241 * RESOLV - Attempt to resolve all subprograms referenced in 3242 * call statements by first searching the internal subprogram 3243 * table (SUBTAB), then by searching GROMs for GPL 3244 * subprograms. In RESGPL, it builds a subprogram table. 3245 * If, after searching all of the subprogram areas, there 3246 * are any subprograms whose location cannot be determined, 3247 * an error occurs. 3248 ************************************************************ 3249 7946 05C9 RESOLV INCT R9 Save return address 3250 7948 C64B MOV R11,*R9 3251 794A C160 MOV @CALIST,R5 Pick up call list pointer 794C 830A 3252 794E 1337 JEQ RES50 If no subprogram references 3253 7950 C1A0 RES03 MOV @SUBTAB,R6 Pick up subprogram table ptr 7952 833A 3254 7954 1327 RES05 JEQ RES15 Try to resolve by checking 3255 * 3256 * Compares two names for a match when trying to resolve all 3257 * references to subprograms. 3258 * Register usage is generally as follows: 3259 * R5 - Pointer to CALIST entry to be compared 3260 * R7 - Pointer to entry to be compared to SUBTAB 3261 * Returns as pointer to name if found or zero 3262 * if not found 3263 * R10 - Returned as length of name 3264 7956 C0C6 MOV R6,R3 Put in place for GETV 3265 7958 0583 INC R3 Point at the name length 3266 795A 06A0 BL @GETV1 Get the name length 795C 1880 3267 795E 0981 SRL R1,8 Put in LSB and clear MSB 3268 7960 C101 MOV R1,R4 Save it for the move 3269 7962 0223 AI R3,3 Point at name pointer 7964 0003 3270 7966 06A0 BL @GET1 Get the name pointer 7968 6C9E 3271 796A C1C1 MOV R1,R7 Save in permanent 3272 796C C801 MOV R1,@PGMPTR Save for compare 796E 832C 3273 7970 C0C5 MOV R5,R3 To get the CALIST entry 3274 7972 0583 INC R3 Point at the name length 3275 7974 06A0 BL @GETV1 Get the name length 7976 1880 3276 7978 9801 CB R1,@R4LB Name length match? 797A 83E9 3277 797C 161A JNE RES20 No, no match possible 3278 797E C004 MOV R4,R0 Save name length for compare 3279 7980 0223 AI R3,3 Point at the name pointer 7982 0003 3280 7984 06A0 BL @GET1 Get the pointer to the name 7986 6C9E 3281 7988 C0C1 MOV R1,R3 Set up to get the name 3282 798A 06A0 COMPTN BL @GETV1 Get a char of CALIST name 798C 1880 3283 * Next PGMSUB call is the same as PGMCHR except in skipping 3284 * ERAM check 99/4 ASSEMBLER SUBPROGS2 PAGE 0076 3285 798E 06A0 BL @PGMSUB Get a char of found name 7990 6C7A 3286 7992 9201 CB R1,R8 Chars match? 3287 7994 160E JNE RES20 No, not same name 3288 7996 0583 INC R3 Next character 3289 7998 0600 DEC R0 Done with compare? 3290 799A 16F7 JNE COMPTN No, check the rest 3291 * Found the subprogram in GROM and built the table. 3292 * Set resolved flag and get back. 3293 799C C105 MOV R5,R4 Set resolved flag now 3294 799E 0701 SETO R1 Set up a resolved flag 3295 79A0 06A0 BL @PUTV1 And put the byte in 79A2 6422 3296 79A4 C0C5 RES15 MOV R5,R3 Get call list pointer 3297 79A6 05C3 INCT R3 Point at link 3298 79A8 06A0 BL @GET1 Get the name link 79AA 6C9E 3299 79AC C141 MOV R1,R5 Save and set condition 3300 79AE 130E JEQ RESGPL End of call list? Yes 3301 79B0 16CF JNE RES03 No, go check the next in list 3302 79B2 C0C6 RES20 MOV R6,R3 Get next entry in subpgm table 3303 79B4 05C3 INCT R3 Point at the link 3304 79B6 06A0 BL @GET1 Get the link 79B8 6C9E 3305 79BA C181 MOV R1,R6 Update subprogram table pointe 3306 79BC 10CB JMP RES05 And try next entry 3307 79BE 04C3 RES50 CLR R3 Indicate no error return 3308 79C0 C2D9 RES51 MOV *R9,R11 Restore return address 3309 79C2 0649 DECT R9 Restore stack 3310 79C4 045B RT All resolved and ok 3311 79C6 0203 RES52 LI R3,>001C 79C8 001C 3312 79CA 10FA JMP RES51 3313 ************************************************************ 3314 * RESGPL routine 3315 * Resolves as a GPL subprogram by comparing names in CALL 3316 * list and GROM link list in EXEC. If name found in GROM 3317 * then turn the resolved flag on and if not found an error 3318 * occurs. Fetch subprogram access address from the link 3319 * list and builds a subprogram table for that call. 3320 ************************************************************ 3321 79CC C160 RESGPL MOV @CALIST,R5 Get the call list pointer 79CE 830A 3322 * Get the next subprogram in the call list that has not been 3323 * resolved. 3324 79D0 C0C5 GET01 MOV R5,R3 Get pointer in call list 3325 79D2 13F5 JEQ RES50 If end of list 3326 79D4 06A0 BL @GETV1 Get the resolved flag 79D6 1880 3327 79D8 1306 JEQ GPL00 If not resolved 3328 79DA 05C3 GET03 INCT R3 Point at link 3329 79DC 06A0 BL @GET1 Get the link 79DE 6C9E 3330 79E0 C141 MOV R1,R5 Save it and set condition 3331 79E2 16F6 JNE GET01 If not end of list, go on 3332 79E4 10EC JMP RES50 Return 3333 * Start looking at GROM subprogram link list. 3334 79E6 0207 GPL00 LI R7,GPLIST Load address of link list 79E8 A026 99/4 ASSEMBLER SUBPROGS2 PAGE 0077 3335 79EA C0C5 MOV R5,R3 Copy CALIST address 3336 79EC 0583 INC R3 Point to name length 3337 79EE 06A0 BL @GETV1 Get the name length 79F0 1880 3338 79F2 0981 SRL R1,8 Adjust to the right byte 3339 79F4 C001 MOV R1,R0 Copy for later use 3340 79F6 04CA CLR R10 Clear for name length 3341 79F8 0223 AI R3,3 Point to name ptr in call list 79FA 0003 3342 79FC DB47 GPL10 MOVB R7,@GRMWAX(R13) Specify address in link list 79FE 0402 3343 7A00 06C7 SWPB R7 Need to kill time here 3344 7A02 DB47 MOVB R7,@GRMWAX(R13) Move next byte 7A04 0402 3345 7A06 06C7 SWPB R7 Get R7 in right order 3346 7A08 D21D MOVB *R13,R8 Read next link address from 3347 7A0A D81D MOVB *R13,@R8LB linked list 7A0C 83F1 3348 7A0E 05C7 INCT R7 Point to name length in GROM 3349 7A10 DB47 MOVB R7,@GRMWAX(R13) Specify name length address 7A12 0402 3350 7A14 06C7 SWPB R7 Need to kill time here 3351 7A16 DB47 MOVB R7,@GRMWAX(R13) Move next byte 7A18 0402 3352 7A1A 06C7 SWPB R7 Get R7 in right order 3353 7A1C D81D MOVB *R13,@R10LB Get the name length in GROM 7A1E 83F5 3354 7A20 8280 C R0,R10 Compare name length 3355 7A22 1304 JEQ GPL25 If matches, compare names 3356 7A24 C1C8 GPLNXT MOV R8,R7 Didn't match, get link to next 3357 7A26 16EA JNE GPL10 Loop if not end of list 3358 7A28 C0C5 MOV R5,R3 If end of GPL list, ignore thi 3359 7A2A 10D7 JMP GET03 entry in CALIST 3360 * Start comparing the names 3361 7A2C 06A0 GPL25 BL @GET1 Get name ptr form call list 7A2E 6C9E 3362 * R1 contains address of name 3363 7A30 D7E0 MOVB @R1LB,*R15 Get one character from VDP 7A32 83E3 3364 7A34 1000 NOP 3365 7A36 D7C1 MOVB R1,*R15 Then compare with the one in 3366 7A38 981D GPL30 CB *R13,@XVDPRD GROM - R13 points to GROM 7A3A 8800 3367 7A3C 16F3 JNE GPLNXT If no match get next in GROM 3368 7A3E 060A DEC R10 All matched? 3369 7A40 16FB JNE GPL30 No, loop for next characters 3370 * Found the GPL subprogram. Now start building GPL's 3371 * subprogram table. 3372 * First put all information in FAC since they might get 3373 * destroyed in MEMCHK. 3374 * @FAC2 = Set program bit and name length 3375 * @FAC4 = Subprogram table link address 3376 * @FAC6 = Pointer to name 3377 * @FAC8 = Access address in GROM 3378 * @FAC10 = Current call list address 3379 7A42 020C LI R12,FAC2 Optimize for speed and space 7A44 834C 3380 7A46 C700 MOV R0,*R12 Keep length in FAC2 3381 7A48 EF20 SOC @FNCFLG,*R12+ Set program bit 99/4 ASSEMBLER SUBPROGS2 PAGE 0078 7A4A 7506 3382 7A4C CF20 MOV @SUBTAB,*R12+ Set up subtable link address 7A4E 833A 3383 7A50 06A0 BL @GET1 Get pointer to name 7A52 6C9E 3384 7A54 CF01 MOV R1,*R12+ Move it to FAC6 3385 7A56 DF1D MOVB *R13,*R12+ Get access address from GROM 3386 7A58 1000 NOP 3387 7A5A DF1D MOVB *R13,*R12+ and put it in FAC8 3388 7A5C C705 MOV R5,*R12 Save current call list address 3389 * Check if ERAM exists or imperative statement. If so then 3390 * copy name into appropriate VDP area. 3391 7A5E D1A0 MOVB @RAMFLG,R6 ERAM present? 7A60 8389 3392 7A62 1603 JNE GPL40 Yes, then save name in table 3393 7A64 D1A0 MOVB @PRGFLG,R6 Imperative call 7A66 8344 3394 7A68 1619 JNE GPL60 No, handle normally 3395 * Copy name into table area 3396 7A6A C800 GPL40 MOV R0,@FAC Copy name length 7A6C 834A 3397 7A6E 06A0 BL @MEMCHK Get the space. FAC = name leng 7A70 72D8 3398 7A72 79C6 DATA RES52 Error return address 3399 7A74 C0E0 MOV @FAC6,R3 Get pointer to name 7A76 8350 3400 7A78 6820 S @FAC,@FREPTR New free pointer 7A7A 834A 7A7C 8340 3401 7A7E C120 MOV @FREPTR,R4 New place of name 7A80 8340 3402 7A82 0584 INC R4 3403 7A84 C804 MOV R4,@FAC6 New pointer to name 7A86 8350 3404 7A88 C0A0 MOV @FAC,R2 Counter for the move 7A8A 834A 3405 * Now copy the name, character by character 3406 7A8C 06A0 GPL50 BL @GETV1 Get a byte 7A8E 1880 3407 7A90 06A0 BL @PUTV1 Put a byte 7A92 6422 3408 7A94 0583 INC R3 3409 7A96 0584 INC R4 3410 7A98 0602 DEC R2 Done? 3411 7A9A 16F8 JNE GPL50 No, move the rest 3412 * Restore all the information from FAC area and build 3413 * subprograms symbol table. 3414 7A9C C820 GPL60 MOV @C8,@FAC Need 8 bytes 7A9E 706C 7AA0 834A 3415 7AA2 06A0 BL @MEMCHK Get the bytes. Check the space 7AA4 72D8 3416 7AA6 79C6 DATA RES52 Error return address 3417 7AA8 6820 S @C8,@FREPTR Updata the free pointer 7AAA 706C 7AAC 8340 3418 7AAE C020 MOV @FREPTR,R0 Get location to move to 7AB0 8340 3419 7AB2 0580 INC R0 True pointer 99/4 ASSEMBLER SUBPROGS2 PAGE 0079 3420 7AB4 C800 MOV R0,@SUBTAB Update subprogram table ptr 7AB6 833A 3421 7AB8 0201 LI R1,FAC2 Subprograms info starts FAC2 7ABA 834C 3422 7ABC D7E0 MOVB @R0LB,*R15 Load out address 7ABE 83E1 3423 7AC0 0260 ORI R0,WRVDP Enable VDP write 7AC2 4000 3424 7AC4 D7C0 MOVB R0,*R15 3425 7AC6 0200 LI R0,XVDPWD Optimize to save bytes 7AC8 8C00 3426 7ACA 0203 LI R3,8 Going to move 8 bytes 7ACC 0008 3427 7ACE D431 GPL70 MOVB *R1+,*R0 Copy mode, name length, link, 3428 7AD0 0603 DEC R3 ptr to name, ptr to subprogra 3429 7AD2 16FD JNE GPL70 3430 7AD4 C0D1 MOV *R1,R3 Restore ptr into call list 3431 7AD6 0460 B @GET03 Check next entry in call list 7AD8 79DA 3432 ************************************************************ 3433 7ADA AORG >7ADA 3435 3436 0005 FLG EQU 5 3437 3438 * R12 total number of bytes to move 3439 * R10 move from 3440 * R9 move to 3441 * R8 minor counter (buffer counter) 3442 * R7 buffer pointer 3443 3444 7ADA 020C SCROLL LI R12,736 Going to move 736 bytes 7ADC 02E0 3445 7ADE 020A LI R10,32 Address to move from 7AE0 0020 3446 7AE2 04C9 CLR R9 Address to move to 3447 7AE4 C18B MOV R11,R6 Save return address 3448 7AE6 06A0 BL @SCRO1 Scroll the screen 7AE8 7B10 3449 7AEA 0205 LI R5,XVDPWD Optimize for speed later 7AEC 8C00 3450 7AEE 0204 LI R4,>02E0 Addr of bottom line on screen 7AF0 02E0 3451 7AF2 0201 LI R1,>7F80 Edge character and space char 7AF4 7F80 3452 7AF6 0202 LI R2,28 28 characters on bottom line 7AF8 001C 3453 7AFA 06A0 BL @PUTV1 Init VDP & put out 1st edge ch 7AFC 6422 3454 7AFE D541 MOVB R1,*R5 Put out 2nd edge character 3455 7B00 06C1 SWPB R1 Bare the space character 3456 7B02 D541 SCRBOT MOVB R1,*R5 Write out space character 3457 7B04 0602 DEC R2 One less to move 3458 7B06 16FD JNE SCRBOT Loop if more 3459 7B08 06C1 SWPB R1 Bare the edge character again 3460 7B0A D541 MOVB R1,*R5 Output edge character 3461 7B0C D541 MOVB R1,*R5 Output edge character 3462 7B0E 0456 B *R6 And return go GPL 3463 * Generalized move routine 3464 7B10 04C8 SCRO1 CLR R8 Clear minor counter 99/4 ASSEMBLER SCROLLS PAGE 0080 3465 7B12 D7E0 MOVB @R10LB,*R15 Write out LSB of read-address 7B14 83F5 3466 7B16 02A7 STWP R7 Get the WorkSpace pointer 3467 7B18 D7CA MOVB R10,*R15 Write out MSB of read-address 3468 7B1A DDE0 SCRO2 MOVB @XVDPRD,*R7+ Read a byte 7B1C 8800 3469 7B1E 058A INC R10 Inc read-from address 3470 7B20 0588 INC R8 Inc minor counter 3471 7B22 060C DEC R12 Dec total counter 3472 7B24 1303 JEQ SCRO4 If all bytes read-write them 3473 7B26 0288 CI R8,12 Filled WorkSpace buffer area? 7B28 000C 3474 7B2A 11F7 JLT SCRO2 No, read more 3475 7B2C D7E0 SCRO4 MOVB @R9LB,*R15 Write LSB of write-address 7B2E 83F3 3476 7B30 0269 ORI R9,WRVDP Enable the VDP write 7B32 4000 3477 7B34 D7C9 MOVB R9,*R15 Write MSB of write-address 3478 7B36 02A7 STWP R7 Get WorkSpace buffer pointer 3479 7B38 D837 SCRO6 MOVB *R7+,@XVDPWD Write a byte 7B3A 8C00 3480 7B3C 0589 INC R9 Increment write-address 3481 7B3E 0608 DEC R8 Decrement counter 3482 7B40 16FB JNE SCRO6 Move more if not done 3483 7B42 C30C MOV R12,R12 More on major counter? 3484 7B44 16E5 JNE SCRO1 No, go do another read 3485 7B46 045B RT Yes, done 3486 ************************************************************ 3487 * Decode which I/O utility is being called 3488 * Tag field following the XML IO has the following 3489 * meaning: 3490 * 0 - Line list - utility to search keyword table to 3491 * restore keyword from token 3492 * 1 - Fill space - utility to fill record with space 3493 * when outputting imcomplete records 3494 * 2 - Copy string - utility to copy a string, adding 3495 * the screen offset to each character for display 3496 * purposes 3497 * 3 - Clear ERAM - utility to clear ERAM at the address 3498 * specified by the data word following the IO tag 3499 * and the # of bytes specified by the length 3500 * following the address word. Note that each data 3501 * word is the address of a CPU memory location. 3502 ************************************************************ 3503 7B48 D01D IO MOVB *R13,R0 Read selector from GROM 3504 7B4A 0980 SRL R0,8 Shift for decoding 3505 7B4C 1358 JEQ LLIST 0 is tag for Line list 3506 7B4E 0600 DEC R0 3507 7B50 132C JEQ FILSPC 1 is tag for Fill space 3508 7B52 0600 DEC R0 3509 7B54 130E JEQ CSTRIN 2 is tag for Copy string 3510 * 3 is tag for CLRGRM string 3511 * fall into it 3512 * CALGRM 3513 * R1 - address of clearing start 3514 * R2 - number of bytes to clear 3515 7B56 0201 CLRGRM LI R1,PAD Get CPU RAM offset 7B58 8300 3516 7B5A C081 MOV R1,R2 Need for next read too 99/4 ASSEMBLER SCROLLS PAGE 0081 3517 7B5C B81D AB *R13,@R1LB Add address of ERAM pointer 7B5E 83E3 3518 7B60 C051 MOV *R1,R1 Read the ERAM address 3519 7B62 B81D AB *R13,@R2LB Read address of byte count 7B64 83E5 3520 7B66 C092 MOV *R2,R2 Read the byte count 3521 7B68 04C0 CLR R0 Clear of clearing ERAM 3522 7B6A DC40 CLRGR1 MOVB R0,*R1+ Clear a byte 3523 7B6C 0602 DEC R2 One less to clear, done? 3524 7B6E 16FD JNE CLRGR1 No, loop for rest 3525 7B70 045B RT Yes, return 3526 * CSTRIN 3527 * R0 - PAD2 3528 * R1 - GETV/PUTV buffer 3529 * R3 - FAC4/GETV address 3530 * R5 - return address 3531 7B72 C14B CSTRIN MOV R11,R5 Save return address 3532 7B74 D020 MOVB @PAD2,R0 Get PAD2 7B76 8302 3533 7B78 1317 JEQ CSTR1O If no bytes to copy 3534 7B7A 0980 SRL R0,8 Shift to use as counter 3535 7B7C C120 MOV @CCPADR,R4 Get copy-to address 7B7E 8308 3536 7B80 C0E0 MOV @FAC4,R3 Get copy-from address 7B82 834E 3537 7B84 06A0 CSTRO5 BL @GETV1 Get byte 7B86 1880 3538 7B88 B060 AB @DSRFLG,R1 Add screen offset 7B8A 8317 3539 7B8C 06A0 BL @PUTV1 Put the offset byte out 7B8E 6422 3540 7B90 0583 INC R3 Increment from address 3541 7B92 0584 INC R4 Increment to address 3542 7B94 0600 DEC R0 One less to move 3543 7B96 16F6 JNE CSTRO5 Loop if not done 3544 7B98 C803 MOV R3,@FAC4 Restore for GPL 7B9A 834E 3545 7B9C D800 CSTR07 MOVB R0,@PAD2 Clear for GPL 7B9E 8302 3546 7BA3 CCBHFF EQU $+3 3547 7BA0 0244 ANDI R4,>BFFF Throw away VDP write enable 7BA2 BFFF 3548 7BA4 C804 MOV R4,@CCPADR Restore for GPL 7BA6 8308 3549 7BA8 FILSZ6 EQU $ 3550 7BA8 0455 CSTR1O B *R5 Return 3551 * FILSPC 3552 * R0 - PAD2 3553 * R1 - Buffer for GETV/PUTV 3554 * R2 - PAD3 3555 * R3 - Pointer for GETV 3556 * R4 - CCPADR, pointer for PUTV 3557 * R5 - return address 3558 7BAA C14B FILSPC MOV R11,R5 Save return address 3559 7BAC D0A0 MOVB @PAD3,R2 Get pointer to end of record 7BAE 8303 3560 7BB0 1604 JNE FILSZ1 If space to fill for sure 3561 7BB2 9802 CB R2,@CCPPTR Any filling to do? 7BB4 8306 99/4 ASSEMBLER SCROLLS PAGE 0082 3562 7BB6 1604 JNE FILSZ2 Yes, do it normalling 3563 7BB8 0455 B *R5 No, 255 record already full 3564 7BBA 9802 FILSZ1 CB R2,@CCPPTR Any filling to do? 7BBC 8306 3565 7BBE 12F4 JLE FILSZ6 No, record is complete 3566 7BC0 70A0 FILSZ2 SB @CCPPTR,R2 Compute # of bytes to change 7BC2 8306 3567 7BC4 B802 AB R2,@CCPPTR Point to end 7BC6 8306 3568 7BC8 D020 MOVB @DSRFLG,R0 Filling with zeroes? 7BCA 8317 3569 7BCC 160A JNE FILSZ3 No, fill with spaces 3570 7BCE C0E0 MOV @PABPTR,R3 Check if internal files 7BD0 8304 3571 7BD2 0223 AI R3,FLG 5 byte offset into PAB 7BD4 0005 3572 7BD6 04C1 CLR R1 Initialize to test below 3573 7BD8 06A0 BL @GETV1 Get byte from PAB 7BDA 1880 3574 7BDC 0241 ANDI R1,>0800 Internal? 7BDE 0800 3575 7BE0 1602 JNE FILSZ4 Yes, zero fill 3576 7BE2 0220 FILSZ3 AI R0,>2000 Add space character for filler 7BE4 2000 3577 7BE6 0982 FILSZ4 SRL R2,8 Shift count for looping 3578 7BE8 C120 MOV @CCPADR,R4 Get start address to fill 7BEA 8308 3579 7BEC D040 MOVB R0,R1 Put filler in place for PUTV 3580 7BEE 06A0 FILSZ5 BL @PUTV1 Put out a filler 7BF0 6422 3581 7BF2 0584 INC R4 Increment filler position 3582 7BF4 0602 DEC R2 One less to fill 3583 7BF6 16FB JNE FILSZ5 Loop if move 3584 7BF8 D802 MOVB R2,@PAD3 Restore for GPL 7BFA 8303 3585 7BFC 10CF JMP CSTR07 3586 * LLIST 3587 * R0 - FAC - address of keytab in GROM 3588 * R1 - keyword length 3589 7BFE C30B LLIST MOV R11,R12 Save return address 3590 7C00 06A0 BL @PUTSTK Save GROM address 7C02 60F2 3591 7C04 C020 MOV @FAC,R0 Get address of keytab 7C06 834A 3592 7C08 D220 MOVB @CHAT,R8 Get token to search for 7C0A 8342 3593 7C0C 0201 LI R1,1 Assume one character keyword 7C0E 0001 3594 7C10 DB40 LLISZ4 MOVB R0,@GRMWAX(R13) Load GROM address of table 7C12 0402 3595 7C14 DB60 MOVB @R0LB,@GRMWAX(R13) Both bytes 7C16 83E1 7C18 0402 3596 7C1A D0DD MOVB *R13,R3 Read address of x-char table 3597 7C1C D81D MOVB *R13,@R3LB Both bytes 7C1E 83E7 3598 7C20 A0C1 LLISZ5 A R1,R3 Add length of keyword to point 3599 * at token 3600 7C22 DB43 MOVB R3,@GRMWAX(R13) Write out new GROM address 99/4 ASSEMBLER SCROLLS PAGE 0083 7C24 0402 3601 7C26 DB60 MOVB @R3LB,@GRMWAX(R13) Which points to token 7C28 83E7 7C2A 0402 3602 7C2C D11D MOVB *R13,R4 Read token value 3603 7C2E D15D MOVB *R13,R5 Read possible end of x-char 3604 * table 3605 7C30 9204 CB R4,R8 Token value match? 3606 7C32 1307 JEQ LLISZ6 Yes!!! Found the keyword 3607 7C34 0583 INC R3 No, so skip token value 3608 7C36 9805 CB R5,@CCBHFF Reach end of x-char table? 7C38 7BA3 3609 7C3A 16F2 JNE LLISZ5 No, so check more in the table 3610 7C3C 05C0 INCT R0 Point into x+1 char table 3611 7C3E 0581 INC R1 Try x+1 char table 3612 7C40 10E7 JMP LLISZ4 Loop to check it 3613 * Come here when found keyword 3614 7C42 60C1 LLISZ6 S R1,R3 Subtract length to pnt at K.W. 3615 7C44 C803 MOV R3,@FAC8 Save ptr to KeyWord for GPL 7C46 8352 3616 7C48 C801 MOV R1,@FAC4 Save KeyWord length for GPL 7C4A 834E 3617 7C4C D808 MOVB R8,@FAC Save CHAT for GPL 7C4E 834A 3618 7C50 06A0 BL @GETSTK Restore GROM addres 7C52 610E 3619 7C54 045C B *R12 And return to GPL 3620 ************************************************************ 3621 7C56 AORG >7C56 3623 3624 0088 RETURZ EQU >88 3625 0089 DEFZ EQU >89 3626 008A DIMZ EQU >8A 3627 008B ENDZ EQU >8B 3628 008C FORZ EQU >8C 3629 0092 INPUTZ EQU >92 3630 0093 DATAZ EQU >93 3631 009A REMZ EQU >9A 3632 009B ONZ EQU >9B 3633 009D CALLZ EQU >9D 3634 009E OPTIOZ EQU >9E 3635 00A3 IMAGEZ EQU >A3 3636 00A7 SUBXTZ EQU >A7 3637 00A8 SUBNDZ EQU >A8 3638 00AA LINPUZ EQU >AA 3639 00B2 STEPZ EQU >B2 3640 00C7 NUMZ EQU >C7 3641 *----------------------------------------------------------- 3642 * Added for "NOPSCAN" feature 6/8/81 3643 0040 P1 EQU >40 @ 3644 0050 P2 EQU >50 P 3645 002B P3 EQU >2B + 3646 002D P4 EQU >2D - 3647 0070 P5 EQU >70 p 3648 03B7 PSCFG EQU >03B7 VDP temporary: PSCAN flag 3649 * >00 : no pscan 3650 * >FF : pscan 3651 *----------------------------------------------------------- 3652 99/4 ASSEMBLER SCANS PAGE 0084 3653 *----------------------------------------------------------- 3654 * SCAN routine is changed for implementing "NOPSCAN" 3655 * feature, 6/8/81 3656 * "!@P+" or "!@p+" is RESUME PSCAN 3657 * "!@P-" or "!@p-" is NO PSCAN 3658 *----------------------------------------------------------- 3659 * 3660 ************************************************************ 3661 * SCAN is the main looping structure of the prescan routine. 3662 * Takes care of scanning each statement in a line. Goes 3663 * back to GPL to scan the special cases (DEF, OPTION, DIM, 3664 * SUB, CALL, SUBEND, SUBEXIT) and also goes to GPL to enter 3665 * variables into the symbol table. All statements which are 3666 * not allowed to be imperative are checked directly without 3667 * goting to GPL. The NOCARE label is where a non-special 3668 * statement is scanned, looking for variables to enter them 3669 * into the symbol table. 3670 ************************************************************ 3671 7C56 D01D PSCAN MOVB *R13,R0 Read Scan code 3672 7C58 06A0 BL @PUTSTK Save GROM address 7C5A 60F2 3673 7C5C 06A0 BL @SETREG Set up R8/R9 with CHAT/SUBSTK 7C5E 1E7A 3674 * First decode the type of XML being executed 3675 * Types are: >00 - initial call with program 3676 * >01 - resume within a statement after call to 3677 * GPL for some reason 3678 * >02 - initial call for imperative statement 3679 7C60 0980 SRL R0,8 Set condition 3680 7C62 1305 JEQ SCAN05 If calling scan routine w/pgm 3681 7C64 0600 DEC R0 Returning from call to GPL? 3682 7C66 135D JEQ JNCARE Yes, continue w/in line 3683 7C68 C819 MOV *R9,@RTNADD 7C6A 8326 3684 7C6C 1050 JMP SCAN10 3685 7C6E A660 SCAN05 A @C3,*R9 Skip following XML and select 7C70 6544 3686 7C72 C819 MOV *R9,@RTNADD Set up rtn to common GPL loc 7C74 8326 3687 7C76 04E0 CLR @DATA Assume out of data 7C78 8334 3688 7C7A 8820 SCAN5A C @LINUM,@EXTRAM End of program yet? 7C7C 8312 7C7E 832E 3689 7C80 161B JNE SCAN07 No, get next line 3690 7C82 D020 SCAN5B MOVB @FORNET,R0 Check fornext counter 7C84 8317 3691 7C86 1655 JNE FNERR For/Next error 3692 7C88 D020 MOVB @XFLAG,R0 Check subprogram bits 7C8A 8316 3693 7C8D CBH40 EQU $+1 3694 7C8C 0A40 SLA R0,4 Subprogram encountered? 3695 7C8E 1108 JLT SCAN6A Yes, check subend 3696 7C90 0200 SCAN06 LI R0,>A000 Initialize data stack 7C92 A000 3697 7C94 D800 MOVB R0,@STACK 7C96 8373 3698 7C98 06A0 BL @RESOLV Resolve any subprogram refs 7C9A 7946 99/4 ASSEMBLER SCANS PAGE 0085 3699 7C9C 0460 B @GPL05 Return 7C9E 7E5E 3700 7CA0 0A40 SCAN6A SLA R0,4 Subend encountered? 3701 7CA2 1707 JNC ERRMS No, text ended w/out subend 3702 7CA4 0203 LI R3,TABSAV Get main symbol table's ptr 7CA6 0392 3703 7CA8 06A0 BL @GET1 Get it 7CAA 6C9E 3704 7CAC C801 MOV R1,@SYMTAB 7CAE 833E 3705 7CB0 10EF JMP SCAN06 Merge back in 3706 7CB2 0203 ERRMS LI R3,>18 * MISSING SUBEND 7CB4 0018 3707 7CB6 1076 JMP GPL05L 3708 7CB8 6820 SCAN07 S @C4,@EXTRAM Go to next line in program 7CBA 6A80 7CBC 832E 3709 7CBE D020 MOVB @RAMTOP,R0 ERAM program? 7CC0 8384 3710 7CC2 1604 JNE SCAN08 Yes, handle ERAM 3711 7CC4 06A0 BL @GET No, het new line pointer in VD 7CC6 6C9A 3712 7CC8 832E DATA EXTRAM 3713 7CCA 1003 JMP SCAN09 3714 7CCC 06A0 SCAN08 BL @GETG Get new line pointer from GRAM 7CCE 6CCA 3715 7CD0 832E DATA EXTRAM 3716 7CD2 C801 SCAN09 MOV R1,@PGMPTR Put new line pointer into perm 7CD4 832C 3717 7CD6 5820 SZCB @CBH40,@XFLAG Reset IFFLAG only on new line 7CD8 7C8D 7CDA 8316 3718 *----------------------------------------------------------- 3719 * Following is changed for adding "nopscan" feature 3720 * SCAN9A @PGMCHR Get 1st token on line 3721 7CDC 06A0 SCAN9A BL @PGMCHR Get 1st token on line 7CDE 6C74 3722 7CE0 0203 LI R3,PSCFG Check the flag to see which 7CE2 03B7 3723 * mode is in: NOPSCAN (>00) or PSCAN (>FF) 3724 7CE4 06A0 BL @GETV1 Get the flag from VDP 7CE6 1880 3725 7CE8 1348 JEQ NPSCAN NOPSCAN mode 3726 *----------------------------------------------------------- 3727 7CEA 5820 SZCB @CBH94,@XFLAG Reset ENTER, STRFLG, and FNCFL 7CEC 6005 7CEE 8316 3728 7CF0 D020 MOVB @XFLAG,R0 Get flag bits 7CF2 8316 3729 7CF4 0A80 SLA R0,8 Shift to check REMODE 3730 7CF6 170B JNC SCAN10 If not in REMODE 3731 7CF8 D208 MOVB R8,R8 Check if token 3732 7CFA 1103 JLT SCAN11 If token, look further 3733 7CFC 0203 ERRIBS LI R3,>1E * ILLEGAL BETWEEN SUBPROGRAMS 7CFE 001E 3734 7D00 1051 JMP GPL05L Goto error return 3735 7D02 0706 SCAN11 SETO R6 Set up index into table 3736 7D04 0586 SCAN12 INC R6 Increment to 1st/next element 3737 7D06 9988 CB R8,@IBSTAB(R6) legal stmt between subprogdams 99/4 ASSEMBLER SCANS PAGE 0086 7D08 7EA0 3738 7D0A 1BFC JH SCAN12 Not able to tell, check furthe 3739 7D0C 1AF7 JL ERRIBS Illegal statement here 3740 7D0E 04C6 SCAN10 CLR R6 Offset into special stmt table 3741 7D10 C0E6 SCAN15 MOV @SCNTAB(R6),R3 Read entry from special table 7D12 7E70 3742 7D14 9203 CB R3,R8 Match this token? 3743 7D16 1306 JEQ SCAN20 Yes, handle special case 3744 7D18 1B74 JH NOCARE Didn't match but passed in tab 3745 7D1A 05C6 INCT R6 Increment offset into table 3746 7D1C 0286 CI R6,TABLEN Reach end of table? 7D1E 0030 3747 7D20 16F7 JNE SCAN15 No, check further 3748 7D22 106F JNCARE JMP NOCARE End of table, not special case 3749 7D24 0A83 SCAN20 SLA R3,8 Look at special case byte 3750 7D26 1103 JLT SCGPL1 If MSB set, goto GPL 3751 7D28 06C3 SWPB R3 MSB reset, offset into 9900 3752 7D2A 0463 B @OFFSET(R3) Branch to 9900 special handler 7D2C 7D84 3753 7D2E 0460 SCGPL1 B @SCNGPL 7D30 7E58 3754 7D32 0460 FNERR B @FNNERR 7D34 7E4C 3755 *----------------------------------------------------------- 3756 * These are added for "nopscan" feature 6/8/81 3757 7D36 D020 SCAN26 MOVB @PRGFLG,R0 In program mode? 7D38 8344 3758 7D3A 13A3 JEQ SCAN5B No, check for/next subs&rtn 3759 7D3C 06A0 SCAN28 BL @PGMCHR Yes, check "!@P+" or "!@P-" 7D3E 6C74 3760 7D40 0288 CI R8,P1*256 "@" following "!"? 7D42 4000 3761 7D44 169A JNE SCAN5A No, goto the next line 3762 7D46 06A0 BL @PGMCHR Yes, check for "P" 7D48 6C74 3763 7D4A 0288 CI R8,P2*256 7D4C 5000 3764 7D4E 1303 JEQ SCAN40 Yes, check for "+" or "-" 3765 7D50 0288 CI R8,P5*256 No, try "p" 7D52 7000 3766 7D54 1692 JNE SCAN5A No, goto the next line 3767 7D56 06A0 SCAN40 BL @PGMCHR Yes, check for "+" or "-" 7D58 6C74 3768 7D5A 0288 CI R8,P3*256 7D5C 2B00 3769 7D5E 130A JEQ SCAN35 "!@P+" is found at the 3770 * beginnning of the line 3771 7D60 0288 CI R8,P4*256 7D62 2D00 3772 7D64 168A JNE SCAN5A Didn't file what we want, 3773 * goto the next line 3774 7D66 0201 LI R1,0 "!@P-" is found, set flag to 7D68 0000 3775 * 0 NO PSCAN 3776 7D6A 0204 SCAN30 LI R4,PSCFG Address register for PUTV1 7D6C 03B7 3777 7D6E 06A0 BL @PUTV1 Set the flag PSCFG in VDP tem. 7D70 6422 3778 7D72 1083 JMP SCAN5A Goto the next line 99/4 ASSEMBLER SCANS PAGE 0087 3779 7D74 0201 SCAN35 LI R1,>FF00 "!@P+", set flag to be >FF so 7D76 FF00 3780 * RESUME PSCAN 3781 7D78 10F8 JMP SCAN30 Use common code to set flag 3782 *----------------------------------------------------------- 3783 *----------------------------------------------------------- 3784 * In NOPSCAN mode, only looking for "!@P+", "!@P-" at the 3785 * beginning of each line 6/8/81 3786 7D7A 0288 NPSCAN CI R8,TREMZ*256 First token on line 7D7C 8300 3787 * is it "!" 3788 7D7E 13DE JEQ SCAN28 Yes, check "!@P+" or "!@P-" 3789 7D80 0460 B @SCAN5A No, ignore the whole line, 7D82 7C7A 3790 * just goto the next line 3791 *----------------------------------------------------------- 3792 OFFSET 3793 7D84 10D8 SCN26A JMP SCAN26 3794 7D86 D020 SCAN25 MOVB @PRGFLG,R0 In imperative mode? 7D88 8344 3795 7D8A 1302 JEQ SCAN5C Yes, check for/next sub & rtn 3796 7D8C 0460 B @SCAN5A No, check next line 7D8E 7C7A 3797 7D90 0460 SCAN5C B @SCAN5B 7D92 7C82 3798 * 9900 code special handlers 3799 7D94 F820 IFIF SOCB @CBH40,@XFLAG Indicate scan of "IF" stmt 7D96 7C8D 7D98 8316 3800 * Special handler for program-only statements 3801 7D9A D020 IMPER MOVB @PRGFLG,R0 Executing in a program? 7D9C 8344 3802 7D9E 1649 JNE NXTCHR Yes, proceed in don't char mod 3803 7DA0 0203 ERRIMP LI R3,>12 Illegal imperative return code 7DA2 0012 3804 7DA4 105C GPL05L JMP GPL05 Return to GPL with error 3805 * Special handler for data-statements 3806 7DA6 D020 DATA1 MOVB @DATA,R0 Data already encountered? 7DA8 8334 3807 7DAA 1606 JNE IMAGE Yes, don't set pointer 3808 7DAC C820 MOV @EXTRAM,@LNBUF Save line buffer pointer 7DAE 832E 7DB0 8336 3809 7DB2 C820 MOV @PGMPTR,@DATA Set line buffer pointer 7DB4 832C 7DB6 8334 3810 * Special handler for image-statements 3811 7DB8 D020 IMAGE MOVB @PRGFLG,R0 In program mode? 7DBA 8344 3812 7DBC 0460 B @SCAN5A Yes, no need to scan line 7DBE 7C7A 3813 7DC0 10EF JMP ERRIMP No, illegal imperative 3814 * Special handler for for-statements 3815 7DC2 05A0 FOR INC @XFLAG Increment the nesting counter 7DC4 8316 3816 7DC6 D020 MOVB @XFLAG,R0 Fetch the IFFLAG 7DC8 8316 3817 7DCA 0240 ANDI R0,>4000 Inside an if-statement? 7DCC 4000 99/4 ASSEMBLER SCANS PAGE 0088 3818 7DCE 1331 JEQ NXTCHR No, continue in don't care mod 3819 7DD0 0203 SNTXER LI R3,>1A * SYNTAX ERROR 7DD2 001A 3820 7DD4 1044 JMP GPL05 3821 * Special handler for next-statements 3822 7DD6 C020 SNEXT MOV @XFLAG,R0 Get flag and for-next counter 7DD8 8316 3823 7DDA 0240 ANDI R0,>40FF Get rid of flag bits except IF 7DDC 40FF 3824 7DDE D000 MOVB R0,R0 IFFLAG set? 3825 7DE0 16F7 JNE SNTXER Yes, syntax error 3826 7DE2 0600 DEC R0 Decrement counter by one 3827 7DE4 D820 MOVB @R0LB,@FORNET Move back to the real conter 7DE6 83E1 7DE8 8317 3828 7DEA 1323 JEQ NXTCHR Returning to top level, ok 3829 7DEC 1522 JGT NXTCHR Still at a secndary level, ok 3830 7DEE 0203 LI R3,>14 For/next nesting return code 7DF0 0014 3831 7DF2 1035 JMP GPL05 Return to GPL with error 3832 7DF4 D020 ELSE MOVB @XFLAG,R0 Get flag byte 7DF6 8316 3833 7DF8 0240 ANDI R0,>4000 Inside an if? 7DFA 4000 3834 7DFC 13E9 JEQ SNTXER No, error 3835 * Special handler for statement seperator 3836 7DFE 0460 SEPSMT B @SCAN9A Skip the '::' and check next 7E00 7CDC 3837 * General don't care scan. Simply looks for variables to 3838 * enter into symbol table; stops on end of statement 3839 7E02 0288 NOCARE CI R8,SSEPZ*256 At a statement separator 7E04 8200 3840 7E06 13FB JEQ SEPSMT Skip and scan next statement 3841 7E08 0288 CI R8,TREMZ*256 At a tail remark? 7E0A 8300 3842 7E0C 13BC JEQ SCAN25 Yes, check mode 3843 7E0E D208 MOVB R8,R8 At an end-of-line or symbol? 3844 7E10 13BA JEQ SCAN25 EOL, checK mode 3845 7E12 151F JGT ENTER Symbol, ENTER in symbol table 3846 7E14 0288 CI R8,LNZ*256 Special line number token? 7E16 C900 3847 7E18 130F JEQ SKIPLN Yes, need to skip it 3848 7E1A 0288 CI R8,NUMZ*256 Special numeric token? 7E1C C700 3849 7E1E 130F JEQ STRSKP Yes, need to skip it 3850 7E20 0288 CI R8,UNQSTZ*256 Special string token? 7E22 C800 3851 7E24 130C JEQ STRSKP Yes, need to skip it 3852 7E26 0288 CI R8,THENZ*256 Hit a then-clause? 7E28 B000 3853 7E2A 13E4 JEQ ELSE Yes, treat like a stmt-sep 3854 7E2C 0288 CI R8,ELSEZ*256 Hit a else-clause? 7E2E 8100 3855 7E30 13E1 JEQ ELSE Yes, t[eat liek a stmt-sep 3856 7E32 06A0 NXTCHR BL @PGMCHR Get next token 7E34 6C74 3857 7E36 10E5 JMP NOCARE And continue loop 3858 7E38 05E0 SKIPLN INCT @PGMPTR Skip line number 7E3A 832C 99/4 ASSEMBLER SCANS PAGE 0089 3859 7E3C 10FA JMP NXTCHR And get next token 3860 7E3E 06A0 STRSKP BL @PGMCHR Get length of string/number 7E40 6C74 3861 7E42 06C8 SWPB R8 Swap for add 3862 7E44 A808 A R8,@PGMPTR Skip the string of number 7E46 832C 3863 7E48 04C8 CLR R8 Clear LSB of character 3864 7E4A 10F3 JMP NXTCHR And get next token 3865 * Code to return to GPL to handle special case or an 3866 * end-of-line return 3867 7E4C 0203 FNNERR LI R3,>16 FOR/NEXT NESTING 7E4E 0016 3868 7E50 1006 JMP GPL05 3869 7E52 0203 ENTER LI R3,>10 Load return code for ENTER 7E54 0010 3870 7E56 1003 JMP GPL05 Goto GPL 3871 7E58 0243 SCNGPL ANDI R3,>7F00 Throw away GPL flag 7E5A 7F00 3872 7E5C 0983 SRL R3,8 Shift to use as index for rtn 3873 7E5E C660 GPL05 MOV @RTNADD,*R9 Make sure right GROM address 7E60 8326 3874 7E62 A643 A R3,*R9 Add offset to old GROM address 3875 7E64 06A0 BL @SAVREG Save R8/R9 in CHAT/SUBSTK 7E66 1E8C 3876 7E68 06A0 BL @GETSTK Restore old GROM address 7E6A 610E 3877 7E6C 0460 B @RESET Goto GPL w/condition reset 7E6E 006A 3878 ************************************************************ 3879 * Table of specially scanned statements 3880 * 2 bytes / special token 3881 * Byte 1 - token value 3882 * Byte 2 - "address" of special handler 3883 * If MSB set then GPL and rest is offset from 3884 * the XML that got us here 3885 * If MSB reset then 9900 code and is offset from 3886 * label OFFSET in this assembly of the special 3887 * case handler 3888 ************************************************************ 3889 7E70 81 SCNTAB BYTE ELSEZ,ELSE-OFFSET 7E71 70 3890 7E72 82 BYTE SSEPZ,SEPSMT-OFFSET 7E73 7A 3891 *----------------------------------------------------------- 3892 * Change the following line for searching for !@P- at the 3893 * beginning of line 3894 * BYTE TREMZ,SCAN25-OFFSET 3895 7E74 83 BYTE TREMZ,SCN26A-OFFSET 7E75 00 3896 *----------------------------------------------------------- 3897 7E76 84 BYTE IFZ,IFIF-OFFSET 7E77 10 3898 7E78 85 BYTE GOZ,IMPER-OFFSET 7E79 16 3899 7E7A 86 BYTE GOTOZ,IMPER-OFFSET 7E7B 16 3900 7E7C 87 BYTE GOSUBZ,IMPER-OFFSET 7E7D 16 3901 7E7E 88 BYTE RETURZ,IMPER-OFFSET 99/4 ASSEMBLER SCANS PAGE 0090 7E7F 16 3902 7E80 89 BYTE DEFZ,>82 7E81 82 3903 7E82 8A BYTE DIMZ,>84 7E83 84 3904 7E84 8C BYTE FORZ,FOR-OFFSET 7E85 3E 3905 7E86 92 BYTE INPUTZ,IMPER-OFFSET 7E87 16 3906 7E88 93 BYTE DATAZ,DATA1-OFFSET 7E89 22 3907 7E8A 96 BYTE NEXTZ,SNEXT-OFFSET 7E8B 52 3908 7E8C 9A BYTE REMZ,SCAN25-OFFSET 7E8D 02 3909 7E8E 9B BYTE ONZ,IMPER-OFFSET 7E8F 16 3910 7E90 9D BYTE CALLZ,>86 7E91 86 3911 7E92 9E BYTE OPTIOZ,>88 7E93 88 3912 7E94 A1 BYTE SUBZ,>8A 7E95 8A 3913 7E96 A3 BYTE IMAGEZ,IMAGE-OFFSET 7E97 34 3914 7E98 A7 BYTE SUBXTZ,>8C 7E99 8C 3915 7E9A A8 BYTE SUBNDZ,>8E 7E9B 8E 3916 7E9C AA BYTE LINPUZ,IMPER-OFFSET 7E9D 16 3917 7E9E B0 BYTE THENZ,ELSE-OFFSET 7E9F 70 3918 0030 TABLEN EQU $-SCNTAB 3919 7EA0 82 IBSTAB BYTE SSEPZ 3920 7EA1 83 BYTE TREMZ 3921 7EA2 8B BYTE ENDZ 3922 7EA3 9A BYTE REMZ 3923 7EA4 A1 BYTE SUBZ 3924 7EA5 FF BYTE >FF 3925 ************************************************************ 3926 7EA6 AORG >7EA6 3928 3929 * (RAM to RAM) 3930 * Read data from ERAM 3931 * @FAC10 : Source address on ERAM 3932 * @FAC14 : Destination address in CPU 3933 * Where the data stored after read from ERAM 3934 * @FAC12 : byte count 3935 7EA6 0203 GREAD1 LI R3,FAC12 # of bytes to move 7EA8 8356 3936 7EAA 0202 LI R2,FAC10 Source in ERAM 7EAC 8354 3937 7EAE 0201 LI R1,FAC14 Destination in CPU 7EB0 8358 3938 7EB2 1006 JMP GRZ1 Jump to common routine 3939 * Read data from ERAM to CPU 3940 * @FAC2 : Source address on ERAM 3941 * @FAC6 : Destination address in CPU 99/4 ASSEMBLER GREADS PAGE 0091 3942 * Where the data stored after read from ERAM 3943 * @FAC4 : byte count 3944 7EB4 0203 GREAD LI R3,FAC4 # of bytes to move 7EB6 834E 3945 7EB8 0202 LI R2,FAC2 Source in ERAM 7EBA 834C 3946 7EBC 0201 LI R1,FAC6 Destination in CPU 7EBE 8350 3947 * Common ERAM to CPU transfer routine 3948 7EC0 C112 GRZ1 MOV *R2,R4 3949 7EC2 DC74 GRZ2 MOVB *R4+,*R1+ Move byte from ERAM to CPU 3950 7EC4 0613 DEC *R3 One less to move, done? 3951 7EC6 16FD JNE GRZ2 No, copy the rest 3952 7EC8 045B RT 3953 ************************************************************ 3954 3955 7ECA AORG >7ECA 3957 3958 * (RAM to RAM) 3959 * Write the data whcih is stored in CPU to ERAM 3960 * @PAD2 : Destination address on ERAM where data is going 3961 * to be stored 3962 * @PADC : Soruce address on CPU where data stored 3963 * @PAD8 : byte count 3964 7ECA 0203 GWITE1 LI R3,PAD8 Count 7ECC 8308 3965 7ECE 0202 LI R2,PAD2 Destination 7ED0 8302 3966 7ED2 0201 LI R1,PADC Source 7ED4 830C 3967 7ED6 1006 JMP GWZ1 3968 * Write the data which is stored in CPU to ERAM 3969 * @FAC2 : Destination address on ERAM where data is going 3970 * to be stroed 3971 * @FAC6 : Source address on CPU where dta is stored 3972 * @FAC4 : byte count 3973 7ED8 0203 GWRITE LI R3,FAC4 Count 7EDA 834E 3974 7EDC 0202 LI R2,FAC2 Destination 7EDE 834C 3975 7EE0 0201 LI R1,FAC6 Source 7EE2 8350 3976 * Common routine to copy from CPU to ERAM 3977 7EE4 GWZ1 EQU $ 3978 7EE4 C112 MOV *R2,R4 Get distination address 3979 7EE6 C051 MOV *R1,R1 Get CPU RAM address 3980 7EE8 0221 AI R1,PAD Add in CPU offset 7EEA 8300 3981 7EEC DD31 GWZ2 MOVB *R1+,*R4+ Move a byte 3982 7EEE 0613 DEC *R3 One less to move, done? 3983 7EF0 16FD JNE GWZ2 No, more to move 3984 7EF2 045B RT 3985 ************************************************************ 3986 3987 7EF4 AORG >7EF4 3989 3990 * Delete the text in crunched program on VDP or ERAM 3991 * point to the line # (to be deleted) in the line # table 3992 * RAMTOP 0 if no ERAM 99/4 ASSEMBLER DELREPS PAGE 0092 3993 * ENLN Last location used by the line # table 3994 * STLN First location used by the line # table 3995 * 3996 3997 7EF4 C20B DELREP MOV R11,R8 Save return 3998 7EF6 05E0 INCT @EXTRAM Point to line ptr in table 7EF8 832E 3999 7EFA C0E0 MOV @EXTRAM,R3 Prepare to read it 7EFC 832E 4000 7EFE C1E0 MOV @RAMTOP,R7 Check ERAM flag & get in reg 7F00 8384 4001 7F02 1603 JNE DE01 ERAM, get from it 4002 7F04 06A0 BL @GET1 Get line ptr from VDP 7F06 6C9E 4003 7F08 1002 JMP DE02 4004 7F0A 06A0 DE01 BL @GETG2 Get line ptr from ERAM 7F0C 6CCE 4005 7F0E 0601 DE02 DEC R1 Point to line length 4006 7F10 C0C1 MOV R1,R3 Prepare to read length 4007 7F12 C241 MOV R1,R9 Save copy for use later 4008 7F14 C1C7 MOV R7,R7 Editing in ERAM? 4009 7F16 1603 JNE DE03 ERAM, get length from it 4010 7F18 06A0 BL @GETV1 Get line length from VDP 7F1A 1880 4011 7F1C 1001 JMP DE04 4012 7F1E D053 DE03 MOVB *R3,R1 4013 7F20 D081 DE04 MOVB R1,R2 Move text length for use 4014 7F22 0982 SRL R2,8 Need as a word 4015 7F24 0582 INC R2 Text length = length + length 4016 * byte 4017 7F26 C0E0 MOV @ENLN,R3 Get end of line # table 7F28 8332 4018 7F2A 0583 INC R3 Adjust for inside loop 4019 * UPDATE THE LINE # TABLE 4020 7F2C 0643 DEREA DECT R3 Point to line pointer 4021 7F2E C1C7 MOV R7,R7 Editing in ERAM? 4022 7F30 1603 JNE DE05 ERAM, read it as such 4023 7F32 06A0 BL @GET1 Get line pointer from VDP 7F34 6C9E 4024 7F36 1002 JMP DE06 4025 7F38 06A0 DE05 BL @GETG2 Get line pointer from ERAM 7F3A 6CCE 4026 7F3C C141 DE06 MOV R1,R5 Move for use 4027 7F3E 0605 DEC R5 Point to length byte 4028 7F40 8149 C R9,R5 Compare location of delete 4029 * line & this line 4030 7F42 1209 JLE DEREB This line won't move , 4031 * don't fix pointer 4032 7F44 A042 A R2,R1 Add distance to move to pointe 4033 7F46 C103 MOV R3,R4 Write it to same place 4034 7F48 C1C7 MOV R7,R7 Editing in ERAM? 4035 7F4A 1603 JNE DE10 Yes 4036 7F4C 06A0 BL @PUT1 Put back into line # table 7F4E 6CB2 4037 7F50 1002 JMP DEREB 4038 7F52 06A0 DE10 BL @PUTG2 Put back into line # table 7F54 6CD8 4039 7F56 0643 DEREB DECT R3 Point at the line # 4040 7F58 8803 C R3,@STLN At last line in table? 99/4 ASSEMBLER DELREPS PAGE 0093 7F5A 8330 4041 7F5C 16E7 JNE DEREA No, loop for more 4042 * UPDATA OF LINE # TABLE IS COMPLETE, NOW DELETE TEXT 4043 * R9 still contains pointer to length byte of text to delete 4044 * R2 still contains text length 4045 7F5E 0609 DEC R9 4046 7F60 C0C9 MOV R9,R3 4047 7F62 C149 MOV R9,R5 4048 7F64 A142 A R2,R5 Point to 1st token 4049 7F66 C043 MOV R3,R1 Save for later use 4050 7F68 6060 S @STLN,R1 VDP, calculate # of bytes to m 7F6A 8330 4051 7F6C 0581 INC R1 Correct offset by one 4052 7F6E 06A0 BL @MVDN2 Delete the text 7F70 7F8A 4053 * NOW SET UP POINTERS TO LINE TABLE 4054 7F72 0201 DE18 LI R1,EXTRAM Start with EXTRAM 7F74 832E 4055 7F76 AC42 A R2,*R1+ Update EXTRAM 4056 7F78 AC42 A R2,*R1+ Update STLN 4057 7F7A A442 A R2,*R1 Update ENLN 4058 7F7C 0458 B *R8 And return 4059 ************************************************************ 4060 7F7E AORG >7F7E 4062 4063 * (VDP to VDP) or (RAM to RAM) 4064 * WITHOUT ERAM : Move the contents in VDP RAM from a lower 4065 * address to a higher address avoiding a 4066 * possible over-write of data 4067 * >835C ARG : byte count 4068 * >8300 PAD : source address 4069 * >8306 PAD6 : destination address 4070 * WITH ERAM Same as above except moves ERAM to ERAM 4071 4072 7F7E C060 MVDN MOV @ARG,R1 Get byte count 7F80 835C 4073 7F82 C160 MOV @PAD6,R5 Get destination 7F84 8306 4074 7F86 C0E0 MOV @PAD,R3 Get source 7F88 8300 4075 7F8A C1E0 MVDN2 MOV @RAMTOP,R7 ERAM or VDP? 7F8C 8384 4076 7F8E 1612 JNE MV01 ERAM, so handle it 4077 7F90 1002 JMP MV05 VDP, so jump into loop 4078 7F92 0605 MVDN1 DEC R5 4079 7F94 0603 DEC R3 4080 7F96 MV05 EQU $ 4081 7F96 D7E0 MOVB @R3LB,*R15 Write out read address 7F98 83E7 4082 7F9A D7C3 MOVB R3,*R15 4083 7F9C D1E0 MOVB @XVDPRD,R7 Read a byte 7F9E 8800 4084 7FA0 D7E0 MOVB @R5LB,*R15 Write out write address 7FA2 83EB 4085 7FA4 0265 ORI R5,WRVDP Enable VDP write 7FA6 4000 4086 7FA8 D7C5 MOVB R5,*R15 4087 7FAA D807 MOVB R7,@XVDPWD Write the byte 7FAC 8C00 99/4 ASSEMBLER MVDNS PAGE 0094 4088 7FAE 0601 DEC R1 One less byte to move 4089 7FB0 16F0 JNE MVDN1 Loop if more to move 4090 7FB2 045B RT 4091 7FB4 MV01 EQU $ 4092 7FB4 D553 MVDNZ1 MOVB *R3,*R5 Move a byte 4093 7FB6 0603 DEC R3 Decrement destination 4094 7FB8 0605 DEC R5 Decrement source 4095 7FBA 0601 DEC R1 One less byte to move 4096 7FBC 16FB JNE MVDNZ1 Loop if more to move 4097 7FBE 045B RT 4098 ************************************************************ 4099 4100 7FC0 AORG >7FC0 4102 4103 * (VDP to RAM) >834C=FAC2,>8350=FAC6,>834E=FAC4 4104 * Move data from VDP to ERAM 4105 * @FAC2 : Source address where the data stored on VDP 4106 * @FAC6 : Destination address on ERAM 4107 * @FAC4 : byte count 4108 4109 7FC0 VGWITE EQU $ 4110 7FC0 D7E0 MOVB @FAC3,*R15 LSB of VDP address 7FC2 834D 4111 7FC4 C0A0 MOV @FAC6,R2 Address in ERAM 7FC6 8350 4112 7FC8 D7E0 MOVB @FAC2,*R15 MSB of VDP address 7FCA 834C 4113 7FCC 1000 NOP 4114 7FCE DCA0 VGZ1 MOVB @XVDPRD,*R2+ Move a byte 7FD0 8800 4115 7FD2 0620 DEC @FAC4 One less to move 7FD4 834E 4116 7FD6 16FB JNE VGZ1 If not done, loop for more 4117 7FD8 045B RT Return 4118 ************************************************************ 4119 4120 7FDA AORG >7FDA 4122 4123 * Move data from ERAM to VDP (RAM to VDP) 4124 * @FAC10 : Source address where the data stored on ERAM 4125 * @FAC14 : Destination address on VDP 4126 * @FAC12 : byte count 4127 4128 7FDA C0A0 GVWITE MOV @FAC14,R2 VDP address 7FDC 8358 4129 7FDE D7E0 MOVB @R2LB,*R15 LSB of VDP address 7FE0 83E5 4130 7FE2 0262 ORI R2,WRVDP Enable VDP write 7FE4 4000 4131 7FE6 D7C2 MOVB R2,*R15 MSB of VDP address 4132 7FE8 C0E0 MOV @FAC10,R3 ERAM address 7FEA 8354 4133 7FEC D833 GVZ1 MOVB *R3+,@XVDPWD Move a byte 7FEE 8C00 4134 7FF0 0620 DEC @FAC12 One less to move 7FF2 8356 4135 7FF4 16FB JNE GVZ1 If not done, loop for more 4136 7FF6 045B RT Return 4137 ************************************************************ 99/4 ASSEMBLER GVWITES PAGE 0095 4138 7FFA AORG >7FFA 4139 7FFA 04E0 PAGER CLR @>6000 * RESTORE PAGE ONE 7FFC 6000 4140 7FFE 0459 B *R9 4141 ************************************************************ 4142 4143 END 99/4 ASSEMBLER GVWITES PAGE 0096 ABSZ 00CB ANDZ 00BB ARG 835C ARG1 835D ARG10 8366 ARG2 835E ARG3 835F ARG4 8360 ARG8 8364 ARG9 8365 ARGT05 6B8E ARGT10 6B92 ARGT20 6B9A ARGTST 6B6E ASSG 6334 ASSG54 6360 ASSG55 6374 ASSG56 638A ASSG57 637E ASSG59 63B6 ASSG70 63CE ASSG75 63EA ASSG77 63F4 ASSG79 63F8 ASSG80 6388 ASSGNV 61AE ATNZZ 797C B9900 64F2 BASE 8343 BCON1 6E7E BCONT 6D12 BERMUV 623C BERMUW 70F6 BERR6 70F2 BERSNM 6EDE BERSYN 6EDA BEXC15 685C BIT2 62AB BLTST9 6D58 BMF 6DF2 BREAK 0007 BREAKZ 008E BRKFL 0001 BRKP1L 65D2 BRKPN1 6644 BRKPN2 663E BRKPNT 6636 BSO 6DF6 BSYNCH 6ED6 BUFLEV 8346 BYTE 830C C0 6548 C100 6008 C1000 600A C16 6BF8 C2 6000 C24 6464 C3 6544 C32 7196 C4 6A80 C40 6006 C6 618A C7 6002 C8 706C CALGPL 666C CALIST 830A CALL 750A CALL02 7532 CALL04 753A CALL06 754E CALLZ 009D CB3 6545 CBH40 7C8D CBH63 6D05 CBH65 65A7 CBH66 66F1 CBH67 68AB CBH69 6A9B CBH6A 6860 CBH7 6003 CBH94 6005 CBHA 6004 CBHFF 60D6 CCBH63 709F CCBH6A 70AF CCBHFF 7BA3 CCPADR 8308 CCPPTR 8306 CFI 12B8 CHAT 8342 CHRBUF 837D CIF 74AA CIF01 74E0 CIF02 74F0 CIFRT 7500 CLRGR1 7B6A CLRGRM 7B56 CNS 7016 CNSSEL 6070 COMM05 6D8C COMMAZ 00B3 COMMON 6D74 COMP03 73E8 COMP05 73F6 COMP10 7418 COMPCG 619C COMPCT 73D8 COMPTN 798A CONC 667E CONCAT 0008 CONT 64C8 CONT10 64D8 CONT15 64E6 CONTAD 7502 CONTG 64C4 CONTIN 65CC CONVRT 6E9E COSZZ 78B2 CPALNM 0022 CPALPH 0020 CPBRK 0040 CPDIG 0002 CPLOW 0001 CPMO 0010 CPNIL 0000 CPNUM 0004 CPOP 0008 CPSEP 0080 CPTBL 610C CPUL 0021 CPULNM 0023 CRNBUF 0820 CRNEND 08BE CRNSEL 6076 CRULST 83C0 CRUNCH 7B88 CSN01 11B2 CSTR05 6AFC CSTR07 7B9C CSTR10 6B00 CSTR1O 7BA8 CSTR20 6B1A CSTRIN 7B72 CSTRO5 7B84 CZ 831A DATA 8334 DATA1 7DA6 DATAZ 0093 DCBH6A 7709 DE01 7F0A DE02 7F0E DE03 7F1E DE04 7F20 DE05 7F38 DE06 7F3C DE10 7F52 DE18 7F72 DEFZ 0089 DELREP 7EF4 DEREA 7F2C DEREB 7F56 DIMZ 008A DIVIDE 6B62 DIVIZ 00C4 DSRFLG 8317 DTECT2 606A ELSE 7DF4 ELSEZ 0081 END 665E ENDZ 008B ENLN 8332 ENTER 7E52 EOL 65D6 EOLINE 6872 EOLNE1 687A EOSTM1 6870 EOSTMT 6862 EQUALS 6A8E EQZ 00BE ERR 6652 ERR1 62CE ERR1B 6738 ERR1C 67F0 ERR1CZ 69A4 ERR3 6304 ERR51 67F2 ERRBS 0503 ERRBV 6ECA ERRBV2 70FA ERRCDT 70FE ERRCO1 8323 ERRCOD 8322 ERREX 0403 ERRFN 71A6 ERRFNN 71AC ERRIAL 0E03 ERRIBS 7CFC ERRIMP 7DA0 ERRIOR 0203 ERRLN 038A ERRLNF 0303 ERRMEM 7368 ERRMS 7CB2 ERRMUV 6970 ERROLP 1103 ERROM 0103 ERRONE 664E ERROR 0005 ERRORZ 00A5 ERRREC 0F03 ERRSN 0003 ERRSN1 6ECE ERRSND 1203 ERRSNM 6D5C ERRSO 6468 ERRSY1 6ED2 ERRSYN 664E ERRT 630C ERRTM 0603 ERRX 6308 EXC15L 65D0 EXEC10 650E EXEC11 6516 EXEC15 6542 EXEC16 6576 EXEC17 6588 EXEC20 658E EXEC50 6656 EXECG 6500 EXIT 6652 EXP 8376 EXPONZ 00C5 99/4 ASSEMBLER GVWITES PAGE 0097 EXPZZ 75CA EXRTN 65A6 EXRTN2 65AE EXRTN3 65C8 EXRTNA 6466 EXTRAM 832E EXTRM1 832F FAC 834A FAC1 834B FAC10 8354 FAC11 8355 FAC12 8356 FAC13 8357 FAC14 8358 FAC15 8359 FAC16 835A FAC2 834C FAC3 834D FAC33 836B FAC4 834E FAC5 834F FAC6 8350 FAC7 8351 FAC8 8352 FAC9 8353 FADD 0D80 FBS 15E0 FBS001 15E6 FBSYMB 618C FCOMP 0D3A FCOMPB 6126 FDIV 0FF4 FDVSR 8354 FDVSR1 8355 FDVSR2 8356 FDVSR8 835C FILSPC 7BAA FILSZ1 7BBA FILSZ2 7BC0 FILSZ3 7BE2 FILSZ4 7BE6 FILSZ5 7BEE FILSZ6 7BA8 FLAG 8345 FLG 0005 FLTERR 836C FLTNDX 8354 FLTONE 600E FMULT 0E88 FNCFLG 7506 FNERR 7D32 FNNERR 7E4C FOR 7DC2 FORNET 8317 FORZ 008C FPSIGN 03DC FREPTR 8340 FSUB 0D7C GDTECT 6050 GET 6C9A GET01 79D0 GET03 79DA GET1 6C9E GETCGR 60D0 GETCH 60AE GETCH1 60BC GETCH2 6FDE GETCHG 60C0 GETCHR 6FBA GETG 6CCA GETG2 6CCE GETL10 6764 GETL1Z 68DA GETNB 6FAC GETNB1 6FAE GETS10 73A2 GETSTG 61A2 GETSTK 610E GETSTR 736C GETV 187C GETV1 1880 GO 66D6 GOSUB 673A GOSUB2 673C GOSUBZ 0087 GOT32 677E GOT33 6792 GOT35 6798 GOTO 675C GOTO20 675E GOTO31 679C GOTO32 67A6 GOTO33 67BA GOTO34 67C8 GOTO35 67C4 GOTO36 67CE GOTO40 67DA GOTO50 67EA GOTO90 670A GOTO95 670E GOTOZ 0086 GOZ 0085 GPL00 79E6 GPL05 7E5E GPL05L 7DA4 GPL10 79FC GPL25 7A2C GPL30 7A38 GPL40 7A6A GPL50 7A8C GPL60 7A9C GPL70 7ACE GPLIST A026 GPLNXT 7A24 GPLSU 757E GREAD 7EB4 GREAD1 7EA6 GREATR 6A7E GRINT 79EC GRMRAX 0002 GRMWAX 0402 GRMWDX 0400 GRZ1 7EC0 GRZ2 7EC2 GTZ 00C0 GVWITE 7FDA GVZ1 7FEC GWITE1 7ECA GWRITE 7ED8 GWZ1 7EE4 GWZ2 7EEC H16 7156 IBSTAB 7EA0 IF 68A6 IFIF 7D94 IFZ 0084 IFZ10 68DE IFZ20 68FA IFZ25 6904 IFZ27 6910 IFZ28 691A IFZ30 6928 IFZ35 692E IFZ40 6934 IFZ5 68D0 IFZ50 693A IMAGE 7DB8 IMAGEZ 00A3 IMPER 7D9A INPUTZ 0092 INTRIN 8338 INUSE 7504 IO 7B48 JEQ1C 68EC JNCARE 7D22 JNE88 77BC JOYX 8377 JOYY 8376 KEYBRD 8375 KEYTAB CB00 LBCPMO 6146 LBLPZ 6F81 LEDEND 6B42 LEDERR 6B46 LEDEX 6B28 LEDLE 6A90 LENGTH 6FE2 LESS 6A70 LETCON 69A0 LEXP 6CE2 LFALSE 6AB8 LINPUZ 00AA LINUM 8312 LLC 0020 LLIST 7BFE LLISZ4 7C10 LLISZ5 7C20 LLISZ6 7C42 LNBUF 8336 LNZ 00C9 LOGZZ 76C2 LPAR 6F6C LPARZ 00B7 LSUBP 8348 LT10 6A82 LT15 6A88 LTAB 6A54 LTBLEN 001C LTRUE 6ABE LTST01 6A92 LTST15 6AB0 LTST20 6AE0 LTST90 6AC2 LTSTAB 6ADA LTSTEQ 6AB6 LTSTGE 6AB4 LTSTGT 6AD6 LTSTLE 6AD0 LTSTLT 6AD2 LTSTNE 6ABC LTSTXX 6AB4 LWCNS 6000 MEMC03 731C MEMC04 732C MEMC05 7334 MEMC06 735A MEMC08 7360 MEMCHG 72CE MEMCHK 72D8 MEMERR 7364 MINUS 6B4A MINUSZ 00C2 MOTION 837A MOVF1 6452 MOVFA2 645A MOVFAC 6434 MV01 7FB4 MV05 7F96 MVDN 7F7E MVDN1 7F92 MVDN2 7F8A MVDNZ1 7FB4 MVUP 6F98 MVUP05 6FA4 NABS 6CFA NATN 6D16 NCOS 6D1C NEGPAD 7D00 NEXP 6D22 NEXT 0070 NEXT2 7234 NEXT2A 7228 99/4 ASSEMBLER GVWITES PAGE 0098 NEXT2B 7224 NEXT4 721C NEXT5 72A0 NEXT6 72C8 NEXT8 72C4 NEXTZ 0096 NFOR 7000 NFOR03 7162 NFOR05 716C NFOR07 7170 NFOR09 7174 NFOR1 7006 NFOR10 717E NFOR11 71B4 NFOR12 71DE NFOR13 71EA NFOR1A 702E NFOR1B 7050 NFOR1C 705C NFOR1D 707E NFOR1E 7084 NFOR1F 706E NFOR2 7102 NFOR20 71C2 NFOR3 7110 NFOR30 71CC NINT 6D28 NLET 6948 NLET05 694C NLET10 6978 NLET15 6982 NLOG 6D2E NLPR 6E68 NMIN10 6E8C NMINUS 6E82 NNEXT 7230 NOCARE 7E02 NOLED 664E NOLEDL 64FA NONUD 664E NOTZ 00BD NPLUS 6E96 NPSCAN 7D7A NSGN 6D34 NSIN 6D64 NSQR 6D6A NSTR05 7478 NSTR10 748A NSTR15 7494 NSTR20 749C NSTRCN 7442 NTAB 69FE NTABLN 0056 NTAN 6D70 NUDE10 64F4 NUDEND 65F0 NUDG05 64B0 NUDND1 65E6 NUDND2 65F4 NUDND3 6602 NUDND4 660A NUDNDL 64FE NUDTAB 8328 NUMC49 66A6 NUMCHK 6B92 NUMCON 6684 NUMZ 00C7 NXTCHR 7E32 O0AND 6DFA O0AND1 6E0E O0AND2 6E14 O0NOT 6E2E O0OR 6E1C O0XOR 6E50 OEZ 8314 OFFSET 7D84 ON 66DA ON20 6710 ON30 671A ON40 6726 ON50 6730 ONBRK 66D0 ONERR 66C4 ONWARN 66CA ONZ 009B OPTIOZ 009E ORZ 00BA OVEXP 0FC2 P05 648A P1 0040 P10 6492 P17 64A8 P17L 64C2 P2 0050 P3 002B P4 002D P5 0070 PABPTR 8304 PAD 8300 PAD1 8301 PAD2 8302 PAD3 8303 PAD6 8306 PAD8 8308 PADC 830C PAGE1 6000 PAGE2 6002 PAGER 7FFA PAGSEL 607A PARCOM 6F74 PARSE 6480 PARSEG 6470 PGMC10 6C8E PGMCH 6410 PGMCHR 6C74 PGMPT1 832D PGMPTR 832C PGMSUB 6C7A PLAYER 8374 PLUS 6B1E PLUSZ 00C1 POPSTK 60D4 PRGFLG 8344 PROAZ 8310 PSCAN 7C56 PSCFG 03B7 PSHPRS 6B9C PSYM 6884 PUT1 6CB2 PUTCHR 7F6E PUTG2 6CD8 PUTSTK 60F2 PUTV 641E PUTV1 6422 PWARN 6DBC PWRZZ 7492 PZ 8312 QZ 8316 R0 0000 R0LB 83E1 R1 0001 R10 000A R10LB 83F5 R11 000B R11LB 83F7 R12 000C R12LB 83F9 R13 000D R13LB 83FB R14 000E R14LB 83FD R15 000F R15LB 83FF R1LB 83E3 R2 0002 R2LB 83E5 R3 0003 R3LB 83E7 R4 0004 R4LB 83E9 R5 0005 R5LB 83EB R6 0006 R6LB 83ED R7 0007 R7LB 83EF R8 0008 R8LB 83F1 R9 0009 R9LB 83F3 RAMFLG 8389 RAMPTR 830A RAMTOP 8384 RAND16 83D4 RANDOM 8378 RANERR 6F64 RANGE 6F30 REMZ 009A RES03 7950 RES05 7954 RES15 79A4 RES20 79B2 RES50 79BE RES51 79C0 RES52 79C6 RESET 006A RESGPL 79CC RESOLV 7946 RETRN 6DEC RETU30 6822 RETU40 6838 RETURN 67F8 RETURZ 0088 ROLIN 7AC4 ROLOUT 7A90 ROUNU 0FB2 ROUNUP 0F64 RPARZ 00B6 RTNADD 8326 RTNG 6630 SADD 0D84 SADDR 83D2 SAVEG 83CB SAVRE2 1E90 SAVREG 1E8C SBXT05 78DE SCAL01 75A0 SCAL05 75DE SCAL06 75E8 SCAL08 75F4 SCAL10 762A SCAL12 7640 SCAL14 7656 SCAL15 765A SCAL16 7666 SCAL23 76BC SCAL24 76CC SCAL26 76EC SCAL30 7648 SCAL32 7644 SCAL34 764C SCAL35 7650 SCAL37 7654 SCAL40 76F2 SCAL42 7700 SCAL50 7744 SCAL54 777E SCAL60 77B4 SCAL62 77B8 SCAL70 783A SCAL80 787E SCAL81 78A0 99/4 ASSEMBLER GVWITES PAGE 0099 SCAL82 78C0 SCAL84 78B8 SCAL86 78D0 SCAL88 7878 SCAL89 75D4 SCAL90 75CE SCAL91 75D8 SCAL93 75DC SCAL98 793E SCAN05 7C6E SCAN06 7C90 SCAN07 7CB8 SCAN08 7CCC SCAN09 7CD2 SCAN10 7D0E SCAN11 7D02 SCAN12 7D04 SCAN15 7D10 SCAN20 7D24 SCAN25 7D86 SCAN26 7D36 SCAN28 7D3C SCAN30 7D6A SCAN35 7D74 SCAN40 7D56 SCAN5A 7C7A SCAN5B 7C82 SCAN5C 7D90 SCAN6A 7CA0 SCAN9A 7CDC SCGPL1 7D2E SCLEN 8355 SCN26A 7D84 SCNGPL 7E58 SCNTAB 7E70 SCOMPB 0D42 SCRBOT 7B02 SCRO1 7B10 SCRO2 7B1A SCRO4 7B2C SCRO6 7B38 SCROLL 7ADA SDIV 0FF8 SEETW2 6F02 SEETW4 6F0A SEETW6 6F26 SEETW8 6F2A SEETWO 6EF0 SEPSMT 7DFE SET 6192 SETREG 1E7A SGNZ 00D1 SHRFLG 7508 SIGN 8375 SINZZ 78C0 SKIPLN 7E38 SKPLN 662A SKPS01 6624 SKPSTR 6618 SMB 61DC SMB02 6202 SMB04 6210 SMB05 6214 SMB06 622C SMB08 6232 SMB51 6246 SMB57 6268 SMB71 62FC SMBB 61A8 SMBB10 61BE SMBO10 6236 SMBO20 626E SMBO25 6274 SMBO40 62B6 SMBO41 62B8 SMBO50 6240 SMBO70 62D2 SMBO71 62F6 SMTSEP 65C4 SMTSRT 831E SMULT 0E8C SNEXT 7DD6 SNTXER 7DD0 SPEED 6EE2 SQRZZ 783A SREF 831C SSEPZ 0082 SSUB 0D74 STACK 8373 STATUS 837C STCOD2 6981 STCODE 6188 STEPZ 00B2 STKADD 8373 STKCHK 6DC0 STKDAT 8372 STKEND 83BA STKMOV 60E8 STKRTN 6DF0 STLN 8330 STMTTB 69FC STND12 83AE STOP 665E STREND 831A STRINZ 00C7 STRSKP 7E3E STRSP 8318 STVDP 18AE STVDP3 18AA STVSPT 8324 SUBNDZ 00A8 SUBTAB 833A SUBXIT 78D2 SUBXTZ 00A7 SUBZ 00A1 SYM 6312 SYM1 6320 SYMB 61B4 SYMB10 68A2 SYMB20 687C SYMBOL 0376 SYMTA1 833F SYMTAB 833E SYNCHK 6400 SYNERR 6D60 TABLEN 0030 TABSAV 0392 TANZZ 7940 TEMP2 Spoiler 99/4 ASSEMBLER CRUNCHS PAGE 0001 0001 ************************************************************ 0003 0004 74AA CIF EQU >74AA * GROM ADDRESS'S 0005 750A CALL EQU >750A * 0006 73D8 COMPCT EQU >73D8 * 0007 7EF4 DELREP EQU >7EF4 * 0008 736C GETSTR EQU >736C * 0009 7EB4 GREAD EQU >7EB4 * 0010 7EA6 GREAD1 EQU >7EA6 * 0011 7FDA GVWITE EQU >7FDA * 0012 7ECA GWITE1 EQU >7ECA * 0013 7ED8 GWRITE EQU >7ED8 * 0014 7B48 IO EQU >7B48 * 0015 72CE MEMCHG EQU >72CE * 0016 72D8 MEMCHK EQU >72D8 * 0017 7F7E MVDN EQU >7F7E * 0018 7F8A MVDN2 EQU >7F8A * 0019 7000 NFOR EQU >7000 * 0020 7230 NNEXT EQU >7230 * 0021 7442 NSTRCN EQU >7442 * 0022 7C56 PSCAN EQU >7C56 * 0023 7946 RESOLV EQU >7946 * 0024 7ADA SCROLL EQU >7ADA * 0025 78D2 SUBXIT EQU >78D2 * 0026 7FC0 VGWITE EQU >7FC0 * 0027 * 0028 ************************************************************ 0030 0031 * 0032 6000 LWCNS EQU >6000 0033 * 0034 4000 WRVDP EQU >4000 Write enable for VDP 0035 8800 XVDPRD EQU >8800 Read VDP data 0036 8C00 XVDPWD EQU >8C00 Write VDP data 0037 9800 XGRMRD EQU >9800 Read GROM data 0038 0402 GRMWAX EQU >9C02->9800 Write GROM address 0039 0002 GRMRAX EQU >9802->9800 Read GROM address 0040 0400 GRMWDX EQU >9C00->9800 GROM write data 0041 * 0042 CB00 KEYTAB EQU >CB00 ADDRESS OF KEYWORD TABLE 0043 * 0044 7D00 NEGPAD EQU >7D00 0045 8300 PAD0 EQU >8300 0046 8301 PAD1 EQU >8301 0047 835F PAD5F EQU >835F 0048 83C2 PADC2 EQU >83C2 0049 * 0050 8300 VAR0 EQU >8300 0051 8302 MNUM EQU >8302 0052 8303 MNUM1 EQU >8303 0053 8304 PABPTR EQU >8304 0054 8306 CCPPTR EQU >8306 0055 8308 CCPADR EQU >8308 0056 830A RAMPTR EQU >830A 0057 830A CALIST EQU RAMPTR 0058 830C BYTE EQU >830C 0059 8310 PROAZ EQU >8310 0060 8310 VAR5 EQU PROAZ 0061 8312 PZ EQU >8312 99/4 ASSEMBLER EQUATES PAGE 0002 0062 8312 LINUM EQU PZ 0063 8314 OEZ EQU >8314 0064 8316 QZ EQU >8316 0065 8316 XFLAG EQU QZ 0066 8316 VAR9 EQU QZ 0067 8317 DSRFLG EQU >8317 0068 8317 FORNET EQU DSRFLG 0069 8318 STRSP EQU >8318 0070 831A CZ EQU >831A 0071 831A STREND EQU CZ 0072 831A WSM EQU CZ 0073 831C SREF EQU >831C * Temporary string pointer 0074 831C WSM2 EQU SREF * Temporary string pointer 0075 831E WSM4 EQU >831E * Start of current statement 0076 831E SMTSRT EQU WSM4 * Start of current statement 0077 8320 WSM6 EQU >8320 * Screen address 0078 8320 VARW EQU WSM6 * Screen address 0079 8321 VARW1 EQU >8321 0080 8322 ERRCOD EQU >8322 * Return error code from ALC 0081 8322 WSM8 EQU ERRCOD * Return error code from ALC 0082 8323 ERRCO1 EQU >8323 0083 8324 STVSPT EQU >8324 * Value-stack base 0084 8326 RTNADD EQU >8326 0085 8328 NUDTAB EQU >8328 0086 832A VARA EQU >832A * Ending display location 0087 832C PGMPTR EQU >832C * Program text pointer 0088 832D PGMPT1 EQU >832D 0089 832E EXTRAM EQU >832E * Line number table pointer 0090 832F EXTRM1 EQU >832F 0091 8330 STLN EQU >8330 * Start of line number table 0092 8332 ENLN EQU >8332 * End of line number table 0093 8334 DATA EQU >8334 * Data pointer for READ 0094 8336 LNBUF EQU >8336 * Line table pointer for READ 0095 8338 INTRIN EQU >8338 * Add of intrinsic poly constant 0096 833A SUBTAB EQU >833A * Subprogram symbol table 0097 833E SYMTAB EQU >833E * Symbol table pointer 0098 833F SYMTA1 EQU >833F 0099 8340 FREPTR EQU >8340 * Free space pointer 0100 8342 CHAT EQU >8342 * Current charater/token 0101 8343 BASE EQU >8343 * OPTION BASE value 0102 8344 PRGFLG EQU >8344 * Program/imperative flag 0103 8345 FLAG EQU >8345 * General 8-bit flag 0104 8346 BUFLEV EQU >8346 * Crunch-buffer destruction level 0105 8348 LSUBP EQU >8348 * Last subprogram block on stack 0106 834A FAC EQU >834A * Floating-point ACcurmulator 0107 834B FAC1 EQU >834B 0108 834C FAC2 EQU >834C 0109 834E FAC4 EQU >834E 0110 834F FAC5 EQU >834F 0111 8350 FAC6 EQU >8350 0112 8351 FAC7 EQU >8351 0113 8352 FAC8 EQU >8352 0114 8353 FAC9 EQU >8353 0115 8354 FAC10 EQU >8354 0116 8354 FLTNDX EQU FAC10 0117 8354 FDVSR EQU FAC10 0118 8355 FAC11 EQU >8355 0119 8355 SCLEN EQU FAC11 0120 8355 FDVSR1 EQU FAC11 99/4 ASSEMBLER EQUATES PAGE 0003 0121 8356 FAC12 EQU >8356 0122 8356 FDVSR2 EQU FAC12 0123 8357 FAC13 EQU >8357 0124 8358 FAC14 EQU >8358 0125 8359 FAC15 EQU >8359 0126 835A FAC16 EQU >835A 0127 835C FDVSR8 EQU >835C * Floating-point ARGument 0128 835C ARG EQU FDVSR8 * Floating-point ARGument 0129 835D ARG1 EQU >835D 0130 835E ARG2 EQU >835E 0131 835F ARG3 EQU >835F 0132 8360 ARG4 EQU >8360 0133 8364 ARG8 EQU >8364 0134 8365 ARG9 EQU >8365 0135 8366 ARG10 EQU >8366 0136 836B FAC33 EQU >836B 0137 836C TEMP2 EQU >836C 0138 836C FLTERR EQU TEMP2 0139 836D TYPE EQU >836D 0140 836E VSPTR EQU >836E * Value stack pointer 0141 836F VSPTR1 EQU >836F 0142 8372 STKDAT EQU >8372 0143 8373 STKADD EQU >8373 0144 8373 STACK EQU >8373 0145 8374 PLAYER EQU >8374 0146 8375 KEYBRD EQU >8375 0147 8375 SIGN EQU KEYBRD 0148 8376 JOYY EQU >8376 * Exponent in floating-point 0149 8376 EXP EQU JOYY 0150 8377 JOYX EQU >8377 0151 8378 RANDOM EQU >8378 0152 8379 TIME EQU >8379 0153 837A MOTION EQU >837A 0154 837B VDPSTS EQU >837B 0155 837C STATUS EQU >837C 0156 837D CHRBUF EQU >837D 0157 837E YPT EQU >837E 0158 837F XPT EQU >837F 0159 8389 RAMFLG EQU >8389 * ERAM flag 0160 83BA STKEND EQU >83BA 0161 83AE STND12 EQU STKEND-12 0162 83C0 CRULST EQU >83C0 0163 83CB SAVEG EQU >83CB 0164 83D2 SADDR EQU >83D2 0165 83D4 RAND16 EQU >83D4 0166 * 0167 83E0 WS EQU >83E0 0168 83E1 R0LB EQU >83E1 0169 83E3 R1LB EQU >83E3 0170 83E5 R2LB EQU >83E5 0171 83E7 R3LB EQU >83E7 0172 83E9 R4LB EQU >83E9 0173 83EB R5LB EQU >83EB 0174 83ED R6LB EQU >83ED 0175 83EF R7LB EQU >83EF 0176 83F1 R8LB EQU >83F1 0177 83F3 R9LB EQU >83F3 0178 83F5 R10LB EQU >83F5 0179 83F7 R11LB EQU >83F7 99/4 ASSEMBLER EQUATES PAGE 0004 0180 83F9 R12LB EQU >83F9 0181 83FB R13LB EQU >83FB 0182 83FD R14LB EQU >83FD 0183 83FF R15LB EQU >83FF 0184 * 0185 8302 GDST EQU >8302 0186 8303 AAA11 EQU >8303 0187 8303 GDST1 EQU >8303 0188 8304 VARY EQU >8304 0189 8306 VARY2 EQU >8306 0190 8308 BCNT2 EQU >8308 0191 830C CSRC EQU >830C 0192 834C ADDR1 EQU >834C 0193 834D ADDR11 EQU >834D 0194 834E BCNT1 EQU >834E 0195 8350 ADDR2 EQU >8350 0196 8351 ADDR21 EQU >8351 0197 8354 GSRC EQU >8354 0198 8355 DDD11 EQU >8355 0199 8355 GSRC1 EQU >8355 0200 8356 BCNT3 EQU >8356 0201 8358 DEST EQU >8358 0202 8359 DEST1 EQU >8359 0203 8384 RAMTOP EQU >8384 0204 * VDP variables 0205 0376 SYMBOL EQU >0376 * Saved symbol table pointer 0206 038A ERRLN EQU >038A * On-error line pointer 0207 0392 TABSAV EQU >0392 * Saved main symbol table ponter 0208 03C0 VROAZ EQU >03C0 * Temporary VDP Roll Out Area 0209 03DC FPSIGN EQU >03DC 0210 0820 CRNBUF EQU >0820 * CRuNch BUFfer address 0211 091C CRNEND EQU >091C * CRuNch buffer END 0212 ************************************************************ 0213 6000 AORG >6000 0215 0216 * PAGE SELECTOR FOR PAGE 1 0217 6000 PAGE1 EQU $ >6000 0218 6000 0002 C2 DATA 2 0 0219 * PAGE SELECTOR FOR PAGE 2 0220 6002 PAGE2 EQU $ >6002 0221 6002 00 C7 BYTE >00 0222 6003 07 CBH7 BYTE >07 2 0223 6004 0A CBHA BYTE >0A 0224 6005 94 CBH94 BYTE >94 4 0225 6006 0028 C40 DATA 40 6 0226 6008 0064 C100 DATA 100 8 0227 600A 1000 C1000 DATA >1000 A 0228 600C 0000 DATA 0 C 0229 600E 4001 FLTONE DATA >4001 E 0230 ************************************************************ 0231 * XML table number 7 for Extended Basic - must have 0232 * it's origin at >6010 0233 ************************************************************ 0234 * 0 1 2 3 4 5 6 0235 6010 619C DATA COMPCG,GETSTG,MEMCHG,CNSSEL,PARSEG,CONTG,EXECG 6012 61A2 6014 72CE 6016 6070 6018 6470 99/4 ASSEMBLER XML359 PAGE 0005 601A 64C4 601C 6500 0236 * 7 8 9 A B C D 0237 601E 61BA DATA VPUSHG,VPOP,PGMCH,SYMB,SMBB,ASSGNV,FBSYMB 6020 6C2A 6022 6410 6024 61B4 6026 61A8 6028 61AE 602A 618C 0238 * E F 0239 602C 6EE2 DATA SPEED,CRNSEL 602E 6076 0240 ************************************************************ 0241 * XML table number 8 for Extended Basic - must have 0242 * it's origin at >6030 0243 ************************************************************ 0244 * 0 1 2 3 4 5 6 7 0245 6030 74AA DATA CIF,CONTIN,RTNG,SCROLL,IO,GREAD,GWRITE,DELREP 6032 65CC 6034 6630 6036 7ADA 6038 7B48 603A 7EB4 603C 7ED8 603E 7EF4 0246 * 8 9 A B C D E 0247 6040 7F7E DATA MVDN,MVUP,VGWITE,GVWITE,GREAD1,GWITE1,GDTECT 6042 6F98 6044 7FC0 6046 7FDA 6048 7EA6 604A 7ECA 604C 6050 0248 * F 0249 604E 7C56 DATA PSCAN 0250 0251 * Determine if and how much ERAM is present 0252 6050 D80B GDTECT MOVB R11,@PAGE1 First enable page 1 ROM 6052 6000 0253 *----------------------------------------------------------- 0254 * Replace following line 6/16/81 0255 * (Extended Basic must be made to leave enough space at 0256 * top of RAM expansion for the "hooks" left by the 99/4A 0257 * for TIBUG.) 0258 * SETO R0 Start at >FFFF 0259 * with 0260 * LI R0,>FFE7 Start at >FFE7 0261 ************************************************************ 0262 * RXB 2020 change for PRAM command 0263 6054 C020 MOV @RAMTOP,R0 PRAM sets RAMTOP value 6056 8384 0264 *----------------------------------------------------------- 0265 6058 D40B MOVB R11,*R0 Write a byte of data 0266 605A 940B CB R11,*R0 Read and compare the data 0267 605C 1306 JEQ DTECT2 If matches-found ERAM top 0268 *----------------------------------------------------------- 0269 * Change the following line 6/16/81 0270 * AI R0,->2000 Else drop down 8K 99/4 ASSEMBLER XML359 PAGE 0006 0271 605E 0200 LI R0,>DFFF Else drop down 8K 6060 DFFF 0272 *----------------------------------------------------------- 0273 6062 D40B MOVB R11,*R0 Write a byte of data 0274 6064 940B CB R11,*R0 Read and compare the data 0275 6066 1301 JEQ DTECT2 If matches-found ERAM top 0276 6068 04C0 CLR R0 No match so no ERAM 0277 606A C800 DTECT2 MOV R0,@RAMTOP Set the ERAM top 606C 8384 0278 606E 045B RT And return to GPL 0279 6070 0202 CNSSEL LI R2,CNS 6072 7016 0280 6074 1002 JMP PAGSEL 0281 6076 0202 CRNSEL LI R2,CRUNCH 6078 7B88 0282 * Select page 2 for CRUNCH and CNS 0283 607A 05E0 PAGSEL INCT @STKADD Get space on subroutine stack 607C 8373 0284 607E D1E0 MOVB @STKADD,R7 Get stack pointer 6080 8373 0285 6082 0987 SRL R7,8 Shift to use as offset 0286 6084 D9CB MOVB R11,@PAD0(R7) Save return addr to GPL interp 6086 8300 0287 6088 D9E0 MOVB @R11LB,@PAD1(R7) 608A 83F7 608C 8301 0288 608E D80B MOVB R11,@PAGE2 Select page 2 6090 6002 0289 6092 0692 BL *R2 Do the conversion 0290 6094 D80B MOVB R11,@PAGE1 Reselect page 1 6096 6000 0291 6098 D1E0 MOVB @STKADD,R7 Get subroutine stack pointer 609A 8373 0292 609C 0660 DECT @STKADD Decrement pointer 609E 8373 0293 60A0 0987 SRL R7,8 Shift to use as offset 0294 60A2 D2E7 MOVB @PAD0(R7),R11 Restore return address 60A4 8300 0295 60A6 D827 MOVB @PAD1(R7),@R11LB 60A8 8301 60AA 83F7 0296 60AC 045B RT Return to GPL interpeter 0297 60AE D7E0 GETCH MOVB @R6LB,*R15 60B0 83ED 0298 60B2 1000 NOP 0299 60B4 D7C6 MOVB R6,*R15 0300 60B6 0586 INC R6 0301 60B8 D220 MOVB @XVDPRD,R8 60BA 8800 0302 60BC 0988 GETCH1 SRL R8,8 0303 60BE 045B RT 0304 60C0 DB46 GETCHG MOVB R6,@GRMWAX(R13) 60C2 0402 0305 60C4 DB60 MOVB @R6LB,@GRMWAX(R13) 60C6 83ED 60C8 0402 0306 60CA 0586 INC R6 0307 60CC D21D MOVB *R13,R8 0308 60CE 10F6 JMP GETCH1 99/4 ASSEMBLER XML359 PAGE 0007 0309 60D0 D236 GETCGR MOVB *R6+,R8 0310 60D2 10F4 JMP GETCH1 0311 * 0312 60D6 CBHFF EQU $+2 0313 60D4 0205 POPSTK LI R5,-8 60D6 FFF8 0314 60D8 D7E0 MOVB @VSPTR1,*R15 60DA 836F 0315 60DC 0206 LI R6,ARG 60DE 835C 0316 60E0 D7E0 MOVB @VSPTR,*R15 60E2 836E 0317 60E4 A805 A R5,@VSPTR 60E6 836E 0318 60E8 DDA0 STKMOV MOVB @XVDPRD,*R6+ 60EA 8800 0319 60EC 0585 INC R5 0320 60EE 16FC JNE STKMOV 0321 60F0 045B RT 0322 * 0323 60F2 05E0 PUTSTK INCT @STKADD 60F4 8373 0324 60F6 D120 MOVB @STKADD,R4 60F8 8373 0325 60FA 0984 SRL R4,8 0326 60FC D92D MOVB @GRMRAX(13),@PAD0(R4) 60FE 0002 6100 8300 0327 6102 D92D MOVB @GRMRAX(13),@PAD1(R4) 6104 0002 6106 8301 0328 6108 0624 DEC @PAD0(R4) 610A 8300 0329 610C 045B RT 0330 * 0331 610E D120 GETSTK MOVB @STKADD,R4 6110 8373 0332 6112 0984 SRL R4,8 0333 6114 0660 DECT @STKADD 6116 8373 0334 6118 DB64 MOVB @PAD0(R4),@GRMWAX(R13) 611A 8300 611C 0402 0335 611E DB64 MOVB @PAD1(R4),@GRMWAX(R13) 6120 8301 6122 0402 0336 6124 045B RT 0337 ************************************************************ 0338 6126 AORG >6126 0340 0341 0F64 ROUNUP EQU >0F64 Uses XML >01 Rounding of floating point 0342 0D42 SCOMPB EQU >0D42 Set SCOMP with direct return without GPL 0343 12B8 CFI EQU >12B8 CFI (XML >12) 0344 0E8C SMULT EQU >0E8C SMUL (XML >0D) 0345 0FF4 FDIV EQU >0FF4 FDIV (XML >09) 0346 0FC2 OVEXP EQU >0FC2 Overflow (XML >04) 0347 0E88 FMULT EQU >0E88 FMUL (XML >08) 0348 0D74 SSUB EQU >0D74 SSUB (XML >0C) 0349 0D80 FADD EQU >0D80 FADD (XML >06) 99/4 ASSEMBLER REFS359 PAGE 0008 0350 0FF8 SDIV EQU >0FF8 SDIV (XML >0E) 0351 0D7C FSUB EQU >0D7C FSUB (XML (>07) 0352 0D84 SADD EQU >0D84 SADD (XML >0B) 0353 0FB2 ROUNU EQU >0FB2 Rounding with digit number in >8354 (XML 0354 006A RESET EQU >006A Clear condition bit in GPL status (GPL i 0355 0070 NEXT EQU >0070 GPL interpreter 0356 11B2 CSN01 EQU >11B2 CSN (XML >10) (Without R3 loaded with >1 0357 0D3A FCOMP EQU >0D3A FCOMP (XML >0A) 0358 6126 C0CB FCOMPB MOV R11,R3 0359 6128 0460 B @FCOMP+22 612A 0D50 0360 187C GETV EQU >187C Read 1 byte from VDP, Entry over data ad 0361 1880 GETV1 EQU >1880 Same >187C but does not fetch address, i 0362 1E8C SAVREG EQU >1E8C Set substack pointer and Basic byte 0363 1E90 SAVRE2 EQU >1E90 Same >1E8C but does not set R8 into >834 0364 1E7A SETREG EQU >1E7A Substack pointer in R9 and actual Basic 0365 18AA STVDP3 EQU >18AA Write R6 in VDP (R1=Address+3), 0366 * used for variable table and string point 0367 18AE STVDP EQU >18AE Write R6 in VDP (R1=Address+3), 0368 * used for variable table and string point 0369 15E0 FBS EQU >15E0 Pointer fetch var list 0370 15E6 FBS001 EQU >15E6 Fetch length byte 0371 ************************************************************ 0372 0373 612C AORG >612C 0375 0376 * 0377 * The CHARACTER PROPERTY TABLE 0378 * There is a one-byte entry for every character code 0379 * in the range LLC(lowest legal character) to 0380 * HLC(highest legal character), inclusive. 0381 0020 LLC EQU >20 0382 0000 CPNIL EQU >00 " $ % ' ? 0383 0002 CPDIG EQU >02 digit (0-9) 0384 0004 CPNUM EQU >04 digit, period, E 0385 0008 CPOP EQU >08 1 char operators(!#*+-/<=>^ ) 0386 0010 CPMO EQU >10 multiple operator ( : ) 0387 0020 CPALPH EQU >20 A-Z, @, _ 0388 0040 CPBRK EQU >40 ( ) , ; 0389 0080 CPSEP EQU >80 space 0390 0022 CPALNM EQU CPALPH+CPDIG alpha-digit 0391 *----------------------------------------------------------- 0392 * Following lines are for adding lowercase character set in 0393 * 99/4A, 5/12/81 0394 0001 CPLOW EQU >01 a-z 0395 0023 CPULNM EQU CPALNM+CPLOW Alpha(both upper and lower)+ 0396 * digit-legal variable character 0397 0021 CPUL EQU CPALPH+CPLOW Alpha(both upper and lower) 0398 *----------------------------------------------------------- 0399 610C CPTBL EQU $-LLC 0400 612C 80 BYTE CPSEP SPACE 0401 612D 08 BYTE CPOP ! EXCLAMATION POINT 0402 612E 00 BYTE CPNIL " QUOTATION MARKS 0403 612F 08 BYTE CPOP # NUMBER SIGN 0404 6130 00 BYTE CPNIL $ DOLLAR SIGN 0405 6131 00 BYTE CPNIL % PERCENT 0406 6132 08 BYTE CPOP & AMPERSAND 0407 6133 00 BYTE CPNIL ' APOSTROPHE 0408 6134 40 BYTE CPBRK ( LEFT PARENTHESIS 99/4 ASSEMBLER CPT PAGE 0009 0409 6135 40 BYTE CPBRK ) RIGHT PARENTHESIS 0410 6136 08 BYTE CPOP * ASTERISK 0411 6137 0C BYTE CPOP+CPNUM + PLUS 0412 6138 40 BYTE CPBRK , COMMA 0413 6139 0C BYTE CPOP+CPNUM - MINUS 0414 613A 04 BYTE CPNUM . PERIOD 0415 613B 08 BYTE CPOP / SLANT 0416 613C 06 BYTE CPNUM+CPDIG 0 ZERRO 0417 613D 06 BYTE CPNUM+CPDIG 1 ONE 0418 613E 06 BYTE CPNUM+CPDIG 2 TWO 0419 613F 06 BYTE CPNUM+CPDIG 3 THREE 0420 6140 06 BYTE CPNUM+CPDIG 4 FOUR 0421 6141 06 BYTE CPNUM+CPDIG 5 FIVE 0422 6142 06 BYTE CPNUM+CPDIG 6 SIX 0423 6143 06 BYTE CPNUM+CPDIG 7 SEVEN 0424 6144 06 BYTE CPNUM+CPDIG 8 EIGHT 0425 6145 06 BYTE CPNUM+CPDIG 9 NINE 0426 6146 10 LBCPMO BYTE CPMO : COLON 0427 6147 40 BYTE CPBRK : SEMICOLON 0428 6148 08 BYTE CPOP < LESS THAN 0429 6149 08 BYTE CPOP = EQUALS 0430 614A 08 BYTE CPOP > GREATER THAN 0431 614B 00 BYTE CPNIL ? QUESTION MARK 0432 614C 20 BYTE CPALPH @ COMMERCIAL AT 0433 614D 20 BYTE CPALPH A UPPERCASE A 0434 614E 20 BYTE CPALPH B UPPERCASE B 0435 614F 20 BYTE CPALPH C UPPERCASE C 0436 6150 20 BYTE CPALPH D UPPERCASE D 0437 6151 24 BYTE CPALPH+CPNUM E UPPERCASE E 0438 6152 20 BYTE CPALPH F UPPERCASE F 0439 6153 20 BYTE CPALPH G UPPERCASE G 0440 6154 20 BYTE CPALPH H UPPERCASE H 0441 6155 20 BYTE CPALPH I UPPERCASE I 0442 6156 20 BYTE CPALPH J UPPERCASE J 0443 6157 20 BYTE CPALPH K UPPERCASE K 0444 6158 20 BYTE CPALPH L UPPERCASE L 0445 6159 20 BYTE CPALPH M UPPERCASE M 0446 615A 20 BYTE CPALPH N UPPERCASE N 0447 615B 20 BYTE CPALPH O UPPERCASE O 0448 615C 20 BYTE CPALPH P UPPERCASE P 0449 615D 20 BYTE CPALPH Q UPPERCASE Q 0450 615E 20 BYTE CPALPH R UPPERCASE R 0451 615F 20 BYTE CPALPH S UPPERCASE S 0452 6160 20 BYTE CPALPH T UPPERCASE T 0453 6161 20 BYTE CPALPH U UPPERCASE U 0454 6162 20 BYTE CPALPH V UPPERCASE V 0455 6163 20 BYTE CPALPH W UPPERCASE W 0456 6164 20 BYTE CPALPH X UPPERCASE X 0457 6165 20 BYTE CPALPH Y UPPERCASE Y 0458 6166 20 BYTE CPALPH Z UPPERCASE Z 0459 6167 20 BYTE CPALPH [ LEFT SQUARE BRACKET 0460 6168 20 BYTE CPALPH \ REVERSE SLANT 0461 6169 20 BYTE CPALPH ] RIGHT SQUARE BRACKET 0462 616A 08 BYTE CPOP ^ CIRCUMFLEX 0463 616B 20 BYTE CPALPH _ UNDERLINE 0464 *----------------------------------------------------------- 0465 * Following "`" and lowercase characters are for 0466 * adding lowercase character set in 99/4A, 5/12/81 0467 *----------------------------------------------------------- 99/4 ASSEMBLER CPT PAGE 0010 0468 616C 00 BYTE CPNIL ` GRAVE ACCENT 0469 616D 21 BYTE CPALPH+CPLOW a LOWERCASE a 0470 616E 21 BYTE CPALPH+CPLOW b LOWERCASE b 0471 616F 21 BYTE CPALPH+CPLOW c LOWERCASE c 0472 6170 21 BYTE CPALPH+CPLOW d LOWERCASE d 0473 6171 21 BYTE CPALPH+CPLOW e LOWERCASE e 0474 6172 21 BYTE CPALPH+CPLOW f LOWERCASE f 0475 6173 21 BYTE CPALPH+CPLOW g LOWERCASE g 0476 6174 21 BYTE CPALPH+CPLOW h LOWERCASE h 0477 6175 21 BYTE CPALPH+CPLOW i LOWERCASE i 0478 6176 21 BYTE CPALPH+CPLOW j LOWERCASE j 0479 6177 21 BYTE CPALPH+CPLOW k LOWERCASE k 0480 6178 21 BYTE CPALPH+CPLOW l LOWERCASE l 0481 6179 21 BYTE CPALPH+CPLOW m LOWERCASE m 0482 617A 21 BYTE CPALPH+CPLOW n LOWERCASE n 0483 617B 21 BYTE CPALPH+CPLOW o LOWERCASE o 0484 617C 21 BYTE CPALPH+CPLOW p LOWERCASE p 0485 617D 21 BYTE CPALPH+CPLOW q LOWERCASE q 0486 617E 21 BYTE CPALPH+CPLOW r LOWERCASE r 0487 617F 21 BYTE CPALPH+CPLOW s LOWERCASE s 0488 6180 21 BYTE CPALPH+CPLOW t LOWERCASE t 0489 6181 21 BYTE CPALPH+CPLOW u LOWERCASE u 0490 6182 21 BYTE CPALPH+CPLOW v LOWERCASE v 0491 6183 21 BYTE CPALPH+CPLOW w LOWERCASE w 0492 6184 21 BYTE CPALPH+CPLOW x LOWERCASE x 0493 6185 21 BYTE CPALPH+CPLOW y LOWERCASE y 0494 6186 21 BYTE CPALPH+CPLOW z LOWERCASE z 0495 0496 EVEN 0497 ************************************************************ 0498 6188 AORG >6188 0500 0501 * General Basic support routines (not includeing PARSE) 0502 0503 * 0504 0503 ERRBS EQU >0503 BAD SUBSCRIPT ERROR CODE 0505 0603 ERRTM EQU >0603 ERROR STRING/NUMBER MISMATCH 0506 * 0507 6188 6500 STCODE DATA >6500 0508 618A 0006 C6 DATA >0006 0509 * 0510 * Entry to find Basic symbol table entry for GPL 0511 * 0512 618C 06A0 FBSYMB BL @FBS Search the symbol table 618E 15E0 0513 6190 006A DATA RESET If not found - condition reset 0514 6192 F820 SET SOCB @BIT2,@STATUS Set GPL condition 6194 62AB 6196 837C 0515 6198 0460 B @NEXT If found - condition set 619A 0070 0516 * GPL entry for COMPCT to take advantage of common code 0517 619C 0206 COMPCG LI R6,COMPCT Address of COMPCT 619E 73D8 0518 61A0 100E JMP SMBB10 Jump to set up 0519 * GPL entry for GETSTR to take advantage of common code 0520 61A2 0206 GETSTG LI R6,GETSTR Address of MEMCHK 61A4 736C 0521 61A6 100B JMP SMBB10 Jump to set up 99/4 ASSEMBLER BASSUP PAGE 0011 0522 * GPL entry for SMB to take advantage of common code 0523 61A8 0206 SMBB LI R6,SMB Address of SMB routine 61AA 61DC 0524 61AC 1008 JMP SMBB10 Jump to set up 0525 * GPL entry for ASSGNV to take advantage of common code 0526 61AE 0206 ASSGNV LI R6,ASSG Address of ASSGNV routine 61B0 6334 0527 61B2 1005 JMP SMBB10 Jump to set up 0528 * GPL entry for SMB to take advantage of common code 0529 61B4 0206 SYMB LI R6,SYM Address of SYM routine 61B6 6312 0530 61B8 1002 JMP SMBB10 Jump to set up 0531 * GPL entry for SMB to take advantage of common code 0532 61BA 0206 VPUSHG LI R6,VPUSH Address of VPUSH routine 61BC 6BAA 0533 61BE C1CB SMBB10 MOV R11,R7 Save return address 0534 61C0 06A0 BL @PUTSTK Save current GROM address 61C2 60F2 0535 61C4 06A0 BL @SETREG Set up Basic registers 61C6 1E7A 0536 61C8 05C9 INCT R9 Get space on subroutine stack 0537 61CA C647 MOV R7,*R9 Save the return address 0538 61CC 0696 BL *R6 Branch and link to the routine 0539 61CE C1D9 MOV *R9,R7 Get return address 0540 61D0 0649 DECT R9 Restore subroutine stack 0541 61D2 06A0 BL @SAVREG Save registers for GPL 61D4 1E8C 0542 61D6 06A0 BL @GETSTK Restore GROM address 61D8 610E 0543 61DA 0457 B *R7 Return to GPL 0544 ************************************************************ 0545 * Subroutine to find the pointer to variable space of each 0546 * element of symbol table entry. Decides whether symbol 0547 * table entry pointed to by FAC, FAC+1 is a simple variable 0548 * and returns proper 8-byte block in FAC through FAC7 0549 ************************************************************ 0550 61DC 05C9 SMB INCT R9 Get space on subroutine stack 0551 61DE C64B MOV R11,*R9 Save return address 0552 61E0 C820 MOV @FAC,@FAC4 Copy pointer to table entry 61E2 834A 61E4 834E 0553 61E6 A820 A @C6,@FAC4 Add 6 so point a value space 61E8 618A 61EA 834E 0554 61EC 06A0 BL @GETV Get 1st byte of table entry 61EE 187C 0555 61F0 834A DATA FAC Pointer is in FAC 0556 * 0557 61F2 C101 MOV R1,R4 Copy for later use. 0558 61F4 C081 MOV R1,R2 Copy for later use. 0559 61F6 0A21 SLA R1,2 Check for UDF entry 0560 61F8 1821 JOC BERMUV If UDF - then error 0561 61FA C104 MOV R4,R4 Check for string. 0562 61FC 1102 JLT SMB02 Skip if it is string. 0563 61FE 04E0 CLR @FAC2 Clear for numeric case. 6200 834C 0564 * 0565 * In case of subprogram call check if parameter is shared by 0566 * it's calling program. 99/4 ASSEMBLER BASSUP PAGE 0012 0567 * 0568 6202 0A11 SMB02 SLA R1,1 Check for the shared bit. 0569 6204 1705 JNC SMB04 If it is not shared skip. 0570 6206 06A0 BL @GET Get the value space pointer 6208 6C9A 0571 620A 834E DATA FAC4 in the symbol table. 0572 620C C801 MOV R1,@FAC4 Store the value space address. 620E 834E 0573 * 0574 * Branches to take care of string and array cases. 0575 * Only the numeric variable case stays on. 0576 * 0577 6210 D104 SMB04 MOVB R4,R4 R4 has header byte information 0578 6212 1116 JLT SMBO50 Take care of string. 0579 6214 0A54 SMB05 SLA R4,5 Get only the dimension number. 0580 6216 09D4 SRL R4,13 0581 6218 162A JNE SMBO20 go to array case. 0582 * 0583 * Numeric ERAM cases are special. 0584 * If it is shared get the actual v.s. address from ERAM. 0585 * Otherwise get it from VDP RAM. 0586 * 0587 621A D120 MOVB @RAMTOP,R4 Check for ERAM. 621C 8384 0588 621E 130B JEQ SMBO10 Yes ERAM case. 0589 6220 0A32 SLA R2,3 R2 has a header byte. 0590 6222 1704 JNC SMB06 Shared bit is not ON. 0591 6224 06A0 BL @GETG Get v.s. pointer from ERAM 6226 6CCA 0592 6228 834E DATA FAC4 0593 622A 1003 JMP SMB08 0594 622C 06A0 SMB06 BL @GET Not shared. 622E 6C9A 0595 6230 834E DATA FAC4 Get v.s. address from VDP RAM. 0596 * 0597 6232 C801 SMB08 MOV R1,@FAC4 Store it in FAC4 area. 6234 834E 0598 * 0599 * Return from the SMB routine. 0600 * 0601 6236 C2D9 SMBO10 MOV *R9,R11 Restore return address 0602 6238 0649 DECT R9 Restore stack 0603 623A 045B RT And return 0604 623C 0460 BERMUV B @ERRMUV * INCORRECT NAME USAGE 623E 6970 0605 * 0606 * Start looking for the real address of the symbol. 0607 * 0608 6240 0288 SMBO50 CI R8,LPARZ*256 String - now string array? 6242 B700 0609 6244 13E7 JEQ SMB05 Yes, process as an array 0610 6246 C820 SMB51 MOV @STCODE,@FAC2 String ID code in FAC2 6248 6188 624A 834C 0611 624C C820 MOV @FAC4,@FAC Get string pointer address 624E 834E 6250 834A 0612 6252 06A0 BL @GET Get exact pointer to string 6254 6C9A 99/4 ASSEMBLER BASSUP PAGE 0013 0613 6256 834A DATA FAC 0614 * 0615 6258 C801 MOV R1,@FAC4 Save pointer to string 625A 834E 0616 625C C0C1 MOV R1,R3 Was it a null? 0617 625E 1304 JEQ SMB57 Length is 0 - so is null 0618 6260 0603 DEC R3 Otherwise point at length byte 0619 6262 06A0 BL @GETV1 Get the string length 6264 1880 0620 6266 0981 SRL R1,8 Shift for use as double 0621 6268 C801 SMB57 MOV R1,@FAC6 Put into FAC entry 626A 8350 0622 626C 10E4 JMP SMBO10 And return 0623 * 0624 * Array cases are taken care of here. 0625 * 0626 626E C804 SMBO20 MOV R4,@FAC2 Now have a dimension counter 6270 834C 0627 * that is initilized to maximum 0628 * *FAC+4,FAC+5 already points to 1st dimension maximum in 0629 * in symbol table. 0630 6272 04C2 CLR R2 Clear index accumulator 0631 6274 C802 SMBO25 MOV R2,@FAC6 Save accumulator in FAC 6276 8350 0632 6278 06A0 BL @PGMCHR Get next character 627A 6C74 0633 627C 06A0 BL @PSHPRS PUSH and PARSE subscript 627E 6B9C 0634 6280 B7 BYTE LPARZ,0 Up to a left parenthesis or le 6281 00 0635 * 0636 6282 9820 CB @FAC2,@STCODE Dimension can't be a string 6284 834C 6286 6188 0637 6288 1441 JHE ERRT It is - so error 0638 * Now do float to interger conversion of dimension 0639 628A 04E0 CLR @FAC10 Assume no error 628C 8354 0640 628E 06A0 BL @CFI Gets 2 byte integer in FAC,FAC 6290 12B8 0641 6292 D120 MOVB @FAC10,R4 Error on conversion? 6294 8354 0642 6296 1636 JNE ERR3 Yes, error BAD SUBSCRIPT 0643 6298 C160 MOV @FAC,R5 Save index just read 629A 834A 0644 629C 06A0 BL @VPOP Restore FAC block 629E 6C2A 0645 62A0 06A0 BL @GET Get next dimension maximum 62A2 6C9A 0646 62A4 834E DATA FAC4 FAC4 points into symbol table 0647 * 0648 62A6 8045 C R5,R1 Subscript less-then maximum? 0649 62A8 1B2D JH ERR3 No, index out of bounds 0650 62AB BIT2 EQU $+1 Constant >20 (Opcode is >D120) 0651 62AA D120 MOVB @BASE,R4 Fetch option base to check low 62AC 8343 0652 62AE 1303 JEQ SMBO40 If BASE=0, INDEX=0 is ok 0653 62B0 0605 DEC R5 Adjust BASE 1 index 0654 62B2 1128 JLT ERR3 If subscript was =0 then error 99/4 ASSEMBLER BASSUP PAGE 0014 0655 62B4 1001 JMP SMBO41 Accumulate the subscripts 0656 62B6 0581 SMBO40 INC R1 Adjust size if BASE=0 0657 62B8 3860 SMBO41 MPY @FAC6,R1 R1,R2 has ACCUM*MAX dimension 62BA 8350 0658 62BC A085 A R5,R2 Add latest to accumulator 0659 62BE 05E0 INCT @FAC4 Increment dimension max pointe 62C0 834E 0660 62C2 0620 DEC @FAC2 Decrement remaining-dim count 62C4 834C 0661 62C6 1305 JEQ SMBO70 All dimensions handled ->done 0662 62C8 0288 CI R8,COMMAZ*256 Otherwise, must be at a comma 62CA B300 0663 62CC 13D3 JEQ SMBO25 We are, so loop for more 0664 62CE 0460 ERR1 B @ERRSYN Not a comma, so SYNTAX ERROR 62D0 664E 0665 * 0666 * At this point the required number of dimensions have been 0667 * scanned. 0668 * R2 Contains the index 0669 * R4 Points to the first array element or points to the 0670 * address in ERAM where the first array element is. 0671 62D2 0288 SMBO70 CI R8,RPARZ*256 Make sure at a right parenthes 62D4 B600 0672 62D6 16FB JNE ERR1 Not, so error 0673 62D8 06A0 BL @PGMCHR Get nxt token 62DA 6C74 0674 62DC 06A0 BL @GETV Now check string or numeric 62DE 187C 0675 62E0 834A DATA FAC array by checking s.t. 0676 * 0677 62E2 110C JLT SMB71 If MSB set is a string array 0678 62E4 0A32 SLA R2,3 Numeric, multiply by 8 0679 62E6 D0E0 MOVB @RAMTOP,R3 Does ERAM exist? 62E8 8384 0680 62EA 1305 JEQ SMBO71 No 0681 62EC 06A0 BL @GET Yes, get the content of value 62EE 6C9A 0682 62F0 834E DATA FAC4 pointer 0683 * 0684 62F2 C801 MOV R1,@FAC4 Put it in FAC4 62F4 834E 0685 62F6 A802 SMBO71 A R2,@FAC4 Add into values pointer 62F8 834E 0686 62FA 109D JMP SMBO10 And return in the normal way 0687 62FC 0A12 SMB71 SLA R2,1 String, multiply by 2 0688 62FE A802 A R2,@FAC4 Add into values pointer 6300 834E 0689 6302 10A1 JMP SMB51 And build the string FAC entry 0690 6304 0200 ERR3 LI R0,ERRBS Bad subscript return vector 6306 0503 0691 6308 0460 ERRX B @ERR Exit to GPL 630A 6652 0692 630C 0200 ERRT LI R0,ERRTM String/number mismatch vector 630E 0603 0693 6310 10FB JMP ERRX Use the long branch 0694 ************************************************************ 0695 * Subroutine to put symbol name into FAC and to call FBS to 0696 * find the symbol table for the symbol 0697 ************************************************************ 99/4 ASSEMBLER BASSUP PAGE 0015 0698 6312 04E0 SYM CLR @FAC15 Clear the caharacter counter 6314 8359 0699 6316 0202 LI R2,FAC Copying string into FAC 6318 834A 0700 631A C04B MOV R11,R1 Save return address 0701 *----------------------------------------------------------- 0702 * Fix "A long constant in a variable field in INPUT, 0703 * ACCEPT, LINPUT, NEXT and READ etc. may crash the 0704 * sytem" bug, 5/22/81 0705 * Insert the following 2 lines 0706 631C D208 MOVB R8,R8 0707 631E 11D7 JLT ERR1 If token 0708 6320 DC88 SYM1 MOVB R8,*R2+ Save the character 0709 6322 05A0 INC @FAC15 Count it 6324 8359 0710 6326 06A0 BL @PGMCHR Get next character 6328 6C74 0711 632A 15FA JGT SYM1 Still characters in the name 0712 632C 06A0 BL @FBS Got name, now find s.t. entry 632E 15E0 0713 6330 62CE DATA ERR1 Return vector if not found 0714 * 0715 6332 0451 B *R1 Return to caller if found 0716 ************************************************************ 0717 * ASSGNV, callable from GPL or 9900 code, to assign a value 0718 * to a symbol (strings and numerics) . If numeric, the 0719 * 8 byte descriptor is in the FAC. The descriptor block 0720 * (8 bytes) for the destination variable is on the stack. 0721 * There are two types of descriptor entries which are 0722 * created by SMB in preparation for ASSGNV, one for 0723 * numerics and one for strings. 0724 * NUMERIC 0725 * +-------------------------------------------------------+ 0726 * |S.T. ptr | 00 | |Value ptr | | 0727 * +-------------------------------------------------------+ 0728 * STRING 0729 * +-------------------------------------------------------+ 0730 * |Value ptr| 65 | |String ptr|String length | 0731 * +-------------------------------------------------------+ 0732 * 0733 * CRITICAL NOTE: Becuase of the BL @POPSTK below, if a 0734 * string entry is popped and a garbage collection has taken 0735 * place while the entry was pushed on the stack, and the 0736 * entry was a permanent string the pointer in FAC4 and FAC5 0737 * will be messed up. A BL @VPOP would have taken care of 0738 * the problem but would have taken a lot of extra code. 0739 * Therefore, at ASSG50-ASSG54 it is assumed that the 0740 * previous value assigned to the destination variable has 0741 * been moved and the pointer must be reset by going back to 0742 * the symbol table and getting the correct value pointer. 0743 ************************************************************ 0744 6334 C28B ASSG MOV R11,R10 Save the retun address 0745 6336 06A0 BL @ARGTST Check arg and variable type 6338 6B6E 0746 633A 02CC STST R12 Save status of type 0747 633C 06A0 BL @POPSTK Pop destination descriptor 633E 60D4 0748 * into ARG 0749 6340 0A3C SLA R12,3 Variable type numeric? 99/4 ASSEMBLER BASSUP PAGE 0016 0750 6342 1745 JNC ASSG70 Yes, handle it as such 0751 * Assign a string to a string variable 0752 6344 C060 MOV @ARG4,R1 Get destination pointer 6346 8360 0753 * Dest have non-null value? 0754 6348 130B JEQ ASSG54 No, null->never assigned 0755 * Previously assigned - Must first free the old value 0756 634A 06A0 BL @GET Correct for POPSTK above 634C 6C9A 0757 634E 835C DATA ARG Pointer is in ARG 0758 * 0759 6350 C801 MOV R1,@ARG4 Correct ARG+4,5 too 6352 8360 0760 *----------------------------------------------------------- 0761 * Fix "Assigning a string to itself when memory is full can 0762 * destroy the string" bug, 5/22/81 0763 * Add the following 2 lines and the label ASSG80 0764 6354 8801 C R1,@FAC4 Do not do anything in assign- 6356 834E 0765 * ing a string to itself case 0766 6358 1317 JEQ ASSG80 Detect A$=A$ case, exit 0767 *----------------------------------------------------------- 0768 635A 04C6 CLR R6 Clear for zeroing backpointer 0769 635C 06A0 BL @STVDP3 Free the string 635E 18AA 0770 6360 C120 ASSG54 MOV @FAC6,R4 Is source string a null? 6362 8350 0771 6364 130C JEQ ASSG57 Yes, handle specially 0772 6366 C0E0 MOV @FAC,R3 Get address of source pointer 6368 834A 0773 636A 0283 CI R3,>001C Got a temporay string? 636C 001C 0774 636E 160D JNE ASSG56 No, more complicated 0775 6370 C120 MOV @FAC4,R4 Pick up direct ptr to string 6372 834E 0776 * Common string code to set forward and back pointers 0777 6374 C1A0 ASSG55 MOV @ARG,R6 Ptr to symbol table pointer 6376 835C 0778 6378 C044 MOV R4,R1 Pointer to source string 0779 637A 06A0 BL @STVDP3 Set the backpointer 637C 18AA 0780 637E C060 ASSG57 MOV @ARG,R1 Address of symbol table ptr 6380 835C 0781 6382 C184 MOV R4,R6 Pointer to string 0782 6384 06A0 BL @STVDP Set the forward pointer 6386 18AE 0783 6388 045A ASSG80 B *R10 Done, return 0784 * Symbol-to-symbol assigments of strings 0785 * Must create copy of string 0786 638A C820 ASSG56 MOV @FAC6,@BYTE Fetch length for GETSTR 638C 8350 638E 830C 0787 * NOTE: FAC through FAC+7 cannot be destroyed 0788 * address^of string length^of string 0789 6390 06A0 BL @VPUSH So save it on the stack 6392 6BAA 0790 6394 C80A MOV R10,@FAC Save return link in FAC since 6396 834A 0791 * GETSTR does not destroy FAC 99/4 ASSEMBLER BASSUP PAGE 0017 0792 6398 06A0 BL @GETSTR Call GPL to do the GETSTR 639A 736C 0793 639C C2A0 MOV @FAC,R10 Restore return link 639E 834A 0794 63A0 06A0 BL @VPOP Pop the source info back 63A2 6C2A 0795 * Set up to copy the source string into destination 0796 63A4 C0E0 MOV @FAC4,R3 R3 is now copy-from 63A6 834E 0797 63A8 C160 MOV @SREF,R5 R5 is now copy-to 63AA 831C 0798 63AC C105 MOV R5,R4 Save for pointer setting 0799 * Registers to be used in the copy 0800 * R1 - Used for a buffer 0801 * R3 - Copy-from address 0802 * R2 - # of bytes to be moved 0803 * R5 - copy-to address 0804 63AE C0A0 MOV @FAC6,R2 Fetch the length of the string 63B0 8350 0805 63B2 0265 ORI R5,WRVDP Enable the VDP write 63B4 4000 0806 63B6 06A0 ASSG59 BL @GETV1 Get the character 63B8 1880 0807 63BA D7E0 MOVB @R5LB,*R15 Load out destination address 63BC 83EB 0808 63BE 0583 INC R3 Increment the copy-from 0809 63C0 D7C5 MOVB R5,*R15 1st byte of address to 0810 63C2 0585 INC R5 Increment for next character 0811 63C4 D801 MOVB R1,@XVDPWD Put the character out 63C6 8C00 0812 63C8 0602 DEC R2 Decrement count, finished? 0813 63CA 15F5 JGT ASSG59 No, loop for more 0814 63CC 10D3 JMP ASSG55 Yes, now set pointers 0815 * Code to copy a numeric value into the symbol table 0816 63CE 0202 ASSG70 LI R2,8 Need to assign 8 bytes 63D0 0008 0817 63D2 C160 MOV @ARG4,R5 Destination pointer(R5) 63D4 8360 0818 * from buffer(R4), (R2)bytes 0819 63D6 C0E0 MOV @RAMTOP,R3 Does ERAM exist? 63D8 8384 0820 63DA 160C JNE ASSG77 Yes, write to ERAM 0821 * No, write to VDP 0822 63DC D7E0 MOVB @R5LB,*R15 Load out 2nd byte of address 63DE 83EB 0823 63E0 0265 ORI R5,WRVDP Enable the write to the VDP 63E2 4000 0824 63E4 D7C5 MOVB R5,*R15 Load out 1st byte of address 0825 63E6 0204 LI R4,FAC Source is FAC 63E8 834A 0826 63EA D834 ASSG75 MOVB *R4+,@XVDPWD Move a byte 63EC 8C00 0827 63EE 0602 DEC R2 Decrement the counter, done? 0828 63F0 15FC JGT ASSG75 No, loop for more 0829 63F2 045A B *R10 Yes, return to the caller 0830 63F4 0204 ASSG77 LI R4,FAC Source is in FAC 63F6 834A 0831 63F8 DD74 ASSG79 MOVB *R4+,*R5+ Move a byte 0832 63FA 0602 DEC R2 Decrement the counter, done? 99/4 ASSEMBLER BASSUP PAGE 0018 0833 63FC 15FD JGT ASSG79 No, loop for more 0834 63FE 045A B *R10 Yes, return to caller 0835 * Check for required token 0836 6400 D01D SYNCHK MOVB *R13,R0 Read required token 0837 * 0838 6402 9800 CB R0,@CHAT Have the required token? 6404 8342 0839 6406 1304 JEQ PGMCH Yes, read next character 0840 6408 06A0 BL @SETREG Error return requires R8/R9 se 640A 1E7A 0841 640C 0460 B @ERRSYN * SYNTAX ERROR 640E 664E 0842 * PGMCH - GPL entry point for PGMCHR to set up register 0843 6410 C30B PGMCH MOV R11,R12 Save return address 0844 6412 06A0 BL @PGMCHR Get the next character 6414 6C74 0845 6416 D808 MOVB R8,@CHAT Put it in for GPL 6418 8342 0846 641A 045C B *R12 Return to GPL 0847 641C 045B RT And return to the caller 0848 641E C13B PUTV MOV *R11+,R4 0849 6420 C114 MOV *R4,R4 0850 6422 D7E0 PUTV1 MOVB @R4LB,*R15 6424 83E9 0851 6426 0264 ORI R4,WRVDP 6428 4000 0852 642A D7C4 MOVB R4,*R15 0853 642C 1000 NOP 0854 642E D801 MOVB R1,@XVDPWD 6430 8C00 0855 6432 045B RT 0856 * MOVFAC - copies 8 bytes from VDP(@FAC4) or ERAM(@FAC4) 0857 * to FAC 0858 6434 C060 MOVFAC MOV @FAC4,R1 Get pointer to source 6436 834E 0859 6438 0202 LI R2,8 8 byte values 643A 0008 0860 643C 0203 LI R3,FAC Destination is FAC 643E 834A 0861 6440 C020 MOV @RAMTOP,R0 Does ERAM exist? 6442 8384 0862 6444 160A JNE MOVFA2 Yes, from ERAM 0863 * No, from VDP RAM 0864 6446 06C1 SWPB R1 0865 6448 D7C1 MOVB R1,*R15 Load 2nd byte of address 0866 644A 06C1 SWPB R1 0867 644C D7C1 MOVB R1,*R15 Load 1st byte of address 0868 644E 0205 LI R5,XVDPRD 6450 8800 0869 6452 DCD5 MOVF1 MOVB *R5,*R3+ Move a byte 0870 6454 0602 DEC R2 Decrement counter, done? 0871 6456 15FD JGT MOVF1 No, loop for more 0872 6458 045B RT Yes, return to caller 0873 645A DCF1 MOVFA2 MOVB *R1+,*R3+ 0874 645C 0602 DEC R2 0875 645E 16FD JNE MOVFA2 0876 6460 045B RT 0877 6462 045B RT And return to caller 0878 ************************************************************ 99/4 ASSEMBLER BASSUP PAGE 0019 0879 6464 AORG >6464 0881 0882 * BASIC PARSE CODE 0883 * REGISTER USAGE 0884 * RESERVED FOR GPL INTERPRETER R13, R14, R15 0885 * R13 contains the read address for GROM 0886 * R14 is used in BASSUP/10 for the VDPRAM pointer 0887 * RESERVED IN BASIC SUPPORT 0888 * R8 MSB current character (like CHAT in GPL) 0889 * R8 LSB zero 0890 * R10 read data port address for program data 0891 * ALL EXITS TO GPL MUST GO THROUGH "NUDG05" 0892 * 0893 0894 * ~~~TOKENS~~~ 0895 0081 ELSEZ EQU >81 ELSE 0896 0082 SSEPZ EQU >82 STATEMENT SEPERATOR 0897 0083 TREMZ EQU >83 TAIL REMARK 0898 0084 IFZ EQU >84 IF 0899 0085 GOZ EQU >85 GO 0900 0086 GOTOZ EQU >86 GOTO 0901 0087 GOSUBZ EQU >87 GOSUB 0902 008E BREAKZ EQU >8E BREAK 0903 0096 NEXTZ EQU >96 NEXT 0904 00A1 SUBZ EQU >A1 SUB 0905 00A5 ERRORZ EQU >A5 ERROR 0906 00A6 WARNZ EQU >A6 WARNING 0907 00B0 THENZ EQU >B0 THEN 0908 00B1 TOZ EQU >B1 TO 0909 00B3 COMMAZ EQU >B3 COMMA 0910 00B6 RPARZ EQU >B6 RIGHT PARENTHESIS ) 0911 00B7 LPARZ EQU >B7 LEFT PARENTHESIS ( 0912 00BA ORZ EQU >BA OR 0913 00BB ANDZ EQU >BB AND 0914 00BC XORZ EQU >BC XOR 0915 00BD NOTZ EQU >BD NOT 0916 00BE EQZ EQU >BE EQUAL (=) 0917 00C0 GTZ EQU >C0 GREATER THEN (>) 0918 00C1 PLUSZ EQU >C1 PLUS (+) 0919 00C2 MINUSZ EQU >C2 MINUS (-) 0920 00C4 DIVIZ EQU >C4 DIVIDE (/) 0921 00C5 EXPONZ EQU >C5 EXPONENT 0922 00C7 STRINZ EQU >C7 STRING 0923 00C9 LNZ EQU >C9 LINE NUMBER 0924 00CB ABSZ EQU >CB ABSOLUTE 0925 00D1 SGNZ EQU >D1 SIGN 0926 * 0927 6464 0018 C24 DATA 24 CONSTANT 24 0928 6466 65A6 EXRTNA DATA EXRTN RETURN FOR EXEC 0929 * 0930 6468 0200 ERRSO LI R0,>0703 Issue STACK OVERFLOW message 646A 0703 0931 646C 0460 B @ERR 646E 6652 0932 * 0933 * GRAPHICS LANGUAGE ENTRY TO PARSE 0934 * 0935 6470 06A0 PARSEG BL @SETREG Set up registers for Basic 6472 1E7A 99/4 ASSEMBLER PARSES PAGE 0020 0936 6474 D2ED MOVB @GRMRAX(R13),R11 Get GROM address 6476 0002 0937 6478 D82D MOVB @GRMRAX(R13),@R11LB 647A 0002 647C 83F7 0938 647E 060B DEC R11 0939 * 0940 * 9900 ENTRY TO PARSE 0941 * 0942 6480 05C9 PARSE INCT R9 Get room for return address 0943 6482 0289 CI R9,STKEND Stack full? 6484 83BA 0944 6486 1BF0 JH ERRSO Yes, too many levels deep 0945 6488 C64B MOV R11,*R9 Save the return address 0946 648A D1C8 P05 MOVB R8,R7 Test for token beginning 0947 648C 1102 JLT P10 If token, then look it up 0948 648E 0460 B @PSYM If not token is a symbol 6490 6884 0949 6492 06A0 P10 BL @PGMCHR Get next character 6494 6C74 0950 6496 0977 SRL R7,7 Change last character to offse 0951 6498 0227 AI R7,->B7*2 Check for legal NUD 649A FE92 0952 649C 0287 CI R7,NTABLN Within the legal NUD address? 649E 0056 0953 64A0 1B22 JH CONT15 No, check for legal LED 0954 64A2 C1E7 MOV @NTAB(R7),R7 Get NUD address 64A4 69FE 0955 64A6 1525 JGT B9900 If 9900 code 0956 64A8 P17 EQU $ R7 contains offset into nudtab 0957 64A8 0247 ANDI R7,>7FFF If GPL code, get rid of MSB 64AA 7FFF 0958 64AC A1E0 A @NUDTAB,R7 Add in table address 64AE 8328 0959 64B0 06A0 NUDG05 BL @SAVREG Restore GPL pointers 64B2 1E8C 0960 64B4 DB47 MOVB R7,@GRMWAX(R13) Write out new GROM address 64B6 0402 0961 64B8 06C7 SWPB R7 Bare the LSB 0962 64BA DB47 MOVB R7,@GRMWAX(R13) Put it out too 64BC 0402 0963 64BE 0460 B @RESET Go back to GPL interpreter 64C0 006A 0964 64C2 10F2 P17L JMP P17 0965 * 0966 * CONTINUE ROUTINE FOR PARSE 0967 * 0968 64C4 06A0 CONTG BL @SETREG GPL entry-set Basic registers 64C6 1E7A 0969 64C8 C199 CONT MOV *R9,R6 Get last address from stack 0970 64CA 1506 JGT CONT10 9900 code if not negative 0971 64CC DB46 MOVB R6,@GRMWAX(R13) Write out new GROM address 64CE 0402 0972 64D0 06C6 SWPB R6 Bare the second byte 0973 64D2 DB46 MOVB R6,@GRMWAX(R13) Put it out too 64D4 0402 0974 64D6 C18D MOV R13,R6 Set up to test precedence 0975 64D8 9216 CONT10 CB *R6,R8 Test precedence 0976 64DA 1411 JHE NUDNDL Have parsed far enough->return 99/4 ASSEMBLER PARSES PAGE 0021 0977 64DC 0978 SRL R8,7 Make into table offset 0978 64DE 0228 AI R8,->B8*2 Minimum token for a LED (*2) 64E0 FE90 0979 64E2 0288 CI R8,LTBLEN Maximum token for a LED (*2) 64E4 001C 0980 64E6 1B09 CONT15 JH NOLEDL If outside legal LED range-err 0981 64E8 C1E8 MOV @LTAB(R8),R7 Pick up address of LED handler 64EA 6A54 0982 64EC 04C8 CLR R8 Clear 'CHAT' for getting new 0983 64EE 06A0 BL @PGMCHR Get next character 64F0 6C74 0984 64F2 0457 B9900 B *R7 Go to the LED handler 0985 64F4 0649 NUDE10 DECT R9 Back up subroutine stack 0986 64F6 0587 INC R7 Skip over precedence 0987 64F8 10DB JMP NUDG05 Goto code to return to GPL 0988 64FA 0460 NOLEDL B @NOLED 64FC 664E 0989 64FE 1073 NUDNDL JMP NUDND1 0990 * Execute one or more lines of Basic 0991 6500 EXECG EQU $ GPL entry point for execution 0992 6500 06A0 BL @SETREG Set up registers 6502 1E7A 0993 6504 04E0 CLR @ERRCOD Clear the return code 6506 8322 0994 6508 D020 MOVB @PRGFLG,R0 Imperative statement? 650A 8344 0995 650C 131A JEQ EXEC15 Yes, handle it as such 0996 * Loop for each statement in the program 0997 650E EXEC10 EQU $ 0998 650E D020 MOVB @FLAG,R0 Now test for trace mode 6510 8345 0999 6512 0A30 SLA R0,3 Check the trace bit in FLAG 1000 6514 115F JLT TRACL If set->display line number 1001 6516 C820 EXEC11 MOV @EXTRAM,@PGMPTR Get text pointer 6518 832E 651A 832C 1002 651C 0660 DECT @PGMPTR Back to the line # to check 651E 832C 1003 * break point 1004 6520 06A0 BL @PGMCHR Get the first byte of line # 6522 6C74 1005 6524 02C0 STST R0 Save status for breakpnt check 1006 6526 05A0 INC @PGMPTR Get text pointer again 6528 832C 1007 652A 06A0 BL @PGMCHR Go get the text pointer 652C 6C74 1008 652E 06C8 SWPB R8 Save 1st byte of text pointer 1009 6530 06A0 BL @PGMCHR Get 2nd byte of text pointer 6532 6C74 1010 6534 06C8 SWPB R8 Put text pointer in order 1011 6536 C808 MOV R8,@PGMPTR Set new text pointer 6538 832C 1012 653A 04C8 CLR R8 Clean up the mess 1013 653C 0A20 SLA R0,2 Check breakpoint status 1014 653E 1101 JLT EXEC15 If no breakpoint set - count 1015 6540 177A JNC BRKPNT If breakpoint set-handle it 1016 6542 EXEC15 EQU $ 1017 6544 C3 EQU $+2 Constant data 3 1018 6545 CB3 EQU $+3 Constant byte 3 99/4 ASSEMBLER PARSES PAGE 0022 1019 6542 0300 LIMI 3 Let interrupts loose 6544 0003 1020 6548 C0 EQU $+2 Constant data 0 1021 6546 0300 LIMI 0 Shut down interrupts 6548 0000 1022 654A 04E0 CLR @>83D6 Reset VDP timeout 654C 83D6 1023 654E 020C LI R12,>24 Load console KBD address in CR 6550 0024 1024 6552 30E0 LDCR @C0,3 Select keyboard section 6554 6548 1025 6556 020C LI R12,6 Read address 6558 0006 1026 655A 3600 STCR R0,8 SCAN the keyboard 1027 655C 2420 CZC @C1000,R0 Shift-key depressed? 655E 600A 1028 6560 160A JNE EXEC16 No, execute the Basic statemen 1029 6562 020C LI R12,>24 Test column 3 of keyboard 6564 0024 1030 6566 30E0 LDCR @CB3,3 Select keyboard section 6568 6545 1031 656A 020C LI R12,6 Read address 656C 0006 1032 656E 3600 STCR R0,8 SCAN the keyboard 1033 6570 2420 CZC @C1000,R0 Shift-C depressed? 6572 600A 1034 6574 132E JEQ BRKP1L Yes, so take Basic breakpoint 1035 6576 C820 EXEC16 MOV @PGMPTR,@SMTSRT Save start of statement 6578 832C 657A 831E 1036 657C 05C9 INCT R9 Get subroutine stack space 1037 657E C660 MOV @EXRTNA,*R9 Save the GPL return address 6580 6466 1038 6582 06A0 BL @PGMCHR Now get 1st character of stmt 6584 6C74 1039 6586 1320 JEQ EXRTN3 If EOL after EOS 1040 6588 1102 EXEC17 JLT EXEC20 If top bit set->keyword 1041 658A 0460 B @NLET If not->fake a 'LET' stmt 658C 6948 1042 658E C1C8 EXEC20 MOV R8,R7 Save 1st token so can get 2nd 1043 6590 05A0 INC @PGMPTR Increment the perm pointer 6592 832C 1044 6594 D21A MOVB *R10,R8 Read the character 1045 6596 0977 SRL R7,7 Convert 1st to table offset 1046 6598 0227 AI R7,->AA*2 Check for legal stmt token 659A FEAC 1047 659C 1558 JGT ERRONE Not in range -> error 1048 659E C1E7 MOV @STMTTB(R7),R7 Get address of stmt handler 65A0 69FC 1049 65A2 118F JLT P17L If top bit set -> GROM code 1050 65A4 0457 B *R7 If 9900 code, goto it! 1051 65A6 83 EXRTN BYTE >83 Unused bytes for data constant 1052 65A7 65 CBH65 BYTE >65 since NUDEND skips precedence 1053 65A8 0288 CI R8,SSEPZ*256 EOS only? 65AA 8200 1054 65AC 13CA JEQ EXEC15 Yes, continue on this line 1055 65AE D020 EXRTN2 MOVB @PRGFLG,R0 Did we execute an imperative 65B0 8344 1056 65B2 1351 JEQ EXEC50 Yes, so return to top-level 99/4 ASSEMBLER PARSES PAGE 0023 1057 65B4 6820 S @C4,@EXTRAM No, so goto the next line 65B6 6A80 65B8 832E 1058 65BA 8820 C @EXTRAM,@STLN Check to see if end of program 65BC 832E 65BE 8330 1059 65C0 14A6 JHE EXEC10 No, so loop for the next line 1060 65C2 1049 JMP EXEC50 Yes, so return to top-level 1061 * 1062 * STMT handler for :: 1063 * 1064 65C4 D208 SMTSEP MOVB R8,R8 EOL? 1065 65C6 16E0 JNE EXEC17 NO, there is another stmt 1066 65C8 0649 EXRTN3 DECT R9 YES 1067 65CA 10F1 JMP EXRTN2 Jump back into it 1068 * Continue after a breakpoint 1069 65CC 06A0 CONTIN BL @SETREG Set up Basic registers 65CE 1E7A 1070 65D0 10B8 EXC15L JMP EXEC15 Continue execution 1071 65D2 1038 BRKP1L JMP BRKPN1 1072 65D4 104E TRACL JMP TRACE 1073 * Test for required End-Of-Statement 1074 65D6 D208 EOL MOVB R8,R8 EOL reached? 1075 65D8 1306 JEQ NUDND1 Yes 1076 65DA 0288 CI R8,TREMZ*256 Higher then tail remark token? 65DC 8300 1077 65DE 1B37 JH ERRONE Yes, its an error 1078 65E0 0288 CI R8,ELSEZ*256 Tail, ssep or else? 65E2 8100 1079 65E4 1A34 JL ERRONE No, error 1080 * 1081 * Return from call to PARSE 1082 * (entered from CONT) 1083 * 1084 65E6 C1D9 NUDND1 MOV *R9,R7 Get the return address 1085 65E8 1185 JLT NUDE10 If negative - return to GPL 1086 65EA 0649 DECT R9 Back up the subroutine stack 1087 65EC 0467 B @2(R7) And return to caller 65EE 0002 1088 * (Skip the precedence word) 1089 65F0 D208 NUDEND MOVB R8,R8 Check for EOL 1090 65F2 13F9 JEQ NUDND1 If EOL 1091 65F4 0288 NUDND2 CI R8,STRINZ*256 Lower than a string? 65F6 C700 1092 65F8 1A08 JL NUDND4 Yes 1093 65FA 0288 CI R8,LNZ*256 Higher than a line #? 65FC C900 1094 65FE 1315 JEQ SKPLN Skip line numbers 1095 6600 1A0B JL SKPSTR Skip string or numeric 1096 6602 06A0 NUDND3 BL @PGMCHR Read next character 6604 6C74 1097 6606 13EF JEQ NUDND1 If EOL 1098 6608 10F5 JMP NUDND2 Continue scan of line 1099 660A 0288 NUDND4 CI R8,TREMZ*256 Higher than a tail remark? 660C 8300 1100 660E 1BF9 JH NUDND3 Yes 1101 6610 0288 CI R8,SSEPZ*256 Lower then stmt sep(else)? 6612 8200 1102 6614 1AF6 JL NUDND3 Yes 99/4 ASSEMBLER PARSES PAGE 0024 1103 6616 10E7 JMP NUDND1 TREM or SSEP 1104 6618 06A0 SKPSTR BL @PGMCHR 661A 6C74 1105 661C 06C8 SWPB R8 Prepare to add 1106 661E A808 A R8,@PGMPTR Skip it 6620 832C 1107 6622 04C8 CLR R8 Clear lower byte 1108 6624 06A0 SKPS01 BL @PGMCHR Get next token 6626 6C74 1109 6628 10E3 JMP NUDEND Go on 1110 662A 05E0 SKPLN INCT @PGMPTR Skip line number 662C 832C 1111 662E 10FA JMP SKPS01 Go on 1112 * 1113 * Return from "CALL" to GPL 1114 6630 06A0 RTNG BL @SETREG Set up registers again 6632 1E7A 1115 6634 10D8 JMP NUDND1 And jump back into it! 1116 ************************************************************ 1117 * Handle Breakpoints 1118 6636 D020 BRKPNT MOVB @FLAG,R0 Check flag bits 6638 8345 1119 663A 0A10 SLA R0,1 Check bit 6 for breakpoint 1120 663C 11C9 JLT EXC15L If set then ignore breakpoint 1121 663E 0200 BRKPN2 LI R0,BRKFL 6640 0001 1122 6642 1007 JMP EXIT Return to top-level 1123 6644 D020 BRKPN1 MOVB @FLAG,R0 Move flag bits 6646 8345 1124 6648 0A10 SLA R0,1 Check bit 6 for breakpoint 1125 664A 1195 JLT EXEC16 If set then ignore breakpoint 1126 664C 10F8 JMP BRKPN2 Bit not set 1127 * 1128 * Error handling from 9900 code 1129 * 1130 664E ERRSYN EQU $ These all issue same message 1131 664E ERRONE EQU $ 1132 664E NONUD EQU $ 1133 664E NOLED EQU $ 1134 664E 0200 LI R0,ERRSN *SYNTAX ERROR return code 6650 0003 1135 6652 EXIT EQU $ 1136 6652 C800 ERR MOV R0,@ERRCOD Load up return code for GPL 6654 8322 1137 * General return to GPL portion of Basic 1138 6656 C1E0 EXEC50 MOV @RTNADD,R7 Get return address 6658 8326 1139 665A 0460 B @NUDG05 Use commond code to link back 665C 64B0 1140 * Handle STOP and END statements 1141 STOP 1142 665E 0649 END DECT R9 Pop last call to PARSE 1143 6660 10FA JMP EXEC50 Jump to return to top-level 1144 * Error codes for return to GPL 1145 0003 ERRSN EQU >0003 ERROR SYNTAX 1146 0103 ERROM EQU >0103 ERROR OUT OF MEMORY 1147 0203 ERRIOR EQU >0203 ERROR INDEX OUT OF RANGE 1148 0303 ERRLNF EQU >0303 ERROR LINE NOT FOUND 1149 0403 ERREX EQU >0403 ERROR EXECUTION 99/4 ASSEMBLER PARSES PAGE 0025 1150 * >0004 WARNING NUMERIC OVERFLOW 1151 0001 BRKFL EQU >0001 BREAKPOINT RETURN VECTOR 1152 0005 ERROR EQU >0005 ON ERROR 1153 0006 UDF EQU >0006 FUNCTION REFERENCE 1154 0007 BREAK EQU >0007 ON BREAK 1155 0008 CONCAT EQU >0008 CONCATENATE (&) STRINGS 1156 0009 WARN EQU >0009 ON WARNING 1157 * Warning routine (only OVERFLOW) 1158 6662 C820 WARNZZ MOV @C4,@ERRCOD Load warning code for GPL 6664 6A80 6666 8322 1159 6668 020B LI R11,CONT-2 To optimize for return 666A 64C6 1160 * Return to GPL as a CALL 1161 666C 05C9 CALGPL INCT R9 Get space on subroutine stack 1162 666E C64B MOV R11,*R9 Save return address 1163 6670 10F2 JMP EXEC50 And go to GPL 1164 * Trace a line (Call GPL routine) 1165 6672 C820 TRACE MOV @C2,@ERRCOD Load return vector 6674 6000 6676 8322 1166 6678 020B LI R11,EXEC11-2 Set up for return to execute 667A 6514 1167 667C 10F7 JMP CALGPL Call GPL to display line # 1168 * Special code to handle concatenate (&) 1169 667E 0200 CONC LI R0,CONCAT Go to GPL to handle it 6680 0008 1170 6682 10E7 JMP EXIT Exit to GPL interpeter 1171 ************************************************************ 1172 * NUD routine for a numeric constant 1173 * NUMCON first puts pointer to the numeric string into 1174 * FAC12 for CSN, clears the error byte (FAC10) and then 1175 * converts from a string to a floating point number. Issues 1176 * warning if necessary. Leaves value in FAC 1177 ************************************************************ 1178 6684 C820 NUMCON MOV @PGMPTR,@FAC12 Set pointer for CSN 6686 832C 6688 8356 1179 668A 06C8 SWPB R8 Swap to get length into LSB 1180 668C A808 A R8,@PGMPTR Add to pointer to check end 668E 832C 1181 6690 04E0 CLR @FAC10 Assume no error 6692 8354 1182 6694 06A0 BL @SAVRE2 Save registers 6696 1E90 1183 6698 0203 LI R3,GETCH Adjustment for ERAM in order 669A 60AE 1184 669C D120 MOVB @RAMFLG,R4 to call CSN 669E 8389 1185 66A0 1302 JEQ NUMC49 1186 66A2 0203 LI R3,GETCGR 66A4 60D0 1187 66A6 06A0 NUMC49 BL @CSN01 Convert String to Number 66A8 11B2 1188 66AA 06A0 BL @SETREG Restore registers 66AC 1E7A 1189 66AE 8820 C @FAC12,@PGMPTR Check to see if all converted 66B0 8356 66B2 832C 99/4 ASSEMBLER PARSES PAGE 0026 1190 66B4 16CC JNE ERRONE If not - error 1191 66B6 06A0 BL @PGMCHR Now get next char from program 66B8 6C74 1192 66BA D020 MOVB @FAC10,R0 Get an overflow on conversion? 66BC 8354 1193 66BE 16D1 JNE WARNZZ Yes, have GPL issue warning 1194 66C0 0460 B @CONT Continue the PARSE 66C2 64C8 1195 * 1196 * ON ERROR, ON WARNING and ON BREAK 1197 66C4 0200 ONERR LI R0,ERROR ON ERROR code 66C6 0005 1198 66C8 10C4 JMP EXIT Return to GPL code 1199 66CA 0200 ONWARN LI R0,WARN ON WARNING code 66CC 0009 1200 66CE 10C1 JMP EXIT Return to GPL code 1201 66D0 0200 ONBRK LI R0,BREAK ON BREAK code 66D2 0007 1202 66D4 10BE JMP EXIT Return to GPL code 1203 * 1204 * NUD routine for "GO" 1205 * 1206 66D6 04C3 GO CLR R3 Dummy "ON" index for common 1207 66D8 1020 JMP ON30 Merge into "ON" code 1208 * 1209 * NUD ROUTINE FOR "ON" 1210 * 1211 66DA 0288 ON CI R8,WARNZ*256 On warning? 66DC A600 1212 66DE 13F5 JEQ ONWARN Yes, goto ONWARN 1213 66E0 0288 CI R8,ERRORZ*256 On error? 66E2 A500 1214 66E4 13EF JEQ ONERR Yes, got ONERR 1215 66E6 0288 CI R8,BREAKZ*256 On break? 66E8 8E00 1216 66EA 13F2 JEQ ONBRK Yes, goto ONBRK 1217 * 1218 * Normal "ON" statement 1219 * 1220 66EC 06A0 BL @PARSE PARSE the index value 66EE 6480 1221 66F0 B3 BYTE COMMAZ Stop on a comma or less 1222 66F1 66 CBH66 BYTE >66 Unused byte for constant 1223 66F2 06A0 BL @NUMCHK Ensure index is a number 66F4 6B92 1224 66F6 04E0 CLR @FAC10 Assume no error in CFI 66F8 8354 1225 66FA 06A0 BL @CFI Convert Floating to Integer 66FC 12B8 1226 66FE D020 MOVB @FAC10,R0 Test error code 6700 8354 1227 6702 1603 JNE GOTO90 If overflow, BAD VALUE 1228 6704 C0E0 MOV @FAC,R3 Get the index 6706 834A 1229 6708 1503 JGT ON20 Must be positive 1230 670A 0200 GOTO90 LI R0,ERRIOR Negative, BAD VALUE 670C 0203 1231 670E 10A1 GOTO95 JMP ERR Jump to error handler 1232 6710 ON20 EQU $ Now check GO TO/SUB 99/4 ASSEMBLER PARSES PAGE 0027 1233 6710 0288 CI R8,GOZ*256 Bare "GO" token? 6712 8500 1234 6714 1608 JNE ON40 No, check other possibilities 1235 6716 06A0 BL @PGMCHR Yes, get next token 6718 6C74 1236 671A 0288 ON30 CI R8,TOZ*256 "GO TO" ? 671C B100 1237 671E 1365 JEQ GOTO50 Yes, handle GO TO like GOTO 1238 6720 0288 CI R8,SUBZ*256 "GO SUB" ? 6722 A100 1239 6724 1005 JMP ON50 Merge to common code to test 1240 6726 0288 ON40 CI R8,GOTOZ*256 "GOTO" ? 6728 8600 1241 672A 135F JEQ GOTO50 Yes, go handle it 1242 672C 0288 CI R8,GOSUBZ*256 "GOSUB" ? 672E 8700 1243 6730 168E ON50 JNE ERRONE No, so is an error 1244 6732 06A0 BL @PGMCHR Get next token 6734 6C74 1245 6736 1002 JMP GOSUB2 Goto gosub code 1246 6738 108A ERR1B JMP ERRONE Issue error message 1247 * NUD routine for "GOSUB" 1248 673A 04C3 GOSUB CLR R3 Dummy index for "ON" code 1249 * Common GOSUB code 1250 673C GOSUB2 EQU $ Now build a FAC entry 1251 673C 0201 LI R1,FAC Optimize to save bytes 673E 834A 1252 6740 CC43 MOV R3,*R1+ Save the "ON" index 1253 * in case of garbage collection 1254 6742 DC60 MOVB @CBH66,*R1+ Indicate GOSUB entry on stack 6744 66F1 1255 6746 0581 INC R1 Skip FAC3 1256 6748 C460 MOV @PGMPTR,*R1 Save current ptr w/in line 674A 832C 1257 674C 05F1 INCT *R1+ Skip line # to correct place 1258 674E C460 MOV @EXTRAM,*R1 Save current line # pointer 6750 832E 1259 6752 06A0 BL @VPUSH Save the stack entry 6754 6BAA 1260 6756 C0E0 MOV @FAC,R3 Restore the "ON" index 6758 834A 1261 675A 1001 JMP GOTO20 Jump to code to find the line 1262 * NUD routine for "GOTO" 1263 675C 04C3 GOTO CLR R3 Dummy index for "ON" code 1264 * Common (ON) GOTO/GOSUB THEN/ELSE code to fine line 1265 * 1266 * Get line number from program 1267 675E 0288 GOTO20 CI R8,LNZ*256 Must have line number token 6760 C900 1268 6762 16EA JNE ERR1B Don't, so error 1269 6764 06A0 GETL10 BL @PGMCHR Get MSB of the line number 6766 6C74 1270 6768 D008 MOVB R8,R0 Save it 1271 676A 06A0 BL @PGMCHR Read the character 676C 6C74 1272 676E 0603 DEC R3 Decrement the "ON" index 1273 6770 1534 JGT GOTO40 Loop if not there yet 1274 * 1275 * Find the program line 99/4 ASSEMBLER PARSES PAGE 0028 1276 * 1277 6772 C060 MOV @STLN,R1 Get into line # table 6774 8330 1278 6776 D0A0 MOVB @RAMFLG,R2 Check ERAM flag to see where? 6778 8389 1279 677A 1310 JEQ GOTO31 From VDP, go handle it 1280 677C C081 MOV R1,R2 Copy address 1281 677E 8801 GOT32 C R1,@ENLN Finished w/line # table? 6780 8332 1282 6782 1422 JHE GOTO34 Yes, so line doesn't exist 1283 6784 D0F2 MOVB *R2+,R3 2nd byte match? 1284 6786 0243 ANDI R3,>7FFF Reset possible breakpoint 6788 7FFF 1285 678A 9003 CB R3,R0 Compare 1st byte of #, Match? 1286 678C 1605 JNE GOT35 Not a match, so move on 1287 678E 9232 CB *R2+,R8 2nd byte match? 1288 6790 131E JEQ GOTO36 Yes, line is found! 1289 6792 05C2 GOT33 INCT R2 Skip line pointer 1290 6794 C042 MOV R2,R1 Advance to next line in table 1291 6796 10F3 JMP GOT32 Go back for more 1292 6798 D0F2 GOT35 MOVB *R2+,R3 Skip 2nd byte of line # 1293 679A 10FB JMP GOT33 And jump back in 1294 679C D7E0 GOTO31 MOVB @R1LB,*R15 Get the data from the VDP 679E 83E3 1295 67A0 0202 LI R2,XVDPRD Load up to read data 67A2 8800 1296 67A4 D7C1 MOVB R1,*R15 Write out MSB of address 1297 67A6 8801 GOTO32 C R1,@ENLN Finished w/line # table 67A8 8332 1298 67AA 140E JHE GOTO34 Yes, so line doesn't exist 1299 67AC D0D2 MOVB *R2,R3 Save in temporary place for 1300 * breakpoint checking 1301 67AE 0243 ANDI R3,>7FFF Reset possible breakpoint 67B0 7FFF 1302 67B2 9003 CB R3,R0 Compare 1st byte of #, Match? 1303 67B4 1607 JNE GOTO35 Not a match, so move on 1304 67B6 9212 CB *R2,R8 2nd byte match? 1305 67B8 130A JEQ GOTO36 Yes, line is found! 1306 67BA D0D2 GOTO33 MOVB *R2,R3 Skip 1st byte of line pointer 1307 67BC 0221 AI R1,4 Advance to next line in table 67BE 0004 1308 67C0 D0D2 MOVB *R2,R3 Skip 1nd byte of line pointer 1309 67C2 10F1 JMP GOTO32 Go back for more 1310 67C4 D0D2 GOTO35 MOVB *R2,R3 Skip 2nd byte of line # 1311 67C6 10F9 JMP GOTO33 And jump back in 1312 67C8 0200 GOTO34 LI R0,ERRLNF LINE NOT FOUND error vector 67CA 0303 1313 67CC 10A0 JMP GOTO95 Jump for error exit 1314 67CE 05C1 GOTO36 INCT R1 Adjust to line pointer 1315 67D0 C801 MOV R1,@EXTRAM Save for execution of the line 67D2 832E 1316 67D4 0649 DECT R9 Pop saved link to goto 1317 67D6 0460 B @EXEC10 Reenter EXEC code directly 67D8 650E 1318 67DA 06A0 GOTO40 BL @PGMCHR Get next token 67DC 6C74 1319 67DE 06A0 BL @EOSTMT Premature end of statement? 67E0 6862 1320 67E2 1393 JEQ GOTO90 Yes =>BAD VALUE for index 99/4 ASSEMBLER PARSES PAGE 0029 1321 67E4 0288 CI R8,COMMAZ*256 Comma next ? 67E6 B300 1322 67E8 1603 JNE ERR1C No, error 1323 67EA 06A0 GOTO50 BL @PGMCHR Yes, get next character 67EC 6C74 1324 67EE 10B7 JMP GOTO20 And check this index value 1325 67F0 10A3 ERR1C JMP ERR1B Linking becuase long-distance 1326 67F2 0200 ERR51 LI R0,>0903 RETURN WITHOUT GOSUB 67F4 0903 1327 67F6 108B JMP GOTO95 Exit to GPL 1328 * NUD entry for "RETURN" 1329 67F8 8820 RETURN C @VSPTR,@STVSPT Check bottom of stack 67FA 836E 67FC 8324 1330 67FE 12F9 JLE ERR51 Error -> RETURN WITHOUT GOSUB 1331 6800 06A0 BL @VPOP Pop entry 6802 6C2A 1332 6804 9820 CB @CBH66,@FAC2 Check ID for a GOSUB entry 6806 66F1 6808 834C 1333 680A 160B JNE RETU30 Check for ERROR ENTRY 1334 * 1335 * Have a GOSUB entry 1336 * 1337 680C 06A0 BL @EOSTMT Must have EOS after return 680E 6862 1338 6810 16F3 JNE RETURN Not EOS, then error return? 1339 6812 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6814 834E 6816 832C 1340 6818 C820 MOV @FAC6,@EXTRAM Get return line pointer 681A 8350 681C 832E 1341 681E 0460 B @SKPS01 Go adjust it and get back 6820 6624 1342 * Check ERROR entry 1343 6822 9820 RETU30 CB @CBH69,@FAC2 ERROR ENTRY? 6824 6A9B 6826 834C 1344 6828 1307 JEQ RETU40 Yes, take care of error entry 1345 682A 9820 CB @CBH6A,@FAC2 Subprogram entry? 682C 6860 682E 834C 1346 6830 16E3 JNE RETURN No, look some more 1347 6832 06A0 BL @VPUSH Push it back. Keep information 6834 6BAA 1348 6836 10DD JMP ERR51 RETURN WITHOUT GOSUB error 1349 * 1350 * Have an ERROR entry 1351 * RETURN, RETURN line #, RETURN or RETURN NEXT follows. 1352 * 1353 6838 04C3 RETU40 CLR R3 In case of a line number 1354 683A 0288 CI R8,LNZ*256 Check for a line number 683C C900 1355 683E 1392 JEQ GETL10 Yes, treat like GOTO 1356 6840 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6842 834E 6844 832C 1357 6846 C820 MOV @FAC6,@EXTRAM Get return line pointer 99/4 ASSEMBLER PARSES PAGE 0030 6848 8350 684A 832E 1358 684C 06A0 BL @EOSTMT EOL now? 684E 6862 1359 6850 1305 JEQ BEXC15 Yes, treat like GOSUB rtn. 1360 6852 0288 CI R8,NEXTZ*256 NEXT now? 6854 9600 1361 6856 16CC JNE ERR1C No, so its an error 1362 6858 0460 B @SKPS01 Yes, so execute next statement 685A 6624 1363 685C 0460 BEXC15 B @EXEC15 Execute next line 685E 6542 1364 6860 6A CBH6A BYTE >6A Subprogram call stack ID 1365 EVEN 1366 ************************************************************ 1367 * EOSTMT - Check for End-Of-STateMenT 1368 * Returns with condition '=' if EOS 1369 * else condition '<>' if not EOS 1370 ************************************************************ 1371 6862 D208 EOSTMT MOVB R8,R8 EOL or non-token? 1372 6864 1305 JEQ EOSTM1 EOL-return condition '=' 1373 6866 1504 JGT EOSTM1 Non-token return condition '<> 1374 6868 0288 CI R8,TREMZ*256 In the EOS range (>81 to >83)? 686A 8300 1375 686C 1B01 JH EOSTM1 No, return condition '<>' 1376 686E 8208 C R8,R8 Yes, force condition to '=' 1377 6870 045B EOSTM1 RT 1378 ************************************************************ 1379 * EOLINE - Tests for End-Of-LINE; either a >00 or a 1380 * '!' 1381 * Returns with condition '=' if EOL else condition 1382 * '<>' if not EOL 1383 ************************************************************ 1384 6872 D208 EOLINE MOVB R8,R8 EOL? 1385 6874 1302 JEQ EOLNE1 Yes, return with '=' set 1386 6876 0288 CI R8,TREMZ*256 Set condition on a tall remark 6878 8300 1387 687A 045B EOLNE1 RT And return 1388 687C 0200 SYMB20 LI R0,UDF Long distance 687E 0006 1389 6880 0460 B @GOTO95 6882 670E 1390 * NUD for a symbol (variable) 1391 6884 06A0 PSYM BL @SYM Get symbol table entry 6886 6312 1392 6888 06A0 BL @GETV Get 1st byte of entry 688A 187C 1393 688C 834A DATA FAC SYM left pointer in FAC 1394 * 1395 688E 0A11 SLA R1,1 UDF reference? 1396 6890 11F5 JLT SYMB20 Yes, special code for it 1397 6892 06A0 BL @SMB No, get value space pointer 6894 61DC 1398 6896 9820 CB @FAC2,@CBH65 String reference? 6898 834C 689A 65A7 1399 689C 1302 JEQ SYMB10 Yes, special code for it 1400 689E 06A0 BL @MOVFAC No, numeric ->copy into FAC 68A0 6434 99/4 ASSEMBLER PARSES PAGE 0031 1401 68A2 0460 SYMB10 B @CONT And continue the PARSE 68A4 64C8 1402 * Statement entry for IF statement 1403 68A6 06A0 IF BL @PARSE Evaluate the expression 68A8 6480 1404 68AA B3 BYTE COMMAZ Stop on a comma 1405 68AB 67 CBH67 BYTE >67 Unused byte for a constant 1406 68AC 06A0 BL @NUMCHK Ensure the value is a number 68AE 6B92 1407 68B0 04C3 CLR R3 Create a dummy "ON" index 1408 68B2 0288 CI R8,THENZ*256 Have a "THEN" token 68B4 B000 1409 68B6 169C JNE ERR1C No, error 1410 68B8 0520 NEG @FAC Test if condition true i.e. <> 68BA 834A 1411 68BC 1610 JNE IFZ10 True - branch to the special # 1412 68BE 06A0 BL @PGMCHR Advance to line number token 68C0 6C74 1413 68C2 0288 CI R8,LNZ*256 Have the line # token? 68C4 C900 1414 68C6 1619 JNE IFZ20 No, must look harder for ELSE 1415 68C8 05E0 INCT @PGMPTR Skip the line number 68CA 832C 1416 68CC 06A0 BL @PGMCHR Get next token 68CE 6C74 1417 68D0 0288 IFZ5 CI R8,ELSEZ*256 Test if token is ELSE 68D2 8100 1418 68D4 1304 JEQ IFZ10 We do! So branch to the line # 1419 68D6 0460 B @EOL We don't, so better be EOL 68D8 65D6 1420 68DA 0460 GETL1Z B @GETL10 Get 1st token of clause 68DC 6764 1421 68DE 06A0 IFZ10 BL @PGMCHR Get 1st token of clause 68E0 6C74 1422 68E2 0288 CI R8,LNZ*256 Line # token? 68E4 C900 1423 68E6 13F9 JEQ GETL1Z Yes, go there 1424 68E8 06A0 BL @EOSTMT EOS? 68EA 6862 1425 68EC 1381 JEQ1C JEQ ERR1C Yes, its an error 1426 68EE 0208 LI R8,SSEPZ*256 Cheat to do a continue 68F0 8200 1427 68F2 0620 DEC @PGMPTR Back up to get 1st character 68F4 832C 1428 68F6 0460 B @CONT Continue on 68F8 64C8 1429 * 1430 * LOOK FOR AN ELSE CLAUSE SINCE THE CONDITION WAS FALSE 1431 * 1432 68FA 0203 IFZ20 LI R3,1 IF/ELSE pair counter 68FC 0001 1433 68FE 06A0 BL @EOLINE Trap out EOS following THEN/EL 6900 6872 1434 6902 13F4 JEQ JEQ1C error 1435 6904 0288 IFZ25 CI R8,ELSEZ*256 ELSE? 6906 8100 1436 6908 1603 JNE IFZ27 If not 1437 690A 0603 DEC R3 Matching ELSE? 1438 690C 13E8 JEQ IFZ10 Yes, do it 99/4 ASSEMBLER PARSES PAGE 0032 1439 690E 100F JMP IFZ35 No, go on 1440 6910 0288 IFZ27 CI R8,IFZ*256 Check for it 6912 8400 1441 6914 1602 JNE IFZ28 Not an IF 1442 6916 0583 INC R3 Increment nesting level 1443 6918 100A JMP IFZ35 And go on 1444 691A 0288 IFZ28 CI R8,STRINZ*256 Lower than string? 691C C700 1445 691E 1A04 JL IFZ30 Yes 1446 6920 0288 CI R8,LNZ*256 Higher or = to a line # 6922 C900 1447 6924 1307 JEQ IFZ40 = line # 1448 6926 1A09 JL IFZ50 Skip strings and numerics 1449 6928 06A0 IFZ30 BL @EOLINE EOL? 692A 6872 1450 692C 13D1 JEQ IFZ5 Yes, done scanning 1451 692E 06A0 IFZ35 BL @PGMCHR Get next character 6930 6C74 1452 6932 10E8 JMP IFZ25 And go on 1453 * 1454 * SKIP LINE #'s 1455 * 1456 6934 05E0 IFZ40 INCT @PGMPTR Skip the line # 6936 832C 1457 6938 10FA JMP IFZ35 Go on 1458 * 1459 * SKIP STRINGS AND NUMERICS 1460 * 1461 693A 06A0 IFZ50 BL @PGMCHR Get # of bytes to skip 693C 6C74 1462 693E 06C8 SWPB R8 Swap for add 1463 6940 A808 A R8,@PGMPTR Skip it 6942 832C 1464 6944 04C8 CLR R8 Clear LSB of R8 1465 6946 10F3 JMP IFZ35 1466 ************************************************************ 1467 1469 1470 ************************************************************ 1471 * 'LET' statement handler 1472 * Assignments are done bye putting an entry on the stack 1473 * for the destination variable and getting the source value 1474 * into the FAC. Multiple assignments are handled by the 1475 * stacking the variable entrys and then looping for the 1476 * assignments. Numeric assignments pose no problems, 1477 * strings are more complicated. String assignments are done 1478 * by assigning the source string to the last variable 1479 * specified in the list and changing the FAC entry so that 1480 * the string assigned to the next-to-the-last variable 1481 * comes from the permanent string belonging to the variable 1482 * just assigned. 1483 * e.g. A$,B$,C$="HELLO" 1484 * 1485 * C$-------"HELLO" (source string) 1486 * 1487 * B$-------"HELLO" (copy from C$'s string) 1488 * 1489 * A$-------"HELLO" (copy from B$'s string) 1490 ************************************************************ 99/4 ASSEMBLER PARSES2 PAGE 0033 1491 6948 04E0 NLET CLR @PAD0 Counter for multiple assign's 694A 8300 1492 694C 06A0 NLET05 BL @SYM Get symbol table address 694E 6312 1493 *----------------------------------------------------------- 1494 * The following code has been taken out for checking is 1495 * inserted in SMB 5/22/81 1496 * BL @GETV Get first byte of entry 1497 * DATA FAC SYM left pointer in FAC 1498 * SLA R1,1 Test if a UDF 1499 * JLT ERRMUV Is a UDF - so error 1500 *----------------------------------------------------------- 1501 6950 06A0 BL @SMB Get value space pointer 6952 61DC 1502 6954 06A0 BL @VPUSH Push s.t. pointer on stack 6956 6BAA 1503 6958 05A0 INC @PAD0 Count the variable 695A 8300 1504 695C 0288 CI R8,EQZ*256 Is the token an '='? 695E BE00 1505 6960 130B JEQ NLET10 Yes, go into assignment loop 1506 6962 0288 CI R8,COMMAZ*256 Must have a comma now 6964 B300 1507 6966 161E JNE ERR1CZ Didn't - so error 1508 6968 06A0 BL @PGMCHR Get next token 696A 6C74 1509 696C 15EF JGT NLET05 If legal symbol character 1510 696E 101A JMP ERR1CZ If not - error 1511 6970 0200 ERRMUV LI R0,>0D03 MULTIPLY USED VARIABLE 6972 0D03 1512 6974 0460 B @ERR 6976 6652 1513 6978 06A0 NLET10 BL @PGMCHR Get next token 697A 6C74 1514 697C 06A0 BL @PARSE PARSE the value to assign 697E 6480 1515 6980 83 BYTE TREMZ Parse to the end of statement 1516 6981 65 STCOD2 BYTE >65 Wasted byte (STCODE copy) 1517 * Loop for assignments 1518 6982 06A0 NLET15 BL @ASSG Assign the value to the symbol 6984 6334 1519 6986 0620 DEC @PAD0 One less to assign, done? 6988 8300 1520 698A 130A JEQ LETCON Yes, branch out 1521 698C 9820 CB @FAC2,@STCOD2 String or numeric? 698E 834C 6990 6981 1522 6992 16F7 JNE NLET15 Numeric, just loop for more 1523 6994 C806 MOV R6,@FAC4 Get pointer to new string 6996 834E 1524 6998 C820 MOV @ARG,@FAC Get pointer to last s.t. entry 699A 835C 699C 834A 1525 699E 10F1 JMP NLET15 Now loop to assign more 1526 69A0 0460 LETCON B @EOL Yes, continue the PARSE 69A2 65D6 1527 69A4 0460 ERR1CZ B @ERR1C For long distance jump 69A6 67F0 1528 69A8 664E DATA NONUD (SPARE) >80 99/4 ASSEMBLER PARSES2 PAGE 0034 1529 69AA 664E DATA NONUD ELSE >81 1530 69AC 65C4 DATA SMTSEP :: >82 1531 69AE 65E6 DATA NUDND1 ! >83 1532 69B0 68A6 DATA IF IF >84 1533 69B2 66D6 DATA GO GO >85 1534 69B4 675C DATA GOTO GOTO >86 1535 69B6 673A DATA GOSUB GOSUB >87 1536 69B8 67F8 DATA RETURN RETURN >88 1537 69BA 65F0 DATA NUDEND DEF >89 1538 69BC 65F0 DATA NUDEND DIM >8A 1539 69BE 665E DATA END END >8B 1540 69C0 7000 DATA NFOR FOR >8C 1541 69C2 6948 DATA NLET LET >8D 1542 69C4 8002 DATA >8002 BREAK >8E 1543 69C6 8004 DATA >8004 UNBREAK >8F 1544 69C8 8006 DATA >8006 TRACE >90 1545 69CA 8008 DATA >8008 UNTRACE >91 1546 69CC 8016 DATA >8016 INPUT >92 1547 69CE 65E6 DATA NUDND1 DATA >93 1548 69D0 8012 DATA >8012 RESTORE >94 1549 69D2 8014 DATA >8014 RANDOMIZE >95 1550 69D4 7230 DATA NNEXT NEXT >96 1551 69D6 800A DATA >800A READ >97 1552 69D8 665E DATA STOP STOP >98 1553 69DA 8032 DATA >8032 DELETE >99 1554 69DC 65E6 DATA NUDND1 REM >9A 1555 69DE 66DA DATA ON ON >9B 1556 69E0 800C DATA >800C PRINT >9C 1557 69E2 750A DATA CALL CALL >9D 1558 69E4 65F0 DATA NUDEND OPTION >9E 1559 69E6 8018 DATA >8018 OPEN >9F 1560 69E8 801A DATA >801A CLOSE >A0 1561 69EA 665E DATA STOP SUB >A1 1562 69EC 8034 DATA >8034 DISPLAY >A2 1563 69EE 65E6 DATA NUDND1 IMAGE >A3 1564 69F0 8024 DATA >8024 ACCEPT >A4 1565 69F2 664E DATA NONUD ERROR >A5 1566 69F4 664E DATA NONUD WARNING >A6 1567 69F6 78D2 DATA SUBXIT SUBEXIT >A7 1568 69F8 78D2 DATA SUBXIT SUBEND >A8 1569 69FA 800E DATA >800E RUN >A9 1570 69FC 8010 STMTTB DATA >8010 LINPUT >AA 1571 69FE 6E68 NTAB DATA NLPR LEFT PARENTHISIS >B7 1572 6A00 664E DATA NONUD CONCATENATE >B8 1573 6A02 664E DATA NONUD SPARE >B9 1574 6A04 664E DATA NONUD AND >BA 1575 6A06 664E DATA NONUD OR >BB 1576 6A08 664E DATA NONUD XOR >BC 1577 6A0A 6E2E DATA O0NOT NOT >BD 1578 6A0C 664E DATA NONUD = >BE 1579 6A0E 664E DATA NONUD < >BF 1580 6A10 664E DATA NONUD > >C0 1581 6A12 6E96 DATA NPLUS + >C1 1582 6A14 6E82 DATA NMINUS - >C2 1583 6A16 664E DATA NONUD * >C3 1584 6A18 664E DATA NONUD / >C4 1585 6A1A 664E DATA NONUD ^ >C5 1586 6A1C 664E DATA NONUD SPARE >C6 1587 6A1E 7442 DATA NSTRCN QUOTED STRING >C7 99/4 ASSEMBLER PARSES2 PAGE 0035 1588 6A20 6684 DATA NUMCON UNQUOTED STRING/NUMERIC >C8 1589 6A22 664E DATA NONUD LINE NUMBER >C9 1590 6A24 8026 DATA >8026 EOF >CA 1591 6A26 6CFA DATA NABS ABS >CB 1592 6A28 6D16 DATA NATN ATN >CC 1593 6A2A 6D1C DATA NCOS COS >CD 1594 6A2C 6D22 DATA NEXP EXP >CE 1595 6A2E 6D28 DATA NINT INT >CF 1596 6A30 6D2E DATA NLOG LOG >D0 1597 6A32 6D34 DATA NSGN SGN >D1 1598 6A34 6D64 DATA NSIN SIN >D2 1599 6A36 6D6A DATA NSQR SQR >D3 1600 6A38 6D70 DATA NTAN TAN >D4 1601 6A3A 8036 DATA >8036 LEN >D5 1602 6A3C 8038 DATA >8038 CHRZ >D6 1603 6A3E 803A DATA >803A RND >D7 1604 6A40 8030 DATA >8030 SEGZ >D8 1605 6A42 802A DATA >802A POS >D9 1606 6A44 802C DATA >802C VAL >DA 1607 6A46 802E DATA >802E STR >DB 1608 6A48 8028 DATA >8028 ASC >DC 1609 6A4A 801C DATA >801C PI >DD 1610 6A4C 8000 DATA >8000 REC >DE 1611 6A4E 801E DATA >801E MAX >DF 1612 6A50 8020 DATA >8020 MIN >E0 1613 6A52 8022 DATA >8022 RPTZ >E1 1614 0056 NTABLN EQU $-NTAB 1615 6A54 667E LTAB DATA CONC & >B8 1616 6A56 664E DATA NOLED SPARE >B9 1617 6A58 6E1C DATA O0OR OR >BA 1618 6A5A 6DFA DATA O0AND AND >BB 1619 6A5C 6E50 DATA O0XOR XOR >BC 1620 6A5E 664E DATA NOLED NOT >BD 1621 6A60 6A8E DATA EQUALS = >BE 1622 6A62 6A70 DATA LESS < >BF 1623 6A64 6A7E DATA GREATR > >C0 1624 6A66 6B1E DATA PLUS + >C1 1625 6A68 6B4A DATA MINUS - >C2 1626 6A6A 6B56 DATA TIMES * >C3 1627 6A6C 6B62 DATA DIVIDE / >C4 1628 6A6E 6CE2 DATA LEXP ^ >C5 1629 001C LTBLEN EQU $-LTAB 1630 ************************************************************ 1631 * Relational operators 1632 * Logical conparisons encode the type of comparison and use 1633 * common code to PARSE the expression and set the status 1634 * bits. 1635 * 1636 * The types of legal comparisons are: 1637 * 0 EQUAL 1638 * 1 NOT EQUAL 1639 * 2 LESS THAN 1640 * 3 LESS OR EQUAL 1641 * 4 GREATER THAN 1642 * 5 GREATER THAN OR EQUAL 1643 * 1644 * This code is saved on the subroutine stack 1645 ************************************************************ 1646 6A70 0202 LESS LI R2,2 LESS-THAN code for common rtn 99/4 ASSEMBLER PARSES2 PAGE 0036 6A72 0002 1647 6A74 0288 CI R8,GTZ*256 Test for '>' token 6A76 C000 1648 6A78 1604 JNE LT10 Jump if not 1649 6A7A 0642 DECT R2 Therefore, NOT-EQUAL code 1650 6A7C 1005 JMP LT15 Jump to common 1651 6A80 C4 EQU $+2 Constant 4 1652 6A7E 0202 GREATR LI R2,4 GREATER-THEN code for common 6A80 0004 1653 6A82 0288 LT10 CI R8,EQZ*256 Test for '=' token 6A84 BE00 1654 6A86 1605 JNE LTST01 Jump if '>=' 1655 6A88 06A0 LT15 BL @PGMCHR Must be plain old '>' or '<' 6A8A 6C74 1656 6A8C 1001 JMP LEDLE Jump to test 1657 6A8E 0702 EQUALS SETO R2 Equal bit for common routine 1658 6A90 0582 LEDLE INC R2 Sets to zero 1659 6A92 05C9 LTST01 INCT R9 Get room on stack for code 1660 6A94 C642 MOV R2,*R9 Save status matching code 1661 6A96 06A0 BL @PSHPRS Push 1st arg and PARSE the 2nd 6A98 6B9C 1662 6A9A C0 BYTE GTZ Parse to a '>' 1663 6A9B 69 CBH69 BYTE >69 Used in RETURN routine 1664 6A9C C119 MOV *R9,R4 Get the type code from stack 1665 6A9E 0649 DECT R9 Reset subroutine stack pointer 1666 6AA0 D324 MOVB @LTSTAB(R4),R12 Get address bias to baranch to 6AA2 6ADA 1667 6AA4 088C SRA R12,8 Right justify 1668 6AA6 06A0 BL @ARGTST Test for matching arguments 6AA8 6B6E 1669 6AAA 131A JEQ LTST20 Handle strings specially 1670 6AAC 06A0 BL @SCOMPB Floating point comparison 6AAE 0D42 1671 6AB0 046C LTST15 B @LTSTXX(R12) Interpret the status by code 6AB2 6AB4 1672 6AB4 LTSTXX EQU $ 1673 6AB4 1504 LTSTGE JGT LTRUE Test if GREATER or EQUAL 1674 6AB6 1303 LTSTEQ JEQ LTRUE Test if EQUAL 1675 6AB8 04C4 LFALSE CLR R4 FALSE is a ZERO 1676 6ABA 1003 JMP LTST90 Put it into FAC 1677 6ABC 13FD LTSTNE JEQ LFALSE Test if NOT-EQUAL 1678 6ABE 0204 LTRUE LI R4,>BFFF TRUE is a minus-one 6AC0 BFFF 1679 6AC2 0203 LTST90 LI R3,FAC Store result in FAC 6AC4 834A 1680 6AC6 CCC4 MOV R4,*R3+ Exp & 1st byte of manitissa 1681 6AC8 04F3 CLR *R3+ ZERO the remaining digits 1682 6ACA 04F3 CLR *R3+ ZERO the remaining digits 1683 6ACC 04F3 CLR *R3+ ZERO the remaining digits 1684 6ACE 1039 JMP LEDEND Jump to end of LED routine 1685 6AD0 13F6 LTSTLE JEQ LTRUE Test LESS-THAN or EQUAL 1686 6AD2 11F5 LTSTLT JLT LTRUE Test LESS-THEN 1687 6AD4 10F1 JMP LFALSE Jump to false 1688 6AD6 15F3 LTSTGT JGT LTRUE Test GREATER-THAN 1689 6AD8 10EF JMP LFALSE Jump to false 1690 * Data table for offsets for types 1691 6ADA 02 LTSTAB BYTE LTSTEQ-LTSTXX EQUAL (0) 1692 6ADB 08 BYTE LTSTNE-LTSTXX NOT EQUAL (1) 1693 6ADC 1E BYTE LTSTLT-LTSTXX LESS THEN (2) 99/4 ASSEMBLER PARSES2 PAGE 0037 1694 6ADD 1C BYTE LTSTLE-LTSTXX LESS or EQUAL (3) 1695 6ADE 22 BYTE LTSTGT-LTSTXX GREATER THEN (4) 1696 6ADF 00 BYTE LTSTGE-LTSTXX GREATER or EQUAL (5) 1697 6AE0 C2A0 LTST20 MOV @FAC4,R10 Pointer to string1 6AE2 834E 1698 6AE4 D1E0 MOVB @FAC7,R7 R7 = string2 length 6AE6 8351 1699 6AE8 06A0 BL @VPOP Get LH arg back 6AEA 6C2A 1700 6AEC C120 MOV @FAC4,R4 Pointer to string2 6AEE 834E 1701 6AF0 D1A0 MOVB @FAC7,R6 R6 = string2 length 6AF2 8351 1702 6AF4 D146 MOVB R6,R5 R5 will contain shorter length 1703 6AF6 91C6 CB R6,R7 Compare the 2 lengths 1704 6AF8 1101 JLT CSTR05 Jump if length2 < length1 1705 6AFA D147 MOVB R7,R5 Swap if length1 > length2 1706 6AFC 0985 CSTR05 SRL R5,8 Shift for speed and test zero 1707 6AFE 130D JEQ CSTR20 If ZERO-set status with length 1708 6B00 C0CA CSTR10 MOV R10,R3 Current character location 1709 6B02 058A INC R10 Increment pointer 1710 6B04 06A0 BL @GETV1 Get from VDP 6B06 1880 1711 6B08 D001 MOVB R1,R0 And save for comparison 1712 6B0A C0C4 MOV R4,R3 Current char location in ARG 1713 6B0C 0584 INC R4 Increment pointer 1714 6B0E 06A0 BL @GETV1 Get from VDP 6B10 1880 1715 6B12 9001 CB R1,R0 Compare the characters 1716 6B14 16CD JNE LTST15 Return with status if <> 1717 6B16 0605 DEC R5 Otherwise, decrement counter 1718 6B18 15F3 JGT CSTR10 And loop for each character 1719 6B1A 91C6 CSTR20 CB R6,R7 Status set by length compare 1720 6B1C 10C9 JMP LTST15 Return to do test of status 1721 * ARITHMETIC FUNCTIONS 1722 6B1E 06A0 PLUS BL @PSHPRS Push left arg and PARSE right 6B20 6B9C 1723 6B22 C2 BYTE MINUSZ,0 Stop on a minus!!!!!!!!!!!!!!! 6B23 00 1724 6B24 0202 LI R2,SADD Address of add routine 6B26 0D84 1725 6B28 04E0 LEDEX CLR @FAC10 Clear error code 6B2A 8354 1726 6B2C 06A0 BL @ARGTST Make sure both numerics 6B2E 6B6E 1727 6B30 132E JEQ ARGT05 If strings, error 1728 6B32 06A0 BL @SAVREG Save registers 6B34 1E8C 1729 6B36 0692 BL *R2 Do the operation 1730 6B38 06A0 BL @SETREG Restore registers 6B3A 1E7A 1731 6B3C D0A0 MOVB @FAC10,R2 Test for overflow 6B3E 8354 1732 6B40 1602 JNE LEDERR If overflow ->error 1733 6B42 0460 LEDEND B @CONT Continue the PARSE 6B44 64C8 1734 6B46 0460 LEDERR B @WARNZZ Overflow - issue warning 6B48 6662 1735 6B4A 06A0 MINUS BL @PSHPRS Push left arg and PARSE right 99/4 ASSEMBLER PARSES2 PAGE 0038 6B4C 6B9C 1736 6B4E C2 BYTE MINUSZ,0 Parse to a minus 6B4F 00 1737 6B50 0202 LI R2,SSUB Address of subtract routine 6B52 0D74 1738 6B54 10E9 JMP LEDEX Common code for the operation 1739 6B56 06A0 TIMES BL @PSHPRS Push left arg and PARSE right 6B58 6B9C 1740 6B5A C4 BYTE DIVIZ,0 Parse to a divide!!!!!!!!!!!!! 6B5B 00 1741 6B5C 0202 LI R2,SMULT Address of multiply routine 6B5E 0E8C 1742 6B60 10E3 JMP LEDEX Common code for the operation 1743 6B62 06A0 DIVIDE BL @PSHPRS Push left arg and PARSE right 6B64 6B9C 1744 6B66 C4 BYTE DIVIZ,0 Parse to a divide 6B67 00 1745 6B68 0202 LI R2,SDIV Address of divide routine 6B6A 0FF8 1746 6B6C 10DD JMP LEDEX Common code for the operation 1747 ************************************************************ 1748 * Test arguments on both the stack and in the FAC 1749 * Both must be of the same type 1750 * CALL: 1751 * BL @ARGTST 1752 * JEQ If string 1753 * JNE If numeric 1754 ************************************************************ 1755 6B6E C1A0 ARGTST MOV @VSPTR,R6 Get stack pointer 6B70 836E 1756 6B72 05C6 INCT R6 1757 6B74 D7E0 MOVB @R6LB,*R15 Load 2nd byte of stack address 6B76 83ED 1758 6B78 1000 NOP Kill some time 1759 6B7A D7C6 MOVB R6,*R15 Load 1st byte of stack address 1760 6B7C 1000 NOP Kill some time 1761 6B7E 9820 CB @XVDPRD,@CBH65 String in operand 1? 6B80 8800 6B82 65A7 1762 6B84 1606 JNE ARGT10 No, numeric 1763 6B86 9820 CB @FAC2,@CBH65 Yes, is other the same? 6B88 834C 6B8A 65A7 1764 6B8C 1306 JEQ ARGT20 Yes, do string comparison 1765 6B8E 0460 ARGT05 B @ERRT Data types don't match 6B90 630C 1766 NUMCHK 1767 6B92 9820 ARGT10 CB @FAC2,@CBH65 2nd operand can't be string 6B94 834C 6B96 65A7 1768 6B98 13FA JEQ ARGT05 If so, error 1769 6B9A 045B ARGT20 RT Ok, so return with status 1770 * VPUSH followed by a PARSE 1771 6B9C 05C9 PSHPRS INCT R9 Get room on stack 1772 6B9E 0289 CI R9,STKEND Stack full? 6BA0 83BA 1773 6BA2 1B41 JH VPSH27 Yes, error 1774 6BA4 C64B MOV R11,*R9 Save return on stack 1775 6BA6 020B LI R11,P05 Optimize for the parse 99/4 ASSEMBLER PARSES2 PAGE 0039 6BA8 648A 1776 * Stack VPUSH routine 1777 6BAA 0200 VPUSH LI R0,8 Pushing 8 byte entries 6BAC 0008 1778 6BAE A800 A R0,@VSPTR Update the pointer 6BB0 836E 1779 6BB2 C060 MOV @VSPTR,R1 Now get the new pointer 6BB4 836E 1780 6BB6 D7E0 MOVB @R1LB,*R15 Write new address to VDP chip 6BB8 83E3 1781 6BBA 0261 ORI R1,WRVDP Enable the write 6BBC 4000 1782 6BBE D7C1 MOVB R1,*R15 Write 1st byte of address 1783 6BC0 0201 LI R1,FAC Source is FAC 6BC2 834A 1784 6BC4 D831 VPSH15 MOVB *R1+,@XVDPWD Move a byte 6BC6 8C00 1785 6BC8 0600 DEC R0 Decrement the count, done? 1786 6BCA 15FC JGT VPSH15 No, more to move 1787 6BCC C00B MOV R11,R0 Save the return address 1788 6BCE 9820 CB @FAC2,@CBH65 Pushing a string entry? 6BD0 834C 6BD2 65A7 1789 6BD4 160E JNE VPSH20 No, so done 1790 6BD6 C1A0 MOV @VSPTR,R6 Entry on stack 6BD8 836E 1791 6BDA 0226 AI R6,4 Pointer to the string is here 6BDC 0004 1792 6BDE C060 MOV @FAC,R1 Get the string's owner 6BE0 834A 1793 6BE2 0281 CI R1,>001C Is it a tempory string? 6BE4 001C 1794 6BE6 1605 JNE VPSH20 No, so done 1795 6BE8 C060 VPSH19 MOV @FAC4,R1 Get the address of the string 6BEA 834E 1796 6BEC 1302 JEQ VPSH20 If null string, nothing to do 1797 6BEE 06A0 BL @STVDP3 Set the backpointer 6BF0 18AA 1798 6BF2 C060 VPSH20 MOV @VSPTR,R1 Check for buffer-zone 6BF4 836E 1799 6BF8 C16 EQU $+2 1800 6BF6 0221 AI R1,16 Correct by 16 6BF8 0010 1801 6BFA 8801 C R1,@STREND At least 16 bytes between stac 6BFC 831A 1802 * and string space? 1803 6BFE 1236 JLE VPOP18 Yes, so ok 1804 6C00 05C9 INCT R9 No, save return address 1805 6C02 C640 MOV R0,*R9 on stack 1806 6C04 06A0 BL @COMPCT Do the garbage collection 6C06 73D8 1807 6C08 C019 MOV *R9,R0 Restore return address 1808 6C0A 0649 DECT R9 Fix subroutine stack pointer 1809 6C0C C060 MOV @VSPTR,R1 Get value stack pointer 6C0E 836E 1810 6C10 0221 AI R1,16 Buffer zone 6C12 0010 1811 6C14 8801 C R1,@STREND At least 16 bytes now? 6C16 831A 99/4 ASSEMBLER PARSES2 PAGE 0040 1812 6C18 1229 JLE VPOP18 Yes, so ok 1813 6C1A 0200 VPSH23 LI R0,ERROM No, so MEMORY FULL error 6C1C 0103 1814 6C1E 06A0 VPSH25 BL @SETREG In case of GPL call 6C20 1E7A 1815 6C22 0460 B @ERR 6C24 6652 1816 6C26 0460 VPSH27 B @ERRSO STACK OVERFLOW 6C28 6468 1817 * Stack VPOP routine 1818 6C2A 0202 VPOP LI R2,FAC Destination in FAC 6C2C 834A 1819 6C2E C060 MOV @VSPTR,R1 Get stack pointer 6C30 836E 1820 6C32 8801 C R1,@STVSPT Check for stack underflow 6C34 8324 1821 6C36 121B JLE VPOP20 Yes, error 1822 6C38 D7E0 MOVB @R1LB,*R15 Write 2nd byte of address 6C3A 83E3 1823 6C3C 0200 LI R0,8 Popping 8 bytes 6C3E 0008 1824 6C40 D7C1 MOVB R1,*R15 Write 1st byte of address 1825 6C42 6800 S R0,@VSPTR Adjust stack pointer 6C44 836E 1826 6C46 DCA0 VPOP10 MOVB @XVDPRD,*R2+ Move a byte 6C48 8800 1827 6C4A 0600 DEC R0 Decrement the counter, done? 1828 6C4C 15FC JGT VPOP10 No, finish the work 1829 6C4E C00B MOV R11,R0 Save return address 1830 6C50 9820 CB @FAC2,@CBH65 Pop a string? 6C52 834C 6C54 65A7 1831 6C56 160A JNE VPOP18 No, so done 1832 6C58 04C6 CLR R6 For backpointer clear 1833 6C5A C0E0 MOV @FAC,R3 Get string owner 6C5C 834A 1834 6C5E 0283 CI R3,>001C Pop a temporary? 6C60 001C 1835 6C62 13C2 JEQ VPSH19 Yes, must free it 1836 6C64 06A0 BL @GET1 No, get new pointer from s.t. 6C66 6C9E 1837 6C68 C801 MOV R1,@FAC4 Set new pointer to string 6C6A 834E 1838 6C6C 0450 VPOP18 B *R0 And return 1839 6C6E 0200 VPOP20 LI R0,ERREX * SYNTAX ERROR 6C70 0403 1840 6C72 10D5 JMP VPSH25 1841 * The returned status reflects the character 1842 * RAMFLG = >00 | No ERAM or imperative statements 1843 * >FF | With ERAM and a program is being run 1844 6C74 D220 PGMCHR MOVB @RAMFLG,R8 Test ERAM flag 6C76 8389 1845 6C78 160A JNE PGMC10 ERAM and a program is being ru 1846 * Next label is for entry from SUBPROG. 1847 6C7A D7E0 PGMSUB MOVB @PGMPT1,*R15 Write 2nd byte of address 6C7C 832D 1848 6C7E 020A LI R10,XVDPRD Read data address 6C80 8800 1849 6C82 D7E0 MOVB @PGMPTR,*R15 Write 1st byte of address 99/4 ASSEMBLER PARSES2 PAGE 0041 6C84 832C 1850 6C86 05A0 INC @PGMPTR Increment the perm pointer 6C88 832C 1851 6C8A D21A MOVB *R10,R8 Read the character 1852 6C8C 045B RT And return 1853 6C8E C2A0 PGMC10 MOV @PGMPTR,R10 6C90 832C 1854 6C92 05A0 INC @PGMPTR 6C94 832C 1855 6C96 D23A MOVB *R10+,R8 Write 2nd byte of a address 1856 6C98 045B RT 1857 ************************************************************ 1858 6C9A AORG >6C9A 1860 1861 * (VDP to VDP) or (RAM to RAM) 1862 * GET,GET1 : Get two bytes of data from VDP 1863 * : R3 : address in VDP 1864 * : R1 : where the one byte data stored 1865 * PUT1 : Put two bytes of data into VDP 1866 * : R4 : address on VDP 1867 * : R1 : data 1868 * GETG,GETG2 : Get two bytes of data from ERAM 1869 * : R3 : address on ERAM 1870 * : R1 : where the two byte data stored 1871 * PUTG2 : Put two bytes of data into ERAM 1872 * : R4 : address on ERAM 1873 * : R1 : data 1874 * PUTVG1 : Put one byte of data into ERAM 1875 * : R4 : address in ERAM 1876 * : R1 : data 1877 1878 * Get two bytes from RAM(R3) into R1 1879 6C9A C0FB GET MOV *R11+,R3 1880 6C9C C0D3 MOV *R3,R3 1881 6C9E D7E0 GET1 MOVB @R3LB,*R15 6CA0 83E7 1882 6CA2 D7C3 MOVB R3,*R15 1883 6CA4 1000 NOP 1884 6CA6 D060 MOVB @XVDPRD,R1 6CA8 8800 1885 6CAA D820 MOVB @XVDPRD,@R1LB 6CAC 8800 6CAE 83E3 1886 6CB0 045B RT 1887 * Put two bytes from R1 to RAM(R4) 1888 6CB2 D7E0 PUT1 MOVB @R4LB,*R15 6CB4 83E9 1889 6CB6 0264 ORI R4,WRVDP 6CB8 4000 1890 6CBA D7C4 MOVB R4,*R15 1891 6CBC 1000 NOP 1892 6CBE D801 MOVB R1,@XVDPWD 6CC0 8C00 1893 6CC2 D820 MOVB @R1LB,@XVDPWD 6CC4 83E3 6CC6 8C00 1894 6CC8 045B RT 1895 * Get two bytes from ERAM(R3) to R1 1896 6CCA C0FB GETG MOV *R11+,R3 99/4 ASSEMBLER GETPUTS PAGE 0042 1897 6CCC C0D3 MOV *R3,R3 1898 6CCE GETG2 EQU $ 1899 6CCE D073 MOVB *R3+,R1 1900 6CD0 D813 MOVB *R3,@R1LB 6CD2 83E3 1901 6CD4 0603 DEC R3 1902 6CD6 045B RT 1903 * Put two bytes from R1 to ERAM(R4) 1904 6CD8 PUTG2 EQU $ 1905 6CD8 DD01 MOVB R1,*R4+ 1906 6CDA D520 MOVB @R1LB,*R4 6CDC 83E3 1907 6CDE 0604 DEC R4 Preserve R4 1908 6CE0 045B RT 1909 ************************************************************ 1910 6CE2 AORG >6CE2 1912 1913 6CE2 9820 LEXP CB @FAC2,@CBH63 Must have a numeric 6CE4 834C 6CE6 6D05 1914 6CE8 1B39 JH ERRSNM Don't, so error 1915 6CEA 06A0 BL @PSHPRS Push 1st and parse 2nd 6CEC 6B9C 1916 6CEE C5 BYTE EXPONZ,0 Up to another wxpon or less 6CEF 00 1917 6CF0 06A0 BL @STKCHK Make sure room on stack 6CF2 6DC0 1918 6CF4 0202 LI R2,PWRZZ Address of power routine 6CF6 7492 1919 6CF8 1049 JMP COMM05 Jump into common routine 1920 * ABS 1921 6CFA 0288 NABS CI R8,LPARZ*256 Must have a left parenthesis 6CFC B700 1922 6CFE 1630 JNE SYNERR If not, error 1923 6D00 06A0 BL @PARSE Parse the argument 6D02 6480 1924 6D04 CB BYTE ABSZ Up to another ABS 1925 6D05 63 CBH63 BYTE >63 Use the wasted byte 1926 6D06 9820 CB @FAC2,@CBH63 Must have numeric arg 6D08 834C 6D0A 6D05 1927 6D0C 1B27 JH ERRSNM If not, error 1928 6D0E 0760 ABS @FAC Take the absolute value 6D10 834A 1929 6D12 0460 BCONT B @CONT And continue 6D14 64C8 1930 * ATN 1931 6D16 0202 NATN LI R2,ATNZZ Load up arctan address 6D18 797C 1932 6D1A 102C JMP COMMON Jump into common rountine 1933 * COS 1934 6D1C 0202 NCOS LI R2,COSZZ Load up cosine address 6D1E 78B2 1935 6D20 1029 JMP COMMON Jump into common routine 1936 * EXP 1937 6D22 0202 NEXP LI R2,EXPZZ Load up exponential address 6D24 75CA 1938 6D26 1026 JMP COMMON Jump into common routine 1939 * INT 99/4 ASSEMBLER NUD359 PAGE 0043 1940 6D28 0202 NINT LI R2,GRINT Load up greatest integer addre 6D2A 79EC 1941 6D2C 1023 JMP COMMON Jump into common routine 1942 * LOG 1943 6D2E 0202 NLOG LI R2,LOGZZ Load up logarithm code 6D30 76C2 1944 6D32 1020 JMP COMMON Jump to common routine 1945 * SGN 1946 6D34 0288 NSGN CI R8,LPARZ*256 Must have left parenthesis 6D36 B700 1947 6D38 1613 JNE SYNERR If not, error 1948 6D3A 06A0 BL @PARSE Parse the argument 6D3C 6480 1949 6D3E D1 BYTE SGNZ,0 Up to another SGN 6D3F 00 1950 6D40 9820 CB @FAC2,@CBH63 Must have a numeric arg 6D42 834C 6D44 6D05 1951 6D46 1B0A JH ERRSNM If not, error 1952 6D48 0204 LI R4,>4001 Floating point one 6D4A 4001 1953 6D4C C020 MOV @FAC,R0 Check status 6D4E 834A 1954 6D50 13E0 JEQ BCONT If 0, return 0 1955 6D52 1502 JGT BLTST9 If positive, return +1 1956 6D54 0460 B @LTRUE If negative, return -1 6D56 6ABE 1957 6D58 0460 BLTST9 B @LTST90 Sets up the FAC w/R4 and 0s 6D5A 6AC2 1958 6D5C 0460 ERRSNM B @ERRT STRING-NUMBER MISMATCH 6D5E 630C 1959 6D60 0460 SYNERR B @ERRONE SYNTAX ERROR 6D62 664E 1960 * SIN 1961 6D64 0202 NSIN LI R2,SINZZ Load up sine address 6D66 78C0 1962 6D68 1005 JMP COMMON Jump into common routine 1963 * SQR 1964 6D6A 0202 NSQR LI R2,SQRZZ Load up square-root address 6D6C 783A 1965 6D6E 1002 JMP COMMON Jump into common routine 1966 * TAN 1967 6D70 0202 NTAN LI R2,TANZZ Load up tangent address 6D72 7940 1968 6D74 06A0 COMMON BL @STKCHK Make sure room on stacks 6D76 6DC0 1969 6D78 0288 CI R8,LPARZ*256 Must have left parenthesis 6D7A B700 1970 6D7C 16F1 JNE SYNERR If not, error 1971 6D7E 05C9 INCT R9 Get space on subroutine stack 1972 6D80 C642 MOV R2,*R9 Put address of routine on stac 1973 6D82 06A0 BL @PARSE Parse the argument 6D84 6480 1974 6D86 FF BYTE >FF,0 To end of the arg 6D87 00 1975 6D88 C099 MOV *R9,R2 Get address of function back 1976 6D8A 0649 DECT R9 Decrement subroutine stack 1977 6D8C 9820 COMM05 CB @FAC2,@CBH63 Must have a numeric arg 6D8E 834C 99/4 ASSEMBLER NUD359 PAGE 0044 6D90 6D05 1978 6D92 1BE4 JH ERRSNM If not, error 1979 6D94 04E0 CLR @FAC10 Assume no error or warning 6D96 8354 1980 6D98 06A0 BL @SAVREG Save Basic registers 6D9A 1E8C 1981 6D9C C802 MOV R2,@PAGE2 Select page 2 6D9E 6002 1982 6DA0 0692 BL *R2 Evaluate the function 1983 6DA2 C802 MOV R2,@PAGE1 Reselect Page 1 6DA4 6000 1984 6DA6 06A0 BL @SETREG Set registers up again 6DA8 1E7A 1985 6DAA D020 MOVB @FAC10,R0 Check for error or warning 6DAC 8354 1986 6DAE 13B1 JEQ BCONT If not error, continue 1987 6DB0 0990 SRL R0,9 Check for warning 1988 6DB2 1304 JEQ PWARN Warning, issue it 1989 6DB4 0200 LI R0,>0803 BAD ARGUMENT code 6DB6 0803 1990 6DB8 0460 B @ERR 6DBA 6652 1991 6DBC 0460 PWARN B @WARNZZ Issue the warning message 6DBE 6662 1992 6DC0 0289 STKCHK CI R9,STND12 Enough room on the subr stack? 6DC2 83AE 1993 6DC4 1B18 JH BSO No, memory full error 1994 6DC6 C020 MOV @VSPTR,R0 Get the value stack pointer 6DC8 836E 1995 6DCA 0220 AI R0,48 Buffer-zone of 48 bytes 6DCC 0030 1996 6DCE 8800 C R0,@STREND Room between stack & strings 6DD0 831A 1997 6DD2 1A0E JL STKRTN Yes, return 1998 6DD4 05C9 INCT R9 Get space on subr stack 1999 6DD6 CE4B MOV R11,*R9+ Save return address 2000 6DD8 CE42 MOV R2,*R9+ Save COMMON function code 2001 6DDA C640 MOV R0,*R9 Save v-stack pointer+48 2002 6DDC 06A0 BL @COMPCT Do a garbage collection 6DDE 73D8 2003 6DE0 8819 C *R9,@STREND Enough space now? 6DE2 831A 2004 6DE4 1406 JHE BMF No, MEMORY FULL error 2005 6DE6 0649 DECT R9 Decrement stack pointer 2006 6DE8 C099 MOV *R9,R2 Restore COMMON function code 2007 6DEA 0649 DECT R9 Decrement stack pointer 2008 6DEC C2D9 RETRN MOV *R9,R11 Restore return address 2009 6DEE 0649 DECT R9 Decrement stack pointer 2010 6DF0 045B STKRTN RT 2011 6DF2 0460 BMF B @VPSH23 * MEMORY FULL 6DF4 6C1A 2012 6DF6 0460 BSO B @ERRSO * STACK OVERFLOW 6DF8 6468 2013 ************************************************************ 2014 * LED routine for AND, OR, NOT, and XOR 2015 ************************************************************ 2016 6DFA 06A0 O0AND BL @PSHPRS Push L.H. and PARSE R.H. 6DFC 6B9C 2017 6DFE BB BYTE ANDZ,0 Stop on AND or less 99/4 ASSEMBLER NUD359 PAGE 0045 6DFF 00 2018 6E00 06A0 BL @CONVRT Convert both to integers 6E02 6E9E 2019 6E04 0560 INV @FAC Complement L.H. 6E06 834A 2020 6E08 4820 SZC @FAC,@ARG Perform the AND 6E0A 834A 6E0C 835C 2021 6E0E C820 O0AND1 MOV @ARG,@FAC Put back in FAC 6E10 835C 6E12 834A 2022 6E14 06A0 O0AND2 BL @CIF Convert back to floating 6E16 74AA 2023 6E18 0460 B @CONT Continue 6E1A 64C8 2024 6E1C 06A0 O0OR BL @PSHPRS Push L.H. and PARSE R.H. 6E1E 6B9C 2025 6E20 BA BYTE ORZ,0 Stop on OR or less 6E21 00 2026 6E22 06A0 BL @CONVRT Convert both to integers 6E24 6E9E 2027 6E26 E820 SOC @FAC,@ARG Perform the OR 6E28 834A 6E2A 835C 2028 6E2C 10F0 JMP O0AND1 Convert to floating and done 2029 6E2E 06A0 O0NOT BL @PARSE Parse the arg 6E30 6480 2030 6E32 BD BYTE NOTZ,0 Stop on NOT or less 6E33 00 2031 6E34 9820 CB @FAC2,@CBH63 Get a numeric back? 6E36 834C 6E38 6D05 2032 6E3A 1B49 JH ERRSN1 No, error 2033 6E3C 04E0 CLR @FAC10 Clear for CFI 6E3E 8354 2034 6E40 06A0 BL @CFI Convert to Integer 6E42 12B8 2035 6E44 D020 MOVB @FAC10,R0 Check for an error 6E46 8354 2036 6E48 168B JNE SYNERR Error 2037 6E4A 0560 INV @FAC Perform the NOT 6E4C 834A 2038 6E4E 10E2 JMP O0AND2 Convert to floating and done 2039 6E50 06A0 O0XOR BL @PSHPRS Push L.H. and PARSE R.H. 6E52 6B9C 2040 6E54 BC BYTE XORZ,0 Stop on XOR or less 6E55 00 2041 6E56 06A0 BL @CONVRT Convert both to integer 6E58 6E9E 2042 6E5A C020 MOV @ARG,R0 Get R.H. into register 6E5C 835C 2043 6E5E 2820 XOR @FAC,R0 Do the XOR 6E60 834A 2044 6E62 C800 MOV R0,@FAC Put result back in FAC 6E64 834A 2045 6E66 10D6 JMP O0AND2 Convert and continue 2046 ************************************************************ 2047 * NUD for left parenthesis 2048 ************************************************************ 99/4 ASSEMBLER NUD359 PAGE 0046 2049 6E68 0288 NLPR CI R8,RPARZ*256 Have a right paren already? 6E6A B600 2050 6E6C 1332 JEQ ERRSY1 If so, syntax error 2051 6E6E 06A0 BL @PARSE Parse inside the parenthesises 6E70 6480 2052 6E72 B7 BYTE LPARZ,0 Up to left parenthesis or less 6E73 00 2053 6E74 0288 CI R8,RPARZ*256 Have a right parenthesis now? 6E76 B600 2054 6E78 162C JNE ERRSY1 No, so error 2055 6E7A 06A0 BL @PGMCHR Get next token 6E7C 6C74 2056 6E7E 0460 BCON1 B @CONT And continue 6E80 64C8 2057 ************************************************************ 2058 * NUD for unary minus 2059 ************************************************************ 2060 6E82 06A0 NMINUS BL @PARSE Parse the expression 6E84 6480 2061 6E86 C2 BYTE MINUSZ,0 Up to another minus 6E87 00 2062 6E88 0520 NEG @FAC Make it negative 6E8A 834A 2063 6E8C 9820 NMIN10 CB @FAC2,@CBH63 Must have a numeric 6E8E 834C 6E90 6D05 2064 6E92 1B1D JH ERRSN1 If not, error 2065 6E94 10F4 JMP BCON1 Continue 2066 ************************************************************ 2067 * NUD for unary plus 2068 ************************************************************ 2069 6E96 06A0 NPLUS BL @PARSE Parse the expression 6E98 6480 2070 6E9A C1 BYTE PLUSZ,0 6E9B 00 2071 6E9C 10F7 JMP NMIN10 Use common code 2072 ************************************************************ 2073 * CONVRT - Takes two arguments, 1 form FAC and 1 from the 2074 * top of the stack and converts them to integer 2075 * from floating point, issuing appropriate errors 2076 ************************************************************ 2077 6E9E 05C9 CONVRT INCT R9 2078 6EA0 C64B MOV R11,*R9 SAVE RTN ADDRESS 2079 6EA2 06A0 BL @ARGTST ARGS MUST BE SAME TYPE 6EA4 6B6E 2080 6EA6 1313 JEQ ERRSN1 AND NON-STRING 2081 6EA8 04E0 CLR @FAC10 FOR CFI ERROR CODE 6EAA 8354 2082 6EAC 06A0 BL @CFI CONVERT R.H. ARG 6EAE 12B8 2083 6EB0 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EB2 8354 2084 6EB4 160A JNE ERRBV YES 2085 6EB6 C820 MOV @FAC,@ARG MOVE TO GET L.H. ARG 6EB8 834A 6EBA 835C 2086 6EBC 06A0 BL @VPOP GET L.H. BACK 6EBE 6C2A 2087 6EC0 06A0 BL @CFI CONVERT L.H. 99/4 ASSEMBLER NUD359 PAGE 0047 6EC2 12B8 2088 6EC4 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EC6 8354 2089 6EC8 1391 JEQ RETRN No, get rtn off stack and rtn 2090 * Yes, issue error 2091 6ECA 0460 ERRBV B @GOTO90 BAD VALUE 6ECC 670A 2092 6ECE 0460 ERRSN1 B @ERRT STRING NUMBER MISMATCH 6ED0 630C 2093 6ED2 0460 ERRSY1 B @ERRONE SYNTAX ERROR 6ED4 664E 2094 ************************************************************ 2095 6ED6 AORG >6ED6 2097 2098 2099 6ED6 0460 BSYNCH B @SYNCHK 6ED8 6400 2100 6EDA 0460 BERSYN B @ERRSYN 6EDC 664E 2101 6EDE 0460 BERSNM B @ERRT 6EE0 630C 2102 6EE2 D01D SPEED MOVB *R13,R0 Read XML code 2103 6EE4 0980 SRL R0,8 Shift for word value 2104 6EE6 13F7 JEQ BSYNCH 0 is index for SYNCHK 2105 6EE8 0600 DEC R0 Not SYNCHK, check further 2106 6EEA 1344 JEQ PARCOM 1 is index for PARCOM 2107 6EEC 0600 DEC R0 Not PARCOM, check further 2108 6EEE 1320 JEQ RANGE 2 is index for RANGE 2109 * All otheres assumed to be SEETWO 2110 ************************************************************ 2111 * Find the line specified by the number in FAC 2112 * Searches the table from low address (high number) to 2113 * high address (low number). 2114 ************************************************************ 2115 6EF0 020A SEETWO LI R10,SET Assume number will be found 6EF2 6192 2116 6EF4 0207 LI R7,GET1 Assume reading from the VDP 6EF6 6C9E 2117 6EF8 D020 MOVB @RAMTOP,R0 But correct 6EFA 8384 2118 6EFC 1302 JEQ SEETW2 If 2119 6EFE 0207 LI R7,GETG2 ERAM is present 6F00 6CCE 2120 6F02 C0E0 SEETW2 MOV @ENLN,R3 Get point to start from 6F04 8332 2121 6F06 0223 AI R3,-3 Get into table 6F08 FFFD 2122 6F0A 0697 SEETW4 BL *R7 Read the number from table 2123 6F0C 0241 ANDI R1,>7FFF Throw away possible breakpoint 6F0E 7FFF 2124 6F10 8801 C R1,@FAC Match the number needed? 6F12 834A 2125 6F14 130A JEQ SEETW8 Yes, return with condition set 2126 6F16 1B07 JH SEETW6 No, and also passed it =>retur 2127 6F18 0223 AI R3,-4 No, but sitll might be there 6F1A FFFC 2128 6F1C 8803 C R3,@STLN Reached end of table? 6F1E 8330 2129 6F20 14F4 JHE SEETW4 No, so check further 99/4 ASSEMBLER SPEEDS PAGE 0048 2130 6F22 C0E0 MOV @STLN,R3 End of table, default to last 6F24 8330 2131 6F26 020A SEETW6 LI R10,RESET Indicate not found 6F28 006A 2132 6F2A C803 SEETW8 MOV R3,@EXTRAM Put pointer in for GPL 6F2C 832E 2133 6F2E 045A B *R10 Return with condition 2134 6F30 C30B RANGE MOV R11,R12 Save return address 2135 6F32 9820 CB @FAC2,@CBH63 Have a numeric 6F34 834C 6F36 6D05 2136 6F38 1BD2 JH BERSNM Otherwise string number mismat 2137 6F3A 04E0 CLR @FAC10 Assume no conversion error 6F3C 8354 2138 6F3E 06A0 BL @CFI Convert from float to integer 6F40 12B8 2139 6F42 D020 MOVB @FAC10,R0 Get an error? 6F44 8354 2140 6F46 160E JNE RANERR Yes, indicate it 2141 6F48 D01D MOVB *R13,R0 Read lower limit 2142 6F4A 0980 SRL R0,8 Shift for word compare 2143 6F4C D05D MOVB *R13,R1 Read 1st byte of upper limit 2144 6F4E 06C1 SWPB R1 Kill time 2145 6F50 D05D MOVB *R13,R1 Read 2nd byte of upper limit 2146 6F52 06C1 SWPB R1 Restore upper limit 2147 6F54 C0A0 MOV @FAC,R2 Get the value 6F56 834A 2148 6F58 1105 JLT RANERR If negative, error 2149 6F5A 8002 C R2,R0 Less then low limit? 2150 6F5C 1103 JLT RANERR Yes, error 2151 6F5E 8042 C R2,R1 Greater then limit? 2152 6F60 1B01 JH RANERR Yes, error 2153 6F62 045C B *R12 All ok, so return 2154 6F64 06A0 RANERR BL @SETREG Set up registers for error 6F66 1E7A 2155 6F68 0460 B @GOTO90 * BAD VALUE 6F6A 670A 2156 * Make sure at a left parenthesis 2157 6F6C 9820 LPAR CB @CHAT,@LBLPZ At a left parenthesis 6F6E 8342 6F70 6F81 2158 6F72 16B3 JNE BERSYN No, syntax error 2159 * Parse up to a comma and insure at a comma 2160 6F74 06A0 PARCOM BL @PUTSTK Save GROM address 6F76 60F2 2161 6F78 06A0 BL @SETREG Set up R8/R9 6F7A 1E7A 2162 6F7C 06A0 BL @PARSE Parse the next item 6F7E 6480 2163 6F80 B3 BYTE COMMAZ Up to a comma 2164 6F81 B7 LBLPZ BYTE LPARZ 2165 6F82 0288 CI R8,COMMAZ*256 End on a comma? 6F84 B300 2166 6F86 16A9 JNE BERSYN No, syntax error 2167 6F88 06A0 BL @PGMCHR Yes, get character after it 6F8A 6C74 2168 6F8C 06A0 BL @SAVREG Save R8/R9 for GPL 6F8E 1E8C 2169 6F90 06A0 BL @GETSTK Restore GROM address 99/4 ASSEMBLER SPEEDS PAGE 0049 6F92 610E 2170 6F94 0460 B @RESET Return to GPL reset 6F96 006A 2171 ************************************************************ 2172 6F98 AORG >6F98 2174 2175 * (RAM to RAM) 2176 * WITH ERAM : Move the contents in ERAM FROM a higher 2177 * address to a lower address 2178 * ARG : byte count 2179 * VAR9 : source address 2180 * VAR0 : destination address 2181 2182 6F98 C060 MVUP MOV @ARG,R1 Get byte count 6F9A 835C 2183 6F9C C0E0 MOV @VAR9,R3 Get source 6F9E 8316 2184 6FA0 C160 MOV @VAR0,R5 Get destination 6FA2 8300 2185 6FA4 DD73 MVUP05 MOVB *R3+,*R5+ Move a byte 2186 6FA6 0601 DEC R1 Decrement the counter 2187 6FA8 16FD JNE MVUP05 Loop if more to move 2188 6FAA 045B RT 2189 ************************************************************ 2190 6FAC AORG >6FAC 2192 2193 * Get a non-space character 2194 6FAC C00B GETNB MOV R11,R0 Save return address 2195 6FAE 06A0 GETNB1 BL @GETCHR Get next character 6FB0 6FBA 2196 6FB2 0281 CI R1,' '*256 Space character? 6FB4 2000 2197 6FB6 13FB JEQ GETNB1 Yes, get next character 2198 6FB8 0450 B *R0 No, return character condition 2199 * Get the next character 2200 6FBA 8820 GETCHR C @VARW,@VARA End of line? 6FBC 8320 6FBE 832A 2201 6FC0 1B0E JH GETCH2 Yes, return condition 2202 6FC2 D7E0 MOVB @VARW1,*R15 No, write LSB of VDP address 6FC4 8321 2203 6FC6 0201 LI R1,>A000 Negative screen offset (->60) 6FC8 A000 2204 6FCA D7E0 MOVB @VARW,*R15 Write MSB of VDP address 6FCC 8320 2205 6FCE 05A0 INC @VARW Increment read-from pointer 6FD0 8320 2206 6FD2 B060 AB @XVDPRD,R1 Read and remove screen offset 6FD4 8800 2207 6FD6 0281 CI R1,>1F00 Read an edge character? 6FD8 1F00 2208 6FDA 13EF JEQ GETCHR Yes, skip it 2209 6FDC 045B RT Return 2210 6FDE 04C1 GETCH2 CLR R1 Indicate end of line 2211 6FE0 045B RT Return 2212 *----------------------------------------------------------- 2213 * Remove this routine from CRUNCH because CRUNCH is running 2214 * out of space 5/11/81 2215 *----------------------------------------------------------- 99/4 ASSEMBLER GETNBS PAGE 0050 2216 * Calculate and put length of string/number into 2217 * length byte 2218 6FE2 C0CB LENGTH MOV R11,R3 Save retun address 2219 6FE4 C020 MOV @RAMPTR,R0 Save current crunch pointer 6FE6 830A 2220 6FE8 C200 MOV R0,R8 Put into r8 for PUTCHR below 2221 6FEA 6205 S R5,R8 Calculate length of string 2222 6FEC 0608 DEC R8 RAMPTR is post-incremented 2223 6FEE C805 MOV R5,@RAMPTR Address of length byte 6FF0 830A 2224 6FF2 06A0 BL @PUTCHR Put the length in 6FF4 7F6E 2225 6FF6 C800 MOV R0,@RAMPTR Restore crunch pointer 6FF8 830A 2226 6FFA 0453 B *R3 And return 2227 * FILL IN BYTES OF MODULE WITH COPY OF ORIGINAL? 2228 6FFC 0000 DATA >0000 2229 6FFE EF71 DATA >EF71 ????? 2230 ************************************************************ 2231 2232 7000 AORG >7000 2234 2235 * 2236 * CONVERT THE NUMBER IN THE FAC TO A STRING 2237 * CALL : FAC NUMBER 2238 * R0 0 for free format(R1 & R2 are ignored) 2239 * Bit 0 on for fixed format 2240 * Bit 1 on for an explicit sign 2241 * Bit 2 on to output the sign of a positive 2242 * NO. as a plus sign ('+') instead of a space 2243 * (bit 1 must also be on) 2244 * Bit 3 on for E-notation output 2245 * Bit 4 also on for extended E-notation 2246 * R1 and R2 specify the field size. 2247 * R1 Number of places in the field to the left of 2248 * the decimal point including an explicit sign 2249 * and excluding the dicimal point. 2250 * R2 Number of places in the field to the right of 2251 * the decimal point. 2252 * R1 and R2 exclude ths 4 positions for the exponent 2253 * if bit 3 is on. 2254 * ERRORS: The field has more than 14 significant digits if 2255 * the number is too big to fit in the field. The 2256 * field is filled with asterisks. 2257 * The original contents of the FAC are lost. 2258 2259 2260 7000 0004 LWCNP DATA >0004 2261 7002 0008 LWCNE DATA >0008 2262 7004 0010 LWCNF DATA >0010 2263 * Integer power of ten table 2264 7006 2710 CNSITT DATA 10000 2265 7008 03E8 DATA 1000 2266 700A 00 LW100 BYTE 0 2267 700B 64 LB100 BYTE 100 2268 700C 00 LW10 BYTE 0 2269 700D 0A LB10 BYTE 10 2270 700E 0001 DATA 1 2271 7010 20 LBSPC BYTE ' ' 99/4 ASSEMBLER CNS359 PAGE 0051 2272 7011 2A LBAST BYTE '*' 2273 7012 2E LBPER BYTE '.' 2274 7013 45 LBE BYTE 'E' 2275 7014 30 LBZER BYTE '0' 2276 EVEN 2277 2278 7016 C28B CNS MOV R11,R10 In ROLOUT: use R10 to return 2279 7018 06A0 BL @ROLOUT 701A 7A90 2280 701C 05C9 INCT R9 2281 701E C64D MOV R13,*R9 2282 7020 0206 LI R6,FAC11 Optimize for space and speed 7022 8355 2283 7024 D036 MOVB *R6+,R0 @FAC11=0 if free format output 2284 7026 0980 SRL R0,8 Put in LSB 2285 7028 D076 MOVB *R6+,R1 @FAC12 places to left of dec 2286 702A 0981 SRL R1,8 Put in LSB 2287 702C D0B6 MOVB *R6+,R2 @FAC13 places to right of dec 2288 702E 0982 SRL R2,8 Put in LSB 2289 7030 DDA0 MOVB @LBSPC,*R6+ Put extra space at beginning 7032 7010 2290 * for CNSCHK 2291 7034 0203 LI R3,'-'*256 Assume number is negative 7036 2D00 2292 7038 0760 ABS @FAC Is number negative? 703A 834A 2293 703C 1107 JLT CNS01 Yes, its sign is known 2294 703E 0203 LI R3,' '*256 No, assume a space will be use 7040 2000 2295 7042 2420 CZC @LWCNP,R0 Do positive numbers get a plus 7044 7000 2296 * sign? 2297 7046 1302 JEQ CNS01 No, use a space 2298 7048 0203 LI R3,'+'*256 Yes, get a plus sign 704A 2B00 2299 704C DD83 CNS01 MOVB R3,*R6+ Put sign in buffer 2300 704E C800 MOV R0,@WSM Is free fomat output specified 7050 831A 2301 7052 1675 JNE CNSX No, use fix format output 2302 * FREE FORMAT FLOATING OUTPUT 2303 7054 C120 MOV @FAC,R4 Is it 0? 7056 834A 2304 7058 1611 JNE CNSF1 No 2305 705A 0606 DEC R6 2306 705C 0204 LI R4,' 0' Yes, convert to a '0' and quit 705E 2030 2307 7060 DD84 MOVB R4,*R6+ 2308 7062 DDA0 MOVB @R4LB,*R6+ 7064 83E9 2309 7066 04C4 CLR R4 Put 0 at end of string 2310 7068 D584 MOVB R4,*R6 2311 706A 0204 LI R4,>5902 Put the beginning of string 706C 5902 2312 * in FAC11, LENGTH in FAC12 2313 * FAC15=59, LENGTH=2 2314 706E D804 MOVB R4,@FAC11 7070 8355 2315 7072 D820 MOVB @R4LB,@FAC12 7074 83E9 99/4 ASSEMBLER CNS359 PAGE 0052 7076 8356 2316 7078 0460 B @ROLIN RT in ROLIN 707A 7AC4 2317 707C 06A0 CNSF1 BL @CNSTEN Get base ten exponent, is NO. 707E 72CA 2318 * less then one? 2319 7080 1112 JLT CNSF02 Yes, it can't be printed as an 2320 * integer 2321 7082 028D CI R13,9 No, is number to big to print 7084 0009 2322 7086 150F JGT CNSF02 Yes, round NO. for E-notataion 2323 * output 2324 7088 D820 MOVB @FAC,@R0LB No, check if the number is an 708A 834A 708C 83E1 2325 * integer, get exponent, high 2326 * byte is still zero 2327 708E 0220 AI R0,PAD0 R0=PAD+FAC+2-64 7090 8300 2328 7092 0220 AI R0,>C Get pointer to first 7094 000C 2329 * fractional byte 2330 7096 04C1 CNSF01 CLR R1 2331 7098 D070 MOVB *R0+,R1 Is next byte of fraction zero? 2332 709A 1605 JNE CNSF02 No, print NO. in fixed point 2333 * format 2334 709C 0280 CI R0,FAC8 Yes, reached end of number? 709E 8352 2335 70A0 1AFA JL CNSF01 No, continue looking at 2336 * fractional bytes 2337 70A2 04CA CLR R10 Yes, number is an integer, 2338 * set integer flag 2339 70A4 1011 JMP CNSF05 Go print the number, 2340 * no rounding is necessary 2341 70A6 0201 CNSF02 LI R1,5 Assume rounding for E-notation 70A8 0005 2342 70AA 028D CI R13,9 Is NO. too big for fixed point 70AC 0009 2343 * output? 2344 70AE 1509 JGT CNSF04 Yes, round for E-notataion 2345 70B0 028D CI R13,-4 No, is number to small for 70B2 FFFC 2346 * fixed point output? 2347 70B4 1106 JLT CNSF04 Yes, round for E-notation outp 2348 70B6 8C71 C *R1+,*R1+ Force R1 to =9 2349 70B8 028D CI R13,-2 No, will NO. be printed with 70BA FFFE 2350 * maximum number for fixed 2351 * format significant digits? 2352 70BC 1502 JGT CNSF04 Yes, round accordingly 2353 70BE 0581 INC R1 No, round number for maximum 2354 * significant digits (R1=10) 2355 70C0 A04D A R13,R1 That can be printed for this 2356 * number 2357 70C2 06A0 CNSF04 BL @CNSRND Round NO. accordingly, 70C4 7246 2358 * rounding can change the 2359 * exponent and so the print 2360 * format to be used 99/4 ASSEMBLER CNS359 PAGE 0053 2361 70C6 070A SETO R10 Set non-integer flag 2362 70C8 028D CNSF05 CI R13,9 Decide which print format to 70CA 0009 2363 70CC 152B JGT CNSG use, too big for fixed format 2364 70CE 028D CI R13,-6 Use E-notation number in range 70D0 FFFA 2365 * for max fixed point digits? 2366 70D2 1516 JGT CNSF08 Yes, use fixed format output 2367 70D4 028D CI R13,-10 No, NO. too small for fixed 70D6 FFF6 2368 * format? 2369 70D8 1125 JLT CNSG Yes, use E-notation ouput 2370 * No, the NO. of significant 2371 * digits will determine fixed 2372 * format ouput or not 2373 70DA 0200 LI R0,FAC8 Get pointer to last byte 70DC 8352 2374 * of FAC1 2375 70DE 04C1 CLR R1 Clear low byte of least 2376 * significant byte regester 2377 70E0 0203 LI R3,4 4=15-11 Get NO. of 70E2 0004 2378 * digits+2-exponent scale facto 2379 70E4 A0C7 A R7,R3 Take into acccount a leading 2380 * zero in FAC1 2381 70E6 0643 CNSF06 DECT R3 Decrement sig digit count for 2382 * last zero byte 2383 70E8 0600 DEC R0 Point to next higher byte of F 2384 70EA D050 MOVB *R0,R1 Is next byte all zero? 2385 70EC 13FC JEQ CNSF06 Yes, continue looking for LSB 2386 * No, found the LSB, this loop 2387 * will always terminate since 2388 * FAC1 never 0 2389 70EE 04C0 CLR R0 Take into account if the LSB i 2390 * divisible by ten 2391 70F0 06C1 SWPB R1 Is divisible by ten 2392 70F2 3C20 DIV @LW10,R0 Divide LSB by ten 70F4 700C 2393 70F6 C041 MOV R1,R1 Is the remainder zero? 2394 70F8 1601 JNE CNSF07 No, significant digit count is 2395 * correct 2396 70FA 0603 DEC R3 Yes, LSB has a trailing zero 2397 70FC 8343 CNSF07 C R3,R13 Too many significant digits fo 2398 * fixed format? 2399 70FE 1512 JGT CNSG Yes, use E-notation 2400 * FREE FORMAT FIXED POINT AND INTEGER FLOATING OUTPUT 2401 7100 6347 CNSF08 S R7,R13 Make the exponent even 2402 7102 110A JLT CNSF12 are there digits to left of 2403 * decimal point? Jump if not 2404 * Yes, print decimal point with 2405 * the number 2406 7104 0204 LI R4,3 Figure out where the decimal 7106 0003 2407 * point goes in 2408 7108 A10D A R13,R4 The number's digits 2409 710A 0203 CNSF10 LI R3,12 Convert the maximum number of 710C 000C 2410 * decimal digits, leading and 2411 * trailing zeros are suppressed 99/4 ASSEMBLER CNS359 PAGE 0054 2412 * later 2413 710E 06A0 BL @CNSDIG Convert number to decimal digi 7110 72E6 2414 7112 06A0 BL @CNSUTR Remove trailing zeros 7114 7408 2415 7116 1011 JMP CNSG01 Suppress leading zeros and 2416 7118 0700 CNSF12 SETO R0 figure out how many zeros 2417 * there are 2418 711A 600D S R13,R0 Between decimal point and 2419 * first digit 2420 711C 06A0 BL @CNSPER Put decimal point and zeros 711E 73B2 2421 * in buffer 2422 7120 04C4 CLR R4 Don't print another decimal 2423 * point in the number 2424 7122 10F3 JMP CNSF10 Convert NO. to decimal digits 2425 * finish up 2426 * FREE FORMAT E-NOTATION FLOATING OUTPUT 2427 7124 0203 CNSG LI R3,8 Get maximum NO. of digits to 7126 0008 2428 * print 2429 7128 0204 LI R4,3 Figure out where to put decima 712A 0003 2430 * point 2431 712C 6107 S R7,R4 Take a leading zero into accou 2432 712E 06A0 BL @CNSDIG Convert NO. to decimal digits 7130 72E6 2433 7132 06A0 BL @CNSUTR Suppress trailing zeros 7134 7408 2434 7136 06A0 BL @CNSEXP Put exponent into buffer 7138 7330 2435 713A 0460 CNSG01 B @CNSMLS Suppress leading zeros and 713C 73C4 2436 * finish up 2437 * FIXED FORMAT OUTPUT 2438 * WSM R0 format specifications 2439 * WSM2 R1 format specifications 2440 * WSM4 R2 format specifications 2441 * WSM6 Number of digit places to left of decimal point 2442 * WSM8 Number of digit places to right of decimal point 2443 713E C801 CNSX MOV R1,@WSM2 Save R1 format specifications 7140 831C 2444 7142 C802 MOV R2,@WSM4 Save R2 format specifications 7144 831E 2445 7146 2420 CZC @LWCNE,R0 Is E-notation to be used? 7148 7002 2446 714A 1606 JNE CNSX01 Yes, remove place for sign fro 2447 * left of DP count 2448 714C 0283 CI R3,'-'*256 No, is number negative? 714E 2D00 2449 7150 1303 JEQ CNSX01 Yes, remove sign from digit co 2450 7152 2420 CZC @LWCNS,R0 No, is explicit sign specified 7154 6000 2451 7156 1306 JEQ CNSX02 No, digit count correct as is 2452 7158 0601 CNSX01 DEC R1 Remove place for sign form lef 2453 * of DP digit count 2454 715A 1504 JGT CNSX02 Any places for digits left? 2455 715C 0283 CI R3,'-'*256 No, is number negative? 715E 2D00 99/4 ASSEMBLER CNS359 PAGE 0055 2456 7160 1301 JEQ CNSX02 Yes, can't do anything about i 2457 7162 04C1 CLR R1 No, see if NO. digits to left 2458 * of DP will work 2459 7164 C801 CNSX02 MOV R1,@WSM6 Save number of digits to left 7166 8320 2460 * of DP 2461 7168 1110 JLT CNSJ04 Field to small if there are 2462 * negative places 2463 716A 0602 DEC R2 Take decimal point from right 2464 * of DP count 2465 716C 1501 JGT CNSX03 Are there still places left? 2466 716E 04C2 CLR R2 No, don't print any digits the 2467 7170 C802 CNSX03 MOV R2,@WSM8 Save right of DP digit count 7172 8322 2468 7174 C101 MOV R1,R4 Compute how many significant 2469 * digits are to be printed 2470 7176 A102 A R2,R4 2471 7178 1308 JEQ CNSJ04 None, error 2472 * FALL INTO NO-TO FIXED FORMAT FLOATING OUTPUT 2473 * 2474 * Fixed format floating output 2475 717A 06A0 BL @CNSTEN Get base ten exponent of the F 717C 72CA 2476 717E 2420 CZC @LWCNE,R0 Is E-format call for? 7180 7002 2477 7182 1645 JNE CNSK Yes, go do it 2478 * FIXED FORMAT FLOATING F-FORMAT OUTPUT 2479 7184 880D C R13,@WSM6 Are there too many digits in 7186 8320 2480 * the number for the field size 2481 7188 1102 JLT CNSJ00 No, ok 2482 718A 0460 CNSJ04 B @CNSAST 718C 7440 2483 718E C04D CNSJ00 MOV R13,R1 No, get exponent 2484 7190 A042 A R2,R1 Compute where rounding should 2485 * take place 2486 7192 0281 CI R1,-1 Is the NO. too small for the 7194 FFFF 2487 * field? 2488 7196 112A JLT CNSVZR Yes, result is zero 2489 7198 06A0 BL @CNSRND No, round NO. to the proper 719A 7246 2490 * place 2491 719C 6347 S R7,R13 Convert exponent to an even 2492 * number 2493 719E 110D JLT CNSJ01 Any digits to left of DP? 2494 71A0 0700 SETO R0 Yes, compute how many zero are 2495 * needed before the number to 2496 * fill out the field to the 2497 * proper size 2498 71A2 A020 A @WSM6,R0 71A4 8320 2499 71A6 600D S R13,R0 2500 71A8 06A0 BL @CNSZER Put zeros in the buffer if 71AA 73BC 2501 * needed 2502 71AC 0203 LI R3,3 Compute the number of digits t 71AE 0003 2503 * convert 99/4 ASSEMBLER CNS359 PAGE 0056 2504 71B0 A0CD A R13,R3 Take into account the number's 2505 * size 2506 71B2 C103 MOV R3,R4 Yes, compute where the DP will 2507 * go 2508 71B4 A0E0 A @WSM8,R3 Take into account the NO. of 71B6 8322 2509 * decimal palces 2510 71B8 1011 JMP CNSJ02 Go convert the number 2511 71BA C0E0 CNSJ01 MOV @WSM8,R3 Number is less then one 71BC 8322 2512 71BE 1316 JEQ CNSVZR NO. decimal places, print zero 2513 71C0 C020 MOV @WSM6,R0 Get size of field to right of 71C2 8320 2514 71C4 0580 INC R0 Add one for CNSZER 2515 71C6 06A0 BL @CNSZER Fill field with zeros, they 71C8 73BC 2516 * will be suppressed 2517 71CA C306 MOV R6,R12 Save pointer to DP 2518 71CC 0700 SETO R0 Compute NO. of zeros after DP 2519 71CE 600D S R13,R0 And before the number 2520 71D0 06A0 BL @CNSPER Put them and a DP into the 71D2 73B2 2521 * buffer 2522 71D4 A0CD A R13,R3 Figure out how many digits to 2523 * convert 2524 71D6 0223 AI R3,3 Scale accordingly 71D8 0003 2525 71DA 04C4 CLR R4 Do not print a decimal point 2526 71DC 06A0 CNSJ02 BL @CNSDIG Convert the NO. decimal digits 71DE 72E6 2527 71E0 C020 MOV @WSM4,R0 Is a decimal point required? 71E2 831E 2528 71E4 1601 JNE CNSJ03 Yes, it is already there 2529 71E6 D700 MOVB R0,*R12 No, overwrite it with zero 2530 71E8 0460 CNSJ03 B @CNSCHK Go finish up 71EA 741A 2531 * FIXED FORMAT OUTPUT OF ZERO 2532 71EC C020 CNSVZR MOV @WSM6,R0 Get left of DP field size 71EE 8320 2533 71F0 0580 INC R0 Adjust it for CNSZER 2534 71F2 06A0 BL @CNSZER Put in correct amount of zeros 71F4 73BC 2535 71F6 C306 MOV R6,R12 Save pointer to where DP will 2536 * go 2537 71F8 C020 MOV @WSM4,R0 Is a DP called for? 71FA 831E 2538 71FC 1302 JEQ CNSV01 No, don't print one 2539 71FE 06A0 BL @CNSPER Yes, print it & some zeros 7200 73B2 2540 * after if needed 2541 7202 C020 CNSV01 MOV @WSM,R0 Get R0 format specification 7204 831A 2542 7206 2420 CZC @LWCNE,R0 Is E-format called for? 7208 7002 2543 720A 13EE JEQ CNSJ03 No, finish up 2544 720C 1019 JMP CNSK01 Yes, print an exponent 2545 * FIXED FORMAT FLOATING E-FORMAT OUTPUT 2546 720E C160 CNSK MOV @FAC,R5 Is it zero? 7210 834A 99/4 ASSEMBLER CNS359 PAGE 0057 2547 7212 1603 JNE CNSK1 No, go to CNSK1 2548 7214 04C7 CLR R7 Yes, do it differently: 2549 7216 04CD CLR R13 R7,R13 set to be 0 and jump 2550 7218 10E9 JMP CNSVZR to CNSVZR 2551 721A A042 CNSK1 A R2,R1 Get total number of digits to 2552 * print 2553 721C 0601 DEC R1 Compute where rounding should 2554 * occur 2555 721E 06A0 BL @CNSRND Round number for E-format outp 7220 7246 2556 7222 C0E0 MOV @WSM6,R3 Get number of digits to left 7224 8320 2557 * of DP 2558 7226 6343 S R3,R13 Compute what exponent should b 2559 * printed 2560 7228 058D INC R13 Scale properly 2561 722A 60C7 S R7,R3 Consider only even exponents 2562 722C 05C3 INCT R3 Compute number of digits to 2563 * print & where to put the 2564 * decimal point 2565 722E C103 MOV R3,R4 2566 7230 A0E0 A @WSM8,R3 Take digits to right of DP 7232 8322 2567 * into account 2568 7234 06A0 BL @CNSDIG Convert number to decimal digi 7236 72E6 2569 7238 C020 MOV @WSM4,R0 Is a decimal point needed? 723A 831E 2570 723C 1601 JNE CNSK01 Yes, leave it alone 2571 723E 0606 DEC R6 No, overwrite it with exponent 2572 7240 06A0 CNSK01 BL @CNSEXP Put exponent into the buffer 7242 7330 2573 7244 10D1 JMP CNSJ03 Finish up and zero suppress 2574 * ROUND THE NUMBER IN FAC 2575 * CALL R1 Number of decimal digits to right of most 2576 * significant digit to round to 2577 * R13 Base ten exponent 2578 * R7 0 if R13 is even, 1 if R13 is odd 2579 * BL CNSRND 2580 * STATUS Bits reflect exponent 2581 * R13 Base ten exponent of rounded result 2582 * R7 0 if R13 is even, 1 if R13 is odd 2583 * DESTORYS: R0-R3,R12,R10 2584 * ASSUMES R12 GE -1 2585 7246 05C9 CNSRND INCT R9 Save return address 2586 7248 C64B MOV R11,*R9 2587 724A 6341 S R1,R13 Compute base ten exponent of 2588 * place to round to 2589 724C 6047 S R7,R1 Take position of first digit 2590 * into account 2591 724E 0811 SRA R1,1 Compute address in FAC of byte 2592 * to be looked at 2593 7250 05C1 INCT R1 To determine if rounding occur 2594 7252 0203 LI R3,49*256 Assume 50 will be added to tha 7254 3100 2595 * byte 2596 7256 081D SRA R13,1 Rounding to an even ten's plac 2597 7258 1702 JNC CNSR01 Yes, assumption was correct 2598 725A 0203 LI R3,4*256 No,add 5 to byte to be looked 99/4 ASSEMBLER CNS359 PAGE 0058 725C 0400 2599 725E 0281 CNSR01 CI R1,7 Is all of FAC significant? 7260 0007 2600 7262 1531 JGT CNSR05 Yes, no need to round 2601 7264 0207 LI R7,FAC No, get pointer into FAC 7266 834A 2602 7268 04CC CLR R12 The number is positive 2603 726A D357 MOVB *R7,R13 Get current FAC exponent 2604 726C D28D MOVB R13,R10 Save it to see if it will chan 2605 726E 098D SRL R13,8 Put exponent in the low byte 2606 7270 A1C1 A R1,R7 Get address of byte to look at 2607 7272 B5C3 AB R3,*R7 Add NO. to add to round-1 into 2608 * correct byte 2609 7274 C2C3 MOV R3,R11 In ROUNUP: Change R3 value 2610 7276 C10A MOV R10,R4 In ROUNUP: Use R10 to return 2611 7278 020A LI R10,CNSROV 727A 7290 2612 727C D160 MOVB @FAC,R5 In ROUNUP: Get the exponent va 727E 834A 2613 * from EXP and EXP+1, 2614 * now provide 2615 7280 0985 SRL R5,8 2616 7282 C805 MOV R5,@EXP 7284 8376 2617 7286 D805 MOVB R5,@SIGN Clear sign which is used in RO 7288 8375 2618 728A C149 MOV R9,R5 In ROUNUP: R9 value may be 2619 * changed 2620 728C 0460 B @ROUNUP Propigate carry upwards in FAC 728E 0F64 2621 7290 C284 CNSROV MOV R4,R10 2622 7292 C0CB MOV R11,R3 2623 7294 C245 MOV R5,R9 2624 7296 04C1 CLR R1 Label prevents getting an 2625 * overflow warning 2626 7298 0287 CI R7,FAC1 Did rounding occur at first 729A 834B 2627 * byte of FAC? 2628 729C 1603 JNE CNSR02 No, go clear rest of FAC 2629 729E 92A0 CB @FAC,R10 Yes, did exponent change? 72A0 834A 2630 72A2 160C JNE CNSR03 Yes, FAC is correctly zeroed 2631 * as is 2632 72A4 0283 CNSR02 CI R3,4*256 Did rounding occur on a byte 72A6 0400 2633 * boundry? 2634 72A8 160A JNE CNSR04 Yes, clear rest of bytes in FA 2635 72AA 04C0 CLR R0 No, make this digit divisible 2636 * by ten 2637 72AC D817 MOVB *R7,@R1LB Get byte where rounding occure 72AE 83E3 2638 72B0 3C20 DIV @LW10,R0 Divide by ten to get quotient 72B2 700C 2639 72B4 3820 MPY @LW10,R0 Pack quotient back in, ignore 72B6 700C 2640 72B8 D5E0 MOVB @R1LB,*R7 Put the byte back into the FAC 72BA 83E3 2641 72BC 0587 CNSR03 INC R7 Point to next byte of FAC 2642 72BE DDC1 CNSR04 MOVB R1,*R7+ Zero next byte of FAC 99/4 ASSEMBLER CNS359 PAGE 0059 2643 72C0 0287 CI R7,FAC8 Done zeroing the rest of the 72C2 8352 2644 * FAC? 2645 72C4 1AFC JL CNSR04 No, continue to do it 2646 72C6 C2D9 CNSR05 MOV *R9,R11 Yes, restore return address 2647 72C8 0649 DECT R9 Get new base ten exponent of F 2648 * 2649 * GET BASE TEN EXPONENT OF THE NUMBER IN THE FAC 2650 * CALL BL CSNTEN 2651 * STATUS Status bits reflect exponent 2652 * R13 Base ten exponent 2653 * R7 0 if R13 is even, 1 it R13 is odd 2654 72CA 020D CNSTEN LI R13,->4000 Negative bias 72CC C000 2655 72CE B360 AB @FAC,R13 Get base 1 hundred exponent of 72D0 834A 2656 * FAC 2657 72D2 087D SRA R13,7 Multiply it by two and put it 2658 * in the low byte 2659 72D4 04C7 CLR R7 High bit of FAC1 is always off 2660 72D6 9820 CB @FAC1,@CBHA Is first digit of FAC one 72D8 834B 72DA 6004 2661 * decimal digit? 2662 72DC 1102 JLT CNST01 Yes, base ten exponent is even 2663 72DE 058D INC R13 No, take this into account in 2664 * base ten exponent 2665 72E0 0587 INC R7 This makes the base ten 2666 * exponent odd 2667 72E2 C34D CNST01 MOV R13,R13 Set stauts bits to reflect 2668 * base ten exponent 2669 72E4 045B RT 2670 * 2671 * CONVERT FACTION OF FLOATING NUMBER IN FAC TO ASCII DIGITS 2672 * CALL R3 Number of decimal digits+1 to convert 2673 * R4 Number of digits the decimal point is t 2674 * the left of 2675 * R6 Text pointer to where to put result 2676 * BL CNSDIG 2677 * R3(MB) 0 2678 * R6 Updated to point to end of digits 2679 * R12 Pointer to decimal point 2680 * DESTORYS: R0-R2,R4 2681 * 2682 72E6 05C9 CNSDIG INCT R9 Save return address 2683 72E8 C64B MOV R11,*R9 2684 72EA 04E0 CLR @FAC8 Clear guard digits in case the 72EC 8352 2685 * are printed 2686 72EE 04C1 CLR R1 Clear high byte of current byt 2687 * of FAC register 2688 72F0 0202 LI R2,FAC1 Get pointer to first byte of F 72F2 834B 2689 72F4 06A0 BL @CNSD03 Check for a leading dec point 72F6 7314 2690 72F8 04C0 CNSD01 CLR R0 Clear high word of this byte 2691 * of FAC for divide 2692 72FA D832 MOVB *R2+,@R1LB Get next byte of FAC 72FC 83E3 99/4 ASSEMBLER CNS359 PAGE 0060 2693 72FE 3C20 DIV @LW10,R0 Separate the two decimal digit 7300 700C 2694 7302 06A0 BL @CNSD02 Put the first one in the buffe 7304 730C 2695 7306 C001 MOV R1,R0 Get the one's place digit 2696 7308 020B LI R11,CNSD01 Set up return addressto loop a 730A 72F8 2697 * get the next byte of the FAC 2698 * after this digit is printed 2699 730C 0220 CNSD02 AI R0,'0' Convert this decimal digit to 730E 0030 2700 * ASCII 2701 7310 DDA0 MOVB @R0LB,*R6+ Put this ASCII digit into buff 7312 83E1 2702 7314 0604 CNSD03 DEC R4 Is it time for decimal point? 2703 7316 1603 JNE CNSD04 No, check for end of number 2704 7318 C306 MOV R6,R12 Yes, save ptr to decimal point 2705 731A DDA0 MOVB @LBPER,*R6+ Put decimal point in buffer 731C 7012 2706 * VSPTR (Value stack pointer) at CPU >6E, make sure not to 2707 * destroy it here 2708 731E 0286 CNSD04 CI R6,FAC33 Field overflow? 7320 836B 2709 7322 1402 JHE CNSD06 Yes, put a zero byte at the 2710 * end and return 2711 7324 0603 DEC R3 No, all digits been printed? 2712 7326 1503 JGT CNSDRT No, return & print next digit 2713 7328 D583 CNSD06 MOVB R3,*R6 Yes, put a zero byte at the en 2714 * of the number 2715 732A C2D9 CNSD05 MOV *R9,R11 Restore return address 2716 732C 0649 DECT R9 2717 732E 045B CNSDRT RT 2718 ************************************************************ 2719 2721 2722 * PUT EXPONENT INTO THE BUFFER 2723 * CALL R6 Text pointer into buffer 2724 * R13 Exponent 2725 * BL CNSEXP 2726 * R6 Updated to point after exponent 2727 * DESTORYS: R0,R13 2728 * 2729 7330 05C9 CNSEXP INCT R9 Save return address 2730 7332 CE4B MOV R11,*R9+ 2731 7334 C64C MOV R12,*R9 Save contents of registers 2732 7336 DDA0 MOVB @LBE,*R6+ Put an "E" into the buffer 7338 7013 2733 733A 0200 LI R0,'-'*256 Assume the exponent is negativ 733C 2D00 2734 733E 074D ABS R13 Is exponent negative? 2735 7340 1102 JLT CNSE01 Yes, sign is correct 2736 7342 0200 LI R0,'+'*256 No, get sign for positive exp 7344 2B00 2737 7346 DD80 CNSE01 MOVB R0,*R6+ Put the exponent's sign into 2738 * buffer 2739 7348 028D CI R13,100 Is the exponent to big? 734A 0064 2740 734C 110B JLT CNSE02 No, convert it to ASCII 2741 734E C020 MOV @WSM,R0 Is free format output? 99/4 ASSEMBLER CNS3592 PAGE 0061 7350 831A 2742 7352 1303 JEQ CNSE04 Yes, get the asterisk 2743 7354 2420 CZC @LWCNF,R0 No, is extended exp specified? 7356 7004 2744 7358 1605 JNE CNSE02 Yes, convert it to ASCII 2745 735A 0200 CNSE04 LI R0,'*'*256 No, get an asterisk 735C 2A00 2746 735E DD80 MOVB R0,*R6+ Put two asterisks in the buffe 2747 * for the exponent 2748 7360 DD80 MOVB R0,*R6+ Because it is too big 2749 7362 1015 JMP CNSE03 Go finish up 2750 7364 06A0 CNSE02 BL @CNSINT Convert the exp to ASCII digit 7366 7398 2751 7368 0226 AI R6,-5 Point back to start of exp 736A FFFB 2752 736C C020 MOV @WSM,R0 Is free format output? 736E 831A 2753 7370 130A JEQ CNSE05 Yes 2754 7372 2420 CZC @LWCNF,R0 No, is extended exp specified? 7374 7004 2755 7376 1307 JEQ CNSE05 No 2756 7378 DDA6 MOVB @2(R6),*R6+ Yes, move 3(instead of 2) 737A 0002 2757 * significant 2758 737C DDA6 MOVB @2(R6),*R6+ digits of exponent up pass th 737E 0002 2759 7380 DDA6 MOVB @2(R6),*R6+ leading zeros from CNSINT 7382 0002 2760 7384 1004 JMP CNSE03 2761 7386 DDA6 CNSE05 MOVB @3(R6),*R6+ Move significant digits of 7388 0003 2762 * exponent up pass the leading 2763 * zeros from 2764 738A DDA6 MOVB @3(R6),*R6+ CNSINT 738C 0003 2765 738E D5A0 CNSE03 MOVB @LW10,*R6 Put a zero byte at the end of 7390 700C 2766 * the number 2767 7392 C319 MOV *R9,R12 Restore original contents of 2768 * R12 2769 7394 0649 DECT R9 2770 7396 10C9 JMP CNSD05 POP address and return 2771 * CONVERT AN UNSIGNED INTEGER INTO A STRING OF 5 ASCII DIGIT 2772 * CALL R6 Text pointer 2773 * R13 Integer 2774 * BL CNSINT 2775 * R6 Updated to point after number 2776 * DESTROYS: R0,R12,R13 2777 7398 0200 CNSINT LI R0,CNSITT Get pointer to integer power o 739A 7006 2778 * ten table 2779 739C 04CC CNSI01 CLR R12 Clear high word of integer for 2780 * divide 2781 739E 3F30 DIV *R0+,R12 Divide by next power of ten 2782 73A0 022C AI R12,'0' Convert quotient to ASCII 73A2 0030 2783 73A4 DDA0 MOVB @R12LB,*R6+ Put next digit into the buffer 73A6 83F9 2784 73A8 0280 CI R0,CNSITT+10 Divided by all the powers of t 99/4 ASSEMBLER CNS3592 PAGE 0062 73AA 7010 2785 73AC 1AF7 JL CNSI01 No, compute the next digit of 2786 * the NO. 2787 73AE D58C MOVB R12,*R6 Yes, put a zero byte at the 2788 * end of the number 2789 73B0 045B RT 2790 * PUT SOME ZEROS IN THE BUFFER AND MAYBE A DECIMAL POINT 2791 * CALL R0 Number of zeros+1 2792 * R6 Text pinter into buffer 2793 * BL CNSPER : To put in a decimal point before zeros 2794 * BL CNSZER : Updated to point after the zeros 2795 * DESTROYS: R0 2796 73B2 DDA0 CNSPER MOVB @LBPER,*R6+ Put a decimal point in the buf 73B4 7012 2797 73B6 1002 JMP CNSZER Then some zeros 2798 73B8 DDA0 CNSZ01 MOVB @LBZER,*R6+ Put a zero in the buffer 73BA 7014 2799 73BC 0600 CNSZER DEC R0 Are there more zeros to put in 2800 73BE 15FC JGT CNSZ01 Yes, go put in another zero 2801 73C0 D580 MOVB R0,*R6 No, put a null byte after the 2802 * zeros 2803 73C2 045B RT 2804 * SUPPRESS LEADING ZEROS AND FLOAT THE SIGN 2805 * CALL 2806 * JMP CNSMLS : Entry to finish up after zero suppressin 2807 * BL CNSLEA : Entry to return afterwards 2808 * R1 ASCII sign in high byte 2809 * R6 Pointer to start of number 2810 * DESTROYS: R0-R1 2811 73C4 020B CNSMLS LI R11,CNSSTR Entry to finish up number 73C6 746A 2812 * afterward 2813 73C8 0206 CNSLEA LI R6,FAC15 Get pointer to sign 73CA 8359 2814 73CC D056 MOVB *R6,R1 Get sign 2815 73CE DDA0 CNSL01 MOVB @LBSPC,*R6+ Put a space where the zero 73D0 7010 2816 * or sign was 2817 73D2 9816 CB *R6,@LBZER Is the next byte zero? 73D4 7014 2818 73D6 13FB JEQ CNSL01 Yes, suppress it 2819 73D8 D016 MOVB *R6,R0 No, is this the end of 2820 * the number? 2821 73DA 130F JEQ CNSL02 Yes, put the zero back in, 2822 * NO. is 0 2823 73DC 9800 CB R0,@LBE No, is this the start of 73DE 7013 2824 * the exponent? 2825 73E0 130C JEQ CNSL02 Yes, put the zero back in, 2826 * NO. is 0 2827 73E2 9800 CB R0,@LBPER No, is this the decimal point? 73E4 7012 2828 73E6 160C JNE CNSL03 No, put the sign back in 2829 73E8 C020 MOV @WSM,R0 Yes, is free format output? 73EA 831A 2830 73EC 1609 JNE CNSL03 No, then put the sign 2831 * back in fix fomat output 2832 73EE D026 MOVB @1(R6),R0 Yes, any digits to right of DP 73F0 0001 99/4 ASSEMBLER CNS3592 PAGE 0063 2833 73F2 1303 JEQ CNSL02 No, put the sign back 2834 73F4 9800 CB R0,@LBE Does exponent start after DP? 73F6 7013 2835 73F8 1603 JNE CNSL03 No, put the sign back 2836 73FA 0606 CNSL02 DEC R6 Yes, point back to where the 2837 * zero was 2838 73FC D5A0 MOVB @LBZER,*R6 Put the zero back in, the NO. 73FE 7014 2839 * is 0 2840 7400 0606 CNSL03 DEC R6 Point back to where the sign 2841 * will go 2842 7402 D581 MOVB R1,*R6 Put the sign back in the buffe 2843 7404 045B RT 2844 * REMOVE TRAILING ZEROS 2845 * CALL R3 0 2846 * R6 Pointer to one past end of number 2847 * R12 Pointer to decimal point 2848 * R10 Zero if an integer is being printed 2849 * BL CNSUTR 2850 * R6 Pointer to new end of number 2851 * DESTROYS: NONE 2852 7406 0606 CNSU01 DEC R6 Point back to next digit in 2853 * the NO. 2854 7408 9826 CNSUTR CB @-1(R6),@LBZER Is the last digit in the NO. 0 740A FFFF 740C 7014 2855 740E 13FB JEQ CNSU01 Yes, look back for a non-zero 2856 * digit 2857 7410 C28A MOV R10,R10 No, is an integer being printe 2858 7412 1601 JNE CNSU02 No, put a null at the end of 2859 * the NO. 2860 7414 C18C MOV R12,R6 Yes, end of number is where DP 2861 * is all digits after the 2862 * decimal point should be zero 2863 7416 D583 CNSU02 MOVB R3,*R6 Put a zero byte at the end of 2864 * the number 2865 7418 045B RT 2866 * SET UP A POINTER TO THE BEGINNING OF A FIXED FORMAT FIELD 2867 * AND SEE IF THE FIELD IS LARGE ENOUGH AND FINISH UP 2868 * CALL R12 Pointer to decimal point or where it 2869 * would go 2870 * JMP CNSCHK 2871 * R6 Pointer to beginning of number 2872 * DESTROYS: R0,R1 2873 741A 06A0 CNSCHK BL @CNSLEA Suppress leading zeros and fix 741C 73C8 2874 * up the sign 2875 741E C18C MOV R12,R6 Point to decimal point 2876 7420 61A0 S @WSM2,R6 Point to where the beginning o 7422 831C 2877 * the field is 2878 7424 9826 CB @-1(R6),@LBSPC Does number extend before the 7426 FFFF 7428 7010 2879 * field beginning? 2880 742A 160A JNE CNSAST Yes, error 2881 742C C020 MOV @WSM,R0 No, get R0 format specificatio 742E 831A 2882 7430 2420 CZC @LWCNS,R0 Is an explicit sign required? 99/4 ASSEMBLER CNS3592 PAGE 0064 7432 6000 2883 7434 131A JEQ CNSSTR No, finish up and return 2884 7436 9816 CB *R6,@LBSPC Yes, is first character of 7438 7010 2885 * number a space? 2886 743A 1317 JEQ CNSSTR Yes, finish up and return 2887 743C 9056 CB *R6,R1 No, is first character of 2888 * number the sign? 2889 743E 1315 JEQ CNSSTR Yes, finish up and return 2890 * No, error 2891 * ASTRISK FILL A FIXED FORMAT FIELD AND FINISH UP 2892 * CALL 2893 * JMP CNSAST 2894 * R6 Pointer to the beginning of the string 2895 * DESTROYS: R0,R1 2896 7440 0206 CNSAST LI R6,WSM Optimize for speed and space 7442 831A 2897 7444 C036 MOV *R6+,R0 Get R0 format spacification 2898 7446 C076 MOV *R6+,R1 Get left of decimal point size 2899 7448 A076 A *R6+,R1 Compute length of field 2900 744A 2420 CZC @LWCNE,R0 Is E-format being used? 744C 7002 2901 744E 1305 JEQ CNSA01 No, field length is correct 2902 7450 8C71 C *R1+,*R1+ Yes, increase field length for 2903 * the exponent (Increments R1 2904 * by 4) 2905 7452 2420 CZC @LWCNF,R0 Is extended E-format being use 7454 7004 2906 7456 1301 JEQ CNSA01 No, field length is correct 2907 7458 0581 INC R1 Yes, increase field length for 2908 * the exponent (Increments R1 2909 * by 1) 2910 745A 0206 CNSA01 LI R6,FAC15 Get pointer to beginning of bu 745C 8359 2911 745E C006 MOV R6,R0 Get a pointer to put asterisks 2912 * in the buffer 2913 7460 DC20 CNSA02 MOVB @LBAST,*R0+ Put an asterisk into the buffe 7462 7011 2914 7464 0601 DEC R1 Is the field filled yet? 2915 7466 15FC JGT CNSA02 No, continue asterisk filling 2916 7468 D401 MOVB R1,*R0 Yes, put a zero byte at the en 2917 * of string 2918 * Finish up and return 2919 * FINSH UP -- COMPUTE THE LENGTH OF THE STRING AND RETURN 2920 * CALL R6 Pointer to first character in the string, 2921 * the string ends with a zero byte 2922 * DESTROYS: R0-R1 2923 746A C006 CNSSTR MOV R6,R0 Get pointer to beginning of th 2924 * string 2925 746C D070 CNSS01 MOVB *R0+,R1 Look for end of string, 2926 * found it? 2927 746E 16FE JNE CNSS01 No, keep looking 2928 7470 0600 DEC R0 Yes, point to back to the 2929 * zero byte 2930 7472 6006 S R6,R0 Compute length of string 2931 7474 D820 MOVB @R0LB,@FAC12 Put length of string in FAC12 7476 83E1 7478 8356 2932 747A 0200 LI R0,PAD0 99/4 ASSEMBLER CNS3592 PAGE 0065 747C 8300 2933 747E 6180 S R0,R6 Put beginning of string 2934 * in FAC11 2935 7480 D820 MOVB @R6LB,@FAC11 7482 83ED 7484 8355 2936 7486 C359 MOV *R9,R13 Restore GROM address 2937 7488 0649 DECT R9 Off the stack 2938 748A 0460 B @ROLIN In ROLIN return 748C 7AC4 2939 ************************************************************ 2940 748E AORG >748E 2942 2943 748E 4101 CBH411 DATA >4101 2944 2945 7490 3F CBH3F BYTE >3F 2946 7491 44 CBH44 BYTE >44 2947 EVEN 2948 * 2949 * VROAZ EQU >03C0 VDP roll out area 2950 * FPSIGN EQU >03DC 2951 * PROAZ EQU PAD0+>10 Processor roll out area 2952 * PZ EQU PAD0+>12 2953 * QZ EQU PAD0+>16 2954 * CZ EQU PAD0+>1A 2955 * SGNZ EQU PAD0+>75 2956 * EXPZ EQU PAD0+>76 2957 * OEZ EQU PAD0+>14 2958 0000 EXC127 EQU >00 2959 0008 FHALF EQU >08 2960 0010 SQRTEN EQU >10 2961 0018 LOG10E EQU >18 2962 0020 LN10 EQU >20 2963 0028 PI2 EQU >28 2964 0030 RPI2 EQU >30 2965 0038 PI4 EQU >38 2966 0040 TANPI8 EQU >40 2967 0048 TAN3P8 EQU >48 2968 0050 SQRP EQU >50 2969 006A SQRQ EQU >6A 2970 006A FPOS1 EQU >6A 2971 007C EXPP EQU >7C 2972 0096 EXPQ EQU >96 2973 00B8 LOGP EQU >B8 2974 00E2 LOGQ EQU >E2 2975 010C SINP EQU >010C 2976 014E ATNP EQU >014E 2977 2978 ************************************************************ 2979 * INVOLUTION 2980 * FAC - exponent 2981 * Top of stack - Base 2982 * If integer Base and integer exponent do multiplies to 2983 * keep result exact, otherwise, use logarithm to calculate 2984 * value. 2985 ************************************************************ 2986 7492 C28B PWRZZ MOV R11,R10 2987 7494 06A0 BL @SAVRTN Save return 7496 7AB2 99/4 ASSEMBLER TRINSICS PAGE 0066 2988 7498 06A0 BL @POPSTK Get Base into ARG 749A 60D4 2989 749C C020 MOV @FAC,R0 If exponent=0 749E 834A 2990 74A0 1359 JEQ PWRG01 Then result = 1 2991 74A2 C020 MOV @ARG,R0 If Base=0 74A4 835C 2992 74A6 1352 JEQ PWRG02 Then return 0 or warning 2993 74A8 A820 A @C8,@VSPTR Use Base on stack 74AA 7AF4 74AC 836E 2994 74AE 06A0 BL @PUSH Check to see if E is floating 74B0 7AF2 2995 * integer 2996 74B2 06A0 BL @GRINT Convert 1 copy of exp to int 74B4 79EC 2997 74B6 D820 MOVB @C8,@SIGN Assume sign is positive 74B8 7AF4 74BA 8375 2998 74BC 06A0 BL @XTFACZ FAC=ARG STACK=INT(ARG) 74BE 7B34 2999 74C0 06A0 BL @SCOMPB Integer exponent? 74C2 0D42 3000 74C4 164D JNE PWRZZ3 No, try floating code 3001 * COMPUTE INTEGER POWER B^E 3002 74C6 06A0 BL @PUSH Put Exp above Base on stack 74C8 7AF2 3003 74CA D820 MOVB @C8,@FAC10 Assume no error 74CC 7AF4 74CE 8354 3004 74D0 06A0 BL @CFI Try to convert E to integer 74D2 12B8 3005 74D4 0760 CCBH7 ABS @FAC Absolute value of exponent 74D6 834A 3006 74D8 C320 MOV @FAC,R12 Save integer exponent 74DA 834A 3007 74DC 06A0 BL @POP Return E to FAC; B on stack 74DE 7B16 3008 74E0 D020 MOVB @FAC10,R0 If E>32767 74E2 8354 3009 74E4 1648 JNE PWRZZ1 Return to floating point code 3010 74E6 06A0 BL @XTFACZ Get Base in accumulator 74E8 7B34 3011 74EA 06A0 BL @PUSH Put E on stack for later sign 74EC 7AF2 3012 * check 3013 74EE 060C DEC R12 Reduce exponent by one since 3014 * accumulator starts with Base 3015 74F0 1312 JEQ PWRJ40 If 0 then done already 3016 74F2 091C PWRJ30 SRL R12,1 Check l.s. bit 3017 74F4 1705 JNC PWRJ10 If 0, skip the work 3018 74F6 06A0 BL @SMULT Multiply in this power 74F8 0E8C 3019 74FA A820 A @C8,@VSPTR Restore stack 74FC 7AF4 74FE 836E 3020 7500 C30C PWRJ10 MOV R12,R12 Finished? 3021 7502 1309 JEQ PWRJ40 Yes 3022 7504 06A0 BL @XTFACZ No, exchange: B in FAC, 99/4 ASSEMBLER TRINSICS PAGE 0067 7506 7B34 3023 * accumulator on stack 3024 7508 06A0 BL @PUSH Copy B onto stack 750A 7AF2 3025 750C 06A0 BL @SMULT Square it for new B 750E 0E8C 3026 7510 06A0 BL @XTFACZ Restore order: B on stack 7512 7B34 3027 * accumulator in FAC 3028 7514 10EE JMP PWRJ30 Loop for next bit 3029 7516 6820 PWRJ40 S @C16,@VSPTR Done, clean up 7518 6BF8 751A 836E 3030 751C C0E0 MOV @VSPTR,R3 Get stack pointer 751E 836E 3031 7520 0223 AI R3,8 Test exponent sign now 7522 0008 3032 7524 06A0 BL @GETV1 Get it 7526 1880 3033 7528 1102 JLT PWRJ41 If negative, compute negative 3034 752A 0460 PWRRTN B @ROLIN2 Use commone code to return 752C 7AE0 3035 752E D020 PWRJ41 MOVB @FAC10,R0 If overflow has occured 7530 8354 3036 7532 1606 JNE PWRJ45 Go make it zero 3037 7534 06A0 BL @MOVROM Get a floating point one 7536 7A70 3038 7538 006A DATA FPOS1 into ARG 3039 * 3040 753A 06A0 BL @FDIV Compute the inverse 753C 0FF4 3041 753E 10F5 JMP PWRRTN And return 3042 7540 04E0 PWRJ45 CLR @FAC If overflow, the result=0 7542 834A 3043 7544 D820 MOVB @FAC,@FAC10 Indicate no error 7546 834A 7548 8354 3044 754A 10EF JMP PWRRTN And return 3045 754C D020 PWRG02 MOVB @FAC,R0 Is Exp negative? 754E 834A 3046 7550 1139 JLT PWRG05 Yes, divide by 0 =>put in over 3047 7552 10F6 JMP PWRJ45 No, result is zero and return 3048 7554 0200 PWRG01 LI R0,FAC Need to put floating 1 in FAC 7556 834A 3049 7558 06A0 BL @MOVRM1 Get the floating 1 755A 7A74 3050 755C 006A DATA FPOS1 into FAC 3051 * 3052 755E 10E5 JMP PWRRTN And return 3053 7560 06A0 PWRZZ3 BL @GETV Check for negative 7562 187C 3054 7564 836E DATA VSPTR On the stack 3055 * 3056 7566 1517 JGT PWRZZ2 If ok 3057 7568 D820 MOVB @ERRNIP,@FAC10 Else error code 756A 75BE 756C 8354 3058 756E 6820 S @C8,@VSPTR Throw away entry on stack 7570 7AF4 99/4 ASSEMBLER TRINSICS PAGE 0068 7572 836E 3059 7574 10DA JMP PWRRTN And return 3060 * INTEGER EXPONENT OUT OF INTEGER RANGE 3061 7576 06A0 PWRZZ1 BL @GETV Positive or negative Base? 7578 187C 3062 757A 836E DATA VSPTR 3063 * 3064 757C 150C JGT PWRZZ2 Positive Base 3065 * NEGATIVE BASE - So see if exponent is even or odd to set 3066 * the sign of the result 3067 757E 04C1 PWRZZ4 CLR R1 For double 3068 7580 D060 MOVB @FAC,R1 Get exponent 7582 834A 3069 7584 0741 ABS R1 Work with positive 3070 7586 0281 CI R1,>4600 Too big to have one's byte? 7588 4600 3071 758A 1505 JGT PWRZZ2 Yes, assume number is even 3072 758C 06C1 SWPB R1 Get in low order byte 3073 758E 0221 AI R1,>830B No, get one's radix digit 7590 830B 3074 * location in FAC 3075 7592 D051 MOVB *R1,R1 Get the digit 3076 7594 0A71 SLA R1,7 If last bit set, set top bit 3077 7596 0204 PWRZZ2 LI R4,FPSIGN Save sign of result 7598 03DC 3078 759A 06A0 BL @PUTV1 in a permanent place 759C 6422 3079 759E 06A0 BL @XTFACZ Base in FAC; Exponent on stack 75A0 7B34 3080 75A2 0760 ABS @FAC Must work with positive 75A4 834A 3081 75A6 06A0 BL @LOGZZ Compute LOG(B) in FAC 75A8 76C2 3082 75AA 06A0 BL @SMULT Compute E*LOG(B) in FAC 75AC 0E8C 3083 75AE 06A0 BL @EXPZZ Let exp give error on warning 75B0 75CA 3084 75B2 0203 LI R3,FPSIGN Check sign of result 75B4 03DC 3085 75B6 06A0 BL @GETV1 75B8 1880 3086 75BA 1101 JLT PWRZZ5 If E is negative 3087 75BC 10B6 JMP PWRRTN If E is positive 3088 75BE ERRNIP EQU $ 3089 75BE 0520 PWRZZ5 NEG @FAC Make it negative 75C0 834A 3090 75C2 10B3 JMP PWRRTN 3091 75C4 06A0 PWRG05 BL @OVEXP Return overflow 75C6 0FC2 3092 75C8 10B0 JMP PWRRTN And return 3093 ************************************************************ 3094 * EXPONENTIAL FUNCTION 3095 * FAC = EXP(FAC) 3096 * CALL BL @EXPZZ 3097 * WARNING: WRNOV Overflow 3098 * STACK LEVELS USED: 3099 * X : = FAC * LOG10(E) 3100 * So EXP(FAC) = 10^X 3101 * Make sure X is in range LOG100(X) = LOG10(X)/2 99/4 ASSEMBLER TRINSICS PAGE 0069 3102 * N : = INT(X) 3103 * R : = X-N, 0 <= R < 1 3104 * IF R < .5 THEN R : = R 3105 * ELSE S : = R-5 3106 * A rational function approximation is used for 10^S 3107 * (HART EXPD 1444) 3108 * EXP : = IF R .LT. .5 THEN 10^N * 10^S 3109 * ELSE 10^N * 10^.5 * 10^S 3110 ************************************************************ 3111 75CA C28B EXPZZ MOV R11,R10 3112 75CC 06A0 BL @ROLOUT Get workspace and save return 75CE 7A90 3113 75D0 06A0 BL @MOVROM Get LOG10(E) 75D2 7A70 3114 75D4 0018 DATA LOG10E into ARG 3115 * 3116 75D6 06A0 BL @FMULT X : = FAC * LOG10(E) 75D8 0E88 3117 75DA 06A0 BL @PUSH Save X 75DC 7AF2 3118 75DE 06A0 BL @GRINT Compute N : = INT(X) 75E0 79EC 3119 75E2 06A0 BL @MOVROM Get floating 127 75E4 7A70 3120 75E6 0000 DATA EXC127 into ARG 3121 * 3122 75E8 06A0 BL @FCOMPB Is N > 127? 75EA 6126 3123 75EC 1313 JEQ EXP03 If = 127 3124 75EE 1106 JLT EXP01 If > 127 3125 75F0 0520 NEG @ARG Check negative range 75F2 835C 3126 75F4 06A0 BL @FCOMPB Is N < -127? 75F6 6126 3127 75F8 110D JLT EXP03 N > -127 3128 75FA 130C JEQ EXP03 N = -127 3129 * N is out of range 3130 75FC 6820 EXP01 S @C8,@VSPTR Pop X off stack 75FE 7AF4 7600 836E 3131 7602 C820 MOV @FAC,@EXP Recall exponent sign 7604 834A 7606 8376 3132 7608 D820 MOVB @C8,@SIGN Result is positive 760A 7AF4 760C 8375 3133 760E 06A0 BL @OVEXP Take over or underflow action 7610 0FC2 3134 7612 1055 JMP BROLIN Restore CPU RAM and return 3135 7614 06A0 EXP03 BL @PUSH Save value on stack 7616 7AF2 3136 7618 06A0 BL @CFI Convert to integer exponent 761A 12B8 3137 761C C320 MOV @FAC,R12 Get it in REG to mpy by 2 761E 834A 3138 7620 0A1C SLA R12,1 Compute 2*N 3139 7622 06A0 BL @POP Restore value 7624 7B16 3140 7626 06A0 BL @SSUB Compute R = X - N 99/4 ASSEMBLER TRINSICS PAGE 0070 7628 0D74 3141 762A 06A0 BL @MOVROM Get a floating .5 762C 7A70 3142 762E 0008 DATA FHALF into ARG 3143 * 3144 7630 06A0 BL @FCOMPB Is .5 > R? 7632 6126 3145 7634 1505 JGT EXP04 Yes, S=R 3146 7636 0520 NEG @ARG -.5 7638 835C 3147 763A 06A0 BL @FADD Compute S : = R - .5 763C 0D80 3148 763E 058C INC R12 Remember R >= .5, (2*N+1) 3149 * save a copy of S 3150 7640 06A0 EXP04 BL @PUSH Save a copy of S 7642 7AF2 3151 7644 06A0 BL @POLYW Compute S * P(S^2) 7646 7782 3152 7648 007C DATA EXPP Poly to evaluate 3153 * 3154 764A 06A0 BL @XTFACZ FAC = S, stack = S * P(S^2) 764C 7B34 3155 764E 06A0 BL @POLYX Compute Q(S^2) 7650 77A6 3156 7652 0096 DATA EXPQ Poly to evaluate 3157 * 3158 7654 06A0 BL @POPSTK S * P(S^2) -> ARG 7656 60D4 3159 7658 A820 A @C8,@VSPTR 765A 7AF4 765C 836E 3160 765E 06A0 BL @PUSH Save comp of Q(S^2) 7660 7AF2 3161 7662 06A0 BL @FADD Q(S^2) + S * P(S^2) 7664 0D80 3162 7666 0203 LI R3,FAC Save FAC in a temp 7668 834A 3163 766A 0204 LI R4,CZ 766C 831A 3164 766E CD33 MOV *R3+,*R4+ 1st two bytes 3165 7670 CD33 MOV *R3+,*R4+ 2nd two bytes 3166 7672 CD33 MOV *R3+,*R4+ 3rd two bytes 3167 7674 C513 MOV *R3,*R4 Last two bytes 3168 7676 06A0 BL @POP FAC = Q(S^S), stack = S*P(S^2) 7678 7B16 3169 767A 06A0 BL @XTFACZ Revese same 767C 7B34 3170 767E 06A0 BL @SSUB Compte Q(S^2)-S*P*(S^2) 7680 0D74 3171 7682 0203 LI R3,CZ Get fac back from temp 7684 831A 3172 7686 0204 LI R4,ARG 7688 835C 3173 768A CD33 MOV *R3+,*R4+ 1st two bytes 3174 768C CD33 MOV *R3+,*R4+ 2nd two bytes 3175 768E CD33 MOV *R3+,*R4+ 3rd two bytes 3176 7690 C513 MOV *R3,*R4 Last rwo bytes 3177 7692 06A0 BL @FDIV Compute Q-P/Q-P 7694 0FF4 99/4 ASSEMBLER TRINSICS PAGE 0071 3178 7696 081C EXPSQT SRA R12,1 Check flag that was set above 3179 7698 1705 JNC EXPSQ5 If not set 3180 769A 06A0 BL @MOVROM Get SQR(10) 769C 7A70 3181 769E 0010 DATA SQRTEN into ARG 3182 * 3183 76A0 06A0 BL @FMULT Multipy by SQU(10) if N odd 76A2 0E88 3184 76A4 06A0 EXPSQ5 BL @MOVROM Need a floating 1 76A6 7A70 3185 76A8 006A DATA FPOS1 into ARG 3186 * 3187 76AA 081C SRA R12,1 Check odd power of ten 3188 76AC 1703 JNC EXPSQ8 If not odd power 3189 76AE D820 MOVB @CBHA,@ARG1 Odd power of ten (>0A) 76B0 6004 76B2 835D 3190 76B4 B820 EXPSQ8 AB @R12LB,@ARG Add in power of 100 to Exp 76B6 83F9 76B8 835C 3191 76BA 06A0 BL @FMULT 76BC 0E88 3192 76BE 0460 BROLIN B @ROLIN 76C0 7AC4 3193 ************************************************************ 3194 * LOGARITHM FUNCTION 3195 * FAC : = LOG(FAC) 3196 * ERRORS : ERRLOG LOG of negative number or zero 3197 * attempted. 3198 * STACK LEVELS USED: 3199 * IF FAC <= 0 THEN ERRLOG 3200 * LOG(FAC)=LN(FAC)=LOG10(FAC)*LN(10) 3201 * FAC : = A * 10^N, .1 <= A < 1 3202 * S : = A * SQR(10), 1/SQR(10) <= S < SQR(10) 3203 * LOG10(A) : = LOG10(S/SQR(10)) 3204 * : = LOG10(S) - LOG10(SQR(10)) 3205 * : = LOG10(S) - .5 3206 * LOG : = (N - .5 + LOG10(S)) * LN(10) 3207 * : = (N - .5 * LN(10) + LN(S) 3208 * A rational function approximation is used for LN(S) 3209 * (HART LOGE 2687) 3210 ************************************************************ 3211 76C2 C28B LOGZZ MOV R11,R10 3212 76C4 06A0 BL @ROLOUT Get workspace and save return 76C6 7A90 3213 76C8 C020 MOV @FAC,R0 Check for negative or zero 76CA 834A 3214 76CC 1504 JGT LOGZZ3 If positive 3215 76CE D820 MOVB @ERRLOG,@FAC10 Load error code 76D0 76D6 76D2 8354 3216 76D4 10F4 JMP BROLIN Restore CPU and return 3217 76D6 ERRLOG EQU $ 3218 76D6 06A0 LOGZZ3 BL @TENCNS Get base 10 exponent 76D8 7B64 3219 76DA 160B JNE LOGZZ5 3220 76DC 06A0 BL @MOVROM Get a floating 1 76DE 7A70 3221 76E0 006A DATA FPOS1 into ARG 99/4 ASSEMBLER TRINSICS PAGE 0072 3222 * Make it a floating 10 3223 76E2 D820 MOVB @CBHA,@ARG1 by putting in >0A 76E4 6004 76E6 835D 3224 76E8 06A0 BL @FMULT Multipy FAC by 10 76EA 0E88 3225 76EC 06A0 BL @TENCNS Get new exponent of 10 76EE 7B64 3226 76F0 1002 JMP LOGZ5A Compensate for Mult 3227 76F2 05A0 LOGZZ5 INC @EXP Compenstat for where radix 76F4 8376 3228 * point is 3229 76F6 D820 LOGZ5A MOVB @CBH3F,@FAC Put A in proper range 76F8 7490 76FA 834A 3230 * by putting in >3F 3231 76FC C320 MOV @EXP,R12 76FE 8376 3232 7700 06A0 BL @MOVROM Get SQR(10) 7702 7A70 3233 7704 0010 DATA SQRTEN into ARG 3234 * 3235 7706 06A0 BL @FMULT S : = A * SQR(10) 7708 0E88 3236 770A 06A0 BL @FORMA Z : = (S-1) / (S+1) 770C 77FC 3237 770E 06A0 BL @PUSH Push Z 7710 7AF2 3238 7712 06A0 BL @POLYW Compute Z * P(Z^2) 7714 7782 3239 7716 00B8 DATA LOGP 3240 * 3241 7718 06A0 BL @XTFACZ 771A 7B34 3242 771C 06A0 BL @POLYX Compute Q(Z^2) 771E 77A6 3243 7720 00E2 DATA LOGQ Poly to evaluate 3244 * 3245 7722 06A0 BL @SDIV Compute Z*P(Z^2)/Q(Z^2) 7724 0FF8 3246 7726 06A0 BL @PUSH Push it 7728 7AF2 3247 772A 0200 LI R0,ARG Build entry in ARG 772C 835C 3248 772E CC0C MOV R12,*R0+ Put in exponent 3249 7730 04F0 CLR *R0+ and 3250 7732 04F0 CLR *R0+ clear the 3251 7734 04D0 CLR *R0 rest 3252 * STATUS WAS SET BY THE MOVE ABOVE 3253 7736 130E JEQ LOGZZ7 If zero exponent 3254 7738 0760 ABS @ARG Work with ABS value 773A 835C 3255 773C C020 MOV @ARG,R0 in register 773E 835C 3256 7740 0280 CI R0,99 Too large? 7742 0063 3257 7744 1514 JGT LOGZZ9 Yes 3258 7746 D820 MOVB @FLTONE,@ARG Exponent = >40 7748 600E 99/4 ASSEMBLER TRINSICS PAGE 0073 774A 835C 3259 774C D30C LOGZZ6 MOVB R12,R12 Exponent positive? 3260 774E 1302 JEQ LOGZZ7 Yes 3261 7750 0520 NEG @ARG No, make it negative 7752 835C 3262 7754 06A0 LOGZZ7 BL @MOVRM5 Need a floating .5 7756 7A6A 3263 7758 0008 DATA FHALF in FAC 3264 * 3265 775A 06A0 BL @FSUB Compute N - .5 775C 0D7C 3266 775E 06A0 BL @MOVROM Need LN(10) 7760 7A70 3267 7762 0020 DATA LN10 into ARG 3268 * 3269 7764 06A0 BL @FMULT Compute (N - .5) * LN(10) 7766 0E88 3270 7768 06A0 BL @SADD Add to LN(S) 776A 0D84 3271 776C 10A8 JMP BROLIN Restore CPU and return 3272 776E 6820 LOGZZ9 S @C100,@ARG Subtract first 100 7770 6008 7772 835C 3273 7774 D820 MOVB @ARG1,@ARG2 7776 835D 7778 835E 3274 777A C820 MOV @CBH411,@ARG Load exponent and 777C 748E 777E 835C 3275 * leading digit of >4101 3276 7780 10E5 JMP LOGZZ6 3277 ************************************************************ 3278 * EVALUATE X * P(X^^2) 3279 * ON CALL : PZ Pointer to polynomial coefficients 3280 * : FAC Contains X 3281 * BL @POLYW 3282 * : FAC Returns X * P(X^^2) 3283 ************************************************************ 3284 7782 C83B POLYW MOV *R11+,@PZ Get the poly to evaluate 7784 8312 3285 7786 C28B MOV R11,R10 3286 7788 06A0 BL @SAVRTN Save return address 778A 7AB2 3287 778C 06A0 BL @PUSH Push the argument 778E 7AF2 3288 7790 06A0 BL @POLYX1 Compute P(X^^2) 7792 77AA 3289 7794 06A0 BL @SMULT Compute X*P(X^^2) 7796 0E8C 3290 7798 104E JMP PWRTN2 And return 3291 779A C83B POLY MOV *R11+,@PZ 779C 8312 3292 779E C28B MOV R11,R10 3293 77A0 06A0 BL @SAVRTN Save return address 77A2 7AB2 3294 77A4 1009 JMP POLY01 And merge in below 3295 77A6 C83B POLYX MOV *R11+,@PZ 77A8 8312 3296 77AA C28B POLYX1 MOV R11,R10 99/4 ASSEMBLER TRINSICS PAGE 0074 3297 77AC 06A0 BL @SAVRTN Save return address 77AE 7AB2 3298 77B0 06A0 BL @PUSH Need to copy FAC 77B2 7AF2 3299 * into ARG to square it 3300 77B4 06A0 BL @SMULT Square X (SMULT pops into ARG) 77B6 0E8C 3301 77B8 06A0 POLY01 BL @PUSH Push the argument 77BA 7AF2 3302 77BC C0E0 MOV @PZ,R3 Get the poly to evaluate 77BE 8312 3303 77C0 0200 LI R0,FAC into FAC 77C2 834A 3304 77C4 06A0 BL @MOVRM2 77C6 7A76 3305 77C8 100F JMP POLY03 3306 77CA 06A0 POLY02 BL @POPSTK Get X back 77CC 60D4 3307 77CE A820 A @C8,@VSPTR Keep it on stack 77D0 7AF4 77D2 836E 3308 77D4 06A0 BL @FMULT Multiply previous result by X 77D6 0E88 3309 77D8 C0E0 MOV @PZ,R3 77DA 8312 3310 77DC 0200 LI R0,ARG Get polynomial to evaluate 77DE 835C 3311 77E0 06A0 BL @MOVRM2 into ARG 77E2 7A76 3312 77E4 06A0 BL @FADD Add in this coefficient 77E6 0D80 3313 77E8 A820 POLY03 A @C8,@PZ Point to next coefficient 77EA 7AF4 77EC 8312 3314 * and get first two bytes 3315 * into ARG 3316 77EE 981D CB *R13,@CBH80 Read first byte 77F0 78FD 3317 * and test it to see if done 3318 77F2 16EB JNE POLY02 No, continue computing poly 3319 77F4 6820 S @C8,@VSPTR Pop X off stack 77F6 7AF4 77F8 836E 3320 77FA 101D JMP PWRTN2 Return with poly in FAC 3321 * 3322 77FC C28B FORMA MOV R11,R10 3323 77FE 06A0 BL @SAVRTN Save return address 7800 7AB2 3324 7802 06A0 BL @PUSH Save X on stack 7804 7AF2 3325 7806 06A0 BL @FORMA2 7808 7822 3326 780A 06A0 BL @FORMA2 780C 7822 3327 780E 06A0 BL @XTFACZ Swap (X-1) and X 7810 7B34 3328 7812 06A0 BL @MOVROM Get a floating 1 7814 7A70 3329 7816 006A DATA FPOS1 into ARG 99/4 ASSEMBLER TRINSICS PAGE 0075 3330 * 3331 7818 06A0 BL @FADD X+1 781A 0D80 3332 781C 06A0 BL @SDIV (X-1)/(X+1) 781E 0FF8 3333 7820 100A JMP PWRTN2 And return 3334 7822 C28B FORMA2 MOV R11,R10 3335 7824 06A0 BL @SAVRTN Save return address 7826 7AB2 3336 7828 06A0 BL @MOVROM Get a floating .5 782A 7A70 3337 782C 0008 DATA FHALF int ARG 3338 * 3339 782E 0520 NEG @ARG 7830 835C 3340 7832 06A0 BL @FADD X - .5 7834 0D80 3341 7836 0460 PWRTN2 B @ROLIN2 7838 7AE0 3342 ************************************************************ 3343 * SQUARE ROOT FUNCTION 3344 * Reference for scientific function approximations. 3345 * JOHN F. HART ET AL, Comper approximations, 3346 * JOHN WILEY & SONS, 1968 3347 * FAC : = SQR(FAC) 3348 * ERRORS : ERRSQR Square root of negative number 3349 * attempted 3350 * STACK LEVELS USED: 3351 * IF FAC = 0 THEN SQR : = 0 3352 * IF FAC < 0 THEN ERRSQR 3353 * FAC : = A * 100^N, .01 <= A < 1 3354 * SQR : = 10^N * SQR(A) 3355 * Newton's method with a fixed number of iterations is used 3356 * to approximate SQR(A): 3357 * A rational function approximation is used for Y(0) 3358 * (HART SQRT 0231) 3359 * Y(N+1) = (Y(n))/2 3360 ************************************************************ 3361 783A C28B SQRZZ MOV R11,R10 3362 783C 06A0 BL @ROLOUT Get workspace and save return 783E 7A90 3363 7840 C320 MOV @FAC,R12 Check exponent 7842 834A 3364 7844 1334 JEQ SQR03 FAC is zero, return zero 3365 7846 1130 JLT SQR02 FAC is < 0, error 3366 7848 D820 MOVB @CBH3F,@FAC Create A in range .01 <= A <1 784A 7490 784C 834A 3367 * by loading >3F 3368 784E 022C AI R12,>C100 Remove bias (-63) 7850 C100 3369 7852 088C SRA R12,8 Sign extend 3370 7854 0A1C SLA R12,1 Save 2 * N 3371 7856 06A0 BL @PUSH Save A 7858 7AF2 3372 785A 06A0 BL @PUSH Save A again 785C 7AF2 3373 785E 06A0 BL @POLY Compute P(A) 7860 779A 99/4 ASSEMBLER TRINSICS PAGE 0076 3374 7862 0050 DATA SQRP Poly to evaluate 3375 * 3376 7864 06A0 BL @XTFACZ Stack : = P(A), FAC : = A 7866 7B34 3377 7868 06A0 BL @POLY Compute Q(A) 786A 779A 3378 786C 006A DATA SQRQ Poly to evaluate 3379 * 3380 786E 06A0 BL @SDIV Compute P(A)/Q(A) 7870 0FF8 3381 7872 C820 MOV @CC3,@PZ Save in permanent 7874 7908 7876 8312 3382 7878 06A0 SQR01 BL @POPSTK Pop into ARG 787A 60D4 3383 787C A820 A @C8,@VSPTR But keep it on stack 787E 7AF4 7880 836E 3384 7882 06A0 BL @PUSH Push Y(N) 7884 7AF2 3385 7886 06A0 BL @FDIV Compute A/Y(N) 7888 0FF4 3386 788A 06A0 BL @SADD Compute A/Y(N) + Y(N) 788C 0D84 3387 788E 06A0 BL @MOVROM Nead a floating .5 7890 7A70 3388 7892 0008 DATA FHALF into ARG 3389 * 3390 7894 06A0 BL @FMULT Compute .5 * (A/Y(N) + Y(N)) 7896 0E88 3391 7898 0620 DEC @PZ Decrement loop counter 789A 8312 3392 789C 16ED JNE SQR01 Loop three times 3393 789E 6820 S @C8,@VSPTR Pop off stack 78A0 7AF4 78A2 836E 3394 78A4 0460 B @EXPSQT To finish up 78A6 7696 3395 78A8 D820 SQR02 MOVB @ERRSQR,@FAC10 Load error code for return 78AA 78AE 78AC 8354 3396 78AE ERRSQR EQU $ 3397 78AE 0460 SQR03 B @ROLIN Restore CPU RAM and return 78B0 7AC4 3398 ************************************************************ 3399 * COSINE FUNCTION 3400 * FAC : = COS(FAC) 3401 * COS(FAC) : = SIN(FAC + PI/2) 3402 ************************************************************ 3403 78B2 C30B COSZZ MOV R11,R12 3404 78B4 06A0 BL @MOVROM Need to get PI/2 78B6 7A70 3405 78B8 0028 DATA PI2 into ARG 3406 * 3407 78BA 06A0 BL @FADD Compute FAC + PI/2 78BC 0D80 3408 78BE C2CC MOV R12,R11 And fall into SIN code 3409 ************************************************************ 3410 99/4 ASSEMBLER TRINSICS PAGE 0077 3411 3413 3414 ************************************************************ 3415 * SINE FUNCTION 3416 * FAC : = SIN(FAC) 3417 * STACK LEVELS USED: 3418 * IF FAC < 0 THEN SIN(FAC) : = -SIN(-FAC) 3419 * X : = 2/PI*FAC 3420 * K : = INT(X) 3421 * R : = X-K, 0 <= R < 1 3422 * Q : = K MOD 4 3423 * SO K : = 4*N+Q 3424 * FAC : = PI/2 * K + PI/2 * R 3425 * : = 2*PI*N + PI/2*Q + PI/2*R 3426 * SIN(FAC) : = SIN(P/2*Q+PI/2*R) 3427 * QUADRANT Q Identity 3428 * I 0 SIN(FAC) : = SIN(PI/2*R) 3429 * II 1 SIN(FAC) : = SIN(PI/2+PI/2*R 3430 * : = SIN(PI-*(PI/2+PI/2R)) 3431 * : = SIN(PI/2*(1-R)) 3432 * III 2 SIN(FAC) : = SIN(PI+PI/2*R) 3433 * : = SIN(PI-(PI+PI/2*R)) 3434 * : = SIN(PI/2 * (R-1)) 3435 * IV 3 SIN(FAC) : = SIN(3*PI/2 + PI/2*R 3436 * : = SIN(3*PI/2 + PI/2*R-2*PI) 3437 * : = SIN(PI/2 * (R-1)) 3438 * QUADRANT Q ARGUMENT TO APPROXIMATION POLYNOMIAL 3439 * I 0 R = R 0 <= R < 1 3440 * II 1 1-R = 1-R 0 < 1-R <= 1 3441 * III 2 -R = -R -1 < -R <= 0 3442 * IV 3 R-1 = -(1-R) -1 <= R-1 < 0 3443 * 3444 * A polynomial approximation is used for SIN(P/2*R) 3445 * -1 <= R < 1 3446 * (HART SIN 3344) 3447 ************************************************************ 3448 78C0 C28B SINZZ MOV R11,R10 3449 78C2 06A0 BL @ROLOUT Get workspace and save return 78C4 7A90 3450 78C6 06A0 BL @MOVROM Get 2/PI 78C8 7A70 3451 78CA 0030 DATA RPI2 into ARG 3452 * 3453 78CC 06A0 BL @FMULT X : = 2/PI*FAC 78CE 0E88 3454 78D0 D320 MOVB @FAC,R12 Save sign 78D2 834A 3455 78D4 0760 ABS @FAC Consider positive numbers 78D6 834A 3456 78D8 9820 CB @FAC,@CBH44 Check exponent range 78DA 834A 78DC 7491 3457 * by checking with >44 3458 78DE 152C JGT TRIERR ERR in range of exponent 3459 78E0 06A0 BL @PUSH Save X 78E2 7AF2 3460 78E4 06A0 BL @GRINT K : = INT(K) 78E6 79EC 3461 78E8 04C1 CLR R1 Assume Q is zero 99/4 ASSEMBLER TRINSICS2 PAGE 0078 3462 78EA 04C0 CLR R0 3463 78EC D020 MOVB @FAC,R0 Is FAC zero? 78EE 834A 3464 78F0 130C JEQ SIN02 Yes, Q is zero 3465 78F2 0220 AI R0,>BA00 Bias exponent (->46 byte) 78F4 BA00 3466 * is K too big for (K MOD 4) 3467 * to have a significance? 3468 78F6 1507 JGT SIN01 Yes, defualt Q to zero 3469 78F8 0220 AI R0,>51*256 (FAC+7-PAD0)*256 78FA 5100 3470 78FD CBH80 EQU $+1 CONSTANT >80 3471 78FC 0980 SRL R0,8 3472 78FE 0220 AI R0,PAD0 7900 8300 3473 7902 D810 MOVB *R0,@R1LB No, get 10's and 1's place of 7904 83E3 3474 7908 CC3 EQU $+2 3475 7906 0241 SIN01 ANDI R1,3 Q : = (K MOD 4) 7908 0003 3476 790A C801 SIN02 MOV R1,@QZ 790C 8316 3477 790E 06A0 BL @SSUB R : = X-K 7910 0D74 3478 7912 C060 MOV @QZ,R1 7914 8316 3479 7916 0911 SRL R1,1 Is Q even? 3480 7918 C801 MOV R1,@QZ 791A 8316 3481 791C 1705 JNC SIN03 Yes 3482 791E 06A0 BL @MOVROM Get a floating 1 7920 7A70 3483 7922 006A DATA FPOS1 into ARG 3484 * 3485 7924 06A0 BL @FSUB Compute 1-R 7926 0D7C 3486 7928 C060 SIN03 MOV @QZ,R1 Quadrant III or IV? 792A 8316 3487 792C 1301 JEQ SIN04 No 3488 792E 054C INV R12 Yes, change sign or result 3489 7930 06A0 SIN04 BL @POLYW Evaluate it 7932 7782 3490 7934 010C DATA SINP get poly P's coefficients 3491 * 3492 7936 1054 JMP ATNSGN and set sign 3493 7938 D820 TRIERR MOVB @CCBH7,@FAC10 TRIG error (>7 in FAC10) 793A 74D4 793C 8354 3494 793E 1054 JMP ATNSG3 3495 ************************************************************ 3496 * TANGENT FUCTION 3497 * FAC : = TAN(FAC) 3498 * TAN(FAC) : = SIN(FAC)/COS(FAC) 3499 ************************************************************ 3500 7940 C28B TANZZ MOV R11,R10 3501 7942 06A0 BL @SAVRTN Save return address 7944 7AB2 3502 7946 06A0 BL @PUSH Save FAC on stack 7948 7AF2 99/4 ASSEMBLER TRINSICS2 PAGE 0079 3503 794A 06A0 BL @SINZZ Compute SIN 794C 78C0 3504 794E 06A0 BL @XTFACZ 7950 7B34 3505 7952 06A0 BL @COSZZ Compute COS 7954 78B2 3506 7956 06A0 BL @POPSTK Pop stack into ARG 7958 60D4 3507 795A 9820 CB @FAC10,@CCBH7 Check for error 795C 8354 795E 74D4 3508 7960 1305 JEQ PWRTN3 If error 3509 7962 C020 MOV @FAC,R0 Is COS = zero? 7964 834A 3510 7966 1304 JEQ TAN01 Yes 3511 7968 06A0 BL @FDIV No, TAN : = SIN(ARG)/COS(ARG) 796A 0FF4 3512 796C 0460 PWRTN3 B @ROLIN2 796E 7AE0 3513 7970 D820 TAN01 MOVB @ARG,@SIGN 7972 835C 7974 8375 3514 7976 06A0 BL @OVEXP Issue overflow message 7978 0FC2 3515 797A 10F8 JMP PWRTN3 Clean up and exit 3516 ************************************************************ 3517 * INVERSE TANGENT FUCTION 3518 * FAC : = ATN(FAC) 3519 * STACK LEVELS USED: 3520 * IF FAC < 0 THEN ARCTAN(FAC) = -ARCTAN(-FAC) 3521 * IF 0 <= FAC <= TAN(PI/8) 3522 * THEN T = FAC, ARCTAN(FAC) : = ARCTAN(T) 3523 * IF TAN(PI/8) < FAC < TAN(3*PI/8) 3524 * THEN T = (FAC-1) / (FAC+1), 3525 * ARCTAN(FAC) : = PI/4 + ARCTAN(T) 3526 * IF TAN(3*PI/8) <= FAC 3527 * THEN T = -1/FAC, 3528 * ARCTAN(FAC) : = PI/2 + ARCTAN(T) 3529 * 3530 * A polynomial approximation is used for ARCTAN(T), 3531 * -TAN(PI/8) <= T <= TAN(PI/8) 3532 * (HART ARCTN 4967) 3533 ************************************************************ 3534 797C C28B ATNZZ MOV R11,R10 3535 797E 06A0 BL @ROLOUT Get workspace and save return 7980 7A90 3536 7982 D320 MOVB @FAC,R12 Save sign 7984 834A 3537 7986 0760 ABS @FAC Use ABS(FAC) 7988 834A 3538 798A 04E0 CLR @QZ Assume ARG is in range 798C 8316 3539 798E 06A0 BL @MOVROM Need TAN(PI/8) 7990 7A70 3540 7992 0040 DATA TANPI8 into ARG 3541 * 3542 7994 06A0 BL @FCOMPB Is TAN(3*PI/8) >= ARG? 7996 6126 3543 7998 1317 JEQ ATN02 If = 99/4 ASSEMBLER TRINSICS2 PAGE 0080 3544 799A 1516 JGT ATN02 If > 3545 799C 06A0 BL @MOVROM Need TAN(3*PI/8) 799E 7A70 3546 79A0 0048 DATA TAN3P8 into ARG 3547 * 3548 79A2 06A0 BL @FCOMPB Is TAN(3*PI/8) > ARG? 79A4 6126 3549 79A6 150A JGT ATN01 Yes, use case 2 3550 79A8 06A0 BL @MOVROM Get a floating 1 79AA 7A70 3551 79AC 006A DATA FPOS1 into ARG 3552 * 3553 79AE 0520 NEG @ARG Use case 3 to compute 79B0 835C 3554 79B2 06A0 BL @FDIV T = -1/ARG 79B4 0FF4 3555 79B6 0203 LI R3,PI2 Get PI/2 79B8 0028 3556 79BA 1004 JMP ATN02A Add it in at the end 3557 79BC 06A0 ATN01 BL @FORMA Case 2 : T : = (ARG-1)/(ARG+1) 79BE 77FC 3558 79C0 0203 LI R3,PI4 Get PI/4 79C2 0038 3559 79C4 C803 ATN02A MOV R3,@QZ Set up to evaluate 79C6 8316 3560 79C8 06A0 ATN02 BL @POLYW ATN(T) : = T * P(T^^2) 79CA 7782 3561 79CC 014E DATA ATNP Poly to evlauate 3562 * 3563 79CE C0E0 MOV @QZ,R3 Case 1? 79D0 8316 3564 79D2 1306 JEQ ATNSGN Yes, don't add anything in 3565 79D4 0200 LI R0,ARG 79D6 835C 3566 79D8 06A0 BL @MOVRM2 79DA 7A76 3567 79DC 06A0 BL @FADD Add in the constant 79DE 0D80 3568 79E0 054C ATNSGN INV R12 Check sign of result 3569 79E2 1102 JLT ATNSG3 If sign is already on 3570 79E4 0520 NEG @FAC else negate it 79E6 834A 3571 79E8 0460 ATNSG3 B @ROLIN And return 79EA 7AC4 3572 ************************************************************ 3573 * GREATEST INTEGER FUNCTION 3574 ************************************************************ 3575 79EC C1CB GRINT MOV R11,R7 Save return address 3576 79EE D820 MOVB @FAC,@SIGN Save result sign 79F0 834A 79F2 8375 3577 79F4 0760 ABS @FAC Absolute value 79F6 834A 3578 79F8 D160 MOVB @FAC,R5 Get exponent 79FA 834A 3579 79FC 0985 SRL R5,8 Make it into word 3580 79FE C805 MOV R5,@EXP For rounding 7A00 8376 3581 7A02 0285 CI R5,>40 Exponent < 0? 99/4 ASSEMBLER TRINSICS2 PAGE 0081 7A04 0040 3582 7A06 1124 JLT BITINT Yes, handle it 3583 7A08 0285 CI R5,>45 Exponent > 10^5 ? 7A0A 0045 3584 7A0C 1519 JGT INT02 Yes, handle it 3585 7A0E 0225 AI R5,->46 Locate position 7A10 FFBA 3586 7A12 D820 MOVB @R5LB,@FAC10 Save for rounding 7A14 83EB 7A16 8354 3587 7A18 04C2 CLR R2 3588 7A1A 0203 LI R3,FAC8 7A1C 8352 3589 7A1E A0C5 A R5,R3 Point to 1st fractional digit 3590 7A20 F093 INT01 SOCB *R3,R2 Remember if non-zero 3591 7A22 DCE0 MOVB @R2LB,*R3+ Clear the digit 7A24 83E5 3592 7A26 0585 INC R5 3593 7A28 16FB JNE INT01 3594 7A2A D020 MOVB @SIGN,R0 Get the sign 7A2C 8375 3595 7A2E 150D JGT INT03 If non-negative(i.e. Positive) 3596 7A30 D082 MOVB R2,R2 3597 7A32 1306 JEQ INT02 3598 7A34 B820 AB @CCBH7,@FAC10 Where to round up 7A36 74D4 7A38 8354 3599 7A3A 06A0 BL @ROUNU Do the rounding 7A3C 0FB2 3600 7A3E 1005 JMP INT03 3601 7A40 D020 INT02 MOVB @SIGN,R0 Check the sign 7A42 8375 3602 7A44 1502 JGT INT03 If positive don't negate 3603 7A46 0520 NEG @FAC Make result negative 7A48 834A 3604 7A4A 04E0 INT03 CLR @FAC10 Indicate no error 7A4C 8354 3605 7A4E 0457 B *R7 <<<< Return from here 3606 7A50 0200 BITINT LI R0,FAC Zero or -1 7A52 834A 3607 7A54 0201 LI R1,>BFFF Default to -1 7A56 BFFF 3608 7A58 D0A0 MOVB @SIGN,R2 Negative or Positive? 7A5A 8375 3609 7A5C 1101 JLT INT04 If really negative put in -1 3610 7A5E 04C1 CLR R1 If Positive put in a 0 3611 7A60 CC01 INT04 MOV R1,*R0+ Copy in 0 or -1 3612 7A62 04F0 CLR *R0+ and 3613 7A64 04F0 CLR *R0+ clear 3614 7A66 04D0 CLR *R0 the 3615 7A68 10F0 JMP INT03 rest 3616 * MOVE 8 BYTES FROM ROM(R3) TO CPU AT R0 3617 7A6A 0200 MOVRM5 LI R0,FAC Move to FAC 7A6C 834A 3618 7A6E 1002 JMP MOVRM1 Merge into common code 3619 7A70 0200 MOVROM LI R0,ARG Move to ARG 7A72 835C 3620 7A74 C0FB MOVRM1 MOV *R11+,R3 Constant to load 3621 7A76 0202 MOVRM2 LI R2,8 Constants are 8 bytes long 99/4 ASSEMBLER TRINSICS2 PAGE 0082 7A78 0008 3622 7A7A A0E0 A @INTRIN,R3 Add in GROM offset 7A7C 8338 3623 7A7E DB43 MOVB R3,@GRMWAX(R13) Write MSB of address 7A80 0402 3624 7A82 06C3 SWPB R3 Bare the LSB 3625 7A84 DB43 MOVB R3,@GRMWAX(R13) Write the LSB 7A86 0402 3626 7A88 DC1D MOVRM4 MOVB *R13,*R0+ Read a byte 3627 7A8A 0602 DEC R2 Moved them all yet? 3628 7A8C 16FD JNE MOVRM4 No, copy the next one 3629 7A8E 045B RT Yes, return 3630 * ROLL OUT CPU AREA FOR WORKSPACE 3631 7A90 0201 ROLOUT LI R1,PROAZ Processor roll out area 7A92 8310 3632 7A96 CVROAZ EQU $+2 3633 7A94 0203 LI R3,VROAZ VDP roll out area 7A96 03C0 3634 7A98 D7E0 MOVB @R3LB,*R15 7A9A 83E7 3635 7A9C 0263 ORI R3,WRVDP 7A9E 4000 3636 7AA0 D7C3 MOVB R3,*R15 3637 7AA2 0200 LI R0,26 7AA4 001A 3638 7AA6 D831 ROLOT1 MOVB *R1+,@XVDPWD 7AA8 8C00 3639 7AAA 0600 DEC R0 3640 7AAC 16FC JNE ROLOT1 3641 7AAE 04E0 CLR @FAC8 And save return address 7AB0 8352 3642 * SAVE RETURN ADDRESS 3643 7AB2 05E0 SAVRTN INCT @STKADD 7AB4 8373 3644 7AB6 D260 MOVB @STKADD,R9 7AB8 8373 3645 7ABA 0989 SRL R9,8 3646 7ABC 0229 AI R9,PAD0 7ABE 8300 3647 7AC0 C64A MOV R10,*R9 3648 7AC2 045B RT 3649 * ROLL IN CPU AREA AFTER WORK IS DONE 3650 7AC4 0201 ROLIN LI R1,PROAZ Processor roll out area 7AC6 8310 3651 7AC8 D7E0 MOVB @CVROAZ+1,*R15 LSB of address 7ACA 7A97 3652 7ACC D7E0 MOVB @CVROAZ,*R15 MSB of address 7ACE 7A96 3653 7AD0 0200 LI R0,26 Number of bytes rolled out 7AD2 001A 3654 7AD4 DC60 ROLIN1 MOVB @XVDPRD,*R1+ 7AD6 8800 3655 7AD8 0600 DEC R0 3656 7ADA 16FC JNE ROLIN1 3657 7ADC 04E0 CLR @FAC8 7ADE 8352 3658 7AE0 D260 ROLIN2 MOVB @STKADD,R9 7AE2 8373 3659 7AE4 0989 SRL R9,8 99/4 ASSEMBLER TRINSICS2 PAGE 0083 3660 7AE6 0229 AI R9,PAD0 7AE8 8300 3661 7AEA C2D9 MOV *R9,R11 3662 7AEC 0660 DECT @STKADD 7AEE 8373 3663 7AF0 045B RT 3664 * PUSH FAC ONTO STAK 3665 7AF4 C8 EQU $+2 3666 7AF2 0200 PUSH LI R0,8 Number to push 7AF4 0008 3667 7AF6 A800 A R0,@VSPTR Bump stack pointer 7AF8 836E 3668 7AFA C060 MOV @VSPTR,R1 Get stack poiter 7AFC 836E 3669 7AFE D7E0 MOVB @R1LB,*R15 7B00 83E3 3670 7B02 0261 ORI R1,WRVDP 7B04 4000 3671 7B06 D7C1 MOVB R1,*R15 3672 7B08 0201 LI R1,FAC 7B0A 834A 3673 7B0C D831 PUSH1 MOVB *R1+,@XVDPWD 7B0E 8C00 3674 7B10 0600 DEC R0 3675 7B12 15FC JGT PUSH1 3676 7B14 045B RT 3677 * POP VALUE OFF STACK INTO FAC 3678 7B16 0202 POP LI R2,FAC 7B18 834A 3679 7B1A D7E0 MOVB @VSPTR1,*R15 LSB of address 7B1C 836F 3680 7B1E 0200 LI R0,8 7B20 0008 3681 7B22 D7E0 MOVB @VSPTR,*R15 MSB of address 7B24 836E 3682 7B26 6800 S R0,@VSPTR 7B28 836E 3683 7B2A DCA0 POP1 MOVB @XVDPRD,*R2+ 7B2C 8800 3684 7B2E 0600 DEC R0 3685 7B30 15FC JGT POP1 3686 7B32 045B RT 3687 * EXCHANGE TOP OF STACK AND FAC 3688 7B34 C28B XTFACZ MOV R11,R10 Save return address 3689 7B36 06A0 BL @PUSH Put FAC on top 7B38 7AF2 3690 7B3A 0203 LI R3,8 Working with 8 byte entries 7B3C 0008 3691 7B3E C143 MOV R3,R5 Need another copy for below 3692 7B40 6803 S R3,@VSPTR Point back to old top 7B42 836E 3693 7B44 06A0 BL @POP Put it in FAC 7B46 7B16 3694 7B48 A803 A R3,@VSPTR Restore pointer to old top 7B4A 836E 3695 7B4C C120 MOV @VSPTR,R4 Place to move to 7B4E 836E 3696 7B50 A0C4 A R4,R3 Place to move from 3697 7B52 06A0 XTFAC1 BL @GETV1 Get a byte 99/4 ASSEMBLER TRINSICS2 PAGE 0084 7B54 1880 3698 7B56 06A0 BL @PUTV1 Put a byte 7B58 6422 3699 7B5A 0583 INC R3 3700 7B5C 0584 INC R4 3701 7B5E 0605 DEC R5 Done? 3702 7B60 16F8 JNE XTFAC1 No 3703 7B62 045A B *R10 Yes, retrun 3704 * GET BASE 10 EXPONENT OF THE NUMBER IN FAC 3705 * EXP: Gets the base 10 exponent 3706 * OEZ: 0 if exp is even and 1 if exp is odd 3707 7B64 04C0 TENCNS CLR R0 Get base 100 exponent 3708 7B66 D020 MOVB @FAC,R0 Put in MSB 7B68 834A 3709 7B6A 0220 AI R0,>C000 Remove bias (SUBT >64 from MSB 7B6C C000 3710 7B6E 0A10 SLA R0,1 Multiply it by 2 3711 7B70 0880 SRA R0,8 Sign fill high order byte 3712 7B72 04C3 CLR R3 and put in LSB 3713 7B74 9820 CB @FAC1,@CBHA 1st digit of FAC one decimal 7B76 834B 7B78 6004 3714 * digit? 3715 7B7A 1102 JLT CNST10 Yes, base 10 exponent is even 3716 7B7C 0580 INC R0 No, take this into account in 3717 * exponent 3718 7B7E 0583 INC R3 This makes base 10 exp odd 3719 7B80 C800 CNST10 MOV R0,@EXP 7B82 8376 3720 7B84 C0C3 MOV R3,R3 Set condition for return 3721 7B86 045B RT 3722 ************************************************************ 3723 * MISCELLANEOUS CONSTANTS: 3724 * CBH411 3725 * EXC127 BYTE >41,1,27,0,0,0,0,0 127 3726 * FHALF BYTE >3F,50 .5 3727 * ZER3 BYTE 0,0,0,0,0,0 3728 * SQRTEN BYTE >40,3,16,22,77,66,01,69 SQR(10) 3729 * LOG10E BYTE >3F,43,42,94,48,19,03,25 LOG10(E) 3730 * LN10 BYTE >40,2,30,25,85,09,29,94 LN(10) 3731 * CBH7 EQU $+3 3732 * PI2 BYTE >40,1,57,7,96,32,67,95 PI/2 3733 * RPI2 BYTE >3F,63,66,19,77,23,67,58 2/PI 3734 * PI4 BYTE >3F,78,53,98,16,33,97,45 PI/4 3735 * CBHA EQU $+7 3736 * CBH3F 3737 * TANPI8 BYTE >3F,41,42,13,56,23,73,10 TAN(PI/8)=SQR(2 3738 * TAN3P8 BYTE >40,2,41,42,13,56,23,73 TAN(3*PI/8)=SQR 3739 ** SQR POLYNOMIALS (HART SQRT 0231) 3740 * SQRP BYTE >3F,58,81,22,90,00,00,00 P02=.58812 29E+ 3741 * BYTE >3F,52,67,87,50,00,00,00 P01=.52678 75E+ 3742 * BYTE >3E,58,81,20,00,00,00,00 P00=.58812 E-02 3743 * DATA SGNBIT 3744 * FLTONE 3745 * FPOS1 3746 * SQRQ BYTE >40,01,00,00,00,00,00,00 Q01=.1 E+01 3747 * BYTE >3F,09,99,99,80,00,00,00 Q00=.99999 8 E- 3748 * DATA SGNBIT 3749 ** EXPPONENT POLYNOMIALS (HART EXPD 1444) 99/4 ASSEMBLER TRINSICS2 PAGE 0085 3750 ** P02 = .18312 36015 92753 84761 54 E+02 3751 * EXPP BYTE >40,18,31,23,60,15,92,75 3752 ** P01 = .83140 67212 93711 03487 3446 E+03 3753 * BYTE >41,08,31,40,67,21,29,37 3754 * P00 = .51780 91991 51615 35743 91297 E+04 3755 * BYTE >41,51,78,09,19,91,51,62 3756 * DATA SGNBIT 3757 ** Q03 = .1 E+01 3758 * EXPQ BYTE >40,1,0,0,0,0,0,0 3759 ** Q02 = .15937 41523 60306 52437 552 E+03 3760 * BYTE >41,01,59,37,41,52,36,03 3761 ** Q01 = .27093 16940 85158 99126 11636 E+04 3762 * BYTE >41,27,09,31,69,40,85,16 3763 ** Q00 = .44976 33557 40578 41762 54723 E+04 3764 * BYTE >41,44,97,63,35,57,40,58 3765 * DATA SGNBIT 3766 ** LOG POLYNOMIALS (HART LOGE 2687) 3767 ** P04 = .35670 51030 88437 69 E+00 3768 * LOGP BYTE >3F,35,67,05,10,30,88,44 3769 ** P03 = -.11983 03331 36876 1464 E+02 3770 * BYTE >BF,>F5,98,30,33,31,36,88 3771 ** P02 = .63775 48228 86166 05782 E+02 3772 * BYTE >40,63,77,54,82,28,86,17 3773 ** P01 = -.10883 71223 55838 3228 E+03 3774 * BYTE >BE,>FF,08,83,71,22,35,58 3775 ** P00 = .57947 38138 44442 78265 7 E+02 3776 * BYTE >40,57,94,73,81,38,44,44 3777 * DATA SGNBIT 3778 * LOGQ 3779 ** Q04 = .1 E+01 3780 * BYTE >40,01,0,0,0,0,0,0 3781 ** Q03 = -.13132 59772 88464 0339 E+02 3782 * BYTE >BF,>F3,13,25,97,72,88,46 3783 ** Q02 = .47451 82236 02606 00365 E+02 3784 * BYTE >40,47,45,18,22,36,02,61 3785 ** Q01 = -.64076 45807 52556 00596 E+02 3786 * BYTE >BF,>C0,07,64,58,07,52,56 3787 ** Q00 = .28973 69069 22217 71601 9 E+02 3788 * BYTE >40,28,97,36,90,69,22,22 3789 * DATA SGNBIT 3790 ** SIN POLYNOMIAL (HART SIN 3344) 3791 * SINP 3792 ** REFLECTS CHANGE IN 99/4 CONSTANT TO CORRECT VALU 3793 ** OF SIN AND COS >1 3794 ** P07 = -.64462 13674 9 E-09 3795 ** BYTE >C4,>FA,44,62,13,67,49,00 3796 ** P07 = -.64473 16000 0 E-09 3797 * BYTE >C4,>FA,44,73,16,00,00,00 3798 ** P06 = .56882 03332 688 E-07 3799 * CBH44 EQU $+2 3800 * BYTE >3C,05,68,82,03,33,26,88 3801 ** P05 = -.35988 09117 03133 E-05 3802 * BYTE >C2,>FD,59,88,09,11,70,31 3803 ** P04 = .16044 11684 69828 31 E-03 3804 * BYTE >3E,01,60,44,11,68,46,98 3805 ** P03 = -.46817 54131 06023 168 E-02 3806 * BYTE >C1,>D2,81,75,41,31,06,02 3807 ** P02 = .79692 62624 56180 0806 E-01 3808 * BYTE >3F,07,96,92,62,62,45,62 99/4 ASSEMBLER TRINSICS2 PAGE 0086 3809 ** P01 = -.64596 40975 06219 07082 E+00 3810 * BYTE >C0,>C0,59,64,09,75,06,22 3811 ** P00 = .15707 96323 79489 63959 E+01 3812 * BYTE >40,01,57,07,96,32,67,95 3813 * DATA SGNBIT 3814 ** ATN POLYNOMIAL (HART ARCTN 4967) 3815 * ATNP 3816 ** P09 = -.25357 18798 82 E-01 3817 * BYTE >C0,>FE,53,57,18,79,88,20 3818 ** P08 = .50279 13843 885 E-01 3819 * BYTE >3F,05,02,79,13,84,38,85 3820 ** P07 = -.65069 99940 1396 E-01 3821 * BYTE >C0,>FA,50,69,99,94,01,40 3822 ** P06 = .76737 12439 1641 E-01 3823 * BYTE >3F,07,67,37,12,43,91,64 3824 ** P05 = -.90895 47919 67196 E-01 3825 * BYTE >C0,>F7,08,95,47,91,96,72 3826 ** P04 = .11111 04992 50526 62 E+00 3827 * BYTE >3F,11,11,10,49,92,50,53 3828 ** P03 = -.14285 71269 75961 157 E+00 3829 * BYTE >C0,>F2,28,57,12,69,75,96 3830 ** P02 = .19999 99997 89961 5228 E+00 3831 * BYTE >3F,19,99,99,99,97,89,96 3832 ** P01 = -.33333 33333 32253 4275 E+00 3833 * BYTE >C0,>DF,33,33,33,33,32,25 3834 ** P00 = .99999 99999 99999 08253 E+00 3835 * BYTE >40,01,0,0,0,0,0,0 3836 * DATA SGNBIT 3837 ************************************************************ 3838 3839 7B88 AORG >7B88 3841 3842 0022 QUOTE EQU >22 3843 002C COMMA EQU >2C 3844 3845 0002 LISTZ EQU >02 3846 0005 OLDZ EQU >05 3847 0007 SAVEZ EQU >07 3848 0008 MERGEZ EQU >08 3849 0088 RETURZ EQU >88 3850 008F UNBRKZ EQU >8F 3851 0093 DATAZ EQU >93 3852 0094 RESTOZ EQU >94 3853 009A REMZ EQU >9A 3854 009D CALLZ EQU >9D 3855 00A3 IMAGEZ EQU >A3 3856 00A9 RUNZ EQU >A9 3857 00B5 COLONZ EQU >B5 3858 00C7 QUOTEZ EQU >C7 3859 00C8 UNQSTZ EQU >C8 3860 00ED USINGZ EQU >ED 3861 3862 000A MAXKEY EQU 10 3863 * 3864 * CRUNCH copies a line (normally in LINBUF) to CRNBUF in the 3865 * process, it turns the line number (if any) binary, and 3866 * converts all reserved words to tokens. CALL is a GPL XML 3867 * followed by a single byte which indicates the type of 3868 * crunch to be done. Possible types include: 99/4 ASSEMBLER CRUNCHS PAGE 0087 3869 * >00 - Normal crunch 3870 * >01 - crunch as a data statement (input stmt) 3871 * REGISGERS: 3872 * R0 - R1 Scratch 3873 * R2 - R3 Scratch 3874 * R4 Points to R8LB 3875 * R5 Points to length byte of string/numeric 3876 * R6 Indicates numeric copy mode (numeric/line # 3877 * R7 Mode of copy (strings, names, REMs, etc) 3878 * R8 Character buffer 3879 * R9 Points to name during keyword scan 3880 * R11 - R12 Links 3881 * R13 GROM read data pointer 3882 * R15 VDP write address pointer 3883 * 3884 7B88 C30B CRUNCH MOV R11,R12 Save return link 3885 7B8A D0DD MOVB *R13,R3 Read call code 3886 7B8C 06A0 BL @PUTSTK Save GROM address 7B8E 60F2 3887 7B90 04E0 CLR @FAC Assume no line number 7B92 834A 3888 7B94 0204 LI R4,R8LB Set up W/S low-byte pointer 7B96 83F1 3889 7B98 04C8 CLR R8 Initialize character buffer 3890 7B9A 06A0 BL @GETNB Scan line for 1st good char 7B9C 6FAC 3891 7B9E D501 MOVB R1,*R4 Save character 3892 7BA0 1379 JEQ CRU28 If empty line, return 3893 * Now check crunch call mode, normal or input statement 3894 7BA2 0983 SRL R3,8 Normal curnch call? 3895 7BA4 1307 JEQ CRU01 Yes, crunch the statement 3896 * Initialize for input statement crunch 3897 7BA6 0202 LI R2,CRU84 No, must be crunch input stmt 7BA8 7E5A 3898 7BAA 020A LI R10,CRU83 so set up move indicators 7BAC 7E28 3899 7BAE 0207 LI R7,CRU80 7BB0 7E7A 3900 7BB2 101F JMP CRU10 And jump into it 3901 * Initialize for normal line crunch 3902 7BB4 05A0 CRU01 INC @BUFLEV Indicate CRNBUF is destroyed 7BB6 8346 3903 7BB8 04E0 CLR @ARG4 Assume no symbol 7BBA 8360 3904 7BBC D808 MOVB R8,@PRGFLG Clear program flag 7BBE 8344 3905 7BC0 06A0 BL @GETINT Try to read a line number 7BC2 7F8C 3906 7BC4 C800 MOV R0,@FAC Put line number into final 7BC6 834A 3907 7BC8 1304 JEQ CRU02 If no line number 3908 7BCA 06A0 BL @GETNB Skip all leading spaces 7BCC 6FAC 3909 7BCE D501 MOVB R1,*R4 Save character in R8LB 3910 7BD0 1361 JEQ CRU28 If nothing left in line 3911 7BD2 0207 CRU02 LI R7,CRU16 Set normal scan move 7BD4 7C1E 3912 7BD6 0206 LI R6,CRU96 Set normal numeric scan mode 7BD8 7ED4 99/4 ASSEMBLER CRUNCHS PAGE 0088 3913 7BDA 100B JMP CRU10 Merge into normal scan code 3914 * Main loop of the input copy routine. Sets R8LB to next 3915 * character, R0 to its character property byte 3916 * R7 indicates dispatch mode. 3917 7BDC 0206 CRU04 LI R6,CRU96 Set normal numeric mode 7BDE 7ED4 3918 7BE0 0207 CRU05 LI R7,CRU16 Set normal scan mode 7BE2 7C1E 3919 7BE4 06A0 CRU06 BL @PUTCHR Copy into crunch buffer 7BE6 7F6E 3920 7BE8 06A0 CRU08 BL @GETCHR Get next input character 7BEA 6FBA 3921 7BEC 04C0 CLR R0 Assume nil property 3922 7BEE D501 MOVB R1,*R4 Copy to crunch buffer 3923 7BF0 1307 JEQ CRU12 Finish up if we reach a null 3924 *----------------------------------------------------------- 3925 * Replace following line for adding lowercase character 3926 * set to 99/4A 5/12/81 3927 * CRU10 MOVB @CPTBL(R8),R0 Fetch char's prop table vec 3928 7BF2 9814 CRU10 CB *R4,@ENDPRO Higher then "z" 7BF4 7C1C 3929 7BF6 1403 JHE CRU09 Yes, give CPNIL property 3930 7BF8 D028 MOVB @CPTBL(R8),R0 Fetch char's prop table value 7BFA 610C 3931 7BFC 0457 B *R7 Dispatch to appropriate code 3932 7BFE D000 CRU09 MOVB CPNIL,R0 Don't go to CPT, just take 3933 * CPNIL prop 3934 *----------------------------------------------------------- 3935 7C00 0457 CRU12 B *R7 Dispatch to appropriate code 3936 7C02 C208 CRU14 MOV R8,R8 End of line? 3937 7C04 16EF JNE CRU06 Not yet 3938 7C06 C0E0 CRU15 MOV @RAMPTR,R3 Now check for trailing spaces 7C08 830A 3939 7C0A 0603 DEC R3 Backup to read last character 3940 7C0C 06A0 BL @GETV1 Go read it 7C0E 1880 3941 7C10 9801 CB R1,@CBH20 Last character a space? 7C12 7D65 3942 7C14 163F JNE CRU28 No, so end of line, exit 3943 7C16 0620 DEC @RAMPTR Yes, backup pointer to delete 7C18 830A 3944 7C1A 10F5 JMP CRU15 And test new last character 3945 *----------------------------------------------------------- 3946 * The following two lines are added for adding lowercase 3947 * character set for 99/4A 5/13/81 3948 7C1C 7B ENDPRO BYTE >7B ASCII code for char after "z" 3949 EVEN 3950 *----------------------------------------------------------- 3951 * 3952 * Normal scan mode -- figures out what to do with this char 3953 7C1E D514 CRU16 MOVB *R4,*R4 At end of line? 3954 7C20 1339 JEQ CRU28 Yes, clean up and return 3955 7C22 D000 MOVB R0,R0 Set condition on char prop 3956 7C24 11E1 JLT CRU08 Ignore separators (spaces) 3957 7C26 C260 MOV @RAMPTR,R9 Save crunch pointer 7C28 830A 3958 7C2A 0A20 SLA R0,2 Scan property bits 1 and 2 3959 7C2C 1841 JOC CRU32 Break chars are 1 char tokens 3960 7C2E 110F JLT CRU18 Alpha, prepare to pack name 99/4 ASSEMBLER CRUNCHS PAGE 0089 3961 7C30 0A20 SLA R0,2 Scan property bits 3 and 4 3962 7C32 1713 JNC CRU20 Jump if not multi-char oper 3963 7C34 06A0 BL @GETCHR Check next char to see if we 7C36 6FBA 3964 7C38 0981 SRL R1,8 have a 2 char operator 3965 7C3A 133A JEQ CRU32 If read end of line-single ope 3966 7C3C 06A0 BL @BACKUP Backup read pointer 7C3E 7F54 3967 7C40 9821 CB @CPTBL(R1),@LBCPMO Next char also a multi-oper? 7C42 610C 7C44 6146 3968 7C46 1634 JNE CRU32 No, want single-char oper 3969 7C48 06A0 BL @PUTCHR Copy in first char to oper 7C4A 7F6E 3970 7C4C 1033 JMP CRU36 And scan keyword table 3971 * Set name copy mode 3972 7C4E 0207 CRU18 LI R7,CRU76 Alphabetic: set name copy mode 7C50 7E06 3973 *----------------------------------------------------------- 3974 * Insert following 2 lines for adding lowercase character 3975 * set in 99/4A 5/12/81 3976 7C52 0920 SRL R0,2 Adjust R0 for LOWUP routine 3977 7C54 06A0 BL @LOWUP Translate lowercase to upper 7C56 7FEE 3978 * if necessary 3979 *----------------------------------------------------------- 3980 7C58 10C5 JMP CRU06 And resume copy 3981 * Handle single character operators 3982 7C5A 112A CRU20 JLT CRU32 Bit 4: single character oper 3983 7C5C 0A20 SLA R0,2 Scan property bits 5 and 6 3984 7C5E 180E JOC CRU24 If numeric 3985 7C60 1112 JLT CRU26 If digit only 3986 7C62 0288 CI R8,QUOTE Is it a string quote? 7C64 0022 3987 7C66 1678 JNE ERRIVN No, unknown char so error 3988 7C68 C287 MOV R7,R10 Yes, save current mode 3989 7C6A 0208 CRU22 LI R8,QUOTEZ Convert char to quote token 7C6C 00C7 3990 7C6E 06A0 BL @PUTCHR Put in token 7C70 7F6E 3991 7C72 0207 LI R7,CRU68 Set string, copy mode 7C74 7DE2 3992 7C76 C160 MOV @RAMPTR,R5 Save pointer to length byte 7C78 830A 3993 7C7A 10B4 JMP CRU06 Continue copy w/quote token 3994 7C7C 0288 CRU24 CI R8,'.' A decimal point 7C7E 002E 3995 7C80 1602 JNE CRU26 No, decode as numeric/line # 3996 7C82 0206 LI R6,CRU96 Yes, decode as numeric 7C84 7ED4 3997 7C86 0456 CRU26 B *R6 Handle numeric or line # 3998 7C88 0460 BERRSY B @CERSYN Long distance SYNTAX ERROR 7C8A 7F4C 3999 7C8C 06A0 CRU27 BL @PUTCHR Put out last char before end 7C8E 7F6E 4000 7C90 05A0 INC @VARW Skip last character 7C92 8320 4001 * Here for successful completion of scan 4002 7C94 06C8 CRU28 SWPB R8 Mark end of line with a null 99/4 ASSEMBLER CRUNCHS PAGE 0090 4003 7C96 06A0 BL @PUTCHR Put the end of line in 7C98 7F6E 4004 7C9C CRNADD EQU $+2 4005 7C9A 0200 LI R0,CRNBUF Get start of crunch buffer 7C9C 0820 4006 7C9E 0500 NEG R0 Negate for backwards add 4007 7CA0 A020 A @RAMPTR,R0 Calculate line length 7CA2 830A 4008 7CA4 D820 MOVB @R0LB,@CHAT Save length for GPL 7CA6 83E1 7CA8 8342 4009 7CAA 06A0 BL @GETSTK Restore GROM address 7CAC 610E 4010 7CAE 045C B *R12 Return with pointer beyond nul 4011 * Keyword table scanning routine. Name has already been 4012 * copied into crunch area starting at R9; RAMPTR point just 4013 * beyond name in input line. 4014 * R3 is name length, R1 indexes into the table 4015 7CB0 06A0 CRU32 BL @BACKUP Fix pointer for copy(next line 7CB2 7F54 4016 7CB4 06A0 CRU36 BL @GETCHR Read last character 7CB6 6FBA 4017 7CB8 D501 MOVB R1,*R4 Put into output buffer 4018 7CBA 06A0 BL @PUTCHR Copy into crunch buffer 7CBC 7F6E 4019 7CBE C0E0 CRU38 MOV @RAMPTR,R3 Get end pointer 7CC0 830A 4020 7CC2 60C9 S R9,R3 Sub start to get length of nam 4021 7CC4 0283 CI R3,MAXKEY Is longer than any keyword? 7CC6 000A 4022 7CC8 1B71 JH CRU61 Yes, can't be a keyword 4023 7CCA C083 MOV R3,R2 Get name length and 4024 7CCC 0602 DEC R2 corremt 0 length name indexin 4025 7CCE 0A12 SLA R2,1 Turn it into an index 4026 7CD0 0222 AI R2,KEYTAB Add in address of table list 7CD2 CB00 4027 7CD4 DB42 MOVB R2,@GRMWAX(R13) Load address to GROM 7CD6 0402 4028 7CD8 06C2 SWPB R2 4029 7CDA DB42 MOVB R2,@GRMWAX(R13) 7CDC 0402 4030 7CDE D09D MOVB *R13,R2 Read address of correct table 4031 7CE0 D81D MOVB *R13,@R2LB Both bytes 7CE2 83E5 4032 * R2 now contains the address of the correct table 4033 7CE4 DB42 CRU40 MOVB R2,@GRMWAX(R13) Load address of table 7CE6 0402 4034 7CE8 C003 MOV R3,R0 Copy of length for compare 4035 7CEA DB60 MOVB @R2LB,@GRMWAX(R13) 7CEC 83E5 7CEE 0402 4036 7CF0 D7E0 MOVB @R9LB,*R15 Source is in VDP 7CF2 83F3 4037 7CF4 A083 A R3,R2 Address of next keyword in tab 4038 7CF6 D7C9 MOVB R9,*R15 4039 7CF8 0582 INC R2 Skip token value 4040 7CFA 9760 CRU42 CB @XVDPRD,*R13 Compare the character 7CFC 8800 4041 7CFE 1A59 JL CRU61A If no match possible 99/4 ASSEMBLER CRUNCHS PAGE 0091 4042 7D00 16F1 JNE CRU40 No match, but match possible 4043 7D02 0600 DEC R0 Compared all? 4044 7D04 16FA JNE CRU42 No, check next one 4045 7D06 C809 MOV R9,@RAMPTR Name matched so throw out name 7D08 830A 4046 7D0A D51D MOVB *R13,*R4 Read the token value 4047 7D0C 04E0 CLR @ARG4 Indicate keyword found 7D0E 8360 4048 * Check for specially crunched statements 4049 7D10 0207 LI R7,CRU14 Assume a REM statement 7D12 7C02 4050 7D14 0200 LI R0,SPECTB-1 Now check for special cases 7D16 7FD5 4051 *********************************************************** 4052 * For GRAM KRACKER XB or RichGKXB or SXB substitute with: * 4053 * CI R8,>000B * 4054 *********************************************************** 4055 7D18 0288 CI R8,MERGEZ Is this a command? 7D1A 0008 4056 7D1C 1B06 JH CRU47 No, continue on 4057 7D1E C0E0 MOV @FAC,R3 Yes, attempt to put in program 7D20 834A 4058 7D22 161C JNE ERRCIP Yes, *COMMAND ILLEGAL IN PROGR 4059 7D24 0289 CI R9,CRNBUF Command 1st token in line? 7D26 0820 4060 7D28 16AF JNE BERRSY No, *SYNTAX ERROR* 4061 7D2A 0580 CRU47 INC R0 Skip offset value 4062 7D2C 9C14 CB *R4,*R0+ In special table? 4063 7D2E 1320 JEQ CRU53A Yes, handle it 4064 7D30 1BFC JH CRU47 If still possible match 4065 *********************************************************** 4066 * For GRAM KRACKER XB or RichGKXB or SXB substitute with: * 4067 * CI R8,>000C * 4068 *********************************************************** 4069 7D32 0288 CI R8,MERGEZ A specially scanned command? 7D34 0008 4070 7D36 1AAA JL CRU27 Yes, exit crunch 4071 7D38 0200 LI R0,LNTAB Now check for line number 7D3A 7FC8 4072 7D3C 9C14 CRU48 CB *R4,*R0+ In table? 4073 7D3E 1309 JEQ CRU52 Yes, change to line # crunch 4074 7D40 1BFD JH CRU48 May still be in table 4075 7D42 0288 CI R8,COMMAZ Just crunch a comma? 7D44 00B3 4076 7D46 1303 JEQ CRU50 Yes, so retain current numeric 4077 7D48 0288 CI R8,TOZ Just crunch a TO? 7D4A 00B1 4078 7D4C 160F JNE CRU53 No, so reset to normal numeric 4079 7D4E 0460 CRU50 B @CRU05 Yes, resume normal copy 7D50 7BE0 4080 7D52 0206 CRU52 LI R6,CRU100 Set line number scan mode 7D54 7F08 4081 7D56 10FB JMP CRU50 Set normal scan mode 4082 7D58 05A0 ERRIVN INC @ERRCOD *ILLEGAL VARIABLE NAME 7D5A 8322 4083 7D5C 05A0 ERRCIP INC @ERRCOD *COMMAND ILLEGAL IN PROGRAM 7D5E 8322 4084 7D60 05A0 ERRNQT INC @ERRCOD *NONTERMINATED QUOTED STING 7D62 8322 99/4 ASSEMBLER CRUNCHS PAGE 0092 4085 7D65 CBH20 EQU $+1 4086 7D64 A820 ERRNTL A @C4,@ERRCOD *NAME TO LONG 7D66 6A80 7D68 8322 4087 7D6A 1094 JMP CRU28 Exit back to GPL 4088 7D6C OFFSET EQU $ 4089 7D6C 0460 CRU53 B @CRU04 Stmt sep resets to normal scan 7D6E 7BDC 4090 7D70 D050 CRU53A MOVB *R0,R1 Pick up offset from table 4091 7D72 0981 SRL R1,8 Make into offset 4092 7D74 0461 B @OFFSET(R1) Goto special case handler 7D76 7D6C 4093 * Process a LIST statement 4094 7D78 06A0 CRU57 BL @PUTCHR Put the list token in 7D7A 7F6E 4095 7D7C 06A0 BL @GETNB Get next character 7D7E 6FAC 4096 7D80 0281 CI R1,QUOTE*256 Device name available? 7D82 2200 4097 7D84 1687 JNE CRU28 No, no more to crunch, exit 4098 7D86 020A LI R10,CRU106 Yes, set after string scan mod 7D88 7F2C 4099 7D8A 0460 B @CRU22 Crunch the device name 7D8C 7C6A 4100 * Process an IMAGE statement 4101 7D8E 020A CRU54 LI R10,CRU83B Image after, string copy mode 7D90 7E2E 4102 7D92 1002 JMP CRU59 Handle similar to data stmt 4103 * Process a DATA statement 4104 7D94 020A CRU58 LI R10,CRU83 After-datum skip spaces 7D96 7E28 4105 7D98 8820 CRU59 C @RAMPTR,@CRNADD Image & data must be 1st on li 7D9A 830A 7D9C 7C9C 4106 7D9E 164B JNE JNESY1 If not, error 4107 7DA0 0202 LI R2,CRU84 (non)quote string copy mode 7DA2 7E5A 4108 7DA4 0207 CRU60 LI R7,CRU80 Now set check-for-quote mode 7DA6 7E7A 4109 7DA8 0460 CRU74 B @CRU06 And copyin statement token 7DAA 7BE4 4110 * Here when don't find something in the keyword table 4111 7DAC 0283 CRU61 CI R3,15 Is it longer than name can be? 7DAE 000F 4112 7DB0 1BD9 JH ERRNTL Yes, name to long 4113 7DB2 C020 CRU61A MOV @ARG4,R0 Symbol name last time too? 7DB4 8360 4114 7DB6 163F JNE JNESY1 Yes, can't have 2 in a row 4115 7DB8 0620 DEC @ARG4 Indicate symbol noe 7DBA 8360 4116 7DBC 0207 CRU62 LI R7,CRU16 No keyword,; leave in CRNBUF 7DBE 7C1E 4117 7DC0 0206 LI R6,CRU96 Assume normal numeric scan 7DC2 7ED4 4118 7DC4 0460 CRU64 B @CRU08 And continue to scan line 7DC6 7BE8 4119 * Process a SUB statement 4120 7DC8 C0E0 CRU65 MOV @RAMPTR,R3 Get the current crunch pointer 7DCA 830A 99/4 ASSEMBLER CRUNCHS PAGE 0093 4121 7DCC 0603 DEC R3 Point at last character put in 4122 7DCE 06A0 BL @GETV1 Read it 7DD0 1880 4123 7DD2 9801 CB R1,@GOZTOK Was it a GO? 7DD4 7FC9 4124 7DD6 13BD JEQ CRU52 Yes, SUB is part of GO SUB 4125 * Process a CALL SUB statement 4126 7DD8 0207 CRU66 LI R7,CRU93 Set name copy 7DDA 7EC2 4127 7DDC 10E5 JMP CRU74 And get next character 4128 7DDE 0460 CRU32L B @CRU32 7DE0 7CB0 4129 * Now the various mode copy routines; string, names, image, 4130 * and data statements 4131 7DE2 C208 CRU68 MOV R8,R8 Premature end of line? 4132 7DE4 13BD JEQ ERRNQT Yes, *NONTERMINATED QUOTED STR 4133 7DE6 0288 CI R8,QUOTE Reach end of string? 7DE8 0022 4134 7DEA 16DE JNE CRU74 No, continue copying 4135 7DEC 06A0 BL @GETCHR Get next character 7DEE 6FBA 4136 7DF0 D041 MOVB R1,R1 Read end of line? 4137 7DF2 1305 JEQ CRU70 Yes, can't be double quote 4138 7DF4 0281 CI R1,QUOTE*256 Is it two quotes in a row? 7DF6 2200 4139 7DF8 13D7 JEQ CRU74 Yes, copy in a normal quote 4140 7DFA 06A0 BL @BACKUP No, backup & rtn to normal sca 7DFC 7F54 4141 7DFE C1CA CRU70 MOV R10,R7 Needed for image/data stmts 4142 7E00 06A0 CRU72 BL @LENGTH Calculate length of string 7E02 6FE2 4143 7E04 10DF JMP CRU64 Resume scan 4144 * Names 4145 *----------------------------------------------------------- 4146 * Replace following two lines for adding lowercase 4147 * character set in 99/4A 5/12/81 4148 * CRU76 ANDI R0,CPALNM*256 Is this char alpha or digit 4149 * JEQ CRU74 Yes, continue packing 4150 7E06 0240 CRU76 ANDI R0,CPULNM*256 Is this char alpha (both are 7E08 2300 4151 * upper and lower) or a digit? 4152 7E0A 160B JNE CRU78 Yes, continue packing 4153 *----------------------------------------------------------- 4154 * No, finish w/name packing 4155 7E0C 0288 CI R8,'$' Does name end with a $? 7E0E 0024 4156 7E10 13E6 JEQ CRU32L Yes, include it in name 4157 7E12 D514 MOVB *R4,*R4 At an end of line? 4158 7E14 1302 JEQ CRU79 Yes, don't back up pointer 4159 7E16 06A0 BL @BACKUP Backup for next char 7E18 7F54 4160 7E1A 0460 CRU79 B @CRU38 Jump to name/keyword check 7E1C 7CBE 4161 7E1E 0460 CRU82 B @CRU22 7E20 7C6A 4162 *----------------------------------------------------------- 4163 * Add following 2 lines for adding lowercase character set 4164 * for 99/4A 5/12/81 4165 7E22 06A0 CRU78 BL @LOWUP Translate lower to upper if 99/4 ASSEMBLER CRUNCHS PAGE 0094 7E24 7FEE 4166 * necessary 4167 7E26 10C0 JMP CRU74 Continue packing 4168 *----------------------------------------------------------- 4169 * DATA: Scan spaces after a quoted string datum 4170 7E28 0288 CRU83 CI R8,COMMA Hit a comma? 7E2A 002C 4171 7E2C 1321 JEQ CRU85A Yes, get back into scan 4172 * IMAGE: Scan spaces after a quoted string datum 4173 7E2E D000 CRU83B MOVB R0,R0 At a space? 4174 7E30 11C9 JLT CRU64 Yes, ignore it 4175 7E32 C208 MOV R8,R8 At end of line? 4176 7E34 13C3 JEQ CRU62 Yes, exit scan 4177 7E36 1064 JNESY1 JMP JNESYN No, unknown character 4178 * DATA: Scan imbedded blanks and check trailing blanks 4179 7E38 C820 CRU83A MOV @VARW,@ARG2 Save input pointer 7E3A 8320 7E3C 835E 4180 7E3E 06A0 BL @GETNB Look for next non-blank 7E40 6FAC 4181 7E42 D041 MOVB R1,R1 At end of line? 4182 7E44 1337 JEQ CRU92 Yes, end string and exit 4183 7E46 028A CI R10,CRU83B Scanning an image? 7E48 7E2E 4184 7E4A 1303 JEQ CRU83C Yes, commas are not significan 4185 7E4C 0281 CI R1,COMMA*256 Hit a comma? 7E4E 2C00 4186 7E50 130D JEQ CRU85 Yes, ignore trailing spaces 4187 7E52 C820 CRU83C MOV @ARG2,@VARW No, restore input pointer 7E54 835E 7E56 8320 4188 7E58 10A7 JMP CRU74 and include imbedded space 4189 * DATA: Scan unquoted strings 4190 7E5A 11EE CRU84 JLT CRU83A If hit a space-end of string 4191 7E5C C208 MOV R8,R8 At end-of-line? 4192 7E5E 132A JEQ CRU92 Yes, put in length and exit 4193 7E60 0288 CI R8,COMMA Reached a comma? 7E62 002C 4194 7E64 16A1 JNE CRU74 No, scan unquoted string 4195 7E66 028A CI R10,CRU83B Scanning an IMAGE stmt? 7E68 7E2E 4196 7E6A 139E JEQ CRU74 Commas are not significant 4197 7E6C 06A0 CRU85 BL @LENGTH Yes, end the string 7E6E 6FE2 4198 7E70 0208 CRU85A LI R8,COMMAZ Load a comma token 7E72 00B3 4199 7E74 05A0 INC @VAR5 Count comma for input stmt 7E76 8310 4200 7E78 1095 JMP CRU60 And resume in string mode 4201 * IMAGE/DATA: Check for leading quote mark 4202 7E7A 11A4 CRU80 JLT CRU64 Ignore leading separators 4203 7E7C 0288 CI R8,QUOTE Quotoed string? 7E7E 0022 4204 7E80 13CE JEQ CRU82 Yes, like any string, R10 ok 4205 7E82 C208 MOV R8,R8 End of line? 4206 7E84 1365 JEQ BCRU28 Yes, end it 4207 7E86 028A CI R10,CRU83B Scanning an IMAGE? 7E88 7E2E 4208 7E8A 1303 JEQ CRU88 Yes, ignore commas 99/4 ASSEMBLER CRUNCHS PAGE 0095 4209 7E8C 0288 CI R8,COMMA At a comma? 7E8E 002C 4210 7E90 13EF JEQ CRU85A Yes, put it in directly 4211 7E92 C1C2 CRU88 MOV R2,R7 No, set unquote string copy mo 4212 * IMAGE & DATA: Scan unquoted strings 4213 7E94 0208 CRU86 LI R8,UNQSTZ Load unquoted string token 7E96 00C8 4214 7E98 06A0 BL @PUTCHR Put the token in 7E9A 7F6E 4215 7E9C C160 MOV @RAMPTR,R5 Save current crunch pointer 7E9E 830A 4216 7EA0 06A0 BL @BACKUP Back up to scan again 7EA2 7F54 4217 7EA4 1081 CRU87 JMP CRU74 Resume scan 4218 * CALL and SUB statements 4219 *----------------------------------------------------------- 4220 * Replace following 2 lines for adding lowercase character 4221 * set for 99/4A 5/12/81 4222 * CRU94 ANDI R0,CPALNM*256 Still an alpha-numeric 4223 * JNE CRU74 Yes, include in name 4224 7EA6 0240 CRU94 ANDI R0,CPULNM*256 Still an alpha(U & L)-numeric 7EA8 2300 4225 7EAA 1607 JNE CRU91 Yes, transfer L to U, then 4226 * include in name 4227 *----------------------------------------------------------- 4228 7EAC C208 MOV R8,R8 At end of line? 4229 7EAE 1302 JEQ CRU92 Yes, get out now 4230 7EB0 06A0 CRU90 BL @BACKUP No, reset read pointer 7EB2 7F54 4231 7EB4 0207 CRU92 LI R7,CRU16 Normal scanning mode 7EB6 7C1E 4232 7EB8 10A3 JMP CRU72 Calculate & put in string leng 4233 *----------------------------------------------------------- 4234 * Add following lines for adding lowercase character set 4235 * for 99/4A 5/12/81 4236 7EBA 06A0 CRU91 BL @LOWUP Transfer lowercase char to 7EBC 7FEE 4237 * uppercase char if necessary 4238 7EBE 0460 B @CRU74 Include in name 7EC0 7DA8 4239 *----------------------------------------------------------- 4240 * CALL and SUB statements before hit name 4241 7EC2 1180 CRU93 JLT CRU64 If a space, ignore it 4242 7EC4 C000 MOV R0,R0 Premature EOL or NIL char, pro 4243 7EC6 1342 JEQ CERSYN Yes, *SYNTAX ERROR 4244 *----------------------------------------------------------- 4245 * Replace following line for adding lowercase character set 4246 * for 99/4A 5/12/81 4247 * ANDI R0,CPALPH*256 An alphabetic to start name? 4248 7EC8 0240 ANDI R0,CPUL*256 An alphabetic (both U & L) to 7ECA 2100 4249 * start name? 4250 *----------------------------------------------------------- 4251 7ECC 133F JEQ CERSYN No, syntax error 4252 7ECE 0207 LI R7,CRU94 Set up to copy name 7ED0 7EA6 4253 7ED2 10E0 JMP CRU86 Put in the unqst token 4254 * Numerics 4255 7ED4 0207 CRU96 LI R7,CRU98 Set after-initialize scan 99/4 ASSEMBLER CRUNCHS PAGE 0096 7ED6 7EDE 4256 7ED8 04E0 CLR @ARG Clear the 'E' flag 7EDA 835C 4257 7EDC 10DB JMP CRU86 Set up for the numeric 4258 7EDE C208 CRU98 MOV R8,R8 At end of line? 4259 7EE0 13E9 JEQ CRU92 Yes end the number 4260 7EE2 0A20 SLA R0,2 Scan property bit 2 4261 7EE4 1108 JLT CRU99A If alpha, might ge 'E' 4262 7EE6 0A30 SLA R0,3 Scan property bits 4 and 5 4263 7EE8 1702 JNC CRU99 Bit 4=oper, if not oper, jmp 4264 7EEA C020 MOV @ARG,R0 If operator, follow an 'E'? 7EEC 835C 4265 7EEE 04E0 CRU99 CLR @ARG Previous char no longer an 'E' 7EF0 835C 4266 7EF2 11D8 JLT CRU87 If still numeric 4267 7EF4 10DD JMP CRU90 No longer numeric 4268 7EF6 0288 CRU99A CI R8,'E' 'E' to indicate an exponent? 7EF8 0045 4269 7EFA 16DA JNE CRU90 No, so end the numeric 4270 7EFC C020 MOV @ARG,R0 An 'E' already encountered? 7EFE 835C 4271 7F00 1625 JNESYN JNE CERSYN Yes, so error 4272 7F02 0720 SETO @ARG No, indicated 1 encountered no 7F04 835C 4273 7F06 10CE JMP CRU87 And include it in the number 4274 * Line numbers 4275 7F08 C208 CRU100 MOV R8,R8 At end of line? 4276 7F0A 1322 JEQ BCRU28 Yes, exit crunch 4277 7F0C 06A0 BL @GETINT Try to get a line number 7F0E 7F8C 4278 7F10 C000 MOV R0,R0 Get a line number? 4279 7F12 130A JEQ CRU105 No, back to normal numeric mod 4280 7F14 0208 LI R8,LNZ Load a line number token 7F16 00C9 4281 7F18 06A0 BL @PUTCHR Put it out 7F1A 7F6E 4282 7F1C C200 MOV R0,R8 Set up to put out binary # 4283 7F1E 06C8 SWPB R8 Swap to put MSB of # 1st 4284 7F20 06A0 BL @PUTCHR Put out 1st byte of line # 7F22 7F6E 4285 7F24 0988 SRL R8,8 Bare the 2nd byte of line # 4286 7F26 10BE JMP CRU87 Jump back into it 4287 7F28 0460 CRU105 B @CRU04 Back to normal numeric mode 7F2A 7BDC 4288 * Handle a list statement 4289 7F2C 11CA CRU106 JLT CRU93 If space, ignore it 4290 7F2E C208 MOV R8,R8 At end of line? 4291 7F30 130F JEQ BCRU28 Yes, exit crunch 4292 7F32 0288 CI R8,':' Get a colon? 7F34 003A 4293 7F36 160A JNE CERSYN No, *SYNTAX ERROR 4294 7F38 0208 LI R8,COLONZ Need to put colon in 7F3A 00B5 4295 7F3C 0460 B @CRU27 And exit crunch 7F3E 7C8C 4296 * Error handling routine 4297 7F40 05A0 ERRLTL INC @ERRCOD * LINE TO LONG 3 7F42 8322 4298 7F44 0660 DECT @RAMPTR Backup so can exit to GPL 99/4 ASSEMBLER CRUNCHS PAGE 0097 7F46 830A 4299 7F48 05A0 ERRBLN INC @ERRCOD * BAD LINE NUMBER 2 7F4A 8322 4300 7F4C 05A0 CERSYN INC @ERRCOD * SYNTAX ERROR 1 7F4E 8322 4301 7F50 0460 BCRU28 B @CRU28 Exit back to GPL 7F52 7C94 4302 * Back up pointer in input line to rescan last character 4303 7F54 0620 BACKUP DEC @VARW Back up the pointer 7F56 8320 4304 7F58 D7E0 MOVB @VARW1,*R15 Write LSB of address 7F5A 8321 4305 7F5C 1000 NOP 4306 7F5E D7E0 MOVB @VARW,*R15 Write MSB of address 7F60 8320 4307 7F62 0200 LI R0,>7F00 >7F is an edge character 7F64 7F00 4308 7F66 7020 SB @XVDPRD,R0 At an edge chracter? 7F68 8800 4309 7F6A 13F4 JEQ BACKUP Yes, back up one more 4310 7F6C 045B RT And return to caller 4311 * Put a character into the crunch buffer 4312 7F6E C060 PUTCHR MOV @RAMPTR,R1 Fetch the current pointer 7F70 830A 4313 7F72 0281 CI R1,CRNEND At end of buffer? 7F74 091C 4314 7F76 1BE4 JH ERRLTL Yes, LINE TO LONG 4315 7F78 D7E0 MOVB @R1LB,*R15 Put out LSB of address 7F7A 83E3 4316 7F7C 0261 ORI R1,WRVDP Enable VDP write 7F7E 4000 4317 7F80 D7C1 MOVB R1,*R15 Put out MSB of address 4318 7F82 05A0 INC @RAMPTR Increment the pointer 7F84 830A 4319 7F86 D814 MOVB *R4,@XVDPWD Write out the byte 7F88 8C00 4320 7F8A 045B RT And return 4321 *----------------------------------------------------------- 4322 * Move LENGTH to GETNB, becuase CRUNCH is running out of 4323 * space, 1/21/81 4324 * Calculate and put length of string/number into length 4325 * byte 4326 * LENGTH MOV R11,R3 Save return address 4327 * MOV @RAMPTR,R0 Save current crunch pointer 4328 * MOV R0,R8 Put into R8 for PUTCHR below 4329 * S R5,R8 Calculate length of string 4330 * DEC R8 RAMPTR is post-incremented 4331 * MOV R5,@RAMPTR Address of length byte 4332 * BL @PUTCHR Put the length in 4333 * MOV R0,@RAMPTR Restore crunch pointer 4334 * B *R3 And return 4335 *----------------------------------------------------------- 4336 * 4337 * Get a small non-negative integer 4338 * CALL: VARW - TEXT POINTER, points to second character 4339 * R8 - First character in low byte 4340 * BL @GETINT 4341 * R0 - NUMBER 4342 * VARW - Text pointer, if there is a number, points to 99/4 ASSEMBLER CRUNCHS PAGE 0098 4343 * character after number. If there is not a 4344 * number, unchanged. 4345 * R8 - 0 in high byte 4346 * DESTROYS: R1, R2 4347 7F8C C0CB GETINT MOV R11,R3 Save return address 4348 7F8E C008 MOV R8,R0 Get possible digit 4349 7F90 0202 LI R2,10 Get radix in register for spee 7F92 000A 4350 7F94 0220 AI R0,-'0' Convert from ASCII to binary 7F96 FFD0 4351 7F98 8080 C R0,R2 Is the character a digit? 4352 7F9A 1A08 JL GETI02 Yes, there is a number! 4353 7F9C 04C0 CLR R0 No, indicate no number 4354 7F9E 0453 B *R3 Done, no number 4355 7FA0 3802 GETI01 MPY R2,R0 Multiply previous by radix 4356 7FA2 C000 MOV R0,R0 Overflow? 4357 7FA4 16D1 JNE ERRBLN Yes, bad line number 4358 7FA6 C001 MOV R1,R0 Get low order word of product 4359 7FA8 A008 A R8,R0 Add in next digit 4360 7FAA 11CE JLT ERRBLN If number went negative, error 4361 7FAC 06A0 GETI02 BL @GETCHR Get next character 7FAE 6FBA 4362 7FB0 D501 MOVB R1,*R4 Put into normal position 4363 7FB2 1306 JEQ GETI03 If read end of line 4364 7FB4 0228 AI R8,-'0' Convert from ASCII to binary 7FB6 FFD0 4365 7FB8 8088 C R8,R2 Is this character a digit? 4366 7FBA 1AF2 JL GETI01 Yes, try to pack it in 4367 7FBC 0620 DEC @VARW No point to 1st char after num 7FBE 8320 4368 7FC0 04C8 GETI03 CLR R8 Clean up our mess 4369 7FC2 C000 MOV R0,R0 Hit a natural zero? 4370 7FC4 13C1 JEQ ERRBLN Yes, its an error 4371 7FC6 0453 B *R3 And return 4372 * The LINE NUMER TABLE 4373 * All tokens which appear in the table must have numerics 4374 * which follow them crunched as line numbers. 4375 7FC8 81 LNTAB BYTE ELSEZ 4376 7FC9 85 GOZTOK BYTE GOZ 4377 7FCA 86 BYTE GOTOZ 4378 7FCB 87 BYTE GOSUBZ 4379 7FCC 88 BYTE RETURZ 4380 7FCD 8E BYTE BREAKZ 4381 7FCE 8F BYTE UNBRKZ 4382 7FCF 94 BYTE RESTOZ 4383 7FD0 A5 BYTE ERRORZ 4384 7FD1 A9 BYTE RUNZ 4385 7FD2 B0 BYTE THENZ 4386 7FD3 ED BYTE USINGZ 4387 7FD4 FF BYTE >FF Indicate end of table 4388 EVEN 4389 ************************************************************ 4390 * Table of specially crunched statements 4391 * 2 bytes - special token 4392 * Byte 1 - token value 4393 * Byte 2 - "address" of special handler 4394 * Offset from label OFFSET in this assembly of 4395 * the special case handler 4396 ************************************************************ 99/4 ASSEMBLER CRUNCHS PAGE 0099 4397 7FD6 02 SPECTB BYTE LISTZ,CRU57-OFFSET 7FD7 0C 4398 7FD8 05 BYTE OLDZ,CRU58-OFFSET 7FD9 28 4399 7FDA 07 BYTE SAVEZ,CRU58-OFFSET 7FDB 28 4400 7FDC 08 BYTE MERGEZ,CRU58-OFFSET 7FDD 28 4401 7FDE 82 BYTE SSEPZ,CRU53-OFFSET 7FDF 00 4402 7FE0 83 BYTE TREMZ,CRU74-OFFSET 7FE1 3C 4403 7FE2 93 BYTE DATAZ,CRU58-OFFSET 7FE3 28 4404 7FE4 9A BYTE REMZ,CRU74-OFFSET 7FE5 3C 4405 7FE6 9D BYTE CALLZ,CRU66-OFFSET 7FE7 6C 4406 7FE8 A1 BYTE SUBZ,CRU65-OFFSET 7FE9 5C 4407 7FEA A3 BYTE IMAGEZ,CRU54-OFFSET 7FEB 22 4408 7FEC FF BYTE >FF 4409 EVEN 4410 * 4411 * TRANSFER LOWERCASE CHARACTER TO UPPERCASE CHARACTER 4412 * R0 - Last digit indicates whether this character is a 4413 * lowercase character 4414 7FEE 0240 LOWUP ANDI R0,CPLOW*256 Is lowercase prop set? 7FF0 0100 4415 7FF2 1302 JEQ LU01 No, just return 4416 7FF4 7520 SB @CBH20,*R4 Change lower to upper 7FF6 7D65 4417 7FF8 045B LU01 RT 4418 ************************************************************ 4419 4420 7FFA AORG >7FFA 4421 7FFA 04E0 PAGER CLR @>6000 * RESTORE PAGE ONE 7FFC 6000 4422 7FFE 0459 B *R9 4423 ************************************************************ 4424 END 99/4 ASSEMBLER CRUNCHS PAGE 0100 AAA11 8303 ABSZ 00CB ADDR1 834C ADDR11 834D ADDR2 8350 ADDR21 8351 ANDZ 00BB ARG 835C ARG1 835D ARG10 8366 ARG2 835E ARG3 835F ARG4 8360 ARG8 8364 ARG9 8365 ARGT05 6B8E ARGT10 6B92 ARGT20 6B9A ARGTST 6B6E ASSG 6334 ASSG54 6360 ASSG55 6374 ASSG56 638A ASSG57 637E ASSG59 63B6 ASSG70 63CE ASSG75 63EA ASSG77 63F4 ASSG79 63F8 ASSG80 6388 ASSGNV 61AE ATN01 79BC ATN02 79C8 ATN02A 79C4 ATNP 014E ATNSG3 79E8 ATNSGN 79E0 ATNZZ 797C B9900 64F2 BACKUP 7F54 BASE 8343 BCNT1 834E BCNT2 8308 BCNT3 8356 BCON1 6E7E BCONT 6D12 BCRU28 7F50 BERMUV 623C BERRSY 7C88 BERSNM 6EDE BERSYN 6EDA BEXC15 685C BIT2 62AB BITINT 7A50 BLTST9 6D58 BMF 6DF2 BREAK 0007 BREAKZ 008E BRKFL 0001 BRKP1L 65D2 BRKPN1 6644 BRKPN2 663E BRKPNT 6636 BROLIN 76BE BSO 6DF6 BSYNCH 6ED6 BUFLEV 8346 BYTE 830C C0 6548 C100 6008 C1000 600A C16 6BF8 C2 6000 C24 6464 C3 6544 C4 6A80 C40 6006 C6 618A C7 6002 C8 7AF4 CALGPL 666C CALIST 830A CALL 750A CALLZ 009D CB3 6545 CBH20 7D65 CBH3F 7490 CBH411 748E CBH44 7491 CBH63 6D05 CBH65 65A7 CBH66 66F1 CBH67 68AB CBH69 6A9B CBH6A 6860 CBH7 6003 CBH80 78FD CBH94 6005 CBHA 6004 CBHFF 60D6 CC3 7908 CCBH7 74D4 CCPADR 8308 CCPPTR 8306 CERSYN 7F4C CFI 12B8 CHAT 8342 CHRBUF 837D CIF 74AA CNS 7016 CNS01 704C CNSA01 745A CNSA02 7460 CNSAST 7440 CNSCHK 741A CNSD01 72F8 CNSD02 730C CNSD03 7314 CNSD04 731E CNSD05 732A CNSD06 7328 CNSDIG 72E6 CNSDRT 732E CNSE01 7346 CNSE02 7364 CNSE03 738E CNSE04 735A CNSE05 7386 CNSEXP 7330 CNSF01 7096 CNSF02 70A6 CNSF04 70C2 CNSF05 70C8 CNSF06 70E6 CNSF07 70FC CNSF08 7100 CNSF1 707C CNSF10 710A CNSF12 7118 CNSG 7124 CNSG01 713A CNSI01 739C CNSINT 7398 CNSITT 7006 CNSJ00 718E CNSJ01 71BA CNSJ02 71DC CNSJ03 71E8 CNSJ04 718A CNSK 720E CNSK01 7240 CNSK1 721A CNSL01 73CE CNSL02 73FA CNSL03 7400 CNSLEA 73C8 CNSMLS 73C4 CNSPER 73B2 CNSR01 725E CNSR02 72A4 CNSR03 72BC CNSR04 72BE CNSR05 72C6 CNSRND 7246 CNSROV 7290 CNSS01 746C CNSSEL 6070 CNSSTR 746A CNST01 72E2 CNST10 7B80 CNSTEN 72CA CNSU01 7406 CNSU02 7416 CNSUTR 7408 CNSV01 7202 CNSVZR 71EC CNSX 713E CNSX01 7158 CNSX02 7164 CNSX03 7170 CNSZ01 73B8 CNSZER 73BC COLONZ 00B5 COMM05 6D8C COMMA 002C COMMAZ 00B3 COMMON 6D74 COMPCG 619C COMPCT 73D8 CONC 667E CONCAT 0008 CONT 64C8 CONT10 64D8 CONT15 64E6 CONTG 64C4 CONTIN 65CC CONVRT 6E9E COSZZ 78B2 CPALNM 0022 CPALPH 0020 CPBRK 0040 CPDIG 0002 CPLOW 0001 CPMO 0010 CPNIL 0000 CPNUM 0004 CPOP 0008 CPSEP 0080 CPTBL 610C CPUL 0021 CPULNM 0023 CRNADD 7C9C CRNBUF 0820 CRNEND 091C CRNSEL 6076 CRU01 7BB4 CRU02 7BD2 CRU04 7BDC CRU05 7BE0 CRU06 7BE4 CRU08 7BE8 CRU09 7BFE CRU10 7BF2 CRU100 7F08 CRU105 7F28 CRU106 7F2C CRU12 7C00 CRU14 7C02 CRU15 7C06 CRU16 7C1E CRU18 7C4E CRU20 7C5A 99/4 ASSEMBLER CRUNCHS PAGE 0101 CRU22 7C6A CRU24 7C7C CRU26 7C86 CRU27 7C8C CRU28 7C94 CRU32 7CB0 CRU32L 7DDE CRU36 7CB4 CRU38 7CBE CRU40 7CE4 CRU42 7CFA CRU47 7D2A CRU48 7D3C CRU50 7D4E CRU52 7D52 CRU53 7D6C CRU53A 7D70 CRU54 7D8E CRU57 7D78 CRU58 7D94 CRU59 7D98 CRU60 7DA4 CRU61 7DAC CRU61A 7DB2 CRU62 7DBC CRU64 7DC4 CRU65 7DC8 CRU66 7DD8 CRU68 7DE2 CRU70 7DFE CRU72 7E00 CRU74 7DA8 CRU76 7E06 CRU78 7E22 CRU79 7E1A CRU80 7E7A CRU82 7E1E CRU83 7E28 CRU83A 7E38 CRU83B 7E2E CRU83C 7E52 CRU84 7E5A CRU85 7E6C CRU85A 7E70 CRU86 7E94 CRU87 7EA4 CRU88 7E92 CRU90 7EB0 CRU91 7EBA CRU92 7EB4 CRU93 7EC2 CRU94 7EA6 CRU96 7ED4 CRU98 7EDE CRU99 7EEE CRU99A 7EF6 CRULST 83C0 CRUNCH 7B88 CSN01 11B2 CSRC 830C CSTR05 6AFC CSTR10 6B00 CSTR20 6B1A CVROAZ 7A96 CZ 831A DATA 8334 DATAZ 0093 DDD11 8355 DELREP 7EF4 DEST 8358 DEST1 8359 DIVIDE 6B62 DIVIZ 00C4 DSRFLG 8317 DTECT2 606A ELSEZ 0081 END 665E ENDPRO 7C1C ENLN 8332 EOL 65D6 EOLINE 6872 EOLNE1 687A EOSTM1 6870 EOSTMT 6862 EQUALS 6A8E EQZ 00BE ERR 6652 ERR1 62CE ERR1B 6738 ERR1C 67F0 ERR1CZ 69A4 ERR3 6304 ERR51 67F2 ERRBLN 7F48 ERRBS 0503 ERRBV 6ECA ERRCIP 7D5C ERRCO1 8323 ERRCOD 8322 ERREX 0403 ERRIOR 0203 ERRIVN 7D58 ERRLN 038A ERRLNF 0303 ERRLOG 76D6 ERRLTL 7F40 ERRMUV 6970 ERRNIP 75BE ERRNQT 7D60 ERRNTL 7D64 ERROM 0103 ERRONE 664E ERROR 0005 ERRORZ 00A5 ERRSN 0003 ERRSN1 6ECE ERRSNM 6D5C ERRSO 6468 ERRSQR 78AE ERRSY1 6ED2 ERRSYN 664E ERRT 630C ERRTM 0603 ERRX 6308 EXC127 0000 EXC15L 65D0 EXEC10 650E EXEC11 6516 EXEC15 6542 EXEC16 6576 EXEC17 6588 EXEC20 658E EXEC50 6656 EXECG 6500 EXIT 6652 EXP 8376 EXP01 75FC EXP03 7614 EXP04 7640 EXPONZ 00C5 EXPP 007C EXPQ 0096 EXPSQ5 76A4 EXPSQ8 76B4 EXPSQT 7696 EXPZZ 75CA EXRTN 65A6 EXRTN2 65AE EXRTN3 65C8 EXRTNA 6466 EXTRAM 832E EXTRM1 832F FAC 834A FAC1 834B FAC10 8354 FAC11 8355 FAC12 8356 FAC13 8357 FAC14 8358 FAC15 8359 FAC16 835A FAC2 834C FAC33 836B FAC4 834E FAC5 834F FAC6 8350 FAC7 8351 FAC8 8352 FAC9 8353 FADD 0D80 FBS 15E0 FBS001 15E6 FBSYMB 618C FCOMP 0D3A FCOMPB 6126 FDIV 0FF4 FDVSR 8354 FDVSR1 8355 FDVSR2 8356 FDVSR8 835C FHALF 0008 FLAG 8345 FLTERR 836C FLTNDX 8354 FLTONE 600E FMULT 0E88 FORMA 77FC FORMA2 7822 FORNET 8317 FPOS1 006A FPSIGN 03DC FREPTR 8340 FSUB 0D7C GDST 8302 GDST1 8303 GDTECT 6050 GET 6C9A GET1 6C9E GETCGR 60D0 GETCH 60AE GETCH1 60BC GETCH2 6FDE GETCHG 60C0 GETCHR 6FBA GETG 6CCA GETG2 6CCE GETI01 7FA0 GETI02 7FAC GETI03 7FC0 GETINT 7F8C GETL10 6764 GETL1Z 68DA GETNB 6FAC GETNB1 6FAE GETSTG 61A2 GETSTK 610E GETSTR 736C GETV 187C GETV1 1880 GO 66D6 GOSUB 673A GOSUB2 673C GOSUBZ 0087 GOT32 677E GOT33 6792 GOT35 6798 GOTO 675C GOTO20 675E GOTO31 679C GOTO32 67A6 GOTO33 67BA GOTO34 67C8 99/4 ASSEMBLER CRUNCHS PAGE 0102 GOTO35 67C4 GOTO36 67CE GOTO40 67DA GOTO50 67EA GOTO90 670A GOTO95 670E GOTOZ 0086 GOZ 0085 GOZTOK 7FC9 GREAD 7EB4 GREAD1 7EA6 GREATR 6A7E GRINT 79EC GRMRAX 0002 GRMWAX 0402 GRMWDX 0400 GSRC 8354 GSRC1 8355 GTZ 00C0 GVWITE 7FDA GWITE1 7ECA GWRITE 7ED8 IF 68A6 IFZ 0084 IFZ10 68DE IFZ20 68FA IFZ25 6904 IFZ27 6910 IFZ28 691A IFZ30 6928 IFZ35 692E IFZ40 6934 IFZ5 68D0 IFZ50 693A IMAGEZ 00A3 INT01 7A20 INT02 7A40 INT03 7A4A INT04 7A60 INTRIN 8338 IO 7B48 JEQ1C 68EC JNESY1 7E36 JNESYN 7F00 JOYX 8377 JOYY 8376 KEYBRD 8375 KEYTAB CB00 LB10 700D LB100 700B LBAST 7011 LBCPMO 6146 LBE 7013 LBLPZ 6F81 LBPER 7012 LBSPC 7010 LBZER 7014 LEDEND 6B42 LEDERR 6B46 LEDEX 6B28 LEDLE 6A90 LENGTH 6FE2 LESS 6A70 LETCON 69A0 LEXP 6CE2 LFALSE 6AB8 LINUM 8312 LISTZ 0002 LLC 0020 LN10 0020 LNBUF 8336 LNTAB 7FC8 LNZ 00C9 LOG10E 0018 LOGP 00B8 LOGQ 00E2 LOGZ5A 76F6 LOGZZ 76C2 LOGZZ3 76D6 LOGZZ5 76F2 LOGZZ6 774C LOGZZ7 7754 LOGZZ9 776E LOWUP 7FEE LPAR 6F6C LPARZ 00B7 LSUBP 8348 LT10 6A82 LT15 6A88 LTAB 6A54 LTBLEN 001C LTRUE 6ABE LTST01 6A92 LTST15 6AB0 LTST20 6AE0 LTST90 6AC2 LTSTAB 6ADA LTSTEQ 6AB6 LTSTGE 6AB4 LTSTGT 6AD6 LTSTLE 6AD0 LTSTLT 6AD2 LTSTNE 6ABC LTSTXX 6AB4 LU01 7FF8 LW10 700C LW100 700A LWCNE 7002 LWCNF 7004 LWCNP 7000 LWCNS 6000 MAXKEY 000A MEMCHG 72CE MEMCHK 72D8 MERGEZ 0008 MINUS 6B4A MINUSZ 00C2 MNUM 8302 MNUM1 8303 MOTION 837A MOVF1 6452 MOVFA2 645A MOVFAC 6434 MOVRM1 7A74 MOVRM2 7A76 MOVRM4 7A88 MOVRM5 7A6A MOVROM 7A70 MVDN 7F7E MVDN2 7F8A MVUP 6F98 MVUP05 6FA4 NABS 6CFA NATN 6D16 NCOS 6D1C NEGPAD 7D00 NEXP 6D22 NEXT 0070 NEXTZ 0096 NFOR 7000 NINT 6D28 NLET 6948 NLET05 694C NLET10 6978 NLET15 6982 NLOG 6D2E NLPR 6E68 NMIN10 6E8C NMINUS 6E82 NNEXT 7230 NOLED 664E NOLEDL 64FA NONUD 664E NOTZ 00BD NPLUS 6E96 NSGN 6D34 NSIN 6D64 NSQR 6D6A NSTRCN 7442 NTAB 69FE NTABLN 0056 NTAN 6D70 NUDE10 64F4 NUDEND 65F0 NUDG05 64B0 NUDND1 65E6 NUDND2 65F4 NUDND3 6602 NUDND4 660A NUDNDL 64FE NUDTAB 8328 NUMC49 66A6 NUMCHK 6B92 NUMCON 6684 O0AND 6DFA O0AND1 6E0E O0AND2 6E14 O0NOT 6E2E O0OR 6E1C O0XOR 6E50 OEZ 8314 OFFSET 7D6C OLDZ 0005 ON 66DA ON20 6710 ON30 671A ON40 6726 ON50 6730 ONBRK 66D0 ONERR 66C4 ONWARN 66CA ORZ 00BA OVEXP 0FC2 P05 648A P10 6492 P17 64A8 P17L 64C2 PABPTR 8304 PAD0 8300 PAD1 8301 PAD5F 835F PADC2 83C2 PAGE1 6000 PAGE2 6002 PAGER 7FFA PAGSEL 607A PARCOM 6F74 PARSE 6480 PARSEG 6470 PGMC10 6C8E PGMCH 6410 PGMCHR 6C74 PGMPT1 832D PGMPTR 832C PGMSUB 6C7A PI2 0028 PI4 0038 PLAYER 8374 PLUS 6B1E PLUSZ 00C1 POLY 779A POLY01 77B8 POLY02 77CA POLY03 77E8 POLYW 7782 POLYX 77A6 POLYX1 77AA POP 7B16 POP1 7B2A POPSTK 60D4 PRGFLG 8344 PROAZ 8310 99/4 ASSEMBLER CRUNCHS PAGE 0103 PSCAN 7C56 PSHPRS 6B9C PSYM 6884 PUSH 7AF2 PUSH1 7B0C PUT1 6CB2 PUTCHR 7F6E PUTG2 6CD8 PUTSTK 60F2 PUTV 641E PUTV1 6422 PWARN 6DBC PWRG01 7554 PWRG02 754C PWRG05 75C4 PWRJ10 7500 PWRJ30 74F2 PWRJ40 7516 PWRJ41 752E PWRJ45 7540 PWRRTN 752A PWRTN2 7836 PWRTN3 796C PWRZZ 7492 PWRZZ1 7576 PWRZZ2 7596 PWRZZ3 7560 PWRZZ4 757E PWRZZ5 75BE PZ 8312 QUOTE 0022 QUOTEZ 00C7 QZ 8316 R0 0000 R0LB 83E1 R1 0001 R10 000A R10LB 83F5 R11 000B R11LB 83F7 R12 000C R12LB 83F9 R13 000D R13LB 83FB R14 000E R14LB 83FD R15 000F R15LB 83FF R1LB 83E3 R2 0002 R2LB 83E5 R3 0003 R3LB 83E7 R4 0004 R4LB 83E9 R5 0005 R5LB 83EB R6 0006 R6LB 83ED R7 0007 R7LB 83EF R8 0008 R8LB 83F1 R9 0009 R9LB 83F3 RAMFLG 8389 RAMPTR 830A RAMTOP 8384 RAND16 83D4 RANDOM 8378 RANERR 6F64 RANGE 6F30 REMZ 009A RESET 006A RESOLV 7946 RESTOZ 0094 RETRN 6DEC RETU30 6822 RETU40 6838 RETURN 67F8 RETURZ 0088 ROLIN 7AC4 ROLIN1 7AD4 ROLIN2 7AE0 ROLOT1 7AA6 ROLOUT 7A90 ROUNU 0FB2 ROUNUP 0F64 RPARZ 00B6 RPI2 0030 RTNADD 8326 RTNG 6630 RUNZ 00A9 SADD 0D84 SADDR 83D2 SAVEG 83CB SAVEZ 0007 SAVRE2 1E90 SAVREG 1E8C SAVRTN 7AB2 SCLEN 8355 SCOMPB 0D42 SCROLL 7ADA SDIV 0FF8 SEETW2 6F02 SEETW4 6F0A SEETW6 6F26 SEETW8 6F2A SEETWO 6EF0 SET 6192 SETREG 1E7A SGNZ 00D1 SIGN 8375 SIN01 7906 SIN02 790A SIN03 7928 SIN04 7930 SINP 010C SINZZ 78C0 SKPLN 662A SKPS01 6624 SKPSTR 6618 SMB 61DC SMB02 6202 SMB04 6210 SMB05 6214 SMB06 622C SMB08 6232 SMB51 6246 SMB57 6268 SMB71 62FC SMBB 61A8 SMBB10 61BE SMBO10 6236 SMBO20 626E SMBO25 6274 SMBO40 62B6 SMBO41 62B8 SMBO50 6240 SMBO70 62D2 SMBO71 62F6 SMTSEP 65C4 SMTSRT 831E SMULT 0E8C SPECTB 7FD6 SPEED 6EE2 SQR01 7878 SQR02 78A8 SQR03 78AE SQRP 0050 SQRQ 006A SQRTEN 0010 SQRZZ 783A SREF 831C SSEPZ 0082 SSUB 0D74 STACK 8373 STATUS 837C STCOD2 6981 STCODE 6188 STKADD 8373 STKCHK 6DC0 STKDAT 8372 STKEND 83BA STKMOV 60E8 STKRTN 6DF0 STLN 8330 STMTTB 69FC STND12 83AE STOP 665E STREND 831A STRINZ 00C7 STRSP 8318 STVDP 18AE STVDP3 18AA STVSPT 8324 SUBTAB 833A SUBXIT 78D2 SUBZ 00A1 SYM 6312 SYM1 6320 SYMB 61B4 SYMB10 68A2 SYMB20 687C SYMBOL 0376 SYMTA1 833F SYMTAB 833E SYNCHK 6400 SYNERR 6D60 TABSAV 0392 TAN01 7970 TAN3P8 0048 TANPI8 0040 TANZZ 7940 TEMP2 836C TENCNS 7B64 THENZ 00B0 TIME 8379 TIMES 6B56 TOZ 00B1 TRACE 6672 TRACL 65D4 TREMZ 0083 TRIERR 7938 TYPE 836D UDF 0006 UNBRKZ 008F UNQSTZ 00C8 USINGZ 00ED VAR0 8300 VAR5 8310 VAR9 8316 VARA 832A VARW 8320 VARW1 8321 VARY 8304 VARY2 8306 VDPSTS 837B VGWITE 7FC0 VPOP 6C2A VPOP10 6C46 VPOP18 6C6C VPOP20 6C6E VPSH15 6BC4 VPSH19 6BE8 VPSH20 6BF2 VPSH23 6C1A VPSH25 6C1E VPSH27 6C26 VPUSH 6BAA VPUSHG 61BA VROAZ 03C0 99/4 ASSEMBLER CRUNCHS PAGE 0104 VSPTR 836E VSPTR1 836F WARN 0009 WARNZ 00A6 WARNZZ 6662 WRVDP 4000 WS 83E0 WSM 831A WSM2 831C WSM4 831E WSM6 8320 WSM8 8322 XFLAG 8316 XGRMRD 9800 XORZ 00BC XPT 837F XTFAC1 7B52 XTFACZ 7B34 XVDPRD 8800 XVDPWD 8C00 YPT 837E 0000 ERRORS 836C THENZ 00B0 TIME 8379 TIMES 6B56 TOZ 00B1 TRACE 6672 TRACL 65D4 TREMZ 0083 TYPE 836D UDF 0006 UNQSTZ 00C8 VAR5 8310 VAR9 8316 VARA 832A VARW 8320 VARW1 8321 VDPSTS 837B VGWITE 7FC0 VGZ1 7FCE VPOP 6C2A VPOP10 6C46 VPOP18 6C6C VPOP20 6C6E VPSH15 6BC4 VPSH19 6BE8 VPSH20 6BF2 VPSH23 6C1A VPSH25 6C1E Rich Quote Link to comment Share on other sites More sharing options...
apersson850 Posted October 9, 2023 Share Posted October 9, 2023 I don't get the references to line numbers to match the published listing. Quote Link to comment Share on other sites More sharing options...
RXB Posted October 9, 2023 Share Posted October 9, 2023 4 hours ago, apersson850 said: I don't get the references to line numbers to match the published listing. The line numbers from ROM2 are the ones to look at. Or just search for CPNIL. Here is a upload off XB ROMs... SROM1.txt SROM2.txt Quote Link to comment Share on other sites More sharing options...
JasonACT Posted October 13, 2023 Share Posted October 13, 2023 Does anyone else get a crashed console (I.E. on real hardware) when letting RXB autoload the LOAD file from the WarZone2.DSK after the initial black screen with white writing has shown who wrote it and distributed it? I've tried Classic99 and it doesn't crash with RXB 2022, I've tried TI XB loaded on real hardware and it works ok, along with XB2.9 on hardware which also works well. I'm trying to track down if there's a problem with my Pi Pico device. Quote Link to comment Share on other sites More sharing options...
MikeV Posted October 13, 2023 Share Posted October 13, 2023 15 hours ago, JasonACT said: Does anyone else get a crashed console (I.E. on real hardware) when letting RXB autoload the LOAD file from the WarZone2.DSK after the initial black screen with white writing has shown who wrote it and distributed it? I've tried Classic99 and it doesn't crash with RXB 2022, I've tried TI XB loaded on real hardware and it works ok, along with XB2.9 on hardware which also works well. I'm trying to track down if there's a problem with my Pi Pico device. I actually did not know I had that game, but looked anyways. On an original TI it loaded and ran fine with RXB's 2015, 2022 and 2023. This was from a floppy however, cannot help with the Pi Pico as I do not own one. On Classic it loaded and ran fine except that the fire key 'Q' did nothing. Tried others but they did not seem to work either. Difficult to say for sure as survival time is quite brief without being able to fire. I presume this is a keyboard issue on my setup as the other keys worked. 2 1 Quote Link to comment Share on other sites More sharing options...
JasonACT Posted October 13, 2023 Share Posted October 13, 2023 (edited) 1 hour ago, MikeV said: On an original TI it loaded and ran fine with RXB's 2015, 2022 and 2023. This was from a floppy however, cannot help with the Pi Pico as I do not own one. On Classic it loaded and ran fine except that the fire key 'Q' did nothing. Tried others but they did not seem to work either. Difficult to say for sure as survival time is quite brief without being able to fire. I presume this is a keyboard issue on my setup as the other keys worked. Thanks! I've located & downloaded RXB 2015 and 2020 - both work fine, it seems to only be a problem for me with 2022 (I'll try and find 2023). EDIT: Oh, I see 2023 is not released yet. Edited October 13, 2023 by JasonACT Quote Link to comment Share on other sites More sharing options...
JasonACT Posted October 14, 2023 Share Posted October 14, 2023 It might be something to do with RXB 2022 moving to a 24KB ROM (I am loading this into an emulated 8K paged 32KB ROM). All the other examples of ROM files are sized with a power of 2, so I've got nothing to compare with, but I'm still looking as to why it's failing. Quote Link to comment Share on other sites More sharing options...
RXB Posted December 17, 2023 Share Posted December 17, 2023 Well just finished conversion of XB CALL CHAR(character-code,pattern-identifier) i.e. CALL CHAR(65,"FFFFFFFF81818181") Running a test program: 100 CALL CLEAR 110 OPEN #1:"CLOCK" 120 INPUT #1:A$,B$,C$ 130 FOR C=1 TO 10000 140 CALL CHAR(65,"FFFFFFFF") 150 NEXT C 160 INPUT #1:D$,E$,F$ 170 PRINT A$,D$:B$,E$,C$,F$ 180 END Times I get for XB 44 minutes 55 seconds, same for RXB 2020 and RXB 2023 Time for RXB 2024 is 4 minutes and 9 seconds I believe that is a improvement. 3 Quote Link to comment Share on other sites More sharing options...
JasonACT Posted December 17, 2023 Share Posted December 17, 2023 I noticed that RXB 2022 changed its SAMS behaviour, setting mapping on by default, when 2015/2020 left it off, was there any reason for that? Quote Link to comment Share on other sites More sharing options...
GDMike Posted December 17, 2023 Share Posted December 17, 2023 5 hours ago, JasonACT said: I noticed that RXB 2022 changed its SAMS behaviour, setting mapping on by default, when 2015/2020 left it off, was there any reason for that? Oh? Quote Link to comment Share on other sites More sharing options...
RXB Posted December 17, 2023 Share Posted December 17, 2023 14 hours ago, JasonACT said: I noticed that RXB 2022 changed its SAMS behaviour, setting mapping on by default, when 2015/2020 left it off, was there any reason for that? No just a oversite on my part I guess. Since 2021 I have left it in map mode but the MAP write mode is off. Just when you start a RXB program you not need to use CALL SAMS("MAP","ON") o turn on map mode & write mode Instead you can just CALL SAMS("ON") as map mode is already on. 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted December 17, 2023 Share Posted December 17, 2023 90 A$=RPT$("F",255) 100 CALL CLEAR 110 OPEN #1:"CLOCK" 120 INPUT #1:A$,B$,C$ 130 FOR C=1 TO 10000 140 CALL CHAR(32,A$) 150 NEXT C 160 INPUT #1:D$,E$,F$ 170 PRINT A$,D$:B$,E$,C$,F$ 180 END Ran this using XB 2.9 GEM and RXB 2024 XB 2.9 GEM time: 22 minutes 3 seconds RXB 2024: 3 minutes 53 seconds Quote Link to comment Share on other sites More sharing options...
JasonACT Posted December 17, 2023 Share Posted December 17, 2023 Just FYI - I noticed in the other thread you mention RXB works "just fine" on an unexpanded console: Quote Yea except Myarc had serious issues with backwards compatibility and could not run Basic programs due to that problem. It was fast, but very tough to remain backwards compatible, also unlike Myarc XB the RXB 2020/2021/2022/2023 & 2024 can run from Console only just fine with same speed with or without a 32K. However, as I've previously mentioned, this isn't true - you need a disk controller for RXB to run 100% properly, otherwise you get memory errors: Quote Link to comment Share on other sites More sharing options...
RXB Posted December 17, 2023 Share Posted December 17, 2023 29 minutes ago, JasonACT said: Just FYI - I noticed in the other thread you mention RXB works "just fine" on an unexpanded console: However, as I've previously mentioned, this isn't true - you need a disk controller for RXB to run 100% properly, otherwise you get memory errors: Hmm I have demos that show RXB running from only console just fine. \ I have no idea how you did this but you definitely have a issues. Quote Link to comment Share on other sites More sharing options...
JasonACT Posted December 18, 2023 Share Posted December 18, 2023 On 3/2/2023 at 10:01 AM, RXB said: Well I have fixed this I defaulted to show it but this was before I move to console only and now it works properly. It is in RXB 2023A that is not out yet hopefully Tursi will include it in next RXB release. ^^^ - This is the post that I took to mean there is no new version of RXB 2023 available yet. vvv - This is a post reinforcing my understanding On 5/31/2023 at 5:17 AM, RXB said: Yea just finished RXB 2023A and now you can use CALL PEEK(8192,A,B,"",8198,C,D) just like MM or EA But I added the InsaneMulititasker suggestion of CALL PEEK(8192,A,B,,8198,C,D) also to RXB. Now RXB has CALL POKE but it does not work like XB CALL LOAD as the number section does not work same as CALL LOAD does. I will take another look at it to see if it is feasible. Still working on it... On 6/28/2023 at 6:26 AM, RXB said: RXB 2023 UPDATE New feature of CATALOG LOADER built into the title screen of RXB 2023 This is my post saying I'm seeing an issue 6 months ago... Which is in version RXB2022D - the latest one being distributed with both Classic99 and GameBase. On 7/1/2023 at 12:44 PM, JasonACT said: This is a bit of an anomaly I've noticed in RXB... I'm developing my own Pi Pico Peripheral Expansion Box in the format of a speech synthesizer board, and have just about finished the disk DSR ROM. Now, since I don't use VDP memory, except where needed (user's PAB/buffers) I don't bother to run CALL FILES(3) (or 1, or whatever) in the reset vector. I do make the basic and assembler versions available in the DSR, but only to avoid any incompatibility. In TI Basic, TI Extended Basic and RXB, I can run "OLD DSK.CATALOG" (DSK is the special root access point on my FAT32 SD card, it can look up whole disks by name via the directories on the SD card). When I run my catalog program however, RXB (but not the other 2) gives me an out of memory error on the DSK directory open. If I CALL FILES(1) and reload it and try it again, it works. Why is RXB doing something different to TI's Basics? Here, you are implying I'm doing something wrong, which is strange and off-topic IMO. On 7/2/2023 at 6:38 PM, RXB said: Why are you using a old TI Basic program when RXB has a built in catalog routine and you can do this: CALL CAT("DSK.DISKNAME.") ! this will catalog a disk named "DISKNAME" and you pause the catalog with space bar CALL CAT("DSK4.") ! this will catalog disk 4 and you pause the catalog with space bar CALL CAT(4) ! this will catalog disk 4 and you pause the catalog with space bar CALL CAT("DSK4.","DSK3.") ! this will catalog disk 4 then disk 3 (In RXB you could catalog over 20 disks using CALL CAT and commas.) CALL CAT(4,3) ! this will catalog disk 4 then disk 3 (In RXB you could catalog over 20 disks using CALL CAT and commas.) CALL CAT("DSKA.") ! this will catalog a RAMDISK A just like if it was any other disk drive CALL CAT(A) ! this will catalog a RAMDISK A same as above The CALL CAT works in Edit mode or Program mode EXAMPLE: 10 D$="DSK.DISKNAME." 20 CALL CAT(D$) ! this will catalog disk named DISKNAME or 10 D=3 20 CALL CAT(D) ! this will catalog disk 3 same as if you typed "DSK3." RXB has a almost AI version of a Cataloger. The thing is, I've now tried this in RXB 2020 and it works. It only does what I show above in RXB 2022, and I've only got version D. Now I assume this is the latest available version, because I looked for version 2023 and it's not here. If you've fixed it, that's great, but until you release it I'm still going to have the same issue. 1 Quote Link to comment Share on other sites More sharing options...
JasonACT Posted December 18, 2023 Share Posted December 18, 2023 Ok, I see it here (updated May 9, 2023 - updated a month after I had first downloaded it): https://github.com/tursilion/classic99/commits/main/cartpack/roms And the bug is fixed. 3 Quote Link to comment Share on other sites More sharing options...
+dhe Posted December 18, 2023 Share Posted December 18, 2023 7 hours ago, JasonACT said: And the bug is fixed. Everyone loves a happy ending! 😃 2 1 Quote Link to comment Share on other sites More sharing options...
GDMike Posted December 20, 2023 Share Posted December 20, 2023 (edited) On 12/18/2023 at 5:22 AM, dhe said: Everyone loves a happy ending! 😃 Winner gets candy Edited December 20, 2023 by GDMike 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted January 29 Share Posted January 29 RXB 2024 CALL CHAR DEMO (ASSEMBLY) i DEMO RXB 2024 vs XB 2.9 GEM vs XB3 vs XB 4 Quote Link to comment Share on other sites More sharing options...
RXB Posted February 12 Share Posted February 12 RXB 2024 CALL FILES COMPARISON WITH XB (youtube.com) 2 Quote Link to comment Share on other sites More sharing options...
RXB Posted February 14 Share Posted February 14 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted February 15 Share Posted February 15 RXB 2024 RELEASED AND HERE IT IS... RXB 2024.zip 6 2 Quote Link to comment Share on other sites More sharing options...
RXB Posted February 15 Share Posted February 15 RXB 2024 GAME IN THE DARK (REPAIRED) Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.