Jump to content
IGNORED

RXB - Rich Extended Basic


Bones-69

Recommended Posts

First of all, MPY is much more expensive than CLR---not sure it would be better. Secondly, if your code would actually run, it won't work because the last statement has no effect on FAC+6. The autoincrement occurs after the MPY. This should do it:

       MPY *R3+,*R3+

More importantly (per @Asmusr’s comment below), it will not work because the destination operand must be a register proper.

 

...lee

Edited by Lee Stewart
CORRECTIONS
  • Thanks 1
Link to comment
Share on other sites

  • 2 months later...

ZOOM today I was explaining the problem with RXB 2024 using the % symbol in ROM to indicate a Integer Whole Number.

Like B%=10 would Integer 10 and not like normal XB would be B=10 but 10 would be a 8 byte Floating Point number i.e. >40 >0A >00 >00 >00 >00 >00 >00

Anyway look at the code in XB ROM at line 382 you see % in the mix with other symbols uncer CPNIL and at line 405 you see % is CPNIL so you would think if you

change CPNIL to someplace else it would go that to that address, but it never does.

Why? Well at 3932 you see it just only goes to B *R7 and never gets past that point. If I change CPNIL it just crashes everthing.

 

If you see a way to make this work let me know!

 

Spoiler


 99/4 ASSEMBLER
GVWITES                                                      PAGE 0001
  0001            ************************************************************
  0003                
  0004      7016  CNS    EQU  >7016             * GROM ADDRESS'S  
  0005      7492  PWRZZ  EQU  >7492             *   
  0006      76C2  LOGZZ  EQU  >76C2             *   
  0007      75CA  EXPZZ  EQU  >75CA             *   
  0008      783A  SQRZZ  EQU  >783A             *   
  0009      78B2  COSZZ  EQU  >78B2             *   
  0010      78C0  SINZZ  EQU  >78C0             *   
  0011      7940  TANZZ  EQU  >7940             *   
  0012      797C  ATNZZ  EQU  >797C             *   
  0013      79EC  GRINT  EQU  >79EC             *   
  0014      7A90  ROLOUT EQU  >7A90             *   
  0015      7AC4  ROLIN  EQU  >7AC4             *   
  0016      7B88  CRUNCH EQU  >7B88             *   
  0017      7F6E  PUTCHR EQU  >7F6E             *   
  0018            *   
  0019            * NOTE RXB CHANGE: All lables with $ changed to Z   
  0020            *      LPAR$ is now LPARZ or WARN$$ is now WARNZZ   
  0021            *      this was to use same names as GPL source   
  0022            *   
  0023            ************************************************************
  0025                
  0026            *   
  0027      6000  LWCNS  EQU  >6000   
  0028            *   
  0029      4000  WRVDP  EQU  >4000             Write enable for VDP  
  0030      8800  XVDPRD EQU  >8800             Read VDP data   
  0031      8C00  XVDPWD EQU  >8C00             Write VDP data  
  0032      9800  XGRMRD EQU  >9800             Read GROM data  
  0033      0402  GRMWAX EQU  >9C02->9800       Write GROM address  
  0034      0002  GRMRAX EQU  >9802->9800       Read GROM address   
  0035      0400  GRMWDX EQU  >9C00->9800       GROM write data   
  0036            *   
  0037      CB00  KEYTAB EQU  >CB00             ADDRESS OF KEYWORD TABLE GROM 
  0038            *   
  0039      7D00  NEGPAD EQU  >7D00   
  0040            *   
  0041      8300  PAD    EQU  >8300   
  0042      8301  PAD1   EQU  >8301   
  0043      8302  PAD2   EQU  >8302   
  0044      8303  PAD3   EQU  >8303   
  0045      8304  PABPTR EQU  >8304   
  0046      8306  PAD6   EQU  >8306   
  0047      8306  CCPPTR EQU  >8306   
  0048      8308  PAD8   EQU  >8308   
  0049      8308  CCPADR EQU  >8308   
  0050      830A  RAMPTR EQU  >830A   
  0051      830A  CALIST EQU  RAMPTR  
  0052      830C  PADC   EQU  >830C   
  0053      830C  BYTE   EQU  >830C   
  0054      8310  PROAZ  EQU  >8310   
  0055      8310  VAR5   EQU  PROAZ   
  0056      8312  PZ     EQU  >8312   
  0057      8312  LINUM  EQU  PZ  
  0058      8314  OEZ    EQU  >8314   
  0059      8316  QZ     EQU  >8316   
  0060      8316  XFLAG  EQU  QZ  
  0061      8316  VAR9   EQU  QZ  

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0002
  0062      8317  DSRFLG EQU  >8317   
  0063      8317  FORNET EQU  DSRFLG  
  0064      8318  STRSP  EQU  >8318   
  0065      831A  CZ     EQU  >831A   
  0066      831A  STREND EQU  CZ  
  0067      831A  WSM    EQU  CZ  
  0068      831C  SREF   EQU  >831C * Temporary string pointer  
  0069      831C  WSM2   EQU  SREF  * Temporary string pointer  
  0070      831E  WSM4   EQU  >831E * Start of current statement  
  0071      831E  SMTSRT EQU  WSM4  * Start of current statement  
  0072      8320  WSM6   EQU  >8320 * Screen address  
  0073      8320  VARW   EQU  WSM6  * Screen address  
  0074      8321  VARW1  EQU  >8321   
  0075      8322  ERRCOD EQU  >8322  * Return error code from ALC   
  0076      8322  WSM8   EQU  ERRCOD * Return error code from ALC   
  0077      8323  ERRCO1 EQU  >8323   
  0078      8324  STVSPT EQU  >8324 * Value-stack base  
  0079      8326  RTNADD EQU  >8326   
  0080      8328  NUDTAB EQU  >8328   
  0081      832A  VARA   EQU  >832A * Ending display location   
  0082      832C  PGMPTR EQU  >832C * Program text pointer  
  0083      832D  PGMPT1 EQU  >832D   
  0084      832E  EXTRAM EQU  >832E * Line number table pointer   
  0085      832F  EXTRM1 EQU  >832F   
  0086      8330  STLN   EQU  >8330 * Start of line number table  
  0087      8332  ENLN   EQU  >8332 * End of line number table  
  0088      8334  DATA   EQU  >8334 * Data pointer for READ   
  0089      8336  LNBUF  EQU  >8336 * Line table pointer for READ   
  0090      8338  INTRIN EQU  >8338 * Add of intrinsic poly constant  
  0091      833A  SUBTAB EQU  >833A * Subprogram symbol table   
  0092      833E  SYMTAB EQU  >833E * Symbol table pointer  
  0093      833F  SYMTA1 EQU  >833F   
  0094      8340  FREPTR EQU  >8340 * Free space pointer  
  0095      8342  CHAT   EQU  >8342 * Current charater/token  
  0096      8343  BASE   EQU  >8343 * OPTION BASE value   
  0097      8344  PRGFLG EQU  >8344 * Program/imperative flag   
  0098      8345  FLAG   EQU  >8345 * General 8-bit flag  
  0099      8346  BUFLEV EQU  >8346 * Crunch-buffer destruction level   
  0100      8348  LSUBP  EQU  >8348 * Last subprogram block on stack  
  0101      834A  FAC    EQU  >834A * Floating-point ACcurmulator   
  0102      834B  FAC1   EQU  >834B   
  0103      834C  FAC2   EQU  >834C   
  0104      834D  FAC3   EQU  >834D   
  0105      834E  FAC4   EQU  >834E   
  0106      834F  FAC5   EQU  >834F   
  0107      8350  FAC6   EQU  >8350   
  0108      8351  FAC7   EQU  >8351   
  0109      8352  FAC8   EQU  >8352   
  0110      8353  FAC9   EQU  >8353   
  0111      8354  FAC10  EQU  >8354   
  0112      8354  FLTNDX EQU  FAC10   
  0113      8354  FDVSR  EQU  FAC10   
  0114      8355  FAC11  EQU  >8355   
  0115      8355  SCLEN  EQU  FAC11   
  0116      8355  FDVSR1 EQU  FAC11   
  0117      8356  FAC12  EQU  >8356   
  0118      8356  FDVSR2 EQU  FAC12   
  0119      8357  FAC13  EQU  >8357   
  0120      8358  FAC14  EQU  >8358   

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0003
  0121      8359  FAC15  EQU  >8359   
  0122      835A  FAC16  EQU  >835A   
  0123      835C  FDVSR8 EQU  >835C  * Floating-point ARGument  
  0124      835C  ARG    EQU  FDVSR8 * Floating-point ARGument  
  0125      835D  ARG1   EQU  >835D   
  0126      835E  ARG2   EQU  >835E   
  0127      835F  ARG3   EQU  >835F   
  0128      8360  ARG4   EQU  >8360   
  0129      8364  ARG8   EQU  >8364   
  0130      8365  ARG9   EQU  >8365   
  0131      8366  ARG10  EQU  >8366   
  0132      836B  FAC33  EQU  >836B   
  0133      836C  TEMP2  EQU  >836C   
  0134      836C  FLTERR EQU  TEMP2   
  0135      836D  TYPE   EQU  >836D   
  0136      836E  VSPTR  EQU  >836E * Value stack pointer   
  0137      836F  VSPTR1 EQU  >836F   
  0138      8372  STKDAT EQU  >8372   
  0139      8373  STKADD EQU  >8373   
  0140      8373  STACK  EQU  >8373   
  0141      8374  PLAYER EQU  >8374   
  0142      8375  KEYBRD EQU  >8375   
  0143      8375  SIGN   EQU  KEYBRD  
  0144      8376  JOYY   EQU  >8376 * Exponent in floating-point  
  0145      8376  EXP    EQU  JOYY  
  0146      8377  JOYX   EQU  >8377   
  0147      8378  RANDOM EQU  >8378   
  0148      8379  TIME   EQU  >8379   
  0149      837A  MOTION EQU  >837A   
  0150      837B  VDPSTS EQU  >837B   
  0151      837C  STATUS EQU  >837C   
  0152      837D  CHRBUF EQU  >837D   
  0153      837E  YPT    EQU  >837E   
  0154      837F  XPT    EQU  >837F   
  0155      8384  RAMTOP EQU  >8384   
  0156      8389  RAMFLG EQU  >8389 * ERAM flag   
  0157      83BA  STKEND EQU  >83BA   
  0158      83AE  STND12 EQU  STKEND-12   
  0159      83C0  CRULST EQU  >83C0   
  0160      83CB  SAVEG  EQU  >83CB   
  0161      83D2  SADDR  EQU  >83D2   
  0162      83D4  RAND16 EQU  >83D4   
  0163            *   
  0164      83E0  WS     EQU  >83E0   
  0165      83E1  R0LB   EQU  >83E1   
  0166      83E3  R1LB   EQU  >83E3   
  0167      83E5  R2LB   EQU  >83E5   
  0168      83E7  R3LB   EQU  >83E7   
  0169      83E9  R4LB   EQU  >83E9   
  0170      83EB  R5LB   EQU  >83EB   
  0171      83ED  R6LB   EQU  >83ED   
  0172      83EF  R7LB   EQU  >83EF   
  0173      83F1  R8LB   EQU  >83F1   
  0174      83F3  R9LB   EQU  >83F3   
  0175      83F5  R10LB  EQU  >83F5   
  0176      83F7  R11LB  EQU  >83F7   
  0177      83F9  R12LB  EQU  >83F9   
  0178      83FB  R13LB  EQU  >83FB   
  0179      83FD  R14LB  EQU  >83FD   

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0004
  0180      83FF  R15LB  EQU  >83FF   
  0181            *   
  0182            * VDP variables   
  0183      0376  SYMBOL EQU  >0376 * Saved symbol table pointer  
  0184      038A  ERRLN  EQU  >038A * On-error line pointer   
  0185      0392  TABSAV EQU  >0392 * Saved main symbol table ponter  
  0186      03C0  VROAZ  EQU  >03C0 * Temporary VDP Roll Out Area   
  0187      03DC  FPSIGN EQU  >03DC   
  0188      0820  CRNBUF EQU  >0820 * CRuNch BUFfer address   
  0189      08BE  CRNEND EQU  >08BE * CRuNch buffer END   
  0190            ************************************************************
  0191 6000              AORG >6000   
  0193                
  0194            * PAGE SELECTOR FOR PAGE 1  
  0195      6000  PAGE1  EQU  $                 >6000   
  0196 6000 0002  C2     DATA 2                 0   
  0197            * PAGE SELECTOR FOR PAGE 2  
  0198      6002  PAGE2  EQU  $                 >6002   
  0199 6002   00  C7     BYTE >00   
  0200 6003   07  CBH7   BYTE >07               2   
  0201 6004   0A  CBHA   BYTE >0A   
  0202 6005   94  CBH94  BYTE >94               4   
  0203 6006 0028  C40    DATA 40                6   
  0204 6008 0064  C100   DATA 100               8   
  0205 600A 1000  C1000  DATA >1000             A   
  0206 600C 0000         DATA 0                 C   
  0207 600E 4001  FLTONE DATA >4001             E   
  0208            ************************************************************
  0209            * XML table number 7 for Extended Basic - must have   
  0210            *     it's origin at >6010  
  0211            ************************************************************
  0212            *           0      1      2      3      4      5     6  
  0213 6010 619C         DATA COMPCG,GETSTG,MEMCHG,CNSSEL,PARSEG,CONTG,EXECG  
       6012 61A2  
       6014 72CE  
       6016 6070  
       6018 6470  
       601A 64C4  
       601C 6500  
  0214            *           7      8    9     A    B    C      D  
  0215 601E 61BA         DATA VPUSHG,VPOP,PGMCH,SYMB,SMBB,ASSGNV,FBSYMB   
       6020 6C2A  
       6022 6410  
       6024 61B4  
       6026 61A8  
       6028 61AE  
       602A 618C  
  0216            *             E     F   
  0217 602C 6EE2         DATA SPEED,CRNSEL  
       602E 6076  
  0218            ************************************************************
  0219            * XML table number 8 for Extended Basic - must have   
  0220            *     it's origin at >6030  
  0221            ************************************************************
  0222            *           0   1      2    3      4  5     6      7  
  0223 6030 74AA         DATA CIF,CONTIN,RTNG,SCROLL,IO,GREAD,GWRITE,DELREP   
       6032 65CC  
       6034 6630  
       6036 7ADA  

 99/4 ASSEMBLER
XML359                                                       PAGE 0005
       6038 7B48  
       603A 7EB4  
       603C 7ED8  
       603E 7EF4  
  0224            *           8    9    A      B      C      D      E   
  0225 6040 7F7E         DATA MVDN,MVUP,VGWITE,GVWITE,GREAD1,GWITE1,GDTECT  
       6042 6F98  
       6044 7FC0  
       6046 7FDA  
       6048 7EA6  
       604A 7ECA  
       604C 6050  
  0226            *           F   
  0227 604E 7C56         DATA PSCAN   
  0228                
  0229            * Determine if and how much ERAM is present   
  0230 6050 D80B  GDTECT MOVB R11,@PAGE1        First enable page 1 ROM   
       6052 6000  
  0231            *-----------------------------------------------------------
  0232            * Replace following line      6/16/81   
  0233            * (Extended Basic must be made to leave enough space at   
  0234            * top of RAM expansion for the "hooks" left by the 99/4A  
  0235            * for TIBUG.)   
  0236            *      SETO R0                Start at >FFFF  
  0237            * with  
  0238            *      LI   R0,>FFE7          Start at >FFE7  
  0239            ************************************************************
  0240            * RXB 2020 change for PRAM command  
  0241 6054 C020         MOV  @RAMTOP,R0        PRAM sets RAMTOP value  
       6056 8384  
  0242            *-----------------------------------------------------------
  0243 6058 D40B         MOVB R11,*R0           Write a byte of data  
  0244 605A 940B         CB   R11,*R0           Read and compare the data   
  0245 605C 1306         JEQ  DTECT2            If matches-found ERAM top   
  0246            *-----------------------------------------------------------
  0247            * Change the following line   6/16/81   
  0248            *      AI   R0,->2000         Else drop down 8K   
  0249 605E 0200         LI   R0,>DFFF          Else drop down 8K   
       6060 DFFF  
  0250            *-----------------------------------------------------------
  0251 6062 D40B         MOVB R11,*R0           Write a byte of data  
  0252 6064 940B         CB   R11,*R0           Read and compare the data   
  0253 6066 1301         JEQ  DTECT2            If matches-found ERAM top   
  0254 6068 04C0         CLR  R0                No match so no ERAM   
  0255 606A C800  DTECT2 MOV  R0,@RAMTOP        Set the ERAM top  
       606C 8384  
  0256 606E 045B         RT                     And return to GPL   
  0257 6070 0202  CNSSEL LI   R2,CNS  
       6072 7016  
  0258 6074 1002         JMP  PAGSEL  
  0259 6076 0202  CRNSEL LI   R2,CRUNCH   
       6078 7B88  
  0260            * Select page 2 for CRUNCH and CNS  
  0261 607A 05E0  PAGSEL INCT @STKADD           Get space on subroutine stack 
       607C 8373  
  0262 607E D1E0         MOVB @STKADD,R7        Get stack pointer   
       6080 8373  
  0263 6082 0987         SRL  R7,8              Shift to use as offset  
  0264 6084 D9CB         MOVB R11,@PAD(R7)      Save return addr to GPL interp

 99/4 ASSEMBLER
XML359                                                       PAGE 0006
       6086 8300  
  0265 6088 D9E0         MOVB @R11LB,@PAD1(R7)  
       608A 83F7  
       608C 8301  
  0266 608E D80B         MOVB R11,@PAGE2        Select page 2   
       6090 6002  
  0267 6092 0692         BL   *R2               Do the conversion   
  0268 6094 D80B         MOVB R11,@PAGE1        Reselect page 1   
       6096 6000  
  0269 6098 D1E0         MOVB @STKADD,R7        Get subroutine stack pointer  
       609A 8373  
  0270 609C 0660         DECT @STKADD           Decrement pointer   
       609E 8373  
  0271 60A0 0987         SRL  R7,8              Shift to use as offset  
  0272 60A2 D2E7         MOVB @PAD(R7),R11      Restore return address  
       60A4 8300  
  0273 60A6 D827         MOVB @PAD1(R7),@R11LB  
       60A8 8301  
       60AA 83F7  
  0274 60AC 045B         RT                     Return to GPL interpeter  
  0275 60AE D7E0  GETCH  MOVB @R6LB,*R15  
       60B0 83ED  
  0276 60B2 1000         NOP  
  0277 60B4 D7C6         MOVB R6,*R15   
  0278 60B6 0586         INC  R6  
  0279 60B8 D220         MOVB @XVDPRD,R8  
       60BA 8800  
  0280 60BC 0988  GETCH1 SRL  R8,8  
  0281 60BE 045B         RT   
  0282 60C0 DB46  GETCHG MOVB R6,@GRMWAX(R13)   
       60C2 0402  
  0283 60C4 DB60         MOVB @R6LB,@GRMWAX(R13)  
       60C6 83ED  
       60C8 0402  
  0284 60CA 0586         INC  R6  
  0285 60CC D21D         MOVB *R13,R8   
  0286 60CE 10F6         JMP  GETCH1  
  0287 60D0 D236  GETCGR MOVB *R6+,R8   
  0288 60D2 10F4         JMP  GETCH1  
  0289            *   
  0290      60D6  CBHFF  EQU  $+2   
  0291 60D4 0205  POPSTK LI   R5,-8   
       60D6 FFF8  
  0292 60D8 D7E0         MOVB @VSPTR1,*R15  
       60DA 836F  
  0293 60DC 0206         LI   R6,ARG  
       60DE 835C  
  0294 60E0 D7E0         MOVB @VSPTR,*R15   
       60E2 836E  
  0295 60E4 A805         A    R5,@VSPTR   
       60E6 836E  
  0296 60E8 DDA0  STKMOV MOVB @XVDPRD,*R6+  
       60EA 8800  
  0297 60EC 0585         INC  R5  
  0298 60EE 16FC         JNE  STKMOV  
  0299 60F0 045B         RT   
  0300            *   
  0301 60F2 05E0  PUTSTK INCT @STKADD   
       60F4 8373  

 99/4 ASSEMBLER
XML359                                                       PAGE 0007
  0302 60F6 D120         MOVB @STKADD,R4  
       60F8 8373  
  0303 60FA 0984         SRL  R4,8  
  0304 60FC D92D         MOVB @GRMRAX(13),@PAD(R4)  
       60FE 0002  
       6100 8300  
  0305 6102 D92D         MOVB @GRMRAX(13),@PAD1(R4)   
       6104 0002  
       6106 8301  
  0306 6108 0624         DEC  @PAD(R4)  
       610A 8300  
  0307 610C 045B         RT   
  0308            *   
  0309 610E D120  GETSTK MOVB @STKADD,R4  
       6110 8373  
  0310 6112 0984         SRL  R4,8  
  0311 6114 0660         DECT @STKADD   
       6116 8373  
  0312 6118 DB64         MOVB @PAD(R4),@GRMWAX(R13)   
       611A 8300  
       611C 0402  
  0313 611E DB64         MOVB @PAD1(R4),@GRMWAX(R13)  
       6120 8301  
       6122 0402  
  0314 6124 045B         RT   
  0315            ************************************************************
  0316 6126              AORG >6126   
  0318                
  0319      0F64  ROUNUP EQU  >0F64   Uses XML >01 Rounding of floating point 
  0320      0D42  SCOMPB EQU  >0D42   Set SCOMP with direct return without GPL
  0321      12B8  CFI    EQU  >12B8   CFI (XML >12)   
  0322      0E8C  SMULT  EQU  >0E8C   SMUL (XML >0D)  
  0323      0FF4  FDIV   EQU  >0FF4   FDIV (XML >09)  
  0324      0FC2  OVEXP  EQU  >0FC2   Overflow (XML >04)  
  0325      0E88  FMULT  EQU  >0E88   FMUL (XML >08)  
  0326      0D74  SSUB   EQU  >0D74   SSUB (XML >0C)  
  0327      0D80  FADD   EQU  >0D80   FADD (XML >06)  
  0328      0FF8  SDIV   EQU  >0FF8   SDIV (XML >0E)  
  0329      0D7C  FSUB   EQU  >0D7C   FSUB (XML (>07)   
  0330      0D84  SADD   EQU  >0D84   SADD (XML >0B)  
  0331      0FB2  ROUNU  EQU  >0FB2   Rounding with digit number in >8354 (XML
  0332      006A  RESET  EQU  >006A   Clear condition bit in GPL status (GPL i
  0333      0070  NEXT   EQU  >0070   GPL interpreter   
  0334      11B2  CSN01  EQU  >11B2   CSN (XML >10) (Without R3 loaded with >1
  0335      0D3A  FCOMP  EQU  >0D3A   FCOMP (XML >0A)   
  0336 6126 C0CB  FCOMPB MOV  R11,R3  
  0337 6128 0460         B    @FCOMP+22   
       612A 0D50  
  0338      187C  GETV   EQU  >187C   Read 1 byte from VDP, Entry over data ad
  0339      1880  GETV1  EQU  >1880   Same >187C but does not fetch address, i
  0340      1E8C  SAVREG EQU  >1E8C   Set substack pointer and Basic byte   
  0341      1E90  SAVRE2 EQU  >1E90   Same >1E8C but does not set R8 into >834
  0342      1E7A  SETREG EQU  >1E7A   Substack pointer in R9 and actual Basic 
  0343      18AA  STVDP3 EQU  >18AA   Write R6 in VDP (R1=Address+3),   
  0344            *                   used for variable table and string point
  0345      18AE  STVDP  EQU  >18AE   Write R6 in VDP (R1=Address+3),   
  0346            *                   used for variable table and string point
  0347      15E0  FBS    EQU  >15E0   Pointer fetch var list  
  0348      15E6  FBS001 EQU  >15E6   Fetch length byte   

 99/4 ASSEMBLER
REFS359                                                      PAGE 0008
  0349            ************************************************************
  0350                
  0351 612C              AORG >612C   
  0353                
  0354            *   
  0355            * The CHARACTER PROPERTY TABLE  
  0356            * There is a one-byte entry for every character code  
  0357            * in the range LLC(lowest legal character) to   
  0358            * HLC(highest legal character), inclusive.  
  0359      0020  LLC    EQU  >20   
  0360      0000  CPNIL  EQU  >00               " $ % ' ?   
  0361      0002  CPDIG  EQU  >02               digit (0-9)   
  0362      0004  CPNUM  EQU  >04               digit, period, E  
  0363      0008  CPOP   EQU  >08               1 char operators(!#*+-/<=>^ ) 
  0364      0010  CPMO   EQU  >10               multiple operator ( : )   
  0365      0020  CPALPH EQU  >20               A-Z, @, _   
  0366      0040  CPBRK  EQU  >40               ( ) , ;   
  0367      0080  CPSEP  EQU  >80               space   
  0368      0022  CPALNM EQU  CPALPH+CPDIG      alpha-digit   
  0369            *-----------------------------------------------------------
  0370            * Following lines are for adding lowercase character set in 
  0371            * 99/4A,                      5/12/81   
  0372      0001  CPLOW  EQU  >01               a-z   
  0373      0023  CPULNM EQU  CPALNM+CPLOW      Alpha(both upper and lower)+  
  0374            *                             digit-legal variable character
  0375      0021  CPUL   EQU  CPALPH+CPLOW      Alpha(both upper and lower)   
  0376            *-----------------------------------------------------------
  0377      610C  CPTBL  EQU  $-LLC   
  0378 612C   80         BYTE CPSEP               SPACE   
  0379 612D   08         BYTE CPOP              ! EXCLAMATION POINT   
  0380 612E   00         BYTE CPNIL             " QUOTATION MARKS   
  0381 612F   08         BYTE CPOP              # NUMBER SIGN   
  0382 6130   00         BYTE CPNIL             $ DOLLAR SIGN   
  0383 6131   00         BYTE CPNIL             % PERCENT   
  0384 6132   08         BYTE CPOP              & AMPERSAND   
  0385 6133   00         BYTE CPNIL             ' APOSTROPHE  
  0386 6134   40         BYTE CPBRK             ( LEFT PARENTHESIS  
  0387 6135   40         BYTE CPBRK             ) RIGHT PARENTHESIS   
  0388 6136   08         BYTE CPOP              * ASTERISK  
  0389 6137   0C         BYTE CPOP+CPNUM        + PLUS  
  0390 6138   40         BYTE CPBRK             , COMMA   
  0391 6139   0C         BYTE CPOP+CPNUM        - MINUS   
  0392 613A   04         BYTE CPNUM             . PERIOD  
  0393 613B   08         BYTE CPOP              / SLANT   
  0394 613C   06         BYTE CPNUM+CPDIG       0 ZERRO   
  0395 613D   06         BYTE CPNUM+CPDIG       1 ONE   
  0396 613E   06         BYTE CPNUM+CPDIG       2 TWO   
  0397 613F   06         BYTE CPNUM+CPDIG       3 THREE   
  0398 6140   06         BYTE CPNUM+CPDIG       4 FOUR  
  0399 6141   06         BYTE CPNUM+CPDIG       5 FIVE  
  0400 6142   06         BYTE CPNUM+CPDIG       6 SIX   
  0401 6143   06         BYTE CPNUM+CPDIG       7 SEVEN   
  0402 6144   06         BYTE CPNUM+CPDIG       8 EIGHT   
  0403 6145   06         BYTE CPNUM+CPDIG       9 NINE  
  0404 6146   10  LBCPMO BYTE CPMO              : COLON   
  0405 6147   40         BYTE CPBRK             : SEMICOLON   
  0406 6148   08         BYTE CPOP              < LESS THAN   
  0407 6149   08         BYTE CPOP              = EQUALS  
  0408 614A   08         BYTE CPOP              > GREATER THAN  

 99/4 ASSEMBLER
CPT                                                          PAGE 0009
  0409 614B   00         BYTE CPNIL             ? QUESTION MARK   
  0410 614C   20         BYTE CPALPH            @ COMMERCIAL AT   
  0411 614D   20         BYTE CPALPH            A UPPERCASE A   
  0412 614E   20         BYTE CPALPH            B UPPERCASE B   
  0413 614F   20         BYTE CPALPH            C UPPERCASE C   
  0414 6150   20         BYTE CPALPH            D UPPERCASE D   
  0415 6151   24         BYTE CPALPH+CPNUM      E UPPERCASE E   
  0416 6152   20         BYTE CPALPH            F UPPERCASE F   
  0417 6153   20         BYTE CPALPH            G UPPERCASE G   
  0418 6154   20         BYTE CPALPH            H UPPERCASE H   
  0419 6155   20         BYTE CPALPH            I UPPERCASE I   
  0420 6156   20         BYTE CPALPH            J UPPERCASE J   
  0421 6157   20         BYTE CPALPH            K UPPERCASE K   
  0422 6158   20         BYTE CPALPH            L UPPERCASE L   
  0423 6159   20         BYTE CPALPH            M UPPERCASE M   
  0424 615A   20         BYTE CPALPH            N UPPERCASE N   
  0425 615B   20         BYTE CPALPH            O UPPERCASE O   
  0426 615C   20         BYTE CPALPH            P UPPERCASE P   
  0427 615D   20         BYTE CPALPH            Q UPPERCASE Q   
  0428 615E   20         BYTE CPALPH            R UPPERCASE R   
  0429 615F   20         BYTE CPALPH            S UPPERCASE S   
  0430 6160   20         BYTE CPALPH            T UPPERCASE T   
  0431 6161   20         BYTE CPALPH            U UPPERCASE U   
  0432 6162   20         BYTE CPALPH            V UPPERCASE V   
  0433 6163   20         BYTE CPALPH            W UPPERCASE W   
  0434 6164   20         BYTE CPALPH            X UPPERCASE X   
  0435 6165   20         BYTE CPALPH            Y UPPERCASE Y   
  0436 6166   20         BYTE CPALPH            Z UPPERCASE Z   
  0437 6167   20         BYTE CPALPH            [ LEFT SQUARE BRACKET   
  0438 6168   20         BYTE CPALPH            \ REVERSE SLANT   
  0439 6169   20         BYTE CPALPH            ] RIGHT SQUARE BRACKET  
  0440 616A   08         BYTE CPOP              ^ CIRCUMFLEX  
  0441 616B   20         BYTE CPALPH            _ UNDERLINE   
  0442            *-----------------------------------------------------------
  0443            * Following "`" and lowercase characters are for  
  0444            * adding lowercase character set in 99/4A, 5/12/81  
  0445            *-----------------------------------------------------------
  0446 616C   00         BYTE CPNIL             ` GRAVE ACCENT  
  0447 616D   21         BYTE CPALPH+CPLOW      a LOWERCASE a   
  0448 616E   21         BYTE CPALPH+CPLOW      b LOWERCASE b   
  0449 616F   21         BYTE CPALPH+CPLOW      c LOWERCASE c   
  0450 6170   21         BYTE CPALPH+CPLOW      d LOWERCASE d   
  0451 6171   21         BYTE CPALPH+CPLOW      e LOWERCASE e   
  0452 6172   21         BYTE CPALPH+CPLOW      f LOWERCASE f   
  0453 6173   21         BYTE CPALPH+CPLOW      g LOWERCASE g   
  0454 6174   21         BYTE CPALPH+CPLOW      h LOWERCASE h   
  0455 6175   21         BYTE CPALPH+CPLOW      i LOWERCASE i   
  0456 6176   21         BYTE CPALPH+CPLOW      j LOWERCASE j   
  0457 6177   21         BYTE CPALPH+CPLOW      k LOWERCASE k   
  0458 6178   21         BYTE CPALPH+CPLOW      l LOWERCASE l   
  0459 6179   21         BYTE CPALPH+CPLOW      m LOWERCASE m   
  0460 617A   21         BYTE CPALPH+CPLOW      n LOWERCASE n   
  0461 617B   21         BYTE CPALPH+CPLOW      o LOWERCASE o   
  0462 617C   21         BYTE CPALPH+CPLOW      p LOWERCASE p   
  0463 617D   21         BYTE CPALPH+CPLOW      q LOWERCASE q   
  0464 617E   21         BYTE CPALPH+CPLOW      r LOWERCASE r   
  0465 617F   21         BYTE CPALPH+CPLOW      s LOWERCASE s   
  0466 6180   21         BYTE CPALPH+CPLOW      t LOWERCASE t   
  0467 6181   21         BYTE CPALPH+CPLOW      u LOWERCASE u   

 99/4 ASSEMBLER
CPT                                                          PAGE 0010
  0468 6182   21         BYTE CPALPH+CPLOW      v LOWERCASE v   
  0469 6183   21         BYTE CPALPH+CPLOW      w LOWERCASE w   
  0470 6184   21         BYTE CPALPH+CPLOW      x LOWERCASE x   
  0471 6185   21         BYTE CPALPH+CPLOW      y LOWERCASE y   
  0472 6186   21         BYTE CPALPH+CPLOW      z LOWERCASE z   
  0473                
  0474                   EVEN   
  0475            ************************************************************
  0476 6188              AORG >6188   
  0478                
  0479            * General Basic support routines (not includeing PARSE)   
  0480                
  0481            *   
  0482      0503  ERRBS  EQU  >0503             BAD SUBSCRIPT ERROR CODE  
  0483      0603  ERRTM  EQU  >0603             ERROR STRING/NUMBER MISMATCH  
  0484            *   
  0485 6188 6500  STCODE DATA >6500   
  0486 618A 0006  C6     DATA >0006   
  0487            *   
  0488            * Entry to find Basic symbol table entry for GPL  
  0489            *   
  0490 618C 06A0  FBSYMB BL   @FBS              Search the symbol table   
       618E 15E0  
  0491 6190 006A         DATA RESET             If not found - condition reset
  0492 6192 F820  SET    SOCB @BIT2,@STATUS     Set GPL condition   
       6194 62AB  
       6196 837C  
  0493 6198 0460         B    @NEXT             If found - condition set  
       619A 0070  
  0494            * GPL entry for COMPCT to take advantage of common code   
  0495 619C 0206  COMPCG  LI   R6,COMPCT        Address of COMPCT   
       619E 73D8  
  0496 61A0 100E         JMP  SMBB10            Jump to set up  
  0497            * GPL entry for GETSTR to take advantage of common code   
  0498 61A2 0206  GETSTG LI   R6,GETSTR         Address of MEMCHK   
       61A4 736C  
  0499 61A6 100B         JMP  SMBB10            Jump to set up  
  0500            * GPL entry for SMB to take advantage of common code  
  0501 61A8 0206  SMBB   LI   R6,SMB            Address of SMB routine  
       61AA 61DC  
  0502 61AC 1008         JMP  SMBB10            Jump to set up  
  0503            * GPL entry for ASSGNV to take advantage of common code   
  0504 61AE 0206  ASSGNV LI   R6,ASSG           Address of ASSGNV routine   
       61B0 6334  
  0505 61B2 1005         JMP  SMBB10            Jump to set up  
  0506            * GPL entry for SMB to take advantage of common code  
  0507 61B4 0206  SYMB   LI   R6,SYM            Address of SYM routine  
       61B6 6312  
  0508 61B8 1002         JMP  SMBB10            Jump to set up  
  0509            * GPL entry for SMB to take advantage of common code  
  0510 61BA 0206  VPUSHG LI   R6,VPUSH          Address of VPUSH routine  
       61BC 6BAA  
  0511 61BE C1CB  SMBB10 MOV  R11,R7            Save return address   
  0512 61C0 06A0         BL   @PUTSTK           Save current GROM address   
       61C2 60F2  
  0513 61C4 06A0         BL   @SETREG           Set up Basic registers  
       61C6 1E7A  
  0514 61C8 05C9         INCT R9                Get space on subroutine stack 
  0515 61CA C647         MOV  R7,*R9            Save the return address   

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0011
  0516 61CC 0696         BL   *R6               Branch and link to the routine
  0517 61CE C1D9         MOV  *R9,R7            Get return address  
  0518 61D0 0649         DECT R9                Restore subroutine stack  
  0519 61D2 06A0         BL   @SAVREG           Save registers for GPL  
       61D4 1E8C  
  0520 61D6 06A0         BL   @GETSTK           Restore GROM address  
       61D8 610E  
  0521 61DA 0457         B    *R7               Return to GPL   
  0522            ************************************************************
  0523            * Subroutine to find the pointer to variable space of each  
  0524            * element of symbol table entry. Decides whether symbol   
  0525            * table entry pointed to by FAC, FAC+1 is a simple variable 
  0526            * and returns proper 8-byte block in FAC through FAC7   
  0527            ************************************************************
  0528 61DC 05C9  SMB    INCT R9                Get space on subroutine stack 
  0529 61DE C64B         MOV  R11,*R9           Save return address   
  0530 61E0 C820         MOV  @FAC,@FAC4        Copy pointer to table entry   
       61E2 834A  
       61E4 834E  
  0531 61E6 A820         A    @C6,@FAC4         Add 6 so point a value space  
       61E8 618A  
       61EA 834E  
  0532 61EC 06A0         BL   @GETV             Get 1st byte of table entry   
       61EE 187C  
  0533 61F0 834A         DATA FAC               Pointer is in FAC   
  0534            *   
  0535 61F2 C101         MOV  R1,R4             Copy for later use.   
  0536 61F4 C081         MOV  R1,R2             Copy for later use.   
  0537 61F6 0A21         SLA  R1,2              Check for UDF entry   
  0538 61F8 1821         JOC  BERMUV            If UDF - then error   
  0539 61FA C104         MOV  R4,R4             Check for string.   
  0540 61FC 1102         JLT  SMB02             Skip if it is string.   
  0541 61FE 04E0         CLR  @FAC2             Clear for numeric case.   
       6200 834C  
  0542            *   
  0543            * In case of subprogram call check if parameter is shared by
  0544            * it's  calling program.  
  0545            *   
  0546 6202 0A11  SMB02  SLA  R1,1              Check for the shared bit.   
  0547 6204 1705         JNC  SMB04             If it is not shared skip.   
  0548 6206 06A0         BL   @GET              Get the value space pointer   
       6208 6C9A  
  0549 620A 834E         DATA FAC4                in the symbol table.  
  0550 620C C801         MOV  R1,@FAC4          Store the value space address.
       620E 834E  
  0551            *   
  0552            * Branches to take care of string and array cases.  
  0553            * Only the numeric variable case stays on.  
  0554            *   
  0555 6210 D104  SMB04  MOVB R4,R4             R4 has header byte information
  0556 6212 1116         JLT  SMBO50            Take care of string.  
  0557 6214 0A54  SMB05  SLA  R4,5              Get only the dimension number.
  0558 6216 09D4         SRL  R4,13   
  0559 6218 162A         JNE  SMBO20             go to array case.  
  0560            *   
  0561            * Numeric ERAM cases are special.   
  0562            * If it is shared get the actual v.s. address from ERAM.  
  0563            * Otherwise get it from VDP RAM.  
  0564            *   

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0012
  0565 621A D120         MOVB @RAMTOP,R4        Check for ERAM.   
       621C 8384  
  0566 621E 130B         JEQ  SMBO10            Yes ERAM case.  
  0567 6220 0A32         SLA  R2,3              R2 has a header byte.   
  0568 6222 1704         JNC  SMB06             Shared bit is not ON.   
  0569 6224 06A0         BL   @GETG             Get v.s. pointer from ERAM  
       6226 6CCA  
  0570 6228 834E         DATA FAC4  
  0571 622A 1003         JMP  SMB08   
  0572 622C 06A0  SMB06  BL   @GET              Not shared.   
       622E 6C9A  
  0573 6230 834E         DATA FAC4              Get v.s. address from VDP RAM.
  0574            *   
  0575 6232 C801  SMB08  MOV  R1,@FAC4          Store it in FAC4 area.  
       6234 834E  
  0576            *   
  0577            * Return from the SMB routine.  
  0578            *   
  0579 6236 C2D9  SMBO10 MOV  *R9,R11           Restore return address  
  0580 6238 0649         DECT R9                Restore stack   
  0581 623A 045B         RT                     And return  
  0582 623C 0460  BERMUV B    @ERRMUV           * INCORRECT NAME USAGE  
       623E 6970  
  0583            *   
  0584            * Start looking for the real address of the symbol.   
  0585            *   
  0586 6240 0288  SMBO50 CI   R8,LPARZ*256      String - now string array?  
       6242 B700  
  0587 6244 13E7         JEQ  SMB05             Yes, process as an array  
  0588 6246 C820  SMB51  MOV  @STCODE,@FAC2     String ID code in FAC2  
       6248 6188  
       624A 834C  
  0589 624C C820         MOV  @FAC4,@FAC        Get string pointer address  
       624E 834E  
       6250 834A  
  0590 6252 06A0         BL   @GET              Get exact pointer to string   
       6254 6C9A  
  0591 6256 834A         DATA FAC   
  0592            *   
  0593 6258 C801         MOV  R1,@FAC4          Save pointer to string  
       625A 834E  
  0594 625C C0C1         MOV  R1,R3             Was it a null?  
  0595 625E 1304         JEQ  SMB57             Length is 0 - so is null  
  0596 6260 0603         DEC  R3                Otherwise point at length byte
  0597 6262 06A0         BL   @GETV1            Get the string length   
       6264 1880  
  0598 6266 0981         SRL  R1,8              Shift for use as double   
  0599 6268 C801  SMB57  MOV  R1,@FAC6          Put into FAC entry  
       626A 8350  
  0600 626C 10E4         JMP  SMBO10            And return  
  0601            *   
  0602            * Array cases are taken care of here.   
  0603            *   
  0604 626E C804  SMBO20  MOV R4,@FAC2          Now have a dimension counter  
       6270 834C  
  0605            *                              that is initilized to maximum
  0606            *  *FAC+4,FAC+5 already points to 1st dimension maximum in  
  0607            *    in symbol table.   
  0608 6272 04C2         CLR  R2                Clear index accumulator   

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0013
  0609 6274 C802  SMBO25 MOV  R2,@FAC6          Save accumulator in FAC   
       6276 8350  
  0610 6278 06A0         BL   @PGMCHR           Get next character  
       627A 6C74  
  0611 627C 06A0         BL   @PSHPRS           PUSH and PARSE subscript  
       627E 6B9C  
  0612 6280   B7         BYTE LPARZ,0           Up to a left parenthesis or le
       6281   00  
  0613            *   
  0614 6282 9820         CB   @FAC2,@STCODE     Dimension can't be a string   
       6284 834C  
       6286 6188  
  0615 6288 1441         JHE  ERRT              It is - so error  
  0616            * Now do float to interger conversion of dimension  
  0617 628A 04E0         CLR  @FAC10            Assume no error   
       628C 8354  
  0618 628E 06A0         BL   @CFI              Gets 2 byte integer in FAC,FAC
       6290 12B8  
  0619 6292 D120         MOVB @FAC10,R4         Error on conversion?  
       6294 8354  
  0620 6296 1636         JNE  ERR3              Yes, error BAD SUBSCRIPT  
  0621 6298 C160         MOV  @FAC,R5           Save index just read  
       629A 834A  
  0622 629C 06A0         BL   @VPOP             Restore FAC block   
       629E 6C2A  
  0623 62A0 06A0         BL   @GET              Get next dimension maximum  
       62A2 6C9A  
  0624 62A4 834E         DATA FAC4              FAC4 points into symbol table 
  0625            *   
  0626 62A6 8045         C    R5,R1             Subscript less-then maximum?  
  0627 62A8 1B2D         JH   ERR3              No, index out of bounds   
  0628      62AB  BIT2   EQU  $+1               Constant >20 (Opcode is >D120)
  0629 62AA D120         MOVB @BASE,R4          Fetch option base to check low
       62AC 8343  
  0630 62AE 1303         JEQ  SMBO40            If BASE=0, INDEX=0 is ok  
  0631 62B0 0605         DEC  R5                Adjust BASE 1 index   
  0632 62B2 1128         JLT  ERR3              If subscript was =0 then error
  0633 62B4 1001         JMP  SMBO41            Accumulate the subscripts   
  0634 62B6 0581  SMBO40 INC  R1                Adjust size if BASE=0   
  0635 62B8 3860  SMBO41 MPY  @FAC6,R1          R1,R2 has ACCUM*MAX dimension 
       62BA 8350  
  0636 62BC A085         A    R5,R2             Add latest to accumulator   
  0637 62BE 05E0         INCT @FAC4             Increment dimension max pointe
       62C0 834E  
  0638 62C2 0620         DEC  @FAC2             Decrement remaining-dim count 
       62C4 834C  
  0639 62C6 1305         JEQ  SMBO70            All dimensions handled ->done 
  0640 62C8 0288         CI   R8,COMMAZ*256     Otherwise, must be at a comma 
       62CA B300  
  0641 62CC 13D3         JEQ  SMBO25            We are, so loop for more  
  0642 62CE 0460  ERR1   B    @ERRSYN           Not a comma, so SYNTAX ERROR  
       62D0 664E  
  0643            *   
  0644            * At this point the required number of dimensions have been 
  0645            *  scanned.   
  0646            * R2 Contains the index   
  0647            * R4 Points to the first array element or points to the   
  0648            *  address in ERAM where the first array element is.  
  0649 62D2 0288  SMBO70 CI   R8,RPARZ*256      Make sure at a right parenthes

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0014
       62D4 B600  
  0650 62D6 16FB         JNE  ERR1              Not, so error   
  0651 62D8 06A0         BL   @PGMCHR           Get nxt token   
       62DA 6C74  
  0652 62DC 06A0         BL   @GETV             Now check string or numeric   
       62DE 187C  
  0653 62E0 834A         DATA FAC                array by checking s.t.   
  0654            *   
  0655 62E2 110C         JLT  SMB71             If MSB set is a string array  
  0656 62E4 0A32         SLA  R2,3              Numeric, multiply by 8  
  0657 62E6 D0E0         MOVB @RAMTOP,R3        Does ERAM exist?  
       62E8 8384  
  0658 62EA 1305         JEQ  SMBO71            No  
  0659 62EC 06A0         BL   @GET              Yes, get the content of value 
       62EE 6C9A  
  0660 62F0 834E         DATA FAC4               pointer  
  0661            *   
  0662 62F2 C801         MOV  R1,@FAC4          Put it in FAC4  
       62F4 834E  
  0663 62F6 A802  SMBO71 A    R2,@FAC4          Add into values pointer   
       62F8 834E  
  0664 62FA 109D         JMP  SMBO10            And return in the normal way  
  0665 62FC 0A12  SMB71  SLA  R2,1              String, multiply by 2   
  0666 62FE A802         A    R2,@FAC4          Add into values pointer   
       6300 834E  
  0667 6302 10A1         JMP  SMB51             And build the string FAC entry
  0668 6304 0200  ERR3   LI   R0,ERRBS          Bad subscript return vector   
       6306 0503  
  0669 6308 0460  ERRX   B    @ERR              Exit to GPL   
       630A 6652  
  0670 630C 0200  ERRT   LI   R0,ERRTM          String/number mismatch vector 
       630E 0603  
  0671 6310 10FB         JMP  ERRX              Use the long branch   
  0672            ************************************************************
  0673            * Subroutine to put symbol name into FAC and to call FBS to 
  0674            * find the symbol table for the symbol  
  0675            ************************************************************
  0676 6312 04E0  SYM    CLR  @FAC15            Clear the caharacter counter  
       6314 8359  
  0677 6316 0202         LI   R2,FAC            Copying string into FAC   
       6318 834A  
  0678 631A C04B         MOV  R11,R1            Save return address   
  0679            *-----------------------------------------------------------
  0680            * Fix "A long constant in a variable field in INPUT,  
  0681            *      ACCEPT, LINPUT, NEXT and READ etc. may crash the   
  0682            *      sytem" bug,            5/22/81   
  0683            * Insert the following 2 lines  
  0684 631C D208         MOVB R8,R8   
  0685 631E 11D7         JLT  ERR1              If token  
  0686 6320 DC88  SYM1   MOVB R8,*R2+           Save the character  
  0687 6322 05A0         INC  @FAC15            Count it  
       6324 8359  
  0688 6326 06A0         BL   @PGMCHR           Get next character  
       6328 6C74  
  0689 632A 15FA         JGT  SYM1              Still characters in the name  
  0690 632C 06A0         BL   @FBS              Got name, now find s.t. entry 
       632E 15E0  
  0691 6330 62CE         DATA ERR1              Return vector if not found  
  0692            *   

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0015
  0693 6332 0451         B    *R1               Return to caller if found   
  0694            ************************************************************
  0695            * ASSGNV, callable from GPL or 9900 code, to assign a value 
  0696            * to a symbol (strings and numerics) . If numeric, the  
  0697            * 8 byte descriptor is in the FAC. The descriptor block   
  0698            * (8 bytes) for the destination variable is on the stack.   
  0699            * There are two types of descriptor entries which are   
  0700            * created by SMB in preparation for ASSGNV, one for   
  0701            * numerics and one for strings.   
  0702            *                     NUMERIC   
  0703            * +-------------------------------------------------------+ 
  0704            * |S.T. ptr | 00 |       |Value ptr |                     | 
  0705            * +-------------------------------------------------------+ 
  0706            *                     STRING  
  0707            * +-------------------------------------------------------+ 
  0708            * |Value ptr| 65 |       |String ptr|String length        | 
  0709            * +-------------------------------------------------------+ 
  0710            *   
  0711            * CRITICAL NOTE: Becuase of the BL @POPSTK below, if a  
  0712            * string entry is popped and a garbage collection has taken 
  0713            * place while the entry was pushed on the stack, and the  
  0714            * entry was a permanent string the pointer in FAC4 and FAC5 
  0715            * will be messed up. A BL @VPOP would have taken care of  
  0716            * the problem but would have taken a lot of extra code.   
  0717            * Therefore, at ASSG50-ASSG54 it is assumed that the  
  0718            * previous value assigned to the destination variable has   
  0719            * been moved and the pointer must be reset by going back to 
  0720            * the symbol table and getting the correct value pointer.   
  0721            ************************************************************
  0722 6334 C28B  ASSG   MOV  R11,R10           Save the retun address  
  0723 6336 06A0         BL   @ARGTST           Check arg and variable type   
       6338 6B6E  
  0724 633A 02CC         STST R12               Save status of type   
  0725 633C 06A0         BL   @POPSTK           Pop destination descriptor  
       633E 60D4  
  0726            *                              into ARG   
  0727 6340 0A3C         SLA  R12,3             Variable type numeric?  
  0728 6342 1745         JNC  ASSG70            Yes, handle it as such  
  0729            * Assign a string to a string variable  
  0730 6344 C060         MOV  @ARG4,R1          Get destination pointer   
       6346 8360  
  0731            *                             Dest have non-null  value?  
  0732 6348 130B         JEQ  ASSG54            No, null->never assigned  
  0733            * Previously assigned - Must first free the old value   
  0734 634A 06A0         BL   @GET              Correct for POPSTK above  
       634C 6C9A  
  0735 634E 835C         DATA ARG               Pointer is in ARG   
  0736            *   
  0737 6350 C801         MOV  R1,@ARG4          Correct ARG+4,5 too   
       6352 8360  
  0738            *-----------------------------------------------------------
  0739            * Fix "Assigning a string to itself when memory is full can 
  0740            *      destroy the string" bug, 5/22/81   
  0741            * Add the following 2 lines and the label ASSG80  
  0742 6354 8801         C    R1,@FAC4          Do not do anything in assign- 
       6356 834E  
  0743            *                              ing a string to itself case  
  0744 6358 1317         JEQ  ASSG80            Detect A$=A$ case, exit   
  0745            *-----------------------------------------------------------

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0016
  0746 635A 04C6         CLR  R6                Clear for zeroing backpointer 
  0747 635C 06A0         BL   @STVDP3           Free the string   
       635E 18AA  
  0748 6360 C120  ASSG54 MOV  @FAC6,R4          Is source string a null?  
       6362 8350  
  0749 6364 130C         JEQ  ASSG57            Yes, handle specially   
  0750 6366 C0E0         MOV  @FAC,R3           Get address of source pointer 
       6368 834A  
  0751 636A 0283         CI   R3,>001C          Got a temporay string?  
       636C 001C  
  0752 636E 160D         JNE  ASSG56            No, more complicated  
  0753 6370 C120         MOV  @FAC4,R4          Pick up direct ptr to string  
       6372 834E  
  0754            * Common string code to set forward and back pointers   
  0755 6374 C1A0  ASSG55 MOV  @ARG,R6           Ptr to symbol table pointer   
       6376 835C  
  0756 6378 C044         MOV  R4,R1             Pointer to source string  
  0757 637A 06A0         BL   @STVDP3           Set the backpointer   
       637C 18AA  
  0758 637E C060  ASSG57 MOV  @ARG,R1           Address of symbol table ptr   
       6380 835C  
  0759 6382 C184         MOV  R4,R6             Pointer to string   
  0760 6384 06A0         BL   @STVDP            Set the forward pointer   
       6386 18AE  
  0761 6388 045A  ASSG80 B    *R10              Done, return  
  0762            * Symbol-to-symbol assigments of strings  
  0763            * Must create copy of string  
  0764 638A C820  ASSG56 MOV  @FAC6,@BYTE       Fetch length for GETSTR   
       638C 8350  
       638E 830C  
  0765            * NOTE: FAC through FAC+7 cannot be destroyed   
  0766            *       address^of string length^of string  
  0767 6390 06A0         BL   @VPUSH            So save it on the stack   
       6392 6BAA  
  0768 6394 C80A         MOV  R10,@FAC          Save return link in FAC since 
       6396 834A  
  0769            *                              GETSTR does not destroy FAC  
  0770 6398 06A0         BL   @GETSTR           Call GPL to do the GETSTR   
       639A 736C  
  0771 639C C2A0         MOV  @FAC,R10          Restore return link   
       639E 834A  
  0772 63A0 06A0         BL   @VPOP             Pop the source info back  
       63A2 6C2A  
  0773            * Set up to copy the source string into destination   
  0774 63A4 C0E0         MOV  @FAC4,R3          R3 is now copy-from   
       63A6 834E  
  0775 63A8 C160         MOV  @SREF,R5          R5 is now copy-to   
       63AA 831C  
  0776 63AC C105         MOV  R5,R4             Save for pointer setting  
  0777            * Registers to be used in the copy  
  0778            * R1 - Used for a buffer  
  0779            * R3 - Copy-from address  
  0780            * R2 - # of bytes to be moved   
  0781            * R5 - copy-to address  
  0782 63AE C0A0         MOV  @FAC6,R2          Fetch the length of the string
       63B0 8350  
  0783 63B2 0265         ORI  R5,WRVDP          Enable the VDP write  
       63B4 4000  
  0784 63B6 06A0  ASSG59 BL   @GETV1            Get the character   

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0017
       63B8 1880  
  0785 63BA D7E0         MOVB @R5LB,*R15        Load out destination address  
       63BC 83EB  
  0786 63BE 0583         INC  R3                Increment the copy-from   
  0787 63C0 D7C5         MOVB R5,*R15           1st byte of address to  
  0788 63C2 0585         INC  R5                Increment for next character  
  0789 63C4 D801         MOVB R1,@XVDPWD        Put the character out   
       63C6 8C00  
  0790 63C8 0602         DEC  R2                Decrement count, finished?  
  0791 63CA 15F5         JGT  ASSG59            No, loop for more   
  0792 63CC 10D3         JMP  ASSG55            Yes, now set pointers   
  0793            * Code to copy a numeric value into the symbol table  
  0794 63CE 0202  ASSG70 LI   R2,8              Need to assign 8 bytes  
       63D0 0008  
  0795 63D2 C160         MOV  @ARG4,R5          Destination pointer(R5)   
       63D4 8360  
  0796            *                              from buffer(R4), (R2)bytes   
  0797 63D6 C0E0         MOV  @RAMTOP,R3        Does ERAM exist?  
       63D8 8384  
  0798 63DA 160C         JNE  ASSG77            Yes, write to ERAM  
  0799            *                             No, write to VDP  
  0800 63DC D7E0         MOVB @R5LB,*R15        Load out 2nd byte of address  
       63DE 83EB  
  0801 63E0 0265         ORI  R5,WRVDP          Enable the write to the VDP   
       63E2 4000  
  0802 63E4 D7C5         MOVB R5,*R15           Load out 1st byte of address  
  0803 63E6 0204         LI   R4,FAC            Source is FAC   
       63E8 834A  
  0804 63EA D834  ASSG75 MOVB *R4+,@XVDPWD      Move a byte   
       63EC 8C00  
  0805 63EE 0602         DEC  R2                Decrement the counter, done?  
  0806 63F0 15FC         JGT  ASSG75            No, loop for more   
  0807 63F2 045A         B    *R10              Yes, return to the caller   
  0808 63F4 0204  ASSG77 LI   R4,FAC            Source is in FAC  
       63F6 834A  
  0809 63F8 DD74  ASSG79 MOVB *R4+,*R5+         Move a byte   
  0810 63FA 0602         DEC  R2                Decrement the counter, done?  
  0811 63FC 15FD         JGT  ASSG79            No, loop for more   
  0812 63FE 045A         B    *R10              Yes, return to caller   
  0813            * Check for required token  
  0814 6400 D01D  SYNCHK MOVB *R13,R0           Read required token   
  0815            *   
  0816 6402 9800         CB   R0,@CHAT          Have the required token?  
       6404 8342  
  0817 6406 1304         JEQ  PGMCH             Yes, read next character  
  0818 6408 06A0         BL   @SETREG           Error return requires R8/R9 se
       640A 1E7A  
  0819 640C 0460         B    @ERRSYN           * SYNTAX ERROR  
       640E 664E  
  0820            *      PGMCH - GPL entry point for PGMCHR to set up register
  0821 6410 C30B  PGMCH  MOV  R11,R12           Save return address   
  0822 6412 06A0         BL   @PGMCHR           Get the next character  
       6414 6C74  
  0823 6416 D808         MOVB R8,@CHAT          Put it in for GPL   
       6418 8342  
  0824 641A 045C         B    *R12              Return to GPL   
  0825 641C 045B         RT                     And return to the caller  
  0826 641E C13B  PUTV   MOV  *R11+,R4  
  0827 6420 C114         MOV  *R4,R4  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0018
  0828 6422 D7E0  PUTV1  MOVB @R4LB,*R15  
       6424 83E9  
  0829 6426 0264         ORI  R4,WRVDP  
       6428 4000  
  0830 642A D7C4         MOVB R4,*R15   
  0831 642C 1000         NOP  
  0832 642E D801         MOVB R1,@XVDPWD  
       6430 8C00  
  0833 6432 045B         RT   
  0834            * MOVFAC - copies 8 bytes from VDP(@FAC4) or ERAM(@FAC4)  
  0835            *          to FAC   
  0836 6434 C060  MOVFAC MOV @FAC4,R1           Get pointer to source   
       6436 834E  
  0837 6438 0202         LI  R2,8               8 byte values   
       643A 0008  
  0838 643C 0203         LI  R3,FAC             Destination is FAC  
       643E 834A  
  0839 6440 C020         MOV @RAMTOP,R0         Does ERAM exist?  
       6442 8384  
  0840 6444 160A         JNE MOVFA2             Yes, from ERAM  
  0841            *                             No, from VDP RAM  
  0842 6446 06C1         SWPB R1  
  0843 6448 D7C1         MOVB R1,*R15           Load 2nd byte of address  
  0844 644A 06C1         SWPB R1  
  0845 644C D7C1         MOVB R1,*R15           Load 1st byte of address  
  0846 644E 0205         LI   R5,XVDPRD   
       6450 8800  
  0847 6452 DCD5  MOVF1  MOVB *R5,*R3+          Move a byte   
  0848 6454 0602         DEC  R2                Decrement counter, done?  
  0849 6456 15FD         JGT  MOVF1             No, loop for more   
  0850 6458 045B         RT                     Yes, return to caller   
  0851 645A DCF1  MOVFA2 MOVB *R1+,*R3+   
  0852 645C 0602         DEC  R2  
  0853 645E 16FD         JNE  MOVFA2  
  0854 6460 045B         RT   
  0855 6462 045B         RT                     And return to caller  
  0856            ************************************************************
  0857 6464              AORG >6464   
  0859                
  0860            *      BASIC PARSE CODE   
  0861            * REGISTER USAGE  
  0862            *    RESERVED FOR GPL INTERPRETER  R13, R14, R15  
  0863            *          R13 contains the read address for GROM   
  0864            *          R14 is used in BASSUP/10 for the VDPRAM pointer  
  0865            *    RESERVED IN BASIC SUPPORT  
  0866            *          R8 MSB current character (like CHAT in GPL)  
  0867            *          R8 LSB zero  
  0868            *          R10 read data port address for program data  
  0869            *   ALL EXITS TO GPL MUST GO THROUGH "NUDG05"   
  0870            *   
  0871                
  0872            *                         ~~~TOKENS~~~  
  0873      0081  ELSEZ  EQU  >81               ELSE  
  0874      0082  SSEPZ  EQU  >82               STATEMENT SEPERATOR   
  0875      0083  TREMZ  EQU  >83               TAIL REMARK   
  0876      0084  IFZ    EQU  >84               IF  
  0877      0085  GOZ    EQU  >85               GO  
  0878      0086  GOTOZ  EQU  >86               GOTO  
  0879      0087  GOSUBZ EQU  >87               GOSUB   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0019
  0880      008E  BREAKZ EQU  >8E               BREAK   
  0881      0096  NEXTZ  EQU  >96               NEXT  
  0882      00A1  SUBZ   EQU  >A1               SUB   
  0883      00A5  ERRORZ EQU  >A5               ERROR   
  0884      00A6  WARNZ  EQU  >A6               WARNING   
  0885      00B0  THENZ  EQU  >B0               THEN  
  0886      00B1  TOZ    EQU  >B1               TO  
  0887      00B3  COMMAZ EQU  >B3               COMMA   
  0888      00B6  RPARZ  EQU  >B6               RIGHT PARENTHESIS )   
  0889      00B7  LPARZ  EQU  >B7               LEFT PARENTHESIS (  
  0890      00BA  ORZ    EQU  >BA               OR  
  0891      00BB  ANDZ   EQU  >BB               AND   
  0892      00BC  XORZ   EQU  >BC               XOR   
  0893      00BD  NOTZ   EQU  >BD               NOT   
  0894      00BE  EQZ    EQU  >BE               EQUAL (=)   
  0895      00C0  GTZ    EQU  >C0               GREATER THEN (>)  
  0896      00C1  PLUSZ  EQU  >C1               PLUS (+)  
  0897      00C2  MINUSZ EQU  >C2               MINUS (-)   
  0898      00C4  DIVIZ  EQU  >C4               DIVIDE (/)  
  0899      00C5  EXPONZ EQU  >C5               EXPONENT  
  0900      00C7  STRINZ EQU  >C7               STRING  
  0901      00C9  LNZ    EQU  >C9               LINE NUMBER   
  0902      00CB  ABSZ   EQU  >CB               ABSOLUTE  
  0903      00D1  SGNZ   EQU  >D1               SIGN  
  0904            *   
  0905 6464 0018  C24    DATA 24                CONSTANT 24   
  0906 6466 65A6  EXRTNA DATA EXRTN             RETURN FOR EXEC   
  0907            *   
  0908 6468 0200  ERRSO  LI   R0,>0703          Issue STACK OVERFLOW message  
       646A 0703  
  0909 646C 0460         B    @ERR  
       646E 6652  
  0910            *   
  0911            * GRAPHICS LANGUAGE ENTRY TO PARSE  
  0912            *   
  0913 6470 06A0  PARSEG BL   @SETREG           Set up registers for Basic  
       6472 1E7A  
  0914 6474 D2ED         MOVB @GRMRAX(R13),R11  Get GROM address High byte  
       6476 0002  
  0915 6478 D82D         MOVB @GRMRAX(R13),@R11LB Get GROM addres low byte  
       647A 0002  
       647C 83F7  
  0916 647E 060B         DEC  R11               R11-1   
  0917            *   
  0918            * 9900 ENTRY TO PARSE   
  0919            *   
  0920 6480 05C9  PARSE  INCT R9         R11+2  Get room for return address   
  0921 6482 0289         CI   R9,STKEND         Stack full?   
       6484 83BA  
  0922 6486 1BF0         JH   ERRSO             Yes, too many levels deep   
  0923 6488 C64B         MOV  R11,*R9           Save the return address   
  0924 648A D1C8  P05    MOVB R8,R7     R8=CHAT Test for token beginning  
  0925 648C 1102         JLT  P10               If token, then look it up   
  0926 648E 0460         B    @PSYM             If not token is a symbol  
       6490 6884  
  0927 6492 06A0  P10    BL   @PGMCHR           Get next character  
       6494 6C74  
  0928 6496 0977         SRL  R7,7              Change last character to offse
  0929 6498 0227         AI   R7,->B7*2         Check for legal NUD   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0020
       649A FE92  
  0930 649C 0287         CI   R7,NTABLN         Within the legal NUD address? 
       649E 0056  
  0931 64A0 1B22         JH   CONT15            No, check for legal LED   
  0932 64A2 C1E7         MOV  @NTAB(R7),R7      Get NUD address   
       64A4 69FE  
  0933 64A6 1525         JGT  B9900             If 9900 code  
  0934      64A8  P17    EQU  $                 R7 contains offset into nudtab
  0935 64A8 0247         ANDI R7,>7FFF          If GPL code, get rid of MSB   
       64AA 7FFF  
  0936 64AC A1E0         A    @NUDTAB,R7        Add in table address  
       64AE 8328  
  0937 64B0 06A0  NUDG05 BL   @SAVREG           Restore GPL pointers  
       64B2 1E8C  
  0938 64B4 DB47         MOVB R7,@GRMWAX(R13)    Write out new GROM address   
       64B6 0402  
  0939 64B8 06C7         SWPB R7                Bare the LSB  
  0940 64BA DB47         MOVB R7,@GRMWAX(R13)    Put it out too   
       64BC 0402  
  0941 64BE 0460         B    @RESET            Go back to GPL interpreter  
       64C0 006A  
  0942 64C2 10F2  P17L   JMP  P17   
  0943            *   
  0944            * CONTINUE ROUTINE FOR PARSE  
  0945            *   
  0946 64C4 06A0  CONTG  BL   @SETREG           GPL entry-set Basic registers 
       64C6 1E7A  
  0947 64C8 C199  CONT   MOV  *R9,R6            Get last address from stack   
  0948 64CA 1506         JGT  CONT10            9900 code if not negative   
  0949 64CC DB46         MOVB R6,@GRMWAX(R13)    Write out new GROM address   
       64CE 0402  
  0950 64D0 06C6         SWPB R6                Bare the second byte  
  0951 64D2 DB46         MOVB R6,@GRMWAX(R13)    Put it out too   
       64D4 0402  
  0952 64D6 C18D         MOV  R13,R6            Set up to test precedence   
  0953 64D8 9216  CONT10 CB   *R6,R8            Test precedence   
  0954 64DA 1411         JHE  NUDNDL            Have parsed far enough->return
  0955 64DC 0978         SRL  R8,7              Make into table offset  
  0956 64DE 0228         AI   R8,->B8*2         Minimum token for a LED (*2)  
       64E0 FE90  
  0957 64E2 0288         CI   R8,LTBLEN         Maximum token for a LED (*2)  
       64E4 001C  
  0958 64E6 1B09  CONT15 JH   NOLEDL            If outside legal LED range-err
  0959 64E8 C1E8         MOV  @LTAB(R8),R7      Pick up address of LED handler
       64EA 6A54  
  0960 64EC 04C8         CLR  R8                Clear 'CHAT' for getting new  
  0961 64EE 06A0         BL   @PGMCHR           Get next character  
       64F0 6C74  
  0962 64F2 0457  B9900  B    *R7               Go to the LED handler   
  0963 64F4 0649  NUDE10 DECT R9                Back up subroutine stack  
  0964 64F6 0587         INC  R7                Skip over precedence  
  0965 64F8 10DB         JMP  NUDG05            Goto code to return to GPL  
  0966 64FA 0460  NOLEDL B    @NOLED  
       64FC 664E  
  0967 64FE 1073  NUDNDL JMP  NUDND1  
  0968            * Execute one or more lines of Basic  
  0969      6500  EXECG  EQU  $                 GPL entry point for execution 
  0970 6500 06A0         BL   @SETREG           Set up registers  
       6502 1E7A  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0021
  0971 6504 04E0         CLR  @ERRCOD           Clear the return code   
       6506 8322  
  0972 6508 D020         MOVB @PRGFLG,R0        Imperative statement?   
       650A 8344  
  0973 650C 131A         JEQ  EXEC15            Yes, handle it as such  
  0974            * Loop for each statement in the program  
  0975      650E  EXEC10 EQU  $   
  0976 650E D020         MOVB @FLAG,R0          Now test for trace mode   
       6510 8345  
  0977 6512 0A30         SLA  R0,3              Check the trace bit in FLAG   
  0978 6514 115F         JLT  TRACL             If set->display line number   
  0979 6516 C820  EXEC11 MOV  @EXTRAM,@PGMPTR   Get text pointer  
       6518 832E  
       651A 832C  
  0980 651C 0660         DECT @PGMPTR           Back to the line # to check   
       651E 832C  
  0981            *                              break point  
  0982 6520 06A0         BL   @PGMCHR           Get the first byte of line #  
       6522 6C74  
  0983 6524 02C0         STST R0                Save status for breakpnt check
  0984 6526 05A0         INC  @PGMPTR           Get text pointer again  
       6528 832C  
  0985 652A 06A0         BL   @PGMCHR           Go get the text pointer   
       652C 6C74  
  0986 652E 06C8         SWPB R8                Save 1st byte of text pointer 
  0987 6530 06A0         BL   @PGMCHR           Get 2nd byte of text pointer  
       6532 6C74  
  0988 6534 06C8         SWPB R8                Put text pointer in order   
  0989 6536 C808         MOV  R8,@PGMPTR        Set new text pointer  
       6538 832C  
  0990 653A 04C8         CLR  R8                Clean up the mess   
  0991 653C 0A20         SLA  R0,2              Check breakpoint status   
  0992 653E 1101         JLT  EXEC15            If no breakpoint set - count  
  0993 6540 177A         JNC  BRKPNT            If breakpoint set-handle it   
  0994      6542  EXEC15 EQU  $   
  0995      6544  C3     EQU  $+2               Constant data 3   
  0996      6545  CB3    EQU  $+3               Constant byte 3   
  0997 6542 0300         LIMI 3                 Let interrupts loose  
       6544 0003  
  0998      6548  C0     EQU  $+2               Constant data 0   
  0999 6546 0300         LIMI 0                 Shut down interrupts  
       6548 0000  
  1000 654A 04E0         CLR  @>83D6            Reset VDP timeout   
       654C 83D6  
  1001 654E 020C         LI   R12,>24           Load console KBD address in CR
       6550 0024  
  1002 6552 30E0         LDCR @C0,3             Select keyboard section   
       6554 6548  
  1003 6556 020C         LI   R12,6             Read address  
       6558 0006  
  1004 655A 3600         STCR R0,8              SCAN the keyboard   
  1005 655C 2420         CZC  @C1000,R0         Shift-key depressed?  
       655E 600A  
  1006 6560 160A         JNE  EXEC16            No, execute the Basic statemen
  1007 6562 020C         LI   R12,>24           Test column 3 of keyboard   
       6564 0024  
  1008 6566 30E0         LDCR @CB3,3            Select keyboard section   
       6568 6545  
  1009 656A 020C         LI   R12,6             Read address  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0022
       656C 0006  
  1010 656E 3600         STCR R0,8              SCAN the keyboard   
  1011 6570 2420         CZC  @C1000,R0         Shift-C depressed?  
       6572 600A  
  1012 6574 132E         JEQ  BRKP1L            Yes, so take Basic breakpoint 
  1013 6576 C820  EXEC16 MOV  @PGMPTR,@SMTSRT   Save start of statement   
       6578 832C  
       657A 831E  
  1014 657C 05C9         INCT R9                Get subroutine stack space  
  1015 657E C660         MOV  @EXRTNA,*R9       Save the GPL return address   
       6580 6466  
  1016 6582 06A0         BL   @PGMCHR           Now get 1st character of stmt 
       6584 6C74  
  1017 6586 1320         JEQ  EXRTN3            If EOL after EOS  
  1018 6588 1102  EXEC17 JLT  EXEC20            If top bit set->keyword   
  1019 658A 0460         B    @NLET             If not->fake a 'LET' stmt   
       658C 6948  
  1020 658E C1C8  EXEC20 MOV  R8,R7             Save 1st token so can get 2nd 
  1021 6590 05A0         INC  @PGMPTR           Increment the perm pointer  
       6592 832C  
  1022 6594 D21A         MOVB *R10,R8           Read the character  
  1023 6596 0977         SRL  R7,7              Convert 1st to table offset   
  1024 6598 0227         AI   R7,->AA*2         Check for legal stmt token  
       659A FEAC  
  1025 659C 1558         JGT  ERRONE            Not in range -> error   
  1026 659E C1E7         MOV  @STMTTB(R7),R7    Get address of stmt handler   
       65A0 69FC  
  1027 65A2 118F         JLT  P17L              If top bit set -> GROM code   
  1028 65A4 0457         B    *R7               If 9900 code, goto it!  
  1029 65A6   83  EXRTN  BYTE >83               Unused bytes for data constant
  1030 65A7   65  CBH65  BYTE >65                since NUDEND skips precedence
  1031 65A8 0288         CI   R8,SSEPZ*256      EOS only?   
       65AA 8200  
  1032 65AC 13CA         JEQ  EXEC15            Yes, continue on this line  
  1033 65AE D020  EXRTN2 MOVB @PRGFLG,R0        Did we execute an imperative  
       65B0 8344  
  1034 65B2 1351         JEQ  EXEC50            Yes, so return to top-level   
  1035 65B4 6820         S    @C4,@EXTRAM       No, so goto the next line   
       65B6 6A80  
       65B8 832E  
  1036 65BA 8820         C    @EXTRAM,@STLN     Check to see if end of program
       65BC 832E  
       65BE 8330  
  1037 65C0 14A6         JHE  EXEC10            No, so loop for the next line 
  1038 65C2 1049         JMP  EXEC50            Yes, so return to top-level   
  1039            *   
  1040            * STMT handler for ::   
  1041            *   
  1042 65C4 D208  SMTSEP MOVB R8,R8             EOL?  
  1043 65C6 16E0         JNE  EXEC17            NO, there is another stmt   
  1044 65C8 0649  EXRTN3 DECT R9                YES   
  1045 65CA 10F1         JMP  EXRTN2            Jump back into it   
  1046            * Continue after a breakpoint   
  1047 65CC 06A0  CONTIN BL   @SETREG           Set up Basic registers  
       65CE 1E7A  
  1048 65D0 10B8  EXC15L JMP  EXEC15            Continue execution  
  1049 65D2 1038  BRKP1L JMP  BRKPN1  
  1050 65D4 104E  TRACL  JMP  TRACE   
  1051            * Test for required End-Of-Statement  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0023
  1052 65D6 D208  EOL    MOVB R8,R8             EOL reached?  
  1053 65D8 1306         JEQ  NUDND1            Yes   
  1054 65DA 0288         CI   R8,TREMZ*256      Higher then tail remark token?
       65DC 8300  
  1055 65DE 1B37         JH   ERRONE            Yes, its an error   
  1056 65E0 0288         CI   R8,ELSEZ*256      Tail, ssep or else?   
       65E2 8100  
  1057 65E4 1A34         JL   ERRONE            No, error   
  1058            *   
  1059            * Return from call to PARSE   
  1060            * (entered from CONT)   
  1061            *   
  1062 65E6 C1D9  NUDND1 MOV  *R9,R7            Get the return address  
  1063 65E8 1185         JLT  NUDE10            If negative - return to GPL   
  1064 65EA 0649         DECT R9                Back up the subroutine stack  
  1065 65EC 0467         B    @2(R7)            And return to caller  
       65EE 0002  
  1066            *      (Skip the precedence word)   
  1067 65F0 D208  NUDEND MOVB R8,R8             Check for EOL   
  1068 65F2 13F9         JEQ  NUDND1            If EOL  
  1069 65F4 0288  NUDND2 CI   R8,STRINZ*256     Lower than a string?  
       65F6 C700  
  1070 65F8 1A08         JL   NUDND4            Yes   
  1071 65FA 0288         CI   R8,LNZ*256        Higher than a line #?   
       65FC C900  
  1072 65FE 1315         JEQ  SKPLN             Skip line numbers   
  1073 6600 1A0B         JL   SKPSTR            Skip string or numeric  
  1074 6602 06A0  NUDND3 BL   @PGMCHR           Read next character   
       6604 6C74  
  1075 6606 13EF         JEQ  NUDND1            If EOL  
  1076 6608 10F5         JMP  NUDND2            Continue scan of line   
  1077 660A 0288  NUDND4 CI   R8,TREMZ*256      Higher than a tail remark?  
       660C 8300  
  1078 660E 1BF9         JH   NUDND3            Yes   
  1079 6610 0288         CI   R8,SSEPZ*256      Lower then stmt sep(else)?  
       6612 8200  
  1080 6614 1AF6         JL   NUDND3            Yes   
  1081 6616 10E7         JMP  NUDND1            TREM or SSEP  
  1082 6618 06A0  SKPSTR BL   @PGMCHR   
       661A 6C74  
  1083 661C 06C8         SWPB R8                Prepare to add  
  1084 661E A808         A    R8,@PGMPTR        Skip it   
       6620 832C  
  1085 6622 04C8         CLR  R8                Clear lower byte  
  1086 6624 06A0  SKPS01 BL   @PGMCHR           Get next token  
       6626 6C74  
  1087 6628 10E3         JMP  NUDEND            Go on   
  1088 662A 05E0  SKPLN  INCT @PGMPTR           Skip line number  
       662C 832C  
  1089 662E 10FA         JMP  SKPS01            Go on   
  1090            *   
  1091            * Return from "CALL" to GPL   
  1092 6630 06A0  RTNG   BL   @SETREG           Set up registers again  
       6632 1E7A  
  1093 6634 10D8         JMP  NUDND1            And jump back into it!  
  1094            ************************************************************
  1095            * Handle Breakpoints  
  1096 6636 D020  BRKPNT MOVB @FLAG,R0          Check flag bits   
       6638 8345  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0024
  1097 663A 0A10         SLA  R0,1              Check bit 6 for breakpoint  
  1098 663C 11C9         JLT  EXC15L            If set then ignore breakpoint 
  1099 663E 0200  BRKPN2 LI   R0,BRKFL  
       6640 0001  
  1100 6642 1007         JMP  EXIT              Return to top-level   
  1101 6644 D020  BRKPN1 MOVB @FLAG,R0          Move flag bits  
       6646 8345  
  1102 6648 0A10         SLA  R0,1              Check bit 6 for breakpoint  
  1103 664A 1195         JLT  EXEC16            If set then ignore breakpoint 
  1104 664C 10F8         JMP  BRKPN2            Bit not set   
  1105            *   
  1106            * Error handling from 9900 code   
  1107            *   
  1108      664E  ERRSYN EQU  $                 These all issue same message  
  1109      664E  ERRONE EQU  $   
  1110      664E  NONUD  EQU  $   
  1111      664E  NOLED  EQU  $   
  1112 664E 0200         LI   R0,ERRSN          *SYNTAX ERROR return code   
       6650 0003  
  1113      6652  EXIT   EQU  $   
  1114 6652 C800  ERR    MOV  R0,@ERRCOD        Load up return code for GPL   
       6654 8322  
  1115            * General return to GPL portion of Basic  
  1116 6656 C1E0  EXEC50 MOV  @RTNADD,R7        Get return address  
       6658 8326  
  1117 665A 0460         B    @NUDG05           Use commond code to link back 
       665C 64B0  
  1118            * Handle STOP and END statements  
  1119            STOP  
  1120 665E 0649  END    DECT R9                Pop last call to PARSE  
  1121 6660 10FA         JMP  EXEC50            Jump to return to top-level   
  1122            * Error codes for return to GPL   
  1123      0003  ERRSN  EQU  >0003             ERROR SYNTAX  
  1124      0103  ERROM  EQU  >0103             ERROR OUT OF MEMORY   
  1125      0203  ERRIOR EQU  >0203             ERROR INDEX OUT OF RANGE  
  1126      0303  ERRLNF EQU  >0303             ERROR LINE NOT FOUND  
  1127      0403  ERREX  EQU  >0403             ERROR EXECUTION   
  1128            * >0004 WARNING NUMERIC OVERFLOW  
  1129      0001  BRKFL  EQU  >0001             BREAKPOINT RETURN VECTOR  
  1130      0005  ERROR  EQU  >0005             ON ERROR  
  1131      0006  UDF    EQU  >0006             FUNCTION REFERENCE  
  1132      0007  BREAK  EQU  >0007             ON BREAK  
  1133      0008  CONCAT EQU  >0008             CONCATENATE (&) STRINGS   
  1134      0009  WARN   EQU  >0009             ON WARNING  
  1135            * Warning routine (only OVERFLOW)   
  1136 6662 C820  WARNZZ MOV  @C4,@ERRCOD       Load warning code for GPL   
       6664 6A80  
       6666 8322  
  1137 6668 020B         LI   R11,CONT-2        To optimize for return  
       666A 64C6  
  1138            * Return to GPL as a CALL   
  1139 666C 05C9  CALGPL INCT R9                Get space on subroutine stack 
  1140 666E C64B         MOV  R11,*R9           Save return address   
  1141 6670 10F2         JMP  EXEC50            And go to GPL   
  1142            * Trace a line (Call GPL routine)   
  1143 6672 C820  TRACE  MOV  @C2,@ERRCOD       Load return vector  
       6674 6000  
       6676 8322  
  1144 6678 020B         LI   R11,EXEC11-2      Set up for return to execute  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0025
       667A 6514  
  1145 667C 10F7         JMP  CALGPL            Call GPL to display line #  
  1146            * Special code to handle concatenate (&)  
  1147 667E 0200  CONC   LI   R0,CONCAT         Go to GPL to handle it  
       6680 0008  
  1148 6682 10E7         JMP  EXIT              Exit to GPL interpeter  
  1149            ************************************************************
  1150            *              NUD routine for a numeric constant   
  1151            * NUMCON first puts pointer to the numeric string into  
  1152            * FAC12 for CSN, clears the error byte (FAC10) and then   
  1153            * converts from a string to a floating point number. Issues 
  1154            * warning if necessary. Leaves value in FAC   
  1155            ************************************************************
  1156 6684 C820  NUMCON MOV  @PGMPTR,@FAC12    Set pointer for CSN   
       6686 832C  
       6688 8356  
  1157 668A 06C8         SWPB R8                Swap to get length into LSB   
  1158 668C A808         A    R8,@PGMPTR        Add to pointer to check end   
       668E 832C  
  1159 6690 04E0         CLR  @FAC10            Assume no error   
       6692 8354  
  1160 6694 06A0         BL   @SAVRE2           Save registers  
       6696 1E90  
  1161 6698 0203         LI   R3,GETCH          Adjustment for ERAM in order  
       669A 60AE  
  1162 669C D120         MOVB @RAMFLG,R4         to call CSN  
       669E 8389  
  1163 66A0 1302         JEQ  NUMC49  
  1164 66A2 0203         LI   R3,GETCGR   
       66A4 60D0  
  1165 66A6 06A0  NUMC49 BL   @CSN01            Convert String to Number  
       66A8 11B2  
  1166 66AA 06A0         BL   @SETREG           Restore registers   
       66AC 1E7A  
  1167 66AE 8820         C    @FAC12,@PGMPTR    Check to see if all converted 
       66B0 8356  
       66B2 832C  
  1168 66B4 16CC         JNE  ERRONE            If not - error  
  1169 66B6 06A0         BL   @PGMCHR           Now get next char from program
       66B8 6C74  
  1170 66BA D020         MOVB @FAC10,R0         Get an overflow on conversion?
       66BC 8354  
  1171 66BE 16D1         JNE  WARNZZ            Yes, have GPL issue warning   
  1172 66C0 0460         B    @CONT             Continue the PARSE  
       66C2 64C8  
  1173            *   
  1174            * ON ERROR, ON WARNING and ON BREAK   
  1175 66C4 0200  ONERR  LI   R0,ERROR          ON ERROR code   
       66C6 0005  
  1176 66C8 10C4         JMP  EXIT              Return to GPL code  
  1177 66CA 0200  ONWARN LI   R0,WARN           ON WARNING code   
       66CC 0009  
  1178 66CE 10C1         JMP  EXIT              Return to GPL code  
  1179 66D0 0200  ONBRK  LI   R0,BREAK          ON BREAK code   
       66D2 0007  
  1180 66D4 10BE         JMP  EXIT              Return to GPL code  
  1181            *   
  1182            * NUD routine for "GO"  
  1183            *   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0026
  1184 66D6 04C3  GO     CLR  R3                Dummy "ON" index for common   
  1185 66D8 1020         JMP  ON30              Merge into "ON" code  
  1186            *   
  1187            * NUD ROUTINE FOR "ON"  
  1188            *   
  1189 66DA 0288  ON     CI   R8,WARNZ*256      On warning?   
       66DC A600  
  1190 66DE 13F5         JEQ  ONWARN            Yes, goto ONWARN  
  1191 66E0 0288         CI   R8,ERRORZ*256     On error?   
       66E2 A500  
  1192 66E4 13EF         JEQ  ONERR             Yes, got ONERR  
  1193 66E6 0288         CI   R8,BREAKZ*256     On break?   
       66E8 8E00  
  1194 66EA 13F2         JEQ  ONBRK             Yes, goto ONBRK   
  1195            *   
  1196            * Normal "ON" statement   
  1197            *   
  1198 66EC 06A0         BL   @PARSE            PARSE the index value   
       66EE 6480  
  1199 66F0   B3         BYTE COMMAZ            Stop on a comma or less   
  1200 66F1   66  CBH66  BYTE >66               Unused byte for constant  
  1201 66F2 06A0         BL   @NUMCHK           Ensure index is a number  
       66F4 6B92  
  1202 66F6 04E0         CLR  @FAC10            Assume no error in CFI  
       66F8 8354  
  1203 66FA 06A0         BL   @CFI              Convert Floating to Integer   
       66FC 12B8  
  1204 66FE D020         MOVB @FAC10,R0         Test error code   
       6700 8354  
  1205 6702 1603         JNE  GOTO90            If overflow, BAD VALUE  
  1206 6704 C0E0         MOV  @FAC,R3           Get the index   
       6706 834A  
  1207 6708 1503         JGT  ON20              Must be positive  
  1208 670A 0200  GOTO90 LI   R0,ERRIOR         Negative, BAD VALUE   
       670C 0203  
  1209 670E 10A1  GOTO95 JMP  ERR               Jump to error handler   
  1210      6710  ON20   EQU  $                 Now check GO TO/SUB   
  1211 6710 0288         CI   R8,GOZ*256        Bare "GO" token?  
       6712 8500  
  1212 6714 1608         JNE  ON40              No, check other possibilities 
  1213 6716 06A0         BL   @PGMCHR           Yes, get next token   
       6718 6C74  
  1214 671A 0288  ON30   CI   R8,TOZ*256        "GO TO" ?   
       671C B100  
  1215 671E 1365         JEQ  GOTO50            Yes, handle GO TO like GOTO   
  1216 6720 0288         CI   R8,SUBZ*256       "GO SUB" ?  
       6722 A100  
  1217 6724 1005         JMP  ON50              Merge to common code to test  
  1218 6726 0288  ON40   CI   R8,GOTOZ*256      "GOTO" ?  
       6728 8600  
  1219 672A 135F         JEQ  GOTO50            Yes, go handle it   
  1220 672C 0288         CI   R8,GOSUBZ*256     "GOSUB" ?   
       672E 8700  
  1221 6730 168E  ON50   JNE  ERRONE            No, so is an error  
  1222 6732 06A0         BL   @PGMCHR           Get next token  
       6734 6C74  
  1223 6736 1002         JMP  GOSUB2            Goto gosub code   
  1224 6738 108A  ERR1B  JMP  ERRONE            Issue error message   
  1225            * NUD routine for "GOSUB"   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0027
  1226 673A 04C3  GOSUB  CLR  R3                Dummy index for "ON" code   
  1227            * Common GOSUB code   
  1228      673C  GOSUB2 EQU  $                 Now build a FAC entry   
  1229 673C 0201         LI   R1,FAC            Optimize to save bytes  
       673E 834A  
  1230 6740 CC43         MOV  R3,*R1+           Save the "ON" index   
  1231            *                              in case of garbage collection
  1232 6742 DC60         MOVB @CBH66,*R1+       Indicate GOSUB entry on stack 
       6744 66F1  
  1233 6746 0581         INC  R1                Skip FAC3   
  1234 6748 C460         MOV  @PGMPTR,*R1       Save current ptr w/in line  
       674A 832C  
  1235 674C 05F1         INCT *R1+              Skip line # to correct place  
  1236 674E C460         MOV  @EXTRAM,*R1       Save current line # pointer   
       6750 832E  
  1237 6752 06A0         BL   @VPUSH            Save the stack entry  
       6754 6BAA  
  1238 6756 C0E0         MOV  @FAC,R3           Restore the "ON" index  
       6758 834A  
  1239 675A 1001         JMP  GOTO20            Jump to code to find the line 
  1240            * NUD routine for "GOTO"  
  1241 675C 04C3  GOTO   CLR  R3                Dummy index for "ON" code   
  1242            * Common (ON) GOTO/GOSUB THEN/ELSE code to fine line  
  1243            *   
  1244            * Get line number from program  
  1245 675E 0288  GOTO20 CI   R8,LNZ*256        Must have line number token   
       6760 C900  
  1246 6762 16EA         JNE  ERR1B             Don't, so error   
  1247 6764 06A0  GETL10 BL   @PGMCHR           Get MSB of the line number  
       6766 6C74  
  1248 6768 D008         MOVB R8,R0             Save it   
  1249 676A 06A0         BL   @PGMCHR           Read the character  
       676C 6C74  
  1250 676E 0603         DEC  R3                Decrement the "ON" index  
  1251 6770 1534         JGT  GOTO40            Loop if not there yet   
  1252            *   
  1253            * Find the program line   
  1254            *   
  1255 6772 C060         MOV  @STLN,R1          Get into line # table   
       6774 8330  
  1256 6776 D0A0         MOVB @RAMFLG,R2        Check ERAM flag to see where? 
       6778 8389  
  1257 677A 1310         JEQ  GOTO31            From VDP, go handle it  
  1258 677C C081         MOV  R1,R2             Copy address  
  1259 677E 8801  GOT32  C    R1,@ENLN          Finished w/line # table?  
       6780 8332  
  1260 6782 1422         JHE  GOTO34            Yes, so line doesn't exist  
  1261 6784 D0F2         MOVB *R2+,R3           2nd byte match?   
  1262 6786 0243         ANDI R3,>7FFF          Reset possible breakpoint   
       6788 7FFF  
  1263 678A 9003         CB   R3,R0             Compare 1st byte of #, Match? 
  1264 678C 1605         JNE  GOT35             Not a match, so move on   
  1265 678E 9232         CB   *R2+,R8           2nd byte match?   
  1266 6790 131E         JEQ  GOTO36            Yes, line is found!   
  1267 6792 05C2  GOT33  INCT R2                Skip line pointer   
  1268 6794 C042         MOV  R2,R1             Advance to next line in table 
  1269 6796 10F3         JMP  GOT32             Go back for more  
  1270 6798 D0F2  GOT35  MOVB *R2+,R3           Skip 2nd byte of line #   
  1271 679A 10FB         JMP  GOT33             And jump back in  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0028
  1272 679C D7E0  GOTO31 MOVB @R1LB,*R15        Get the data from the VDP   
       679E 83E3  
  1273 67A0 0202         LI   R2,XVDPRD         Load up to read data  
       67A2 8800  
  1274 67A4 D7C1         MOVB R1,*R15           Write out MSB of address  
  1275 67A6 8801  GOTO32 C    R1,@ENLN          Finished w/line # table   
       67A8 8332  
  1276 67AA 140E         JHE  GOTO34            Yes, so line doesn't exist  
  1277 67AC D0D2         MOVB *R2,R3            Save in temporary place for   
  1278            *                              breakpoint checking  
  1279 67AE 0243         ANDI R3,>7FFF          Reset possible breakpoint   
       67B0 7FFF  
  1280 67B2 9003         CB   R3,R0             Compare 1st byte of #, Match? 
  1281 67B4 1607         JNE  GOTO35            Not a match, so move on   
  1282 67B6 9212         CB   *R2,R8            2nd byte match?   
  1283 67B8 130A         JEQ  GOTO36            Yes, line is found!   
  1284 67BA D0D2  GOTO33 MOVB *R2,R3            Skip 1st byte of line pointer 
  1285 67BC 0221         AI   R1,4              Advance to next line in table 
       67BE 0004  
  1286 67C0 D0D2         MOVB *R2,R3            Skip 1nd byte of line pointer 
  1287 67C2 10F1         JMP  GOTO32            Go back for more  
  1288 67C4 D0D2  GOTO35 MOVB *R2,R3            Skip 2nd byte of line #   
  1289 67C6 10F9         JMP  GOTO33            And jump back in  
  1290 67C8 0200  GOTO34 LI   R0,ERRLNF         LINE NOT FOUND error vector   
       67CA 0303  
  1291 67CC 10A0         JMP  GOTO95            Jump for error exit   
  1292 67CE 05C1  GOTO36 INCT R1                Adjust to line pointer  
  1293 67D0 C801         MOV  R1,@EXTRAM        Save for execution of the line
       67D2 832E  
  1294 67D4 0649         DECT R9                Pop saved link to goto  
  1295 67D6 0460         B    @EXEC10           Reenter EXEC code directly  
       67D8 650E  
  1296 67DA 06A0  GOTO40 BL   @PGMCHR           Get next token  
       67DC 6C74  
  1297 67DE 06A0         BL   @EOSTMT           Premature end of statement?   
       67E0 6862  
  1298 67E2 1393         JEQ  GOTO90            Yes =>BAD VALUE for index   
  1299 67E4 0288         CI   R8,COMMAZ*256     Comma next ?  
       67E6 B300  
  1300 67E8 1603         JNE  ERR1C             No, error   
  1301 67EA 06A0  GOTO50 BL   @PGMCHR           Yes, get next character   
       67EC 6C74  
  1302 67EE 10B7         JMP  GOTO20            And check this index value  
  1303 67F0 10A3  ERR1C  JMP  ERR1B             Linking becuase long-distance 
  1304 67F2 0200  ERR51  LI   R0,>0903          RETURN WITHOUT GOSUB  
       67F4 0903  
  1305 67F6 108B         JMP  GOTO95            Exit to GPL   
  1306            * NUD entry for "RETURN"  
  1307 67F8 8820  RETURN C    @VSPTR,@STVSPT    Check bottom of stack   
       67FA 836E  
       67FC 8324  
  1308 67FE 12F9         JLE  ERR51             Error -> RETURN WITHOUT GOSUB 
  1309 6800 06A0         BL   @VPOP             Pop entry   
       6802 6C2A  
  1310 6804 9820         CB   @CBH66,@FAC2      Check ID for a GOSUB entry  
       6806 66F1  
       6808 834C  
  1311 680A 160B         JNE  RETU30            Check for ERROR ENTRY   
  1312            *   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0029
  1313            * Have a GOSUB entry  
  1314            *   
  1315 680C 06A0         BL   @EOSTMT           Must have EOS after return  
       680E 6862  
  1316 6810 16F3         JNE  RETURN            Not EOS, then error return?   
  1317 6812 C820         MOV  @FAC4,@PGMPTR     Get return ptr w/in line  
       6814 834E  
       6816 832C  
  1318 6818 C820         MOV  @FAC6,@EXTRAM     Get return line pointer   
       681A 8350  
       681C 832E  
  1319 681E 0460         B    @SKPS01           Go adjust it and get back   
       6820 6624  
  1320            * Check ERROR entry   
  1321 6822 9820  RETU30 CB   @CBH69,@FAC2      ERROR ENTRY?  
       6824 6A9B  
       6826 834C  
  1322 6828 1307         JEQ  RETU40            Yes, take care of error entry 
  1323 682A 9820         CB   @CBH6A,@FAC2      Subprogram entry?   
       682C 6860  
       682E 834C  
  1324 6830 16E3         JNE  RETURN            No, look some more  
  1325 6832 06A0         BL   @VPUSH            Push it back. Keep information
       6834 6BAA  
  1326 6836 10DD         JMP  ERR51             RETURN WITHOUT GOSUB error  
  1327            *   
  1328            * Have an ERROR entry   
  1329            * RETURN, RETURN line #, RETURN or RETURN NEXT follows.   
  1330            *   
  1331 6838 04C3  RETU40 CLR  R3                In case of a line number  
  1332 683A 0288         CI   R8,LNZ*256        Check for a line number   
       683C C900  
  1333 683E 1392         JEQ  GETL10            Yes, treat like GOTO  
  1334 6840 C820         MOV  @FAC4,@PGMPTR     Get return ptr w/in line  
       6842 834E  
       6844 832C  
  1335 6846 C820         MOV  @FAC6,@EXTRAM     Get return line pointer   
       6848 8350  
       684A 832E  
  1336 684C 06A0         BL   @EOSTMT           EOL now?  
       684E 6862  
  1337 6850 1305         JEQ  BEXC15            Yes, treat like GOSUB rtn.  
  1338 6852 0288         CI   R8,NEXTZ*256      NEXT now?   
       6854 9600  
  1339 6856 16CC         JNE  ERR1C             No, so its an error   
  1340 6858 0460         B    @SKPS01           Yes, so execute next statement
       685A 6624  
  1341 685C 0460  BEXC15 B    @EXEC15           Execute next line   
       685E 6542  
  1342 6860   6A  CBH6A  BYTE >6A               Subprogram call stack ID  
  1343                   EVEN   
  1344            ************************************************************
  1345            *         EOSTMT - Check for End-Of-STateMenT   
  1346            *         Returns with condition '=' if EOS   
  1347            *           else condition '<>' if not EOS  
  1348            ************************************************************
  1349 6862 D208  EOSTMT MOVB R8,R8             EOL or non-token?   
  1350 6864 1305         JEQ  EOSTM1            EOL-return condition '='  
  1351 6866 1504         JGT  EOSTM1            Non-token return condition '<>

 99/4 ASSEMBLER
PARSES                                                       PAGE 0030
  1352 6868 0288         CI   R8,TREMZ*256      In the EOS range (>81 to >83)?
       686A 8300  
  1353 686C 1B01         JH   EOSTM1            No, return condition '<>'   
  1354 686E 8208         C    R8,R8             Yes, force condition to '='   
  1355 6870 045B  EOSTM1 RT   
  1356            ************************************************************
  1357            *         EOLINE - Tests for End-Of-LINE; either a >00 or a 
  1358            *                  '!'  
  1359            *         Returns with condition '=' if EOL else condition  
  1360            *                  '<>' if not EOL  
  1361            ************************************************************
  1362 6872 D208  EOLINE MOVB R8,R8             EOL?  
  1363 6874 1302         JEQ  EOLNE1            Yes, return with '=' set  
  1364 6876 0288         CI   R8,TREMZ*256      Set condition on a tall remark
       6878 8300  
  1365 687A 045B  EOLNE1 RT                     And return  
  1366 687C 0200  SYMB20 LI   R0,UDF            Long distance   
       687E 0006  
  1367 6880 0460         B    @GOTO95   
       6882 670E  
  1368            * NUD for a symbol (variable)   
  1369 6884 06A0  PSYM   BL   @SYM              Get symbol table entry  
       6886 6312  
  1370 6888 06A0         BL   @GETV             Get 1st byte of entry   
       688A 187C  
  1371 688C 834A         DATA FAC               SYM left pointer in FAC   
  1372            *   
  1373 688E 0A11         SLA  R1,1              UDF reference?  
  1374 6890 11F5         JLT  SYMB20            Yes, special code for it  
  1375 6892 06A0         BL   @SMB              No, get value space pointer   
       6894 61DC  
  1376 6896 9820         CB   @FAC2,@CBH65      String reference?   
       6898 834C  
       689A 65A7  
  1377 689C 1302         JEQ  SYMB10            Yes, special code for it  
  1378 689E 06A0         BL   @MOVFAC           No, numeric ->copy into FAC   
       68A0 6434  
  1379 68A2 0460  SYMB10 B    @CONT             And continue the PARSE  
       68A4 64C8  
  1380            * Statement entry for IF statement  
  1381 68A6 06A0  IF     BL   @PARSE            Evaluate the expression   
       68A8 6480  
  1382 68AA   B3         BYTE COMMAZ            Stop on a comma   
  1383 68AB   67  CBH67  BYTE >67               Unused byte for a constant  
  1384 68AC 06A0         BL   @NUMCHK           Ensure the value is a number  
       68AE 6B92  
  1385 68B0 04C3         CLR  R3                Create a dummy "ON" index   
  1386 68B2 0288         CI   R8,THENZ*256      Have a "THEN" token   
       68B4 B000  
  1387 68B6 169C         JNE  ERR1C             No, error   
  1388 68B8 0520         NEG  @FAC              Test if condition true i.e. <>
       68BA 834A  
  1389 68BC 1610         JNE  IFZ10             True - branch to the special #
  1390 68BE 06A0         BL   @PGMCHR           Advance to line number token  
       68C0 6C74  
  1391 68C2 0288         CI   R8,LNZ*256        Have the line # token?  
       68C4 C900  
  1392 68C6 1619         JNE  IFZ20             No, must look harder for ELSE 
  1393 68C8 05E0         INCT @PGMPTR           Skip the line number  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0031
       68CA 832C  
  1394 68CC 06A0         BL   @PGMCHR           Get next token  
       68CE 6C74  
  1395 68D0 0288  IFZ5   CI   R8,ELSEZ*256      Test if token is ELSE   
       68D2 8100  
  1396 68D4 1304         JEQ  IFZ10             We do! So branch to the line #
  1397 68D6 0460         B    @EOL              We don't, so better be EOL  
       68D8 65D6  
  1398 68DA 0460  GETL1Z B    @GETL10           Get 1st token of clause   
       68DC 6764  
  1399 68DE 06A0  IFZ10  BL   @PGMCHR           Get 1st token of clause   
       68E0 6C74  
  1400 68E2 0288         CI   R8,LNZ*256        Line # token?   
       68E4 C900  
  1401 68E6 13F9         JEQ  GETL1Z            Yes, go there   
  1402 68E8 06A0         BL   @EOSTMT           EOS?  
       68EA 6862  
  1403 68EC 1381  JEQ1C  JEQ  ERR1C             Yes, its an error   
  1404 68EE 0208         LI   R8,SSEPZ*256      Cheat to do a continue  
       68F0 8200  
  1405 68F2 0620         DEC  @PGMPTR           Back up to get 1st character  
       68F4 832C  
  1406 68F6 0460         B    @CONT             Continue on   
       68F8 64C8  
  1407            *   
  1408            * LOOK FOR AN ELSE CLAUSE SINCE THE CONDITION WAS FALSE   
  1409            *   
  1410 68FA 0203  IFZ20  LI   R3,1              IF/ELSE pair counter  
       68FC 0001  
  1411 68FE 06A0         BL   @EOLINE           Trap out EOS following THEN/EL
       6900 6872  
  1412 6902 13F4         JEQ  JEQ1C             error   
  1413 6904 0288  IFZ25  CI   R8,ELSEZ*256      ELSE?   
       6906 8100  
  1414 6908 1603         JNE  IFZ27             If not  
  1415 690A 0603         DEC  R3                Matching ELSE?  
  1416 690C 13E8         JEQ  IFZ10             Yes, do it  
  1417 690E 100F         JMP  IFZ35             No, go on   
  1418 6910 0288  IFZ27  CI   R8,IFZ*256        Check for it  
       6912 8400  
  1419 6914 1602         JNE  IFZ28             Not an IF   
  1420 6916 0583         INC  R3                Increment nesting level   
  1421 6918 100A         JMP  IFZ35              And go on  
  1422 691A 0288  IFZ28  CI   R8,STRINZ*256     Lower than string?  
       691C C700  
  1423 691E 1A04         JL   IFZ30             Yes   
  1424 6920 0288         CI   R8,LNZ*256        Higher or = to a line #   
       6922 C900  
  1425 6924 1307         JEQ  IFZ40             = line #  
  1426 6926 1A09         JL   IFZ50             Skip strings and numerics   
  1427 6928 06A0  IFZ30  BL   @EOLINE           EOL?  
       692A 6872  
  1428 692C 13D1         JEQ  IFZ5              Yes, done scanning  
  1429 692E 06A0  IFZ35  BL   @PGMCHR           Get next character  
       6930 6C74  
  1430 6932 10E8         JMP  IFZ25               And go on   
  1431            *   
  1432            * SKIP LINE #'s   
  1433            *   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0032
  1434 6934 05E0  IFZ40  INCT @PGMPTR           Skip the line #   
       6936 832C  
  1435 6938 10FA         JMP  IFZ35             Go on   
  1436            *   
  1437            * SKIP STRINGS AND NUMERICS   
  1438            *   
  1439 693A 06A0  IFZ50  BL   @PGMCHR           Get # of bytes to skip  
       693C 6C74  
  1440 693E 06C8         SWPB R8                Swap for add  
  1441 6940 A808         A    R8,@PGMPTR        Skip it   
       6942 832C  
  1442 6944 04C8         CLR  R8                Clear LSB of R8   
  1443 6946 10F3         JMP  IFZ35   
  1444            ************************************************************
  1445                
  1447                
  1448            ************************************************************
  1449            *                   'LET' statement handler   
  1450            * Assignments are done bye putting an entry on the stack  
  1451            * for the destination variable and getting the source value 
  1452            * into the FAC. Multiple assignments are handled by the   
  1453            * stacking the variable entrys and then looping for the   
  1454            * assignments. Numeric assignments pose no problems,  
  1455            * strings are more complicated. String assignments are done 
  1456            * by assigning the source string to the last variable   
  1457            * specified in the list and changing the FAC entry so that  
  1458            * the string assigned to the next-to-the-last variable  
  1459            * comes from the permanent string belonging to the variable 
  1460            * just assigned.  
  1461            * e.g.    A$,B$,C$="HELLO"  
  1462            *   
  1463            *         C$-------"HELLO" (source string)  
  1464            *   
  1465            *         B$-------"HELLO" (copy from CZ's string)  
  1466            *   
  1467            *         A$-------"HELLO" (copy from BZ's string)  
  1468            ************************************************************
  1469 6948 04E0  NLET   CLR  @PAD              Counter for multiple assign's 
       694A 8300  
  1470 694C 06A0  NLET05 BL   @SYM              Get symbol table address  
       694E 6312  
  1471            *-----------------------------------------------------------
  1472            * The following code has been taken out for checking is   
  1473            * inserted in SMB             5/22/81   
  1474            *      BL   @GETV             Get first byte of entry   
  1475            *      DATA FAC               SYM left pointer in FAC   
  1476            *      SLA  R1,1              Test if a UDF   
  1477            *      JLT  ERRMUV            Is a UDF - so error   
  1478            *-----------------------------------------------------------
  1479 6950 06A0         BL   @SMB              Get value space pointer   
       6952 61DC  
  1480 6954 06A0         BL   @VPUSH            Push s.t. pointer on stack  
       6956 6BAA  
  1481 6958 05A0         INC  @PAD              Count the variable  
       695A 8300  
  1482 695C 0288         CI   R8,EQZ*256        Is the token an '='?  
       695E BE00  
  1483 6960 130B         JEQ  NLET10            Yes, go into assignment loop  
  1484 6962 0288         CI   R8,COMMAZ*256     Must have a comma now   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0033
       6964 B300  
  1485 6966 161E         JNE  ERR1CZ            Didn't - so error   
  1486 6968 06A0         BL   @PGMCHR           Get next token  
       696A 6C74  
  1487 696C 15EF         JGT  NLET05            If legal symbol character   
  1488 696E 101A         JMP  ERR1CZ            If not - error  
  1489 6970 0200  ERRMUV LI   R0,>0D03          MULTIPLY USED VARIABLE  
       6972 0D03  
  1490 6974 0460         B    @ERR  
       6976 6652  
  1491 6978 06A0  NLET10 BL   @PGMCHR           Get next token  
       697A 6C74  
  1492 697C 06A0         BL   @PARSE            PARSE the value to assign   
       697E 6480  
  1493 6980   83         BYTE TREMZ             Parse to the end of statement 
  1494 6981   65  STCOD2 BYTE >65               Wasted byte (STCODE copy)   
  1495            * Loop for assignments  
  1496 6982 06A0  NLET15 BL   @ASSG             Assign the value to the symbol
       6984 6334  
  1497 6986 0620         DEC  @PAD              One less to assign, done?   
       6988 8300  
  1498 698A 130A         JEQ  LETCON            Yes, branch out   
  1499 698C 9820         CB   @FAC2,@STCOD2     String or numeric?  
       698E 834C  
       6990 6981  
  1500 6992 16F7         JNE  NLET15            Numeric, just loop for more   
  1501 6994 C806         MOV  R6,@FAC4          Get pointer to new string   
       6996 834E  
  1502 6998 C820         MOV  @ARG,@FAC         Get pointer to last s.t. entry
       699A 835C  
       699C 834A  
  1503 699E 10F1         JMP  NLET15            Now loop to assign more   
  1504 69A0 0460  LETCON B    @EOL              Yes, continue the PARSE   
       69A2 65D6  
  1505 69A4 0460  ERR1CZ B    @ERR1C            For long distance jump  
       69A6 67F0  
  1506 69A8 664E         DATA NONUD             (SPARE)             >80   
  1507 69AA 664E         DATA NONUD             ELSE                >81   
  1508 69AC 65C4         DATA SMTSEP            ::                  >82   
  1509 69AE 65E6         DATA NUDND1            !                   >83   
  1510 69B0 68A6         DATA IF                IF                  >84   
  1511 69B2 66D6         DATA GO                GO                  >85   
  1512 69B4 675C         DATA GOTO              GOTO                >86   
  1513 69B6 673A         DATA GOSUB             GOSUB               >87   
  1514 69B8 67F8         DATA RETURN            RETURN              >88   
  1515 69BA 65F0         DATA NUDEND            DEF                 >89   
  1516 69BC 65F0         DATA NUDEND            DIM                 >8A   
  1517 69BE 665E         DATA END               END                 >8B   
  1518 69C0 7000         DATA NFOR              FOR                 >8C   
  1519 69C2 6948         DATA NLET              LET                 >8D   
  1520 69C4 8002         DATA >8002             BREAK               >8E   
  1521 69C6 8004         DATA >8004             UNBREAK             >8F   
  1522 69C8 8006         DATA >8006             TRACE               >90   
  1523 69CA 8008         DATA >8008             UNTRACE             >91   
  1524 69CC 8016         DATA >8016             INPUT               >92   
  1525 69CE 65E6         DATA NUDND1            DATA                >93   
  1526 69D0 8012         DATA >8012             RESTORE             >94   
  1527 69D2 8014         DATA >8014             RANDOMIZE           >95   
  1528 69D4 7230         DATA NNEXT             NEXT                >96   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0034
  1529 69D6 800A         DATA >800A             READ                >97   
  1530 69D8 665E         DATA STOP              STOP                >98   
  1531 69DA 8032         DATA >8032             DELETE              >99   
  1532 69DC 65E6         DATA NUDND1            REM                 >9A   
  1533 69DE 66DA         DATA ON                ON                  >9B   
  1534 69E0 800C         DATA >800C             PRINT               >9C   
  1535 69E2 750A         DATA CALL              CALL                >9D   
  1536 69E4 65F0         DATA NUDEND            OPTION              >9E   
  1537 69E6 8018         DATA >8018             OPEN                >9F   
  1538 69E8 801A         DATA >801A             CLOSE               >A0   
  1539 69EA 665E         DATA STOP              SUB                 >A1   
  1540 69EC 8034         DATA >8034             DISPLAY             >A2   
  1541 69EE 65E6         DATA NUDND1            IMAGE               >A3   
  1542 69F0 8024         DATA >8024             ACCEPT              >A4   
  1543 69F2 664E         DATA NONUD             ERROR               >A5   
  1544 69F4 664E         DATA NONUD             WARNING             >A6   
  1545 69F6 78D2         DATA SUBXIT            SUBEXIT             >A7   
  1546 69F8 78D2         DATA SUBXIT            SUBEND              >A8   
  1547 69FA 800E         DATA >800E             RUN                 >A9   
  1548 69FC 8010  STMTTB DATA >8010             LINPUT              >AA   
  1549 69FE 6E68  NTAB   DATA NLPR              LEFT PARENTHISIS    >B7   
  1550 6A00 664E         DATA NONUD             CONCATENATE         >B8   
  1551 6A02 664E         DATA NONUD             SPARE               >B9   
  1552 6A04 664E         DATA NONUD             AND                 >BA   
  1553 6A06 664E         DATA NONUD             OR                  >BB   
  1554 6A08 664E         DATA NONUD             XOR                 >BC   
  1555 6A0A 6E2E         DATA O0NOT             NOT                 >BD   
  1556 6A0C 664E         DATA NONUD             =                   >BE   
  1557 6A0E 664E         DATA NONUD             <                   >BF   
  1558 6A10 664E         DATA NONUD             >                   >C0   
  1559 6A12 6E96         DATA NPLUS             +                   >C1   
  1560 6A14 6E82         DATA NMINUS            -                   >C2   
  1561 6A16 664E         DATA NONUD             *                   >C3   
  1562 6A18 664E         DATA NONUD             /                   >C4   
  1563 6A1A 664E         DATA NONUD             ^                   >C5   
  1564 6A1C 664E         DATA NONUD             INTEGER             >C6   
  1565 6A1E 7442         DATA NSTRCN            QUOTED STRING       >C7   
  1566 6A20 6684         DATA NUMCON        UNQUOTED STRING/NUMERIC >C8   
  1567 6A22 664E         DATA NONUD             LINE NUMBER         >C9   
  1568 6A24 8026         DATA >8026             EOF                 >CA   
  1569 6A26 6CFA         DATA NABS              ABS                 >CB   
  1570 6A28 6D16         DATA NATN              ATN                 >CC   
  1571 6A2A 6D1C         DATA NCOS              COS                 >CD   
  1572 6A2C 6D22         DATA NEXP              EXP                 >CE   
  1573 6A2E 6D28         DATA NINT              INT                 >CF   
  1574 6A30 6D2E         DATA NLOG              LOG                 >D0   
  1575 6A32 6D34         DATA NSGN              SGN                 >D1   
  1576 6A34 6D64         DATA NSIN              SIN                 >D2   
  1577 6A36 6D6A         DATA NSQR              SQR                 >D3   
  1578 6A38 6D70         DATA NTAN              TAN                 >D4   
  1579 6A3A 8036         DATA >8036             LEN                 >D5   
  1580 6A3C 8038         DATA >8038             CHRZ                >D6   
  1581 6A3E 803A         DATA >803A             RND                 >D7   
  1582 6A40 8030         DATA >8030             SEGZ                >D8   
  1583 6A42 802A         DATA >802A             POS                 >D9   
  1584 6A44 802C         DATA >802C             VAL                 >DA   
  1585 6A46 802E         DATA >802E             STR                 >DB   
  1586 6A48 8028         DATA >8028             ASC                 >DC   
  1587 6A4A 801C         DATA >801C             PI                  >DD   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0035
  1588 6A4C 8000         DATA >8000             REC                 >DE   
  1589 6A4E 801E         DATA >801E             MAX                 >DF   
  1590 6A50 8020         DATA >8020             MIN                 >E0   
  1591 6A52 8022         DATA >8022             RPTZ                >E1   
  1592      0056  NTABLN EQU  $-NTAB  
  1593 6A54 667E  LTAB   DATA CONC              &                   >B8   
  1594 6A56 664E         DATA NOLED             SPARE               >B9   
  1595 6A58 6E1C         DATA O0OR              OR                  >BA   
  1596 6A5A 6DFA         DATA O0AND             AND                 >BB   
  1597 6A5C 6E50         DATA O0XOR             XOR                 >BC   
  1598 6A5E 664E         DATA NOLED             NOT                 >BD   
  1599 6A60 6A8E         DATA EQUALS            =                   >BE   
  1600 6A62 6A70         DATA LESS              <                   >BF   
  1601 6A64 6A7E         DATA GREATR            >                   >C0   
  1602 6A66 6B1E         DATA PLUS              +                   >C1   
  1603 6A68 6B4A         DATA MINUS             -                   >C2   
  1604 6A6A 6B56         DATA TIMES             *                   >C3   
  1605 6A6C 6B62         DATA DIVIDE            /                   >C4   
  1606 6A6E 6CE2         DATA LEXP              ^                   >C5   
  1607      001C  LTBLEN EQU  $-LTAB  
  1608            ************************************************************
  1609            *                     Relational operators  
  1610            * Logical conparisons encode the type of comparison and use 
  1611            * common code to PARSE the expression and set the status  
  1612            * bits.   
  1613            *   
  1614            * The types of legal comparisons are:   
  1615            *                             0 EQUAL   
  1616            *                             1 NOT EQUAL   
  1617            *                             2 LESS THAN   
  1618            *                             3 LESS OR EQUAL   
  1619            *                             4 GREATER THAN  
  1620            *                             5 GREATER THAN OR EQUAL   
  1621            *   
  1622            * This code is saved on the subroutine stack  
  1623            ************************************************************
  1624 6A70 0202  LESS   LI   R2,2              LESS-THAN code for common rtn 
       6A72 0002  
  1625 6A74 0288         CI   R8,GTZ*256        Test for '>' token  
       6A76 C000  
  1626 6A78 1604         JNE  LT10              Jump if not   
  1627 6A7A 0642         DECT R2                Therefore, NOT-EQUAL code   
  1628 6A7C 1005         JMP  LT15              Jump to common  
  1629      6A80  C4     EQU  $+2               Constant 4  
  1630 6A7E 0202  GREATR LI   R2,4              GREATER-THEN code for common  
       6A80 0004  
  1631 6A82 0288  LT10   CI   R8,EQZ*256        Test for '=' token  
       6A84 BE00  
  1632 6A86 1605         JNE  LTST01            Jump if '>='  
  1633 6A88 06A0  LT15   BL   @PGMCHR           Must be plain old '>' or '<'  
       6A8A 6C74  
  1634 6A8C 1001         JMP  LEDLE             Jump to test  
  1635 6A8E 0702  EQUALS SETO R2                Equal bit for common routine  
  1636 6A90 0582  LEDLE  INC  R2                Sets to zero  
  1637 6A92 05C9  LTST01 INCT R9                Get room on stack for code  
  1638 6A94 C642         MOV  R2,*R9            Save status matching code   
  1639 6A96 06A0         BL   @PSHPRS           Push 1st arg and PARSE the 2nd
       6A98 6B9C  
  1640 6A9A   C0         BYTE GTZ               Parse to a '>'  

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0036
  1641 6A9B   69  CBH69  BYTE >69               Used in RETURN routine  
  1642 6A9C C119         MOV  *R9,R4            Get the type code from stack  
  1643 6A9E 0649         DECT R9                Reset subroutine stack pointer
  1644 6AA0 D324         MOVB @LTSTAB(R4),R12   Get address bias to baranch to
       6AA2 6ADA  
  1645 6AA4 088C         SRA  R12,8             Right justify   
  1646 6AA6 06A0         BL   @ARGTST           Test for matching arguments   
       6AA8 6B6E  
  1647 6AAA 131A         JEQ  LTST20            Handle strings specially  
  1648 6AAC 06A0         BL   @SCOMPB           Floating point comparison   
       6AAE 0D42  
  1649 6AB0 046C  LTST15 B    @LTSTXX(R12)      Interpret the status by code  
       6AB2 6AB4  
  1650      6AB4  LTSTXX EQU  $   
  1651 6AB4 1504  LTSTGE JGT  LTRUE             Test if GREATER or EQUAL  
  1652 6AB6 1303  LTSTEQ JEQ  LTRUE             Test if EQUAL   
  1653 6AB8 04C4  LFALSE CLR  R4                FALSE is a ZERO   
  1654 6ABA 1003         JMP  LTST90            Put it into FAC   
  1655 6ABC 13FD  LTSTNE JEQ  LFALSE            Test if NOT-EQUAL   
  1656 6ABE 0204  LTRUE  LI   R4,>BFFF          TRUE is a minus-one   
       6AC0 BFFF  
  1657 6AC2 0203  LTST90 LI   R3,FAC            Store result in FAC   
       6AC4 834A  
  1658 6AC6 CCC4         MOV  R4,*R3+           Exp & 1st byte of manitissa   
  1659 6AC8 04F3         CLR  *R3+              ZERO the remaining digits   
  1660 6ACA 04F3         CLR  *R3+              ZERO the remaining digits   
  1661 6ACC 04F3         CLR  *R3+              ZERO the remaining digits   
  1662 6ACE 1039         JMP  LEDEND            Jump to end of LED routine  
  1663 6AD0 13F6  LTSTLE JEQ  LTRUE             Test LESS-THAN or EQUAL   
  1664 6AD2 11F5  LTSTLT JLT  LTRUE             Test LESS-THEN  
  1665 6AD4 10F1         JMP  LFALSE            Jump to false   
  1666 6AD6 15F3  LTSTGT JGT  LTRUE             Test GREATER-THAN   
  1667 6AD8 10EF         JMP  LFALSE            Jump to false   
  1668            * Data table for offsets for types  
  1669 6ADA   02  LTSTAB BYTE LTSTEQ-LTSTXX     EQUAL               (0)   
  1670 6ADB   08         BYTE LTSTNE-LTSTXX     NOT EQUAL           (1)   
  1671 6ADC   1E         BYTE LTSTLT-LTSTXX     LESS THEN           (2)   
  1672 6ADD   1C         BYTE LTSTLE-LTSTXX     LESS or EQUAL       (3)   
  1673 6ADE   22         BYTE LTSTGT-LTSTXX     GREATER THEN        (4)   
  1674 6ADF   00         BYTE LTSTGE-LTSTXX     GREATER or EQUAL    (5)   
  1675 6AE0 C2A0  LTST20 MOV  @FAC4,R10         Pointer to string1  
       6AE2 834E  
  1676 6AE4 D1E0         MOVB @FAC7,R7          R7 = string2 length   
       6AE6 8351  
  1677 6AE8 06A0         BL   @VPOP             Get LH arg back   
       6AEA 6C2A  
  1678 6AEC C120         MOV  @FAC4,R4          Pointer to string2  
       6AEE 834E  
  1679 6AF0 D1A0         MOVB @FAC7,R6          R6 = string2 length   
       6AF2 8351  
  1680 6AF4 D146         MOVB R6,R5             R5 will contain shorter length
  1681 6AF6 91C6         CB   R6,R7             Compare the 2 lengths   
  1682 6AF8 1101         JLT  CSTR05            Jump if length2 < length1   
  1683 6AFA D147         MOVB R7,R5             Swap if length1 > length2   
  1684 6AFC 0985  CSTR05 SRL  R5,8              Shift for speed and test zero 
  1685 6AFE 130D         JEQ  CSTR20            If ZERO-set status with length
  1686 6B00 C0CA  CSTR10 MOV  R10,R3            Current character location  
  1687 6B02 058A         INC  R10               Increment pointer   
  1688 6B04 06A0         BL   @GETV1            Get from VDP  

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0037
       6B06 1880  
  1689 6B08 D001         MOVB R1,R0             And save for comparison   
  1690 6B0A C0C4         MOV  R4,R3             Current char location in ARG  
  1691 6B0C 0584         INC  R4                Increment pointer   
  1692 6B0E 06A0         BL   @GETV1            Get from VDP  
       6B10 1880  
  1693 6B12 9001         CB   R1,R0             Compare the characters  
  1694 6B14 16CD         JNE  LTST15            Return with status if <>  
  1695 6B16 0605         DEC  R5                Otherwise, decrement counter  
  1696 6B18 15F3         JGT  CSTR10            And loop for each character   
  1697 6B1A 91C6  CSTR20 CB   R6,R7             Status set by length compare  
  1698 6B1C 10C9         JMP  LTST15            Return to do test of status   
  1699            * ARITHMETIC FUNCTIONS  
  1700 6B1E 06A0  PLUS   BL   @PSHPRS           Push left arg and PARSE right 
       6B20 6B9C  
  1701 6B22   C2         BYTE MINUSZ,0          Stop on a minus!!!!!!!!!!!!!!!
       6B23   00  
  1702 6B24 0202         LI   R2,SADD           Address of add routine  
       6B26 0D84  
  1703 6B28 04E0  LEDEX  CLR  @FAC10            Clear error code  
       6B2A 8354  
  1704 6B2C 06A0         BL   @ARGTST           Make sure both numerics   
       6B2E 6B6E  
  1705 6B30 132E         JEQ  ARGT05            If strings, error   
  1706 6B32 06A0         BL   @SAVREG           Save registers  
       6B34 1E8C  
  1707 6B36 0692         BL   *R2               Do the operation  
  1708 6B38 06A0         BL   @SETREG           Restore registers   
       6B3A 1E7A  
  1709 6B3C D0A0         MOVB @FAC10,R2         Test for overflow   
       6B3E 8354  
  1710 6B40 1602         JNE  LEDERR            If overflow ->error   
  1711 6B42 0460  LEDEND B    @CONT             Continue the PARSE  
       6B44 64C8  
  1712 6B46 0460  LEDERR B    @WARNZZ           Overflow - issue warning  
       6B48 6662  
  1713 6B4A 06A0  MINUS  BL   @PSHPRS           Push left arg and PARSE right 
       6B4C 6B9C  
  1714 6B4E   C2         BYTE MINUSZ,0          Parse to a minus  
       6B4F   00  
  1715 6B50 0202         LI   R2,SSUB           Address of subtract routine   
       6B52 0D74  
  1716 6B54 10E9         JMP  LEDEX             Common code for the operation 
  1717 6B56 06A0  TIMES  BL   @PSHPRS           Push left arg and PARSE right 
       6B58 6B9C  
  1718 6B5A   C4         BYTE DIVIZ,0           Parse to a divide!!!!!!!!!!!!!
       6B5B   00  
  1719 6B5C 0202         LI   R2,SMULT          Address of multiply routine   
       6B5E 0E8C  
  1720 6B60 10E3         JMP  LEDEX             Common code for the operation 
  1721 6B62 06A0  DIVIDE BL   @PSHPRS           Push left arg and PARSE right 
       6B64 6B9C  
  1722 6B66   C4         BYTE DIVIZ,0           Parse to a divide   
       6B67   00  
  1723 6B68 0202         LI   R2,SDIV           Address of divide routine   
       6B6A 0FF8  
  1724 6B6C 10DD         JMP  LEDEX             Common code for the operation 
  1725            ************************************************************
  1726            * Test arguments on both the stack and in the FAC   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0038
  1727            *      Both must be of the same type  
  1728            *  CALL:  
  1729            *      BL   @ARGTST   
  1730            *      JEQ                    If string   
  1731            *      JNE                    If numeric  
  1732            ************************************************************
  1733 6B6E C1A0  ARGTST MOV  @VSPTR,R6         Get stack pointer   
       6B70 836E  
  1734 6B72 05C6         INCT R6  
  1735 6B74 D7E0         MOVB @R6LB,*R15        Load 2nd byte of stack address
       6B76 83ED  
  1736 6B78 1000         NOP                    Kill some time  
  1737 6B7A D7C6         MOVB R6,*R15           Load 1st byte of stack address
  1738 6B7C 1000         NOP                    Kill some time  
  1739 6B7E 9820         CB   @XVDPRD,@CBH65    String in operand 1?  
       6B80 8800  
       6B82 65A7  
  1740 6B84 1606         JNE  ARGT10            No, numeric   
  1741 6B86 9820         CB   @FAC2,@CBH65      Yes, is other the same?   
       6B88 834C  
       6B8A 65A7  
  1742 6B8C 1306         JEQ  ARGT20            Yes, do string comparison   
  1743 6B8E 0460  ARGT05 B    @ERRT             Data types don't match  
       6B90 630C  
  1744            NUMCHK  
  1745 6B92 9820  ARGT10 CB   @FAC2,@CBH65      2nd operand can't be string   
       6B94 834C  
       6B96 65A7  
  1746 6B98 13FA         JEQ  ARGT05            If so, error  
  1747 6B9A 045B  ARGT20 RT                     Ok, so return with status   
  1748            * VPUSH followed by a PARSE   
  1749 6B9C 05C9  PSHPRS INCT R9                Get room on stack   
  1750 6B9E 0289         CI   R9,STKEND         Stack full?   
       6BA0 83BA  
  1751 6BA2 1B41         JH   VPSH27            Yes, error  
  1752 6BA4 C64B         MOV  R11,*R9           Save return on stack  
  1753 6BA6 020B         LI   R11,P05           Optimize for the parse  
       6BA8 648A  
  1754            * Stack VPUSH routine   
  1755 6BAA 0200  VPUSH  LI   R0,8              Pushing 8 byte entries  
       6BAC 0008  
  1756 6BAE A800         A    R0,@VSPTR         Update the pointer  
       6BB0 836E  
  1757 6BB2 C060         MOV  @VSPTR,R1         Now get the new pointer   
       6BB4 836E  
  1758 6BB6 D7E0         MOVB @R1LB,*R15        Write new address to VDP chip 
       6BB8 83E3  
  1759 6BBA 0261         ORI  R1,WRVDP          Enable the write  
       6BBC 4000  
  1760 6BBE D7C1         MOVB R1,*R15           Write 1st byte of address   
  1761 6BC0 0201         LI   R1,FAC            Source is FAC   
       6BC2 834A  
  1762 6BC4 D831  VPSH15 MOVB *R1+,@XVDPWD      Move a byte   
       6BC6 8C00  
  1763 6BC8 0600         DEC  R0                Decrement the count, done?  
  1764 6BCA 15FC         JGT  VPSH15            No, more to move  
  1765 6BCC C00B         MOV  R11,R0            Save the return address   
  1766 6BCE 9820         CB   @FAC2,@CBH65      Pushing a string entry?   
       6BD0 834C  

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0039
       6BD2 65A7  
  1767 6BD4 160E         JNE  VPSH20            No, so done   
  1768 6BD6 C1A0         MOV  @VSPTR,R6         Entry on stack  
       6BD8 836E  
  1769 6BDA 0226         AI   R6,4              Pointer to the string is here 
       6BDC 0004  
  1770 6BDE C060         MOV  @FAC,R1           Get the string's owner  
       6BE0 834A  
  1771 6BE2 0281         CI   R1,>001C          Is it a tempory string?   
       6BE4 001C  
  1772 6BE6 1605         JNE  VPSH20            No, so done   
  1773 6BE8 C060  VPSH19 MOV  @FAC4,R1          Get the address of the string 
       6BEA 834E  
  1774 6BEC 1302         JEQ  VPSH20            If null string, nothing to do 
  1775 6BEE 06A0         BL   @STVDP3           Set the backpointer   
       6BF0 18AA  
  1776 6BF2 C060  VPSH20 MOV  @VSPTR,R1         Check for buffer-zone   
       6BF4 836E  
  1777      6BF8  C16    EQU  $+2   
  1778 6BF6 0221         AI   R1,16             Correct by 16   
       6BF8 0010  
  1779 6BFA 8801         C    R1,@STREND        At least 16 bytes between stac
       6BFC 831A  
  1780            *                              and string space?  
  1781 6BFE 1236         JLE  VPOP18            Yes, so ok  
  1782 6C00 05C9         INCT R9                No, save return address   
  1783 6C02 C640         MOV  R0,*R9             on stack   
  1784 6C04 06A0         BL   @COMPCT           Do the garbage collection   
       6C06 73D8  
  1785 6C08 C019         MOV  *R9,R0            Restore return address  
  1786 6C0A 0649         DECT R9                Fix subroutine stack pointer  
  1787 6C0C C060         MOV  @VSPTR,R1         Get value stack pointer   
       6C0E 836E  
  1788 6C10 0221         AI   R1,16             Buffer zone   
       6C12 0010  
  1789 6C14 8801         C    R1,@STREND        At least 16 bytes now?  
       6C16 831A  
  1790 6C18 1229         JLE  VPOP18            Yes, so ok  
  1791 6C1A 0200  VPSH23 LI   R0,ERROM          No, so MEMORY FULL error  
       6C1C 0103  
  1792 6C1E 06A0  VPSH25 BL   @SETREG           In case of GPL call   
       6C20 1E7A  
  1793 6C22 0460         B    @ERR  
       6C24 6652  
  1794 6C26 0460  VPSH27 B    @ERRSO            STACK OVERFLOW  
       6C28 6468  
  1795            * Stack VPOP routine  
  1796 6C2A 0202  VPOP   LI   R2,FAC            Destination in FAC  
       6C2C 834A  
  1797 6C2E C060         MOV  @VSPTR,R1         Get stack pointer   
       6C30 836E  
  1798 6C32 8801         C    R1,@STVSPT        Check for stack underflow   
       6C34 8324  
  1799 6C36 121B         JLE  VPOP20            Yes, error  
  1800 6C38 D7E0         MOVB @R1LB,*R15        Write 2nd byte of address   
       6C3A 83E3  
  1801 6C3C 0200         LI   R0,8              Popping 8 bytes   
       6C3E 0008  
  1802 6C40 D7C1         MOVB R1,*R15           Write 1st byte of address   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0040
  1803 6C42 6800         S    R0,@VSPTR         Adjust stack pointer  
       6C44 836E  
  1804 6C46 DCA0  VPOP10 MOVB @XVDPRD,*R2+      Move a byte   
       6C48 8800  
  1805 6C4A 0600         DEC  R0                Decrement the counter, done?  
  1806 6C4C 15FC         JGT  VPOP10            No, finish the work   
  1807 6C4E C00B         MOV  R11,R0            Save return address   
  1808 6C50 9820         CB   @FAC2,@CBH65      Pop a string?   
       6C52 834C  
       6C54 65A7  
  1809 6C56 160A         JNE  VPOP18            No, so done   
  1810 6C58 04C6         CLR  R6                For backpointer clear   
  1811 6C5A C0E0         MOV  @FAC,R3           Get string owner  
       6C5C 834A  
  1812 6C5E 0283         CI   R3,>001C          Pop a temporary?  
       6C60 001C  
  1813 6C62 13C2         JEQ  VPSH19            Yes, must free it   
  1814 6C64 06A0         BL   @GET1             No, get new pointer from s.t. 
       6C66 6C9E  
  1815 6C68 C801         MOV  R1,@FAC4          Set new pointer to string   
       6C6A 834E  
  1816 6C6C 0450  VPOP18 B    *R0               And return  
  1817 6C6E 0200  VPOP20 LI   R0,ERREX          * SYNTAX ERROR  
       6C70 0403  
  1818 6C72 10D5         JMP  VPSH25  
  1819            * The returned status reflects the character  
  1820            * RAMFLG = >00   | No ERAM or imperative statements   
  1821            *          >FF   | With ERAM and a program is being run   
  1822 6C74 D220  PGMCHR MOVB @RAMFLG,R8        Test ERAM flag  
       6C76 8389  
  1823 6C78 160A         JNE  PGMC10            ERAM and a program is being ru
  1824            * Next label is for entry from SUBPROG.   
  1825 6C7A D7E0  PGMSUB MOVB @PGMPT1,*R15      Write 2nd byte of address   
       6C7C 832D  
  1826 6C7E 020A         LI   R10,XVDPRD        Read data address   
       6C80 8800  
  1827 6C82 D7E0         MOVB @PGMPTR,*R15      Write 1st byte of address   
       6C84 832C  
  1828 6C86 05A0         INC  @PGMPTR           Increment the perm pointer  
       6C88 832C  
  1829 6C8A D21A         MOVB *R10,R8           Read the character  
  1830 6C8C 045B         RT                     And return  
  1831 6C8E C2A0  PGMC10 MOV  @PGMPTR,R10   
       6C90 832C  
  1832 6C92 05A0         INC  @PGMPTR   
       6C94 832C  
  1833 6C96 D23A         MOVB *R10+,R8          Write 2nd byte of a address   
  1834 6C98 045B         RT   
  1835            ************************************************************
  1836 6C9A              AORG >6C9A   
  1838                
  1839            * (VDP to VDP) or (RAM to RAM)  
  1840            * GET,GET1          : Get two bytes of data from VDP  
  1841            *                   : R3 : address in VDP   
  1842            *                   : R1 : where the one byte data stored   
  1843            * PUT1              : Put two bytes of data into VDP  
  1844            *                   : R4 : address on VDP   
  1845            *                   : R1 : data   
  1846            * GETG,GETG2        : Get two bytes of data from ERAM   

 99/4 ASSEMBLER
GETPUTS                                                      PAGE 0041
  1847            *                   : R3 : address on ERAM  
  1848            *                   : R1 : where the two byte data stored   
  1849            * PUTG2             : Put two bytes of data into ERAM   
  1850            *                   : R4 : address on ERAM  
  1851            *                   : R1 : data   
  1852            * PUTVG1            : Put one byte of data into ERAM  
  1853            *                   : R4 : address in ERAM  
  1854            *                   : R1 : data   
  1855                
  1856            * Get two bytes from RAM(R3) into R1  
  1857 6C9A C0FB  GET    MOV  *R11+,R3  
  1858 6C9C C0D3         MOV  *R3,R3  
  1859 6C9E D7E0  GET1   MOVB @R3LB,*R15  
       6CA0 83E7  
  1860 6CA2 D7C3         MOVB R3,*R15   
  1861 6CA4 1000         NOP  
  1862 6CA6 D060         MOVB @XVDPRD,R1  
       6CA8 8800  
  1863 6CAA D820         MOVB @XVDPRD,@R1LB   
       6CAC 8800  
       6CAE 83E3  
  1864 6CB0 045B         RT   
  1865            * Put two bytes from R1 to RAM(R4)  
  1866 6CB2 D7E0  PUT1   MOVB @R4LB,*R15  
       6CB4 83E9  
  1867 6CB6 0264         ORI  R4,WRVDP  
       6CB8 4000  
  1868 6CBA D7C4         MOVB R4,*R15   
  1869 6CBC 1000         NOP  
  1870 6CBE D801         MOVB R1,@XVDPWD  
       6CC0 8C00  
  1871 6CC2 D820         MOVB @R1LB,@XVDPWD   
       6CC4 83E3  
       6CC6 8C00  
  1872 6CC8 045B         RT   
  1873            * Get two bytes from ERAM(R3) to R1   
  1874 6CCA C0FB  GETG   MOV  *R11+,R3  
  1875 6CCC C0D3         MOV  *R3,R3  
  1876      6CCE  GETG2  EQU  $   
  1877 6CCE D073         MOVB *R3+,R1   
  1878 6CD0 D813         MOVB *R3,@R1LB   
       6CD2 83E3  
  1879 6CD4 0603         DEC  R3  
  1880 6CD6 045B         RT   
  1881            * Put two bytes from R1 to ERAM(R4)   
  1882      6CD8  PUTG2  EQU  $   
  1883 6CD8 DD01         MOVB R1,*R4+   
  1884 6CDA D520         MOVB @R1LB,*R4   
       6CDC 83E3  
  1885 6CDE 0604         DEC  R4                Preserve R4   
  1886 6CE0 045B         RT   
  1887            ************************************************************
  1888                
  1889 6CE2              AORG >6CE2   
  1891                
  1892 6CE2 9820  LEXP   CB   @FAC2,@CBH63      Must have a numeric   
       6CE4 834C  
       6CE6 6D05  
  1893 6CE8 1B39         JH   ERRSNM            Don't, so error   

 99/4 ASSEMBLER
NUD359                                                       PAGE 0042
  1894 6CEA 06A0         BL   @PSHPRS           Push 1st and parse 2nd  
       6CEC 6B9C  
  1895 6CEE   C5         BYTE EXPONZ,0          Up to another wxpon or less   
       6CEF   00  
  1896 6CF0 06A0         BL   @STKCHK           Make sure room on stack   
       6CF2 6DC0  
  1897 6CF4 0202         LI   R2,PWRZZ          Address of power routine  
       6CF6 7492  
  1898 6CF8 1049         JMP  COMM05            Jump into common routine  
  1899            * ABS   
  1900 6CFA 0288  NABS   CI   R8,LPARZ*256      Must have a left parenthesis  
       6CFC B700  
  1901 6CFE 1630         JNE  SYNERR            If not, error   
  1902 6D00 06A0         BL   @PARSE            Parse the argument  
       6D02 6480  
  1903 6D04   CB         BYTE ABSZ              Up to another ABS   
  1904 6D05   63  CBH63  BYTE >63               Use the wasted byte   
  1905 6D06 9820         CB   @FAC2,@CBH63      Must have numeric arg   
       6D08 834C  
       6D0A 6D05  
  1906 6D0C 1B27         JH   ERRSNM            If not, error   
  1907 6D0E 0760         ABS  @FAC              Take the absolute value   
       6D10 834A  
  1908 6D12 0460  BCONT  B    @CONT             And continue  
       6D14 64C8  
  1909            * ATN   
  1910 6D16 0202  NATN   LI   R2,ATNZZ          Load up arctan address  
       6D18 797C  
  1911 6D1A 102C         JMP  COMMON            Jump into common rountine   
  1912            * COS   
  1913 6D1C 0202  NCOS   LI   R2,COSZZ          Load up cosine address  
       6D1E 78B2  
  1914 6D20 1029         JMP  COMMON            Jump into common routine  
  1915            * EXP   
  1916 6D22 0202  NEXP   LI   R2,EXPZZ          Load up exponential address   
       6D24 75CA  
  1917 6D26 1026         JMP  COMMON            Jump into common routine  
  1918            * INT   
  1919 6D28 0202  NINT   LI   R2,GRINT          Load up greatest integer addre
       6D2A 79EC  
  1920 6D2C 1023         JMP  COMMON            Jump into common routine  
  1921            * LOG   
  1922 6D2E 0202  NLOG   LI   R2,LOGZZ          Load up logarithm code  
       6D30 76C2  
  1923 6D32 1020         JMP  COMMON            Jump to common routine  
  1924            * SGN   
  1925 6D34 0288  NSGN   CI   R8,LPARZ*256      Must have left parenthesis  
       6D36 B700  
  1926 6D38 1613         JNE  SYNERR            If not, error   
  1927 6D3A 06A0         BL   @PARSE            Parse the argument  
       6D3C 6480  
  1928 6D3E   D1         BYTE SGNZ,0            Up to another SGN   
       6D3F   00  
  1929 6D40 9820         CB   @FAC2,@CBH63      Must have a numeric arg   
       6D42 834C  
       6D44 6D05  
  1930 6D46 1B0A         JH   ERRSNM            If not, error   
  1931 6D48 0204         LI   R4,>4001          Floating point one  
       6D4A 4001  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0043
  1932 6D4C C020         MOV  @FAC,R0           Check status  
       6D4E 834A  
  1933 6D50 13E0         JEQ  BCONT             If 0, return 0  
  1934 6D52 1502         JGT  BLTST9            If positive, return +1  
  1935 6D54 0460         B    @LTRUE            If negative, return -1  
       6D56 6ABE  
  1936 6D58 0460  BLTST9 B    @LTST90           Sets up the FAC w/R4 and 0s   
       6D5A 6AC2  
  1937 6D5C 0460  ERRSNM B    @ERRT             STRING-NUMBER MISMATCH  
       6D5E 630C  
  1938 6D60 0460  SYNERR B    @ERRONE           SYNTAX ERROR  
       6D62 664E  
  1939            * SIN   
  1940 6D64 0202  NSIN   LI   R2,SINZZ          Load up sine address  
       6D66 78C0  
  1941 6D68 1005         JMP  COMMON            Jump into common routine  
  1942            * SQR   
  1943 6D6A 0202  NSQR   LI   R2,SQRZZ          Load up square-root address   
       6D6C 783A  
  1944 6D6E 1002         JMP  COMMON            Jump into common routine  
  1945            * TAN   
  1946 6D70 0202  NTAN   LI   R2,TANZZ          Load up tangent address   
       6D72 7940  
  1947 6D74 06A0  COMMON BL   @STKCHK           Make sure room on stacks  
       6D76 6DC0  
  1948 6D78 0288         CI   R8,LPARZ*256      Must have left parenthesis  
       6D7A B700  
  1949 6D7C 16F1         JNE  SYNERR            If not, error   
  1950 6D7E 05C9         INCT R9                Get space on subroutine stack 
  1951 6D80 C642         MOV  R2,*R9            Put address of routine on stac
  1952 6D82 06A0         BL   @PARSE            Parse the argument  
       6D84 6480  
  1953 6D86   FF         BYTE >FF,0             To end of the arg   
       6D87   00  
  1954 6D88 C099         MOV  *R9,R2            Get address of function back  
  1955 6D8A 0649         DECT  R9               Decrement subroutine stack  
  1956 6D8C 9820  COMM05 CB   @FAC2,@CBH63      Must have a numeric arg   
       6D8E 834C  
       6D90 6D05  
  1957 6D92 1BE4         JH   ERRSNM            If not, error   
  1958 6D94 04E0         CLR  @FAC10            Assume no error or warning  
       6D96 8354  
  1959 6D98 06A0         BL   @SAVREG           Save Basic registers  
       6D9A 1E8C  
  1960 6D9C C802         MOV  R2,@PAGE2         Select page 2   
       6D9E 6002  
  1961 6DA0 0692         BL   *R2               Evaluate the function   
  1962 6DA2 C802         MOV  R2,@PAGE1         Reselect Page 1   
       6DA4 6000  
  1963 6DA6 06A0         BL   @SETREG           Set registers up again  
       6DA8 1E7A  
  1964 6DAA D020         MOVB @FAC10,R0         Check for error or warning  
       6DAC 8354  
  1965 6DAE 13B1         JEQ  BCONT             If not error, continue  
  1966 6DB0 0990         SRL  R0,9              Check for warning   
  1967 6DB2 1304         JEQ  PWARN             Warning, issue it   
  1968 6DB4 0200         LI   R0,>0803          BAD ARGUMENT code   
       6DB6 0803  
  1969 6DB8 0460         B    @ERR  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0044
       6DBA 6652  
  1970 6DBC 0460  PWARN  B    @WARNZZ           Issue the warning message   
       6DBE 6662  
  1971 6DC0 0289  STKCHK CI   R9,STND12         Enough room on the subr stack?
       6DC2 83AE  
  1972 6DC4 1B18         JH   BSO               No, memory full error   
  1973 6DC6 C020         MOV  @VSPTR,R0         Get the value stack pointer   
       6DC8 836E  
  1974 6DCA 0220         AI   R0,48             Buffer-zone of 48 bytes   
       6DCC 0030  
  1975 6DCE 8800         C    R0,@STREND        Room between stack & strings  
       6DD0 831A  
  1976 6DD2 1A0E         JL   STKRTN            Yes, return   
  1977 6DD4 05C9         INCT R9                Get space on subr stack   
  1978 6DD6 CE4B         MOV  R11,*R9+          Save return address   
  1979 6DD8 CE42         MOV  R2,*R9+           Save COMMON function code   
  1980 6DDA C640         MOV  R0,*R9            Save v-stack pointer+48   
  1981 6DDC 06A0         BL   @COMPCT           Do a garbage collection   
       6DDE 73D8  
  1982 6DE0 8819         C    *R9,@STREND       Enough space now?   
       6DE2 831A  
  1983 6DE4 1406         JHE  BMF               No, MEMORY FULL error   
  1984 6DE6 0649         DECT R9                Decrement stack pointer   
  1985 6DE8 C099         MOV  *R9,R2            Restore COMMON function code  
  1986 6DEA 0649         DECT R9                Decrement stack pointer   
  1987 6DEC C2D9  RETRN  MOV *R9,R11            Restore return address  
  1988 6DEE 0649         DECT R9                Decrement stack pointer   
  1989 6DF0 045B  STKRTN RT   
  1990 6DF2 0460  BMF    B    @VPSH23           * MEMORY FULL   
       6DF4 6C1A  
  1991 6DF6 0460  BSO    B    @ERRSO            * STACK OVERFLOW  
       6DF8 6468  
  1992            ************************************************************
  1993            * LED routine for AND, OR, NOT, and XOR   
  1994            ************************************************************
  1995 6DFA 06A0  O0AND  BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6DFC 6B9C  
  1996 6DFE   BB         BYTE ANDZ,0            Stop on AND or less   
       6DFF   00  
  1997 6E00 06A0         BL   @CONVRT           Convert both to integers  
       6E02 6E9E  
  1998 6E04 0560         INV  @FAC              Complement L.H.   
       6E06 834A  
  1999 6E08 4820         SZC  @FAC,@ARG         Perform the AND   
       6E0A 834A  
       6E0C 835C  
  2000 6E0E C820  O0AND1 MOV  @ARG,@FAC         Put back in FAC   
       6E10 835C  
       6E12 834A  
  2001 6E14 06A0  O0AND2 BL   @CIF              Convert back to floating  
       6E16 74AA  
  2002 6E18 0460         B    @CONT             Continue  
       6E1A 64C8  
  2003 6E1C 06A0  O0OR   BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6E1E 6B9C  
  2004 6E20   BA         BYTE ORZ,0             Stop on OR or less  
       6E21   00  
  2005 6E22 06A0         BL   @CONVRT           Convert both to integers  
       6E24 6E9E  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0045
  2006 6E26 E820         SOC  @FAC,@ARG         Perform the OR  
       6E28 834A  
       6E2A 835C  
  2007 6E2C 10F0         JMP  O0AND1            Convert to floating and done  
  2008 6E2E 06A0  O0NOT  BL   @PARSE            Parse the arg   
       6E30 6480  
  2009 6E32   BD         BYTE NOTZ,0            Stop on NOT or less   
       6E33   00  
  2010 6E34 9820         CB   @FAC2,@CBH63      Get a numeric back?   
       6E36 834C  
       6E38 6D05  
  2011 6E3A 1B49         JH   ERRSN1            No, error   
  2012 6E3C 04E0         CLR  @FAC10            Clear for CFI   
       6E3E 8354  
  2013 6E40 06A0         BL   @CFI              Convert to Integer  
       6E42 12B8  
  2014 6E44 D020         MOVB @FAC10,R0         Check for an error  
       6E46 8354  
  2015 6E48 168B         JNE  SYNERR            Error   
  2016 6E4A 0560         INV  @FAC              Perform the NOT   
       6E4C 834A  
  2017 6E4E 10E2         JMP  O0AND2            Convert to floating and done  
  2018 6E50 06A0  O0XOR  BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6E52 6B9C  
  2019 6E54   BC         BYTE XORZ,0            Stop on XOR or less   
       6E55   00  
  2020 6E56 06A0         BL   @CONVRT           Convert both to integer   
       6E58 6E9E  
  2021 6E5A C020         MOV  @ARG,R0           Get R.H. into register  
       6E5C 835C  
  2022 6E5E 2820         XOR  @FAC,R0           Do the XOR  
       6E60 834A  
  2023 6E62 C800         MOV  R0,@FAC           Put result back in FAC  
       6E64 834A  
  2024 6E66 10D6         JMP  O0AND2            Convert and continue  
  2025            ************************************************************
  2026            * NUD for left parenthesis  
  2027            ************************************************************
  2028 6E68 0288  NLPR   CI   R8,RPARZ*256      Have a right paren already?   
       6E6A B600  
  2029 6E6C 1332         JEQ  ERRSY1            If so, syntax error   
  2030 6E6E 06A0         BL   @PARSE            Parse inside the parenthesises
       6E70 6480  
  2031 6E72   B7         BYTE LPARZ,0           Up to left parenthesis or less
       6E73   00  
  2032 6E74 0288         CI   R8,RPARZ*256      Have a right parenthesis now? 
       6E76 B600  
  2033 6E78 162C         JNE  ERRSY1            No, so error  
  2034 6E7A 06A0         BL   @PGMCHR           Get next token  
       6E7C 6C74  
  2035 6E7E 0460  BCON1  B    @CONT             And continue  
       6E80 64C8  
  2036            ************************************************************
  2037            * NUD for unary minus   
  2038            ************************************************************
  2039 6E82 06A0  NMINUS BL   @PARSE            Parse the expression  
       6E84 6480  
  2040 6E86   C2         BYTE MINUSZ,0          Up to another minus   
       6E87   00  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0046
  2041 6E88 0520         NEG  @FAC              Make it negative  
       6E8A 834A  
  2042 6E8C 9820  NMIN10 CB   @FAC2,@CBH63      Must have a numeric   
       6E8E 834C  
       6E90 6D05  
  2043 6E92 1B1D         JH   ERRSN1            If not, error   
  2044 6E94 10F4         JMP  BCON1             Continue  
  2045            ************************************************************
  2046            * NUD for unary plus  
  2047            ************************************************************
  2048 6E96 06A0  NPLUS  BL   @PARSE            Parse the expression  
       6E98 6480  
  2049 6E9A   C1         BYTE PLUSZ,0   
       6E9B   00  
  2050 6E9C 10F7         JMP  NMIN10            Use common code   
  2051            ************************************************************
  2052            * CONVRT - Takes two arguments, 1 form FAC and 1 from the   
  2053            *          top of the stack and converts them to integer  
  2054            *          from floating point, issuing appropriate errors  
  2055            ************************************************************
  2056 6E9E 05C9  CONVRT INCT R9  
  2057 6EA0 C64B         MOV  R11,*R9           SAVE RTN ADDRESS  
  2058 6EA2 06A0         BL   @ARGTST           ARGS MUST BE SAME TYPE  
       6EA4 6B6E  
  2059 6EA6 1313         JEQ  ERRSN1            AND NON-STRING  
  2060 6EA8 04E0         CLR  @FAC10            FOR CFI ERROR CODE  
       6EAA 8354  
  2061 6EAC 06A0         BL   @CFI              CONVERT R.H. ARG  
       6EAE 12B8  
  2062 6EB0 D020         MOVB @FAC10,R0         ANY ERROR OR WARNING?   
       6EB2 8354  
  2063 6EB4 160A         JNE  ERRBV             YES   
  2064 6EB6 C820         MOV  @FAC,@ARG         MOVE TO GET L.H. ARG  
       6EB8 834A  
       6EBA 835C  
  2065 6EBC 06A0         BL   @VPOP             GET L.H. BACK   
       6EBE 6C2A  
  2066 6EC0 06A0         BL   @CFI              CONVERT L.H.  
       6EC2 12B8  
  2067 6EC4 D020         MOVB @FAC10,R0         ANY ERROR OR WARNING?   
       6EC6 8354  
  2068 6EC8 1391         JEQ  RETRN             No, get rtn off stack and rtn 
  2069            *                             Yes, issue error  
  2070 6ECA 0460  ERRBV  B    @GOTO90           BAD VALUE   
       6ECC 670A  
  2071 6ECE 0460  ERRSN1 B    @ERRT             STRING NUMBER MISMATCH  
       6ED0 630C  
  2072 6ED2 0460  ERRSY1 B    @ERRONE           SYNTAX ERROR  
       6ED4 664E  
  2073            ************************************************************
  2074 6ED6              AORG >6ED6   
  2076                
  2077                
  2078 6ED6 0460  BSYNCH B    @SYNCHK   
       6ED8 6400  
  2079 6EDA 0460  BERSYN B    @ERRSYN   
       6EDC 664E  
  2080 6EDE 0460  BERSNM B    @ERRT   
       6EE0 630C  

 99/4 ASSEMBLER
SPEEDS                                                       PAGE 0047
  2081 6EE2 D01D  SPEED  MOVB *R13,R0           Read XML code   
  2082 6EE4 0980         SRL  R0,8              Shift for word value  
  2083 6EE6 13F7         JEQ  BSYNCH            0 is index for SYNCHK   
  2084 6EE8 0600         DEC  R0                Not SYNCHK, check further   
  2085 6EEA 1344         JEQ  PARCOM            1 is index for PARCOM   
  2086 6EEC 0600         DEC  R0                Not PARCOM, check further   
  2087 6EEE 1320         JEQ  RANGE             2 is index for RANGE  
  2088            * All otheres assumed to be SEETWO  
  2089            ************************************************************
  2090            * Find the line specified by the number in FAC  
  2091            * Searches the table from low address (high number) to  
  2092            *  high address (low number).   
  2093            ************************************************************
  2094 6EF0 020A  SEETWO LI   R10,SET           Assume number will be found   
       6EF2 6192  
  2095 6EF4 0207         LI   R7,GET1           Assume reading from the VDP   
       6EF6 6C9E  
  2096 6EF8 D020         MOVB @RAMTOP,R0        But correct   
       6EFA 8384  
  2097 6EFC 1302         JEQ  SEETW2               If   
  2098 6EFE 0207         LI   R7,GETG2              ERAM is present   
       6F00 6CCE  
  2099 6F02 C0E0  SEETW2 MOV  @ENLN,R3          Get point to start from   
       6F04 8332  
  2100 6F06 0223         AI   R3,-3             Get into table  
       6F08 FFFD  
  2101 6F0A 0697  SEETW4 BL   *R7               Read the number from table  
  2102 6F0C 0241         ANDI R1,>7FFF          Throw away possible breakpoint
       6F0E 7FFF  
  2103 6F10 8801         C    R1,@FAC           Match the number needed?  
       6F12 834A  
  2104 6F14 130A         JEQ  SEETW8            Yes, return with condition set
  2105 6F16 1B07         JH   SEETW6            No, and also passed it =>retur
  2106 6F18 0223         AI   R3,-4             No, but sitll might be there  
       6F1A FFFC  
  2107 6F1C 8803         C    R3,@STLN          Reached end of table?   
       6F1E 8330  
  2108 6F20 14F4         JHE  SEETW4            No, so check further  
  2109 6F22 C0E0         MOV  @STLN,R3          End of table, default to last 
       6F24 8330  
  2110 6F26 020A  SEETW6 LI   R10,RESET         Indicate not found  
       6F28 006A  
  2111 6F2A C803  SEETW8 MOV  R3,@EXTRAM        Put pointer in for GPL  
       6F2C 832E  
  2112 6F2E 045A         B    *R10              Return with condition   
  2113 6F30 C30B  RANGE  MOV  R11,R12           Save return address   
  2114 6F32 9820         CB   @FAC2,@CBH63      Have a numeric  
       6F34 834C  
       6F36 6D05  
  2115 6F38 1BD2         JH   BERSNM            Otherwise string number mismat
  2116 6F3A 04E0         CLR  @FAC10            Assume no conversion error  
       6F3C 8354  
  2117 6F3E 06A0         BL   @CFI              Convert from float to integer 
       6F40 12B8  
  2118 6F42 D020         MOVB @FAC10,R0         Get an error?   
       6F44 8354  
  2119 6F46 160E         JNE  RANERR            Yes, indicate it  
  2120 6F48 D01D         MOVB *R13,R0           Read lower limit  
  2121 6F4A 0980         SRL  R0,8              Shift for word compare  

 99/4 ASSEMBLER
SPEEDS                                                       PAGE 0048
  2122 6F4C D05D         MOVB *R13,R1           Read 1st byte of upper limit  
  2123 6F4E 06C1         SWPB R1                Kill time   
  2124 6F50 D05D         MOVB *R13,R1           Read 2nd byte of upper limit  
  2125 6F52 06C1         SWPB R1                Restore upper limit   
  2126 6F54 C0A0         MOV  @FAC,R2           Get the value   
       6F56 834A  
  2127 6F58 1105         JLT  RANERR            If negative, error  
  2128 6F5A 8002         C    R2,R0             Less then low limit?  
  2129 6F5C 1103         JLT  RANERR            Yes, error  
  2130 6F5E 8042         C    R2,R1             Greater then limit?   
  2131 6F60 1B01         JH   RANERR            Yes, error  
  2132 6F62 045C         B    *R12              All ok, so return   
  2133 6F64 06A0  RANERR BL   @SETREG           Set up registers for error  
       6F66 1E7A  
  2134 6F68 0460         B    @GOTO90           * BAD VALUE   
       6F6A 670A  
  2135            * Make sure at a left parenthesis   
  2136 6F6C 9820  LPAR   CB   @CHAT,@LBLPZ      At a left parenthesis   
       6F6E 8342  
       6F70 6F81  
  2137 6F72 16B3         JNE  BERSYN            No, syntax error  
  2138            * Parse up to a comma and insure at a comma   
  2139 6F74 06A0  PARCOM BL   @PUTSTK           Save GROM address   
       6F76 60F2  
  2140 6F78 06A0         BL   @SETREG           Set up R8/R9  
       6F7A 1E7A  
  2141 6F7C 06A0         BL   @PARSE            Parse the next item   
       6F7E 6480  
  2142 6F80   B3         BYTE COMMAZ            Up to a comma   
  2143 6F81   B7  LBLPZ  BYTE LPARZ   
  2144 6F82 0288         CI   R8,COMMAZ*256     End on a comma?   
       6F84 B300  
  2145 6F86 16A9         JNE  BERSYN            No, syntax error  
  2146 6F88 06A0         BL   @PGMCHR           Yes, get character after it   
       6F8A 6C74  
  2147 6F8C 06A0         BL   @SAVREG           Save R8/R9 for GPL  
       6F8E 1E8C  
  2148 6F90 06A0         BL   @GETSTK           Restore GROM address  
       6F92 610E  
  2149 6F94 0460         B    @RESET            Return to GPL reset   
       6F96 006A  
  2150            ************************************************************
  2151 6F98              AORG >6F98   
  2153                
  2154            * (RAM to RAM)  
  2155            * WITH ERAM    : Move the contents in ERAM FROM a higher  
  2156            *                 address to a lower address  
  2157            *                ARG    : byte count  
  2158            *                VAR9   : source address  
  2159            *                PAD    : destination address   
  2160                
  2161 6F98 C060  MVUP   MOV  @ARG,R1           Get byte count  
       6F9A 835C  
  2162 6F9C C0E0         MOV  @VAR9,R3          Get source  
       6F9E 8316  
  2163 6FA0 C160         MOV  @PAD,R5           Get destination   
       6FA2 8300  
  2164 6FA4 DD73  MVUP05 MOVB *R3+,*R5+         Move a byte   
  2165 6FA6 0601         DEC  R1                Decrement the counter   

 99/4 ASSEMBLER
MVUPS                                                        PAGE 0049
  2166 6FA8 16FD         JNE  MVUP05            Loop if more to move  
  2167 6FAA 045B         RT   
  2168            ************************************************************
  2169                
  2170 6FAC              AORG >6FAC   
  2172                
  2173            * Get a non-space character   
  2174 6FAC C00B  GETNB  MOV  R11,R0            Save return address   
  2175 6FAE 06A0  GETNB1 BL   @GETCHR           Get next character  
       6FB0 6FBA  
  2176 6FB2 0281         CI   R1,' '*256        Space character?  
       6FB4 2000  
  2177 6FB6 13FB         JEQ  GETNB1            Yes, get next character   
  2178 6FB8 0450         B    *R0               No, return character condition
  2179            * Get the next character  
  2180 6FBA 8820  GETCHR C    @VARW,@VARA       End of line?  
       6FBC 8320  
       6FBE 832A  
  2181 6FC0 1B0E         JH   GETCH2            Yes, return condition   
  2182 6FC2 D7E0         MOVB @VARW1,*R15       No, write LSB of VDP address  
       6FC4 8321  
  2183 6FC6 0201         LI   R1,>A000          Negative screen offset (->60) 
       6FC8 A000  
  2184 6FCA D7E0         MOVB @VARW,*R15        Write MSB of VDP address  
       6FCC 8320  
  2185 6FCE 05A0         INC  @VARW             Increment read-from pointer   
       6FD0 8320  
  2186 6FD2 B060         AB   @XVDPRD,R1        Read and remove screen offset 
       6FD4 8800  
  2187 6FD6 0281         CI   R1,>1F00          Read an edge character?   
       6FD8 1F00  
  2188 6FDA 13EF         JEQ  GETCHR            Yes, skip it  
  2189 6FDC 045B         RT                     Return  
  2190 6FDE 04C1  GETCH2 CLR  R1                Indicate end of line  
  2191 6FE0 045B         RT                     Return  
  2192            *-----------------------------------------------------------
  2193            * Remove this routine from CRUNCH because CRUNCH is running 
  2194            * out of space                5/11/81   
  2195            *-----------------------------------------------------------
  2196            *      Calculate and put length of string/number into   
  2197            *      length byte  
  2198 6FE2 C0CB  LENGTH MOV  R11,R3            Save retun address  
  2199 6FE4 C020         MOV  @RAMPTR,R0        Save current crunch pointer   
       6FE6 830A  
  2200 6FE8 C200         MOV  R0,R8             Put into r8 for PUTCHR below  
  2201 6FEA 6205         S    R5,R8             Calculate length of string  
  2202 6FEC 0608         DEC  R8                RAMPTR is post-incremented  
  2203 6FEE C805         MOV  R5,@RAMPTR        Address of length byte  
       6FF0 830A  
  2204 6FF2 06A0         BL   @PUTCHR           Put the length in   
       6FF4 7F6E  
  2205 6FF6 C800         MOV  R0,@RAMPTR        Restore crunch pointer  
       6FF8 830A  
  2206 6FFA 0453         B    *R3               And return  
  2207            * FILL IN BYTES OF MODULE WITH COPY OF ORIGINAL?  
  2208 6FFC 0000         DATA >0000   
  2209 6FFE EF71         DATA >EF71             ?????   
  2210            ************************************************************
  2211 7000              AORG >7000   

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0050
  2213                
  2214            ************************************************************
  2215            * FOR statement   
  2216            * Builds up a stack entry for the FOR statement. Checks the 
  2217            * syntax of a FOR statement and also checks to see if the   
  2218            * loop is executed at all. The loop is not executed if the  
  2219            * limit of the FOR is > then initial value and the step is  
  2220            * positive of the limit of the FOR is < then initial value  
  2221            * and the step is negative.   
  2222            *   
  2223            * A stack entry for a 'FOR' statement looks like:   
  2224            *   
  2225            * +-------------------------------------------------------+ 
  2226            * | PTR TO S.T. | >67 |     | Value Space  | BUFLEV       | 
  2227            * |   ENTRY     |     |     |  Pointer     |              | 
  2228            * | ------------------------------------------------------| 
  2229            * | FOR line #  | FOR line  |                             | 
  2230            * | table ptr   |  pointer  |                             | 
  2231            * |-------------------------------------------------------| 
  2232            * |                    Increment Value                    | 
  2233            * |-------------------------------------------------------| 
  2234            * |                        Limit                          | 
  2235            * +-------------------------------------------------------+ 
  2236            ************************************************************
  2237 7000 D208  NFOR   MOVB R8,R8             EOL?  
  2238 7002 1501         JGT  NFOR1             If symbol name, ok  
  2239 7004 107C         JMP  ERRCDT            If EOL or Token, error  
  2240 7006 06A0  NFOR1  BL   @SYM              Get pointer to s.t. entry   
       7008 6312  
  2241 700A 06A0         BL   @GETV             Get 1st byte of symbol  
       700C 187C  
  2242 700E 834A         DATA FAC                 entry   
  2243            *   
  2244 7010 0241         ANDI R1,>C700          Check string, function & array
       7012 C700  
  2245 7014 1670         JNE  BERMUW            If andy of the above, error   
  2246 7016 0288         CI   R8,EQZ*256        Must have '='   
       7018 BE00  
  2247 701A 1671         JNE  ERRCDT            If not, error   
  2248 701C 06A0         BL   @SMB              Get index's value space   
       701E 61DC  
  2249 7020 04E0         CLR  @FAC2             Dummy entry ID on the stack   
       7022 834C  
  2250 7024 C820         MOV  @BUFLEV,@FAC6     Save buffer level   
       7026 8346  
       7028 8350  
  2251            *   
  2252            * Search stack for another FOR entry with the same loop   
  2253            *  variable. If one is found, remove it.  
  2254            *   
  2255 702A C0E0         MOV  @VSPTR,R3         Copy stack pointer  
       702C 836E  
  2256            *   
  2257            * See if end of stack   
  2258 702E 8803  NFOR1A C    R3,@STVSPT        Check stack underflow   
       7030 8324  
  2259 7032 1228         JLE  NFOR1E            Finished with stack scan  
  2260            * See if FOR entry  
  2261 7034 06A0         BL   @GET1             Get pointer to s.t. entry   

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0051
       7036 6C9E  
  2262 7038 C001         MOV  R1,R0             Move it to use later  
  2263 703A D060         MOVB @XVDPRD,R1        Read stack ID   
       703C 8800  
  2264 703E 9801         CB   R1,@CBH67         Is stack entry a FOR?   
       7040 68AB  
  2265 7042 1606         JNE  NFOR1B            No, 8 byte regular entry  
  2266            * Compare loop variables  
  2267 7044 8800         C    R0,@FAC           Loop variables match?   
       7046 834A  
  2268 7048 1309         JEQ  NFOR1C            Yes   
  2269 704A 0223         AI   R3,-32            Skip this FOR entry   
       704C FFE0  
  2270 704E 10EF         JMP  NFOR1A            Loop  
  2271 7050 9801  NFOR1B CB   R1,@CCBH6A        Hit a subprogram entry?   
       7052 70AF  
  2272 7054 1317         JEQ  NFOR1E            Yes, don't scan anymore   
  2273 7056 0223         AI   R3,-8             Skip 8 byte stack entry   
       7058 FFF8  
  2274 705A 10E9         JMP  NFOR1A            Loop  
  2275            * Found matching loop variable, move stack down 32 bytes  
  2276 705C C0A0  NFOR1C MOV  @VSPTR,R2         Copy stack pointer  
       705E 836E  
  2277 7060 6083         S    R3,R2             Calculate # of bytes to move  
  2278 7062 130D         JEQ  NFOR1D            0 bytes, skip move  
  2279 7064 C103         MOV  R3,R4             Destination pointer   
  2280 7066 0224         AI   R4,-24            Place to move to  
       7068 FFE8  
  2281      706C  C8     EQU  $+2   
  2282 706A 0223         AI   R3,8              Point at entry above FOR entry
       706C 0008  
  2283 706E 06A0  NFOR1F BL   @GETV1            Get the byte  
       7070 1880  
  2284 7072 06A0         BL   @PUTV1            Put the byte  
       7074 6422  
  2285 7076 0583         INC  R3                Inc From pointer  
  2286 7078 0584         INC  R4                Inc To pointer  
  2287 707A 0602         DEC  R2                Decrement counter   
  2288 707C 16F8         JNE  NFOR1F            Loop if not done  
  2289 707E 6820  NFOR1D S    @C32,@VSPTR       Adjust top of stack   
       7080 7196  
       7082 836E  
  2290            * Now put new FOR entry on stack  
  2291 7084 06A0  NFOR1E BL   @VPUSH            Reserve space for limit   
       7086 6BAA  
  2292 7088 06A0         BL   @VPUSH               increment,   
       708A 6BAA  
  2293 708C 06A0         BL   @VPUSH                and 2nd info entry  
       708E 6BAA  
  2294 7090 D820         MOVB @CBH67,@FAC2      FOR ID on stack   
       7092 68AB  
       7094 834C  
  2295 7096 06A0         BL   @PGMCHR           Get next character  
       7098 6C74  
  2296 709A 06A0         BL   @PSHPRS           Push symbol I.D. entry  
       709C 6B9C  
  2297 709E   B1         BYTE TOZ               Parse the initial value   
  2298 709F   63  CCBH63 BYTE >63               Wasted byte (CBH63)   
  2299 70A0 0288         CI   R8,TOZ*256        TO?   

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0052
       70A2 B100  
  2300 70A4 162C         JNE  ERRCDT            No, error   
  2301 70A6 06A0         BL   @PGMCHR   
       70A8 6C74  
  2302 70AA 06A0         BL   @PSHPRS           Push initial and get limit  
       70AC 6B9C  
  2303 70AE   B2         BYTE STEPZ   
  2304 70AF   6A  CCBH6A BYTE >6A               Wasted byte (CBA6A)   
  2305 70B0 9820         CB   @CCBH63,@FAC2     If a string value   
       70B2 709F  
       70B4 834C  
  2306 70B6 1A1D         JL   BERR6             Its an error  
  2307 70B8 6820         S    @C40,@VSPTR   
       70BA 6006  
       70BC 836E  
  2308 70BE 06A0         BL   @VPUSH            Push the limit  
       70C0 6BAA  
  2309 70C2 06A0         BL   @EOSTMT           At the end of statement?  
       70C4 6862  
  2310 70C6 131D         JEQ  NFOR2             Yes, default incr to 1  
  2311 70C8 0288         CI   R8,STEPZ*256      STEP?   
       70CA B200  
  2312 70CC 1618         JNE  ERRCDT            No, Its an error  
  2313 70CE A820         A    @C32,@VSPTR       Corrrect stack pointer  
       70D0 7196  
       70D2 836E  
  2314 70D4 06A0         BL   @PGMCHR   
       70D6 6C74  
  2315 70D8 06A0         BL   @PARSE            Get the increment   
       70DA 6480  
  2316 70DC   83         BYTE TREMZ,0   
       70DD   00  
  2317 70DE 6820         S    @C32,@VSPTR       Get stack to needed place   
       70E0 7196  
       70E2 836E  
  2318 70E4 C020         MOV  @FAC,R0           Can't have zero increment   
       70E6 834A  
  2319 70E8 1308         JEQ  ERRBV2            If 0, its an error  
  2320 70EA 9820         CB   @CCBH63,@FAC2     Can't have zero increment   
       70EC 709F  
       70EE 834C  
  2321 70F0 140F         JHE  NFOR3             If numeric, ok  
  2322 70F2 0460  BERR6  B    @ERRT             * STRING NUMBER MISMATCH  
       70F4 630C  
  2323 70F6 0460  BERMUW B    @ERRMUV           * MULTIPLY USED VARIABLE  
       70F8 6970  
  2324 70FA 0460  ERRBV2 B    @GOTO90   
       70FC 670A  
  2325 70FE 0460  ERRCDT B    @ERRSYN   
       7100 664E  
  2326 7102 0200  NFOR2  LI   R0,FAC  
       7104 834A  
  2327 7106 CC20         MOV  @FLTONE,*R0+      Put a floating one in   
       7108 600E  
  2328 710A 04F0         CLR  *R0+  
  2329 710C 04F0         CLR  *R0+  
  2330 710E 04D0         CLR  *R0   
  2331 7110 06A0  NFOR3  BL   @VPUSH            Push the step   
       7112 6BAA  

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0053
  2332 7114 0201         LI   R1,FAC            Optimize to save bytes  
       7116 834A  
  2333 7118 CC60         MOV  @EXTRAM,*R1+      Save line # pointer   
       711A 832E  
  2334 711C C460         MOV  @PGMPTR,*R1       Save ptr w/in the line  
       711E 832C  
  2335 7120 0611         DEC  *R1               Back up so get last character 
  2336 7122 06A0         BL   @VPUSH            Push it too!  
       7124 6BAA  
  2337 7126 A820         A    @H16,@VSPTR       Point to initial value  
       7128 7156  
       712A 836E  
  2338 712C 06A0         BL   @VPOP             Get initial value   
       712E 6C2A  
  2339 7130 06A0         BL   @ASSG             Assign it   
       7132 6334  
  2340 7134 A820         A    @C8,@VSPTR        Restore to top of entry   
       7136 706C  
       7138 836E  
  2341            * Check to see if execute loop at all   
  2342 713A 06A0         BL   @VPOP             Get ptr to value  
       713C 6C2A  
  2343 713E 06A0         BL   @MOVFAC           Get value   
       7140 6434  
  2344 7142 6820         S    @H16,@VSPTR       Point at limit  
       7144 7156  
       7146 836E  
  2345 7148 06A0         BL   @SCOMPB           Compare them  
       714A 0D42  
  2346            * VSPTR is now below the FOR entry  
  2347 714C 02C4         STST R4                Save the status   
  2348 714E 1309         JEQ  NFOR03            IF =  
  2349 7150 C0E0         MOV  @VSPTR,R3   
       7152 836E  
  2350      7156  H16    EQU  $+2   
  2351 7154 0223         AI   R3,16   
       7156 0010  
  2352 7158 06A0         BL   @GETV1            Check negative step   
       715A 1880  
  2353 715C 1107         JLT  NFOR05            If a decrement  
  2354 715E 0A14         SLA  R4,1              Check out of limit  
  2355 7160 1507         JGT  NFOR07            Out of limit  
  2356 7162 A820  NFOR03 A    @C32,@VSPTR       Leave the entry on  
       7164 7196  
       7166 836E  
  2357 7168 0460         B    @CONT     <<<<<<< Result is w/in limit  
       716A 64C8  
  2358 716C 0A14  NFOR05 SLA  R4,1              Check out of limit  
  2359 716E 15F9         JGT  NFOR03            Result is w/in limit  
  2360            * Initial value is not within the limit. Therefore, the loop
  2361            * is not executed at all. Must skip the code in the body of 
  2362            * the loop  
  2363 7170 0203  NFOR07 LI   R3,1              FOR/NEXT pair counter   
       7172 0001  
  2364 7174 06A0  NFOR09 BL   @EOLINE           Check end of line   
       7176 6872  
  2365 7178 1338         JEQ  NFOR13            Is end of line  
  2366 717A 06A0         BL   @PGMCHR           Get 1st token on line   
       717C 6C74  

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0054
  2367 717E 0288  NFOR10 CI   R8,NEXTZ*256      If NEXT   
       7180 9600  
  2368 7182 1618         JNE  NFOR11            If not  
  2369 7184 0603         DEC  R3                Decrement counter   
  2370 7186 162B         JNE  NFOR12            If NOT matching next  
  2371 7188 06A0         BL   @PGMCHR           Get 1st char of loop variable 
       718A 6C74  
  2372            * Check is added in SYM       5/26/81   
  2373            *      JLT  ERRCDT            If token  
  2374 718C 06A0         BL   @SYM              Get s.t. pointer to check matc
       718E 6312  
  2375 7190 C0E0         MOV  @VSPTR,R3         Correct to top of entry   
       7192 836E  
  2376      7196  C32    EQU  $+2   
  2377 7194 0223         AI   R3,32   
       7196 0020  
  2378 7198 06A0         BL   @GET1             Get pointer   
       719A 6C9E  
  2379 719C 8801         C    R1,@FAC           Match?  
       719E 834A  
  2380 71A0 1605         JNE  ERRFNN            No match  
  2381 71A2 0460         B    @CONT             Continue  <<<<<<<< THE WAY  
       71A4 64C8  
  2382 71A6 A820  ERRFN  A    @C4,@EXTRAM   
       71A8 6A80  
       71AA 832E  
  2383 71AC 0200  ERRFNN LI   R0,>0B03          FOR NEXT NESTING  
       71AE 0B03  
  2384 71B0 0460         B    @ERR  
       71B2 6652  
  2385 71B4 0288  NFOR11 CI   R8,SUBZ*256       Hit a SUB?  
       71B6 A100  
  2386 71B8 13F9         JEQ  ERRFNN            Yes, can't find matching next 
  2387 71BA 0288         CI   R8,FORZ*256       FOR?  
       71BC 8C00  
  2388 71BE 1601         JNE  NFOR20            No, Check some more   
  2389 71C0 0583         INC  R3                Increment depth   
  2390 71C2 0288  NFOR20 CI   R8,LNZ*256        Line number token?  
       71C4 C900  
  2391 71C6 1602         JNE  NFOR30            No, Check some more   
  2392 71C8 05E0         INCT @PGMPTR           Skip the line number  
       71CA 832C  
  2393 71CC 0288  NFOR30 CI   R8,STRINZ*256     String?   
       71CE C700  
  2394 71D0 1606         JNE  NFOR12            No, Check end of statement  
  2395 71D2 06A0         BL   @PGMCHR           Yes, get string length  
       71D4 6C74  
  2396 71D6 06C8         SWPB R8                Put the length in R8  
  2397 71D8 A808         A    R8,@PGMPTR        Skip that many length   
       71DA 832C  
  2398 71DC 04C8         CLR  R8                Clear next crunched code  
  2399 71DE 06A0  NFOR12 BL   @PGMCHR           Read next crunched code   
       71E0 6C74  
  2400 71E2 06A0         BL   @EOSTMT           Check EOS (includes EOL)  
       71E4 6862  
  2401 71E6 16ED         JNE  NFOR20            Check for line # or string  
  2402 71E8 10C5         JMP  NFOR09            Is EOS or EOL   
  2403 71EA D020  NFOR13 MOVB @PRGFLG,R0        If imperative w/out match   
       71EC 8344  

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0055
  2404 71EE 13DE         JEQ  ERRFNN            Its an error  
  2405 71F0 6820         S    @C4,@EXTRAM       Goto next line  
       71F2 6A80  
       71F4 832E  
  2406 71F6 8820         C    @EXTRAM,@STLN     Hit end of program?   
       71F8 832E  
       71FA 8330  
  2407 71FC 1AD4         JL   ERRFN             Yes, can't match the next   
  2408 71FE C820         MOV  @EXTRAM,@PGMPTR   Set PGMPTR to get new PGMPTR  
       7200 832E  
       7202 832C  
  2409 7204 06A0         BL   @PGMCHR           Get   
       7206 6C74  
  2410 7208 D808         MOVB R8,@PGMPTR         new  
       720A 832C  
  2411 720C D81A         MOVB *R10,@PGMPT1        PGMPTR  
       720E 832D  
  2412 7210 06A0         BL   @PGMCHR           Get next line   
       7212 6C74  
  2413 7214 06A0         BL   @EOSTMT           Check EOS or EOL  
       7216 6862  
  2414 7218 13AD         JEQ  NFOR09            Is EOS or EOL   
  2415 721A 10B1         JMP  NFOR10            Keep looping  
  2416            * NEXT4 and NEXT2A were moved from in-line to here in an  
  2417            * effort to make the "normal" path through the NEXT code as 
  2418            * straight-line as possible.  
  2419 721C 6820  NEXT4  S    @C24,@VSPTR       LOOP VARIABLES DON'T MATCH  
       721E 6464  
       7220 836E  
  2420 7222 1008         JMP  NEXT2   
  2421 7224 06A0  NEXT2B BL   @VPUSH            Keep stack information  
       7226 6BAA  
  2422 7228 0200  NEXT2A LI   R0,>0C03            NEXT WITHOUT FOR  
       722A 0C03  
  2423 722C 0460         B    @ERR  
       722E 6652  
  2424            ************************************************************
  2425            * NEXT statement handler - find the matching FOR statement  
  2426            * on the stack, add the increment to the current value of   
  2427            * the index variable and check to see if execute the loop   
  2428            * again. If loop-variable's value is still within bounds,   
  2429            * goto the top of the loop, otherwise, flush the FOR entry  
  2430            * off the stack and continue with the statement following   
  2431            * the NEXT statement.   
  2432            ************************************************************
  2433 7230 06A0  NNEXT  BL   @SYM              GET S.T.   I.D.   
       7232 6312  
  2434            *      MOV  @FAC,R4           SYM/FBSYMB leaves value in R4 
  2435 7234 8820  NEXT2  C    @VSPTR,@STVSPT    CHECK FOR BOTTOM OF STACK   
       7236 836E  
       7238 8324  
  2436 723A 12F6         JLE  NEXT2A            IF AT BOTTOM -> NEXT W/OUT FOR
  2437 723C 06A0         BL   @VPOP             GET 'FOR' ENTRY OFF STACK   
       723E 6C2A  
  2438 7240 9820         CB   @FAC2,@CBH67      CHECK FOR 'FOR' ENTRY   
       7242 834C  
       7244 68AB  
  2439 7246 16EE         JNE  NEXT2B            Is not a 'FOR' entry, error   
  2440 7248 8804         C    R4,@FAC           CHECK IF MATCHING 'FOR' ENTRY 

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0056
       724A 834A  
  2441 724C 16E7         JNE  NEXT4             Is not a match, so check more 
  2442 724E C0E0         MOV  @VSPTR,R3         Check BUFLEV for match  
       7250 836E  
  2443 7252 0223         AI   R3,14             Point at the BUFLEV in stack  
       7254 000E  
  2444 7256 06A0         BL   @GET1             Read it   
       7258 6C9E  
  2445 725A 8801         C    R1,@BUFLEV        SAME LEVEL?   
       725C 8346  
  2446 725E 16A6         JNE  ERRFNN            NO, ITS AN ERROR  
  2447 7260 6820         S    @C8,@VSPTR  
       7262 706C  
       7264 836E  
  2448 7266 06A0         BL   @MOVFAC           GET INDEX VALUE   
       7268 6434  
  2449 726A 06A0         BL   @SAVREG           SAVE BASIC REGISTERS  
       726C 1E8C  
  2450 726E 06A0         BL   @SADD             ADD IN THE INCREMENT  
       7270 0D84  
  2451 7272 06A0         BL   @SETREG           RESTORE BASIC REGS  
       7274 1E7A  
  2452 7276 A820         A    @C24,@VSPTR   
       7278 6464  
       727A 836E  
  2453 727C 06A0         BL   @ASSG             SAVE NEW INDEX VALUE  
       727E 6334  
  2454 7280 6820         S    @H16,@VSPTR       POINT TO THE LIMIT  
       7282 7156  
       7284 836E  
  2455 7286 06A0         BL   @SCOMPB           TEST W/IN LIMIT   
       7288 0D42  
  2456 728A 02C4         STST R4                SAVE RESULT OF COMPARE  
  2457 728C 1309         JEQ  NEXT5             IF = DO LAST LOOP   
  2458 728E C0E0         MOV  @VSPTR,R3         CHECK FOR A DECREMENT   
       7290 836E  
  2459 7292 0223         AI   R3,16             Point at increment/decrement  
       7294 0010  
  2460 7296 06A0         BL   @GETV1            Get 1st byte and set condition
       7298 1880  
  2461 729A 1116         JLT  NEXT6             If was a decrement  
  2462 729C 0A14         SLA  R4,1              Check if out of limit   
  2463 729E 1512         JGT  NEXT8             Out of limit  
  2464 72A0 A820  NEXT5  A    @C32,@VSPTR       Point to 'FOR' I.D. entry   
       72A2 7196  
       72A4 836E  
  2465 72A6 C0E0         MOV  @VSPTR,R3         GOTO TOP OF 'FOR' LOOP  
       72A8 836E  
  2466 72AA 0223         AI   R3,-8             Point to old EXTRAM   
       72AC FFF8  
  2467 72AE 06A0         BL   @GET1             Get new EXTRAM  
       72B0 6C9E  
  2468 72B2 C801         MOV  R1,@EXTRAM        Put it in   
       72B4 832E  
  2469 72B6 05C3         INCT R3                POINT AT OLD PGMPTR   
  2470 72B8 06A0         BL   @GET1             Get old PGMPTR  
       72BA 6C9E  
  2471 72BC C801         MOV  R1,@PGMPTR        Put it in   
       72BE 832C  

 99/4 ASSEMBLER
FORNEXTS                                                     PAGE 0057
  2472 72C0 06A0         BL   @PGMCHR           Get 1st token in line   
       72C2 6C74  
  2473 72C4 0460  NEXT8  B    @CONT             Continue on   
       72C6 64C8  
  2474            * TEST LIMIT FOR DECREMENT  
  2475 72C8 0A14  NEXT6  SLA  R4,1              Check if out of limit   
  2476 72CA 15EA         JGT  NEXT5             If within limit, continue   
  2477 72CC 10FB         JMP  NEXT8             Continue PARSE  
  2478            ************************************************************
  2479 72CE              AORG >72CE   
  2481                
  2482            ************************************************************
  2483            *                 MEMORY CHECK ROUTINE  
  2484            * It checks to see if there is enough room to insert a  
  2485            * symbol table entry or a P.A.B. into the VDP between the   
  2486            * static symbol table/PAB area and the dymamic string area. 
  2487            * If there is not it attempts to move the string space down 
  2488            * (to  lower address) and then insert the needed area   
  2489            * between the two. NOTE: it may invoke COMPCT to do a   
  2490            * garbage collection. If there is not enough space after  
  2491            * COMPCT then issues *MEMORY FULL* message.   
  2492            *   
  2493            * INPUT:  # of bytes needed in FAC, FAC+1   
  2494            * USES:   R0, R12 as temporaries as well as R0 - R6 when  
  2495            *         invoking COMPCT   
  2496            ************************************************************
  2497 72CE 06A0  MEMCHG BL   @MEMCHK           GPL entry point   
       72D0 72D8  
  2498 72D2 6192         DATA SET               If NOT enough memory  
  2499 72D4 0460         B    @RESET            If enough memory  
       72D6 006A  
  2500 72D8 C30B  MEMCHK MOV  R11,R12           Save return address   
  2501 72DA C020         MOV  @FREPTR,R0        GET BEGINNING OF S.T. FREE SPA
       72DC 8340  
  2502 72DE 6020         S    @STRSP,R0         CALCULATE SIZE OF GAP   
       72E0 8318  
  2503 72E2 8020         C    @FAC,R0           ENOUGH SPACE ALREADY?   
       72E4 834A  
  2504 72E6 1A3C         JL   MEMC08            YES - DONE - RTN  
  2505 72E8 06A0         BL   @COMPCT           NO - COMPACITFY STRING SPACE  
       72EA 73D8  
  2506 72EC C020         MOV  @STREND,R0        GET STRING FREE SPACE   
       72EE 831A  
  2507 72F0 6020         S    @VSPTR,R0         CALCULATE SIZE OF GAP   
       72F2 836E  
  2508 72F4 0220         AI   R0,-64            VSPTR OFFSET TOO  
       72F6 FFC0  
  2509 72F8 C2A0         MOV  @FAC,R10          GET TOTAL # NEEDED BACK   
       72FA 834A  
  2510 72FC 8280         C    R0,R10            ENOUGH ROOM NOW?  
  2511 72FE 1A32         JL   MEMERR            NO - *MEMORY FULL*  
  2512            *   
  2513            * Now move the DYNAMIC STRING AREA DOWN IN MEMORY   
  2514            *   
  2515 7300 C020         MOV  @STRSP,R0         CALCULATE # OF BYTES  
       7302 8318  
  2516 7304 C0A0         MOV  @STREND,R2        Beginning of move address   
       7306 831A  
  2517 7308 6002         S    R2,R0              in the total string space  

 99/4 ASSEMBLER
STRINGS                                                      PAGE 0058
  2518 730A 680A         S    R10,@STREND       SET FREE PTR(COPY-TO ADDRESS) 
       730C 831A  
  2519 730E C000         MOV  R0,R0             NO BYTES TO MOVE?   
  2520 7310 130D         JEQ  MEMC04            RIGHT   
  2521 7312 C0C2         MOV  R2,R3             ADDRESS FOR GETV  
  2522 7314 0583         INC  R3  
  2523 7316 C120         MOV  @STREND,R4        ADDRESS FOR PUTV  
       7318 831A  
  2524 731A 0584         INC  R4  
  2525 731C 06A0  MEMC03 BL   @GETV1            GET THE BYTE  
       731E 1880  
  2526 7320 06A0         BL   @PUTV1            PUT THE BYTE  
       7322 6422  
  2527 7324 0583         INC  R3                INC THE FROM  
  2528 7326 0584         INC  R4                INC THE TO  
  2529 7328 0600         DEC  R0                DEC THE COUNT   
  2530 732A 15F8         JGT  MEMC03            IF NOT DONE   
  2531            *                             MOVE IT   
  2532 732C 680A  MEMC04 S    R10,@STRSP        SET NEW STRIG SPACE PTR   
       732E 8318  
  2533            *   
  2534            * NOW FIX UP STRING PTRS  
  2535            *   
  2536 7330 C020         MOV  @STRSP,R0         GET BEGINNING OF STRING SPACE 
       7332 8318  
  2537 7334 8020  MEMC05 C    @STREND,R0        FINISHED?   
       7336 831A  
  2538 7338 1413         JHE  MEMC08            YES   
  2539 733A 04C1         CLR  R1                CLEAR LOWER BYTE  
  2540 733C C0C0         MOV  R0,R3             FOR GETV  
  2541 733E 06A0         BL   @GETV1            GET LENGTH BYTE   
       7340 1880  
  2542 7342 06C1         SWPB R1                SWAP FOR ADD  
  2543 7344 6001         S    R1,R0             POINT AT BEGINNING OF STRING  
  2544 7346 C0C0         MOV  R0,R3             FOR THE GETV1 BELOW   
  2545 7348 0223         AI   R3,-3             POINT AT THE BACKPOITER   
       734A FFFD  
  2546 734C 06A0         BL   @GET1             GET THE BACK POINTER  
       734E 6C9E  
  2547            *                             BOTH BYTES  
  2548 7350 C041         MOV  R1,R1             FREE STRING?  
  2549 7352 1303         JEQ  MEMC06            YES   
  2550 7354 C180         MOV  R0,R6             PTR TO STRING FOR STVDP   
  2551 7356 06A0         BL   @STVDP            SET FORWARD PTR   
       7358 18AE  
  2552 735A 0220  MEMC06 AI   R0,-4             NOW POINT AT NEXT LENGTH  
       735C FFFC  
  2553 735E 10EA         JMP  MEMC05            CONTINUE ON   
  2554 7360 046C  MEMC08 B    @2(R12)           Return with space allocated   
       7362 0002  
  2555 7364 C31C  MEMERR MOV  *R12,R12          Pick up error return address  
  2556 7366 045C         B    *R12              * MEMORY FULL(prescan time)   
  2557 7368 0460  ERRMEM B    @VPSH23           * MEMORY FULL(execution tiem) 
       736A 6C1A  
  2558            ************************************************************
  2559            * GETSTR - Checks to see if there is enough space in the  
  2560            *          string area to allocate a string, if there is it 
  2561            *          allocates it. If there is not it does a garbage  
  2562            *          collection and once again checks to see if there 

 99/4 ASSEMBLER
STRINGS                                                      PAGE 0059
  2563            *          is enough room. If so it allocates it, if not it 
  2564            *          issues a *MEMORY FULL* message.  
  2565            *   
  2566            * INPUT :  # of bytes needed in @BYTE   
  2567            * OUTPUT:  Pointer to new string in @SREF   
  2568            *          Both length bytes in place & zeroed Breakpointer 
  2569            *          @STREND points 1st free byte(new)  
  2570            *   
  2571            * USES  :  R0 - R6 Temporaries  
  2572            *   
  2573            * Note  :  COMPCT allows a buffer zone of 8 stack entries   
  2574            *          above what is there when COMPCT is called. This  
  2575            *          should allow enough space to avoid a collision   
  2576            *          between the string space and the stack. If   
  2577            *          garbage begins to appear in the string space   
  2578            *          that can't be accounted for, the buffer zone   
  2579            *          will be increased.   
  2580            ************************************************************
  2581 736C C020  GETSTR MOV  @BYTE,R0          GET # OF BYTES NEEDED   
       736E 830C  
  2582 7370 C30B         MOV  R11,R12           SAVE RTN ADDRESS  
  2583 7372 8C30         C    *R0+,*R0+         ADJUST FOR BACKPTR & 2 LENGTHS
  2584            *                              (INCREMENT BY 4)   
  2585 7374 C060         MOV  @STREND,R1        CHECK IF ENOUGH ROOM  
       7376 831A  
  2586 7378 6040         S    R0,R1             BY ADVANCING THE FREE PTR   
  2587 737A C0A0         MOV  @VSPTR,R2         GET VALUE STACK PTR   
       737C 836E  
  2588 737E 0222         AI   R2,64             ALLOW BUFFER ZONE   
       7380 0040  
  2589 7382 8081         C    R1,R2             ENOUGH SPACE?   
  2590 7384 1B0E         JH   GETS10            YES, ALL IS WELL  
  2591 7386 06A0         BL   @COMPCT           NO, COMPACTIFY  
       7388 73D8  
  2592 738A C0A0         MOV  @VSPTR,R2         GET VALUE STACK POINTER   
       738C 836E  
  2593 738E 0222         AI   R2,64             ALLOW BUFFER ZONE   
       7390 0040  
  2594 7392 C020         MOV  @BYTE,R0          GET # OF BYTES BACK   
       7394 830C  
  2595 7396 8C30         C    *R0+,*R0+         INCREMENT BY 4  
  2596 7398 C060         MOV  @STREND,R1        GET NEW END OF STRING SPACE   
       739A 831A  
  2597 739C 6040         S    R0,R1             ADVANCE IT  
  2598 739E 8081         C    R1,R2             ENOUGH SPACE NOW?   
  2599 73A0 12E3         JLE  ERRMEM            NO, *MEMORY FULL*   
  2600 73A2 0220  GETS10 AI   R0,-4             GET EXACT LENGTH BACK   
       73A4 FFFC  
  2601 73A6 D060         MOVB @R0LB,R1          STORE ENTRY LENGTH  
       73A8 83E1  
  2602 73AA 06A0         BL   @PUTV             PUT THE ENDING LENGTH   
       73AC 641E  
  2603 73AE 831A         DATA STREND             BYTE IN THE STRING   
  2604 73B0 6800         S    R0,@STREND        PT AT FIRST BYTE OF STRING  
       73B2 831A  
  2605 73B4 C820         MOV  @STREND,@SREF     POINT SREF AT THE STRING  
       73B6 831A  
       73B8 831C  
  2606 73BA 0620         DEC  @STREND           POINT AT LEADING LENGTH BYTE  

 99/4 ASSEMBLER
STRINGS                                                      PAGE 0060
       73BC 831A  
  2607 73BE 06A0         BL   @PUTV             PUT THE LEADING LENGTH BYTE IN
       73C0 641E  
  2608 73C2 831A         DATA STREND            THE STRING  
  2609 73C4 0660         DECT @STREND           POINT AT BACKPOINTER  
       73C6 831A  
  2610 73C8 04C6         CLR  R6                ZERO FOR THE BACKPOINTER  
  2611 73CA C060         MOV  @STREND,R1        ADDR OR THE BACKPOINTER   
       73CC 831A  
  2612 73CE 06A0         BL   @STVDP            CLEAR THE BACKPOINTER   
       73D0 18AE  
  2613 73D2 0620         DEC  @STREND           POINT AT 1ST FREE BYTE  
       73D4 831A  
  2614 73D6 045C         B    *R12              ALL DONE  
  2615            ************************************************************
  2616            * COMPCT - Is the string garbage collection routine. It can 
  2617            *          be invoked by GETSTR or MEMCHK. It copies all  
  2618            *          used strings to the top of the string space  
  2619            *          suppressing out all of the unused strings  
  2620            *    INPUT : None   
  2621            *    OUTPUT: UPDATED @STRSP AND @STREND   
  2622            *    USES  : R0-R6 AS TEMPORARIES   
  2623            ************************************************************
  2624 73D8 C1CB  COMPCT MOV  R11,R7            Save rtn address  
  2625 73DA C020         MOV  @FREPTR,R0        Get pointer to free space   
       73DC 8340  
  2626 73DE C160         MOV  @STRSP,R5         Get pointer to string space   
       73E0 8318  
  2627 73E2 C800         MOV  R0,@STRSP         Set new string space pointer  
       73E4 8318  
  2628 73E6 0585         INC  R5                Compensate for decrement  
  2629 73E8 0605  COMP03 DEC  R5                Point at length of string   
  2630 73EA 8160         C    @STREND,R5        At end of string space?   
       73EC 831A  
  2631 73EE 1A03         JL   COMP05            No, check this string for copy
  2632 73F0 C800         MOV  R0,@STREND        Yes, set end of free space  
       73F2 831A  
  2633 73F4 0457         B    *R7               Return to caller  
  2634 73F6 C085  COMP05 MOV  R5,R2             Copy ptr to end in case moved 
  2635 73F8 C0C5         MOV  R5,R3             Copy ptr to end in read length
  2636 73FA 06A0         BL   @GETV1            Read the length byte  
       73FC 1880  
  2637 73FE D181         MOVB R1,R6             Put it in R6 for address  
  2638 7400 0986         SRL  R6,8              Need in LSB for word  
  2639 7402 6146         S    R6,R5             Point at the string start   
  2640 7404 0225         AI   R5,-3             Point at the back pointer   
       7406 FFFD  
  2641 7408 C0C5         MOV  R5,R3             Set up for GETV   
  2642 740A 06A0         BL   @GET1             Get the backpointer   
       740C 6C9E  
  2643 740E C041         MOV  R1,R1             Is this string garbage?   
  2644 7410 13EB         JEQ  COMP03            Yes, just ignore it   
  2645            * PERTINENT REGISTERS AT THIS POINT   
  2646            *        R0 - is where the sting will end   
  2647            *        R6 - # of bytes to be moved(does not)  
  2648            *             include lengths and backpointer   
  2649            *        R2 - points at trailing length byte of string  
  2650            *             to be moved   
  2651            * IN GENERAL : MOVE (R6) BYTES FROM VDP(R2-R6) TO VDP(R0-R6)

 99/4 ASSEMBLER
STRINGS                                                      PAGE 0061
  2652            *              VDP(R0-R6) moving backwards i.e. the last  
  2653            *              byte of the entry is moved first, then the   
  2654            *              next to the last byte...   
  2655 7412 8DB6         C    *R6+,*R6+         INCR by 4 to include overhead 
  2656 7414 C0C2         MOV  R2,R3             Restore ptr to end of string  
  2657 7416 C100         MOV  R0,R4             Get ptr to end of string space
  2658 7418 06A0  COMP10 BL   @GETV1            Read a byte   
       741A 1880  
  2659 741C 06A0         BL   @PUTV1            Write a byte  
       741E 6422  
  2660 7420 0603         DEC  R3                Decrement source pointer  
  2661 7422 0604         DEC  R4                Decrement destination pointer 
  2662 7424 0606         DEC  R6                Decrement the counter   
  2663 7426 15F8         JGT  COMP10            Loop if not finished  
  2664 7428 0244         ANDI R4,>3FFF          Delete VDP write-enable & reg 
       742A 3FFF  
  2665 742C C004         MOV  R4,R0             Set new free space pointer  
  2666 742E 0584         INC  R4                Point at backpointer just move
  2667 7430 C0C4         MOV  R4,R3             Copy pointer to read it   
  2668 7432 06A0         BL   @GET1             Get the backpointer   
       7434 6C9E  
  2669            * R1 now contains the address of the forward pointer  
  2670 7436 C183         MOV  R3,R6             Address of the string entry   
  2671 7438 0226         AI   R6,3              Point at the string itself  
       743A 0003  
  2672            * R6 now contains the address of the string   
  2673 743C 06A0         BL   @STVDP            Reset the forward pointer   
       743E 18AE  
  2674 7440 10D3         JMP  COMP03            Loop for next string  
  2675            ************************************************************
  2676            * NSTRCN - Nud for string constants   
  2677            *          Copies the string into the string space and sets 
  2678            *          up the FAC with a string entry of the following  
  2679            *          form:  
  2680            *   
  2681            * +-------+-----+----+------------+-----------+   
  2682            * | >001C | >65 | XX | Pointer    | Length of |   
  2683            * |       |     |    | to string  | string    |   
  2684            * +-------+-----+----+------------+-----------+   
  2685            * FAC     +2    +3   +4           +6  
  2686            ************************************************************
  2687 7442 06C8  NSTRCN SWPB R8  
  2688 7444 C808         MOV  R8,@FAC6          Save length   
       7446 8350  
  2689 7448 C808         MOV  R8,@BYTE          For GETSTR  
       744A 830C  
  2690 744C 06C8         SWPB R8  
  2691 744E 06A0         BL   @GETSTR           Get result string   
       7450 736C  
  2692 7452 0200         LI   R0,>001C          Get address of SREF   
       7454 001C  
  2693 7456 0201         LI   R1,FAC            Optimize to save bytes  
       7458 834A  
  2694 745A CC40         MOV  R0,*R1+           Indicate temporary string   
  2695 745C DC60         MOVB @CBH65,*R1+       Indicate a string   
       745E 65A7  
  2696 7460 DC40         MOVB R0,*R1+           Byte is not used  
  2697 7462 C460         MOV  @SREF,*R1         Save pointer to string  
       7464 831C  

 99/4 ASSEMBLER
STRINGS                                                      PAGE 0062
  2698 7466 C0A0         MOV  @BYTE,R2          Get number of bytes to copy in
       7468 830C  
  2699 746A 1318         JEQ  NSTR20            If none to copy   
  2700 746C C111         MOV  *R1,R4            Get pointer to destination  
  2701 746E C0E0         MOV  @PGMPTR,R3        Get pointer to source   
       7470 832C  
  2702 7472 D020         MOVB @RAMFLG,R0        ERAM or VDP?  
       7474 8389  
  2703 7476 1609         JNE  NSTR10            ERAM  
  2704            * Get the string from VDP   
  2705 7478 06A0  NSTR05 BL   @GETV1            Get a byte  
       747A 1880  
  2706 747C 06A0         BL   @PUTV1            Put a byte  
       747E 6422  
  2707 7480 0583         INC  R3                Next in source  
  2708 7482 0584         INC  R4                Next in destination   
  2709 7484 0602         DEC  R2                1 less to move  
  2710 7486 16F8         JNE  NSTR05            If more to move, do it  
  2711 7488 1009         JMP  NSTR20            Else if done, exit  
  2712 748A D7E0  NSTR10 MOVB @R4LB,*R15        Write 2nd byte of VDP address 
       748C 83E9  
  2713 748E 0264         ORI  R4,WRVDP          Enable VDP write  
       7490 4000  
  2714 7492 D7C4         MOVB R4,*R15           Write 1st byte of VDP address 
  2715 7494 D833  NSTR15 MOVB *R3+,@XVDPWD      Move byte from ERAM to VDP  
       7496 8C00  
  2716 7498 0602         DEC  R2                1 less to move  
  2717 749A 16FC         JNE  NSTR15            If ont done, loop for more  
  2718 749C A820  NSTR20 A    @FAC6,@PGMPTR     Skip the string   
       749E 8350  
       74A0 832C  
  2719 74A2 06A0         BL   @PGMCHR           Get character following string
       74A4 6C74  
  2720 74A6 0460         B    @CONT             And continue on   
       74A8 64C8  
  2721            ************************************************************
  2722 74AA              AORG >74AA   
  2724                
  2725            ************************************************************
  2726            * CIF     - Convert integer to floating   
  2727            *           Assume that the value in the FAC is an integer  
  2728            *            and converts it into an 8 byte floating point  
  2729            *            value  
  2730            ************************************************************
  2731 74AA 0204  CIF    LI   R4,FAC            Will convert into the FAC   
       74AC 834A  
  2732 74AE C014         MOV  *R4,R0            Get integer into register   
  2733 74B0 C184         MOV  R4,R6             Copy pointer to FAC to clear i
  2734 74B2 04F6         CLR  *R6+              Clear FAC & FAC+1   
  2735 74B4 04F6         CLR  *R6+              In case had a string in FAC   
  2736 74B6 C140         MOV  R0,R5             Is integer equal to zero?   
  2737 74B8 1323         JEQ  CIFRT             Yes, zero result and return   
  2738 74BA 0740         ABS  R0                Get ABS value of ARG  
  2739 74BC 0203         LI   R3,>40            Get exponent bias   
       74BE 0040  
  2740 74C0 04F6         CLR  *R6+              Clear words in result that  
  2741 74C2 04D6         CLR  *R6                might not get a value  
  2742 74C4 0280         CI   R0,100            Is integer less than 100?   
       74C6 0064  

 99/4 ASSEMBLER
CIFS                                                         PAGE 0063
  2743 74C8 1A13         JL   CIF02             Yes, just put in 1st fraction 
  2744            *                              part   
  2745 74CA 0280         CI   R0,10000          No, is ARG less then 100^2?   
       74CC 2710  
  2746 74CE 1A08         JL   CIF01             Yes, just 1 division necessary
  2747            *                             No, 2 divisions are necessary 
  2748 74D0 0583         INC  R3                Add 1 to exponent for 1st   
  2749 74D2 C040         MOV  R0,R1             Put # in low order word for th
  2750            *                              divide   
  2751 74D4 04C0         CLR  R0                Clear high order word for the 
  2752            *                              divide   
  2753 74D6 3C20         DIV  @C100,R0          Divide by the radix   
       74D8 6008  
  2754 74DA D920         MOVB @R1LB,@3(R4)  ~@  Move the radix digit in   
       74DC 83E3  
       74DE 0003  
  2755 74E0 0583  CIF01  INC  R3                Add 1 to exponent for divide  
  2756 74E2 C040         MOV  R0,R1             Put in low order for divide   
  2757 74E4 04C0         CLR  R0                Clear high order for divide   
  2758 74E6 3C20         DIV  @C100,R0          Divide by the radix   
       74E8 6008  
  2759 74EA D920         MOVB @R1LB,@2(R4)  ~@  Put next radix digit in   
       74EC 83E3  
       74EE 0002  
  2760 74F0 D920  CIF02  MOVB @R0LB,@1(R4)  ~@  Put highest order radix digit 
       74F2 83E1  
       74F4 0001  
  2761 74F6 D520         MOVB @R3LB,*R4         Put exponent in   
       74F8 83E7  
  2762 74FA 0545         INV  R5                Is result positive?   
  2763 74FC 1101         JLT  CIFRT             Yes, sign is correct  
  2764 74FE 0514         NEG  *R4               No, make it negative  
  2765 7500 045B  CIFRT  RT   
  2766            ************************************************************
  2767                
  2768 7502              AORG >7502   
  2770                
  2771 7502 A000  CONTAD DATA >A000             Address of a continue stmt  
  2772      A026  GPLIST EQU  >A026             GPL subprogram linked list  
  2773                
  2774      00C8  UNQSTZ EQU  >C8               Unquoted string token   
  2775                
  2776 7504 8000  INUSE  DATA >8000             In-use flag   
  2777 7506 4000  FNCFLG DATA >4000             User-defined function flag  
  2778 7508 2000  SHRFLG DATA >2000             Shared-value flag   
  2779            *   
  2780            * ERROR CODES   
  2781            *   
  2782      1203  ERRSND EQU  >1203             * SUBEND NOT IN SUBPROGRAM  
  2783      0F03  ERRREC EQU  >0F03             * RECURSIVE SUBPROGRAM CALL   
  2784      0E03  ERRIAL EQU  >0E03             * INCORRECT ARGUMENT LIST   
  2785      1103  ERROLP EQU  >1103             * ONLY LEGAL IN A PROGRAM   
  2786                
  2787            ************************************************************
  2788            * CALL - STATEMENT EXECUTION  
  2789            * Finds the subprogram specified in the subprogram table,   
  2790            * evaluates and assigns any arguments to the formal   
  2791            * parameters, builds the stack block, and transfers control 
  2792            * into the subprogram.  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0064
  2793            *  General register usage:  
  2794            *     R0 - R6 Temporaries   
  2795            *     R7      Pointer into formals in subprogram name entry 
  2796            *     R8      Character returned by PGMCHR  
  2797            *     R9      Subroutine stack  
  2798            *     R10     Temporary   
  2799            *     R11     Return link   
  2800            *     R12     Temporary   
  2801            *     R13     GROM read-data address  
  2802            *     R14     Interpreter flags   
  2803            *     R15     VDP write-address address   
  2804            ************************************************************
  2805 750A 06A0  CALL   BL   @PGMCHR           Skip UNQSTZ & get name length 
       750C 6C74  
  2806 750E D808         MOVB R8,@FAC15         Save lengthfor FBS  
       7510 8359  
  2807 7512 D108         MOVB R8,R4             For the copies to be made   
  2808 7514 0984         SRL  R4,8               below  
  2809 7516 C020         MOV  @PGMPTR,R0        Get pointer to name   
       7518 832C  
  2810 751A D060         MOVB @RAMFLG,R1        ERAM or VDP?  
       751C 8389  
  2811 751E 130D         JEQ  CALL04            VDP   
  2812            * ERAM, must copy into VDP  
  2813 7520 C140         MOV  R0,R5             Pointer to string in ERAM   
  2814 7522 0200         LI   R0,CRNBUF         Destination in VDP  
       7524 0820  
  2815 7526 C0C4         MOV  R4,R3             Length for this move  
  2816 7528 D7E0         MOVB @R0LB,*R15        Load out the VDP write address
       752A 83E1  
  2817 752C 0260         ORI  R0,WRVDP          Enable the VDP write  
       752E 4000  
  2818 7530 D7C0         MOVB R0,*R15           Second byte of VDP write  
  2819 7532 D835  CALL02 MOVB *R5+,@XVDPWD      Move a byte   
       7534 8C00  
  2820 7536 0603         DEC  R3                One less byte to move   
  2821 7538 16FC         JNE  CALL02            Loop if not done  
  2822 753A A804  CALL04 A    R4,@PGMPTR        Skip over the name  
       753C 832C  
  2823 753E 0201         LI   R1,FAC            Destination in CPU  
       7540 834A  
  2824 7542 D7E0         MOVB @R0LB,*R15        Load out VDP read address   
       7544 83E1  
  2825 7546 0240         ANDI R0,>3FFF          Kill VDP write-enable   
       7548 3FFF  
  2826 754A D7C0         MOVB R0,*R15           Both bytes  
  2827 754C 1000         NOP                    Don't go to fast for it   
  2828 754E DC60  CALL06 MOVB @XVDPRD,*R1+      Move a byte   
       7550 8800  
  2829 7552 0604         DEC  R4                One less bye to move  
  2830 7554 16FC         JNE  CALL06            Loop if not done  
  2831 7556 C120         MOV  @SUBTAB,R4        Get beginning of subpgm table 
       7558 833A  
  2832 755A 133C         JEQ  SCAL89            If table empty, search in GPL 
  2833 755C 06A0         BL   @FBS001           Search subprogram table   
       755E 15E6  
  2834 7560 75D4         DATA SCAL89            If not found, search in GPL   
  2835            * Pointer to table entry returned in both R4 and FAC  
  2836 7562 06A0         BL   @PGMCHR           Get next token  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0065
       7564 6C74  
  2837 7566 C0C4         MOV  R4,R3             Duplicate pointer for GETV  
  2838 7568 06A0         BL   @GETV1            Get flag byte   
       756A 1880  
  2839 756C 1130         JLT  SCAL90            If attempted recursive call   
  2840 756E 0A11         SLA  R1,1              Check for BASIC/GPL program   
  2841 7570 1106         JLT  GPLSU             GPL subprogram  
  2842 7572 D2E0         MOVB @PRGFLG,R11       Imperative call to BASIC sub? 
       7574 8344  
  2843 7576 1614         JNE  SCAL01            No, OK-handle BASIC subprogram
  2844 7578 0200         LI   R0,ERROLP         Can't call a BASIC sub  
       757A 1103  
  2845 757C 102D         JMP  SCAL91              imperatively  
  2846            *   
  2847            * Handle a GPL subprogram   
  2848            *   
  2849 757E 05C9  GPLSU  INCT R9  
  2850 7580 CE60         MOV  @CONTAD,*R9+      Put address of a cont on stack
       7582 7502  
  2851 7584 C64D         MOV  R13,*R9           Save address for real BASIC   
  2852 7586 0223         AI   R3,6              Now set up new environment  
       7588 0006  
  2853 758A 06A0         BL   @GET1             Get access address of GPL subp
       758C 6C9E  
  2854 758E DB41         MOVB R1,@GRMWAX(R13)    Load out the address into GRO
       7590 0402  
  2855 7592 06C1         SWPB R1                Need to kill time here  
  2856 7594 DB41         MOVB R1,@GRMWAX(R13)    Next byte also   
       7596 0402  
  2857 7598 06A0         BL   @SAVREG           Restore registers to GPL  
       759A 1E8C  
  2858 759C 0460         B    @RESET            And enter the routine   
       759E 006A  
  2859            *   
  2860            * Execute BASIC subprogram  
  2861            *   
  2862      75A0  SCAL01 EQU  $   
  2863            *-----------------------------------------------------------
  2864            * Fix "An error happened in a CALL statement keeps its  
  2865            *      in-use flag set" bug.  5/12/81   
  2866            *  Move the following 3 lines after finishing processing  
  2867            *  the parameter list, before entering the subprogram.  
  2868            *        SRL  R1,1             Restore mode to original form
  2869            *        SOCB @INUSE,R1        Set the in-use flag bit  
  2870            *        BL   @PUTV1           Put the byte back  
  2871            * Save the pointer to table entry for setting in-use flag   
  2872            * later.  
  2873            * $$$$$$$ USE VDP(0374) 2 BYTES AS TEMPRORARY HERE  
  2874 75A0 0204         LI   R4,>0374          R4: address register for PUT1 
       75A2 0374  
  2875 75A4 C043         MOV  R3,R1             R1: data register for PUT1  
  2876 75A6 06A0         BL   @PUT1             Save the pointer to table   
       75A8 6CB2  
  2877            *                              entry in VDP temporary   
  2878            *-----------------------------------------------------------
  2879 75AA C303         MOV  R3,R12            Save subtable address   
  2880 75AC 04E0         CLR  @FAC2             Indicate non-special entry  
       75AE 834C  
  2881 75B0 06A0         BL   @VPUSH            Push subprogram entry on stack

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0066
       75B2 6BAA  
  2882 75B4 C10C         MOV  R12,R4            Restore sub table address   
  2883 75B6 C1C4         MOV  R4,R7   
  2884 75B8 0227         AI   R7,6              Point to 1st argument in list 
       75BA 0006  
  2885 75BC C0C7         MOV  R7,R3             Formals' pointer  
  2886 75BE 06A0         BL   @GET1             Check to see if any   
       75C0 6C9E  
  2887 75C2 C041         MOV  R1,R1             Any args?   
  2888 75C4 133F         JEQ  SCAL32            None, jump forward  
  2889 75C6 0288         CI   R8,LPARZ*256      Must see a left parenthesis   
       75C8 B700  
  2890 75CA 1640         JNE  SCAL34            If not, error   
  2891 75CC 1013         JMP  SCAL08            Jump into argument loop   
  2892 75CE 0200  SCAL90 LI   R0,ERRREC         * RECURSIVE SUBPROGRAM CALL   
       75D0 0F03  
  2893 75D2 1002         JMP  SCAL91  
  2894 75D4 0200  SCAL89 LI   R0,>000A          GPL check for DSR subprogram  
       75D6 000A  
  2895 75D8 0460  SCAL91 B    @ERR  
       75DA 6652  
  2896 75DC 1031  SCAL93 JMP  SCAL12            Going down!   
  2897 75DE 06A0  SCAL05 BL   @POPSTK           Short stack pop routine   
       75E0 60D4  
  2898 75E2 C1E0         MOV  @ARG4,R7          To quickly restore R7   
       75E4 8360  
  2899 75E6 05C7         INCT R7                To account for SCAL80   
  2900 75E8 0288  SCAL06 CI   R8,RPARZ*256      Actual list ended?  
       75EA B600  
  2901 75EC 132D         JEQ  SCAL30            Actuals all scanned   
  2902 75EE 0288         CI   R8,COMMAZ*256     Must see a comma then   
       75F0 B300  
  2903 75F2 1626         JNE  SCAL12            Didn't, so error  
  2904            * Scan next actual. Check if it is just a name  
  2905 75F4 C820  SCAL08 MOV  @PGMPTR,@ERRCOD   Save text ptr in case of expr 
       75F6 832C  
       75F8 8322  
  2906 75FA 06A0         BL   @PGMCHR           Get next character  
       75FC 6C74  
  2907 75FE 1179         JLT  SCAL40            No, so must be an expression  
  2908 7600 C307         MOV  R7,R12            Save formals pointer  
  2909 7602 06A0         BL   @SYM              Read name & see if recognized 
       7604 6312  
  2910 7606 06A0         BL   @GETV             Check function flag   
       7608 187C  
  2911 760A 834A         DATA FAC   
  2912 760C C1CC         MOV  R12,R7            Restore formals pointer first 
  2913 760E 2460         CZC  @FNCFLG,R1        User-defined function?  
       7610 7506  
  2914 7612 166F         JNE  SCAL40            Yes, pass by value  
  2915 7614 0288         CI   R8,LPARZ*256      Complex type?   
       7616 B700  
  2916 7618 1620         JNE  SCAL15            No  
  2917 761A 06A0         BL   @PGMCHR           Check if formal entry   
       761C 6C74  
  2918 761E 0288         CI   R8,RPARZ*256      FOO() ?   
       7620 B600  
  2919 7622 1319         JEQ  SCAL14            Yes, handle it as such  
  2920 7624 0288         CI   R8,COMMAZ*256     or FOO(,...) ?  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0067
       7626 B300  
  2921 7628 1613         JNE  SCAL35            No, an array element FOO(I... 
  2922 762A 06A0  SCAL10 BL   @PGMCHR           Formal array, scan to end   
       762C 6C74  
  2923 762E 06A0         BL   @EOSTMT           Check if end-of-statement   
       7630 6862  
  2924 7632 1306         JEQ  SCAL12            Premature end of statement  
  2925 7634 0288         CI   R8,COMMAZ*256     Another comma?  
       7636 B300  
  2926 7638 13F8         JEQ  SCAL10            Yes, continue on to end   
  2927 763A 0288         CI   R8,RPARZ*256      End yet?  
       763C B600  
  2928 763E 130B         JEQ  SCAL14            Yes, merge in below   
  2929 7640 0460  SCAL12 B    @ERRONE           * SYNTAX ERROR  
       7642 664E  
  2930 7644 0460  SCAL32 B    @SCAL62           Going down!   
       7646 77B8  
  2931 7648 0460  SCAL30 B    @SCAL60   
       764A 77B4  
  2932 764C 0460  SCAL34 B    @SCAL88   
       764E 7878  
  2933 7650 0460  SCAL35 B    @SCAL50   
       7652 7744  
  2934 7654 10C9  SCAL37 JMP  SCAL06  
  2935            *   
  2936            * Here for Scalers/Arrays by Reference  
  2937 7656 06A0  SCAL14 BL   @PGMCHR           Pass the right parenthesis  
       7658 6C74  
  2938 765A 0288  SCAL15 CI   R8,COMMAZ*256     Just a name?  
       765C B300  
  2939 765E 1303         JEQ  SCAL16            Yes   
  2940 7660 0288         CI   R8,RPARZ*256      Start an expression?  
       7662 B600  
  2941 7664 1646         JNE  SCAL40            Yes, name starts an expression
  2942 7666 06A0  SCAL16 BL   @GETV             Get mode of name  
       7668 187C  
  2943 766A 834A         DATA FAC               Ptr to s.t. entry left by SYM 
  2944 766C D081         MOVB R1,R2             Save for check below  
  2945 766E 06A0         BL   @SCAL80           And fetch next formal info  
       7670 787E  
  2946 7672 D042         MOVB R2,R1             Copy for this check   
  2947 7674 0241         ANDI R1,>C700            for the comparison  
       7676 C700  
  2948 7678 C006         MOV  R6,R0             Use a temporary rgister   
  2949 767A 0240         ANDI R0,>C700            for the comparison  
       767C C700  
  2950 767E 8001         C    R1,R0             Must be exact match   
  2951 7680 16E5         JNE  SCAL34            Else can't pass by reference  
  2952 7682 E1A0         SOC  @SHRFLG,R6        Set the shared symbol flag  
       7684 7508  
  2953 7686 D046         MOVB R6,R1             Load up for PUTV  
  2954 7688 C105         MOV  R5,R4             Address to put the flag   
  2955 768A 06A0         BL   @PUTV1            Set the flag in the s.t. entry
       768C 6422  
  2956 768E 0244         ANDI R4,>3FFF          Kill VDP write-enable bit   
       7690 3FFF  
  2957            *   
  2958            * The following section finds actual's value space address  
  2959            *  and puts it in R1.   

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0068
  2960            *  FAC contains the symbol table's address.   
  2961            * If actual is NOT shared.......................  
  2962            *  Symbol table's address+6 will point to the value space   
  2963            *   except for numeric ERAM cae. In a numeric ERAM case   
  2964            *   GET1 to get pointer to the ERAM value space.  
  2965            * If actual is SHARED........................   
  2966            *  GET1 to get the pointer in symbol table's address+6  
  2967            *  In a numeric ERAM case, GETG to get the indirect point   
  2968            *   to the actual's vlaue space pointer after GET1 is call  
  2969            *   
  2970 7692 C060         MOV  @FAC,R1           Ptr to actual s.t. entry  
       7694 834A  
  2971 7696 0221         AI   R1,6              Ptr to actuals value space  
       7698 0006  
  2972 769A 0246         ANDI R6,>8700          Keep info on string or array  
       769C 8700  
  2973 769E 0242         ANDI R2,>2000          Is actual shared?   
       76A0 2000  
  2974 76A2 130C         JEQ  SCAL23            No, use it  
  2975 76A4 C0C1         MOV  R1,R3             Else look further   
  2976 76A6 06A0         BL   @GET1             Get the true pointer  
       76A8 6C9E  
  2977 76AA D186         MOVB R6,R6             Array or string?  
  2978 76AC 160F         JNE  SCAL24            Yes, both are special cases   
  2979 76AE D0A0         MOVB @RAMTOP,R2        ERAM present?   
       76B0 8384  
  2980 76B2 130C         JEQ  SCAL24            No ERAM, so skip  
  2981            * Numeric variable, shared, ERAM.   
  2982 76B4 C0C1         MOV  R1,R3             Get ptr to original from ERAM 
  2983 76B6 06A0         BL   @GETG2            Get indirect pointer  
       76B8 6CCE  
  2984 76BA 1008         JMP  SCAL24  
  2985            * Shared bit is NOT on.   
  2986 76BC D186  SCAL23 MOVB R6,R6             Check for array or string   
  2987 76BE 1606         JNE  SCAL24            Yes, take what's in there   
  2988 76C0 D0A0         MOVB @RAMTOP,R2        ERAM exists?  
       76C2 8384  
  2989 76C4 1303         JEQ  SCAL24            No  
  2990 76C6 C0C1         MOV  R1,R3             Numeric and ERAM case   
  2991 76C8 06A0         BL   @GET1             Get ERAM value space address  
       76CA 6C9E  
  2992            *                             R4 pointing to value space of 
  2993 76CC 0224  SCAL24 AI   R4,6               subprogram's symbol table  
       76CE 0006  
  2994 76D0 D186         MOVB R6,R6             Array or string case?   
  2995 76D2 160C         JNE  SCAL26            Yes, so just put ptr in VDP   
  2996            * Here check for ERAM program and if ERAM then copy the   
  2997            * address of shared value space into corresponding value  
  2998            * space in ERAM   
  2999 76D4 D1A0         MOVB @RAMTOP,R6        Get the ERAM flag   
       76D6 8384  
  3000 76D8 1309         JEQ  SCAL26            If no ERAM, simple case   
  3001 76DA C181         MOV  R1,R6             Keep shared value space addres
  3002 76DC C0C4         MOV  R4,R3             Put ptr in value space in ERAM
  3003 76DE 06A0         BL   @GET1             Get value space address in ERA
       76E0 6C9E  
  3004 76E2 C101         MOV  R1,R4             Copy address into R4 for PUTG2
  3005 76E4 C046         MOV  R6,R1             Get the value to put in ERAM  
  3006 76E6 06A0         BL   @PUTG2            Write it into ERAM  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0069
       76E8 6CD8  
  3007 76EA 10B4         JMP  SCAL37            Loop for next argument  
  3008 76EC 06A0  SCAL26 BL   @PUT1             Set symbol indirect link  
       76EE 6CB2  
  3009 76F0 10B1         JMP  SCAL37            And loop for next arg   
  3010            *   
  3011            * Here to pass an expression by value   
  3012            *   
  3013 76F2 C820  SCAL40 MOV  @ERRCOD,@PGMPTR   Restore text pointer  
       76F4 8322  
       76F6 832C  
  3014 76F8 C807         MOV  R7,@FAC4          Save formals pointer  
       76FA 834E  
  3015 76FC 04E0         CLR  @FAC2             Don't let VPUSH mess up   
       76FE 834C  
  3016 7700 06A0  SCAL42 BL   @PGMCHR           Set up for the parse  
       7702 6C74  
  3017            * Save formals ptr & SUBTAB ptr and evaluate the expression 
  3018 7704 06A0         BL   @PSHPRS   
       7706 6B9C  
  3019 7708   B6         BYTE RPARZ             Stop on an rpar or comma  
  3020 7709   6A  DCBH6A BYTE >6A               (CBH6A copy)  
  3021 770A 06A0         BL   @POPSTK           Restore formals pointer   
       770C 60D4  
  3022 770E A820         A    @C16,@VSPTR       But keep it on stack  
       7710 6BF8  
       7712 836E  
  3023 7714 06A0         BL   @VPUSH            Save parse result   
       7716 6BAA  
  3024 7718 C1E0         MOV  @ARG4,R7          Restore formals pointer   
       771A 8360  
  3025 771C 06A0         BL   @SCAL80           And fetch next formal's info  
       771E 787E  
  3026 7720 C805         MOV  R5,@FAC           Set up for assignment   
       7722 834A  
  3027 7724 06A0         BL   @SMB              Get value space   
       7726 61DC  
  3028 7728 6820         S    @C16,@VSPTR       Get to s.t. info  
       772A 6BF8  
       772C 836E  
  3029 772E 06A0         BL   @VPUSH            Set up for ASSG   
       7730 6BAA  
  3030 7732 A820         A    @C8,@VSPTR        Get back to parse result  
       7734 706C  
       7736 836E  
  3031 7738 06A0         BL   @VPOP             Get parse result back   
       773A 6C2A  
  3032 773C 06A0         BL   @ASSG             Assign the value to the formal
       773E 6334  
  3033 7740 0460         B    @SCAL05           And go back for more  
       7742 75DE  
  3034            *   
  3035            * Here for array elements   
  3036            *   
  3037 7744 0620  SCAL50 DEC  @PGMPTR           Restore text pointer to lpar  
       7746 832C  
  3038 7748 020B         LI   R11,FAC2          Optimize to save  
       774A 834C  
  3039 774C 04FB         CLR  *R11+             Don't let VPUSH mess up (FAC2)

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0070
  3040 774E CEC7         MOV  R7,*R11+          Save formals pointer    (FAC4)
  3041 7750 C6E0         MOV  @ERRCOD,*R11      For save on stack       (FAC6)
       7752 8322  
  3042 7754 06A0         BL   @VPUSH            Save the info   
       7756 6BAA  
  3043 7758 0208         LI   R8,LPARZ*256      Load up R8 with the lpar again
       775A B700  
  3044 775C C820         MOV  @FAC,@PAD         Save ptr to s.t. entry  
       775E 834A  
       7760 8300  
  3045 7762 06A0         BL   @SMB              Check if name or expression   
       7764 61DC  
  3046 7766 0288         CI   R8,COMMAZ*256   
       7768 B300  
  3047 776A 1309         JEQ  SCAL54            Name if ended on a comma  
  3048 776C 0288         CI   R8,RPARZ*256  
       776E B600  
  3049 7770 1306         JEQ  SCAL54             or rpar  
  3050 7772 06A0         BL   @VPOP             Get saved info back   
       7774 6C2A  
  3051 7776 C820         MOV  @FAC6,@PGMPTR     Else expr, Restore test pointe
       7778 8350  
       777A 832C  
  3052 777C 10C1         JMP  SCAL42            And handle like an expression 
  3053            *   
  3054            * Passing array elements by reference   
  3055 777E 06A0  SCAL54 BL   @POPSTK           Restore symbol pointer  
       7780 60D4  
  3056 7782 C1E0         MOV  @ARG4,R7  
       7784 8360  
  3057 7786 06A0         BL   @SCAL80           Get next formal's info  
       7788 787E  
  3058 778A 06A0         BL   @GETV             Check actualOs mode   
       778C 187C  
  3059 778E 8300         DATA PAD               Get back header information   
  3060 7790 0241         ANDI R1,>C000          Throw away all but string & fu
       7792 C000  
  3061 7794 9046         CB   R6,R1             Check mode match (string/num) 
  3062 7796 1612         JNE  JNE88             Don't, so error   
  3063            * Can set bit in R1 since MSB (R1)=MSB (R6)   
  3064 7798 F060         SOCB @SHRFLG,R1        Set the share flag  
       779A 7508  
  3065 779C C105         MOV  R5,R4             Address for PUTV  
  3066 779E 06A0         BL   @PUTV1            Put it in the s.t. entry  
       77A0 6422  
  3067 77A2 0244         ANDI R4,>3FFF          Kill VDP write, enable bit  
       77A4 3FFF  
  3068 77A6 C060         MOV  @FAC,R1           Assuming string, ref link=@FAC
       77A8 834A  
  3069 77AA D186         MOVB R6,R6             Check if it is a string   
  3070 77AC 118F         JLT  SCAL24            If so, go set ref. link   
  3071 77AE C060         MOV  @FAC4,R1          Numeric, ref. link=@FAC4(v.s.)
       77B0 834E  
  3072 77B2 108C         JMP  SCAL24            Now set the link and go on  
  3073            *   
  3074            * Here when done parsing actuals  
  3075            *   
  3076 77B4 06A0  SCAL60 BL   @PGMCHR           Pass the right parenthesis  
       77B6 6C74  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0071
  3077 77B8 06A0  SCAL62 BL   @EOSTMT           Must be at end of statement   
       77BA 6862  
  3078 77BC 165D  JNE88  JNE  SCAL88            If not, error   
  3079 77BE C0C7         MOV  R7,R3             Formals must also have ended  
  3080 77C0 05C7         INCT R7  
  3081 77C2 C807         MOV  R7,@FAC           Keep R7, POPSTK destorys R7   
       77C4 834A  
  3082 77C6 06A0         BL   @GET1             Get the last arg address  
       77C8 6C9E  
  3083 77CA C041         MOV  R1,R1             Formals end?  
  3084 77CC 1655         JNE  SCAL88            Didn't, so error  
  3085            *   
  3086            * Now set up the stack entry  
  3087            *   
  3088 77CE 06A0         BL   @VPUSH            Check if enough room for push 
       77D0 6BAA  
  3089 77D2 6820         S    @C8,@VSPTR        Get back right pointer  
       77D4 706C  
       77D6 836E  
  3090 77D8 06A0         BL   @POPSTK           Retrieve ptr to subprog s.t.  
       77DA 60D4  
  3091 77DC 020C         LI   R12,FAC           For code optimization   
       77DE 834A  
  3092 77E0 C04C         MOV  R12,R1            Store following data in FAC   
  3093 77E2 C81C         MOV  *R12,@ARG2        Save new environment pointer  
       77E4 835E  
  3094            *   
  3095            * First push entry. PGMCHR, EXTRAM, SYMTAB and RAM(SYNBOL)  
  3096            *   
  3097 77E6 0200         LI   R0,PGMPTR         Optimize  
       77E8 832C  
  3098 77EA CC70         MOV  *R0+,*R1+         Text pointer         PGMPTR   
  3099 77EC CC70         MOV  *R0+,*R1+         Line table pointer   EXTRAM   
  3100 77EE CC60         MOV  @SYMTAB,*R1+      Symbol table pointer  
       77F0 833E  
  3101 77F2 0203         LI   R3,SYMBOL         Put address of SYMBOL   
       77F4 0376  
  3102 77F6 06A0         BL   @GET1             Get RAM(SYMBOL) in REG1   
       77F8 6C9E  
  3103 77FA C801         MOV  R1,@FAC6          Move to FAC area  
       77FC 8350  
  3104 77FE 06A0         BL   @VPUSH            Save first entry  
       7800 6BAA  
  3105            *   
  3106            * Push second entry. Subprogram table pointer, >6A on warnin
  3107            *  bits and @LSUBP in the second stack.   
  3108 7802 C10C         MOV  R12,R4            Going to build entry in FAC   
  3109 7804 CD20         MOV  @ARG,*R4+         Subprogram table entry pointer
       7806 835C  
  3110 7808 DD20         MOVB @DCBH6A,*R4+      >6A = Stack ID  
       780A 7709  
  3111 780C D0A0         MOVB @FLAG,R2          Warning/break bits  
       780E 8345  
  3112 7810 0242         ANDI R2,>0600          Mask off other bits   
       7812 0600  
  3113 7814 DD02         MOVB R2,*R4+           Put bits in stack entry   
  3114 7816 C820         MOV  @LSUBP,@FAC6      Last subprogram block on stack
       7818 8348  
       781A 8350  

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0072
  3115 781C 06A0         BL   @VPUSH            Push final entry  
       781E 6BAA  
  3116 7820 C820         MOV  @VSPTR,@LSUBP     Set bottom of stack for the su
       7822 836E  
       7824 8348  
  3117            *   
  3118            * Now build the new environment by modifying PGMCHR,  
  3119            * EXTRAM and pointer to sub's symbol table.   
  3120 7826 0200         LI   R0,PGMPTR         Optimization  
       7828 832C  
  3121 782A D7E0         MOVB @ARG3,*R15        2nd byte of address   
       782C 835F  
  3122 782E 0201         LI   R1,XVDPRD         Optimize to save bytes  
       7830 8800  
  3123 7832 D7E0         MOVB @ARG2,*R15        1st byte of address   
       7834 835E  
  3124 7836 0204         LI   R4,4              Need 4 bytes  
       7838 0004  
  3125 783A DC11  SCAL70 MOVB *R1,*R0+          Read EXTRAM and PGMPTR  
  3126 783C 0604         DEC  R4  
  3127 783E 16FD         JNE  SCAL70  
  3128 7840 D811         MOVB *R1,@SYMTAB       New SYMTAB  
       7842 833E  
  3129 7844 0204         LI   R4,SYMBOL   
       7846 0376  
  3130 7848 D811         MOVB *R1,@SYMTA1   
       784A 833F  
  3131 784C C060         MOV  @SYMTAB,R1  
       784E 833E  
  3132 7850 06A0         BL   @PUT1             New RAM(SYMBOL)   
       7852 6CB2  
  3133 7854 04E0         CLR  @ERRCOD           Clean up our mess   
       7856 8322  
  3134 7858 06A0         BL   @PGMCHR           Get the next token into R8  
       785A 6C74  
  3135            *-----------------------------------------------------------
  3136            * Fix "A error happened in a CALL statement keeps it  
  3137            *   "in-use flag set" bug,    5/23/81   
  3138            * Insert following lines:   
  3139 785C 0203         LI   R3,>0374          Restore the pointer to table  
       785E 0374  
  3140            *  entry from VDP temporary, R3: address reg. for GET1  
  3141 7860 06A0         BL   @GET1   
       7862 6C9E  
  3142 7864 C0C1         MOV  R1,R3             Get flag byte   
  3143 7866 06A0         BL   @GETV1  
       7868 1880  
  3144 786A F060         SOCB @INUSE,R1         Set the in-use flag bit   
       786C 7504  
  3145 786E C103         MOV  R3,R4             ??????????????????????????????
  3146 7870 06A0         BL   @PUTV1            Put the byte back   
       7872 6422  
  3147            *-----------------------------------------------------------
  3148 7874 0460         B    @NUDEND           Enter the subprogram  
       7876 65F0  
  3149 7878 0200  SCAL88 LI   R0,ERRIAL         * INCORRECT ARGUMENT LIST   
       787A 0E03  
  3150 787C 1062         JMP  $+>C6             Jump to  B @ERR   
  3151            ************************************************************

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0073
  3152            * Fetch next formal and prop for adjustment   
  3153            * Register modification   
  3154            *    R5  Address of s.t. entry (formal's entry)   
  3155            *    R6  Header byte of formal's entry  
  3156            *    R7  Updated formal's pointer   
  3157            * Destroys: R1, R2, R3, R4, R11, R12  
  3158            ************************************************************
  3159 787E C30B  SCAL80 MOV  R11,R12           Save return address   
  3160 7880 C0C7         MOV  R7,R3             Fetch symbol pointer  
  3161 7882 05C7         INCT R7                Point to next formal  
  3162 7884 06A0         BL   @GET1             Fetch s.t. pointer  
       7886 6C9E  
  3163 7888 C0C1         MOV  R1,R3             Set condition & put in place  
  3164 788A 13F6         JEQ  SCAL88            If to many actuals  
  3165 788C C101         MOV  R1,R4             Save for below  
  3166 788E C141         MOV  R1,R5             Save for return   
  3167 7890 06A0         BL   @GET1             Get header bytes  
       7892 6C9E  
  3168 7894 2060         COC  @SHRFLG,R1        Shared?   
       7896 7508  
  3169 7898 1313         JEQ  SCAL82            Yes, reset flag and old value 
  3170 789A C181         MOV  R1,R6             Save for return & test string 
  3171 789C 1101         JLT  SCAL81            If it is a string, then SCAL81
  3172 789E 045C         B    *R12              Return  
  3173 78A0 0223  SCAL81 AI   R3,6              Is string, point at value ptr 
       78A2 0006  
  3174 78A4 06A0         BL   @GET1             Get the value pointer   
       78A6 6C9E  
  3175 78A8 C101         MOV  R1,R4             Null value?   
  3176 78AA 1312         JEQ  SCAL86            Yes   
  3177 78AC 04C1         CLR  R1                No, must free current string  
  3178 78AE 0224         AI   R4,-3             Point at the backpointer  
       78B0 FFFD  
  3179 78B2 06A0         BL   @PUT1             Clear the backpointer   
       78B4 6CB2  
  3180 78B6 C103         MOV  R3,R4   
  3181 78B8 04C1  SCAL84 CLR  R1                Needed for entry from below   
  3182 78BA 06A0         BL   @PUT1             Clear the forward pointer   
       78BC 6CB2  
  3183 78BE 045C         B    *R12              Just return   
  3184 78C0 0241  SCAL82 ANDI R1,>DFFF          Reset the share flag  
       78C2 DFFF  
  3185 78C4 06A0         BL   @PUTV1            Put it there  
       78C6 6422  
  3186 78C8 0224         AI   R4,6              Point at ref pointer  
       78CA 0006  
  3187 78CC C181         MOV  R1,R6             Set for return  
  3188 78CE 11F4         JLT  SCAL84            If string clear ref pointer   
  3189 78D0 045C  SCAL86 B    *R12              Return  
  3190            ************************************************************
  3191            * Execute a SUBEXIT or SUBEND   
  3192            ************************************************************
  3193 78D2 C160  SUBXIT MOV  @LSUBP,R5         Check for subprogram on stack 
       78D4 8348  
  3194 78D6 1333         JEQ  SCAL98            Not one, so error   
  3195 78D8 8805         C    R5,@VSPTR         Extra check on stack pointer  
       78DA 836E  
  3196 78DC 1B30         JH   SCAL98            Pointers are messed up, error 
  3197 78DE 06A0  SBXT05 BL   @VPOP             Get stack entry   

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0074
       78E0 6C2A  
  3198 78E2 9820         CB   @FAC2,@DCBH6A     Reached the subprogram entry? 
       78E4 834C  
       78E6 7709  
  3199 78E8 16FA         JNE  SBXT05            Not yet   
  3200            *   
  3201            * Reached the subprogram stack entry. Get information FAC   
  3202            *  area has subprograms table pointer, >6A, on warning bits 
  3203            *  and LSUBP  
  3204 78EA 020C         LI   R12,FAC           Optimize for the copies   
       78EC 834A  
  3205 78EE C00C         MOV  R12,R0            For this copy   
  3206 78F0 C0F0         MOV  *R0+,R3           Subprogram pointer  
  3207 78F2 06A0         BL   @GETV1            Get header byte in subprogram 
       78F4 1880  
  3208 78F6 5060         SZCB @INUSE,R1         Reset the in-use bit  
       78F8 7504  
  3209 78FA C103         MOV  R3,R4   
  3210 78FC 06A0         BL   @PUTV1            Put it back   
       78FE 6422  
  3211 7900 C070         MOV  *R0+,R1           On warning bits   
  3212 7902 D120         MOVB @FLAG,R4          Get the current flag  
       7904 8345  
  3213 7906 0244         ANDI R4,>F900          Trash current warning bits  
       7908 F900  
  3214 790A F120         SOCB @R1LB,R4          OR the old ones back in   
       790C 83E3  
  3215 790E D804         MOVB R4,@FLAG          And put flag back   
       7910 8345  
  3216 7912 05C0         INCT R0                There is one word empty   
  3217 7914 C830         MOV  *R0+,@LSUBP       Last subprogram block on stack
       7916 8348  
  3218            *   
  3219            * Second subprogram stack entry. Restore pointers. FAC area 
  3220            *  has PGMPTR, EXTRAM, SYMTAB, RAM(SYMBOL)  
  3221 7918 06A0         BL   @VPOP             Get second entry  
       791A 6C2A  
  3222 791C C00C         MOV  R12,R0            Put FAC in R0. (optimization) 
  3223 791E 0201         LI   R1,PGMPTR         For optimization  
       7920 832C  
  3224 7922 C470         MOV  *R0+,*R1          Restore text pointer    PGMPTR
  3225 7924 0631         DEC  *R1+              Save code to decrement it   
  3226 7926 CC70         MOV  *R0+,*R1+         Line table pointer EXTRAM   
  3227 7928 C830         MOV  *R0+,@SYMTAB      Restore symbol table pointer  
       792A 833E  
  3228 792C C070         MOV  *R0+,R1           Restore permanent s.t. pointer
  3229 792E 0204         LI   R4,SYMBOL         Place in VDP  
       7930 0376  
  3230 7932 06A0         BL   @PUT1             Put it out there  
       7934 6CB2  
  3231 7936 06A0         BL   @PGMCHR           Load R8 with EOS/EOL & go on  
       7938 6C74  
  3232 793A 0460         B    @EOL  
       793C 65D6  
  3233 793E 0200  SCAL98 LI   R0,ERRSND         * SUBEND NOT IN SUBPROGRAM  
       7940 1203  
  3234 7942 0460         B    @ERR  
       7944 6652  
  3235            ************************************************************

 99/4 ASSEMBLER
SUBPROGS                                                     PAGE 0075
  3236                
  3237                
  3239                
  3240            ************************************************************
  3241            * RESOLV - Attempt to resolve all subprograms referenced in 
  3242            * call statements by first searching the internal subprogram
  3243            * table (SUBTAB), then by searching GROMs for GPL   
  3244            * subprograms. In RESGPL, it builds a subprogram table.   
  3245            * If, after searching all of the subprogram areas, there  
  3246            * are any subprograms whose location cannot be determined,  
  3247            * an error occurs.  
  3248            ************************************************************
  3249 7946 05C9  RESOLV INCT R9                Save return address   
  3250 7948 C64B         MOV  R11,*R9   
  3251 794A C160         MOV  @CALIST,R5        Pick up call list pointer   
       794C 830A  
  3252 794E 1337         JEQ  RES50             If no subprogram references   
  3253 7950 C1A0  RES03  MOV  @SUBTAB,R6        Pick up subprogram table ptr  
       7952 833A  
  3254 7954 1327  RES05  JEQ  RES15             Try to resolve by checking  
  3255            *   
  3256            * Compares two names for a match when trying to resolve all 
  3257            *  references to subprograms.   
  3258            * Register usage is generally as follows:   
  3259            *         R5  - Pointer to CALIST entry to be compared  
  3260            *         R7  - Pointer to entry to be compared to SUBTAB   
  3261            *               Returns as pointer to name if found or zero 
  3262            *                if not found   
  3263            *         R10 - Returned as length of name  
  3264 7956 C0C6         MOV  R6,R3             Put in place for GETV   
  3265 7958 0583         INC  R3                Point at the name length  
  3266 795A 06A0         BL   @GETV1            Get the name length   
       795C 1880  
  3267 795E 0981         SRL  R1,8              Put in LSB and clear MSB  
  3268 7960 C101         MOV  R1,R4             Save it for the move  
  3269 7962 0223         AI   R3,3              Point at name pointer   
       7964 0003  
  3270 7966 06A0         BL   @GET1             Get the name pointer  
       7968 6C9E  
  3271 796A C1C1         MOV  R1,R7             Save in permanent   
  3272 796C C801         MOV  R1,@PGMPTR        Save for compare  
       796E 832C  
  3273 7970 C0C5         MOV  R5,R3             To get the CALIST entry   
  3274 7972 0583         INC  R3                Point at the name length  
  3275 7974 06A0         BL   @GETV1            Get the name length   
       7976 1880  
  3276 7978 9801         CB   R1,@R4LB          Name length match?  
       797A 83E9  
  3277 797C 161A         JNE  RES20             No, no match possible   
  3278 797E C004         MOV  R4,R0             Save name length for compare  
  3279 7980 0223         AI   R3,3              Point at the name pointer   
       7982 0003  
  3280 7984 06A0         BL   @GET1             Get the pointer to the name   
       7986 6C9E  
  3281 7988 C0C1         MOV  R1,R3             Set up to get the name  
  3282 798A 06A0  COMPTN BL   @GETV1            Get a char of CALIST name   
       798C 1880  
  3283            * Next PGMSUB call is the same as PGMCHR except in skipping 
  3284            *  ERAM check   

 99/4 ASSEMBLER
SUBPROGS2                                                    PAGE 0076
  3285 798E 06A0         BL   @PGMSUB           Get a char of found name  
       7990 6C7A  
  3286 7992 9201         CB   R1,R8             Chars match?  
  3287 7994 160E         JNE  RES20             No, not same name   
  3288 7996 0583         INC  R3                Next character  
  3289 7998 0600         DEC  R0                Done with compare?  
  3290 799A 16F7         JNE  COMPTN            No, check the rest  
  3291            * Found the subprogram in GROM and built the table.   
  3292            * Set resolved flag and get back.   
  3293 799C C105         MOV  R5,R4             Set resolved flag now   
  3294 799E 0701         SETO R1                Set up a resolved flag  
  3295 79A0 06A0         BL   @PUTV1            And put the byte in   
       79A2 6422  
  3296 79A4 C0C5  RES15  MOV  R5,R3             Get call list pointer   
  3297 79A6 05C3         INCT R3                Point at link   
  3298 79A8 06A0         BL   @GET1             Get the name link   
       79AA 6C9E  
  3299 79AC C141         MOV  R1,R5             Save and set condition  
  3300 79AE 130E         JEQ  RESGPL            End of call list? Yes   
  3301 79B0 16CF         JNE  RES03             No, go check the next in list 
  3302 79B2 C0C6  RES20  MOV  R6,R3             Get next entry in subpgm table
  3303 79B4 05C3         INCT R3                Point at the link   
  3304 79B6 06A0         BL   @GET1             Get the link  
       79B8 6C9E  
  3305 79BA C181         MOV  R1,R6             Update subprogram table pointe
  3306 79BC 10CB         JMP  RES05             And try next entry  
  3307 79BE 04C3  RES50  CLR  R3                Indicate no error return  
  3308 79C0 C2D9  RES51  MOV  *R9,R11           Restore return address  
  3309 79C2 0649         DECT R9                Restore stack   
  3310 79C4 045B         RT                     All resolved and ok   
  3311 79C6 0203  RES52  LI   R3,>001C  
       79C8 001C  
  3312 79CA 10FA         JMP  RES51   
  3313            ************************************************************
  3314            *                   RESGPL routine  
  3315            * Resolves as a GPL subprogram by comparing names in CALL   
  3316            * list and GROM link list in EXEC. If name found in GROM  
  3317            * then turn the resolved flag on and if not found an error  
  3318            * occurs. Fetch subprogram access address from the link   
  3319            * list and builds a subprogram table for that call.   
  3320            ************************************************************
  3321 79CC C160  RESGPL MOV  @CALIST,R5        Get the call list pointer   
       79CE 830A  
  3322            * Get the next subprogram in the call list that has not been
  3323            *  resolved.  
  3324 79D0 C0C5  GET01  MOV  R5,R3             Get pointer in call list  
  3325 79D2 13F5         JEQ  RES50             If end of list  
  3326 79D4 06A0         BL   @GETV1            Get the resolved flag   
       79D6 1880  
  3327 79D8 1306         JEQ  GPL00             If not resolved   
  3328 79DA 05C3  GET03  INCT R3                Point at link   
  3329 79DC 06A0         BL   @GET1             Get the link  
       79DE 6C9E  
  3330 79E0 C141         MOV  R1,R5             Save it and set condition   
  3331 79E2 16F6         JNE  GET01             If not end of list, go on   
  3332 79E4 10EC         JMP  RES50             Return  
  3333            * Start looking at GROM subprogram link list.   
  3334 79E6 0207  GPL00  LI   R7,GPLIST         Load address of link list   
       79E8 A026  

 99/4 ASSEMBLER
SUBPROGS2                                                    PAGE 0077
  3335 79EA C0C5         MOV  R5,R3             Copy CALIST address   
  3336 79EC 0583         INC  R3                Point to name length  
  3337 79EE 06A0         BL   @GETV1            Get the name length   
       79F0 1880  
  3338 79F2 0981         SRL  R1,8              Adjust to the right byte  
  3339 79F4 C001         MOV  R1,R0             Copy for later use  
  3340 79F6 04CA         CLR  R10               Clear for name length   
  3341 79F8 0223         AI   R3,3              Point to name ptr in call list
       79FA 0003  
  3342 79FC DB47  GPL10  MOVB R7,@GRMWAX(R13)    Specify address in link list 
       79FE 0402  
  3343 7A00 06C7         SWPB R7                Need to kill time here  
  3344 7A02 DB47         MOVB R7,@GRMWAX(R13)    Move next byte   
       7A04 0402  
  3345 7A06 06C7         SWPB R7                Get R7 in right order   
  3346 7A08 D21D         MOVB *R13,R8           Read next link address from   
  3347 7A0A D81D         MOVB *R13,@R8LB         linked list  
       7A0C 83F1  
  3348 7A0E 05C7         INCT R7                Point to name length in GROM  
  3349 7A10 DB47         MOVB R7,@GRMWAX(R13)    Specify name length address  
       7A12 0402  
  3350 7A14 06C7         SWPB R7                Need to kill time here  
  3351 7A16 DB47         MOVB R7,@GRMWAX(R13)    Move next byte   
       7A18 0402  
  3352 7A1A 06C7         SWPB R7                Get R7 in right order   
  3353 7A1C D81D         MOVB *R13,@R10LB       Get the name length in GROM   
       7A1E 83F5  
  3354 7A20 8280         C    R0,R10            Compare name length   
  3355 7A22 1304         JEQ  GPL25             If matches, compare names   
  3356 7A24 C1C8  GPLNXT MOV  R8,R7             Didn't match, get link to next
  3357 7A26 16EA         JNE  GPL10             Loop if not end of list   
  3358 7A28 C0C5         MOV  R5,R3             If end of GPL list, ignore thi
  3359 7A2A 10D7         JMP  GET03              entry in CALIST  
  3360            * Start comparing the names   
  3361 7A2C 06A0  GPL25  BL   @GET1             Get name ptr form call list   
       7A2E 6C9E  
  3362            *                             R1 contains address of name   
  3363 7A30 D7E0         MOVB @R1LB,*R15        Get one character from VDP  
       7A32 83E3  
  3364 7A34 1000         NOP  
  3365 7A36 D7C1         MOVB R1,*R15           Then compare with the one in  
  3366 7A38 981D  GPL30  CB   *R13,@XVDPRD       GROM - R13 points to GROM  
       7A3A 8800  
  3367 7A3C 16F3         JNE  GPLNXT            If no match get next in GROM  
  3368 7A3E 060A         DEC  R10               All matched?  
  3369 7A40 16FB         JNE  GPL30             No, loop for next characters  
  3370            * Found the GPL subprogram. Now start building GPL's  
  3371            *  subprogram table.  
  3372            * First put all information in FAC since they might get   
  3373            *  destroyed in MEMCHK.   
  3374            * @FAC2  = Set program bit and name length  
  3375            * @FAC4  = Subprogram table link address  
  3376            * @FAC6  = Pointer to name  
  3377            * @FAC8  = Access address in GROM   
  3378            * @FAC10 = Current call list address  
  3379 7A42 020C         LI   R12,FAC2          Optimize for speed and space  
       7A44 834C  
  3380 7A46 C700         MOV  R0,*R12           Keep length in FAC2   
  3381 7A48 EF20         SOC  @FNCFLG,*R12+     Set program bit   

 99/4 ASSEMBLER
SUBPROGS2                                                    PAGE 0078
       7A4A 7506  
  3382 7A4C CF20         MOV  @SUBTAB,*R12+     Set up subtable link address  
       7A4E 833A  
  3383 7A50 06A0         BL   @GET1             Get pointer to name   
       7A52 6C9E  
  3384 7A54 CF01         MOV  R1,*R12+          Move it to FAC6   
  3385 7A56 DF1D         MOVB *R13,*R12+        Get access address from GROM  
  3386 7A58 1000         NOP  
  3387 7A5A DF1D         MOVB *R13,*R12+         and put it in FAC8   
  3388 7A5C C705         MOV  R5,*R12           Save current call list address
  3389            * Check if ERAM exists or imperative statement. If so then  
  3390            * copy name into appropriate VDP area.  
  3391 7A5E D1A0         MOVB @RAMFLG,R6        ERAM present?   
       7A60 8389  
  3392 7A62 1603         JNE  GPL40             Yes, then save name in table  
  3393 7A64 D1A0         MOVB @PRGFLG,R6        Imperative call   
       7A66 8344  
  3394 7A68 1619         JNE  GPL60             No, handle normally   
  3395            * Copy name into table area   
  3396 7A6A C800  GPL40  MOV  R0,@FAC           Copy name length  
       7A6C 834A  
  3397 7A6E 06A0         BL   @MEMCHK           Get the space. FAC = name leng
       7A70 72D8  
  3398 7A72 79C6         DATA RES52             Error return address  
  3399 7A74 C0E0         MOV  @FAC6,R3          Get pointer to name   
       7A76 8350  
  3400 7A78 6820         S    @FAC,@FREPTR      New free pointer  
       7A7A 834A  
       7A7C 8340  
  3401 7A7E C120         MOV  @FREPTR,R4        New place of name   
       7A80 8340  
  3402 7A82 0584         INC  R4  
  3403 7A84 C804         MOV  R4,@FAC6          New pointer to name   
       7A86 8350  
  3404 7A88 C0A0         MOV  @FAC,R2           Counter for the move  
       7A8A 834A  
  3405            * Now copy the name, character by character   
  3406 7A8C 06A0  GPL50  BL   @GETV1            Get a byte  
       7A8E 1880  
  3407 7A90 06A0         BL   @PUTV1            Put a byte  
       7A92 6422  
  3408 7A94 0583         INC  R3  
  3409 7A96 0584         INC  R4  
  3410 7A98 0602         DEC  R2                Done?   
  3411 7A9A 16F8         JNE  GPL50             No, move the rest   
  3412            * Restore all the information from FAC area and build   
  3413            *  subprograms symbol table.  
  3414 7A9C C820  GPL60  MOV  @C8,@FAC          Need 8 bytes  
       7A9E 706C  
       7AA0 834A  
  3415 7AA2 06A0         BL   @MEMCHK           Get the bytes. Check the space
       7AA4 72D8  
  3416 7AA6 79C6         DATA RES52             Error return address  
  3417 7AA8 6820         S    @C8,@FREPTR       Updata the free pointer   
       7AAA 706C  
       7AAC 8340  
  3418 7AAE C020         MOV  @FREPTR,R0        Get location to move to   
       7AB0 8340  
  3419 7AB2 0580         INC  R0                True pointer  

 99/4 ASSEMBLER
SUBPROGS2                                                    PAGE 0079
  3420 7AB4 C800         MOV  R0,@SUBTAB        Update subprogram table ptr   
       7AB6 833A  
  3421 7AB8 0201         LI   R1,FAC2           Subprograms info starts FAC2  
       7ABA 834C  
  3422 7ABC D7E0         MOVB @R0LB,*R15        Load out address  
       7ABE 83E1  
  3423 7AC0 0260         ORI  R0,WRVDP          Enable VDP write  
       7AC2 4000  
  3424 7AC4 D7C0         MOVB R0,*R15   
  3425 7AC6 0200         LI   R0,XVDPWD         Optimize to save bytes  
       7AC8 8C00  
  3426 7ACA 0203         LI   R3,8              Going to move 8 bytes   
       7ACC 0008  
  3427 7ACE D431  GPL70  MOVB *R1+,*R0          Copy mode, name length, link, 
  3428 7AD0 0603         DEC  R3                 ptr to name, ptr to subprogra
  3429 7AD2 16FD         JNE  GPL70   
  3430 7AD4 C0D1         MOV  *R1,R3            Restore ptr into call list  
  3431 7AD6 0460         B    @GET03            Check next entry in call list 
       7AD8 79DA  
  3432            ************************************************************
  3433 7ADA              AORG >7ADA   
  3435                
  3436      0005  FLG    EQU  5   
  3437                
  3438            * R12  total number of bytes to move  
  3439            * R10  move from  
  3440            * R9   move to  
  3441            * R8   minor counter (buffer counter)   
  3442            * R7   buffer pointer   
  3443                
  3444 7ADA 020C  SCROLL LI   R12,736           Going to move 736 bytes   
       7ADC 02E0  
  3445 7ADE 020A         LI   R10,32            Address to move from  
       7AE0 0020  
  3446 7AE2 04C9         CLR  R9                Address to move to  
  3447 7AE4 C18B         MOV  R11,R6            Save return address   
  3448 7AE6 06A0         BL   @SCRO1            Scroll the screen   
       7AE8 7B10  
  3449 7AEA 0205         LI   R5,XVDPWD         Optimize for speed later  
       7AEC 8C00  
  3450 7AEE 0204         LI   R4,>02E0          Addr of bottom line on screen 
       7AF0 02E0  
  3451 7AF2 0201         LI   R1,>7F80          Edge character and space char 
       7AF4 7F80  
  3452 7AF6 0202         LI   R2,28             28 characters on bottom line  
       7AF8 001C  
  3453 7AFA 06A0         BL   @PUTV1            Init VDP & put out 1st edge ch
       7AFC 6422  
  3454 7AFE D541         MOVB R1,*R5            Put out 2nd edge character  
  3455 7B00 06C1         SWPB R1                Bare the space character  
  3456 7B02 D541  SCRBOT MOVB R1,*R5            Write out space character   
  3457 7B04 0602         DEC  R2                One less to move  
  3458 7B06 16FD         JNE  SCRBOT            Loop if more  
  3459 7B08 06C1         SWPB R1                Bare the edge character again 
  3460 7B0A D541         MOVB R1,*R5            Output edge character   
  3461 7B0C D541         MOVB R1,*R5            Output edge character   
  3462 7B0E 0456         B    *R6               And return go GPL   
  3463            * Generalized move routine  
  3464 7B10 04C8  SCRO1  CLR  R8                Clear minor counter   

 99/4 ASSEMBLER
SCROLLS                                                      PAGE 0080
  3465 7B12 D7E0         MOVB @R10LB,*R15       Write out LSB of read-address 
       7B14 83F5  
  3466 7B16 02A7         STWP R7                Get the WorkSpace pointer   
  3467 7B18 D7CA         MOVB R10,*R15          Write out MSB of read-address 
  3468 7B1A DDE0  SCRO2  MOVB @XVDPRD,*R7+      Read a byte   
       7B1C 8800  
  3469 7B1E 058A         INC  R10               Inc read-from address   
  3470 7B20 0588         INC  R8                Inc minor counter   
  3471 7B22 060C         DEC  R12               Dec total counter   
  3472 7B24 1303         JEQ  SCRO4             If all bytes read-write them  
  3473 7B26 0288         CI   R8,12             Filled WorkSpace buffer area? 
       7B28 000C  
  3474 7B2A 11F7         JLT  SCRO2             No, read more   
  3475 7B2C D7E0  SCRO4  MOVB @R9LB,*R15        Write LSB of write-address  
       7B2E 83F3  
  3476 7B30 0269         ORI  R9,WRVDP          Enable the VDP write  
       7B32 4000  
  3477 7B34 D7C9         MOVB R9,*R15           Write MSB of write-address  
  3478 7B36 02A7         STWP R7                Get WorkSpace buffer pointer  
  3479 7B38 D837  SCRO6  MOVB *R7+,@XVDPWD      Write a byte  
       7B3A 8C00  
  3480 7B3C 0589         INC  R9                Increment write-address   
  3481 7B3E 0608         DEC  R8                Decrement counter   
  3482 7B40 16FB         JNE  SCRO6             Move more if not done   
  3483 7B42 C30C         MOV  R12,R12           More on major counter?  
  3484 7B44 16E5         JNE  SCRO1             No, go do another read  
  3485 7B46 045B         RT                     Yes, done   
  3486            ************************************************************
  3487            * Decode which I/O utility is being called  
  3488            * Tag field following the XML IO has the following  
  3489            * meaning:  
  3490            *     0 - Line list - utility to search keyword table to  
  3491            *         restore keyword from token  
  3492            *     1 - Fill space - utility to fill record with space  
  3493            *         when outputting imcomplete records  
  3494            *     2 - Copy string - utility to copy a string, adding  
  3495            *         the screen offset to each character for display   
  3496            *         purposes  
  3497            *     3 - Clear ERAM - utility to clear ERAM at the address 
  3498            *         specified by the data word following the IO tag   
  3499            *         and the # of bytes specified by the length  
  3500            *         following the address word. Note that each data   
  3501            *         word is the address of a CPU memory location.   
  3502            ************************************************************
  3503 7B48 D01D  IO     MOVB *R13,R0           Read selector from GROM   
  3504 7B4A 0980         SRL  R0,8              Shift for decoding  
  3505 7B4C 1358         JEQ  LLIST             0 is tag for Line list  
  3506 7B4E 0600         DEC  R0  
  3507 7B50 132C         JEQ  FILSPC            1 is tag for Fill space   
  3508 7B52 0600         DEC  R0  
  3509 7B54 130E         JEQ  CSTRIN            2 is tag for Copy string  
  3510            *                             3 is tag for CLRGRM string  
  3511            *                                fall into it   
  3512            * CALGRM  
  3513            * R1 - address of clearing start  
  3514            * R2 - number of bytes to clear   
  3515 7B56 0201  CLRGRM LI   R1,PAD            Get CPU RAM offset  
       7B58 8300  
  3516 7B5A C081         MOV  R1,R2             Need for next read too  

 99/4 ASSEMBLER
SCROLLS                                                      PAGE 0081
  3517 7B5C B81D         AB   *R13,@R1LB        Add address of ERAM pointer   
       7B5E 83E3  
  3518 7B60 C051         MOV  *R1,R1            Read the ERAM address   
  3519 7B62 B81D         AB   *R13,@R2LB        Read address of byte count  
       7B64 83E5  
  3520 7B66 C092         MOV  *R2,R2            Read the byte count   
  3521 7B68 04C0         CLR  R0                Clear of clearing ERAM  
  3522 7B6A DC40  CLRGR1 MOVB R0,*R1+           Clear a byte  
  3523 7B6C 0602         DEC  R2                One less to clear, done?  
  3524 7B6E 16FD         JNE  CLRGR1            No, loop for rest   
  3525 7B70 045B         RT                     Yes, return   
  3526            * CSTRIN  
  3527            * R0 - PAD2   
  3528            * R1 - GETV/PUTV buffer   
  3529            * R3 - FAC4/GETV address  
  3530            * R5 - return address   
  3531 7B72 C14B  CSTRIN MOV  R11,R5            Save return address   
  3532 7B74 D020         MOVB @PAD2,R0          Get PAD2  
       7B76 8302  
  3533 7B78 1317         JEQ  CSTR1O            If no bytes to copy   
  3534 7B7A 0980         SRL  R0,8              Shift to use as counter   
  3535 7B7C C120         MOV  @CCPADR,R4        Get copy-to address   
       7B7E 8308  
  3536 7B80 C0E0         MOV  @FAC4,R3          Get copy-from address   
       7B82 834E  
  3537 7B84 06A0  CSTRO5 BL   @GETV1            Get byte  
       7B86 1880  
  3538 7B88 B060         AB   @DSRFLG,R1        Add screen offset   
       7B8A 8317  
  3539 7B8C 06A0         BL   @PUTV1            Put the offset byte out   
       7B8E 6422  
  3540 7B90 0583         INC  R3                Increment from address  
  3541 7B92 0584         INC  R4                Increment to address  
  3542 7B94 0600         DEC  R0                One less to move  
  3543 7B96 16F6         JNE  CSTRO5            Loop if not done  
  3544 7B98 C803         MOV  R3,@FAC4          Restore for GPL   
       7B9A 834E  
  3545 7B9C D800  CSTR07 MOVB R0,@PAD2          Clear for GPL   
       7B9E 8302  
  3546      7BA3  CCBHFF EQU  $+3   
  3547 7BA0 0244         ANDI R4,>BFFF          Throw away VDP write enable   
       7BA2 BFFF  
  3548 7BA4 C804         MOV  R4,@CCPADR        Restore for GPL   
       7BA6 8308  
  3549      7BA8  FILSZ6 EQU  $   
  3550 7BA8 0455  CSTR1O B    *R5               Return  
  3551            * FILSPC  
  3552            * R0 - PAD2   
  3553            * R1 - Buffer for GETV/PUTV   
  3554            * R2 - PAD3   
  3555            * R3 - Pointer for GETV   
  3556            * R4 - CCPADR, pointer for PUTV   
  3557            * R5 - return address   
  3558 7BAA C14B  FILSPC MOV  R11,R5            Save return address   
  3559 7BAC D0A0         MOVB @PAD3,R2          Get pointer to end of record  
       7BAE 8303  
  3560 7BB0 1604         JNE  FILSZ1            If space to fill for sure   
  3561 7BB2 9802         CB   R2,@CCPPTR        Any filling to do?  
       7BB4 8306  

 99/4 ASSEMBLER
SCROLLS                                                      PAGE 0082
  3562 7BB6 1604         JNE  FILSZ2            Yes, do it normalling   
  3563 7BB8 0455         B    *R5               No, 255 record already full   
  3564 7BBA 9802  FILSZ1 CB   R2,@CCPPTR        Any filling to do?  
       7BBC 8306  
  3565 7BBE 12F4         JLE  FILSZ6            No, record is complete  
  3566 7BC0 70A0  FILSZ2 SB   @CCPPTR,R2        Compute # of bytes to change  
       7BC2 8306  
  3567 7BC4 B802         AB   R2,@CCPPTR        Point to end  
       7BC6 8306  
  3568 7BC8 D020         MOVB @DSRFLG,R0        Filling with zeroes?  
       7BCA 8317  
  3569 7BCC 160A         JNE  FILSZ3            No, fill with spaces  
  3570 7BCE C0E0         MOV  @PABPTR,R3        Check if internal files   
       7BD0 8304  
  3571 7BD2 0223         AI   R3,FLG            5 byte offset into PAB  
       7BD4 0005  
  3572 7BD6 04C1         CLR  R1                Initialize to test below  
  3573 7BD8 06A0         BL   @GETV1            Get byte from PAB   
       7BDA 1880  
  3574 7BDC 0241         ANDI R1,>0800          Internal?   
       7BDE 0800  
  3575 7BE0 1602         JNE  FILSZ4            Yes, zero fill  
  3576 7BE2 0220  FILSZ3 AI   R0,>2000          Add space character for filler
       7BE4 2000  
  3577 7BE6 0982  FILSZ4 SRL  R2,8              Shift count for looping   
  3578 7BE8 C120         MOV  @CCPADR,R4        Get start address to fill   
       7BEA 8308  
  3579 7BEC D040         MOVB R0,R1             Put filler in place for PUTV  
  3580 7BEE 06A0  FILSZ5 BL   @PUTV1            Put out a filler  
       7BF0 6422  
  3581 7BF2 0584         INC  R4                Increment filler position   
  3582 7BF4 0602         DEC  R2                One less to fill  
  3583 7BF6 16FB         JNE  FILSZ5            Loop if move  
  3584 7BF8 D802         MOVB R2,@PAD3          Restore for GPL   
       7BFA 8303  
  3585 7BFC 10CF         JMP  CSTR07  
  3586            * LLIST   
  3587            * R0 - FAC - address of keytab in GROM  
  3588            * R1 - keyword length   
  3589 7BFE C30B  LLIST  MOV  R11,R12           Save return address   
  3590 7C00 06A0         BL   @PUTSTK           Save GROM address   
       7C02 60F2  
  3591 7C04 C020         MOV  @FAC,R0           Get address of keytab   
       7C06 834A  
  3592 7C08 D220         MOVB @CHAT,R8          Get token to search for   
       7C0A 8342  
  3593 7C0C 0201         LI   R1,1              Assume one character keyword  
       7C0E 0001  
  3594 7C10 DB40  LLISZ4 MOVB R0,@GRMWAX(R13)   Load GROM address of table  
       7C12 0402  
  3595 7C14 DB60         MOVB @R0LB,@GRMWAX(R13) Both bytes   
       7C16 83E1  
       7C18 0402  
  3596 7C1A D0DD         MOVB *R13,R3           Read address of x-char table  
  3597 7C1C D81D         MOVB *R13,@R3LB        Both bytes  
       7C1E 83E7  
  3598 7C20 A0C1  LLISZ5 A    R1,R3             Add length of keyword to point
  3599            *                              at token   
  3600 7C22 DB43         MOVB R3,@GRMWAX(R13)   Write out new GROM address  

 99/4 ASSEMBLER
SCROLLS                                                      PAGE 0083
       7C24 0402  
  3601 7C26 DB60         MOVB @R3LB,@GRMWAX(R13) Which points to token  
       7C28 83E7  
       7C2A 0402  
  3602 7C2C D11D         MOVB *R13,R4           Read token value  
  3603 7C2E D15D         MOVB *R13,R5           Read possible end of x-char   
  3604            *                              table  
  3605 7C30 9204         CB   R4,R8             Token value match?  
  3606 7C32 1307         JEQ  LLISZ6            Yes!!! Found the keyword  
  3607 7C34 0583         INC  R3                No, so skip token value   
  3608 7C36 9805         CB   R5,@CCBHFF        Reach end of x-char table?  
       7C38 7BA3  
  3609 7C3A 16F2         JNE  LLISZ5            No, so check more in the table
  3610 7C3C 05C0         INCT R0                Point into x+1 char table   
  3611 7C3E 0581         INC  R1                Try x+1 char table  
  3612 7C40 10E7         JMP  LLISZ4            Loop to check it  
  3613            * Come here when found keyword  
  3614 7C42 60C1  LLISZ6 S    R1,R3             Subtract length to pnt at K.W.
  3615 7C44 C803         MOV  R3,@FAC8          Save ptr to KeyWord for GPL   
       7C46 8352  
  3616 7C48 C801         MOV  R1,@FAC4          Save KeyWord length for GPL   
       7C4A 834E  
  3617 7C4C D808         MOVB R8,@FAC           Save CHAT for GPL   
       7C4E 834A  
  3618 7C50 06A0         BL   @GETSTK           Restore GROM addres   
       7C52 610E  
  3619 7C54 045C         B    *R12              And return to GPL   
  3620            ************************************************************
  3621 7C56              AORG >7C56   
  3623                
  3624      0088  RETURZ EQU  >88   
  3625      0089  DEFZ   EQU  >89   
  3626      008A  DIMZ   EQU  >8A   
  3627      008B  ENDZ   EQU  >8B   
  3628      008C  FORZ   EQU  >8C   
  3629      0092  INPUTZ EQU  >92   
  3630      0093  DATAZ  EQU  >93   
  3631      009A  REMZ   EQU  >9A   
  3632      009B  ONZ    EQU  >9B   
  3633      009D  CALLZ  EQU  >9D   
  3634      009E  OPTIOZ EQU  >9E   
  3635      00A3  IMAGEZ EQU  >A3   
  3636      00A7  SUBXTZ EQU  >A7   
  3637      00A8  SUBNDZ EQU  >A8   
  3638      00AA  LINPUZ EQU  >AA   
  3639      00B2  STEPZ  EQU  >B2   
  3640      00C7  NUMZ   EQU  >C7   
  3641            *-----------------------------------------------------------
  3642            * Added for "NOPSCAN" feature 6/8/81  
  3643      0040  P1     EQU  >40               @   
  3644      0050  P2     EQU  >50               P   
  3645      002B  P3     EQU  >2B               +   
  3646      002D  P4     EQU  >2D               -   
  3647      0070  P5     EQU  >70               p   
  3648      03B7  PSCFG  EQU  >03B7             VDP temporary: PSCAN flag   
  3649            *                                            >00 : no pscan 
  3650            *                                            >FF : pscan  
  3651            *-----------------------------------------------------------
  3652                

 99/4 ASSEMBLER
SCANS                                                        PAGE 0084
  3653            *-----------------------------------------------------------
  3654            * SCAN routine is changed for implementing "NOPSCAN"  
  3655            * feature,                    6/8/81  
  3656            * "!@P+" or "!@p+"            is RESUME PSCAN   
  3657            * "!@P-" or "!@p-"            is NO PSCAN   
  3658            *-----------------------------------------------------------
  3659            *   
  3660            ************************************************************
  3661            * SCAN is the main looping structure of the prescan routine.
  3662            * Takes care of scanning each statement in a line. Goes   
  3663            * back to GPL to scan the special cases (DEF, OPTION, DIM,  
  3664            * SUB, CALL, SUBEND, SUBEXIT) and also goes to GPL to enter 
  3665            * variables into the symbol table. All statements which are 
  3666            * not allowed to be imperative are checked directly without 
  3667            * goting to GPL. The NOCARE label is where a non-special  
  3668            * statement is scanned, looking for variables to enter them 
  3669            * into the symbol table.  
  3670            ************************************************************
  3671 7C56 D01D  PSCAN  MOVB *R13,R0           Read Scan code  
  3672 7C58 06A0         BL   @PUTSTK           Save GROM address   
       7C5A 60F2  
  3673 7C5C 06A0         BL   @SETREG           Set up R8/R9 with CHAT/SUBSTK 
       7C5E 1E7A  
  3674            * First decode the type of XML being executed   
  3675            * Types are: >00 - initial call with program  
  3676            *            >01 - resume within a statement after call to  
  3677            *                  GPL for some reason  
  3678            *            >02 - initial call for imperative statement  
  3679 7C60 0980         SRL  R0,8              Set condition   
  3680 7C62 1305         JEQ  SCAN05            If calling scan routine w/pgm 
  3681 7C64 0600         DEC  R0                Returning from call to GPL?   
  3682 7C66 135D         JEQ  JNCARE            Yes, continue w/in line   
  3683 7C68 C819         MOV  *R9,@RTNADD   
       7C6A 8326  
  3684 7C6C 1050         JMP  SCAN10  
  3685 7C6E A660  SCAN05 A    @C3,*R9           Skip following XML and select 
       7C70 6544  
  3686 7C72 C819         MOV  *R9,@RTNADD       Set up rtn to common GPL loc  
       7C74 8326  
  3687 7C76 04E0         CLR  @DATA             Assume out of data  
       7C78 8334  
  3688 7C7A 8820  SCAN5A C    @LINUM,@EXTRAM    End of program yet?   
       7C7C 8312  
       7C7E 832E  
  3689 7C80 161B         JNE  SCAN07            No, get next line   
  3690 7C82 D020  SCAN5B MOVB @FORNET,R0        Check fornext counter   
       7C84 8317  
  3691 7C86 1655         JNE  FNERR             For/Next error  
  3692 7C88 D020         MOVB @XFLAG,R0         Check subprogram bits   
       7C8A 8316  
  3693      7C8D  CBH40  EQU  $+1   
  3694 7C8C 0A40         SLA  R0,4              Subprogram encountered?   
  3695 7C8E 1108         JLT  SCAN6A            Yes, check subend   
  3696 7C90 0200  SCAN06 LI   R0,>A000          Initialize data stack   
       7C92 A000  
  3697 7C94 D800         MOVB R0,@STACK   
       7C96 8373  
  3698 7C98 06A0         BL   @RESOLV           Resolve any subprogram refs   
       7C9A 7946  

 99/4 ASSEMBLER
SCANS                                                        PAGE 0085
  3699 7C9C 0460         B    @GPL05            Return  
       7C9E 7E5E  
  3700 7CA0 0A40  SCAN6A SLA  R0,4              Subend encountered?   
  3701 7CA2 1707         JNC  ERRMS             No, text ended w/out subend   
  3702 7CA4 0203         LI   R3,TABSAV         Get main symbol table's ptr   
       7CA6 0392  
  3703 7CA8 06A0         BL   @GET1             Get it  
       7CAA 6C9E  
  3704 7CAC C801         MOV  R1,@SYMTAB  
       7CAE 833E  
  3705 7CB0 10EF         JMP  SCAN06            Merge back in   
  3706 7CB2 0203  ERRMS  LI   R3,>18            * MISSING SUBEND  
       7CB4 0018  
  3707 7CB6 1076         JMP  GPL05L  
  3708 7CB8 6820  SCAN07 S    @C4,@EXTRAM       Go to next line in program  
       7CBA 6A80  
       7CBC 832E  
  3709 7CBE D020         MOVB @RAMTOP,R0        ERAM program?   
       7CC0 8384  
  3710 7CC2 1604         JNE  SCAN08            Yes, handle  ERAM   
  3711 7CC4 06A0         BL   @GET              No, het new line pointer in VD
       7CC6 6C9A  
  3712 7CC8 832E         DATA EXTRAM  
  3713 7CCA 1003         JMP  SCAN09  
  3714 7CCC 06A0  SCAN08 BL   @GETG             Get new line pointer from GRAM
       7CCE 6CCA  
  3715 7CD0 832E         DATA EXTRAM  
  3716 7CD2 C801  SCAN09 MOV  R1,@PGMPTR        Put new line pointer into perm
       7CD4 832C  
  3717 7CD6 5820         SZCB @CBH40,@XFLAG     Reset IFFLAG only on new line 
       7CD8 7C8D  
       7CDA 8316  
  3718            *-----------------------------------------------------------
  3719            * Following is changed for adding "nopscan" feature   
  3720            * SCAN9A @PGMCHR                Get 1st token on line   
  3721 7CDC 06A0  SCAN9A BL   @PGMCHR           Get 1st token on line   
       7CDE 6C74  
  3722 7CE0 0203         LI   R3,PSCFG          Check the flag to see which   
       7CE2 03B7  
  3723            *                  mode is in: NOPSCAN (>00) or PSCAN (>FF) 
  3724 7CE4 06A0         BL   @GETV1            Get the flag from VDP   
       7CE6 1880  
  3725 7CE8 1348         JEQ  NPSCAN            NOPSCAN mode  
  3726            *-----------------------------------------------------------
  3727 7CEA 5820         SZCB @CBH94,@XFLAG     Reset ENTER, STRFLG, and FNCFL
       7CEC 6005  
       7CEE 8316  
  3728 7CF0 D020         MOVB @XFLAG,R0         Get flag bits   
       7CF2 8316  
  3729 7CF4 0A80         SLA  R0,8              Shift to check REMODE   
  3730 7CF6 170B         JNC  SCAN10            If not in REMODE  
  3731 7CF8 D208         MOVB R8,R8             Check if token  
  3732 7CFA 1103         JLT  SCAN11            If token, look further  
  3733 7CFC 0203  ERRIBS LI   R3,>1E            * ILLEGAL BETWEEN SUBPROGRAMS 
       7CFE 001E  
  3734 7D00 1051         JMP  GPL05L            Goto error return   
  3735 7D02 0706  SCAN11 SETO R6                Set up index into table   
  3736 7D04 0586  SCAN12 INC  R6                Increment to 1st/next element 
  3737 7D06 9988         CB   R8,@IBSTAB(R6)    legal stmt between subprogdams

 99/4 ASSEMBLER
SCANS                                                        PAGE 0086
       7D08 7EA0  
  3738 7D0A 1BFC         JH   SCAN12            Not able to tell, check furthe
  3739 7D0C 1AF7         JL   ERRIBS            Illegal statement here  
  3740 7D0E 04C6  SCAN10 CLR  R6                Offset into special stmt table
  3741 7D10 C0E6  SCAN15 MOV  @SCNTAB(R6),R3    Read entry from special table 
       7D12 7E70  
  3742 7D14 9203         CB   R3,R8             Match this token?   
  3743 7D16 1306         JEQ  SCAN20            Yes, handle special case  
  3744 7D18 1B74         JH   NOCARE            Didn't match but passed in tab
  3745 7D1A 05C6         INCT R6                Increment offset into table   
  3746 7D1C 0286         CI   R6,TABLEN         Reach end of table?   
       7D1E 0030  
  3747 7D20 16F7         JNE  SCAN15            No, check further   
  3748 7D22 106F  JNCARE JMP  NOCARE            End of table, not special case
  3749 7D24 0A83  SCAN20 SLA  R3,8              Look at special case byte   
  3750 7D26 1103         JLT  SCGPL1            If MSB set, goto GPL  
  3751 7D28 06C3         SWPB R3                MSB reset, offset into 9900   
  3752 7D2A 0463         B    @OFFSET(R3)       Branch to 9900 special handler
       7D2C 7D84  
  3753 7D2E 0460  SCGPL1 B    @SCNGPL   
       7D30 7E58  
  3754 7D32 0460  FNERR  B    @FNNERR   
       7D34 7E4C  
  3755            *-----------------------------------------------------------
  3756            * These are added for "nopscan" feature 6/8/81  
  3757 7D36 D020  SCAN26 MOVB @PRGFLG,R0        In program mode?  
       7D38 8344  
  3758 7D3A 13A3         JEQ  SCAN5B            No, check for/next subs&rtn   
  3759 7D3C 06A0  SCAN28 BL   @PGMCHR           Yes, check "!@P+" or "!@P-"   
       7D3E 6C74  
  3760 7D40 0288         CI   R8,P1*256         "@" following "!"?  
       7D42 4000  
  3761 7D44 169A         JNE  SCAN5A            No, goto the next line  
  3762 7D46 06A0         BL   @PGMCHR           Yes, check for "P"  
       7D48 6C74  
  3763 7D4A 0288         CI   R8,P2*256   
       7D4C 5000  
  3764 7D4E 1303         JEQ  SCAN40            Yes, check for "+" or "-"   
  3765 7D50 0288         CI   R8,P5*256         No, try "p"   
       7D52 7000  
  3766 7D54 1692         JNE  SCAN5A            No, goto the next line  
  3767 7D56 06A0  SCAN40 BL   @PGMCHR           Yes, check for "+" or "-"   
       7D58 6C74  
  3768 7D5A 0288         CI   R8,P3*256   
       7D5C 2B00  
  3769 7D5E 130A         JEQ  SCAN35            "!@P+" is found at the  
  3770            *                               beginnning of the line  
  3771 7D60 0288         CI   R8,P4*256   
       7D62 2D00  
  3772 7D64 168A         JNE  SCAN5A            Didn't file what we want,   
  3773            *                              goto the next line   
  3774 7D66 0201         LI   R1,0              "!@P-" is found, set flag to  
       7D68 0000  
  3775            *                              0 NO PSCAN   
  3776 7D6A 0204  SCAN30 LI   R4,PSCFG          Address register for PUTV1  
       7D6C 03B7  
  3777 7D6E 06A0         BL   @PUTV1            Set the flag PSCFG in VDP tem.
       7D70 6422  
  3778 7D72 1083         JMP  SCAN5A            Goto the next line  

 99/4 ASSEMBLER
SCANS                                                        PAGE 0087
  3779 7D74 0201  SCAN35 LI   R1,>FF00          "!@P+", set flag to be >FF so 
       7D76 FF00  
  3780            *                              RESUME PSCAN   
  3781 7D78 10F8         JMP  SCAN30            Use common code to set flag   
  3782            *-----------------------------------------------------------
  3783            *-----------------------------------------------------------
  3784            * In NOPSCAN mode, only looking for "!@P+", "!@P-" at the   
  3785            * beginning of each line      6/8/81  
  3786 7D7A 0288  NPSCAN CI   R8,TREMZ*256      First token on line   
       7D7C 8300  
  3787            *                              is it "!"  
  3788 7D7E 13DE         JEQ  SCAN28            Yes, check "!@P+" or "!@P-"   
  3789 7D80 0460         B    @SCAN5A           No, ignore the whole line,  
       7D82 7C7A  
  3790            *                              just goto the next line  
  3791            *-----------------------------------------------------------
  3792            OFFSET  
  3793 7D84 10D8  SCN26A JMP  SCAN26  
  3794 7D86 D020  SCAN25 MOVB @PRGFLG,R0        In imperative mode?   
       7D88 8344  
  3795 7D8A 1302         JEQ  SCAN5C            Yes, check for/next sub & rtn 
  3796 7D8C 0460         B    @SCAN5A           No, check next line   
       7D8E 7C7A  
  3797 7D90 0460  SCAN5C B    @SCAN5B   
       7D92 7C82  
  3798            * 9900 code special handlers  
  3799 7D94 F820  IFIF   SOCB @CBH40,@XFLAG     Indicate scan of "IF" stmt  
       7D96 7C8D  
       7D98 8316  
  3800            * Special handler for program-only statements   
  3801 7D9A D020  IMPER  MOVB @PRGFLG,R0        Executing in a program?   
       7D9C 8344  
  3802 7D9E 1649         JNE  NXTCHR            Yes, proceed in don't char mod
  3803 7DA0 0203  ERRIMP LI   R3,>12            Illegal imperative return code
       7DA2 0012  
  3804 7DA4 105C  GPL05L JMP  GPL05             Return to GPL with error  
  3805            * Special handler for data-statements   
  3806 7DA6 D020  DATA1  MOVB @DATA,R0          Data already encountered?   
       7DA8 8334  
  3807 7DAA 1606         JNE  IMAGE             Yes, don't set pointer  
  3808 7DAC C820         MOV  @EXTRAM,@LNBUF    Save line buffer pointer  
       7DAE 832E  
       7DB0 8336  
  3809 7DB2 C820         MOV  @PGMPTR,@DATA     Set line buffer pointer   
       7DB4 832C  
       7DB6 8334  
  3810            * Special handler for image-statements  
  3811 7DB8 D020  IMAGE  MOVB @PRGFLG,R0        In program mode?  
       7DBA 8344  
  3812 7DBC 0460         B    @SCAN5A           Yes, no need to scan line   
       7DBE 7C7A  
  3813 7DC0 10EF         JMP  ERRIMP            No, illegal imperative  
  3814            * Special handler for for-statements  
  3815 7DC2 05A0  FOR    INC  @XFLAG            Increment the nesting counter 
       7DC4 8316  
  3816 7DC6 D020         MOVB @XFLAG,R0         Fetch the IFFLAG  
       7DC8 8316  
  3817 7DCA 0240         ANDI R0,>4000          Inside an if-statement?   
       7DCC 4000  

 99/4 ASSEMBLER
SCANS                                                        PAGE 0088
  3818 7DCE 1331         JEQ  NXTCHR            No, continue in don't care mod
  3819 7DD0 0203  SNTXER LI   R3,>1A            * SYNTAX ERROR  
       7DD2 001A  
  3820 7DD4 1044         JMP  GPL05   
  3821            * Special handler for next-statements   
  3822 7DD6 C020  SNEXT  MOV  @XFLAG,R0         Get flag and for-next counter 
       7DD8 8316  
  3823 7DDA 0240         ANDI R0,>40FF          Get rid of flag bits except IF
       7DDC 40FF  
  3824 7DDE D000         MOVB R0,R0             IFFLAG set?   
  3825 7DE0 16F7         JNE  SNTXER            Yes, syntax error   
  3826 7DE2 0600         DEC  R0                Decrement counter by one  
  3827 7DE4 D820         MOVB @R0LB,@FORNET     Move back to the real conter  
       7DE6 83E1  
       7DE8 8317  
  3828 7DEA 1323         JEQ  NXTCHR            Returning to top level, ok  
  3829 7DEC 1522         JGT  NXTCHR            Still at a secndary level, ok 
  3830 7DEE 0203         LI   R3,>14            For/next nesting return code  
       7DF0 0014  
  3831 7DF2 1035         JMP  GPL05             Return to GPL with error  
  3832 7DF4 D020  ELSE   MOVB @XFLAG,R0         Get flag byte   
       7DF6 8316  
  3833 7DF8 0240         ANDI R0,>4000          Inside an if?   
       7DFA 4000  
  3834 7DFC 13E9         JEQ  SNTXER            No, error   
  3835            * Special handler for statement seperator   
  3836 7DFE 0460  SEPSMT B    @SCAN9A           Skip the '::' and check next  
       7E00 7CDC  
  3837            * General don't care scan. Simply looks for variables to  
  3838            *  enter into symbol table; stops on end of statement   
  3839 7E02 0288  NOCARE CI   R8,SSEPZ*256      At a statement separator  
       7E04 8200  
  3840 7E06 13FB         JEQ  SEPSMT            Skip and scan next statement  
  3841 7E08 0288         CI   R8,TREMZ*256      At a tail remark?   
       7E0A 8300  
  3842 7E0C 13BC         JEQ  SCAN25            Yes, check mode   
  3843 7E0E D208         MOVB R8,R8             At an end-of-line or symbol?  
  3844 7E10 13BA         JEQ  SCAN25            EOL, checK mode   
  3845 7E12 151F         JGT  ENTER             Symbol, ENTER in symbol table 
  3846 7E14 0288         CI   R8,LNZ*256        Special line number token?  
       7E16 C900  
  3847 7E18 130F         JEQ  SKIPLN            Yes, need to skip it  
  3848 7E1A 0288         CI   R8,NUMZ*256       Special numeric token?  
       7E1C C700  
  3849 7E1E 130F         JEQ  STRSKP            Yes, need to skip it  
  3850 7E20 0288         CI   R8,UNQSTZ*256     Special string token?   
       7E22 C800  
  3851 7E24 130C         JEQ  STRSKP            Yes, need to skip it  
  3852 7E26 0288         CI   R8,THENZ*256      Hit a then-clause?  
       7E28 B000  
  3853 7E2A 13E4         JEQ  ELSE              Yes, treat like a stmt-sep  
  3854 7E2C 0288         CI   R8,ELSEZ*256      Hit a else-clause?  
       7E2E 8100  
  3855 7E30 13E1         JEQ  ELSE              Yes, t[eat liek a stmt-sep  
  3856 7E32 06A0  NXTCHR BL   @PGMCHR           Get next token  
       7E34 6C74  
  3857 7E36 10E5         JMP  NOCARE            And continue loop   
  3858 7E38 05E0  SKIPLN INCT @PGMPTR           Skip line number  
       7E3A 832C  

 99/4 ASSEMBLER
SCANS                                                        PAGE 0089
  3859 7E3C 10FA         JMP  NXTCHR            And get next token  
  3860 7E3E 06A0  STRSKP BL   @PGMCHR           Get length of string/number   
       7E40 6C74  
  3861 7E42 06C8         SWPB R8                Swap for add  
  3862 7E44 A808         A    R8,@PGMPTR        Skip the string of number   
       7E46 832C  
  3863 7E48 04C8         CLR  R8                Clear LSB of character  
  3864 7E4A 10F3         JMP  NXTCHR            And get next token  
  3865            * Code to return to GPL to handle special case or an  
  3866            *  end-of-line return   
  3867 7E4C 0203  FNNERR LI   R3,>16            FOR/NEXT NESTING  
       7E4E 0016  
  3868 7E50 1006         JMP  GPL05   
  3869 7E52 0203  ENTER  LI   R3,>10            Load return code for ENTER  
       7E54 0010  
  3870 7E56 1003         JMP  GPL05             Goto GPL  
  3871 7E58 0243  SCNGPL ANDI R3,>7F00          Throw away GPL flag   
       7E5A 7F00  
  3872 7E5C 0983         SRL  R3,8              Shift to use as index for rtn 
  3873 7E5E C660  GPL05  MOV  @RTNADD,*R9       Make sure right GROM address  
       7E60 8326  
  3874 7E62 A643         A    R3,*R9            Add offset to old GROM address
  3875 7E64 06A0         BL   @SAVREG           Save R8/R9 in CHAT/SUBSTK   
       7E66 1E8C  
  3876 7E68 06A0         BL   @GETSTK           Restore old GROM address  
       7E6A 610E  
  3877 7E6C 0460         B    @RESET            Goto GPL w/condition reset  
       7E6E 006A  
  3878            ************************************************************
  3879            * Table of specially scanned statements   
  3880            * 2 bytes / special token   
  3881            * Byte 1 - token value  
  3882            * Byte 2 - "address" of special handler   
  3883            *        If MSB set then GPL and rest is offset from  
  3884            *         the XML that got us here  
  3885            *        If MSB reset then 9900 code and is offset from   
  3886            *         label OFFSET in this assembly of the special  
  3887            *         case handler  
  3888            ************************************************************
  3889 7E70   81  SCNTAB BYTE ELSEZ,ELSE-OFFSET   
       7E71   70  
  3890 7E72   82         BYTE SSEPZ,SEPSMT-OFFSET   
       7E73   7A  
  3891            *-----------------------------------------------------------
  3892            * Change the following line for searching for !@P- at the   
  3893            *  beginning of line  
  3894            *      BYTE TREMZ,SCAN25-OFFSET   
  3895 7E74   83         BYTE TREMZ,SCN26A-OFFSET   
       7E75   00  
  3896            *-----------------------------------------------------------
  3897 7E76   84         BYTE IFZ,IFIF-OFFSET   
       7E77   10  
  3898 7E78   85         BYTE GOZ,IMPER-OFFSET  
       7E79   16  
  3899 7E7A   86         BYTE GOTOZ,IMPER-OFFSET  
       7E7B   16  
  3900 7E7C   87         BYTE GOSUBZ,IMPER-OFFSET   
       7E7D   16  
  3901 7E7E   88         BYTE RETURZ,IMPER-OFFSET   

 99/4 ASSEMBLER
SCANS                                                        PAGE 0090
       7E7F   16  
  3902 7E80   89         BYTE DEFZ,>82  
       7E81   82  
  3903 7E82   8A         BYTE DIMZ,>84  
       7E83   84  
  3904 7E84   8C         BYTE FORZ,FOR-OFFSET   
       7E85   3E  
  3905 7E86   92         BYTE INPUTZ,IMPER-OFFSET   
       7E87   16  
  3906 7E88   93         BYTE DATAZ,DATA1-OFFSET  
       7E89   22  
  3907 7E8A   96         BYTE NEXTZ,SNEXT-OFFSET  
       7E8B   52  
  3908 7E8C   9A         BYTE REMZ,SCAN25-OFFSET  
       7E8D   02  
  3909 7E8E   9B         BYTE ONZ,IMPER-OFFSET  
       7E8F   16  
  3910 7E90   9D         BYTE CALLZ,>86   
       7E91   86  
  3911 7E92   9E         BYTE OPTIOZ,>88  
       7E93   88  
  3912 7E94   A1         BYTE SUBZ,>8A  
       7E95   8A  
  3913 7E96   A3         BYTE IMAGEZ,IMAGE-OFFSET   
       7E97   34  
  3914 7E98   A7         BYTE SUBXTZ,>8C  
       7E99   8C  
  3915 7E9A   A8         BYTE SUBNDZ,>8E  
       7E9B   8E  
  3916 7E9C   AA         BYTE LINPUZ,IMPER-OFFSET   
       7E9D   16  
  3917 7E9E   B0         BYTE THENZ,ELSE-OFFSET   
       7E9F   70  
  3918      0030  TABLEN EQU  $-SCNTAB  
  3919 7EA0   82  IBSTAB BYTE SSEPZ   
  3920 7EA1   83         BYTE TREMZ   
  3921 7EA2   8B         BYTE ENDZ  
  3922 7EA3   9A         BYTE REMZ  
  3923 7EA4   A1         BYTE SUBZ  
  3924 7EA5   FF         BYTE >FF   
  3925            ************************************************************
  3926 7EA6              AORG >7EA6   
  3928                
  3929            * (RAM to RAM)  
  3930            * Read data from ERAM   
  3931            * @FAC10 : Source address on ERAM   
  3932            * @FAC14 : Destination address in CPU   
  3933            *           Where the data stored after read from ERAM  
  3934            * @FAC12 : byte count   
  3935 7EA6 0203  GREAD1 LI   R3,FAC12          # of bytes to move  
       7EA8 8356  
  3936 7EAA 0202         LI   R2,FAC10          Source in ERAM  
       7EAC 8354  
  3937 7EAE 0201         LI   R1,FAC14          Destination in CPU  
       7EB0 8358  
  3938 7EB2 1006         JMP  GRZ1              Jump to common routine  
  3939            * Read data from ERAM to CPU  
  3940            * @FAC2  : Source address on ERAM   
  3941            * @FAC6  : Destination address in CPU   

 99/4 ASSEMBLER
GREADS                                                       PAGE 0091
  3942            *           Where the data stored after read from ERAM  
  3943            * @FAC4  : byte count   
  3944 7EB4 0203  GREAD  LI   R3,FAC4           # of bytes to move  
       7EB6 834E  
  3945 7EB8 0202         LI   R2,FAC2           Source in ERAM  
       7EBA 834C  
  3946 7EBC 0201         LI   R1,FAC6           Destination in CPU  
       7EBE 8350  
  3947            * Common ERAM to CPU transfer routine   
  3948 7EC0 C112  GRZ1   MOV  *R2,R4  
  3949 7EC2 DC74  GRZ2   MOVB *R4+,*R1+         Move byte from ERAM to CPU  
  3950 7EC4 0613         DEC  *R3               One less to move, done?   
  3951 7EC6 16FD         JNE  GRZ2              No, copy the rest   
  3952 7EC8 045B         RT   
  3953            ************************************************************
  3954                
  3955 7ECA              AORG >7ECA   
  3957                
  3958            * (RAM to RAM)  
  3959            * Write the data whcih is stored in CPU to ERAM   
  3960            * @PAD2  : Destination address on ERAM where data is going  
  3961            *           to be stored  
  3962            * @PADC  : Soruce address on CPU where data stored  
  3963            * @PAD8  : byte count   
  3964 7ECA 0203  GWITE1 LI   R3,PAD8           Count   
       7ECC 8308  
  3965 7ECE 0202         LI   R2,PAD2           Destination   
       7ED0 8302  
  3966 7ED2 0201         LI   R1,PADC           Source  
       7ED4 830C  
  3967 7ED6 1006         JMP  GWZ1  
  3968            * Write the data which is stored in CPU to ERAM   
  3969            * @FAC2  : Destination address on ERAM where data is going  
  3970            *           to be stroed  
  3971            * @FAC6  : Source address on CPU where dta is stored  
  3972            * @FAC4  : byte count   
  3973 7ED8 0203  GWRITE LI   R3,FAC4           Count   
       7EDA 834E  
  3974 7EDC 0202         LI   R2,FAC2           Destination   
       7EDE 834C  
  3975 7EE0 0201         LI   R1,FAC6           Source  
       7EE2 8350  
  3976            * Common routine to copy from CPU to ERAM   
  3977      7EE4  GWZ1   EQU  $   
  3978 7EE4 C112         MOV  *R2,R4            Get distination address   
  3979 7EE6 C051         MOV  *R1,R1            Get CPU RAM address   
  3980 7EE8 0221         AI   R1,PAD            Add in CPU offset   
       7EEA 8300  
  3981 7EEC DD31  GWZ2   MOVB *R1+,*R4+         Move a byte   
  3982 7EEE 0613         DEC  *R3               One less to move, done?   
  3983 7EF0 16FD         JNE  GWZ2              No, more to move  
  3984 7EF2 045B         RT   
  3985            ************************************************************
  3986                
  3987 7EF4              AORG >7EF4   
  3989                
  3990            * Delete the text in crunched program on VDP or ERAM  
  3991            *  point to the line # (to be deleted) in the line # table  
  3992            * RAMTOP  0 if no ERAM  

 99/4 ASSEMBLER
DELREPS                                                      PAGE 0092
  3993            * ENLN    Last location used by the line # table  
  3994            * STLN    First location used by the line # table   
  3995            *   
  3996                
  3997 7EF4 C20B  DELREP MOV  R11,R8            Save return   
  3998 7EF6 05E0         INCT @EXTRAM           Point to line ptr in table  
       7EF8 832E  
  3999 7EFA C0E0         MOV  @EXTRAM,R3        Prepare to read it  
       7EFC 832E  
  4000 7EFE C1E0         MOV  @RAMTOP,R7        Check ERAM flag & get in reg  
       7F00 8384  
  4001 7F02 1603         JNE  DE01              ERAM, get from it   
  4002 7F04 06A0         BL   @GET1             Get line ptr from VDP   
       7F06 6C9E  
  4003 7F08 1002         JMP  DE02  
  4004 7F0A 06A0  DE01   BL   @GETG2            Get line ptr from ERAM  
       7F0C 6CCE  
  4005 7F0E 0601  DE02   DEC  R1                Point to line length  
  4006 7F10 C0C1         MOV  R1,R3             Prepare to read length  
  4007 7F12 C241         MOV  R1,R9             Save copy for use later   
  4008 7F14 C1C7         MOV  R7,R7             Editing in ERAM?  
  4009 7F16 1603         JNE  DE03              ERAM, get length from it  
  4010 7F18 06A0         BL   @GETV1            Get line length from VDP  
       7F1A 1880  
  4011 7F1C 1001         JMP  DE04  
  4012 7F1E D053  DE03   MOVB *R3,R1  
  4013 7F20 D081  DE04   MOVB R1,R2             Move text length for use  
  4014 7F22 0982         SRL  R2,8              Need as a word  
  4015 7F24 0582         INC  R2                Text length = length + length 
  4016            *                              byte   
  4017 7F26 C0E0         MOV  @ENLN,R3          Get end of line # table   
       7F28 8332  
  4018 7F2A 0583         INC  R3                Adjust for inside loop  
  4019            * UPDATE THE LINE # TABLE   
  4020 7F2C 0643  DEREA  DECT R3                Point to line pointer   
  4021 7F2E C1C7         MOV  R7,R7             Editing in ERAM?  
  4022 7F30 1603         JNE  DE05              ERAM, read it as such   
  4023 7F32 06A0         BL   @GET1             Get line pointer from VDP   
       7F34 6C9E  
  4024 7F36 1002         JMP  DE06  
  4025 7F38 06A0  DE05   BL   @GETG2            Get line pointer from ERAM  
       7F3A 6CCE  
  4026 7F3C C141  DE06   MOV  R1,R5             Move for use  
  4027 7F3E 0605         DEC  R5                Point to length byte  
  4028 7F40 8149         C    R9,R5             Compare location of delete  
  4029            *                              line & this line   
  4030 7F42 1209         JLE  DEREB             This line won't move ,  
  4031            *                              don't fix pointer  
  4032 7F44 A042         A    R2,R1             Add distance to move to pointe
  4033 7F46 C103         MOV  R3,R4             Write it to same place  
  4034 7F48 C1C7         MOV  R7,R7             Editing in ERAM?  
  4035 7F4A 1603         JNE  DE10              Yes   
  4036 7F4C 06A0         BL   @PUT1             Put back into line # table  
       7F4E 6CB2  
  4037 7F50 1002         JMP  DEREB   
  4038 7F52 06A0  DE10   BL   @PUTG2            Put back into line # table  
       7F54 6CD8  
  4039 7F56 0643  DEREB  DECT R3                Point at the line #   
  4040 7F58 8803         C    R3,@STLN          At last line in table?  

 99/4 ASSEMBLER
DELREPS                                                      PAGE 0093
       7F5A 8330  
  4041 7F5C 16E7         JNE  DEREA             No, loop for more   
  4042            * UPDATA OF LINE # TABLE IS COMPLETE, NOW DELETE TEXT   
  4043            * R9 still contains pointer to length byte of text to delete
  4044            * R2 still contains text length   
  4045 7F5E 0609         DEC  R9  
  4046 7F60 C0C9         MOV  R9,R3   
  4047 7F62 C149         MOV  R9,R5   
  4048 7F64 A142         A    R2,R5             Point to 1st token  
  4049 7F66 C043         MOV  R3,R1             Save for later use  
  4050 7F68 6060         S    @STLN,R1          VDP, calculate # of bytes to m
       7F6A 8330  
  4051 7F6C 0581         INC  R1                Correct offset by one   
  4052 7F6E 06A0         BL   @MVDN2            Delete the text   
       7F70 7F8A  
  4053            * NOW SET UP POINTERS TO LINE TABLE   
  4054 7F72 0201  DE18   LI   R1,EXTRAM         Start with EXTRAM   
       7F74 832E  
  4055 7F76 AC42         A    R2,*R1+           Update EXTRAM   
  4056 7F78 AC42         A    R2,*R1+           Update STLN   
  4057 7F7A A442         A    R2,*R1            Update ENLN   
  4058 7F7C 0458         B    *R8               And return  
  4059            ************************************************************
  4060 7F7E              AORG >7F7E   
  4062                
  4063            * (VDP to VDP) or (RAM to RAM)  
  4064            * WITHOUT ERAM : Move the contents in VDP RAM from a lower  
  4065            *                address to a higher address avoiding a   
  4066            *                possible over-write of data  
  4067            * >835C          ARG    : byte count  
  4068            * >8300          PAD    : source address  
  4069            * >8306          PAD6   : destination address   
  4070            * WITH ERAM    Same as above except moves ERAM to ERAM  
  4071                
  4072 7F7E C060  MVDN   MOV  @ARG,R1           Get byte count  
       7F80 835C  
  4073 7F82 C160         MOV  @PAD6,R5          Get destination   
       7F84 8306  
  4074 7F86 C0E0         MOV  @PAD,R3           Get source  
       7F88 8300  
  4075 7F8A C1E0  MVDN2  MOV  @RAMTOP,R7        ERAM or VDP?  
       7F8C 8384  
  4076 7F8E 1612         JNE  MV01              ERAM, so handle it  
  4077 7F90 1002         JMP  MV05              VDP, so jump into loop  
  4078 7F92 0605  MVDN1  DEC  R5  
  4079 7F94 0603         DEC  R3  
  4080      7F96  MV05   EQU  $   
  4081 7F96 D7E0         MOVB @R3LB,*R15        Write out read address  
       7F98 83E7  
  4082 7F9A D7C3         MOVB R3,*R15   
  4083 7F9C D1E0         MOVB @XVDPRD,R7        Read a byte   
       7F9E 8800  
  4084 7FA0 D7E0         MOVB @R5LB,*R15        Write out write address   
       7FA2 83EB  
  4085 7FA4 0265         ORI  R5,WRVDP          Enable VDP write  
       7FA6 4000  
  4086 7FA8 D7C5         MOVB R5,*R15   
  4087 7FAA D807         MOVB R7,@XVDPWD        Write the byte  
       7FAC 8C00  

 99/4 ASSEMBLER
MVDNS                                                        PAGE 0094
  4088 7FAE 0601         DEC  R1                One less byte to move   
  4089 7FB0 16F0         JNE  MVDN1             Loop if more to move  
  4090 7FB2 045B         RT   
  4091      7FB4  MV01   EQU  $   
  4092 7FB4 D553  MVDNZ1 MOVB *R3,*R5           Move a byte   
  4093 7FB6 0603         DEC  R3                Decrement destination   
  4094 7FB8 0605         DEC  R5                Decrement source  
  4095 7FBA 0601         DEC  R1                One less byte to move   
  4096 7FBC 16FB         JNE  MVDNZ1            Loop if more to move  
  4097 7FBE 045B         RT   
  4098            ************************************************************
  4099                
  4100 7FC0              AORG >7FC0   
  4102                
  4103            * (VDP to RAM) >834C=FAC2,>8350=FAC6,>834E=FAC4   
  4104            * Move data from VDP to ERAM  
  4105            * @FAC2  : Source address where the data stored on VDP  
  4106            * @FAC6  : Destination address on ERAM  
  4107            * @FAC4  : byte count   
  4108                
  4109      7FC0  VGWITE EQU  $   
  4110 7FC0 D7E0         MOVB @FAC3,*R15        LSB of VDP address  
       7FC2 834D  
  4111 7FC4 C0A0         MOV  @FAC6,R2          Address in ERAM   
       7FC6 8350  
  4112 7FC8 D7E0         MOVB @FAC2,*R15        MSB of VDP address  
       7FCA 834C  
  4113 7FCC 1000         NOP  
  4114 7FCE DCA0  VGZ1   MOVB @XVDPRD,*R2+      Move a byte   
       7FD0 8800  
  4115 7FD2 0620         DEC  @FAC4             One less to move  
       7FD4 834E  
  4116 7FD6 16FB         JNE  VGZ1              If not done, loop for more  
  4117 7FD8 045B         RT                     Return  
  4118            ************************************************************
  4119                
  4120 7FDA              AORG >7FDA   
  4122                
  4123            * Move data from ERAM to VDP (RAM to VDP)   
  4124            * @FAC10 : Source address where the data stored on ERAM   
  4125            * @FAC14 : Destination address on VDP   
  4126            * @FAC12 : byte count   
  4127                
  4128 7FDA C0A0  GVWITE MOV  @FAC14,R2         VDP address   
       7FDC 8358  
  4129 7FDE D7E0         MOVB @R2LB,*R15        LSB of VDP address  
       7FE0 83E5  
  4130 7FE2 0262         ORI  R2,WRVDP          Enable VDP write  
       7FE4 4000  
  4131 7FE6 D7C2         MOVB R2,*R15           MSB of VDP address  
  4132 7FE8 C0E0         MOV  @FAC10,R3         ERAM address  
       7FEA 8354  
  4133 7FEC D833  GVZ1   MOVB *R3+,@XVDPWD      Move a byte   
       7FEE 8C00  
  4134 7FF0 0620         DEC  @FAC12            One less to move  
       7FF2 8356  
  4135 7FF4 16FB         JNE  GVZ1              If not done, loop for more  
  4136 7FF6 045B         RT                     Return  
  4137            ************************************************************

 99/4 ASSEMBLER
GVWITES                                                      PAGE 0095
  4138 7FFA              AORG >7FFA   
  4139 7FFA 04E0  PAGER  CLR  @>6000      * RESTORE PAGE ONE  
       7FFC 6000  
  4140 7FFE 0459         B    *R9   
  4141            ************************************************************
  4142                
  4143                   END  

 99/4 ASSEMBLER
GVWITES                                                      PAGE 0096
    ABSZ    00CB      ANDZ    00BB      ARG     835C      ARG1    835D    
    ARG10   8366      ARG2    835E      ARG3    835F      ARG4    8360    
    ARG8    8364      ARG9    8365      ARGT05  6B8E      ARGT10  6B92    
    ARGT20  6B9A      ARGTST  6B6E      ASSG    6334      ASSG54  6360    
    ASSG55  6374      ASSG56  638A      ASSG57  637E      ASSG59  63B6    
    ASSG70  63CE      ASSG75  63EA      ASSG77  63F4      ASSG79  63F8    
    ASSG80  6388      ASSGNV  61AE      ATNZZ   797C      B9900   64F2    
    BASE    8343      BCON1   6E7E      BCONT   6D12      BERMUV  623C    
    BERMUW  70F6      BERR6   70F2      BERSNM  6EDE      BERSYN  6EDA    
    BEXC15  685C      BIT2    62AB      BLTST9  6D58      BMF     6DF2    
    BREAK   0007      BREAKZ  008E      BRKFL   0001      BRKP1L  65D2    
    BRKPN1  6644      BRKPN2  663E      BRKPNT  6636      BSO     6DF6    
    BSYNCH  6ED6      BUFLEV  8346      BYTE    830C      C0      6548    
    C100    6008      C1000   600A      C16     6BF8      C2      6000    
    C24     6464      C3      6544      C32     7196      C4      6A80    
    C40     6006      C6      618A      C7      6002      C8      706C    
    CALGPL  666C      CALIST  830A      CALL    750A      CALL02  7532    
    CALL04  753A      CALL06  754E      CALLZ   009D      CB3     6545    
    CBH40   7C8D      CBH63   6D05      CBH65   65A7      CBH66   66F1    
    CBH67   68AB      CBH69   6A9B      CBH6A   6860      CBH7    6003    
    CBH94   6005      CBHA    6004      CBHFF   60D6      CCBH63  709F    
    CCBH6A  70AF      CCBHFF  7BA3      CCPADR  8308      CCPPTR  8306    
    CFI     12B8      CHAT    8342      CHRBUF  837D      CIF     74AA    
    CIF01   74E0      CIF02   74F0      CIFRT   7500      CLRGR1  7B6A    
    CLRGRM  7B56      CNS     7016      CNSSEL  6070      COMM05  6D8C    
    COMMAZ  00B3      COMMON  6D74      COMP03  73E8      COMP05  73F6    
    COMP10  7418      COMPCG  619C      COMPCT  73D8      COMPTN  798A    
    CONC    667E      CONCAT  0008      CONT    64C8      CONT10  64D8    
    CONT15  64E6      CONTAD  7502      CONTG   64C4      CONTIN  65CC    
    CONVRT  6E9E      COSZZ   78B2      CPALNM  0022      CPALPH  0020    
    CPBRK   0040      CPDIG   0002      CPLOW   0001      CPMO    0010    
    CPNIL   0000      CPNUM   0004      CPOP    0008      CPSEP   0080    
    CPTBL   610C      CPUL    0021      CPULNM  0023      CRNBUF  0820    
    CRNEND  08BE      CRNSEL  6076      CRULST  83C0      CRUNCH  7B88    
    CSN01   11B2      CSTR05  6AFC      CSTR07  7B9C      CSTR10  6B00    
    CSTR1O  7BA8      CSTR20  6B1A      CSTRIN  7B72      CSTRO5  7B84    
    CZ      831A      DATA    8334      DATA1   7DA6      DATAZ   0093    
    DCBH6A  7709      DE01    7F0A      DE02    7F0E      DE03    7F1E    
    DE04    7F20      DE05    7F38      DE06    7F3C      DE10    7F52    
    DE18    7F72      DEFZ    0089      DELREP  7EF4      DEREA   7F2C    
    DEREB   7F56      DIMZ    008A      DIVIDE  6B62      DIVIZ   00C4    
    DSRFLG  8317      DTECT2  606A      ELSE    7DF4      ELSEZ   0081    
    END     665E      ENDZ    008B      ENLN    8332      ENTER   7E52    
    EOL     65D6      EOLINE  6872      EOLNE1  687A      EOSTM1  6870    
    EOSTMT  6862      EQUALS  6A8E      EQZ     00BE      ERR     6652    
    ERR1    62CE      ERR1B   6738      ERR1C   67F0      ERR1CZ  69A4    
    ERR3    6304      ERR51   67F2      ERRBS   0503      ERRBV   6ECA    
    ERRBV2  70FA      ERRCDT  70FE      ERRCO1  8323      ERRCOD  8322    
    ERREX   0403      ERRFN   71A6      ERRFNN  71AC      ERRIAL  0E03    
    ERRIBS  7CFC      ERRIMP  7DA0      ERRIOR  0203      ERRLN   038A    
    ERRLNF  0303      ERRMEM  7368      ERRMS   7CB2      ERRMUV  6970    
    ERROLP  1103      ERROM   0103      ERRONE  664E      ERROR   0005    
    ERRORZ  00A5      ERRREC  0F03      ERRSN   0003      ERRSN1  6ECE    
    ERRSND  1203      ERRSNM  6D5C      ERRSO   6468      ERRSY1  6ED2    
    ERRSYN  664E      ERRT    630C      ERRTM   0603      ERRX    6308    
    EXC15L  65D0      EXEC10  650E      EXEC11  6516      EXEC15  6542    
    EXEC16  6576      EXEC17  6588      EXEC20  658E      EXEC50  6656    
    EXECG   6500      EXIT    6652      EXP     8376      EXPONZ  00C5    

 99/4 ASSEMBLER
GVWITES                                                      PAGE 0097
    EXPZZ   75CA      EXRTN   65A6      EXRTN2  65AE      EXRTN3  65C8    
    EXRTNA  6466      EXTRAM  832E      EXTRM1  832F      FAC     834A    
    FAC1    834B      FAC10   8354      FAC11   8355      FAC12   8356    
    FAC13   8357      FAC14   8358      FAC15   8359      FAC16   835A    
    FAC2    834C      FAC3    834D      FAC33   836B      FAC4    834E    
    FAC5    834F      FAC6    8350      FAC7    8351      FAC8    8352    
    FAC9    8353      FADD    0D80      FBS     15E0      FBS001  15E6    
    FBSYMB  618C      FCOMP   0D3A      FCOMPB  6126      FDIV    0FF4    
    FDVSR   8354      FDVSR1  8355      FDVSR2  8356      FDVSR8  835C    
    FILSPC  7BAA      FILSZ1  7BBA      FILSZ2  7BC0      FILSZ3  7BE2    
    FILSZ4  7BE6      FILSZ5  7BEE      FILSZ6  7BA8      FLAG    8345    
    FLG     0005      FLTERR  836C      FLTNDX  8354      FLTONE  600E    
    FMULT   0E88      FNCFLG  7506      FNERR   7D32      FNNERR  7E4C    
    FOR     7DC2      FORNET  8317      FORZ    008C      FPSIGN  03DC    
    FREPTR  8340      FSUB    0D7C      GDTECT  6050      GET     6C9A    
    GET01   79D0      GET03   79DA      GET1    6C9E      GETCGR  60D0    
    GETCH   60AE      GETCH1  60BC      GETCH2  6FDE      GETCHG  60C0    
    GETCHR  6FBA      GETG    6CCA      GETG2   6CCE      GETL10  6764    
    GETL1Z  68DA      GETNB   6FAC      GETNB1  6FAE      GETS10  73A2    
    GETSTG  61A2      GETSTK  610E      GETSTR  736C      GETV    187C    
    GETV1   1880      GO      66D6      GOSUB   673A      GOSUB2  673C    
    GOSUBZ  0087      GOT32   677E      GOT33   6792      GOT35   6798    
    GOTO    675C      GOTO20  675E      GOTO31  679C      GOTO32  67A6    
    GOTO33  67BA      GOTO34  67C8      GOTO35  67C4      GOTO36  67CE    
    GOTO40  67DA      GOTO50  67EA      GOTO90  670A      GOTO95  670E    
    GOTOZ   0086      GOZ     0085      GPL00   79E6      GPL05   7E5E    
    GPL05L  7DA4      GPL10   79FC      GPL25   7A2C      GPL30   7A38    
    GPL40   7A6A      GPL50   7A8C      GPL60   7A9C      GPL70   7ACE    
    GPLIST  A026      GPLNXT  7A24      GPLSU   757E      GREAD   7EB4    
    GREAD1  7EA6      GREATR  6A7E      GRINT   79EC      GRMRAX  0002    
    GRMWAX  0402      GRMWDX  0400      GRZ1    7EC0      GRZ2    7EC2    
    GTZ     00C0      GVWITE  7FDA      GVZ1    7FEC      GWITE1  7ECA    
    GWRITE  7ED8      GWZ1    7EE4      GWZ2    7EEC      H16     7156    
    IBSTAB  7EA0      IF      68A6      IFIF    7D94      IFZ     0084    
    IFZ10   68DE      IFZ20   68FA      IFZ25   6904      IFZ27   6910    
    IFZ28   691A      IFZ30   6928      IFZ35   692E      IFZ40   6934    
    IFZ5    68D0      IFZ50   693A      IMAGE   7DB8      IMAGEZ  00A3    
    IMPER   7D9A      INPUTZ  0092      INTRIN  8338      INUSE   7504    
    IO      7B48      JEQ1C   68EC      JNCARE  7D22      JNE88   77BC    
    JOYX    8377      JOYY    8376      KEYBRD  8375      KEYTAB  CB00    
    LBCPMO  6146      LBLPZ   6F81      LEDEND  6B42      LEDERR  6B46    
    LEDEX   6B28      LEDLE   6A90      LENGTH  6FE2      LESS    6A70    
    LETCON  69A0      LEXP    6CE2      LFALSE  6AB8      LINPUZ  00AA    
    LINUM   8312      LLC     0020      LLIST   7BFE      LLISZ4  7C10    
    LLISZ5  7C20      LLISZ6  7C42      LNBUF   8336      LNZ     00C9    
    LOGZZ   76C2      LPAR    6F6C      LPARZ   00B7      LSUBP   8348    
    LT10    6A82      LT15    6A88      LTAB    6A54      LTBLEN  001C    
    LTRUE   6ABE      LTST01  6A92      LTST15  6AB0      LTST20  6AE0    
    LTST90  6AC2      LTSTAB  6ADA      LTSTEQ  6AB6      LTSTGE  6AB4    
    LTSTGT  6AD6      LTSTLE  6AD0      LTSTLT  6AD2      LTSTNE  6ABC    
    LTSTXX  6AB4      LWCNS   6000      MEMC03  731C      MEMC04  732C    
    MEMC05  7334      MEMC06  735A      MEMC08  7360      MEMCHG  72CE    
    MEMCHK  72D8      MEMERR  7364      MINUS   6B4A      MINUSZ  00C2    
    MOTION  837A      MOVF1   6452      MOVFA2  645A      MOVFAC  6434    
    MV01    7FB4      MV05    7F96      MVDN    7F7E      MVDN1   7F92    
    MVDN2   7F8A      MVDNZ1  7FB4      MVUP    6F98      MVUP05  6FA4    
    NABS    6CFA      NATN    6D16      NCOS    6D1C      NEGPAD  7D00    
    NEXP    6D22      NEXT    0070      NEXT2   7234      NEXT2A  7228    

 99/4 ASSEMBLER
GVWITES                                                      PAGE 0098
    NEXT2B  7224      NEXT4   721C      NEXT5   72A0      NEXT6   72C8    
    NEXT8   72C4      NEXTZ   0096      NFOR    7000      NFOR03  7162    
    NFOR05  716C      NFOR07  7170      NFOR09  7174      NFOR1   7006    
    NFOR10  717E      NFOR11  71B4      NFOR12  71DE      NFOR13  71EA    
    NFOR1A  702E      NFOR1B  7050      NFOR1C  705C      NFOR1D  707E    
    NFOR1E  7084      NFOR1F  706E      NFOR2   7102      NFOR20  71C2    
    NFOR3   7110      NFOR30  71CC      NINT    6D28      NLET    6948    
    NLET05  694C      NLET10  6978      NLET15  6982      NLOG    6D2E    
    NLPR    6E68      NMIN10  6E8C      NMINUS  6E82      NNEXT   7230    
    NOCARE  7E02      NOLED   664E      NOLEDL  64FA      NONUD   664E    
    NOTZ    00BD      NPLUS   6E96      NPSCAN  7D7A      NSGN    6D34    
    NSIN    6D64      NSQR    6D6A      NSTR05  7478      NSTR10  748A    
    NSTR15  7494      NSTR20  749C      NSTRCN  7442      NTAB    69FE    
    NTABLN  0056      NTAN    6D70      NUDE10  64F4      NUDEND  65F0    
    NUDG05  64B0      NUDND1  65E6      NUDND2  65F4      NUDND3  6602    
    NUDND4  660A      NUDNDL  64FE      NUDTAB  8328      NUMC49  66A6    
    NUMCHK  6B92      NUMCON  6684      NUMZ    00C7      NXTCHR  7E32    
    O0AND   6DFA      O0AND1  6E0E      O0AND2  6E14      O0NOT   6E2E    
    O0OR    6E1C      O0XOR   6E50      OEZ     8314      OFFSET  7D84    
    ON      66DA      ON20    6710      ON30    671A      ON40    6726    
    ON50    6730      ONBRK   66D0      ONERR   66C4      ONWARN  66CA    
    ONZ     009B      OPTIOZ  009E      ORZ     00BA      OVEXP   0FC2    
    P05     648A      P1      0040      P10     6492      P17     64A8    
    P17L    64C2      P2      0050      P3      002B      P4      002D    
    P5      0070      PABPTR  8304      PAD     8300      PAD1    8301    
    PAD2    8302      PAD3    8303      PAD6    8306      PAD8    8308    
    PADC    830C      PAGE1   6000      PAGE2   6002      PAGER   7FFA    
    PAGSEL  607A      PARCOM  6F74      PARSE   6480      PARSEG  6470    
    PGMC10  6C8E      PGMCH   6410      PGMCHR  6C74      PGMPT1  832D    
    PGMPTR  832C      PGMSUB  6C7A      PLAYER  8374      PLUS    6B1E    
    PLUSZ   00C1      POPSTK  60D4      PRGFLG  8344      PROAZ   8310    
    PSCAN   7C56      PSCFG   03B7      PSHPRS  6B9C      PSYM    6884    
    PUT1    6CB2      PUTCHR  7F6E      PUTG2   6CD8      PUTSTK  60F2    
    PUTV    641E      PUTV1   6422      PWARN   6DBC      PWRZZ   7492    
    PZ      8312      QZ      8316      R0      0000      R0LB    83E1    
    R1      0001      R10     000A      R10LB   83F5      R11     000B    
    R11LB   83F7      R12     000C      R12LB   83F9      R13     000D    
    R13LB   83FB      R14     000E      R14LB   83FD      R15     000F    
    R15LB   83FF      R1LB    83E3      R2      0002      R2LB    83E5    
    R3      0003      R3LB    83E7      R4      0004      R4LB    83E9    
    R5      0005      R5LB    83EB      R6      0006      R6LB    83ED    
    R7      0007      R7LB    83EF      R8      0008      R8LB    83F1    
    R9      0009      R9LB    83F3      RAMFLG  8389      RAMPTR  830A    
    RAMTOP  8384      RAND16  83D4      RANDOM  8378      RANERR  6F64    
    RANGE   6F30      REMZ    009A      RES03   7950      RES05   7954    
    RES15   79A4      RES20   79B2      RES50   79BE      RES51   79C0    
    RES52   79C6      RESET   006A      RESGPL  79CC      RESOLV  7946    
    RETRN   6DEC      RETU30  6822      RETU40  6838      RETURN  67F8    
    RETURZ  0088      ROLIN   7AC4      ROLOUT  7A90      ROUNU   0FB2    
    ROUNUP  0F64      RPARZ   00B6      RTNADD  8326      RTNG    6630    
    SADD    0D84      SADDR   83D2      SAVEG   83CB      SAVRE2  1E90    
    SAVREG  1E8C      SBXT05  78DE      SCAL01  75A0      SCAL05  75DE    
    SCAL06  75E8      SCAL08  75F4      SCAL10  762A      SCAL12  7640    
    SCAL14  7656      SCAL15  765A      SCAL16  7666      SCAL23  76BC    
    SCAL24  76CC      SCAL26  76EC      SCAL30  7648      SCAL32  7644    
    SCAL34  764C      SCAL35  7650      SCAL37  7654      SCAL40  76F2    
    SCAL42  7700      SCAL50  7744      SCAL54  777E      SCAL60  77B4    
    SCAL62  77B8      SCAL70  783A      SCAL80  787E      SCAL81  78A0    

 99/4 ASSEMBLER
GVWITES                                                      PAGE 0099
    SCAL82  78C0      SCAL84  78B8      SCAL86  78D0      SCAL88  7878    
    SCAL89  75D4      SCAL90  75CE      SCAL91  75D8      SCAL93  75DC    
    SCAL98  793E      SCAN05  7C6E      SCAN06  7C90      SCAN07  7CB8    
    SCAN08  7CCC      SCAN09  7CD2      SCAN10  7D0E      SCAN11  7D02    
    SCAN12  7D04      SCAN15  7D10      SCAN20  7D24      SCAN25  7D86    
    SCAN26  7D36      SCAN28  7D3C      SCAN30  7D6A      SCAN35  7D74    
    SCAN40  7D56      SCAN5A  7C7A      SCAN5B  7C82      SCAN5C  7D90    
    SCAN6A  7CA0      SCAN9A  7CDC      SCGPL1  7D2E      SCLEN   8355    
    SCN26A  7D84      SCNGPL  7E58      SCNTAB  7E70      SCOMPB  0D42    
    SCRBOT  7B02      SCRO1   7B10      SCRO2   7B1A      SCRO4   7B2C    
    SCRO6   7B38      SCROLL  7ADA      SDIV    0FF8      SEETW2  6F02    
    SEETW4  6F0A      SEETW6  6F26      SEETW8  6F2A      SEETWO  6EF0    
    SEPSMT  7DFE      SET     6192      SETREG  1E7A      SGNZ    00D1    
    SHRFLG  7508      SIGN    8375      SINZZ   78C0      SKIPLN  7E38    
    SKPLN   662A      SKPS01  6624      SKPSTR  6618      SMB     61DC    
    SMB02   6202      SMB04   6210      SMB05   6214      SMB06   622C    
    SMB08   6232      SMB51   6246      SMB57   6268      SMB71   62FC    
    SMBB    61A8      SMBB10  61BE      SMBO10  6236      SMBO20  626E    
    SMBO25  6274      SMBO40  62B6      SMBO41  62B8      SMBO50  6240    
    SMBO70  62D2      SMBO71  62F6      SMTSEP  65C4      SMTSRT  831E    
    SMULT   0E8C      SNEXT   7DD6      SNTXER  7DD0      SPEED   6EE2    
    SQRZZ   783A      SREF    831C      SSEPZ   0082      SSUB    0D74    
    STACK   8373      STATUS  837C      STCOD2  6981      STCODE  6188    
    STEPZ   00B2      STKADD  8373      STKCHK  6DC0      STKDAT  8372    
    STKEND  83BA      STKMOV  60E8      STKRTN  6DF0      STLN    8330    
    STMTTB  69FC      STND12  83AE      STOP    665E      STREND  831A    
    STRINZ  00C7      STRSKP  7E3E      STRSP   8318      STVDP   18AE    
    STVDP3  18AA      STVSPT  8324      SUBNDZ  00A8      SUBTAB  833A    
    SUBXIT  78D2      SUBXTZ  00A7      SUBZ    00A1      SYM     6312    
    SYM1    6320      SYMB    61B4      SYMB10  68A2      SYMB20  687C    
    SYMBOL  0376      SYMTA1  833F      SYMTAB  833E      SYNCHK  6400    
    SYNERR  6D60      TABLEN  0030      TABSAV  0392      TANZZ   7940    
    TEMP2  

Spoiler


 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0001
  0001            ************************************************************
  0003                
  0004      74AA  CIF    EQU  >74AA             * GROM ADDRESS'S  
  0005      750A  CALL   EQU  >750A             *   
  0006      73D8  COMPCT EQU  >73D8             *   
  0007      7EF4  DELREP EQU  >7EF4             *   
  0008      736C  GETSTR EQU  >736C             *   
  0009      7EB4  GREAD  EQU  >7EB4             *   
  0010      7EA6  GREAD1 EQU  >7EA6             *   
  0011      7FDA  GVWITE EQU  >7FDA             *   
  0012      7ECA  GWITE1 EQU  >7ECA             *   
  0013      7ED8  GWRITE EQU  >7ED8             *   
  0014      7B48  IO     EQU  >7B48             *   
  0015      72CE  MEMCHG EQU  >72CE             *   
  0016      72D8  MEMCHK EQU  >72D8             *   
  0017      7F7E  MVDN   EQU  >7F7E             *   
  0018      7F8A  MVDN2  EQU  >7F8A             *   
  0019      7000  NFOR   EQU  >7000             *   
  0020      7230  NNEXT  EQU  >7230             *   
  0021      7442  NSTRCN EQU  >7442             *   
  0022      7C56  PSCAN  EQU  >7C56             *   
  0023      7946  RESOLV EQU  >7946             *   
  0024      7ADA  SCROLL EQU  >7ADA             *   
  0025      78D2  SUBXIT EQU  >78D2             *   
  0026      7FC0  VGWITE EQU  >7FC0             *   
  0027            *   
  0028            ************************************************************
  0030                
  0031            *   
  0032      6000  LWCNS  EQU  >6000   
  0033            *   
  0034      4000  WRVDP  EQU  >4000             Write enable for VDP  
  0035      8800  XVDPRD EQU  >8800             Read VDP data   
  0036      8C00  XVDPWD EQU  >8C00             Write VDP data  
  0037      9800  XGRMRD EQU  >9800             Read GROM data  
  0038      0402  GRMWAX EQU  >9C02->9800       Write GROM address  
  0039      0002  GRMRAX EQU  >9802->9800       Read GROM address   
  0040      0400  GRMWDX EQU  >9C00->9800       GROM write data   
  0041            *   
  0042      CB00  KEYTAB EQU  >CB00             ADDRESS OF KEYWORD TABLE  
  0043            *   
  0044      7D00  NEGPAD EQU  >7D00   
  0045      8300  PAD0   EQU  >8300   
  0046      8301  PAD1   EQU  >8301   
  0047      835F  PAD5F  EQU  >835F   
  0048      83C2  PADC2  EQU  >83C2   
  0049            *   
  0050      8300  VAR0   EQU  >8300   
  0051      8302  MNUM   EQU  >8302   
  0052      8303  MNUM1  EQU  >8303   
  0053      8304  PABPTR EQU  >8304   
  0054      8306  CCPPTR EQU  >8306   
  0055      8308  CCPADR EQU  >8308   
  0056      830A  RAMPTR EQU  >830A   
  0057      830A  CALIST EQU  RAMPTR  
  0058      830C  BYTE   EQU  >830C   
  0059      8310  PROAZ  EQU  >8310   
  0060      8310  VAR5   EQU  PROAZ   
  0061      8312  PZ     EQU  >8312   

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0002
  0062      8312  LINUM  EQU  PZ  
  0063      8314  OEZ    EQU  >8314   
  0064      8316  QZ     EQU  >8316   
  0065      8316  XFLAG  EQU  QZ  
  0066      8316  VAR9   EQU  QZ  
  0067      8317  DSRFLG EQU  >8317   
  0068      8317  FORNET EQU  DSRFLG  
  0069      8318  STRSP  EQU  >8318   
  0070      831A  CZ     EQU  >831A   
  0071      831A  STREND EQU  CZ  
  0072      831A  WSM    EQU  CZ  
  0073      831C  SREF   EQU  >831C * Temporary string pointer  
  0074      831C  WSM2   EQU  SREF  * Temporary string pointer  
  0075      831E  WSM4   EQU  >831E * Start of current statement  
  0076      831E  SMTSRT EQU  WSM4  * Start of current statement  
  0077      8320  WSM6   EQU  >8320 * Screen address  
  0078      8320  VARW   EQU  WSM6  * Screen address  
  0079      8321  VARW1  EQU  >8321   
  0080      8322  ERRCOD EQU  >8322 * Return error code from ALC  
  0081      8322  WSM8   EQU  ERRCOD * Return error code from ALC   
  0082      8323  ERRCO1 EQU  >8323   
  0083      8324  STVSPT EQU  >8324 * Value-stack base  
  0084      8326  RTNADD EQU  >8326   
  0085      8328  NUDTAB EQU  >8328   
  0086      832A  VARA   EQU  >832A * Ending display location   
  0087      832C  PGMPTR EQU  >832C * Program text pointer  
  0088      832D  PGMPT1 EQU  >832D   
  0089      832E  EXTRAM EQU  >832E * Line number table pointer   
  0090      832F  EXTRM1 EQU  >832F   
  0091      8330  STLN   EQU  >8330 * Start of line number table  
  0092      8332  ENLN   EQU  >8332 * End of line number table  
  0093      8334  DATA   EQU  >8334 * Data pointer for READ   
  0094      8336  LNBUF  EQU  >8336 * Line table pointer for READ   
  0095      8338  INTRIN EQU  >8338 * Add of intrinsic poly constant  
  0096      833A  SUBTAB EQU  >833A * Subprogram symbol table   
  0097      833E  SYMTAB EQU  >833E * Symbol table pointer  
  0098      833F  SYMTA1 EQU  >833F   
  0099      8340  FREPTR EQU  >8340 * Free space pointer  
  0100      8342  CHAT   EQU  >8342 * Current charater/token  
  0101      8343  BASE   EQU  >8343 * OPTION BASE value   
  0102      8344  PRGFLG EQU  >8344 * Program/imperative flag   
  0103      8345  FLAG   EQU  >8345 * General 8-bit flag  
  0104      8346  BUFLEV EQU  >8346 * Crunch-buffer destruction level   
  0105      8348  LSUBP  EQU  >8348 * Last subprogram block on stack  
  0106      834A  FAC    EQU  >834A * Floating-point ACcurmulator   
  0107      834B  FAC1   EQU  >834B   
  0108      834C  FAC2   EQU  >834C   
  0109      834E  FAC4   EQU  >834E   
  0110      834F  FAC5   EQU  >834F   
  0111      8350  FAC6   EQU  >8350   
  0112      8351  FAC7   EQU  >8351   
  0113      8352  FAC8   EQU  >8352   
  0114      8353  FAC9   EQU  >8353   
  0115      8354  FAC10  EQU  >8354   
  0116      8354  FLTNDX EQU  FAC10   
  0117      8354  FDVSR  EQU  FAC10   
  0118      8355  FAC11  EQU  >8355   
  0119      8355  SCLEN  EQU  FAC11   
  0120      8355  FDVSR1 EQU  FAC11   

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0003
  0121      8356  FAC12  EQU  >8356   
  0122      8356  FDVSR2 EQU  FAC12   
  0123      8357  FAC13  EQU  >8357   
  0124      8358  FAC14  EQU  >8358   
  0125      8359  FAC15  EQU  >8359   
  0126      835A  FAC16  EQU  >835A   
  0127      835C  FDVSR8 EQU  >835C * Floating-point ARGument   
  0128      835C  ARG    EQU  FDVSR8 * Floating-point ARGument  
  0129      835D  ARG1   EQU  >835D   
  0130      835E  ARG2   EQU  >835E   
  0131      835F  ARG3   EQU  >835F   
  0132      8360  ARG4   EQU  >8360   
  0133      8364  ARG8   EQU  >8364   
  0134      8365  ARG9   EQU  >8365   
  0135      8366  ARG10  EQU  >8366   
  0136      836B  FAC33  EQU  >836B   
  0137      836C  TEMP2  EQU  >836C   
  0138      836C  FLTERR EQU  TEMP2   
  0139      836D  TYPE   EQU  >836D   
  0140      836E  VSPTR  EQU  >836E * Value stack pointer   
  0141      836F  VSPTR1 EQU  >836F   
  0142      8372  STKDAT EQU  >8372   
  0143      8373  STKADD EQU  >8373   
  0144      8373  STACK  EQU  >8373   
  0145      8374  PLAYER EQU  >8374   
  0146      8375  KEYBRD EQU  >8375   
  0147      8375  SIGN   EQU  KEYBRD  
  0148      8376  JOYY   EQU  >8376 * Exponent in floating-point  
  0149      8376  EXP    EQU  JOYY  
  0150      8377  JOYX   EQU  >8377   
  0151      8378  RANDOM EQU  >8378   
  0152      8379  TIME   EQU  >8379   
  0153      837A  MOTION EQU  >837A   
  0154      837B  VDPSTS EQU  >837B   
  0155      837C  STATUS EQU  >837C   
  0156      837D  CHRBUF EQU  >837D   
  0157      837E  YPT    EQU  >837E   
  0158      837F  XPT    EQU  >837F   
  0159      8389  RAMFLG EQU  >8389 * ERAM flag   
  0160      83BA  STKEND EQU  >83BA   
  0161      83AE  STND12 EQU  STKEND-12   
  0162      83C0  CRULST EQU  >83C0   
  0163      83CB  SAVEG  EQU  >83CB   
  0164      83D2  SADDR  EQU  >83D2   
  0165      83D4  RAND16 EQU  >83D4   
  0166            *   
  0167      83E0  WS     EQU  >83E0   
  0168      83E1  R0LB   EQU  >83E1   
  0169      83E3  R1LB   EQU  >83E3   
  0170      83E5  R2LB   EQU  >83E5   
  0171      83E7  R3LB   EQU  >83E7   
  0172      83E9  R4LB   EQU  >83E9   
  0173      83EB  R5LB   EQU  >83EB   
  0174      83ED  R6LB   EQU  >83ED   
  0175      83EF  R7LB   EQU  >83EF   
  0176      83F1  R8LB   EQU  >83F1   
  0177      83F3  R9LB   EQU  >83F3   
  0178      83F5  R10LB  EQU  >83F5   
  0179      83F7  R11LB  EQU  >83F7   

 99/4 ASSEMBLER
EQUATES                                                      PAGE 0004
  0180      83F9  R12LB  EQU  >83F9   
  0181      83FB  R13LB  EQU  >83FB   
  0182      83FD  R14LB  EQU  >83FD   
  0183      83FF  R15LB  EQU  >83FF   
  0184            *   
  0185      8302  GDST   EQU  >8302   
  0186      8303  AAA11  EQU  >8303   
  0187      8303  GDST1  EQU  >8303   
  0188      8304  VARY   EQU  >8304   
  0189      8306  VARY2  EQU  >8306   
  0190      8308  BCNT2  EQU  >8308   
  0191      830C  CSRC   EQU  >830C   
  0192      834C  ADDR1  EQU  >834C   
  0193      834D  ADDR11 EQU  >834D   
  0194      834E  BCNT1  EQU  >834E   
  0195      8350  ADDR2  EQU  >8350   
  0196      8351  ADDR21 EQU  >8351   
  0197      8354  GSRC   EQU  >8354   
  0198      8355  DDD11  EQU  >8355   
  0199      8355  GSRC1  EQU  >8355   
  0200      8356  BCNT3  EQU  >8356   
  0201      8358  DEST   EQU  >8358   
  0202      8359  DEST1  EQU  >8359   
  0203      8384  RAMTOP EQU  >8384   
  0204            * VDP variables   
  0205      0376  SYMBOL EQU  >0376 * Saved symbol table pointer  
  0206      038A  ERRLN  EQU  >038A * On-error line pointer   
  0207      0392  TABSAV EQU  >0392 * Saved main symbol table ponter  
  0208      03C0  VROAZ  EQU  >03C0 * Temporary VDP Roll Out Area   
  0209      03DC  FPSIGN EQU  >03DC   
  0210      0820  CRNBUF EQU  >0820 * CRuNch BUFfer address   
  0211      091C  CRNEND EQU  >091C * CRuNch buffer END   
  0212            ************************************************************
  0213 6000              AORG >6000   
  0215                
  0216            * PAGE SELECTOR FOR PAGE 1  
  0217      6000  PAGE1  EQU  $                 >6000   
  0218 6000 0002  C2     DATA 2                 0   
  0219            * PAGE SELECTOR FOR PAGE 2  
  0220      6002  PAGE2  EQU  $                 >6002   
  0221 6002   00  C7     BYTE >00   
  0222 6003   07  CBH7   BYTE >07               2   
  0223 6004   0A  CBHA   BYTE >0A   
  0224 6005   94  CBH94  BYTE >94               4   
  0225 6006 0028  C40    DATA 40                6   
  0226 6008 0064  C100   DATA 100               8   
  0227 600A 1000  C1000  DATA >1000             A   
  0228 600C 0000         DATA 0                 C   
  0229 600E 4001  FLTONE DATA >4001             E   
  0230            ************************************************************
  0231            * XML table number 7 for Extended Basic - must have   
  0232            *     it's origin at >6010  
  0233            ************************************************************
  0234            *           0      1      2      3      4      5     6  
  0235 6010 619C         DATA COMPCG,GETSTG,MEMCHG,CNSSEL,PARSEG,CONTG,EXECG  
       6012 61A2  
       6014 72CE  
       6016 6070  
       6018 6470  

 99/4 ASSEMBLER
XML359                                                       PAGE 0005
       601A 64C4  
       601C 6500  
  0236            *           7      8    9     A    B    C      D  
  0237 601E 61BA         DATA VPUSHG,VPOP,PGMCH,SYMB,SMBB,ASSGNV,FBSYMB   
       6020 6C2A  
       6022 6410  
       6024 61B4  
       6026 61A8  
       6028 61AE  
       602A 618C  
  0238            *             E     F   
  0239 602C 6EE2         DATA SPEED,CRNSEL  
       602E 6076  
  0240            ************************************************************
  0241            * XML table number 8 for Extended Basic - must have   
  0242            *     it's origin at >6030  
  0243            ************************************************************
  0244            *           0   1      2    3      4  5     6      7  
  0245 6030 74AA         DATA CIF,CONTIN,RTNG,SCROLL,IO,GREAD,GWRITE,DELREP   
       6032 65CC  
       6034 6630  
       6036 7ADA  
       6038 7B48  
       603A 7EB4  
       603C 7ED8  
       603E 7EF4  
  0246            *           8    9    A      B      C      D      E   
  0247 6040 7F7E         DATA MVDN,MVUP,VGWITE,GVWITE,GREAD1,GWITE1,GDTECT  
       6042 6F98  
       6044 7FC0  
       6046 7FDA  
       6048 7EA6  
       604A 7ECA  
       604C 6050  
  0248            *           F   
  0249 604E 7C56         DATA PSCAN   
  0250                
  0251            * Determine if and how much ERAM is present   
  0252 6050 D80B  GDTECT MOVB R11,@PAGE1        First enable page 1 ROM   
       6052 6000  
  0253            *-----------------------------------------------------------
  0254            * Replace following line      6/16/81   
  0255            * (Extended Basic must be made to leave enough space at   
  0256            * top of RAM expansion for the "hooks" left by the 99/4A  
  0257            * for TIBUG.)   
  0258            *      SETO R0                Start at >FFFF  
  0259            * with  
  0260            *      LI   R0,>FFE7          Start at >FFE7  
  0261            ************************************************************
  0262            * RXB 2020 change for PRAM command  
  0263 6054 C020         MOV  @RAMTOP,R0        PRAM sets RAMTOP value  
       6056 8384  
  0264            *-----------------------------------------------------------
  0265 6058 D40B         MOVB R11,*R0           Write a byte of data  
  0266 605A 940B         CB   R11,*R0           Read and compare the data   
  0267 605C 1306         JEQ  DTECT2            If matches-found ERAM top   
  0268            *-----------------------------------------------------------
  0269            * Change the following line   6/16/81   
  0270            *      AI   R0,->2000         Else drop down 8K   

 99/4 ASSEMBLER
XML359                                                       PAGE 0006
  0271 605E 0200         LI   R0,>DFFF          Else drop down 8K   
       6060 DFFF  
  0272            *-----------------------------------------------------------
  0273 6062 D40B         MOVB R11,*R0           Write a byte of data  
  0274 6064 940B         CB   R11,*R0           Read and compare the data   
  0275 6066 1301         JEQ  DTECT2            If matches-found ERAM top   
  0276 6068 04C0         CLR  R0                No match so no ERAM   
  0277 606A C800  DTECT2 MOV  R0,@RAMTOP        Set the ERAM top  
       606C 8384  
  0278 606E 045B         RT                     And return to GPL   
  0279 6070 0202  CNSSEL LI   R2,CNS  
       6072 7016  
  0280 6074 1002         JMP  PAGSEL  
  0281 6076 0202  CRNSEL LI   R2,CRUNCH   
       6078 7B88  
  0282            * Select page 2 for CRUNCH and CNS  
  0283 607A 05E0  PAGSEL INCT @STKADD           Get space on subroutine stack 
       607C 8373  
  0284 607E D1E0         MOVB @STKADD,R7        Get stack pointer   
       6080 8373  
  0285 6082 0987         SRL  R7,8              Shift to use as offset  
  0286 6084 D9CB         MOVB R11,@PAD0(R7)     Save return addr to GPL interp
       6086 8300  
  0287 6088 D9E0         MOVB @R11LB,@PAD1(R7)  
       608A 83F7  
       608C 8301  
  0288 608E D80B         MOVB R11,@PAGE2        Select page 2   
       6090 6002  
  0289 6092 0692         BL   *R2               Do the conversion   
  0290 6094 D80B         MOVB R11,@PAGE1        Reselect page 1   
       6096 6000  
  0291 6098 D1E0         MOVB @STKADD,R7        Get subroutine stack pointer  
       609A 8373  
  0292 609C 0660         DECT @STKADD           Decrement pointer   
       609E 8373  
  0293 60A0 0987         SRL  R7,8              Shift to use as offset  
  0294 60A2 D2E7         MOVB @PAD0(R7),R11     Restore return address  
       60A4 8300  
  0295 60A6 D827         MOVB @PAD1(R7),@R11LB  
       60A8 8301  
       60AA 83F7  
  0296 60AC 045B         RT                     Return to GPL interpeter  
  0297 60AE D7E0  GETCH  MOVB @R6LB,*R15  
       60B0 83ED  
  0298 60B2 1000         NOP  
  0299 60B4 D7C6         MOVB R6,*R15   
  0300 60B6 0586         INC  R6  
  0301 60B8 D220         MOVB @XVDPRD,R8  
       60BA 8800  
  0302 60BC 0988  GETCH1 SRL  R8,8  
  0303 60BE 045B         RT   
  0304 60C0 DB46  GETCHG MOVB R6,@GRMWAX(R13)   
       60C2 0402  
  0305 60C4 DB60         MOVB @R6LB,@GRMWAX(R13)  
       60C6 83ED  
       60C8 0402  
  0306 60CA 0586         INC  R6  
  0307 60CC D21D         MOVB *R13,R8   
  0308 60CE 10F6         JMP  GETCH1  

 99/4 ASSEMBLER
XML359                                                       PAGE 0007
  0309 60D0 D236  GETCGR MOVB *R6+,R8   
  0310 60D2 10F4         JMP  GETCH1  
  0311            *   
  0312      60D6  CBHFF  EQU  $+2   
  0313 60D4 0205  POPSTK LI   R5,-8   
       60D6 FFF8  
  0314 60D8 D7E0         MOVB @VSPTR1,*R15  
       60DA 836F  
  0315 60DC 0206         LI   R6,ARG  
       60DE 835C  
  0316 60E0 D7E0         MOVB @VSPTR,*R15   
       60E2 836E  
  0317 60E4 A805         A    R5,@VSPTR   
       60E6 836E  
  0318 60E8 DDA0  STKMOV MOVB @XVDPRD,*R6+  
       60EA 8800  
  0319 60EC 0585         INC  R5  
  0320 60EE 16FC         JNE  STKMOV  
  0321 60F0 045B         RT   
  0322            *   
  0323 60F2 05E0  PUTSTK INCT @STKADD   
       60F4 8373  
  0324 60F6 D120         MOVB @STKADD,R4  
       60F8 8373  
  0325 60FA 0984         SRL  R4,8  
  0326 60FC D92D         MOVB @GRMRAX(13),@PAD0(R4)   
       60FE 0002  
       6100 8300  
  0327 6102 D92D         MOVB @GRMRAX(13),@PAD1(R4)   
       6104 0002  
       6106 8301  
  0328 6108 0624         DEC  @PAD0(R4)   
       610A 8300  
  0329 610C 045B         RT   
  0330            *   
  0331 610E D120  GETSTK MOVB @STKADD,R4  
       6110 8373  
  0332 6112 0984         SRL  R4,8  
  0333 6114 0660         DECT @STKADD   
       6116 8373  
  0334 6118 DB64         MOVB @PAD0(R4),@GRMWAX(R13)  
       611A 8300  
       611C 0402  
  0335 611E DB64         MOVB @PAD1(R4),@GRMWAX(R13)  
       6120 8301  
       6122 0402  
  0336 6124 045B         RT   
  0337            ************************************************************
  0338 6126              AORG >6126   
  0340                
  0341      0F64  ROUNUP EQU  >0F64   Uses XML >01 Rounding of floating point 
  0342      0D42  SCOMPB EQU  >0D42   Set SCOMP with direct return without GPL
  0343      12B8  CFI    EQU  >12B8   CFI (XML >12)   
  0344      0E8C  SMULT  EQU  >0E8C   SMUL (XML >0D)  
  0345      0FF4  FDIV   EQU  >0FF4   FDIV (XML >09)  
  0346      0FC2  OVEXP  EQU  >0FC2   Overflow (XML >04)  
  0347      0E88  FMULT  EQU  >0E88   FMUL (XML >08)  
  0348      0D74  SSUB   EQU  >0D74   SSUB (XML >0C)  
  0349      0D80  FADD   EQU  >0D80   FADD (XML >06)  

 99/4 ASSEMBLER
REFS359                                                      PAGE 0008
  0350      0FF8  SDIV   EQU  >0FF8   SDIV (XML >0E)  
  0351      0D7C  FSUB   EQU  >0D7C   FSUB (XML (>07)   
  0352      0D84  SADD   EQU  >0D84   SADD (XML >0B)  
  0353      0FB2  ROUNU  EQU  >0FB2   Rounding with digit number in >8354 (XML
  0354      006A  RESET  EQU  >006A   Clear condition bit in GPL status (GPL i
  0355      0070  NEXT   EQU  >0070   GPL interpreter   
  0356      11B2  CSN01  EQU  >11B2   CSN (XML >10) (Without R3 loaded with >1
  0357      0D3A  FCOMP  EQU  >0D3A   FCOMP (XML >0A)   
  0358 6126 C0CB  FCOMPB MOV  R11,R3  
  0359 6128 0460         B    @FCOMP+22   
       612A 0D50  
  0360      187C  GETV   EQU  >187C   Read 1 byte from VDP, Entry over data ad
  0361      1880  GETV1  EQU  >1880   Same >187C but does not fetch address, i
  0362      1E8C  SAVREG EQU  >1E8C   Set substack pointer and Basic byte   
  0363      1E90  SAVRE2 EQU  >1E90   Same >1E8C but does not set R8 into >834
  0364      1E7A  SETREG EQU  >1E7A   Substack pointer in R9 and actual Basic 
  0365      18AA  STVDP3 EQU  >18AA   Write R6 in VDP (R1=Address+3),   
  0366            *                   used for variable table and string point
  0367      18AE  STVDP  EQU  >18AE   Write R6 in VDP (R1=Address+3),   
  0368            *                   used for variable table and string point
  0369      15E0  FBS    EQU  >15E0   Pointer fetch var list  
  0370      15E6  FBS001 EQU  >15E6   Fetch length byte   
  0371            ************************************************************
  0372                
  0373 612C              AORG >612C   
  0375                
  0376            *   
  0377            * The CHARACTER PROPERTY TABLE  
  0378            * There is a one-byte entry for every character code  
  0379            * in the range LLC(lowest legal character) to   
  0380            * HLC(highest legal character), inclusive.  
  0381      0020  LLC    EQU  >20   
  0382      0000  CPNIL  EQU  >00               " $ % ' ?   
  0383      0002  CPDIG  EQU  >02               digit (0-9)   
  0384      0004  CPNUM  EQU  >04               digit, period, E  
  0385      0008  CPOP   EQU  >08               1 char operators(!#*+-/<=>^ ) 
  0386      0010  CPMO   EQU  >10               multiple operator ( : )   
  0387      0020  CPALPH EQU  >20               A-Z, @, _   
  0388      0040  CPBRK  EQU  >40               ( ) , ;   
  0389      0080  CPSEP  EQU  >80               space   
  0390      0022  CPALNM EQU  CPALPH+CPDIG      alpha-digit   
  0391            *-----------------------------------------------------------
  0392            * Following lines are for adding lowercase character set in 
  0393            * 99/4A,                      5/12/81   
  0394      0001  CPLOW  EQU  >01               a-z   
  0395      0023  CPULNM EQU  CPALNM+CPLOW      Alpha(both upper and lower)+  
  0396            *                             digit-legal variable character
  0397      0021  CPUL   EQU  CPALPH+CPLOW      Alpha(both upper and lower)   
  0398            *-----------------------------------------------------------
  0399      610C  CPTBL  EQU  $-LLC   
  0400 612C   80         BYTE CPSEP               SPACE   
  0401 612D   08         BYTE CPOP              ! EXCLAMATION POINT   
  0402 612E   00         BYTE CPNIL             " QUOTATION MARKS   
  0403 612F   08         BYTE CPOP              # NUMBER SIGN   
  0404 6130   00         BYTE CPNIL             $ DOLLAR SIGN   
  0405 6131   00         BYTE CPNIL             % PERCENT   
  0406 6132   08         BYTE CPOP              & AMPERSAND   
  0407 6133   00         BYTE CPNIL             ' APOSTROPHE  
  0408 6134   40         BYTE CPBRK             ( LEFT PARENTHESIS  

 99/4 ASSEMBLER
CPT                                                          PAGE 0009
  0409 6135   40         BYTE CPBRK             ) RIGHT PARENTHESIS   
  0410 6136   08         BYTE CPOP              * ASTERISK  
  0411 6137   0C         BYTE CPOP+CPNUM        + PLUS  
  0412 6138   40         BYTE CPBRK             , COMMA   
  0413 6139   0C         BYTE CPOP+CPNUM        - MINUS   
  0414 613A   04         BYTE CPNUM             . PERIOD  
  0415 613B   08         BYTE CPOP              / SLANT   
  0416 613C   06         BYTE CPNUM+CPDIG       0 ZERRO   
  0417 613D   06         BYTE CPNUM+CPDIG       1 ONE   
  0418 613E   06         BYTE CPNUM+CPDIG       2 TWO   
  0419 613F   06         BYTE CPNUM+CPDIG       3 THREE   
  0420 6140   06         BYTE CPNUM+CPDIG       4 FOUR  
  0421 6141   06         BYTE CPNUM+CPDIG       5 FIVE  
  0422 6142   06         BYTE CPNUM+CPDIG       6 SIX   
  0423 6143   06         BYTE CPNUM+CPDIG       7 SEVEN   
  0424 6144   06         BYTE CPNUM+CPDIG       8 EIGHT   
  0425 6145   06         BYTE CPNUM+CPDIG       9 NINE  
  0426 6146   10  LBCPMO BYTE CPMO              : COLON   
  0427 6147   40         BYTE CPBRK             : SEMICOLON   
  0428 6148   08         BYTE CPOP              < LESS THAN   
  0429 6149   08         BYTE CPOP              = EQUALS  
  0430 614A   08         BYTE CPOP              > GREATER THAN  
  0431 614B   00         BYTE CPNIL             ? QUESTION MARK   
  0432 614C   20         BYTE CPALPH            @ COMMERCIAL AT   
  0433 614D   20         BYTE CPALPH            A UPPERCASE A   
  0434 614E   20         BYTE CPALPH            B UPPERCASE B   
  0435 614F   20         BYTE CPALPH            C UPPERCASE C   
  0436 6150   20         BYTE CPALPH            D UPPERCASE D   
  0437 6151   24         BYTE CPALPH+CPNUM      E UPPERCASE E   
  0438 6152   20         BYTE CPALPH            F UPPERCASE F   
  0439 6153   20         BYTE CPALPH            G UPPERCASE G   
  0440 6154   20         BYTE CPALPH            H UPPERCASE H   
  0441 6155   20         BYTE CPALPH            I UPPERCASE I   
  0442 6156   20         BYTE CPALPH            J UPPERCASE J   
  0443 6157   20         BYTE CPALPH            K UPPERCASE K   
  0444 6158   20         BYTE CPALPH            L UPPERCASE L   
  0445 6159   20         BYTE CPALPH            M UPPERCASE M   
  0446 615A   20         BYTE CPALPH            N UPPERCASE N   
  0447 615B   20         BYTE CPALPH            O UPPERCASE O   
  0448 615C   20         BYTE CPALPH            P UPPERCASE P   
  0449 615D   20         BYTE CPALPH            Q UPPERCASE Q   
  0450 615E   20         BYTE CPALPH            R UPPERCASE R   
  0451 615F   20         BYTE CPALPH            S UPPERCASE S   
  0452 6160   20         BYTE CPALPH            T UPPERCASE T   
  0453 6161   20         BYTE CPALPH            U UPPERCASE U   
  0454 6162   20         BYTE CPALPH            V UPPERCASE V   
  0455 6163   20         BYTE CPALPH            W UPPERCASE W   
  0456 6164   20         BYTE CPALPH            X UPPERCASE X   
  0457 6165   20         BYTE CPALPH            Y UPPERCASE Y   
  0458 6166   20         BYTE CPALPH            Z UPPERCASE Z   
  0459 6167   20         BYTE CPALPH            [ LEFT SQUARE BRACKET   
  0460 6168   20         BYTE CPALPH            \ REVERSE SLANT   
  0461 6169   20         BYTE CPALPH            ] RIGHT SQUARE BRACKET  
  0462 616A   08         BYTE CPOP              ^ CIRCUMFLEX  
  0463 616B   20         BYTE CPALPH            _ UNDERLINE   
  0464            *-----------------------------------------------------------
  0465            * Following "`" and lowercase characters are for  
  0466            * adding lowercase character set in 99/4A, 5/12/81  
  0467            *-----------------------------------------------------------

 99/4 ASSEMBLER
CPT                                                          PAGE 0010
  0468 616C   00         BYTE CPNIL             ` GRAVE ACCENT  
  0469 616D   21         BYTE CPALPH+CPLOW      a LOWERCASE a   
  0470 616E   21         BYTE CPALPH+CPLOW      b LOWERCASE b   
  0471 616F   21         BYTE CPALPH+CPLOW      c LOWERCASE c   
  0472 6170   21         BYTE CPALPH+CPLOW      d LOWERCASE d   
  0473 6171   21         BYTE CPALPH+CPLOW      e LOWERCASE e   
  0474 6172   21         BYTE CPALPH+CPLOW      f LOWERCASE f   
  0475 6173   21         BYTE CPALPH+CPLOW      g LOWERCASE g   
  0476 6174   21         BYTE CPALPH+CPLOW      h LOWERCASE h   
  0477 6175   21         BYTE CPALPH+CPLOW      i LOWERCASE i   
  0478 6176   21         BYTE CPALPH+CPLOW      j LOWERCASE j   
  0479 6177   21         BYTE CPALPH+CPLOW      k LOWERCASE k   
  0480 6178   21         BYTE CPALPH+CPLOW      l LOWERCASE l   
  0481 6179   21         BYTE CPALPH+CPLOW      m LOWERCASE m   
  0482 617A   21         BYTE CPALPH+CPLOW      n LOWERCASE n   
  0483 617B   21         BYTE CPALPH+CPLOW      o LOWERCASE o   
  0484 617C   21         BYTE CPALPH+CPLOW      p LOWERCASE p   
  0485 617D   21         BYTE CPALPH+CPLOW      q LOWERCASE q   
  0486 617E   21         BYTE CPALPH+CPLOW      r LOWERCASE r   
  0487 617F   21         BYTE CPALPH+CPLOW      s LOWERCASE s   
  0488 6180   21         BYTE CPALPH+CPLOW      t LOWERCASE t   
  0489 6181   21         BYTE CPALPH+CPLOW      u LOWERCASE u   
  0490 6182   21         BYTE CPALPH+CPLOW      v LOWERCASE v   
  0491 6183   21         BYTE CPALPH+CPLOW      w LOWERCASE w   
  0492 6184   21         BYTE CPALPH+CPLOW      x LOWERCASE x   
  0493 6185   21         BYTE CPALPH+CPLOW      y LOWERCASE y   
  0494 6186   21         BYTE CPALPH+CPLOW      z LOWERCASE z   
  0495                
  0496                   EVEN   
  0497            ************************************************************
  0498 6188              AORG >6188   
  0500                
  0501            * General Basic support routines (not includeing PARSE)   
  0502                
  0503            *   
  0504      0503  ERRBS  EQU  >0503             BAD SUBSCRIPT ERROR CODE  
  0505      0603  ERRTM  EQU  >0603             ERROR STRING/NUMBER MISMATCH  
  0506            *   
  0507 6188 6500  STCODE DATA >6500   
  0508 618A 0006  C6     DATA >0006   
  0509            *   
  0510            * Entry to find Basic symbol table entry for GPL  
  0511            *   
  0512 618C 06A0  FBSYMB BL   @FBS              Search the symbol table   
       618E 15E0  
  0513 6190 006A         DATA RESET             If not found - condition reset
  0514 6192 F820  SET    SOCB @BIT2,@STATUS     Set GPL condition   
       6194 62AB  
       6196 837C  
  0515 6198 0460         B    @NEXT             If found - condition set  
       619A 0070  
  0516            * GPL entry for COMPCT to take advantage of common code   
  0517 619C 0206  COMPCG  LI   R6,COMPCT        Address of COMPCT   
       619E 73D8  
  0518 61A0 100E         JMP  SMBB10            Jump to set up  
  0519            * GPL entry for GETSTR to take advantage of common code   
  0520 61A2 0206  GETSTG LI   R6,GETSTR         Address of MEMCHK   
       61A4 736C  
  0521 61A6 100B         JMP  SMBB10            Jump to set up  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0011
  0522            * GPL entry for SMB to take advantage of common code  
  0523 61A8 0206  SMBB   LI   R6,SMB            Address of SMB routine  
       61AA 61DC  
  0524 61AC 1008         JMP  SMBB10            Jump to set up  
  0525            * GPL entry for ASSGNV to take advantage of common code   
  0526 61AE 0206  ASSGNV LI   R6,ASSG           Address of ASSGNV routine   
       61B0 6334  
  0527 61B2 1005         JMP  SMBB10            Jump to set up  
  0528            * GPL entry for SMB to take advantage of common code  
  0529 61B4 0206  SYMB   LI   R6,SYM            Address of SYM routine  
       61B6 6312  
  0530 61B8 1002         JMP  SMBB10            Jump to set up  
  0531            * GPL entry for SMB to take advantage of common code  
  0532 61BA 0206  VPUSHG LI   R6,VPUSH          Address of VPUSH routine  
       61BC 6BAA  
  0533 61BE C1CB  SMBB10 MOV  R11,R7            Save return address   
  0534 61C0 06A0         BL   @PUTSTK           Save current GROM address   
       61C2 60F2  
  0535 61C4 06A0         BL   @SETREG           Set up Basic registers  
       61C6 1E7A  
  0536 61C8 05C9         INCT R9                Get space on subroutine stack 
  0537 61CA C647         MOV  R7,*R9            Save the return address   
  0538 61CC 0696         BL   *R6               Branch and link to the routine
  0539 61CE C1D9         MOV  *R9,R7            Get return address  
  0540 61D0 0649         DECT R9                Restore subroutine stack  
  0541 61D2 06A0         BL   @SAVREG           Save registers for GPL  
       61D4 1E8C  
  0542 61D6 06A0         BL   @GETSTK           Restore GROM address  
       61D8 610E  
  0543 61DA 0457         B    *R7               Return to GPL   
  0544            ************************************************************
  0545            * Subroutine to find the pointer to variable space of each  
  0546            * element of symbol table entry. Decides whether symbol   
  0547            * table entry pointed to by FAC, FAC+1 is a simple variable 
  0548            * and returns proper 8-byte block in FAC through FAC7   
  0549            ************************************************************
  0550 61DC 05C9  SMB    INCT R9                Get space on subroutine stack 
  0551 61DE C64B         MOV  R11,*R9           Save return address   
  0552 61E0 C820         MOV  @FAC,@FAC4        Copy pointer to table entry   
       61E2 834A  
       61E4 834E  
  0553 61E6 A820         A    @C6,@FAC4         Add 6 so point a value space  
       61E8 618A  
       61EA 834E  
  0554 61EC 06A0         BL   @GETV             Get 1st byte of table entry   
       61EE 187C  
  0555 61F0 834A         DATA FAC               Pointer is in FAC   
  0556            *   
  0557 61F2 C101         MOV  R1,R4             Copy for later use.   
  0558 61F4 C081         MOV  R1,R2             Copy for later use.   
  0559 61F6 0A21         SLA  R1,2              Check for UDF entry   
  0560 61F8 1821         JOC  BERMUV            If UDF - then error   
  0561 61FA C104         MOV  R4,R4             Check for string.   
  0562 61FC 1102         JLT  SMB02             Skip if it is string.   
  0563 61FE 04E0         CLR  @FAC2             Clear for numeric case.   
       6200 834C  
  0564            *   
  0565            * In case of subprogram call check if parameter is shared by
  0566            * it's  calling program.  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0012
  0567            *   
  0568 6202 0A11  SMB02  SLA  R1,1              Check for the shared bit.   
  0569 6204 1705         JNC  SMB04             If it is not shared skip.   
  0570 6206 06A0         BL   @GET              Get the value space pointer   
       6208 6C9A  
  0571 620A 834E         DATA FAC4                in the symbol table.  
  0572 620C C801         MOV  R1,@FAC4          Store the value space address.
       620E 834E  
  0573            *   
  0574            * Branches to take care of string and array cases.  
  0575            * Only the numeric variable case stays on.  
  0576            *   
  0577 6210 D104  SMB04  MOVB R4,R4             R4 has header byte information
  0578 6212 1116         JLT  SMBO50            Take care of string.  
  0579 6214 0A54  SMB05  SLA  R4,5              Get only the dimension number.
  0580 6216 09D4         SRL  R4,13   
  0581 6218 162A         JNE  SMBO20             go to array case.  
  0582            *   
  0583            * Numeric ERAM cases are special.   
  0584            * If it is shared get the actual v.s. address from ERAM.  
  0585            * Otherwise get it from VDP RAM.  
  0586            *   
  0587 621A D120         MOVB @RAMTOP,R4        Check for ERAM.   
       621C 8384  
  0588 621E 130B         JEQ  SMBO10            Yes ERAM case.  
  0589 6220 0A32         SLA  R2,3              R2 has a header byte.   
  0590 6222 1704         JNC  SMB06             Shared bit is not ON.   
  0591 6224 06A0         BL   @GETG             Get v.s. pointer from ERAM  
       6226 6CCA  
  0592 6228 834E         DATA FAC4  
  0593 622A 1003         JMP  SMB08   
  0594 622C 06A0  SMB06  BL   @GET              Not shared.   
       622E 6C9A  
  0595 6230 834E         DATA FAC4              Get v.s. address from VDP RAM.
  0596            *   
  0597 6232 C801  SMB08  MOV  R1,@FAC4          Store it in FAC4 area.  
       6234 834E  
  0598            *   
  0599            * Return from the SMB routine.  
  0600            *   
  0601 6236 C2D9  SMBO10 MOV  *R9,R11           Restore return address  
  0602 6238 0649         DECT R9                Restore stack   
  0603 623A 045B         RT                     And return  
  0604 623C 0460  BERMUV B    @ERRMUV           * INCORRECT NAME USAGE  
       623E 6970  
  0605            *   
  0606            * Start looking for the real address of the symbol.   
  0607            *   
  0608 6240 0288  SMBO50 CI   R8,LPARZ*256      String - now string array?  
       6242 B700  
  0609 6244 13E7         JEQ  SMB05             Yes, process as an array  
  0610 6246 C820  SMB51  MOV  @STCODE,@FAC2     String ID code in FAC2  
       6248 6188  
       624A 834C  
  0611 624C C820         MOV  @FAC4,@FAC        Get string pointer address  
       624E 834E  
       6250 834A  
  0612 6252 06A0         BL   @GET              Get exact pointer to string   
       6254 6C9A  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0013
  0613 6256 834A         DATA FAC   
  0614            *   
  0615 6258 C801         MOV  R1,@FAC4          Save pointer to string  
       625A 834E  
  0616 625C C0C1         MOV  R1,R3             Was it a null?  
  0617 625E 1304         JEQ  SMB57             Length is 0 - so is null  
  0618 6260 0603         DEC  R3                Otherwise point at length byte
  0619 6262 06A0         BL   @GETV1            Get the string length   
       6264 1880  
  0620 6266 0981         SRL  R1,8              Shift for use as double   
  0621 6268 C801  SMB57  MOV  R1,@FAC6          Put into FAC entry  
       626A 8350  
  0622 626C 10E4         JMP  SMBO10            And return  
  0623            *   
  0624            * Array cases are taken care of here.   
  0625            *   
  0626 626E C804  SMBO20  MOV R4,@FAC2          Now have a dimension counter  
       6270 834C  
  0627            *                              that is initilized to maximum
  0628            *  *FAC+4,FAC+5 already points to 1st dimension maximum in  
  0629            *    in symbol table.   
  0630 6272 04C2         CLR  R2                Clear index accumulator   
  0631 6274 C802  SMBO25 MOV  R2,@FAC6          Save accumulator in FAC   
       6276 8350  
  0632 6278 06A0         BL   @PGMCHR           Get next character  
       627A 6C74  
  0633 627C 06A0         BL   @PSHPRS           PUSH and PARSE subscript  
       627E 6B9C  
  0634 6280   B7         BYTE LPARZ,0           Up to a left parenthesis or le
       6281   00  
  0635            *   
  0636 6282 9820         CB   @FAC2,@STCODE     Dimension can't be a string   
       6284 834C  
       6286 6188  
  0637 6288 1441         JHE  ERRT              It is - so error  
  0638            * Now do float to interger conversion of dimension  
  0639 628A 04E0         CLR  @FAC10            Assume no error   
       628C 8354  
  0640 628E 06A0         BL   @CFI              Gets 2 byte integer in FAC,FAC
       6290 12B8  
  0641 6292 D120         MOVB @FAC10,R4         Error on conversion?  
       6294 8354  
  0642 6296 1636         JNE  ERR3              Yes, error BAD SUBSCRIPT  
  0643 6298 C160         MOV  @FAC,R5           Save index just read  
       629A 834A  
  0644 629C 06A0         BL   @VPOP             Restore FAC block   
       629E 6C2A  
  0645 62A0 06A0         BL   @GET              Get next dimension maximum  
       62A2 6C9A  
  0646 62A4 834E         DATA FAC4              FAC4 points into symbol table 
  0647            *   
  0648 62A6 8045         C    R5,R1             Subscript less-then maximum?  
  0649 62A8 1B2D         JH   ERR3              No, index out of bounds   
  0650      62AB  BIT2   EQU  $+1               Constant >20 (Opcode is >D120)
  0651 62AA D120         MOVB @BASE,R4          Fetch option base to check low
       62AC 8343  
  0652 62AE 1303         JEQ  SMBO40            If BASE=0, INDEX=0 is ok  
  0653 62B0 0605         DEC  R5                Adjust BASE 1 index   
  0654 62B2 1128         JLT  ERR3              If subscript was =0 then error

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0014
  0655 62B4 1001         JMP  SMBO41            Accumulate the subscripts   
  0656 62B6 0581  SMBO40 INC  R1                Adjust size if BASE=0   
  0657 62B8 3860  SMBO41 MPY  @FAC6,R1          R1,R2 has ACCUM*MAX dimension 
       62BA 8350  
  0658 62BC A085         A    R5,R2             Add latest to accumulator   
  0659 62BE 05E0         INCT @FAC4             Increment dimension max pointe
       62C0 834E  
  0660 62C2 0620         DEC  @FAC2             Decrement remaining-dim count 
       62C4 834C  
  0661 62C6 1305         JEQ  SMBO70            All dimensions handled ->done 
  0662 62C8 0288         CI   R8,COMMAZ*256     Otherwise, must be at a comma 
       62CA B300  
  0663 62CC 13D3         JEQ  SMBO25            We are, so loop for more  
  0664 62CE 0460  ERR1   B    @ERRSYN           Not a comma, so SYNTAX ERROR  
       62D0 664E  
  0665            *   
  0666            * At this point the required number of dimensions have been 
  0667            *  scanned.   
  0668            * R2 Contains the index   
  0669            * R4 Points to the first array element or points to the   
  0670            *  address in ERAM where the first array element is.  
  0671 62D2 0288  SMBO70 CI   R8,RPARZ*256      Make sure at a right parenthes
       62D4 B600  
  0672 62D6 16FB         JNE  ERR1              Not, so error   
  0673 62D8 06A0         BL   @PGMCHR           Get nxt token   
       62DA 6C74  
  0674 62DC 06A0         BL   @GETV             Now check string or numeric   
       62DE 187C  
  0675 62E0 834A         DATA FAC                array by checking s.t.   
  0676            *   
  0677 62E2 110C         JLT  SMB71             If MSB set is a string array  
  0678 62E4 0A32         SLA  R2,3              Numeric, multiply by 8  
  0679 62E6 D0E0         MOVB @RAMTOP,R3        Does ERAM exist?  
       62E8 8384  
  0680 62EA 1305         JEQ  SMBO71            No  
  0681 62EC 06A0         BL   @GET              Yes, get the content of value 
       62EE 6C9A  
  0682 62F0 834E         DATA FAC4               pointer  
  0683            *   
  0684 62F2 C801         MOV  R1,@FAC4          Put it in FAC4  
       62F4 834E  
  0685 62F6 A802  SMBO71 A    R2,@FAC4          Add into values pointer   
       62F8 834E  
  0686 62FA 109D         JMP  SMBO10            And return in the normal way  
  0687 62FC 0A12  SMB71  SLA  R2,1              String, multiply by 2   
  0688 62FE A802         A    R2,@FAC4          Add into values pointer   
       6300 834E  
  0689 6302 10A1         JMP  SMB51             And build the string FAC entry
  0690 6304 0200  ERR3   LI   R0,ERRBS          Bad subscript return vector   
       6306 0503  
  0691 6308 0460  ERRX   B    @ERR              Exit to GPL   
       630A 6652  
  0692 630C 0200  ERRT   LI   R0,ERRTM          String/number mismatch vector 
       630E 0603  
  0693 6310 10FB         JMP  ERRX              Use the long branch   
  0694            ************************************************************
  0695            * Subroutine to put symbol name into FAC and to call FBS to 
  0696            * find the symbol table for the symbol  
  0697            ************************************************************

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0015
  0698 6312 04E0  SYM    CLR  @FAC15            Clear the caharacter counter  
       6314 8359  
  0699 6316 0202         LI   R2,FAC            Copying string into FAC   
       6318 834A  
  0700 631A C04B         MOV  R11,R1            Save return address   
  0701            *-----------------------------------------------------------
  0702            * Fix "A long constant in a variable field in INPUT,  
  0703            *      ACCEPT, LINPUT, NEXT and READ etc. may crash the   
  0704            *      sytem" bug,            5/22/81   
  0705            * Insert the following 2 lines  
  0706 631C D208         MOVB R8,R8   
  0707 631E 11D7         JLT  ERR1              If token  
  0708 6320 DC88  SYM1   MOVB R8,*R2+           Save the character  
  0709 6322 05A0         INC  @FAC15            Count it  
       6324 8359  
  0710 6326 06A0         BL   @PGMCHR           Get next character  
       6328 6C74  
  0711 632A 15FA         JGT  SYM1              Still characters in the name  
  0712 632C 06A0         BL   @FBS              Got name, now find s.t. entry 
       632E 15E0  
  0713 6330 62CE         DATA ERR1              Return vector if not found  
  0714            *   
  0715 6332 0451         B    *R1               Return to caller if found   
  0716            ************************************************************
  0717            * ASSGNV, callable from GPL or 9900 code, to assign a value 
  0718            * to a symbol (strings and numerics) . If numeric, the  
  0719            * 8 byte descriptor is in the FAC. The descriptor block   
  0720            * (8 bytes) for the destination variable is on the stack.   
  0721            * There are two types of descriptor entries which are   
  0722            * created by SMB in preparation for ASSGNV, one for   
  0723            * numerics and one for strings.   
  0724            *                     NUMERIC   
  0725            * +-------------------------------------------------------+ 
  0726            * |S.T. ptr | 00 |       |Value ptr |                     | 
  0727            * +-------------------------------------------------------+ 
  0728            *                     STRING  
  0729            * +-------------------------------------------------------+ 
  0730            * |Value ptr| 65 |       |String ptr|String length        | 
  0731            * +-------------------------------------------------------+ 
  0732            *   
  0733            * CRITICAL NOTE: Becuase of the BL @POPSTK below, if a  
  0734            * string entry is popped and a garbage collection has taken 
  0735            * place while the entry was pushed on the stack, and the  
  0736            * entry was a permanent string the pointer in FAC4 and FAC5 
  0737            * will be messed up. A BL @VPOP would have taken care of  
  0738            * the problem but would have taken a lot of extra code.   
  0739            * Therefore, at ASSG50-ASSG54 it is assumed that the  
  0740            * previous value assigned to the destination variable has   
  0741            * been moved and the pointer must be reset by going back to 
  0742            * the symbol table and getting the correct value pointer.   
  0743            ************************************************************
  0744 6334 C28B  ASSG   MOV  R11,R10           Save the retun address  
  0745 6336 06A0         BL   @ARGTST           Check arg and variable type   
       6338 6B6E  
  0746 633A 02CC         STST R12               Save status of type   
  0747 633C 06A0         BL   @POPSTK           Pop destination descriptor  
       633E 60D4  
  0748            *                              into ARG   
  0749 6340 0A3C         SLA  R12,3             Variable type numeric?  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0016
  0750 6342 1745         JNC  ASSG70            Yes, handle it as such  
  0751            * Assign a string to a string variable  
  0752 6344 C060         MOV  @ARG4,R1          Get destination pointer   
       6346 8360  
  0753            *                             Dest have non-null  value?  
  0754 6348 130B         JEQ  ASSG54            No, null->never assigned  
  0755            * Previously assigned - Must first free the old value   
  0756 634A 06A0         BL   @GET              Correct for POPSTK above  
       634C 6C9A  
  0757 634E 835C         DATA ARG               Pointer is in ARG   
  0758            *   
  0759 6350 C801         MOV  R1,@ARG4          Correct ARG+4,5 too   
       6352 8360  
  0760            *-----------------------------------------------------------
  0761            * Fix "Assigning a string to itself when memory is full can 
  0762            *      destroy the string" bug, 5/22/81   
  0763            * Add the following 2 lines and the label ASSG80  
  0764 6354 8801         C    R1,@FAC4          Do not do anything in assign- 
       6356 834E  
  0765            *                              ing a string to itself case  
  0766 6358 1317         JEQ  ASSG80            Detect A$=A$ case, exit   
  0767            *-----------------------------------------------------------
  0768 635A 04C6         CLR  R6                Clear for zeroing backpointer 
  0769 635C 06A0         BL   @STVDP3           Free the string   
       635E 18AA  
  0770 6360 C120  ASSG54 MOV  @FAC6,R4          Is source string a null?  
       6362 8350  
  0771 6364 130C         JEQ  ASSG57            Yes, handle specially   
  0772 6366 C0E0         MOV  @FAC,R3           Get address of source pointer 
       6368 834A  
  0773 636A 0283         CI   R3,>001C          Got a temporay string?  
       636C 001C  
  0774 636E 160D         JNE  ASSG56            No, more complicated  
  0775 6370 C120         MOV  @FAC4,R4          Pick up direct ptr to string  
       6372 834E  
  0776            * Common string code to set forward and back pointers   
  0777 6374 C1A0  ASSG55 MOV  @ARG,R6           Ptr to symbol table pointer   
       6376 835C  
  0778 6378 C044         MOV  R4,R1             Pointer to source string  
  0779 637A 06A0         BL   @STVDP3           Set the backpointer   
       637C 18AA  
  0780 637E C060  ASSG57 MOV  @ARG,R1           Address of symbol table ptr   
       6380 835C  
  0781 6382 C184         MOV  R4,R6             Pointer to string   
  0782 6384 06A0         BL   @STVDP            Set the forward pointer   
       6386 18AE  
  0783 6388 045A  ASSG80 B    *R10              Done, return  
  0784            * Symbol-to-symbol assigments of strings  
  0785            * Must create copy of string  
  0786 638A C820  ASSG56 MOV  @FAC6,@BYTE       Fetch length for GETSTR   
       638C 8350  
       638E 830C  
  0787            * NOTE: FAC through FAC+7 cannot be destroyed   
  0788            *       address^of string length^of string  
  0789 6390 06A0         BL   @VPUSH            So save it on the stack   
       6392 6BAA  
  0790 6394 C80A         MOV  R10,@FAC          Save return link in FAC since 
       6396 834A  
  0791            *                              GETSTR does not destroy FAC  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0017
  0792 6398 06A0         BL   @GETSTR           Call GPL to do the GETSTR   
       639A 736C  
  0793 639C C2A0         MOV  @FAC,R10          Restore return link   
       639E 834A  
  0794 63A0 06A0         BL   @VPOP             Pop the source info back  
       63A2 6C2A  
  0795            * Set up to copy the source string into destination   
  0796 63A4 C0E0         MOV  @FAC4,R3          R3 is now copy-from   
       63A6 834E  
  0797 63A8 C160         MOV  @SREF,R5          R5 is now copy-to   
       63AA 831C  
  0798 63AC C105         MOV  R5,R4             Save for pointer setting  
  0799            * Registers to be used in the copy  
  0800            * R1 - Used for a buffer  
  0801            * R3 - Copy-from address  
  0802            * R2 - # of bytes to be moved   
  0803            * R5 - copy-to address  
  0804 63AE C0A0         MOV  @FAC6,R2          Fetch the length of the string
       63B0 8350  
  0805 63B2 0265         ORI  R5,WRVDP          Enable the VDP write  
       63B4 4000  
  0806 63B6 06A0  ASSG59 BL   @GETV1            Get the character   
       63B8 1880  
  0807 63BA D7E0         MOVB @R5LB,*R15        Load out destination address  
       63BC 83EB  
  0808 63BE 0583         INC  R3                Increment the copy-from   
  0809 63C0 D7C5         MOVB R5,*R15           1st byte of address to  
  0810 63C2 0585         INC  R5                Increment for next character  
  0811 63C4 D801         MOVB R1,@XVDPWD        Put the character out   
       63C6 8C00  
  0812 63C8 0602         DEC  R2                Decrement count, finished?  
  0813 63CA 15F5         JGT  ASSG59            No, loop for more   
  0814 63CC 10D3         JMP  ASSG55            Yes, now set pointers   
  0815            * Code to copy a numeric value into the symbol table  
  0816 63CE 0202  ASSG70 LI   R2,8              Need to assign 8 bytes  
       63D0 0008  
  0817 63D2 C160         MOV  @ARG4,R5          Destination pointer(R5)   
       63D4 8360  
  0818            *                              from buffer(R4), (R2)bytes   
  0819 63D6 C0E0         MOV  @RAMTOP,R3        Does ERAM exist?  
       63D8 8384  
  0820 63DA 160C         JNE  ASSG77            Yes, write to ERAM  
  0821            *                             No, write to VDP  
  0822 63DC D7E0         MOVB @R5LB,*R15        Load out 2nd byte of address  
       63DE 83EB  
  0823 63E0 0265         ORI  R5,WRVDP          Enable the write to the VDP   
       63E2 4000  
  0824 63E4 D7C5         MOVB R5,*R15           Load out 1st byte of address  
  0825 63E6 0204         LI   R4,FAC            Source is FAC   
       63E8 834A  
  0826 63EA D834  ASSG75 MOVB *R4+,@XVDPWD      Move a byte   
       63EC 8C00  
  0827 63EE 0602         DEC  R2                Decrement the counter, done?  
  0828 63F0 15FC         JGT  ASSG75            No, loop for more   
  0829 63F2 045A         B    *R10              Yes, return to the caller   
  0830 63F4 0204  ASSG77 LI   R4,FAC            Source is in FAC  
       63F6 834A  
  0831 63F8 DD74  ASSG79 MOVB *R4+,*R5+         Move a byte   
  0832 63FA 0602         DEC  R2                Decrement the counter, done?  

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0018
  0833 63FC 15FD         JGT  ASSG79            No, loop for more   
  0834 63FE 045A         B    *R10              Yes, return to caller   
  0835            * Check for required token  
  0836 6400 D01D  SYNCHK MOVB *R13,R0           Read required token   
  0837            *   
  0838 6402 9800         CB   R0,@CHAT          Have the required token?  
       6404 8342  
  0839 6406 1304         JEQ  PGMCH             Yes, read next character  
  0840 6408 06A0         BL   @SETREG           Error return requires R8/R9 se
       640A 1E7A  
  0841 640C 0460         B    @ERRSYN           * SYNTAX ERROR  
       640E 664E  
  0842            *      PGMCH - GPL entry point for PGMCHR to set up register
  0843 6410 C30B  PGMCH  MOV  R11,R12           Save return address   
  0844 6412 06A0         BL   @PGMCHR           Get the next character  
       6414 6C74  
  0845 6416 D808         MOVB R8,@CHAT          Put it in for GPL   
       6418 8342  
  0846 641A 045C         B    *R12              Return to GPL   
  0847 641C 045B         RT                     And return to the caller  
  0848 641E C13B  PUTV   MOV  *R11+,R4  
  0849 6420 C114         MOV  *R4,R4  
  0850 6422 D7E0  PUTV1  MOVB @R4LB,*R15  
       6424 83E9  
  0851 6426 0264         ORI  R4,WRVDP  
       6428 4000  
  0852 642A D7C4         MOVB R4,*R15   
  0853 642C 1000         NOP  
  0854 642E D801         MOVB R1,@XVDPWD  
       6430 8C00  
  0855 6432 045B         RT   
  0856            * MOVFAC - copies 8 bytes from VDP(@FAC4) or ERAM(@FAC4)  
  0857            *          to FAC   
  0858 6434 C060  MOVFAC MOV @FAC4,R1           Get pointer to source   
       6436 834E  
  0859 6438 0202         LI  R2,8               8 byte values   
       643A 0008  
  0860 643C 0203         LI  R3,FAC             Destination is FAC  
       643E 834A  
  0861 6440 C020         MOV @RAMTOP,R0         Does ERAM exist?  
       6442 8384  
  0862 6444 160A         JNE MOVFA2             Yes, from ERAM  
  0863            *                             No, from VDP RAM  
  0864 6446 06C1         SWPB R1  
  0865 6448 D7C1         MOVB R1,*R15           Load 2nd byte of address  
  0866 644A 06C1         SWPB R1  
  0867 644C D7C1         MOVB R1,*R15           Load 1st byte of address  
  0868 644E 0205         LI   R5,XVDPRD   
       6450 8800  
  0869 6452 DCD5  MOVF1  MOVB *R5,*R3+          Move a byte   
  0870 6454 0602         DEC  R2                Decrement counter, done?  
  0871 6456 15FD         JGT  MOVF1             No, loop for more   
  0872 6458 045B         RT                     Yes, return to caller   
  0873 645A DCF1  MOVFA2 MOVB *R1+,*R3+   
  0874 645C 0602         DEC  R2  
  0875 645E 16FD         JNE  MOVFA2  
  0876 6460 045B         RT   
  0877 6462 045B         RT                     And return to caller  
  0878            ************************************************************

 99/4 ASSEMBLER
BASSUP                                                       PAGE 0019
  0879 6464              AORG >6464   
  0881                
  0882            *      BASIC PARSE CODE   
  0883            * REGISTER USAGE  
  0884            *    RESERVED FOR GPL INTERPRETER  R13, R14, R15  
  0885            *          R13 contains the read address for GROM   
  0886            *          R14 is used in BASSUP/10 for the VDPRAM pointer  
  0887            *    RESERVED IN BASIC SUPPORT  
  0888            *          R8 MSB current character (like CHAT in GPL)  
  0889            *          R8 LSB zero  
  0890            *          R10 read data port address for program data  
  0891            *   ALL EXITS TO GPL MUST GO THROUGH "NUDG05"   
  0892            *   
  0893                
  0894            *                         ~~~TOKENS~~~  
  0895      0081  ELSEZ  EQU  >81               ELSE  
  0896      0082  SSEPZ  EQU  >82               STATEMENT SEPERATOR   
  0897      0083  TREMZ  EQU  >83               TAIL REMARK   
  0898      0084  IFZ    EQU  >84               IF  
  0899      0085  GOZ    EQU  >85               GO  
  0900      0086  GOTOZ  EQU  >86               GOTO  
  0901      0087  GOSUBZ EQU  >87               GOSUB   
  0902      008E  BREAKZ EQU  >8E               BREAK   
  0903      0096  NEXTZ  EQU  >96               NEXT  
  0904      00A1  SUBZ   EQU  >A1               SUB   
  0905      00A5  ERRORZ EQU  >A5               ERROR   
  0906      00A6  WARNZ  EQU  >A6               WARNING   
  0907      00B0  THENZ  EQU  >B0               THEN  
  0908      00B1  TOZ    EQU  >B1               TO  
  0909      00B3  COMMAZ EQU  >B3               COMMA   
  0910      00B6  RPARZ  EQU  >B6               RIGHT PARENTHESIS )   
  0911      00B7  LPARZ  EQU  >B7               LEFT PARENTHESIS (  
  0912      00BA  ORZ    EQU  >BA               OR  
  0913      00BB  ANDZ   EQU  >BB               AND   
  0914      00BC  XORZ   EQU  >BC               XOR   
  0915      00BD  NOTZ   EQU  >BD               NOT   
  0916      00BE  EQZ    EQU  >BE               EQUAL (=)   
  0917      00C0  GTZ    EQU  >C0               GREATER THEN (>)  
  0918      00C1  PLUSZ  EQU  >C1               PLUS (+)  
  0919      00C2  MINUSZ EQU  >C2               MINUS (-)   
  0920      00C4  DIVIZ  EQU  >C4               DIVIDE (/)  
  0921      00C5  EXPONZ EQU  >C5               EXPONENT  
  0922      00C7  STRINZ EQU  >C7               STRING  
  0923      00C9  LNZ    EQU  >C9               LINE NUMBER   
  0924      00CB  ABSZ   EQU  >CB               ABSOLUTE  
  0925      00D1  SGNZ   EQU  >D1               SIGN  
  0926            *   
  0927 6464 0018  C24    DATA 24                CONSTANT 24   
  0928 6466 65A6  EXRTNA DATA EXRTN             RETURN FOR EXEC   
  0929            *   
  0930 6468 0200  ERRSO  LI   R0,>0703          Issue STACK OVERFLOW message  
       646A 0703  
  0931 646C 0460         B    @ERR  
       646E 6652  
  0932            *   
  0933            * GRAPHICS LANGUAGE ENTRY TO PARSE  
  0934            *   
  0935 6470 06A0  PARSEG BL   @SETREG           Set up registers for Basic  
       6472 1E7A  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0020
  0936 6474 D2ED         MOVB @GRMRAX(R13),R11   Get GROM address   
       6476 0002  
  0937 6478 D82D         MOVB @GRMRAX(R13),@R11LB   
       647A 0002  
       647C 83F7  
  0938 647E 060B         DEC  R11   
  0939            *   
  0940            * 9900 ENTRY TO PARSE   
  0941            *   
  0942 6480 05C9  PARSE  INCT R9                Get room for return address   
  0943 6482 0289         CI   R9,STKEND         Stack full?   
       6484 83BA  
  0944 6486 1BF0         JH   ERRSO             Yes, too many levels deep   
  0945 6488 C64B         MOV  R11,*R9           Save the return address   
  0946 648A D1C8  P05    MOVB R8,R7             Test for token beginning  
  0947 648C 1102         JLT  P10               If token, then look it up   
  0948 648E 0460         B    @PSYM             If not token is a symbol  
       6490 6884  
  0949 6492 06A0  P10    BL   @PGMCHR           Get next character  
       6494 6C74  
  0950 6496 0977         SRL  R7,7              Change last character to offse
  0951 6498 0227         AI   R7,->B7*2         Check for legal NUD   
       649A FE92  
  0952 649C 0287         CI   R7,NTABLN         Within the legal NUD address? 
       649E 0056  
  0953 64A0 1B22         JH   CONT15            No, check for legal LED   
  0954 64A2 C1E7         MOV  @NTAB(R7),R7      Get NUD address   
       64A4 69FE  
  0955 64A6 1525         JGT  B9900             If 9900 code  
  0956      64A8  P17    EQU  $                 R7 contains offset into nudtab
  0957 64A8 0247         ANDI R7,>7FFF          If GPL code, get rid of MSB   
       64AA 7FFF  
  0958 64AC A1E0         A    @NUDTAB,R7        Add in table address  
       64AE 8328  
  0959 64B0 06A0  NUDG05 BL   @SAVREG           Restore GPL pointers  
       64B2 1E8C  
  0960 64B4 DB47         MOVB R7,@GRMWAX(R13)    Write out new GROM address   
       64B6 0402  
  0961 64B8 06C7         SWPB R7                Bare the LSB  
  0962 64BA DB47         MOVB R7,@GRMWAX(R13)    Put it out too   
       64BC 0402  
  0963 64BE 0460         B    @RESET            Go back to GPL interpreter  
       64C0 006A  
  0964 64C2 10F2  P17L   JMP  P17   
  0965            *   
  0966            * CONTINUE ROUTINE FOR PARSE  
  0967            *   
  0968 64C4 06A0  CONTG  BL   @SETREG           GPL entry-set Basic registers 
       64C6 1E7A  
  0969 64C8 C199  CONT   MOV  *R9,R6            Get last address from stack   
  0970 64CA 1506         JGT  CONT10            9900 code if not negative   
  0971 64CC DB46         MOVB R6,@GRMWAX(R13)    Write out new GROM address   
       64CE 0402  
  0972 64D0 06C6         SWPB R6                Bare the second byte  
  0973 64D2 DB46         MOVB R6,@GRMWAX(R13)    Put it out too   
       64D4 0402  
  0974 64D6 C18D         MOV  R13,R6            Set up to test precedence   
  0975 64D8 9216  CONT10 CB   *R6,R8            Test precedence   
  0976 64DA 1411         JHE  NUDNDL            Have parsed far enough->return

 99/4 ASSEMBLER
PARSES                                                       PAGE 0021
  0977 64DC 0978         SRL  R8,7              Make into table offset  
  0978 64DE 0228         AI   R8,->B8*2         Minimum token for a LED (*2)  
       64E0 FE90  
  0979 64E2 0288         CI   R8,LTBLEN         Maximum token for a LED (*2)  
       64E4 001C  
  0980 64E6 1B09  CONT15 JH   NOLEDL            If outside legal LED range-err
  0981 64E8 C1E8         MOV  @LTAB(R8),R7      Pick up address of LED handler
       64EA 6A54  
  0982 64EC 04C8         CLR  R8                Clear 'CHAT' for getting new  
  0983 64EE 06A0         BL   @PGMCHR           Get next character  
       64F0 6C74  
  0984 64F2 0457  B9900  B    *R7               Go to the LED handler   
  0985 64F4 0649  NUDE10 DECT R9                Back up subroutine stack  
  0986 64F6 0587         INC  R7                Skip over precedence  
  0987 64F8 10DB         JMP  NUDG05            Goto code to return to GPL  
  0988 64FA 0460  NOLEDL B    @NOLED  
       64FC 664E  
  0989 64FE 1073  NUDNDL JMP  NUDND1  
  0990            * Execute one or more lines of Basic  
  0991      6500  EXECG  EQU  $                 GPL entry point for execution 
  0992 6500 06A0         BL   @SETREG           Set up registers  
       6502 1E7A  
  0993 6504 04E0         CLR  @ERRCOD           Clear the return code   
       6506 8322  
  0994 6508 D020         MOVB @PRGFLG,R0        Imperative statement?   
       650A 8344  
  0995 650C 131A         JEQ  EXEC15            Yes, handle it as such  
  0996            * Loop for each statement in the program  
  0997      650E  EXEC10 EQU  $   
  0998 650E D020         MOVB @FLAG,R0          Now test for trace mode   
       6510 8345  
  0999 6512 0A30         SLA  R0,3              Check the trace bit in FLAG   
  1000 6514 115F         JLT  TRACL             If set->display line number   
  1001 6516 C820  EXEC11 MOV  @EXTRAM,@PGMPTR   Get text pointer  
       6518 832E  
       651A 832C  
  1002 651C 0660         DECT @PGMPTR           Back to the line # to check   
       651E 832C  
  1003            *                              break point  
  1004 6520 06A0         BL   @PGMCHR           Get the first byte of line #  
       6522 6C74  
  1005 6524 02C0         STST R0                Save status for breakpnt check
  1006 6526 05A0         INC  @PGMPTR           Get text pointer again  
       6528 832C  
  1007 652A 06A0         BL   @PGMCHR           Go get the text pointer   
       652C 6C74  
  1008 652E 06C8         SWPB R8                Save 1st byte of text pointer 
  1009 6530 06A0         BL   @PGMCHR           Get 2nd byte of text pointer  
       6532 6C74  
  1010 6534 06C8         SWPB R8                Put text pointer in order   
  1011 6536 C808         MOV  R8,@PGMPTR        Set new text pointer  
       6538 832C  
  1012 653A 04C8         CLR  R8                Clean up the mess   
  1013 653C 0A20         SLA  R0,2              Check breakpoint status   
  1014 653E 1101         JLT  EXEC15            If no breakpoint set - count  
  1015 6540 177A         JNC  BRKPNT            If breakpoint set-handle it   
  1016      6542  EXEC15 EQU  $   
  1017      6544  C3     EQU  $+2               Constant data 3   
  1018      6545  CB3    EQU  $+3               Constant byte 3   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0022
  1019 6542 0300         LIMI 3                 Let interrupts loose  
       6544 0003  
  1020      6548  C0     EQU  $+2               Constant data 0   
  1021 6546 0300         LIMI 0                 Shut down interrupts  
       6548 0000  
  1022 654A 04E0         CLR  @>83D6            Reset VDP timeout   
       654C 83D6  
  1023 654E 020C         LI   R12,>24           Load console KBD address in CR
       6550 0024  
  1024 6552 30E0         LDCR @C0,3             Select keyboard section   
       6554 6548  
  1025 6556 020C         LI   R12,6             Read address  
       6558 0006  
  1026 655A 3600         STCR R0,8              SCAN the keyboard   
  1027 655C 2420         CZC  @C1000,R0         Shift-key depressed?  
       655E 600A  
  1028 6560 160A         JNE  EXEC16            No, execute the Basic statemen
  1029 6562 020C         LI   R12,>24           Test column 3 of keyboard   
       6564 0024  
  1030 6566 30E0         LDCR @CB3,3            Select keyboard section   
       6568 6545  
  1031 656A 020C         LI   R12,6             Read address  
       656C 0006  
  1032 656E 3600         STCR R0,8              SCAN the keyboard   
  1033 6570 2420         CZC  @C1000,R0         Shift-C depressed?  
       6572 600A  
  1034 6574 132E         JEQ  BRKP1L            Yes, so take Basic breakpoint 
  1035 6576 C820  EXEC16 MOV  @PGMPTR,@SMTSRT   Save start of statement   
       6578 832C  
       657A 831E  
  1036 657C 05C9         INCT R9                Get subroutine stack space  
  1037 657E C660         MOV  @EXRTNA,*R9       Save the GPL return address   
       6580 6466  
  1038 6582 06A0         BL   @PGMCHR           Now get 1st character of stmt 
       6584 6C74  
  1039 6586 1320         JEQ  EXRTN3            If EOL after EOS  
  1040 6588 1102  EXEC17 JLT  EXEC20            If top bit set->keyword   
  1041 658A 0460         B    @NLET             If not->fake a 'LET' stmt   
       658C 6948  
  1042 658E C1C8  EXEC20 MOV  R8,R7             Save 1st token so can get 2nd 
  1043 6590 05A0         INC  @PGMPTR           Increment the perm pointer  
       6592 832C  
  1044 6594 D21A         MOVB *R10,R8           Read the character  
  1045 6596 0977         SRL  R7,7              Convert 1st to table offset   
  1046 6598 0227         AI   R7,->AA*2         Check for legal stmt token  
       659A FEAC  
  1047 659C 1558         JGT  ERRONE            Not in range -> error   
  1048 659E C1E7         MOV  @STMTTB(R7),R7    Get address of stmt handler   
       65A0 69FC  
  1049 65A2 118F         JLT  P17L              If top bit set -> GROM code   
  1050 65A4 0457         B    *R7               If 9900 code, goto it!  
  1051 65A6   83  EXRTN  BYTE >83               Unused bytes for data constant
  1052 65A7   65  CBH65  BYTE >65                since NUDEND skips precedence
  1053 65A8 0288         CI   R8,SSEPZ*256      EOS only?   
       65AA 8200  
  1054 65AC 13CA         JEQ  EXEC15            Yes, continue on this line  
  1055 65AE D020  EXRTN2 MOVB @PRGFLG,R0        Did we execute an imperative  
       65B0 8344  
  1056 65B2 1351         JEQ  EXEC50            Yes, so return to top-level   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0023
  1057 65B4 6820         S    @C4,@EXTRAM       No, so goto the next line   
       65B6 6A80  
       65B8 832E  
  1058 65BA 8820         C    @EXTRAM,@STLN     Check to see if end of program
       65BC 832E  
       65BE 8330  
  1059 65C0 14A6         JHE  EXEC10            No, so loop for the next line 
  1060 65C2 1049         JMP  EXEC50            Yes, so return to top-level   
  1061            *   
  1062            * STMT handler for ::   
  1063            *   
  1064 65C4 D208  SMTSEP MOVB R8,R8             EOL?  
  1065 65C6 16E0         JNE  EXEC17            NO, there is another stmt   
  1066 65C8 0649  EXRTN3 DECT R9                YES   
  1067 65CA 10F1         JMP  EXRTN2            Jump back into it   
  1068            * Continue after a breakpoint   
  1069 65CC 06A0  CONTIN BL   @SETREG           Set up Basic registers  
       65CE 1E7A  
  1070 65D0 10B8  EXC15L JMP  EXEC15            Continue execution  
  1071 65D2 1038  BRKP1L JMP  BRKPN1  
  1072 65D4 104E  TRACL  JMP  TRACE   
  1073            * Test for required End-Of-Statement  
  1074 65D6 D208  EOL    MOVB R8,R8             EOL reached?  
  1075 65D8 1306         JEQ  NUDND1            Yes   
  1076 65DA 0288         CI   R8,TREMZ*256      Higher then tail remark token?
       65DC 8300  
  1077 65DE 1B37         JH   ERRONE            Yes, its an error   
  1078 65E0 0288         CI   R8,ELSEZ*256      Tail, ssep or else?   
       65E2 8100  
  1079 65E4 1A34         JL   ERRONE            No, error   
  1080            *   
  1081            * Return from call to PARSE   
  1082            * (entered from CONT)   
  1083            *   
  1084 65E6 C1D9  NUDND1 MOV  *R9,R7            Get the return address  
  1085 65E8 1185         JLT  NUDE10            If negative - return to GPL   
  1086 65EA 0649         DECT R9                Back up the subroutine stack  
  1087 65EC 0467         B    @2(R7)            And return to caller  
       65EE 0002  
  1088            *      (Skip the precedence word)   
  1089 65F0 D208  NUDEND MOVB R8,R8             Check for EOL   
  1090 65F2 13F9         JEQ  NUDND1            If EOL  
  1091 65F4 0288  NUDND2 CI   R8,STRINZ*256     Lower than a string?  
       65F6 C700  
  1092 65F8 1A08         JL   NUDND4            Yes   
  1093 65FA 0288         CI   R8,LNZ*256        Higher than a line #?   
       65FC C900  
  1094 65FE 1315         JEQ  SKPLN             Skip line numbers   
  1095 6600 1A0B         JL   SKPSTR            Skip string or numeric  
  1096 6602 06A0  NUDND3 BL   @PGMCHR           Read next character   
       6604 6C74  
  1097 6606 13EF         JEQ  NUDND1            If EOL  
  1098 6608 10F5         JMP  NUDND2            Continue scan of line   
  1099 660A 0288  NUDND4 CI   R8,TREMZ*256      Higher than a tail remark?  
       660C 8300  
  1100 660E 1BF9         JH   NUDND3            Yes   
  1101 6610 0288         CI   R8,SSEPZ*256      Lower then stmt sep(else)?  
       6612 8200  
  1102 6614 1AF6         JL   NUDND3            Yes   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0024
  1103 6616 10E7         JMP  NUDND1            TREM or SSEP  
  1104 6618 06A0  SKPSTR BL   @PGMCHR   
       661A 6C74  
  1105 661C 06C8         SWPB R8                Prepare to add  
  1106 661E A808         A    R8,@PGMPTR        Skip it   
       6620 832C  
  1107 6622 04C8         CLR  R8                Clear lower byte  
  1108 6624 06A0  SKPS01 BL   @PGMCHR           Get next token  
       6626 6C74  
  1109 6628 10E3         JMP  NUDEND            Go on   
  1110 662A 05E0  SKPLN  INCT @PGMPTR           Skip line number  
       662C 832C  
  1111 662E 10FA         JMP  SKPS01            Go on   
  1112            *   
  1113            * Return from "CALL" to GPL   
  1114 6630 06A0  RTNG   BL   @SETREG           Set up registers again  
       6632 1E7A  
  1115 6634 10D8         JMP  NUDND1            And jump back into it!  
  1116            ************************************************************
  1117            * Handle Breakpoints  
  1118 6636 D020  BRKPNT MOVB @FLAG,R0          Check flag bits   
       6638 8345  
  1119 663A 0A10         SLA  R0,1              Check bit 6 for breakpoint  
  1120 663C 11C9         JLT  EXC15L            If set then ignore breakpoint 
  1121 663E 0200  BRKPN2 LI   R0,BRKFL  
       6640 0001  
  1122 6642 1007         JMP  EXIT              Return to top-level   
  1123 6644 D020  BRKPN1 MOVB @FLAG,R0          Move flag bits  
       6646 8345  
  1124 6648 0A10         SLA  R0,1              Check bit 6 for breakpoint  
  1125 664A 1195         JLT  EXEC16            If set then ignore breakpoint 
  1126 664C 10F8         JMP  BRKPN2            Bit not set   
  1127            *   
  1128            * Error handling from 9900 code   
  1129            *   
  1130      664E  ERRSYN EQU  $                 These all issue same message  
  1131      664E  ERRONE EQU  $   
  1132      664E  NONUD  EQU  $   
  1133      664E  NOLED  EQU  $   
  1134 664E 0200         LI   R0,ERRSN          *SYNTAX ERROR return code   
       6650 0003  
  1135      6652  EXIT   EQU  $   
  1136 6652 C800  ERR    MOV  R0,@ERRCOD        Load up return code for GPL   
       6654 8322  
  1137            * General return to GPL portion of Basic  
  1138 6656 C1E0  EXEC50 MOV  @RTNADD,R7        Get return address  
       6658 8326  
  1139 665A 0460         B    @NUDG05           Use commond code to link back 
       665C 64B0  
  1140            * Handle STOP and END statements  
  1141            STOP  
  1142 665E 0649  END    DECT R9                Pop last call to PARSE  
  1143 6660 10FA         JMP  EXEC50            Jump to return to top-level   
  1144            * Error codes for return to GPL   
  1145      0003  ERRSN  EQU  >0003             ERROR SYNTAX  
  1146      0103  ERROM  EQU  >0103             ERROR OUT OF MEMORY   
  1147      0203  ERRIOR EQU  >0203             ERROR INDEX OUT OF RANGE  
  1148      0303  ERRLNF EQU  >0303             ERROR LINE NOT FOUND  
  1149      0403  ERREX  EQU  >0403             ERROR EXECUTION   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0025
  1150            * >0004 WARNING NUMERIC OVERFLOW  
  1151      0001  BRKFL  EQU  >0001             BREAKPOINT RETURN VECTOR  
  1152      0005  ERROR  EQU  >0005             ON ERROR  
  1153      0006  UDF    EQU  >0006             FUNCTION REFERENCE  
  1154      0007  BREAK  EQU  >0007             ON BREAK  
  1155      0008  CONCAT EQU  >0008             CONCATENATE (&) STRINGS   
  1156      0009  WARN   EQU  >0009             ON WARNING  
  1157            * Warning routine (only OVERFLOW)   
  1158 6662 C820  WARNZZ MOV  @C4,@ERRCOD       Load warning code for GPL   
       6664 6A80  
       6666 8322  
  1159 6668 020B         LI   R11,CONT-2        To optimize for return  
       666A 64C6  
  1160            * Return to GPL as a CALL   
  1161 666C 05C9  CALGPL INCT R9                Get space on subroutine stack 
  1162 666E C64B         MOV  R11,*R9           Save return address   
  1163 6670 10F2         JMP  EXEC50            And go to GPL   
  1164            * Trace a line (Call GPL routine)   
  1165 6672 C820  TRACE  MOV  @C2,@ERRCOD       Load return vector  
       6674 6000  
       6676 8322  
  1166 6678 020B         LI   R11,EXEC11-2      Set up for return to execute  
       667A 6514  
  1167 667C 10F7         JMP  CALGPL            Call GPL to display line #  
  1168            * Special code to handle concatenate (&)  
  1169 667E 0200  CONC   LI   R0,CONCAT         Go to GPL to handle it  
       6680 0008  
  1170 6682 10E7         JMP  EXIT              Exit to GPL interpeter  
  1171            ************************************************************
  1172            *              NUD routine for a numeric constant   
  1173            * NUMCON first puts pointer to the numeric string into  
  1174            * FAC12 for CSN, clears the error byte (FAC10) and then   
  1175            * converts from a string to a floating point number. Issues 
  1176            * warning if necessary. Leaves value in FAC   
  1177            ************************************************************
  1178 6684 C820  NUMCON MOV  @PGMPTR,@FAC12    Set pointer for CSN   
       6686 832C  
       6688 8356  
  1179 668A 06C8         SWPB R8                Swap to get length into LSB   
  1180 668C A808         A    R8,@PGMPTR        Add to pointer to check end   
       668E 832C  
  1181 6690 04E0         CLR  @FAC10            Assume no error   
       6692 8354  
  1182 6694 06A0         BL   @SAVRE2           Save registers  
       6696 1E90  
  1183 6698 0203         LI   R3,GETCH          Adjustment for ERAM in order  
       669A 60AE  
  1184 669C D120         MOVB @RAMFLG,R4         to call CSN  
       669E 8389  
  1185 66A0 1302         JEQ  NUMC49  
  1186 66A2 0203         LI   R3,GETCGR   
       66A4 60D0  
  1187 66A6 06A0  NUMC49 BL   @CSN01            Convert String to Number  
       66A8 11B2  
  1188 66AA 06A0         BL   @SETREG           Restore registers   
       66AC 1E7A  
  1189 66AE 8820         C    @FAC12,@PGMPTR    Check to see if all converted 
       66B0 8356  
       66B2 832C  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0026
  1190 66B4 16CC         JNE  ERRONE            If not - error  
  1191 66B6 06A0         BL   @PGMCHR           Now get next char from program
       66B8 6C74  
  1192 66BA D020         MOVB @FAC10,R0         Get an overflow on conversion?
       66BC 8354  
  1193 66BE 16D1         JNE  WARNZZ            Yes, have GPL issue warning   
  1194 66C0 0460         B    @CONT             Continue the PARSE  
       66C2 64C8  
  1195            *   
  1196            * ON ERROR, ON WARNING and ON BREAK   
  1197 66C4 0200  ONERR  LI   R0,ERROR          ON ERROR code   
       66C6 0005  
  1198 66C8 10C4         JMP  EXIT              Return to GPL code  
  1199 66CA 0200  ONWARN LI   R0,WARN           ON WARNING code   
       66CC 0009  
  1200 66CE 10C1         JMP  EXIT              Return to GPL code  
  1201 66D0 0200  ONBRK  LI   R0,BREAK          ON BREAK code   
       66D2 0007  
  1202 66D4 10BE         JMP  EXIT              Return to GPL code  
  1203            *   
  1204            * NUD routine for "GO"  
  1205            *   
  1206 66D6 04C3  GO     CLR  R3                Dummy "ON" index for common   
  1207 66D8 1020         JMP  ON30              Merge into "ON" code  
  1208            *   
  1209            * NUD ROUTINE FOR "ON"  
  1210            *   
  1211 66DA 0288  ON     CI   R8,WARNZ*256      On warning?   
       66DC A600  
  1212 66DE 13F5         JEQ  ONWARN            Yes, goto ONWARN  
  1213 66E0 0288         CI   R8,ERRORZ*256     On error?   
       66E2 A500  
  1214 66E4 13EF         JEQ  ONERR             Yes, got ONERR  
  1215 66E6 0288         CI   R8,BREAKZ*256     On break?   
       66E8 8E00  
  1216 66EA 13F2         JEQ  ONBRK             Yes, goto ONBRK   
  1217            *   
  1218            * Normal "ON" statement   
  1219            *   
  1220 66EC 06A0         BL   @PARSE            PARSE the index value   
       66EE 6480  
  1221 66F0   B3         BYTE COMMAZ            Stop on a comma or less   
  1222 66F1   66  CBH66  BYTE >66               Unused byte for constant  
  1223 66F2 06A0         BL   @NUMCHK           Ensure index is a number  
       66F4 6B92  
  1224 66F6 04E0         CLR  @FAC10            Assume no error in CFI  
       66F8 8354  
  1225 66FA 06A0         BL   @CFI              Convert Floating to Integer   
       66FC 12B8  
  1226 66FE D020         MOVB @FAC10,R0         Test error code   
       6700 8354  
  1227 6702 1603         JNE  GOTO90            If overflow, BAD VALUE  
  1228 6704 C0E0         MOV  @FAC,R3           Get the index   
       6706 834A  
  1229 6708 1503         JGT  ON20              Must be positive  
  1230 670A 0200  GOTO90 LI   R0,ERRIOR         Negative, BAD VALUE   
       670C 0203  
  1231 670E 10A1  GOTO95 JMP  ERR               Jump to error handler   
  1232      6710  ON20   EQU  $                 Now check GO TO/SUB   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0027
  1233 6710 0288         CI   R8,GOZ*256        Bare "GO" token?  
       6712 8500  
  1234 6714 1608         JNE  ON40              No, check other possibilities 
  1235 6716 06A0         BL   @PGMCHR           Yes, get next token   
       6718 6C74  
  1236 671A 0288  ON30   CI   R8,TOZ*256        "GO TO" ?   
       671C B100  
  1237 671E 1365         JEQ  GOTO50            Yes, handle GO TO like GOTO   
  1238 6720 0288         CI   R8,SUBZ*256       "GO SUB" ?  
       6722 A100  
  1239 6724 1005         JMP  ON50              Merge to common code to test  
  1240 6726 0288  ON40   CI   R8,GOTOZ*256      "GOTO" ?  
       6728 8600  
  1241 672A 135F         JEQ  GOTO50            Yes, go handle it   
  1242 672C 0288         CI   R8,GOSUBZ*256     "GOSUB" ?   
       672E 8700  
  1243 6730 168E  ON50   JNE  ERRONE            No, so is an error  
  1244 6732 06A0         BL   @PGMCHR           Get next token  
       6734 6C74  
  1245 6736 1002         JMP  GOSUB2            Goto gosub code   
  1246 6738 108A  ERR1B  JMP  ERRONE            Issue error message   
  1247            * NUD routine for "GOSUB"   
  1248 673A 04C3  GOSUB  CLR  R3                Dummy index for "ON" code   
  1249            * Common GOSUB code   
  1250      673C  GOSUB2 EQU  $                 Now build a FAC entry   
  1251 673C 0201         LI   R1,FAC            Optimize to save bytes  
       673E 834A  
  1252 6740 CC43         MOV  R3,*R1+           Save the "ON" index   
  1253            *                              in case of garbage collection
  1254 6742 DC60         MOVB @CBH66,*R1+       Indicate GOSUB entry on stack 
       6744 66F1  
  1255 6746 0581         INC  R1                Skip FAC3   
  1256 6748 C460         MOV  @PGMPTR,*R1       Save current ptr w/in line  
       674A 832C  
  1257 674C 05F1         INCT *R1+              Skip line # to correct place  
  1258 674E C460         MOV  @EXTRAM,*R1       Save current line # pointer   
       6750 832E  
  1259 6752 06A0         BL   @VPUSH            Save the stack entry  
       6754 6BAA  
  1260 6756 C0E0         MOV  @FAC,R3           Restore the "ON" index  
       6758 834A  
  1261 675A 1001         JMP  GOTO20            Jump to code to find the line 
  1262            * NUD routine for "GOTO"  
  1263 675C 04C3  GOTO   CLR  R3                Dummy index for "ON" code   
  1264            * Common (ON) GOTO/GOSUB THEN/ELSE code to fine line  
  1265            *   
  1266            * Get line number from program  
  1267 675E 0288  GOTO20 CI   R8,LNZ*256        Must have line number token   
       6760 C900  
  1268 6762 16EA         JNE  ERR1B             Don't, so error   
  1269 6764 06A0  GETL10 BL   @PGMCHR           Get MSB of the line number  
       6766 6C74  
  1270 6768 D008         MOVB R8,R0             Save it   
  1271 676A 06A0         BL   @PGMCHR           Read the character  
       676C 6C74  
  1272 676E 0603         DEC  R3                Decrement the "ON" index  
  1273 6770 1534         JGT  GOTO40            Loop if not there yet   
  1274            *   
  1275            * Find the program line   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0028
  1276            *   
  1277 6772 C060         MOV  @STLN,R1          Get into line # table   
       6774 8330  
  1278 6776 D0A0         MOVB @RAMFLG,R2        Check ERAM flag to see where? 
       6778 8389  
  1279 677A 1310         JEQ  GOTO31            From VDP, go handle it  
  1280 677C C081         MOV  R1,R2             Copy address  
  1281 677E 8801  GOT32  C    R1,@ENLN          Finished w/line # table?  
       6780 8332  
  1282 6782 1422         JHE  GOTO34            Yes, so line doesn't exist  
  1283 6784 D0F2         MOVB *R2+,R3           2nd byte match?   
  1284 6786 0243         ANDI R3,>7FFF          Reset possible breakpoint   
       6788 7FFF  
  1285 678A 9003         CB   R3,R0             Compare 1st byte of #, Match? 
  1286 678C 1605         JNE  GOT35             Not a match, so move on   
  1287 678E 9232         CB   *R2+,R8           2nd byte match?   
  1288 6790 131E         JEQ  GOTO36            Yes, line is found!   
  1289 6792 05C2  GOT33  INCT R2                Skip line pointer   
  1290 6794 C042         MOV  R2,R1             Advance to next line in table 
  1291 6796 10F3         JMP  GOT32             Go back for more  
  1292 6798 D0F2  GOT35  MOVB *R2+,R3           Skip 2nd byte of line #   
  1293 679A 10FB         JMP  GOT33             And jump back in  
  1294 679C D7E0  GOTO31 MOVB @R1LB,*R15        Get the data from the VDP   
       679E 83E3  
  1295 67A0 0202         LI   R2,XVDPRD         Load up to read data  
       67A2 8800  
  1296 67A4 D7C1         MOVB R1,*R15           Write out MSB of address  
  1297 67A6 8801  GOTO32 C    R1,@ENLN          Finished w/line # table   
       67A8 8332  
  1298 67AA 140E         JHE  GOTO34            Yes, so line doesn't exist  
  1299 67AC D0D2         MOVB *R2,R3            Save in temporary place for   
  1300            *                              breakpoint checking  
  1301 67AE 0243         ANDI R3,>7FFF          Reset possible breakpoint   
       67B0 7FFF  
  1302 67B2 9003         CB   R3,R0             Compare 1st byte of #, Match? 
  1303 67B4 1607         JNE  GOTO35            Not a match, so move on   
  1304 67B6 9212         CB   *R2,R8            2nd byte match?   
  1305 67B8 130A         JEQ  GOTO36            Yes, line is found!   
  1306 67BA D0D2  GOTO33 MOVB *R2,R3            Skip 1st byte of line pointer 
  1307 67BC 0221         AI   R1,4              Advance to next line in table 
       67BE 0004  
  1308 67C0 D0D2         MOVB *R2,R3            Skip 1nd byte of line pointer 
  1309 67C2 10F1         JMP  GOTO32            Go back for more  
  1310 67C4 D0D2  GOTO35 MOVB *R2,R3            Skip 2nd byte of line #   
  1311 67C6 10F9         JMP  GOTO33            And jump back in  
  1312 67C8 0200  GOTO34 LI   R0,ERRLNF         LINE NOT FOUND error vector   
       67CA 0303  
  1313 67CC 10A0         JMP  GOTO95            Jump for error exit   
  1314 67CE 05C1  GOTO36 INCT R1                Adjust to line pointer  
  1315 67D0 C801         MOV  R1,@EXTRAM        Save for execution of the line
       67D2 832E  
  1316 67D4 0649         DECT R9                Pop saved link to goto  
  1317 67D6 0460         B    @EXEC10           Reenter EXEC code directly  
       67D8 650E  
  1318 67DA 06A0  GOTO40 BL   @PGMCHR           Get next token  
       67DC 6C74  
  1319 67DE 06A0         BL   @EOSTMT           Premature end of statement?   
       67E0 6862  
  1320 67E2 1393         JEQ  GOTO90            Yes =>BAD VALUE for index   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0029
  1321 67E4 0288         CI   R8,COMMAZ*256     Comma next ?  
       67E6 B300  
  1322 67E8 1603         JNE  ERR1C             No, error   
  1323 67EA 06A0  GOTO50 BL   @PGMCHR           Yes, get next character   
       67EC 6C74  
  1324 67EE 10B7         JMP  GOTO20            And check this index value  
  1325 67F0 10A3  ERR1C  JMP  ERR1B             Linking becuase long-distance 
  1326 67F2 0200  ERR51  LI   R0,>0903          RETURN WITHOUT GOSUB  
       67F4 0903  
  1327 67F6 108B         JMP  GOTO95            Exit to GPL   
  1328            * NUD entry for "RETURN"  
  1329 67F8 8820  RETURN C    @VSPTR,@STVSPT    Check bottom of stack   
       67FA 836E  
       67FC 8324  
  1330 67FE 12F9         JLE  ERR51             Error -> RETURN WITHOUT GOSUB 
  1331 6800 06A0         BL   @VPOP             Pop entry   
       6802 6C2A  
  1332 6804 9820         CB   @CBH66,@FAC2      Check ID for a GOSUB entry  
       6806 66F1  
       6808 834C  
  1333 680A 160B         JNE  RETU30            Check for ERROR ENTRY   
  1334            *   
  1335            * Have a GOSUB entry  
  1336            *   
  1337 680C 06A0         BL   @EOSTMT           Must have EOS after return  
       680E 6862  
  1338 6810 16F3         JNE  RETURN            Not EOS, then error return?   
  1339 6812 C820         MOV  @FAC4,@PGMPTR     Get return ptr w/in line  
       6814 834E  
       6816 832C  
  1340 6818 C820         MOV  @FAC6,@EXTRAM     Get return line pointer   
       681A 8350  
       681C 832E  
  1341 681E 0460         B    @SKPS01           Go adjust it and get back   
       6820 6624  
  1342            * Check ERROR entry   
  1343 6822 9820  RETU30 CB   @CBH69,@FAC2      ERROR ENTRY?  
       6824 6A9B  
       6826 834C  
  1344 6828 1307         JEQ  RETU40            Yes, take care of error entry 
  1345 682A 9820         CB   @CBH6A,@FAC2      Subprogram entry?   
       682C 6860  
       682E 834C  
  1346 6830 16E3         JNE  RETURN            No, look some more  
  1347 6832 06A0         BL   @VPUSH            Push it back. Keep information
       6834 6BAA  
  1348 6836 10DD         JMP  ERR51             RETURN WITHOUT GOSUB error  
  1349            *   
  1350            * Have an ERROR entry   
  1351            * RETURN, RETURN line #, RETURN or RETURN NEXT follows.   
  1352            *   
  1353 6838 04C3  RETU40 CLR  R3                In case of a line number  
  1354 683A 0288         CI   R8,LNZ*256        Check for a line number   
       683C C900  
  1355 683E 1392         JEQ  GETL10            Yes, treat like GOTO  
  1356 6840 C820         MOV  @FAC4,@PGMPTR     Get return ptr w/in line  
       6842 834E  
       6844 832C  
  1357 6846 C820         MOV  @FAC6,@EXTRAM     Get return line pointer   

 99/4 ASSEMBLER
PARSES                                                       PAGE 0030
       6848 8350  
       684A 832E  
  1358 684C 06A0         BL   @EOSTMT           EOL now?  
       684E 6862  
  1359 6850 1305         JEQ  BEXC15            Yes, treat like GOSUB rtn.  
  1360 6852 0288         CI   R8,NEXTZ*256      NEXT now?   
       6854 9600  
  1361 6856 16CC         JNE  ERR1C             No, so its an error   
  1362 6858 0460         B    @SKPS01           Yes, so execute next statement
       685A 6624  
  1363 685C 0460  BEXC15 B    @EXEC15           Execute next line   
       685E 6542  
  1364 6860   6A  CBH6A  BYTE >6A               Subprogram call stack ID  
  1365                   EVEN   
  1366            ************************************************************
  1367            *         EOSTMT - Check for End-Of-STateMenT   
  1368            *         Returns with condition '=' if EOS   
  1369            *           else condition '<>' if not EOS  
  1370            ************************************************************
  1371 6862 D208  EOSTMT MOVB R8,R8             EOL or non-token?   
  1372 6864 1305         JEQ  EOSTM1            EOL-return condition '='  
  1373 6866 1504         JGT  EOSTM1            Non-token return condition '<>
  1374 6868 0288         CI   R8,TREMZ*256      In the EOS range (>81 to >83)?
       686A 8300  
  1375 686C 1B01         JH   EOSTM1            No, return condition '<>'   
  1376 686E 8208         C    R8,R8             Yes, force condition to '='   
  1377 6870 045B  EOSTM1 RT   
  1378            ************************************************************
  1379            *         EOLINE - Tests for End-Of-LINE; either a >00 or a 
  1380            *                  '!'  
  1381            *         Returns with condition '=' if EOL else condition  
  1382            *                  '<>' if not EOL  
  1383            ************************************************************
  1384 6872 D208  EOLINE MOVB R8,R8             EOL?  
  1385 6874 1302         JEQ  EOLNE1            Yes, return with '=' set  
  1386 6876 0288         CI   R8,TREMZ*256      Set condition on a tall remark
       6878 8300  
  1387 687A 045B  EOLNE1 RT                     And return  
  1388 687C 0200  SYMB20 LI   R0,UDF            Long distance   
       687E 0006  
  1389 6880 0460         B    @GOTO95   
       6882 670E  
  1390            * NUD for a symbol (variable)   
  1391 6884 06A0  PSYM   BL   @SYM              Get symbol table entry  
       6886 6312  
  1392 6888 06A0         BL   @GETV             Get 1st byte of entry   
       688A 187C  
  1393 688C 834A         DATA FAC               SYM left pointer in FAC   
  1394            *   
  1395 688E 0A11         SLA  R1,1              UDF reference?  
  1396 6890 11F5         JLT  SYMB20            Yes, special code for it  
  1397 6892 06A0         BL   @SMB              No, get value space pointer   
       6894 61DC  
  1398 6896 9820         CB   @FAC2,@CBH65      String reference?   
       6898 834C  
       689A 65A7  
  1399 689C 1302         JEQ  SYMB10            Yes, special code for it  
  1400 689E 06A0         BL   @MOVFAC           No, numeric ->copy into FAC   
       68A0 6434  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0031
  1401 68A2 0460  SYMB10 B    @CONT             And continue the PARSE  
       68A4 64C8  
  1402            * Statement entry for IF statement  
  1403 68A6 06A0  IF     BL   @PARSE            Evaluate the expression   
       68A8 6480  
  1404 68AA   B3         BYTE COMMAZ            Stop on a comma   
  1405 68AB   67  CBH67  BYTE >67               Unused byte for a constant  
  1406 68AC 06A0         BL   @NUMCHK           Ensure the value is a number  
       68AE 6B92  
  1407 68B0 04C3         CLR  R3                Create a dummy "ON" index   
  1408 68B2 0288         CI   R8,THENZ*256      Have a "THEN" token   
       68B4 B000  
  1409 68B6 169C         JNE  ERR1C             No, error   
  1410 68B8 0520         NEG  @FAC              Test if condition true i.e. <>
       68BA 834A  
  1411 68BC 1610         JNE  IFZ10             True - branch to the special #
  1412 68BE 06A0         BL   @PGMCHR           Advance to line number token  
       68C0 6C74  
  1413 68C2 0288         CI   R8,LNZ*256        Have the line # token?  
       68C4 C900  
  1414 68C6 1619         JNE  IFZ20             No, must look harder for ELSE 
  1415 68C8 05E0         INCT @PGMPTR           Skip the line number  
       68CA 832C  
  1416 68CC 06A0         BL   @PGMCHR           Get next token  
       68CE 6C74  
  1417 68D0 0288  IFZ5   CI   R8,ELSEZ*256      Test if token is ELSE   
       68D2 8100  
  1418 68D4 1304         JEQ  IFZ10             We do! So branch to the line #
  1419 68D6 0460         B    @EOL              We don't, so better be EOL  
       68D8 65D6  
  1420 68DA 0460  GETL1Z B    @GETL10           Get 1st token of clause   
       68DC 6764  
  1421 68DE 06A0  IFZ10  BL   @PGMCHR           Get 1st token of clause   
       68E0 6C74  
  1422 68E2 0288         CI   R8,LNZ*256        Line # token?   
       68E4 C900  
  1423 68E6 13F9         JEQ  GETL1Z            Yes, go there   
  1424 68E8 06A0         BL   @EOSTMT           EOS?  
       68EA 6862  
  1425 68EC 1381  JEQ1C  JEQ  ERR1C             Yes, its an error   
  1426 68EE 0208         LI   R8,SSEPZ*256      Cheat to do a continue  
       68F0 8200  
  1427 68F2 0620         DEC  @PGMPTR           Back up to get 1st character  
       68F4 832C  
  1428 68F6 0460         B    @CONT             Continue on   
       68F8 64C8  
  1429            *   
  1430            * LOOK FOR AN ELSE CLAUSE SINCE THE CONDITION WAS FALSE   
  1431            *   
  1432 68FA 0203  IFZ20  LI   R3,1              IF/ELSE pair counter  
       68FC 0001  
  1433 68FE 06A0         BL   @EOLINE           Trap out EOS following THEN/EL
       6900 6872  
  1434 6902 13F4         JEQ  JEQ1C             error   
  1435 6904 0288  IFZ25  CI   R8,ELSEZ*256      ELSE?   
       6906 8100  
  1436 6908 1603         JNE  IFZ27             If not  
  1437 690A 0603         DEC  R3                Matching ELSE?  
  1438 690C 13E8         JEQ  IFZ10             Yes, do it  

 99/4 ASSEMBLER
PARSES                                                       PAGE 0032
  1439 690E 100F         JMP  IFZ35             No, go on   
  1440 6910 0288  IFZ27  CI   R8,IFZ*256        Check for it  
       6912 8400  
  1441 6914 1602         JNE  IFZ28             Not an IF   
  1442 6916 0583         INC  R3                Increment nesting level   
  1443 6918 100A         JMP  IFZ35              And go on  
  1444 691A 0288  IFZ28  CI   R8,STRINZ*256     Lower than string?  
       691C C700  
  1445 691E 1A04         JL   IFZ30             Yes   
  1446 6920 0288         CI   R8,LNZ*256        Higher or = to a line #   
       6922 C900  
  1447 6924 1307         JEQ  IFZ40             = line #  
  1448 6926 1A09         JL   IFZ50             Skip strings and numerics   
  1449 6928 06A0  IFZ30  BL   @EOLINE           EOL?  
       692A 6872  
  1450 692C 13D1         JEQ  IFZ5              Yes, done scanning  
  1451 692E 06A0  IFZ35  BL   @PGMCHR           Get next character  
       6930 6C74  
  1452 6932 10E8         JMP  IFZ25               And go on   
  1453            *   
  1454            * SKIP LINE #'s   
  1455            *   
  1456 6934 05E0  IFZ40  INCT @PGMPTR           Skip the line #   
       6936 832C  
  1457 6938 10FA         JMP  IFZ35             Go on   
  1458            *   
  1459            * SKIP STRINGS AND NUMERICS   
  1460            *   
  1461 693A 06A0  IFZ50  BL   @PGMCHR           Get # of bytes to skip  
       693C 6C74  
  1462 693E 06C8         SWPB R8                Swap for add  
  1463 6940 A808         A    R8,@PGMPTR        Skip it   
       6942 832C  
  1464 6944 04C8         CLR  R8                Clear LSB of R8   
  1465 6946 10F3         JMP  IFZ35   
  1466            ************************************************************
  1467                
  1469                
  1470            ************************************************************
  1471            *                   'LET' statement handler   
  1472            * Assignments are done bye putting an entry on the stack  
  1473            * for the destination variable and getting the source value 
  1474            * into the FAC. Multiple assignments are handled by the   
  1475            * stacking the variable entrys and then looping for the   
  1476            * assignments. Numeric assignments pose no problems,  
  1477            * strings are more complicated. String assignments are done 
  1478            * by assigning the source string to the last variable   
  1479            * specified in the list and changing the FAC entry so that  
  1480            * the string assigned to the next-to-the-last variable  
  1481            * comes from the permanent string belonging to the variable 
  1482            * just assigned.  
  1483            * e.g.    A$,B$,C$="HELLO"  
  1484            *   
  1485            *         C$-------"HELLO" (source string)  
  1486            *   
  1487            *         B$-------"HELLO" (copy from C$'s string)  
  1488            *   
  1489            *         A$-------"HELLO" (copy from B$'s string)  
  1490            ************************************************************

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0033
  1491 6948 04E0  NLET   CLR  @PAD0             Counter for multiple assign's 
       694A 8300  
  1492 694C 06A0  NLET05 BL   @SYM              Get symbol table address  
       694E 6312  
  1493            *-----------------------------------------------------------
  1494            * The following code has been taken out for checking is   
  1495            * inserted in SMB             5/22/81   
  1496            *      BL   @GETV             Get first byte of entry   
  1497            *      DATA FAC               SYM left pointer in FAC   
  1498            *      SLA  R1,1              Test if a UDF   
  1499            *      JLT  ERRMUV            Is a UDF - so error   
  1500            *-----------------------------------------------------------
  1501 6950 06A0         BL   @SMB              Get value space pointer   
       6952 61DC  
  1502 6954 06A0         BL   @VPUSH            Push s.t. pointer on stack  
       6956 6BAA  
  1503 6958 05A0         INC  @PAD0             Count the variable  
       695A 8300  
  1504 695C 0288         CI   R8,EQZ*256        Is the token an '='?  
       695E BE00  
  1505 6960 130B         JEQ  NLET10            Yes, go into assignment loop  
  1506 6962 0288         CI   R8,COMMAZ*256     Must have a comma now   
       6964 B300  
  1507 6966 161E         JNE  ERR1CZ            Didn't - so error   
  1508 6968 06A0         BL   @PGMCHR           Get next token  
       696A 6C74  
  1509 696C 15EF         JGT  NLET05            If legal symbol character   
  1510 696E 101A         JMP  ERR1CZ            If not - error  
  1511 6970 0200  ERRMUV LI   R0,>0D03          MULTIPLY USED VARIABLE  
       6972 0D03  
  1512 6974 0460         B    @ERR  
       6976 6652  
  1513 6978 06A0  NLET10 BL   @PGMCHR           Get next token  
       697A 6C74  
  1514 697C 06A0         BL   @PARSE            PARSE the value to assign   
       697E 6480  
  1515 6980   83         BYTE TREMZ             Parse to the end of statement 
  1516 6981   65  STCOD2 BYTE >65               Wasted byte (STCODE copy)   
  1517            * Loop for assignments  
  1518 6982 06A0  NLET15 BL   @ASSG             Assign the value to the symbol
       6984 6334  
  1519 6986 0620         DEC  @PAD0             One less to assign, done?   
       6988 8300  
  1520 698A 130A         JEQ  LETCON            Yes, branch out   
  1521 698C 9820         CB   @FAC2,@STCOD2     String or numeric?  
       698E 834C  
       6990 6981  
  1522 6992 16F7         JNE  NLET15            Numeric, just loop for more   
  1523 6994 C806         MOV  R6,@FAC4          Get pointer to new string   
       6996 834E  
  1524 6998 C820         MOV  @ARG,@FAC         Get pointer to last s.t. entry
       699A 835C  
       699C 834A  
  1525 699E 10F1         JMP  NLET15            Now loop to assign more   
  1526 69A0 0460  LETCON B    @EOL              Yes, continue the PARSE   
       69A2 65D6  
  1527 69A4 0460  ERR1CZ B    @ERR1C            For long distance jump  
       69A6 67F0  
  1528 69A8 664E         DATA NONUD             (SPARE)             >80   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0034
  1529 69AA 664E         DATA NONUD             ELSE                >81   
  1530 69AC 65C4         DATA SMTSEP            ::                  >82   
  1531 69AE 65E6         DATA NUDND1            !                   >83   
  1532 69B0 68A6         DATA IF                IF                  >84   
  1533 69B2 66D6         DATA GO                GO                  >85   
  1534 69B4 675C         DATA GOTO              GOTO                >86   
  1535 69B6 673A         DATA GOSUB             GOSUB               >87   
  1536 69B8 67F8         DATA RETURN            RETURN              >88   
  1537 69BA 65F0         DATA NUDEND            DEF                 >89   
  1538 69BC 65F0         DATA NUDEND            DIM                 >8A   
  1539 69BE 665E         DATA END               END                 >8B   
  1540 69C0 7000         DATA NFOR              FOR                 >8C   
  1541 69C2 6948         DATA NLET              LET                 >8D   
  1542 69C4 8002         DATA >8002             BREAK               >8E   
  1543 69C6 8004         DATA >8004             UNBREAK             >8F   
  1544 69C8 8006         DATA >8006             TRACE               >90   
  1545 69CA 8008         DATA >8008             UNTRACE             >91   
  1546 69CC 8016         DATA >8016             INPUT               >92   
  1547 69CE 65E6         DATA NUDND1            DATA                >93   
  1548 69D0 8012         DATA >8012             RESTORE             >94   
  1549 69D2 8014         DATA >8014             RANDOMIZE           >95   
  1550 69D4 7230         DATA NNEXT             NEXT                >96   
  1551 69D6 800A         DATA >800A             READ                >97   
  1552 69D8 665E         DATA STOP              STOP                >98   
  1553 69DA 8032         DATA >8032             DELETE              >99   
  1554 69DC 65E6         DATA NUDND1            REM                 >9A   
  1555 69DE 66DA         DATA ON                ON                  >9B   
  1556 69E0 800C         DATA >800C             PRINT               >9C   
  1557 69E2 750A         DATA CALL              CALL                >9D   
  1558 69E4 65F0         DATA NUDEND            OPTION              >9E   
  1559 69E6 8018         DATA >8018             OPEN                >9F   
  1560 69E8 801A         DATA >801A             CLOSE               >A0   
  1561 69EA 665E         DATA STOP              SUB                 >A1   
  1562 69EC 8034         DATA >8034             DISPLAY             >A2   
  1563 69EE 65E6         DATA NUDND1            IMAGE               >A3   
  1564 69F0 8024         DATA >8024             ACCEPT              >A4   
  1565 69F2 664E         DATA NONUD             ERROR               >A5   
  1566 69F4 664E         DATA NONUD             WARNING             >A6   
  1567 69F6 78D2         DATA SUBXIT            SUBEXIT             >A7   
  1568 69F8 78D2         DATA SUBXIT            SUBEND              >A8   
  1569 69FA 800E         DATA >800E             RUN                 >A9   
  1570 69FC 8010  STMTTB DATA >8010             LINPUT              >AA   
  1571 69FE 6E68  NTAB   DATA NLPR              LEFT PARENTHISIS    >B7   
  1572 6A00 664E         DATA NONUD             CONCATENATE         >B8   
  1573 6A02 664E         DATA NONUD             SPARE               >B9   
  1574 6A04 664E         DATA NONUD             AND                 >BA   
  1575 6A06 664E         DATA NONUD             OR                  >BB   
  1576 6A08 664E         DATA NONUD             XOR                 >BC   
  1577 6A0A 6E2E         DATA O0NOT             NOT                 >BD   
  1578 6A0C 664E         DATA NONUD             =                   >BE   
  1579 6A0E 664E         DATA NONUD             <                   >BF   
  1580 6A10 664E         DATA NONUD             >                   >C0   
  1581 6A12 6E96         DATA NPLUS             +                   >C1   
  1582 6A14 6E82         DATA NMINUS            -                   >C2   
  1583 6A16 664E         DATA NONUD             *                   >C3   
  1584 6A18 664E         DATA NONUD             /                   >C4   
  1585 6A1A 664E         DATA NONUD             ^                   >C5   
  1586 6A1C 664E         DATA NONUD             SPARE               >C6   
  1587 6A1E 7442         DATA NSTRCN            QUOTED STRING       >C7   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0035
  1588 6A20 6684         DATA NUMCON        UNQUOTED STRING/NUMERIC >C8   
  1589 6A22 664E         DATA NONUD             LINE NUMBER         >C9   
  1590 6A24 8026         DATA >8026             EOF                 >CA   
  1591 6A26 6CFA         DATA NABS              ABS                 >CB   
  1592 6A28 6D16         DATA NATN              ATN                 >CC   
  1593 6A2A 6D1C         DATA NCOS              COS                 >CD   
  1594 6A2C 6D22         DATA NEXP              EXP                 >CE   
  1595 6A2E 6D28         DATA NINT              INT                 >CF   
  1596 6A30 6D2E         DATA NLOG              LOG                 >D0   
  1597 6A32 6D34         DATA NSGN              SGN                 >D1   
  1598 6A34 6D64         DATA NSIN              SIN                 >D2   
  1599 6A36 6D6A         DATA NSQR              SQR                 >D3   
  1600 6A38 6D70         DATA NTAN              TAN                 >D4   
  1601 6A3A 8036         DATA >8036             LEN                 >D5   
  1602 6A3C 8038         DATA >8038             CHRZ                >D6   
  1603 6A3E 803A         DATA >803A             RND                 >D7   
  1604 6A40 8030         DATA >8030             SEGZ                >D8   
  1605 6A42 802A         DATA >802A             POS                 >D9   
  1606 6A44 802C         DATA >802C             VAL                 >DA   
  1607 6A46 802E         DATA >802E             STR                 >DB   
  1608 6A48 8028         DATA >8028             ASC                 >DC   
  1609 6A4A 801C         DATA >801C             PI                  >DD   
  1610 6A4C 8000         DATA >8000             REC                 >DE   
  1611 6A4E 801E         DATA >801E             MAX                 >DF   
  1612 6A50 8020         DATA >8020             MIN                 >E0   
  1613 6A52 8022         DATA >8022             RPTZ                >E1   
  1614      0056  NTABLN EQU  $-NTAB  
  1615 6A54 667E  LTAB   DATA CONC              &                   >B8   
  1616 6A56 664E         DATA NOLED             SPARE               >B9   
  1617 6A58 6E1C         DATA O0OR              OR                  >BA   
  1618 6A5A 6DFA         DATA O0AND             AND                 >BB   
  1619 6A5C 6E50         DATA O0XOR             XOR                 >BC   
  1620 6A5E 664E         DATA NOLED             NOT                 >BD   
  1621 6A60 6A8E         DATA EQUALS            =                   >BE   
  1622 6A62 6A70         DATA LESS              <                   >BF   
  1623 6A64 6A7E         DATA GREATR            >                   >C0   
  1624 6A66 6B1E         DATA PLUS              +                   >C1   
  1625 6A68 6B4A         DATA MINUS             -                   >C2   
  1626 6A6A 6B56         DATA TIMES             *                   >C3   
  1627 6A6C 6B62         DATA DIVIDE            /                   >C4   
  1628 6A6E 6CE2         DATA LEXP              ^                   >C5   
  1629      001C  LTBLEN EQU  $-LTAB  
  1630            ************************************************************
  1631            *                     Relational operators  
  1632            * Logical conparisons encode the type of comparison and use 
  1633            * common code to PARSE the expression and set the status  
  1634            * bits.   
  1635            *   
  1636            * The types of legal comparisons are:   
  1637            *                             0 EQUAL   
  1638            *                             1 NOT EQUAL   
  1639            *                             2 LESS THAN   
  1640            *                             3 LESS OR EQUAL   
  1641            *                             4 GREATER THAN  
  1642            *                             5 GREATER THAN OR EQUAL   
  1643            *   
  1644            * This code is saved on the subroutine stack  
  1645            ************************************************************
  1646 6A70 0202  LESS   LI   R2,2              LESS-THAN code for common rtn 

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0036
       6A72 0002  
  1647 6A74 0288         CI   R8,GTZ*256        Test for '>' token  
       6A76 C000  
  1648 6A78 1604         JNE  LT10              Jump if not   
  1649 6A7A 0642         DECT R2                Therefore, NOT-EQUAL code   
  1650 6A7C 1005         JMP  LT15              Jump to common  
  1651      6A80  C4     EQU  $+2               Constant 4  
  1652 6A7E 0202  GREATR LI   R2,4              GREATER-THEN code for common  
       6A80 0004  
  1653 6A82 0288  LT10   CI   R8,EQZ*256        Test for '=' token  
       6A84 BE00  
  1654 6A86 1605         JNE  LTST01            Jump if '>='  
  1655 6A88 06A0  LT15   BL   @PGMCHR           Must be plain old '>' or '<'  
       6A8A 6C74  
  1656 6A8C 1001         JMP  LEDLE             Jump to test  
  1657 6A8E 0702  EQUALS SETO R2                Equal bit for common routine  
  1658 6A90 0582  LEDLE  INC  R2                Sets to zero  
  1659 6A92 05C9  LTST01 INCT R9                Get room on stack for code  
  1660 6A94 C642         MOV  R2,*R9            Save status matching code   
  1661 6A96 06A0         BL   @PSHPRS           Push 1st arg and PARSE the 2nd
       6A98 6B9C  
  1662 6A9A   C0         BYTE GTZ               Parse to a '>'  
  1663 6A9B   69  CBH69  BYTE >69               Used in RETURN routine  
  1664 6A9C C119         MOV  *R9,R4            Get the type code from stack  
  1665 6A9E 0649         DECT R9                Reset subroutine stack pointer
  1666 6AA0 D324         MOVB @LTSTAB(R4),R12   Get address bias to baranch to
       6AA2 6ADA  
  1667 6AA4 088C         SRA  R12,8             Right justify   
  1668 6AA6 06A0         BL   @ARGTST           Test for matching arguments   
       6AA8 6B6E  
  1669 6AAA 131A         JEQ  LTST20            Handle strings specially  
  1670 6AAC 06A0         BL   @SCOMPB           Floating point comparison   
       6AAE 0D42  
  1671 6AB0 046C  LTST15 B    @LTSTXX(R12)      Interpret the status by code  
       6AB2 6AB4  
  1672      6AB4  LTSTXX EQU  $   
  1673 6AB4 1504  LTSTGE JGT  LTRUE             Test if GREATER or EQUAL  
  1674 6AB6 1303  LTSTEQ JEQ  LTRUE             Test if EQUAL   
  1675 6AB8 04C4  LFALSE CLR  R4                FALSE is a ZERO   
  1676 6ABA 1003         JMP  LTST90            Put it into FAC   
  1677 6ABC 13FD  LTSTNE JEQ  LFALSE            Test if NOT-EQUAL   
  1678 6ABE 0204  LTRUE  LI   R4,>BFFF          TRUE is a minus-one   
       6AC0 BFFF  
  1679 6AC2 0203  LTST90 LI   R3,FAC            Store result in FAC   
       6AC4 834A  
  1680 6AC6 CCC4         MOV  R4,*R3+           Exp & 1st byte of manitissa   
  1681 6AC8 04F3         CLR  *R3+              ZERO the remaining digits   
  1682 6ACA 04F3         CLR  *R3+              ZERO the remaining digits   
  1683 6ACC 04F3         CLR  *R3+              ZERO the remaining digits   
  1684 6ACE 1039         JMP  LEDEND            Jump to end of LED routine  
  1685 6AD0 13F6  LTSTLE JEQ  LTRUE             Test LESS-THAN or EQUAL   
  1686 6AD2 11F5  LTSTLT JLT  LTRUE             Test LESS-THEN  
  1687 6AD4 10F1         JMP  LFALSE            Jump to false   
  1688 6AD6 15F3  LTSTGT JGT  LTRUE             Test GREATER-THAN   
  1689 6AD8 10EF         JMP  LFALSE            Jump to false   
  1690            * Data table for offsets for types  
  1691 6ADA   02  LTSTAB BYTE LTSTEQ-LTSTXX     EQUAL               (0)   
  1692 6ADB   08         BYTE LTSTNE-LTSTXX     NOT EQUAL           (1)   
  1693 6ADC   1E         BYTE LTSTLT-LTSTXX     LESS THEN           (2)   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0037
  1694 6ADD   1C         BYTE LTSTLE-LTSTXX     LESS or EQUAL       (3)   
  1695 6ADE   22         BYTE LTSTGT-LTSTXX     GREATER THEN        (4)   
  1696 6ADF   00         BYTE LTSTGE-LTSTXX     GREATER or EQUAL    (5)   
  1697 6AE0 C2A0  LTST20 MOV  @FAC4,R10         Pointer to string1  
       6AE2 834E  
  1698 6AE4 D1E0         MOVB @FAC7,R7          R7 = string2 length   
       6AE6 8351  
  1699 6AE8 06A0         BL   @VPOP             Get LH arg back   
       6AEA 6C2A  
  1700 6AEC C120         MOV  @FAC4,R4          Pointer to string2  
       6AEE 834E  
  1701 6AF0 D1A0         MOVB @FAC7,R6          R6 = string2 length   
       6AF2 8351  
  1702 6AF4 D146         MOVB R6,R5             R5 will contain shorter length
  1703 6AF6 91C6         CB   R6,R7             Compare the 2 lengths   
  1704 6AF8 1101         JLT  CSTR05            Jump if length2 < length1   
  1705 6AFA D147         MOVB R7,R5             Swap if length1 > length2   
  1706 6AFC 0985  CSTR05 SRL  R5,8              Shift for speed and test zero 
  1707 6AFE 130D         JEQ  CSTR20            If ZERO-set status with length
  1708 6B00 C0CA  CSTR10 MOV  R10,R3            Current character location  
  1709 6B02 058A         INC  R10               Increment pointer   
  1710 6B04 06A0         BL   @GETV1            Get from VDP  
       6B06 1880  
  1711 6B08 D001         MOVB R1,R0             And save for comparison   
  1712 6B0A C0C4         MOV  R4,R3             Current char location in ARG  
  1713 6B0C 0584         INC  R4                Increment pointer   
  1714 6B0E 06A0         BL   @GETV1            Get from VDP  
       6B10 1880  
  1715 6B12 9001         CB   R1,R0             Compare the characters  
  1716 6B14 16CD         JNE  LTST15            Return with status if <>  
  1717 6B16 0605         DEC  R5                Otherwise, decrement counter  
  1718 6B18 15F3         JGT  CSTR10            And loop for each character   
  1719 6B1A 91C6  CSTR20 CB   R6,R7             Status set by length compare  
  1720 6B1C 10C9         JMP  LTST15            Return to do test of status   
  1721            * ARITHMETIC FUNCTIONS  
  1722 6B1E 06A0  PLUS   BL   @PSHPRS           Push left arg and PARSE right 
       6B20 6B9C  
  1723 6B22   C2         BYTE MINUSZ,0          Stop on a minus!!!!!!!!!!!!!!!
       6B23   00  
  1724 6B24 0202         LI   R2,SADD           Address of add routine  
       6B26 0D84  
  1725 6B28 04E0  LEDEX  CLR  @FAC10            Clear error code  
       6B2A 8354  
  1726 6B2C 06A0         BL   @ARGTST           Make sure both numerics   
       6B2E 6B6E  
  1727 6B30 132E         JEQ  ARGT05            If strings, error   
  1728 6B32 06A0         BL   @SAVREG           Save registers  
       6B34 1E8C  
  1729 6B36 0692         BL   *R2               Do the operation  
  1730 6B38 06A0         BL   @SETREG           Restore registers   
       6B3A 1E7A  
  1731 6B3C D0A0         MOVB @FAC10,R2         Test for overflow   
       6B3E 8354  
  1732 6B40 1602         JNE  LEDERR            If overflow ->error   
  1733 6B42 0460  LEDEND B    @CONT             Continue the PARSE  
       6B44 64C8  
  1734 6B46 0460  LEDERR B    @WARNZZ           Overflow - issue warning  
       6B48 6662  
  1735 6B4A 06A0  MINUS  BL   @PSHPRS           Push left arg and PARSE right 

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0038
       6B4C 6B9C  
  1736 6B4E   C2         BYTE MINUSZ,0          Parse to a minus  
       6B4F   00  
  1737 6B50 0202         LI   R2,SSUB           Address of subtract routine   
       6B52 0D74  
  1738 6B54 10E9         JMP  LEDEX             Common code for the operation 
  1739 6B56 06A0  TIMES  BL   @PSHPRS           Push left arg and PARSE right 
       6B58 6B9C  
  1740 6B5A   C4         BYTE DIVIZ,0           Parse to a divide!!!!!!!!!!!!!
       6B5B   00  
  1741 6B5C 0202         LI   R2,SMULT          Address of multiply routine   
       6B5E 0E8C  
  1742 6B60 10E3         JMP  LEDEX             Common code for the operation 
  1743 6B62 06A0  DIVIDE BL   @PSHPRS           Push left arg and PARSE right 
       6B64 6B9C  
  1744 6B66   C4         BYTE DIVIZ,0           Parse to a divide   
       6B67   00  
  1745 6B68 0202         LI   R2,SDIV           Address of divide routine   
       6B6A 0FF8  
  1746 6B6C 10DD         JMP  LEDEX             Common code for the operation 
  1747            ************************************************************
  1748            * Test arguments on both the stack and in the FAC   
  1749            *      Both must be of the same type  
  1750            *  CALL:  
  1751            *      BL   @ARGTST   
  1752            *      JEQ                    If string   
  1753            *      JNE                    If numeric  
  1754            ************************************************************
  1755 6B6E C1A0  ARGTST MOV  @VSPTR,R6         Get stack pointer   
       6B70 836E  
  1756 6B72 05C6         INCT R6  
  1757 6B74 D7E0         MOVB @R6LB,*R15        Load 2nd byte of stack address
       6B76 83ED  
  1758 6B78 1000         NOP                    Kill some time  
  1759 6B7A D7C6         MOVB R6,*R15           Load 1st byte of stack address
  1760 6B7C 1000         NOP                    Kill some time  
  1761 6B7E 9820         CB   @XVDPRD,@CBH65    String in operand 1?  
       6B80 8800  
       6B82 65A7  
  1762 6B84 1606         JNE  ARGT10            No, numeric   
  1763 6B86 9820         CB   @FAC2,@CBH65      Yes, is other the same?   
       6B88 834C  
       6B8A 65A7  
  1764 6B8C 1306         JEQ  ARGT20            Yes, do string comparison   
  1765 6B8E 0460  ARGT05 B    @ERRT             Data types don't match  
       6B90 630C  
  1766            NUMCHK  
  1767 6B92 9820  ARGT10 CB   @FAC2,@CBH65      2nd operand can't be string   
       6B94 834C  
       6B96 65A7  
  1768 6B98 13FA         JEQ  ARGT05            If so, error  
  1769 6B9A 045B  ARGT20 RT                     Ok, so return with status   
  1770            * VPUSH followed by a PARSE   
  1771 6B9C 05C9  PSHPRS INCT R9                Get room on stack   
  1772 6B9E 0289         CI   R9,STKEND         Stack full?   
       6BA0 83BA  
  1773 6BA2 1B41         JH   VPSH27            Yes, error  
  1774 6BA4 C64B         MOV  R11,*R9           Save return on stack  
  1775 6BA6 020B         LI   R11,P05           Optimize for the parse  

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0039
       6BA8 648A  
  1776            * Stack VPUSH routine   
  1777 6BAA 0200  VPUSH  LI   R0,8              Pushing 8 byte entries  
       6BAC 0008  
  1778 6BAE A800         A    R0,@VSPTR         Update the pointer  
       6BB0 836E  
  1779 6BB2 C060         MOV  @VSPTR,R1         Now get the new pointer   
       6BB4 836E  
  1780 6BB6 D7E0         MOVB @R1LB,*R15        Write new address to VDP chip 
       6BB8 83E3  
  1781 6BBA 0261         ORI  R1,WRVDP          Enable the write  
       6BBC 4000  
  1782 6BBE D7C1         MOVB R1,*R15           Write 1st byte of address   
  1783 6BC0 0201         LI   R1,FAC            Source is FAC   
       6BC2 834A  
  1784 6BC4 D831  VPSH15 MOVB *R1+,@XVDPWD      Move a byte   
       6BC6 8C00  
  1785 6BC8 0600         DEC  R0                Decrement the count, done?  
  1786 6BCA 15FC         JGT  VPSH15            No, more to move  
  1787 6BCC C00B         MOV  R11,R0            Save the return address   
  1788 6BCE 9820         CB   @FAC2,@CBH65      Pushing a string entry?   
       6BD0 834C  
       6BD2 65A7  
  1789 6BD4 160E         JNE  VPSH20            No, so done   
  1790 6BD6 C1A0         MOV  @VSPTR,R6         Entry on stack  
       6BD8 836E  
  1791 6BDA 0226         AI   R6,4              Pointer to the string is here 
       6BDC 0004  
  1792 6BDE C060         MOV  @FAC,R1           Get the string's owner  
       6BE0 834A  
  1793 6BE2 0281         CI   R1,>001C          Is it a tempory string?   
       6BE4 001C  
  1794 6BE6 1605         JNE  VPSH20            No, so done   
  1795 6BE8 C060  VPSH19 MOV  @FAC4,R1          Get the address of the string 
       6BEA 834E  
  1796 6BEC 1302         JEQ  VPSH20            If null string, nothing to do 
  1797 6BEE 06A0         BL   @STVDP3           Set the backpointer   
       6BF0 18AA  
  1798 6BF2 C060  VPSH20 MOV  @VSPTR,R1         Check for buffer-zone   
       6BF4 836E  
  1799      6BF8  C16    EQU  $+2   
  1800 6BF6 0221         AI   R1,16             Correct by 16   
       6BF8 0010  
  1801 6BFA 8801         C    R1,@STREND        At least 16 bytes between stac
       6BFC 831A  
  1802            *                              and string space?  
  1803 6BFE 1236         JLE  VPOP18            Yes, so ok  
  1804 6C00 05C9         INCT R9                No, save return address   
  1805 6C02 C640         MOV  R0,*R9             on stack   
  1806 6C04 06A0         BL   @COMPCT           Do the garbage collection   
       6C06 73D8  
  1807 6C08 C019         MOV  *R9,R0            Restore return address  
  1808 6C0A 0649         DECT R9                Fix subroutine stack pointer  
  1809 6C0C C060         MOV  @VSPTR,R1         Get value stack pointer   
       6C0E 836E  
  1810 6C10 0221         AI   R1,16             Buffer zone   
       6C12 0010  
  1811 6C14 8801         C    R1,@STREND        At least 16 bytes now?  
       6C16 831A  

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0040
  1812 6C18 1229         JLE  VPOP18            Yes, so ok  
  1813 6C1A 0200  VPSH23 LI   R0,ERROM          No, so MEMORY FULL error  
       6C1C 0103  
  1814 6C1E 06A0  VPSH25 BL   @SETREG           In case of GPL call   
       6C20 1E7A  
  1815 6C22 0460         B    @ERR  
       6C24 6652  
  1816 6C26 0460  VPSH27 B    @ERRSO            STACK OVERFLOW  
       6C28 6468  
  1817            * Stack VPOP routine  
  1818 6C2A 0202  VPOP   LI   R2,FAC            Destination in FAC  
       6C2C 834A  
  1819 6C2E C060         MOV  @VSPTR,R1         Get stack pointer   
       6C30 836E  
  1820 6C32 8801         C    R1,@STVSPT        Check for stack underflow   
       6C34 8324  
  1821 6C36 121B         JLE  VPOP20            Yes, error  
  1822 6C38 D7E0         MOVB @R1LB,*R15        Write 2nd byte of address   
       6C3A 83E3  
  1823 6C3C 0200         LI   R0,8              Popping 8 bytes   
       6C3E 0008  
  1824 6C40 D7C1         MOVB R1,*R15           Write 1st byte of address   
  1825 6C42 6800         S    R0,@VSPTR         Adjust stack pointer  
       6C44 836E  
  1826 6C46 DCA0  VPOP10 MOVB @XVDPRD,*R2+      Move a byte   
       6C48 8800  
  1827 6C4A 0600         DEC  R0                Decrement the counter, done?  
  1828 6C4C 15FC         JGT  VPOP10            No, finish the work   
  1829 6C4E C00B         MOV  R11,R0            Save return address   
  1830 6C50 9820         CB   @FAC2,@CBH65      Pop a string?   
       6C52 834C  
       6C54 65A7  
  1831 6C56 160A         JNE  VPOP18            No, so done   
  1832 6C58 04C6         CLR  R6                For backpointer clear   
  1833 6C5A C0E0         MOV  @FAC,R3           Get string owner  
       6C5C 834A  
  1834 6C5E 0283         CI   R3,>001C          Pop a temporary?  
       6C60 001C  
  1835 6C62 13C2         JEQ  VPSH19            Yes, must free it   
  1836 6C64 06A0         BL   @GET1             No, get new pointer from s.t. 
       6C66 6C9E  
  1837 6C68 C801         MOV  R1,@FAC4          Set new pointer to string   
       6C6A 834E  
  1838 6C6C 0450  VPOP18 B    *R0               And return  
  1839 6C6E 0200  VPOP20 LI   R0,ERREX          * SYNTAX ERROR  
       6C70 0403  
  1840 6C72 10D5         JMP  VPSH25  
  1841            * The returned status reflects the character  
  1842            * RAMFLG = >00   | No ERAM or imperative statements   
  1843            *          >FF   | With ERAM and a program is being run   
  1844 6C74 D220  PGMCHR MOVB @RAMFLG,R8        Test ERAM flag  
       6C76 8389  
  1845 6C78 160A         JNE  PGMC10            ERAM and a program is being ru
  1846            * Next label is for entry from SUBPROG.   
  1847 6C7A D7E0  PGMSUB MOVB @PGMPT1,*R15      Write 2nd byte of address   
       6C7C 832D  
  1848 6C7E 020A         LI   R10,XVDPRD        Read data address   
       6C80 8800  
  1849 6C82 D7E0         MOVB @PGMPTR,*R15      Write 1st byte of address   

 99/4 ASSEMBLER
PARSES2                                                      PAGE 0041
       6C84 832C  
  1850 6C86 05A0         INC  @PGMPTR           Increment the perm pointer  
       6C88 832C  
  1851 6C8A D21A         MOVB *R10,R8           Read the character  
  1852 6C8C 045B         RT                     And return  
  1853 6C8E C2A0  PGMC10 MOV  @PGMPTR,R10   
       6C90 832C  
  1854 6C92 05A0         INC  @PGMPTR   
       6C94 832C  
  1855 6C96 D23A         MOVB *R10+,R8          Write 2nd byte of a address   
  1856 6C98 045B         RT   
  1857            ************************************************************
  1858 6C9A              AORG >6C9A   
  1860                
  1861            * (VDP to VDP) or (RAM to RAM)  
  1862            * GET,GET1          : Get two bytes of data from VDP  
  1863            *                   : R3 : address in VDP   
  1864            *                   : R1 : where the one byte data stored   
  1865            * PUT1              : Put two bytes of data into VDP  
  1866            *                   : R4 : address on VDP   
  1867            *                   : R1 : data   
  1868            * GETG,GETG2        : Get two bytes of data from ERAM   
  1869            *                   : R3 : address on ERAM  
  1870            *                   : R1 : where the two byte data stored   
  1871            * PUTG2             : Put two bytes of data into ERAM   
  1872            *                   : R4 : address on ERAM  
  1873            *                   : R1 : data   
  1874            * PUTVG1            : Put one byte of data into ERAM  
  1875            *                   : R4 : address in ERAM  
  1876            *                   : R1 : data   
  1877                
  1878            * Get two bytes from RAM(R3) into R1  
  1879 6C9A C0FB  GET    MOV  *R11+,R3  
  1880 6C9C C0D3         MOV  *R3,R3  
  1881 6C9E D7E0  GET1   MOVB @R3LB,*R15  
       6CA0 83E7  
  1882 6CA2 D7C3         MOVB R3,*R15   
  1883 6CA4 1000         NOP  
  1884 6CA6 D060         MOVB @XVDPRD,R1  
       6CA8 8800  
  1885 6CAA D820         MOVB @XVDPRD,@R1LB   
       6CAC 8800  
       6CAE 83E3  
  1886 6CB0 045B         RT   
  1887            * Put two bytes from R1 to RAM(R4)  
  1888 6CB2 D7E0  PUT1   MOVB @R4LB,*R15  
       6CB4 83E9  
  1889 6CB6 0264         ORI  R4,WRVDP  
       6CB8 4000  
  1890 6CBA D7C4         MOVB R4,*R15   
  1891 6CBC 1000         NOP  
  1892 6CBE D801         MOVB R1,@XVDPWD  
       6CC0 8C00  
  1893 6CC2 D820         MOVB @R1LB,@XVDPWD   
       6CC4 83E3  
       6CC6 8C00  
  1894 6CC8 045B         RT   
  1895            * Get two bytes from ERAM(R3) to R1   
  1896 6CCA C0FB  GETG   MOV  *R11+,R3  

 99/4 ASSEMBLER
GETPUTS                                                      PAGE 0042
  1897 6CCC C0D3         MOV  *R3,R3  
  1898      6CCE  GETG2  EQU  $   
  1899 6CCE D073         MOVB *R3+,R1   
  1900 6CD0 D813         MOVB *R3,@R1LB   
       6CD2 83E3  
  1901 6CD4 0603         DEC  R3  
  1902 6CD6 045B         RT   
  1903            * Put two bytes from R1 to ERAM(R4)   
  1904      6CD8  PUTG2  EQU  $   
  1905 6CD8 DD01         MOVB R1,*R4+   
  1906 6CDA D520         MOVB @R1LB,*R4   
       6CDC 83E3  
  1907 6CDE 0604         DEC  R4                Preserve R4   
  1908 6CE0 045B         RT   
  1909            ************************************************************
  1910 6CE2              AORG >6CE2   
  1912                
  1913 6CE2 9820  LEXP   CB   @FAC2,@CBH63      Must have a numeric   
       6CE4 834C  
       6CE6 6D05  
  1914 6CE8 1B39         JH   ERRSNM            Don't, so error   
  1915 6CEA 06A0         BL   @PSHPRS           Push 1st and parse 2nd  
       6CEC 6B9C  
  1916 6CEE   C5         BYTE EXPONZ,0          Up to another wxpon or less   
       6CEF   00  
  1917 6CF0 06A0         BL   @STKCHK           Make sure room on stack   
       6CF2 6DC0  
  1918 6CF4 0202         LI   R2,PWRZZ          Address of power routine  
       6CF6 7492  
  1919 6CF8 1049         JMP  COMM05            Jump into common routine  
  1920            * ABS   
  1921 6CFA 0288  NABS   CI   R8,LPARZ*256      Must have a left parenthesis  
       6CFC B700  
  1922 6CFE 1630         JNE  SYNERR            If not, error   
  1923 6D00 06A0         BL   @PARSE            Parse the argument  
       6D02 6480  
  1924 6D04   CB         BYTE ABSZ              Up to another ABS   
  1925 6D05   63  CBH63  BYTE >63               Use the wasted byte   
  1926 6D06 9820         CB   @FAC2,@CBH63      Must have numeric arg   
       6D08 834C  
       6D0A 6D05  
  1927 6D0C 1B27         JH   ERRSNM            If not, error   
  1928 6D0E 0760         ABS  @FAC              Take the absolute value   
       6D10 834A  
  1929 6D12 0460  BCONT  B    @CONT             And continue  
       6D14 64C8  
  1930            * ATN   
  1931 6D16 0202  NATN   LI   R2,ATNZZ          Load up arctan address  
       6D18 797C  
  1932 6D1A 102C         JMP  COMMON            Jump into common rountine   
  1933            * COS   
  1934 6D1C 0202  NCOS   LI   R2,COSZZ          Load up cosine address  
       6D1E 78B2  
  1935 6D20 1029         JMP  COMMON            Jump into common routine  
  1936            * EXP   
  1937 6D22 0202  NEXP   LI   R2,EXPZZ          Load up exponential address   
       6D24 75CA  
  1938 6D26 1026         JMP  COMMON            Jump into common routine  
  1939            * INT   

 99/4 ASSEMBLER
NUD359                                                       PAGE 0043
  1940 6D28 0202  NINT   LI   R2,GRINT          Load up greatest integer addre
       6D2A 79EC  
  1941 6D2C 1023         JMP  COMMON            Jump into common routine  
  1942            * LOG   
  1943 6D2E 0202  NLOG   LI   R2,LOGZZ          Load up logarithm code  
       6D30 76C2  
  1944 6D32 1020         JMP  COMMON            Jump to common routine  
  1945            * SGN   
  1946 6D34 0288  NSGN   CI   R8,LPARZ*256      Must have left parenthesis  
       6D36 B700  
  1947 6D38 1613         JNE  SYNERR            If not, error   
  1948 6D3A 06A0         BL   @PARSE            Parse the argument  
       6D3C 6480  
  1949 6D3E   D1         BYTE SGNZ,0            Up to another SGN   
       6D3F   00  
  1950 6D40 9820         CB   @FAC2,@CBH63      Must have a numeric arg   
       6D42 834C  
       6D44 6D05  
  1951 6D46 1B0A         JH   ERRSNM            If not, error   
  1952 6D48 0204         LI   R4,>4001          Floating point one  
       6D4A 4001  
  1953 6D4C C020         MOV  @FAC,R0           Check status  
       6D4E 834A  
  1954 6D50 13E0         JEQ  BCONT             If 0, return 0  
  1955 6D52 1502         JGT  BLTST9            If positive, return +1  
  1956 6D54 0460         B    @LTRUE            If negative, return -1  
       6D56 6ABE  
  1957 6D58 0460  BLTST9 B    @LTST90           Sets up the FAC w/R4 and 0s   
       6D5A 6AC2  
  1958 6D5C 0460  ERRSNM B    @ERRT             STRING-NUMBER MISMATCH  
       6D5E 630C  
  1959 6D60 0460  SYNERR B    @ERRONE           SYNTAX ERROR  
       6D62 664E  
  1960            * SIN   
  1961 6D64 0202  NSIN   LI   R2,SINZZ          Load up sine address  
       6D66 78C0  
  1962 6D68 1005         JMP  COMMON            Jump into common routine  
  1963            * SQR   
  1964 6D6A 0202  NSQR   LI   R2,SQRZZ          Load up square-root address   
       6D6C 783A  
  1965 6D6E 1002         JMP  COMMON            Jump into common routine  
  1966            * TAN   
  1967 6D70 0202  NTAN   LI   R2,TANZZ          Load up tangent address   
       6D72 7940  
  1968 6D74 06A0  COMMON BL   @STKCHK           Make sure room on stacks  
       6D76 6DC0  
  1969 6D78 0288         CI   R8,LPARZ*256      Must have left parenthesis  
       6D7A B700  
  1970 6D7C 16F1         JNE  SYNERR            If not, error   
  1971 6D7E 05C9         INCT R9                Get space on subroutine stack 
  1972 6D80 C642         MOV  R2,*R9            Put address of routine on stac
  1973 6D82 06A0         BL   @PARSE            Parse the argument  
       6D84 6480  
  1974 6D86   FF         BYTE >FF,0             To end of the arg   
       6D87   00  
  1975 6D88 C099         MOV  *R9,R2            Get address of function back  
  1976 6D8A 0649         DECT  R9               Decrement subroutine stack  
  1977 6D8C 9820  COMM05 CB   @FAC2,@CBH63      Must have a numeric arg   
       6D8E 834C  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0044
       6D90 6D05  
  1978 6D92 1BE4         JH   ERRSNM            If not, error   
  1979 6D94 04E0         CLR  @FAC10            Assume no error or warning  
       6D96 8354  
  1980 6D98 06A0         BL   @SAVREG           Save Basic registers  
       6D9A 1E8C  
  1981 6D9C C802         MOV  R2,@PAGE2         Select page 2   
       6D9E 6002  
  1982 6DA0 0692         BL   *R2               Evaluate the function   
  1983 6DA2 C802         MOV  R2,@PAGE1         Reselect Page 1   
       6DA4 6000  
  1984 6DA6 06A0         BL   @SETREG           Set registers up again  
       6DA8 1E7A  
  1985 6DAA D020         MOVB @FAC10,R0         Check for error or warning  
       6DAC 8354  
  1986 6DAE 13B1         JEQ  BCONT             If not error, continue  
  1987 6DB0 0990         SRL  R0,9              Check for warning   
  1988 6DB2 1304         JEQ  PWARN             Warning, issue it   
  1989 6DB4 0200         LI   R0,>0803          BAD ARGUMENT code   
       6DB6 0803  
  1990 6DB8 0460         B    @ERR  
       6DBA 6652  
  1991 6DBC 0460  PWARN  B    @WARNZZ           Issue the warning message   
       6DBE 6662  
  1992 6DC0 0289  STKCHK CI   R9,STND12         Enough room on the subr stack?
       6DC2 83AE  
  1993 6DC4 1B18         JH   BSO               No, memory full error   
  1994 6DC6 C020         MOV  @VSPTR,R0         Get the value stack pointer   
       6DC8 836E  
  1995 6DCA 0220         AI   R0,48             Buffer-zone of 48 bytes   
       6DCC 0030  
  1996 6DCE 8800         C    R0,@STREND        Room between stack & strings  
       6DD0 831A  
  1997 6DD2 1A0E         JL   STKRTN            Yes, return   
  1998 6DD4 05C9         INCT R9                Get space on subr stack   
  1999 6DD6 CE4B         MOV  R11,*R9+          Save return address   
  2000 6DD8 CE42         MOV  R2,*R9+           Save COMMON function code   
  2001 6DDA C640         MOV  R0,*R9            Save v-stack pointer+48   
  2002 6DDC 06A0         BL   @COMPCT           Do a garbage collection   
       6DDE 73D8  
  2003 6DE0 8819         C    *R9,@STREND       Enough space now?   
       6DE2 831A  
  2004 6DE4 1406         JHE  BMF               No, MEMORY FULL error   
  2005 6DE6 0649         DECT R9                Decrement stack pointer   
  2006 6DE8 C099         MOV  *R9,R2            Restore COMMON function code  
  2007 6DEA 0649         DECT R9                Decrement stack pointer   
  2008 6DEC C2D9  RETRN  MOV *R9,R11            Restore return address  
  2009 6DEE 0649         DECT R9                Decrement stack pointer   
  2010 6DF0 045B  STKRTN RT   
  2011 6DF2 0460  BMF    B    @VPSH23           * MEMORY FULL   
       6DF4 6C1A  
  2012 6DF6 0460  BSO    B    @ERRSO            * STACK OVERFLOW  
       6DF8 6468  
  2013            ************************************************************
  2014            * LED routine for AND, OR, NOT, and XOR   
  2015            ************************************************************
  2016 6DFA 06A0  O0AND  BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6DFC 6B9C  
  2017 6DFE   BB         BYTE ANDZ,0            Stop on AND or less   

 99/4 ASSEMBLER
NUD359                                                       PAGE 0045
       6DFF   00  
  2018 6E00 06A0         BL   @CONVRT           Convert both to integers  
       6E02 6E9E  
  2019 6E04 0560         INV  @FAC              Complement L.H.   
       6E06 834A  
  2020 6E08 4820         SZC  @FAC,@ARG         Perform the AND   
       6E0A 834A  
       6E0C 835C  
  2021 6E0E C820  O0AND1 MOV  @ARG,@FAC         Put back in FAC   
       6E10 835C  
       6E12 834A  
  2022 6E14 06A0  O0AND2 BL   @CIF              Convert back to floating  
       6E16 74AA  
  2023 6E18 0460         B    @CONT             Continue  
       6E1A 64C8  
  2024 6E1C 06A0  O0OR   BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6E1E 6B9C  
  2025 6E20   BA         BYTE ORZ,0             Stop on OR or less  
       6E21   00  
  2026 6E22 06A0         BL   @CONVRT           Convert both to integers  
       6E24 6E9E  
  2027 6E26 E820         SOC  @FAC,@ARG         Perform the OR  
       6E28 834A  
       6E2A 835C  
  2028 6E2C 10F0         JMP  O0AND1            Convert to floating and done  
  2029 6E2E 06A0  O0NOT  BL   @PARSE            Parse the arg   
       6E30 6480  
  2030 6E32   BD         BYTE NOTZ,0            Stop on NOT or less   
       6E33   00  
  2031 6E34 9820         CB   @FAC2,@CBH63      Get a numeric back?   
       6E36 834C  
       6E38 6D05  
  2032 6E3A 1B49         JH   ERRSN1            No, error   
  2033 6E3C 04E0         CLR  @FAC10            Clear for CFI   
       6E3E 8354  
  2034 6E40 06A0         BL   @CFI              Convert to Integer  
       6E42 12B8  
  2035 6E44 D020         MOVB @FAC10,R0         Check for an error  
       6E46 8354  
  2036 6E48 168B         JNE  SYNERR            Error   
  2037 6E4A 0560         INV  @FAC              Perform the NOT   
       6E4C 834A  
  2038 6E4E 10E2         JMP  O0AND2            Convert to floating and done  
  2039 6E50 06A0  O0XOR  BL   @PSHPRS           Push L.H. and PARSE R.H.  
       6E52 6B9C  
  2040 6E54   BC         BYTE XORZ,0            Stop on XOR or less   
       6E55   00  
  2041 6E56 06A0         BL   @CONVRT           Convert both to integer   
       6E58 6E9E  
  2042 6E5A C020         MOV  @ARG,R0           Get R.H. into register  
       6E5C 835C  
  2043 6E5E 2820         XOR  @FAC,R0           Do the XOR  
       6E60 834A  
  2044 6E62 C800         MOV  R0,@FAC           Put result back in FAC  
       6E64 834A  
  2045 6E66 10D6         JMP  O0AND2            Convert and continue  
  2046            ************************************************************
  2047            * NUD for left parenthesis  
  2048            ************************************************************

 99/4 ASSEMBLER
NUD359                                                       PAGE 0046
  2049 6E68 0288  NLPR   CI   R8,RPARZ*256      Have a right paren already?   
       6E6A B600  
  2050 6E6C 1332         JEQ  ERRSY1            If so, syntax error   
  2051 6E6E 06A0         BL   @PARSE            Parse inside the parenthesises
       6E70 6480  
  2052 6E72   B7         BYTE LPARZ,0           Up to left parenthesis or less
       6E73   00  
  2053 6E74 0288         CI   R8,RPARZ*256      Have a right parenthesis now? 
       6E76 B600  
  2054 6E78 162C         JNE  ERRSY1            No, so error  
  2055 6E7A 06A0         BL   @PGMCHR           Get next token  
       6E7C 6C74  
  2056 6E7E 0460  BCON1  B    @CONT             And continue  
       6E80 64C8  
  2057            ************************************************************
  2058            * NUD for unary minus   
  2059            ************************************************************
  2060 6E82 06A0  NMINUS BL   @PARSE            Parse the expression  
       6E84 6480  
  2061 6E86   C2         BYTE MINUSZ,0          Up to another minus   
       6E87   00  
  2062 6E88 0520         NEG  @FAC              Make it negative  
       6E8A 834A  
  2063 6E8C 9820  NMIN10 CB   @FAC2,@CBH63      Must have a numeric   
       6E8E 834C  
       6E90 6D05  
  2064 6E92 1B1D         JH   ERRSN1            If not, error   
  2065 6E94 10F4         JMP  BCON1             Continue  
  2066            ************************************************************
  2067            * NUD for unary plus  
  2068            ************************************************************
  2069 6E96 06A0  NPLUS  BL   @PARSE            Parse the expression  
       6E98 6480  
  2070 6E9A   C1         BYTE PLUSZ,0   
       6E9B   00  
  2071 6E9C 10F7         JMP  NMIN10            Use common code   
  2072            ************************************************************
  2073            * CONVRT - Takes two arguments, 1 form FAC and 1 from the   
  2074            *          top of the stack and converts them to integer  
  2075            *          from floating point, issuing appropriate errors  
  2076            ************************************************************
  2077 6E9E 05C9  CONVRT INCT R9  
  2078 6EA0 C64B         MOV  R11,*R9           SAVE RTN ADDRESS  
  2079 6EA2 06A0         BL   @ARGTST           ARGS MUST BE SAME TYPE  
       6EA4 6B6E  
  2080 6EA6 1313         JEQ  ERRSN1            AND NON-STRING  
  2081 6EA8 04E0         CLR  @FAC10            FOR CFI ERROR CODE  
       6EAA 8354  
  2082 6EAC 06A0         BL   @CFI              CONVERT R.H. ARG  
       6EAE 12B8  
  2083 6EB0 D020         MOVB @FAC10,R0         ANY ERROR OR WARNING?   
       6EB2 8354  
  2084 6EB4 160A         JNE  ERRBV             YES   
  2085 6EB6 C820         MOV  @FAC,@ARG         MOVE TO GET L.H. ARG  
       6EB8 834A  
       6EBA 835C  
  2086 6EBC 06A0         BL   @VPOP             GET L.H. BACK   
       6EBE 6C2A  
  2087 6EC0 06A0         BL   @CFI              CONVERT L.H.  

 99/4 ASSEMBLER
NUD359                                                       PAGE 0047
       6EC2 12B8  
  2088 6EC4 D020         MOVB @FAC10,R0         ANY ERROR OR WARNING?   
       6EC6 8354  
  2089 6EC8 1391         JEQ  RETRN             No, get rtn off stack and rtn 
  2090            *                             Yes, issue error  
  2091 6ECA 0460  ERRBV  B    @GOTO90           BAD VALUE   
       6ECC 670A  
  2092 6ECE 0460  ERRSN1 B    @ERRT             STRING NUMBER MISMATCH  
       6ED0 630C  
  2093 6ED2 0460  ERRSY1 B    @ERRONE           SYNTAX ERROR  
       6ED4 664E  
  2094            ************************************************************
  2095 6ED6              AORG >6ED6   
  2097                
  2098                
  2099 6ED6 0460  BSYNCH B    @SYNCHK   
       6ED8 6400  
  2100 6EDA 0460  BERSYN B    @ERRSYN   
       6EDC 664E  
  2101 6EDE 0460  BERSNM B    @ERRT   
       6EE0 630C  
  2102 6EE2 D01D  SPEED  MOVB *R13,R0           Read XML code   
  2103 6EE4 0980         SRL  R0,8              Shift for word value  
  2104 6EE6 13F7         JEQ  BSYNCH            0 is index for SYNCHK   
  2105 6EE8 0600         DEC  R0                Not SYNCHK, check further   
  2106 6EEA 1344         JEQ  PARCOM            1 is index for PARCOM   
  2107 6EEC 0600         DEC  R0                Not PARCOM, check further   
  2108 6EEE 1320         JEQ  RANGE             2 is index for RANGE  
  2109            * All otheres assumed to be SEETWO  
  2110            ************************************************************
  2111            * Find the line specified by the number in FAC  
  2112            * Searches the table from low address (high number) to  
  2113            *  high address (low number).   
  2114            ************************************************************
  2115 6EF0 020A  SEETWO LI   R10,SET           Assume number will be found   
       6EF2 6192  
  2116 6EF4 0207         LI   R7,GET1           Assume reading from the VDP   
       6EF6 6C9E  
  2117 6EF8 D020         MOVB @RAMTOP,R0        But correct   
       6EFA 8384  
  2118 6EFC 1302         JEQ  SEETW2               If   
  2119 6EFE 0207         LI   R7,GETG2              ERAM is present   
       6F00 6CCE  
  2120 6F02 C0E0  SEETW2 MOV  @ENLN,R3          Get point to start from   
       6F04 8332  
  2121 6F06 0223         AI   R3,-3             Get into table  
       6F08 FFFD  
  2122 6F0A 0697  SEETW4 BL   *R7               Read the number from table  
  2123 6F0C 0241         ANDI R1,>7FFF          Throw away possible breakpoint
       6F0E 7FFF  
  2124 6F10 8801         C    R1,@FAC           Match the number needed?  
       6F12 834A  
  2125 6F14 130A         JEQ  SEETW8            Yes, return with condition set
  2126 6F16 1B07         JH   SEETW6            No, and also passed it =>retur
  2127 6F18 0223         AI   R3,-4             No, but sitll might be there  
       6F1A FFFC  
  2128 6F1C 8803         C    R3,@STLN          Reached end of table?   
       6F1E 8330  
  2129 6F20 14F4         JHE  SEETW4            No, so check further  

 99/4 ASSEMBLER
SPEEDS                                                       PAGE 0048
  2130 6F22 C0E0         MOV  @STLN,R3          End of table, default to last 
       6F24 8330  
  2131 6F26 020A  SEETW6 LI   R10,RESET         Indicate not found  
       6F28 006A  
  2132 6F2A C803  SEETW8 MOV  R3,@EXTRAM        Put pointer in for GPL  
       6F2C 832E  
  2133 6F2E 045A         B    *R10              Return with condition   
  2134 6F30 C30B  RANGE  MOV  R11,R12           Save return address   
  2135 6F32 9820         CB   @FAC2,@CBH63      Have a numeric  
       6F34 834C  
       6F36 6D05  
  2136 6F38 1BD2         JH   BERSNM            Otherwise string number mismat
  2137 6F3A 04E0         CLR  @FAC10            Assume no conversion error  
       6F3C 8354  
  2138 6F3E 06A0         BL   @CFI              Convert from float to integer 
       6F40 12B8  
  2139 6F42 D020         MOVB @FAC10,R0         Get an error?   
       6F44 8354  
  2140 6F46 160E         JNE  RANERR            Yes, indicate it  
  2141 6F48 D01D         MOVB *R13,R0           Read lower limit  
  2142 6F4A 0980         SRL  R0,8              Shift for word compare  
  2143 6F4C D05D         MOVB *R13,R1           Read 1st byte of upper limit  
  2144 6F4E 06C1         SWPB R1                Kill time   
  2145 6F50 D05D         MOVB *R13,R1           Read 2nd byte of upper limit  
  2146 6F52 06C1         SWPB R1                Restore upper limit   
  2147 6F54 C0A0         MOV  @FAC,R2           Get the value   
       6F56 834A  
  2148 6F58 1105         JLT  RANERR            If negative, error  
  2149 6F5A 8002         C    R2,R0             Less then low limit?  
  2150 6F5C 1103         JLT  RANERR            Yes, error  
  2151 6F5E 8042         C    R2,R1             Greater then limit?   
  2152 6F60 1B01         JH   RANERR            Yes, error  
  2153 6F62 045C         B    *R12              All ok, so return   
  2154 6F64 06A0  RANERR BL   @SETREG           Set up registers for error  
       6F66 1E7A  
  2155 6F68 0460         B    @GOTO90           * BAD VALUE   
       6F6A 670A  
  2156            * Make sure at a left parenthesis   
  2157 6F6C 9820  LPAR   CB   @CHAT,@LBLPZ      At a left parenthesis   
       6F6E 8342  
       6F70 6F81  
  2158 6F72 16B3         JNE  BERSYN            No, syntax error  
  2159            * Parse up to a comma and insure at a comma   
  2160 6F74 06A0  PARCOM BL   @PUTSTK           Save GROM address   
       6F76 60F2  
  2161 6F78 06A0         BL   @SETREG           Set up R8/R9  
       6F7A 1E7A  
  2162 6F7C 06A0         BL   @PARSE            Parse the next item   
       6F7E 6480  
  2163 6F80   B3         BYTE COMMAZ            Up to a comma   
  2164 6F81   B7  LBLPZ  BYTE LPARZ   
  2165 6F82 0288         CI   R8,COMMAZ*256     End on a comma?   
       6F84 B300  
  2166 6F86 16A9         JNE  BERSYN            No, syntax error  
  2167 6F88 06A0         BL   @PGMCHR           Yes, get character after it   
       6F8A 6C74  
  2168 6F8C 06A0         BL   @SAVREG           Save R8/R9 for GPL  
       6F8E 1E8C  
  2169 6F90 06A0         BL   @GETSTK           Restore GROM address  

 99/4 ASSEMBLER
SPEEDS                                                       PAGE 0049
       6F92 610E  
  2170 6F94 0460         B    @RESET            Return to GPL reset   
       6F96 006A  
  2171            ************************************************************
  2172 6F98              AORG >6F98   
  2174                
  2175            * (RAM to RAM)  
  2176            * WITH ERAM    : Move the contents in ERAM FROM a higher  
  2177            *                 address to a lower address  
  2178            *                ARG    : byte count  
  2179            *                VAR9   : source address  
  2180            *                VAR0   : destination address   
  2181                
  2182 6F98 C060  MVUP   MOV  @ARG,R1           Get byte count  
       6F9A 835C  
  2183 6F9C C0E0         MOV  @VAR9,R3          Get source  
       6F9E 8316  
  2184 6FA0 C160         MOV  @VAR0,R5          Get destination   
       6FA2 8300  
  2185 6FA4 DD73  MVUP05 MOVB *R3+,*R5+         Move a byte   
  2186 6FA6 0601         DEC  R1                Decrement the counter   
  2187 6FA8 16FD         JNE  MVUP05            Loop if more to move  
  2188 6FAA 045B         RT   
  2189            ************************************************************
  2190 6FAC              AORG >6FAC   
  2192                
  2193            * Get a non-space character   
  2194 6FAC C00B  GETNB  MOV  R11,R0            Save return address   
  2195 6FAE 06A0  GETNB1 BL   @GETCHR           Get next character  
       6FB0 6FBA  
  2196 6FB2 0281         CI   R1,' '*256        Space character?  
       6FB4 2000  
  2197 6FB6 13FB         JEQ  GETNB1            Yes, get next character   
  2198 6FB8 0450         B    *R0               No, return character condition
  2199            * Get the next character  
  2200 6FBA 8820  GETCHR C    @VARW,@VARA       End of line?  
       6FBC 8320  
       6FBE 832A  
  2201 6FC0 1B0E         JH   GETCH2            Yes, return condition   
  2202 6FC2 D7E0         MOVB @VARW1,*R15       No, write LSB of VDP address  
       6FC4 8321  
  2203 6FC6 0201         LI   R1,>A000          Negative screen offset (->60) 
       6FC8 A000  
  2204 6FCA D7E0         MOVB @VARW,*R15        Write MSB of VDP address  
       6FCC 8320  
  2205 6FCE 05A0         INC  @VARW             Increment read-from pointer   
       6FD0 8320  
  2206 6FD2 B060         AB   @XVDPRD,R1        Read and remove screen offset 
       6FD4 8800  
  2207 6FD6 0281         CI   R1,>1F00          Read an edge character?   
       6FD8 1F00  
  2208 6FDA 13EF         JEQ  GETCHR            Yes, skip it  
  2209 6FDC 045B         RT                     Return  
  2210 6FDE 04C1  GETCH2 CLR  R1                Indicate end of line  
  2211 6FE0 045B         RT                     Return  
  2212            *-----------------------------------------------------------
  2213            * Remove this routine from CRUNCH because CRUNCH is running 
  2214            * out of space                5/11/81   
  2215            *-----------------------------------------------------------

 99/4 ASSEMBLER
GETNBS                                                       PAGE 0050
  2216            *      Calculate and put length of string/number into   
  2217            *      length byte  
  2218 6FE2 C0CB  LENGTH MOV  R11,R3            Save retun address  
  2219 6FE4 C020         MOV  @RAMPTR,R0        Save current crunch pointer   
       6FE6 830A  
  2220 6FE8 C200         MOV  R0,R8             Put into r8 for PUTCHR below  
  2221 6FEA 6205         S    R5,R8             Calculate length of string  
  2222 6FEC 0608         DEC  R8                RAMPTR is post-incremented  
  2223 6FEE C805         MOV  R5,@RAMPTR        Address of length byte  
       6FF0 830A  
  2224 6FF2 06A0         BL   @PUTCHR           Put the length in   
       6FF4 7F6E  
  2225 6FF6 C800         MOV  R0,@RAMPTR        Restore crunch pointer  
       6FF8 830A  
  2226 6FFA 0453         B    *R3               And return  
  2227            * FILL IN BYTES OF MODULE WITH COPY OF ORIGINAL?  
  2228 6FFC 0000         DATA >0000   
  2229 6FFE EF71         DATA >EF71             ?????   
  2230            ************************************************************
  2231                
  2232 7000              AORG >7000   
  2234                
  2235            *   
  2236            *      CONVERT THE NUMBER IN THE FAC TO A STRING  
  2237            * CALL  : FAC NUMBER  
  2238            *         R0  0 for free format(R1 & R2 are ignored)  
  2239            *             Bit 0 on for fixed format   
  2240            *             Bit 1 on for an explicit sign   
  2241            *             Bit 2 on to output the sign of a positive   
  2242            *             NO. as a plus sign ('+') instead of a space   
  2243            *              (bit 1 must also be on)  
  2244            *             Bit 3 on for E-notation output  
  2245            *             Bit 4 also on for extended E-notation   
  2246            *         R1 and R2 specify the field size.   
  2247            *         R1  Number of places in the field to the left of  
  2248            *              the decimal point including an explicit sign 
  2249            *              and excluding the dicimal point.   
  2250            *         R2  Number of places in the field to the right of 
  2251            *              the decimal point.   
  2252            *         R1 and R2 exclude ths 4 positions for the exponent
  2253            *              if bit 3 is on.  
  2254            * ERRORS:   The field has more than 14 significant digits if
  2255            *            the number is too big to fit in the field. The 
  2256            *            field is filled with asterisks.  
  2257            *           The original contents of the FAC are lost.  
  2258                
  2259                
  2260 7000 0004  LWCNP  DATA >0004   
  2261 7002 0008  LWCNE  DATA >0008   
  2262 7004 0010  LWCNF  DATA >0010   
  2263            * Integer power of ten table  
  2264 7006 2710  CNSITT DATA 10000   
  2265 7008 03E8         DATA 1000  
  2266 700A   00  LW100  BYTE 0   
  2267 700B   64  LB100  BYTE 100   
  2268 700C   00  LW10   BYTE 0   
  2269 700D   0A  LB10   BYTE 10  
  2270 700E 0001         DATA 1   
  2271 7010   20  LBSPC  BYTE ' '   

 99/4 ASSEMBLER
CNS359                                                       PAGE 0051
  2272 7011   2A  LBAST  BYTE '*'   
  2273 7012   2E  LBPER  BYTE '.'   
  2274 7013   45  LBE    BYTE 'E'   
  2275 7014   30  LBZER  BYTE '0'   
  2276                   EVEN   
  2277                
  2278 7016 C28B  CNS    MOV  R11,R10           In ROLOUT: use R10 to return  
  2279 7018 06A0         BL   @ROLOUT   
       701A 7A90  
  2280 701C 05C9         INCT R9  
  2281 701E C64D         MOV  R13,*R9   
  2282 7020 0206         LI   R6,FAC11          Optimize for space and speed  
       7022 8355  
  2283 7024 D036         MOVB *R6+,R0           @FAC11=0 if free format output
  2284 7026 0980         SRL  R0,8              Put in LSB  
  2285 7028 D076         MOVB *R6+,R1           @FAC12 places to left of dec  
  2286 702A 0981         SRL  R1,8              Put in LSB  
  2287 702C D0B6         MOVB *R6+,R2           @FAC13 places to right of dec 
  2288 702E 0982         SRL  R2,8              Put in LSB  
  2289 7030 DDA0         MOVB @LBSPC,*R6+       Put extra space at beginning  
       7032 7010  
  2290            *                              for CNSCHK   
  2291 7034 0203         LI   R3,'-'*256        Assume number is negative   
       7036 2D00  
  2292 7038 0760         ABS  @FAC              Is number negative?   
       703A 834A  
  2293 703C 1107         JLT  CNS01             Yes, its sign is known  
  2294 703E 0203         LI   R3,' '*256        No, assume a space will be use
       7040 2000  
  2295 7042 2420         CZC  @LWCNP,R0         Do positive numbers get a plus
       7044 7000  
  2296            *                              sign?  
  2297 7046 1302         JEQ  CNS01             No, use a space   
  2298 7048 0203         LI   R3,'+'*256        Yes, get a plus sign  
       704A 2B00  
  2299 704C DD83  CNS01  MOVB R3,*R6+           Put sign in buffer  
  2300 704E C800         MOV  R0,@WSM           Is free fomat output specified
       7050 831A  
  2301 7052 1675         JNE  CNSX              No, use fix format output   
  2302            * FREE FORMAT FLOATING OUTPUT   
  2303 7054 C120         MOV  @FAC,R4           Is it 0?  
       7056 834A  
  2304 7058 1611         JNE  CNSF1             No  
  2305 705A 0606         DEC  R6  
  2306 705C 0204         LI   R4,' 0'           Yes, convert to a '0' and quit
       705E 2030  
  2307 7060 DD84         MOVB R4,*R6+   
  2308 7062 DDA0         MOVB @R4LB,*R6+  
       7064 83E9  
  2309 7066 04C4         CLR  R4                Put 0 at end of string  
  2310 7068 D584         MOVB R4,*R6  
  2311 706A 0204         LI   R4,>5902          Put the beginning of string   
       706C 5902  
  2312            *                              in FAC11, LENGTH in FAC12  
  2313            *                              FAC15=59, LENGTH=2   
  2314 706E D804         MOVB R4,@FAC11   
       7070 8355  
  2315 7072 D820         MOVB @R4LB,@FAC12  
       7074 83E9  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0052
       7076 8356  
  2316 7078 0460         B    @ROLIN            RT in ROLIN   
       707A 7AC4  
  2317 707C 06A0  CNSF1  BL   @CNSTEN           Get base ten exponent, is NO. 
       707E 72CA  
  2318            *                              less then one?   
  2319 7080 1112         JLT  CNSF02            Yes, it can't be printed as an
  2320            *                              integer  
  2321 7082 028D         CI   R13,9             No, is number to big to print 
       7084 0009  
  2322 7086 150F         JGT  CNSF02            Yes, round NO. for E-notataion
  2323            *                              output   
  2324 7088 D820         MOVB @FAC,@R0LB        No, check if the number is an 
       708A 834A  
       708C 83E1  
  2325            *                              integer, get exponent, high  
  2326            *                              byte is still zero   
  2327 708E 0220         AI   R0,PAD0           R0=PAD+FAC+2-64   
       7090 8300  
  2328 7092 0220         AI   R0,>C             Get pointer to first  
       7094 000C  
  2329            *                              fractional byte  
  2330 7096 04C1  CNSF01 CLR  R1  
  2331 7098 D070         MOVB *R0+,R1           Is next byte of fraction zero?
  2332 709A 1605         JNE  CNSF02            No, print NO. in fixed point  
  2333            *                              format   
  2334 709C 0280         CI   R0,FAC8           Yes, reached end of number?   
       709E 8352  
  2335 70A0 1AFA         JL   CNSF01            No, continue looking at   
  2336            *                              fractional bytes   
  2337 70A2 04CA         CLR  R10               Yes, number is an integer,  
  2338            *                              set integer flag   
  2339 70A4 1011         JMP  CNSF05            Go print the number,  
  2340            *                              no rounding is necessary   
  2341 70A6 0201  CNSF02 LI   R1,5              Assume rounding for E-notation
       70A8 0005  
  2342 70AA 028D         CI   R13,9             Is NO. too big for fixed point
       70AC 0009  
  2343            *                              output?  
  2344 70AE 1509         JGT  CNSF04            Yes, round for E-notataion  
  2345 70B0 028D         CI   R13,-4            No, is number to small for  
       70B2 FFFC  
  2346            *                              fixed point output?  
  2347 70B4 1106         JLT  CNSF04            Yes, round for E-notation outp
  2348 70B6 8C71         C    *R1+,*R1+         Force R1 to =9  
  2349 70B8 028D         CI   R13,-2            No, will NO. be printed with  
       70BA FFFE  
  2350            *                              maximum number for fixed   
  2351            *                              format significant digits?   
  2352 70BC 1502         JGT  CNSF04            Yes, round accordingly  
  2353 70BE 0581         INC  R1                No, round number for maximum  
  2354            *                              significant digits (R1=10)   
  2355 70C0 A04D         A    R13,R1            That can be printed for this  
  2356            *                              number   
  2357 70C2 06A0  CNSF04 BL   @CNSRND           Round NO. accordingly,  
       70C4 7246  
  2358            *                              rounding can change the  
  2359            *                              exponent and so the print  
  2360            *                              format to be used  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0053
  2361 70C6 070A         SETO R10               Set non-integer flag  
  2362 70C8 028D  CNSF05 CI   R13,9             Decide which print format to  
       70CA 0009  
  2363 70CC 152B         JGT  CNSG               use, too big for fixed format
  2364 70CE 028D         CI   R13,-6            Use E-notation number in range
       70D0 FFFA  
  2365            *                              for max fixed point digits?  
  2366 70D2 1516         JGT  CNSF08            Yes, use fixed format output  
  2367 70D4 028D         CI   R13,-10           No, NO. too small for fixed   
       70D6 FFF6  
  2368            *                              format?  
  2369 70D8 1125         JLT  CNSG              Yes, use E-notation ouput   
  2370            *                             No, the NO. of significant  
  2371            *                              digits will determine fixed  
  2372            *                              format ouput or not  
  2373 70DA 0200         LI   R0,FAC8           Get pointer to last byte  
       70DC 8352  
  2374            *                              of FAC1  
  2375 70DE 04C1         CLR  R1                Clear low byte of least   
  2376            *                              significant byte regester  
  2377 70E0 0203         LI   R3,4              4=15-11 Get NO. of  
       70E2 0004  
  2378            *                              digits+2-exponent scale facto
  2379 70E4 A0C7         A    R7,R3             Take into acccount a leading  
  2380            *                              zero in FAC1   
  2381 70E6 0643  CNSF06 DECT R3                Decrement sig digit count for 
  2382            *                              last zero byte   
  2383 70E8 0600         DEC  R0                Point to next higher byte of F
  2384 70EA D050         MOVB *R0,R1            Is next byte all zero?  
  2385 70EC 13FC         JEQ  CNSF06            Yes, continue looking for LSB 
  2386            *                             No, found the LSB, this loop  
  2387            *                              will always terminate since  
  2388            *                              FAC1 never 0   
  2389 70EE 04C0         CLR  R0                Take into account if the LSB i
  2390            *                              divisible by ten   
  2391 70F0 06C1         SWPB R1                Is divisible by ten   
  2392 70F2 3C20         DIV  @LW10,R0          Divide LSB by ten   
       70F4 700C  
  2393 70F6 C041         MOV  R1,R1             Is the remainder zero?  
  2394 70F8 1601         JNE  CNSF07            No, significant digit count is
  2395            *                              correct  
  2396 70FA 0603         DEC  R3                Yes, LSB has a trailing zero  
  2397 70FC 8343  CNSF07 C    R3,R13            Too many significant digits fo
  2398            *                              fixed format?  
  2399 70FE 1512         JGT  CNSG              Yes, use E-notation   
  2400            * FREE FORMAT FIXED POINT AND INTEGER FLOATING OUTPUT   
  2401 7100 6347  CNSF08 S    R7,R13            Make the exponent even  
  2402 7102 110A         JLT  CNSF12             are there digits to left of  
  2403            *                              decimal point? Jump if not   
  2404            *                             Yes, print decimal point with 
  2405            *                              the number   
  2406 7104 0204         LI   R4,3              Figure out where the decimal  
       7106 0003  
  2407            *                              point goes in  
  2408 7108 A10D         A    R13,R4            The number's digits   
  2409 710A 0203  CNSF10 LI   R3,12             Convert the maximum number of 
       710C 000C  
  2410            *                              decimal digits, leading and  
  2411            *                              trailing zeros are suppressed

 99/4 ASSEMBLER
CNS359                                                       PAGE 0054
  2412            *                              later  
  2413 710E 06A0         BL   @CNSDIG           Convert number to decimal digi
       7110 72E6  
  2414 7112 06A0         BL   @CNSUTR           Remove trailing zeros   
       7114 7408  
  2415 7116 1011         JMP  CNSG01            Suppress leading zeros and  
  2416 7118 0700  CNSF12 SETO R0                 figure out how many zeros  
  2417            *                              there are  
  2418 711A 600D         S    R13,R0            Between decimal point and   
  2419            *                              first digit  
  2420 711C 06A0         BL   @CNSPER           Put decimal point and zeros   
       711E 73B2  
  2421            *                              in buffer  
  2422 7120 04C4         CLR  R4                Don't print another decimal   
  2423            *                              point in the number  
  2424 7122 10F3         JMP  CNSF10            Convert NO. to decimal digits 
  2425            *                              finish up  
  2426            * FREE FORMAT E-NOTATION FLOATING OUTPUT  
  2427 7124 0203  CNSG   LI   R3,8              Get maximum NO. of digits to  
       7126 0008  
  2428            *                              print  
  2429 7128 0204         LI   R4,3              Figure out where to put decima
       712A 0003  
  2430            *                              point  
  2431 712C 6107         S    R7,R4             Take a leading zero into accou
  2432 712E 06A0         BL   @CNSDIG           Convert NO. to decimal digits 
       7130 72E6  
  2433 7132 06A0         BL   @CNSUTR           Suppress trailing zeros   
       7134 7408  
  2434 7136 06A0         BL   @CNSEXP           Put exponent into buffer  
       7138 7330  
  2435 713A 0460  CNSG01 B    @CNSMLS           Suppress leading zeros and  
       713C 73C4  
  2436            *                              finish up  
  2437            * FIXED FORMAT OUTPUT   
  2438            * WSM       R0 format specifications  
  2439            * WSM2      R1 format specifications  
  2440            * WSM4      R2 format specifications  
  2441            * WSM6      Number of digit places to left of decimal point 
  2442            * WSM8      Number of digit places to right of decimal point
  2443 713E C801  CNSX   MOV  R1,@WSM2          Save R1 format specifications 
       7140 831C  
  2444 7142 C802         MOV  R2,@WSM4          Save R2 format specifications 
       7144 831E  
  2445 7146 2420         CZC  @LWCNE,R0         Is E-notation to be used?   
       7148 7002  
  2446 714A 1606         JNE  CNSX01            Yes, remove place for sign fro
  2447            *                              left of DP count   
  2448 714C 0283         CI   R3,'-'*256        No, is number negative?   
       714E 2D00  
  2449 7150 1303         JEQ  CNSX01            Yes, remove sign from digit co
  2450 7152 2420         CZC  @LWCNS,R0         No, is explicit sign specified
       7154 6000  
  2451 7156 1306         JEQ  CNSX02            No, digit count correct as is 
  2452 7158 0601  CNSX01 DEC  R1                Remove place for sign form lef
  2453            *                              of DP digit count  
  2454 715A 1504         JGT  CNSX02            Any places for digits left?   
  2455 715C 0283         CI   R3,'-'*256        No, is number negative?   
       715E 2D00  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0055
  2456 7160 1301         JEQ  CNSX02            Yes, can't do anything about i
  2457 7162 04C1         CLR  R1                No, see if NO. digits to left 
  2458            *                              of DP will work  
  2459 7164 C801  CNSX02 MOV  R1,@WSM6          Save number of digits to left 
       7166 8320  
  2460            *                              of DP  
  2461 7168 1110         JLT  CNSJ04            Field to small if there are   
  2462            *                              negative places  
  2463 716A 0602         DEC  R2                Take decimal point from right 
  2464            *                              of DP count  
  2465 716C 1501         JGT  CNSX03            Are there still places left?  
  2466 716E 04C2         CLR  R2                No, don't print any digits the
  2467 7170 C802  CNSX03 MOV  R2,@WSM8          Save right of DP digit count  
       7172 8322  
  2468 7174 C101         MOV  R1,R4             Compute how many significant  
  2469            *                              digits are to be printed   
  2470 7176 A102         A    R2,R4   
  2471 7178 1308         JEQ  CNSJ04            None, error   
  2472            *   FALL INTO NO-TO FIXED FORMAT FLOATING OUTPUT  
  2473            *   
  2474            * Fixed format floating output  
  2475 717A 06A0         BL   @CNSTEN           Get base ten exponent of the F
       717C 72CA  
  2476 717E 2420         CZC  @LWCNE,R0         Is E-format call for?   
       7180 7002  
  2477 7182 1645         JNE  CNSK              Yes, go do it   
  2478            * FIXED FORMAT FLOATING F-FORMAT OUTPUT   
  2479 7184 880D         C    R13,@WSM6         Are there too many digits in  
       7186 8320  
  2480            *                              the number for the field size
  2481 7188 1102         JLT  CNSJ00            No, ok  
  2482 718A 0460  CNSJ04 B    @CNSAST   
       718C 7440  
  2483 718E C04D  CNSJ00 MOV  R13,R1            No, get exponent  
  2484 7190 A042         A    R2,R1             Compute where rounding should 
  2485            *                              take place   
  2486 7192 0281         CI   R1,-1             Is the NO. too small for the  
       7194 FFFF  
  2487            *                              field?   
  2488 7196 112A         JLT  CNSVZR            Yes, result is zero   
  2489 7198 06A0         BL   @CNSRND           No, round NO. to the proper   
       719A 7246  
  2490            *                              place  
  2491 719C 6347         S    R7,R13            Convert exponent to an even   
  2492            *                              number   
  2493 719E 110D         JLT  CNSJ01            Any digits to left of DP?   
  2494 71A0 0700         SETO R0                Yes, compute how many zero are
  2495            *                              needed before the number to  
  2496            *                              fill out the field to the  
  2497            *                              proper size  
  2498 71A2 A020         A    @WSM6,R0  
       71A4 8320  
  2499 71A6 600D         S    R13,R0  
  2500 71A8 06A0         BL   @CNSZER           Put zeros in the buffer if  
       71AA 73BC  
  2501            *                              needed   
  2502 71AC 0203         LI   R3,3              Compute the number of digits t
       71AE 0003  
  2503            *                              convert  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0056
  2504 71B0 A0CD         A    R13,R3            Take into account the number's
  2505            *                              size   
  2506 71B2 C103         MOV  R3,R4             Yes, compute where the DP will
  2507            *                              go   
  2508 71B4 A0E0         A    @WSM8,R3          Take into account the NO. of  
       71B6 8322  
  2509            *                              decimal palces   
  2510 71B8 1011         JMP  CNSJ02            Go convert the number   
  2511 71BA C0E0  CNSJ01 MOV  @WSM8,R3          Number is less then one   
       71BC 8322  
  2512 71BE 1316         JEQ  CNSVZR            NO. decimal places, print zero
  2513 71C0 C020         MOV  @WSM6,R0          Get size of field to right of 
       71C2 8320  
  2514 71C4 0580         INC  R0                Add one for CNSZER  
  2515 71C6 06A0         BL   @CNSZER           Fill field with zeros, they   
       71C8 73BC  
  2516            *                              will be suppressed   
  2517 71CA C306         MOV  R6,R12            Save pointer to DP  
  2518 71CC 0700         SETO R0                Compute NO. of zeros after DP 
  2519 71CE 600D         S    R13,R0            And before the number   
  2520 71D0 06A0         BL   @CNSPER           Put them and a DP into the  
       71D2 73B2  
  2521            *                              buffer   
  2522 71D4 A0CD         A    R13,R3            Figure out how many digits to 
  2523            *                              convert  
  2524 71D6 0223         AI   R3,3              Scale accordingly   
       71D8 0003  
  2525 71DA 04C4         CLR  R4                Do not print a decimal point  
  2526 71DC 06A0  CNSJ02 BL   @CNSDIG           Convert the NO. decimal digits
       71DE 72E6  
  2527 71E0 C020         MOV  @WSM4,R0          Is a decimal point required?  
       71E2 831E  
  2528 71E4 1601         JNE  CNSJ03            Yes, it is already there  
  2529 71E6 D700         MOVB R0,*R12           No, overwrite it with zero  
  2530 71E8 0460  CNSJ03 B    @CNSCHK           Go finish up  
       71EA 741A  
  2531            * FIXED FORMAT OUTPUT OF ZERO   
  2532 71EC C020  CNSVZR MOV  @WSM6,R0          Get left of DP field size   
       71EE 8320  
  2533 71F0 0580         INC  R0                Adjust it for CNSZER  
  2534 71F2 06A0         BL   @CNSZER           Put in correct amount of zeros
       71F4 73BC  
  2535 71F6 C306         MOV  R6,R12            Save pointer to where DP will 
  2536            *                              go   
  2537 71F8 C020         MOV  @WSM4,R0          Is a DP called for?   
       71FA 831E  
  2538 71FC 1302         JEQ  CNSV01            No, don't print one   
  2539 71FE 06A0         BL   @CNSPER           Yes, print it & some zeros  
       7200 73B2  
  2540            *                              after if needed  
  2541 7202 C020  CNSV01 MOV  @WSM,R0           Get R0 format specification   
       7204 831A  
  2542 7206 2420         CZC  @LWCNE,R0         Is E-format called for?   
       7208 7002  
  2543 720A 13EE         JEQ  CNSJ03            No, finish up   
  2544 720C 1019         JMP  CNSK01            Yes, print an exponent  
  2545            * FIXED FORMAT FLOATING E-FORMAT OUTPUT   
  2546 720E C160  CNSK   MOV  @FAC,R5           Is it zero?   
       7210 834A  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0057
  2547 7212 1603         JNE  CNSK1             No, go to CNSK1   
  2548 7214 04C7         CLR  R7                Yes, do it differently:   
  2549 7216 04CD         CLR  R13                R7,R13 set to be 0 and jump  
  2550 7218 10E9         JMP  CNSVZR             to CNSVZR  
  2551 721A A042  CNSK1  A    R2,R1             Get total number of digits to 
  2552            *                              print  
  2553 721C 0601         DEC  R1                Compute where rounding should 
  2554            *                              occur  
  2555 721E 06A0         BL   @CNSRND           Round number for E-format outp
       7220 7246  
  2556 7222 C0E0         MOV  @WSM6,R3          Get number of digits to left  
       7224 8320  
  2557            *                             of DP   
  2558 7226 6343         S    R3,R13            Compute what exponent should b
  2559            *                              printed  
  2560 7228 058D         INC  R13               Scale properly  
  2561 722A 60C7         S    R7,R3             Consider only even exponents  
  2562 722C 05C3         INCT R3                Compute number of digits to   
  2563            *                              print & where to put the   
  2564            *                              decimal point  
  2565 722E C103         MOV  R3,R4   
  2566 7230 A0E0         A    @WSM8,R3          Take digits to right of DP  
       7232 8322  
  2567            *                              into account   
  2568 7234 06A0         BL   @CNSDIG           Convert number to decimal digi
       7236 72E6  
  2569 7238 C020         MOV  @WSM4,R0          Is a decimal point needed?  
       723A 831E  
  2570 723C 1601         JNE  CNSK01            Yes, leave it alone   
  2571 723E 0606         DEC  R6                No, overwrite it with exponent
  2572 7240 06A0  CNSK01 BL   @CNSEXP           Put exponent into the buffer  
       7242 7330  
  2573 7244 10D1         JMP  CNSJ03            Finish up and zero suppress   
  2574            * ROUND THE NUMBER IN FAC   
  2575            * CALL    R1     Number of decimal digits to right of most  
  2576            *                 significant digit to round to   
  2577            *         R13    Base ten exponent  
  2578            *         R7     0 if R13 is even, 1 if R13 is odd  
  2579            *         BL     CNSRND   
  2580            *         STATUS Bits reflect exponent  
  2581            *         R13    Base ten exponent of rounded result  
  2582            *         R7     0 if R13 is even, 1 if R13 is odd  
  2583            *      DESTORYS: R0-R3,R12,R10  
  2584            *      ASSUMES R12 GE -1  
  2585 7246 05C9  CNSRND INCT R9                Save return address   
  2586 7248 C64B         MOV  R11,*R9   
  2587 724A 6341         S    R1,R13            Compute base ten exponent of  
  2588            *                              place to round to  
  2589 724C 6047         S    R7,R1             Take position of first digit  
  2590            *                              into account   
  2591 724E 0811         SRA  R1,1              Compute address in FAC of byte
  2592            *                             to be looked at   
  2593 7250 05C1         INCT R1                To determine if rounding occur
  2594 7252 0203         LI   R3,49*256         Assume 50 will be added to tha
       7254 3100  
  2595            *                              byte   
  2596 7256 081D         SRA  R13,1             Rounding to an even ten's plac
  2597 7258 1702         JNC  CNSR01            Yes, assumption was correct   
  2598 725A 0203         LI   R3,4*256          No,add 5 to byte to be looked 

 99/4 ASSEMBLER
CNS359                                                       PAGE 0058
       725C 0400  
  2599 725E 0281  CNSR01 CI   R1,7              Is all of FAC significant?  
       7260 0007  
  2600 7262 1531         JGT  CNSR05            Yes, no need to round   
  2601 7264 0207         LI   R7,FAC            No, get pointer into FAC  
       7266 834A  
  2602 7268 04CC         CLR  R12               The number is positive  
  2603 726A D357         MOVB *R7,R13           Get current FAC exponent  
  2604 726C D28D         MOVB R13,R10           Save it to see if it will chan
  2605 726E 098D         SRL  R13,8             Put exponent in the low byte  
  2606 7270 A1C1         A    R1,R7             Get address of byte to look at
  2607 7272 B5C3         AB   R3,*R7            Add NO. to add to round-1 into
  2608            *                              correct byte   
  2609 7274 C2C3         MOV  R3,R11            In ROUNUP: Change R3 value  
  2610 7276 C10A         MOV  R10,R4            In ROUNUP: Use R10 to return  
  2611 7278 020A         LI   R10,CNSROV  
       727A 7290  
  2612 727C D160         MOVB @FAC,R5           In ROUNUP: Get the exponent va
       727E 834A  
  2613            *                                        from EXP and EXP+1,
  2614            *                                        now provide  
  2615 7280 0985         SRL  R5,8  
  2616 7282 C805         MOV  R5,@EXP   
       7284 8376  
  2617 7286 D805         MOVB R5,@SIGN          Clear sign which is used in RO
       7288 8375  
  2618 728A C149         MOV  R9,R5             In ROUNUP: R9 value may be  
  2619            *                                        changed  
  2620 728C 0460         B    @ROUNUP           Propigate carry upwards in FAC
       728E 0F64  
  2621 7290 C284  CNSROV MOV  R4,R10  
  2622 7292 C0CB         MOV  R11,R3  
  2623 7294 C245         MOV  R5,R9   
  2624 7296 04C1         CLR  R1                Label prevents getting an   
  2625            *                              overflow warning   
  2626 7298 0287         CI   R7,FAC1           Did rounding occur at first   
       729A 834B  
  2627            *                              byte of FAC?   
  2628 729C 1603         JNE  CNSR02            No, go clear rest of FAC  
  2629 729E 92A0         CB   @FAC,R10          Yes, did exponent change?   
       72A0 834A  
  2630 72A2 160C         JNE  CNSR03            Yes, FAC is correctly zeroed  
  2631            *                              as is  
  2632 72A4 0283  CNSR02 CI   R3,4*256          Did rounding occur on a byte  
       72A6 0400  
  2633            *                              boundry?   
  2634 72A8 160A         JNE  CNSR04            Yes, clear rest of bytes in FA
  2635 72AA 04C0         CLR  R0                No, make this digit divisible 
  2636            *                              by ten   
  2637 72AC D817         MOVB *R7,@R1LB         Get byte where rounding occure
       72AE 83E3  
  2638 72B0 3C20         DIV  @LW10,R0          Divide by ten to get quotient 
       72B2 700C  
  2639 72B4 3820         MPY  @LW10,R0          Pack quotient back in, ignore 
       72B6 700C  
  2640 72B8 D5E0         MOVB @R1LB,*R7         Put the byte back into the FAC
       72BA 83E3  
  2641 72BC 0587  CNSR03 INC  R7                Point to next byte of FAC   
  2642 72BE DDC1  CNSR04 MOVB R1,*R7+           Zero next byte of FAC   

 99/4 ASSEMBLER
CNS359                                                       PAGE 0059
  2643 72C0 0287         CI   R7,FAC8           Done zeroing the rest of the  
       72C2 8352  
  2644            *                              FAC?   
  2645 72C4 1AFC         JL   CNSR04            No, continue to do it   
  2646 72C6 C2D9  CNSR05 MOV  *R9,R11           Yes, restore return address   
  2647 72C8 0649         DECT R9                Get new base ten exponent of F
  2648            *   
  2649            * GET BASE TEN EXPONENT OF THE NUMBER IN THE FAC  
  2650            * CALL     BL        CSNTEN   
  2651            *        STATUS      Status bits reflect exponent   
  2652            *          R13       Base ten exponent  
  2653            *          R7        0 if R13 is even, 1 it R13 is odd  
  2654 72CA 020D  CNSTEN LI   R13,->4000        Negative bias   
       72CC C000  
  2655 72CE B360         AB   @FAC,R13          Get base 1 hundred exponent of
       72D0 834A  
  2656            *                              FAC  
  2657 72D2 087D         SRA  R13,7             Multiply it by two and put it 
  2658            *                              in the low byte  
  2659 72D4 04C7         CLR  R7                High bit of FAC1 is always off
  2660 72D6 9820         CB   @FAC1,@CBHA       Is first digit of FAC one   
       72D8 834B  
       72DA 6004  
  2661            *                              decimal digit?   
  2662 72DC 1102         JLT  CNST01            Yes, base ten exponent is even
  2663 72DE 058D         INC  R13               No, take this into account in 
  2664            *                              base ten exponent  
  2665 72E0 0587         INC  R7                This makes the base ten   
  2666            *                              exponent odd   
  2667 72E2 C34D  CNST01 MOV  R13,R13           Set stauts bits to reflect  
  2668            *                              base ten exponent  
  2669 72E4 045B         RT   
  2670            *   
  2671            * CONVERT FACTION OF FLOATING NUMBER IN FAC TO ASCII DIGITS 
  2672            * CALL        R3     Number of decimal digits+1 to convert  
  2673            *             R4     Number of digits the decimal point is t
  2674            *                     the left of   
  2675            *             R6     Text pointer to where to put result  
  2676            * BL       CNSDIG   
  2677            *             R3(MB) 0  
  2678            *             R6     Updated to point to end of digits  
  2679            *             R12    Pointer to decimal point   
  2680            * DESTORYS: R0-R2,R4  
  2681            *   
  2682 72E6 05C9  CNSDIG INCT R9                Save return address   
  2683 72E8 C64B         MOV  R11,*R9   
  2684 72EA 04E0         CLR  @FAC8             Clear guard digits in case the
       72EC 8352  
  2685            *                              are printed  
  2686 72EE 04C1         CLR  R1                Clear high byte of current byt
  2687            *                              of FAC register  
  2688 72F0 0202         LI   R2,FAC1           Get pointer to first byte of F
       72F2 834B  
  2689 72F4 06A0         BL   @CNSD03           Check for a leading dec point 
       72F6 7314  
  2690 72F8 04C0  CNSD01 CLR  R0                Clear high word of this byte  
  2691            *                              of FAC for divide  
  2692 72FA D832         MOVB *R2+,@R1LB        Get next byte of FAC  
       72FC 83E3  

 99/4 ASSEMBLER
CNS359                                                       PAGE 0060
  2693 72FE 3C20         DIV  @LW10,R0          Separate the two decimal digit
       7300 700C  
  2694 7302 06A0         BL   @CNSD02           Put the first one in the buffe
       7304 730C  
  2695 7306 C001         MOV  R1,R0             Get the one's place digit   
  2696 7308 020B         LI   R11,CNSD01        Set up return addressto loop a
       730A 72F8  
  2697            *                              get the next byte of the FAC 
  2698            *                              after this digit is printed  
  2699 730C 0220  CNSD02 AI   R0,'0'            Convert this decimal digit to 
       730E 0030  
  2700            *                              ASCII  
  2701 7310 DDA0         MOVB @R0LB,*R6+        Put this ASCII digit into buff
       7312 83E1  
  2702 7314 0604  CNSD03 DEC  R4                Is it time for decimal point? 
  2703 7316 1603         JNE  CNSD04            No, check for end of number   
  2704 7318 C306         MOV  R6,R12            Yes, save ptr to decimal point
  2705 731A DDA0         MOVB @LBPER,*R6+       Put decimal point in buffer   
       731C 7012  
  2706            * VSPTR (Value stack pointer) at CPU >6E, make sure not to  
  2707            *  destroy it here  
  2708 731E 0286  CNSD04 CI   R6,FAC33          Field overflow?   
       7320 836B  
  2709 7322 1402         JHE  CNSD06            Yes, put a zero byte at the   
  2710            *                              end and return   
  2711 7324 0603         DEC  R3                No, all digits been printed?  
  2712 7326 1503         JGT  CNSDRT            No, return & print next digit 
  2713 7328 D583  CNSD06 MOVB R3,*R6            Yes, put a zero byte at the en
  2714            *                              of the number  
  2715 732A C2D9  CNSD05 MOV  *R9,R11           Restore return address  
  2716 732C 0649         DECT R9  
  2717 732E 045B  CNSDRT RT   
  2718            ************************************************************
  2719                
  2721                
  2722            * PUT EXPONENT INTO THE BUFFER  
  2723            * CALL        R6     Text pointer into buffer   
  2724            *             R13    Exponent   
  2725            *   BL      CNSEXP  
  2726            *             R6     Updated to point after exponent  
  2727            * DESTORYS:   R0,R13  
  2728            *   
  2729 7330 05C9  CNSEXP INCT R9                Save return address   
  2730 7332 CE4B         MOV  R11,*R9+  
  2731 7334 C64C         MOV  R12,*R9           Save contents of registers  
  2732 7336 DDA0         MOVB @LBE,*R6+         Put an "E" into the buffer  
       7338 7013  
  2733 733A 0200         LI   R0,'-'*256        Assume the exponent is negativ
       733C 2D00  
  2734 733E 074D         ABS  R13               Is exponent negative?   
  2735 7340 1102         JLT  CNSE01            Yes, sign is correct  
  2736 7342 0200         LI   R0,'+'*256        No, get sign for positive exp 
       7344 2B00  
  2737 7346 DD80  CNSE01 MOVB R0,*R6+           Put the exponent's sign into  
  2738            *                              buffer   
  2739 7348 028D         CI   R13,100           Is the exponent to big?   
       734A 0064  
  2740 734C 110B         JLT  CNSE02            No, convert it to ASCII   
  2741 734E C020         MOV  @WSM,R0           Is free format output?  

 99/4 ASSEMBLER
CNS3592                                                      PAGE 0061
       7350 831A  
  2742 7352 1303         JEQ  CNSE04            Yes, get the asterisk   
  2743 7354 2420         CZC  @LWCNF,R0         No, is extended exp specified?
       7356 7004  
  2744 7358 1605         JNE  CNSE02            Yes, convert it to ASCII  
  2745 735A 0200  CNSE04 LI   R0,'*'*256        No, get an asterisk   
       735C 2A00  
  2746 735E DD80         MOVB R0,*R6+           Put two asterisks in the buffe
  2747            *                              for the exponent   
  2748 7360 DD80         MOVB R0,*R6+           Because it is too big   
  2749 7362 1015         JMP  CNSE03            Go finish up  
  2750 7364 06A0  CNSE02 BL   @CNSINT           Convert the exp to ASCII digit
       7366 7398  
  2751 7368 0226         AI   R6,-5             Point back to start of exp  
       736A FFFB  
  2752 736C C020         MOV  @WSM,R0           Is free format output?  
       736E 831A  
  2753 7370 130A         JEQ  CNSE05            Yes   
  2754 7372 2420         CZC  @LWCNF,R0         No, is extended exp specified?
       7374 7004  
  2755 7376 1307         JEQ  CNSE05            No  
  2756 7378 DDA6         MOVB @2(R6),*R6+       Yes, move 3(instead of 2)   
       737A 0002  
  2757            *                              significant  
  2758 737C DDA6         MOVB @2(R6),*R6+        digits of exponent up pass th
       737E 0002  
  2759 7380 DDA6         MOVB @2(R6),*R6+        leading zeros from CNSINT  
       7382 0002  
  2760 7384 1004         JMP  CNSE03  
  2761 7386 DDA6  CNSE05 MOVB @3(R6),*R6+       Move significant digits of  
       7388 0003  
  2762            *                              exponent up pass the leading 
  2763            *                              zeros from   
  2764 738A DDA6         MOVB @3(R6),*R6+        CNSINT   
       738C 0003  
  2765 738E D5A0  CNSE03 MOVB @LW10,*R6         Put a zero byte at the end of 
       7390 700C  
  2766            *                              the number   
  2767 7392 C319         MOV  *R9,R12           Restore original contents of  
  2768            *                              R12  
  2769 7394 0649         DECT R9  
  2770 7396 10C9         JMP  CNSD05            POP address and return  
  2771            * CONVERT AN UNSIGNED INTEGER INTO A STRING OF 5 ASCII DIGIT
  2772            * CALL        R6     Text pointer   
  2773            *             R13    Integer  
  2774            *   BL      CNSINT  
  2775            *             R6     Updated to point after number  
  2776            * DESTROYS:   R0,R12,R13  
  2777 7398 0200  CNSINT LI   R0,CNSITT         Get pointer to integer power o
       739A 7006  
  2778            *                              ten table  
  2779 739C 04CC  CNSI01 CLR  R12               Clear high word of integer for
  2780            *                              divide   
  2781 739E 3F30         DIV  *R0+,R12          Divide by next power of ten   
  2782 73A0 022C         AI   R12,'0'           Convert quotient to ASCII   
       73A2 0030  
  2783 73A4 DDA0         MOVB @R12LB,*R6+       Put next digit into the buffer
       73A6 83F9  
  2784 73A8 0280         CI   R0,CNSITT+10      Divided by all the powers of t

 99/4 ASSEMBLER
CNS3592                                                      PAGE 0062
       73AA 7010  
  2785 73AC 1AF7         JL   CNSI01            No, compute the next digit of 
  2786            *                              the NO.  
  2787 73AE D58C         MOVB R12,*R6           Yes, put a zero byte at the   
  2788            *                              end of the number  
  2789 73B0 045B         RT   
  2790            * PUT SOME ZEROS IN THE BUFFER AND MAYBE A DECIMAL POINT  
  2791            * CALL        R0     Number of zeros+1  
  2792            *             R6     Text pinter into buffer  
  2793            *   BL     CNSPER :  To put in a decimal point before zeros 
  2794            *   BL     CNSZER :  Updated to point after the zeros   
  2795            * DESTROYS:   R0  
  2796 73B2 DDA0  CNSPER MOVB @LBPER,*R6+       Put a decimal point in the buf
       73B4 7012  
  2797 73B6 1002         JMP  CNSZER            Then some zeros   
  2798 73B8 DDA0  CNSZ01 MOVB @LBZER,*R6+       Put a zero in the buffer  
       73BA 7014  
  2799 73BC 0600  CNSZER DEC  R0                Are there more zeros to put in
  2800 73BE 15FC         JGT  CNSZ01            Yes, go put in another zero   
  2801 73C0 D580         MOVB R0,*R6            No, put a null byte after the 
  2802            *                              zeros  
  2803 73C2 045B         RT   
  2804            * SUPPRESS LEADING ZEROS AND FLOAT THE SIGN   
  2805            * CALL  
  2806            *   JMP    CNSMLS : Entry to finish up after zero suppressin
  2807            *   BL     CNSLEA : Entry to return afterwards  
  2808            *            R1     ASCII sign in high byte   
  2809            *            R6     Pointer to start of number  
  2810            * DESTROYS:  R0-R1  
  2811 73C4 020B  CNSMLS LI   R11,CNSSTR        Entry to finish up number   
       73C6 746A  
  2812            *                              afterward  
  2813 73C8 0206  CNSLEA LI   R6,FAC15          Get pointer to sign   
       73CA 8359  
  2814 73CC D056         MOVB *R6,R1            Get sign  
  2815 73CE DDA0  CNSL01 MOVB @LBSPC,*R6+       Put a space where the zero  
       73D0 7010  
  2816            *                              or sign was  
  2817 73D2 9816         CB   *R6,@LBZER        Is the next byte zero?  
       73D4 7014  
  2818 73D6 13FB         JEQ  CNSL01            Yes, suppress it  
  2819 73D8 D016         MOVB *R6,R0            No, is this the end of  
  2820            *                              the number?  
  2821 73DA 130F         JEQ  CNSL02            Yes, put the zero back in,  
  2822            *                              NO. is 0   
  2823 73DC 9800         CB   R0,@LBE           No, is this the start of  
       73DE 7013  
  2824            *                              the exponent?  
  2825 73E0 130C         JEQ  CNSL02            Yes, put the zero back in,  
  2826            *                              NO. is 0   
  2827 73E2 9800         CB   R0,@LBPER         No, is this the decimal point?
       73E4 7012  
  2828 73E6 160C         JNE  CNSL03            No, put the sign back in  
  2829 73E8 C020         MOV  @WSM,R0           Yes, is free format output?   
       73EA 831A  
  2830 73EC 1609         JNE  CNSL03            No, then put the sign   
  2831            *                              back in fix fomat output   
  2832 73EE D026         MOVB @1(R6),R0         Yes, any digits to right of DP
       73F0 0001  

 99/4 ASSEMBLER
CNS3592                                                      PAGE 0063
  2833 73F2 1303         JEQ  CNSL02            No, put the sign back   
  2834 73F4 9800         CB   R0,@LBE           Does exponent start after DP? 
       73F6 7013  
  2835 73F8 1603         JNE  CNSL03            No, put the sign back   
  2836 73FA 0606  CNSL02 DEC  R6                Yes, point back to where the  
  2837            *                              zero was   
  2838 73FC D5A0         MOVB @LBZER,*R6        Put the zero back in, the NO. 
       73FE 7014  
  2839            *                              is 0   
  2840 7400 0606  CNSL03 DEC  R6                Point back to where the sign  
  2841            *                              will go  
  2842 7402 D581         MOVB R1,*R6            Put the sign back in the buffe
  2843 7404 045B         RT   
  2844            * REMOVE TRAILING ZEROS   
  2845            * CALL      R3      0   
  2846            *           R6      Pointer to one past end of number   
  2847            *           R12     Pointer to decimal point  
  2848            *           R10     Zero if an integer is being printed   
  2849            *   BL   CNSUTR   
  2850            *           R6      Pointer to new end of number  
  2851            * DESTROYS: NONE  
  2852 7406 0606  CNSU01 DEC  R6                Point back to next digit in   
  2853            *                              the NO.  
  2854 7408 9826  CNSUTR CB   @-1(R6),@LBZER    Is the last digit in the NO. 0
       740A FFFF  
       740C 7014  
  2855 740E 13FB         JEQ  CNSU01            Yes, look back for a non-zero 
  2856            *                              digit  
  2857 7410 C28A         MOV  R10,R10           No, is an integer being printe
  2858 7412 1601         JNE  CNSU02            No, put a null at the end of  
  2859            *                              the NO.  
  2860 7414 C18C         MOV  R12,R6            Yes, end of number is where DP
  2861            *                              is all digits after the  
  2862            *                              decimal point should be zero 
  2863 7416 D583  CNSU02 MOVB R3,*R6            Put a zero byte at the end of 
  2864            *                              the number   
  2865 7418 045B         RT   
  2866            * SET UP A POINTER TO THE BEGINNING OF A FIXED FORMAT FIELD 
  2867            * AND SEE IF THE FIELD IS LARGE ENOUGH AND FINISH UP  
  2868            * CALL      R12     Pointer to decimal point or where it  
  2869            *                    would go   
  2870            *   JMP   CNSCHK  
  2871            *           R6      Pointer to beginning of number  
  2872            * DESTROYS: R0,R1   
  2873 741A 06A0  CNSCHK BL   @CNSLEA           Suppress leading zeros and fix
       741C 73C8  
  2874            *                              up the sign  
  2875 741E C18C         MOV  R12,R6            Point to decimal point  
  2876 7420 61A0         S    @WSM2,R6          Point to where the beginning o
       7422 831C  
  2877            *                              the field is   
  2878 7424 9826         CB   @-1(R6),@LBSPC    Does number extend before the 
       7426 FFFF  
       7428 7010  
  2879            *                              field beginning?   
  2880 742A 160A         JNE  CNSAST            Yes, error  
  2881 742C C020         MOV  @WSM,R0           No, get R0 format specificatio
       742E 831A  
  2882 7430 2420         CZC  @LWCNS,R0         Is an explicit sign required? 

 99/4 ASSEMBLER
CNS3592                                                      PAGE 0064
       7432 6000  
  2883 7434 131A         JEQ  CNSSTR            No, finish up and return  
  2884 7436 9816         CB   *R6,@LBSPC        Yes, is first character of  
       7438 7010  
  2885            *                              number a space?  
  2886 743A 1317         JEQ  CNSSTR            Yes, finish up and return   
  2887 743C 9056         CB   *R6,R1            No, is first character of   
  2888            *                              number the sign?   
  2889 743E 1315         JEQ  CNSSTR            Yes, finish up and return   
  2890            *                             No, error   
  2891            * ASTRISK FILL A FIXED FORMAT FIELD AND FINISH UP   
  2892            * CALL  
  2893            *   JMP   CNSAST  
  2894            *           R6        Pointer to the beginning of the string
  2895            * DESTROYS: R0,R1   
  2896 7440 0206  CNSAST LI   R6,WSM            Optimize for speed and space  
       7442 831A  
  2897 7444 C036         MOV  *R6+,R0           Get R0 format spacification   
  2898 7446 C076         MOV  *R6+,R1           Get left of decimal point size
  2899 7448 A076         A    *R6+,R1           Compute length of field   
  2900 744A 2420         CZC  @LWCNE,R0         Is E-format being used?   
       744C 7002  
  2901 744E 1305         JEQ  CNSA01            No, field length is correct   
  2902 7450 8C71         C    *R1+,*R1+         Yes, increase field length for
  2903            *                              the exponent (Increments R1  
  2904            *                              by 4)  
  2905 7452 2420         CZC  @LWCNF,R0         Is extended E-format being use
       7454 7004  
  2906 7456 1301         JEQ  CNSA01            No, field length is correct   
  2907 7458 0581         INC  R1                Yes, increase field length for
  2908            *                              the exponent (Increments R1  
  2909            *                              by 1)  
  2910 745A 0206  CNSA01 LI   R6,FAC15          Get pointer to beginning of bu
       745C 8359  
  2911 745E C006         MOV  R6,R0             Get a pointer to put asterisks
  2912            *                              in the buffer  
  2913 7460 DC20  CNSA02 MOVB @LBAST,*R0+       Put an asterisk into the buffe
       7462 7011  
  2914 7464 0601         DEC  R1                Is the field filled yet?  
  2915 7466 15FC         JGT  CNSA02            No, continue asterisk filling 
  2916 7468 D401         MOVB R1,*R0            Yes, put a zero byte at the en
  2917            *                              of string  
  2918            *                             Finish up and return  
  2919            * FINSH UP -- COMPUTE THE LENGTH OF THE STRING AND RETURN   
  2920            * CALL       R6    Pointer to first character in the string,
  2921            *                   the string ends with a zero byte  
  2922            * DESTROYS:  R0-R1  
  2923 746A C006  CNSSTR MOV  R6,R0             Get pointer to beginning of th
  2924            *                              string   
  2925 746C D070  CNSS01 MOVB *R0+,R1           Look for end of string,   
  2926            *                              found it?  
  2927 746E 16FE         JNE  CNSS01            No, keep looking  
  2928 7470 0600         DEC  R0                Yes, point to back to the   
  2929            *                              zero byte  
  2930 7472 6006         S    R6,R0             Compute length of string  
  2931 7474 D820         MOVB @R0LB,@FAC12      Put length of string in FAC12 
       7476 83E1  
       7478 8356  
  2932 747A 0200         LI   R0,PAD0   

 99/4 ASSEMBLER
CNS3592                                                      PAGE 0065
       747C 8300  
  2933 747E 6180         S    R0,R6             Put beginning of string   
  2934            *                              in FAC11   
  2935 7480 D820         MOVB @R6LB,@FAC11  
       7482 83ED  
       7484 8355  
  2936 7486 C359         MOV  *R9,R13           Restore GROM address  
  2937 7488 0649         DECT R9                Off the stack   
  2938 748A 0460         B    @ROLIN            In ROLIN return   
       748C 7AC4  
  2939            ************************************************************
  2940 748E              AORG >748E   
  2942                
  2943 748E 4101  CBH411 DATA >4101   
  2944                
  2945 7490   3F  CBH3F  BYTE >3F   
  2946 7491   44  CBH44  BYTE >44   
  2947                   EVEN   
  2948            *   
  2949            * VROAZ  EQU >03C0            VDP roll out area   
  2950            * FPSIGN EQU >03DC  
  2951            * PROAZ  EQU PAD0+>10         Processor roll out area   
  2952            * PZ     EQU PAD0+>12   
  2953            * QZ     EQU PAD0+>16   
  2954            * CZ     EQU PAD0+>1A   
  2955            * SGNZ   EQU PAD0+>75   
  2956            * EXPZ   EQU PAD0+>76   
  2957            * OEZ    EQU PAD0+>14   
  2958      0000  EXC127 EQU  >00   
  2959      0008  FHALF  EQU  >08   
  2960      0010  SQRTEN EQU  >10   
  2961      0018  LOG10E EQU  >18   
  2962      0020  LN10   EQU  >20   
  2963      0028  PI2    EQU  >28   
  2964      0030  RPI2   EQU  >30   
  2965      0038  PI4    EQU  >38   
  2966      0040  TANPI8 EQU  >40   
  2967      0048  TAN3P8 EQU  >48   
  2968      0050  SQRP   EQU  >50   
  2969      006A  SQRQ   EQU  >6A   
  2970      006A  FPOS1  EQU  >6A   
  2971      007C  EXPP   EQU  >7C   
  2972      0096  EXPQ   EQU  >96   
  2973      00B8  LOGP   EQU  >B8   
  2974      00E2  LOGQ   EQU  >E2   
  2975      010C  SINP   EQU  >010C   
  2976      014E  ATNP   EQU  >014E   
  2977                
  2978            ************************************************************
  2979            * INVOLUTION  
  2980            * FAC           - exponent  
  2981            * Top of stack  - Base  
  2982            * If integer Base and integer exponent do multiplies to   
  2983            * keep result exact, otherwise, use logarithm to calculate  
  2984            * value.  
  2985            ************************************************************
  2986 7492 C28B  PWRZZ  MOV  R11,R10   
  2987 7494 06A0         BL   @SAVRTN           Save return   
       7496 7AB2  

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0066
  2988 7498 06A0         BL   @POPSTK           Get Base into ARG   
       749A 60D4  
  2989 749C C020         MOV  @FAC,R0           If exponent=0   
       749E 834A  
  2990 74A0 1359         JEQ  PWRG01            Then result = 1   
  2991 74A2 C020         MOV  @ARG,R0           If Base=0   
       74A4 835C  
  2992 74A6 1352         JEQ  PWRG02            Then return 0 or warning  
  2993 74A8 A820         A    @C8,@VSPTR        Use Base on stack   
       74AA 7AF4  
       74AC 836E  
  2994 74AE 06A0         BL   @PUSH             Check to see if E is floating 
       74B0 7AF2  
  2995            *                              integer  
  2996 74B2 06A0         BL   @GRINT            Convert 1 copy of exp to int  
       74B4 79EC  
  2997 74B6 D820         MOVB @C8,@SIGN         Assume sign is positive   
       74B8 7AF4  
       74BA 8375  
  2998 74BC 06A0         BL   @XTFACZ           FAC=ARG     STACK=INT(ARG)  
       74BE 7B34  
  2999 74C0 06A0         BL   @SCOMPB           Integer exponent?   
       74C2 0D42  
  3000 74C4 164D         JNE  PWRZZ3            No, try floating code   
  3001            * COMPUTE INTEGER POWER B^E   
  3002 74C6 06A0         BL   @PUSH             Put Exp above Base on stack   
       74C8 7AF2  
  3003 74CA D820         MOVB @C8,@FAC10        Assume no error   
       74CC 7AF4  
       74CE 8354  
  3004 74D0 06A0         BL   @CFI              Try to convert E to integer   
       74D2 12B8  
  3005 74D4 0760  CCBH7  ABS  @FAC              Absolute value of exponent  
       74D6 834A  
  3006 74D8 C320         MOV  @FAC,R12          Save integer exponent   
       74DA 834A  
  3007 74DC 06A0         BL   @POP              Return E to FAC; B on stack   
       74DE 7B16  
  3008 74E0 D020         MOVB @FAC10,R0         If E>32767  
       74E2 8354  
  3009 74E4 1648         JNE  PWRZZ1            Return to floating point code 
  3010 74E6 06A0         BL   @XTFACZ           Get Base in accumulator   
       74E8 7B34  
  3011 74EA 06A0         BL   @PUSH             Put E on stack for later sign 
       74EC 7AF2  
  3012            *                              check  
  3013 74EE 060C         DEC  R12               Reduce exponent by one since  
  3014            *                              accumulator starts with Base 
  3015 74F0 1312         JEQ  PWRJ40            If 0 then done already  
  3016 74F2 091C  PWRJ30 SRL  R12,1             Check l.s. bit  
  3017 74F4 1705         JNC  PWRJ10            If 0, skip the work   
  3018 74F6 06A0         BL   @SMULT            Multiply in this power  
       74F8 0E8C  
  3019 74FA A820         A    @C8,@VSPTR        Restore stack   
       74FC 7AF4  
       74FE 836E  
  3020 7500 C30C  PWRJ10 MOV  R12,R12           Finished?   
  3021 7502 1309         JEQ  PWRJ40            Yes   
  3022 7504 06A0         BL   @XTFACZ           No, exchange: B in FAC,   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0067
       7506 7B34  
  3023            *                              accumulator on stack   
  3024 7508 06A0         BL   @PUSH             Copy B onto stack   
       750A 7AF2  
  3025 750C 06A0         BL   @SMULT            Square it for new B   
       750E 0E8C  
  3026 7510 06A0         BL   @XTFACZ           Restore order: B on stack   
       7512 7B34  
  3027            *                              accumulator in FAC   
  3028 7514 10EE         JMP  PWRJ30            Loop for next bit   
  3029 7516 6820  PWRJ40 S    @C16,@VSPTR       Done, clean up  
       7518 6BF8  
       751A 836E  
  3030 751C C0E0         MOV  @VSPTR,R3         Get stack pointer   
       751E 836E  
  3031 7520 0223         AI   R3,8              Test exponent sign now  
       7522 0008  
  3032 7524 06A0         BL   @GETV1            Get it  
       7526 1880  
  3033 7528 1102         JLT  PWRJ41            If negative, compute negative 
  3034 752A 0460  PWRRTN B    @ROLIN2           Use commone code to return  
       752C 7AE0  
  3035 752E D020  PWRJ41 MOVB @FAC10,R0         If overflow has occured   
       7530 8354  
  3036 7532 1606         JNE  PWRJ45            Go make it zero   
  3037 7534 06A0         BL   @MOVROM           Get a floating point one  
       7536 7A70  
  3038 7538 006A         DATA FPOS1              into ARG   
  3039            *   
  3040 753A 06A0         BL   @FDIV             Compute the inverse   
       753C 0FF4  
  3041 753E 10F5         JMP  PWRRTN            And return  
  3042 7540 04E0  PWRJ45 CLR  @FAC              If overflow, the result=0   
       7542 834A  
  3043 7544 D820         MOVB @FAC,@FAC10       Indicate no error   
       7546 834A  
       7548 8354  
  3044 754A 10EF         JMP  PWRRTN            And return  
  3045 754C D020  PWRG02 MOVB @FAC,R0           Is Exp negative?  
       754E 834A  
  3046 7550 1139         JLT  PWRG05            Yes, divide by 0 =>put in over
  3047 7552 10F6         JMP  PWRJ45            No, result is zero and return 
  3048 7554 0200  PWRG01 LI   R0,FAC            Need to put floating 1 in FAC 
       7556 834A  
  3049 7558 06A0         BL   @MOVRM1           Get the floating 1  
       755A 7A74  
  3050 755C 006A         DATA FPOS1              into FAC   
  3051            *   
  3052 755E 10E5         JMP  PWRRTN            And return  
  3053 7560 06A0  PWRZZ3 BL   @GETV             Check for negative  
       7562 187C  
  3054 7564 836E         DATA VSPTR             On the stack  
  3055            *   
  3056 7566 1517         JGT  PWRZZ2            If ok   
  3057 7568 D820         MOVB @ERRNIP,@FAC10    Else error code   
       756A 75BE  
       756C 8354  
  3058 756E 6820         S    @C8,@VSPTR        Throw away entry on stack   
       7570 7AF4  

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0068
       7572 836E  
  3059 7574 10DA         JMP  PWRRTN            And return  
  3060            * INTEGER EXPONENT OUT OF INTEGER RANGE   
  3061 7576 06A0  PWRZZ1 BL   @GETV             Positive or negative Base?  
       7578 187C  
  3062 757A 836E         DATA VSPTR   
  3063            *   
  3064 757C 150C         JGT  PWRZZ2            Positive Base   
  3065            * NEGATIVE BASE - So see if exponent is even or odd to set  
  3066            *                  the sign of the result   
  3067 757E 04C1  PWRZZ4 CLR  R1                For double  
  3068 7580 D060         MOVB @FAC,R1           Get exponent  
       7582 834A  
  3069 7584 0741         ABS  R1                Work with positive  
  3070 7586 0281         CI   R1,>4600          Too big to have one's byte?   
       7588 4600  
  3071 758A 1505         JGT  PWRZZ2            Yes, assume number is even  
  3072 758C 06C1         SWPB R1                Get in low order byte   
  3073 758E 0221         AI   R1,>830B          No, get one's radix digit   
       7590 830B  
  3074            *                              location in FAC  
  3075 7592 D051         MOVB *R1,R1            Get the digit   
  3076 7594 0A71         SLA  R1,7              If last bit set, set top bit  
  3077 7596 0204  PWRZZ2 LI   R4,FPSIGN         Save sign of result   
       7598 03DC  
  3078 759A 06A0         BL   @PUTV1             in a permanent place   
       759C 6422  
  3079 759E 06A0         BL   @XTFACZ           Base in FAC; Exponent on stack
       75A0 7B34  
  3080 75A2 0760         ABS  @FAC              Must work with positive   
       75A4 834A  
  3081 75A6 06A0         BL   @LOGZZ            Compute LOG(B) in FAC   
       75A8 76C2  
  3082 75AA 06A0         BL   @SMULT            Compute E*LOG(B) in FAC   
       75AC 0E8C  
  3083 75AE 06A0         BL   @EXPZZ            Let exp give error on warning 
       75B0 75CA  
  3084 75B2 0203         LI   R3,FPSIGN         Check sign of result  
       75B4 03DC  
  3085 75B6 06A0         BL   @GETV1  
       75B8 1880  
  3086 75BA 1101         JLT  PWRZZ5            If E is negative  
  3087 75BC 10B6         JMP  PWRRTN            If E is positive  
  3088      75BE  ERRNIP EQU  $   
  3089 75BE 0520  PWRZZ5 NEG  @FAC              Make it negative  
       75C0 834A  
  3090 75C2 10B3         JMP  PWRRTN  
  3091 75C4 06A0  PWRG05 BL   @OVEXP            Return overflow   
       75C6 0FC2  
  3092 75C8 10B0         JMP  PWRRTN            And return  
  3093            ************************************************************
  3094            * EXPONENTIAL FUNCTION  
  3095            * FAC   =   EXP(FAC)  
  3096            * CALL      BL   @EXPZZ   
  3097            * WARNING:  WRNOV             Overflow  
  3098            * STACK LEVELS USED:  
  3099            *      X : = FAC * LOG10(E)   
  3100            *      So EXP(FAC) = 10^X   
  3101            *      Make sure X is in range LOG100(X) = LOG10(X)/2   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0069
  3102            *      N : = INT(X)   
  3103            *      R : = X-N, 0 <= R < 1  
  3104            *      IF R < .5 THEN R : = R   
  3105            *                ELSE S : = R-5   
  3106            * A rational function approximation is used for 10^S  
  3107            * (HART EXPD 1444)  
  3108            * EXP : = IF R .LT. .5 THEN 10^N * 10^S   
  3109            *                      ELSE 10^N * 10^.5 * 10^S   
  3110            ************************************************************
  3111 75CA C28B  EXPZZ  MOV  R11,R10   
  3112 75CC 06A0         BL   @ROLOUT           Get workspace and save return 
       75CE 7A90  
  3113 75D0 06A0         BL   @MOVROM           Get LOG10(E)  
       75D2 7A70  
  3114 75D4 0018         DATA LOG10E               into ARG   
  3115            *   
  3116 75D6 06A0         BL   @FMULT            X : = FAC * LOG10(E)  
       75D8 0E88  
  3117 75DA 06A0         BL   @PUSH             Save X  
       75DC 7AF2  
  3118 75DE 06A0         BL   @GRINT            Compute N : = INT(X)  
       75E0 79EC  
  3119 75E2 06A0         BL   @MOVROM           Get floating 127  
       75E4 7A70  
  3120 75E6 0000         DATA EXC127              into ARG  
  3121            *   
  3122 75E8 06A0         BL   @FCOMPB           Is N > 127?   
       75EA 6126  
  3123 75EC 1313         JEQ  EXP03             If = 127  
  3124 75EE 1106         JLT  EXP01             If > 127  
  3125 75F0 0520         NEG  @ARG              Check negative range  
       75F2 835C  
  3126 75F4 06A0         BL   @FCOMPB           Is N < -127?  
       75F6 6126  
  3127 75F8 110D         JLT  EXP03             N > -127  
  3128 75FA 130C         JEQ  EXP03             N = -127  
  3129            * N is out of range   
  3130 75FC 6820  EXP01  S    @C8,@VSPTR        Pop X off stack   
       75FE 7AF4  
       7600 836E  
  3131 7602 C820         MOV  @FAC,@EXP         Recall exponent sign  
       7604 834A  
       7606 8376  
  3132 7608 D820         MOVB @C8,@SIGN         Result is positive  
       760A 7AF4  
       760C 8375  
  3133 760E 06A0         BL   @OVEXP            Take over or underflow action 
       7610 0FC2  
  3134 7612 1055         JMP  BROLIN            Restore CPU RAM and return  
  3135 7614 06A0  EXP03  BL   @PUSH             Save value on stack   
       7616 7AF2  
  3136 7618 06A0         BL   @CFI              Convert to integer exponent   
       761A 12B8  
  3137 761C C320         MOV  @FAC,R12          Get it in REG to mpy by 2   
       761E 834A  
  3138 7620 0A1C         SLA  R12,1             Compute 2*N   
  3139 7622 06A0         BL   @POP              Restore value   
       7624 7B16  
  3140 7626 06A0         BL   @SSUB             Compute R = X - N   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0070
       7628 0D74  
  3141 762A 06A0         BL   @MOVROM           Get a floating .5   
       762C 7A70  
  3142 762E 0008         DATA FHALF              into ARG   
  3143            *   
  3144 7630 06A0         BL   @FCOMPB           Is .5 > R?  
       7632 6126  
  3145 7634 1505         JGT  EXP04             Yes, S=R  
  3146 7636 0520         NEG  @ARG              -.5   
       7638 835C  
  3147 763A 06A0         BL   @FADD             Compute S : = R - .5  
       763C 0D80  
  3148 763E 058C         INC  R12               Remember R >= .5, (2*N+1)   
  3149            *                              save a copy of S   
  3150 7640 06A0  EXP04  BL   @PUSH             Save a copy of S  
       7642 7AF2  
  3151 7644 06A0         BL   @POLYW            Compute S * P(S^2)  
       7646 7782  
  3152 7648 007C         DATA EXPP              Poly to evaluate  
  3153            *   
  3154 764A 06A0         BL   @XTFACZ           FAC = S, stack = S * P(S^2)   
       764C 7B34  
  3155 764E 06A0         BL   @POLYX            Compute Q(S^2)  
       7650 77A6  
  3156 7652 0096         DATA EXPQ              Poly to evaluate  
  3157            *   
  3158 7654 06A0         BL   @POPSTK           S * P(S^2) -> ARG   
       7656 60D4  
  3159 7658 A820         A    @C8,@VSPTR  
       765A 7AF4  
       765C 836E  
  3160 765E 06A0         BL   @PUSH             Save comp of Q(S^2)   
       7660 7AF2  
  3161 7662 06A0         BL   @FADD             Q(S^2) + S * P(S^2)   
       7664 0D80  
  3162 7666 0203         LI   R3,FAC            Save FAC in a temp  
       7668 834A  
  3163 766A 0204         LI   R4,CZ   
       766C 831A  
  3164 766E CD33         MOV  *R3+,*R4+         1st two bytes   
  3165 7670 CD33         MOV  *R3+,*R4+         2nd two bytes   
  3166 7672 CD33         MOV  *R3+,*R4+         3rd two bytes   
  3167 7674 C513         MOV  *R3,*R4           Last two bytes  
  3168 7676 06A0         BL   @POP              FAC = Q(S^S), stack = S*P(S^2)
       7678 7B16  
  3169 767A 06A0         BL   @XTFACZ           Revese same   
       767C 7B34  
  3170 767E 06A0         BL   @SSUB             Compte Q(S^2)-S*P*(S^2)   
       7680 0D74  
  3171 7682 0203         LI   R3,CZ             Get fac back from temp  
       7684 831A  
  3172 7686 0204         LI   R4,ARG  
       7688 835C  
  3173 768A CD33         MOV  *R3+,*R4+         1st two bytes   
  3174 768C CD33         MOV  *R3+,*R4+         2nd two bytes   
  3175 768E CD33         MOV  *R3+,*R4+         3rd two bytes   
  3176 7690 C513         MOV  *R3,*R4           Last rwo bytes  
  3177 7692 06A0         BL   @FDIV             Compute Q-P/Q-P   
       7694 0FF4  

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0071
  3178 7696 081C  EXPSQT SRA  R12,1             Check flag that was set above 
  3179 7698 1705         JNC  EXPSQ5            If not set  
  3180 769A 06A0         BL   @MOVROM           Get SQR(10)   
       769C 7A70  
  3181 769E 0010         DATA SQRTEN             into ARG   
  3182            *   
  3183 76A0 06A0         BL   @FMULT            Multipy by SQU(10) if N odd   
       76A2 0E88  
  3184 76A4 06A0  EXPSQ5 BL   @MOVROM           Need a floating 1   
       76A6 7A70  
  3185 76A8 006A         DATA FPOS1              into ARG   
  3186            *   
  3187 76AA 081C         SRA  R12,1             Check odd power of ten  
  3188 76AC 1703         JNC  EXPSQ8            If not odd power  
  3189 76AE D820         MOVB @CBHA,@ARG1       Odd power of ten (>0A)  
       76B0 6004  
       76B2 835D  
  3190 76B4 B820  EXPSQ8 AB   @R12LB,@ARG       Add in power of 100 to Exp  
       76B6 83F9  
       76B8 835C  
  3191 76BA 06A0         BL   @FMULT  
       76BC 0E88  
  3192 76BE 0460  BROLIN B    @ROLIN  
       76C0 7AC4  
  3193            ************************************************************
  3194            * LOGARITHM FUNCTION  
  3195            * FAC       : = LOG(FAC)  
  3196            * ERRORS    : ERRLOG     LOG of negative number or zero   
  3197            *                         attempted.  
  3198            * STACK LEVELS USED:  
  3199            *    IF FAC <= 0 THEN ERRLOG  
  3200            *    LOG(FAC)=LN(FAC)=LOG10(FAC)*LN(10)   
  3201            *    FAC      : = A * 10^N,     .1 <= A < 1   
  3202            *    S        : = A * SQR(10),  1/SQR(10) <= S < SQR(10)  
  3203            *    LOG10(A) : = LOG10(S/SQR(10))  
  3204            *             : = LOG10(S) - LOG10(SQR(10))   
  3205            *             : = LOG10(S) - .5   
  3206            *    LOG      : = (N - .5 + LOG10(S)) * LN(10)  
  3207            *             : = (N - .5 * LN(10) + LN(S)  
  3208            * A rational function approximation is used for LN(S)   
  3209            * (HART LOGE 2687)  
  3210            ************************************************************
  3211 76C2 C28B  LOGZZ  MOV  R11,R10   
  3212 76C4 06A0         BL   @ROLOUT           Get workspace and save return 
       76C6 7A90  
  3213 76C8 C020         MOV  @FAC,R0           Check for negative or zero  
       76CA 834A  
  3214 76CC 1504         JGT  LOGZZ3            If positive   
  3215 76CE D820         MOVB @ERRLOG,@FAC10    Load error code   
       76D0 76D6  
       76D2 8354  
  3216 76D4 10F4         JMP  BROLIN            Restore CPU and return  
  3217      76D6  ERRLOG EQU  $   
  3218 76D6 06A0  LOGZZ3 BL   @TENCNS           Get base 10 exponent  
       76D8 7B64  
  3219 76DA 160B         JNE  LOGZZ5  
  3220 76DC 06A0         BL   @MOVROM           Get a floating 1  
       76DE 7A70  
  3221 76E0 006A         DATA FPOS1              into ARG   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0072
  3222            *                         Make it a floating 10   
  3223 76E2 D820         MOVB @CBHA,@ARG1        by putting in >0A  
       76E4 6004  
       76E6 835D  
  3224 76E8 06A0         BL   @FMULT            Multipy FAC by 10   
       76EA 0E88  
  3225 76EC 06A0         BL   @TENCNS           Get new exponent of 10  
       76EE 7B64  
  3226 76F0 1002         JMP  LOGZ5A            Compensate for Mult   
  3227 76F2 05A0  LOGZZ5 INC  @EXP              Compenstat for where radix  
       76F4 8376  
  3228            *                              point is   
  3229 76F6 D820  LOGZ5A MOVB @CBH3F,@FAC       Put A in proper range   
       76F8 7490  
       76FA 834A  
  3230            *                              by putting in >3F  
  3231 76FC C320         MOV  @EXP,R12  
       76FE 8376  
  3232 7700 06A0         BL   @MOVROM           Get SQR(10)   
       7702 7A70  
  3233 7704 0010         DATA SQRTEN             into ARG   
  3234            *   
  3235 7706 06A0         BL   @FMULT            S : = A * SQR(10)   
       7708 0E88  
  3236 770A 06A0         BL   @FORMA            Z : = (S-1) / (S+1)   
       770C 77FC  
  3237 770E 06A0         BL   @PUSH             Push Z  
       7710 7AF2  
  3238 7712 06A0         BL   @POLYW            Compute Z * P(Z^2)  
       7714 7782  
  3239 7716 00B8         DATA LOGP  
  3240            *   
  3241 7718 06A0         BL   @XTFACZ   
       771A 7B34  
  3242 771C 06A0         BL   @POLYX            Compute Q(Z^2)  
       771E 77A6  
  3243 7720 00E2         DATA LOGQ              Poly to evaluate  
  3244            *   
  3245 7722 06A0         BL   @SDIV             Compute Z*P(Z^2)/Q(Z^2)   
       7724 0FF8  
  3246 7726 06A0         BL   @PUSH             Push it   
       7728 7AF2  
  3247 772A 0200         LI   R0,ARG            Build entry in ARG  
       772C 835C  
  3248 772E CC0C         MOV  R12,*R0+          Put in exponent   
  3249 7730 04F0         CLR  *R0+               and  
  3250 7732 04F0         CLR  *R0+                clear the   
  3251 7734 04D0         CLR  *R0                        rest   
  3252            * STATUS WAS SET BY THE MOVE ABOVE  
  3253 7736 130E         JEQ  LOGZZ7            If zero exponent  
  3254 7738 0760         ABS  @ARG              Work with ABS value   
       773A 835C  
  3255 773C C020         MOV  @ARG,R0             in register   
       773E 835C  
  3256 7740 0280         CI   R0,99             Too large?  
       7742 0063  
  3257 7744 1514         JGT  LOGZZ9            Yes   
  3258 7746 D820         MOVB @FLTONE,@ARG      Exponent = >40  
       7748 600E  

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0073
       774A 835C  
  3259 774C D30C  LOGZZ6 MOVB R12,R12           Exponent positive?  
  3260 774E 1302         JEQ  LOGZZ7            Yes   
  3261 7750 0520         NEG  @ARG              No, make it negative  
       7752 835C  
  3262 7754 06A0  LOGZZ7 BL   @MOVRM5           Need a floating .5  
       7756 7A6A  
  3263 7758 0008         DATA FHALF              in FAC   
  3264            *   
  3265 775A 06A0         BL   @FSUB             Compute N - .5  
       775C 0D7C  
  3266 775E 06A0         BL   @MOVROM           Need LN(10)   
       7760 7A70  
  3267 7762 0020         DATA LN10               into ARG   
  3268            *   
  3269 7764 06A0         BL   @FMULT            Compute (N - .5) * LN(10)   
       7766 0E88  
  3270 7768 06A0         BL   @SADD             Add to LN(S)  
       776A 0D84  
  3271 776C 10A8         JMP  BROLIN            Restore CPU and return  
  3272 776E 6820  LOGZZ9 S    @C100,@ARG        Subtract first 100  
       7770 6008  
       7772 835C  
  3273 7774 D820         MOVB @ARG1,@ARG2   
       7776 835D  
       7778 835E  
  3274 777A C820         MOV  @CBH411,@ARG      Load exponent and   
       777C 748E  
       777E 835C  
  3275            *                              leading digit of >4101   
  3276 7780 10E5         JMP  LOGZZ6  
  3277            ************************************************************
  3278            * EVALUATE X * P(X^^2)  
  3279            * ON CALL  : PZ          Pointer to polynomial coefficients 
  3280            *          : FAC         Contains X   
  3281            *      BL    @POLYW   
  3282            *          : FAC         Returns  X * P(X^^2)   
  3283            ************************************************************
  3284 7782 C83B  POLYW  MOV  *R11+,@PZ         Get the poly to evaluate  
       7784 8312  
  3285 7786 C28B         MOV  R11,R10   
  3286 7788 06A0         BL   @SAVRTN           Save return address   
       778A 7AB2  
  3287 778C 06A0         BL   @PUSH             Push the argument   
       778E 7AF2  
  3288 7790 06A0         BL   @POLYX1           Compute P(X^^2)   
       7792 77AA  
  3289 7794 06A0         BL   @SMULT            Compute X*P(X^^2)   
       7796 0E8C  
  3290 7798 104E         JMP  PWRTN2            And return  
  3291 779A C83B  POLY   MOV  *R11+,@PZ   
       779C 8312  
  3292 779E C28B         MOV  R11,R10   
  3293 77A0 06A0         BL   @SAVRTN           Save return address   
       77A2 7AB2  
  3294 77A4 1009         JMP  POLY01            And merge in below  
  3295 77A6 C83B  POLYX  MOV  *R11+,@PZ   
       77A8 8312  
  3296 77AA C28B  POLYX1 MOV  R11,R10   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0074
  3297 77AC 06A0         BL   @SAVRTN           Save return address   
       77AE 7AB2  
  3298 77B0 06A0         BL   @PUSH             Need to copy FAC  
       77B2 7AF2  
  3299            *                              into ARG to square it  
  3300 77B4 06A0         BL   @SMULT            Square X (SMULT pops into ARG)
       77B6 0E8C  
  3301 77B8 06A0  POLY01 BL   @PUSH             Push the argument   
       77BA 7AF2  
  3302 77BC C0E0         MOV  @PZ,R3            Get the poly to evaluate  
       77BE 8312  
  3303 77C0 0200         LI   R0,FAC             into FAC   
       77C2 834A  
  3304 77C4 06A0         BL   @MOVRM2   
       77C6 7A76  
  3305 77C8 100F         JMP  POLY03  
  3306 77CA 06A0  POLY02 BL   @POPSTK           Get X back  
       77CC 60D4  
  3307 77CE A820         A    @C8,@VSPTR        Keep it on stack  
       77D0 7AF4  
       77D2 836E  
  3308 77D4 06A0         BL   @FMULT            Multiply previous result by X 
       77D6 0E88  
  3309 77D8 C0E0         MOV  @PZ,R3  
       77DA 8312  
  3310 77DC 0200         LI   R0,ARG            Get polynomial to evaluate  
       77DE 835C  
  3311 77E0 06A0         BL   @MOVRM2            into ARG   
       77E2 7A76  
  3312 77E4 06A0         BL   @FADD             Add in this coefficient   
       77E6 0D80  
  3313 77E8 A820  POLY03 A    @C8,@PZ           Point to next coefficient   
       77EA 7AF4  
       77EC 8312  
  3314            *                              and get first two bytes  
  3315            *                               into ARG  
  3316 77EE 981D         CB   *R13,@CBH80       Read first byte   
       77F0 78FD  
  3317            *                              and test it to see if done   
  3318 77F2 16EB         JNE  POLY02            No, continue computing poly   
  3319 77F4 6820         S    @C8,@VSPTR        Pop X off stack   
       77F6 7AF4  
       77F8 836E  
  3320 77FA 101D         JMP  PWRTN2            Return with poly in FAC   
  3321            *   
  3322 77FC C28B  FORMA  MOV  R11,R10   
  3323 77FE 06A0         BL   @SAVRTN           Save return address   
       7800 7AB2  
  3324 7802 06A0         BL   @PUSH             Save X on stack   
       7804 7AF2  
  3325 7806 06A0         BL   @FORMA2   
       7808 7822  
  3326 780A 06A0         BL   @FORMA2   
       780C 7822  
  3327 780E 06A0         BL   @XTFACZ           Swap (X-1) and X  
       7810 7B34  
  3328 7812 06A0         BL   @MOVROM           Get a floating 1  
       7814 7A70  
  3329 7816 006A         DATA FPOS1              into ARG   

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0075
  3330            *   
  3331 7818 06A0         BL   @FADD             X+1   
       781A 0D80  
  3332 781C 06A0         BL   @SDIV             (X-1)/(X+1)   
       781E 0FF8  
  3333 7820 100A         JMP  PWRTN2            And return  
  3334 7822 C28B  FORMA2 MOV  R11,R10   
  3335 7824 06A0         BL   @SAVRTN           Save return address   
       7826 7AB2  
  3336 7828 06A0         BL   @MOVROM           Get a floating .5   
       782A 7A70  
  3337 782C 0008         DATA FHALF              int ARG  
  3338            *   
  3339 782E 0520         NEG  @ARG  
       7830 835C  
  3340 7832 06A0         BL   @FADD             X - .5  
       7834 0D80  
  3341 7836 0460  PWRTN2 B    @ROLIN2   
       7838 7AE0  
  3342            ************************************************************
  3343            * SQUARE ROOT FUNCTION  
  3344            * Reference for scientific function approximations.   
  3345            * JOHN F. HART ET AL, Comper approximations,  
  3346            *  JOHN WILEY & SONS, 1968  
  3347            * FAC    : = SQR(FAC)   
  3348            * ERRORS :   ERRSQR      Square root of negative number   
  3349            *                         attempted   
  3350            * STACK LEVELS USED:  
  3351            *     IF FAC = 0 THEN SQR : = 0   
  3352            *     IF FAC < 0 THEN ERRSQR  
  3353            *     FAC : = A * 100^N,        .01 <= A < 1  
  3354            *     SQR : = 10^N * SQR(A)   
  3355            * Newton's method with a fixed number of iterations is used 
  3356            * to approximate SQR(A):  
  3357            * A rational function approximation is used for Y(0)  
  3358            *      (HART SQRT 0231)   
  3359            * Y(N+1) = (Y(n))/2   
  3360            ************************************************************
  3361 783A C28B  SQRZZ  MOV  R11,R10   
  3362 783C 06A0         BL   @ROLOUT           Get workspace and save return 
       783E 7A90  
  3363 7840 C320         MOV  @FAC,R12          Check exponent  
       7842 834A  
  3364 7844 1334         JEQ  SQR03             FAC is zero, return zero  
  3365 7846 1130         JLT  SQR02             FAC is < 0, error   
  3366 7848 D820         MOVB @CBH3F,@FAC       Create A in range .01 <= A <1 
       784A 7490  
       784C 834A  
  3367            *                              by loading >3F   
  3368 784E 022C         AI   R12,>C100         Remove bias (-63)   
       7850 C100  
  3369 7852 088C         SRA  R12,8             Sign extend   
  3370 7854 0A1C         SLA  R12,1             Save 2 * N  
  3371 7856 06A0         BL   @PUSH             Save A  
       7858 7AF2  
  3372 785A 06A0         BL   @PUSH             Save A again  
       785C 7AF2  
  3373 785E 06A0         BL   @POLY             Compute P(A)  
       7860 779A  

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0076
  3374 7862 0050         DATA SQRP              Poly to evaluate  
  3375            *   
  3376 7864 06A0         BL   @XTFACZ           Stack : = P(A), FAC : = A   
       7866 7B34  
  3377 7868 06A0         BL   @POLY             Compute Q(A)  
       786A 779A  
  3378 786C 006A         DATA SQRQ              Poly to evaluate  
  3379            *   
  3380 786E 06A0         BL   @SDIV             Compute P(A)/Q(A)   
       7870 0FF8  
  3381 7872 C820         MOV  @CC3,@PZ          Save in permanent   
       7874 7908  
       7876 8312  
  3382 7878 06A0  SQR01  BL   @POPSTK           Pop into ARG  
       787A 60D4  
  3383 787C A820         A    @C8,@VSPTR        But keep it on stack  
       787E 7AF4  
       7880 836E  
  3384 7882 06A0         BL   @PUSH             Push Y(N)   
       7884 7AF2  
  3385 7886 06A0         BL   @FDIV             Compute A/Y(N)  
       7888 0FF4  
  3386 788A 06A0         BL   @SADD             Compute A/Y(N) + Y(N)   
       788C 0D84  
  3387 788E 06A0         BL   @MOVROM           Nead a floating .5  
       7890 7A70  
  3388 7892 0008         DATA FHALF              into ARG   
  3389            *   
  3390 7894 06A0         BL   @FMULT            Compute .5 * (A/Y(N) + Y(N))  
       7896 0E88  
  3391 7898 0620         DEC  @PZ               Decrement loop counter  
       789A 8312  
  3392 789C 16ED         JNE  SQR01             Loop three times  
  3393 789E 6820         S    @C8,@VSPTR        Pop off stack   
       78A0 7AF4  
       78A2 836E  
  3394 78A4 0460         B    @EXPSQT           To finish up  
       78A6 7696  
  3395 78A8 D820  SQR02  MOVB @ERRSQR,@FAC10    Load error code for return  
       78AA 78AE  
       78AC 8354  
  3396      78AE  ERRSQR EQU  $   
  3397 78AE 0460  SQR03  B    @ROLIN            Restore CPU RAM and return  
       78B0 7AC4  
  3398            ************************************************************
  3399            * COSINE FUNCTION   
  3400            * FAC         : = COS(FAC)  
  3401            * COS(FAC)    : = SIN(FAC + PI/2)   
  3402            ************************************************************
  3403 78B2 C30B  COSZZ  MOV  R11,R12   
  3404 78B4 06A0         BL   @MOVROM           Need to get PI/2  
       78B6 7A70  
  3405 78B8 0028         DATA PI2                into ARG   
  3406            *   
  3407 78BA 06A0         BL   @FADD             Compute FAC + PI/2  
       78BC 0D80  
  3408 78BE C2CC         MOV  R12,R11           And fall into SIN code  
  3409            ************************************************************
  3410                

 99/4 ASSEMBLER
TRINSICS                                                     PAGE 0077
  3411                
  3413                
  3414            ************************************************************
  3415            * SINE FUNCTION   
  3416            * FAC          : = SIN(FAC)   
  3417            * STACK LEVELS USED:  
  3418            *     IF FAC < 0 THEN SIN(FAC) : = -SIN(-FAC)   
  3419            *     X       : = 2/PI*FAC  
  3420            *     K       : = INT(X)  
  3421            *     R       : = X-K, 0 <= R < 1   
  3422            *     Q       : = K MOD 4   
  3423            *  SO K       : = 4*N+Q   
  3424            *    FAC      : = PI/2 * K + PI/2 * R   
  3425            *             : = 2*PI*N + PI/2*Q + PI/2*R  
  3426            *    SIN(FAC) : = SIN(P/2*Q+PI/2*R)   
  3427            * QUADRANT  Q     Identity  
  3428            * I         0     SIN(FAC)    : = SIN(PI/2*R)   
  3429            * II        1     SIN(FAC)    : = SIN(PI/2+PI/2*R   
  3430            *                             : = SIN(PI-*(PI/2+PI/2R))   
  3431            *                             : = SIN(PI/2*(1-R))   
  3432            * III       2     SIN(FAC)    : = SIN(PI+PI/2*R)  
  3433            *                             : = SIN(PI-(PI+PI/2*R))   
  3434            *                             : = SIN(PI/2 * (R-1))   
  3435            * IV        3     SIN(FAC)    : = SIN(3*PI/2 + PI/2*R   
  3436            *                             : = SIN(3*PI/2 + PI/2*R-2*PI) 
  3437            *                             : = SIN(PI/2 * (R-1))   
  3438            * QUADRANT  Q  ARGUMENT TO APPROXIMATION POLYNOMIAL   
  3439            * I         0    R      = R         0 <= R   <  1   
  3440            * II        1  1-R      = 1-R       0 <  1-R <= 1   
  3441            * III       2   -R      = -R       -1 <  -R  <= 0   
  3442            * IV        3    R-1    = -(1-R)   -1 <= R-1 <  0   
  3443            *   
  3444            * A polynomial approximation is used for SIN(P/2*R)   
  3445            *                      -1 <= R < 1  
  3446            * (HART SIN 3344)   
  3447            ************************************************************
  3448 78C0 C28B  SINZZ  MOV  R11,R10   
  3449 78C2 06A0         BL   @ROLOUT           Get workspace and save return 
       78C4 7A90  
  3450 78C6 06A0         BL   @MOVROM           Get 2/PI  
       78C8 7A70  
  3451 78CA 0030         DATA RPI2               into ARG   
  3452            *   
  3453 78CC 06A0         BL   @FMULT            X : = 2/PI*FAC  
       78CE 0E88  
  3454 78D0 D320         MOVB @FAC,R12          Save sign   
       78D2 834A  
  3455 78D4 0760         ABS  @FAC              Consider positive numbers   
       78D6 834A  
  3456 78D8 9820         CB   @FAC,@CBH44       Check exponent range  
       78DA 834A  
       78DC 7491  
  3457            *                              by checking with >44   
  3458 78DE 152C         JGT  TRIERR            ERR in range of exponent  
  3459 78E0 06A0         BL   @PUSH             Save X  
       78E2 7AF2  
  3460 78E4 06A0         BL   @GRINT            K : = INT(K)  
       78E6 79EC  
  3461 78E8 04C1         CLR  R1                Assume Q is zero  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0078
  3462 78EA 04C0         CLR  R0  
  3463 78EC D020         MOVB @FAC,R0           Is FAC zero?  
       78EE 834A  
  3464 78F0 130C         JEQ  SIN02             Yes, Q is zero  
  3465 78F2 0220         AI   R0,>BA00          Bias exponent (->46 byte)   
       78F4 BA00  
  3466            *                              is K too big for (K MOD 4)   
  3467            *                              to have a significance?  
  3468 78F6 1507         JGT  SIN01             Yes, defualt Q to zero  
  3469 78F8 0220         AI   R0,>51*256        (FAC+7-PAD0)*256  
       78FA 5100  
  3470      78FD  CBH80  EQU  $+1               CONSTANT >80  
  3471 78FC 0980         SRL  R0,8  
  3472 78FE 0220         AI   R0,PAD0   
       7900 8300  
  3473 7902 D810         MOVB *R0,@R1LB         No, get 10's and 1's place of 
       7904 83E3  
  3474      7908  CC3    EQU  $+2   
  3475 7906 0241  SIN01  ANDI R1,3              Q : = (K MOD 4)   
       7908 0003  
  3476 790A C801  SIN02  MOV  R1,@QZ  
       790C 8316  
  3477 790E 06A0         BL   @SSUB             R : = X-K   
       7910 0D74  
  3478 7912 C060         MOV  @QZ,R1  
       7914 8316  
  3479 7916 0911         SRL  R1,1              Is Q even?  
  3480 7918 C801         MOV  R1,@QZ  
       791A 8316  
  3481 791C 1705         JNC  SIN03             Yes   
  3482 791E 06A0         BL   @MOVROM           Get a floating 1  
       7920 7A70  
  3483 7922 006A         DATA FPOS1              into ARG   
  3484            *   
  3485 7924 06A0         BL   @FSUB             Compute 1-R   
       7926 0D7C  
  3486 7928 C060  SIN03  MOV  @QZ,R1            Quadrant III or IV?   
       792A 8316  
  3487 792C 1301         JEQ  SIN04             No  
  3488 792E 054C         INV  R12               Yes, change sign or result  
  3489 7930 06A0  SIN04  BL   @POLYW            Evaluate it   
       7932 7782  
  3490 7934 010C         DATA SINP               get poly P's coefficients  
  3491            *   
  3492 7936 1054         JMP  ATNSGN              and set sign  
  3493 7938 D820  TRIERR MOVB @CCBH7,@FAC10     TRIG error (>7 in FAC10)  
       793A 74D4  
       793C 8354  
  3494 793E 1054         JMP  ATNSG3  
  3495            ************************************************************
  3496            * TANGENT FUCTION   
  3497            * FAC            : = TAN(FAC)   
  3498            * TAN(FAC)       : = SIN(FAC)/COS(FAC)  
  3499            ************************************************************
  3500 7940 C28B  TANZZ  MOV  R11,R10   
  3501 7942 06A0         BL   @SAVRTN           Save return address   
       7944 7AB2  
  3502 7946 06A0         BL   @PUSH             Save FAC on stack   
       7948 7AF2  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0079
  3503 794A 06A0         BL   @SINZZ            Compute SIN   
       794C 78C0  
  3504 794E 06A0         BL   @XTFACZ   
       7950 7B34  
  3505 7952 06A0         BL   @COSZZ            Compute COS   
       7954 78B2  
  3506 7956 06A0         BL   @POPSTK           Pop stack into ARG  
       7958 60D4  
  3507 795A 9820         CB   @FAC10,@CCBH7     Check for error   
       795C 8354  
       795E 74D4  
  3508 7960 1305         JEQ  PWRTN3            If error  
  3509 7962 C020         MOV  @FAC,R0           Is COS = zero?  
       7964 834A  
  3510 7966 1304         JEQ  TAN01             Yes   
  3511 7968 06A0         BL   @FDIV             No, TAN : = SIN(ARG)/COS(ARG) 
       796A 0FF4  
  3512 796C 0460  PWRTN3 B    @ROLIN2   
       796E 7AE0  
  3513 7970 D820  TAN01  MOVB @ARG,@SIGN  
       7972 835C  
       7974 8375  
  3514 7976 06A0         BL   @OVEXP            Issue overflow message  
       7978 0FC2  
  3515 797A 10F8         JMP  PWRTN3            Clean up and exit   
  3516            ************************************************************
  3517            * INVERSE TANGENT FUCTION   
  3518            * FAC            : = ATN(FAC)   
  3519            * STACK LEVELS USED:  
  3520            *     IF FAC <  0 THEN ARCTAN(FAC) = -ARCTAN(-FAC)  
  3521            *     IF 0   <= FAC <= TAN(PI/8)  
  3522            *                 THEN T = FAC, ARCTAN(FAC) : = ARCTAN(T)   
  3523            *     IF TAN(PI/8) < FAC < TAN(3*PI/8)  
  3524            *                 THEN T = (FAC-1) / (FAC+1),   
  3525            *                      ARCTAN(FAC) : = PI/4 + ARCTAN(T)   
  3526            *     IF TAN(3*PI/8) <= FAC   
  3527            *                 THEN T = -1/FAC,  
  3528            *                      ARCTAN(FAC) : = PI/2 + ARCTAN(T)   
  3529            *   
  3530            * A polynomial approximation is used for ARCTAN(T),   
  3531            *              -TAN(PI/8) <= T <= TAN(PI/8)   
  3532            * (HART ARCTN 4967)   
  3533            ************************************************************
  3534 797C C28B  ATNZZ  MOV  R11,R10   
  3535 797E 06A0         BL   @ROLOUT           Get workspace and save return 
       7980 7A90  
  3536 7982 D320         MOVB @FAC,R12          Save sign   
       7984 834A  
  3537 7986 0760         ABS  @FAC              Use ABS(FAC)  
       7988 834A  
  3538 798A 04E0         CLR  @QZ               Assume ARG is in range  
       798C 8316  
  3539 798E 06A0         BL   @MOVROM           Need TAN(PI/8)  
       7990 7A70  
  3540 7992 0040         DATA TANPI8             into ARG   
  3541            *   
  3542 7994 06A0         BL   @FCOMPB           Is TAN(3*PI/8) >= ARG?  
       7996 6126  
  3543 7998 1317         JEQ  ATN02             If =  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0080
  3544 799A 1516         JGT  ATN02             If >  
  3545 799C 06A0         BL   @MOVROM           Need TAN(3*PI/8)  
       799E 7A70  
  3546 79A0 0048         DATA TAN3P8             into ARG   
  3547            *   
  3548 79A2 06A0         BL   @FCOMPB           Is TAN(3*PI/8) > ARG?   
       79A4 6126  
  3549 79A6 150A         JGT  ATN01             Yes, use case 2   
  3550 79A8 06A0         BL   @MOVROM           Get a floating 1  
       79AA 7A70  
  3551 79AC 006A         DATA FPOS1              into ARG   
  3552            *   
  3553 79AE 0520         NEG  @ARG              Use case 3 to compute   
       79B0 835C  
  3554 79B2 06A0         BL   @FDIV             T = -1/ARG  
       79B4 0FF4  
  3555 79B6 0203         LI   R3,PI2            Get PI/2  
       79B8 0028  
  3556 79BA 1004         JMP  ATN02A            Add it in at the end  
  3557 79BC 06A0  ATN01  BL   @FORMA            Case 2 : T : = (ARG-1)/(ARG+1)
       79BE 77FC  
  3558 79C0 0203         LI   R3,PI4            Get PI/4  
       79C2 0038  
  3559 79C4 C803  ATN02A MOV  R3,@QZ            Set up to evaluate  
       79C6 8316  
  3560 79C8 06A0  ATN02  BL   @POLYW            ATN(T) : = T * P(T^^2)  
       79CA 7782  
  3561 79CC 014E         DATA ATNP              Poly to evlauate  
  3562            *   
  3563 79CE C0E0         MOV  @QZ,R3            Case 1?   
       79D0 8316  
  3564 79D2 1306         JEQ  ATNSGN            Yes, don't add anything in  
  3565 79D4 0200         LI   R0,ARG  
       79D6 835C  
  3566 79D8 06A0         BL   @MOVRM2   
       79DA 7A76  
  3567 79DC 06A0         BL   @FADD             Add in the constant   
       79DE 0D80  
  3568 79E0 054C  ATNSGN INV  R12               Check sign of result  
  3569 79E2 1102         JLT  ATNSG3            If sign is already on   
  3570 79E4 0520         NEG  @FAC               else negate it   
       79E6 834A  
  3571 79E8 0460  ATNSG3 B    @ROLIN            And return  
       79EA 7AC4  
  3572            ************************************************************
  3573            * GREATEST INTEGER FUNCTION   
  3574            ************************************************************
  3575 79EC C1CB  GRINT  MOV  R11,R7            Save return address   
  3576 79EE D820         MOVB @FAC,@SIGN        Save result sign  
       79F0 834A  
       79F2 8375  
  3577 79F4 0760         ABS  @FAC              Absolute value  
       79F6 834A  
  3578 79F8 D160         MOVB @FAC,R5           Get exponent  
       79FA 834A  
  3579 79FC 0985         SRL  R5,8              Make it into word   
  3580 79FE C805         MOV  R5,@EXP           For rounding  
       7A00 8376  
  3581 7A02 0285         CI   R5,>40            Exponent < 0?   

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0081
       7A04 0040  
  3582 7A06 1124         JLT  BITINT            Yes, handle it  
  3583 7A08 0285         CI   R5,>45            Exponent > 10^5 ?   
       7A0A 0045  
  3584 7A0C 1519         JGT  INT02             Yes, handle it  
  3585 7A0E 0225         AI   R5,->46           Locate position   
       7A10 FFBA  
  3586 7A12 D820         MOVB @R5LB,@FAC10      Save for rounding   
       7A14 83EB  
       7A16 8354  
  3587 7A18 04C2         CLR  R2  
  3588 7A1A 0203         LI   R3,FAC8   
       7A1C 8352  
  3589 7A1E A0C5         A    R5,R3             Point to 1st fractional digit 
  3590 7A20 F093  INT01  SOCB *R3,R2            Remember if non-zero  
  3591 7A22 DCE0         MOVB @R2LB,*R3+        Clear the digit   
       7A24 83E5  
  3592 7A26 0585         INC  R5  
  3593 7A28 16FB         JNE  INT01   
  3594 7A2A D020         MOVB @SIGN,R0          Get the sign  
       7A2C 8375  
  3595 7A2E 150D         JGT  INT03             If non-negative(i.e. Positive)
  3596 7A30 D082         MOVB R2,R2   
  3597 7A32 1306         JEQ  INT02   
  3598 7A34 B820         AB   @CCBH7,@FAC10     Where to round up   
       7A36 74D4  
       7A38 8354  
  3599 7A3A 06A0         BL   @ROUNU            Do the rounding   
       7A3C 0FB2  
  3600 7A3E 1005         JMP  INT03   
  3601 7A40 D020  INT02  MOVB @SIGN,R0          Check the sign  
       7A42 8375  
  3602 7A44 1502         JGT  INT03             If positive don't negate  
  3603 7A46 0520         NEG  @FAC              Make result negative  
       7A48 834A  
  3604 7A4A 04E0  INT03  CLR  @FAC10            Indicate no error   
       7A4C 8354  
  3605 7A4E 0457         B    *R7          <<<< Return from here  
  3606 7A50 0200  BITINT LI   R0,FAC            Zero or -1  
       7A52 834A  
  3607 7A54 0201         LI   R1,>BFFF          Default to -1   
       7A56 BFFF  
  3608 7A58 D0A0         MOVB @SIGN,R2          Negative or Positive?   
       7A5A 8375  
  3609 7A5C 1101         JLT  INT04             If really negative put in -1  
  3610 7A5E 04C1         CLR  R1                If Positive put in a 0  
  3611 7A60 CC01  INT04  MOV  R1,*R0+           Copy in 0 or -1   
  3612 7A62 04F0         CLR  *R0+               and  
  3613 7A64 04F0         CLR  *R0+                clear   
  3614 7A66 04D0         CLR  *R0                  the  
  3615 7A68 10F0         JMP  INT03                 rest  
  3616            * MOVE 8 BYTES FROM ROM(R3) TO CPU AT R0  
  3617 7A6A 0200  MOVRM5 LI   R0,FAC            Move to FAC   
       7A6C 834A  
  3618 7A6E 1002         JMP  MOVRM1            Merge into common code  
  3619 7A70 0200  MOVROM LI   R0,ARG            Move to ARG   
       7A72 835C  
  3620 7A74 C0FB  MOVRM1 MOV  *R11+,R3          Constant to load  
  3621 7A76 0202  MOVRM2 LI   R2,8              Constants are 8 bytes long  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0082
       7A78 0008  
  3622 7A7A A0E0         A    @INTRIN,R3        Add in GROM offset  
       7A7C 8338  
  3623 7A7E DB43         MOVB R3,@GRMWAX(R13)    Write MSB of address   
       7A80 0402  
  3624 7A82 06C3         SWPB R3                Bare the LSB  
  3625 7A84 DB43         MOVB R3,@GRMWAX(R13)    Write the LSB  
       7A86 0402  
  3626 7A88 DC1D  MOVRM4 MOVB *R13,*R0+         Read a byte   
  3627 7A8A 0602         DEC  R2                Moved them all yet?   
  3628 7A8C 16FD         JNE  MOVRM4            No, copy the next one   
  3629 7A8E 045B         RT                     Yes, return   
  3630            * ROLL OUT CPU AREA FOR WORKSPACE   
  3631 7A90 0201  ROLOUT LI   R1,PROAZ          Processor roll out area   
       7A92 8310  
  3632      7A96  CVROAZ EQU  $+2   
  3633 7A94 0203         LI   R3,VROAZ          VDP roll out area   
       7A96 03C0  
  3634 7A98 D7E0         MOVB @R3LB,*R15  
       7A9A 83E7  
  3635 7A9C 0263         ORI  R3,WRVDP  
       7A9E 4000  
  3636 7AA0 D7C3         MOVB R3,*R15   
  3637 7AA2 0200         LI   R0,26   
       7AA4 001A  
  3638 7AA6 D831  ROLOT1 MOVB *R1+,@XVDPWD  
       7AA8 8C00  
  3639 7AAA 0600         DEC  R0  
  3640 7AAC 16FC         JNE  ROLOT1  
  3641 7AAE 04E0         CLR  @FAC8             And save return address   
       7AB0 8352  
  3642            * SAVE RETURN ADDRESS   
  3643 7AB2 05E0  SAVRTN INCT @STKADD   
       7AB4 8373  
  3644 7AB6 D260         MOVB @STKADD,R9  
       7AB8 8373  
  3645 7ABA 0989         SRL  R9,8  
  3646 7ABC 0229         AI   R9,PAD0   
       7ABE 8300  
  3647 7AC0 C64A         MOV  R10,*R9   
  3648 7AC2 045B         RT   
  3649            * ROLL IN CPU AREA AFTER WORK IS DONE   
  3650 7AC4 0201  ROLIN  LI   R1,PROAZ          Processor roll out area   
       7AC6 8310  
  3651 7AC8 D7E0         MOVB @CVROAZ+1,*R15    LSB of address  
       7ACA 7A97  
  3652 7ACC D7E0         MOVB @CVROAZ,*R15      MSB of address  
       7ACE 7A96  
  3653 7AD0 0200         LI   R0,26             Number of bytes rolled out  
       7AD2 001A  
  3654 7AD4 DC60  ROLIN1 MOVB @XVDPRD,*R1+  
       7AD6 8800  
  3655 7AD8 0600         DEC  R0  
  3656 7ADA 16FC         JNE  ROLIN1  
  3657 7ADC 04E0         CLR  @FAC8   
       7ADE 8352  
  3658 7AE0 D260  ROLIN2 MOVB @STKADD,R9  
       7AE2 8373  
  3659 7AE4 0989         SRL  R9,8  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0083
  3660 7AE6 0229         AI   R9,PAD0   
       7AE8 8300  
  3661 7AEA C2D9         MOV  *R9,R11   
  3662 7AEC 0660         DECT @STKADD   
       7AEE 8373  
  3663 7AF0 045B         RT   
  3664            * PUSH FAC ONTO STAK  
  3665      7AF4  C8     EQU  $+2   
  3666 7AF2 0200  PUSH   LI   R0,8              Number to push  
       7AF4 0008  
  3667 7AF6 A800         A    R0,@VSPTR         Bump stack pointer  
       7AF8 836E  
  3668 7AFA C060         MOV  @VSPTR,R1         Get stack poiter  
       7AFC 836E  
  3669 7AFE D7E0         MOVB @R1LB,*R15  
       7B00 83E3  
  3670 7B02 0261         ORI  R1,WRVDP  
       7B04 4000  
  3671 7B06 D7C1         MOVB R1,*R15   
  3672 7B08 0201         LI   R1,FAC  
       7B0A 834A  
  3673 7B0C D831  PUSH1  MOVB *R1+,@XVDPWD  
       7B0E 8C00  
  3674 7B10 0600         DEC  R0  
  3675 7B12 15FC         JGT  PUSH1   
  3676 7B14 045B         RT   
  3677            * POP VALUE OFF STACK INTO FAC  
  3678 7B16 0202  POP    LI   R2,FAC  
       7B18 834A  
  3679 7B1A D7E0         MOVB @VSPTR1,*R15      LSB of address  
       7B1C 836F  
  3680 7B1E 0200         LI   R0,8  
       7B20 0008  
  3681 7B22 D7E0         MOVB @VSPTR,*R15       MSB of address  
       7B24 836E  
  3682 7B26 6800         S    R0,@VSPTR   
       7B28 836E  
  3683 7B2A DCA0  POP1   MOVB @XVDPRD,*R2+  
       7B2C 8800  
  3684 7B2E 0600         DEC  R0  
  3685 7B30 15FC         JGT  POP1  
  3686 7B32 045B         RT   
  3687            * EXCHANGE TOP OF STACK AND FAC   
  3688 7B34 C28B  XTFACZ MOV  R11,R10           Save return address   
  3689 7B36 06A0         BL   @PUSH             Put FAC on top  
       7B38 7AF2  
  3690 7B3A 0203         LI   R3,8              Working with 8 byte entries   
       7B3C 0008  
  3691 7B3E C143         MOV  R3,R5             Need another copy for below   
  3692 7B40 6803         S    R3,@VSPTR         Point back to old top   
       7B42 836E  
  3693 7B44 06A0         BL   @POP              Put it in FAC   
       7B46 7B16  
  3694 7B48 A803         A    R3,@VSPTR         Restore pointer to old top  
       7B4A 836E  
  3695 7B4C C120         MOV  @VSPTR,R4         Place to move to  
       7B4E 836E  
  3696 7B50 A0C4         A    R4,R3             Place to move from  
  3697 7B52 06A0  XTFAC1 BL   @GETV1            Get a byte  

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0084
       7B54 1880  
  3698 7B56 06A0         BL   @PUTV1            Put a byte  
       7B58 6422  
  3699 7B5A 0583         INC  R3  
  3700 7B5C 0584         INC  R4  
  3701 7B5E 0605         DEC  R5                Done?   
  3702 7B60 16F8         JNE  XTFAC1            No  
  3703 7B62 045A         B    *R10              Yes, retrun   
  3704            * GET BASE 10 EXPONENT OF THE NUMBER IN FAC   
  3705            * EXP:      Gets the base 10 exponent   
  3706            * OEZ:      0 if exp is even and 1 if exp is odd  
  3707 7B64 04C0  TENCNS CLR  R0                Get base 100 exponent   
  3708 7B66 D020         MOVB @FAC,R0           Put in MSB  
       7B68 834A  
  3709 7B6A 0220         AI   R0,>C000          Remove bias (SUBT >64 from MSB
       7B6C C000  
  3710 7B6E 0A10         SLA  R0,1              Multiply it by 2  
  3711 7B70 0880         SRA  R0,8              Sign fill high order byte   
  3712 7B72 04C3         CLR  R3                 and put in LSB   
  3713 7B74 9820         CB   @FAC1,@CBHA       1st digit of FAC one decimal  
       7B76 834B  
       7B78 6004  
  3714            *                              digit?   
  3715 7B7A 1102         JLT  CNST10            Yes, base 10 exponent is even 
  3716 7B7C 0580         INC  R0                No, take this into account in 
  3717            *                              exponent   
  3718 7B7E 0583         INC  R3                This makes base 10 exp odd  
  3719 7B80 C800  CNST10 MOV  R0,@EXP   
       7B82 8376  
  3720 7B84 C0C3         MOV  R3,R3             Set condition for return  
  3721 7B86 045B         RT   
  3722            ************************************************************
  3723            * MISCELLANEOUS CONSTANTS:  
  3724            * CBH411  
  3725            * EXC127    BYTE >41,1,27,0,0,0,0,0          127  
  3726            * FHALF     BYTE >3F,50                      .5   
  3727            * ZER3      BYTE 0,0,0,0,0,0  
  3728            * SQRTEN    BYTE >40,3,16,22,77,66,01,69     SQR(10)  
  3729            * LOG10E    BYTE >3F,43,42,94,48,19,03,25    LOG10(E)   
  3730            * LN10      BYTE >40,2,30,25,85,09,29,94     LN(10)   
  3731            * CBH7      EQU  $+3  
  3732            * PI2       BYTE >40,1,57,7,96,32,67,95      PI/2   
  3733            * RPI2      BYTE >3F,63,66,19,77,23,67,58    2/PI   
  3734            * PI4       BYTE >3F,78,53,98,16,33,97,45    PI/4   
  3735            * CBHA      EQU  $+7  
  3736            * CBH3F   
  3737            * TANPI8    BYTE >3F,41,42,13,56,23,73,10    TAN(PI/8)=SQR(2
  3738            * TAN3P8    BYTE >40,2,41,42,13,56,23,73     TAN(3*PI/8)=SQR
  3739            **          SQR POLYNOMIALS  (HART SQRT 0231)   
  3740            * SQRP      BYTE >3F,58,81,22,90,00,00,00    P02=.58812 29E+
  3741            *           BYTE >3F,52,67,87,50,00,00,00    P01=.52678 75E+
  3742            *           BYTE >3E,58,81,20,00,00,00,00    P00=.58812 E-02
  3743            *           DATA SGNBIT   
  3744            * FLTONE  
  3745            * FPOS1   
  3746            * SQRQ      BYTE >40,01,00,00,00,00,00,00    Q01=.1 E+01  
  3747            *           BYTE >3F,09,99,99,80,00,00,00    Q00=.99999 8 E-
  3748            *           DATA SGNBIT   
  3749            **          EXPPONENT POLYNOMIALS  (HART EXPD 1444)   

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0085
  3750            **          P02 = .18312 36015 92753 84761 54 E+02  
  3751            * EXPP      BYTE >40,18,31,23,60,15,92,75   
  3752            **          P01 = .83140 67212 93711 03487 3446 E+03  
  3753            *           BYTE >41,08,31,40,67,21,29,37   
  3754            *           P00 = .51780 91991 51615 35743 91297 E+04   
  3755            *           BYTE >41,51,78,09,19,91,51,62   
  3756            *           DATA SGNBIT   
  3757            **          Q03 = .1 E+01   
  3758            * EXPQ      BYTE >40,1,0,0,0,0,0,0  
  3759            **          Q02 = .15937 41523 60306 52437 552 E+03   
  3760            *           BYTE >41,01,59,37,41,52,36,03   
  3761            **          Q01 = .27093 16940 85158 99126 11636 E+04   
  3762            *           BYTE >41,27,09,31,69,40,85,16   
  3763            **          Q00 = .44976 33557 40578 41762 54723 E+04   
  3764            *           BYTE >41,44,97,63,35,57,40,58   
  3765            *           DATA SGNBIT   
  3766            **          LOG POLYNOMIALS  (HART LOGE 2687)   
  3767            **          P04 = .35670 51030 88437 69 E+00  
  3768            * LOGP      BYTE >3F,35,67,05,10,30,88,44   
  3769            **          P03 = -.11983 03331 36876 1464 E+02   
  3770            *           BYTE >BF,>F5,98,30,33,31,36,88  
  3771            **          P02 = .63775 48228 86166 05782 E+02   
  3772            *           BYTE >40,63,77,54,82,28,86,17   
  3773            **          P01 = -.10883 71223 55838 3228 E+03   
  3774            *           BYTE >BE,>FF,08,83,71,22,35,58  
  3775            **          P00 = .57947 38138 44442 78265 7 E+02   
  3776            *           BYTE >40,57,94,73,81,38,44,44   
  3777            *           DATA SGNBIT   
  3778            * LOGQ  
  3779            **          Q04 = .1 E+01   
  3780            *           BYTE >40,01,0,0,0,0,0,0   
  3781            **          Q03 = -.13132 59772 88464 0339 E+02   
  3782            *           BYTE >BF,>F3,13,25,97,72,88,46  
  3783            **          Q02 = .47451 82236 02606 00365 E+02   
  3784            *           BYTE >40,47,45,18,22,36,02,61   
  3785            **          Q01 = -.64076 45807 52556 00596 E+02  
  3786            *           BYTE >BF,>C0,07,64,58,07,52,56  
  3787            **          Q00 = .28973 69069 22217 71601 9 E+02   
  3788            *           BYTE >40,28,97,36,90,69,22,22   
  3789            *           DATA SGNBIT   
  3790            **          SIN POLYNOMIAL  (HART SIN 3344)   
  3791            * SINP  
  3792            **          REFLECTS CHANGE IN 99/4 CONSTANT TO CORRECT VALU
  3793            **          OF SIN AND COS >1   
  3794            **          P07 = -.64462 13674 9 E-09  
  3795            **          BYTE >C4,>FA,44,62,13,67,49,00  
  3796            **          P07 = -.64473 16000 0 E-09  
  3797            *           BYTE >C4,>FA,44,73,16,00,00,00  
  3798            **          P06 = .56882 03332 688 E-07   
  3799            * CBH44     EQU  $+2  
  3800            *           BYTE >3C,05,68,82,03,33,26,88   
  3801            **          P05 = -.35988 09117 03133 E-05  
  3802            *           BYTE >C2,>FD,59,88,09,11,70,31  
  3803            **          P04 = .16044 11684 69828 31 E-03  
  3804            *           BYTE >3E,01,60,44,11,68,46,98   
  3805            **          P03 = -.46817 54131 06023 168 E-02  
  3806            *           BYTE >C1,>D2,81,75,41,31,06,02  
  3807            **          P02 = .79692 62624 56180 0806 E-01  
  3808            *           BYTE >3F,07,96,92,62,62,45,62   

 99/4 ASSEMBLER
TRINSICS2                                                    PAGE 0086
  3809            **          P01 = -.64596 40975 06219 07082 E+00  
  3810            *           BYTE >C0,>C0,59,64,09,75,06,22  
  3811            **          P00 = .15707 96323 79489 63959 E+01   
  3812            *           BYTE >40,01,57,07,96,32,67,95   
  3813            *           DATA SGNBIT   
  3814            **          ATN POLYNOMIAL  (HART ARCTN 4967)   
  3815            * ATNP  
  3816            **          P09 = -.25357 18798 82 E-01   
  3817            *           BYTE >C0,>FE,53,57,18,79,88,20  
  3818            **          P08 = .50279 13843 885 E-01   
  3819            *           BYTE >3F,05,02,79,13,84,38,85   
  3820            **          P07 = -.65069 99940 1396 E-01   
  3821            *           BYTE >C0,>FA,50,69,99,94,01,40  
  3822            **          P06 = .76737 12439 1641 E-01  
  3823            *           BYTE >3F,07,67,37,12,43,91,64   
  3824            **          P05 = -.90895 47919 67196 E-01  
  3825            *           BYTE >C0,>F7,08,95,47,91,96,72  
  3826            **          P04 = .11111 04992 50526 62 E+00  
  3827            *           BYTE >3F,11,11,10,49,92,50,53   
  3828            **          P03 = -.14285 71269 75961 157 E+00  
  3829            *           BYTE >C0,>F2,28,57,12,69,75,96  
  3830            **          P02 = .19999 99997 89961 5228 E+00  
  3831            *           BYTE >3F,19,99,99,99,97,89,96   
  3832            **          P01 = -.33333 33333 32253 4275 E+00   
  3833            *           BYTE >C0,>DF,33,33,33,33,32,25  
  3834            **          P00 = .99999 99999 99999 08253 E+00   
  3835            *           BYTE >40,01,0,0,0,0,0,0   
  3836            *           DATA SGNBIT   
  3837            ************************************************************
  3838                
  3839 7B88              AORG >7B88   
  3841                
  3842      0022  QUOTE  EQU  >22   
  3843      002C  COMMA  EQU  >2C   
  3844                
  3845      0002  LISTZ  EQU  >02   
  3846      0005  OLDZ   EQU  >05   
  3847      0007  SAVEZ  EQU  >07   
  3848      0008  MERGEZ EQU  >08   
  3849      0088  RETURZ EQU  >88   
  3850      008F  UNBRKZ EQU  >8F   
  3851      0093  DATAZ  EQU  >93   
  3852      0094  RESTOZ EQU  >94   
  3853      009A  REMZ   EQU  >9A   
  3854      009D  CALLZ  EQU  >9D   
  3855      00A3  IMAGEZ EQU  >A3   
  3856      00A9  RUNZ   EQU  >A9   
  3857      00B5  COLONZ EQU  >B5   
  3858      00C7  QUOTEZ EQU  >C7   
  3859      00C8  UNQSTZ EQU  >C8   
  3860      00ED  USINGZ EQU  >ED   
  3861                
  3862      000A  MAXKEY EQU  10  
  3863            *   
  3864            * CRUNCH copies a line (normally in LINBUF) to CRNBUF in the
  3865            * process, it turns the line number (if any) binary, and  
  3866            * converts all reserved words to tokens. CALL is a GPL XML  
  3867            * followed by a single byte which indicates the type of   
  3868            * crunch to be done. Possible types include:  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0087
  3869            *              >00 - Normal crunch  
  3870            *              >01 - crunch as a data statement (input stmt)
  3871            *        REGISGERS:   
  3872            *      R0 - R1   Scratch  
  3873            *      R2 - R3   Scratch  
  3874            *      R4        Points to R8LB   
  3875            *      R5        Points to length byte of string/numeric  
  3876            *      R6        Indicates numeric copy mode (numeric/line #
  3877            *      R7        Mode of copy (strings, names, REMs, etc)   
  3878            *      R8        Character buffer   
  3879            *      R9        Points to name during keyword scan   
  3880            *      R11 - R12 Links  
  3881            *      R13       GROM read data pointer   
  3882            *      R15       VDP write address pointer  
  3883            *   
  3884 7B88 C30B  CRUNCH MOV  R11,R12           Save return link  
  3885 7B8A D0DD         MOVB *R13,R3           Read call code  
  3886 7B8C 06A0         BL   @PUTSTK           Save GROM address   
       7B8E 60F2  
  3887 7B90 04E0         CLR  @FAC              Assume no line number   
       7B92 834A  
  3888 7B94 0204         LI   R4,R8LB           Set up W/S low-byte pointer   
       7B96 83F1  
  3889 7B98 04C8         CLR  R8                Initialize character buffer   
  3890 7B9A 06A0         BL   @GETNB            Scan line for 1st good char   
       7B9C 6FAC  
  3891 7B9E D501         MOVB R1,*R4            Save character  
  3892 7BA0 1379         JEQ  CRU28             If empty line, return   
  3893            * Now check crunch call mode, normal or input statement   
  3894 7BA2 0983         SRL  R3,8              Normal curnch call?   
  3895 7BA4 1307         JEQ  CRU01             Yes, crunch the statement   
  3896            * Initialize for input statement crunch   
  3897 7BA6 0202         LI   R2,CRU84          No, must be crunch input stmt 
       7BA8 7E5A  
  3898 7BAA 020A         LI   R10,CRU83           so set up move indicators   
       7BAC 7E28  
  3899 7BAE 0207         LI   R7,CRU80  
       7BB0 7E7A  
  3900 7BB2 101F         JMP  CRU10             And jump into it  
  3901            * Initialize for normal line crunch   
  3902 7BB4 05A0  CRU01  INC  @BUFLEV           Indicate CRNBUF is destroyed  
       7BB6 8346  
  3903 7BB8 04E0         CLR  @ARG4             Assume no symbol  
       7BBA 8360  
  3904 7BBC D808         MOVB R8,@PRGFLG        Clear program flag  
       7BBE 8344  
  3905 7BC0 06A0         BL   @GETINT           Try to read a line number   
       7BC2 7F8C  
  3906 7BC4 C800         MOV  R0,@FAC           Put line number into final  
       7BC6 834A  
  3907 7BC8 1304         JEQ  CRU02             If no line number   
  3908 7BCA 06A0         BL   @GETNB            Skip all leading spaces   
       7BCC 6FAC  
  3909 7BCE D501         MOVB R1,*R4            Save character in R8LB  
  3910 7BD0 1361         JEQ  CRU28             If nothing left in line   
  3911 7BD2 0207  CRU02  LI   R7,CRU16          Set normal scan move  
       7BD4 7C1E  
  3912 7BD6 0206         LI   R6,CRU96          Set normal numeric scan mode  
       7BD8 7ED4  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0088
  3913 7BDA 100B         JMP  CRU10             Merge into normal scan code   
  3914            * Main loop of the input copy routine. Sets R8LB to next  
  3915            * character, R0 to its character property byte  
  3916            * R7 indicates dispatch mode.   
  3917 7BDC 0206  CRU04  LI   R6,CRU96          Set normal numeric mode   
       7BDE 7ED4  
  3918 7BE0 0207  CRU05  LI   R7,CRU16          Set normal scan mode  
       7BE2 7C1E  
  3919 7BE4 06A0  CRU06  BL   @PUTCHR           Copy into crunch buffer   
       7BE6 7F6E  
  3920 7BE8 06A0  CRU08  BL   @GETCHR           Get next input character  
       7BEA 6FBA  
  3921 7BEC 04C0         CLR  R0                Assume nil property   
  3922 7BEE D501         MOVB R1,*R4            Copy to crunch buffer   
  3923 7BF0 1307         JEQ  CRU12             Finish up if we reach a null  
  3924            *-----------------------------------------------------------
  3925            * Replace following line for adding lowercase character   
  3926            * set to 99/4A                5/12/81   
  3927            *  CRU10 MOVB @CPTBL(R8),R0     Fetch char's prop table vec 
  3928 7BF2 9814  CRU10  CB   *R4,@ENDPRO       Higher then "z"   
       7BF4 7C1C  
  3929 7BF6 1403         JHE  CRU09             Yes, give CPNIL property  
  3930 7BF8 D028         MOVB @CPTBL(R8),R0     Fetch char's prop table value 
       7BFA 610C  
  3931 7BFC 0457         B    *R7               Dispatch to appropriate code  
  3932 7BFE D000  CRU09  MOVB CPNIL,R0          Don't go to CPT, just take  
  3933            *                              CPNIL prop   
  3934            *-----------------------------------------------------------
  3935 7C00 0457  CRU12  B    *R7               Dispatch to appropriate code  
  3936 7C02 C208  CRU14  MOV  R8,R8             End of line?  
  3937 7C04 16EF         JNE  CRU06             Not yet   
  3938 7C06 C0E0  CRU15  MOV  @RAMPTR,R3        Now check for trailing spaces 
       7C08 830A  
  3939 7C0A 0603         DEC  R3                Backup to read last character 
  3940 7C0C 06A0         BL   @GETV1            Go read it  
       7C0E 1880  
  3941 7C10 9801         CB   R1,@CBH20         Last character a space?   
       7C12 7D65  
  3942 7C14 163F         JNE  CRU28             No, so end of line, exit  
  3943 7C16 0620         DEC  @RAMPTR           Yes, backup pointer to delete 
       7C18 830A  
  3944 7C1A 10F5         JMP  CRU15             And test new last character   
  3945            *-----------------------------------------------------------
  3946            * The following two lines are added for adding lowercase  
  3947            * character set for 99/4A     5/13/81   
  3948 7C1C   7B  ENDPRO BYTE >7B               ASCII code for char after "z" 
  3949                   EVEN   
  3950            *-----------------------------------------------------------
  3951            *   
  3952            * Normal scan mode -- figures out what to do with this char 
  3953 7C1E D514  CRU16 MOVB  *R4,*R4           At end of line?   
  3954 7C20 1339         JEQ  CRU28             Yes, clean up and return  
  3955 7C22 D000         MOVB R0,R0             Set condition on char prop  
  3956 7C24 11E1         JLT  CRU08             Ignore separators (spaces)  
  3957 7C26 C260         MOV  @RAMPTR,R9        Save crunch pointer   
       7C28 830A  
  3958 7C2A 0A20         SLA  R0,2              Scan property bits 1 and 2  
  3959 7C2C 1841         JOC  CRU32             Break chars are 1 char tokens 
  3960 7C2E 110F         JLT  CRU18             Alpha, prepare to pack name   

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0089
  3961 7C30 0A20         SLA  R0,2              Scan property bits 3 and 4  
  3962 7C32 1713         JNC  CRU20             Jump if not multi-char oper   
  3963 7C34 06A0         BL   @GETCHR           Check next char to see if we  
       7C36 6FBA  
  3964 7C38 0981         SRL  R1,8               have a 2 char operator   
  3965 7C3A 133A         JEQ  CRU32             If read end of line-single ope
  3966 7C3C 06A0         BL   @BACKUP           Backup read pointer   
       7C3E 7F54  
  3967 7C40 9821         CB   @CPTBL(R1),@LBCPMO Next char also a multi-oper? 
       7C42 610C  
       7C44 6146  
  3968 7C46 1634         JNE  CRU32             No, want single-char oper   
  3969 7C48 06A0         BL   @PUTCHR           Copy in first char to oper  
       7C4A 7F6E  
  3970 7C4C 1033         JMP  CRU36             And scan keyword table  
  3971            * Set name copy mode  
  3972 7C4E 0207  CRU18  LI   R7,CRU76          Alphabetic: set name copy mode
       7C50 7E06  
  3973            *-----------------------------------------------------------
  3974            * Insert following 2 lines for adding lowercase character   
  3975            * set in 99/4A                5/12/81   
  3976 7C52 0920         SRL  R0,2              Adjust R0 for LOWUP routine   
  3977 7C54 06A0         BL   @LOWUP            Translate lowercase to upper  
       7C56 7FEE  
  3978            *                              if necessary   
  3979            *-----------------------------------------------------------
  3980 7C58 10C5         JMP  CRU06             And resume copy   
  3981            * Handle single character operators   
  3982 7C5A 112A  CRU20  JLT  CRU32             Bit 4: single character oper  
  3983 7C5C 0A20         SLA  R0,2              Scan property bits 5 and 6  
  3984 7C5E 180E         JOC  CRU24             If numeric  
  3985 7C60 1112         JLT  CRU26             If digit only   
  3986 7C62 0288         CI   R8,QUOTE          Is it a string quote?   
       7C64 0022  
  3987 7C66 1678         JNE  ERRIVN            No, unknown char so error   
  3988 7C68 C287         MOV  R7,R10            Yes, save current mode  
  3989 7C6A 0208  CRU22  LI   R8,QUOTEZ         Convert char to quote token   
       7C6C 00C7  
  3990 7C6E 06A0         BL   @PUTCHR           Put in token  
       7C70 7F6E  
  3991 7C72 0207         LI   R7,CRU68          Set string, copy mode   
       7C74 7DE2  
  3992 7C76 C160         MOV  @RAMPTR,R5        Save pointer to length byte   
       7C78 830A  
  3993 7C7A 10B4         JMP  CRU06             Continue copy w/quote token   
  3994 7C7C 0288  CRU24  CI   R8,'.'            A decimal point   
       7C7E 002E  
  3995 7C80 1602         JNE  CRU26             No, decode as numeric/line #  
  3996 7C82 0206         LI   R6,CRU96          Yes, decode as numeric  
       7C84 7ED4  
  3997 7C86 0456  CRU26  B    *R6               Handle numeric or line #  
  3998 7C88 0460  BERRSY B    @CERSYN           Long distance SYNTAX ERROR  
       7C8A 7F4C  
  3999 7C8C 06A0  CRU27  BL   @PUTCHR           Put out last char before end  
       7C8E 7F6E  
  4000 7C90 05A0         INC  @VARW             Skip last character   
       7C92 8320  
  4001            * Here for successful completion of scan  
  4002 7C94 06C8  CRU28  SWPB R8                Mark end of line with a null  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0090
  4003 7C96 06A0         BL   @PUTCHR           Put the end of line in  
       7C98 7F6E  
  4004      7C9C  CRNADD EQU  $+2   
  4005 7C9A 0200         LI   R0,CRNBUF         Get start of crunch buffer  
       7C9C 0820  
  4006 7C9E 0500         NEG  R0                Negate for backwards add  
  4007 7CA0 A020         A    @RAMPTR,R0        Calculate line length   
       7CA2 830A  
  4008 7CA4 D820         MOVB @R0LB,@CHAT       Save length for GPL   
       7CA6 83E1  
       7CA8 8342  
  4009 7CAA 06A0         BL   @GETSTK           Restore GROM address  
       7CAC 610E  
  4010 7CAE 045C         B    *R12              Return with pointer beyond nul
  4011            * Keyword table scanning routine. Name has already been   
  4012            * copied into crunch area starting at R9; RAMPTR point just 
  4013            * beyond name in input line.  
  4014            * R3 is name length, R1 indexes into the table  
  4015 7CB0 06A0  CRU32  BL   @BACKUP           Fix pointer for copy(next line
       7CB2 7F54  
  4016 7CB4 06A0  CRU36  BL   @GETCHR           Read last character   
       7CB6 6FBA  
  4017 7CB8 D501         MOVB R1,*R4            Put into output buffer  
  4018 7CBA 06A0         BL   @PUTCHR           Copy into crunch buffer   
       7CBC 7F6E  
  4019 7CBE C0E0  CRU38  MOV  @RAMPTR,R3        Get end pointer   
       7CC0 830A  
  4020 7CC2 60C9         S    R9,R3             Sub start to get length of nam
  4021 7CC4 0283         CI   R3,MAXKEY         Is longer than any keyword?   
       7CC6 000A  
  4022 7CC8 1B71         JH   CRU61             Yes, can't be a keyword   
  4023 7CCA C083         MOV  R3,R2             Get name length and   
  4024 7CCC 0602         DEC  R2                 corremt 0 length name indexin
  4025 7CCE 0A12         SLA  R2,1              Turn it into an index   
  4026 7CD0 0222         AI   R2,KEYTAB         Add in address of table list  
       7CD2 CB00  
  4027 7CD4 DB42         MOVB R2,@GRMWAX(R13)    Load address to GROM   
       7CD6 0402  
  4028 7CD8 06C2         SWPB R2  
  4029 7CDA DB42         MOVB R2,@GRMWAX(R13)   
       7CDC 0402  
  4030 7CDE D09D         MOVB *R13,R2           Read address of correct table 
  4031 7CE0 D81D         MOVB *R13,@R2LB        Both bytes  
       7CE2 83E5  
  4032            * R2 now contains the address of the correct table  
  4033 7CE4 DB42  CRU40  MOVB R2,@GRMWAX(R13)   Load address of table   
       7CE6 0402  
  4034 7CE8 C003         MOV  R3,R0             Copy of length for compare  
  4035 7CEA DB60         MOVB @R2LB,@GRMWAX(R13)  
       7CEC 83E5  
       7CEE 0402  
  4036 7CF0 D7E0         MOVB @R9LB,*R15        Source is in VDP  
       7CF2 83F3  
  4037 7CF4 A083         A    R3,R2             Address of next keyword in tab
  4038 7CF6 D7C9         MOVB R9,*R15   
  4039 7CF8 0582         INC  R2                Skip token value  
  4040 7CFA 9760  CRU42  CB   @XVDPRD,*R13      Compare the character   
       7CFC 8800  
  4041 7CFE 1A59         JL   CRU61A            If no match possible  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0091
  4042 7D00 16F1         JNE  CRU40             No match, but match possible  
  4043 7D02 0600         DEC  R0                Compared all?   
  4044 7D04 16FA         JNE  CRU42             No, check next one  
  4045 7D06 C809         MOV  R9,@RAMPTR        Name matched so throw out name
       7D08 830A  
  4046 7D0A D51D         MOVB *R13,*R4          Read the token value  
  4047 7D0C 04E0         CLR  @ARG4             Indicate keyword found  
       7D0E 8360  
  4048            * Check for specially crunched statements   
  4049 7D10 0207         LI   R7,CRU14          Assume a REM statement  
       7D12 7C02  
  4050 7D14 0200         LI   R0,SPECTB-1       Now check for special cases   
       7D16 7FD5  
  4051            *********************************************************** 
  4052            * For GRAM KRACKER XB or RichGKXB or SXB substitute with: * 
  4053            *      CI   R8,>000B                                      * 
  4054            *********************************************************** 
  4055 7D18 0288         CI   R8,MERGEZ         Is this a command?  
       7D1A 0008  
  4056 7D1C 1B06         JH   CRU47             No, continue on   
  4057 7D1E C0E0         MOV  @FAC,R3           Yes, attempt to put in program
       7D20 834A  
  4058 7D22 161C         JNE  ERRCIP            Yes, *COMMAND ILLEGAL IN PROGR
  4059 7D24 0289         CI   R9,CRNBUF         Command 1st token in line?  
       7D26 0820  
  4060 7D28 16AF         JNE  BERRSY            No, *SYNTAX ERROR*  
  4061 7D2A 0580  CRU47  INC  R0                Skip offset value   
  4062 7D2C 9C14         CB   *R4,*R0+          In special table?   
  4063 7D2E 1320         JEQ  CRU53A            Yes, handle it  
  4064 7D30 1BFC         JH   CRU47             If still possible match   
  4065            *********************************************************** 
  4066            * For GRAM KRACKER XB or RichGKXB or SXB substitute with: * 
  4067            *      CI   R8,>000C                                      * 
  4068            *********************************************************** 
  4069 7D32 0288         CI   R8,MERGEZ         A specially scanned command?  
       7D34 0008  
  4070 7D36 1AAA         JL   CRU27             Yes, exit crunch  
  4071 7D38 0200         LI   R0,LNTAB          Now check for line number   
       7D3A 7FC8  
  4072 7D3C 9C14  CRU48  CB   *R4,*R0+          In table?   
  4073 7D3E 1309         JEQ  CRU52             Yes, change to line # crunch  
  4074 7D40 1BFD         JH   CRU48             May still be in table   
  4075 7D42 0288         CI   R8,COMMAZ         Just crunch a comma?  
       7D44 00B3  
  4076 7D46 1303         JEQ  CRU50             Yes, so retain current numeric
  4077 7D48 0288         CI   R8,TOZ            Just crunch a TO?   
       7D4A 00B1  
  4078 7D4C 160F         JNE  CRU53             No, so reset to normal numeric
  4079 7D4E 0460  CRU50  B    @CRU05            Yes, resume normal copy   
       7D50 7BE0  
  4080 7D52 0206  CRU52  LI   R6,CRU100         Set line number scan mode   
       7D54 7F08  
  4081 7D56 10FB         JMP  CRU50             Set normal scan mode  
  4082 7D58 05A0  ERRIVN INC  @ERRCOD           *ILLEGAL VARIABLE NAME  
       7D5A 8322  
  4083 7D5C 05A0  ERRCIP INC  @ERRCOD           *COMMAND ILLEGAL IN PROGRAM   
       7D5E 8322  
  4084 7D60 05A0  ERRNQT INC  @ERRCOD           *NONTERMINATED QUOTED STING   
       7D62 8322  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0092
  4085      7D65  CBH20  EQU  $+1   
  4086 7D64 A820  ERRNTL A    @C4,@ERRCOD       *NAME TO LONG   
       7D66 6A80  
       7D68 8322  
  4087 7D6A 1094         JMP  CRU28             Exit back to GPL  
  4088      7D6C  OFFSET EQU  $   
  4089 7D6C 0460  CRU53  B    @CRU04            Stmt sep resets to normal scan
       7D6E 7BDC  
  4090 7D70 D050  CRU53A MOVB *R0,R1            Pick up offset from table   
  4091 7D72 0981         SRL  R1,8              Make into offset  
  4092 7D74 0461         B    @OFFSET(R1)       Goto special case handler   
       7D76 7D6C  
  4093            * Process a LIST statement  
  4094 7D78 06A0  CRU57  BL   @PUTCHR           Put the list token in   
       7D7A 7F6E  
  4095 7D7C 06A0         BL   @GETNB            Get next character  
       7D7E 6FAC  
  4096 7D80 0281         CI   R1,QUOTE*256      Device name available?  
       7D82 2200  
  4097 7D84 1687         JNE  CRU28             No, no more to crunch, exit   
  4098 7D86 020A         LI   R10,CRU106        Yes, set after string scan mod
       7D88 7F2C  
  4099 7D8A 0460         B    @CRU22            Crunch the device name  
       7D8C 7C6A  
  4100            * Process an IMAGE statement  
  4101 7D8E 020A  CRU54  LI   R10,CRU83B        Image after, string copy mode 
       7D90 7E2E  
  4102 7D92 1002         JMP  CRU59             Handle similar to data stmt   
  4103            * Process a DATA statement  
  4104 7D94 020A  CRU58  LI   R10,CRU83         After-datum skip spaces   
       7D96 7E28  
  4105 7D98 8820  CRU59  C    @RAMPTR,@CRNADD   Image & data must be 1st on li
       7D9A 830A  
       7D9C 7C9C  
  4106 7D9E 164B         JNE  JNESY1            If not, error   
  4107 7DA0 0202         LI   R2,CRU84          (non)quote string copy mode   
       7DA2 7E5A  
  4108 7DA4 0207  CRU60  LI   R7,CRU80          Now set check-for-quote mode  
       7DA6 7E7A  
  4109 7DA8 0460  CRU74  B    @CRU06            And copyin statement token  
       7DAA 7BE4  
  4110            * Here when don't find something in the keyword table   
  4111 7DAC 0283  CRU61  CI   R3,15             Is it longer than name can be?
       7DAE 000F  
  4112 7DB0 1BD9         JH   ERRNTL            Yes, name to long   
  4113 7DB2 C020  CRU61A MOV  @ARG4,R0          Symbol name last time too?  
       7DB4 8360  
  4114 7DB6 163F         JNE  JNESY1            Yes, can't have 2 in a row  
  4115 7DB8 0620         DEC  @ARG4             Indicate symbol noe   
       7DBA 8360  
  4116 7DBC 0207  CRU62  LI   R7,CRU16          No keyword,; leave in CRNBUF  
       7DBE 7C1E  
  4117 7DC0 0206         LI   R6,CRU96          Assume normal numeric scan  
       7DC2 7ED4  
  4118 7DC4 0460  CRU64  B    @CRU08            And continue to scan line   
       7DC6 7BE8  
  4119            * Process a SUB statement   
  4120 7DC8 C0E0  CRU65  MOV  @RAMPTR,R3        Get the current crunch pointer
       7DCA 830A  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0093
  4121 7DCC 0603         DEC  R3                Point at last character put in
  4122 7DCE 06A0         BL   @GETV1            Read it   
       7DD0 1880  
  4123 7DD2 9801         CB   R1,@GOZTOK        Was it a GO?  
       7DD4 7FC9  
  4124 7DD6 13BD         JEQ  CRU52             Yes, SUB is part of GO SUB  
  4125            * Process a CALL SUB statement  
  4126 7DD8 0207  CRU66  LI   R7,CRU93          Set name copy   
       7DDA 7EC2  
  4127 7DDC 10E5         JMP  CRU74             And get next character  
  4128 7DDE 0460  CRU32L B    @CRU32  
       7DE0 7CB0  
  4129            * Now the various mode copy routines; string, names, image, 
  4130            *  and data statements  
  4131 7DE2 C208  CRU68  MOV  R8,R8             Premature end of line?  
  4132 7DE4 13BD         JEQ  ERRNQT            Yes, *NONTERMINATED QUOTED STR
  4133 7DE6 0288         CI   R8,QUOTE          Reach end of string?  
       7DE8 0022  
  4134 7DEA 16DE         JNE  CRU74             No, continue copying  
  4135 7DEC 06A0         BL   @GETCHR           Get next character  
       7DEE 6FBA  
  4136 7DF0 D041         MOVB R1,R1             Read end of line?   
  4137 7DF2 1305         JEQ  CRU70             Yes, can't be double quote  
  4138 7DF4 0281         CI   R1,QUOTE*256      Is it two quotes in a row?  
       7DF6 2200  
  4139 7DF8 13D7         JEQ  CRU74             Yes, copy in a normal quote   
  4140 7DFA 06A0         BL   @BACKUP           No, backup & rtn to normal sca
       7DFC 7F54  
  4141 7DFE C1CA  CRU70  MOV  R10,R7            Needed for image/data stmts   
  4142 7E00 06A0  CRU72  BL   @LENGTH           Calculate length of string  
       7E02 6FE2  
  4143 7E04 10DF         JMP  CRU64             Resume scan   
  4144            * Names   
  4145            *-----------------------------------------------------------
  4146            * Replace following two lines for adding lowercase  
  4147            * character set in 99/4A      5/12/81   
  4148            *  CRU76  ANDI R0,CPALNM*256    Is this char alpha or digit 
  4149            *         JEQ  CRU74            Yes, continue packing   
  4150 7E06 0240  CRU76  ANDI R0,CPULNM*256     Is this char alpha (both are  
       7E08 2300  
  4151            *                              upper and lower) or a digit? 
  4152 7E0A 160B         JNE  CRU78             Yes, continue packing   
  4153            *-----------------------------------------------------------
  4154            *                             No, finish w/name packing   
  4155 7E0C 0288         CI   R8,'$'            Does name end with a $?   
       7E0E 0024  
  4156 7E10 13E6         JEQ  CRU32L            Yes, include it in name   
  4157 7E12 D514         MOVB *R4,*R4           At an end of line?  
  4158 7E14 1302         JEQ  CRU79             Yes, don't back up pointer  
  4159 7E16 06A0         BL   @BACKUP           Backup for next char  
       7E18 7F54  
  4160 7E1A 0460  CRU79  B    @CRU38            Jump to name/keyword check  
       7E1C 7CBE  
  4161 7E1E 0460  CRU82  B    @CRU22  
       7E20 7C6A  
  4162            *-----------------------------------------------------------
  4163            * Add following 2 lines for adding lowercase character set  
  4164            * for 99/4A                   5/12/81   
  4165 7E22 06A0  CRU78  BL   @LOWUP            Translate lower to upper if   

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0094
       7E24 7FEE  
  4166            *                              necessary  
  4167 7E26 10C0         JMP  CRU74             Continue packing  
  4168            *-----------------------------------------------------------
  4169            * DATA: Scan spaces after a quoted string datum   
  4170 7E28 0288  CRU83  CI   R8,COMMA          Hit a comma?  
       7E2A 002C  
  4171 7E2C 1321         JEQ  CRU85A            Yes, get back into scan   
  4172            * IMAGE: Scan spaces after a quoted string datum  
  4173 7E2E D000  CRU83B MOVB R0,R0             At a space?   
  4174 7E30 11C9         JLT  CRU64             Yes, ignore it  
  4175 7E32 C208         MOV  R8,R8             At end of line?   
  4176 7E34 13C3         JEQ  CRU62             Yes, exit scan  
  4177 7E36 1064  JNESY1 JMP  JNESYN            No, unknown character   
  4178            * DATA: Scan imbedded blanks and check trailing blanks  
  4179 7E38 C820  CRU83A MOV  @VARW,@ARG2       Save input pointer  
       7E3A 8320  
       7E3C 835E  
  4180 7E3E 06A0         BL   @GETNB            Look for next non-blank   
       7E40 6FAC  
  4181 7E42 D041         MOVB R1,R1             At end of line?   
  4182 7E44 1337         JEQ  CRU92             Yes, end string and exit  
  4183 7E46 028A         CI   R10,CRU83B        Scanning an image?  
       7E48 7E2E  
  4184 7E4A 1303         JEQ  CRU83C            Yes, commas are not significan
  4185 7E4C 0281         CI   R1,COMMA*256      Hit a comma?  
       7E4E 2C00  
  4186 7E50 130D         JEQ  CRU85             Yes, ignore trailing spaces   
  4187 7E52 C820  CRU83C MOV  @ARG2,@VARW       No, restore input pointer   
       7E54 835E  
       7E56 8320  
  4188 7E58 10A7         JMP  CRU74              and include imbedded space   
  4189            * DATA: Scan unquoted strings   
  4190 7E5A 11EE  CRU84  JLT  CRU83A            If hit a space-end of string  
  4191 7E5C C208         MOV  R8,R8             At end-of-line?   
  4192 7E5E 132A         JEQ  CRU92             Yes, put in length and exit   
  4193 7E60 0288         CI   R8,COMMA          Reached a comma?  
       7E62 002C  
  4194 7E64 16A1         JNE  CRU74             No, scan unquoted string  
  4195 7E66 028A         CI   R10,CRU83B        Scanning an IMAGE stmt?   
       7E68 7E2E  
  4196 7E6A 139E         JEQ  CRU74             Commas are not significant  
  4197 7E6C 06A0  CRU85  BL   @LENGTH           Yes, end the string   
       7E6E 6FE2  
  4198 7E70 0208  CRU85A LI   R8,COMMAZ         Load a comma token  
       7E72 00B3  
  4199 7E74 05A0         INC  @VAR5             Count comma for input stmt  
       7E76 8310  
  4200 7E78 1095         JMP  CRU60             And resume in string mode   
  4201            * IMAGE/DATA: Check for leading quote mark  
  4202 7E7A 11A4  CRU80  JLT  CRU64             Ignore leading separators   
  4203 7E7C 0288         CI   R8,QUOTE          Quotoed string?   
       7E7E 0022  
  4204 7E80 13CE         JEQ  CRU82             Yes, like any string, R10 ok  
  4205 7E82 C208         MOV  R8,R8             End of line?  
  4206 7E84 1365         JEQ  BCRU28            Yes, end it   
  4207 7E86 028A         CI   R10,CRU83B        Scanning an IMAGE?  
       7E88 7E2E  
  4208 7E8A 1303         JEQ  CRU88             Yes, ignore commas  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0095
  4209 7E8C 0288         CI   R8,COMMA          At a comma?   
       7E8E 002C  
  4210 7E90 13EF         JEQ  CRU85A            Yes, put it in directly   
  4211 7E92 C1C2  CRU88  MOV  R2,R7             No, set unquote string copy mo
  4212            * IMAGE & DATA: Scan unquoted strings   
  4213 7E94 0208  CRU86  LI   R8,UNQSTZ         Load unquoted string token  
       7E96 00C8  
  4214 7E98 06A0         BL   @PUTCHR           Put the token in  
       7E9A 7F6E  
  4215 7E9C C160         MOV  @RAMPTR,R5        Save current crunch pointer   
       7E9E 830A  
  4216 7EA0 06A0         BL   @BACKUP           Back up to scan again   
       7EA2 7F54  
  4217 7EA4 1081  CRU87  JMP  CRU74             Resume scan   
  4218            * CALL and SUB statements   
  4219            *-----------------------------------------------------------
  4220            * Replace following 2 lines for adding lowercase character  
  4221            * set for 99/4A               5/12/81   
  4222            *  CRU94 ANDI R0,CPALNM*256     Still an alpha-numeric  
  4223            *        JNE  CRU74             Yes, include in name  
  4224 7EA6 0240  CRU94  ANDI R0,CPULNM*256     Still an alpha(U & L)-numeric 
       7EA8 2300  
  4225 7EAA 1607         JNE  CRU91             Yes, transfer L to U, then  
  4226            *                              include in name  
  4227            *-----------------------------------------------------------
  4228 7EAC C208         MOV  R8,R8             At end of line?   
  4229 7EAE 1302         JEQ  CRU92             Yes, get out now  
  4230 7EB0 06A0  CRU90  BL   @BACKUP           No, reset read pointer  
       7EB2 7F54  
  4231 7EB4 0207  CRU92  LI   R7,CRU16          Normal scanning mode  
       7EB6 7C1E  
  4232 7EB8 10A3         JMP  CRU72             Calculate & put in string leng
  4233            *-----------------------------------------------------------
  4234            * Add following lines for adding lowercase character set  
  4235            * for 99/4A                   5/12/81   
  4236 7EBA 06A0  CRU91  BL   @LOWUP            Transfer lowercase char to  
       7EBC 7FEE  
  4237            *                              uppercase char if necessary  
  4238 7EBE 0460         B    @CRU74            Include in name   
       7EC0 7DA8  
  4239            *-----------------------------------------------------------
  4240            * CALL and SUB statements before hit name   
  4241 7EC2 1180  CRU93  JLT  CRU64             If a space, ignore it   
  4242 7EC4 C000         MOV  R0,R0             Premature EOL or NIL char, pro
  4243 7EC6 1342         JEQ  CERSYN            Yes, *SYNTAX ERROR  
  4244            *-----------------------------------------------------------
  4245            * Replace following line for adding lowercase character set 
  4246            * for 99/4A                   5/12/81   
  4247            *         ANDI R0,CPALPH*256    An alphabetic to start name?
  4248 7EC8 0240         ANDI R0,CPUL*256       An alphabetic (both U & L) to 
       7ECA 2100  
  4249            *                              start name?  
  4250            *-----------------------------------------------------------
  4251 7ECC 133F         JEQ  CERSYN            No, syntax error  
  4252 7ECE 0207         LI   R7,CRU94          Set up to copy name   
       7ED0 7EA6  
  4253 7ED2 10E0         JMP  CRU86             Put in the unqst token  
  4254            * Numerics  
  4255 7ED4 0207  CRU96  LI   R7,CRU98          Set after-initialize scan   

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0096
       7ED6 7EDE  
  4256 7ED8 04E0         CLR  @ARG              Clear the 'E' flag  
       7EDA 835C  
  4257 7EDC 10DB         JMP  CRU86             Set up for the numeric  
  4258 7EDE C208  CRU98  MOV  R8,R8             At end of line?   
  4259 7EE0 13E9         JEQ  CRU92             Yes end the number  
  4260 7EE2 0A20         SLA  R0,2              Scan property bit 2   
  4261 7EE4 1108         JLT  CRU99A            If alpha, might ge 'E'  
  4262 7EE6 0A30         SLA  R0,3              Scan property bits 4 and 5  
  4263 7EE8 1702         JNC  CRU99             Bit 4=oper, if not oper, jmp  
  4264 7EEA C020         MOV  @ARG,R0           If operator, follow an 'E'?   
       7EEC 835C  
  4265 7EEE 04E0  CRU99  CLR  @ARG              Previous char no longer an 'E'
       7EF0 835C  
  4266 7EF2 11D8         JLT  CRU87             If still numeric  
  4267 7EF4 10DD         JMP  CRU90             No longer numeric   
  4268 7EF6 0288  CRU99A CI   R8,'E'            'E' to indicate an exponent?  
       7EF8 0045  
  4269 7EFA 16DA         JNE  CRU90             No, so end the numeric  
  4270 7EFC C020         MOV  @ARG,R0           An 'E' already encountered?   
       7EFE 835C  
  4271 7F00 1625  JNESYN JNE  CERSYN            Yes, so error   
  4272 7F02 0720         SETO @ARG              No, indicated 1 encountered no
       7F04 835C  
  4273 7F06 10CE         JMP  CRU87             And include it in the number  
  4274            * Line numbers  
  4275 7F08 C208  CRU100 MOV  R8,R8             At end of line?   
  4276 7F0A 1322         JEQ  BCRU28            Yes, exit crunch  
  4277 7F0C 06A0         BL   @GETINT           Try to get a line number  
       7F0E 7F8C  
  4278 7F10 C000         MOV  R0,R0             Get a line number?  
  4279 7F12 130A         JEQ  CRU105            No, back to normal numeric mod
  4280 7F14 0208         LI   R8,LNZ            Load a line number token  
       7F16 00C9  
  4281 7F18 06A0         BL   @PUTCHR           Put it out  
       7F1A 7F6E  
  4282 7F1C C200         MOV  R0,R8             Set up to put out binary #  
  4283 7F1E 06C8         SWPB R8                Swap to put MSB of # 1st  
  4284 7F20 06A0         BL   @PUTCHR           Put out 1st byte of line #  
       7F22 7F6E  
  4285 7F24 0988         SRL  R8,8              Bare the 2nd byte of line #   
  4286 7F26 10BE         JMP  CRU87             Jump back into it   
  4287 7F28 0460  CRU105 B    @CRU04            Back to normal numeric mode   
       7F2A 7BDC  
  4288            * Handle a list statement   
  4289 7F2C 11CA  CRU106 JLT  CRU93             If space, ignore it   
  4290 7F2E C208         MOV  R8,R8             At end of line?   
  4291 7F30 130F         JEQ  BCRU28            Yes, exit crunch  
  4292 7F32 0288         CI   R8,':'            Get a colon?  
       7F34 003A  
  4293 7F36 160A         JNE  CERSYN            No, *SYNTAX ERROR   
  4294 7F38 0208         LI   R8,COLONZ         Need to put colon in  
       7F3A 00B5  
  4295 7F3C 0460         B    @CRU27            And exit crunch   
       7F3E 7C8C  
  4296            * Error handling routine  
  4297 7F40 05A0  ERRLTL INC  @ERRCOD           * LINE TO LONG      3   
       7F42 8322  
  4298 7F44 0660         DECT @RAMPTR           Backup so can exit to GPL   

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0097
       7F46 830A  
  4299 7F48 05A0  ERRBLN INC  @ERRCOD           * BAD LINE NUMBER   2   
       7F4A 8322  
  4300 7F4C 05A0  CERSYN INC  @ERRCOD           * SYNTAX ERROR      1   
       7F4E 8322  
  4301 7F50 0460  BCRU28 B    @CRU28            Exit back to GPL  
       7F52 7C94  
  4302            * Back up pointer in input line to rescan last character  
  4303 7F54 0620  BACKUP DEC  @VARW             Back up the pointer   
       7F56 8320  
  4304 7F58 D7E0         MOVB @VARW1,*R15       Write LSB of address  
       7F5A 8321  
  4305 7F5C 1000         NOP  
  4306 7F5E D7E0         MOVB @VARW,*R15        Write MSB of address  
       7F60 8320  
  4307 7F62 0200         LI   R0,>7F00          >7F is an edge character  
       7F64 7F00  
  4308 7F66 7020         SB   @XVDPRD,R0        At an edge chracter?  
       7F68 8800  
  4309 7F6A 13F4         JEQ  BACKUP            Yes, back up one more   
  4310 7F6C 045B         RT                     And return to caller  
  4311            * Put a character into the crunch buffer  
  4312 7F6E C060  PUTCHR MOV  @RAMPTR,R1        Fetch the current pointer   
       7F70 830A  
  4313 7F72 0281         CI   R1,CRNEND         At end of buffer?   
       7F74 091C  
  4314 7F76 1BE4         JH   ERRLTL            Yes, LINE TO LONG   
  4315 7F78 D7E0         MOVB @R1LB,*R15        Put out LSB of address  
       7F7A 83E3  
  4316 7F7C 0261         ORI  R1,WRVDP          Enable VDP write  
       7F7E 4000  
  4317 7F80 D7C1         MOVB R1,*R15           Put out MSB of address  
  4318 7F82 05A0         INC  @RAMPTR           Increment the pointer   
       7F84 830A  
  4319 7F86 D814         MOVB *R4,@XVDPWD       Write out the byte  
       7F88 8C00  
  4320 7F8A 045B         RT                     And return  
  4321            *-----------------------------------------------------------
  4322            * Move LENGTH to GETNB, becuase CRUNCH is running out of  
  4323            * space, 1/21/81  
  4324            * Calculate and put length of string/number into length   
  4325            * byte  
  4326            * LENGTH MOV  R11,R3            Save return address   
  4327            *        MOV  @RAMPTR,R0        Save current crunch pointer 
  4328            *        MOV  R0,R8             Put into R8 for PUTCHR below
  4329            *        S    R5,R8             Calculate length of string  
  4330            *        DEC  R8                RAMPTR is post-incremented  
  4331            *        MOV  R5,@RAMPTR        Address of length byte  
  4332            *        BL   @PUTCHR           Put the length in   
  4333            *        MOV  R0,@RAMPTR        Restore crunch pointer  
  4334            *        B    *R3               And return  
  4335            *-----------------------------------------------------------
  4336            *   
  4337            * Get a small non-negative integer  
  4338            * CALL: VARW - TEXT POINTER, points to second character   
  4339            *       R8   - First character in low byte  
  4340            *       BL     @GETINT  
  4341            *       R0   - NUMBER   
  4342            *       VARW - Text pointer, if there is a number, points to

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0098
  4343            *               character after number. If there is not a   
  4344            *               number, unchanged.  
  4345            *       R8   - 0 in high byte   
  4346            *       DESTROYS: R1, R2  
  4347 7F8C C0CB  GETINT MOV  R11,R3            Save return address   
  4348 7F8E C008         MOV  R8,R0             Get possible digit  
  4349 7F90 0202         LI   R2,10             Get radix in register for spee
       7F92 000A  
  4350 7F94 0220         AI   R0,-'0'           Convert from ASCII to binary  
       7F96 FFD0  
  4351 7F98 8080         C    R0,R2             Is the character a digit?   
  4352 7F9A 1A08         JL   GETI02            Yes, there is a number!   
  4353 7F9C 04C0         CLR  R0                No, indicate no number  
  4354 7F9E 0453         B    *R3               Done, no number   
  4355 7FA0 3802  GETI01 MPY  R2,R0             Multiply previous by radix  
  4356 7FA2 C000         MOV  R0,R0             Overflow?   
  4357 7FA4 16D1         JNE  ERRBLN            Yes, bad line number  
  4358 7FA6 C001         MOV  R1,R0             Get low order word of product 
  4359 7FA8 A008         A    R8,R0             Add in next digit   
  4360 7FAA 11CE         JLT  ERRBLN            If number went negative, error
  4361 7FAC 06A0  GETI02 BL   @GETCHR           Get next character  
       7FAE 6FBA  
  4362 7FB0 D501         MOVB R1,*R4            Put into normal position  
  4363 7FB2 1306         JEQ  GETI03            If read end of line   
  4364 7FB4 0228         AI   R8,-'0'           Convert from ASCII to binary  
       7FB6 FFD0  
  4365 7FB8 8088         C    R8,R2             Is this character a digit?  
  4366 7FBA 1AF2         JL   GETI01            Yes, try to pack it in  
  4367 7FBC 0620         DEC  @VARW             No point to 1st char after num
       7FBE 8320  
  4368 7FC0 04C8  GETI03 CLR  R8                Clean up our mess   
  4369 7FC2 C000         MOV  R0,R0             Hit a natural zero?   
  4370 7FC4 13C1         JEQ  ERRBLN            Yes, its an error   
  4371 7FC6 0453         B    *R3               And return  
  4372            * The LINE NUMER TABLE  
  4373            * All tokens which appear in the table must have numerics   
  4374            * which follow them crunched as line numbers.   
  4375 7FC8   81  LNTAB  BYTE ELSEZ   
  4376 7FC9   85  GOZTOK BYTE GOZ   
  4377 7FCA   86         BYTE GOTOZ   
  4378 7FCB   87         BYTE GOSUBZ  
  4379 7FCC   88         BYTE RETURZ  
  4380 7FCD   8E         BYTE BREAKZ  
  4381 7FCE   8F         BYTE UNBRKZ  
  4382 7FCF   94         BYTE RESTOZ  
  4383 7FD0   A5         BYTE ERRORZ  
  4384 7FD1   A9         BYTE RUNZ  
  4385 7FD2   B0         BYTE THENZ   
  4386 7FD3   ED         BYTE USINGZ  
  4387 7FD4   FF         BYTE >FF               Indicate end of table   
  4388                   EVEN   
  4389            ************************************************************
  4390            * Table of specially crunched statements  
  4391            * 2 bytes - special token   
  4392            *  Byte 1 - token value   
  4393            *  Byte 2 - "address" of special handler  
  4394            *           Offset from label OFFSET in this assembly of  
  4395            *           the special case handler  
  4396            ************************************************************

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0099
  4397 7FD6   02  SPECTB BYTE LISTZ,CRU57-OFFSET  
       7FD7   0C  
  4398 7FD8   05         BYTE OLDZ,CRU58-OFFSET   
       7FD9   28  
  4399 7FDA   07         BYTE SAVEZ,CRU58-OFFSET  
       7FDB   28  
  4400 7FDC   08         BYTE MERGEZ,CRU58-OFFSET   
       7FDD   28  
  4401 7FDE   82         BYTE SSEPZ,CRU53-OFFSET  
       7FDF   00  
  4402 7FE0   83         BYTE TREMZ,CRU74-OFFSET  
       7FE1   3C  
  4403 7FE2   93         BYTE DATAZ,CRU58-OFFSET  
       7FE3   28  
  4404 7FE4   9A         BYTE REMZ,CRU74-OFFSET   
       7FE5   3C  
  4405 7FE6   9D         BYTE CALLZ,CRU66-OFFSET  
       7FE7   6C  
  4406 7FE8   A1         BYTE SUBZ,CRU65-OFFSET   
       7FE9   5C  
  4407 7FEA   A3         BYTE IMAGEZ,CRU54-OFFSET   
       7FEB   22  
  4408 7FEC   FF         BYTE >FF   
  4409                   EVEN   
  4410            *   
  4411            * TRANSFER LOWERCASE CHARACTER TO UPPERCASE CHARACTER   
  4412            * R0 - Last digit indicates whether this character is a   
  4413            *       lowercase character   
  4414 7FEE 0240  LOWUP  ANDI R0,CPLOW*256      Is lowercase prop set?  
       7FF0 0100  
  4415 7FF2 1302         JEQ  LU01              No, just return   
  4416 7FF4 7520         SB   @CBH20,*R4        Change lower to upper   
       7FF6 7D65  
  4417 7FF8 045B  LU01   RT   
  4418            ************************************************************
  4419                
  4420 7FFA              AORG >7FFA   
  4421 7FFA 04E0  PAGER  CLR  @>6000      * RESTORE PAGE ONE  
       7FFC 6000  
  4422 7FFE 0459         B    *R9   
  4423            ************************************************************
  4424                   END  

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0100
    AAA11   8303      ABSZ    00CB      ADDR1   834C      ADDR11  834D    
    ADDR2   8350      ADDR21  8351      ANDZ    00BB      ARG     835C    
    ARG1    835D      ARG10   8366      ARG2    835E      ARG3    835F    
    ARG4    8360      ARG8    8364      ARG9    8365      ARGT05  6B8E    
    ARGT10  6B92      ARGT20  6B9A      ARGTST  6B6E      ASSG    6334    
    ASSG54  6360      ASSG55  6374      ASSG56  638A      ASSG57  637E    
    ASSG59  63B6      ASSG70  63CE      ASSG75  63EA      ASSG77  63F4    
    ASSG79  63F8      ASSG80  6388      ASSGNV  61AE      ATN01   79BC    
    ATN02   79C8      ATN02A  79C4      ATNP    014E      ATNSG3  79E8    
    ATNSGN  79E0      ATNZZ   797C      B9900   64F2      BACKUP  7F54    
    BASE    8343      BCNT1   834E      BCNT2   8308      BCNT3   8356    
    BCON1   6E7E      BCONT   6D12      BCRU28  7F50      BERMUV  623C    
    BERRSY  7C88      BERSNM  6EDE      BERSYN  6EDA      BEXC15  685C    
    BIT2    62AB      BITINT  7A50      BLTST9  6D58      BMF     6DF2    
    BREAK   0007      BREAKZ  008E      BRKFL   0001      BRKP1L  65D2    
    BRKPN1  6644      BRKPN2  663E      BRKPNT  6636      BROLIN  76BE    
    BSO     6DF6      BSYNCH  6ED6      BUFLEV  8346      BYTE    830C    
    C0      6548      C100    6008      C1000   600A      C16     6BF8    
    C2      6000      C24     6464      C3      6544      C4      6A80    
    C40     6006      C6      618A      C7      6002      C8      7AF4    
    CALGPL  666C      CALIST  830A      CALL    750A      CALLZ   009D    
    CB3     6545      CBH20   7D65      CBH3F   7490      CBH411  748E    
    CBH44   7491      CBH63   6D05      CBH65   65A7      CBH66   66F1    
    CBH67   68AB      CBH69   6A9B      CBH6A   6860      CBH7    6003    
    CBH80   78FD      CBH94   6005      CBHA    6004      CBHFF   60D6    
    CC3     7908      CCBH7   74D4      CCPADR  8308      CCPPTR  8306    
    CERSYN  7F4C      CFI     12B8      CHAT    8342      CHRBUF  837D    
    CIF     74AA      CNS     7016      CNS01   704C      CNSA01  745A    
    CNSA02  7460      CNSAST  7440      CNSCHK  741A      CNSD01  72F8    
    CNSD02  730C      CNSD03  7314      CNSD04  731E      CNSD05  732A    
    CNSD06  7328      CNSDIG  72E6      CNSDRT  732E      CNSE01  7346    
    CNSE02  7364      CNSE03  738E      CNSE04  735A      CNSE05  7386    
    CNSEXP  7330      CNSF01  7096      CNSF02  70A6      CNSF04  70C2    
    CNSF05  70C8      CNSF06  70E6      CNSF07  70FC      CNSF08  7100    
    CNSF1   707C      CNSF10  710A      CNSF12  7118      CNSG    7124    
    CNSG01  713A      CNSI01  739C      CNSINT  7398      CNSITT  7006    
    CNSJ00  718E      CNSJ01  71BA      CNSJ02  71DC      CNSJ03  71E8    
    CNSJ04  718A      CNSK    720E      CNSK01  7240      CNSK1   721A    
    CNSL01  73CE      CNSL02  73FA      CNSL03  7400      CNSLEA  73C8    
    CNSMLS  73C4      CNSPER  73B2      CNSR01  725E      CNSR02  72A4    
    CNSR03  72BC      CNSR04  72BE      CNSR05  72C6      CNSRND  7246    
    CNSROV  7290      CNSS01  746C      CNSSEL  6070      CNSSTR  746A    
    CNST01  72E2      CNST10  7B80      CNSTEN  72CA      CNSU01  7406    
    CNSU02  7416      CNSUTR  7408      CNSV01  7202      CNSVZR  71EC    
    CNSX    713E      CNSX01  7158      CNSX02  7164      CNSX03  7170    
    CNSZ01  73B8      CNSZER  73BC      COLONZ  00B5      COMM05  6D8C    
    COMMA   002C      COMMAZ  00B3      COMMON  6D74      COMPCG  619C    
    COMPCT  73D8      CONC    667E      CONCAT  0008      CONT    64C8    
    CONT10  64D8      CONT15  64E6      CONTG   64C4      CONTIN  65CC    
    CONVRT  6E9E      COSZZ   78B2      CPALNM  0022      CPALPH  0020    
    CPBRK   0040      CPDIG   0002      CPLOW   0001      CPMO    0010    
    CPNIL   0000      CPNUM   0004      CPOP    0008      CPSEP   0080    
    CPTBL   610C      CPUL    0021      CPULNM  0023      CRNADD  7C9C    
    CRNBUF  0820      CRNEND  091C      CRNSEL  6076      CRU01   7BB4    
    CRU02   7BD2      CRU04   7BDC      CRU05   7BE0      CRU06   7BE4    
    CRU08   7BE8      CRU09   7BFE      CRU10   7BF2      CRU100  7F08    
    CRU105  7F28      CRU106  7F2C      CRU12   7C00      CRU14   7C02    
    CRU15   7C06      CRU16   7C1E      CRU18   7C4E      CRU20   7C5A    

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0101
    CRU22   7C6A      CRU24   7C7C      CRU26   7C86      CRU27   7C8C    
    CRU28   7C94      CRU32   7CB0      CRU32L  7DDE      CRU36   7CB4    
    CRU38   7CBE      CRU40   7CE4      CRU42   7CFA      CRU47   7D2A    
    CRU48   7D3C      CRU50   7D4E      CRU52   7D52      CRU53   7D6C    
    CRU53A  7D70      CRU54   7D8E      CRU57   7D78      CRU58   7D94    
    CRU59   7D98      CRU60   7DA4      CRU61   7DAC      CRU61A  7DB2    
    CRU62   7DBC      CRU64   7DC4      CRU65   7DC8      CRU66   7DD8    
    CRU68   7DE2      CRU70   7DFE      CRU72   7E00      CRU74   7DA8    
    CRU76   7E06      CRU78   7E22      CRU79   7E1A      CRU80   7E7A    
    CRU82   7E1E      CRU83   7E28      CRU83A  7E38      CRU83B  7E2E    
    CRU83C  7E52      CRU84   7E5A      CRU85   7E6C      CRU85A  7E70    
    CRU86   7E94      CRU87   7EA4      CRU88   7E92      CRU90   7EB0    
    CRU91   7EBA      CRU92   7EB4      CRU93   7EC2      CRU94   7EA6    
    CRU96   7ED4      CRU98   7EDE      CRU99   7EEE      CRU99A  7EF6    
    CRULST  83C0      CRUNCH  7B88      CSN01   11B2      CSRC    830C    
    CSTR05  6AFC      CSTR10  6B00      CSTR20  6B1A      CVROAZ  7A96    
    CZ      831A      DATA    8334      DATAZ   0093      DDD11   8355    
    DELREP  7EF4      DEST    8358      DEST1   8359      DIVIDE  6B62    
    DIVIZ   00C4      DSRFLG  8317      DTECT2  606A      ELSEZ   0081    
    END     665E      ENDPRO  7C1C      ENLN    8332      EOL     65D6    
    EOLINE  6872      EOLNE1  687A      EOSTM1  6870      EOSTMT  6862    
    EQUALS  6A8E      EQZ     00BE      ERR     6652      ERR1    62CE    
    ERR1B   6738      ERR1C   67F0      ERR1CZ  69A4      ERR3    6304    
    ERR51   67F2      ERRBLN  7F48      ERRBS   0503      ERRBV   6ECA    
    ERRCIP  7D5C      ERRCO1  8323      ERRCOD  8322      ERREX   0403    
    ERRIOR  0203      ERRIVN  7D58      ERRLN   038A      ERRLNF  0303    
    ERRLOG  76D6      ERRLTL  7F40      ERRMUV  6970      ERRNIP  75BE    
    ERRNQT  7D60      ERRNTL  7D64      ERROM   0103      ERRONE  664E    
    ERROR   0005      ERRORZ  00A5      ERRSN   0003      ERRSN1  6ECE    
    ERRSNM  6D5C      ERRSO   6468      ERRSQR  78AE      ERRSY1  6ED2    
    ERRSYN  664E      ERRT    630C      ERRTM   0603      ERRX    6308    
    EXC127  0000      EXC15L  65D0      EXEC10  650E      EXEC11  6516    
    EXEC15  6542      EXEC16  6576      EXEC17  6588      EXEC20  658E    
    EXEC50  6656      EXECG   6500      EXIT    6652      EXP     8376    
    EXP01   75FC      EXP03   7614      EXP04   7640      EXPONZ  00C5    
    EXPP    007C      EXPQ    0096      EXPSQ5  76A4      EXPSQ8  76B4    
    EXPSQT  7696      EXPZZ   75CA      EXRTN   65A6      EXRTN2  65AE    
    EXRTN3  65C8      EXRTNA  6466      EXTRAM  832E      EXTRM1  832F    
    FAC     834A      FAC1    834B      FAC10   8354      FAC11   8355    
    FAC12   8356      FAC13   8357      FAC14   8358      FAC15   8359    
    FAC16   835A      FAC2    834C      FAC33   836B      FAC4    834E    
    FAC5    834F      FAC6    8350      FAC7    8351      FAC8    8352    
    FAC9    8353      FADD    0D80      FBS     15E0      FBS001  15E6    
    FBSYMB  618C      FCOMP   0D3A      FCOMPB  6126      FDIV    0FF4    
    FDVSR   8354      FDVSR1  8355      FDVSR2  8356      FDVSR8  835C    
    FHALF   0008      FLAG    8345      FLTERR  836C      FLTNDX  8354    
    FLTONE  600E      FMULT   0E88      FORMA   77FC      FORMA2  7822    
    FORNET  8317      FPOS1   006A      FPSIGN  03DC      FREPTR  8340    
    FSUB    0D7C      GDST    8302      GDST1   8303      GDTECT  6050    
    GET     6C9A      GET1    6C9E      GETCGR  60D0      GETCH   60AE    
    GETCH1  60BC      GETCH2  6FDE      GETCHG  60C0      GETCHR  6FBA    
    GETG    6CCA      GETG2   6CCE      GETI01  7FA0      GETI02  7FAC    
    GETI03  7FC0      GETINT  7F8C      GETL10  6764      GETL1Z  68DA    
    GETNB   6FAC      GETNB1  6FAE      GETSTG  61A2      GETSTK  610E    
    GETSTR  736C      GETV    187C      GETV1   1880      GO      66D6    
    GOSUB   673A      GOSUB2  673C      GOSUBZ  0087      GOT32   677E    
    GOT33   6792      GOT35   6798      GOTO    675C      GOTO20  675E    
    GOTO31  679C      GOTO32  67A6      GOTO33  67BA      GOTO34  67C8    

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0102
    GOTO35  67C4      GOTO36  67CE      GOTO40  67DA      GOTO50  67EA    
    GOTO90  670A      GOTO95  670E      GOTOZ   0086      GOZ     0085    
    GOZTOK  7FC9      GREAD   7EB4      GREAD1  7EA6      GREATR  6A7E    
    GRINT   79EC      GRMRAX  0002      GRMWAX  0402      GRMWDX  0400    
    GSRC    8354      GSRC1   8355      GTZ     00C0      GVWITE  7FDA    
    GWITE1  7ECA      GWRITE  7ED8      IF      68A6      IFZ     0084    
    IFZ10   68DE      IFZ20   68FA      IFZ25   6904      IFZ27   6910    
    IFZ28   691A      IFZ30   6928      IFZ35   692E      IFZ40   6934    
    IFZ5    68D0      IFZ50   693A      IMAGEZ  00A3      INT01   7A20    
    INT02   7A40      INT03   7A4A      INT04   7A60      INTRIN  8338    
    IO      7B48      JEQ1C   68EC      JNESY1  7E36      JNESYN  7F00    
    JOYX    8377      JOYY    8376      KEYBRD  8375      KEYTAB  CB00    
    LB10    700D      LB100   700B      LBAST   7011      LBCPMO  6146    
    LBE     7013      LBLPZ   6F81      LBPER   7012      LBSPC   7010    
    LBZER   7014      LEDEND  6B42      LEDERR  6B46      LEDEX   6B28    
    LEDLE   6A90      LENGTH  6FE2      LESS    6A70      LETCON  69A0    
    LEXP    6CE2      LFALSE  6AB8      LINUM   8312      LISTZ   0002    
    LLC     0020      LN10    0020      LNBUF   8336      LNTAB   7FC8    
    LNZ     00C9      LOG10E  0018      LOGP    00B8      LOGQ    00E2    
    LOGZ5A  76F6      LOGZZ   76C2      LOGZZ3  76D6      LOGZZ5  76F2    
    LOGZZ6  774C      LOGZZ7  7754      LOGZZ9  776E      LOWUP   7FEE    
    LPAR    6F6C      LPARZ   00B7      LSUBP   8348      LT10    6A82    
    LT15    6A88      LTAB    6A54      LTBLEN  001C      LTRUE   6ABE    
    LTST01  6A92      LTST15  6AB0      LTST20  6AE0      LTST90  6AC2    
    LTSTAB  6ADA      LTSTEQ  6AB6      LTSTGE  6AB4      LTSTGT  6AD6    
    LTSTLE  6AD0      LTSTLT  6AD2      LTSTNE  6ABC      LTSTXX  6AB4    
    LU01    7FF8      LW10    700C      LW100   700A      LWCNE   7002    
    LWCNF   7004      LWCNP   7000      LWCNS   6000      MAXKEY  000A    
    MEMCHG  72CE      MEMCHK  72D8      MERGEZ  0008      MINUS   6B4A    
    MINUSZ  00C2      MNUM    8302      MNUM1   8303      MOTION  837A    
    MOVF1   6452      MOVFA2  645A      MOVFAC  6434      MOVRM1  7A74    
    MOVRM2  7A76      MOVRM4  7A88      MOVRM5  7A6A      MOVROM  7A70    
    MVDN    7F7E      MVDN2   7F8A      MVUP    6F98      MVUP05  6FA4    
    NABS    6CFA      NATN    6D16      NCOS    6D1C      NEGPAD  7D00    
    NEXP    6D22      NEXT    0070      NEXTZ   0096      NFOR    7000    
    NINT    6D28      NLET    6948      NLET05  694C      NLET10  6978    
    NLET15  6982      NLOG    6D2E      NLPR    6E68      NMIN10  6E8C    
    NMINUS  6E82      NNEXT   7230      NOLED   664E      NOLEDL  64FA    
    NONUD   664E      NOTZ    00BD      NPLUS   6E96      NSGN    6D34    
    NSIN    6D64      NSQR    6D6A      NSTRCN  7442      NTAB    69FE    
    NTABLN  0056      NTAN    6D70      NUDE10  64F4      NUDEND  65F0    
    NUDG05  64B0      NUDND1  65E6      NUDND2  65F4      NUDND3  6602    
    NUDND4  660A      NUDNDL  64FE      NUDTAB  8328      NUMC49  66A6    
    NUMCHK  6B92      NUMCON  6684      O0AND   6DFA      O0AND1  6E0E    
    O0AND2  6E14      O0NOT   6E2E      O0OR    6E1C      O0XOR   6E50    
    OEZ     8314      OFFSET  7D6C      OLDZ    0005      ON      66DA    
    ON20    6710      ON30    671A      ON40    6726      ON50    6730    
    ONBRK   66D0      ONERR   66C4      ONWARN  66CA      ORZ     00BA    
    OVEXP   0FC2      P05     648A      P10     6492      P17     64A8    
    P17L    64C2      PABPTR  8304      PAD0    8300      PAD1    8301    
    PAD5F   835F      PADC2   83C2      PAGE1   6000      PAGE2   6002    
    PAGER   7FFA      PAGSEL  607A      PARCOM  6F74      PARSE   6480    
    PARSEG  6470      PGMC10  6C8E      PGMCH   6410      PGMCHR  6C74    
    PGMPT1  832D      PGMPTR  832C      PGMSUB  6C7A      PI2     0028    
    PI4     0038      PLAYER  8374      PLUS    6B1E      PLUSZ   00C1    
    POLY    779A      POLY01  77B8      POLY02  77CA      POLY03  77E8    
    POLYW   7782      POLYX   77A6      POLYX1  77AA      POP     7B16    
    POP1    7B2A      POPSTK  60D4      PRGFLG  8344      PROAZ   8310    

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0103
    PSCAN   7C56      PSHPRS  6B9C      PSYM    6884      PUSH    7AF2    
    PUSH1   7B0C      PUT1    6CB2      PUTCHR  7F6E      PUTG2   6CD8    
    PUTSTK  60F2      PUTV    641E      PUTV1   6422      PWARN   6DBC    
    PWRG01  7554      PWRG02  754C      PWRG05  75C4      PWRJ10  7500    
    PWRJ30  74F2      PWRJ40  7516      PWRJ41  752E      PWRJ45  7540    
    PWRRTN  752A      PWRTN2  7836      PWRTN3  796C      PWRZZ   7492    
    PWRZZ1  7576      PWRZZ2  7596      PWRZZ3  7560      PWRZZ4  757E    
    PWRZZ5  75BE      PZ      8312      QUOTE   0022      QUOTEZ  00C7    
    QZ      8316      R0      0000      R0LB    83E1      R1      0001    
    R10     000A      R10LB   83F5      R11     000B      R11LB   83F7    
    R12     000C      R12LB   83F9      R13     000D      R13LB   83FB    
    R14     000E      R14LB   83FD      R15     000F      R15LB   83FF    
    R1LB    83E3      R2      0002      R2LB    83E5      R3      0003    
    R3LB    83E7      R4      0004      R4LB    83E9      R5      0005    
    R5LB    83EB      R6      0006      R6LB    83ED      R7      0007    
    R7LB    83EF      R8      0008      R8LB    83F1      R9      0009    
    R9LB    83F3      RAMFLG  8389      RAMPTR  830A      RAMTOP  8384    
    RAND16  83D4      RANDOM  8378      RANERR  6F64      RANGE   6F30    
    REMZ    009A      RESET   006A      RESOLV  7946      RESTOZ  0094    
    RETRN   6DEC      RETU30  6822      RETU40  6838      RETURN  67F8    
    RETURZ  0088      ROLIN   7AC4      ROLIN1  7AD4      ROLIN2  7AE0    
    ROLOT1  7AA6      ROLOUT  7A90      ROUNU   0FB2      ROUNUP  0F64    
    RPARZ   00B6      RPI2    0030      RTNADD  8326      RTNG    6630    
    RUNZ    00A9      SADD    0D84      SADDR   83D2      SAVEG   83CB    
    SAVEZ   0007      SAVRE2  1E90      SAVREG  1E8C      SAVRTN  7AB2    
    SCLEN   8355      SCOMPB  0D42      SCROLL  7ADA      SDIV    0FF8    
    SEETW2  6F02      SEETW4  6F0A      SEETW6  6F26      SEETW8  6F2A    
    SEETWO  6EF0      SET     6192      SETREG  1E7A      SGNZ    00D1    
    SIGN    8375      SIN01   7906      SIN02   790A      SIN03   7928    
    SIN04   7930      SINP    010C      SINZZ   78C0      SKPLN   662A    
    SKPS01  6624      SKPSTR  6618      SMB     61DC      SMB02   6202    
    SMB04   6210      SMB05   6214      SMB06   622C      SMB08   6232    
    SMB51   6246      SMB57   6268      SMB71   62FC      SMBB    61A8    
    SMBB10  61BE      SMBO10  6236      SMBO20  626E      SMBO25  6274    
    SMBO40  62B6      SMBO41  62B8      SMBO50  6240      SMBO70  62D2    
    SMBO71  62F6      SMTSEP  65C4      SMTSRT  831E      SMULT   0E8C    
    SPECTB  7FD6      SPEED   6EE2      SQR01   7878      SQR02   78A8    
    SQR03   78AE      SQRP    0050      SQRQ    006A      SQRTEN  0010    
    SQRZZ   783A      SREF    831C      SSEPZ   0082      SSUB    0D74    
    STACK   8373      STATUS  837C      STCOD2  6981      STCODE  6188    
    STKADD  8373      STKCHK  6DC0      STKDAT  8372      STKEND  83BA    
    STKMOV  60E8      STKRTN  6DF0      STLN    8330      STMTTB  69FC    
    STND12  83AE      STOP    665E      STREND  831A      STRINZ  00C7    
    STRSP   8318      STVDP   18AE      STVDP3  18AA      STVSPT  8324    
    SUBTAB  833A      SUBXIT  78D2      SUBZ    00A1      SYM     6312    
    SYM1    6320      SYMB    61B4      SYMB10  68A2      SYMB20  687C    
    SYMBOL  0376      SYMTA1  833F      SYMTAB  833E      SYNCHK  6400    
    SYNERR  6D60      TABSAV  0392      TAN01   7970      TAN3P8  0048    
    TANPI8  0040      TANZZ   7940      TEMP2   836C      TENCNS  7B64    
    THENZ   00B0      TIME    8379      TIMES   6B56      TOZ     00B1    
    TRACE   6672      TRACL   65D4      TREMZ   0083      TRIERR  7938    
    TYPE    836D      UDF     0006      UNBRKZ  008F      UNQSTZ  00C8    
    USINGZ  00ED      VAR0    8300      VAR5    8310      VAR9    8316    
    VARA    832A      VARW    8320      VARW1   8321      VARY    8304    
    VARY2   8306      VDPSTS  837B      VGWITE  7FC0      VPOP    6C2A    
    VPOP10  6C46      VPOP18  6C6C      VPOP20  6C6E      VPSH15  6BC4    
    VPSH19  6BE8      VPSH20  6BF2      VPSH23  6C1A      VPSH25  6C1E    
    VPSH27  6C26      VPUSH   6BAA      VPUSHG  61BA      VROAZ   03C0    

 99/4 ASSEMBLER
CRUNCHS                                                      PAGE 0104
    VSPTR   836E      VSPTR1  836F      WARN    0009      WARNZ   00A6    
    WARNZZ  6662      WRVDP   4000      WS      83E0      WSM     831A    
    WSM2    831C      WSM4    831E      WSM6    8320      WSM8    8322    
    XFLAG   8316      XGRMRD  9800      XORZ    00BC      XPT     837F    
    XTFAC1  7B52      XTFACZ  7B34      XVDPRD  8800      XVDPWD  8C00    
    YPT     837E    
  0000 ERRORS
 

836C      THENZ   00B0      TIME    8379      TIMES   6B56    
    TOZ     00B1      TRACE   6672      TRACL   65D4      TREMZ   0083    
    TYPE    836D      UDF     0006      UNQSTZ  00C8      VAR5    8310    
    VAR9    8316      VARA    832A      VARW    8320      VARW1   8321    
    VDPSTS  837B      VGWITE  7FC0      VGZ1    7FCE      VPOP    6C2A    
    VPOP10  6C46      VPOP18  6C6C      VPOP20  6C6E      VPSH15  6BC4    
    VPSH19  6BE8      VPSH20  6BF2      VPSH23  6C1A      VPSH25  6C1E    
 

Rich

Link to comment
Share on other sites

Does anyone else get a crashed console (I.E. on real hardware) when letting RXB autoload the LOAD file from the WarZone2.DSK after the initial black screen with white writing has shown who wrote it and distributed it?

 

I've tried Classic99 and it doesn't crash with RXB 2022, I've tried TI XB loaded on real hardware and it works ok, along with XB2.9 on hardware which also works well.

 

I'm trying to track down if there's a problem with my Pi Pico device.

Link to comment
Share on other sites

15 hours ago, JasonACT said:

Does anyone else get a crashed console (I.E. on real hardware) when letting RXB autoload the LOAD file from the WarZone2.DSK after the initial black screen with white writing has shown who wrote it and distributed it?

 

I've tried Classic99 and it doesn't crash with RXB 2022, I've tried TI XB loaded on real hardware and it works ok, along with XB2.9 on hardware which also works well.

 

I'm trying to track down if there's a problem with my Pi Pico device.

I actually did not know I had that game, but looked anyways.

 

On an original TI it loaded and ran fine with RXB's 2015, 2022 and 2023. This was from a floppy however, cannot help with the Pi Pico as I do not own one.

On Classic it loaded and ran fine except that the fire key 'Q' did nothing. Tried others but they did not seem to work either. Difficult to say for sure as survival time is quite brief without being able to fire. I presume this is a keyboard issue on my setup as the other keys worked.

  • Like 2
  • Thanks 1
Link to comment
Share on other sites

1 hour ago, MikeV said:

On an original TI it loaded and ran fine with RXB's 2015, 2022 and 2023. This was from a floppy however, cannot help with the Pi Pico as I do not own one.

On Classic it loaded and ran fine except that the fire key 'Q' did nothing. Tried others but they did not seem to work either. Difficult to say for sure as survival time is quite brief without being able to fire. I presume this is a keyboard issue on my setup as the other keys worked.

Thanks!

 

I've located & downloaded RXB 2015 and 2020 - both work fine, it seems to only be a problem for me with 2022 (I'll try and find 2023).

 

EDIT: Oh, I see 2023 is not released yet.

Edited by JasonACT
Link to comment
Share on other sites