SteveB Posted March 21 Share Posted March 21 From the "COMBAT XB COMPETITION": On 3/20/2023 at 12:20 AM, RXB said: Cool looking at the PDF documents do you have to update it when I release a new version of RXB? Down the road I am looking at adding Integer math to be used instead of Floating Point math in RXB, maybe a modified version of XB 110 also calling it XB 111. Adding a token to XB so like you can currently do A$= a string. But a new token A%= a word value (2 bytes) instead of like currently A= a floating point value (8 bytes). Thus instead of 9 x 8 bytes for say A(9) being 72 bytes for those numbers, A#(9) would be 9 x 2 bytes would be only 18 bytes and faster too. You see Floating Point really slows down XB especially when dealing with Graphics as row and column values never need to be Floating Points. Currently if you say ROW=7 (>40 >07, >00, >00 >00 >00 >00 >00) it is stored in 8 bytes floating point stored variable ROW. But in RXB or XB 111 it would be ROW$=7 (>00 >07) it is stored in 2 bytes variable ROW#. So over all savings of memory is 3 bytes vs 8 bytes. Ah but speed difference will really add up very fast as no Floating-Point conversion is needed. This will also be done in Assembly of the ROMs. (I am rewriting the XB ROMs for this new feature.) So this will benefit everyone using XB or RXB. And TIcodEd can also benefit. Hi Rich, I think this topic deserves an own thread to discuss, this is an amazing project! Would you like to share your approach in more detail? When I look at any XB, I can't remember a single CALL that expects a floatingpoint number. HCHAR, SOUND, COLOR, SPRITE ... all integer parameters. Only the arithmetic functions require floats. Avoiding those BLWP @XMLLNK DATA CFI would really save a lot of time. I mean, in the program they are unquoted strings, will be converted to Radix-100, transfered to the FAC, then converted by XMLLNK/CFI to integer, where it could be just a 16bit MOV in the first place.... When I look at the way TI stores a program in tokens I see 1. Numeric Variables and numeric literals as "unquoted strings": X=123 -> 58 BE[=] C8[Unquotedstring] 03[length] 31 32 33 2. String variables and string literals as "quoted strings": A$="Hello." -> 41 24 BE[=] C7[Quotedstring] 06[length] 48 65 6C 6C 6F 2E The introduction of integer-variables would require a third pair, i.e. N%=165 -> 4E 25 BE[=] C6[SignedInteger] 00 A5 >C6 is not used by XB, but I am not sure which additional token are already taken by ABASIC, I couldn't find a token-list including them ( @9640News ?) I would be happy to include something like this in TiCodEd. I am rooting hard for your project! Steve 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 21 Share Posted March 21 Thanks I know very little about ABASIC other then I downloaded the Manual to see the features used. And how RXB % token integers would work is: N%=165 ->4E 25 BE[=] >C6 >00 >A5 There is no sign used ranges are >00 to >7FFF same as in CALL LOAD or CALL PEEK for positive numbers or >8000 to >FFFF for negative numbers. i.e. CALL LOAD(8192,165) 8192 is >2000 or CALL LOAD(-20480,165) -20480 is >B000 This is exactly how many RXB commands work like CALL MOVES("RR",5,8192,-20480) this would move from RAM to RAM the 5 bytes from >2000 TO >B000 But in future it would not be using FLOATING POINT to do this thus speeding up XB quite a bit. Thank you again. Expecting some help from Lee Stewart on this project. Quote Link to comment Share on other sites More sharing options...
+9640News Posted March 21 Share Posted March 21 If one sorta knows what they are searching for, you can look at BeeryMiller/ABasic: ABasic for MDOS (github.com) and do a search for a string/word that might lead to the tokens list. Beery 1 Quote Link to comment Share on other sites More sharing options...
+InsaneMultitasker Posted March 22 Share Posted March 22 1 hour ago, 9640News said: If one sorta knows what they are searching for, you can look at BeeryMiller/ABasic: ABasic for MDOS (github.com) and do a search for a string/word that might lead to the tokens list. Beery 4 hours ago, SteveB said: >C6 is not used by XB, but I am not sure which additional token are already taken by ABASIC Look for file 160.EQUTOKEN. There are a few other files, and there is also an extended "NUD" token handler. Don't put complete trust in the list as some things are hard-coded elsewhere, but this is a good starting point for the curious. I bumped into this while tracking down an issue with the token handler in ABASIC. Much of the assembly code will match XB's code as ABASIC is derived from much of the same source. 3 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 22 Share Posted March 22 Do you mean this literally? Down the road I am looking at adding Integer math to be used instead of Floating Point math in RXB, maybe a modified version of XB 110 also calling it XB 111. Or do you mean the way it was used for example in the Swedish computer ABC-80, where A was a floating point numeric variable but A% was an integer one, both possibilities existing at the same time? That would of course make it much more convenient. Quote Link to comment Share on other sites More sharing options...
+Retrospect Posted March 22 Share Posted March 22 Well I took it as , he meant to eradicate floating point altogether, which would end up much more like the Basic that Wozniak made for the early Apple II computers? 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 22 Share Posted March 22 34 minutes ago, apersson850 said: Do you mean this literally? Down the road I am looking at adding Integer math to be used instead of Floating Point math in RXB, maybe a modified version of XB 110 also calling it XB 111. Or do you mean the way it was used for example in the Swedish computer ABC-80, where A was a floating point numeric variable but A% was an integer one, both possibilities existing at the same time? That would of course make it much more convenient. Yea I have been making modified versions of XB ROMs and GPL for 30 years now. And yes A=11 would be like normal XB a Floating Point number in memory, but A%=11 would be a word value of 2 bytes only in memory. In total memory usage A=11 takes up 18 bytes of memory, while A%=11 takes up only 8 bytes of memory total. i.e. A % = >C6 1 1 this is 6 bytes for name in program, 2 bytes for the number 11 to be stored as >000A in memory. 1 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 22 Share Posted March 22 Yes, I've read about what you've been doing, and I'm of course aware of the concept of integer vs. real data. My question was not about the benefit of it, just about if what you were quoted to have written was false or true. It would have been limiting if it was true, so I'm glad it was a mistake. I presume the issue is not so much the pure math (+, -, * and div), but rather all places where a numeric variable can be used. Does the system have a common routine that's called to evaluate the four different types of values in a statement like FOR I%=12 TO B*3 STEP X%+2 ? So that you only have to modify that number handler in one place? Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 22 Share Posted March 22 1 hour ago, apersson850 said: Yes, I've read about what you've been doing, and I'm of course aware of the concept of integer vs. real data. My question was not about the benefit of it, just about if what you were quoted to have written was false or true. It would have been limiting if it was true, so I'm glad it was a mistake. I presume the issue is not so much the pure math (+, -, * and div), but rather all places where a numeric variable can be used. Does the system have a common routine that's called to evaluate the four different types of values in a statement like FOR I%=12 TO B*3 STEP X%+2 ? So that you only have to modify that number handler in one place? If you look for NFOR you will find the FOR routine in ROM 1 and below that is the NEXT routine in ROM 1. As you can see even in Floating point format is converted to integer for Assembly to complete the math and same for the increment values. 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 0038 * 0039 7D00 NEGPAD EQU >7D00 0040 8300 PAD0 EQU >8300 0041 8301 PAD1 EQU >8301 0042 835F PAD5F EQU >835F 0043 83C2 PADC2 EQU >83C2 0044 * 0045 8300 VAR0 EQU >8300 0046 8302 MNUM EQU >8302 0047 8303 MNUM1 EQU >8303 0048 8304 PABPTR EQU >8304 0049 8306 CCPPTR EQU >8306 0050 8308 CCPADR EQU >8308 0051 830A RAMPTR EQU >830A 0052 830A CALIST EQU RAMPTR 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 834E FAC4 EQU >834E 0105 834F FAC5 EQU >834F 0106 8350 FAC6 EQU >8350 0107 8351 FAC7 EQU >8351 0108 8352 FAC8 EQU >8352 0109 8353 FAC9 EQU >8353 0110 8354 FAC10 EQU >8354 0111 8354 FLTNDX EQU FAC10 0112 8354 FDVSR EQU FAC10 0113 8355 FAC11 EQU >8355 0114 8355 SCLEN EQU FAC11 0115 8355 FDVSR1 EQU FAC11 0116 8356 FAC12 EQU >8356 0117 8356 FDVSR2 EQU FAC12 0118 8357 FAC13 EQU >8357 0119 8358 FAC14 EQU >8358 0120 8359 FAC15 EQU >8359 99/4 ASSEMBLER EQUATES PAGE 0003 0121 835A FAC16 EQU >835A 0122 835C FDVSR8 EQU >835C * Floating-point ARGument 0123 835C ARG EQU FDVSR8 * Floating-point ARGument 0124 835D ARG1 EQU >835D 0125 835E ARG2 EQU >835E 0126 835F ARG3 EQU >835F 0127 8360 ARG4 EQU >8360 0128 8364 ARG8 EQU >8364 0129 8365 ARG9 EQU >8365 0130 8366 ARG10 EQU >8366 0131 836B FAC33 EQU >836B 0132 836C TEMP2 EQU >836C 0133 836C FLTERR EQU TEMP2 0134 836D TYPE EQU >836D 0135 836E VSPTR EQU >836E * Value stack pointer 0136 836F VSPTR1 EQU >836F 0137 8372 STKDAT EQU >8372 0138 8373 STKADD EQU >8373 0139 8373 STACK EQU >8373 0140 8374 PLAYER EQU >8374 0141 8375 KEYBRD EQU >8375 0142 8375 SIGN EQU KEYBRD 0143 8376 JOYY EQU >8376 * Exponent in floating-point 0144 8376 EXP EQU JOYY 0145 8377 JOYX EQU >8377 0146 8378 RANDOM EQU >8378 0147 8379 TIME EQU >8379 0148 837A MOTION EQU >837A 0149 837B VDPSTS EQU >837B 0150 837C STATUS EQU >837C 0151 837D CHRBUF EQU >837D 0152 837E YPT EQU >837E 0153 837F XPT EQU >837F 0154 8389 RAMFLG EQU >8389 * ERAM flag 0155 83BA STKEND EQU >83BA 0156 83AE STND12 EQU STKEND-12 0157 83C0 CRULST EQU >83C0 0158 83CB SAVEG EQU >83CB 0159 83D2 SADDR EQU >83D2 0160 83D4 RAND16 EQU >83D4 0161 * 0162 83E0 WS EQU >83E0 0163 83E1 R0LB EQU >83E1 0164 83E3 R1LB EQU >83E3 0165 83E5 R2LB EQU >83E5 0166 83E7 R3LB EQU >83E7 0167 83E9 R4LB EQU >83E9 0168 83EB R5LB EQU >83EB 0169 83ED R6LB EQU >83ED 0170 83EF R7LB EQU >83EF 0171 83F1 R8LB EQU >83F1 0172 83F3 R9LB EQU >83F3 0173 83F5 R10LB EQU >83F5 0174 83F7 R11LB EQU >83F7 0175 83F9 R12LB EQU >83F9 0176 83FB R13LB EQU >83FB 0177 83FD R14LB EQU >83FD 0178 83FF R15LB EQU >83FF 0179 * 99/4 ASSEMBLER EQUATES PAGE 0004 0180 8302 GDST EQU >8302 0181 8303 AAA11 EQU >8303 0182 8303 GDST1 EQU >8303 0183 8304 VARY EQU >8304 0184 8306 VARY2 EQU >8306 0185 8308 BCNT2 EQU >8308 0186 830C CSRC EQU >830C 0187 834C ADDR1 EQU >834C 0188 834D ADDR11 EQU >834D 0189 834E BCNT1 EQU >834E 0190 8350 ADDR2 EQU >8350 0191 8351 ADDR21 EQU >8351 0192 8354 GSRC EQU >8354 0193 8355 DDD11 EQU >8355 0194 8355 GSRC1 EQU >8355 0195 8356 BCNT3 EQU >8356 0196 8358 DEST EQU >8358 0197 8359 DEST1 EQU >8359 0198 8384 RAMTOP EQU >8384 0199 * VDP variables 0200 0376 SYMBOL EQU >0376 * Saved symbol table pointer 0201 038A ERRLN EQU >038A * On-error line pointer 0202 0392 TABSAV EQU >0392 * Saved main symbol table ponter 0203 03C0 VROAZ EQU >03C0 * Temporary VDP Roll Out Area 0204 03DC FPSIGN EQU >03DC 0205 0820 CRNBUF EQU >0820 * CRuNch BUFfer address 0206 08BE CRNEND EQU >08BE * CRuNch buffer END 0207 ************************************************************ 0208 6000 AORG >6000 0210 0211 * PAGE SELECTOR FOR PAGE 1 0212 6000 PAGE1 EQU $ >6000 0213 6000 0002 C2 DATA 2 0 0214 * PAGE SELECTOR FOR PAGE 2 0215 6002 PAGE2 EQU $ >6002 0216 6002 00 C7 BYTE >00 0217 6003 07 CBH7 BYTE >07 2 0218 6004 0A CBHA BYTE >0A 0219 6005 94 CBH94 BYTE >94 4 0220 6006 0028 C40 DATA 40 6 0221 6008 0064 C100 DATA 100 8 0222 600A 1000 C1000 DATA >1000 A 0223 600C 0000 DATA 0 C 0224 600E 4001 FLTONE DATA >4001 E 0225 ************************************************************ 0226 * XML table number 7 for Extended Basic - must have 0227 * it's origin at >6010 0228 ************************************************************ 0229 * 0 1 2 3 4 5 6 0230 6010 619C DATA COMPCG,GETSTG,MEMCHG,CNSSEL,PARSEG,CONTG,EXECG 6012 61A2 6014 72CE 6016 6070 6018 6470 601A 64C4 601C 6500 0231 * 7 8 9 A B C D 0232 601E 61BA DATA VPUSHG,VPOP,PGMCH,SYMB,SMBB,ASSGNV,FBSYMB 6020 6C2A 99/4 ASSEMBLER XML359 PAGE 0005 6022 6410 6024 61B4 6026 61A8 6028 61AE 602A 618C 0233 * E F 0234 602C 6EE2 DATA SPEED,CRNSEL 602E 6076 0235 ************************************************************ 0236 * XML table number 8 for Extended Basic - must have 0237 * it's origin at >6030 0238 ************************************************************ 0239 * 0 1 2 3 4 5 6 7 0240 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 0241 * 8 9 A B C D E 0242 6040 7F7E DATA MVDN,MVUP,VGWITE,GVWITE,GREAD1,GWITE1,GDTECT 6042 6F98 6044 7FC0 6046 7FDA 6048 7EA6 604A 7ECA 604C 6050 0243 * F 0244 604E 7C56 DATA PSCAN 0245 0246 * Determine if and how much ERAM is present 0247 6050 D80B GDTECT MOVB R11,@PAGE1 First enable page 1 ROM 6052 6000 0248 *----------------------------------------------------------- 0249 * Replace following line 6/16/81 0250 * (Extended Basic must be made to leave enough space at 0251 * top of RAM expansion for the "hooks" left by the 99/4A 0252 * for TIBUG.) 0253 * SETO R0 Start at >FFFF 0254 * with 0255 * LI R0,>FFE7 Start at >FFE7 0256 ************************************************************ 0257 * RXB 2020 change for PRAM command 0258 6054 C020 MOV @RAMTOP,R0 PRAM sets RAMTOP value 6056 8384 0259 *----------------------------------------------------------- 0260 6058 D40B MOVB R11,*R0 Write a byte of data 0261 605A 940B CB R11,*R0 Read and compare the data 0262 605C 1306 JEQ DTECT2 If matches-found ERAM top 0263 *----------------------------------------------------------- 0264 * Change the following line 6/16/81 0265 * AI R0,->2000 Else drop down 8K 0266 605E 0200 LI R0,>DFFF Else drop down 8K 6060 DFFF 0267 *----------------------------------------------------------- 0268 6062 D40B MOVB R11,*R0 Write a byte of data 0269 6064 940B CB R11,*R0 Read and compare the data 99/4 ASSEMBLER XML359 PAGE 0006 0270 6066 1301 JEQ DTECT2 If matches-found ERAM top 0271 6068 04C0 CLR R0 No match so no ERAM 0272 606A C800 DTECT2 MOV R0,@RAMTOP Set the ERAM top 606C 8384 0273 606E 045B RT And return to GPL 0274 6070 0202 CNSSEL LI R2,CNS 6072 7016 0275 6074 1002 JMP PAGSEL 0276 6076 0202 CRNSEL LI R2,CRUNCH 6078 7B88 0277 * Select page 2 for CRUNCH and CNS 0278 607A 05E0 PAGSEL INCT @STKADD Get space on subroutine stack 607C 8373 0279 607E D1E0 MOVB @STKADD,R7 Get stack pointer 6080 8373 0280 6082 0987 SRL R7,8 Shift to use as offset 0281 6084 D9CB MOVB R11,@PAD0(R7) Save return addr to GPL interp 6086 8300 0282 6088 D9E0 MOVB @R11LB,@PAD1(R7) 608A 83F7 608C 8301 0283 608E D80B MOVB R11,@PAGE2 Select page 2 6090 6002 0284 6092 0692 BL *R2 Do the conversion 0285 6094 D80B MOVB R11,@PAGE1 Reselect page 1 6096 6000 0286 6098 D1E0 MOVB @STKADD,R7 Get subroutine stack pointer 609A 8373 0287 609C 0660 DECT @STKADD Decrement pointer 609E 8373 0288 60A0 0987 SRL R7,8 Shift to use as offset 0289 60A2 D2E7 MOVB @PAD0(R7),R11 Restore return address 60A4 8300 0290 60A6 D827 MOVB @PAD1(R7),@R11LB 60A8 8301 60AA 83F7 0291 60AC 045B RT Return to GPL interpeter 0292 60AE D7E0 GETCH MOVB @R6LB,*R15 60B0 83ED 0293 60B2 1000 NOP 0294 60B4 D7C6 MOVB R6,*R15 0295 60B6 0586 INC R6 0296 60B8 D220 MOVB @XVDPRD,R8 60BA 8800 0297 60BC 0988 GETCH1 SRL R8,8 0298 60BE 045B RT 0299 60C0 DB46 GETCHG MOVB R6,@GRMWAX(R13) 60C2 0402 0300 60C4 DB60 MOVB @R6LB,@GRMWAX(R13) 60C6 83ED 60C8 0402 0301 60CA 0586 INC R6 0302 60CC D21D MOVB *R13,R8 0303 60CE 10F6 JMP GETCH1 0304 60D0 D236 GETCGR MOVB *R6+,R8 0305 60D2 10F4 JMP GETCH1 0306 * 0307 60D6 CBHFF EQU $+2 0308 60D4 0205 POPSTK LI R5,-8 99/4 ASSEMBLER XML359 PAGE 0007 60D6 FFF8 0309 60D8 D7E0 MOVB @VSPTR1,*R15 60DA 836F 0310 60DC 0206 LI R6,ARG 60DE 835C 0311 60E0 D7E0 MOVB @VSPTR,*R15 60E2 836E 0312 60E4 A805 A R5,@VSPTR 60E6 836E 0313 60E8 DDA0 STKMOV MOVB @XVDPRD,*R6+ 60EA 8800 0314 60EC 0585 INC R5 0315 60EE 16FC JNE STKMOV 0316 60F0 045B RT 0317 * 0318 60F2 05E0 PUTSTK INCT @STKADD 60F4 8373 0319 60F6 D120 MOVB @STKADD,R4 60F8 8373 0320 60FA 0984 SRL R4,8 0321 60FC D92D MOVB @GRMRAX(13),@PAD0(R4) 60FE 0002 6100 8300 0322 6102 D92D MOVB @GRMRAX(13),@PAD1(R4) 6104 0002 6106 8301 0323 6108 0624 DEC @PAD0(R4) 610A 8300 0324 610C 045B RT 0325 * 0326 610E D120 GETSTK MOVB @STKADD,R4 6110 8373 0327 6112 0984 SRL R4,8 0328 6114 0660 DECT @STKADD 6116 8373 0329 6118 DB64 MOVB @PAD0(R4),@GRMWAX(R13) 611A 8300 611C 0402 0330 611E DB64 MOVB @PAD1(R4),@GRMWAX(R13) 6120 8301 6122 0402 0331 6124 045B RT 0332 ************************************************************ 0333 6126 AORG >6126 0335 0336 0F64 ROUNUP EQU >0F64 Uses XML >01 Rounding of floating point 0337 0D42 SCOMPB EQU >0D42 Set SCOMP with direct return without GPL 0338 12B8 CFI EQU >12B8 CFI (XML >12) 0339 0E8C SMULT EQU >0E8C SMUL (XML >0D) 0340 0FF4 FDIV EQU >0FF4 FDIV (XML >09) 0341 0FC2 OVEXP EQU >0FC2 Overflow (XML >04) 0342 0E88 FMULT EQU >0E88 FMUL (XML >08) 0343 0D74 SSUB EQU >0D74 SSUB (XML >0C) 0344 0D80 FADD EQU >0D80 FADD (XML >06) 0345 0FF8 SDIV EQU >0FF8 SDIV (XML >0E) 0346 0D7C FSUB EQU >0D7C FSUB (XML (>07) 0347 0D84 SADD EQU >0D84 SADD (XML >0B) 0348 0FB2 ROUNU EQU >0FB2 Rounding with digit number in >8354 (XML 0349 006A RESET EQU >006A Clear condition bit in GPL status (GPL i 99/4 ASSEMBLER REFS359 PAGE 0008 0350 0070 NEXT EQU >0070 GPL interpreter 0351 11B2 CSN01 EQU >11B2 CSN (XML >10) (Without R3 loaded with >1 0352 0D3A FCOMP EQU >0D3A FCOMP (XML >0A) 0353 6126 C0CB FCOMPB MOV R11,R3 0354 6128 0460 B @FCOMP+22 612A 0D50 0355 187C GETV EQU >187C Read 1 byte from VDP, Entry over data ad 0356 1880 GETV1 EQU >1880 Same >187C but does not fetch address, i 0357 1E8C SAVREG EQU >1E8C Set substack pointer and Basic byte 0358 1E90 SAVRE2 EQU >1E90 Same >1E8C but does not set R8 into >834 0359 1E7A SETREG EQU >1E7A Substack pointer in R9 and actual Basic 0360 18AA STVDP3 EQU >18AA Write R6 in VDP (R1=Address+3), 0361 * used for variable table and string point 0362 18AE STVDP EQU >18AE Write R6 in VDP (R1=Address+3), 0363 * used for variable table and string point 0364 15E0 FBS EQU >15E0 Pointer fetch var list 0365 15E6 FBS001 EQU >15E6 Fetch length byte 0366 ************************************************************ 0367 0368 612C AORG >612C 0370 0371 * 0372 * The CHARACTER PROPERTY TABLE 0373 * There is a one-byte entry for every character code 0374 * in the range LLC(lowest legal character) to 0375 * HLC(highest legal character), inclusive. 0376 0020 LLC EQU >20 0377 0000 CPNIL EQU >00 " $ % ' ? 0378 0002 CPDIG EQU >02 digit (0-9) 0379 0004 CPNUM EQU >04 digit, period, E 0380 0008 CPOP EQU >08 1 char operators(!#*+-/<=>^ ) 0381 0010 CPMO EQU >10 multiple operator ( : ) 0382 0020 CPALPH EQU >20 A-Z, @, _ 0383 0040 CPBRK EQU >40 ( ) , ; 0384 0080 CPSEP EQU >80 space 0385 0022 CPALNM EQU CPALPH+CPDIG alpha-digit 0386 *----------------------------------------------------------- 0387 * Following lines are for adding lowercase character set in 0388 * 99/4A, 5/12/81 0389 0001 CPLOW EQU >01 a-z 0390 0023 CPULNM EQU CPALNM+CPLOW Alpha(both upper and lower)+ 0391 * digit-legal variable character 0392 0021 CPUL EQU CPALPH+CPLOW Alpha(both upper and lower) 0393 *----------------------------------------------------------- 0394 610C CPTBL EQU $-LLC 0395 612C 80 BYTE CPSEP SPACE 0396 612D 08 BYTE CPOP ! EXCLAMATION POINT 0397 612E 00 BYTE CPNIL " QUOTATION MARKS 0398 612F 08 BYTE CPOP # NUMBER SIGN 0399 6130 00 BYTE CPNIL $ DOLLAR SIGN 0400 6131 00 BYTE CPNIL % PERCENT 0401 6132 08 BYTE CPOP & AMPERSAND 0402 6133 00 BYTE CPNIL ' APOSTROPHE 0403 6134 40 BYTE CPBRK ( LEFT PARENTHESIS 0404 6135 40 BYTE CPBRK ) RIGHT PARENTHESIS 0405 6136 08 BYTE CPOP * ASTERISK 0406 6137 0C BYTE CPOP+CPNUM + PLUS 0407 6138 40 BYTE CPBRK , COMMA 0408 6139 0C BYTE CPOP+CPNUM - MINUS 99/4 ASSEMBLER CPT PAGE 0009 0409 613A 04 BYTE CPNUM . PERIOD 0410 613B 08 BYTE CPOP / SLANT 0411 613C 06 BYTE CPNUM+CPDIG 0 ZERRO 0412 613D 06 BYTE CPNUM+CPDIG 1 ONE 0413 613E 06 BYTE CPNUM+CPDIG 2 TWO 0414 613F 06 BYTE CPNUM+CPDIG 3 THREE 0415 6140 06 BYTE CPNUM+CPDIG 4 FOUR 0416 6141 06 BYTE CPNUM+CPDIG 5 FIVE 0417 6142 06 BYTE CPNUM+CPDIG 6 SIX 0418 6143 06 BYTE CPNUM+CPDIG 7 SEVEN 0419 6144 06 BYTE CPNUM+CPDIG 8 EIGHT 0420 6145 06 BYTE CPNUM+CPDIG 9 NINE 0421 6146 10 LBCPMO BYTE CPMO : COLON 0422 6147 40 BYTE CPBRK : SEMICOLON 0423 6148 08 BYTE CPOP < LESS THAN 0424 6149 08 BYTE CPOP = EQUALS 0425 614A 08 BYTE CPOP > GREATER THAN 0426 614B 00 BYTE CPNIL ? QUESTION MARK 0427 614C 20 BYTE CPALPH @ COMMERCIAL AT 0428 614D 20 BYTE CPALPH A UPPERCASE A 0429 614E 20 BYTE CPALPH B UPPERCASE B 0430 614F 20 BYTE CPALPH C UPPERCASE C 0431 6150 20 BYTE CPALPH D UPPERCASE D 0432 6151 24 BYTE CPALPH+CPNUM E UPPERCASE E 0433 6152 20 BYTE CPALPH F UPPERCASE F 0434 6153 20 BYTE CPALPH G UPPERCASE G 0435 6154 20 BYTE CPALPH H UPPERCASE H 0436 6155 20 BYTE CPALPH I UPPERCASE I 0437 6156 20 BYTE CPALPH J UPPERCASE J 0438 6157 20 BYTE CPALPH K UPPERCASE K 0439 6158 20 BYTE CPALPH L UPPERCASE L 0440 6159 20 BYTE CPALPH M UPPERCASE M 0441 615A 20 BYTE CPALPH N UPPERCASE N 0442 615B 20 BYTE CPALPH O UPPERCASE O 0443 615C 20 BYTE CPALPH P UPPERCASE P 0444 615D 20 BYTE CPALPH Q UPPERCASE Q 0445 615E 20 BYTE CPALPH R UPPERCASE R 0446 615F 20 BYTE CPALPH S UPPERCASE S 0447 6160 20 BYTE CPALPH T UPPERCASE T 0448 6161 20 BYTE CPALPH U UPPERCASE U 0449 6162 20 BYTE CPALPH V UPPERCASE V 0450 6163 20 BYTE CPALPH W UPPERCASE W 0451 6164 20 BYTE CPALPH X UPPERCASE X 0452 6165 20 BYTE CPALPH Y UPPERCASE Y 0453 6166 20 BYTE CPALPH Z UPPERCASE Z 0454 6167 20 BYTE CPALPH [ LEFT SQUARE BRACKET 0455 6168 20 BYTE CPALPH \ REVERSE SLANT 0456 6169 20 BYTE CPALPH ] RIGHT SQUARE BRACKET 0457 616A 08 BYTE CPOP ^ CIRCUMFLEX 0458 616B 20 BYTE CPALPH _ UNDERLINE 0459 *----------------------------------------------------------- 0460 * Following "`" and lowercase characters are for 0461 * adding lowercase character set in 99/4A, 5/12/81 0462 *----------------------------------------------------------- 0463 616C 00 BYTE CPNIL ` GRAVE ACCENT 0464 616D 21 BYTE CPALPH+CPLOW a LOWERCASE a 0465 616E 21 BYTE CPALPH+CPLOW b LOWERCASE b 0466 616F 21 BYTE CPALPH+CPLOW c LOWERCASE c 0467 6170 21 BYTE CPALPH+CPLOW d LOWERCASE d 99/4 ASSEMBLER CPT PAGE 0010 0468 6171 21 BYTE CPALPH+CPLOW e LOWERCASE e 0469 6172 21 BYTE CPALPH+CPLOW f LOWERCASE f 0470 6173 21 BYTE CPALPH+CPLOW g LOWERCASE g 0471 6174 21 BYTE CPALPH+CPLOW h LOWERCASE h 0472 6175 21 BYTE CPALPH+CPLOW i LOWERCASE i 0473 6176 21 BYTE CPALPH+CPLOW j LOWERCASE j 0474 6177 21 BYTE CPALPH+CPLOW k LOWERCASE k 0475 6178 21 BYTE CPALPH+CPLOW l LOWERCASE l 0476 6179 21 BYTE CPALPH+CPLOW m LOWERCASE m 0477 617A 21 BYTE CPALPH+CPLOW n LOWERCASE n 0478 617B 21 BYTE CPALPH+CPLOW o LOWERCASE o 0479 617C 21 BYTE CPALPH+CPLOW p LOWERCASE p 0480 617D 21 BYTE CPALPH+CPLOW q LOWERCASE q 0481 617E 21 BYTE CPALPH+CPLOW r LOWERCASE r 0482 617F 21 BYTE CPALPH+CPLOW s LOWERCASE s 0483 6180 21 BYTE CPALPH+CPLOW t LOWERCASE t 0484 6181 21 BYTE CPALPH+CPLOW u LOWERCASE u 0485 6182 21 BYTE CPALPH+CPLOW v LOWERCASE v 0486 6183 21 BYTE CPALPH+CPLOW w LOWERCASE w 0487 6184 21 BYTE CPALPH+CPLOW x LOWERCASE x 0488 6185 21 BYTE CPALPH+CPLOW y LOWERCASE y 0489 6186 21 BYTE CPALPH+CPLOW z LOWERCASE z 0490 0491 EVEN 0492 ************************************************************ 0493 6188 AORG >6188 0495 0496 * General Basic support routines (not includeing PARSE) 0497 0498 * 0499 0503 ERRBS EQU >0503 BAD SUBSCRIPT ERROR CODE 0500 0603 ERRTM EQU >0603 ERROR STRING/NUMBER MISMATCH 0501 * 0502 6188 6500 STCODE DATA >6500 0503 618A 0006 C6 DATA >0006 0504 * 0505 * Entry to find Basic symbol table entry for GPL 0506 * 0507 618C 06A0 FBSYMB BL @FBS Search the symbol table 618E 15E0 0508 6190 006A DATA RESET If not found - condition reset 0509 6192 F820 SET SOCB @BIT2,@STATUS Set GPL condition 6194 62AB 6196 837C 0510 6198 0460 B @NEXT If found - condition set 619A 0070 0511 * GPL entry for COMPCT to take advantage of common code 0512 619C 0206 COMPCG LI R6,COMPCT Address of COMPCT 619E 73D8 0513 61A0 100E JMP SMBB10 Jump to set up 0514 * GPL entry for GETSTR to take advantage of common code 0515 61A2 0206 GETSTG LI R6,GETSTR Address of MEMCHK 61A4 736C 0516 61A6 100B JMP SMBB10 Jump to set up 0517 * GPL entry for SMB to take advantage of common code 0518 61A8 0206 SMBB LI R6,SMB Address of SMB routine 61AA 61DC 0519 61AC 1008 JMP SMBB10 Jump to set up 0520 * GPL entry for ASSGNV to take advantage of common code 99/4 ASSEMBLER BASSUP PAGE 0011 0521 61AE 0206 ASSGNV LI R6,ASSG Address of ASSGNV routine 61B0 6334 0522 61B2 1005 JMP SMBB10 Jump to set up 0523 * GPL entry for SMB to take advantage of common code 0524 61B4 0206 SYMB LI R6,SYM Address of SYM routine 61B6 6312 0525 61B8 1002 JMP SMBB10 Jump to set up 0526 * GPL entry for SMB to take advantage of common code 0527 61BA 0206 VPUSHG LI R6,VPUSH Address of VPUSH routine 61BC 6BAA 0528 61BE C1CB SMBB10 MOV R11,R7 Save return address 0529 61C0 06A0 BL @PUTSTK Save current GROM address 61C2 60F2 0530 61C4 06A0 BL @SETREG Set up Basic registers 61C6 1E7A 0531 61C8 05C9 INCT R9 Get space on subroutine stack 0532 61CA C647 MOV R7,*R9 Save the return address 0533 61CC 0696 BL *R6 Branch and link to the routine 0534 61CE C1D9 MOV *R9,R7 Get return address 0535 61D0 0649 DECT R9 Restore subroutine stack 0536 61D2 06A0 BL @SAVREG Save registers for GPL 61D4 1E8C 0537 61D6 06A0 BL @GETSTK Restore GROM address 61D8 610E 0538 61DA 0457 B *R7 Return to GPL 0539 ************************************************************ 0540 * Subroutine to find the pointer to variable space of each 0541 * element of symbol table entry. Decides whether symbol 0542 * table entry pointed to by FAC, FAC+1 is a simple variable 0543 * and returns proper 8-byte block in FAC through FAC7 0544 ************************************************************ 0545 61DC 05C9 SMB INCT R9 Get space on subroutine stack 0546 61DE C64B MOV R11,*R9 Save return address 0547 61E0 C820 MOV @FAC,@FAC4 Copy pointer to table entry 61E2 834A 61E4 834E 0548 61E6 A820 A @C6,@FAC4 Add 6 so point a value space 61E8 618A 61EA 834E 0549 61EC 06A0 BL @GETV Get 1st byte of table entry 61EE 187C 0550 61F0 834A DATA FAC Pointer is in FAC 0551 * 0552 61F2 C101 MOV R1,R4 Copy for later use. 0553 61F4 C081 MOV R1,R2 Copy for later use. 0554 61F6 0A21 SLA R1,2 Check for UDF entry 0555 61F8 1821 JOC BERMUV If UDF - then error 0556 61FA C104 MOV R4,R4 Check for string. 0557 61FC 1102 JLT SMB02 Skip if it is string. 0558 61FE 04E0 CLR @FAC2 Clear for numeric case. 6200 834C 0559 * 0560 * In case of subprogram call check if parameter is shared by 0561 * it's calling program. 0562 * 0563 6202 0A11 SMB02 SLA R1,1 Check for the shared bit. 0564 6204 1705 JNC SMB04 If it is not shared skip. 0565 6206 06A0 BL @GET Get the value space pointer 6208 6C9A 99/4 ASSEMBLER BASSUP PAGE 0012 0566 620A 834E DATA FAC4 in the symbol table. 0567 620C C801 MOV R1,@FAC4 Store the value space address. 620E 834E 0568 * 0569 * Branches to take care of string and array cases. 0570 * Only the numeric variable case stays on. 0571 * 0572 6210 D104 SMB04 MOVB R4,R4 R4 has header byte information 0573 6212 1116 JLT SMBO50 Take care of string. 0574 6214 0A54 SMB05 SLA R4,5 Get only the dimension number. 0575 6216 09D4 SRL R4,13 0576 6218 162A JNE SMBO20 go to array case. 0577 * 0578 * Numeric ERAM cases are special. 0579 * If it is shared get the actual v.s. address from ERAM. 0580 * Otherwise get it from VDP RAM. 0581 * 0582 621A D120 MOVB @RAMTOP,R4 Check for ERAM. 621C 8384 0583 621E 130B JEQ SMBO10 Yes ERAM case. 0584 6220 0A32 SLA R2,3 R2 has a header byte. 0585 6222 1704 JNC SMB06 Shared bit is not ON. 0586 6224 06A0 BL @GETG Get v.s. pointer from ERAM 6226 6CCA 0587 6228 834E DATA FAC4 0588 622A 1003 JMP SMB08 0589 622C 06A0 SMB06 BL @GET Not shared. 622E 6C9A 0590 6230 834E DATA FAC4 Get v.s. address from VDP RAM. 0591 * 0592 6232 C801 SMB08 MOV R1,@FAC4 Store it in FAC4 area. 6234 834E 0593 * 0594 * Return from the SMB routine. 0595 * 0596 6236 C2D9 SMBO10 MOV *R9,R11 Restore return address 0597 6238 0649 DECT R9 Restore stack 0598 623A 045B RT And return 0599 623C 0460 BERMUV B @ERRMUV * INCORRECT NAME USAGE 623E 6970 0600 * 0601 * Start looking for the real address of the symbol. 0602 * 0603 6240 0288 SMBO50 CI R8,LPARZ*256 String - now string array? 6242 B700 0604 6244 13E7 JEQ SMB05 Yes, process as an array 0605 6246 C820 SMB51 MOV @STCODE,@FAC2 String ID code in FAC2 6248 6188 624A 834C 0606 624C C820 MOV @FAC4,@FAC Get string pointer address 624E 834E 6250 834A 0607 6252 06A0 BL @GET Get exact pointer to string 6254 6C9A 0608 6256 834A DATA FAC 0609 * 0610 6258 C801 MOV R1,@FAC4 Save pointer to string 625A 834E 0611 625C C0C1 MOV R1,R3 Was it a null? 99/4 ASSEMBLER BASSUP PAGE 0013 0612 625E 1304 JEQ SMB57 Length is 0 - so is null 0613 6260 0603 DEC R3 Otherwise point at length byte 0614 6262 06A0 BL @GETV1 Get the string length 6264 1880 0615 6266 0981 SRL R1,8 Shift for use as double 0616 6268 C801 SMB57 MOV R1,@FAC6 Put into FAC entry 626A 8350 0617 626C 10E4 JMP SMBO10 And return 0618 * 0619 * Array cases are taken care of here. 0620 * 0621 626E C804 SMBO20 MOV R4,@FAC2 Now have a dimension counter 6270 834C 0622 * that is initilized to maximum 0623 * *FAC+4,FAC+5 already points to 1st dimension maximum in 0624 * in symbol table. 0625 6272 04C2 CLR R2 Clear index accumulator 0626 6274 C802 SMBO25 MOV R2,@FAC6 Save accumulator in FAC 6276 8350 0627 6278 06A0 BL @PGMCHR Get next character 627A 6C74 0628 627C 06A0 BL @PSHPRS PUSH and PARSE subscript 627E 6B9C 0629 6280 B7 BYTE LPARZ,0 Up to a left parenthesis or le 6281 00 0630 * 0631 6282 9820 CB @FAC2,@STCODE Dimension can't be a string 6284 834C 6286 6188 0632 6288 1441 JHE ERRT It is - so error 0633 * Now do float to interger conversion of dimension 0634 628A 04E0 CLR @FAC10 Assume no error 628C 8354 0635 628E 06A0 BL @CFI Gets 2 byte integer in FAC,FAC 6290 12B8 0636 6292 D120 MOVB @FAC10,R4 Error on conversion? 6294 8354 0637 6296 1636 JNE ERR3 Yes, error BAD SUBSCRIPT 0638 6298 C160 MOV @FAC,R5 Save index just read 629A 834A 0639 629C 06A0 BL @VPOP Restore FAC block 629E 6C2A 0640 62A0 06A0 BL @GET Get next dimension maximum 62A2 6C9A 0641 62A4 834E DATA FAC4 FAC4 points into symbol table 0642 * 0643 62A6 8045 C R5,R1 Subscript less-then maximum? 0644 62A8 1B2D JH ERR3 No, index out of bounds 0645 62AB BIT2 EQU $+1 Constant >20 (Opcode is >D120) 0646 62AA D120 MOVB @BASE,R4 Fetch option base to check low 62AC 8343 0647 62AE 1303 JEQ SMBO40 If BASE=0, INDEX=0 is ok 0648 62B0 0605 DEC R5 Adjust BASE 1 index 0649 62B2 1128 JLT ERR3 If subscript was =0 then error 0650 62B4 1001 JMP SMBO41 Accumulate the subscripts 0651 62B6 0581 SMBO40 INC R1 Adjust size if BASE=0 0652 62B8 3860 SMBO41 MPY @FAC6,R1 R1,R2 has ACCUM*MAX dimension 62BA 8350 0653 62BC A085 A R5,R2 Add latest to accumulator 99/4 ASSEMBLER BASSUP PAGE 0014 0654 62BE 05E0 INCT @FAC4 Increment dimension max pointe 62C0 834E 0655 62C2 0620 DEC @FAC2 Decrement remaining-dim count 62C4 834C 0656 62C6 1305 JEQ SMBO70 All dimensions handled ->done 0657 62C8 0288 CI R8,COMMAZ*256 Otherwise, must be at a comma 62CA B300 0658 62CC 13D3 JEQ SMBO25 We are, so loop for more 0659 62CE 0460 ERR1 B @ERRSYN Not a comma, so SYNTAX ERROR 62D0 664E 0660 * 0661 * At this point the required number of dimensions have been 0662 * scanned. 0663 * R2 Contains the index 0664 * R4 Points to the first array element or points to the 0665 * address in ERAM where the first array element is. 0666 62D2 0288 SMBO70 CI R8,RPARZ*256 Make sure at a right parenthes 62D4 B600 0667 62D6 16FB JNE ERR1 Not, so error 0668 62D8 06A0 BL @PGMCHR Get nxt token 62DA 6C74 0669 62DC 06A0 BL @GETV Now check string or numeric 62DE 187C 0670 62E0 834A DATA FAC array by checking s.t. 0671 * 0672 62E2 110C JLT SMB71 If MSB set is a string array 0673 62E4 0A32 SLA R2,3 Numeric, multiply by 8 0674 62E6 D0E0 MOVB @RAMTOP,R3 Does ERAM exist? 62E8 8384 0675 62EA 1305 JEQ SMBO71 No 0676 62EC 06A0 BL @GET Yes, get the content of value 62EE 6C9A 0677 62F0 834E DATA FAC4 pointer 0678 * 0679 62F2 C801 MOV R1,@FAC4 Put it in FAC4 62F4 834E 0680 62F6 A802 SMBO71 A R2,@FAC4 Add into values pointer 62F8 834E 0681 62FA 109D JMP SMBO10 And return in the normal way 0682 62FC 0A12 SMB71 SLA R2,1 String, multiply by 2 0683 62FE A802 A R2,@FAC4 Add into values pointer 6300 834E 0684 6302 10A1 JMP SMB51 And build the string FAC entry 0685 6304 0200 ERR3 LI R0,ERRBS Bad subscript return vector 6306 0503 0686 6308 0460 ERRX B @ERR Exit to GPL 630A 6652 0687 630C 0200 ERRT LI R0,ERRTM String/number mismatch vector 630E 0603 0688 6310 10FB JMP ERRX Use the long branch 0689 ************************************************************ 0690 * Subroutine to put symbol name into FAC and to call FBS to 0691 * find the symbol table for the symbol 0692 ************************************************************ 0693 6312 04E0 SYM CLR @FAC15 Clear the character counter 6314 8359 0694 6316 0202 LI R2,FAC Copying string into FAC 6318 834A 0695 631A C04B MOV R11,R1 Save return address 99/4 ASSEMBLER BASSUP PAGE 0015 0696 *----------------------------------------------------------- 0697 * Fix "A long constant in a variable field in INPUT, 0698 * ACCEPT, LINPUT, NEXT and READ etc. may crash the 0699 * sytem" bug, 5/22/81 0700 * Insert the following 2 lines 0701 631C D208 MOVB R8,R8 0702 631E 11D7 JLT ERR1 If token 0703 6320 DC88 SYM1 MOVB R8,*R2+ Save the character 0704 6322 05A0 INC @FAC15 Count it 6324 8359 0705 6326 06A0 BL @PGMCHR Get next character 6328 6C74 0706 632A 15FA JGT SYM1 Still characters in the name 0707 632C 06A0 BL @FBS Got name, now find s.t. entry 632E 15E0 0708 6330 62CE DATA ERR1 Return vector if not found 0709 * 0710 6332 0451 B *R1 Return to caller if found 0711 ************************************************************ 0712 * ASSGNV, callable from GPL or 9900 code, to assign a value 0713 * to a symbol (strings and numerics) . If numeric, the 0714 * 8 byte descriptor is in the FAC. The descriptor block 0715 * (8 bytes) for the destination variable is on the stack. 0716 * There are two types of descriptor entries which are 0717 * created by SMB in preparation for ASSGNV, one for 0718 * numerics and one for strings. 0719 * NUMERIC 0720 * +-------------------------------------------------------+ 0721 * |S.T. ptr | 00 | |Value ptr | | 0722 * +-------------------------------------------------------+ 0723 * STRING 0724 * +-------------------------------------------------------+ 0725 * |Value ptr| 65 | |String ptr|String length | 0726 * +-------------------------------------------------------+ 0727 * 0728 * CRITICAL NOTE: Becuase of the BL @POPSTK below, if a 0729 * string entry is popped and a garbage collection has taken 0730 * place while the entry was pushed on the stack, and the 0731 * entry was a permanent string the pointer in FAC4 and FAC5 0732 * will be messed up. A BL @VPOP would have taken care of 0733 * the problem but would have taken a lot of extra code. 0734 * Therefore, at ASSG50-ASSG54 it is assumed that the 0735 * previous value assigned to the destination variable has 0736 * been moved and the pointer must be reset by going back to 0737 * the symbol table and getting the correct value pointer. 0738 ************************************************************ 0739 6334 C28B ASSG MOV R11,R10 Save the retun address 0740 6336 06A0 BL @ARGTST Check arg and variable type 6338 6B6E 0741 633A 02CC STST R12 Save status of type 0742 633C 06A0 BL @POPSTK Pop destination descriptor 633E 60D4 0743 * into ARG 0744 6340 0A3C SLA R12,3 Variable type numeric? 0745 6342 1745 JNC ASSG70 Yes, handle it as such 0746 * Assign a string to a string variable 0747 6344 C060 MOV @ARG4,R1 Get destination pointer 6346 8360 0748 * Dest have non-null value? 99/4 ASSEMBLER BASSUP PAGE 0016 0749 6348 130B JEQ ASSG54 No, null->never assigned 0750 * Previously assigned - Must first free the old value 0751 634A 06A0 BL @GET Correct for POPSTK above 634C 6C9A 0752 634E 835C DATA ARG Pointer is in ARG 0753 * 0754 6350 C801 MOV R1,@ARG4 Correct ARG+4,5 too 6352 8360 0755 *----------------------------------------------------------- 0756 * Fix "Assigning a string to itself when memory is full can 0757 * destroy the string" bug, 5/22/81 0758 * Add the following 2 lines and the label ASSG80 0759 6354 8801 C R1,@FAC4 Do not do anything in assign- 6356 834E 0760 * ing a string to itself case 0761 6358 1317 JEQ ASSG80 Detect A$=A$ case, exit 0762 *----------------------------------------------------------- 0763 635A 04C6 CLR R6 Clear for zeroing backpointer 0764 635C 06A0 BL @STVDP3 Free the string 635E 18AA 0765 6360 C120 ASSG54 MOV @FAC6,R4 Is source string a null? 6362 8350 0766 6364 130C JEQ ASSG57 Yes, handle specially 0767 6366 C0E0 MOV @FAC,R3 Get address of source pointer 6368 834A 0768 636A 0283 CI R3,>001C Got a temporay string? 636C 001C 0769 636E 160D JNE ASSG56 No, more complicated 0770 6370 C120 MOV @FAC4,R4 Pick up direct ptr to string 6372 834E 0771 * Common string code to set forward and back pointers 0772 6374 C1A0 ASSG55 MOV @ARG,R6 Ptr to symbol table pointer 6376 835C 0773 6378 C044 MOV R4,R1 Pointer to source string 0774 637A 06A0 BL @STVDP3 Set the backpointer 637C 18AA 0775 637E C060 ASSG57 MOV @ARG,R1 Address of symbol table ptr 6380 835C 0776 6382 C184 MOV R4,R6 Pointer to string 0777 6384 06A0 BL @STVDP Set the forward pointer 6386 18AE 0778 6388 045A ASSG80 B *R10 Done, return 0779 * Symbol-to-symbol assigments of strings 0780 * Must create copy of string 0781 638A C820 ASSG56 MOV @FAC6,@BYTE Fetch length for GETSTR 638C 8350 638E 830C 0782 * NOTE: FAC through FAC+7 cannot be destroyed 0783 * address^of string length^of string 0784 6390 06A0 BL @VPUSH So save it on the stack 6392 6BAA 0785 6394 C80A MOV R10,@FAC Save return link in FAC since 6396 834A 0786 * GETSTR does not destroy FAC 0787 6398 06A0 BL @GETSTR Call GPL to do the GETSTR 639A 736C 0788 639C C2A0 MOV @FAC,R10 Restore return link 639E 834A 0789 63A0 06A0 BL @VPOP Pop the source info back 99/4 ASSEMBLER BASSUP PAGE 0017 63A2 6C2A 0790 * Set up to copy the source string into destination 0791 63A4 C0E0 MOV @FAC4,R3 R3 is now copy-from 63A6 834E 0792 63A8 C160 MOV @SREF,R5 R5 is now copy-to 63AA 831C 0793 63AC C105 MOV R5,R4 Save for pointer setting 0794 * Registers to be used in the copy 0795 * R1 - Used for a buffer 0796 * R3 - Copy-from address 0797 * R2 - # of bytes to be moved 0798 * R5 - copy-to address 0799 63AE C0A0 MOV @FAC6,R2 Fetch the length of the string 63B0 8350 0800 63B2 0265 ORI R5,WRVDP Enable the VDP write 63B4 4000 0801 63B6 06A0 ASSG59 BL @GETV1 Get the character 63B8 1880 0802 63BA D7E0 MOVB @R5LB,*R15 Load out destination address 63BC 83EB 0803 63BE 0583 INC R3 Increment the copy-from 0804 63C0 D7C5 MOVB R5,*R15 1st byte of address to 0805 63C2 0585 INC R5 Increment for next character 0806 63C4 D801 MOVB R1,@XVDPWD Put the character out 63C6 8C00 0807 63C8 0602 DEC R2 Decrement count, finished? 0808 63CA 15F5 JGT ASSG59 No, loop for more 0809 63CC 10D3 JMP ASSG55 Yes, now set pointers 0810 * Code to copy a numeric value into the symbol table 0811 63CE 0202 ASSG70 LI R2,8 Need to assign 8 bytes 63D0 0008 0812 63D2 C160 MOV @ARG4,R5 Destination pointer(R5) 63D4 8360 0813 * from buffer(R4), (R2)bytes 0814 63D6 C0E0 MOV @RAMTOP,R3 Does ERAM exist? 63D8 8384 0815 63DA 160C JNE ASSG77 Yes, write to ERAM 0816 * No, write to VDP 0817 63DC D7E0 MOVB @R5LB,*R15 Load out 2nd byte of address 63DE 83EB 0818 63E0 0265 ORI R5,WRVDP Enable the write to the VDP 63E2 4000 0819 63E4 D7C5 MOVB R5,*R15 Load out 1st byte of address 0820 63E6 0204 LI R4,FAC Source is FAC 63E8 834A 0821 63EA D834 ASSG75 MOVB *R4+,@XVDPWD Move a byte 63EC 8C00 0822 63EE 0602 DEC R2 Decrement the counter, done? 0823 63F0 15FC JGT ASSG75 No, loop for more 0824 63F2 045A B *R10 Yes, return to the caller 0825 63F4 0204 ASSG77 LI R4,FAC Source is in FAC 63F6 834A 0826 63F8 DD74 ASSG79 MOVB *R4+,*R5+ Move a byte 0827 63FA 0602 DEC R2 Decrement the counter, done? 0828 63FC 15FD JGT ASSG79 No, loop for more 0829 63FE 045A B *R10 Yes, return to caller 0830 * Check for required token 0831 6400 D01D SYNCHK MOVB *R13,R0 Read required token 0832 * 99/4 ASSEMBLER BASSUP PAGE 0018 0833 6402 9800 CB R0,@CHAT Have the required token? 6404 8342 0834 6406 1304 JEQ PGMCH Yes, read next character 0835 6408 06A0 BL @SETREG Error return requires R8/R9 se 640A 1E7A 0836 640C 0460 B @ERRSYN * SYNTAX ERROR 640E 664E 0837 * PGMCH - GPL entry point for PGMCHR to set up register 0838 6410 C30B PGMCH MOV R11,R12 Save return address 0839 6412 06A0 BL @PGMCHR Get the next character 6414 6C74 0840 6416 D808 MOVB R8,@CHAT Put it in for GPL 6418 8342 0841 641A 045C B *R12 Return to GPL 0842 641C 045B RT And return to the caller 0843 641E C13B PUTV MOV *R11+,R4 0844 6420 C114 MOV *R4,R4 0845 6422 D7E0 PUTV1 MOVB @R4LB,*R15 6424 83E9 0846 6426 0264 ORI R4,WRVDP 6428 4000 0847 642A D7C4 MOVB R4,*R15 0848 642C 1000 NOP 0849 642E D801 MOVB R1,@XVDPWD 6430 8C00 0850 6432 045B RT 0851 * MOVFAC - copies 8 bytes from VDP(@FAC4) or ERAM(@FAC4) 0852 * to FAC 0853 6434 C060 MOVFAC MOV @FAC4,R1 Get pointer to source 6436 834E 0854 6438 0202 LI R2,8 8 byte values 643A 0008 0855 643C 0203 LI R3,FAC Destination is FAC 643E 834A 0856 6440 C020 MOV @RAMTOP,R0 Does ERAM exist? 6442 8384 0857 6444 160A JNE MOVFA2 Yes, from ERAM 0858 * No, from VDP RAM 0859 6446 06C1 SWPB R1 0860 6448 D7C1 MOVB R1,*R15 Load 2nd byte of address 0861 644A 06C1 SWPB R1 0862 644C D7C1 MOVB R1,*R15 Load 1st byte of address 0863 644E 0205 LI R5,XVDPRD 6450 8800 0864 6452 DCD5 MOVF1 MOVB *R5,*R3+ Move a byte 0865 6454 0602 DEC R2 Decrement counter, done? 0866 6456 15FD JGT MOVF1 No, loop for more 0867 6458 045B RT Yes, return to caller 0868 645A DCF1 MOVFA2 MOVB *R1+,*R3+ 0869 645C 0602 DEC R2 0870 645E 16FD JNE MOVFA2 0871 6460 045B RT 0872 6462 045B RT And return to caller 0873 ************************************************************ 0874 6464 AORG >6464 0876 0877 * BASIC PARSE CODE 0878 * REGISTER USAGE 0879 * RESERVED FOR GPL INTERPRETER R13, R14, R15 99/4 ASSEMBLER PARSES PAGE 0019 0880 * R13 contains the read address for GROM 0881 * R14 is used in BASSUP/10 for the VDPRAM pointer 0882 * RESERVED IN BASIC SUPPORT 0883 * R8 MSB current character (like CHAT in GPL) 0884 * R8 LSB zero 0885 * R10 read data port address for program data 0886 * ALL EXITS TO GPL MUST GO THROUGH "NUDG05" 0887 * 0888 0889 * ~~~TOKENS~~~ 0890 0081 ELSEZ EQU >81 ELSE 0891 0082 SSEPZ EQU >82 STATEMENT SEPERATOR 0892 0083 TREMZ EQU >83 TAIL REMARK 0893 0084 IFZ EQU >84 IF 0894 0085 GOZ EQU >85 GO 0895 0086 GOTOZ EQU >86 GOTO 0896 0087 GOSUBZ EQU >87 GOSUB 0897 008E BREAKZ EQU >8E BREAK 0898 0096 NEXTZ EQU >96 NEXT 0899 00A1 SUBZ EQU >A1 SUB 0900 00A5 ERRORZ EQU >A5 ERROR 0901 00A6 WARNZ EQU >A6 WARNING 0902 00B0 THENZ EQU >B0 THEN 0903 00B1 TOZ EQU >B1 TO 0904 00B3 COMMAZ EQU >B3 COMMA 0905 00B6 RPARZ EQU >B6 RIGHT PARENTHESIS ) 0906 00B7 LPARZ EQU >B7 LEFT PARENTHESIS ( 0907 00BA ORZ EQU >BA OR 0908 00BB ANDZ EQU >BB AND 0909 00BC XORZ EQU >BC XOR 0910 00BD NOTZ EQU >BD NOT 0911 00BE EQZ EQU >BE EQUAL (=) 0912 00C0 GTZ EQU >C0 GREATER THEN (>) 0913 00C1 PLUSZ EQU >C1 PLUS (+) 0914 00C2 MINUSZ EQU >C2 MINUS (-) 0915 00C4 DIVIZ EQU >C4 DIVIDE (/) 0916 00C5 EXPONZ EQU >C5 EXPONENT 0917 00C7 STRINZ EQU >C7 STRING 0918 00C9 LNZ EQU >C9 LINE NUMBER 0919 00CB ABSZ EQU >CB ABSOLUTE 0920 00D1 SGNZ EQU >D1 SIGN 0921 * 0922 6464 0018 C24 DATA 24 CONSTANT 24 0923 6466 65A6 EXRTNA DATA EXRTN RETURN FOR EXEC 0924 * 0925 6468 0200 ERRSO LI R0,>0703 Issue STACK OVERFLOW message 646A 0703 0926 646C 0460 B @ERR 646E 6652 0927 * 0928 * GRAPHICS LANGUAGE ENTRY TO PARSE 0929 * 0930 6470 06A0 PARSEG BL @SETREG Set up registers for Basic 6472 1E7A 0931 6474 D2ED MOVB @GRMRAX(R13),R11 Get GROM address 6476 0002 0932 6478 D82D MOVB @GRMRAX(R13),@R11LB 647A 0002 647C 83F7 99/4 ASSEMBLER PARSES PAGE 0020 0933 647E 060B DEC R11 0934 * 0935 * 9900 ENTRY TO PARSE 0936 * 0937 6480 05C9 PARSE INCT R9 Get room for return address 0938 6482 0289 CI R9,STKEND Stack full? 6484 83BA 0939 6486 1BF0 JH ERRSO Yes, too many levels deep 0940 6488 C64B MOV R11,*R9 Save the return address 0941 648A D1C8 P05 MOVB R8,R7 Test for token beginning 0942 648C 1102 JLT P10 If token, then look it up 0943 648E 0460 B @PSYM If not token is a symbol 6490 6884 0944 6492 06A0 P10 BL @PGMCHR Get next character 6494 6C74 0945 6496 0977 SRL R7,7 Change last character to offse 0946 6498 0227 AI R7,->B7*2 Check for legal NUD 649A FE92 0947 649C 0287 CI R7,NTABLN Within the legal NUD address? 649E 0056 0948 64A0 1B22 JH CONT15 No, check for legal LED 0949 64A2 C1E7 MOV @NTAB(R7),R7 Get NUD address 64A4 69FE 0950 64A6 1525 JGT B9900 If 9900 code 0951 64A8 P17 EQU $ R7 contains offset into nudtab 0952 64A8 0247 ANDI R7,>7FFF If GPL code, get rid of MSB 64AA 7FFF 0953 64AC A1E0 A @NUDTAB,R7 Add in table address 64AE 8328 0954 64B0 06A0 NUDG05 BL @SAVREG Restore GPL pointers 64B2 1E8C 0955 64B4 DB47 MOVB R7,@GRMWAX(R13) Write out new GROM address 64B6 0402 0956 64B8 06C7 SWPB R7 Bare the LSB 0957 64BA DB47 MOVB R7,@GRMWAX(R13) Put it out too 64BC 0402 0958 64BE 0460 B @RESET Go back to GPL interpreter 64C0 006A 0959 64C2 10F2 P17L JMP P17 0960 * 0961 * CONTINUE ROUTINE FOR PARSE 0962 * 0963 64C4 06A0 CONTG BL @SETREG GPL entry-set Basic registers 64C6 1E7A 0964 64C8 C199 CONT MOV *R9,R6 Get last address from stack 0965 64CA 1506 JGT CONT10 9900 code if not negative 0966 64CC DB46 MOVB R6,@GRMWAX(R13) Write out new GROM address 64CE 0402 0967 64D0 06C6 SWPB R6 Bare the second byte 0968 64D2 DB46 MOVB R6,@GRMWAX(R13) Put it out too 64D4 0402 0969 64D6 C18D MOV R13,R6 Set up to test precedence 0970 64D8 9216 CONT10 CB *R6,R8 Test precedence 0971 64DA 1411 JHE NUDNDL Have parsed far enough->return 0972 64DC 0978 SRL R8,7 Make into table offset 0973 64DE 0228 AI R8,->B8*2 Minimum token for a LED (*2) 64E0 FE90 0974 64E2 0288 CI R8,LTBLEN Maximum token for a LED (*2) 64E4 001C 99/4 ASSEMBLER PARSES PAGE 0021 0975 64E6 1B09 CONT15 JH NOLEDL If outside legal LED range-err 0976 64E8 C1E8 MOV @LTAB(R8),R7 Pick up address of LED handler 64EA 6A54 0977 64EC 04C8 CLR R8 Clear 'CHAT' for getting new 0978 64EE 06A0 BL @PGMCHR Get next character 64F0 6C74 0979 64F2 0457 B9900 B *R7 Go to the LED handler 0980 64F4 0649 NUDE10 DECT R9 Back up subroutine stack 0981 64F6 0587 INC R7 Skip over precedence 0982 64F8 10DB JMP NUDG05 Goto code to return to GPL 0983 64FA 0460 NOLEDL B @NOLED 64FC 664E 0984 64FE 1073 NUDNDL JMP NUDND1 0985 * Execute one or more lines of Basic 0986 6500 EXECG EQU $ GPL entry point for execution 0987 6500 06A0 BL @SETREG Set up registers 6502 1E7A 0988 6504 04E0 CLR @ERRCOD Clear the return code 6506 8322 0989 6508 D020 MOVB @PRGFLG,R0 Imperative statement? 650A 8344 0990 650C 131A JEQ EXEC15 Yes, handle it as such 0991 * Loop for each statement in the program 0992 650E EXEC10 EQU $ 0993 650E D020 MOVB @FLAG,R0 Now test for trace mode 6510 8345 0994 6512 0A30 SLA R0,3 Check the trace bit in FLAG 0995 6514 115F JLT TRACL If set->display line number 0996 6516 C820 EXEC11 MOV @EXTRAM,@PGMPTR Get text pointer 6518 832E 651A 832C 0997 651C 0660 DECT @PGMPTR Back to the line # to check 651E 832C 0998 * break point 0999 6520 06A0 BL @PGMCHR Get the first byte of line # 6522 6C74 1000 6524 02C0 STST R0 Save status for breakpnt check 1001 6526 05A0 INC @PGMPTR Get text pointer again 6528 832C 1002 652A 06A0 BL @PGMCHR Go get the text pointer 652C 6C74 1003 652E 06C8 SWPB R8 Save 1st byte of text pointer 1004 6530 06A0 BL @PGMCHR Get 2nd byte of text pointer 6532 6C74 1005 6534 06C8 SWPB R8 Put text pointer in order 1006 6536 C808 MOV R8,@PGMPTR Set new text pointer 6538 832C 1007 653A 04C8 CLR R8 Clean up the mess 1008 653C 0A20 SLA R0,2 Check breakpoint status 1009 653E 1101 JLT EXEC15 If no breakpoint set - count 1010 6540 177A JNC BRKPNT If breakpoint set-handle it 1011 6542 EXEC15 EQU $ 1012 6544 C3 EQU $+2 Constant data 3 1013 6545 CB3 EQU $+3 Constant byte 3 1014 6542 0300 LIMI 3 Let interrupts loose 6544 0003 1015 6548 C0 EQU $+2 Constant data 0 1016 6546 0300 LIMI 0 Shut down interrupts 6548 0000 99/4 ASSEMBLER PARSES PAGE 0022 1017 654A 04E0 CLR @>83D6 Reset VDP timeout 654C 83D6 1018 654E 020C LI R12,>24 Load console KBD address in CR 6550 0024 1019 6552 30E0 LDCR @C0,3 Select keyboard section 6554 6548 1020 6556 020C LI R12,6 Read address 6558 0006 1021 655A 3600 STCR R0,8 SCAN the keyboard 1022 655C 2420 CZC @C1000,R0 Shift-key depressed? 655E 600A 1023 6560 160A JNE EXEC16 No, execute the Basic statemen 1024 6562 020C LI R12,>24 Test column 3 of keyboard 6564 0024 1025 6566 30E0 LDCR @CB3,3 Select keyboard section 6568 6545 1026 656A 020C LI R12,6 Read address 656C 0006 1027 656E 3600 STCR R0,8 SCAN the keyboard 1028 6570 2420 CZC @C1000,R0 Shift-C depressed? 6572 600A 1029 6574 132E JEQ BRKP1L Yes, so take Basic breakpoint 1030 6576 C820 EXEC16 MOV @PGMPTR,@SMTSRT Save start of statement 6578 832C 657A 831E 1031 657C 05C9 INCT R9 Get subroutine stack space 1032 657E C660 MOV @EXRTNA,*R9 Save the GPL return address 6580 6466 1033 6582 06A0 BL @PGMCHR Now get 1st character of stmt 6584 6C74 1034 6586 1320 JEQ EXRTN3 If EOL after EOS 1035 6588 1102 EXEC17 JLT EXEC20 If top bit set->keyword 1036 658A 0460 B @NLET If not->fake a 'LET' stmt 658C 6948 1037 658E C1C8 EXEC20 MOV R8,R7 Save 1st token so can get 2nd 1038 6590 05A0 INC @PGMPTR Increment the perm pointer 6592 832C 1039 6594 D21A MOVB *R10,R8 Read the character 1040 6596 0977 SRL R7,7 Convert 1st to table offset 1041 6598 0227 AI R7,->AA*2 Check for legal stmt token 659A FEAC 1042 659C 1558 JGT ERRONE Not in range -> error 1043 659E C1E7 MOV @STMTTB(R7),R7 Get address of stmt handler 65A0 69FC 1044 65A2 118F JLT P17L If top bit set -> GROM code 1045 65A4 0457 B *R7 If 9900 code, goto it! 1046 65A6 83 EXRTN BYTE >83 Unused bytes for data constant 1047 65A7 65 CBH65 BYTE >65 since NUDEND skips precedence 1048 65A8 0288 CI R8,SSEPZ*256 EOS only? 65AA 8200 1049 65AC 13CA JEQ EXEC15 Yes, continue on this line 1050 65AE D020 EXRTN2 MOVB @PRGFLG,R0 Did we execute an imperative 65B0 8344 1051 65B2 1351 JEQ EXEC50 Yes, so return to top-level 1052 65B4 6820 S @C4,@EXTRAM No, so goto the next line 65B6 6A80 65B8 832E 1053 65BA 8820 C @EXTRAM,@STLN Check to see if end of program 65BC 832E 99/4 ASSEMBLER PARSES PAGE 0023 65BE 8330 1054 65C0 14A6 JHE EXEC10 No, so loop for the next line 1055 65C2 1049 JMP EXEC50 Yes, so return to top-level 1056 * 1057 * STMT handler for :: 1058 * 1059 65C4 D208 SMTSEP MOVB R8,R8 EOL? 1060 65C6 16E0 JNE EXEC17 NO, there is another stmt 1061 65C8 0649 EXRTN3 DECT R9 YES 1062 65CA 10F1 JMP EXRTN2 Jump back into it 1063 * Continue after a breakpoint 1064 65CC 06A0 CONTIN BL @SETREG Set up Basic registers 65CE 1E7A 1065 65D0 10B8 EXC15L JMP EXEC15 Continue execution 1066 65D2 1038 BRKP1L JMP BRKPN1 1067 65D4 104E TRACL JMP TRACE 1068 * Test for required End-Of-Statement 1069 65D6 D208 EOL MOVB R8,R8 EOL reached? 1070 65D8 1306 JEQ NUDND1 Yes 1071 65DA 0288 CI R8,TREMZ*256 Higher then tail remark token? 65DC 8300 1072 65DE 1B37 JH ERRONE Yes, its an error 1073 65E0 0288 CI R8,ELSEZ*256 Tail, ssep or else? 65E2 8100 1074 65E4 1A34 JL ERRONE No, error 1075 * 1076 * Return from call to PARSE 1077 * (entered from CONT) 1078 * 1079 65E6 C1D9 NUDND1 MOV *R9,R7 Get the return address 1080 65E8 1185 JLT NUDE10 If negative - return to GPL 1081 65EA 0649 DECT R9 Back up the subroutine stack 1082 65EC 0467 B @2(R7) And return to caller 65EE 0002 1083 * (Skip the precedence word) 1084 65F0 D208 NUDEND MOVB R8,R8 Check for EOL 1085 65F2 13F9 JEQ NUDND1 If EOL 1086 65F4 0288 NUDND2 CI R8,STRINZ*256 Lower than a string? 65F6 C700 1087 65F8 1A08 JL NUDND4 Yes 1088 65FA 0288 CI R8,LNZ*256 Higher than a line #? 65FC C900 1089 65FE 1315 JEQ SKPLN Skip line numbers 1090 6600 1A0B JL SKPSTR Skip string or numeric 1091 6602 06A0 NUDND3 BL @PGMCHR Read next character 6604 6C74 1092 6606 13EF JEQ NUDND1 If EOL 1093 6608 10F5 JMP NUDND2 Continue scan of line 1094 660A 0288 NUDND4 CI R8,TREMZ*256 Higher than a tail remark? 660C 8300 1095 660E 1BF9 JH NUDND3 Yes 1096 6610 0288 CI R8,SSEPZ*256 Lower then stmt sep(else)? 6612 8200 1097 6614 1AF6 JL NUDND3 Yes 1098 6616 10E7 JMP NUDND1 TREM or SSEP 1099 6618 06A0 SKPSTR BL @PGMCHR 661A 6C74 1100 661C 06C8 SWPB R8 Prepare to add 1101 661E A808 A R8,@PGMPTR Skip it 99/4 ASSEMBLER PARSES PAGE 0024 6620 832C 1102 6622 04C8 CLR R8 Clear lower byte 1103 6624 06A0 SKPS01 BL @PGMCHR Get next token 6626 6C74 1104 6628 10E3 JMP NUDEND Go on 1105 662A 05E0 SKPLN INCT @PGMPTR Skip line number 662C 832C 1106 662E 10FA JMP SKPS01 Go on 1107 * 1108 * Return from "CALL" to GPL 1109 6630 06A0 RTNG BL @SETREG Set up registers again 6632 1E7A 1110 6634 10D8 JMP NUDND1 And jump back into it! 1111 ************************************************************ 1112 * Handle Breakpoints 1113 6636 D020 BRKPNT MOVB @FLAG,R0 Check flag bits 6638 8345 1114 663A 0A10 SLA R0,1 Check bit 6 for breakpoint 1115 663C 11C9 JLT EXC15L If set then ignore breakpoint 1116 663E 0200 BRKPN2 LI R0,BRKFL 6640 0001 1117 6642 1007 JMP EXIT Return to top-level 1118 6644 D020 BRKPN1 MOVB @FLAG,R0 Move flag bits 6646 8345 1119 6648 0A10 SLA R0,1 Check bit 6 for breakpoint 1120 664A 1195 JLT EXEC16 If set then ignore breakpoint 1121 664C 10F8 JMP BRKPN2 Bit not set 1122 * 1123 * Error handling from 9900 code 1124 * 1125 664E ERRSYN EQU $ These all issue same message 1126 664E ERRONE EQU $ 1127 664E NONUD EQU $ 1128 664E NOLED EQU $ 1129 664E 0200 LI R0,ERRSN *SYNTAX ERROR return code 6650 0003 1130 6652 EXIT EQU $ 1131 6652 C800 ERR MOV R0,@ERRCOD Load up return code for GPL 6654 8322 1132 * General return to GPL portion of Basic 1133 6656 C1E0 EXEC50 MOV @RTNADD,R7 Get return address 6658 8326 1134 665A 0460 B @NUDG05 Use commond code to link back 665C 64B0 1135 * Handle STOP and END statements 1136 STOP 1137 665E 0649 END DECT R9 Pop last call to PARSE 1138 6660 10FA JMP EXEC50 Jump to return to top-level 1139 * Error codes for return to GPL 1140 0003 ERRSN EQU >0003 ERROR SYNTAX 1141 0103 ERROM EQU >0103 ERROR OUT OF MEMORY 1142 0203 ERRIOR EQU >0203 ERROR INDEX OUT OF RANGE 1143 0303 ERRLNF EQU >0303 ERROR LINE NOT FOUND 1144 0403 ERREX EQU >0403 ERROR EXECUTION 1145 * >0004 WARNING NUMERIC OVERFLOW 1146 0001 BRKFL EQU >0001 BREAKPOINT RETURN VECTOR 1147 0005 ERROR EQU >0005 ON ERROR 1148 0006 UDF EQU >0006 FUNCTION REFERENCE 1149 0007 BREAK EQU >0007 ON BREAK 99/4 ASSEMBLER PARSES PAGE 0025 1150 0008 CONCAT EQU >0008 CONCATENATE (&) STRINGS 1151 0009 WARN EQU >0009 ON WARNING 1152 * Warning routine (only OVERFLOW) 1153 6662 C820 WARNZZ MOV @C4,@ERRCOD Load warning code for GPL 6664 6A80 6666 8322 1154 6668 020B LI R11,CONT-2 To optimize for return 666A 64C6 1155 * Return to GPL as a CALL 1156 666C 05C9 CALGPL INCT R9 Get space on subroutine stack 1157 666E C64B MOV R11,*R9 Save return address 1158 6670 10F2 JMP EXEC50 And go to GPL 1159 * Trace a line (Call GPL routine) 1160 6672 C820 TRACE MOV @C2,@ERRCOD Load return vector 6674 6000 6676 8322 1161 6678 020B LI R11,EXEC11-2 Set up for return to execute 667A 6514 1162 667C 10F7 JMP CALGPL Call GPL to display line # 1163 * Special code to handle concatenate (&) 1164 667E 0200 CONC LI R0,CONCAT Go to GPL to handle it 6680 0008 1165 6682 10E7 JMP EXIT Exit to GPL interpeter 1166 ************************************************************ 1167 * NUD routine for a numeric constant 1168 * NUMCON first puts pointer to the numeric string into 1169 * FAC12 for CSN, clears the error byte (FAC10) and then 1170 * converts from a string to a floating point number. Issues 1171 * warning if necessary. Leaves value in FAC 1172 ************************************************************ 1173 6684 C820 NUMCON MOV @PGMPTR,@FAC12 Set pointer for CSN 6686 832C 6688 8356 1174 668A 06C8 SWPB R8 Swap to get length into LSB 1175 668C A808 A R8,@PGMPTR Add to pointer to check end 668E 832C 1176 6690 04E0 CLR @FAC10 Assume no error 6692 8354 1177 6694 06A0 BL @SAVRE2 Save registers 6696 1E90 1178 6698 0203 LI R3,GETCH Adjustment for ERAM in order 669A 60AE 1179 669C D120 MOVB @RAMFLG,R4 to call CSN 669E 8389 1180 66A0 1302 JEQ NUMC49 1181 66A2 0203 LI R3,GETCGR 66A4 60D0 1182 66A6 06A0 NUMC49 BL @CSN01 Convert String to Number 66A8 11B2 1183 66AA 06A0 BL @SETREG Restore registers 66AC 1E7A 1184 66AE 8820 C @FAC12,@PGMPTR Check to see if all converted 66B0 8356 66B2 832C 1185 66B4 16CC JNE ERRONE If not - error 1186 66B6 06A0 BL @PGMCHR Now get next char from program 66B8 6C74 1187 66BA D020 MOVB @FAC10,R0 Get an overflow on conversion? 66BC 8354 99/4 ASSEMBLER PARSES PAGE 0026 1188 66BE 16D1 JNE WARNZZ Yes, have GPL issue warning 1189 66C0 0460 B @CONT Continue the PARSE 66C2 64C8 1190 * 1191 * ON ERROR, ON WARNING and ON BREAK 1192 66C4 0200 ONERR LI R0,ERROR ON ERROR code 66C6 0005 1193 66C8 10C4 JMP EXIT Return to GPL code 1194 66CA 0200 ONWARN LI R0,WARN ON WARNING code 66CC 0009 1195 66CE 10C1 JMP EXIT Return to GPL code 1196 66D0 0200 ONBRK LI R0,BREAK ON BREAK code 66D2 0007 1197 66D4 10BE JMP EXIT Return to GPL code 1198 * 1199 * NUD routine for "GO" 1200 * 1201 66D6 04C3 GO CLR R3 Dummy "ON" index for common 1202 66D8 1020 JMP ON30 Merge into "ON" code 1203 * 1204 * NUD ROUTINE FOR "ON" 1205 * 1206 66DA 0288 ON CI R8,WARNZ*256 On warning? 66DC A600 1207 66DE 13F5 JEQ ONWARN Yes, goto ONWARN 1208 66E0 0288 CI R8,ERRORZ*256 On error? 66E2 A500 1209 66E4 13EF JEQ ONERR Yes, got ONERR 1210 66E6 0288 CI R8,BREAKZ*256 On break? 66E8 8E00 1211 66EA 13F2 JEQ ONBRK Yes, goto ONBRK 1212 * 1213 * Normal "ON" statement 1214 * 1215 66EC 06A0 BL @PARSE PARSE the index value 66EE 6480 1216 66F0 B3 BYTE COMMAZ Stop on a comma or less 1217 66F1 66 CBH66 BYTE >66 Unused byte for constant 1218 66F2 06A0 BL @NUMCHK Ensure index is a number 66F4 6B92 1219 66F6 04E0 CLR @FAC10 Assume no error in CFI 66F8 8354 1220 66FA 06A0 BL @CFI Convert Floating to Integer 66FC 12B8 1221 66FE D020 MOVB @FAC10,R0 Test error code 6700 8354 1222 6702 1603 JNE GOTO90 If overflow, BAD VALUE 1223 6704 C0E0 MOV @FAC,R3 Get the index 6706 834A 1224 6708 1503 JGT ON20 Must be positive 1225 670A 0200 GOTO90 LI R0,ERRIOR Negative, BAD VALUE 670C 0203 1226 670E 10A1 GOTO95 JMP ERR Jump to error handler 1227 6710 ON20 EQU $ Now check GO TO/SUB 1228 6710 0288 CI R8,GOZ*256 Bare "GO" token? 6712 8500 1229 6714 1608 JNE ON40 No, check other possibilities 1230 6716 06A0 BL @PGMCHR Yes, get next token 6718 6C74 99/4 ASSEMBLER PARSES PAGE 0027 1231 671A 0288 ON30 CI R8,TOZ*256 "GO TO" ? 671C B100 1232 671E 1365 JEQ GOTO50 Yes, handle GO TO like GOTO 1233 6720 0288 CI R8,SUBZ*256 "GO SUB" ? 6722 A100 1234 6724 1005 JMP ON50 Merge to common code to test 1235 6726 0288 ON40 CI R8,GOTOZ*256 "GOTO" ? 6728 8600 1236 672A 135F JEQ GOTO50 Yes, go handle it 1237 672C 0288 CI R8,GOSUBZ*256 "GOSUB" ? 672E 8700 1238 6730 168E ON50 JNE ERRONE No, so is an error 1239 6732 06A0 BL @PGMCHR Get next token 6734 6C74 1240 6736 1002 JMP GOSUB2 Goto gosub code 1241 6738 108A ERR1B JMP ERRONE Issue error message 1242 * NUD routine for "GOSUB" 1243 673A 04C3 GOSUB CLR R3 Dummy index for "ON" code 1244 * Common GOSUB code 1245 673C GOSUB2 EQU $ Now build a FAC entry 1246 673C 0201 LI R1,FAC Optimize to save bytes 673E 834A 1247 6740 CC43 MOV R3,*R1+ Save the "ON" index 1248 * in case of garbage collection 1249 6742 DC60 MOVB @CBH66,*R1+ Indicate GOSUB entry on stack 6744 66F1 1250 6746 0581 INC R1 Skip FAC3 1251 6748 C460 MOV @PGMPTR,*R1 Save current ptr w/in line 674A 832C 1252 674C 05F1 INCT *R1+ Skip line # to correct place 1253 674E C460 MOV @EXTRAM,*R1 Save current line # pointer 6750 832E 1254 6752 06A0 BL @VPUSH Save the stack entry 6754 6BAA 1255 6756 C0E0 MOV @FAC,R3 Restore the "ON" index 6758 834A 1256 675A 1001 JMP GOTO20 Jump to code to find the line 1257 * NUD routine for "GOTO" 1258 675C 04C3 GOTO CLR R3 Dummy index for "ON" code 1259 * Common (ON) GOTO/GOSUB THEN/ELSE code to fine line 1260 * 1261 * Get line number from program 1262 675E 0288 GOTO20 CI R8,LNZ*256 Must have line number token 6760 C900 1263 6762 16EA JNE ERR1B Don't, so error 1264 6764 06A0 GETL10 BL @PGMCHR Get MSB of the line number 6766 6C74 1265 6768 D008 MOVB R8,R0 Save it 1266 676A 06A0 BL @PGMCHR Read the character 676C 6C74 1267 676E 0603 DEC R3 Decrement the "ON" index 1268 6770 1534 JGT GOTO40 Loop if not there yet 1269 * 1270 * Find the program line 1271 * 1272 6772 C060 MOV @STLN,R1 Get into line # table 6774 8330 1273 6776 D0A0 MOVB @RAMFLG,R2 Check ERAM flag to see where? 6778 8389 99/4 ASSEMBLER PARSES PAGE 0028 1274 677A 1310 JEQ GOTO31 From VDP, go handle it 1275 677C C081 MOV R1,R2 Copy address 1276 677E 8801 GOT32 C R1,@ENLN Finished w/line # table? 6780 8332 1277 6782 1422 JHE GOTO34 Yes, so line doesn't exist 1278 6784 D0F2 MOVB *R2+,R3 2nd byte match? 1279 6786 0243 ANDI R3,>7FFF Reset possible breakpoint 6788 7FFF 1280 678A 9003 CB R3,R0 Compare 1st byte of #, Match? 1281 678C 1605 JNE GOT35 Not a match, so move on 1282 678E 9232 CB *R2+,R8 2nd byte match? 1283 6790 131E JEQ GOTO36 Yes, line is found! 1284 6792 05C2 GOT33 INCT R2 Skip line pointer 1285 6794 C042 MOV R2,R1 Advance to next line in table 1286 6796 10F3 JMP GOT32 Go back for more 1287 6798 D0F2 GOT35 MOVB *R2+,R3 Skip 2nd byte of line # 1288 679A 10FB JMP GOT33 And jump back in 1289 679C D7E0 GOTO31 MOVB @R1LB,*R15 Get the data from the VDP 679E 83E3 1290 67A0 0202 LI R2,XVDPRD Load up to read data 67A2 8800 1291 67A4 D7C1 MOVB R1,*R15 Write out MSB of address 1292 67A6 8801 GOTO32 C R1,@ENLN Finished w/line # table 67A8 8332 1293 67AA 140E JHE GOTO34 Yes, so line doesn't exist 1294 67AC D0D2 MOVB *R2,R3 Save in temporary place for 1295 * breakpoint checking 1296 67AE 0243 ANDI R3,>7FFF Reset possible breakpoint 67B0 7FFF 1297 67B2 9003 CB R3,R0 Compare 1st byte of #, Match? 1298 67B4 1607 JNE GOTO35 Not a match, so move on 1299 67B6 9212 CB *R2,R8 2nd byte match? 1300 67B8 130A JEQ GOTO36 Yes, line is found! 1301 67BA D0D2 GOTO33 MOVB *R2,R3 Skip 1st byte of line pointer 1302 67BC 0221 AI R1,4 Advance to next line in table 67BE 0004 1303 67C0 D0D2 MOVB *R2,R3 Skip 1nd byte of line pointer 1304 67C2 10F1 JMP GOTO32 Go back for more 1305 67C4 D0D2 GOTO35 MOVB *R2,R3 Skip 2nd byte of line # 1306 67C6 10F9 JMP GOTO33 And jump back in 1307 67C8 0200 GOTO34 LI R0,ERRLNF LINE NOT FOUND error vector 67CA 0303 1308 67CC 10A0 JMP GOTO95 Jump for error exit 1309 67CE 05C1 GOTO36 INCT R1 Adjust to line pointer 1310 67D0 C801 MOV R1,@EXTRAM Save for execution of the line 67D2 832E 1311 67D4 0649 DECT R9 Pop saved link to goto 1312 67D6 0460 B @EXEC10 Reenter EXEC code directly 67D8 650E 1313 67DA 06A0 GOTO40 BL @PGMCHR Get next token 67DC 6C74 1314 67DE 06A0 BL @EOSTMT Premature end of statement? 67E0 6862 1315 67E2 1393 JEQ GOTO90 Yes =>BAD VALUE for index 1316 67E4 0288 CI R8,COMMAZ*256 Comma next ? 67E6 B300 1317 67E8 1603 JNE ERR1C No, error 1318 67EA 06A0 GOTO50 BL @PGMCHR Yes, get next character 67EC 6C74 99/4 ASSEMBLER PARSES PAGE 0029 1319 67EE 10B7 JMP GOTO20 And check this index value 1320 67F0 10A3 ERR1C JMP ERR1B Linking becuase long-distance 1321 67F2 0200 ERR51 LI R0,>0903 RETURN WITHOUT GOSUB 67F4 0903 1322 67F6 108B JMP GOTO95 Exit to GPL 1323 * NUD entry for "RETURN" 1324 67F8 8820 RETURN C @VSPTR,@STVSPT Check bottom of stack 67FA 836E 67FC 8324 1325 67FE 12F9 JLE ERR51 Error -> RETURN WITHOUT GOSUB 1326 6800 06A0 BL @VPOP Pop entry 6802 6C2A 1327 6804 9820 CB @CBH66,@FAC2 Check ID for a GOSUB entry 6806 66F1 6808 834C 1328 680A 160B JNE RETU30 Check for ERROR ENTRY 1329 * 1330 * Have a GOSUB entry 1331 * 1332 680C 06A0 BL @EOSTMT Must have EOS after return 680E 6862 1333 6810 16F3 JNE RETURN Not EOS, then error return? 1334 6812 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6814 834E 6816 832C 1335 6818 C820 MOV @FAC6,@EXTRAM Get return line pointer 681A 8350 681C 832E 1336 681E 0460 B @SKPS01 Go adjust it and get back 6820 6624 1337 * Check ERROR entry 1338 6822 9820 RETU30 CB @CBH69,@FAC2 ERROR ENTRY? 6824 6A9B 6826 834C 1339 6828 1307 JEQ RETU40 Yes, take care of error entry 1340 682A 9820 CB @CBH6A,@FAC2 Subprogram entry? 682C 6860 682E 834C 1341 6830 16E3 JNE RETURN No, look some more 1342 6832 06A0 BL @VPUSH Push it back. Keep information 6834 6BAA 1343 6836 10DD JMP ERR51 RETURN WITHOUT GOSUB error 1344 * 1345 * Have an ERROR entry 1346 * RETURN, RETURN line #, RETURN or RETURN NEXT follows. 1347 * 1348 6838 04C3 RETU40 CLR R3 In case of a line number 1349 683A 0288 CI R8,LNZ*256 Check for a line number 683C C900 1350 683E 1392 JEQ GETL10 Yes, treat like GOTO 1351 6840 C820 MOV @FAC4,@PGMPTR Get return ptr w/in line 6842 834E 6844 832C 1352 6846 C820 MOV @FAC6,@EXTRAM Get return line pointer 6848 8350 684A 832E 1353 684C 06A0 BL @EOSTMT EOL now? 684E 6862 1354 6850 1305 JEQ BEXC15 Yes, treat like GOSUB rtn. 99/4 ASSEMBLER PARSES PAGE 0030 1355 6852 0288 CI R8,NEXTZ*256 NEXT now? 6854 9600 1356 6856 16CC JNE ERR1C No, so its an error 1357 6858 0460 B @SKPS01 Yes, so execute next statement 685A 6624 1358 685C 0460 BEXC15 B @EXEC15 Execute next line 685E 6542 1359 6860 6A CBH6A BYTE >6A Subprogram call stack ID 1360 EVEN 1361 ************************************************************ 1362 * EOSTMT - Check for End-Of-STateMenT 1363 * Returns with condition '=' if EOS 1364 * else condition '<>' if not EOS 1365 ************************************************************ 1366 6862 D208 EOSTMT MOVB R8,R8 EOL or non-token? 1367 6864 1305 JEQ EOSTM1 EOL-return condition '=' 1368 6866 1504 JGT EOSTM1 Non-token return condition '<> 1369 6868 0288 CI R8,TREMZ*256 In the EOS range (>81 to >83)? 686A 8300 1370 686C 1B01 JH EOSTM1 No, return condition '<>' 1371 686E 8208 C R8,R8 Yes, force condition to '=' 1372 6870 045B EOSTM1 RT 1373 ************************************************************ 1374 * EOLINE - Tests for End-Of-LINE; either a >00 or a 1375 * '!' 1376 * Returns with condition '=' if EOL else condition 1377 * '<>' if not EOL 1378 ************************************************************ 1379 6872 D208 EOLINE MOVB R8,R8 EOL? 1380 6874 1302 JEQ EOLNE1 Yes, return with '=' set 1381 6876 0288 CI R8,TREMZ*256 Set condition on a tall remark 6878 8300 1382 687A 045B EOLNE1 RT And return 1383 687C 0200 SYMB20 LI R0,UDF Long distance 687E 0006 1384 6880 0460 B @GOTO95 6882 670E 1385 * NUD for a symbol (variable) 1386 6884 06A0 PSYM BL @SYM Get symbol table entry 6886 6312 1387 6888 06A0 BL @GETV Get 1st byte of entry 688A 187C 1388 688C 834A DATA FAC SYM left pointer in FAC 1389 * 1390 688E 0A11 SLA R1,1 UDF reference? 1391 6890 11F5 JLT SYMB20 Yes, special code for it 1392 6892 06A0 BL @SMB No, get value space pointer 6894 61DC 1393 6896 9820 CB @FAC2,@CBH65 String reference? 6898 834C 689A 65A7 1394 689C 1302 JEQ SYMB10 Yes, special code for it 1395 689E 06A0 BL @MOVFAC No, numeric ->copy into FAC 68A0 6434 1396 68A2 0460 SYMB10 B @CONT And continue the PARSE 68A4 64C8 1397 * Statement entry for IF statement 1398 68A6 06A0 IF BL @PARSE Evaluate the expression 68A8 6480 99/4 ASSEMBLER PARSES PAGE 0031 1399 68AA B3 BYTE COMMAZ Stop on a comma 1400 68AB 67 CBH67 BYTE >67 Unused byte for a constant 1401 68AC 06A0 BL @NUMCHK Ensure the value is a number 68AE 6B92 1402 68B0 04C3 CLR R3 Create a dummy "ON" index 1403 68B2 0288 CI R8,THENZ*256 Have a "THEN" token 68B4 B000 1404 68B6 169C JNE ERR1C No, error 1405 68B8 0520 NEG @FAC Test if condition true i.e. <> 68BA 834A 1406 68BC 1610 JNE IFZ10 True - branch to the special # 1407 68BE 06A0 BL @PGMCHR Advance to line number token 68C0 6C74 1408 68C2 0288 CI R8,LNZ*256 Have the line # token? 68C4 C900 1409 68C6 1619 JNE IFZ20 No, must look harder for ELSE 1410 68C8 05E0 INCT @PGMPTR Skip the line number 68CA 832C 1411 68CC 06A0 BL @PGMCHR Get next token 68CE 6C74 1412 68D0 0288 IFZ5 CI R8,ELSEZ*256 Test if token is ELSE 68D2 8100 1413 68D4 1304 JEQ IFZ10 We do! So branch to the line # 1414 68D6 0460 B @EOL We don't, so better be EOL 68D8 65D6 1415 68DA 0460 GETL1Z B @GETL10 Get 1st token of clause 68DC 6764 1416 68DE 06A0 IFZ10 BL @PGMCHR Get 1st token of clause 68E0 6C74 1417 68E2 0288 CI R8,LNZ*256 Line # token? 68E4 C900 1418 68E6 13F9 JEQ GETL1Z Yes, go there 1419 68E8 06A0 BL @EOSTMT EOS? 68EA 6862 1420 68EC 1381 JEQ1C JEQ ERR1C Yes, its an error 1421 68EE 0208 LI R8,SSEPZ*256 Cheat to do a continue 68F0 8200 1422 68F2 0620 DEC @PGMPTR Back up to get 1st character 68F4 832C 1423 68F6 0460 B @CONT Continue on 68F8 64C8 1424 * 1425 * LOOK FOR AN ELSE CLAUSE SINCE THE CONDITION WAS FALSE 1426 * 1427 68FA 0203 IFZ20 LI R3,1 IF/ELSE pair counter 68FC 0001 1428 68FE 06A0 BL @EOLINE Trap out EOS following THEN/EL 6900 6872 1429 6902 13F4 JEQ JEQ1C error 1430 6904 0288 IFZ25 CI R8,ELSEZ*256 ELSE? 6906 8100 1431 6908 1603 JNE IFZ27 If not 1432 690A 0603 DEC R3 Matching ELSE? 1433 690C 13E8 JEQ IFZ10 Yes, do it 1434 690E 100F JMP IFZ35 No, go on 1435 6910 0288 IFZ27 CI R8,IFZ*256 Check for it 6912 8400 1436 6914 1602 JNE IFZ28 Not an IF 1437 6916 0583 INC R3 Increment nesting level 99/4 ASSEMBLER PARSES PAGE 0032 1438 6918 100A JMP IFZ35 And go on 1439 691A 0288 IFZ28 CI R8,STRINZ*256 Lower than string? 691C C700 1440 691E 1A04 JL IFZ30 Yes 1441 6920 0288 CI R8,LNZ*256 Higher or = to a line # 6922 C900 1442 6924 1307 JEQ IFZ40 = line # 1443 6926 1A09 JL IFZ50 Skip strings and numerics 1444 6928 06A0 IFZ30 BL @EOLINE EOL? 692A 6872 1445 692C 13D1 JEQ IFZ5 Yes, done scanning 1446 692E 06A0 IFZ35 BL @PGMCHR Get next character 6930 6C74 1447 6932 10E8 JMP IFZ25 And go on 1448 * 1449 * SKIP LINE #'s 1450 * 1451 6934 05E0 IFZ40 INCT @PGMPTR Skip the line # 6936 832C 1452 6938 10FA JMP IFZ35 Go on 1453 * 1454 * SKIP STRINGS AND NUMERICS 1455 * 1456 693A 06A0 IFZ50 BL @PGMCHR Get # of bytes to skip 693C 6C74 1457 693E 06C8 SWPB R8 Swap for add 1458 6940 A808 A R8,@PGMPTR Skip it 6942 832C 1459 6944 04C8 CLR R8 Clear LSB of R8 1460 6946 10F3 JMP IFZ35 1461 ************************************************************ 1462 1464 1465 ************************************************************ 1466 * 'LET' statement handler 1467 * Assignments are done bye putting an entry on the stack 1468 * for the destination variable and getting the source value 1469 * into the FAC. Multiple assignments are handled by the 1470 * stacking the variable entrys and then looping for the 1471 * assignments. Numeric assignments pose no problems, 1472 * strings are more complicated. String assignments are done 1473 * by assigning the source string to the last variable 1474 * specified in the list and changing the FAC entry so that 1475 * the string assigned to the next-to-the-last variable 1476 * comes from the permanent string belonging to the variable 1477 * just assigned. 1478 * e.g. A$,B$,C$="HELLO" 1479 * 1480 * C$-------"HELLO" (source string) 1481 * 1482 * B$-------"HELLO" (copy from CZ's string) 1483 * 1484 * A$-------"HELLO" (copy from BZ's string) 1485 ************************************************************ 1486 6948 04E0 NLET CLR @PAD0 Counter for multiple assign's 694A 8300 1487 694C 06A0 NLET05 BL @SYM Get symbol table address 694E 6312 1488 *----------------------------------------------------------- 99/4 ASSEMBLER PARSES2 PAGE 0033 1489 * The following code has been taken out for checking is 1490 * inserted in SMB 5/22/81 1491 * BL @GETV Get first byte of entry 1492 * DATA FAC SYM left pointer in FAC 1493 * SLA R1,1 Test if a UDF 1494 * JLT ERRMUV Is a UDF - so error 1495 *----------------------------------------------------------- 1496 6950 06A0 BL @SMB Get value space pointer 6952 61DC 1497 6954 06A0 BL @VPUSH Push s.t. pointer on stack 6956 6BAA 1498 6958 05A0 INC @PAD0 Count the variable 695A 8300 1499 695C 0288 CI R8,EQZ*256 Is the token an '='? 695E BE00 1500 6960 130B JEQ NLET10 Yes, go into assignment loop 1501 6962 0288 CI R8,COMMAZ*256 Must have a comma now 6964 B300 1502 6966 161E JNE ERR1CZ Didn't - so error 1503 6968 06A0 BL @PGMCHR Get next token 696A 6C74 1504 696C 15EF JGT NLET05 If legal symbol character 1505 696E 101A JMP ERR1CZ If not - error 1506 6970 0200 ERRMUV LI R0,>0D03 MULTIPLY USED VARIABLE 6972 0D03 1507 6974 0460 B @ERR 6976 6652 1508 6978 06A0 NLET10 BL @PGMCHR Get next token 697A 6C74 1509 697C 06A0 BL @PARSE PARSE the value to assign 697E 6480 1510 6980 83 BYTE TREMZ Parse to the end of statement 1511 6981 65 STCOD2 BYTE >65 Wasted byte (STCODE copy) 1512 * Loop for assignments 1513 6982 06A0 NLET15 BL @ASSG Assign the value to the symbol 6984 6334 1514 6986 0620 DEC @PAD0 One less to assign, done? 6988 8300 1515 698A 130A JEQ LETCON Yes, branch out 1516 698C 9820 CB @FAC2,@STCOD2 String or numeric? 698E 834C 6990 6981 1517 6992 16F7 JNE NLET15 Numeric, just loop for more 1518 6994 C806 MOV R6,@FAC4 Get pointer to new string 6996 834E 1519 6998 C820 MOV @ARG,@FAC Get pointer to last s.t. entry 699A 835C 699C 834A 1520 699E 10F1 JMP NLET15 Now loop to assign more 1521 69A0 0460 LETCON B @EOL Yes, continue the PARSE 69A2 65D6 1522 69A4 0460 ERR1CZ B @ERR1C For long distance jump 69A6 67F0 1523 69A8 664E DATA NONUD (SPARE) >80 1524 69AA 664E DATA NONUD ELSE >81 1525 69AC 65C4 DATA SMTSEP :: >82 1526 69AE 65E6 DATA NUDND1 ! >83 1527 69B0 68A6 DATA IF IF >84 1528 69B2 66D6 DATA GO GO >85 99/4 ASSEMBLER PARSES2 PAGE 0034 1529 69B4 675C DATA GOTO GOTO >86 1530 69B6 673A DATA GOSUB GOSUB >87 1531 69B8 67F8 DATA RETURN RETURN >88 1532 69BA 65F0 DATA NUDEND DEF >89 1533 69BC 65F0 DATA NUDEND DIM >8A 1534 69BE 665E DATA END END >8B 1535 69C0 7000 DATA NFOR FOR >8C 1536 69C2 6948 DATA NLET LET >8D 1537 69C4 8002 DATA >8002 BREAK >8E 1538 69C6 8004 DATA >8004 UNBREAK >8F 1539 69C8 8006 DATA >8006 TRACE >90 1540 69CA 8008 DATA >8008 UNTRACE >91 1541 69CC 8016 DATA >8016 INPUT >92 1542 69CE 65E6 DATA NUDND1 DATA >93 1543 69D0 8012 DATA >8012 RESTORE >94 1544 69D2 8014 DATA >8014 RANDOMIZE >95 1545 69D4 7230 DATA NNEXT NEXT >96 1546 69D6 800A DATA >800A READ >97 1547 69D8 665E DATA STOP STOP >98 1548 69DA 8032 DATA >8032 DELETE >99 1549 69DC 65E6 DATA NUDND1 REM >9A 1550 69DE 66DA DATA ON ON >9B 1551 69E0 800C DATA >800C PRINT >9C 1552 69E2 750A DATA CALL CALL >9D 1553 69E4 65F0 DATA NUDEND OPTION >9E 1554 69E6 8018 DATA >8018 OPEN >9F 1555 69E8 801A DATA >801A CLOSE >A0 1556 69EA 665E DATA STOP SUB >A1 1557 69EC 8034 DATA >8034 DISPLAY >A2 1558 69EE 65E6 DATA NUDND1 IMAGE >A3 1559 69F0 8024 DATA >8024 ACCEPT >A4 1560 69F2 664E DATA NONUD ERROR >A5 1561 69F4 664E DATA NONUD WARNING >A6 1562 69F6 78D2 DATA SUBXIT SUBEXIT >A7 1563 69F8 78D2 DATA SUBXIT SUBEND >A8 1564 69FA 800E DATA >800E RUN >A9 1565 69FC 8010 STMTTB DATA >8010 LINPUT >AA 1566 69FE 6E68 NTAB DATA NLPR LEFT PARENTHISIS >B7 1567 6A00 664E DATA NONUD CONCATENATE >B8 1568 6A02 664E DATA NONUD SPARE >B9 1569 6A04 664E DATA NONUD AND >BA 1570 6A06 664E DATA NONUD OR >BB 1571 6A08 664E DATA NONUD XOR >BC 1572 6A0A 6E2E DATA O0NOT NOT >BD 1573 6A0C 664E DATA NONUD = >BE 1574 6A0E 664E DATA NONUD < >BF 1575 6A10 664E DATA NONUD > >C0 1576 6A12 6E96 DATA NPLUS + >C1 1577 6A14 6E82 DATA NMINUS - >C2 1578 6A16 664E DATA NONUD * >C3 1579 6A18 664E DATA NONUD / >C4 1580 6A1A 664E DATA NONUD ^ >C5 1581 6A1C 664E DATA NONUD SPARE >C6 1582 6A1E 7442 DATA NSTRCN QUOTED STRING >C7 1583 6A20 6684 DATA NUMCON UNQUOTED STRING/NUMERIC >C8 1584 6A22 664E DATA NONUD LINE NUMBER >C9 1585 6A24 8026 DATA >8026 EOF >CA 1586 6A26 6CFA DATA NABS ABS >CB 1587 6A28 6D16 DATA NATN ATN >CC 99/4 ASSEMBLER PARSES2 PAGE 0035 1588 6A2A 6D1C DATA NCOS COS >CD 1589 6A2C 6D22 DATA NEXP EXP >CE 1590 6A2E 6D28 DATA NINT INT >CF 1591 6A30 6D2E DATA NLOG LOG >D0 1592 6A32 6D34 DATA NSGN SGN >D1 1593 6A34 6D64 DATA NSIN SIN >D2 1594 6A36 6D6A DATA NSQR SQR >D3 1595 6A38 6D70 DATA NTAN TAN >D4 1596 6A3A 8036 DATA >8036 LEN >D5 1597 6A3C 8038 DATA >8038 CHRZ >D6 1598 6A3E 803A DATA >803A RND >D7 1599 6A40 8030 DATA >8030 SEGZ >D8 1600 6A42 802A DATA >802A POS >D9 1601 6A44 802C DATA >802C VAL >DA 1602 6A46 802E DATA >802E STR >DB 1603 6A48 8028 DATA >8028 ASC >DC 1604 6A4A 801C DATA >801C PI >DD 1605 6A4C 8000 DATA >8000 REC >DE 1606 6A4E 801E DATA >801E MAX >DF 1607 6A50 8020 DATA >8020 MIN >E0 1608 6A52 8022 DATA >8022 RPTZ >E1 1609 0056 NTABLN EQU $-NTAB 1610 6A54 667E LTAB DATA CONC & >B8 1611 6A56 664E DATA NOLED SPARE >B9 1612 6A58 6E1C DATA O0OR OR >BA 1613 6A5A 6DFA DATA O0AND AND >BB 1614 6A5C 6E50 DATA O0XOR XOR >BC 1615 6A5E 664E DATA NOLED NOT >BD 1616 6A60 6A8E DATA EQUALS = >BE 1617 6A62 6A70 DATA LESS < >BF 1618 6A64 6A7E DATA GREATR > >C0 1619 6A66 6B1E DATA PLUS + >C1 1620 6A68 6B4A DATA MINUS - >C2 1621 6A6A 6B56 DATA TIMES * >C3 1622 6A6C 6B62 DATA DIVIDE / >C4 1623 6A6E 6CE2 DATA LEXP ^ >C5 1624 001C LTBLEN EQU $-LTAB 1625 ************************************************************ 1626 * Relational operators 1627 * Logical conparisons encode the type of comparison and use 1628 * common code to PARSE the expression and set the status 1629 * bits. 1630 * 1631 * The types of legal comparisons are: 1632 * 0 EQUAL 1633 * 1 NOT EQUAL 1634 * 2 LESS THAN 1635 * 3 LESS OR EQUAL 1636 * 4 GREATER THAN 1637 * 5 GREATER THAN OR EQUAL 1638 * 1639 * This code is saved on the subroutine stack 1640 ************************************************************ 1641 6A70 0202 LESS LI R2,2 LESS-THAN code for common rtn 6A72 0002 1642 6A74 0288 CI R8,GTZ*256 Test for '>' token 6A76 C000 1643 6A78 1604 JNE LT10 Jump if not 1644 6A7A 0642 DECT R2 Therefore, NOT-EQUAL code 99/4 ASSEMBLER PARSES2 PAGE 0036 1645 6A7C 1005 JMP LT15 Jump to common 1646 6A80 C4 EQU $+2 Constant 4 1647 6A7E 0202 GREATR LI R2,4 GREATER-THEN code for common 6A80 0004 1648 6A82 0288 LT10 CI R8,EQZ*256 Test for '=' token 6A84 BE00 1649 6A86 1605 JNE LTST01 Jump if '>=' 1650 6A88 06A0 LT15 BL @PGMCHR Must be plain old '>' or '<' 6A8A 6C74 1651 6A8C 1001 JMP LEDLE Jump to test 1652 6A8E 0702 EQUALS SETO R2 Equal bit for common routine 1653 6A90 0582 LEDLE INC R2 Sets to zero 1654 6A92 05C9 LTST01 INCT R9 Get room on stack for code 1655 6A94 C642 MOV R2,*R9 Save status matching code 1656 6A96 06A0 BL @PSHPRS Push 1st arg and PARSE the 2nd 6A98 6B9C 1657 6A9A C0 BYTE GTZ Parse to a '>' 1658 6A9B 69 CBH69 BYTE >69 Used in RETURN routine 1659 6A9C C119 MOV *R9,R4 Get the type code from stack 1660 6A9E 0649 DECT R9 Reset subroutine stack pointer 1661 6AA0 D324 MOVB @LTSTAB(R4),R12 Get address bias to baranch to 6AA2 6ADA 1662 6AA4 088C SRA R12,8 Right justify 1663 6AA6 06A0 BL @ARGTST Test for matching arguments 6AA8 6B6E 1664 6AAA 131A JEQ LTST20 Handle strings specially 1665 6AAC 06A0 BL @SCOMPB Floating point comparison 6AAE 0D42 1666 6AB0 046C LTST15 B @LTSTXX(R12) Interpret the status by code 6AB2 6AB4 1667 6AB4 LTSTXX EQU $ 1668 6AB4 1504 LTSTGE JGT LTRUE Test if GREATER or EQUAL 1669 6AB6 1303 LTSTEQ JEQ LTRUE Test if EQUAL 1670 6AB8 04C4 LFALSE CLR R4 FALSE is a ZERO 1671 6ABA 1003 JMP LTST90 Put it into FAC 1672 6ABC 13FD LTSTNE JEQ LFALSE Test if NOT-EQUAL 1673 6ABE 0204 LTRUE LI R4,>BFFF TRUE is a minus-one 6AC0 BFFF 1674 6AC2 0203 LTST90 LI R3,FAC Store result in FAC 6AC4 834A 1675 6AC6 CCC4 MOV R4,*R3+ Exp & 1st byte of manitissa 1676 6AC8 04F3 CLR *R3+ ZERO the remaining digits 1677 6ACA 04F3 CLR *R3+ ZERO the remaining digits 1678 6ACC 04F3 CLR *R3+ ZERO the remaining digits 1679 6ACE 1039 JMP LEDEND Jump to end of LED routine 1680 6AD0 13F6 LTSTLE JEQ LTRUE Test LESS-THAN or EQUAL 1681 6AD2 11F5 LTSTLT JLT LTRUE Test LESS-THEN 1682 6AD4 10F1 JMP LFALSE Jump to false 1683 6AD6 15F3 LTSTGT JGT LTRUE Test GREATER-THAN 1684 6AD8 10EF JMP LFALSE Jump to false 1685 * Data table for offsets for types 1686 6ADA 02 LTSTAB BYTE LTSTEQ-LTSTXX EQUAL (0) 1687 6ADB 08 BYTE LTSTNE-LTSTXX NOT EQUAL (1) 1688 6ADC 1E BYTE LTSTLT-LTSTXX LESS THEN (2) 1689 6ADD 1C BYTE LTSTLE-LTSTXX LESS or EQUAL (3) 1690 6ADE 22 BYTE LTSTGT-LTSTXX GREATER THEN (4) 1691 6ADF 00 BYTE LTSTGE-LTSTXX GREATER or EQUAL (5) 1692 6AE0 C2A0 LTST20 MOV @FAC4,R10 Pointer to string1 6AE2 834E 99/4 ASSEMBLER PARSES2 PAGE 0037 1693 6AE4 D1E0 MOVB @FAC7,R7 R7 = string2 length 6AE6 8351 1694 6AE8 06A0 BL @VPOP Get LH arg back 6AEA 6C2A 1695 6AEC C120 MOV @FAC4,R4 Pointer to string2 6AEE 834E 1696 6AF0 D1A0 MOVB @FAC7,R6 R6 = string2 length 6AF2 8351 1697 6AF4 D146 MOVB R6,R5 R5 will contain shorter length 1698 6AF6 91C6 CB R6,R7 Compare the 2 lengths 1699 6AF8 1101 JLT CSTR05 Jump if length2 < length1 1700 6AFA D147 MOVB R7,R5 Swap if length1 > length2 1701 6AFC 0985 CSTR05 SRL R5,8 Shift for speed and test zero 1702 6AFE 130D JEQ CSTR20 If ZERO-set status with length 1703 6B00 C0CA CSTR10 MOV R10,R3 Current character location 1704 6B02 058A INC R10 Increment pointer 1705 6B04 06A0 BL @GETV1 Get from VDP 6B06 1880 1706 6B08 D001 MOVB R1,R0 And save for comparison 1707 6B0A C0C4 MOV R4,R3 Current char location in ARG 1708 6B0C 0584 INC R4 Increment pointer 1709 6B0E 06A0 BL @GETV1 Get from VDP 6B10 1880 1710 6B12 9001 CB R1,R0 Compare the characters 1711 6B14 16CD JNE LTST15 Return with status if <> 1712 6B16 0605 DEC R5 Otherwise, decrement counter 1713 6B18 15F3 JGT CSTR10 And loop for each character 1714 6B1A 91C6 CSTR20 CB R6,R7 Status set by length compare 1715 6B1C 10C9 JMP LTST15 Return to do test of status 1716 * ARITHMETIC FUNCTIONS 1717 6B1E 06A0 PLUS BL @PSHPRS Push left arg and PARSE right 6B20 6B9C 1718 6B22 C2 BYTE MINUSZ,0 Stop on a minus!!!!!!!!!!!!!!! 6B23 00 1719 6B24 0202 LI R2,SADD Address of add routine 6B26 0D84 1720 6B28 04E0 LEDEX CLR @FAC10 Clear error code 6B2A 8354 1721 6B2C 06A0 BL @ARGTST Make sure both numerics 6B2E 6B6E 1722 6B30 132E JEQ ARGT05 If strings, error 1723 6B32 06A0 BL @SAVREG Save registers 6B34 1E8C 1724 6B36 0692 BL *R2 Do the operation 1725 6B38 06A0 BL @SETREG Restore registers 6B3A 1E7A 1726 6B3C D0A0 MOVB @FAC10,R2 Test for overflow 6B3E 8354 1727 6B40 1602 JNE LEDERR If overflow ->error 1728 6B42 0460 LEDEND B @CONT Continue the PARSE 6B44 64C8 1729 6B46 0460 LEDERR B @WARNZZ Overflow - issue warning 6B48 6662 1730 6B4A 06A0 MINUS BL @PSHPRS Push left arg and PARSE right 6B4C 6B9C 1731 6B4E C2 BYTE MINUSZ,0 Parse to a minus 6B4F 00 1732 6B50 0202 LI R2,SSUB Address of subtract routine 6B52 0D74 99/4 ASSEMBLER PARSES2 PAGE 0038 1733 6B54 10E9 JMP LEDEX Common code for the operation 1734 6B56 06A0 TIMES BL @PSHPRS Push left arg and PARSE right 6B58 6B9C 1735 6B5A C4 BYTE DIVIZ,0 Parse to a divide!!!!!!!!!!!!! 6B5B 00 1736 6B5C 0202 LI R2,SMULT Address of multiply routine 6B5E 0E8C 1737 6B60 10E3 JMP LEDEX Common code for the operation 1738 6B62 06A0 DIVIDE BL @PSHPRS Push left arg and PARSE right 6B64 6B9C 1739 6B66 C4 BYTE DIVIZ,0 Parse to a divide 6B67 00 1740 6B68 0202 LI R2,SDIV Address of divide routine 6B6A 0FF8 1741 6B6C 10DD JMP LEDEX Common code for the operation 1742 ************************************************************ 1743 * Test arguments on both the stack and in the FAC 1744 * Both must be of the same type 1745 * CALL: 1746 * BL @ARGTST 1747 * JEQ If string 1748 * JNE If numeric 1749 ************************************************************ 1750 6B6E C1A0 ARGTST MOV @VSPTR,R6 Get stack pointer 6B70 836E 1751 6B72 05C6 INCT R6 1752 6B74 D7E0 MOVB @R6LB,*R15 Load 2nd byte of stack address 6B76 83ED 1753 6B78 1000 NOP Kill some time 1754 6B7A D7C6 MOVB R6,*R15 Load 1st byte of stack address 1755 6B7C 1000 NOP Kill some time 1756 6B7E 9820 CB @XVDPRD,@CBH65 String in operand 1? 6B80 8800 6B82 65A7 1757 6B84 1606 JNE ARGT10 No, numeric 1758 6B86 9820 CB @FAC2,@CBH65 Yes, is other the same? 6B88 834C 6B8A 65A7 1759 6B8C 1306 JEQ ARGT20 Yes, do string comparison 1760 6B8E 0460 ARGT05 B @ERRT Data types don't match 6B90 630C 1761 NUMCHK 1762 6B92 9820 ARGT10 CB @FAC2,@CBH65 2nd operand can't be string 6B94 834C 6B96 65A7 1763 6B98 13FA JEQ ARGT05 If so, error 1764 6B9A 045B ARGT20 RT Ok, so return with status 1765 * VPUSH followed by a PARSE 1766 6B9C 05C9 PSHPRS INCT R9 Get room on stack 1767 6B9E 0289 CI R9,STKEND Stack full? 6BA0 83BA 1768 6BA2 1B41 JH VPSH27 Yes, error 1769 6BA4 C64B MOV R11,*R9 Save return on stack 1770 6BA6 020B LI R11,P05 Optimize for the parse 6BA8 648A 1771 * Stack VPUSH routine 1772 6BAA 0200 VPUSH LI R0,8 Pushing 8 byte entries 6BAC 0008 1773 6BAE A800 A R0,@VSPTR Update the pointer 99/4 ASSEMBLER PARSES2 PAGE 0039 6BB0 836E 1774 6BB2 C060 MOV @VSPTR,R1 Now get the new pointer 6BB4 836E 1775 6BB6 D7E0 MOVB @R1LB,*R15 Write new address to VDP chip 6BB8 83E3 1776 6BBA 0261 ORI R1,WRVDP Enable the write 6BBC 4000 1777 6BBE D7C1 MOVB R1,*R15 Write 1st byte of address 1778 6BC0 0201 LI R1,FAC Source is FAC 6BC2 834A 1779 6BC4 D831 VPSH15 MOVB *R1+,@XVDPWD Move a byte 6BC6 8C00 1780 6BC8 0600 DEC R0 Decrement the count, done? 1781 6BCA 15FC JGT VPSH15 No, more to move 1782 6BCC C00B MOV R11,R0 Save the return address 1783 6BCE 9820 CB @FAC2,@CBH65 Pushing a string entry? 6BD0 834C 6BD2 65A7 1784 6BD4 160E JNE VPSH20 No, so done 1785 6BD6 C1A0 MOV @VSPTR,R6 Entry on stack 6BD8 836E 1786 6BDA 0226 AI R6,4 Pointer to the string is here 6BDC 0004 1787 6BDE C060 MOV @FAC,R1 Get the string's owner 6BE0 834A 1788 6BE2 0281 CI R1,>001C Is it a tempory string? 6BE4 001C 1789 6BE6 1605 JNE VPSH20 No, so done 1790 6BE8 C060 VPSH19 MOV @FAC4,R1 Get the address of the string 6BEA 834E 1791 6BEC 1302 JEQ VPSH20 If null string, nothing to do 1792 6BEE 06A0 BL @STVDP3 Set the backpointer 6BF0 18AA 1793 6BF2 C060 VPSH20 MOV @VSPTR,R1 Check for buffer-zone 6BF4 836E 1794 6BF8 C16 EQU $+2 1795 6BF6 0221 AI R1,16 Correct by 16 6BF8 0010 1796 6BFA 8801 C R1,@STREND At least 16 bytes between stac 6BFC 831A 1797 * and string space? 1798 6BFE 1236 JLE VPOP18 Yes, so ok 1799 6C00 05C9 INCT R9 No, save return address 1800 6C02 C640 MOV R0,*R9 on stack 1801 6C04 06A0 BL @COMPCT Do the garbage collection 6C06 73D8 1802 6C08 C019 MOV *R9,R0 Restore return address 1803 6C0A 0649 DECT R9 Fix subroutine stack pointer 1804 6C0C C060 MOV @VSPTR,R1 Get value stack pointer 6C0E 836E 1805 6C10 0221 AI R1,16 Buffer zone 6C12 0010 1806 6C14 8801 C R1,@STREND At least 16 bytes now? 6C16 831A 1807 6C18 1229 JLE VPOP18 Yes, so ok 1808 6C1A 0200 VPSH23 LI R0,ERROM No, so MEMORY FULL error 6C1C 0103 1809 6C1E 06A0 VPSH25 BL @SETREG In case of GPL call 6C20 1E7A 99/4 ASSEMBLER PARSES2 PAGE 0040 1810 6C22 0460 B @ERR 6C24 6652 1811 6C26 0460 VPSH27 B @ERRSO STACK OVERFLOW 6C28 6468 1812 * Stack VPOP routine 1813 6C2A 0202 VPOP LI R2,FAC Destination in FAC 6C2C 834A 1814 6C2E C060 MOV @VSPTR,R1 Get stack pointer 6C30 836E 1815 6C32 8801 C R1,@STVSPT Check for stack underflow 6C34 8324 1816 6C36 121B JLE VPOP20 Yes, error 1817 6C38 D7E0 MOVB @R1LB,*R15 Write 2nd byte of address 6C3A 83E3 1818 6C3C 0200 LI R0,8 Popping 8 bytes 6C3E 0008 1819 6C40 D7C1 MOVB R1,*R15 Write 1st byte of address 1820 6C42 6800 S R0,@VSPTR Adjust stack pointer 6C44 836E 1821 6C46 DCA0 VPOP10 MOVB @XVDPRD,*R2+ Move a byte 6C48 8800 1822 6C4A 0600 DEC R0 Decrement the counter, done? 1823 6C4C 15FC JGT VPOP10 No, finish the work 1824 6C4E C00B MOV R11,R0 Save return address 1825 6C50 9820 CB @FAC2,@CBH65 Pop a string? 6C52 834C 6C54 65A7 1826 6C56 160A JNE VPOP18 No, so done 1827 6C58 04C6 CLR R6 For backpointer clear 1828 6C5A C0E0 MOV @FAC,R3 Get string owner 6C5C 834A 1829 6C5E 0283 CI R3,>001C Pop a temporary? 6C60 001C 1830 6C62 13C2 JEQ VPSH19 Yes, must free it 1831 6C64 06A0 BL @GET1 No, get new pointer from s.t. 6C66 6C9E 1832 6C68 C801 MOV R1,@FAC4 Set new pointer to string 6C6A 834E 1833 6C6C 0450 VPOP18 B *R0 And return 1834 6C6E 0200 VPOP20 LI R0,ERREX * SYNTAX ERROR 6C70 0403 1835 6C72 10D5 JMP VPSH25 1836 * The returned status reflects the character 1837 * RAMFLG = >00 | No ERAM or imperative statements 1838 * >FF | With ERAM and a program is being run 1839 6C74 D220 PGMCHR MOVB @RAMFLG,R8 Test ERAM flag 6C76 8389 1840 6C78 160A JNE PGMC10 ERAM and a program is being ru 1841 * Next label is for entry from SUBPROG. 1842 6C7A D7E0 PGMSUB MOVB @PGMPT1,*R15 Write 2nd byte of address 6C7C 832D 1843 6C7E 020A LI R10,XVDPRD Read data address 6C80 8800 1844 6C82 D7E0 MOVB @PGMPTR,*R15 Write 1st byte of address 6C84 832C 1845 6C86 05A0 INC @PGMPTR Increment the perm pointer 6C88 832C 1846 6C8A D21A MOVB *R10,R8 Read the character 1847 6C8C 045B RT And return 99/4 ASSEMBLER PARSES2 PAGE 0041 1848 6C8E C2A0 PGMC10 MOV @PGMPTR,R10 6C90 832C 1849 6C92 05A0 INC @PGMPTR 6C94 832C 1850 6C96 D23A MOVB *R10+,R8 Write 2nd byte of a address 1851 6C98 045B RT 1852 ************************************************************ 1853 6C9A AORG >6C9A 1855 1856 * (VDP to VDP) or (RAM to RAM) 1857 * GET,GET1 : Get two bytes of data from VDP 1858 * : R3 : address in VDP 1859 * : R1 : where the one byte data stored 1860 * PUT1 : Put two bytes of data into VDP 1861 * : R4 : address on VDP 1862 * : R1 : data 1863 * GETG,GETG2 : Get two bytes of data from ERAM 1864 * : R3 : address on ERAM 1865 * : R1 : where the two byte data stored 1866 * PUTG2 : Put two bytes of data into ERAM 1867 * : R4 : address on ERAM 1868 * : R1 : data 1869 * PUTVG1 : Put one byte of data into ERAM 1870 * : R4 : address in ERAM 1871 * : R1 : data 1872 1873 * Get two bytes from RAM(R3) into R1 1874 6C9A C0FB GET MOV *R11+,R3 1875 6C9C C0D3 MOV *R3,R3 1876 6C9E D7E0 GET1 MOVB @R3LB,*R15 6CA0 83E7 1877 6CA2 D7C3 MOVB R3,*R15 1878 6CA4 1000 NOP 1879 6CA6 D060 MOVB @XVDPRD,R1 6CA8 8800 1880 6CAA D820 MOVB @XVDPRD,@R1LB 6CAC 8800 6CAE 83E3 1881 6CB0 045B RT 1882 * Put two bytes from R1 to RAM(R4) 1883 6CB2 D7E0 PUT1 MOVB @R4LB,*R15 6CB4 83E9 1884 6CB6 0264 ORI R4,WRVDP 6CB8 4000 1885 6CBA D7C4 MOVB R4,*R15 1886 6CBC 1000 NOP 1887 6CBE D801 MOVB R1,@XVDPWD 6CC0 8C00 1888 6CC2 D820 MOVB @R1LB,@XVDPWD 6CC4 83E3 6CC6 8C00 1889 6CC8 045B RT 1890 * Get two bytes from ERAM(R3) to R1 1891 6CCA C0FB GETG MOV *R11+,R3 1892 6CCC C0D3 MOV *R3,R3 1893 6CCE GETG2 EQU $ 1894 6CCE D073 MOVB *R3+,R1 1895 6CD0 D813 MOVB *R3,@R1LB 6CD2 83E3 99/4 ASSEMBLER GETPUTS PAGE 0042 1896 6CD4 0603 DEC R3 1897 6CD6 045B RT 1898 * Put two bytes from R1 to ERAM(R4) 1899 6CD8 PUTG2 EQU $ 1900 6CD8 DD01 MOVB R1,*R4+ 1901 6CDA D520 MOVB @R1LB,*R4 6CDC 83E3 1902 6CDE 0604 DEC R4 Preserve R4 1903 6CE0 045B RT 1904 ************************************************************ 1905 1906 6CE2 AORG >6CE2 1908 1909 6CE2 9820 LEXP CB @FAC2,@CBH63 Must have a numeric 6CE4 834C 6CE6 6D05 1910 6CE8 1B39 JH ERRSNM Don't, so error 1911 6CEA 06A0 BL @PSHPRS Push 1st and parse 2nd 6CEC 6B9C 1912 6CEE C5 BYTE EXPONZ,0 Up to another wxpon or less 6CEF 00 1913 6CF0 06A0 BL @STKCHK Make sure room on stack 6CF2 6DC0 1914 6CF4 0202 LI R2,PWRZZ Address of power routine 6CF6 7492 1915 6CF8 1049 JMP COMM05 Jump into common routine 1916 * ABS 1917 6CFA 0288 NABS CI R8,LPARZ*256 Must have a left parenthesis 6CFC B700 1918 6CFE 1630 JNE SYNERR If not, error 1919 6D00 06A0 BL @PARSE Parse the argument 6D02 6480 1920 6D04 CB BYTE ABSZ Up to another ABS 1921 6D05 63 CBH63 BYTE >63 Use the wasted byte 1922 6D06 9820 CB @FAC2,@CBH63 Must have numeric arg 6D08 834C 6D0A 6D05 1923 6D0C 1B27 JH ERRSNM If not, error 1924 6D0E 0760 ABS @FAC Take the absolute value 6D10 834A 1925 6D12 0460 BCONT B @CONT And continue 6D14 64C8 1926 * ATN 1927 6D16 0202 NATN LI R2,ATNZZ Load up arctan address 6D18 797C 1928 6D1A 102C JMP COMMON Jump into common rountine 1929 * COS 1930 6D1C 0202 NCOS LI R2,COSZZ Load up cosine address 6D1E 78B2 1931 6D20 1029 JMP COMMON Jump into common routine 1932 * EXP 1933 6D22 0202 NEXP LI R2,EXPZZ Load up exponential address 6D24 75CA 1934 6D26 1026 JMP COMMON Jump into common routine 1935 * INT 1936 6D28 0202 NINT LI R2,GRINT Load up greatest integer addre 6D2A 79EC 1937 6D2C 1023 JMP COMMON Jump into common routine 1938 * LOG 99/4 ASSEMBLER NUD359 PAGE 0043 1939 6D2E 0202 NLOG LI R2,LOGZZ Load up logarithm code 6D30 76C2 1940 6D32 1020 JMP COMMON Jump to common routine 1941 * SGN 1942 6D34 0288 NSGN CI R8,LPARZ*256 Must have left parenthesis 6D36 B700 1943 6D38 1613 JNE SYNERR If not, error 1944 6D3A 06A0 BL @PARSE Parse the argument 6D3C 6480 1945 6D3E D1 BYTE SGNZ,0 Up to another SGN 6D3F 00 1946 6D40 9820 CB @FAC2,@CBH63 Must have a numeric arg 6D42 834C 6D44 6D05 1947 6D46 1B0A JH ERRSNM If not, error 1948 6D48 0204 LI R4,>4001 Floating point one 6D4A 4001 1949 6D4C C020 MOV @FAC,R0 Check status 6D4E 834A 1950 6D50 13E0 JEQ BCONT If 0, return 0 1951 6D52 1502 JGT BLTST9 If positive, return +1 1952 6D54 0460 B @LTRUE If negative, return -1 6D56 6ABE 1953 6D58 0460 BLTST9 B @LTST90 Sets up the FAC w/R4 and 0s 6D5A 6AC2 1954 6D5C 0460 ERRSNM B @ERRT STRING-NUMBER MISMATCH 6D5E 630C 1955 6D60 0460 SYNERR B @ERRONE SYNTAX ERROR 6D62 664E 1956 * SIN 1957 6D64 0202 NSIN LI R2,SINZZ Load up sine address 6D66 78C0 1958 6D68 1005 JMP COMMON Jump into common routine 1959 * SQR 1960 6D6A 0202 NSQR LI R2,SQRZZ Load up square-root address 6D6C 783A 1961 6D6E 1002 JMP COMMON Jump into common routine 1962 * TAN 1963 6D70 0202 NTAN LI R2,TANZZ Load up tangent address 6D72 7940 1964 6D74 06A0 COMMON BL @STKCHK Make sure room on stacks 6D76 6DC0 1965 6D78 0288 CI R8,LPARZ*256 Must have left parenthesis 6D7A B700 1966 6D7C 16F1 JNE SYNERR If not, error 1967 6D7E 05C9 INCT R9 Get space on subroutine stack 1968 6D80 C642 MOV R2,*R9 Put address of routine on stac 1969 6D82 06A0 BL @PARSE Parse the argument 6D84 6480 1970 6D86 FF BYTE >FF,0 To end of the arg 6D87 00 1971 6D88 C099 MOV *R9,R2 Get address of function back 1972 6D8A 0649 DECT R9 Decrement subroutine stack 1973 6D8C 9820 COMM05 CB @FAC2,@CBH63 Must have a numeric arg 6D8E 834C 6D90 6D05 1974 6D92 1BE4 JH ERRSNM If not, error 1975 6D94 04E0 CLR @FAC10 Assume no error or warning 6D96 8354 99/4 ASSEMBLER NUD359 PAGE 0044 1976 6D98 06A0 BL @SAVREG Save Basic registers 6D9A 1E8C 1977 6D9C C802 MOV R2,@PAGE2 Select page 2 6D9E 6002 1978 6DA0 0692 BL *R2 Evaluate the function 1979 6DA2 C802 MOV R2,@PAGE1 Reselect Page 1 6DA4 6000 1980 6DA6 06A0 BL @SETREG Set registers up again 6DA8 1E7A 1981 6DAA D020 MOVB @FAC10,R0 Check for error or warning 6DAC 8354 1982 6DAE 13B1 JEQ BCONT If not error, continue 1983 6DB0 0990 SRL R0,9 Check for warning 1984 6DB2 1304 JEQ PWARN Warning, issue it 1985 6DB4 0200 LI R0,>0803 BAD ARGUMENT code 6DB6 0803 1986 6DB8 0460 B @ERR 6DBA 6652 1987 6DBC 0460 PWARN B @WARNZZ Issue the warning message 6DBE 6662 1988 6DC0 0289 STKCHK CI R9,STND12 Enough room on the subr stack? 6DC2 83AE 1989 6DC4 1B18 JH BSO No, memory full error 1990 6DC6 C020 MOV @VSPTR,R0 Get the value stack pointer 6DC8 836E 1991 6DCA 0220 AI R0,48 Buffer-zone of 48 bytes 6DCC 0030 1992 6DCE 8800 C R0,@STREND Room between stack & strings 6DD0 831A 1993 6DD2 1A0E JL STKRTN Yes, return 1994 6DD4 05C9 INCT R9 Get space on subr stack 1995 6DD6 CE4B MOV R11,*R9+ Save return address 1996 6DD8 CE42 MOV R2,*R9+ Save COMMON function code 1997 6DDA C640 MOV R0,*R9 Save v-stack pointer+48 1998 6DDC 06A0 BL @COMPCT Do a garbage collection 6DDE 73D8 1999 6DE0 8819 C *R9,@STREND Enough space now? 6DE2 831A 2000 6DE4 1406 JHE BMF No, MEMORY FULL error 2001 6DE6 0649 DECT R9 Decrement stack pointer 2002 6DE8 C099 MOV *R9,R2 Restore COMMON function code 2003 6DEA 0649 DECT R9 Decrement stack pointer 2004 6DEC C2D9 RETRN MOV *R9,R11 Restore return address 2005 6DEE 0649 DECT R9 Decrement stack pointer 2006 6DF0 045B STKRTN RT 2007 6DF2 0460 BMF B @VPSH23 * MEMORY FULL 6DF4 6C1A 2008 6DF6 0460 BSO B @ERRSO * STACK OVERFLOW 6DF8 6468 2009 ************************************************************ 2010 * LED routine for AND, OR, NOT, and XOR 2011 ************************************************************ 2012 6DFA 06A0 O0AND BL @PSHPRS Push L.H. and PARSE R.H. 6DFC 6B9C 2013 6DFE BB BYTE ANDZ,0 Stop on AND or less 6DFF 00 2014 6E00 06A0 BL @CONVRT Convert both to integers 6E02 6E9E 2015 6E04 0560 INV @FAC Complement L.H. 99/4 ASSEMBLER NUD359 PAGE 0045 6E06 834A 2016 6E08 4820 SZC @FAC,@ARG Perform the AND 6E0A 834A 6E0C 835C 2017 6E0E C820 O0AND1 MOV @ARG,@FAC Put back in FAC 6E10 835C 6E12 834A 2018 6E14 06A0 O0AND2 BL @CIF Convert back to floating 6E16 74AA 2019 6E18 0460 B @CONT Continue 6E1A 64C8 2020 6E1C 06A0 O0OR BL @PSHPRS Push L.H. and PARSE R.H. 6E1E 6B9C 2021 6E20 BA BYTE ORZ,0 Stop on OR or less 6E21 00 2022 6E22 06A0 BL @CONVRT Convert both to integers 6E24 6E9E 2023 6E26 E820 SOC @FAC,@ARG Perform the OR 6E28 834A 6E2A 835C 2024 6E2C 10F0 JMP O0AND1 Convert to floating and done 2025 6E2E 06A0 O0NOT BL @PARSE Parse the arg 6E30 6480 2026 6E32 BD BYTE NOTZ,0 Stop on NOT or less 6E33 00 2027 6E34 9820 CB @FAC2,@CBH63 Get a numeric back? 6E36 834C 6E38 6D05 2028 6E3A 1B49 JH ERRSN1 No, error 2029 6E3C 04E0 CLR @FAC10 Clear for CFI 6E3E 8354 2030 6E40 06A0 BL @CFI Convert to Integer 6E42 12B8 2031 6E44 D020 MOVB @FAC10,R0 Check for an error 6E46 8354 2032 6E48 168B JNE SYNERR Error 2033 6E4A 0560 INV @FAC Perform the NOT 6E4C 834A 2034 6E4E 10E2 JMP O0AND2 Convert to floating and done 2035 6E50 06A0 O0XOR BL @PSHPRS Push L.H. and PARSE R.H. 6E52 6B9C 2036 6E54 BC BYTE XORZ,0 Stop on XOR or less 6E55 00 2037 6E56 06A0 BL @CONVRT Convert both to integer 6E58 6E9E 2038 6E5A C020 MOV @ARG,R0 Get R.H. into register 6E5C 835C 2039 6E5E 2820 XOR @FAC,R0 Do the XOR 6E60 834A 2040 6E62 C800 MOV R0,@FAC Put result back in FAC 6E64 834A 2041 6E66 10D6 JMP O0AND2 Convert and continue 2042 ************************************************************ 2043 * NUD for left parenthesis 2044 ************************************************************ 2045 6E68 0288 NLPR CI R8,RPARZ*256 Have a right paren already? 6E6A B600 2046 6E6C 1332 JEQ ERRSY1 If so, syntax error 2047 6E6E 06A0 BL @PARSE Parse inside the parenthesises 99/4 ASSEMBLER NUD359 PAGE 0046 6E70 6480 2048 6E72 B7 BYTE LPARZ,0 Up to left parenthesis or less 6E73 00 2049 6E74 0288 CI R8,RPARZ*256 Have a right parenthesis now? 6E76 B600 2050 6E78 162C JNE ERRSY1 No, so error 2051 6E7A 06A0 BL @PGMCHR Get next token 6E7C 6C74 2052 6E7E 0460 BCON1 B @CONT And continue 6E80 64C8 2053 ************************************************************ 2054 * NUD for unary minus 2055 ************************************************************ 2056 6E82 06A0 NMINUS BL @PARSE Parse the expression 6E84 6480 2057 6E86 C2 BYTE MINUSZ,0 Up to another minus 6E87 00 2058 6E88 0520 NEG @FAC Make it negative 6E8A 834A 2059 6E8C 9820 NMIN10 CB @FAC2,@CBH63 Must have a numeric 6E8E 834C 6E90 6D05 2060 6E92 1B1D JH ERRSN1 If not, error 2061 6E94 10F4 JMP BCON1 Continue 2062 ************************************************************ 2063 * NUD for unary plus 2064 ************************************************************ 2065 6E96 06A0 NPLUS BL @PARSE Parse the expression 6E98 6480 2066 6E9A C1 BYTE PLUSZ,0 6E9B 00 2067 6E9C 10F7 JMP NMIN10 Use common code 2068 ************************************************************ 2069 * CONVRT - Takes two arguments, 1 form FAC and 1 from the 2070 * top of the stack and converts them to integer 2071 * from floating point, issuing appropriate errors 2072 ************************************************************ 2073 6E9E 05C9 CONVRT INCT R9 2074 6EA0 C64B MOV R11,*R9 SAVE RTN ADDRESS 2075 6EA2 06A0 BL @ARGTST ARGS MUST BE SAME TYPE 6EA4 6B6E 2076 6EA6 1313 JEQ ERRSN1 AND NON-STRING 2077 6EA8 04E0 CLR @FAC10 FOR CFI ERROR CODE 6EAA 8354 2078 6EAC 06A0 BL @CFI CONVERT R.H. ARG 6EAE 12B8 2079 6EB0 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EB2 8354 2080 6EB4 160A JNE ERRBV YES 2081 6EB6 C820 MOV @FAC,@ARG MOVE TO GET L.H. ARG 6EB8 834A 6EBA 835C 2082 6EBC 06A0 BL @VPOP GET L.H. BACK 6EBE 6C2A 2083 6EC0 06A0 BL @CFI CONVERT L.H. 6EC2 12B8 2084 6EC4 D020 MOVB @FAC10,R0 ANY ERROR OR WARNING? 6EC6 8354 2085 6EC8 1391 JEQ RETRN No, get rtn off stack and rtn 99/4 ASSEMBLER NUD359 PAGE 0047 2086 * Yes, issue error 2087 6ECA 0460 ERRBV B @GOTO90 BAD VALUE 6ECC 670A 2088 6ECE 0460 ERRSN1 B @ERRT STRING NUMBER MISMATCH 6ED0 630C 2089 6ED2 0460 ERRSY1 B @ERRONE SYNTAX ERROR 6ED4 664E 2090 ************************************************************ 2091 6ED6 AORG >6ED6 2093 2094 2095 6ED6 0460 BSYNCH B @SYNCHK 6ED8 6400 2096 6EDA 0460 BERSYN B @ERRSYN 6EDC 664E 2097 6EDE 0460 BERSNM B @ERRT 6EE0 630C 2098 6EE2 D01D SPEED MOVB *R13,R0 Read XML code 2099 6EE4 0980 SRL R0,8 Shift for word value 2100 6EE6 13F7 JEQ BSYNCH 0 is index for SYNCHK 2101 6EE8 0600 DEC R0 Not SYNCHK, check further 2102 6EEA 1344 JEQ PARCOM 1 is index for PARCOM 2103 6EEC 0600 DEC R0 Not PARCOM, check further 2104 6EEE 1320 JEQ RANGE 2 is index for RANGE 2105 * All otheres assumed to be SEETWO 2106 ************************************************************ 2107 * Find the line specified by the number in FAC 2108 * Searches the table from low address (high number) to 2109 * high address (low number). 2110 ************************************************************ 2111 6EF0 020A SEETWO LI R10,SET Assume number will be found 6EF2 6192 2112 6EF4 0207 LI R7,GET1 Assume reading from the VDP 6EF6 6C9E 2113 6EF8 D020 MOVB @RAMTOP,R0 But correct 6EFA 8384 2114 6EFC 1302 JEQ SEETW2 If 2115 6EFE 0207 LI R7,GETG2 ERAM is present 6F00 6CCE 2116 6F02 C0E0 SEETW2 MOV @ENLN,R3 Get point to start from 6F04 8332 2117 6F06 0223 AI R3,-3 Get into table 6F08 FFFD 2118 6F0A 0697 SEETW4 BL *R7 Read the number from table 2119 6F0C 0241 ANDI R1,>7FFF Throw away possible breakpoint 6F0E 7FFF 2120 6F10 8801 C R1,@FAC Match the number needed? 6F12 834A 2121 6F14 130A JEQ SEETW8 Yes, return with condition set 2122 6F16 1B07 JH SEETW6 No, and also passed it =>retur 2123 6F18 0223 AI R3,-4 No, but sitll might be there 6F1A FFFC 2124 6F1C 8803 C R3,@STLN Reached end of table? 6F1E 8330 2125 6F20 14F4 JHE SEETW4 No, so check further 2126 6F22 C0E0 MOV @STLN,R3 End of table, default to last 6F24 8330 2127 6F26 020A SEETW6 LI R10,RESET Indicate not found 6F28 006A 99/4 ASSEMBLER SPEEDS PAGE 0048 2128 6F2A C803 SEETW8 MOV R3,@EXTRAM Put pointer in for GPL 6F2C 832E 2129 6F2E 045A B *R10 Return with condition 2130 6F30 C30B RANGE MOV R11,R12 Save return address 2131 6F32 9820 CB @FAC2,@CBH63 Have a numeric 6F34 834C 6F36 6D05 2132 6F38 1BD2 JH BERSNM Otherwise string number mismat 2133 6F3A 04E0 CLR @FAC10 Assume no conversion error 6F3C 8354 2134 6F3E 06A0 BL @CFI Convert from float to integer 6F40 12B8 2135 6F42 D020 MOVB @FAC10,R0 Get an error? 6F44 8354 2136 6F46 160E JNE RANERR Yes, indicate it 2137 6F48 D01D MOVB *R13,R0 Read lower limit 2138 6F4A 0980 SRL R0,8 Shift for word compare 2139 6F4C D05D MOVB *R13,R1 Read 1st byte of upper limit 2140 6F4E 06C1 SWPB R1 Kill time 2141 6F50 D05D MOVB *R13,R1 Read 2nd byte of upper limit 2142 6F52 06C1 SWPB R1 Restore upper limit 2143 6F54 C0A0 MOV @FAC,R2 Get the value 6F56 834A 2144 6F58 1105 JLT RANERR If negative, error 2145 6F5A 8002 C R2,R0 Less then low limit? 2146 6F5C 1103 JLT RANERR Yes, error 2147 6F5E 8042 C R2,R1 Greater then limit? 2148 6F60 1B01 JH RANERR Yes, error 2149 6F62 045C B *R12 All ok, so return 2150 6F64 06A0 RANERR BL @SETREG Set up registers for error 6F66 1E7A 2151 6F68 0460 B @GOTO90 * BAD VALUE 6F6A 670A 2152 * Make sure at a left parenthesis 2153 6F6C 9820 LPAR CB @CHAT,@LBLPZ At a left parenthesis 6F6E 8342 6F70 6F81 2154 6F72 16B3 JNE BERSYN No, syntax error 2155 * Parse up to a comma and insure at a comma 2156 6F74 06A0 PARCOM BL @PUTSTK Save GROM address 6F76 60F2 2157 6F78 06A0 BL @SETREG Set up R8/R9 6F7A 1E7A 2158 6F7C 06A0 BL @PARSE Parse the next item 6F7E 6480 2159 6F80 B3 BYTE COMMAZ Up to a comma 2160 6F81 B7 LBLPZ BYTE LPARZ 2161 6F82 0288 CI R8,COMMAZ*256 End on a comma? 6F84 B300 2162 6F86 16A9 JNE BERSYN No, syntax error 2163 6F88 06A0 BL @PGMCHR Yes, get character after it 6F8A 6C74 2164 6F8C 06A0 BL @SAVREG Save R8/R9 for GPL 6F8E 1E8C 2165 6F90 06A0 BL @GETSTK Restore GROM address 6F92 610E 2166 6F94 0460 B @RESET Return to GPL reset 6F96 006A 2167 ************************************************************ 99/4 ASSEMBLER SPEEDS PAGE 0049 2168 6F98 AORG >6F98 2170 2171 * (RAM to RAM) 2172 * WITH ERAM : Move the contents in ERAM FROM a higher 2173 * address to a lower address 2174 * ARG : byte count 2175 * VAR9 : source address 2176 * VAR0 : destination address 2177 2178 6F98 C060 MVUP MOV @ARG,R1 Get byte count 6F9A 835C 2179 6F9C C0E0 MOV @VAR9,R3 Get source 6F9E 8316 2180 6FA0 C160 MOV @VAR0,R5 Get destination 6FA2 8300 2181 6FA4 DD73 MVUP05 MOVB *R3+,*R5+ Move a byte 2182 6FA6 0601 DEC R1 Decrement the counter 2183 6FA8 16FD JNE MVUP05 Loop if more to move 2184 6FAA 045B RT 2185 ************************************************************ 2186 2187 6FAC AORG >6FAC 2189 2190 * Get a non-space character 2191 6FAC C00B GETNB MOV R11,R0 Save return address 2192 6FAE 06A0 GETNB1 BL @GETCHR Get next character 6FB0 6FBA 2193 6FB2 0281 CI R1,' '*256 Space character? 6FB4 2000 2194 6FB6 13FB JEQ GETNB1 Yes, get next character 2195 6FB8 0450 B *R0 No, return character condition 2196 * Get the next character 2197 6FBA 8820 GETCHR C @VARW,@VARA End of line? 6FBC 8320 6FBE 832A 2198 6FC0 1B0E JH GETCH2 Yes, return condition 2199 6FC2 D7E0 MOVB @VARW1,*R15 No, write LSB of VDP address 6FC4 8321 2200 6FC6 0201 LI R1,>A000 Negative screen offset (->60) 6FC8 A000 2201 6FCA D7E0 MOVB @VARW,*R15 Write MSB of VDP address 6FCC 8320 2202 6FCE 05A0 INC @VARW Increment read-from pointer 6FD0 8320 2203 6FD2 B060 AB @XVDPRD,R1 Read and remove screen offset 6FD4 8800 2204 6FD6 0281 CI R1,>1F00 Read an edge character? 6FD8 1F00 2205 6FDA 13EF JEQ GETCHR Yes, skip it 2206 6FDC 045B RT Return 2207 6FDE 04C1 GETCH2 CLR R1 Indicate end of line 2208 6FE0 045B RT Return 2209 *----------------------------------------------------------- 2210 * Remove this routine from CRUNCH because CRUNCH is running 2211 * out of space 5/11/81 2212 *----------------------------------------------------------- 2213 * Calculate and put length of string/number into 2214 * length byte 2215 6FE2 C0CB LENGTH MOV R11,R3 Save retun address 99/4 ASSEMBLER GETNBS PAGE 0050 2216 6FE4 C020 MOV @RAMPTR,R0 Save current crunch pointer 6FE6 830A 2217 6FE8 C200 MOV R0,R8 Put into r8 for PUTCHR below 2218 6FEA 6205 S R5,R8 Calculate length of string 2219 6FEC 0608 DEC R8 RAMPTR is post-incremented 2220 6FEE C805 MOV R5,@RAMPTR Address of length byte 6FF0 830A 2221 6FF2 06A0 BL @PUTCHR Put the length in 6FF4 7F6E 2222 6FF6 C800 MOV R0,@RAMPTR Restore crunch pointer 6FF8 830A 2223 6FFA 0453 B *R3 And return 2224 * FILL IN BYTES OF MODULE WITH COPY OF ORIGINAL? 2225 6FFC 0000 DATA >0000 2226 6FFE EF71 DATA >EF71 ????? 2227 ************************************************************ 2228 7000 AORG >7000 2230 2231 ************************************************************ 2232 * FOR statement 2233 * Builds up a stack entry for the FOR statement. Checks the 2234 * syntax of a FOR statement and also checks to see if the 2235 * loop is executed at all. The loop is not executed if the 2236 * limit of the FOR is > then initial value and the step is 2237 * positive of the limit of the FOR is < then initial value 2238 * and the step is negative. 2239 * 2240 * A stack entry for a 'FOR' statement looks like: 2241 * 2242 * +-------------------------------------------------------+ 2243 * | PTR TO S.T. | >67 | | Value Space | BUFLEV | 2244 * | ENTRY | | | Pointer | | 2245 * | ------------------------------------------------------| 2246 * | FOR line # | FOR line | | 2247 * | table ptr | pointer | | 2248 * |-------------------------------------------------------| 2249 * | Increment Value | 2250 * |-------------------------------------------------------| 2251 * | Limit | 2252 * +-------------------------------------------------------+ 2253 ************************************************************ 2254 7000 D208 NFOR MOVB R8,R8 EOL? 2255 7002 1501 JGT NFOR1 If symbol name, ok 2256 7004 107C JMP ERRCDT If EOL or Token, error 2257 7006 06A0 NFOR1 BL @SYM Get pointer to s.t. entry 7008 6312 2258 700A 06A0 BL @GETV Get 1st byte of symbol 700C 187C 2259 700E 834A DATA FAC entry 2260 * 2261 7010 0241 ANDI R1,>C700 Check string, function & array 7012 C700 2262 7014 1670 JNE BERMUW If andy of the above, error 2263 7016 0288 CI R8,EQZ*256 Must have '=' 7018 BE00 2264 701A 1671 JNE ERRCDT If not, error 2265 701C 06A0 BL @SMB Get index's value space 701E 61DC 2266 7020 04E0 CLR @FAC2 Dummy entry ID on the stack 99/4 ASSEMBLER FORNEXTS PAGE 0051 7022 834C 2267 7024 C820 MOV @BUFLEV,@FAC6 Save buffer level 7026 8346 7028 8350 2268 * 2269 * Search stack for another FOR entry with the same loop 2270 * variable. If one is found, remove it. 2271 * 2272 702A C0E0 MOV @VSPTR,R3 Copy stack pointer 702C 836E 2273 * 2274 * See if end of stack 2275 702E 8803 NFOR1A C R3,@STVSPT Check stack underflow 7030 8324 2276 7032 1228 JLE NFOR1E Finished with stack scan 2277 * See if FOR entry 2278 7034 06A0 BL @GET1 Get pointer to s.t. entry 7036 6C9E 2279 7038 C001 MOV R1,R0 Move it to use later 2280 703A D060 MOVB @XVDPRD,R1 Read stack ID 703C 8800 2281 703E 9801 CB R1,@CBH67 Is stack entry a FOR? 7040 68AB 2282 7042 1606 JNE NFOR1B No, 8 byte regular entry 2283 * Compare loop variables 2284 7044 8800 C R0,@FAC Loop variables match? 7046 834A 2285 7048 1309 JEQ NFOR1C Yes 2286 704A 0223 AI R3,-32 Skip this FOR entry 704C FFE0 2287 704E 10EF JMP NFOR1A Loop 2288 7050 9801 NFOR1B CB R1,@CCBH6A Hit a subprogram entry? 7052 70AF 2289 7054 1317 JEQ NFOR1E Yes, don't scan anymore 2290 7056 0223 AI R3,-8 Skip 8 byte stack entry 7058 FFF8 2291 705A 10E9 JMP NFOR1A Loop 2292 * Found matching loop variable, move stack down 32 bytes 2293 705C C0A0 NFOR1C MOV @VSPTR,R2 Copy stack pointer 705E 836E 2294 7060 6083 S R3,R2 Calculate # of bytes to move 2295 7062 130D JEQ NFOR1D 0 bytes, skip move 2296 7064 C103 MOV R3,R4 Destination pointer 2297 7066 0224 AI R4,-24 Place to move to 7068 FFE8 2298 706C C8 EQU $+2 2299 706A 0223 AI R3,8 Point at entry above FOR entry 706C 0008 2300 706E 06A0 NFOR1F BL @GETV1 Get the byte 7070 1880 2301 7072 06A0 BL @PUTV1 Put the byte 7074 6422 2302 7076 0583 INC R3 Inc From pointer 2303 7078 0584 INC R4 Inc To pointer 2304 707A 0602 DEC R2 Decrement counter 2305 707C 16F8 JNE NFOR1F Loop if not done 2306 707E 6820 NFOR1D S @C32,@VSPTR Adjust top of stack 7080 7196 7082 836E 99/4 ASSEMBLER FORNEXTS PAGE 0052 2307 * Now put new FOR entry on stack 2308 7084 06A0 NFOR1E BL @VPUSH Reserve space for limit 7086 6BAA 2309 7088 06A0 BL @VPUSH increment, 708A 6BAA 2310 708C 06A0 BL @VPUSH and 2nd info entry 708E 6BAA 2311 7090 D820 MOVB @CBH67,@FAC2 FOR ID on stack 7092 68AB 7094 834C 2312 7096 06A0 BL @PGMCHR Get next character 7098 6C74 2313 709A 06A0 BL @PSHPRS Push symbol I.D. entry 709C 6B9C 2314 709E B1 BYTE TOZ Parse the initial value 2315 709F 63 CCBH63 BYTE >63 Wasted byte (CBH63) 2316 70A0 0288 CI R8,TOZ*256 TO? 70A2 B100 2317 70A4 162C JNE ERRCDT No, error 2318 70A6 06A0 BL @PGMCHR 70A8 6C74 2319 70AA 06A0 BL @PSHPRS Push initial and get limit 70AC 6B9C 2320 70AE B2 BYTE STEPZ 2321 70AF 6A CCBH6A BYTE >6A Wasted byte (CBA6A) 2322 70B0 9820 CB @CCBH63,@FAC2 If a string value 70B2 709F 70B4 834C 2323 70B6 1A1D JL BERR6 Its an error 2324 70B8 6820 S @C40,@VSPTR 70BA 6006 70BC 836E 2325 70BE 06A0 BL @VPUSH Push the limit 70C0 6BAA 2326 70C2 06A0 BL @EOSTMT At the end of statement? 70C4 6862 2327 70C6 131D JEQ NFOR2 Yes, default incr to 1 2328 70C8 0288 CI R8,STEPZ*256 STEP? 70CA B200 2329 70CC 1618 JNE ERRCDT No, Its an error 2330 70CE A820 A @C32,@VSPTR Corrrect stack pointer 70D0 7196 70D2 836E 2331 70D4 06A0 BL @PGMCHR 70D6 6C74 2332 70D8 06A0 BL @PARSE Get the increment 70DA 6480 2333 70DC 83 BYTE TREMZ,0 70DD 00 2334 70DE 6820 S @C32,@VSPTR Get stack to needed place 70E0 7196 70E2 836E 2335 70E4 C020 MOV @FAC,R0 Can't have zero increment 70E6 834A 2336 70E8 1308 JEQ ERRBV2 If 0, its an error 2337 70EA 9820 CB @CCBH63,@FAC2 Can't have zero increment 70EC 709F 70EE 834C 2338 70F0 140F JHE NFOR3 If numeric, ok 99/4 ASSEMBLER FORNEXTS PAGE 0053 2339 70F2 0460 BERR6 B @ERRT * STRING NUMBER MISMATCH 70F4 630C 2340 70F6 0460 BERMUW B @ERRMUV * MULTIPLY USED VARIABLE 70F8 6970 2341 70FA 0460 ERRBV2 B @GOTO90 70FC 670A 2342 70FE 0460 ERRCDT B @ERRSYN 7100 664E 2343 7102 0200 NFOR2 LI R0,FAC 7104 834A 2344 7106 CC20 MOV @FLTONE,*R0+ Put a floating one in 7108 600E 2345 710A 04F0 CLR *R0+ 2346 710C 04F0 CLR *R0+ 2347 710E 04D0 CLR *R0 2348 7110 06A0 NFOR3 BL @VPUSH Push the step 7112 6BAA 2349 7114 0201 LI R1,FAC Optimize to save bytes 7116 834A 2350 7118 CC60 MOV @EXTRAM,*R1+ Save line # pointer 711A 832E 2351 711C C460 MOV @PGMPTR,*R1 Save ptr w/in the line 711E 832C 2352 7120 0611 DEC *R1 Back up so get last character 2353 7122 06A0 BL @VPUSH Push it too! 7124 6BAA 2354 7126 A820 A @H16,@VSPTR Point to initial value 7128 7156 712A 836E 2355 712C 06A0 BL @VPOP Get initial value 712E 6C2A 2356 7130 06A0 BL @ASSG Assign it 7132 6334 2357 7134 A820 A @C8,@VSPTR Restore to top of entry 7136 706C 7138 836E 2358 * Check to see if execute loop at all 2359 713A 06A0 BL @VPOP Get ptr to value 713C 6C2A 2360 713E 06A0 BL @MOVFAC Get value 7140 6434 2361 7142 6820 S @H16,@VSPTR Point at limit 7144 7156 7146 836E 2362 7148 06A0 BL @SCOMPB Compare them 714A 0D42 2363 * VSPTR is now below the FOR entry 2364 714C 02C4 STST R4 Save the status 2365 714E 1309 JEQ NFOR03 IF = 2366 7150 C0E0 MOV @VSPTR,R3 7152 836E 2367 7156 H16 EQU $+2 2368 7154 0223 AI R3,16 7156 0010 2369 7158 06A0 BL @GETV1 Check negative step 715A 1880 2370 715C 1107 JLT NFOR05 If a decrement 2371 715E 0A14 SLA R4,1 Check out of limit 2372 7160 1507 JGT NFOR07 Out of limit 99/4 ASSEMBLER FORNEXTS PAGE 0054 2373 7162 A820 NFOR03 A @C32,@VSPTR Leave the entry on 7164 7196 7166 836E 2374 7168 0460 B @CONT <<<<<<< Result is w/in limit 716A 64C8 2375 716C 0A14 NFOR05 SLA R4,1 Check out of limit 2376 716E 15F9 JGT NFOR03 Result is w/in limit 2377 * Initial value is not within the limit. Therefore, the loop 2378 * is not executed at all. Must skip the code in the body of 2379 * the loop 2380 7170 0203 NFOR07 LI R3,1 FOR/NEXT pair counter 7172 0001 2381 7174 06A0 NFOR09 BL @EOLINE Check end of line 7176 6872 2382 7178 1338 JEQ NFOR13 Is end of line 2383 717A 06A0 BL @PGMCHR Get 1st token on line 717C 6C74 2384 717E 0288 NFOR10 CI R8,NEXTZ*256 If NEXT 7180 9600 2385 7182 1618 JNE NFOR11 If not 2386 7184 0603 DEC R3 Decrement counter 2387 7186 162B JNE NFOR12 If NOT matching next 2388 7188 06A0 BL @PGMCHR Get 1st char of loop variable 718A 6C74 2389 * Check is added in SYM 5/26/81 2390 * JLT ERRCDT If token 2391 718C 06A0 BL @SYM Get s.t. pointer to check matc 718E 6312 2392 7190 C0E0 MOV @VSPTR,R3 Correct to top of entry 7192 836E 2393 7196 C32 EQU $+2 2394 7194 0223 AI R3,32 7196 0020 2395 7198 06A0 BL @GET1 Get pointer 719A 6C9E 2396 719C 8801 C R1,@FAC Match? 719E 834A 2397 71A0 1605 JNE ERRFNN No match 2398 71A2 0460 B @CONT Continue <<<<<<<< THE WAY 71A4 64C8 2399 71A6 A820 ERRFN A @C4,@EXTRAM 71A8 6A80 71AA 832E 2400 71AC 0200 ERRFNN LI R0,>0B03 FOR NEXT NESTING 71AE 0B03 2401 71B0 0460 B @ERR 71B2 6652 2402 71B4 0288 NFOR11 CI R8,SUBZ*256 Hit a SUB? 71B6 A100 2403 71B8 13F9 JEQ ERRFNN Yes, can't find matching next 2404 71BA 0288 CI R8,FORZ*256 FOR? 71BC 8C00 2405 71BE 1601 JNE NFOR20 No, Check some more 2406 71C0 0583 INC R3 Increment depth 2407 71C2 0288 NFOR20 CI R8,LNZ*256 Line number token? 71C4 C900 2408 71C6 1602 JNE NFOR30 No, Check some more 2409 71C8 05E0 INCT @PGMPTR Skip the line number 71CA 832C 99/4 ASSEMBLER FORNEXTS PAGE 0055 2410 71CC 0288 NFOR30 CI R8,STRINZ*256 String? 71CE C700 2411 71D0 1606 JNE NFOR12 No, Check end of statement 2412 71D2 06A0 BL @PGMCHR Yes, get string length 71D4 6C74 2413 71D6 06C8 SWPB R8 Put the length in R8 2414 71D8 A808 A R8,@PGMPTR Skip that many length 71DA 832C 2415 71DC 04C8 CLR R8 Clear next crunched code 2416 71DE 06A0 NFOR12 BL @PGMCHR Read next crunched code 71E0 6C74 2417 71E2 06A0 BL @EOSTMT Check EOS (includes EOL) 71E4 6862 2418 71E6 16ED JNE NFOR20 Check for line # or string 2419 71E8 10C5 JMP NFOR09 Is EOS or EOL 2420 71EA D020 NFOR13 MOVB @PRGFLG,R0 If imperative w/out match 71EC 8344 2421 71EE 13DE JEQ ERRFNN Its an error 2422 71F0 6820 S @C4,@EXTRAM Goto next line 71F2 6A80 71F4 832E 2423 71F6 8820 C @EXTRAM,@STLN Hit end of program? 71F8 832E 71FA 8330 2424 71FC 1AD4 JL ERRFN Yes, can't match the next 2425 71FE C820 MOV @EXTRAM,@PGMPTR Set PGMPTR to get new PGMPTR 7200 832E 7202 832C 2426 7204 06A0 BL @PGMCHR Get 7206 6C74 2427 7208 D808 MOVB R8,@PGMPTR new 720A 832C 2428 720C D81A MOVB *R10,@PGMPT1 PGMPTR 720E 832D 2429 7210 06A0 BL @PGMCHR Get next line 7212 6C74 2430 7214 06A0 BL @EOSTMT Check EOS or EOL 7216 6862 2431 7218 13AD JEQ NFOR09 Is EOS or EOL 2432 721A 10B1 JMP NFOR10 Keep looping 2433 * NEXT4 and NEXT2A were moved from in-line to here in an 2434 * effort to make the "normal" path through the NEXT code as 2435 * straight-line as possible. 2436 721C 6820 NEXT4 S @C24,@VSPTR LOOP VARIABLES DON'T MATCH 721E 6464 7220 836E 2437 7222 1008 JMP NEXT2 2438 7224 06A0 NEXT2B BL @VPUSH Keep stack information 7226 6BAA 2439 7228 0200 NEXT2A LI R0,>0C03 NEXT WITHOUT FOR 722A 0C03 2440 722C 0460 B @ERR 722E 6652 2441 ************************************************************ 2442 * NEXT statement handler - find the matching FOR statement 2443 * on the stack, add the increment to the current value of 2444 * the index variable and check to see if execute the loop 2445 * again. If loop-variable's value is still within bounds, 2446 * goto the top of the loop, otherwise, flush the FOR entry 99/4 ASSEMBLER FORNEXTS PAGE 0056 2447 * off the stack and continue with the statement following 2448 * the NEXT statement. 2449 ************************************************************ 2450 7230 06A0 NNEXT BL @SYM GET S.T. I.D. 7232 6312 2451 * MOV @FAC,R4 SYM/FBSYMB leaves value in R4 2452 7234 8820 NEXT2 C @VSPTR,@STVSPT CHECK FOR BOTTOM OF STACK 7236 836E 7238 8324 2453 723A 12F6 JLE NEXT2A IF AT BOTTOM -> NEXT W/OUT FOR 2454 723C 06A0 BL @VPOP GET 'FOR' ENTRY OFF STACK 723E 6C2A 2455 7240 9820 CB @FAC2,@CBH67 CHECK FOR 'FOR' ENTRY 7242 834C 7244 68AB 2456 7246 16EE JNE NEXT2B Is not a 'FOR' entry, error 2457 7248 8804 C R4,@FAC CHECK IF MATCHING 'FOR' ENTRY 724A 834A 2458 724C 16E7 JNE NEXT4 Is not a match, so check more 2459 724E C0E0 MOV @VSPTR,R3 Check BUFLEV for match 7250 836E 2460 7252 0223 AI R3,14 Point at the BUFLEV in stack 7254 000E 2461 7256 06A0 BL @GET1 Read it 7258 6C9E 2462 725A 8801 C R1,@BUFLEV SAME LEVEL? 725C 8346 2463 725E 16A6 JNE ERRFNN NO, ITS AN ERROR 2464 7260 6820 S @C8,@VSPTR 7262 706C 7264 836E 2465 7266 06A0 BL @MOVFAC GET INDEX VALUE 7268 6434 2466 726A 06A0 BL @SAVREG SAVE BASIC REGISTERS 726C 1E8C 2467 726E 06A0 BL @SADD ADD IN THE INCREMENT 7270 0D84 2468 7272 06A0 BL @SETREG RESTORE BASIC REGS 7274 1E7A 2469 7276 A820 A @C24,@VSPTR 7278 6464 727A 836E 2470 727C 06A0 BL @ASSG SAVE NEW INDEX VALUE 727E 6334 2471 7280 6820 S @H16,@VSPTR POINT TO THE LIMIT 7282 7156 7284 836E 2472 7286 06A0 BL @SCOMPB TEST W/IN LIMIT 7288 0D42 2473 728A 02C4 STST R4 SAVE RESULT OF COMPARE 2474 728C 1309 JEQ NEXT5 IF = DO LAST LOOP 2475 728E C0E0 MOV @VSPTR,R3 CHECK FOR A DECREMENT 7290 836E 2476 7292 0223 AI R3,16 Point at increment/decrement 7294 0010 2477 7296 06A0 BL @GETV1 Get 1st byte and set condition 7298 1880 2478 729A 1116 JLT NEXT6 If was a decrement 2479 729C 0A14 SLA R4,1 Check if out of limit 99/4 ASSEMBLER FORNEXTS PAGE 0057 2480 729E 1512 JGT NEXT8 Out of limit 2481 72A0 A820 NEXT5 A @C32,@VSPTR Point to 'FOR' I.D. entry 72A2 7196 72A4 836E 2482 72A6 C0E0 MOV @VSPTR,R3 GOTO TOP OF 'FOR' LOOP 72A8 836E 2483 72AA 0223 AI R3,-8 Point to old EXTRAM 72AC FFF8 2484 72AE 06A0 BL @GET1 Get new EXTRAM 72B0 6C9E 2485 72B2 C801 MOV R1,@EXTRAM Put it in 72B4 832E 2486 72B6 05C3 INCT R3 POINT AT OLD PGMPTR 2487 72B8 06A0 BL @GET1 Get old PGMPTR 72BA 6C9E 2488 72BC C801 MOV R1,@PGMPTR Put it in 72BE 832C 2489 72C0 06A0 BL @PGMCHR Get 1st token in line 72C2 6C74 2490 72C4 0460 NEXT8 B @CONT Continue on 72C6 64C8 2491 * TEST LIMIT FOR DECREMENT 2492 72C8 0A14 NEXT6 SLA R4,1 Check if out of limit 2493 72CA 15EA JGT NEXT5 If within limit, continue 2494 72CC 10FB JMP NEXT8 Continue PARSE 2495 ************************************************************ 2496 72CE AORG >72CE 2498 2499 ************************************************************ 2500 * MEMORY CHECK ROUTINE 2501 * It checks to see if there is enough room to insert a 2502 * symbol table entry or a P.A.B. into the VDP between the 2503 * static symbol table/PAB area and the dymamic string area. 2504 * If there is not it attempts to move the string space down 2505 * (to lower address) and then insert the needed area 2506 * between the two. NOTE: it may invoke COMPCT to do a 2507 * garbage collection. If there is not enough space after 2508 * COMPCT then issues *MEMORY FULL* message. 2509 * 2510 * INPUT: # of bytes needed in FAC, FAC+1 2511 * USES: R0, R12 as temporaries as well as R0 - R6 when 2512 * invoking COMPCT 2513 ************************************************************ 2514 72CE 06A0 MEMCHG BL @MEMCHK GPL entry point 72D0 72D8 2515 72D2 6192 DATA SET If NOT enough memory 2516 72D4 0460 B @RESET If enough memory 72D6 006A 2517 72D8 C30B MEMCHK MOV R11,R12 Save return address 2518 72DA C020 MOV @FREPTR,R0 GET BEGINNING OF S.T. FREE SPA 72DC 8340 2519 72DE 6020 S @STRSP,R0 CALCULATE SIZE OF GAP 72E0 8318 2520 72E2 8020 C @FAC,R0 ENOUGH SPACE ALREADY? 72E4 834A 2521 72E6 1A3C JL MEMC08 YES - DONE - RTN 2522 72E8 06A0 BL @COMPCT NO - COMPACITFY STRING SPACE 72EA 73D8 2523 72EC C020 MOV @STREND,R0 GET STRING FREE SPACE 99/4 ASSEMBLER STRINGS PAGE 0058 72EE 831A 2524 72F0 6020 S @VSPTR,R0 CALCULATE SIZE OF GAP 72F2 836E 2525 72F4 0220 AI R0,-64 VSPTR OFFSET TOO 72F6 FFC0 2526 72F8 C2A0 MOV @FAC,R10 GET TOTAL # NEEDED BACK 72FA 834A 2527 72FC 8280 C R0,R10 ENOUGH ROOM NOW? 2528 72FE 1A32 JL MEMERR NO - *MEMORY FULL* 2529 * 2530 * Now move the DYNAMIC STRING AREA DOWN IN MEMORY 2531 * 2532 7300 C020 MOV @STRSP,R0 CALCULATE # OF BYTES 7302 8318 2533 7304 C0A0 MOV @STREND,R2 Beginning of move address 7306 831A 2534 7308 6002 S R2,R0 in the total string space 2535 730A 680A S R10,@STREND SET FREE PTR(COPY-TO ADDRESS) 730C 831A 2536 730E C000 MOV R0,R0 NO BYTES TO MOVE? 2537 7310 130D JEQ MEMC04 RIGHT 2538 7312 C0C2 MOV R2,R3 ADDRESS FOR GETV 2539 7314 0583 INC R3 2540 7316 C120 MOV @STREND,R4 ADDRESS FOR PUTV 7318 831A 2541 731A 0584 INC R4 2542 731C 06A0 MEMC03 BL @GETV1 GET THE BYTE 731E 1880 2543 7320 06A0 BL @PUTV1 PUT THE BYTE 7322 6422 2544 7324 0583 INC R3 INC THE FROM 2545 7326 0584 INC R4 INC THE TO 2546 7328 0600 DEC R0 DEC THE COUNT 2547 732A 15F8 JGT MEMC03 IF NOT DONE 2548 * MOVE IT 2549 732C 680A MEMC04 S R10,@STRSP SET NEW STRIG SPACE PTR 732E 8318 2550 * 2551 * NOW FIX UP STRING PTRS 2552 * 2553 7330 C020 MOV @STRSP,R0 GET BEGINNING OF STRING SPACE 7332 8318 2554 7334 8020 MEMC05 C @STREND,R0 FINISHED? 7336 831A 2555 7338 1413 JHE MEMC08 YES 2556 733A 04C1 CLR R1 CLEAR LOWER BYTE 2557 733C C0C0 MOV R0,R3 FOR GETV 2558 733E 06A0 BL @GETV1 GET LENGTH BYTE 7340 1880 2559 7342 06C1 SWPB R1 SWAP FOR ADD 2560 7344 6001 S R1,R0 POINT AT BEGINNING OF STRING 2561 7346 C0C0 MOV R0,R3 FOR THE GETV1 BELOW 2562 7348 0223 AI R3,-3 POINT AT THE BACKPOITER 734A FFFD 2563 734C 06A0 BL @GET1 GET THE BACK POINTER 734E 6C9E 2564 * BOTH BYTES 2565 7350 C041 MOV R1,R1 FREE STRING? 2566 7352 1303 JEQ MEMC06 YES 99/4 ASSEMBLER STRINGS PAGE 0059 2567 7354 C180 MOV R0,R6 PTR TO STRING FOR STVDP 2568 7356 06A0 BL @STVDP SET FORWARD PTR 7358 18AE 2569 735A 0220 MEMC06 AI R0,-4 NOW POINT AT NEXT LENGTH 735C FFFC 2570 735E 10EA JMP MEMC05 CONTINUE ON 2571 7360 046C MEMC08 B @2(R12) Return with space allocated 7362 0002 2572 7364 C31C MEMERR MOV *R12,R12 Pick up error return address 2573 7366 045C B *R12 * MEMORY FULL(prescan time) 2574 7368 0460 ERRMEM B @VPSH23 * MEMORY FULL(execution tiem) 736A 6C1A 2575 ************************************************************ 2576 * GETSTR - Checks to see if there is enough space in the 2577 * string area to allocate a string, if there is it 2578 * allocates it. If there is not it does a garbage 2579 * collection and once again checks to see if there 2580 * is enough room. If so it allocates it, if not it 2581 * issues a *MEMORY FULL* message. 2582 * 2583 * INPUT : # of bytes needed in @BYTE 2584 * OUTPUT: Pointer to new string in @SREF 2585 * Both length bytes in place & zeroed Breakpointer 2586 * @STREND points 1st free byte(new) 2587 * 2588 * USES : R0 - R6 Temporaries 2589 * 2590 * Note : COMPCT allows a buffer zone of 8 stack entries 2591 * above what is there when COMPCT is called. This 2592 * should allow enough space to avoid a collision 2593 * between the string space and the stack. If 2594 * garbage begins to appear in the string space 2595 * that can't be accounted for, the buffer zone 2596 * will be increased. 2597 ************************************************************ 2598 736C C020 GETSTR MOV @BYTE,R0 GET # OF BYTES NEEDED 736E 830C 2599 7370 C30B MOV R11,R12 SAVE RTN ADDRESS 2600 7372 8C30 C *R0+,*R0+ ADJUST FOR BACKPTR & 2 LENGTHS 2601 * (INCREMENT BY 4) 2602 7374 C060 MOV @STREND,R1 CHECK IF ENOUGH ROOM 7376 831A 2603 7378 6040 S R0,R1 BY ADVANCING THE FREE PTR 2604 737A C0A0 MOV @VSPTR,R2 GET VALUE STACK PTR 737C 836E 2605 737E 0222 AI R2,64 ALLOW BUFFER ZONE 7380 0040 2606 7382 8081 C R1,R2 ENOUGH SPACE? 2607 7384 1B0E JH GETS10 YES, ALL IS WELL 2608 7386 06A0 BL @COMPCT NO, COMPACTIFY 7388 73D8 2609 738A C0A0 MOV @VSPTR,R2 GET VALUE STACK POINTER 738C 836E 2610 738E 0222 AI R2,64 ALLOW BUFFER ZONE 7390 0040 2611 7392 C020 MOV @BYTE,R0 GET # OF BYTES BACK 7394 830C 2612 7396 8C30 C *R0+,*R0+ INCREMENT BY 4 2613 7398 C060 MOV @STREND,R1 GET NEW END OF STRING SPACE 99/4 ASSEMBLER STRINGS PAGE 0060 739A 831A 2614 739C 6040 S R0,R1 ADVANCE IT 2615 739E 8081 C R1,R2 ENOUGH SPACE NOW? 2616 73A0 12E3 JLE ERRMEM NO, *MEMORY FULL* 2617 73A2 0220 GETS10 AI R0,-4 GET EXACT LENGTH BACK 73A4 FFFC 2618 73A6 D060 MOVB @R0LB,R1 STORE ENTRY LENGTH 73A8 83E1 2619 73AA 06A0 BL @PUTV PUT THE ENDING LENGTH 73AC 641E 2620 73AE 831A DATA STREND BYTE IN THE STRING 2621 73B0 6800 S R0,@STREND PT AT FIRST BYTE OF STRING 73B2 831A 2622 73B4 C820 MOV @STREND,@SREF POINT SREF AT THE STRING 73B6 831A 73B8 831C 2623 73BA 0620 DEC @STREND POINT AT LEADING LENGTH BYTE 73BC 831A 2624 73BE 06A0 BL @PUTV PUT THE LEADING LENGTH BYTE IN 73C0 641E 2625 73C2 831A DATA STREND THE STRING 2626 73C4 0660 DECT @STREND POINT AT BACKPOINTER 73C6 831A 2627 73C8 04C6 CLR R6 ZERO FOR THE BACKPOINTER 2628 73CA C060 MOV @STREND,R1 ADDR OR THE BACKPOINTER 73CC 831A 2629 73CE 06A0 BL @STVDP CLEAR THE BACKPOINTER 73D0 18AE 2630 73D2 0620 DEC @STREND POINT AT 1ST FREE BYTE 73D4 831A 2631 73D6 045C B *R12 ALL DONE 2632 ************************************************************ 2633 * COMPCT - Is the string garbage collection routine. It can 2634 * be invoked by GETSTR or MEMCHK. It copies all 2635 * used strings to the top of the string space 2636 * suppressing out all of the unused strings 2637 * INPUT : None 2638 * OUTPUT: UPDATED @STRSP AND @STREND 2639 * USES : R0-R6 AS TEMPORARIES 2640 ************************************************************ 2641 73D8 C1CB COMPCT MOV R11,R7 Save rtn address 2642 73DA C020 MOV @FREPTR,R0 Get pointer to free space 73DC 8340 2643 73DE C160 MOV @STRSP,R5 Get pointer to string space 73E0 8318 2644 73E2 C800 MOV R0,@STRSP Set new string space pointer 73E4 8318 2645 73E6 0585 INC R5 Compensate for decrement 2646 73E8 0605 COMP03 DEC R5 Point at length of string 2647 73EA 8160 C @STREND,R5 At end of string space? 73EC 831A 2648 73EE 1A03 JL COMP05 No, check this string for copy 2649 73F0 C800 MOV R0,@STREND Yes, set end of free space 73F2 831A 2650 73F4 0457 B *R7 Return to caller 2651 73F6 C085 COMP05 MOV R5,R2 Copy ptr to end in case moved 2652 73F8 C0C5 MOV R5,R3 Copy ptr to end in read length 2653 73FA 06A0 BL @GETV1 Read the length byte 73FC 1880 99/4 ASSEMBLER STRINGS PAGE 0061 2654 73FE D181 MOVB R1,R6 Put it in R6 for address 2655 7400 0986 SRL R6,8 Need in LSB for word 2656 7402 6146 S R6,R5 Point at the string start 2657 7404 0225 AI R5,-3 Point at the back pointer 7406 FFFD 2658 7408 C0C5 MOV R5,R3 Set up for GETV 2659 740A 06A0 BL @GET1 Get the backpointer 740C 6C9E 2660 740E C041 MOV R1,R1 Is this string garbage? 2661 7410 13EB JEQ COMP03 Yes, just ignore it 2662 * PERTINENT REGISTERS AT THIS POINT 2663 * R0 - is where the sting will end 2664 * R6 - # of bytes to be moved(does not) 2665 * include lengths and backpointer 2666 * R2 - points at trailing length byte of string 2667 * to be moved 2668 * IN GENERAL : MOVE (R6) BYTES FROM VDP(R2-R6) TO VDP(R0-R6) 2669 * VDP(R0-R6) moving backwards i.e. the last 2670 * byte of the entry is moved first, then the 2671 * next to the last byte... 2672 7412 8DB6 C *R6+,*R6+ INCR by 4 to include overhead 2673 7414 C0C2 MOV R2,R3 Restore ptr to end of string 2674 7416 C100 MOV R0,R4 Get ptr to end of string space 2675 7418 06A0 COMP10 BL @GETV1 Read a byte 741A 1880 2676 741C 06A0 BL @PUTV1 Write a byte 741E 6422 2677 7420 0603 DEC R3 Decrement source pointer 2678 7422 0604 DEC R4 Decrement destination pointer 2679 7424 0606 DEC R6 Decrement the counter 2680 7426 15F8 JGT COMP10 Loop if not finished 2681 7428 0244 ANDI R4,>3FFF Delete VDP write-enable & reg 742A 3FFF 2682 742C C004 MOV R4,R0 Set new free space pointer 2683 742E 0584 INC R4 Point at backpointer just move 2684 7430 C0C4 MOV R4,R3 Copy pointer to read it 2685 7432 06A0 BL @GET1 Get the backpointer 7434 6C9E 2686 * R1 now contains the address of the forward pointer 2687 7436 C183 MOV R3,R6 Address of the string entry 2688 7438 0226 AI R6,3 Point at the string itself 743A 0003 2689 * R6 now contains the address of the string 2690 743C 06A0 BL @STVDP Reset the forward pointer 743E 18AE 2691 7440 10D3 JMP COMP03 Loop for next string 2692 ************************************************************ 2693 * NSTRCN - Nud for string constants 2694 * Copies the string into the string space and sets 2695 * up the FAC with a string entry of the following 2696 * form: 2697 * 2698 * +-------+-----+----+------------+-----------+ 2699 * | >001C | >65 | XX | Pointer | Length of | 2700 * | | | | to string | string | 2701 * +-------+-----+----+------------+-----------+ 2702 * FAC +2 +3 +4 +6 2703 ************************************************************ 2704 7442 06C8 NSTRCN SWPB R8 99/4 ASSEMBLER STRINGS PAGE 0062 2705 7444 C808 MOV R8,@FAC6 Save length 7446 8350 2706 7448 C808 MOV R8,@BYTE For GETSTR 744A 830C 2707 744C 06C8 SWPB R8 2708 744E 06A0 BL @GETSTR Get result string 7450 736C 2709 7452 0200 LI R0,>001C Get address of SREF 7454 001C 2710 7456 0201 LI R1,FAC Optimize to save bytes 7458 834A 2711 745A CC40 MOV R0,*R1+ Indicate temporary string 2712 745C DC60 MOVB @CBH65,*R1+ Indicate a string 745E 65A7 2713 7460 DC40 MOVB R0,*R1+ Byte is not used 2714 7462 C460 MOV @SREF,*R1 Save pointer to string 7464 831C 2715 7466 C0A0 MOV @BYTE,R2 Get number of bytes to copy in 7468 830C 2716 746A 1318 JEQ NSTR20 If none to copy 2717 746C C111 MOV *R1,R4 Get pointer to destination 2718 746E C0E0 MOV @PGMPTR,R3 Get pointer to source 7470 832C 2719 7472 D020 MOVB @RAMFLG,R0 ERAM or VDP? 7474 8389 2720 7476 1609 JNE NSTR10 ERAM 2721 * Get the string from VDP 2722 7478 06A0 NSTR05 BL @GETV1 Get a byte 747A 1880 2723 747C 06A0 BL @PUTV1 Put a byte 747E 6422 2724 7480 0583 INC R3 Next in source 2725 7482 0584 INC R4 Next in destination 2726 7484 0602 DEC R2 1 less to move 2727 7486 16F8 JNE NSTR05 If more to move, do it 2728 7488 1009 JMP NSTR20 Else if done, exit 2729 748A D7E0 NSTR10 MOVB @R4LB,*R15 Write 2nd byte of VDP address 748C 83E9 2730 748E 0264 ORI R4,WRVDP Enable VDP write 7490 4000 2731 7492 D7C4 MOVB R4,*R15 Write 1st byte of VDP address 2732 7494 D833 NSTR15 MOVB *R3+,@XVDPWD Move byte from ERAM to VDP 7496 8C00 2733 7498 0602 DEC R2 1 less to move 2734 749A 16FC JNE NSTR15 If ont done, loop for more 2735 749C A820 NSTR20 A @FAC6,@PGMPTR Skip the string 749E 8350 74A0 832C 2736 74A2 06A0 BL @PGMCHR Get character following string 74A4 6C74 2737 74A6 0460 B @CONT And continue on 74A8 64C8 2738 ************************************************************ 2739 74AA AORG >74AA 2741 2742 ************************************************************ 2743 * CIF - Convert integer to floating 2744 * Assume that the value in the FAC is an integer 2745 * and converts it into an 8 byte floating point 99/4 ASSEMBLER CIFS PAGE 0063 2746 * value 2747 ************************************************************ 2748 74AA 0204 CIF LI R4,FAC Will convert into the FAC 74AC 834A 2749 74AE C014 MOV *R4,R0 Get integer into register 2750 74B0 C184 MOV R4,R6 Copy pointer to FAC to clear i 2751 74B2 04F6 CLR *R6+ Clear FAC & FAC+1 2752 74B4 04F6 CLR *R6+ In case had a string in FAC 2753 74B6 C140 MOV R0,R5 Is integer equal to zero? 2754 74B8 1323 JEQ CIFRT Yes, zero result and return 2755 74BA 0740 ABS R0 Get ABS value of ARG 2756 74BC 0203 LI R3,>40 Get exponent bias 74BE 0040 2757 74C0 04F6 CLR *R6+ Clear words in result that 2758 74C2 04D6 CLR *R6 might not get a value 2759 74C4 0280 CI R0,100 Is integer less than 100? 74C6 0064 2760 74C8 1A13 JL CIF02 Yes, just put in 1st fraction 2761 * part 2762 74CA 0280 CI R0,10000 No, is ARG less then 100^2? 74CC 2710 2763 74CE 1A08 JL CIF01 Yes, just 1 division necessary 2764 * No, 2 divisions are necessary 2765 74D0 0583 INC R3 Add 1 to exponent for 1st 2766 74D2 C040 MOV R0,R1 Put # in low order word for th 2767 * divide 2768 74D4 04C0 CLR R0 Clear high order word for the 2769 * divide 2770 74D6 3C20 DIV @C100,R0 Divide by the radix 74D8 6008 2771 74DA D920 MOVB @R1LB,@3(R4) ~@ Move the radix digit in 74DC 83E3 74DE 0003 2772 74E0 0583 CIF01 INC R3 Add 1 to exponent for divide 2773 74E2 C040 MOV R0,R1 Put in low order for divide 2774 74E4 04C0 CLR R0 Clear high order for divide 2775 74E6 3C20 DIV @C100,R0 Divide by the radix 74E8 6008 2776 74EA D920 MOVB @R1LB,@2(R4) ~@ Put next radix digit in 74EC 83E3 74EE 0002 2777 74F0 D920 CIF02 MOVB @R0LB,@1(R4) ~@ Put highest order radix digit 74F2 83E1 74F4 0001 2778 74F6 D520 MOVB @R3LB,*R4 Put exponent in 74F8 83E7 2779 74FA 0545 INV R5 Is result positive? 2780 74FC 1101 JLT CIFRT Yes, sign is correct 2781 74FE 0514 NEG *R4 No, make it negative 2782 7500 045B CIFRT RT 2783 ************************************************************ 2784 2785 7502 AORG >7502 2787 2788 7502 A000 CONTAD DATA >A000 Address of a continue stmt 2789 A026 GPLIST EQU >A026 GPL subprogram linked list 2790 2791 00C8 UNQSTZ EQU >C8 Unquoted string token 2792 99/4 ASSEMBLER SUBPROGS PAGE 0064 2793 7504 8000 INUSE DATA >8000 In-use flag 2794 7506 4000 FNCFLG DATA >4000 User-defined function flag 2795 7508 2000 SHRFLG DATA >2000 Shared-value flag 2796 * 2797 * ERROR CODES 2798 * 2799 1203 ERRSND EQU >1203 * SUBEND NOT IN SUBPROGRAM 2800 0F03 ERRREC EQU >0F03 * RECURSIVE SUBPROGRAM CALL 2801 0E03 ERRIAL EQU >0E03 * INCORRECT ARGUMENT LIST 2802 1103 ERROLP EQU >1103 * ONLY LEGAL IN A PROGRAM 2803 2804 ************************************************************ 2805 * CALL - STATEMENT EXECUTION 2806 * Finds the subprogram specified in the subprogram table, 2807 * evaluates and assigns any arguments to the formal 2808 * parameters, builds the stack block, and transfers control 2809 * into the subprogram. 2810 * General register usage: 2811 * R0 - R6 Temporaries 2812 * R7 Pointer into formals in subprogram name entry 2813 * R8 Character returned by PGMCHR 2814 * R9 Subroutine stack 2815 * R10 Temporary 2816 * R11 Return link 2817 * R12 Temporary 2818 * R13 GROM read-data address 2819 * R14 Interpreter flags 2820 * R15 VDP write-address address 2821 ************************************************************ 2822 750A 06A0 CALL BL @PGMCHR Skip UNQSTZ & get name length 750C 6C74 2823 750E D808 MOVB R8,@FAC15 Save lengthfor FBS 7510 8359 2824 7512 D108 MOVB R8,R4 For the copies to be made 2825 7514 0984 SRL R4,8 below 2826 7516 C020 MOV @PGMPTR,R0 Get pointer to name 7518 832C 2827 751A D060 MOVB @RAMFLG,R1 ERAM or VDP? 751C 8389 2828 751E 130D JEQ CALL04 VDP 2829 * ERAM, must copy into VDP 2830 7520 C140 MOV R0,R5 Pointer to string in ERAM 2831 7522 0200 LI R0,CRNBUF Destination in VDP 7524 0820 2832 7526 C0C4 MOV R4,R3 Length for this move 2833 7528 D7E0 MOVB @R0LB,*R15 Load out the VDP write address 752A 83E1 2834 752C 0260 ORI R0,WRVDP Enable the VDP write 752E 4000 2835 7530 D7C0 MOVB R0,*R15 Second byte of VDP write 2836 7532 D835 CALL02 MOVB *R5+,@XVDPWD Move a byte 7534 8C00 2837 7536 0603 DEC R3 One less byte to move 2838 7538 16FC JNE CALL02 Loop if not done 2839 753A A804 CALL04 A R4,@PGMPTR Skip over the name 753C 832C 2840 753E 0201 LI R1,FAC Destination in CPU 7540 834A 2841 7542 D7E0 MOVB @R0LB,*R15 Load out VDP read address 99/4 ASSEMBLER SUBPROGS PAGE 0065 7544 83E1 2842 7546 0240 ANDI R0,>3FFF Kill VDP write-enable 7548 3FFF 2843 754A D7C0 MOVB R0,*R15 Both bytes 2844 754C 1000 NOP Don't go to fast for it 2845 754E DC60 CALL06 MOVB @XVDPRD,*R1+ Move a byte 7550 8800 2846 7552 0604 DEC R4 One less bye to move 2847 7554 16FC JNE CALL06 Loop if not done 2848 7556 C120 MOV @SUBTAB,R4 Get beginning of subpgm table 7558 833A 2849 755A 133C JEQ SCAL89 If table empty, search in GPL 2850 755C 06A0 BL @FBS001 Search subprogram table 755E 15E6 2851 7560 75D4 DATA SCAL89 If not found, search in GPL 2852 * Pointer to table entry returned in both R4 and FAC 2853 7562 06A0 BL @PGMCHR Get next token 7564 6C74 2854 7566 C0C4 MOV R4,R3 Duplicate pointer for GETV 2855 7568 06A0 BL @GETV1 Get flag byte 756A 1880 2856 756C 1130 JLT SCAL90 If attempted recursive call 2857 756E 0A11 SLA R1,1 Check for BASIC/GPL program 2858 7570 1106 JLT GPLSU GPL subprogram 2859 7572 D2E0 MOVB @PRGFLG,R11 Imperative call to BASIC sub? 7574 8344 2860 7576 1614 JNE SCAL01 No, OK-handle BASIC subprogram 2861 7578 0200 LI R0,ERROLP Can't call a BASIC sub 757A 1103 2862 757C 102D JMP SCAL91 imperatively 2863 * 2864 * Handle a GPL subprogram 2865 * 2866 757E 05C9 GPLSU INCT R9 2867 7580 CE60 MOV @CONTAD,*R9+ Put address of a cont on stack 7582 7502 2868 7584 C64D MOV R13,*R9 Save address for real BASIC 2869 7586 0223 AI R3,6 Now set up new environment 7588 0006 2870 758A 06A0 BL @GET1 Get access address of GPL subp 758C 6C9E 2871 758E DB41 MOVB R1,@GRMWAX(R13) Load out the address into GRO 7590 0402 2872 7592 06C1 SWPB R1 Need to kill time here 2873 7594 DB41 MOVB R1,@GRMWAX(R13) Next byte also 7596 0402 2874 7598 06A0 BL @SAVREG Restore registers to GPL 759A 1E8C 2875 759C 0460 B @RESET And enter the routine 759E 006A 2876 * 2877 * Execute BASIC subprogram 2878 * 2879 75A0 SCAL01 EQU $ 2880 *----------------------------------------------------------- 2881 * Fix "An error happened in a CALL statement keeps its 2882 * in-use flag set" bug. 5/12/81 2883 * Move the following 3 lines after finishing processing 2884 * the parameter list, before entering the subprogram. 99/4 ASSEMBLER SUBPROGS PAGE 0066 2885 * SRL R1,1 Restore mode to original form 2886 * SOCB @INUSE,R1 Set the in-use flag bit 2887 * BL @PUTV1 Put the byte back 2888 * Save the pointer to table entry for setting in-use flag 2889 * later. 2890 * $$$$$$$ USE VDP(0374) 2 BYTES AS TEMPRORARY HERE 2891 75A0 0204 LI R4,>0374 R4: address register for PUT1 75A2 0374 2892 75A4 C043 MOV R3,R1 R1: data register for PUT1 2893 75A6 06A0 BL @PUT1 Save the pointer to table 75A8 6CB2 2894 * entry in VDP temporary 2895 *----------------------------------------------------------- 2896 75AA C303 MOV R3,R12 Save subtable address 2897 75AC 04E0 CLR @FAC2 Indicate non-special entry 75AE 834C 2898 75B0 06A0 BL @VPUSH Push subprogram entry on stack 75B2 6BAA 2899 75B4 C10C MOV R12,R4 Restore sub table address 2900 75B6 C1C4 MOV R4,R7 2901 75B8 0227 AI R7,6 Point to 1st argument in list 75BA 0006 2902 75BC C0C7 MOV R7,R3 Formals' pointer 2903 75BE 06A0 BL @GET1 Check to see if any 75C0 6C9E 2904 75C2 C041 MOV R1,R1 Any args? 2905 75C4 133F JEQ SCAL32 None, jump forward 2906 75C6 0288 CI R8,LPARZ*256 Must see a left parenthesis 75C8 B700 2907 75CA 1640 JNE SCAL34 If not, error 2908 75CC 1013 JMP SCAL08 Jump into argument loop 2909 75CE 0200 SCAL90 LI R0,ERRREC * RECURSIVE SUBPROGRAM CALL 75D0 0F03 2910 75D2 1002 JMP SCAL91 2911 75D4 0200 SCAL89 LI R0,>000A GPL check for DSR subprogram 75D6 000A 2912 75D8 0460 SCAL91 B @ERR 75DA 6652 2913 75DC 1031 SCAL93 JMP SCAL12 Going down! 2914 75DE 06A0 SCAL05 BL @POPSTK Short stack pop routine 75E0 60D4 2915 75E2 C1E0 MOV @ARG4,R7 To quickly restore R7 75E4 8360 2916 75E6 05C7 INCT R7 To account for SCAL80 2917 75E8 0288 SCAL06 CI R8,RPARZ*256 Actual list ended? 75EA B600 2918 75EC 132D JEQ SCAL30 Actuals all scanned 2919 75EE 0288 CI R8,COMMAZ*256 Must see a comma then 75F0 B300 2920 75F2 1626 JNE SCAL12 Didn't, so error 2921 * Scan next actual. Check if it is just a name 2922 75F4 C820 SCAL08 MOV @PGMPTR,@ERRCOD Save text ptr in case of expr 75F6 832C 75F8 8322 2923 75FA 06A0 BL @PGMCHR Get next character 75FC 6C74 2924 75FE 1179 JLT SCAL40 No, so must be an expression 2925 7600 C307 MOV R7,R12 Save formals pointer 2926 7602 06A0 BL @SYM Read name & see if recognized 99/4 ASSEMBLER SUBPROGS PAGE 0067 7604 6312 2927 7606 06A0 BL @GETV Check function flag 7608 187C 2928 760A 834A DATA FAC 2929 760C C1CC MOV R12,R7 Restore formals pointer first 2930 760E 2460 CZC @FNCFLG,R1 User-defined function? 7610 7506 2931 7612 166F JNE SCAL40 Yes, pass by value 2932 7614 0288 CI R8,LPARZ*256 Complex type? 7616 B700 2933 7618 1620 JNE SCAL15 No 2934 761A 06A0 BL @PGMCHR Check if formal entry 761C 6C74 2935 761E 0288 CI R8,RPARZ*256 FOO() ? 7620 B600 2936 7622 1319 JEQ SCAL14 Yes, handle it as such 2937 7624 0288 CI R8,COMMAZ*256 or FOO(,...) ? 7626 B300 2938 7628 1613 JNE SCAL35 No, an array element FOO(I... 2939 762A 06A0 SCAL10 BL @PGMCHR Formal array, scan to end 762C 6C74 2940 762E 06A0 BL @EOSTMT Check if end-of-statement 7630 6862 2941 7632 1306 JEQ SCAL12 Premature end of statement 2942 7634 0288 CI R8,COMMAZ*256 Another comma? 7636 B300 2943 7638 13F8 JEQ SCAL10 Yes, continue on to end 2944 763A 0288 CI R8,RPARZ*256 End yet? 763C B600 2945 763E 130B JEQ SCAL14 Yes, merge in below 2946 7640 0460 SCAL12 B @ERRONE * SYNTAX ERROR 7642 664E 2947 7644 0460 SCAL32 B @SCAL62 Going down! 7646 77B8 2948 7648 0460 SCAL30 B @SCAL60 764A 77B4 2949 764C 0460 SCAL34 B @SCAL88 764E 7878 2950 7650 0460 SCAL35 B @SCAL50 7652 7744 2951 7654 10C9 SCAL37 JMP SCAL06 2952 * 2953 * Here for Scalers/Arrays by Reference 2954 7656 06A0 SCAL14 BL @PGMCHR Pass the right parenthesis 7658 6C74 2955 765A 0288 SCAL15 CI R8,COMMAZ*256 Just a name? 765C B300 2956 765E 1303 JEQ SCAL16 Yes 2957 7660 0288 CI R8,RPARZ*256 Start an expression? 7662 B600 2958 7664 1646 JNE SCAL40 Yes, name starts an expression 2959 7666 06A0 SCAL16 BL @GETV Get mode of name 7668 187C 2960 766A 834A DATA FAC Ptr to s.t. entry left by SYM 2961 766C D081 MOVB R1,R2 Save for check below 2962 766E 06A0 BL @SCAL80 And fetch next formal info 7670 787E 2963 7672 D042 MOVB R2,R1 Copy for this check 2964 7674 0241 ANDI R1,>C700 for the comparison 99/4 ASSEMBLER SUBPROGS PAGE 0068 7676 C700 2965 7678 C006 MOV R6,R0 Use a temporary rgister 2966 767A 0240 ANDI R0,>C700 for the comparison 767C C700 2967 767E 8001 C R1,R0 Must be exact match 2968 7680 16E5 JNE SCAL34 Else can't pass by reference 2969 7682 E1A0 SOC @SHRFLG,R6 Set the shared symbol flag 7684 7508 2970 7686 D046 MOVB R6,R1 Load up for PUTV 2971 7688 C105 MOV R5,R4 Address to put the flag 2972 768A 06A0 BL @PUTV1 Set the flag in the s.t. entry 768C 6422 2973 768E 0244 ANDI R4,>3FFF Kill VDP write-enable bit 7690 3FFF 2974 * 2975 * The following section finds actual's value space address 2976 * and puts it in R1. 2977 * FAC contains the symbol table's address. 2978 * If actual is NOT shared....................... 2979 * Symbol table's address+6 will point to the value space 2980 * except for numeric ERAM cae. In a numeric ERAM case 2981 * GET1 to get pointer to the ERAM value space. 2982 * If actual is SHARED........................ 2983 * GET1 to get the pointer in symbol table's address+6 2984 * In a numeric ERAM case, GETG to get the indirect point 2985 * to the actual's vlaue space pointer after GET1 is call 2986 * 2987 7692 C060 MOV @FAC,R1 Ptr to actual s.t. entry 7694 834A 2988 7696 0221 AI R1,6 Ptr to actuals value space 7698 0006 2989 769A 0246 ANDI R6,>8700 Keep info on string or array 769C 8700 2990 769E 0242 ANDI R2,>2000 Is actual shared? 76A0 2000 2991 76A2 130C JEQ SCAL23 No, use it 2992 76A4 C0C1 MOV R1,R3 Else look further 2993 76A6 06A0 BL @GET1 Get the true pointer 76A8 6C9E 2994 76AA D186 MOVB R6,R6 Array or string? 2995 76AC 160F JNE SCAL24 Yes, both are special cases 2996 76AE D0A0 MOVB @RAMTOP,R2 ERAM present? 76B0 8384 2997 76B2 130C JEQ SCAL24 No ERAM, so skip 2998 * Numeric variable, shared, ERAM. 2999 76B4 C0C1 MOV R1,R3 Get ptr to original from ERAM 3000 76B6 06A0 BL @GETG2 Get indirect pointer 76B8 6CCE 3001 76BA 1008 JMP SCAL24 3002 * Shared bit is NOT on. 3003 76BC D186 SCAL23 MOVB R6,R6 Check for array or string 3004 76BE 1606 JNE SCAL24 Yes, take what's in there 3005 76C0 D0A0 MOVB @RAMTOP,R2 ERAM exists? 76C2 8384 3006 76C4 1303 JEQ SCAL24 No 3007 76C6 C0C1 MOV R1,R3 Numeric and ERAM case 3008 76C8 06A0 BL @GET1 Get ERAM value space address 76CA 6C9E 3009 * R4 pointing to value space of 99/4 ASSEMBLER SUBPROGS PAGE 0069 3010 76CC 0224 SCAL24 AI R4,6 subprogram's symbol table 76CE 0006 3011 76D0 D186 MOVB R6,R6 Array or string case? 3012 76D2 160C JNE SCAL26 Yes, so just put ptr in VDP 3013 * Here check for ERAM program and if ERAM then copy the 3014 * address of shared value space into corresponding value 3015 * space in ERAM 3016 76D4 D1A0 MOVB @RAMTOP,R6 Get the ERAM flag 76D6 8384 3017 76D8 1309 JEQ SCAL26 If no ERAM, simple case 3018 76DA C181 MOV R1,R6 Keep shared value space addres 3019 76DC C0C4 MOV R4,R3 Put ptr in value space in ERAM 3020 76DE 06A0 BL @GET1 Get value space address in ERA 76E0 6C9E 3021 76E2 C101 MOV R1,R4 Copy address into R4 for PUTG2 3022 76E4 C046 MOV R6,R1 Get the value to put in ERAM 3023 76E6 06A0 BL @PUTG2 Write it into ERAM 76E8 6CD8 3024 76EA 10B4 JMP SCAL37 Loop for next argument 3025 76EC 06A0 SCAL26 BL @PUT1 Set symbol indirect link 76EE 6CB2 3026 76F0 10B1 JMP SCAL37 And loop for next arg 3027 * 3028 * Here to pass an expression by value 3029 * 3030 76F2 C820 SCAL40 MOV @ERRCOD,@PGMPTR Restore text pointer 76F4 8322 76F6 832C 3031 76F8 C807 MOV R7,@FAC4 Save formals pointer 76FA 834E 3032 76FC 04E0 CLR @FAC2 Don't let VPUSH mess up 76FE 834C 3033 7700 06A0 SCAL42 BL @PGMCHR Set up for the parse 7702 6C74 3034 * Save formals ptr & SUBTAB ptr and evaluate the expression 3035 7704 06A0 BL @PSHPRS 7706 6B9C 3036 7708 B6 BYTE RPARZ Stop on an rpar or comma 3037 7709 6A DCBH6A BYTE >6A (CBH6A copy) 3038 770A 06A0 BL @POPSTK Restore formals pointer 770C 60D4 3039 770E A820 A @C16,@VSPTR But keep it on stack 7710 6BF8 7712 836E 3040 7714 06A0 BL @VPUSH Save parse result 7716 6BAA 3041 7718 C1E0 MOV @ARG4,R7 Restore formals pointer 771A 8360 3042 771C 06A0 BL @SCAL80 And fetch next formal's info 771E 787E 3043 7720 C805 MOV R5,@FAC Set up for assignment 7722 834A 3044 7724 06A0 BL @SMB Get value space 7726 61DC 3045 7728 6820 S @C16,@VSPTR Get to s.t. info 772A 6BF8 772C 836E 3046 772E 06A0 BL @VPUSH Set up for ASSG 7730 6BAA 99/4 ASSEMBLER SUBPROGS PAGE 0070 3047 7732 A820 A @C8,@VSPTR Get back to parse result 7734 706C 7736 836E 3048 7738 06A0 BL @VPOP Get parse result back 773A 6C2A 3049 773C 06A0 BL @ASSG Assign the value to the formal 773E 6334 3050 7740 0460 B @SCAL05 And go back for more 7742 75DE 3051 * 3052 * Here for array elements 3053 * 3054 7744 0620 SCAL50 DEC @PGMPTR Restore text pointer to lpar 7746 832C 3055 7748 020B LI R11,FAC2 Optimize to save 774A 834C 3056 774C 04FB CLR *R11+ Don't let VPUSH mess up (FAC2) 3057 774E CEC7 MOV R7,*R11+ Save formals pointer (FAC4) 3058 7750 C6E0 MOV @ERRCOD,*R11 For save on stack (FAC6) 7752 8322 3059 7754 06A0 BL @VPUSH Save the info 7756 6BAA 3060 7758 0208 LI R8,LPARZ*256 Load up R8 with the lpar again 775A B700 3061 775C C820 MOV @FAC,@PAD0 Save ptr to s.t. entry 775E 834A 7760 8300 3062 7762 06A0 BL @SMB Check if name or expression 7764 61DC 3063 7766 0288 CI R8,COMMAZ*256 7768 B300 3064 776A 1309 JEQ SCAL54 Name if ended on a comma 3065 776C 0288 CI R8,RPARZ*256 776E B600 3066 7770 1306 JEQ SCAL54 or rpar 3067 7772 06A0 BL @VPOP Get saved info back 7774 6C2A 3068 7776 C820 MOV @FAC6,@PGMPTR Else expr, Restore test pointe 7778 8350 777A 832C 3069 777C 10C1 JMP SCAL42 And handle like an expression 3070 * 3071 * Passing array elements by reference 3072 777E 06A0 SCAL54 BL @POPSTK Restore symbol pointer 7780 60D4 3073 7782 C1E0 MOV @ARG4,R7 7784 8360 3074 7786 06A0 BL @SCAL80 Get next formal's info 7788 787E 3075 778A 06A0 BL @GETV Check actualOs mode 778C 187C 3076 778E 8300 DATA PAD0 Get back header information 3077 7790 0241 ANDI R1,>C000 Throw away all but string & fu 7792 C000 3078 7794 9046 CB R6,R1 Check mode match (string/num) 3079 7796 1612 JNE JNE88 Don't, so error 3080 * Can set bit in R1 since MSB (R1)=MSB (R6) 3081 7798 F060 SOCB @SHRFLG,R1 Set the share flag 779A 7508 99/4 ASSEMBLER SUBPROGS PAGE 0071 3082 779C C105 MOV R5,R4 Address for PUTV 3083 779E 06A0 BL @PUTV1 Put it in the s.t. entry 77A0 6422 3084 77A2 0244 ANDI R4,>3FFF Kill VDP write, enable bit 77A4 3FFF 3085 77A6 C060 MOV @FAC,R1 Assuming string, ref link=@FAC 77A8 834A 3086 77AA D186 MOVB R6,R6 Check if it is a string 3087 77AC 118F JLT SCAL24 If so, go set ref. link 3088 77AE C060 MOV @FAC4,R1 Numeric, ref. link=@FAC4(v.s.) 77B0 834E 3089 77B2 108C JMP SCAL24 Now set the link and go on 3090 * 3091 * Here when done parsing actuals 3092 * 3093 77B4 06A0 SCAL60 BL @PGMCHR Pass the right parenthesis 77B6 6C74 3094 77B8 06A0 SCAL62 BL @EOSTMT Must be at end of statement 77BA 6862 3095 77BC 165D JNE88 JNE SCAL88 If not, error 3096 77BE C0C7 MOV R7,R3 Formals must also have ended 3097 77C0 05C7 INCT R7 3098 77C2 C807 MOV R7,@FAC Keep R7, POPSTK destorys R7 77C4 834A 3099 77C6 06A0 BL @GET1 Get the last arg address 77C8 6C9E 3100 77CA C041 MOV R1,R1 Formals end? 3101 77CC 1655 JNE SCAL88 Didn't, so error 3102 * 3103 * Now set up the stack entry 3104 * 3105 77CE 06A0 BL @VPUSH Check if enough room for push 77D0 6BAA 3106 77D2 6820 S @C8,@VSPTR Get back right pointer 77D4 706C 77D6 836E 3107 77D8 06A0 BL @POPSTK Retrieve ptr to subprog s.t. 77DA 60D4 3108 77DC 020C LI R12,FAC For code optimization 77DE 834A 3109 77E0 C04C MOV R12,R1 Store following data in FAC 3110 77E2 C81C MOV *R12,@ARG2 Save new environment pointer 77E4 835E 3111 * 3112 * First push entry. PGMCHR, EXTRAM, SYMTAB and RAM(SYNBOL) 3113 * 3114 77E6 0200 LI R0,PGMPTR Optimize 77E8 832C 3115 77EA CC70 MOV *R0+,*R1+ Text pointer PGMPTR 3116 77EC CC70 MOV *R0+,*R1+ Line table pointer EXTRAM 3117 77EE CC60 MOV @SYMTAB,*R1+ Symbol table pointer 77F0 833E 3118 77F2 0203 LI R3,SYMBOL Put address of SYMBOL 77F4 0376 3119 77F6 06A0 BL @GET1 Get RAM(SYMBOL) in REG1 77F8 6C9E 3120 77FA C801 MOV R1,@FAC6 Move to FAC area 77FC 8350 3121 77FE 06A0 BL @VPUSH Save first entry 99/4 ASSEMBLER SUBPROGS PAGE 0072 7800 6BAA 3122 * 3123 * Push second entry. Subprogram table pointer, >6A on warnin 3124 * bits and @LSUBP in the second stack. 3125 7802 C10C MOV R12,R4 Going to build entry in FAC 3126 7804 CD20 MOV @ARG,*R4+ Subprogram table entry pointer 7806 835C 3127 7808 DD20 MOVB @DCBH6A,*R4+ >6A = Stack ID 780A 7709 3128 780C D0A0 MOVB @FLAG,R2 Warning/break bits 780E 8345 3129 7810 0242 ANDI R2,>0600 Mask off other bits 7812 0600 3130 7814 DD02 MOVB R2,*R4+ Put bits in stack entry 3131 7816 C820 MOV @LSUBP,@FAC6 Last subprogram block on stack 7818 8348 781A 8350 3132 781C 06A0 BL @VPUSH Push final entry 781E 6BAA 3133 7820 C820 MOV @VSPTR,@LSUBP Set bottom of stack for the su 7822 836E 7824 8348 3134 * 3135 * Now build the new environment by modifying PGMCHR, 3136 * EXTRAM and pointer to sub's symbol table. 3137 7826 0200 LI R0,PGMPTR Optimization 7828 832C 3138 782A D7E0 MOVB @ARG3,*R15 2nd byte of address 782C 835F 3139 782E 0201 LI R1,XVDPRD Optimize to save bytes 7830 8800 3140 7832 D7E0 MOVB @ARG2,*R15 1st byte of address 7834 835E 3141 7836 0204 LI R4,4 Need 4 bytes 7838 0004 3142 783A DC11 SCAL70 MOVB *R1,*R0+ Read EXTRAM and PGMPTR 3143 783C 0604 DEC R4 3144 783E 16FD JNE SCAL70 3145 7840 D811 MOVB *R1,@SYMTAB New SYMTAB 7842 833E 3146 7844 0204 LI R4,SYMBOL 7846 0376 3147 7848 D811 MOVB *R1,@SYMTA1 784A 833F 3148 784C C060 MOV @SYMTAB,R1 784E 833E 3149 7850 06A0 BL @PUT1 New RAM(SYMBOL) 7852 6CB2 3150 7854 04E0 CLR @ERRCOD Clean up our mess 7856 8322 3151 7858 06A0 BL @PGMCHR Get the next token into R8 785A 6C74 3152 *----------------------------------------------------------- 3153 * Fix "A error happened in a CALL statement keeps it 3154 * "in-use flag set" bug, 5/23/81 3155 * Insert following lines: 3156 785C 0203 LI R3,>0374 Restore the pointer to table 785E 0374 3157 * entry from VDP temporary, R3: address reg. for GET1 99/4 ASSEMBLER SUBPROGS PAGE 0073 3158 7860 06A0 BL @GET1 7862 6C9E 3159 7864 C0C1 MOV R1,R3 Get flag byte 3160 7866 06A0 BL @GETV1 7868 1880 3161 786A F060 SOCB @INUSE,R1 Set the in-use flag bit 786C 7504 3162 786E C103 MOV R3,R4 ?????????????????????????????? 3163 7870 06A0 BL @PUTV1 Put the byte back 7872 6422 3164 *----------------------------------------------------------- 3165 7874 0460 B @NUDEND Enter the subprogram 7876 65F0 3166 7878 0200 SCAL88 LI R0,ERRIAL * INCORRECT ARGUMENT LIST 787A 0E03 3167 787C 1062 JMP $+>C6 Jump to B @ERR 3168 ************************************************************ 3169 * Fetch next formal and prop for adjustment 3170 * Register modification 3171 * R5 Address of s.t. entry (formal's entry) 3172 * R6 Header byte of formal's entry 3173 * R7 Updated formal's pointer 3174 * Destroys: R1, R2, R3, R4, R11, R12 3175 ************************************************************ 3176 787E C30B SCAL80 MOV R11,R12 Save return address 3177 7880 C0C7 MOV R7,R3 Fetch symbol pointer 3178 7882 05C7 INCT R7 Point to next formal 3179 7884 06A0 BL @GET1 Fetch s.t. pointer 7886 6C9E 3180 7888 C0C1 MOV R1,R3 Set condition & put in place 3181 788A 13F6 JEQ SCAL88 If to many actuals 3182 788C C101 MOV R1,R4 Save for below 3183 788E C141 MOV R1,R5 Save for return 3184 7890 06A0 BL @GET1 Get header bytes 7892 6C9E 3185 7894 2060 COC @SHRFLG,R1 Shared? 7896 7508 3186 7898 1313 JEQ SCAL82 Yes, reset flag and old value 3187 789A C181 MOV R1,R6 Save for return & test string 3188 789C 1101 JLT SCAL81 If it is a string, then SCAL81 3189 789E 045C B *R12 Return 3190 78A0 0223 SCAL81 AI R3,6 Is string, point at value ptr 78A2 0006 3191 78A4 06A0 BL @GET1 Get the value pointer 78A6 6C9E 3192 78A8 C101 MOV R1,R4 Null value? 3193 78AA 1312 JEQ SCAL86 Yes 3194 78AC 04C1 CLR R1 No, must free current string 3195 78AE 0224 AI R4,-3 Point at the backpointer 78B0 FFFD 3196 78B2 06A0 BL @PUT1 Clear the backpointer 78B4 6CB2 3197 78B6 C103 MOV R3,R4 3198 78B8 04C1 SCAL84 CLR R1 Needed for entry from below 3199 78BA 06A0 BL @PUT1 Clear the forward pointer 78BC 6CB2 3200 78BE 045C B *R12 Just return 3201 78C0 0241 SCAL82 ANDI R1,>DFFF Reset the share flag 78C2 DFFF 99/4 ASSEMBLER SUBPROGS PAGE 0074 3202 78C4 06A0 BL @PUTV1 Put it there 78C6 6422 3203 78C8 0224 AI R4,6 Point at ref pointer 78CA 0006 3204 78CC C181 MOV R1,R6 Set for return 3205 78CE 11F4 JLT SCAL84 If string clear ref pointer 3206 78D0 045C SCAL86 B *R12 Return 3207 ************************************************************ 3208 * Execute a SUBEXIT or SUBEND 3209 ************************************************************ 3210 78D2 C160 SUBXIT MOV @LSUBP,R5 Check for subprogram on stack 78D4 8348 3211 78D6 1333 JEQ SCAL98 Not one, so error 3212 78D8 8805 C R5,@VSPTR Extra check on stack pointer 78DA 836E 3213 78DC 1B30 JH SCAL98 Pointers are messed up, error 3214 78DE 06A0 SBXT05 BL @VPOP Get stack entry 78E0 6C2A 3215 78E2 9820 CB @FAC2,@DCBH6A Reached the subprogram entry? 78E4 834C 78E6 7709 3216 78E8 16FA JNE SBXT05 Not yet 3217 * 3218 * Reached the subprogram stack entry. Get information FAC 3219 * area has subprograms table pointer, >6A, on warning bits 3220 * and LSUBP 3221 78EA 020C LI R12,FAC Optimize for the copies 78EC 834A 3222 78EE C00C MOV R12,R0 For this copy 3223 78F0 C0F0 MOV *R0+,R3 Subprogram pointer 3224 78F2 06A0 BL @GETV1 Get header byte in subprogram 78F4 1880 3225 78F6 5060 SZCB @INUSE,R1 Reset the in-use bit 78F8 7504 3226 78FA C103 MOV R3,R4 3227 78FC 06A0 BL @PUTV1 Put it back 78FE 6422 3228 7900 C070 MOV *R0+,R1 On warning bits 3229 7902 D120 MOVB @FLAG,R4 Get the current flag 7904 8345 3230 7906 0244 ANDI R4,>F900 Trash current warning bits 7908 F900 3231 790A F120 SOCB @R1LB,R4 OR the old ones back in 790C 83E3 3232 790E D804 MOVB R4,@FLAG And put flag back 7910 8345 3233 7912 05C0 INCT R0 There is one word empty 3234 7914 C830 MOV *R0+,@LSUBP Last subprogram block on stack 7916 8348 3235 * 3236 * Second subprogram stack entry. Restore pointers. FAC area 3237 * has PGMPTR, EXTRAM, SYMTAB, RAM(SYMBOL) 3238 7918 06A0 BL @VPOP Get second entry 791A 6C2A 3239 791C C00C MOV R12,R0 Put FAC in R0. (optimization) 3240 791E 0201 LI R1,PGMPTR For optimization 7920 832C 3241 7922 C470 MOV *R0+,*R1 Restore text pointer PGMPTR 3242 7924 0631 DEC *R1+ Save code to decrement it 99/4 ASSEMBLER SUBPROGS PAGE 0075 3243 7926 CC70 MOV *R0+,*R1+ Line table pointer EXTRAM 3244 7928 C830 MOV *R0+,@SYMTAB Restore symbol table pointer 792A 833E 3245 792C C070 MOV *R0+,R1 Restore permanent s.t. pointer 3246 792E 0204 LI R4,SYMBOL Place in VDP 7930 0376 3247 7932 06A0 BL @PUT1 Put it out there 7934 6CB2 3248 7936 06A0 BL @PGMCHR Load R8 with EOS/EOL & go on 7938 6C74 3249 793A 0460 B @EOL 793C 65D6 3250 793E 0200 SCAL98 LI R0,ERRSND * SUBEND NOT IN SUBPROGRAM 7940 1203 3251 7942 0460 B @ERR 7944 6652 3252 ************************************************************ 3253 3254 3256 3257 ************************************************************ 3258 * RESOLV - Attempt to resolve all subprograms referenced in 3259 * call statements by first searching the internal subprogram 3260 * table (SUBTAB), then by searching GROMs for GPL 3261 * subprograms. In RESGPL, it builds a subprogram table. 3262 * If, after searching all of the subprogram areas, there 3263 * are any subprograms whose location cannot be determined, 3264 * an error occurs. 3265 ************************************************************ 3266 7946 05C9 RESOLV INCT R9 Save return address 3267 7948 C64B MOV R11,*R9 3268 794A C160 MOV @CALIST,R5 Pick up call list pointer 794C 830A 3269 794E 1337 JEQ RES50 If no subprogram references 3270 7950 C1A0 RES03 MOV @SUBTAB,R6 Pick up subprogram table ptr 7952 833A 3271 7954 1327 RES05 JEQ RES15 Try to resolve by checking 3272 * 3273 * Compares two names for a match when trying to resolve all 3274 * references to subprograms. 3275 * Register usage is generally as follows: 3276 * R5 - Pointer to CALIST entry to be compared 3277 * R7 - Pointer to entry to be compared to SUBTAB 3278 * Returns as pointer to name if found or zero 3279 * if not found 3280 * R10 - Returned as length of name 3281 7956 C0C6 MOV R6,R3 Put in place for GETV 3282 7958 0583 INC R3 Point at the name length 3283 795A 06A0 BL @GETV1 Get the name length 795C 1880 3284 795E 0981 SRL R1,8 Put in LSB and clear MSB 3285 7960 C101 MOV R1,R4 Save it for the move 3286 7962 0223 AI R3,3 Point at name pointer 7964 0003 3287 7966 06A0 BL @GET1 Get the name pointer 7968 6C9E 3288 796A C1C1 MOV R1,R7 Save in permanent 3289 796C C801 MOV R1,@PGMPTR Save for compare 796E 832C 99/4 ASSEMBLER SUBPROGS2 PAGE 0076 3290 7970 C0C5 MOV R5,R3 To get the CALIST entry 3291 7972 0583 INC R3 Point at the name length 3292 7974 06A0 BL @GETV1 Get the name length 7976 1880 3293 7978 9801 CB R1,@R4LB Name length match? 797A 83E9 3294 797C 161A JNE RES20 No, no match possible 3295 797E C004 MOV R4,R0 Save name length for compare 3296 7980 0223 AI R3,3 Point at the name pointer 7982 0003 3297 7984 06A0 BL @GET1 Get the pointer to the name 7986 6C9E 3298 7988 C0C1 MOV R1,R3 Set up to get the name 3299 798A 06A0 COMPTN BL @GETV1 Get a char of CALIST name 798C 1880 3300 * Next PGMSUB call is the same as PGMCHR except in skipping 3301 * ERAM check 3302 798E 06A0 BL @PGMSUB Get a char of found name 7990 6C7A 3303 7992 9201 CB R1,R8 Chars match? 3304 7994 160E JNE RES20 No, not same name 3305 7996 0583 INC R3 Next character 3306 7998 0600 DEC R0 Done with compare? 3307 799A 16F7 JNE COMPTN No, check the rest 3308 * Found the subprogram in GROM and built the table. 3309 * Set resolved flag and get back. 3310 799C C105 MOV R5,R4 Set resolved flag now 3311 799E 0701 SETO R1 Set up a resolved flag 3312 79A0 06A0 BL @PUTV1 And put the byte in 79A2 6422 3313 79A4 C0C5 RES15 MOV R5,R3 Get call list pointer 3314 79A6 05C3 INCT R3 Point at link 3315 79A8 06A0 BL @GET1 Get the name link 79AA 6C9E 3316 79AC C141 MOV R1,R5 Save and set condition 3317 79AE 130E JEQ RESGPL End of call list? Yes 3318 79B0 16CF JNE RES03 No, go check the next in list 3319 79B2 C0C6 RES20 MOV R6,R3 Get next entry in subpgm table 3320 79B4 05C3 INCT R3 Point at the link 3321 79B6 06A0 BL @GET1 Get the link 79B8 6C9E 3322 79BA C181 MOV R1,R6 Update subprogram table pointe 3323 79BC 10CB JMP RES05 And try next entry 3324 79BE 04C3 RES50 CLR R3 Indicate no error return 3325 79C0 C2D9 RES51 MOV *R9,R11 Restore return address 3326 79C2 0649 DECT R9 Restore stack 3327 79C4 045B RT All resolved and ok 3328 79C6 0203 RES52 LI R3,>001C 79C8 001C 3329 79CA 10FA JMP RES51 3330 ************************************************************ 3331 * RESGPL routine 3332 * Resolves as a GPL subprogram by comparing names in CALL 3333 * list and GROM link list in EXEC. If name found in GROM 3334 * then turn the resolved flag on and if not found an error 3335 * occurs. Fetch subprogram access address from the link 3336 * list and builds a subprogram table for that call. 3337 ************************************************************ 3338 79CC C160 RESGPL MOV @CALIST,R5 Get the call list pointer 99/4 ASSEMBLER SUBPROGS2 PAGE 0077 79CE 830A 3339 * Get the next subprogram in the call list that has not been 3340 * resolved. 3341 79D0 C0C5 GET01 MOV R5,R3 Get pointer in call list 3342 79D2 13F5 JEQ RES50 If end of list 3343 79D4 06A0 BL @GETV1 Get the resolved flag 79D6 1880 3344 79D8 1306 JEQ GPL00 If not resolved 3345 79DA 05C3 GET03 INCT R3 Point at link 3346 79DC 06A0 BL @GET1 Get the link 79DE 6C9E 3347 79E0 C141 MOV R1,R5 Save it and set condition 3348 79E2 16F6 JNE GET01 If not end of list, go on 3349 79E4 10EC JMP RES50 Return 3350 * Start looking at GROM subprogram link list. 3351 79E6 0207 GPL00 LI R7,GPLIST Load address of link list 79E8 A026 3352 79EA C0C5 MOV R5,R3 Copy CALIST address 3353 79EC 0583 INC R3 Point to name length 3354 79EE 06A0 BL @GETV1 Get the name length 79F0 1880 3355 79F2 0981 SRL R1,8 Adjust to the right byte 3356 79F4 C001 MOV R1,R0 Copy for later use 3357 79F6 04CA CLR R10 Clear for name length 3358 79F8 0223 AI R3,3 Point to name ptr in call list 79FA 0003 3359 79FC DB47 GPL10 MOVB R7,@GRMWAX(R13) Specify address in link list 79FE 0402 3360 7A00 06C7 SWPB R7 Need to kill time here 3361 7A02 DB47 MOVB R7,@GRMWAX(R13) Move next byte 7A04 0402 3362 7A06 06C7 SWPB R7 Get R7 in right order 3363 7A08 D21D MOVB *R13,R8 Read next link address from 3364 7A0A D81D MOVB *R13,@R8LB linked list 7A0C 83F1 3365 7A0E 05C7 INCT R7 Point to name length in GROM 3366 7A10 DB47 MOVB R7,@GRMWAX(R13) Specify name length address 7A12 0402 3367 7A14 06C7 SWPB R7 Need to kill time here 3368 7A16 DB47 MOVB R7,@GRMWAX(R13) Move next byte 7A18 0402 3369 7A1A 06C7 SWPB R7 Get R7 in right order 3370 7A1C D81D MOVB *R13,@R10LB Get the name length in GROM 7A1E 83F5 3371 7A20 8280 C R0,R10 Compare name length 3372 7A22 1304 JEQ GPL25 If matches, compare names 3373 7A24 C1C8 GPLNXT MOV R8,R7 Didn't match, get link to next 3374 7A26 16EA JNE GPL10 Loop if not end of list 3375 7A28 C0C5 MOV R5,R3 If end of GPL list, ignore thi 3376 7A2A 10D7 JMP GET03 entry in CALIST 3377 * Start comparing the names 3378 7A2C 06A0 GPL25 BL @GET1 Get name ptr form call list 7A2E 6C9E 3379 * R1 contains address of name 3380 7A30 D7E0 MOVB @R1LB,*R15 Get one character from VDP 7A32 83E3 3381 7A34 1000 NOP 3382 7A36 D7C1 MOVB R1,*R15 Then compare with the one in 3383 7A38 981D GPL30 CB *R13,@XVDPRD GROM - R13 points to GROM 99/4 ASSEMBLER SUBPROGS2 PAGE 0078 7A3A 8800 3384 7A3C 16F3 JNE GPLNXT If no match get next in GROM 3385 7A3E 060A DEC R10 All matched? 3386 7A40 16FB JNE GPL30 No, loop for next characters 3387 * Found the GPL subprogram. Now start building GPL's 3388 * subprogram table. 3389 * First put all information in FAC since they might get 3390 * destroyed in MEMCHK. 3391 * @FAC2 = Set program bit and name length 3392 * @FAC4 = Subprogram table link address 3393 * @FAC6 = Pointer to name 3394 * @FAC8 = Access address in GROM 3395 * @FAC10 = Current call list address 3396 7A42 020C LI R12,FAC2 Optimize for speed and space 7A44 834C 3397 7A46 C700 MOV R0,*R12 Keep length in FAC2 3398 7A48 EF20 SOC @FNCFLG,*R12+ Set program bit 7A4A 7506 3399 7A4C CF20 MOV @SUBTAB,*R12+ Set up subtable link address 7A4E 833A 3400 7A50 06A0 BL @GET1 Get pointer to name 7A52 6C9E 3401 7A54 CF01 MOV R1,*R12+ Move it to FAC6 3402 7A56 DF1D MOVB *R13,*R12+ Get access address from GROM 3403 7A58 1000 NOP 3404 7A5A DF1D MOVB *R13,*R12+ and put it in FAC8 3405 7A5C C705 MOV R5,*R12 Save current call list address 3406 * Check if ERAM exists or imperative statement. If so then 3407 * copy name into appropriate VDP area. 3408 7A5E D1A0 MOVB @RAMFLG,R6 ERAM present? 7A60 8389 3409 7A62 1603 JNE GPL40 Yes, then save name in table 3410 7A64 D1A0 MOVB @PRGFLG,R6 Imperative call 7A66 8344 3411 7A68 1619 JNE GPL60 No, handle normally 3412 * Copy name into table area 3413 7A6A C800 GPL40 MOV R0,@FAC Copy name length 7A6C 834A 3414 7A6E 06A0 BL @MEMCHK Get the space. FAC = name leng 7A70 72D8 3415 7A72 79C6 DATA RES52 Error return address 3416 7A74 C0E0 MOV @FAC6,R3 Get pointer to name 7A76 8350 3417 7A78 6820 S @FAC,@FREPTR New free pointer 7A7A 834A 7A7C 8340 3418 7A7E C120 MOV @FREPTR,R4 New place of name 7A80 8340 3419 7A82 0584 INC R4 3420 7A84 C804 MOV R4,@FAC6 New pointer to name 7A86 8350 3421 7A88 C0A0 MOV @FAC,R2 Counter for the move 7A8A 834A 3422 * Now copy the name, character by character 3423 7A8C 06A0 GPL50 BL @GETV1 Get a byte 7A8E 1880 3424 7A90 06A0 BL @PUTV1 Put a byte 7A92 6422 3425 7A94 0583 INC R3 99/4 ASSEMBLER SUBPROGS2 PAGE 0079 3426 7A96 0584 INC R4 3427 7A98 0602 DEC R2 Done? 3428 7A9A 16F8 JNE GPL50 No, move the rest 3429 * Restore all the information from FAC area and build 3430 * subprograms symbol table. 3431 7A9C C820 GPL60 MOV @C8,@FAC Need 8 bytes 7A9E 706C 7AA0 834A 3432 7AA2 06A0 BL @MEMCHK Get the bytes. Check the space 7AA4 72D8 3433 7AA6 79C6 DATA RES52 Error return address 3434 7AA8 6820 S @C8,@FREPTR Updata the free pointer 7AAA 706C 7AAC 8340 3435 7AAE C020 MOV @FREPTR,R0 Get location to move to 7AB0 8340 3436 7AB2 0580 INC R0 True pointer 3437 7AB4 C800 MOV R0,@SUBTAB Update subprogram table ptr 7AB6 833A 3438 7AB8 0201 LI R1,FAC2 Subprograms info starts FAC2 7ABA 834C 3439 7ABC D7E0 MOVB @R0LB,*R15 Load out address 7ABE 83E1 3440 7AC0 0260 ORI R0,WRVDP Enable VDP write 7AC2 4000 3441 7AC4 D7C0 MOVB R0,*R15 3442 7AC6 0200 LI R0,XVDPWD Optimize to save bytes 7AC8 8C00 3443 7ACA 0203 LI R3,8 Going to move 8 bytes 7ACC 0008 3444 7ACE D431 GPL70 MOVB *R1+,*R0 Copy mode, name length, link, 3445 7AD0 0603 DEC R3 ptr to name, ptr to subprogra 3446 7AD2 16FD JNE GPL70 3447 7AD4 C0D1 MOV *R1,R3 Restore ptr into call list 3448 7AD6 0460 B @GET03 Check next entry in call list 7AD8 79DA 3449 ************************************************************ 3450 7ADA AORG >7ADA 3452 3453 0005 FLG EQU 5 3454 3455 * R12 total number of bytes to move 3456 * R10 move from 3457 * R9 move to 3458 * R8 minor counter (buffer counter) 3459 * R7 buffer pointer 3460 3461 7ADA 020C SCROLL LI R12,736 Going to move 736 bytes 7ADC 02E0 3462 7ADE 020A LI R10,32 Address to move from 7AE0 0020 3463 7AE2 04C9 CLR R9 Address to move to 3464 7AE4 C18B MOV R11,R6 Save return address 3465 7AE6 06A0 BL @SCRO1 Scroll the screen 7AE8 7B10 3466 7AEA 0205 LI R5,XVDPWD Optimize for speed later 7AEC 8C00 3467 7AEE 0204 LI R4,>02E0 Addr of bottom line on screen 7AF0 02E0 99/4 ASSEMBLER SCROLLS PAGE 0080 3468 7AF2 0201 LI R1,>7F80 Edge character and space char 7AF4 7F80 3469 7AF6 0202 LI R2,28 28 characters on bottom line 7AF8 001C 3470 7AFA 06A0 BL @PUTV1 Init VDP & put out 1st edge ch 7AFC 6422 3471 7AFE D541 MOVB R1,*R5 Put out 2nd edge character 3472 7B00 06C1 SWPB R1 Bare the space character 3473 7B02 D541 SCRBOT MOVB R1,*R5 Write out space character 3474 7B04 0602 DEC R2 One less to move 3475 7B06 16FD JNE SCRBOT Loop if more 3476 7B08 06C1 SWPB R1 Bare the edge character again 3477 7B0A D541 MOVB R1,*R5 Output edge character 3478 7B0C D541 MOVB R1,*R5 Output edge character 3479 7B0E 0456 B *R6 And return go GPL 3480 * Generalized move routine 3481 7B10 04C8 SCRO1 CLR R8 Clear minor counter 3482 7B12 D7E0 MOVB @R10LB,*R15 Write out LSB of read-address 7B14 83F5 3483 7B16 02A7 STWP R7 Get the WorkSpace pointer 3484 7B18 D7CA MOVB R10,*R15 Write out MSB of read-address 3485 7B1A DDE0 SCRO2 MOVB @XVDPRD,*R7+ Read a byte 7B1C 8800 3486 7B1E 058A INC R10 Inc read-from address 3487 7B20 0588 INC R8 Inc minor counter 3488 7B22 060C DEC R12 Dec total counter 3489 7B24 1303 JEQ SCRO4 If all bytes read-write them 3490 7B26 0288 CI R8,12 Filled WorkSpace buffer area? 7B28 000C 3491 7B2A 11F7 JLT SCRO2 No, read more 3492 7B2C D7E0 SCRO4 MOVB @R9LB,*R15 Write LSB of write-address 7B2E 83F3 3493 7B30 0269 ORI R9,WRVDP Enable the VDP write 7B32 4000 3494 7B34 D7C9 MOVB R9,*R15 Write MSB of write-address 3495 7B36 02A7 STWP R7 Get WorkSpace buffer pointer 3496 7B38 D837 SCRO6 MOVB *R7+,@XVDPWD Write a byte 7B3A 8C00 3497 7B3C 0589 INC R9 Increment write-address 3498 7B3E 0608 DEC R8 Decrement counter 3499 7B40 16FB JNE SCRO6 Move more if not done 3500 7B42 C30C MOV R12,R12 More on major counter? 3501 7B44 16E5 JNE SCRO1 No, go do another read 3502 7B46 045B RT Yes, done 3503 ************************************************************ 3504 * Decode which I/O utility is being called 3505 * Tag field following the XML IO has the following 3506 * meaning: 3507 * 0 - Line list - utility to search keyword table to 3508 * restore keyword from token 3509 * 1 - Fill space - utility to fill record with space 3510 * when outputting imcomplete records 3511 * 2 - Copy string - utility to copy a string, adding 3512 * the screen offset to each character for display 3513 * purposes 3514 * 3 - Clear ERAM - utility to clear ERAM at the address 3515 * specified by the data word following the IO tag 3516 * and the # of bytes specified by the length 3517 * following the address word. Note that each data 99/4 ASSEMBLER SCROLLS PAGE 0081 3518 * word is the address of a CPU memory location. 3519 ************************************************************ 3520 7B48 D01D IO MOVB *R13,R0 Read selector from GROM 3521 7B4A 0980 SRL R0,8 Shift for decoding 3522 7B4C 1358 JEQ LLIST 0 is tag for Line list 3523 7B4E 0600 DEC R0 3524 7B50 132C JEQ FILSPC 1 is tag for Fill space 3525 7B52 0600 DEC R0 3526 7B54 130E JEQ CSTRIN 2 is tag for Copy string 3527 * 3 is tag for CLRGRM string 3528 * fall into it 3529 * CALGRM 3530 * R1 - address of clearing start 3531 * R2 - number of bytes to clear 3532 7B56 0201 CLRGRM LI R1,PAD0 Get CPU RAM offset 7B58 8300 3533 7B5A C081 MOV R1,R2 Need for next read too 3534 7B5C B81D AB *R13,@R1LB Add address of ERAM pointer 7B5E 83E3 3535 7B60 C051 MOV *R1,R1 Read the ERAM address 3536 7B62 B81D AB *R13,@R2LB Read address of byte count 7B64 83E5 3537 7B66 C092 MOV *R2,R2 Read the byte count 3538 7B68 04C0 CLR R0 Clear of clearing ERAM 3539 7B6A DC40 CLRGR1 MOVB R0,*R1+ Clear a byte 3540 7B6C 0602 DEC R2 One less to clear, done? 3541 7B6E 16FD JNE CLRGR1 No, loop for rest 3542 7B70 045B RT Yes, return 3543 * CSTRIN 3544 * R0 - MNUM 3545 * R1 - GETV/PUTV buffer 3546 * R3 - FAC4/GETV address 3547 * R5 - return address 3548 7B72 C14B CSTRIN MOV R11,R5 Save return address 3549 7B74 D020 MOVB @MNUM,R0 Get MNUM 7B76 8302 3550 7B78 1317 JEQ CSTR1O If no bytes to copy 3551 7B7A 0980 SRL R0,8 Shift to use as counter 3552 7B7C C120 MOV @CCPADR,R4 Get copy-to address 7B7E 8308 3553 7B80 C0E0 MOV @FAC4,R3 Get copy-from address 7B82 834E 3554 7B84 06A0 CSTRO5 BL @GETV1 Get byte 7B86 1880 3555 7B88 B060 AB @DSRFLG,R1 Add screen offset 7B8A 8317 3556 7B8C 06A0 BL @PUTV1 Put the offset byte out 7B8E 6422 3557 7B90 0583 INC R3 Increment from address 3558 7B92 0584 INC R4 Increment to address 3559 7B94 0600 DEC R0 One less to move 3560 7B96 16F6 JNE CSTRO5 Loop if not done 3561 7B98 C803 MOV R3,@FAC4 Restore for GPL 7B9A 834E 3562 7B9C D800 CSTR07 MOVB R0,@MNUM Clear for GPL 7B9E 8302 3563 7BA3 CCBHFF EQU $+3 3564 7BA0 0244 ANDI R4,>BFFF Throw away VDP write enable 7BA2 BFFF 99/4 ASSEMBLER SCROLLS PAGE 0082 3565 7BA4 C804 MOV R4,@CCPADR Restore for GPL 7BA6 8308 3566 7BA8 FILSZ6 EQU $ 3567 7BA8 0455 CSTR1O B *R5 Return 3568 * FILSPC 3569 * R0 - MNUM 3570 * R1 - Buffer for GETV/PUTV 3571 * R2 - MNUM1 3572 * R3 - Pointer for GETV 3573 * R4 - CCPADR, pointer for PUTV 3574 * R5 - return address 3575 7BAA C14B FILSPC MOV R11,R5 Save return address 3576 7BAC D0A0 MOVB @MNUM1,R2 Get pointer to end of record 7BAE 8303 3577 7BB0 1604 JNE FILSZ1 If space to fill for sure 3578 7BB2 9802 CB R2,@CCPPTR Any filling to do? 7BB4 8306 3579 7BB6 1604 JNE FILSZ2 Yes, do it normalling 3580 7BB8 0455 B *R5 No, 255 record already full 3581 7BBA 9802 FILSZ1 CB R2,@CCPPTR Any filling to do? 7BBC 8306 3582 7BBE 12F4 JLE FILSZ6 No, record is complete 3583 7BC0 70A0 FILSZ2 SB @CCPPTR,R2 Compute # of bytes to change 7BC2 8306 3584 7BC4 B802 AB R2,@CCPPTR Point to end 7BC6 8306 3585 7BC8 D020 MOVB @DSRFLG,R0 Filling with zeroes? 7BCA 8317 3586 7BCC 160A JNE FILSZ3 No, fill with spaces 3587 7BCE C0E0 MOV @PABPTR,R3 Check if internal files 7BD0 8304 3588 7BD2 0223 AI R3,FLG 5 byte offset into PAB 7BD4 0005 3589 7BD6 04C1 CLR R1 Initialize to test below 3590 7BD8 06A0 BL @GETV1 Get byte from PAB 7BDA 1880 3591 7BDC 0241 ANDI R1,>0800 Internal? 7BDE 0800 3592 7BE0 1602 JNE FILSZ4 Yes, zero fill 3593 7BE2 0220 FILSZ3 AI R0,>2000 Add space character for filler 7BE4 2000 3594 7BE6 0982 FILSZ4 SRL R2,8 Shift count for looping 3595 7BE8 C120 MOV @CCPADR,R4 Get start address to fill 7BEA 8308 3596 7BEC D040 MOVB R0,R1 Put filler in place for PUTV 3597 7BEE 06A0 FILSZ5 BL @PUTV1 Put out a filler 7BF0 6422 3598 7BF2 0584 INC R4 Increment filler position 3599 7BF4 0602 DEC R2 One less to fill 3600 7BF6 16FB JNE FILSZ5 Loop if move 3601 7BF8 D802 MOVB R2,@MNUM1 Restore for GPL 7BFA 8303 3602 7BFC 10CF JMP CSTR07 3603 * LLIST 3604 * R0 - FAC - address of keytab in GROM 3605 * R1 - keyword length 3606 7BFE C30B LLIST MOV R11,R12 Save return address 3607 7C00 06A0 BL @PUTSTK Save GROM address 7C02 60F2 99/4 ASSEMBLER SCROLLS PAGE 0083 3608 7C04 C020 MOV @FAC,R0 Get address of keytab 7C06 834A 3609 7C08 D220 MOVB @CHAT,R8 Get token to search for 7C0A 8342 3610 7C0C 0201 LI R1,1 Assume one character keyword 7C0E 0001 3611 7C10 DB40 LLISZ4 MOVB R0,@GRMWAX(R13) Load GROM address of table 7C12 0402 3612 7C14 DB60 MOVB @R0LB,@GRMWAX(R13) Both bytes 7C16 83E1 7C18 0402 3613 7C1A D0DD MOVB *R13,R3 Read address of x-char table 3614 7C1C D81D MOVB *R13,@R3LB Both bytes 7C1E 83E7 3615 7C20 A0C1 LLISZ5 A R1,R3 Add length of keyword to point 3616 * at token 3617 7C22 DB43 MOVB R3,@GRMWAX(R13) Write out new GROM address 7C24 0402 3618 7C26 DB60 MOVB @R3LB,@GRMWAX(R13) Which points to token 7C28 83E7 7C2A 0402 3619 7C2C D11D MOVB *R13,R4 Read token value 3620 7C2E D15D MOVB *R13,R5 Read possible end of x-char 3621 * table 3622 7C30 9204 CB R4,R8 Token value match? 3623 7C32 1307 JEQ LLISZ6 Yes!!! Found the keyword 3624 7C34 0583 INC R3 No, so skip token value 3625 7C36 9805 CB R5,@CCBHFF Reach end of x-char table? 7C38 7BA3 3626 7C3A 16F2 JNE LLISZ5 No, so check more in the table 3627 7C3C 05C0 INCT R0 Point into x+1 char table 3628 7C3E 0581 INC R1 Try x+1 char table 3629 7C40 10E7 JMP LLISZ4 Loop to check it 3630 * Come here when found keyword 3631 7C42 60C1 LLISZ6 S R1,R3 Subtract length to pnt at K.W. 3632 7C44 C803 MOV R3,@FAC8 Save ptr to KeyWord for GPL 7C46 8352 3633 7C48 C801 MOV R1,@FAC4 Save KeyWord length for GPL 7C4A 834E 3634 7C4C D808 MOVB R8,@FAC Save CHAT for GPL 7C4E 834A 3635 7C50 06A0 BL @GETSTK Restore GROM addres 7C52 610E 3636 7C54 045C B *R12 And return to GPL 3637 ************************************************************ 3638 7C56 AORG >7C56 3640 3641 0088 RETURZ EQU >88 3642 0089 DEFZ EQU >89 3643 008A DIMZ EQU >8A 3644 008B ENDZ EQU >8B 3645 008C FORZ EQU >8C 3646 0092 INPUTZ EQU >92 3647 0093 DATAZ EQU >93 3648 009A REMZ EQU >9A 3649 009B ONZ EQU >9B 3650 009D CALLZ EQU >9D 3651 009E OPTIOZ EQU >9E 3652 00A3 IMAGEZ EQU >A3 99/4 ASSEMBLER SCANS PAGE 0084 3653 00A7 SUBXTZ EQU >A7 3654 00A8 SUBNDZ EQU >A8 3655 00AA LINPUZ EQU >AA 3656 00B2 STEPZ EQU >B2 3657 00C7 NUMZ EQU >C7 3658 *----------------------------------------------------------- 3659 * Added for "NOPSCAN" feature 6/8/81 3660 0040 P1 EQU >40 @ 3661 0050 P2 EQU >50 P 3662 002B P3 EQU >2B + 3663 002D P4 EQU >2D - 3664 0070 P5 EQU >70 p 3665 03B7 PSCFG EQU >03B7 VDP temporary: PSCAN flag 3666 * >00 : no pscan 3667 * >FF : pscan 3668 *----------------------------------------------------------- 3669 3670 *----------------------------------------------------------- 3671 * SCAN routine is changed for implementing "NOPSCAN" 3672 * feature, 6/8/81 3673 * "!@P+" or "!@p+" is RESUME PSCAN 3674 * "!@P-" or "!@p-" is NO PSCAN 3675 *----------------------------------------------------------- 3676 * 3677 ************************************************************ 3678 * SCAN is the main looping structure of the prescan routine. 3679 * Takes care of scanning each statement in a line. Goes 3680 * back to GPL to scan the special cases (DEF, OPTION, DIM, 3681 * SUB, CALL, SUBEND, SUBEXIT) and also goes to GPL to enter 3682 * variables into the symbol table. All statements which are 3683 * not allowed to be imperative are checked directly without 3684 * goting to GPL. The NOCARE label is where a non-special 3685 * statement is scanned, looking for variables to enter them 3686 * into the symbol table. 3687 ************************************************************ 3688 7C56 D01D PSCAN MOVB *R13,R0 Read Scan code 3689 7C58 06A0 BL @PUTSTK Save GROM address 7C5A 60F2 3690 7C5C 06A0 BL @SETREG Set up R8/R9 with CHAT/SUBSTK 7C5E 1E7A 3691 * First decode the type of XML being executed 3692 * Types are: >00 - initial call with program 3693 * >01 - resume within a statement after call to 3694 * GPL for some reason 3695 * >02 - initial call for imperative statement 3696 7C60 0980 SRL R0,8 Set condition 3697 7C62 1305 JEQ SCAN05 If calling scan routine w/pgm 3698 7C64 0600 DEC R0 Returning from call to GPL? 3699 7C66 135D JEQ JNCARE Yes, continue w/in line 3700 7C68 C819 MOV *R9,@RTNADD 7C6A 8326 3701 7C6C 1050 JMP SCAN10 3702 7C6E A660 SCAN05 A @C3,*R9 Skip following XML and select 7C70 6544 3703 7C72 C819 MOV *R9,@RTNADD Set up rtn to common GPL loc 7C74 8326 3704 7C76 04E0 CLR @DATA Assume out of data 7C78 8334 3705 7C7A 8820 SCAN5A C @LINUM,@EXTRAM End of program yet? 99/4 ASSEMBLER SCANS PAGE 0085 7C7C 8312 7C7E 832E 3706 7C80 161B JNE SCAN07 No, get next line 3707 7C82 D020 SCAN5B MOVB @FORNET,R0 Check fornext counter 7C84 8317 3708 7C86 1655 JNE FNERR For/Next error 3709 7C88 D020 MOVB @XFLAG,R0 Check subprogram bits 7C8A 8316 3710 7C8D CBH40 EQU $+1 3711 7C8C 0A40 SLA R0,4 Subprogram encountered? 3712 7C8E 1108 JLT SCAN6A Yes, check subend 3713 7C90 0200 SCAN06 LI R0,>A000 Initialize data stack 7C92 A000 3714 7C94 D800 MOVB R0,@STACK 7C96 8373 3715 7C98 06A0 BL @RESOLV Resolve any subprogram refs 7C9A 7946 3716 7C9C 0460 B @GPL05 Return 7C9E 7E5E 3717 7CA0 0A40 SCAN6A SLA R0,4 Subend encountered? 3718 7CA2 1707 JNC ERRMS No, text ended w/out subend 3719 7CA4 0203 LI R3,TABSAV Get main symbol table's ptr 7CA6 0392 3720 7CA8 06A0 BL @GET1 Get it 7CAA 6C9E 3721 7CAC C801 MOV R1,@SYMTAB 7CAE 833E 3722 7CB0 10EF JMP SCAN06 Merge back in 3723 7CB2 0203 ERRMS LI R3,>18 * MISSING SUBEND 7CB4 0018 3724 7CB6 1076 JMP GPL05L 3725 7CB8 6820 SCAN07 S @C4,@EXTRAM Go to next line in program 7CBA 6A80 7CBC 832E 3726 7CBE D020 MOVB @RAMTOP,R0 ERAM program? 7CC0 8384 3727 7CC2 1604 JNE SCAN08 Yes, handle ERAM 3728 7CC4 06A0 BL @GET No, het new line pointer in VD 7CC6 6C9A 3729 7CC8 832E DATA EXTRAM 3730 7CCA 1003 JMP SCAN09 3731 7CCC 06A0 SCAN08 BL @GETG Get new line pointer from GRAM 7CCE 6CCA 3732 7CD0 832E DATA EXTRAM 3733 7CD2 C801 SCAN09 MOV R1,@PGMPTR Put new line pointer into perm 7CD4 832C 3734 7CD6 5820 SZCB @CBH40,@XFLAG Reset IFFLAG only on new line 7CD8 7C8D 7CDA 8316 3735 *----------------------------------------------------------- 3736 * Following is changed for adding "nopscan" feature 3737 * SCAN9A @PGMCHR Get 1st token on line 3738 7CDC 06A0 SCAN9A BL @PGMCHR Get 1st token on line 7CDE 6C74 3739 7CE0 0203 LI R3,PSCFG Check the flag to see which 7CE2 03B7 3740 * mode is in: NOPSCAN (>00) or PSCAN (>FF) 3741 7CE4 06A0 BL @GETV1 Get the flag from VDP 7CE6 1880 99/4 ASSEMBLER SCANS PAGE 0086 3742 7CE8 1348 JEQ NPSCAN NOPSCAN mode 3743 *----------------------------------------------------------- 3744 7CEA 5820 SZCB @CBH94,@XFLAG Reset ENTER, STRFLG, and FNCFL 7CEC 6005 7CEE 8316 3745 7CF0 D020 MOVB @XFLAG,R0 Get flag bits 7CF2 8316 3746 7CF4 0A80 SLA R0,8 Shift to check REMODE 3747 7CF6 170B JNC SCAN10 If not in REMODE 3748 7CF8 D208 MOVB R8,R8 Check if token 3749 7CFA 1103 JLT SCAN11 If token, look further 3750 7CFC 0203 ERRIBS LI R3,>1E * ILLEGAL BETWEEN SUBPROGRAMS 7CFE 001E 3751 7D00 1051 JMP GPL05L Goto error return 3752 7D02 0706 SCAN11 SETO R6 Set up index into table 3753 7D04 0586 SCAN12 INC R6 Increment to 1st/next element 3754 7D06 9988 CB R8,@IBSTAB(R6) legal stmt between subprogdams 7D08 7EA0 3755 7D0A 1BFC JH SCAN12 Not able to tell, check furthe 3756 7D0C 1AF7 JL ERRIBS Illegal statement here 3757 7D0E 04C6 SCAN10 CLR R6 Offset into special stmt table 3758 7D10 C0E6 SCAN15 MOV @SCNTAB(R6),R3 Read entry from special table 7D12 7E70 3759 7D14 9203 CB R3,R8 Match this token? 3760 7D16 1306 JEQ SCAN20 Yes, handle special case 3761 7D18 1B74 JH NOCARE Didn't match but passed in tab 3762 7D1A 05C6 INCT R6 Increment offset into table 3763 7D1C 0286 CI R6,TABLEN Reach end of table? 7D1E 0030 3764 7D20 16F7 JNE SCAN15 No, check further 3765 7D22 106F JNCARE JMP NOCARE End of table, not special case 3766 7D24 0A83 SCAN20 SLA R3,8 Look at special case byte 3767 7D26 1103 JLT SCGPL1 If MSB set, goto GPL 3768 7D28 06C3 SWPB R3 MSB reset, offset into 9900 3769 7D2A 0463 B @OFFSET(R3) Branch to 9900 special handler 7D2C 7D84 3770 7D2E 0460 SCGPL1 B @SCNGPL 7D30 7E58 3771 7D32 0460 FNERR B @FNNERR 7D34 7E4C 3772 *----------------------------------------------------------- 3773 * These are added for "nopscan" feature 6/8/81 3774 7D36 D020 SCAN26 MOVB @PRGFLG,R0 In program mode? 7D38 8344 3775 7D3A 13A3 JEQ SCAN5B No, check for/next subs&rtn 3776 7D3C 06A0 SCAN28 BL @PGMCHR Yes, check "!@P+" or "!@P-" 7D3E 6C74 3777 7D40 0288 CI R8,P1*256 "@" following "!"? 7D42 4000 3778 7D44 169A JNE SCAN5A No, goto the next line 3779 7D46 06A0 BL @PGMCHR Yes, check for "P" 7D48 6C74 3780 7D4A 0288 CI R8,P2*256 7D4C 5000 3781 7D4E 1303 JEQ SCAN40 Yes, check for "+" or "-" 3782 7D50 0288 CI R8,P5*256 No, try "p" 7D52 7000 3783 7D54 1692 JNE SCAN5A No, goto the next line 3784 7D56 06A0 SCAN40 BL @PGMCHR Yes, check for "+" or "-" 99/4 ASSEMBLER SCANS PAGE 0087 7D58 6C74 3785 7D5A 0288 CI R8,P3*256 7D5C 2B00 3786 7D5E 130A JEQ SCAN35 "!@P+" is found at the 3787 * beginnning of the line 3788 7D60 0288 CI R8,P4*256 7D62 2D00 3789 7D64 168A JNE SCAN5A Didn't file what we want, 3790 * goto the next line 3791 7D66 0201 LI R1,0 "!@P-" is found, set flag to 7D68 0000 3792 * 0 NO PSCAN 3793 7D6A 0204 SCAN30 LI R4,PSCFG Address register for PUTV1 7D6C 03B7 3794 7D6E 06A0 BL @PUTV1 Set the flag PSCFG in VDP tem. 7D70 6422 3795 7D72 1083 JMP SCAN5A Goto the next line 3796 7D74 0201 SCAN35 LI R1,>FF00 "!@P+", set flag to be >FF so 7D76 FF00 3797 * RESUME PSCAN 3798 7D78 10F8 JMP SCAN30 Use common code to set flag 3799 *----------------------------------------------------------- 3800 *----------------------------------------------------------- 3801 * In NOPSCAN mode, only looking for "!@P+", "!@P-" at the 3802 * beginning of each line 6/8/81 3803 7D7A 0288 NPSCAN CI R8,TREMZ*256 First token on line 7D7C 8300 3804 * is it "!" 3805 7D7E 13DE JEQ SCAN28 Yes, check "!@P+" or "!@P-" 3806 7D80 0460 B @SCAN5A No, ignore the whole line, 7D82 7C7A 3807 * just goto the next line 3808 *----------------------------------------------------------- 3809 OFFSET 3810 7D84 10D8 SCN26A JMP SCAN26 3811 7D86 D020 SCAN25 MOVB @PRGFLG,R0 In imperative mode? 7D88 8344 3812 7D8A 1302 JEQ SCAN5C Yes, check for/next sub & rtn 3813 7D8C 0460 B @SCAN5A No, check next line 7D8E 7C7A 3814 7D90 0460 SCAN5C B @SCAN5B 7D92 7C82 3815 * 9900 code special handlers 3816 7D94 F820 IFIF SOCB @CBH40,@XFLAG Indicate scan of "IF" stmt 7D96 7C8D 7D98 8316 3817 * Special handler for program-only statements 3818 7D9A D020 IMPER MOVB @PRGFLG,R0 Executing in a program? 7D9C 8344 3819 7D9E 1649 JNE NXTCHR Yes, proceed in don't char mod 3820 7DA0 0203 ERRIMP LI R3,>12 Illegal imperative return code 7DA2 0012 3821 7DA4 105C GPL05L JMP GPL05 Return to GPL with error 3822 * Special handler for data-statements 3823 7DA6 D020 DATA1 MOVB @DATA,R0 Data already encountered? 7DA8 8334 3824 7DAA 1606 JNE IMAGE Yes, don't set pointer 3825 7DAC C820 MOV @EXTRAM,@LNBUF Save line buffer pointer 7DAE 832E 99/4 ASSEMBLER SCANS PAGE 0088 7DB0 8336 3826 7DB2 C820 MOV @PGMPTR,@DATA Set line buffer pointer 7DB4 832C 7DB6 8334 3827 * Special handler for image-statements 3828 7DB8 D020 IMAGE MOVB @PRGFLG,R0 In program mode? 7DBA 8344 3829 7DBC 0460 B @SCAN5A Yes, no need to scan line 7DBE 7C7A 3830 7DC0 10EF JMP ERRIMP No, illegal imperative 3831 * Special handler for for-statements 3832 7DC2 05A0 FOR INC @XFLAG Increment the nesting counter 7DC4 8316 3833 7DC6 D020 MOVB @XFLAG,R0 Fetch the IFFLAG 7DC8 8316 3834 7DCA 0240 ANDI R0,>4000 Inside an if-statement? 7DCC 4000 3835 7DCE 1331 JEQ NXTCHR No, continue in don't care mod 3836 7DD0 0203 SNTXER LI R3,>1A * SYNTAX ERROR 7DD2 001A 3837 7DD4 1044 JMP GPL05 3838 * Special handler for next-statements 3839 7DD6 C020 SNEXT MOV @XFLAG,R0 Get flag and for-next counter 7DD8 8316 3840 7DDA 0240 ANDI R0,>40FF Get rid of flag bits except IF 7DDC 40FF 3841 7DDE D000 MOVB R0,R0 IFFLAG set? 3842 7DE0 16F7 JNE SNTXER Yes, syntax error 3843 7DE2 0600 DEC R0 Decrement counter by one 3844 7DE4 D820 MOVB @R0LB,@FORNET Move back to the real conter 7DE6 83E1 7DE8 8317 3845 7DEA 1323 JEQ NXTCHR Returning to top level, ok 3846 7DEC 1522 JGT NXTCHR Still at a secndary level, ok 3847 7DEE 0203 LI R3,>14 For/next nesting return code 7DF0 0014 3848 7DF2 1035 JMP GPL05 Return to GPL with error 3849 7DF4 D020 ELSE MOVB @XFLAG,R0 Get flag byte 7DF6 8316 3850 7DF8 0240 ANDI R0,>4000 Inside an if? 7DFA 4000 3851 7DFC 13E9 JEQ SNTXER No, error 3852 * Special handler for statement seperator 3853 7DFE 0460 SEPSMT B @SCAN9A Skip the '::' and check next 7E00 7CDC 3854 * General don't care scan. Simply looks for variables to 3855 * enter into symbol table; stops on end of statement 3856 7E02 0288 NOCARE CI R8,SSEPZ*256 At a statement separator 7E04 8200 3857 7E06 13FB JEQ SEPSMT Skip and scan next statement 3858 7E08 0288 CI R8,TREMZ*256 At a tail remark? 7E0A 8300 3859 7E0C 13BC JEQ SCAN25 Yes, check mode 3860 7E0E D208 MOVB R8,R8 At an end-of-line or symbol? 3861 7E10 13BA JEQ SCAN25 EOL, checK mode 3862 7E12 151F JGT ENTER Symbol, ENTER in symbol table 3863 7E14 0288 CI R8,LNZ*256 Special line number token? 7E16 C900 3864 7E18 130F JEQ SKIPLN Yes, need to skip it 99/4 ASSEMBLER SCANS PAGE 0089 3865 7E1A 0288 CI R8,NUMZ*256 Special numeric token? 7E1C C700 3866 7E1E 130F JEQ STRSKP Yes, need to skip it 3867 7E20 0288 CI R8,UNQSTZ*256 Special string token? 7E22 C800 3868 7E24 130C JEQ STRSKP Yes, need to skip it 3869 7E26 0288 CI R8,THENZ*256 Hit a then-clause? 7E28 B000 3870 7E2A 13E4 JEQ ELSE Yes, treat like a stmt-sep 3871 7E2C 0288 CI R8,ELSEZ*256 Hit a else-clause? 7E2E 8100 3872 7E30 13E1 JEQ ELSE Yes, t[eat liek a stmt-sep 3873 7E32 06A0 NXTCHR BL @PGMCHR Get next token 7E34 6C74 3874 7E36 10E5 JMP NOCARE And continue loop 3875 7E38 05E0 SKIPLN INCT @PGMPTR Skip line number 7E3A 832C 3876 7E3C 10FA JMP NXTCHR And get next token 3877 7E3E 06A0 STRSKP BL @PGMCHR Get length of string/number 7E40 6C74 3878 7E42 06C8 SWPB R8 Swap for add 3879 7E44 A808 A R8,@PGMPTR Skip the string of number 7E46 832C 3880 7E48 04C8 CLR R8 Clear LSB of character 3881 7E4A 10F3 JMP NXTCHR And get next token 3882 * Code to return to GPL to handle special case or an 3883 * end-of-line return 3884 7E4C 0203 FNNERR LI R3,>16 FOR/NEXT NESTING 7E4E 0016 3885 7E50 1006 JMP GPL05 3886 7E52 0203 ENTER LI R3,>10 Load return code for ENTER 7E54 0010 3887 7E56 1003 JMP GPL05 Goto GPL 3888 7E58 0243 SCNGPL ANDI R3,>7F00 Throw away GPL flag 7E5A 7F00 3889 7E5C 0983 SRL R3,8 Shift to use as index for rtn 3890 7E5E C660 GPL05 MOV @RTNADD,*R9 Make sure right GROM address 7E60 8326 3891 7E62 A643 A R3,*R9 Add offset to old GROM address 3892 7E64 06A0 BL @SAVREG Save R8/R9 in CHAT/SUBSTK 7E66 1E8C 3893 7E68 06A0 BL @GETSTK Restore old GROM address 7E6A 610E 3894 7E6C 0460 B @RESET Goto GPL w/condition reset 7E6E 006A 3895 ************************************************************ 3896 * Table of specially scanned statements 3897 * 2 bytes / special token 3898 * Byte 1 - token value 3899 * Byte 2 - "address" of special handler 3900 * If MSB set then GPL and rest is offset from 3901 * the XML that got us here 3902 * If MSB reset then 9900 code and is offset from 3903 * label OFFSET in this assembly of the special 3904 * case handler 3905 ************************************************************ 3906 7E70 81 SCNTAB BYTE ELSEZ,ELSE-OFFSET 7E71 70 3907 7E72 82 BYTE SSEPZ,SEPSMT-OFFSET 99/4 ASSEMBLER SCANS PAGE 0090 7E73 7A 3908 *----------------------------------------------------------- 3909 * Change the following line for searching for !@P- at the 3910 * beginning of line 3911 * BYTE TREMZ,SCAN25-OFFSET 3912 7E74 83 BYTE TREMZ,SCN26A-OFFSET 7E75 00 3913 *----------------------------------------------------------- 3914 7E76 84 BYTE IFZ,IFIF-OFFSET 7E77 10 3915 7E78 85 BYTE GOZ,IMPER-OFFSET 7E79 16 3916 7E7A 86 BYTE GOTOZ,IMPER-OFFSET 7E7B 16 3917 7E7C 87 BYTE GOSUBZ,IMPER-OFFSET 7E7D 16 3918 7E7E 88 BYTE RETURZ,IMPER-OFFSET 7E7F 16 3919 7E80 89 BYTE DEFZ,>82 7E81 82 3920 7E82 8A BYTE DIMZ,>84 7E83 84 3921 7E84 8C BYTE FORZ,FOR-OFFSET 7E85 3E 3922 7E86 92 BYTE INPUTZ,IMPER-OFFSET 7E87 16 3923 7E88 93 BYTE DATAZ,DATA1-OFFSET 7E89 22 3924 7E8A 96 BYTE NEXTZ,SNEXT-OFFSET 7E8B 52 3925 7E8C 9A BYTE REMZ,SCAN25-OFFSET 7E8D 02 3926 7E8E 9B BYTE ONZ,IMPER-OFFSET 7E8F 16 3927 7E90 9D BYTE CALLZ,>86 7E91 86 3928 7E92 9E BYTE OPTIOZ,>88 7E93 88 3929 7E94 A1 BYTE SUBZ,>8A 7E95 8A 3930 7E96 A3 BYTE IMAGEZ,IMAGE-OFFSET 7E97 34 3931 7E98 A7 BYTE SUBXTZ,>8C 7E99 8C 3932 7E9A A8 BYTE SUBNDZ,>8E 7E9B 8E 3933 7E9C AA BYTE LINPUZ,IMPER-OFFSET 7E9D 16 3934 7E9E B0 BYTE THENZ,ELSE-OFFSET 7E9F 70 3935 0030 TABLEN EQU $-SCNTAB 3936 7EA0 82 IBSTAB BYTE SSEPZ 3937 7EA1 83 BYTE TREMZ 3938 7EA2 8B BYTE ENDZ 3939 7EA3 9A BYTE REMZ 3940 7EA4 A1 BYTE SUBZ 3941 7EA5 FF BYTE >FF 3942 ************************************************************ 3943 7EA6 AORG >7EA6 99/4 ASSEMBLER GREADS PAGE 0091 3945 3946 * (RAM to RAM) 3947 * Read data from ERAM 3948 * @GSRC : Source address on ERAM 3949 * @DEST : Destination address in CPU 3950 * Where the data stored after read from ERAM 3951 * @BCNT3 : byte count 3952 7EA6 0203 GREAD1 LI R3,BCNT3 # of bytes to move 7EA8 8356 3953 7EAA 0202 LI R2,GSRC Source in ERAM 7EAC 8354 3954 7EAE 0201 LI R1,DEST Destination in CPU 7EB0 8358 3955 7EB2 1006 JMP GRZ1 Jump to common routine 3956 * Read data from ERAM to CPU 3957 * @ADDR1 : Source address on ERAM 3958 * @ADDR2 : Destination address in CPU 3959 * Where the data stored after read from ERAM 3960 * @BCNT1 : byte count 3961 7EB4 0203 GREAD LI R3,BCNT1 # of bytes to move 7EB6 834E 3962 7EB8 0202 LI R2,ADDR1 Source in ERAM 7EBA 834C 3963 7EBC 0201 LI R1,ADDR2 Destination in CPU 7EBE 8350 3964 * Common ERAM to CPU transfer routine 3965 7EC0 C112 GRZ1 MOV *R2,R4 3966 7EC2 DC74 GRZ2 MOVB *R4+,*R1+ Move byte from ERAM to CPU 3967 7EC4 0613 DEC *R3 One less to move, done? 3968 7EC6 16FD JNE GRZ2 No, copy the rest 3969 7EC8 045B RT 3970 ************************************************************ 3971 3972 7ECA AORG >7ECA 3974 3975 * (RAM to RAM) 3976 * Write the data whcih is stored in CPU to ERAM 3977 * @GDST : Destination address on ERAM where data is going 3978 * to be stored 3979 * @CSRC : Soruce address on CPU where data stored 3980 * @BCNT2 : byte count 3981 7ECA 0203 GWITE1 LI R3,BCNT2 Count 7ECC 8308 3982 7ECE 0202 LI R2,GDST Destination 7ED0 8302 3983 7ED2 0201 LI R1,CSRC Source 7ED4 830C 3984 7ED6 1006 JMP GWZ1 3985 * Write the data which is stored in CPU to ERAM 3986 * @ADDR1 : Destination address on ERAM where data is going 3987 * to be stroed 3988 * @ADDR2 : Source address on CPU where dta is stored 3989 * @BCNT1 : byte count 3990 7ED8 0203 GWRITE LI R3,BCNT1 Count 7EDA 834E 3991 7EDC 0202 LI R2,ADDR1 Destination 7EDE 834C 3992 7EE0 0201 LI R1,ADDR2 Source 7EE2 8350 99/4 ASSEMBLER GWRITES PAGE 0092 3993 * Common routine to copy from CPU to ERAM 3994 7EE4 GWZ1 EQU $ 3995 7EE4 C112 MOV *R2,R4 Get distination address 3996 7EE6 C051 MOV *R1,R1 Get CPU RAM address 3997 7EE8 0221 AI R1,PAD0 Add in CPU offset 7EEA 8300 3998 7EEC DD31 GWZ2 MOVB *R1+,*R4+ Move a byte 3999 7EEE 0613 DEC *R3 One less to move, done? 4000 7EF0 16FD JNE GWZ2 No, more to move 4001 7EF2 045B RT 4002 ************************************************************ 4003 4004 7EF4 AORG >7EF4 4006 4007 * Delete the text in crunched program on VDP or ERAM 4008 * point to the line # (to be deleted) in the line # table 4009 * RAMTOP 0 if no ERAM 4010 * ENLN Last location used by the line # table 4011 * STLN First location used by the line # table 4012 * 4013 4014 7EF4 C20B DELREP MOV R11,R8 Save return 4015 7EF6 05E0 INCT @EXTRAM Point to line ptr in table 7EF8 832E 4016 7EFA C0E0 MOV @EXTRAM,R3 Prepare to read it 7EFC 832E 4017 7EFE C1E0 MOV @RAMTOP,R7 Check ERAM flag & get in reg 7F00 8384 4018 7F02 1603 JNE DE01 ERAM, get from it 4019 7F04 06A0 BL @GET1 Get line ptr from VDP 7F06 6C9E 4020 7F08 1002 JMP DE02 4021 7F0A 06A0 DE01 BL @GETG2 Get line ptr from ERAM 7F0C 6CCE 4022 7F0E 0601 DE02 DEC R1 Point to line length 4023 7F10 C0C1 MOV R1,R3 Prepare to read length 4024 7F12 C241 MOV R1,R9 Save copy for use later 4025 7F14 C1C7 MOV R7,R7 Editing in ERAM? 4026 7F16 1603 JNE DE03 ERAM, get length from it 4027 7F18 06A0 BL @GETV1 Get line length from VDP 7F1A 1880 4028 7F1C 1001 JMP DE04 4029 7F1E D053 DE03 MOVB *R3,R1 4030 7F20 D081 DE04 MOVB R1,R2 Move text length for use 4031 7F22 0982 SRL R2,8 Need as a word 4032 7F24 0582 INC R2 Text length = length + length 4033 * byte 4034 7F26 C0E0 MOV @ENLN,R3 Get end of line # table 7F28 8332 4035 7F2A 0583 INC R3 Adjust for inside loop 4036 * UPDATE THE LINE # TABLE 4037 7F2C 0643 DEREA DECT R3 Point to line pointer 4038 7F2E C1C7 MOV R7,R7 Editing in ERAM? 4039 7F30 1603 JNE DE05 ERAM, read it as such 4040 7F32 06A0 BL @GET1 Get line pointer from VDP 7F34 6C9E 4041 7F36 1002 JMP DE06 4042 7F38 06A0 DE05 BL @GETG2 Get line pointer from ERAM 7F3A 6CCE 99/4 ASSEMBLER DELREPS PAGE 0093 4043 7F3C C141 DE06 MOV R1,R5 Move for use 4044 7F3E 0605 DEC R5 Point to length byte 4045 7F40 8149 C R9,R5 Compare location of delete 4046 * line & this line 4047 7F42 1209 JLE DEREB This line won't move , 4048 * don't fix pointer 4049 7F44 A042 A R2,R1 Add distance to move to pointe 4050 7F46 C103 MOV R3,R4 Write it to same place 4051 7F48 C1C7 MOV R7,R7 Editing in ERAM? 4052 7F4A 1603 JNE DE10 Yes 4053 7F4C 06A0 BL @PUT1 Put back into line # table 7F4E 6CB2 4054 7F50 1002 JMP DEREB 4055 7F52 06A0 DE10 BL @PUTG2 Put back into line # table 7F54 6CD8 4056 7F56 0643 DEREB DECT R3 Point at the line # 4057 7F58 8803 C R3,@STLN At last line in table? 7F5A 8330 4058 7F5C 16E7 JNE DEREA No, loop for more 4059 * UPDATA OF LINE # TABLE IS COMPLETE, NOW DELETE TEXT 4060 * R9 still contains pointer to length byte of text to delete 4061 * R2 still contains text length 4062 7F5E 0609 DEC R9 4063 7F60 C0C9 MOV R9,R3 4064 7F62 C149 MOV R9,R5 4065 7F64 A142 A R2,R5 Point to 1st token 4066 7F66 C043 MOV R3,R1 Save for later use 4067 7F68 6060 S @STLN,R1 VDP, calculate # of bytes to m 7F6A 8330 4068 7F6C 0581 INC R1 Correct offset by one 4069 7F6E 06A0 BL @MVDN2 Delete the text 7F70 7F8A 4070 * NOW SET UP POINTERS TO LINE TABLE 4071 7F72 0201 DE18 LI R1,EXTRAM Start with EXTRAM 7F74 832E 4072 7F76 AC42 A R2,*R1+ Update EXTRAM 4073 7F78 AC42 A R2,*R1+ Update STLN 4074 7F7A A442 A R2,*R1 Update ENLN 4075 7F7C 0458 B *R8 And return 4076 ************************************************************ 4077 7F7E AORG >7F7E 4079 4080 * (VDP to VDP) or (RAM to RAM) 4081 * WITHOUT ERAM : Move the contents in VDP RAM from a lower 4082 * address to a higher address avoiding a 4083 * possible over-write of data 4084 * >835C ARG : byte count 4085 * >8300 VAR0 : source address 4086 * >8306 VARY2 : destination address 4087 * WITH ERAM Same as above except moves ERAM to ERAM 4088 4089 7F7E C060 MVDN MOV @ARG,R1 Get byte count 7F80 835C 4090 7F82 C160 MOV @VARY2,R5 Get destination 7F84 8306 4091 7F86 C0E0 MOV @VAR0,R3 Get source 7F88 8300 4092 7F8A C1E0 MVDN2 MOV @RAMTOP,R7 ERAM or VDP? 7F8C 8384 99/4 ASSEMBLER MVDNS PAGE 0094 4093 7F8E 1612 JNE MV01 ERAM, so handle it 4094 7F90 1002 JMP MV05 VDP, so jump into loop 4095 7F92 0605 MVDN1 DEC R5 4096 7F94 0603 DEC R3 4097 7F96 MV05 EQU $ 4098 7F96 D7E0 MOVB @R3LB,*R15 Write out read address 7F98 83E7 4099 7F9A D7C3 MOVB R3,*R15 4100 7F9C D1E0 MOVB @XVDPRD,R7 Read a byte 7F9E 8800 4101 7FA0 D7E0 MOVB @R5LB,*R15 Write out write address 7FA2 83EB 4102 7FA4 0265 ORI R5,WRVDP Enable VDP write 7FA6 4000 4103 7FA8 D7C5 MOVB R5,*R15 4104 7FAA D807 MOVB R7,@XVDPWD Write the byte 7FAC 8C00 4105 7FAE 0601 DEC R1 One less byte to move 4106 7FB0 16F0 JNE MVDN1 Loop if more to move 4107 7FB2 045B RT 4108 7FB4 MV01 EQU $ 4109 7FB4 D553 MVDNZ1 MOVB *R3,*R5 Move a byte 4110 7FB6 0603 DEC R3 Decrement destination 4111 7FB8 0605 DEC R5 Decrement source 4112 7FBA 0601 DEC R1 One less byte to move 4113 7FBC 16FB JNE MVDNZ1 Loop if more to move 4114 7FBE 045B RT 4115 ************************************************************ 4116 4117 7FC0 AORG >7FC0 4119 4120 * (VDP to RAM) >834C=ADDR1,>8350=ADDR2,>834E=BCNT1 4121 * Move data from VDP to ERAM 4122 * @ADDR1 : Source address where the data stored on VDP 4123 * @ADDR2 : Destination address on ERAM 4124 * @BCNT1 : byte count 4125 4126 7FC0 VGWITE EQU $ 4127 7FC0 D7E0 MOVB @ADDR11,*R15 LSB of VDP address 7FC2 834D 4128 7FC4 C0A0 MOV @ADDR2,R2 Address in ERAM 7FC6 8350 4129 7FC8 D7E0 MOVB @ADDR1,*R15 MSB of VDP address 7FCA 834C 4130 7FCC 1000 NOP 4131 7FCE DCA0 VGZ1 MOVB @XVDPRD,*R2+ Move a byte 7FD0 8800 4132 7FD2 0620 DEC @BCNT1 One less to move 7FD4 834E 4133 7FD6 16FB JNE VGZ1 If not done, loop for more 4134 7FD8 045B RT Return 4135 ************************************************************ 4136 4137 7FDA AORG >7FDA 4139 4140 * Move data from ERAM to VDP (RAM to VDP) 4141 * @GSRC : Source address where the data stored on ERAM 4142 * @DEST : Destination address on VDP 4143 * @BCNT3 : byte count 99/4 ASSEMBLER GVWITES PAGE 0095 4144 4145 7FDA C0A0 GVWITE MOV @DEST,R2 VDP address 7FDC 8358 4146 7FDE D7E0 MOVB @R2LB,*R15 LSB of VDP address 7FE0 83E5 4147 7FE2 0262 ORI R2,WRVDP Enable VDP write 7FE4 4000 4148 7FE6 D7C2 MOVB R2,*R15 MSB of VDP address 4149 7FE8 C0E0 MOV @GSRC,R3 ERAM address 7FEA 8354 4150 7FEC D833 GVZ1 MOVB *R3+,@XVDPWD Move a byte 7FEE 8C00 4151 7FF0 0620 DEC @BCNT3 One less to move 7FF2 8356 4152 7FF4 16FB JNE GVZ1 If not done, loop for more 4153 7FF6 045B RT Return 4154 4155 7FFE AORG >7FFE 4156 7FFE 9226 DATA >9226 4157 4158 ************************************************************ 4159 4160 END 99/4 ASSEMBLER GVWITES PAGE 0096 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 ATNZZ 797C B9900 64F2 BASE 8343 BCNT1 834E BCNT2 8308 BCNT3 8356 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 CSRC 830C CSTR05 6AFC CSTR07 7B9C CSTR10 6B00 CSTR1O 7BA8 CSTR20 6B1A CSTRIN 7B72 CSTRO5 7B84 CZ 831A DATA 8334 DATA1 7DA6 DATAZ 0093 DCBH6A 7709 DDD11 8355 DE01 7F0A DE02 7F0E DE03 7F1E DE04 7F20 DE05 7F38 DE06 7F3C DE10 7F52 DE18 7F72 DEFZ 0089 DELREP 7EF4 DEREA 7F2C DEREB 7F56 DEST 8358 DEST1 8359 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 99/4 ASSEMBLER GVWITES PAGE 0097 EXC15L 65D0 EXEC10 650E EXEC11 6516 EXEC15 6542 EXEC16 6576 EXEC17 6588 EXEC20 658E EXEC50 6656 EXECG 6500 EXIT 6652 EXP 8376 EXPONZ 00C5 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 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 GDST 8302 GDST1 8303 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 GSRC 8354 GSRC1 8355 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 MNUM 8302 MNUM1 8303 MOTION 837A MOVF1 6452 MOVFA2 645A 99/4 ASSEMBLER GVWITES PAGE 0098 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 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 PAD0 8300 PAD1 8301 PAD5F 835F PADC2 83C2 PAGE1 6000 PAGE2 6002 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 99/4 ASSEMBLER GVWITES PAGE 0099 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 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 836C THENZ 00B0 TIME 8379 TIMES 6B56 TOZ 00B1 TRACE 6672 TRACL 65D4 TREMZ 0083 TYPE 836D UDF 0006 UNQSTZ 00C8 VAR0 8300 VAR5 8310 VAR9 8316 VARA 832A VARW 8320 VARW1 8321 VARY 8304 VARY2 8306 VDPSTS 837B VGWITE 7FC0 VGZ1 7FCE 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 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 XVDPRD 8800 XVDPWD 8C00 YPT 837E 0000 ERRORS This makes it a little more easy to modify. Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 23 Share Posted March 23 Thank you. I was more thinking along the line that evaluating the numeric value of an argument was done the same regardless of where it was done. Like it doesn't matter if you use variable B in the FOR statement above or if you calculate SIN(B) or SQR(B). If it's the same routine you don't need to change in too many places. Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 23 Share Posted March 23 2 hours ago, apersson850 said: Thank you. I was more thinking along the line that evaluating the numeric value of an argument was done the same regardless of where it was done. Like it doesn't matter if you use variable B in the FOR statement above or if you calculate SIN(B) or SQR(B). If it's the same routine you don't need to change in too many places. Why would you even consider using integer for SIN(B) or SQR(B) at all? That is what INT(#) was for in first place. Floating Point is for accuracy, integer is for rounded results using INT(#) or just for numbers like ROW and COLUMN for graphics. My reason for % token for integers is mostly for Graphics like CALL HCHAR(row,column,character-number,repetition) as XB treats all numbers a Floating Point even when it has to convert it to integer each time for all these in the command. This is a true waste of time for the Interpreter when a better solution is using integer in first place instead. Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 23 Share Posted March 23 Yes, I get where the integers are most useful. But since a user may still want to compute the square root of an integer, or maybe even the sine value, you need to handle it in some way. Unless you just issue an error, of course. 1 Quote Link to comment Share on other sites More sharing options...
+InsaneMultitasker Posted March 23 Share Posted March 23 FWIW, ABASIC uses the "%" convention for integer constants (edit:and variables). The numeric variables default to real (float) just like in XB however, there is additional functionality to convert a numberic variable from real to integer, or to declare a variable as an integer type. This also holds true for numeric arrays. The interpreter leverages the variable stack and the token, as appropriate, to determine how to use the variable or constant. SYMBOL TYPE OF VARIABLE $ STRING VARIABLE % INTEGER CONSTANT (no symbol) REAL FLOATING POINT DEFINT - define as integers DEFREAL- define as floating point (64 bit) DEFSTR – define as string 1 Quote Link to comment Share on other sites More sharing options...
jstimson Posted March 23 Share Posted March 23 The machine I moved onto after my TI was a Commodore 128. It also had the standard convention for use of integer only variables vs float (and string). From the system guide..... The Commodore 128 uses three types of variables in BASIC. These are: normal numeric, integer numeric, string (alfanumeric). Normal NUMERIC VARIABLES, also called floating point variables, can have any exponent value from -10 to +10, with up to nine digits of accuracy. When a number becomes larger than nine digits can show, the computer displays it in scientific notation form, with the number normalized to one digit and eight decimal places, followed by the letter E and the power of 10 by which the number is multiplied. For example, the number 12345678901 is displayed as 1.23456789E+10. INTEGER VARIABLES can be used when the number is from +32767 to -32768 (inclusive), and with no fractional portion. An integer variable is a number like 5, 10 or -100. Integers take up less space than floating point variables, particularly when used in an array (see below). STRING VARIABLES are those used for character data, which may contain numbers, letters and any other characters the Commodore 128 can display. An example of a string variable is "COMMODORE 128". VARIABLE NAMES may consist of a single letter, a letter followed by a number, or two letters. Variable names may be longer than two characters, but only the first two are significant. An integer is specified by using the percent sign (%) after the variable name. String variables have a dollar sign ($) after their names. EXAMPLES: Numeric Variable Names: A, A5, BZ Integer Variable Names: A%, A5%, BZ% String Variable Names: A$, A5$, BZ$ 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 23 Share Posted March 23 3 hours ago, apersson850 said: Yes, I get where the integers are most useful. But since a user may still want to compute the square root of an integer, or maybe even the sine value, you need to handle it in some way. Unless you just issue an error, of course. Well as INTEGER will only range from -32768 (>8001) to 0 (>0000) to 32767 (>7FFF) how would I do a SIN or SQR? And yes, that would create a OUT OF RANGE ERROR or incorrect results overall with huge rounding errors. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 23 Share Posted March 23 18 minutes ago, RXB said: Well as INTEGER will only range from -32768 (>8001) to 0 (>0000) to 32767 (>7FFF) how would I do a SIN or SQR? And yes, that would create a OUT OF RANGE ERROR or incorrect results overall with huge rounding errors. Just like we have INT() you could create FLOAT() to convert the other way. ?? Just spitballin' here. Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 23 Share Posted March 23 20 minutes ago, TheBF said: Just like we have INT() you could create FLOAT() to convert the other way. ?? Just spitballin' here. Thanks, but we already have floating point built into XB so that is kind of superfluous. We have INT(#) and that does a great job already. So A%=INT(SIN(X+2)) would make A%=-1 if X=8 And that would same a many bytes of memory over Floating Point. You could do the other way X=SQR(Y+A%) so X=8.87862602 if Y=76.83 and A%=2 This would be processed by the interpreter like X=SQR(Y+2) I think adding more math would be mostly pointless unused features. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 23 Share Posted March 23 (edited) 1 hour ago, TheBF said: Just like we have INT() you could create FLOAT() to convert the other way. ?? Just spitballin' here. 54 minutes ago, RXB said: Thanks, but we already have floating point built into XB so that is kind of superfluous. We have INT(#) and that does a great job already. So A%=INT(SIN(X+2)) would make A%=-1 if X=8 And that would same a many bytes of memory over Floating Point. You could do the other way X=SQR(Y+A%) so X=8.87862602 if Y=76.83 and A%=2 I think adding more math would be mostly pointless unused features. Actually, a routine like FLOAT() would only need to call CIF (Convert Integer to Float). Any expressions with mixed FLOATs and INTs should do the conversion implicitly, anyway, so maybe there would not be a need for FLOAT(). ..lee Edited March 24 by Lee Stewart correction 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 23 Share Posted March 23 10 minutes ago, RXB said: Thanks, but we already have floating point built into XB so that is kind of superfluous. You have floating point until somebody tries to feed an integer variable/expression to a transcendental function as was mentioned earlier. It might be the easier way to cover your "assets" as they say. And since as Lee points out there is already code to do it... 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 24 Share Posted March 24 31 minutes ago, Lee Stewart said: Actually, a routine like FLOAT() would only need to call CIF (Convert Float to Integer). Any expressions with mixed FLOATs and INTs should do the conversion implicitly, anyway, so maybe there would not be a need for FLOAT(). ..lee Lee is correct it is called INT(floating Point value) this routing just fetched the number in floating point and converts to integer. Thus X%=INT(floating point value) is the integer. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 24 Share Posted March 24 15 minutes ago, RXB said: Lee is correct it is called INT(floating Point value) this routing just fetched the number in floating point and converts to integer. Thus X%=INT(floating point value) is the integer. Actually, I had the translation of CIF backwards. It should have been Convert Integer to Float. I corrected it in my post. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 24 Share Posted March 24 16 hours ago, Lee Stewart said: Actually, I had the translation of CIF backwards. It should have been Convert Integer to Float. I corrected it in my post. ...lee That is built-into all of XB as any number you entire is automatically converted to Floating Point. Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 24 Share Posted March 24 (edited) 10 hours ago, RXB said: Well as INTEGER will only range from -32768 (>8001) to 0 (>0000) to 32767 (>7FFF) how would I do a SIN or SQR? And yes, that would create a OUT OF RANGE ERROR or incorrect results overall with huge rounding errors. Whether it's needed or not can be argued about. But there's no conceptual issue. The output of the functions would be a float, but the input could be an integer. So the interpreter would have to handle that the argument could be an integer too, not just the alternatives that exist today. This is perfectly legitimate: A%=1 B%=127 PRINT SIN(A%) PRINT SQR(B%) The output would be 0.84147098 and 11.26942767, respectively. Nothing wrong with that. But the arguments need to implcitly be converted to float before fed into the math routines in question, which adds another alternative. There is one standard math function that's a bit tricky, and that's division. If you compute B%=11::C%=3::PRINT B%/C%, then what should the result be? Normally / is a floating point operation, which would then return 3.66666667. But if you instead do B%=11::C%=3::A%=B%/C%::PRINT A%, then it's clear that the printout will be 3 instead, since it comes from an integer variable. Pascal handles this by not only defining +, -, * and /, but for integer values also div and mod. Here div is integer division and mod is the reminder after integer division. So 11/3=3.66666667 but 11 div 3=3 and 11 mod 3=2. In Pascal, the equivalent of A%=30000::B%=A%+A% will silently become -5536. No overflow alarms or anything else like that. Edited March 24 by apersson850 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted March 24 Share Posted March 24 8 hours ago, apersson850 said: Whether it's needed or not can be argued about. But there's no conceptual issue. The output of the functions would be a float, but the input could be an integer. So the interpreter would have to handle that the argument could be an integer too, not just the alternatives that exist today. This is perfectly legitimate: A%=1 B%=127 PRINT SIN(A%) PRINT SQR(B%) The output would be 0.84147098 and 11.26942767, respectively. Nothing wrong with that. But the arguments need to implcitly be converted to float before fed into the math routines in question, which adds another alternative. There is one standard math function that's a bit tricky, and that's division. If you compute B%=11::C%=3::PRINT B%/C%, then what should the result be? Normally / is a floating point operation, which would then return 3.66666667. But if you instead do B%=11::C%=3::A%=B%/C%::PRINT A%, then it's clear that the printout will be 3 instead, since it comes from an integer variable. Pascal handles this by not only defining +, -, * and /, but for integer values also div and mod. Here div is integer division and mod is the reminder after integer division. So 11/3=3.66666667 but 11 div 3=3 and 11 mod 3=2. In Pascal, the equivalent of A%=30000::B%=A%+A% will silently become -5536. No overflow alarms or anything else like that. Tell me how this would work in the Interpreter PRINT A%/B% as what is the point of even having INTEGER numbers if everything is Floating Point? Unless specified all values will be in Floating Point as results. Thus, how I plan on making it work in XB is the same as if you did this PRINT 11/3 the result will be a Floating Point result. If you do a A%=11/3 than A%=3 the INTERPETER would use CIF automatically for A%, same if you did this A%=INT(PI) then A%=3 Doing any kind of math will always result in some floating point slowing down the results, I am not going to write a integer only ROM. By the way RXB has CALL MOD(number,divisor,quotiant,remainder) example: CALL MOD(-32768,3,Q,R) would return Q=10922 and R=2 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted March 26 Share Posted March 26 On 3/24/2023 at 6:52 PM, RXB said: Tell me how this would work in the Interpreter PRINT A%/B% as what is the point of even having INTEGER numbers if everything is Floating Point? Well, that's what I'm asking you? The only point I see with integers, if the math still is with reals, is to save space to store them. Which may have a value by itself, but is a bit short handed. On 3/24/2023 at 6:52 PM, RXB said: Unless specified all values will be in Floating Point as results. Then it doesn't make sense, since A%+B% should definitely still be in integer. If you want to PRINT it, then perhaps converting it to a float before printing makes sense, since printing takes quite some time anyway. On 3/24/2023 at 6:52 PM, RXB said: Thus, how I plan on making it work in XB is the same as if you did this PRINT 11/3 the result will be a Floating Point result. If you do a A%=11/3 than A%=3 the INTERPETER would use CIF automatically for A%, same if you did this A%=INT(PI) then A%=3 You mean the opposite, right, CFI will be implied. Which makes sense, as you don't have integer literal values just like that. On 3/24/2023 at 6:52 PM, RXB said: Doing any kind of math will always result in some floating point slowing down the results, I am not going to write a integer only ROM. Unfortunately my advice is then that you stop right there. Since if you aren't going to do integer math with integer variables, like in the A%=B%+C%, then the main benefit of higher speed is gone. The benefit of requiring less storagae space you can get already as it is, if you use CALL LOAD/CALL PEEK to store and retreive values somewhere in memory. Or you can use characters in a string and use their ASCII code as numeric values. The good thing with integer math and the TMS 9900 is that it's simple. You have almost everything already in the CPU. Just need sign handling for DIV and MPY. 2 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.