Jump to content
IGNORED

Original TI Source Code


webdeck

Recommended Posts

I am wondering how much of original TI source code is available out there.  Not decompiled source from ROMs/GROMs, but the original source with comments, which can be a treasure trove of information.

 

What I have found so far:

  • TI-99/4A Console ROM source code (included in The Cyc)
  • RXB purchased the Extended Basic ROM and GROM source code (RXB source code)

 

Is there anything else out there?

  • Like 1
Link to comment
Share on other sites

20 minutes ago, webdeck said:

I am wondering how much of original TI source code is available out there.  Not decompiled source from ROMs/GROMs, but the original source with comments, which can be a treasure trove of information.

 

What I have found so far:

  • TI-99/4A Console ROM source code (included in The Cyc)
  • RXB purchased the Extended Basic ROM and GROM source code (RXB source code)

 

Is there anything else out there?

ET at Sea, but was incomplete.

 

Link to comment
Share on other sites

TI Forth source is available as CV182.DSK (“03NOV82”) and CV183.DSK (“08DEC82”) on WHTech. The support code is pretty well documented, but the word definitions in the resident dictionary have little to no documentation. In a way, you could say they are self-documenting because they are mostly DATA statements composed of lists of execution addresses (cfas) that are mnemonic. and follow corresponding high-level Forth code. I have added  my own comments to a lot of the code (though not much of the dictionary code) in “Appendix O TMS9900 Assembly Source Code for TI Forth” in my second edition of the TI Forth Manual available in the “Forth – Software” section of the first post of TI-99/4A development resources.

 

...lee

Link to comment
Share on other sites

16 minutes ago, apersson850 said:

I would have liked the source code for the p-code card as well as at least a kernel unit with interface code (which is delivered with many p-systems, but not the one for the TI 99/4A).

There is PSystem source code for the Geneve for MDOS mode that is out there.

 

Beery

Link to comment
Share on other sites

On 9/27/2020 at 1:34 PM, FarmerPotato said:

TI writer and Editor Assembler. There’s a thread somewhere. 

REA has source code for Editor Assembler but have to go back to RXB Version 1005 to see it.

Oh and I released Disk Manager 4 which at time was updated TI version.

Disk Manager Cart that you could use 9 Disks, RAMDISK and even demo a GPL fake Disk drive. 

  • Like 1
Link to comment
Share on other sites

Spoiler

 
********************************************************************************
* DISK MANAGER 5 * by RICH GILBERTSON * UPGRADE OF Disk Manger II module by TI *
********************************************************************************
*
* FLAGS
*
N      EQU   0
YN     EQU   1
NUMBER EQU   2
Y      EQU   2
TWO    EQU   >32
THREE  EQU   >33
FOUR   EQU   >34
NINE   EQU   >39
*
* KEYS
*
CLEAR  EQU   2
REDO   EQU   6
DOWN   EQU   10
PROCD  EQU   12
BEGIN  EQU   14
BACK   EQU   15
SPACE  EQU   32
*
* GROM
*
G0000  EQU   >0000
*
* CPU
*
MBASE  EQU   >8300
REDOX  EQU   >8306
BEGINX EQU   >8308
BACKX  EQU   >830A
SCRADD EQU   >830C            * SCReen ADDress
SECNUM EQU   >8316            * SECtor NUMber
DSKNUM EQU   >8318            * DiSK NUMber
IOSEC  EQU   >8319            * Input Output SECtor bit
BUFADD EQU   >831A            * BUFfer ADDress
MCFLAG EQU   >8329            * Master/Copy FLAG
LOGFLG EQU   >832A            * LOG FLaG
ACODE  EQU   >832D            * Access CODE
DFLAG  EQU   >832E            * Disk FLAG
ONEDSK EQU   >8330            * ONE DiSK flag
OVROW  EQU   >8339            * Old Vertical ROW
OVCOL  EQU   >833A            * Old Vertical COL
CURSOR EQU   >833D
OUTFLG EQU   >833E            * OUTput FLAG for catalog device
ABORTF EQU   >833F            * ABORT Flag
ADINFO EQU   >8340            * ADditional INFO buffer offset
MESNUM EQU   >8349            * MESsage NUMber
FAC    EQU   >834A
FAC1   EQU   >834B
FAC2   EQU   >834C
FAC3   EQU   >834D
FAC4   EQU   >834E
FAC5   EQU   >834F
FAC6   EQU   >8350
FAC7   EQU   >8351
FAC8   EQU   >8352
FAC9   EQU   >8353
ERCODE EQU   >8354
FAC11  EQU   >8355
FAC12  EQU   >8356
FAC13  EQU   >8357
FAC17  EQU   >835B
ARG    EQU   >835C
ARG1   EQU   >835D
ARG2   EQU   >835E
MEMSIZ EQU   >8370
DATSTK EQU   >8372
SUBSTK EQU   >8373
KEY    EQU   >8375
ITIMER EQU   >8379
STATUS EQU   >837C
VCHAR  EQU   >837D
VROW   EQU   >837E
VCOL   EQU   >837F
*
* VDP
*
VBUFF  EQU   >0B10            * Vdp BUFFer
VLEN   EQU   >0B19            * Length byte
NUMAU  EQU   >0C12            * NUMber of AUs
SECTRK EQU   >0C14            * SECtors per TRacK
SAVCPU EQU   >0C28            * SAVe CPU >0C28 - >0C72 (>8300 - >834A)
TRACKS EQU   >0C1C            * Number of TRACKS
DMAST  EQU   >0C72
DCOPY  EQU   >0C8A
SIDES  EQU   >0E10            * Number of SIDES
DENSTY EQU   >0E11            * DENSITY
********************************************************************************
       GROM >6000
       TITL 'DM 2 GROM >6000'
       DATA >AA02,>0100,>0000,MENU1,>0000,>0000,>0000,>0000
 
       AORG >002A
***************************** COPY FILE ****************************************
FCOPY  DST   FCOPY,@REDOX
       CALL  HEADER           * 'COPY FILE'
       BYTE  >24
FCOPY2 CALL  GETDRIVEGETINPUT         * 'MASTER DISK (1-9)?'
       BYTE  >03,>FF,>FF,>FF,>FF,>FF  * >03 = VROW
       BYTE  >4F,>00                  * >4F = 'FILENAME?'
       CALL  FILECOPY
       CALL  CMDDONE
       BR    FCOPY2
***************************** RENAME FILE **************************************
FRENA  DST   FRENA,@REDOX
       CALL  HEADER           * 'RENAME FILE'
       BYTE  >25
       CALL  GETDRIVEGETINPUT         * 'MASTER DISK (1-9)?'
       BYTE  >03,>FF,>FF,>00,>FF,>34  * >03 = VROW
       BYTE  >34,>00                  * >34 = 'NEW FILENAME?'
       DST   >0C75,@FAC6      * POINTER TO OLD BUFFER NAME
       DST   >0C8D,@FAC4      * POINTER TO NEW BUFFER NAME
       ST    V@DMAST,@FAC2    * DRIVE NUMBER
       CALL  RENAME
       CALL  CHKERR
       CALL  CMDDONE
       BR    FRENA
***************************** DELETE FILE **************************************
FDEL   CALL  HEADER           * 'DELETE FILE'
       BYTE  >26
       DST   FDEL,@REDOX
       CALL  DSPLY            * 'SELECTIVE (Y/N)?'
       BYTE  >FE,>03,>62,>FF
       CALL  INKEY
       BYTE  YN,>0C,>10,Y
       CEQ   >02,V@>0C10      * Y?
       BS    FDEL3            * Yes
FDEL2  CALL  GETDRIVEGETINPUT * 'MASTER DISK (1-9)?'
       BYTE  >04,>FF,>FF,>00  * >04 = VROW
       BYTE  >00,>FF
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CALL  DELETE
       CALL  CMDDONE
       BR    FDEL2
FDEL3  CALL  GETDRIVEGETINPUT * 'MASTER DISK (1-9)?'
       BYTE  >04,>00,>00,>00  * >04 = VROW
       BYTE  >00,>00
       CALL  BLINES
       BYTE  >03,>08
       DST   >0302,@VROW
       CALL  CATALOGER
       CALL  DSPLY            * ' FILENAME   SIZE    TYPE   P'
                              * '__________  ____   _______ _'
       BYTE  >FE,>06,>38,>FF
FDEL4  DCZ   V*>8302          * FILE COUNTER
       BS    FDEL8
       DST   >0802,@VROW
       CALL  STEPFILE
       CALL  BLINES
       BYTE  >12,>17
       CALL  DSPLY            * 'DELETE (Y/N)?'
       BYTE  >FE,>0B,>45,>FF
       CALL  INKEY
       BYTE  YN,>0C,>1E,N
       CZ    V@>0C1E          * N? DELETE
       BS    FDEL7            * No
       CLOG  >08,V@>0E1E      * FILE PROTECTED?
       BS    FDEL5            * No
       CALL  OVERIDEPROTECT
       CZ    V@>0C20          * N? OVERRIDE
       BS    FDEL7            * No
       CALL  PROTECTION       * UNPROTECT OR PROTECT
       BYTE  >0C,>75,>0C,>72
FDEL5  CALL  DELETE
       CEQ   >F8,@DFLAG
       BR    FDEL6
       DDECT @>8302           * FILE COUNTER-1
FDEL6  CALL  BLINES
       BYTE  >0D,>0D
FDEL7  CALL  WORKNG           * SKIP FILE AND GET NEXT FILE
       PUSH  @>8302
       PUSH  @>8303
       CALL  BLINES
       BYTE  >08,>12
       DST   >0302,@VROW
       CALL  CATALOGER
       ST    *STATUS,@>8303
       ST    *STATUS,@>8302
       B     FDEL4
FDEL8  CALL  CMDDONE
       BR    FDEL
***************************** MODIFY FILE PROTECTION ***************************
FMODP  CALL  HEADER           * 'MODIFY FILE PROTECTION'
       BYTE  >28
       DST   FMODP,@REDOX
FMODP2 CALL  GETDRIVEGETINPUT * 'MASTER DISK (1-9)?'
       BYTE  >03,>FF,>FF,>00  * >03 = VROW
       BYTE  >00,>00
       DST   FMODP2,@REDOX
       CALL  DSPLY            * 'PROTECT (Y/N)?'
       BYTE  >FE,>07,>46,>FF
       CALL  INKEY
       BYTE  YN,>0C,>20,N
       CALL  WORKNG
       DST   >0C75,@FAC4      * POINTER TO BUFFER NAME
       ST    V@DMAST,@FAC2    * DRIVE NUMBER
       CLR   @FAC3            * UNPROTECT
       CZ    V@>0C20          * N? PROTECT
       BS    FMODP3           * No
       INV   @FAC3            * PROTECT
FMODP3 CALL  PROTCT
       CALL  CHKERR
       CALL  CMDDONE
       BR    FMODP
***************************** CATALOG DISK *************************************
DCAT   CALL  HEADER           * 'CATALOG DISK'
       BYTE  >2A
       DST   DCAT,@REDOX
       CALL  GETDRIVEGETINPUT * 'MASTER DISK (1-9)?'
       BYTE  >03,>FF,>00,>00  * >03 = VROW
       BYTE  >00,>00
       CALL  DSPLY            * 'WHERE DO YOU WANT LISTING?'
                              * '1 SCREEN        '
                              * '2 SOLID STATE PRINTER         '
                              * '3 PIO INTERFACE               '
                              * '4 OTHER'
                              * 'YOUR CHOICE?'
       BYTE  >FE,>06,>40,>F5,>41,>F5
       BYTE  >4E,>FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>25,FOUR
       ST    V@>0C25,@KEY
       DEC   @KEY
       CASE  @KEY
       BR    DCAT4            * Screen
       BR    DCAT1            * Thermal Printer
       BR    DCAT2            * PIO
       BR    DCAT3            * Device input
DCAT1  ST    >02,V@>0CCF      * LENGTH BYTE
       DST   >5450,V@>0CD0    * TP output
       B     DCAT4
DCAT2  MOVE  4,G@G61B1,V@>0CCF * Length byte
       B     DCAT4
G61B1  STRI  'PIO'
DCAT3  CALL  DSPLY            * 'DEVICE NAME?'
       BYTE  >FE,>0C,>50,>F5,>FF
       CALL  GETDEVICENAME    * GET DEVICE NAME
       BYTE  >0C,>D0,>38,>0C,>CF
DCAT4  CALL  WORKNG
       CALL  DSPLY            * 'PRESS :         '
                              * '                '
                              * 'CLEAR TO ABORT COMMAND'
       BYTE  >FE,>16,>5C,>FF
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CLR   @OUTFLG          * OUTPUT FLAG OFF
       CEQ   >02,V@>0C21
       BR    DCAT5
       CEQ   >01,V@>0C23
       BR    DCAT5
       CEQ   >01,V@>0C25      * Screen ouput
       BS    DCAT5
       ST    >FF,@OUTFLG      * OUTPUT FLAG ON
       CALL  EXIO             * OPEN,VAR/DIS/OUT/SEQ
       BYTE  >00,>12
DCAT5  CALL  BLINES
       BYTE  >03,>12
       CALL  DSPLY            * VROW=>03 VCOL=>02
       BYTE  >FE,>03,>FF
       CALL  CATALOGER
       DCZ   V*>8302
       BS    DCAT7
       CALL  DSPLY            * ' FILENAME   SIZE    TYPE   P'
                              * ' ________   ____   _______ _'
       BYTE  >FE,>11,>38,>FF
       CZ    @OUTFLG          * OUTPUT FLAG OFF?
       BS    DCAT6            * Yes
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>00,>04
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>11,>12
DCAT6  BR    PAUSE
DCAT7  CZ    @OUTFLG          * OUTPUT FLAG OFF?
       BS    PAUSE            * Yes
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>00,>04
PAUSE  DCZ   V*>8302          * FILE COUNT
       BS    PAUSE4
       CALL  STEPFILE
       DCZ   @>832B
       BR    PAUSE3
       SCAN                   * SCAN KEYS
       BR    PAUSE3
       CEQ   CLEAR,@KEY       * FCTN 4
       BS    PAUSE4
       CEQ   SPACE,@KEY       * SPACE?
       BR    PAUSE3
PAUSE2 SCAN                   * SCAN KEYS
       BR    PAUSE2
       CEQ   SPACE,@KEY       * SPACE?
       BR    PAUSE2
PAUSE3 B     PAUSE
PAUSE4 CZ    @OUTFLG          * OUTPUT FLAG OFF?
       BS    PAUSE5            * Yes
       CALL  EXIO             * CLOSE CODE
       BYTE  >01
PAUSE5 CALL  CMDDONE
       BR    DCAT
****************************** CATALOGER
CATALOGER DCLR  @SECNUM       * SECTOR NUMBER TO READ OR WRITE
          ST    >FF,@IOSEC    * SET READ SECTOR BIT
          DST   >0E12,@BUFADD * BUFFER ADDRESS
          CALL  SECTORREADWRITE
          CALL  CHKERR
          CALL  DSPLY         * 'DSK  -  DISKNAME='
          BYTE  >35,>FF
          FMT
          COL   5
          SCRO  48
          HSTR  1,@DSKNUM     * DRIVE NUMBER
          FEND
          ST    @OVCOL,@VCOL
          CALL  CVRC
          MOVE  10,V@>0E12,V*SCRADD * COPY BUFFER NAME
          DST   >0640,@FAC
          ST    >C8,@FAC3
          DST   >0E4A,@FAC4
CATALOGER1 ST    V*FAC4,@FAC6
          CEQ   >FF,@FAC6
          BR    CATALOGER2
          DSUB  >0008,@FAC
          B     CATALOGER4
CATALOGER2 CLOG  >80,@FAC6
          BS    CATALOGER3
          DDEC  @FAC
CATALOGER3 SLL   >01,@FAC6
          CZ    @FAC6
          BR    CATALOGER2
CATALOGER4 DINC  @FAC4
          DEC   @FAC3
          BR    CATALOGER1
          DST   @FAC,@>8302
          DST   V@>0E1C,@>8304
          DSUB  @>8302,@>8304
          CALL  ADSPLY        * 'AVAILABLE='
          BYTE  >F5,>36,>FF
          CALL  G70DC         * SHOW NUMBER
          BYTE  >02
          CALL  ADSPLY        * 'USED='
          BYTE  >F0,>01,>37,>FF
          DDECT @>8304
          CALL  G70DC         * SHOW NUMBER
          BYTE  >04
          DST   >0001,@SECNUM * SECTOR NUMBER TO READ OR WRITE
          DST   >0D10,@BUFADD * BUFFER ADDRESS
          CALL  SECTORREADWRITE
          CALL  CHKERR
          DST   >0E12,@BUFADD * BUFFER ADDRESS
          DST   >0D10,@>8302
          RTN
STEPFILE DST   >0E12,@BUFADD  * BUFFER ADDRESS
       DST   V*>8302,@SECNUM  * SECTOR NUMBER TO READ OR WRITE
       CALL  SECTORREADWRITE
       CALL  CHKERR
       DST   V@>0E20,@>8304
       DINC  @>8304
       CALL  G6377
       CALL  CVRC
       MOVE  10,V@>0E12,V*SCRADD * MOVE BUFFER
       MOVE  10,V@>0E12,V@>0C75  * COPY BUFFER
       ADD   >0B,@VCOL
       CALL  G70DC            * SHOW NUMBER
       BYTE  >04
       CLOG  >01,V@>0E1E      * FILE TYPE
       BS    STEPFILE1
       CALL  DSPLY            * 'PROGRAM'
       BYTE  >E6,>39,>FF
       BR    STEPFILE6
STEPFILE1 CLR   @>832F
       CLOG  >02,V@>0E1E      * FILE TYPE
       BS    STEPFILE2
       CALL  DSPLY            * 'INT/'
       BYTE  >E6,>3B,>FF
       BR    STEPFILE3
STEPFILE2 CALL  DSPLY         * 'DIS/'
       BYTE  >E6,>3A,>FF
STEPFILE3 CLR   @>832F
       CLOG  >80,V@>0E1E      * FILE TYPE
       BS    STEPFILE4
       CALL  DSPLY            * 'VAR'
       BYTE  >3C,>FF
       BR    STEPFILE5
STEPFILE4 CALL  DSPLY         * 'FIX'
       BYTE  >3D,>FF
STEPFILE5 CLR   @>8304
       ST    V@>0E23,@>8305   * FILE SIZE
       CALL  G70E2            * SHOW NUMBER
       BYTE  >04
STEPFILE6 CLOG  >08,V@>0E1E   * FILE TYPE
       BS    STEPFILE7
       CALL  DSPLY            * 'Y'
       BYTE  >FB,>1D,>01,>F5,>FF
       BR    STEPFILE8
STEPFILE7 CALL  DSPLY         * VROW+1 VCOL=2
       BYTE  >F5,>FF
STEPFILE8 CALL  G63A9
       DINCT @>8302
       RTN
G6377  CEQ   >02,V@>0C21
       BR    G63A8
       CEQ   >01,V@>0C23
       BR    G63A8
       CEQ   >2D,V@>00C6
       BR    G6392
       MOVE  >0160,V@>0100,V@>00E0 * SCROLL UP 2 LINES
       BR    G6399
G6392  MOVE  >01A0,V@>00C0,V@>00A0 * SCROLL UP 2 LINES
G6399  ST    SPACE,V@>0240
       MOVE  31,V@>0240,V@>0241    * BLANK 1 LINE
       DST   >1202,@VROW
G63A8  RTN
G63A9  CEQ   >02,V@>0C21
       BR    G63BF
       CEQ   >01,V@>0C23
       BR    G63BF
       CZ    @OUTFLG          * OUTPUT FLAG OFF?
       BS    G63BF            * Yes
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>12,>12
G63BF  RTN
***************************** DISK BACKUP **************************************
DBKUP  CALL  HEADER           * 'BACKUP DISK'
       BYTE  >2B
       DST   DBKUP,@REDOX
DBKUP1 ST    >F8,V@>0C73
       ST    >F8,V@>0C8B
       CALL  DSPLY            * 'SELECTIVE (Y/N)?'
       BYTE  >FE,>03,>62,>FF
       CALL  INKEY
       BYTE  YN,>0C,>1E,Y
DBKUP2 CALL  DSPLY            * 'MASTER DISK (1-9)?'
       BYTE  >FE,>04,>52,>FF
       CZ    @ONEDSK
       BS    DBKUP3
       ST    >31,@VCHAR       * 1
       BR    DBKUP4
DBKUP3 CALL  INKEY
       BYTE  NUMBER,>0C,>72,NINE
DBKUP4 CALL  CHECKDISK
       BYTE  >0C,>72,>0E,>12,>0C,>7F
       CHE   >F2,V@>0C73
       BS    DBKUP5
       CZ    @ONEDSK
       BS    DBKUP2
       CALL  BANK5
       CALL  FCTNBEEP
       BR    DBKUP2
DBKUP5 CALL  DSPLY            * 'COPY DISK (1-9)?'
       BYTE  >FE,>06,>53,>FF
       CZ    @ONEDSK
       BS    DBKUP6
       ST    >31,@VCHAR       * 1
       BR    DBKUP7
DBKUP6 CALL  INKEY
       BYTE  NUMBER,>0C,>8A,NINE
       CEQ   V@DCOPY,V@DMAST
       BR    DBKUP7
       CALL  XHONK
       BR    DBKUP5
DBKUP7 CALL  CHECKDISK
       BYTE  >0C,>8A,>0E,>12,>0C,>97
       CHE   >F1,@DFLAG
       BS    DBKUP8
       CZ    @ONEDSK
       BS    DBKUP5
       CALL  BANK5
       CALL  FCTNBEEP
       BR    DBKUP5
DBKUP8 CALL  DSPLY            * 'INITIALIZE NEW DISK' '(Y/N)?'
       BYTE  >FE,>08,>2F,>61,>FF
       CEQ   >F1,V@>0C8B
       BS    DBKUP9
       CEQ   >31,V@>0C8B
       BS    DBKUP9
       CALL  INKEY
       BYTE  YN,>0C,>1F,N
       BR    DBKUPA
DBKUP9 ST    >59,@VCHAR       * Y
       ST    >02,V@>0C1F      * Y
DBKUPA CEQ   >02,V@>0C1F      * Y?
       BR    DBKUPE           * No
       CLR   V@>0CA1          * START TO INITIALIZE
       MOVE  10,V@>0C7F,V@>0C97
       DST   >0C97,@>830E
       ST    >01,@>833C
       B     DBKUPC
DBKUPB INC   @>833C
DBKUPC CGT   >0A,@>833C
       BS    DBKUPD
       CEQ   SPACE,V*>830E
       BS    DBKUPD
       INC   V@>0CA1
       DINC  @>830E
       B     DBKUPB
DBKUPD CALL  DSPLY            * 'NEW DISKNAME?'
       BYTE  >FE,>09,>51,>FF
       CALL  GETINPUT         * GET INPUT
       BYTE  >0C,>97,>0A,>0C,>A1
       CALL  DSPLY
       BYTE  >F5,>FF
       CALL  FORMATINPUT
       B     DBKUPF
DBKUPE CEQ   >F1,V@>0C8B      * INITIALIZED DISK
       BS    DBKUP1
DBKUPF CALL  WORKNG
       CEQ   >02,V@>0C1F      * Y? INITIALIZE
       BR    DBKUPG           * No
       ST    V@DCOPY,@DSKNUM  * DRIVE NUMBER
       CALL  DINIT2
       DST   >0902,@VROW
       CALL  CATALOGER
DBKUPG CZ    V@>0C1E          * N? SELECTIVE
       BR    DBKUPH           * Yes
       CALL  DSPLY            * 'PRESS           '
                              * '                '
                              * 'CLEAR TO ABORT COMMAND'
       BYTE  >FE,>16,>5C,>FF
DBKUPH CZ    V@>0C1E          * N? SELECTIVE
       BR    DBKUPI           * No
       ST    >02,V@>0C20      * Set YES flag
DBKUPI CALL  G6B63
       DST   >0B02,@VROW
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       ST    >4D,@MCFLAG      * Master
       CALL  CATALOGER
       CALL  DSPLY            * ' FILENAME SIZE    TYPE   P'
                              * ' ________ ____   _______ _'
       BYTE  >FE,>0D,>38,>FF
DBKUPJ DCZ   V*>8302
       BS    DBKUPO
       DCEQ  >0001,@SECNUM    * SECTOR 1?
       BS    DBKUPK           * Yes
       CEQ   >02,V@>0C20      * Y? SELECTIVE
       BR    DBKUPK           * No
       CALL  G6B63
DBKUPK DST   >0F02,@VROW
       CALL  STEPFILE
       CZ    V@>0C1E          * N? SELECTIVE
       BS    DBKUPL           * No
       CALL  BLINES
       BYTE  >12,>17
       CALL  DSPLY            * 'COPY FILE' '(Y/N)?'
       BYTE  >FE,>12,>24,>61,>FF
       CALL  INKEY
       BYTE  YN,>0C,>20,N
       CALL  BLINES
       BYTE  >12,>12
       CALL  WORKNG
       CZ    V@>0C20          * N? COPY FILE
       BS    DBKUPM           * No
DBKUPL MOVE  10,V@>0C75,V@>0C8D
       CALL  FILECOPY2
DBKUPM CZ    V@>0C1E          * N? SELECTIVE
       BR    DBKUPN           * Yes
       SCAN                   * SCAN KEYS
       BR    DBKUPN
       CEQ   CLEAR,@KEY       * FCTN4
       BS    DBKUPO
DBKUPN PUSH  @>8310
       PUSH  @>8311
       CALL  BLINES
       BYTE  >0F,>10
       DST   >0F02,@VROW
       ST    *STATUS,@>8311
       ST    *STATUS,@>8310
       B     DBKUPJ
DBKUPO CALL  CMDDONE
       BR    DBKUP
***************************** MODIFIY DISK NAME ********************************
DMOD   CALL  HEADER           * 'MODIFY DISK NAME'
       BYTE  >2D
       DST   DMOD,@REDOX
       CALL  GETDRIVEGETINPUT * 'MASTER DISK (1-9)?'
       BYTE  >03,>FF,>00,>00  * >03 = VROW
       BYTE  >00,>00
       CALL  DSPLY            * 'NEW DISKNAME?'
       BYTE  >FE,>06,>51,>FF
       CALL  GETINPUT         * GET DISKNAME
       BYTE  >0C,>97,>0A,>0C,>A1
       CALL  WORKNG
       CALL  SECTORREADWRITE  * READ OLD DISKNAME
       CALL  CHKERR
       MOVE  10,V@>0C97,V@>0E12 * SET UP NEW DISKNAME
       CLR   @IOSEC             * SET WRITE SECTOR BIT
       CALL  SECTORREADWRITE    * WRITE NEW DISKNAME
       CALL  CHKERR
       CALL  CMDDONE
       B     DMOD
***************************** INITIALIZE DISK **********************************
DINIT  CALL  HEADER           * 'INITIALIZE NEW DISK'
       BYTE  >2F
       DST   DINIT,@REDOX
       ST    >F8,V@>0C73
       ST    >F8,V@>0C8B
       CALL  DSPLY            * 'MASTER DISK (1-9)?'
       BYTE  >FE,>03,>52,>FF
       ST    >31,@VCHAR       * 1
       CZ    @ONEDSK
       BR    DINIT1
       CALL  INKEY
       BYTE  NUMBER,>0C,>72,NINE
DINIT1 CALL  CHECKDISK
       BYTE  >0C,>72,>0E,>12,>0C,>7F
       CALL  DSPLY            * 'NEW DISKNAME?'
       BYTE  >FE,>06,>51,>FF
       CALL  GETINPUT         * GET INPUT
       BYTE  >0C,>97,>0A,>0C,>A1
       CALL  DSPLY            * VROW=>08
       BYTE  >FC,>08,>FF
       CALL  FORMATINPUT
       CALL  WORKNG
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CALL  DINIT2
       CALL  DSPLY            * VROW=>0C VCOL=>02
       BYTE  >FE,>0C,>FF
       CALL  CATALOGER
       CALL  CMDDONE
       BR    DINIT
DINIT2 CALL  INITIALIZEDISK
       CLR   V@>0E12
       MOVE  >00FF,V@>0E12,V@>0E13
       ST    >FF,V@>0E4A
       MOVE  >00C7,V@>0E4A,V@>0E4B
       DST   V@NUMAU,@>8312   * Number of AU
       DCLR  @>8310
       DDIV  >0008,@>8310
       DDEC  @>8310
       CLR   V@>0E4A
       MOVE  @>8310,V@>0E4A,V@>0E4B
       DCZ   @>8312
       BS    FORMATANDMAP2
       DADD  >0E4B,@>8310
       CLR   @>8332           * FLAG
       B     FORMATANDMAP1
FORMATANDMAP  SLL   >01,@>8332
FORMATANDMAP1 INC   @>8332
       DDEC  @>8312
       BR    FORMATANDMAP
       INV   @>8332
       ST    @>8332,V*>8310
FORMATANDMAP2  DCLR  @SECNUM    * SECTOR NUMBER
       CLR   @IOSEC             * SET READ SECTOR BIT
       DST   >0E12,@BUFADD      * BUFFER ADDRESS
       ST    >03,V@>0E4A
       MOVE  10,V@>0C97,V@>0E12 * DISK VOLUME NAME
       DST   V@NUMAU,V@>0E1C    * NUMBER OF AUs
       ST    V@SECTRK,V@>0E1E   * SECTORS PER TRACK
       DST   >4453,V@>0E1F      * Store DS
       CEQ   >0A,V@>0C27        * PROPRIETARY?
       BR    FORMATANDMAP3      * No
       DST   >4B50,V@>0E21      * Store KP
       B     FORMATANDMAP4
FORMATANDMAP3 DST >4B20,V@>0E21    * Store K
FORMATANDMAP4 ST  V@TRACKS,V@>0E23 * TRACKS PER SIDE
       ST    V@SIDES,V@>0E24    * NUMBER OF SIDES
       ST    V@DENSTY,V@>0E25   * DENSITY
       CALL  ABORT              * SECTORREADWRITE
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    FORMATANDMAP8
       DST   VBUFF,@BUFADD    * BUFFER ADDRESS
       CLR   V@VBUFF          * CLEAR THE VDP BUFFER
       MOVE  >00FF,V@VBUFF,V@>0B11
       DINC  @SECNUM          * SECTOR NUMBER+1
       CALL  ABORT            * SECTORREADWRITE
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    FORMATANDMAP8
       ST    >FF,@IOSEC       * SET READ SECTOR BIT
       DST   >0002,@>8310     * NEW SECTOR NUMBER 2
FORMATANDMAP5 DST   @>8310,@SECNUM   * SECTOR NUMBER
       CALL  ABORT            * SECTORREADWRITE
       CHE   >F8,@DFLAG
       BS    FORMATANDMAP7
       DST   @SECNUM,@>8312   * SAVE SECTOR NUMBER
       DST   @SECNUM,@>8314   * SAVE SECTOR NUMBER
       DSRL  >0003,@>8312
       DADD  >0E4A,@>8312
       ST    >01,@>8332
       DAND  >0007,@>8314
       DCZ   @>8314
       BS    FORMATANDMAP6
       SLL   @>8315,@>8332
FORMATANDMAP6 OR    @>8332,V*>8312
FORMATANDMAP7 DINC  @>8310
       DCEQ  V@NUMAU,@>8310   * Number of AU
       BR    FORMATANDMAP5
       DST   >0E12,@BUFADD    * BUFFER ADDRESS
       CLR   @IOSEC           * SET WRITE SECTOR BIT
       DCLR  @SECNUM          * SECTOR NUMBER
       CALL  ABORT            * SECTORREADWRITE
       CALL  CHKERR
       CALL  BLINES
       BYTE  >13,>13
FORMATANDMAP8 RTN
***************************** QUICK TEST ***************************************
TQICK  CLR   @ABORTF
       CALL  HEADER           * 'QUICK TEST'
       BYTE  >30
       DST   TQICK,@REDOX
TQICK1 ST    >F8,V@>0C73
       ST    >F8,V@>0C8B
       CALL  DSPLY            * 'DESTRUCTIVE TEST (Y/N)?'
       BYTE  >FE,>03,>4A,>FF
       CALL  INKEY
       BYTE  YN,>0C,>1E,N
       CEQ   >02,V@>0C1E      * Y? DESTRUCTIVE
       BR    TQICK2           * No
       CALL  DSPLY            * VROW=>04
       BYTE  >FC,>04,>FF
       CALL  FORMATINPUT
TQICK2 CALL  DSPLY            * 'MASTER DISK (1-9)?'
       BYTE  >FE,>07,>52,>FF
       ST    >31,@VCHAR       * 1
       CZ    @ONEDSK
       BR    TQICK3
       CALL  INKEY
       BYTE  NUMBER,>0C,>72,NINE
TQICK3 CALL  CHECKDISK
       BYTE  >0C,>72,>0E,>12,>0C,>7F
       CZ    V@>0C1E          * N? DESTRUCTIVE
       BR    TQICK4           * Yes
       CHE   >F2,V@>0C73
       BR    TQICK1
TQICK4 CALL  DSPLY            * 'LOOP (Y/N)?'
       BYTE  >FE,>09,>49,>FF
       CALL  INKEY
       BYTE  YN,>0C,>26,N
       CALL  DSPLY            * 'LOG ERRORS (Y/N)?'
       BYTE  >FE,>0A,>5F,>FF
       CALL  INKEY
       BYTE  YN,>0C,>10,N
       ST    V@>0C10,@LOGFLG
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TQICK5           * No
       CALL  DSPLY            * 'DEVICE NAME?'
       BYTE  >FE,>0B,>50,>F5,>FF
       CALL  GETDEVICENAME    * GET DEVICE NAME
       BYTE  >0C,>D0,>38,>0C,>CF
       CALL  G6AFF
TQICK5 CALL  WORKNG
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TQICK6           * No
       CALL  EXIO             * OPEN,VAR/DIS/OUT/SEQ
       BYTE  >00,>12
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>00,>03
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>00,>00
       CALL  EXIO             * CLOSE
       BYTE  >01
TQICK6 DCLR  V@>0C16
       DCLR  V@>0C18
       ST    >07,@VROW
       CALL  DSPLY            * VROW=>08 VCOL=>02
       BYTE  >FE,>08,>FF
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CEQ   >02,V@>0C1E      * Y? DESTRUCTIVE
       BR    TQICK7           * No
       CALL  INITIALIZEDISK
TQICK7 CALL  DSPLY            * 'PRESS           '
                              * '                '
                              * 'CLEAR TO ABORT COMMAND'
       BYTE  >FE,>16,>5C,>FF
TQICK8 CALL  ERRORSANDPASS
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CZ    V@>0C1E          * N? DESTRUCTIVE
       BR    TQICK9           * Yes
       CALL  READINGSECTORS
       B     TQICKA
TQICK9 CALL  TCOMPD
       BYTE  >FF
       BYTE  >F7
TQICKA CALL  ERRORSANDPASS2
       CEQ   >02,@ABORTF      * ABORT?
       BS    TQICKC           * Yes
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TQICKB           * No
       CALL  G6AE2
TQICKB CEQ   >02,V@>0C26      * Y? LOOP
       BS    TQICK8           * Yes
TQICKC CEQ   >02,@LOGFLG      * Y? LOG
       BR    TQICKD           * No
       CALL  G6AEF
TQICKD CALL  CMDDONE
       B     TQICK
***************************** COMPREHENSIVE TEST *******************************
TCOMP  CLR   @ABORTF
       CALL  HEADER           * 'COMPREHENSIVE TEST'
       BYTE  >31
       CALL  HEADER2
       BYTE  >42
       ST    >F8,V@>0C73
       ST    >F8,V@>0C8B
       CALL  DSPLY            * 'MASTER DISK (1-9)?'
       BYTE  >FE,>04,>52,>FF
       ST    >31,@VCHAR       * 1
       CZ    @ONEDSK
       BR    TCOMP1
       CALL  INKEY
       BYTE  NUMBER,>0C,>72,NINE
TCOMP1 CALL  CHECKDISK
       BYTE  >0C,>72,>0E,>12,>0C,>7F
       CALL  DSPLY            * VROW=>06
       BYTE  >FC,>06,>FF
       CALL  FORMATINPUT
       CALL  DSPLY            * 'LOOP (Y/N)?'
       BYTE  >FE,>09,>49,>FF
       CALL  INKEY
       BYTE  YN,>0C,>26,N
       CALL  DSPLY            * 'LOG ERRORS (Y/N)?'
       BYTE  >FE,>0A,>5F,>FF
       CALL  INKEY
       BYTE  YN,>0C,>10,N
       ST    V@>0C10,@LOGFLG
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMP2           * No
       CALL  DSPLY            * 'DEVICE NAME?'
       BYTE  >FE,>0B,>50,>F5,>FF
       CALL  GETDEVICENAME    * GET DEVICE NAME
       BYTE  >0C,>D0,>38,>0C,>CF
       CALL  G6AFF
TCOMP2 CALL  WORKNG
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMP3           * No
       CALL  EXIO             * OPEN,VAR/DIS/OUT/SEQ
       BYTE  >00,>12
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>00,>03
       CALL  EXIO             * CLOSE
       BYTE  >01
TCOMP3 CALL  INITIALIZEDISK
       CALL  DSPLY            * 'PRESS           '
                              * '                '
                              * 'CLEAR TO ABORT COMMAND'
       BYTE  >FE,>16,>5C,>FF
       DCLR  V@>0C18
       DCLR  V@>0C16
       CALL  ERRORSANDPASS
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
TCOMP4 CALL  TESTNUMBER
       BYTE  >01,>6E,>6E
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  TESTNUMBER
       BYTE  >02,>C5,>C5
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  TESTNUMBER
       BYTE  >03,>00,>08
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  TESTNUMBER
       BYTE  >04,>FF,>F7
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  DSPLY            * 'TEST #'
       BYTE  >FE,>14,>63,>19,>FF
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMP5           * No
       CALL  LOGOUTPUT
TCOMP5 CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       DCLR  @>8310           * ???????
       DST   V@NUMAU,@>8312   * Number of AU
       DDEC  @>8312           * AU -1
       CLR   @IOSEC           * SET READ SECTOR BIT
TCOMP6 DST   @>8310,@SECNUM   * SECTOR NUMBER
       DST   @SECNUM,V@>0E12
       ST    >08,@SCRADD
       CALL  ABORT            * SECTORREADWRITE
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  G6C2C
       DST   @>8312,@SECNUM   * SECTOR NUMBER
       DST   @SECNUM,V@>0E12
       CALL  ABORT            * SECTORREADWRITE
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  G6C2C
       DINC  @>8310
       DDEC  @>8312
       DCGT  @>8312,@>8310
       BR    TCOMP6
       ST    >FF,@IOSEC       * SET WRITE SECTOR BIT
       DINC  @>8310           * ????
       DDEC  @>8312           * ?????
       CALL  DSPLY            * 'TEST #'
       BYTE  >FE,>14,>63,>1A,>FF
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMP7           * No
       CALL  LOGOUTPUT
TCOMP7 DDEC  @>8310
       DINC  @>8312           * ???????
       DCEQ  @>8312,@>8310    * ????????
       BS    TCOMP8
       DST   @>8310,@SECNUM   * SECTOR NUMBER
       CALL  ABORT            * SECTORREADWRITE
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  G6C2C
       DCEQ  @SECNUM,V@>0E12
       BS    TCOMP8
       ST    >08,@SCRADD
       ST    >99,@DFLAG
       CALL  G6C31
TCOMP8 DST   @>8312,@SECNUM   * SECTOR NUMBER
       CALL  ABORT            * SECTORREADWRITE
       CEQ   >02,@ABORTF      * ABORT?
       BS    TCOMPB           * Yes
       CALL  G6C2C
       CEQ   >F8,@DFLAG
       BR    TCOMP9
       DCEQ  @SECNUM,V@>0E12
       BS    TCOMP9
       ST    >99,@DFLAG
       CALL  G6C31
TCOMP9 DCZ   @>8310
       BR    TCOMP7
       CALL  BLINES
       BYTE  >14,>14
       CALL  ERRORSANDPASS2
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMPA           * No
       CALL  G6AE2
TCOMPA CEQ   >02,V@>0C26      * Y? LOOP
       BS    TCOMP4           * Yes
TCOMPB CEQ   >02,@LOGFLG      * Y? LOG
       BR    TCOMPC           * No
       CALL  G6AEF
TCOMPC CALL  CMDDONE
       BR    TCOMP
TCOMPD PUSH  @>8310
       PUSH  @>8311
       B     TESTNUMBER2
TESTNUMBER PUSH  @>8310
       PUSH  @>8311
       DCLR  @>8310
       FETCH @>8311
       CALL  DSPLY            * 'TEST #'
       BYTE  >FE,>14,>63,>FF
       CALL  G70F2
       BYTE  >10
       CEQ   >02,@LOGFLG      * Y? LOG
       BR    TESTNUMBER2      * No
       CALL  LOGOUTPUT
TESTNUMBER2 FETCH @>8311
       ST    @>8311,V@>0E12
       MOVE  >00FF,V@>0E12,V@>0E13
       FETCH @>8310
       ST    @>8310,V@>0E92
       ST    *STATUS,@>8311
       ST    *STATUS,@>8310
       DCLR  @SECNUM          * SECTOR NUMBER
       CLR   @IOSEC           * SET WRITE SECTOR BIT
       DST   >0E12,@BUFADD    * BUFFER ADDRESS
       B     READINGSECTORS1
READINGSECTORS DCLR  @SECNUM  * SECTOR NUMBER
       ST    >FF,@IOSEC       * SET READ SECTOR BIT
       DST   >0E12,@BUFADD    * BUFFER ADDRESS
READINGSECTORS1 CALL  ABORT            * SECTORREADWRITE
       CEQ   >02,@ABORTF      * ABORT?
       BS    READINGSECTORS2           * Yes
       CALL  G6C2C
       DINC  @SECNUM          * SECTOR NUMBER+1
       DST   V@NUMAU,@FAC12   * Number of AU
       DCEQ  @FAC12,@SECNUM
       BR    READINGSECTORS1
       CALL  BLINES
       BYTE  >14,>14
READINGSECTORS2 RTN
ERRORSANDPASS PUSH  @>8314
       PUSH  @>8315
       PUSH  @VCOL
       PUSH  @VROW
       DST   V@>0C18,@>8314
       CALL  DSPLY            * '  TOTAL ERRORS:'
       BYTE  >FE,>11,>5E,>FF
       BR    ERRORSANDPASS3
ERRORSANDPASS2 PUSH  @>8314
       PUSH  @>8315
       PUSH  @VCOL
       PUSH  @VROW
       DINC  V@>0C16
       DST   V@>0C16,@>8314
       CALL  DSPLY            * 'COMPLETED PASS:'
       BYTE  >FE,>12,>5D,>FF
ERRORSANDPASS3 CALL  G70CC            * SHOW NUMBER
       BYTE  >14
       ST    *STATUS,@VROW
       ST    *STATUS,@VCOL
       ST    *STATUS,@>8315
       ST    *STATUS,@>8314
       RTN
INITIALIZEDISK  CALL  BLINES
       BYTE  >13,>13
       CALL  DSPLY            * 'INITIALIZE NEW DISK'
       BYTE  >FE,>14,>2F,>FF
       ST    @DSKNUM,@FAC2    * DRIVE NUMBER
       ST    V@TRACKS,@FAC3   * NUMBER OF TRACKS
       DST   >0E12,@FAC4      * BUFFER ADDRESS
       ST    V@SIDES,@FAC7    * NUMBER OF SIDES
       CEQ   >01,@FAC7        * 1 SIDE?
       BS    INITIALIZEDISK1  * Yes
       OR    >10,@FAC2
INITIALIZEDISK1 ST V@DENSTY,@FAC6 * DENSITY
       CEQ   >01,@FAC6
       BS    INITIALIZEDISK2
       OR    >20,@FAC2
INITIALIZEDISK2 CEQ   >28,@FAC3   * 40 TRACK?
       BS    INITIALIZEDISK3      * Yes
       CEQ   >23,@FAC3            * 35 TRACK?
       BS    INITIALIZEDISK3      * Yes
       OR    >10,@FAC2
INITIALIZEDISK3 CALL  FORMAT
       DST   @FAC,V@NUMAU     * Get Number of AU
       DST   @FAC3,V@SECTRK   * Sectors per Track
       CEQ   >02,V@SIDES      * 2 SIDES?
       BR    INITIALIZEDISK4  * No
       CEQ   >02,@FAC7        * 2 SIDES?
       BS    INITIALIZEDISK4  * Yes
       ST    >01,V@SIDES      * 1 SIDE
INITIALIZEDISK4 CALL  CHKERR
       CALL  BLINES
       BYTE  >14,>14
       RTN
LOGOUTPUT  CALL  EXIO         * OPEN,VAR/DIS/APE/SEQ
       BYTE  >00,>16
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>14,>14
       BR    G6AFA
G6AE2  CALL  EXIO             * OPEN,VAR/DIS/APE/SEQ
       BYTE  >00,>16
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>12,>12
       BR    G6AFA
G6AEF  CALL  EXIO             * OPEN,VAR/DIS/APE/SEQ
       BYTE  >00,>16
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>11,>11
G6AFA  CALL  EXIO             * CLOSE
       BYTE  >01
       RTN
G6AFF  DCEQ  >4453,V@>0CD0    * DS?
       BR    G6B25
       CEQ   >4B,V@>0CD2      * K?
       BR    G6B25
       ST    V@DMAST,@>830E
       ADD   >30,@>830E       * ADD ASCII 0
       CEQ   V@>0CD3,@>830E
       BR    G6B25
       CALL  DSPLY            * 'LISTING DEVICE ERROR'
       BYTE  >FE,>14,>43,>FF
       CALL  HONKFCTN
       BR    FCTN8
G6B25  RTN
***************************** HONK *********************************************
XHONK  CALL  BADTON
       BR    G6B2E
***************************** BEEP *********************************************
XBEEP  CALL  ACCTON
G6B2E  CLR   @ITIMER
G6B30  CZ    @>83CE
       BR    G6B30
       RTN
       PUSH  @VCOL
       PUSH  @VROW
       ST    SPACE,V@>0C7F
       MOVE  9,V@>0C7F,V@>0C80
       CALL  BANK5
       CALL  DSPLY            * 'LOAD MASTER DISK'
       BYTE  >FE,>14,>0E,>FF
       CALL  FCTNBEEP
       CALL  BLINES
       BYTE  >15,>15
       ST    >4D,@MCFLAG      * Master
******************************* Restore VROW VCOL
RESTOREVROWVCOL ST    *STATUS,@VROW
       ST    *STATUS,@VCOL
       RTN
G6B63  PUSH  @VCOL
       PUSH  @VROW
       ST    >4D,@MCFLAG      * Master
       CZ    @ONEDSK
       BS    RESTOREVROWVCOL
       CALL  READSECTOR
       BR    RESTOREVROWVCOL
G6B73  PUSH  @VCOL
       PUSH  @VROW
       ST    SPACE,V@>0C97
       MOVE  9,V@>0C97,V@>0C98
       CALL  BANK5
       CALL  DSPLY            * 'LOAD COPY DISK'
       BYTE  >FE,>14,>0F,>FF
       CALL  FCTNBEEP
       CALL  BLINES
       BYTE  >15,>15
       ST    >43,@MCFLAG      * Copy
       B     RESTOREVROWVCOL
G6B9A  PUSH  @VCOL
       PUSH  @VROW
       ST    >43,@MCFLAG      * Copy
       CZ    @ONEDSK
       BS    RESTOREVROWVCOL
       CALL  READSECTOR
       BR    RESTOREVROWVCOL
READSECTOR CALL  G6BF8
       DST   VBUFF,@BUFADD    * BUFFER ADDRESS
       ST    >FF,@IOSEC       * SET READ SECTOR BIT
       ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       CEQ   >4D,@MCFLAG      * Master?
       BS    G6BC1            * Yes
       ST    V@DCOPY,@DSKNUM  * DRIVE NUMBER
G6BC1  DCLR  @SECNUM          * SECTOR NUMBER
G6BC3  CALL  SECTORREADWRITE
       DST   >0C7F,@FAC
       CEQ   >4D,@MCFLAG      * Master?
       BS    G6BD3            * Yes
       DST   >0C97,@FAC
G6BD3  DST   VBUFF,@FAC2
       ST    >01,@>833C
       B     G6BDF
G6BDD  INC   @>833C
G6BDF  CGT   >05,@>833C
       BS    G6BF2
       DCEQ  V*FAC2,V*FAC
       BR    G6BF3
       DINCT @FAC
       DINCT @FAC2
       B     G6BDD
G6BF2  RTN
G6BF3  CALL  G6BF8
       BR    G6BC3
G6BF8  CALL  BANK5
       DST   >1502,@VROW
       CALL  DSPLY            * 'DISKNAME='
       BYTE  >33,>FF
       CALL  CVRC
       CEQ   >4D,@MCFLAG      * Master?
       BR    G6C1C            * No
       MOVE  10,V@>0C7F,V*SCRADD
       CALL  DSPLY            * 'LOAD MASTER DISK'
       BYTE  >FE,>14,>0E,>FF
       BR    FCTNBEEP
G6C1C  MOVE  10,V@>0C97,V*SCRADD
       CALL  DSPLY            * 'LOAD COPY DISK'
       BYTE  >FE,>14,>0F,>FF
       BR    FCTNBEEP
G6C2C  CEQ   >F8,@DFLAG
       BS    G6C97
G6C31  MOVE  >00E0,V@>0140,V@>0120 * SCROLL 7 LINES
       ST    SPACE,V@>0220
       MOVE  31,V@>0220,V@>0221    * BLANK 1 LINE
       DINC  V@>0C18
       PUSH  @>8310
       PUSH  @>8311
       PUSH  @VCOL
       PUSH  @VROW
       DST   V@>0C18,@>8310
       CALL  XHONK
       CALL  DSPLY            * '  TOTAL ERRORS:'
       BYTE  >FE,>11,>5E,>FF
       CALL  G70DC            * SHOW NUMBER
       BYTE  >10
       CALL  DSPLY            * 'BAD ADDRESS/CODE'
       BYTE  >FE,>10,>56,>FF
       CALL  G70DC            * SHOW NUMBER
       BYTE  >16
       CALL  DSPLY            * VCOL+1
       BYTE  >E0,>FF
       CALL  G6CB4
       CEQ   >02,@LOGFLG      * Y?  LOG
       BR    G6C87            * No
       CALL  EXIO             * OPEN,VAR/DIS/APE/SEQ
       BYTE  >00,>16
       CALL  EXIO             * WRITE,ROW,COL
       BYTE  >03,>10,>10
       CALL  EXIO             * CLOSE
       BYTE  >01
G6C87  ST    *STATUS,@VROW
       ST    *STATUS,@VCOL
       ST    *STATUS,@>8311
       ST    *STATUS,@>8310
G6C97  RTN
****************************  Check for error
CHKERR CEQ   >F8,@DFLAG
       BS    G6CB3
       CALL  BLINES
       BYTE  >14,>14
       CALL  DSPLY            * VROW=>14 VCOL=>02 'DISK ERROR'
       BYTE  >FE,>14,>05,>FF
       CALL  BLINES
       BYTE  >15,>15
       CALL  G6CB4
       BR    HONKFCTN
G6CB3  RTN
G6CB4  PUSH  @>8310
       PUSH  @>8311
       CLR   @>8310
       ST    @DFLAG,@>8311
       AND   >F0,@>8311
       SRL   >04,@>8311
       CALL  G70F2
       BYTE  >10
       CLR   @>8310
       ST    @DFLAG,@>8311
       AND   >0F,@>8311
       CALL  G70F2
       BYTE  >10
       ST    *STATUS,@>8311
       ST    *STATUS,@>8310
       RTN
***************************** Calculate Vaddr from ROW and COL
CVRC   CLR   @SCRADD
       ST    @VROW,@>830D
       DSLL  >0005,@SCRADD
       ADD   @VCOL,@>830D
       RTN
DELETE CALL  DELETE1            * LENGTH,BUFFER ADDRESS
       BYTE  >07,>0C,>72
       RTN
DELETE1 CLR  V@VBUFF
       MOVE  10,V@VBUFF,V@>0B11
       FETCH @>830E             * Max device name length
       ST    @>830E,V@VBUFF
       FETCH @>830E             * Buffer address
       FETCH @>830F             * Buffer address
       MOVE  6,G@G6D5F,V@VLEN   * Get DSK0. into PAB
       ADD   @DSKNUM,V@>0B1D    * DRIVE NUMBER
       MOVE  10,V@>0C75,V@>0B1F * Get filename
       CLR   V@>0B11
       DST   @>830E,@FAC        * Get buffer address
       DADD  >0003,@FAC
       ST    >01,@FAC3          * COUNTER=1
       B     DELETE3
DELETE2 INC  @FAC3              * COUNTER +1
DELETE3 CGT  >0A,@FAC3          * Filename length > 10 ?
       BS    DELETE4            * Yes
       CEQ   SPACE,V*FAC        * End filename?
       BS    DELETE4            * Yes
       INC   V@VLEN             * Length +1
       DINC  @FAC               * Address of name +1
       B     DELETE2
DELETE4 DST  VLEN,@FAC12        * Length byte
       CALL  LINK
       BYTE  >08
       BS    DELETE5
       ST    V@>0B11,@DFLAG
       SRL   >05,@DFLAG
       CZ    @DFLAG
       BR    DELETE6
       ST    >F8,@DFLAG
       BR    DELETE6
DELETE5 ST   >F0,@DFLAG
DELETE6 ST   @DFLAG,V@>0001(@>830E)
       BR    CHKERR
G6D5F  STRI  'DSK0.'
***************************** DSRLNK routine
*   Parm 1 I/O op
*    0, flags
*    3, row, col
*    Other
EXIO   MOVE  >004A,@MBASE,V@SAVCPU
       FETCH @>8332           * Get flag
       ST    @>8332,V@>0CC6   * I/O CODE
       CZ    @>8332           * FLAG<>0
       BR    EXIO1            * Yes
       FETCH @>8332           * Get byte
       ST    @>8332,V@>0CC7   * FILE TYPE
                              * >0CC8 = BUFFER ADDDRESS
       ST    >20,V@>0CCA      * LOGICAL RECORD LENGTH
       ST    >20,V@>0CCB      * CHARACTER COUNT
       DCLR  V@>0CCC          * RECORD NUMBER
       CLR   V@>0CCE          * SCREEN OFFSET
       DST   >0CCF,@FAC12     * LENGTH BYTE
       CALL  LINK
       BYTE  >08
       BS    G6DE1            * ERROR
       CALL  CHECKOPCODE
       BR    EXIO4            * No error
EXIO1  CEQ   >03,V@>0CC6      * CLOSE?
       BR    EXIO3            * No
       DCLR  @>8310
       DCLR  @>8312
       FETCH @>8311
       DSLL  >0005,@>8310
       FETCH @>8313
       DINC  @>8312
       DSLL  >0005,@>8312
EXIO2  DST   >0CCF,@FAC12     * Length byte
       DST   @>8310,V@>0CC8
       CALL  LINK
       BYTE  >08
       BS    G6DE1            * ERROR
       CALL  CHECKOPCODE
       DADD  >0020,@>8310     * SCREEN ADDRESS +32
       DCEQ  @>8312,@>8310    * SCREEN ADDRESS = LAST LINE
       BR    EXIO2
       B     EXIO4
EXIO3  DST   >0CCF,@FAC12     * Length byte
       CALL  LINK
       BYTE  >08
       BS    G6DE1            * ERROR
       CALL  CHECKOPCODE
EXIO4  MOVE  >004A,V@SAVCPU,@MBASE
       RTN
G6DE1  CLR   @DFLAG
       B     LISTINGDEVICEERROR
CHECKOPCODE ST V@>0CC7,@DFLAG  * I/O CODE
       SRL   >05,@DFLAG
       CZ    @DFLAG
       BR    LISTINGDEVICEERROR
       ST    >F8,@DFLAG
       RTN
LISTINGDEVICEERROR CALL DSPLY  * 'LISTING DEVICE ERROR'
       BYTE  >F3,>FE,>14,>43,>FF
       DCLR  @>830E
       ST    @DFLAG,@>830F
       CALL  G70F2
       BYTE  >0E
       CALL  HONKFCTN
       B     FCTN8
***************************** BLANK LINES (VROW,COUNT)
BLINES PUSH  @VCOL
       PUSH  @VROW
       FETCH @VROW
       FETCH @SCRADD
       CLR   @VCOL
G6E16  FMT
       HCHA  32,' '
       FEND
       CZ    @VROW
       BS    RESTOREVROWVCOL
       CH    @SCRADD,@VROW
       BR    G6E16
       B     RESTOREVROWVCOL
BANK5  ST    SPACE,V@>027F    * BLANK 5 LINES
       MOVE  >00A0,V@>027F,V@>0280
       RTN
****************************** INITILIAZE DISK INPUT
FORMATINPUT CALL  DSPLY            * 'TRACKS PER SIDE?'
       BYTE  >FB,>02,>4D,>FF
       MOVE  4,G@G6EAD,V@VBUFF
       CALL  GETINPUT         * GET INPUT
       BYTE  >0B,>11,>02,>0B,>10
       CEQ   >01,V@VBUFF
       BR    FORMATINPUT1
       ST    >20,V@>0B12
FORMATINPUT1 DST   >0B11,@FAC12 * TRACKS PER SIDE
       CLR   @ERCODE
       XML   >10              * CSN
       CZ    @ERCODE
       BS    FORMATINPUT2
       CALL  XHONK
       BR    FORMATINPUT
FORMATINPUT2  XML   >12       * CFI
       CZ    @ERCODE
       BS    FORMATINPUT3
       CALL  XHONK
       BR    FORMATINPUT
FORMATINPUT3  ST    @FAC1,V@TRACKS
       CALL  DSPLY            * 'SINGLE SIDED (Y/N)?'
       BYTE  >F5,>4C,>FF
       CALL  INKEY
       BYTE  YN,>0E,>10,N
       CEQ   >02,V@SIDES      * Y? SINGLE SIDED
       BR    FORMATINPUT4            * No
       ST    >01,V@SIDES      * SINGLE SIDED
       BR    FORMATINPUT5
FORMATINPUT4 ST >02,V@SIDES   * DOUBLE SIDED
FORMATINPUT5 CALL  DSPLY      * 'SINGLE DENSITY (Y/N)?'
       BYTE  >F5,>4B,>FF
       CALL  INKEY
       BYTE  YN,>0E,>11,N
       CEQ   >02,V@DENSTY     * Y? SINGLE DENSITY
       BR    FORMATINPUT6            * No
       ST    >01,V@DENSTY     * SINGLE DENSITY
       BR    FORMATINPUT7
FORMATINPUT6 ST >02,V@DENSTY  * DOUBLE DENSITY
FORMATINPUT7 RTN
G6EAD  BYTE  >02,>34,>30,>20
SECTOR DST   >0110,V@>0C1A    * W/R SECTOR
       B     LEVEL1
FORMAT DST   >0111,V@>0C1A    * FORMAT DISK
LEVEL1  DST   >0C1A,@FAC12
       CALL  LINK
       BYTE  >0A
       BS    G6F0D
       ST    @FAC6,@DFLAG     * ERROR CODE
       CZ    @FAC6
       BR    G6ED4
       ST    >F8,@DFLAG       * NO ERROR
       BR    G6ED7
G6ED4  ADD   >10,@DFLAG       * ?
G6ED7  RTN
PROTCT DST   >0112,V@>0C1A    * PROTECT/UNPROTECT
       B     LEVEL2
RENAME DST   >0113,V@>0C1A    * RENAME
       B     LEVEL2
FILEIN DST   >0114,V@>0C1A    * FILE INPUT
       B     LEVEL2
FILEOU DST   >0115,V@>0C1A    * FILE OUTPUT
LEVEL2  DST   >0C1A,@FAC12
       CALL  LINK
       BYTE  >0A
       BS    G6F0D
       SRL   >05,@FAC6
       ST    @FAC6,@DFLAG
       CZ    @DFLAG
       BR    G6F0C
       ST    >F8,@DFLAG
G6F0C  RTN
G6F0D  ST    >F0,@DFLAG
       RTN
ABORT  PUSH  @VCOL
       PUSH  @VROW
       DCZ   @>832B
       BR    ABORT1
       SCAN                   * SCAN KEYS
       BR    ABORT1
       CEQ   CLEAR,@KEY       * FCTN4
       BR    ABORT1
       ST    >02,@ABORTF
ABORT1 DST   >130D,@VROW
       CALL  G70DC            * SHOW NUMBER
       BYTE  >16
       CEQ   >FF,@IOSEC       * WRITE SECTOR BIT SET?
       BR    ABORT2           * No
       ST    >3E,@VCHAR       * >
       BR    ABORT3
ABORT2 ST    >3C,@VCHAR       * <
ABORT3 ST    *STATUS,@VROW
       ST    *STATUS,@VCOL
SECTORREADWRITE DST @SECNUM,@FAC6 * SECTOR NUMBER TO READ OR WRITE
                 DST   @DSKNUM,@FAC2 * DRIVE NUMBER/READ OR WRITE BIT
                 DST   @BUFADD,@FAC4 * BUFFER ADDRESS
                 B     SECTOR
***************************** Key Scan
KSCAN  CLR   @ITIMER
KSCAN1 SCAN                   * SCAN KEYS
       BS    KSCAN2
       CHE   >14,@ITIMER
       BR    KSCAN1
       EX    @CURSOR,@VCHAR
       B     KSCAN
KSCAN2 CEQ   >60,@VCHAR
       BR    KSCAN3
       EX    @CURSOR,@VCHAR
KSCAN3 CEQ   DOWN,@KEY         * FCTN X
       BR    KSCAN6
       INC   V@>0C27
       CEQ   >0A,V@>0C27
       BS    KSCAN4
       CALL  XHONK
       BR    KSCAN5
KSCAN4 CALL  XBEEP
KSCAN5 CALL  G740E
       BR    KSCAN
KSCAN6 RTN
G6F81  INC   @VCOL            * VCOL+1
       CH    >1D,@VCOL
       BR    G6F8D
G6F88  INC   @VROW            * VROW+1
       ST    >02,@VCOL        * VCOL=2
G6F8D  RTN
G6F8E  DEC   @VCOL
       CGE   >02,@VCOL
       BS    G6F9A
       ST    >1D,@VCOL
       DEC   @VROW
G6F9A  RTN
CHECKDISK PUSH @>8310
       PUSH  @>8311
       FETCH @>8302           * DRIVE NUMBER ADDRESS
       FETCH @>8303           * DRIVE NUMBER ADDRESS
       ST    V*>8302,@DSKNUM  * DRIVE NUMBER
       FETCH @BUFADD          * BUFFER ADDRESS
       FETCH @BUFADD+1        * BUFFER ADDRESS
CHECKDISK1 CZ @ONEDSK
       BS    CHECKDISK3
       PUSH  @VROW
       PUSH  @VCOL
       DCEQ  >0C8A,@>8302
       BR    CHECKDISK2
       CALL  G6B73
CHECKDISK2 ST *STATUS,@VCOL
       ST    *STATUS,@VROW
CHECKDISK3 DCLR  @SECNUM      * SECTOR NUMBER
       ST    >FF,@IOSEC       * SET READ SECTOR BIT
       CALL  SECTORREADWRITE
       CEQ   >F8,@DFLAG
       BR    CHECKDISK4
       ST    >F1,@DFLAG
       DCEQ  >4453,V@>000D(@BUFADD) * DS?
       BR    CHECKDISK4
       CEQ   >4B,V@>000F(@BUFADD)   * K?
       BR    CHECKDISK4
       INC   @VROW
       ST    >02,@VCOL
       CALL  DSPLY            * BLANK >1C BYTES
       BYTE  >F0,>1C,>FF
       ST    >02,@VCOL
       CALL  DSPLY            * 'DISKNAME='
       BYTE  >33,>FF
       CALL  CVRC
       MOVE  10,V*BUFADD,V*SCRADD
       ADD   >0A,@VCOL
       DST   V@>000A(@BUFADD),V@NUMAU  * Number of AU
       DST   V@>000C(@BUFADD),V@SECTRK * Sectors per Track
       ST    >F8,@DFLAG
       CEQ   >50,V@>0010(@BUFADD) * P?
       BR    CHECKDISK4
       ST    >F2,@DFLAG       * PROPRITARY DISK ERROR
CHECKDISK4 CEQ >16,@DFLAG
       BR    CHECKDISK5
       CALL  DSPLY            * VROW+2 VCOL=>02 'DISK ERROR'
       BYTE  >F5,>05,>FF
       CALL  G6CB4
       CALL  DSPLY            * BLANK >0A BYTES
       BYTE  >F0,>0A,>FF
       BR    G70B8
CHECKDISK5 CEQ >F0,@DFLAG
       BR    CHECKDISK6
       CALL  DSPLY            * 'DISK ERROR'
       BYTE  >F5,>05,>E6,>E9,>F0,>0D
       BYTE  >FF
       BR    G70B8
CHECKDISK6 CEQ >31,@DFLAG     * ERROR?
       BS    CHECKDISK7       * Yes
       CEQ   >32,@DFLAG       * ERROR?
       BS    CHECKDISK7       * Yes
       CEQ   >F1,@DFLAG
       BR    CHECKDISK8
CHECKDISK7 CALL  DSPLY        * 'DISK NOT INITIALIZED'
       BYTE  >F5,>57,>F0,>05,>FF
       ST    >F1,@DFLAG
CHECKDISK8 CHE >F0,@DFLAG
       BS    CHECKDISK9
       CEQ   >31,@DFLAG
       BS    CHECKDISK9
       CEQ   >16,@DFLAG
       BS    CHECKDISK9
       CALL  DSPLY            * VROW+2 VCOL=>02 'DISK ERROR'
       BYTE  >F5,>05,>FF
       CALL  G6CB4
       CALL  DSPLY            * BLANK >0A BYTES
       BYTE  >F0,>0A,>FF
CHECKDISK9 FETCH @>8310
           FETCH @>8311
       CHE   >F8,@DFLAG
       BS    CHECKDISKA
       CALL  XHONK
CHECKDISKA CHE   >F2,@DFLAG
       BS    CHECKDISKB
       ST    SPACE,V*BUFADD   * CLEAR NAME BUFFER
       MOVE  9,V*BUFADD,V@>0001(@BUFADD)
CHECKDISKB MOVE  10,V*BUFADD,V*>8310
       DCEQ  >0C7F,@>8310
       BR    CHECKDISKC
       ST    @DFLAG,V@>0C73   * WHY ?????????
       BR    CHECKDISKD
CHECKDISKC ST    @DFLAG,V@>0C8B
CHECKDISKD ST *STATUS,@>8311
       ST    *STATUS,@>8310
       RTN
G70B8  CALL  XHONK
       PUSH  @VROW
       CALL  BANK5
       CALL  FCTNBEEP
       ST    *STATUS,@VROW
       DEC   @VROW
       B     CHECKDISK1
G70CC  ST    >FF,@ERCODE      * SHOW NUMBER
       FETCH @FAC
       DST   *FAC,@FAC
       DST   >2710,@FAC4
       B     G7105
G70DC  ST    >FF,@ERCODE      * SHOW NUMBER
       B     G70F5
G70E2  ST    >FF,@ERCODE      * SHOW NUMBER
       FETCH @FAC
       DST   *FAC,@FAC
       DST   >0064,@FAC4
       B     G7105
G70F2  CLR   @ERCODE
G70F5  FETCH @FAC
       DST   *FAC,@FAC
       B     G7101
       CLR   @ERCODE
G7101  DST   >03E8,@FAC4
G7105  DST   @FAC,@FAC2
       CLR   @FAC11
G710B  DCLR  @FAC
       DDIV  @FAC4,@FAC
       CEQ   >FF,@FAC11
       BR    G711E
       FMT
       SCRO  48
       HSTR  1,@FAC1
       FEND
       B     G7137
G711E  DCZ   @FAC
       BS    G712E
       FMT
       SCRO  48
       HSTR  1,@FAC1
       FEND
       ST    >FF,@FAC11
       B     G7137
G712E  CEQ   >FF,@ERCODE
       BR    G7137
       FMT
       HTEX  ' '
       FEND
G7137  DST   @FAC4,@FAC6
       DCLR  @FAC4
       DDIV  >000A,@FAC4
       DCEQ  >0001,@FAC4
       BR    G710B
       FMT
       SCRO  48
       HSTR  1,@FAC3
       FEND
       RTN
HONKFCTN  CALL  XHONK
       CALL  DSPLY            * 'PRESS: PROC'D, REDO,'
                              * '       BEGIN OR BACK'
       BYTE  >FE,>16,>12,>FF
       BR    G7171
FCTNBEEP  CALL  DSPLY            * 'PRESS: PROC'D, REDO,'
                              * '       BEGIN OR BACK'
       BYTE  >FE,>16,>12,>FF
       BR    BEEPFCTN
BLANK5FCTNBEEP  CALL  BANK5
       CALL  DSPLY            * 'SCREEN IS COMPLETE'
                              * 'PRESS: PROC'D, REDO,'
                              * '       BEGIN OR BACK'
       BYTE  >FE,>15,>11,>F5,>12,>FF
BEEPFCTN  CALL  XBEEP
G7171  ST    SPACE,@VCHAR
       CALL  KSCAN
       CEQ   REDO,@KEY        * FCTN 8
       BR    G7181
G717C  CALL  BANK5
       BR    FCTN8
G7181  CEQ   BEGIN,@KEY       * FCTN 5
       BR    G718B
       CALL  BANK5
       BR    FCTN5
G718B  CEQ   BACK,@KEY        * FCTN 9
       BR    G7195
       CALL  BANK5
       BR    FCTN9
G7195  CEQ   PROCD,@KEY       * FCTN 6
       BR    G71A3
       CEQ   >F8,@DFLAG
       BR    G717C
       CALL  WORKNG
       RTN
G71A3  CALL  XHONK
       BR    G7171
***************************** Subroutine
CMDDONE CALL  BANK5
       CALL  DSPLY            * 'COMMAND COMPLETED'
                              * 'PRESS: PROC'D, REDO,'
                              * '       BEGIN OR BACK'
       BYTE  >FE,>15,>0D,>F5,>12,>FF
       CALL  XBEEP
G71B7  ST    SPACE,@VCHAR
       CALL  KSCAN
       CALL  FCTN
       CEQ   PROCD,@KEY       * FCTN 6
       BR    G71C6
       RTN
G71C6  CALL  XHONK
       BR    G71B7
WORKNG CALL  BANK5
       CALL  DSPLY            * 'WORKING.....   PLEASE WAIT.'
       BYTE  >FE,>15,>10,>FF
       RTN
OVERIDEPROTECT CALL  DSPLY    * 'OVERRIDE PROTECTION (Y/N)?'
       BYTE  >F4,>47,>FF
       CALL  INKEY
       BYTE  YN,>0C,>20,N
       RTN
***************************** Subroutine, 4 bytes fetched
PROTECTION FETCH @FAC4        * UNPROTECT OR PROTECT
       FETCH @FAC5
       FETCH @FAC2
       FETCH @FAC3
       ST    V*FAC2,@FAC2
       CLR   @FAC3
       CEQ   >02,V@>0C20      * >02=YES
       BR    G71FD
       CALL  PROTCT
       BR    CHKERR
G71FD  RTN
GETDRIVEGETINPUT  CALL  BLINES
                  BYTE  >04,>17
       ST    >F8,V@>0C73
       ST    >F8,V@>0C8B
       FETCH @>831C           * ROW value
       CEQ   >FF,@ONEDSK
       BR    G7217
       ST    V@DMAST,V@DCOPY
G7217  FETCH @>831E           * ROW+1 FLAG
       FETCH @>831F           * FILENAME FLAG
       FETCH @>8320           * COPY DISK FLAG
       CEQ   >FF,@>8320       * COPY DISK FLAG?
       BR    G7224            * No
       FETCH @>8321           * ROW+1 FLAG
G7224  FETCH @>8322           * 'N' FLAG
       CEQ   >FF,@>8322       * 'N' FLAG?
       BR    G722D            * No
       FETCH @>8324           * MESSAGE NUMBER
G722D  FETCH @>8326           * RETURN FLAG
       ST    @>831C,@VROW     * GET ROW
       ST    >02,@VCOL
       DST   @VROW,@>8327     * SAVE VROW
G7238  DST   @>8327,@VROW     * RESTORE VROW
       CALL  DSPLY            * 'MASTER DISK (1-9)?'
       BYTE  >52,>FF
       ST    >31,@VCHAR       * 1
       CZ    @ONEDSK
       BR    G724E
       CALL  INKEY
       BYTE  NUMBER,>0C,>72,NINE
G724E  CALL  CHECKDISK
       BYTE  >0C,>72,>0E,>12,>0C,>7F
       CALL  G6F88            * VROW+1 VCOL=2
       CHE   >F8,@DFLAG
       BS    G7270
       CEQ   >F2,@DFLAG
       BS    G7270
       CZ    @ONEDSK
       BS    G726E
       CALL  BANK5
       CALL  FCTNBEEP
G726E  BR    G7238
G7270  DST   @>8327,@VROW
       INC   @VROW
       CEQ   >FF,@>831E       * ROW+1 FLAG
       BR    G727C            * No
       INC   @VROW
G727C  CEQ   >FF,@>831F       * FILENAME FLAG
       BR    G728E            * No
       CALL  DSPLY            * 'FILENAME?'
       BYTE  >4F,>FF
       CALL  GETINPUT         * GET INPUT
       BYTE  >0C,>75,>0A,>0C,>74
G728E  INCT  @VROW
       ST    >02,@VCOL
G7293  DST   @>8327,@VROW     * RESTORE VROW
       ADD   >03,@VROW        * VROW+3
       CEQ   >FF,@>831E       * ROW+1 FLAG
       BR    G72A0            * No
       INC   @VROW
G72A0  CZ    @>8320           * COPY DISK FLAG
       BR    G72A9            * Yes
       ST    V@DMAST,V@DCOPY
G72A9  CEQ   >FF,@>8320       * COPY DISK FLAG
       BR    G72DC            * No
       CALL  DSPLY            * 'COPY DISK (1-9)?'
       BYTE  >53,>FF
       ST    >31,@VCHAR       * 1
       CZ    @ONEDSK
       BR    G72D3
       CALL  INKEY
       BYTE  NUMBER,>0C,>8A,NINE
       CEQ   >02,V@>0C21
       BR    G72D3
       CEQ   V@DCOPY,V@DMAST
       BR    G72D3
       CALL  XHONK
       BR    G7293
G72D3  CALL  CHECKDISK
       BYTE  >0C,>8A,>0E,>12,>0C,>97
G72DC  CALL  G6F88            * VROW+1 VCOL=2
       CHE   >F8,@DFLAG
       BS    G72F5
       CEQ   >F2,@DFLAG
       BS    G72F5
       CZ    @ONEDSK
       BS    G72F3
       CALL  BANK5
       CALL  FCTNBEEP
G72F3  BR    G7293
G72F5  DST   @>8327,@VROW     * RESTORE VROW
       ADD   >04,@VROW        * VROW+4
       CEQ   >FF,@>831E       * ROW+1 FLAG
       BR    G7302            * No
       INC   @VROW
G7302  CEQ   >FF,@>8320       * COPY DISK FLAG
       BR    G730E            * No
       CEQ   >FF,@>8321       * ROW+1 FLAG
       BR    G730E            * No
       INC   @VROW
G730E  CEQ   >FF,@>8322       * 'N' FLAG
       BR    G7323            * No
       CLR   @FAC6            * CLEAR MESSAGE NUMBER
       ST    @>8324,@FAC7     * GET MESSAGE NUMBER
       CALL  DMSG
       CALL  GETINPUT         * GET INPUT
       BYTE  >0C,>8D,>0A,>0C,>8C
G7323  CZ    @>8326           * RETURN FLAG
       BR    BLANK5FCTNBEEP
       RTN
FILECOPY CALL  G6B63
FILECOPY2 ST V@DMAST,@FAC2    * DRIVE NUMBER
       CLR   @FAC3            * ACCESS CODE
       DST   >0C75,@FAC4      * POINTER TO BUFFER NAME
       ST    >40,@FAC6        * OFFSET POINTER TO ADDITIONAL INFO
       DST   >0E12,@ADINFO    * BUFFER START ADDRESS
       CALL  FILEIN
       ST    @>8331,@ACODE    * ACCESS CODE
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    G73E4
       PUSH  @>8342
       PUSH  @>8343
       DCLR  @>8342
       B     G7356
G7353  CALL  G6B63
G7356  ST    V@DMAST,@DSKNUM  * DRIVE NUMBER
       DST   VBUFF,@BUFADD    * BUFFER ADDRESS
       DCLR  @SECNUM          * SECTOR NUMBER
       ST    >FF,@IOSEC       * SET READ SECTOR BIT
       CALL  SECTORREADWRITE
       CEQ   >50,V@>0B20      * P?
       BR    G7379            * No
       CALL  DSPLY            * 'PROPRIETARY DISK ERROR'
       BYTE  >F3,>FE,>14,>60,>FF
       CALL  HONKFCTN
       BR    FCTN8
G7379  ST    V@DMAST,@FAC2    * DRIVE NUMBER
       ST    @ACODE,@FAC3     * ACCESS CODE
       DST   >0C75,@FAC4      * POINTER TO BUFFER NAME
       ST    >40,@FAC6        * OFFSET POINTER TO ADDITIONAL INFO
       CALL  FILEIN
       ST    @FAC3,@ACODE     * ACCESS CODE
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    G73E4
       CALL  G6B9A
       DCZ   @>8342
       BR    G73BE
       ST    *STATUS,@>8343   * STATUS FLAG
       ST    *STATUS,@>8342   * NUMBER OF FIRST RECORD
       ST    V@DCOPY,@FAC2    * DRIVE NUMBER
       CLR   @FAC3            * ACCESS CODE
       DST   >0C8D,@FAC4      * POINTER TO BUFFER NAME
       ST    >40,@FAC6        * OFFSET POINTER TO ADDITIONAL INFO
       CALL  FILEOU
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    G73E4
       DCLR  @>8342
G73BE  ST    V@DCOPY,@FAC2    * DRIVE NUMBER
       ST    @ACODE,@FAC3     * ACCESS CODE
       DST   >0C8D,@FAC4      * POINTER TO BUFFER NAME
       ST    >40,@FAC6        * OFFSET POINTER TO ADDITIONAL INFO
       CALL  FILEOU
       CALL  CHKERR
       CHE   >F8,@DFLAG
       BR    G73E4
       CLR   @>830E
       ST    @ACODE,@>830F    * ACCESS CODE
       DADD  @>830E,@>8342    * NUMBER OF FIRST SECTOR
       CHE   @>8331,@ACODE    * ACCESS CODE
       BS    G7353
G73E4  RTN
***************************** DISPLAY HEADING (parm=message #)
HEADER ALL   SPACE
       CLR   @VROW
HEADER2 INC   @VROW
       CLR   @>8310
       FETCH @>8311           * MESSAGE #
       DST   @>8310,@FAC6     * Save it
       DADD  @>8310,@>8310    * Double it
       DADD  @MBASE,@>8310    * Add in >8300+Message#
       MOVE  4,G@G0000(@>8310),@>8312 * Get index address
       DSUB  @>8312,@>8314
       SRL   >01,@>8315
       ST    >10,@VCOL
       SUB   @>8315,@VCOL
       CALL  DMSG             * Put message on screen
G740E  CEQ   >0A,V@>0C27
       BS    G741A
       DST   >2020,V@>000F    * SPACE SPACE
       RTN
G741A  DST   >3E3C,V@>000F    * <>
       RTN
***************************** Subroutine, 4 bytes fetched
INKEY  FETCH @FAC             * FLAG byte
       FETCH @FAC1            * Flag address
       FETCH @FAC2            * Flag address
       CEQ   >02,@FAC         * Message?
       BR    INKEY1           * No.
       FETCH @FAC5            * Highest key
       BR    INKEY3
INKEY1 FETCH @MESNUM          * Message #
       DST   @MBASE,@FAC7     * >8300
       DADD  >0002,@FAC7      * >8300+2
       MOVE  2,G@G0000(@FAC7),@FAC9  * Get index address
       MOVE  1,G@G0000(@FAC9),@FAC11 * Single byte
       DST   @MBASE,@FAC7     * >8300
       DADD  >0000,@FAC7      * What the heck is this?
       MOVE  2,G@G0000(@FAC7),@FAC9  * Get index address
       MOVE  1,G@G0000(@FAC9),@FAC12 * Single byte
       CEQ   >02,@MESNUM      * Single letter?
       BR    INKEY2           * No
       ST    @FAC11,V*FAC1    * Save single character 123456789
       BR    INKEY3
INKEY2 ST    @FAC12,V*FAC1    * Save single character YN
INKEY3 CALL  XBEEP
       DST   @OVROW,@VROW
       ST    V*FAC1,@VCHAR    * Show character
       CEQ   >02,@FAC
       BR    INKEY4
       ADD   >30,@VCHAR       * Add >30 to NUMBER
INKEY4 CALL  KSCAN
       CGT   >0F,@KEY
       BS    INKEY5
       DEC   @KEY
       CASE  @KEY
       BR    INKEY8           * FCTN 7
       BR    INKEY3           * FCTN 4
       BR    INKEY8           * FCTN 1
       BR    INKEY8           * FCTN 2
       BR    INKEY8           * FCTN =
       BR    INKEY9           * FCTN 8
       BR    INKEY8           * FCTN 3
       BR    INKEY8           * FCTN S
       BR    INKEY8           * FCTN D
       BR    INKEYA           * FCTN X
       BR    INKEY8           * FCTN E
       BR    INKEY8           * FCTN 6
       BR    INKEYA           * ENTER
       BR    FCTN5            * FCTN 5
       BR    FCTN9            * FCTN 9
INKEY5 CEQ   >01,@FAC
       BR    INKEY6
       CEQ   @FAC11,@KEY
       BS    INKEY6
       CEQ   @FAC12,@KEY
       BR    INKEY8
INKEY6 CEQ   >02,@FAC
       BR    INKEY7
       CH    @FAC5,@KEY
       BS    INKEY8
       CHE   >31,@KEY         * 1?
       BR    INKEY8
INKEY7 ST    @KEY,@VCHAR
       BR    INKEY4
INKEY8 CALL  XHONK
       BR    INKEY4
INKEY9 B     FCTN8
INKEYA CEQ   >01,@FAC
       BR    INKEYC
       ST    @VCHAR,@KEY
       CEQ   @FAC11,@VCHAR
       BR    INKEYB
       ST    >02,V*FAC1
       BR    INKEYC
INKEYB CLR   V*FAC1
INKEYC CEQ   >02,@FAC
       BR    INKEYD
       ST    @VCHAR,V*FAC1
       SUB   >30,V*FAC1
       ST    V*FAC1,@KEY
INKEYD RTN
GETDEVICENAME ST   >02,@FAC17 * GET DEVICE NAME
              B     GETINPUT1
GETINPUT  CLR   @FAC17         * GET INPUT
GETINPUT1 FETCH @FAC12
          FETCH @FAC13
          FETCH @FAC
          ST    >01,@FAC1
GETINPUT2 CALL  G6F81
          INC   @FAC1
          CEQ   @FAC,@FAC1
          BR    GETINPUT2
          CALL  CVRC
          DST   @SCRADD,@FAC5
          DST   @VROW,@FAC3
          CALL  XBEEP
          FETCH @ARG
          FETCH @ARG1
          ST    V*ARG,@FAC2
GETINPUT3 DST   @OVROW,@VROW
          DST   @FAC12,@ARG2
          ST    >01,@FAC1
          CZ    @FAC2
          BS    GETINPUT5
GETINPUT4 ST    V*ARG2,@VCHAR
          DINC  @ARG2
          CALL  G6F81
          INC   @FAC1
          CH    @FAC2,@FAC1
          BR    GETINPUT4
GETINPUT5 CGT   @FAC,@FAC1
          BS    GETINPUT7
          CALL  CVRC
GETINPUT6 ST    >61,@VCHAR
          CALL  G6F81
          CALL  CVRC
          DCGT  @FAC5,@SCRADD
          BR    GETINPUT6
GETINPUT7 DST   @OVROW,@VROW
GETINPUT8 CLR   @FAC7
          MOVE  8,G@G8010,V@>0B00
GETINPUT9 EX    @CURSOR,@VCHAR
          CALL  KSCAN
          CGT   >0F,@KEY
          BS    GETINPUTA
          DEC   @KEY
          CASE  @KEY
          BR    GETINPUTH        * FCTN 7
          BR    GETINPUTI        * FCTN 4
          BR    GETINPUTJ        * FCTN 1
          BR    GETINPUTM        * FCTN 2
          BR    GETINPUTH        * FCTN =
          BR    FCTN8            * FCTN 8
          BR    GETINPUTH        * FCTN 3
          BR    GETINPUTO        * FCTN S
          BR    GETINPUTP        * FCTN D
          BR    GETINPUTH        * FCTN X
          BR    GETINPUTH        * FCTN E
          BR    GETINPUTH        * FCTN 6
          BR    GETINPUTQ        * ENTER
          BR    FCTN5            * FCTN 5
          BR    FCTN9            * FCTN 9
GETINPUTA CZ    @FAC17
          BR    GETINPUTB
          CEQ   SPACE,@KEY       * SPACE?
          BS    GETINPUTH
          CEQ   >2E,@KEY         * PERIOD?
          BS    GETINPUTH
GETINPUTB CEQ   >FF,@FAC7
          BR    GETINPUTE
          CEQ   @FAC,@FAC2
          BS    GETINPUTH
          DST   @VROW,@FAC8
          CALL  CVRC
          DCEQ  @FAC5,@SCRADD
          BS    GETINPUTH
          ST    @VCHAR,@ERCODE
          CALL  G6F81
GETINPUTC ST    @VCHAR,@FAC11
          ST    @ERCODE,@VCHAR
          ST    @FAC11,@ERCODE
          CALL  G6F81
          CALL  CVRC
          DCGT  @FAC5,@SCRADD
          BS    GETINPUTD
          CEQ   >61,@ERCODE
          BR    GETINPUTC
GETINPUTD DST   @FAC8,@VROW
          ST    >61,@VCHAR
GETINPUTE CEQ   >61,@VCHAR
          BR    GETINPUTF
          INC   @FAC2
GETINPUTF ST    @KEY,@VCHAR
          CALL  CVRC
          DCEQ  @FAC5,@SCRADD
          BS    GETINPUTG
          CALL  G6F81
GETINPUTG B     GETINPUT9
GETINPUTH CALL  XHONK
          BR    GETINPUT9
GETINPUTI CLR   @FAC2
          B     GETINPUT3
GETINPUTJ CEQ   >61,@VCHAR
          BS    GETINPUTH
          CZ    @FAC2
          BS    GETINPUTH
          DEC   @FAC2
          DST   @VROW,@FAC8
          CALL  CVRC
          DCEQ  @FAC5,@SCRADD
          BS    GETINPUTL
          DST   @FAC5,@>8310
          DSUB  @SCRADD,@>8310
GETINPUTK CALL  G6F81
          ST    @VCHAR,V*SCRADD
          CEQ   >61,@VCHAR
          BS    GETINPUTL
          CALL  CVRC
          DCEQ  @FAC5,@SCRADD
          BR    GETINPUTK
GETINPUTL ST    >61,@VCHAR
          DST   @FAC8,@VROW
          B     GETINPUT8
GETINPUTM CZ    @FAC2
          BS    GETINPUTH
          CEQ   @FAC,@FAC2
          BS    GETINPUTH
          DCEQ  >004D,@VROW
GETINPUTN BS    GETINPUTH
          ST    >FF,@FAC7
          MOVE  8,G@G8018,V@>0B00
          B     GETINPUT9
GETINPUTO DCEQ  @OVROW,@VROW
          BS    GETINPUTH
          CALL  G6F8E
          BR    GETINPUT8
GETINPUTP CALL  CVRC
          DCEQ  @FAC5,@SCRADD
          BS    GETINPUTH
          CEQ   >61,@VCHAR
          BS    GETINPUTH
          CALL  G6F81
          BR    GETINPUT8
GETINPUTQ CZ    @FAC2
          BS    GETINPUTH
          DST   @OVROW,@VROW
          CLR   @FAC1
GETINPUTR CEQ   >61,@VCHAR
          BR    GETINPUTS
          ST    SPACE,@VCHAR
GETINPUTS ST    @VCHAR,V*FAC12
          DINC  @FAC12
          CALL  G6F81
          INC   @FAC1
          CEQ   @FAC,@FAC1
          BR    GETINPUTR
          ST    @FAC2,V*ARG
          MOVE  8,G@G8010,V@>0B00
          RTN
FCTN   CEQ   REDO,@KEY        * FCTN 8
       BS    FCTN8
       CEQ   BEGIN,@KEY       * FCTN 5
       BS    FCTN5
       CEQ   BACK,@KEY        * FCTN 9
       BS    FCTN9
       RTN
FCTN8  DST   @REDOX,V@>0C1A
       B     G76C2
FCTN5  DST   @BEGINX,V@>0C1A
       B     G76C2
FCTN9  DST   @BACKX,V@>0C1A
G76C2  CALL  BANK5
       ST    >7E,@SUBSTK
       ST    >9E,@DATSTK
       CALL  G76CE
G76CE  DST   V@>0C1A,*SUBSTK
       MOVE  8,G@G8010,V@>0B00
       RTN
***************************** Display Message.  8350=msg #
DMSG   DCHE  >0064,@FAC6      * Highest number of messeges
       BS    DMSG1
       DST   @MBASE,@FAC4
       BR    DMSG2
DMSG1  DST   @>8337,@FAC4
       DSUB  >0064,@FAC6
DMSG2  DADD  @FAC6,@FAC4
       DADD  @FAC6,@FAC4
       MOVE  4,G@G0000(@FAC4),@FAC6
       DSUB  @FAC6,@FAC8
       CALL  CVRC
       MOVE  @FAC8,G@G0000(@FAC6),V*SCRADD
       DST   @FAC8,@>830E
       DSRL  >0005,@FAC8
       ADD   @FAC9,@VROW
       AND   >1F,@>830F
       ADD   @>830F,@VCOL
DMSG3  CZ    @>832F
       BS    DMSG4
       ST    SPACE,@VCHAR
       INC   @VCOL
DMSG4  ST    >FF,@>832F
       DST   @VROW,@OVROW
       RTN
       BYTE  >2F,>2C,>2A,>3D,>23,>3F
       BYTE  >20,>3E,>3C,>30
ADSPLY ST   >00,@>832F
***************************** Multi-lingual display
*  >F0nn nn blanks to current posn
*  >F1   blank lines 1-18
*  >F2   blank line 18
*  >F3   blank lines 20-23
*  >F4   VROW+2, VCOL=2
*  >F5   VROW+1, VCOL=2
*  >FF   end of parms
*  >FB   fetch VCOL
*  >FC   fetch VROW
*  >FE   fetch VROW, VCOL=2
DSPLY  CLR   @FAC6
DSPLY1 FETCH @FAC7
       CALL  CVRC
       CHE   >E0,@FAC7
       BS    DSPLY2
       CALL  DMSG
       BR    DSPLY
DSPLY2 CHE   >F0,@FAC7
       BS    DSPLY3
       MOVE  1,G@GETINPUTN(@FAC6),V*SCRADD
       INC   @VCOL
       B     DSPLY
DSPLY3 CEQ   >FF,@FAC7
       BS    DMSG4
       CH    >FA,@FAC7
       BS    DSPLYC
       SUB   >F0,@FAC7
       CASE  @FAC7
       BR    DSPLY4
       BR    DSPLY6
       BR    DSPLY7
       BR    DSPLY8
       BR    DSPLYA
       BR    DSPLYB
       CALL  DMSG3
       BR    DSPLY
DSPLY4 FETCH @FAC2
DSPLY5 ST    SPACE,@VCHAR
       INC   @VCOL
       DEC   @FAC2
       BR    DSPLY5
       BR    DSPLY1
DSPLY6 DST   @VROW,@FAC11
       FMT
       COL   0
       ROW   0
       FOR   19
       HCHA  32,' '
       ROW+  1
       FEND
       FEND
       B     DSPLY9
DSPLY7 DST   @VROW,@FAC11
       CALL  BLINES
       BYTE  >12,>12
       BR    DSPLY9
DSPLY8 DST   @VROW,@FAC11
       CALL  BLINES
       BYTE  >14,>17
DSPLY9 DST   @FAC11,@VROW
       B     DSPLY1
DSPLYA INC   @VROW
DSPLYB INC   @VROW
       ST    >02,@VCOL
       B     DSPLY1
DSPLYC CEQ   >FC,@FAC7
       BR    DSPLYD
       FETCH @VROW
DSPLYD CEQ   >FB,@FAC7
       BR    DSPLYE
       FETCH @VCOL
DSPLYE CEQ   >FD,@FAC7
       BR    DSPLYF
       FETCH @VCOL
       CLR   @VROW
       DSRC  >0004,@VROW
       SRL   >04,@VROW
DSPLYF CEQ   >FE,@FAC7
       BR    DSPLYG
       FETCH @VROW
       ST    >02,@VCOL
DSPLYG B     DSPLY1
********************************************************************************
MENU1  DATA  >0000
       DATA  ENGLSH
       STRI  'DISK MANAGER 5'
********************************************************************************
ENGLSH DST  ENGMSG,@MBASE
       ALL   SPACE
G81F2  DST   DMANGR,@BEGINX
       ST    >01,@FAC2        * CALL FILES 1
       DST   >0116,V@>0C1A    *
       DST   >0C1A,@FAC12      *
       CALL  LINK             *
       BYTE  >0A              *
       ALL   SPACE
       DST   >0900,@FAC
       CALL  LOCASE           * Load lower case
       ST    >01,V@DMAST
       ST    >02,V@DCOPY
       DCLR  @>832B
       DST   @MEMSIZ,@>830E
       DINC  @>830E
       DSUB  >0E12,@>830E
       ST    @>830E,@>8331
       ST    >FF,@>832F
       ST    >60,@CURSOR
       MOVE  8,G@G8010,V@>0B00 * CURSOR
       MOVE  8,G@G8020,V@>0B08 * EDGE CHARACTER
       CLR   @ONEDSK
       ST    >01,V@>0C21
       MOVE  5,V@>0C21,V@>0C22
       CLR   V@>0C74
       CLR   V@>0C8C
       CLR   V@>0CCF          * Length byte
       CLR   V@>0C27
***************************** Disk Manager *************************************
DMANGR DST   DMANGR,@REDOX
       DST   QUIT,@BACKX
       CALL  HEADER           * 'DISK MANAGER'
       BYTE  >1E
       CALL  DSPLY            * '1' 'FILE COMMANDS'
                              * '2' 'DISK COMMANDS'
                              * '3' 'DISK TESTS'
                              *
       BYTE  >F4,>15,>1F,>F4,>16,>20
       BYTE  >F4,>17,>21,>FF
       CZ    @ONEDSK
       BR    SINGLE
       CALL  DSPLY            * '4''SET ALL COMMANDS FOR SINGLE DISK PROCESSING'
                              * 'YOUR CHOICE?'
       BYTE  >F4,>18,>22,>FE,>16,>4E
       BYTE  >FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>21,FOUR
       BR    NORMAL
SINGLE CALL  DSPLY            * 'SINGLE DISK PROCESSING HAS BEEN INITIALIZED'
                              * 'YOUR CHOICE?'
       BYTE  >F4,>23,>FE,>16,>4E,>FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>21,THREE
NORMAL DEC   @KEY
       CASE  @KEY
       BR    FMANGR
       BR    DCMDS
       BR    DTEST
       ST    >FF,@ONEDSK
       ST    >01,V@DMAST
       ST    >01,V@DCOPY
       ST    >01,V@>0C21
       B     DMANGR
QUIT   EXIT
***************************** File Manger **************************************
FMANGR DST   FMANGR,@REDOX
       DST   DMANGR,@BACKX
       CALL  HEADER           * 'FILE COMMANDS'
       BYTE  >1F
       CALL  DSPLY            * '1' 'COPY FILE'
                              * '2' 'RENAME FILE'
                              * '3' 'DELETE FILE'
                              * '4' 'MODIFIY FILE PROTECTION'
                              * 'YOUR CHOICE?'
       BYTE  >F4,>15,>24,>F4,>16,>25
       BYTE  >F4,>17,>26,>F4,>18,>28
       BYTE  >FE,>16,>4E,>FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>22,FOUR
       DEC   @KEY
       DST   FMANGR,@BACKX
       CLR   V@>0C74
       CLR   V@>0C8C
       CASE  @KEY
       BR    FCOPY
       BR    FRENA
       BR    FDEL
       BR    FMODP
***************************** Disk Commands ************************************
DCMDS  DST   DCMDS,@REDOX
       DST   DMANGR,@BACKX
       CALL  HEADER           * 'DISK COMMANDS'
       BYTE  >20
       CALL  DSPLY            * '1' 'CATALOG DISK'
                              * '2' 'BACKUP DISK'
                              * '3' 'MODIFY DISK NAME'
                              * '4' 'INITIALIZE NEW DISK'
                              * 'YOUR CHOICE?'
       BYTE  >F4,>15,>2A,>F4,>16,>2B
       BYTE  >F4,>17,>2D,>F4,>18,>2F
       BYTE  >FE,>16,>4E,>FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>23,FOUR
       DEC   @KEY
       DST   DCMDS,@BACKX
       CLR   V@>0C89
       CLR   V@>0CA1
       CASE  @KEY
       BR    DCAT
       BR    DBKUP
       BR    DMOD
       BR    DINIT
***************************** Disk Tests ***************************************
DTEST  DST   DTEST,@REDOX
       DST   DMANGR,@BACKX
       CALL  HEADER           * 'DISK TESTS'
       BYTE  >21
       CALL  DSPLY            * '1' 'QUICK TEST'
                              * '2' 'COMPREHENSIVE TEST'
                              * 'YOUR CHOICE?'
       BYTE  >F4,>15,>30,>F4,>16,>31
       BYTE  >FE,>16,>4E,>FF
       CALL  INKEY
       BYTE  NUMBER,>0C,>24,TWO
       DEC   @KEY
       DST   DTEST,@BACKX
       CLR   V@>0C89
       CLR   V@>0CA1
       CASE  @KEY
       BR    TQICK
       BR    TCOMP
 
****************************** GROM 8000 ***************************************
       GROM  >8000
       AORG  >0010
 
G8010  TEXT  '<<$$$$<<'              * CURSOR CHARACTER
G8018  TEXT  'xx````xx'              * EDGE CHARACTER
G8020  BYTE  >00,>00,>00,>00,>24,>24,>3C,>3C,>42,>59
***************************** Message Table ************************************
                                * ADDRESS OF MESSAGES IN GROM
ENGMSG DATA  G8448,G8449,G844A
       DATA  G844A,G844A,G844A
       DATA  G8454,G8454,G8454
       DATA  G8454,G8454,G8454
       DATA  G8454,G8454,G8465
       DATA  G8475,G8483,G849D
       DATA  G84AF,G84E4,G84E4
       DATA  G84E4,G84E5,G84E6
       DATA  G84E7,G84E8,G84E9
       DATA  G84EA,G84EB,G84EC
       DATA  G84ED,G84F9,G8506
       DATA  G8513,G851D,G8553
       DATA  G8583,G858C,G8597
       DATA  G85A2,G85A2,G85B8
       DATA  G85B8,G85C4,G85CF
       DATA  G85CF,G85DF,G85DF
       DATA  G85F2,G85FC,G860E
       DATA  G860E,G8617,G8624
       DATA  G8635,G863F,G8645
       DATA  G8681,G8688,G868C
       DATA  G8690,G8693,G8696
       DATA  G8696,G8696,G86B0
       DATA  G8717,G8722,G8736
       DATA  G8736,G8743,G8751
       DATA  G876B,G876B,G8776
       DATA  G878D,G87A2,G87B5
       DATA  G87C5,G87D1,G87DA
       DATA  G87E6,G87F3,G8805
       DATA  G8815,G8815,G8815
       DATA  G8825,G8839,G8839
       DATA  G8839,G8839,G8839
       DATA  G886F,G887E,G888D
       DATA  G889E,G88B4,G88BA
       DATA  G88CA,G88D0
***************************** TEXT MESSAGES ************************************
G8448  TEXT  'N'                                                      * >00
G8449  TEXT  'Y'                                                      * >01
G844A  TEXT  'DISK ERROR'                                             * >05
G8454  TEXT  'COMMAND COMPLETED'                                      * >0D
G8465  TEXT  'LOAD MASTER DISK'                                       * >0E
G8475  TEXT  'LOAD COPY DISK'                                         * >0F
G8483  TEXT  'WORKING.....  PLEASE WAIT.'                             * >10
G849D  TEXT  'SCREEN IS COMPLETE'                                     * >11
G84AF  TEXT  'PRESS: PROC''D, REDO,            BEGIN, OR BACK'        * >12
G84E4  TEXT  '1'                                                      * >15
G84E5  TEXT  '2'                                                      * >16
G84E6  TEXT  '3'                                                      * >17
G84E7  TEXT  '4'                                                      * >18
G84E8  TEXT  '5'                                                      * >19
G84E9  TEXT  '6'                                                      * >1A
G84EA  TEXT  '7'                                                      * >1B
G84EB  TEXT  '8'                                                      * >1C
G84EC  TEXT  '9'                                                      * >1D
G84ED  TEXT  'DISK MANAGER'                                           * >1E
G84F9  TEXT  'FILE COMMANDS'                                          * >1F
G8506  TEXT  'DISK COMMANDS'                                          * >20
G8513  TEXT  'DISK TESTS'                                             * >21
G851D  TEXT  'SET ALL COMMANDS FOR            SINGLE DISK PROCESSING' * >22
G8553  TEXT  'SINGLE DISK PROCESSING HAS      BEEN INITIALIZED'       * >23
G8583  TEXT  'COPY FILE'                                              * >24
G858C  TEXT  'RENAME FILE'                                            * >25
G8597  TEXT  'DELETE FILE'                                            * >26
G85A2  TEXT  'MODIFY FILE PROTECTION'                                 * >28
G85B8  TEXT  'CATALOG DISK'                                           * >2A
G85C4  TEXT  'BACKUP DISK'                                            * >2B
G85CF  TEXT  'MODIFY DISK NAME'                                       * >2D
G85DF  TEXT  'INITIALIZE NEW DISK'                                    * >2F
G85F2  TEXT  'QUICK TEST'                                             * >30
G85FC  TEXT  'COMPREHENSIVE TEST'                                     * >31
G860E  TEXT  'DISKNAME='                                              * >33
G8617  TEXT  'NEW FILENAME?'                                          * >34
G8624  TEXT  'DSK  -  DISKNAME='                                      * >35
G8635  TEXT  'AVAILABLE='                                             * >36
G863F  TEXT  ' USED='                                                 * >37
G8645  TEXT  ' FILENAME  SIZE '                                       * >38
       TEXT  '   TYPE    P    '
       TEXT  '---------- ---- '
       TEXT  '---------- -'
G8681  TEXT  'PROGRAM'                                                * >39
G8688  TEXT  'DIS/'                                                   * >3A
G868C  TEXT  'INT/'                                                   * >3B
G8690  TEXT  'VAR'                                                    * >3C
G8693  TEXT  'FIX'                                                    * >3D
G8696  TEXT  'WHERE DO YOU WANT LISTING?'                             * >40
G86B0  TEXT  '1 SCREEN        '                                       * >41
       TEXT  '                '
       TEXT  '2 SOLID STATE PRINTER           '
       TEXT  '3 PIO INTERFACE                 '
       TEXT  '4 OTHER'
G8717  TEXT  'DESTRUCTIVE'                                            * >42
G8722  TEXT  'LISTING DEVICE ERROR'                                   * >43
G8736  TEXT  'DELETE (Y/N)?'                                          * >45
G8743  TEXT  'PROTECT (Y/N)?'                                         * >46
G8751  TEXT  'OVERRIDE PROTECTION (Y/N)?'                             * >47
G876B  TEXT  'LOOP (Y/N)?'                                            * >49
G8776  TEXT  'DESTRUCTIVE TEST (Y/N)?'                                * >4A
G878D  TEXT  'SINGLE DENSITY (Y/N)?'                                  * >4B
G87A2  TEXT  'SINGLE SIDED (Y/N)?'                                    * >4C
G87B5  TEXT  'TRACKS PER SIDE?'                                       * >4D
G87C5  TEXT  'YOUR CHOICE?'                                           * >4E
G87D1  TEXT  'FILENAME?'                                              * >4F
G87DA  TEXT  'DEVICE NAME?'                                           * >50
G87E6  TEXT  'NEW DISKNAME?'                                          * >51
G87F3  TEXT  'MASTER DISK (1-9)?'                                     * >52
G8805  TEXT  'COPY DISK (1-9)?'                                       * >53
G8815  TEXT  'BAD ADDRESS/CODE'                                       * >56
G8825  TEXT  'DISK NOT INITIALIZED'                                   * >57
G8839  TEXT  'PRESS:          '                                       * >5C
       TEXT  '                '
       TEXT  'CLEAR TO ABORT COMMAND'
G886F  TEXT  'COMPLETED PASS:'                                        * >5D
G887E  TEXT  '  TOTAL ERRORS:'                                        * >5E
G888D  TEXT  'LOG ERRORS (Y/N)?'                                      * >5F
G889E  TEXT  'PROPRIETARY DISK ERROR'                                 * >60
G88B4  TEXT  '(Y/N)?'                                                 * >61
G88BA  TEXT  'SELECTIVE (Y/N)?'                                       * >62
G88CA  TEXT  'TEST #'                                                 * >63
G88D0  BYTE  >00
********************************************************************************
       END
 
 

 

  • Like 1
Link to comment
Share on other sites

Above was Rich Disk Manager 5

This below is RXB2001 but the XB source is there, lost the original in a Hard Drive failure.

Spoiler

 
***********************************************************
       TITL 'MYXB3'
***********************************************************
       GROM >6000
***********************************************************
       TITL 'EQUATES EDIT-359'
***********************************************************
CPUBAS EQU  >A040             CRU base
***********************************************************
*           GROM ADDRESSES
MZMSG  EQU  >6038             Start of message area
MZPSCN EQU  >6A70             Module PSCAN branch table add
***********************************************************
OUTREC EQU  >801A
G8024  EQU  >8024             CHKEND in upper GROM is diffe
KEYTAB EQU  >CB00
ERRTAB EQU  >CD77
TRACBK EQU  >CE1F
RETNOS EQU  >CF68
EDTZZ0 EQU  >D000             Edit a line or display it tab
EDTZ00 EQU  >D00D             Edit a line or display it
SAVLIN EQU  >D0AF             Save input line address
GE025  EQU  >E025             RXB PATCH CODE FOR EA CART
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER SECTIONS
 
CLSALL EQU  >8012             CLose ALL open files
SAVE   EQU  >8014             SAVE a program
OLD    EQU  >8016             OLD  (load a program)
LIST   EQU  >8018             LIST a program
OLD1   EQU  >8026             A subprogram for LOAD
MERGE  EQU  >8028             MERGE a program
GRMLST EQU  >802A             List program line from ERAM
GRSUB2 EQU  >802C             Read from ERAM(GREAD1) or VDP
GRSUB3 EQU  >802E             Read from ERAM(use GREAD1) or
*                              VDP, reset prossible bkpt to
ATNZZ  EQU  >0032             Arctangent routine
ERRZ   EQU  >6A84             ERRor routine
EXEC   EQU  >A004
ASC    EQU  >A00A
EXEC1  EQU  >A00C             EXECute a program statememt
EXEC6D EQU  >A00E
DELINK EQU  >A010
SQUISH EQU  >A014
INTRND EQU  >A018             Initilize random number
LINK1  EQU  >A026             LINK to subprogram
***********************************************************
*    Equates for routine in MONITOR
CALDSR EQU  >10               CALL DEVICE SERVICE ROUTINE
TONE1  EQU  >34               ACCEPT TONE
TONE2  EQU  >36               BAD TONE
***********************************************************
*    Equates for XMLs
SYNCHK EQU  >00               SYNCHK XML selector
SEETWO EQU  >03               SEETWO XML selector
COMPCT EQU  >70               PREFORM A GARBAGE COLLECTION
MEMCHK EQU  >72               MEMORY check routine: VDP
VPUSH  EQU  >77               Push on value stack
VPOP   EQU  >78               Pop off value stack
PGMCHR EQU  >79               GET PROGRAM CHARACTER
SCHSYM EQU  >7D               Search symbol table
SPEED  EQU  >7E               SPEED UP XML
CRUNCH EQU  >7F               Crunch an input line
CONTIN EQU  >81               Continue after a break
SCROLL EQU  >83               SCROLL THE SCREEN
IO     EQU  >84               IO utility (KW table search)
GREAD  EQU  >85               READ DATA FROM ERAM
GWRITE EQU  >86               WRITE DATA TO ERAM
DELREP EQU  >87               REMOVE CONTENT FROM VDP/ERAM
MVDN   EQU  >88               MOVE DATA IN VDP/ERAM
MVUP EQU    >89               MOVE DATA IN VDP/ERAM
VGWITE EQU  >8A               MOVE DATA FROM VDP TO ERAM
GVWITE EQU  >8B               WRITE DATA FROM GRAM TO VRAM
GDTECT EQU  >8E               ERAM DETECT&ROM PAGE 1 ENABLE
SCNSMT EQU  >8F               SCAN STATEMENT FOR PRESCAN
***********************************************************
*    GPL Status Block
STACK  EQU  >8372             STACK FOR DATA
KEYBD  EQU  >8374             KEYBOARD SELCTION
RKEY   EQU  >8375             KEY CODE
RANDOM EQU  >8378             RANDOM NUMBER GENERATOR
TIMER  EQU  >8379             TIMING REGISTER
MOTION EQU  >837A             NUMBER OF MOVING SPRITES
VDPSTS EQU  >837B             VDP STATUS REGISTER
ERCODE EQU  >837C             STATUS REGISTER
***********************************************************
*    Temporary workspaces in EDIT
VAR0   EQU  >8300            TEMPORARY
VARV   EQU  >8301            TEMPORARY
ACCUM  EQU  >8302            # OF BYTES ACCUMULATOR (4 BYTE
STPT   EQU  >8302            TWO BYTES
VARY   EQU  >8304
VARY2  EQU  >8306
PABPTR EQU  >8304
DFLTLM EQU  >8306            Default array limit (10)
CCPPTR EQU  >8306            OFFSET WITHIN RECORED (1)
RECLEN EQU  >8307            LENGTH OF CURRENT RECORD (1)
CCPADR EQU  >8308            RAM address of current refs
VARC   EQU  >8308
CCPADD EQU  >8308            RAM address of current color
CALIST EQU  >830A            Call list for resolving refs
RAMPTR EQU  >830A            Pointer for crunching
BYTES  EQU  >830C            BYTE COUNTER
NMPTR  EQU  >830C            Pointer save for pscan
CHSAV  EQU  >830E
CURINC EQU  >830E            Increment for auto-num mode
TOPSTK EQU  >8310            Top of data stack pointer
LINUM  EQU  >8312            Used to determine end of scan
NMLEN  EQU  >8314            Current line for auto-num
CURLIN EQU  >8314            Current line for auto-num
VAR9   EQU  >8316
XFLAG  EQU  >8316            SCAN FLAG-BITS USED AS BELOW
DSRFLG EQU  >8317            INTERNAL =60, EXTERNAL =0 (1)
FORNET EQU  >8317            Nesting level of for/next
AAA1   EQU  >8302
BBB1   EQU  >830C
CCC1   EQU  >8308
***********************************************************
*    Permanent workspace variables
STRSP  EQU  >8318            String space begining
STREND EQU  >831A            String space ending
SREF   EQU  >831C            Temporary string pointer
SMTSRT EQU  >831E            Start of current statement
VARW   EQU  >8320            Screen address
ERRCOD EQU  >8322            Return error code from ALC
STVSPT EQU  >8324            Value-stack base
VARA   EQU  >832A            Ending display location
PGMPTR EQU  >832C            Program text pointer
EXTRAM EQU  >832E            Line number table pointer
STLN   EQU  >8330            Start of line number table
ENLN   EQU  >8332            End of line number table
DATA   EQU  >8334            Data pointer for READ
LNBUF  EQU  >8336            Line table pointer for READ
INTRIN EQU  >8338            Add of intrinsic poly constant
SUBTAB EQU  >833A            Subprogram symbol table
IOSTRT EQU  >833C            PAB list/Start of I/O chain
SYMTAB EQU  >833E            Symbol table pointer
FREPTR EQU  >8340            Free space pointer
CHAT   EQU  >8342            Current charater/token
BASE   EQU  >8343            OPTION BASE value
PRGFLG EQU  >8344            Program/imperative flag
FLAG   EQU  >8345            General 8-bit flag
BUFLEV EQU  >8346            Crunch-buffer destruction leve
LSUBP  EQU  >8348            Last subprogram block on stack
* FAC  EQU  >834A            Floating-point ACcurmulator
FAC1   EQU  FAC+1
FAC2   EQU  FAC+2
FAC3   EQU  FAC+3
FAC4   EQU  FAC+4
FAC5   EQU  FAC+5
FAC6   EQU  FAC+6
FAC7   EQU  FAC+7
FAC8   EQU  FAC+8
FAC9   EQU  FAC+9
FAC10  EQU  FAC+10
FAC12  EQU  FAC+12
FAC13  EQU  FAC+13
FAC14  EQU  FAC+14
FAC15  EQU  FAC+15
FAC16  EQU  FAC+16
FAC17  EQU  FAC+17
AAA    EQU  FAC+2
CCC    EQU  FAC+4
BBB    EQU  FAC+6
DDD    EQU  FAC+2
FFF    EQU  FAC+4
EEE    EQU  FAC+6
DDD1   EQU  FAC+10
FFF1   EQU  FAC+12
EEE1   EQU  FAC+14
* ARG  EQU  >835C             Floating-point ARGument
ARG1   EQU  ARG+1
ARG2   EQU  ARG+2
ARG3   EQU  ARG+3
ARG4   EQU  ARG+4
ARG5   EQU  ARG+5
ARG6   EQU  ARG+6
ARG7   EQU  ARG+7
ARG8   EQU  ARG+8
XSTLN  EQU  >8364            GKXB variable
XENLN  EQU  >8366            GKXB variable
ARG11  EQU  ARG+11
XCURLI EQU  >8368            GKXB variable
XCURIN EQU  >836A            GKXB variable
ARG15  EQU  ARG+15
ARG16  EQU  ARG+16
* VSPTR  EQU  >836E          Value stack pointer
EXPZ   EQU  >8376            Exponent in floating-point
RAMTOP EQU  >8384            Highest address in ERAM
RAMFRE EQU  >8386            Free pointer in the ERAM
RSTK   EQU  >8388            Subroutine stack base
RAMFLG EQU  >8389            ERAM flag
STKMIN EQU  >83AF            Base of data stack
STKMAX EQU  >83BD            Top of data stack
PRTNFN EQU  >83CE
***********************************************************
*    VDP addresses
NLNADD EQU  >02E2             New LiNe ADDress
ENDSCR EQU  >02FE             END of SCReen address
LODFLG EQU  >0371             Auto-boot needed flag
START  EQU  >0372             Line to start execution at
SYMBOL EQU  >0376             Saved symbol table pointer
SPGMPT EQU  >0382             Saved PGMPTR for continue
SBUFLV EQU  >0384             Saved BUFLEV for contiue
SEXTRM EQU  >0386             Saved EXTRAM for continue
* SAVEVP EQU  >0388           Saved VSPRT for continue
* ERRLN  EQU  >038A           On-error line pointer
BUFSRT EQU  >038C             Edit recall start addr (VARW)
BUFEND EQU  >038E             Edit recall end addr (VARA)
TABSAV EQU  >0392             Saved main symbol table ponte
SLSUBP EQU  >0396             Saved LSUBP for continue
SFLAG  EQU  >0398             Saved on-warning/break bits
SSTEMP EQU  >039A             To save subprogram program ta
SSTMP2 EQU  >039C             Same as above. Used in SUBPRO
MRGPAB EQU  >039E             MERGEd temporary for pab ptr
*----------------------------------------------------------
* Added 6/8/81 for NOPSCAN feature
PSCFG  EQU  >03B7
*----------------------------------------------------------
*    Flag 0:  99/4  console, 5/29/81
*         1:  99/4A console
CONFLG EQU  >03BB
*----------------------------------------------------------
* Temporary
NOTONE EQU  >0374             NO-TONE for SIZE in ACCEPT us
*                              in FLMGRS (4 bytes used)
SAVEVP EQU  >0388
ERRLN  EQU  >038A
ACCVRW EQU  >03AC             Temoporary used in ERRZZ, als
*                              used in FLMGRS
VALIDP EQU  >03B0             Use as two values passing fro
VALIDL EQU  >03B2             VALIDATE code to READL1
OLDTOP EQU  >03BC             Temporary used in ERRZZ, also
CRNBUF EQU  >0820             CRuNch BUFfer address
CRNEND EQU  >08BE             CRuNch buffer END
RECBUF EQU  >08C0             Edit RECall BUFfer
VRAMVS EQU  >0958             Default base of value stack
CNSTMP EQU  >0390             Use as temporary stored place
***********************************************************
*    IMMEDITATE VALUES
NUMBR  EQU  >00               NUMERIC validate
LISTZ  EQU  >02
OLDZ   EQU  >05
RESEQZ EQU  >06
SAVEZ  EQU  >07
MERGEZ EQU  >08
DWNARR EQU  >0A
UPARR  EQU  >0B
CHRTN  EQU  >0D
OFFSET EQU  >60
OSPACE EQU  >20+OFFSET        GKXB space plus offset
*  Bits in XFLAG
REMODE EQU  0                 REM only mode
OPTFLG EQU  1                 Option base declared flag
FNCFLG EQU  2                 Scanning UDF
SUBFLG EQU  3                 Scanning a subprogram
STRFLG EQU  4                 Scanning a string variable
SAFLG  EQU  5                 Scanning subprogram arguments
IFFLAG EQU  6                 Scanning an if-statement
ENTXFL EQU  7                 ENTERX flag
*
*               BITS IN FLAG
* NUMBIT EQU  >00             Autonum bit (Can't use MACRO)
WRNPRT EQU  1                 Warning print bit
WRNSTP EQU  2                 Warning stop bit
***********************************************************
* Editting command equates
BREAK  EQU  >02               Break key
DLETE  EQU  >03               Delete key
INSRT  EQU  >04               Insert key
RECALL EQU  >06               Edit-buffer recall
CLRLN  EQU  >07               Clear-line key
BACK   EQU  >08               Back-space key
FORW   EQU  >09               Forward-space key
DOWN   EQU  >0A               Down-arrow key
UPMV   EQU  >0B               Up-arrow key
***********************************************************
* IMMEDITE VALUES
QUOTE  EQU  >22               "
DOLLAR EQU  >24               $
CURSOR EQU  >1E+OFFSET        CURSOR
EDGECH EQU  >1F+OFFSET        EDGE character
COMMA  EQU  >2C               ,
DASH   EQU  >2D               -  GKXB
COLON  EQU  >3A               :  GKXB
***********************************************************
* PAB offset
CZCLOS EQU  1                 CLOSE CODE
COD    EQU  4                 I/O code
NLEN   EQU  13                Length of file descriptor
***********************************************************
*    BASIC TOKEN TABLE
*      EQU  >80               spare token
ELSEZ  EQU  >81               ELSE
SSEPZ  EQU  >82               ::
TREMZ  EQU  >83               $
IFZ    EQU  >84               IF
GOZ    EQU  >85               GO
GOTOZ  EQU  >86               GOTO
GOSUBZ EQU  >87               GOSUB
RETURZ EQU  >88               RETURN
DEFZ   EQU  >89               DEF
DIMZ   EQU  >8A               DIM
ENDZ   EQU  >8B               END
FORZ   EQU  >8C               FOR
LETZ   EQU  >8D               LET
BREAKZ EQU  >8E               BREAK
UNBREZ EQU  >8F               UNBREAK
TRACEZ EQU  >90               TRACE
UNTRAZ EQU  >91               UNTRACE
INPUTZ EQU  >92               INPUT
DATAZ  EQU  >93               DATA
RESTOZ EQU  >94               RESTORE
RANDOZ EQU  >95               RANDOMIZE
NEXTZ  EQU  >96               NEXT
READZ  EQU  >97               READ
STOPZ  EQU  >98               STOP
DELETZ EQU  >99               DELETE
REMZ   EQU  >9A               REM
ONZ    EQU  >9B               ON
PRINTZ EQU  >9C               PRINT
CALLZ  EQU  >9D               CALL
OPTIOZ EQU  >9E               OPTION
OPENZ  EQU  >9F               OPEN
CLOSEZ EQU  >A0               CLOSE
SUBZ   EQU  >A1               SUB
DISPLZ EQU  >A2               DISPLAY
IMAGEZ EQU  >A3               IMAGE
ACCEPZ EQU  >A4               ACCEPT
ERRORZ EQU  >A5               ERROR
WARNZ  EQU  >A6               WARNING
SUBXTZ EQU  >A7               SUBEXIT
SUBNDZ EQU  >A8               SUBEND
RUNZ   EQU  >A9               RUN
LINPUZ EQU  >AA               LINPUT
*      EQU  >AB               Zpare token (LIBRARY)
*      EQU  >AC               Zpare token (REAL)
*      EQU  >AD               Zpare token (INTEGER)
*      EQU  >AE               Zpare token (SCRATCH)
*      EQU  >AF               Zpare token
THENZ  EQU  >B0               THEN
TOZ    EQU  >B1               TO
STEPZ  EQU  >B2               STEP
COMMAZ EQU  >B3               ,
SEMICZ EQU  >B4               ;
COLONZ EQU  >B5               :
RPARZ  EQU  >B6               )
LPARZ  EQU  >B7               (
CONCZ  EQU  >B8               &          (CONCATENATE)
*      EQU  >B9               spare token
ORZ    EQU  >BA               OR
ANDZ   EQU  >BB               AND
XORZ   EQU  >BC               XOR
NOTZ   EQU  >BD               NOT
EQUALZ EQU  >BE               =
LESSZ  EQU  >BF               <
GREATZ EQU  >C0               >
PLUSZ  EQU  >C1               +
MINUSZ EQU  >C2               -
MULTZ  EQU  >C3               *
DIVIZ  EQU  >C4               /
CIRCUZ EQU  >C5               ^
*      EQU  >C6               spare token
STRINZ EQU  >C7               QUOTED STRING
UNQSTZ EQU  >C8               UNQUOTED STRING
NUMZ   EQU  >C8               ALSO NUMERICAL STRING
NUMCOZ EQU  >C8               ALSO UNQUOTED STRING
LNZ    EQU  >C9               LINE NUMBER CONSTANT
*      EQU  >CA               spare token
ABSZ   EQU  >CB               ABS
ATNZ   EQU  >CC               ATN
COSZ   EQU  >CD               COS
EXPZZ  EQU  >CE               EXP
INTZ   EQU  >CF               INT
LOGZ   EQU  >D0               LOG
SGNZZ  EQU  >D1               SGN
SINZ   EQU  >D2               SIN
SQRZ   EQU  >D3               SQR
TANZ   EQU  >D4               TAN
LENZ   EQU  >D5               LEN
CHRZZ  EQU  >D6               CHR$
RNDZ   EQU  >D7               RND
SEGZZ  EQU  >D8               SEG$
POSZ   EQU  >D9               POS
VAL    EQU  >DA               VAL
STRZZ  EQU  >DB               STR$
ASCZ   EQU  >DC               ASC
PIZ    EQU  >DD               PI
RECZ   EQU  >DE               REC
MAXZ   EQU  >DF               MAX
MINZ   EQU  >E0               MIN
RPTZZ  EQU  >E1               RPT$
*      EQU  >E2  to >E7
NUMERZ EQU  >E8               NUMERIC
DIGITZ EQU  >E9               DIGIT
UALPHZ EQU  >EA               UALPHA
SIZEZ  EQU  >EB               SIZE
ALLZ   EQU  >EC               ALL
USINGZ EQU  >ED               USING
BEEPZ  EQU  >EE               BEEP
ERASEZ EQU  >EF               ERASE
ATZ    EQU  >F0               AT
BASEZ  EQU  >F1               BASE
*      EQU  >F2               spare token (TEMPORARY)
*      EQU  >F3               spare token (VARIABLE)
*      EQU  >F4               spare token (RELATIVE)
*      EQU  >F5               spare token (INTERNAL)
SEQUEZ EQU  >F6               SEQUENTIAL
OUTPUZ EQU  >F7               OUTPUT
UPDATZ EQU  >F8               UPDATE
APPENZ EQU  >F9               APPEND
FIXEDZ EQU  >FA               FIXED
PERMAZ EQU  >FB               PERMANENT
TABZ   EQU  >FC               TAB
NUMBEZ EQU  >FD               #
VALIDZ EQU  >FE               VALIDATE
*      EQU  >FF               ILLEGAL VALUE
***********************************************************
       TITL 'EDIT-359'
***********************************************************
*                        GROM HEADER
***********************************************************
       GROM >6000
       AORG 0
       DATA >AA02,>0100,0,USER,0,LINK1,0,0
***********************************************************
*    Branch table for routines in EDIT
***********************************************************
       BR   AUTON
G6012  BR   TOPL15
       BR   INITPG
       BR   SPRINT            Initialize sprites.
       BR   CHRTBL            RXB CHRTBL
       BR   TOPL10
G601C  BR   CHRTAB
       BR   SZRUN
       BR   $                 Was GETLNB
       BR   KILSYM
       BR   $                 Was CRUNCH
       BR   GETNB
       BR   GETNB2
       BR   GETCHR
       BR   GETLN
       BR   AUTO1
       DATA TOPL02
       BR   EDITLN
       BR   GRSUB1            Read from ERAM (use GREAD/VDP
       BR   GWSUB             Write a few bytes to ERAM/VDP
*    Error and system messages
*      BASE 0,0,>300,>300,0,0,>60
MSGERR BYTE >A9,>CE,>80,>A5,>D2,>D2,>CF,>D2
*           In Error
MSGFST BYTE >07,>B2,>C5,>C1,>C4,>D9,>80,>8A
*            Ready
MSGBRK BYTE >0A,>A2,>D2,>C5,>C1,>CB,>D0,>CF,>C9,>CE,>D4
*            Breakpoint
MSGTA  BYTE >B4,>D2,>D9,>80,>A1,>C7,>C1,>C9,>CE
*           Try Again
MSGWRN BYTE >8A,>80,>B7,>C1,>D2,>CE,>C9,>CE,>C7
*            * Warning
MSG10  BYTE >10,>AE,>D5,>CD,>C5,>D2,>C9,>C3,>80
*            Numeric
       BYTE >AF,>D6,>C5,>D2,>C6,>CC,>CF,>D7
*           Overflow
MSG14  BYTE >0C,>B3,>D9,>CE,>D4,>C1,>D8,>80,>A5,>D2,>D2,>CF
*            Syntax Error
MSG16  BYTE >18,>A9,>CC,>CC,>C5,>C7,>C1,>CC,>80,>A1,>C6,>D4
*            Illegal After
       BYTE >B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD
*           Subprogram
MSG17  BYTE >10,>B5,>CE,>CD,>C1,>D4,>C3,>C8,>C5,>C4,>80
*           Unmatched
       BYTE >B1,>D5,>CF,>D4,>C5,>D3
*           Quotes
MSG19  BYTE >0D,>AE,>C1,>CD,>C5,>80,>B4,>CF,>CF,>80,>AC,>CF
*            Name Too Long
MSG24  BYTE >16,>B3,>D4,>D2,>C9,>CE,>C7,>8D,>AE,>D5,>CD,>C2
*            String-Number
       BYTE >AD,>C9,>D3,>CD,>C1,>D4,>C3,>C8
*           Mismatch
MSG25  BYTE >11,>AF,>D0,>D4,>C9,>CF,>CE,>80,>A2,>C1,>D3,>C5
*            Option Base
       BYTE >A5,>D2,>D2,>CF,>D2
*           Error
MSG28  BYTE >14,>A9,>CD,>D0,>D2,>CF,>D0,>C5,>D2,>CC,>D9,>80
*            Improperly
       BYTE >B5,>D3,>C5,>C4,>80,>AE,>C1,>CD,>C5
*           Used Name
MSG34  BYTE >16,>B5,>CE,>D2,>C5,>C3,>CF,>C7,>CE,>C9,>DA,>C5
*            Unrecognized
       BYTE >A3,>C8,>C1,>D2,>C1,>C3,>D4,>C5,>D2
*           Character
MSG36  BYTE >0B,>A9,>CD,>C1,>C7,>C5,>80,>A5,>D2,>D2,>CF,>D2
*            Image Error
MSG39  BYTE >0B,>AD,>C5,>CD,>CF,>D2,>D9,>80,>A6,>D5,>CC,>CC
*            Memory Full
MSG40  BYTE >0E,>B3,>D4,>C1,>C3,>CB,>80,>AF,>D6,>C5,>D2,>C6
*            Stack Overflow
MSG43  BYTE >10,>AE,>A5,>B8,>B4,>80,>B7,>C9,>D4,>C8,>CF,>D5
*            NEXT Without
       BYTE >A6,>AF,>B2
*           FOR
MSG44  BYTE >10,>A6,>AF,>B2,>8D,>AE,>A5,>B8,>B4,>80
*           FOR-NEXT
       BYTE >AE,>C5,>D3,>D4,>C9,>CE,>C7
*           Nesting
MSG47  BYTE >15,>AD,>D5,>D3,>D4,>80,>A2,>C5,>80,>A9,>CE
*            Must be in
       BYTE >80,>B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD
*            Subprogram
MSG48  BYTE >19,>B2,>C5,>C3,>D5,>D2,>D3,>C9,>D6,>C5,>80
*           Recursive
       BYTE >B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD,>80,>A3
*           Subprogram Call
MSG49  BYTE >0E,>AD,>C9,>D3,>D3,>C9,>CE,>C7,>80,>B3,>B5,>A2
*            Missing Subend
MSG51  BYTE >14,>B2,>A5,>B4,>B5,>B2,>AE,>80,>B7,>C9,>D4,>C8
*            RETURN Without
       BYTE >80,>A7,>AF,>B3,>B5,>A2
*           GOSUB
MSG54  BYTE >10,>B3,>D4,>D2,>C9,>CE,>C7,>80
*            String
       BYTE >B4,>D2,>D5,>CE,>C3,>C1,>D4,>C5,>C4
*           Truncated
MSG57  BYTE >0D,>A2,>C1,>C4,>80,>B3,>D5,>C2,>D3,>C3,>D2,>C9
*            Bad Subscript
MSG60  BYTE >0E,>AC,>C9,>CE,>C5,>80,>AE,>CF,>D4,>80,>A6,>CF
*           Line Not Found
MSG61  BYTE >0F,>A2,>C1,>C4,>80,>AC,>C9,>CE,>C5,>80
*           Bad Line
       BYTE >AE,>D5,>CD,>C2,>C5,>D2
*           Number
MSG67  BYTE >0E,>A3,>C1,>CE,>87,>D4,>80,>A3,>CF,>CE,>D4,>C9
*            Can't Continue
MSG69  BYTE >1A,>A3,>CF,>CD,>CD,>C1,>CE,>C4,>80
*            Command
       BYTE >A9,>CC,>CC,>C5,>C7,>C1,>CC,>80,>C9,>CE,>80
*           Illegal in
       BYTE >B0,>D2,>CF,>C7,>D2,>C1,>CD
*           Program
MSG70  BYTE >17,>AF,>CE,>CC,>D9,>80,>AC,>C5,>C7,>C1,>CC,>80
*            Only Legal
       BYTE >C9,>CE,>80 >C1,>80,>B0,>D2,>CF,>C7,>D2,>C1,>CD
*           in a Program
MSG74  BYTE >0C,>A2,>C1,>C4,>80,>A1,>D2,>C7,>D5,>CD,>C5,>CE
*            Bad Argument
MSG78  BYTE >12,>AE,>CF,>80,>B0,>D2,>CF,>C7,>D2,>C1,>CD
*            No Program
       BYTE >80,>B0,>D2,>C5,>D3,>C5,>CE,>D4
*            Present
MSG79  BYTE >09,>A2,>C1,>C4,>80,>B6,>C1,>CC,>D5,>C5
*            Bad Value
MSG81  BYTE >17,>A9,>D1,>C3,>C3,>D2,>D2,>C5,>C3,>D4,>80
*            Incorrect
       BYTE >A1,>D2,>C7,>D5,>CD,>C5,>CE,>D4,>80,>AC,>C9,>D3
*           Argument List
MSG83  BYTE >0B,>A9,>CE,>D0,>D5,>D4,>80,>A5,>D2,>D2,>CF,>D2
*            Input Error
MSG84  BYTE >0A,>A4,>C1,>D4,>C1,>80,>A5,>D2,>D2,>CF,>D2
*            Data Error
MSG97  BYTE >14,>B0,>D2,>CF,>D4,>C5,>C3,>D4,>C9,>CF,>CE,>80
*            Protection
       BYTE >B6,>C9,>CF,>CC,>C1,>D4,>C9,>CF,>CE
*           Violation
MSG109 BYTE >0A,>A6,>C9,>CC,>C5,>80,>A5,>D2,>D2,>CF,>D2
*            File Error
MSG130 BYTE >09,>A9,>8F,>AF,>80,>A5,>D2,>D2,>CF,>D2
*            I/O Error
MSG135 BYTE >14,>B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD,>80
*            Subprogram
       BYTE >AE,>CF,>D4,>80,>A6,>CF,>D5,>CE,>C4
*            Not Found
MSG62  BYTE >0D,>AC,>C9,>CE,>C5,>80,>B4,>CF,>CF,>80,>AC,>CF
*            Line Too Long
MSGFRE BYTE >A2,>D9,>D4,>C5,>D3,>80,>A6,>D2,>C5,>C5
*           Bytes Free
MSGSFR BYTE >A2,>D9,>D4,>C5,>D3,>80,>CF,>C6,>80,>B3,>D4,>C1
*           Bytes of Stack
       BYTE >A6,>D2,>C5,>C5
*           Free
MSGGFR BYTE >A2,>D9,>D4,>C5,>D3,>80,>CF,>C6,>80,>B0,>D2,>CF
*           Bytes of Program
       BYTE >CD
MSGGF1 BYTE >B3,>D0,>C1,>C3,>C5,>80,>A6,>D2,>C5,>C5
*           Space Free
MSGCIS BYTE >B5,>A4,>A6,>80,>B2,>C5,>C6,>D3,>80,>A9,>D4,>D3
*           UDF Refs Itself
MSGCF  BYTE >A3,>C1,>CC,>CC,>C5,>C4,>80,>A6,>D2,>CF,>CD
*           Called From
MSG56  BYTE >16,>B3,>D0,>C5,>C5,>C3,>C8,>80,>B3,>D4,>D2,>C9
*            Speech String
       BYTE >B4,>CF,>CF,>80,>AC,>CF,>CE,>C7
*           Too Long
*      BASE 0,0,>0300,>0300,0,0,0
USER   DATA 0,TOPLEV
 
       BYTE 17
       TEXT 'RXB VERSION 2001 '
DSCLOD BYTE 9
       TEXT 'DSK1.LOAD'
       BYTE 0
SPCCHR BYTE >81,>00,>00,>00,>00,>00,>81,>00     * CURSOR CH
       DATA 0,0,0,0                             * EDGE CHAR
VDPREG BYTE >E0,>00,>20,>00,>06,>00
***********************************************************
*            START OF BASIC INTERPETER
***********************************************************
TOPLEV CLR  V@>0370           Initialize temp area
       MOVE 77,V@>0370,V@>0371
* RXB MODULE PATCH CODE FOR RXB MODULE ********************
*      ST   5,@KEYBD          Select full keyboard
*      SCAN
*      CZ   @KEYBD
*      BR   G6388             99/4A Console?
       CALL CART              * RXB PATCH CODE FOR CARTRIDE
       ST   >01,V@CONFLG      Select 99/4A console
G6388  CLR  @KEYBD
* RXB MODULE PATCH CODE FOR RXB MODULE ********************
*      DST  NLNADD,V@BUFSRT   Initialize edit-buffer start
*      DST  NLNADD,V@BUFEND   Initialize edit-buffer end
       MOVE 2,G@ATNZZ,@INTRIN Get address of ATNZZ
       AND  >1F,@INTRIN       Throw away the BR opcode
       DADD >5B,@INTRIN       Address of polynomial constan
 
* RXB PATCH CODE *************
       ST   >31,V@LODFLG      indicate try auto-boot
       BR   SZNEW
       AORG >03A5
*----------------------------------------------------------
* Add the following line for fixing "MEMORY FULL" error
* occurring during MERGE execution will leave the file open
* to disk DSR bug, 5/19/81
SZNEW  CLR  V@MRGPAB          Initialize merged temporary
*                              for PAB pointer
*----------------------------------------------------------
       ST   RSTK,@SUBSTK      Load base of subroutine stack
       CALL CHRTA2            Load character table
       CLR  @FLAG             Initialize flag byte
       DCLR @BUFLEV           Initialize crunch buffer leve
       CALL CLSALL            Close all open files
       CLR  @DATA             Initialize READ/DATA pointer
       DST  VRAMVS,@VSPTR     Initialize base of value stac
       DST  @VSPTR,@STVSPT    Save in permanent base
       DST  @VSPTR,V@SAVEVP
       CALL INITPG            Initialize program & s.t.
       CALL INTRND            Initialize random number
       CZ   V@LODFLG
       BS   TOPL02            If need auto-boot
* RXB PATCH CODE *************
*      CLR  V@LODFLG          Won't ever need to do again
       BR   G63D0
* RXB PATCH CODE ******************************************
       AORG >03D0
G63D0  CALL AUTOLD            Attempt an auto-boot
*     Label TOPL02 is used by auto-boot in detection of err
ERRRDY EQU  $
TOPL02 CALL G6A84             Say READY
       BYTE 0               *  returns to TOPL15
TOPL05 CALL INITPG            Initialize program space
TOPL10 CALL KILSYM            Kill the symbol table
* RXB PATCH CODE *************
* TOPL15 AND  >F7,@FLAG         If error in UDF execution
TOPL15 B    MYSRCH
G63E0  ST   5,@KEYBD          Select full keyboard
       SCAN
       CLR  @KEYBD
TOPL20 ST   RSTK,@SUBSTK      Initialize subroutine stack
TOPL25 DST  NLNADD,@VARW      Screen addr = lower left corn
       CLR  @RAMFLG           Clear the RAMFLG
       CLR  @PRGFLG           Make sure not in program mode
* Check for auto-num mode
       CLOG >01,@FLAG         If auto-num on
       BS   TOPL35
       DADD @CURINC,@CURLIN   Generate new line number
       CGE  0,@CURLIN         >32767?
       BS   TOPL30
       AND  >FE,@FLAG         If out of range->exit auto-nu
       B    TOPL35            Merge in below
* Must be a long branch!!
TOPL30 DCEQ @ENLN,@STLN       Line might exist
       BS   G6412
       DST  @CURLIN,@FAC      Ready for program search
       XML  SPEED
       BYTE SEETWO          * Search for existence of line
       BS   EDTZ05            COND set = line found
G6412  XML  SCROLL            Scroll to the next line
       DST  @CURLIN,@ARG2     New line #
       CALL DISO              Display the line number
       DINC @VARW             Following by a space
       BR   G6420
TOPL35 XML  SCROLL            Scroll the screen
G6420  ST   >9E,V@NLNADD-1    Display the prompt character
       CALL G6A76             Read in a line
       CALL SAVLIN            Save input line for recall
*    Crunch the input line
       CLR  @ERRCOD           Assume no-error return
       DST  CRNBUF,@RAMPTR    Initialize crunch pointer
       XML  CRUNCH            CRUNCH the input line
       BYTE 0              *  Normal crunch mode
TOPL42 CASE @ERRCOD+1
       BR   TOPL45            No error detected
       BR   ERRSYN            *SYNTAX ERROR
       BR   ERRBLN            *BAD LINE NUMBER
       BR   ERRLTL            *LINE TOO LONG
       BR   ERRNTL            *NAME TOO LONG
       BR   ERRNQS            *UNMATCHED QUOTES
       BR   ERRCIP            *COMMAND ILLEGAL IN PROGRAM
       BR   ERRIVN            *UNRECOGNIZED CHARACTER
TOPL45 DCZ  @FAC              Line # present
       BS   TOPL55
       CLOG >01,@FLAG         Not AUTONUM
       BR   G645B
       CEQ  >0D,@RKEY         Must be up or down
       BS   G645B
       CEQ  >01,@CHAT         Start EDIT mode
       BR   G645B
       B    EDTZZ0
G645B  CALL EDITLN            EDIT the line into the progra
       BS   TOPL25            If didn't change the line
       BR   TOPL10
*    Jump always
TOPL55 CEQ  >01,@CHAT         If blank line - ignore
       BS   TOPL25
       CEQ  >EB,V@CRNBUF
       BS   SZSIZE
       CH   >08,V@CRNBUF      If imperative
* GKXB Branch code for new commands DEL, COPY, and MOVE.
       BS   NEWCMD            Go here to test for new
*                              keywords
       DST  CRNBUF+1,@PGMPTR  Anticipate usage of PGMCHR
       XML  PGMCHR            Prepare CHAT for OLD and SAVE
       CASE V@CRNBUF          Select the keyword
       BR   SZNEW             NEW                 0
       BR   SZCONT            CONTINUE            1
       BR   SZLIST            LIST                2
       BR   SZBYE             BYE                 3
       BR   SZNUM             NUMBER              4
       BR   SZOLD             OLD                 5
       BR   SZRES             RESEQUENCE          6
       BR   SZSAVE            SAVE                7
       BR   SZMERG            MERGE               8
*    AUTO-BOOT - attempt a ---->   RUN "DSK1.LOAD"
AUTOLD MOVE 11,G@DSCLOD,V@CRNBUF
       DST  CRNBUF,@PGMPTR    DSK1.LOAD is in crunch buffer
* RXB PATCH CODE *************
*      BR   SZRUNL            Go to the RUN "NAME" CODE
       BR   MYRUN
********************************* RUN *********************
SZRUN  CEQ  >C7,@CHAT         Ready for 'RUN "NAME" ----
       BR   G64BF
SZRUNL DST  @PGMPTR,@FAC14    Save pointer to name
       XML  PGMCHR            Get the length of the string
       ST   @CHAT,@FAC13      Put it in FAC13
       CLR  @FAC12            Make it a double byte
       DADD @FAC12,@PGMPTR    Skip the string
       XML  PGMCHR            To see there is line no. ahea
       CALL G8024             Only RUN "NAME" ?
       BR   ERRSYN            No - junk on end so error
       ST   STRINZ,@CHAT      Prepare for LOAD routine
       DST  @FAC14,@PGMPTR    Restore the saved PGMPTR
       CALL OLD1              Load the program
       BR   SZRUN0            Go ahead from here
*                              No RUN "NAME" : just run the
*                              current program in memory
G64BF  CEQ  >C9,@CHAT         Is there a line # after RUN?
       BR   G64D5
       XML  PGMCHR            Get the line number
       ST   @CHAT,@FAC        Put it in FAC for SEETWO
       XML  PGMCHR
       ST   @CHAT,@FAC1
       XML  PGMCHR            Should be EOS now
       CALL G8024             Is it?
       BS   SZRUN2            Yes - Go ahead from here
*                              Just 'RUN'
G64D5  CALL G8024             Should be EOS now
       BR   ERRSYN            No-SYNTAX ERROR
SZRUN0 DCEQ @ENLN,@STLN       Refuse without program
       BS   ILLST
       DST  @ENLN,V@START     Defualt to beginning
       DSUB 3,V@START         Offset into the table
       BR   SZRUN1            Merge in below
*    Jump always
SZRUN2 DCEQ @ENLN,@STLN       Refuse without program
       BR   G64F9
ILLST  XML  SCROLL            Scroll the screen for message
       CLR  @PRGFLG           Prevent line # printing
WRNNPP CALL G6A82
       BYTE 29                * NO PROGRAM PRESENT
       BR   TOPL15
*    Condition can never be set since line 0 is prohibited
G64F9  XML  SPEED
       BYTE SEETWO          * Find the line in the program
       BR   ERRLNF            * LINE NOT FOUND
       DST  @EXTRAM,V@START   Program run starts here
* GKXB RUN code for color change.
SZRUN1 BR   RUNPAT            Change colors.
G6504  CALL CLSALL            Close any open files
       DEC  @PRGFLG           Put it back in execution
       ST   @RAMTOP+1,@RAMFLG Set/reset RAMFLG flag -- when
       DCLR V@SEXTRM           in program mode & ERAM exist
       DCLR V@ERRLN           Disallow CONTINUE after RUN
       CALL KILSYM            Reset ERR handling to defualt
       ST   RSTK,@SUBSTK      Set the stack empty
* RXB PATCH CODE ************ Turn off DSK#.LOAD search
* SZRUN4 B    G6A70
SZRUN4 B    SCHOFF            Turn off search first then G6
EDTZ05 B    EDTZ00
**************************** CONTINUE *********************
SZCONT CALL GETNB             Check for END-OF-LINE
       BR   ERRSY1            Junk on end of command
       DCZ  V@SEXTRM          If can continue
       BS   ERRCC
       XML  SCROLL
       DST  V@SEXTRM,@EXTRAM  Copy old line table pointer
       DST  V@SPGMPT,@PGMPTR  Copy old text pointer
       DST  V@SBUFLV,@BUFLEV  Copy old buffer level
       DST  V@SLSUBP,@LSUBP   Copy last subprogram on stack
       OR   V@SFLAG,@FLAG     Restore on-warning/break bits
G6540  DCH  V@SAVEVP,@VSPTR   While extra on stack
       BR   G654A
       XML  VPOP              Pop them off
       BR   G6540
G654A  ST   >FF,@PRGFLG       Idicate program mode
       ST   @RAMTOP+1,@RAMFLG Set/reset RAMFLG flag --- whe
*                              in program mode & ERAM exist
       DCLR V@SEXTRM          Prevent unauthorized CONTINUE
       DST  VRAMVS,V@SAVEVP   Init for program completion
       XML  CONTIN            Resume normal execution
ERRCC  CALL G6A84             Indicate error
       BYTE 25              * "* CAN'T CONTINUE"
**************************** NUMBER ***********************
*----------------------------------------------------------
* Fix NUMBER command cause XB goes into a loop displaying
* *PROTECTION VIOLATION when a PROTECTED program is in
* memory bug, add the following line after label SZNEW
SZNUM  CLOG >80,@FLAG         Check PROTEDTION VIOLATION
       BR   ERRPV
*----------------------------------------------------------
       CALL AUTON             Get start line # and incremen
       OR   >01,@FLAG         Set AUTONUM bit for future us
       DST  NLNADD,@VARW      Initialize screen address
       BR   TOPL30            Jump back into it
*    Jump always
***********************************************************
* AUTON - scans the NUM, LIST and RES commands for line
* numbers. Leaves 1st line number in CURLIN and 2nd line
* number in CURINC. AUTON is entry point from NUM to defual
* to 100,10          AUTON is entry point for LIST.
***********************************************************
AUTON  DST  100,@CURLIN       Defualt start
 
* GKXB AUTO4 label
AUTO4  DST  10,@CURINC        Defualt increment
       ST   COMMA,@VARC       Comma is the separator
AUTO1  DDEC @VARW             Don't miss the first characte
* GKXB AUTO3 label
AUTO3  CALL GETNB             Get 1st character after keywo
       BS   AUTO2             If end of line
       CALL GETLN             Try to get a line number
       CZ   @BYTES            If digits gotten
       BS   G658D
       DST  @FAC,@CURLIN      Set initial
G658D  CALL GETNB2            Allow spaces before separator
       DCH  @VARA,@VARW       Check end of line
       BS   AUTO2
       CEQ  @VARC,@CHAT       If not correct separator
* GKXB Modification to the RES to allow renumbering a
*      portion of a program.
       BR   CKLIST            GKXB AUTON for record length.
* GKXB AUTO5 label
AUTO5  CALL GETNB             Get char after separator
       BS   AUTO2             If end of line
       CALL GETLN             Try to get 2nd number
       CZ   @BYTES            If digits gotten
       BS   G65A9
       DST  @FAC,@CURINC      Save the increment
G65A9  CALL GETNB2            Check EOL
* GKXB Modification to the RES to allow renumbering a
*      portion of a program.
       BR   RES2              GKXB AUTON for range check
AUTO2  RTN
*************************** SAVE **************************
SZSAVE DCEQ @ENLN,@STLN       If no program
       BS   ILLST
       B    SAVE
*************************** OLD ***************************
SZOLD  B    OLD
*************************** BYE ***************************
SZBYE  CALL CLSALL            Properly close all files
SZEXIT EXIT                   Return to MONITOR
*************************** LIST **************************
SZLIST DCEQ @ENLN,@STLN       Refuse LIST without prrogram
       BS   ILLST
       B    LIST              LIST the program
*************************** MERGE *************************
SZMERG B    MERGE
*************************** SIZE **************************
* RXB SIZE PATCH CODE ********
* SZSIZE CZ   V@CRNBUF+1        Must have EOL
SZSIZE B    NSIZE
       BR   ERRSYN
G65CE  XML  COMPCT            Garbage collect to free space
       DST  @STREND,@ARG2     Get end of string space
       DSUB @VSPTR,@ARG2      Subtract stack pointer
       DSUB 63,@ARG2          Require 64-byte buffer
       GT                     If less then 64 bytes left
       BS   G65DF
       DCLR @ARG2             Then indicate zero
G65DF  XML  SCROLL            Scroll the screen
       DST  NLNADD+2,@VARW    Begin a new line
       CALL DISO              Display the number
       CZ   @RAMTOP           If no ERAM present
       BR   G65F7
       MOVE 10,G@MSGFRE,V@1(@VARW)
       BR   G6621
G65F7  MOVE 19,G@MSGSFR,V@1(@VARW)
       XML  SCROLL            Scroll the screen
       DST  NLNADD+2,@VARW    Beginning of line
       DST  @RAMFRE,@ARG2     Calculate space in ERAM
       DSUB CPUBAS-1,@ARG2    Subtract base
       CALL DISO              Display the number
       MOVE 16,G@MSGGFR,V@1(@VARW)
* RXB SIZE PATCH CODE ********
G6618  XML  SCROLL
       MOVE 10,G@MSGGF1,V@NLNADD+4
G6621  XML  SCROLL            Scroll the screen
* RXB SIZE PATCH CODE ********
*      BR   TOPL15            Return to top-level
G6623  RTN
       RTN                    RXB wasted byte.
************************** RESEQUENCE *********************
SZRES  DCEQ @ENLN,@STLN       If no program
       BS   ILLST
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       CALL RES1              GKXB pickup of renage
* GKXB RES6 label
RES6   DST  @XENLN,@FAC       GKXB Compute # of increments
       DSUB @XSTLN,@FAC       GKXB Actual number of lines -
       DSRL 2,@FAC            Also takes care of this ^^^
       DMUL @CURINC,@FAC      Compute space taken by increm
       DCZ  @FAC              Bad line number
       BR   ERRBLN
       DADD @FAC2,@CURLIN     Compute highest address used
       CARRY                  Watch out for overflow
       BS   ERRBLN
       CH   >7F,@CURLIN       Overflow is > 32767
       BS   ERRBLN
       ST   @RAMTOP+1,@RAMFLG Set/reset RAMFLG to use PGMCH
       CLR  @ARG4             To be used for double add
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       CALL RES4              GKXB Check high line # for ov
       DST  @>8370,@VAR0      Assume VDP-top
       CZ   @RAMFLG           But if ERAM exists
       BS   G665F
       DST  @RAMTOP,@VAR0     Top for ERAM
G665F  DINCT @PGMPTR          Skip EOL and count
G6661  XML  PGMCHR            VDP RAM or ERAM
       CEQ  >C7,@CHAT         Skip strings
       BS   SEQZ2
       CEQ  >C8,@CHAT         If numeric
       BR   G6677
SEQZ2  XML  PGMCHR            Get next token (count)
       ST   @CHAT,@ARG5       For double add
       DADD @ARG4,@PGMPTR     Up to end of string
       BR   G66AA
G6677  CEQ  >C9,@CHAT         Check for line #
       BR   G66AA
       CALL GRSUB2            Get the line # in the text
       BYTE PGMPTR          * @PGMPTR : Source addr on ERAM
       DST  @EEE1,@FAC8       Save it temporary place
       DST  @CURLIN,@ARG2     Set for searching
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       DST  @XSTLN,@ARG       GKXB New segment start
G6689  CALL GRSUB3            Read the line # fromn ERAM
*                              (use GREAD1) or VDP, reset
*                              possible breakpoint too
       BYTE ARG             * @ARG : Source addr on ERAM/VD
       DCEQ @EEE1,@FAC8
       BS   SEQZ3
       DSUB @CURINC,@ARG2     Update new line #
       DADD 4,@ARG            And entry in line # table
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       DCH  @XENLN,@ARG       GKXB New segment end
       BR   G6689
       BR   G66A8             GKXB Skip replacing undefined
*                              line # with 32767
       DATA >7FFF *           GKXB unused bytes
SEQZ3  CALL GWSUB             Write a few bytes of data
*                 @PGMPTR : Destination address on ERAM/VDP
*                 @ARG2   : Data
*                 2       : Byte count
       BYTE PGMPTR,ARG2,2
G66A8  DINCT @PGMPTR          Pass two byte line # in text
G66AA  DCLR @>83D6            Reset VDP timeout
       DCHE @VAR0,@PGMPTR     And on end of program
       BR   G6661
*  Now update the line # table itself
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       DST  @XSTLN,@FAC       GKXB New segment start
       DST  @CURLIN,@ARG      With start address off course
G66B8  CALL GWSUB             Write a few bytes of data to
*                              ERAM (use GWRITE) or VDP
*                 @FAC   : Destination address on ERAM/VDP
*                 @ARG   : Data
*                 2      : Byte count
       BYTE FAC,ARG,2
       DSUB @CURINC,@ARG      Compute next line #
       DADD 4,@FAC            And next entry in line # tabl
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       DCH  @XENLN,@FAC       GKXB New segment end# table
       BR   G66B8
       CLR  @RAMFLG           Restore the ERAM flag
* GKXB Modification to the RES command to allow renumbering
*      a portion of the program.
       BR   RES5              GKXB find out where to return
***********************************************************
*              EDIT a line into a program
*
* Must be called with the following set up:
*    FAC    = line number of line to be edited into program
*    CHAT   = length of line
*    CRNBUF = crunched line
***********************************************************
EDITLN CLOG >80,@FLAG         Protection violation
       BR   ERRPV
       CALL CLSALL            Close any open files
       CALL KILSYM            Kill symbol table
       CLR  @STPT             Restore STPT
       ST   @CHAT,@STPT+1
***********************************************************
* @CHAT=1 ? YES : LINE NUMBER ONLY -  GO TO DELETE THE LINE
*           NO  : INSERT A NEW LINE OR REPLACE EXISTING LIN
***********************************************************
       CEQ  >01,@CHAT         Something besides line #
       BR   INSREP
       CLOG >01,@FLAG         Auto-number mode on
       BS   G66F0
       AND  >FE,@FLAG         Reset AUTONUM mode
RTNSET CEQ  @>8300,@>8300     Set condition bit
       RTNC                   And return
G66F0  DCEQ @ENLN,@STLN       If no program
       BS   RTNSET
***********************************************************
* EDITZ1 Delete the line # from line-#-buffer.
*        Delete the text from program text area.
***********************************************************
EDITZ1 XML  SPEED             Try to find the given line #
       BYTE SEETWO
       BR   RTNSET            Return if not found
       XML  DELREP            Remove it's text from program
*   Delete the 4 bytes from the line # table
       DST  @EXTRAM,@VARY2    Pointer to line pointer
       DINC @VARY2            Advance to last byte of entry
       DDECT @EXTRAM          Point to first byte of entry
       DST  @EXTRAM,@VAR0
       DDEC @VAR0             Last byte of next line entry
*                              Move down 4 bytes from here
       DSUB @STLN,@EXTRAM     # of bytes to move down
       DCZ  @EXTRAM
       BS   G6714
       DST  @EXTRAM,@ARG      Put in arg for MVDN
       XML  MVDN              Move one byte at a time
G6714  DADD >04,@STLN         New start addr of line # tab
       CZ   @RAMTOP           If ERAM not exist
       BR   G6724
       DCH  @>8370,@STLN      Delete the only line
       BS   TOPL05
       BR   G672E             With ERAM
G6724  DCZ  @STLN
       BS   TOPL05
       DCH  @RAMTOP,@STLN
       BS   TOPL05
G672E  BR   KILSYM            Kill symbol table with return
***********************************************************
*    INSERT A NEW LINE OR REPLACE AN EXISTING LINE
***********************************************************
* BUILD LINE # AND LINE POINTER IN VARY, +1, +2, +3, +4
INSREP DST  @FAC,@VARY        2 bytes of line #
       DST  @ENLN,@VARY2      Last address of line-#-table
       DST  @ENLN,@EXTRAM     Prepare to search the line #
***********************************************************
* 1ST LINE IN MEMORY : EDITZ5 -- EDITZ6 -- EDITZ8 -- DONE
***********************************************************
       DCEQ @ENLN,@STLN       1st text?
       BS   EDITZ5
***********************************************************
* EDITZ3
*    COMPARE LINE # IN FAC WITH LINE # IN THE LINE # TABLE
*    EQUATE : --DELTX--EDITZ8-DONE
*    HIGHER : HIGHEST LINE? YES : EDITZ6--EDITZ8--DONE
*                           NO  : BACK TO EDITZ3
*    LOWER  : EDITZ4--EDITZ8--DONE
***********************************************************
       DINC @EXTRAM           Get line
EDITZ3 DSUB 4,@EXTRAM         Go to next line in program
       CALL GRSUB1            Read from ERAM(use GREAD)/VDP
       BYTE EXTRAM          * @EXTRAM : Source addr on ERAM
*                              or VDP
       AND  >7F,@EEE          Reset possible breakpoint
       DCEQ @EEE,@FAC         If #s match-delete old
       BS   DELTX
       DST  4,@VARA           For MEMFUL
       H                      New line # is greater
       BR   G675E
       DCEQ @STLN,@EXTRAM     Line to be inserted got the
*                              highest line number in line
*                              # table :: add to the end of
*                              line-#table
       BS   EDITZ6
       BR   EDITZ3
***********************************************************
* EDITZ4
*    ALLOCATE SPACE IN LINE # TABLE BY MOVING
*    PART (ARG=4) OF THE LINE # TABLE UP
***********************************************************
G675E  DST  4,@ARG
EDITZ4 DADD @EXTRAM,@ARG
       DSUB @STLN,@ARG        # of bytes in between
       DST  @STLN,@VAR9       Copy old start address of lin
       CALL MEMFUL            Check for memory full
       DADD @STPT,@STLN
       CZ   @RAMTOP
       BR   G677E
       MOVE @ARG,V*VAR9,V*STLN Move line # table
       BR   G6783
G677E  DST  @STLN,@VAR0       Destination address for MVUP
       XML  MVUP              Move the line # table up
G6783  DST  @ENLN,@VARY2      Set up line ptr in line # ent
       BR   EDITZ8
***********************************************************
* EDITZ5
* EDITZ6
*    SET UP 1ST ENTRY IN LINE # TABLE BY GIVING @VARA=3
*    WHEN INSERT THE HIGHEST LINE :
*     CONCATENATE LINE # ENTRY TO  LINE # TABLE
***********************************************************
EDITZ5 DST  >03,@VARA         Subtract >03 from STLN(@>8370
*                              to get new start addr of tab
EDITZ6 CALL MEMFUL            Check for memory full
       DADD @STPT,@STLN       Concatenate line # entry to
       DST  @STLN,@EXTRAM      table
***********************************************************
* EDITZ8
*    UPDATE ENTRY IN LINE # TABLE, PUT TEXT IN -- DONE
***********************************************************
EDITZ8 EQU  $
* Update the 4 bytes entry in line # table
       DINC @VARY2            Point to 1st token (not lengt
       DSUB @STPT,@VARY2      Set up the line pointer for V
       CALL GWSUB             Write a few bytes of data to
*                              ERAM (use GWRITE) or VDP
*      @EXTRAM : Destination address on ERAM/VDP
*      @VARY   : Data
*      4       : Byte count
       BYTE EXTRAM,VARY,4
***********************************************************
* Now insert the line's text between the line number table
*  and the rest of the program's text
***********************************************************
********** GET THE LENGTH OF LINE # TABLE IN @ARG *********
       DST  @ENLN,@ARG        Highest addr for line # table
       DSUB @STLN,@ARG        Total length of line # table
       DINC @ARG              Add one for extra offset
****************** MOVE THE LINE # TABLE ******************
       DST  @STLN,@VAR9       Old start addr of line # tabl
       DINC @STPT             Point to next free byte in VD
       DSUB @STPT,@STLN       New entry to line # table
       DSUB @STPT,@ENLN
       CZ   @RAMTOP           If ERAM not exist
       BR   G67C0
       MOVE @ARG,V*VAR9,V*STLN  Move line # table
       BR   G67C5
G67C0  DST  @STLN,@VAR0       Set up destination addr for M
       XML  MVUP              Move line # table
****************** WRITE THE LENGTH BYTE ******************
G67C5  DDEC @STPT             Update length of text
       DDEC @VARY2            Point to the length byte
       CALL GWSUB             Write a few bytes of data
*                              to ERAM (use GWRITE) or VDP
*      @VAR2      : Destination address on ERAM or VDP
*      @(STPT+1)  : Data
*      1          : Byte count
       BYTE VARY2,STPT+1,1
       DINC @VARY2
********************* WRITE THE TEXT **********************
       CZ   @RAMTOP           If ERAM not exist
       BR   G67DE
       MOVE @STPT,V@CRNBUF,V*VARY2 Move text
       BR   G67EA
G67DE  DST  CRNBUF,@AAA       Copy the text from crunch
*                         buffer (which is on VDP) to ERAM
       DST  @VARY2,@BBB
       DST  @STPT,@CCC        @CCC : Byte count
       XML  VGWITE
G67EA  BR   KILSYM            Kill symbol table and return
***********************************************************
* REPLACE AN EXISTING LINE
************** Compute length of old entry ****************
DELTX  DINCT @EXTRAM          Point to the line pointer
       CALL GRSUB1            Read from ERAM (use GREAD)/VD
       BYTE EXTRAM          * @EXTRAM : Source addr on ERAM
       DDECT @EXTRAM          Restore back
       DDEC  @EEE             Point to the length byte
       CALL GRSUB1            Read the length from ERAM/VDP
       BYTE EEE             * @EEE : Source addr on ERAM/VD
       ST   @EEE,@VARA+1
       CLR  @VARA             Make a double byte
       DNEG @VARA             And get length difference
       CALL MEMFUL            Check for memory full
       DADD @VARA,@STLN       Update STLN
       XML  DELREP            Remove old text (same line #)
       DDECT @EXTRAM          Correct pointer
******* SET UP THE LINE POINTER IN LINE # ENTRY ***********
       DST  @ENLN,@VARY2      Prepare setting up line point
       BR   EDITZ8            Go update entry in line # tab
*                              and put text in
***********************************************************
* SUBROUTINE TO READ 2 BYTES OF DATA FROM VDP OR ERAM
*  (use GREAD)
***********************************************************
GRSUB1 FETCH @FFF             Fetch the source addr on ERAM
       DST  *FFF,@DDD         Put it in @DDD
       CZ   @RAMTOP           If ERAM present
       BS   G6823
       DST  2,@FFF            @FFF : Byte count
       XML  GREAD             Read data from ERAM
*                             @EEE : Destination addr on CP
       BR   G6827             ERAM not exists
G6823  DST  V*DDD,@EEE        Read data from VDP
G6827  RTN
***********************************************************
* SUBROUTINE TO WRITE A FEW BYTES OF DATA TO VDP OR ERAM
*  (use GWRITE)
***********************************************************
GWSUB  FETCH @AAA             Fetch the destination addr on
       DST  *AAA,@AAA         ERAM/VDP
       FETCH @BBB+1           Fetch the source addr on CPU
*                              where data is stored
       CLR  @BBB              Make a double byte
       FETCH @CCC+1           Fetch the byte count
       CLR  @CCC              Make a double byte
       CZ   @RAMTOP           If ERAM exists
       BS   G683E
       XML  GWRITE            Write the data to ERAM
       RTN
G683E  MOVE @CCC,*BBB+1,V*AAA Write to VDP
       RTN
***********************************************************
* SUBROUTINE TO GET A NON-BLANK CHARACTER FROM LINE
***********************************************************
GETNB  CALL GETCHR            Get a character
       BS   RTNSET            If end-of-line
GETNB2 CEQ  >20,@CHAT
       BS   GETNB
       RTN
***********************************************************
* SUBROUTNE TO GET A CHARACTER FROM LINE
***********************************************************
GETCHR DCH  @VARA,@VARW
       BS   RTNSET
       ST   V*VARW,@CHAT      Put character in @CHAT
       CEQ  >7F,@CHAT         If not edge character
       BS   G6864
       SUB  OFFSET,@CHAT   >60 Screen character into ASCII
       DINC @VARW
       RTN
G6864  DADD 4,@VARW           Skip to next line
       BR   GETCHR
*  Jump always
***********************************************************
* GETLN - Gets an line number after a command and puts it
* into the FAC. If the character in CHAT when it is called
* is not in the legal numeric range (0-9) then GETLN
* GETLN returns with no other action.
*  Called by: AUTON, RUN, EDITLN
***********************************************************
GETLN  DCLR @FAC              Assume no number
       CLR  @BYTES            Assume no digits
GETLN2 SUB  >30,@CHAT         ASCII to normal range
       CHE  10,@CHAT          If numeric digit
       BS   G6891
       DMUL 10,@FAC           Multiply by 10
       DCZ  @FAC              Error if overflow
       BR   GTLNER
       ST   @CHAT,@FAC1       Need to add in this digit
       DADD @FAC2,@FAC        Add accumulator into last dig
       DCGE 0,@FAC            Error if overflow
       BR   GTLNER
       INC  @BYTES            Got another digit
       CALL GETCHR            Get the next character
       BR   GETLN2            If not EOS
G6891  CZ   @BYTES            If digits gotten
       BS   G6899
       DCZ  @FAC              If hit natural zero
       BS   GTLNER
G6899  ADD  >30,@CHAT         Put back into ASCII
       RTN
GTLNER XML  SCROLL            Scroll the screen
       CLR  @PRGFLG           Don't print a line number
       BR   ERRBLN            * BAD LINE NUMBER
MEMFUL DADD @STPT,@VARA       Total # of bytes to be added
* GKXB MEMFLL label
MEMFLL DSUB @VARA,@STLN       New STLN
       CZ   @RAMTOP
       BS   G68B5
       DCHE CPUBAS,@STLN      Not enough memory
       BR   MEMZ1
       RTN
G68B5  DCHE VRAMVS+64+256,@STLN Memory full
       BS   G68C2
MEMZ1  DADD @VARA,@STLN       Back to old start line # tabl
       CALL G6A84
       BYTE 11                * MEMORY FULL
G68C2  RTN
* Initialize program space
INITPG CLR  @RAMFLG           Reset RAMFLG
       XML  GDTECT            Search for ERAM & select ROM
       DST  @RAMTOP,@RAMFRE   Initialize free pointer
       DST  @>8370,@STLN      Assume VDP - initialize STLN
       CZ   @RAMTOP           If ERAM is present
       BS   G68D9
       DST  @RAMTOP,@STLN     Initialize STLN for ERAM
G68D9  DST  @STLN,@ENLN       Init ENLN based upon STLN
* Kill the symbol table
KILSYM DST  @STLN,@FREPTR     Assume VDP and init free poin
       DCEQ @>8370,@FREPTR
       BS   G68E6
       DDEC @FREPTR           Back off 1 if program present
G68E6  CZ   @RAMTOP           If ERAM exists
       BS   G68FC
       DST  @STLN,@RAMFRE     Update the @RAMFRE
       DCEQ @RAMTOP,@RAMFRE
       BS   G68F9
       DDEC @RAMFRE           Back off 1 if program present
G68F9  DST  @>8370,@FREPTR    Initialize VDP free pointer
G68FC  DCLR @SYMTAB           Kill symbol table
       DCLR @SUBTAB           Kill subprogram table
       DST  @FREPTR,@STRSP    Initialize string space
       DST  @STRSP,@STREND
       CLR  @BASE             Reset OPTION BASE to 0
       DCLR V@SEXTRM          Disallow CONTINUE
       DST  VRAMVS,@STVSPT    Initialize base of value stac
       DST  @STVSPT,@VSPTR    Initialize value stack pointe
       DST  @VSPTR,V@SAVEVP   Initialize pointer in VDP too
       RTN
***********************************************************
* Data for the color tables (starts at >0800)
* BYTE >D0,>00,>00,>00,>00,>00,>00,>00
* BYTE >00,>00,>00,>00,>00,>00,>00,>10
* BYTE >10,>10,>10,>10,>10,>10,>10,>10
* BYTE >10,>10,>10,>10,>10,>10,>10,>10
***********************************************************
CHRTA2 ALL  >20+OFFSET        Clear the screen
       DST  >3567,@>83C0      Initialize random number gen
       MOVE 16,G@SPCCHR,V@>03F0 Cursor character
* RXB PATCH CODE
CHRTAB DST  >0400,@FAC        Address of chracater tables
       ST   95,@FAC2          Number of characters
       CALL CHRTBL            RXB character loader
       BR   G6939
* RXB SUB CODE FOR SIZE ******
SDISO  DST NLNADD+2,@VARW    *
       CALL DISO             *
       RTN                   *
******************************
G6939  BACK 4                 Border color = BLUE
       CLR  V@>0800
       MOVE 14,V@>0800,V@>0801
       ST   >F0,V@>080F       WHITE fore/transparent back
       MOVE 16,V@>080F,V@>0810
       CALL SPRINT
* This part might be moved up later, load special character
* here. Don't load before hiding all sprites.
       MOVE 6,G@VDPREG,#1
       RTN
*
****** Initialization of sprites. Enable 28 sprites. ******
*
SPRINT CLR  V@>0780           Clear motion of all sprites
       MOVE >6F,V@>0780,V@>0781
* Replace the line for speeding up XB. 5/22/81
*      ST   28,@MOTION        All in motion
       CLR  @MOTION           All not in motion
       ST   >D0,V@>0370       Sprites 29 to 32 unavailiable
       DST  >C000,V@>0300     Hide the first sprites
       DCLR V@>0302           Make first sprite transparent
       MOVE 108,V@>0300,V@>0304 Ripple for the rest
       RTN
*
* ERROR messages in this file
*
ERRSY1 CLR  @PRGFLG           Without a line number
ERRSYN CALL G6A84
       BYTE 3                 * SYNTAX ERROR
ERRNQS XML  SCROLL            Scroll up the screen
       CALL G6A84             EOL before end of string
       BYTE 5                 * UNMATCHED QUOTES message
ERRNTL CLR  @PRGFLG           Don't print a line #
       CALL G6A84
       BYTE 6                 * NAME TOO LONG
ERRLNF CALL G6A84
       BYTE 22                * LINE NOT FOUND
ERRBLN CALL G6A84
       BYTE 23                * BAD LINE NUMBER
ERRLTL CLR  @PRGFLG           Don't print line number
       CALL G6A84             Issue the error
       BYTE 24                * LINE TOO LONG
ERRCIP XML  SCROLL            Scrolling the screen
       CALL G6A84
       BYTE 26                * COMMAND ILLEGAL IN PROGRAM
ERRPV  CALL G6A84
       BYTE 39                * PROTECTION VIOLATION
ERRIVN CLR  @PRGFLG           Don't print line number
       CALL G6A84
       BYTE 40                * UNRECOGNIZED CHARACTER
*
* Other ERROR messages in the program
*
* ERRRDY    * READY                BYTE 0
* ERRMEM    * MEMORY FULL          BYTE 11
* ERRCC     * CAN'T CONTINUE       BYTE 25
* WRNNPP    * NO PROGRAM PRESENT   BYTE 29
***********************************************************
* RXB SIZE
NSIZE  CZ   @PRGFLG           * PROGRAM MODE?
       BR   CSIZE
       CZ   V@CRNBUF+1        * NORMAL
       BR   ERROLP
       CALL SIZEAS
       BR   TOPL15
CSIZE  CALL CHKEND            * CALL SIZE
       CALL SIZEAS
       CALL RETURN
SIZEAS CALL G65CE
       CZ   @RAMTOP
       BS   AMSSIZ
       MOVE 6,@>2002,@FAC
       DCEQ >AA55,@FAC+4
       BR   AMSSIZ
       DST  @FAC+2,@ARG2
       DSUB @FAC,@ARG2
       CALL SDISO
       MOVE 17,G@MESSAG,V@1(@VARW)
       CALL G6618
       B    AMSSIZ
***********************************************************
       AORG >0A70
G6A70  BR   PRESCN
       BR   $                 Spare
       BR   LLIST
G6A76  BR   READLN
       BR   CHKEND            check End Of Statement
       BR   $                 Was SEETWO - now spare
G6A7C  BR   DISO
       BR   ENTER
       BR   ENT09
G6A82  BR   WARNZZ
G6A84  BR   ERRZZ
G6A86  BR   READL1
       BR   READ00
       BR   READL3
       BR   $                 Spare
***********************************************************
* READLN - Read one logical line (up to four physical lines
* from the keyboard. Interpret things like BACKSPACE,
* INSERT, DELETE AND FORWARD. The total number of character
* can be limited by changing the start value for ARG2
* (upper limit), and entering at READL1 and VARW has to
* contain the start address of the feild, and VARA the
* current highest wirte address. Entering at READ00 allows
* for specification of the intial cursor-position. In this
* case ARG5 has to be set to the cursor-position. Please se
* to it that VARA, VARW, ARG2, and ARG4 have consistent
* values, i.e.
*           VARW <= ARG5 <= VARA <= ARG2
* ARG4 indicates if the line has been changed. If so, it
* contains a 0. If you enter READLN through READ00, you hav
* to initialize ARG4 to a nonzero value, should you want to
* use this feature.
***********************************************************
*----------------------------------------------------------
* Fix "You cannot add characters to a line whose number is
* multiple of 256, if that line was reached by typing eithe
* an up arrow or a down arrow form a previous line" bug,
* replace following 3 lines:
* READLN ST   >FF,@ARG7         Indicate non-check mode
*        DST  >037D,@ARG2       Set default upper limit
*        DST  @VARW,@VARA       Default nothing entered yet
*      with
READLN DST  >057D,@ARG2       Set default upper limit
       DST  @VARW,@VARA       Default to nothing entered ye
READL3 ST   >FF,@ARG7         Indicate non-check mode
*----------------------------------------------------------
* Please make sure that VARA points at a space location, or
* at the end-of-field.
*-------------- ADD FOLLOWING LINES 6/12/81 ---------------
READL1 CLR  V@NOTONE          Reset flag for ACCEPT SIZE to
       ST   1,@ARG4           This means "no change" in lin
READL2 DST  @VARW,@ARG5       Position cursor at start of f
*----------------------------------------------------------
* Auto-repeat function is added for 99/4A, in PSCANS line
* READ00 to READZ2+1 are changed to following code
*----------------------------------------------------------
READ00 CLR  @VAR0             Counter for auto-repeat fucti
*
* To get out of insert mode, we usually return here.
*
READ01 CLR  @ARG8             Indicate normal operation mod
       ST   CURSOR,@VARV      Use VARV for CURSOR/CHARACTER
* Idicate one character and alternate current character
* position between normal and cursor.
READZ1 EX   @VARV,V*ARG5      By alternating between the
*                              normal character and the
*                              cursor, we make the cursor
       CLR  @TIMER             blink
* RXB PATCH CODE FOR USER *****
* G6AAE  SCAN                   Scan for a character
*        RAND 99                Force randomize to be rando
G6AAE  CALL DUSER             USER from EDIT mode
       BS   READZ2            Found one!!!!
G6AB3  INC  @VAR0             Increment the auto-repeat cou
       CEQ  >FF,@RKEY         It is an old key
       BS   G6AC5
       CHE  >FE,@VAR0         Hold old key for a while
       BR   G6AC5
       SUB  30,@VAR0          Control repeat rate
       B    READZ5
G6AC5  CH   >10,@TIMER        Time next character switch
       BR   G6AAE
       BR   READZ1            Restart character blink cycle
*
* Correct if we ended up with a displayed cursor
*
READZ2 CLR  @VAR0
READZ5 CEQ  CURSOR,@VARV      Will have to change once more
       BS   G6AD7
       EX   @VARV,V*ARG5      Exchange for current cursor
* GKXB key routines CTRL up, down, left, right
G6AD7  B    CTRLS             GKXB CTRL KEYS
       BS   G6BD0
*
* BREAK character handling comes first
*
G6ADC  CEQ  BREAK,@RKEY       Saw break character
       BR   G6AF4
       AND  >FE,@FLAG         Reset AUTONUM mode
       CZ   @PRGFLG           If in run mode
       BS   BTOP15
*----------------------------------------------------------
* FIX FCTN4 breaks a program during an execution of INPUT,
* ACCEPT, or LINPUT statement regardless of ON BREAK NEXT
* flag bug 5/19/81
* Replace following 2 lines:
*        DST  @SMTSRT,V@SPGMPT Save place for continue
*        B    EXEC6D           Interrupt execution
* with:
       CLOG >40,@FLAG         If ON-BREAK-NEXT has not been
       BR    G6AF4             set, i.e. break is illegal
       DST  @SMTSRT,V@SPGMPT  Save place for continue
       B    EXEC6D            Interrupt execution
*----------------------------------------------------------
*
* Edit buffer recall
*
* RXB PATCH CODE ************ USER PATCH
*  G6AF4  CEQ  RECALL,@RKEY     If edit recall
G6AF4  CEQ  >FF,@RKEY         NO KEY---SO NEVER USE
       BR   G6B2A
       CZ   @PRGFLG           Ignore if exec mode
       BR   READZ1
       AND  >FE,@FLAG         Reset AUTONUM
       DST  NLNADD+32,@VARW   Initialize to 32 below screen
G6B04  XML  SCROLL            Scroll the screen
       DSUB 32,@VARW          Line start is 32 lower now
       DCEQ V@BUFSRT,@VARW    Until reach recall start
       BR   G6B04
       DST  V@BUFEND,@VARA    Set old end of line
       DST  @VARA,@FAC        Calculate length of old line
       DSUB @VARW,@FAC        Subtract start from end
       BS   READZ3            If no characters to recall
* RXB PATCH CODE FOR USER ****
*      MOVE @FAC,V@RECBUF,V*VARW Recall line
       MOVE @FAC,V*VARW,V*VARW
READZ3 ST   >FF,@ARG7         Non-check mode
       DST  @VARW,@ARG5       Cursor at beginning of line
       BR   READ00            Allow edit of line
*
* BACK-ARROW - Space back one position
*
G6B2A  CEQ  BACK,@RKEY        Backup to previous position
       BS   RBACK
*
* RIGHT-ARROW - Forward space
*
       CEQ  FORW,@RKEY        Space one position
       BS   RFORW
*
* INSERT - Start INSERT mode here
*
       CEQ  INSRT,@RKEY       Set INSERT flag
       BR   G6B3C
       ST   1,@ARG8           Select INSERT mode
*
* DELETE - Delete the current character
*
G6B3C  CEQ  DLETE,@RKEY       DELETE all right
       BR   G6B94
*------------ ADD THE FOLLOWING LINE 6/12/81 --------------
       CLR  V@NOTONE          Reset flag for SIZE in ACCEPT
       CLR  @ARG4             Indicate definite change in l
       DCEQ @ARG5,@VARA       Not an empty line
       BS   G6B8E
       CEQ  EDGECH,V*VARA     If pointing at end
       BR   G6B53
       DDEC @VARA             Backup up onto line
G6B53  DST  @VARA,@ARG        Move everything from right
       DSUB @ARG5,@ARG         of the cursor to the left
       MOVE @ARG,V@1(@ARG5),V*ARG5
       DST  @ARG5,@ARG        Start at the beginning
       AND  >FC,@ARG1
       OR   >1D,@ARG1         Move over to the end of the l
G6B69  DCHE @VARA,@ARG        Update all errors
       BS   G6B7A
       EX   V*ARG,V@4(@ARG)   Restore edge characters
       DADD 32,@ARG           Next victim please
       BR   G6B69
G6B7A  DDEC @VARA             Pre-update end of string
       CEQ  EDGECH,V*VARA     Hit edge character
       BR   G6B86
       DSUB 4,@VARA           Skip over edge characters
* For auto-repeat function 5/19/81
G6B86  CEQ  >20+OFFSET,V*VARA
       BS   READ01
       DINC @VARA             Locked at feild position
G6B8E  ST   >20+OFFSET,V*VARA Clear last position
       BR   READ01
*
* CLEAR - Clear the entire input line
*
G6B94  CEQ  CLRLN,@RKEY       Found CLEAR command
       BR   G6BB3
*-------------- ADD THE FOLLOWING LINE 6/12/81 ------------
       CLR  V@NOTONE          Reset flag for SIZE in ACCEPT
*                              Current maximum to minimum
G6B9C  CEQ  >7F,V*VARA         Don't clear edges
       BS   G6BA6
       ST   >20+OFFSET,V*VARA Blank line
G6BA6  DDEC @VARA             Pre-update end-of-line
       DCHE @VARW,@VARA       Up to and including first pos
       BS   G6B9C
       DINC @VARA             Undo last subtraction
       CLR  @ARG4             Indicate change
       BR   READL2            And restart everything
* General exit point. Unidentified control codes don't have
* effect!!!!!
G6BB3  CEQ  CHRTN,@RKEY       Only react on CR/UP/DOWN
       BS   G6BC2
       CEQ  UPMV,@RKEY
       BS   G6BC2
       CEQ  DOWN,@RKEY
       BR   READZ1
G6BC2  DCEQ @ARG2,@VARA       Check for block on last posit
       BR   G6BCF
       CEQ  >20+OFFSET,V*VARA Blocked. . . . . .
       BS   G6BCF
       DINC @VARA             Point beyond last character i
*                              line
G6BCF  RTN                    ENTER the current line
G6BD0  CZ   @ARG7             Check value of RKEY against g
       BR   VALIZ9
       DST  V@VALIDP,@ARG     Pick up the standard stuff
       ST   V*ARG,@ARG        V@VALIDP : Pointer to the
*                              standard stuff
       CLOG >04,@ARG          Specified UPPER CASE
       BS   G6BF0
       CH   >5A,@RKEY         Z too high for anything
       BS   VALIZ2
       CHE  >41,@RKEY         A already in range
       BS   VALIZ9
       CEQ  >20,@RKEY         SPACE allow spaces in UALPHA
       BS   VALIZ9
G6BF0  CLOG >01,@ARG          Specified NUMERIC
       BS   G6C0B
       CEQ  >45,@RKEY         E ?
       BS   VALIZ9
       CEQ  >2E,@RKEY         . ?
       BS   VALIZ9
       CEQ  >2B,@RKEY         + ?
       BS   VALIZ9
       CEQ  >2D,@RKEY         - ?
       BS   VALIZ9
       BR   VALIZ1            now try DIGIT range
G6C0B  CLOG >02,@ARG          Digit range selected
       BS   VALIZ2
VALIZ1 CHE  >30,@RKEY         0 ?
       BR   VALIZ2            No good
       CHE  >3A,@RKEY         9 ?
       BR   VALIZ9            Numeric allright
VALIZ2 DST  V@VALIDP,@ARG     Copy start address of string
       ST   V@VALIDL+1,@FAC6   and string length
       BR   VALIZ4             now test given characters
VALIZ3 CEQ  V*ARG,@RKEY       valid!!!!
       BS   VALIZ9
VALIZ4 DINC @ARG              Update actual address
       DEC  @FAC6              and count # of characters
       BR   VALIZ3
G6C30  CZ   @PRTNFN           Wait for completion of previo
       BR   G6C30              tone, and then
       CALL TONE2               ---BEEP---
       BR   READZ1            Continue in whatever mode we'
*                              in now
VALIZ9 CZ   @ARG8             INSERT mode?
       BS   G6C91
* INSERT - is COMPLICATED!!!!! Because of those edge charac
* Shift up all things. . . . continue as a standard insert
* VARA <= ARG2
       DCEQ @ARG2,@VARA       If end of screen
       BS   READZ4
*----------------------------------------------------------
* Fix Editing a line that has been retrived by the REDO key
* and may garble the last few characters bug, 5/28/81
       CEQ  EDGECH,V*VARA     If at end of line
       BR   READZ4
       DCEQ >02FE,@VARA       If also at end of screen
       BR   G6C64
       XML  SCROLL            Scroll the screen
       DSUB 32,@VARW          Back up line start address
       DSUB 28,@VARA          Back up to current start line
       DSUB 32,@ARG2          Absolute high limit backs up
       DSUB 32,@ARG5          Current cursor position too
       B    READZ4
G6C64  DADD 4,@VARA           Skip to next line
*----------------------------------------------------------
READZ4 DST  @VARA,@ARG        Use ARG as temp for insert
G6C6B  DCH  @ARG5,@ARG        Move everything up to current
*                              line
       BR   G6C8A
       DDEC @ARG              Copy lower location to higher
       ST   V*ARG,V@1(@ARG)   Going from high to low
       CEQ  EDGECH,V*ARG      Bumped into wall again
       BR   G6C88
       DSUB 4,@ARG            Skip the wall
       ST   V*ARG,V@5(@ARG)   And move character over
G6C88  BR   G6C6B
G6C8A  DCHE @ARG2,@VARA       Only update VARA if upper
       BS   G6C91
       DINC @VARA              hasn't been reached yet
G6C91  ADD  OFFSET,@RKEY      Create displayable character
       ST   @RKEY,V*ARG5      Display at current character
*                              position
       CLR  @ARG4             Indicate change in line
READ05 DCEQ @ARG2,@ARG5       Hit right margin
       BR   G6CAD
       CZ   V@NOTONE          If not the first time
       BS   G6CA7
       CALL TONE1             ---BEEP---
G6CA7  ST   >FF,V@NOTONE      Set the flag
       BR   READZ1            Stay in current mode !!!!
G6CAD  DINC @ARG5             Update current address
       CEQ  EDGECH,V*ARG5     Correct for next line
       BR   G6CB9
       DADD 4,@ARG5           By skipping border
G6CB9  DCH  @VARA,@ARG5       Check for last new high limit
       BR   G6CC1
       DST  @ARG5,@VARA       Update new high limit
G6CC1  DCHE >02FE,@VARA       Still some space to go
       BR   READZ1
       XML  SCROLL            Scroll the screen!!!
       DSUB 28,@VARA          Back to current start of line
       CZ   @ARG8             If not insert mode then
       BS   G6CD5
       DSUB 4,@VARA           Off by 4 more-correct it
G6CD5  DSUB 32,@VARW          Backup line start address
       DSUB 32,@ARG2          Absolute high limit backs up
       DSUB 32,@ARG5          Current cursor position too
       BR   READZ1            Start with something else
*
* Something special for forward cursor move
*
RFORW  CLR  @ARG8             Leave INSERT mode - don't cop
       BR   READ05             but use rest of input logic
*----------------------------------------------------------
* RBACK section has been moved from READL2+1 for adding
* auto-repeat function in 99/4A. Also
*       BR   READ01   is added at the end, 5/18/81
*----------------------------------------------------------
* This will cause the next test to fail initialy, since
* VARW clearly equals ARG5 first time through
*------------- ADD THE FOLLOWING LINE 6/12/81 -------------
RBACK  CLR  V@NOTONE          Reset flag for SIZE in ACCEPT
       DCH  @VARW,@ARG5       The standard backup entry
       BR   G6CFB
       DDEC @ARG5             So we backup the current posi
       CEQ  EDGECH,V*ARG5     Skip border line
       BR   G6CFB
       DSUB 4,@ARG5           Backup to previous line
G6CFB  BR   READ01            Go back for next character
***********************************************************
* WARNZZ - Checks the special warning handling conditions
* which can be set by an ON WARNING statement and does the
* following based upon those conditions:
* ON WARNING PRINT - prints continues execution
* ON WARNING STOP  - prints and stops
* ON WARNING NEXT  - ignores the warning and goes on
***********************************************************
WARNZZ DCLR @ERRCOD           Clear the error if form 9900
       CLR  @EXPZ
       FETCH @EXPZ+1          Get index into error table
       DSLL 2,@EXPZ           Multiply by 4
       DADD ERRTAB,@EXPZ      Get addres of entry into tabl
       MOVE 4,G@0(@EXPZ),@FAC10
       CZ   @PRGFLG           If its imperative
       BS   WRNZZ3             take defualt.
       CLOG >02,@FLAG         If print turned on
       BR   G6D35
WRNZZ3 XML  SCROLL            Scroll the screen
       MOVE 9,G@MSGWRN,V@NLNADD * WARNING
       XML  SCROLL            Scroll the screen again
       DST  NLNADD+2,@VARW    Start address behind warning
       CALL TRACBK            Check for warning in UDF
       BS   WRNZZ5            Was UDF so message already ou
       CALL ERPNT5            Print the message
WRNZZ5 ST   3,@XPT
* If imperative then continue on normally
G6D35  CZ   @PRGFLG           If its imperative
       BR   G6D3C
       B    RETNOS
* If warning continue turned on the continue
G6D3C  CLOG >04,@FLAG         If contiue
       BR   ERRZZ4
       B    RETNOS
ERRZZ4 CALL CLEAN             Clean up stack and s.t.
ERRZZ5 DST  V@SAVEVP,@VSPTR   Restore value stack
BTOP15 B    G6012             Finish up and go back
***********************************************************
* ERRZZ - Sets up an error stack entry based upon the
* information passed to it by the caller and what it can
* gather from the error table. It then either prints the
* error message and aborts or goes to the line specified by
* a previously executed ON ERROR statement. The stack enrry
* looks like:
* ---------------------------------------------------------
* | Error code | Severity | >69 | Luno # | EXTRAM | PGMPTR
* | ^          | ^        | ^   | ^      | ^      | ^
* | FAC        | FAC1     | FAC2| FAC3   | FAC4   | FAC6
*----------------------------------------------------------
* ERROR CODE - the error number
* SEVERITY   - Severity of the error
*      1     - Warning
*      5     - Possibly recoverable
*      9     - Fatal, unrecoverable
* >69  ERROR STACK ENTRY ID
* LUNO #     - Luno # if file error or -1 if non-file error
* EXTRAM, PGMPTR - Information to indicate the line # of
*                  the error
***********************************************************
*----------------------------------------------------------
* In order to fix MEMORY FULL error occurring during MERGE
* execution will leave the file open to disk DSR bug,
* following lines should be added,
*??????? ????????????????????? ???????????????? ???????????
* This note for the reshipment of FLMGR after 6/10/81
* IOCALL routine are copied from FLMGR here, becuase FLMGR
* is not in the branch table in FLMGR.
*??????? ????????????????????? ???????????????? ???????????
* ERRZZ DST  V@MRGPAB,@PABPTR
*       DCZ  @PABPTR          Error must occur in EDITLN
*                              routine during MERGEing
*       BS   HERE
*       CALL IOCALL           Close all files
*       DATA CZCLOS
* HERE  ...........program continues
* A statement BR IOCALL needs to be added in FLMGRS, which
* is not going to be reshipped at this time 6/10/81
* Therefore, the following patch is used
*??????????????????????????????????????????????????????????
ERRZZ  DEX  V@MRGPAB,@PABPTR
       DCZ  @PABPTR           Error must occur in EDITLN
*                              routine during MERGEing
       BS   G6D74
       MOVE 30,@FAC,V@>03C0   Save FAC area
       DST  @PABPTR,@FAC12    Get the PAB pointer in FAC
       DADD NLEN,@FAC12       Compute name length entry
       ST   1,V@4(@PABPTR)    * Select name length entry
       CALL CALDSR            Call actual DSR line routine
       BYTE 8
       MOVE 30,V@>03C0,@FAC
 
* Ignore the error coming back from DSR
       DCLR @PABPTR           Clear V@MRGPAB in case
*                              any kind of I/O operation
*                              following MERGE
*                              (Also for the DEX statement)
G6D74  DEX  V@MRGPAB,@PABPTR  Get the PABPTR back
*----------------------------------------------------------
       DCLR @ERRCOD           Clear error code if from 9900
       DSUB @CURINC,@CURLIN   Just in case in autonum mode
       DCEQ CRNBUF,@SYMTAB    If prescanning r.h.
       BR   G6D87              of UDF and parameter in
       DST  V@CRNBUF+2,@SYMTAB crunch buffer, fix SYMTAB
G6D87  CLR  @EXPZ             Get index into error table
       FETCH @EXPZ+1          Get index into error table
       DSLL 2,@EXPZ           Multiply index by 4
       DADD ERRTAB,@EXPZ      Address of table entry
       MOVE 4,G@0(@EXPZ),@FAC10  Get table entry
       ST   RSTK+2,@SUBSTK    Init subroutine stack but all
*                              for GROM return address
       CZ   @FAC13            If message only
       BR   G6DAF
ERRZZR CALL ERPRNT            Display the error message
       DCEQ MSGFST,@FAC10     If * READY *
       BR   G6DAD
       CALL CLSALL            Close all files
G6DAD  BR   ERRZZ4             and clean up
G6DAF  CZ   @PRGFLG           If imperative-default
       BS   ERRZ1
       DCZ  V@ERRLN           If error turned off
       BR   G6DBF
ERRZ1  CALL TRACBK            Check for UDF
       BS   ERRZZ4            Was UDF, message already out
       BR   ERRZZR            Assume normal error
*
* Error turned on. Now build the error entry
*
G6DBF  CALL CLEAN             Clean up the stack
       DST  @FAC12,@FAC       Put in error & severity
       ST   >69,@FAC2         Error stack ID
       DCEQ MSG130,@FAC10     If I/O error
       BR   G6DD6
       ST   V@2(@PABPTR),@FAC3  *  Put in LUNO #
       OR   >80,@FAC1         And indicate an I/O error
G6DD6  DST  @EXTRAM,@FAC6     Save line pointer
       DST  @SMTSRT,@FAC4     Save pointer to beginning of
*                              statement
       DST  @VSPTR,@ARG       Must check for room on stack
       DADD 24,@ARG           Need 24 to help out VPUSH
       DCH  @ARG,@STREND      If not room
       BS   G6DFD
       CALL ERPRNT            Put out the message anyway
       DST  MSG39,@FAC10      Memory full message
       CLR  @PRGFLG           Don't print a line #
       CALL ERPRNT            Print it too
       MOVE 8,G@MSGERR,V@NLNADD-18
       BR   ERRZZ5            And give up
G6DFD  XML  VPUSH             Push the error entry
       DCLR @EXTRAM           Clear on-error entry
       DEX  V@ERRLN,@EXTRAM   Set line pointer & clear on-e
       CALL GRSUB2            Read the line text pointer VD
*                              ERAM (use GREAD1) or VDP
       BYTE EXTRAM          * @EXTRAM : Source address
*                              in ERAM/VDP
       DST  @EEE1,@PGMPTR     Put the result in @PGMPTR
       XML  CONTIN            And go to the line
***********************************************************
* ERPRNT - Print an error or warning message
*
* ERPRNT - Entry point for ERROR
* ERPNT5 - Entry point for WARNING
***********************************************************
ERPRNT CALL G601C             Load the character table
       XML  SCROLL            Scroll the screen
       ST   >2A+OFFSET,V@NLNADD Put the * in
       DST  NLNADD+2,@VARW    Set up for the message
ERPNT5 CLR  @KEYBD            Enable main console
       MOVE 1,G@0(@FAC10),@ARG1  Get message length
       CLR  @ARG
       MOVE @ARG,G@1(@FAC10),V*VARW   Display
       DADD @ARG,@VARW        Start location for " IN "
       DCEQ MSG130,@FAC10     "* I/O ERROR [xx]xy"
       BR   G6E4D
       DINC @VARW             Update for one space
*                              separation
       ST   V@>04(@PABPTR),@ARG3   * Create high order resu
       CLR  @ARG2             Only display high order decim
       CALL DISO              Display this number
       ST   V@>05(@PABPTR),@ARG3  * Get low order result
       SRL  5,@ARG3           Remove mose identification bi
       CALL DISO              Output the number in decimal
G6E4D  DCEQ MSGFST,@FAC10
       BS   G6E79
       CALL TONE2             Wake up the idiot!!!!
       CZ   @PRGFLG           If program, print line #
       BS   G6E79
       DCH  >02F6,@VARW       It will pass EOL
       BR   G6E66
       XML  SCROLL            Display on next line
       DST  NLNADD+1,@VARW    Indent for the "IN"
G6E66  DST  >C9CE,V@1(@VARW)   * Put in the "in"
       DADD 4,@VARW           Display location for line
       ST   @CHAT,@EXPZ       ASC destroys CHAT
       CALL ASC               DISPLAY THE LINE #
       ST   @EXPZ,@CHAT       Restore CHAT
G6E79  XML  SCROLL
       RTN
***********************************************************
* LLIST - Lists one program line on the screen. The
* entrypoint to the line is given in STPT.
* In this routine, FAC2 is used as a flag to indicate that
* the most recent character output was an alphanumeric
* character. If the next character is also an alphanumeric
* character, then the two are separated by a space.
***********************************************************
LLIST  CLOG >80,@FLAG         If program protected
       BS   G6E85
       CALL ERRZZ             * PROTECTION VIOLATION
       BYTE 39
G6E85  CALL OUTREC            Make room for a new line
       DST  V*EXTRAM,@ARG2    Prepare for line # printing
       AND  >7F,@ARG2         Reset possible BreakPoint
       CALL OUTLN             Diplay line in free format
       DST  @CCPADD,@VARW     Copy position for editing
       DINC @VARW             Leave room for space
       DST  V@2(@EXTRAM),@PGMPTR   * Get pointer to line
LLISZ0 DST  >0020,@FAC2       Clear blank fill and set spac
LLIZ12 XML  PGMCHR            Get next token on line
       CZ   @CHAT             Exit on end of line
       BS   LLISZ9
       CZ   @FAC3             If separator needed
       BS   LLIZ15
       EX   @CHAT,@FAC3       Save CHAT and bare the separa
       CALL DSPCHR            Put the separator out
       EX   @CHAT,@FAC3       Restore CHAT
* Next thing to determine is whether or not we need a space
* for separation with the next stuff.
LLIZ15 CLR  @FAC3             Assume we'll get alphanumeric
       CEQ  SSEPZ,@CHAT       If double-colon
       BS   LLIZ16
       CEQ  COLONZ,@CHAT      If colon now and colon
       BR   G6EC4
LLIZ16 CEQ  COLONZ,@FAC        before-separater
       BS   LLIZ17
G6EC4  CHE  COMMAZ,@CHAT      Figure out separator range
       BR   G6ECE
       CHE  ORZ,@CHAT
       BR   LLISZ2
G6ECE  CH   NOTZ,@CHAT        Figure out separator range
       BR   G6ED8
       CHE  NUMCOZ,@CHAT
       BR   LLISZ2
G6ED8  ST   >20,@FAC3          Prepare for alfa indication
       CZ   @FAC2              alfanum-alfanum combination
       BS   LLISZ2
       CEQ  >20,@FAC10        Don't ouput 2 spaces
       BS   LLISZ2
LLIZ17 ST   @CHAT,@FAC2       Save CHAT somewhere
       ST   >20,@CHAT         And display a space
       CALL DSPCHR
       ST   @FAC2,@CHAT       Retrive CHAT
LLISZ2 EX   @FAC3,@FAC2       Could be for the next time to
* That takes care of all the extra spaces we might need
       CLOG >80,@CHAT         Just copy variable names
       BR   G6F0A
G6EF8  CALL DSPCHR            Copy the character to output
       XML  PGMCHR            Get the next character
       CZ   @CHAT             But exit on EOL
       BS   LLISZ9
       CLOG >80,@CHAT
       BS   G6EF8
       CLR  @FAC             No spaces if ":" or "::"
       BR   LLIZ15
G6F0A  CEQ  NUMZ,@CHAT
       BS   G6F17
       CEQ  STRINZ,@CHAT
       BR   LLISZ3
       CALL DSPQUO            Display first quote of string
* This place is the general location for strings both quote
* unquoted.
G6F17  XML  PGMCHR            Get string length in CHAT
       ST   @CHAT,@FAC        Copy in temporary space
G6F1C  CZ   @FAC              Also take care of empty strin
       BS   G6F35
       XML  PGMCHR
       CZ   @FAC2             Alpha means unquoted string
       BR   G6F2E
       CEQ  QUOTE,@CHAT
       BR   G6F2E
       CALL DSPCHR            Display two quotes for one
G6F2E  CALL DSPCHR            Display 2nd quote or char
       DEC  @FAC              Update string length, get nex
       BR   G6F1C
G6F35  CZ   @FAC2
       BR   LLISZ1            Non-alfa end means extra
       CALL DSPQUO            Display closing quote
       ST   >20,@FAC2         Cause space before following
       BR   LLISZ1             alpha
* Try to decode line numbers and keywords
LLISZ3 CEQ  LNZ,@CHAT         Decode line #
       BR   G6F55
       XML  PGMCHR            Get the high order byte first
       ST   @CHAT,@ARG2
       XML  PGMCHR
       ST   @CHAT,@ARG3        information as collected her
       CALL OUTLN             Display the actual informatio
       BR   LLISZ1            And continue
* Now it has to be a normal keyword
G6F55  DST  KEYTAB,@FAC       Address of KEYTAB for search
       XML  IO                Search keyword table
       BYTE 0                 * Select table search
*                      FAC8 returns with pointer to keyword
*                      FAC4 has length
LLISZ6 MOVE 1,G@0(@FAC8),@CHAT
* And output the thus found character
       CALL DSPCHR            Display character on screen
       DINC @FAC8             Update FAC8 for next referenc
       DEC  @FAC5             Count number of characters
       BR   LLISZ6            Always less then 255
       CEQ  TREMZ,@FAC        No spaces after!!!
       BS   LLISZ7
       CEQ  REMZ,@FAC         No spaces after REM
       BS   LLISZ7
       CHE  COMMAZ,@FAC       Master stuff =>space
       BR   LLISZ0
       CEQ  USINGZ,@FAC       Master stuff =>space
       BS   LLISZ0
       CEQ  NUMBEZ,@FAC       "#" never followed by space
       BR   LLISZ1
LLISZ7 CLR  @FAC2             Avoid spaces behind here
LLISZ1 CLR  @FAC3             Indicate separator not needed
       BR   LLIZ12            Continue for next keyword
***********************************************************
* Convert a number from binary to ASCII
* Input  : binary number in ARG2 and ARG3
* Output : pointer to ASCII number in FAC11 with the actual
*          number lying just before and ending with FAC10.
*          i.e. the last digit of the ASCII representation
*          is in FAC10; number of digits in the number in
*          ARG5
***********************************************************
CVRTLN CLR  @ARG5             Start with 0 characters
       ST   ARG11,@ARG11      Select first address + 1
G6F90  DCLR @ARG              Clear upper 2 bytes of 4 byte
       DEC  @ARG11            Go to next position
       DDIV 10,@ARG           Compute least significant rem
       ADD  >30,@ARG3         Always < 10 off course
       ST   @ARG3,*ARG11      Store it in ARG
       DST  @ARG,@ARG2        Replace remainder by result
       INC  @ARG5             Update total # of characters
       DCZ  @ARG2             Until whole number converted
       BR   G6F90
LLISZ9 RTN
* Output a line number to a device (or screen)
OUTLN  CALL CVRTLN            Convert from binary to ASCII
OUTLZ1 ST   *ARG11,@CHAT      Get the next character
       CALL DSPCHR            Display the character
       INC  @ARG11            Increment the character posit
       DEC  @ARG5             Decrement number of digits
       BR   OUTLZ1            Output digit if not all out
       RTN
* Display number on the screen
DISO   CALL CVRTLN            Convert from binary to ASCII
DISPZ1 ST   *ARG11,V*VARW     Get more significant characte
       ADD  OFFSET,V*VARW     Display character on screen
       DINC @VARW             Update screen pointer
       INC  @ARG11            Get next position
       DEC  @ARG5             Update count
       BR   DISPZ1            Add loop until finished
       RTN
* Put out a quote
DSPQUO ST   QUOTE,@CHAT       DISPLAY A QUOTE
* Put out next character
DSPCHR CH   @RECLEN,@CCPPTR   Action on end of screen
       BR   G6FDE
       CALL OUTREC            Output crrrent record
       DSUB 32,@VARW          Keep track of begining of lin
G6FDE  ST   @DSRFLG,V*CCPADD  Put offset on screen
       ADD  @CHAT,V*CCPADD    Add in the character
       DINC @CCPADD           Bump output pointer
       INC  @CCPPTR           Update current line positon
       ST   @CHAT,@FAC10      FAC10 may be used by OUTREC !
       RTN
***********************************************************
* Static scanner to build the main symbol table and to buil
* symbol tables for each subprogram and to build the
* subprogram table. Checks some errors and aborts if any
* detected.
***********************************************************
*----------------------------------------------------------
* Added the following 6/8/81  for NOPSCAN feature
*  Flag PSCFG: >00 NOPSCAN
*              >FF RESUME PSCAN
PRESCN ST   >FF,V@PSCFG       Default to PSCAN
*----------------------------------------------------------
       DCLR @CALIST           Initialize call list
       DST  10,@DFLTLM        Set default array size
       DCLR @XFLAG            Initialize prescan flag bits
*                              and FOR/NEXT counter
       CZ   @PRGFLG           If imperative
       BR   G700B
       DST  CRNBUF,@PGMPTR    Pointer to 1st token
       XML  PGMCHR            Get the 1st token
       XML  SCROLL            Scroll the screen
       CALL SCAN10            Do the static scan of the lin
       BR   G7013             If program
G700B  CALL SCAN              Scan the program
       AND  >90,@FLAG         Reset all the flags but the
*                              TRACE & LIST/EDIT protection
       DCLR @LSUBP
G7013  DST  V@SAVEVP,@VSPTR   Initialize VSPTR
       B    EXEC              Execute the program or statem
***********************************************************
*                     Static Scanner
***********************************************************
SCAN   DST  @ENLN,@EXTRAM     1st address of line # table
       DADD 3,@EXTRAM
       DCLR @SYMTAB           Clear the symbol table
       DCLR @SUBTAB           Clear the subprogram table
       CZ   @RAMTOP
       BR   G7031
       DST  @STLN,@FREPTR     Initialize free-space pointer
       DDEC @FREPTR           Back up from line # table
       BR   G703B
G7031  DST  @STLN,@RAMFRE     Initialize ERAM free-space
       DDEC @RAMFRE           pointer
       DST  @>8370,@FREPTR    Initialize with no pgm in VDP
G703B  CLR  @BASE             OPTION BASE = 0
       DST  @FREPTR,@STRSP    Initailize string space
       DST  @STRSP,@STREND
       DST  @STLN,@LINUM
       DINCT @LINUM           Point to last line in program
* THE FOLLOWING 20 STATEMENTS CANNOT BE SEPARATED OR THE
* ASSEMBLY LANGUAGE CODE WILL NOT WORK - SRH
       XML  SCNSMT            Scan the program
       BYTE 0               * Entire program flag
SCAN10 XML  SCNSMT            Scan the statement
       BYTE 2               * Single statement flag
       BR   SCANRT            Normal end of scan
       BR   SCNDEF            Scan a def
       BR   SCNDIM            Scan a dim
       BR   CALLS             Scan a call
       BR   SCNOPT            Scan an option base
       BR   SUBS              Scan a sub
       BR   SUBNDS            Scan a subexit
       BR   SUBNDS            Scan a subend
       BR   CALENT            Call ENTER
       BR   ERROLP            * ONLY LEGAL IN A PROGRAM
       BR   ERRNWF            * NEXT WITHOUT FOR
       BR   ERRFNN            * FOR/NEXT NESTING
       BR   ERRMS             * MISSING SUBEND
       BR   ERRSYX            * SYNTAX ERROR
       BR   ERRMEM            * MEMORY FULL
       BR   ERRIBS            * ILLEGAL AFTER SUBPROGRAM
*
*                    SPECIALLY SCANNED STATEMENTS
* DIM STATEMENT
SCNDIM CLOG >40,@XFLAG
       BR   ERRSYX
G7073  CALL ENTER             Declare this symbol
       CEQ  COMMAZ,@CHAT      Loop if more
       BS   G7073
       BR   SCAN25            Must have EOL now
* OPTION BASE STATEMENT
SCNOPT CALL IMPIF             Can't be imperative or in "IF
       CALL PGMERR            OPTION - therefore must be BA
       CLOG >02,@XFLAG
       BR   ERROBE
*                             Error if OPTFLG already set
       CALL CHKSYN            Must have a "BASE"
       BYTE BASEZ
       CALL CHKSYN            Must have a numeric constant
       BYTE NUMCOZ
       CALL CHKSYN            Must have 1-char numeric cons
       BYTE 1
       CLR  @BASE             Assume BASE=0
       SUB  >30,@CHAT         Must be 0 or 1
       BS   SCAN20            OK if 0
       DEC  @CHAT             Check for a 1
       BR   ERROBE            If it was not a 1 then ERROR
       INC  @BASE             Set OPTION BASE=1
SCAN20 OR   >02,@XFLAG        Set the option base flag
SCAN22 XML  PGMCHR            Now - check for end-of-line
SCAN25 CALL CHKEND            If not EOL or :: or !    -err
       BS   CONSCN            If EOS - continue scan
       BR   ERRSYX            * SYNTAX ERROR
* DEF STATEMENT
SCNDEF CALL IMPIF             Can't be imperative or in "IF
       OR   >84,@XFLAG        Set function bit
*                             Set ENTERX bit
       CALL ENTER             Enter the function name
*                             ENTER resets function bit
       CLOG >07,V*SYMTAB      Did function have parm?
       BS   SCAN55            No...
       OR   >80,@XFLAG        >80 call for parm enter
       OR   >08,@FLAG         Fake it so symbol table
*                              searches won't be made
       CALL ENTERW            Enter the parameter
       AND  >F7,@FLAG         Reset function bit
       CALL CHKSYN            Complex symbol must be
       BYTE RPARZ           *  followed by ")="
       CALL CHKSYN
       BYTE EQUALZ
       MOVE 29,V*SYMTAB,V@CRNBUF
       DST  V@CRNBUF+4,@VAR0  Get pointer to name
       CZ   @RAMTOP           If ERAM program
       BS   G70EB
* If ERAM must fix up the name pointer because the name was
* moved too
       DSUB @SYMTAB,@VAR0     Offset into entry
       DADD CRNBUF,@VAR0      New location of name
       DST  @VAR0,V@CRNBUF+4  Put it in
G70EB  DST  V@2(@SYMTAB),@FREPTR  * Reset free space pointe
       DST  CRNBUF,@SYMTAB    Point into crunch buffer
       DDEC @FREPTR
SCAN35 CALL CHKEND            If EOL or ! or ::
       BS   SCAN50            Yes
       CGT  >00,@CHAT
       BS   SCAN40
       CEQ  NUMZ,@CHAT        If numeric - skip it
       BS   SCAN45
       CEQ  STRINZ,@CHAT      If string - skip
       BR   G710D
SCAN45 CALL SKPSTR            Skip the string or numeric
G710D  XML  PGMCHR            Get next charater
       BR   SCAN35
* Jump always
SCAN40 OR   >80,@XFLAG        Make an ENTERX (>80)call
       CALL ENTERX            Enter the symbol
**** Relink to keep parameter at the beginning of the table
       DCEQ CRNBUF,@SYMTAB    If no entry
       BS   SCAN35
       DST  V@CRNBUF+2,V@2(@SYMTAB)  * Put link in
       DST  @SYMTAB,V@CRNBUF+2      Put new pointer in
       DST  CRNBUF,@SYMTAB    Put new pointer in
       BR   SCAN35            Go on
* Jump always
SCAN50 DST  V@CRNBUF+2,@SYMTAB  Delink the parameter
       BR   CONSCN            Continue the scan
SCAN55 CALL CHKSYN
       BYTE EQUALZ
       BR   CONSCN
CALENT OR   >80,@XFLAG        Set enterx (>80) flag
       CALL ENTERX            Enter in symbol table
CONSCN XML  SCNSMT            Return to 9900 code to resume
       BYTE 1               * Return call to 9900 code
IMPIF  CLOG >40,@XFLAG        Not in if
       BR   ERRSYX
IMPILL CZ   @PRGFLG           Program mode - OK - return
       BR   SCANRT
ERROLP CALL ERRZZ             If imperative - error
       BYTE 27              * Only legal in a program
* Syntax required token routine
CHKSYN FETCH @FAC
       CEQ  @FAC,@CHAT
       BS   PGMERR
ERRSYX CALL ERRZZ
       BYTE 3                 * Syntax error
CHKEND CLOG >80,@CHAT
       BS   G7168
       CHE  TREMZ+1,@CHAT
       BS   G7168
       CEQ  @>8300,@>8300     Force COND to "SET"
       RTNC
G7168  CZ   @CHAT             Set COND according to CHAT
SCANRT RTNC
***********************************************************
*                    CALLS routine
* This routine scans the CALL statement. Get the subprogram
* name, search the table and update the call list
* (value stack area) if necessary. Share eht same XML
* search routine as the symbol table code uses.
***********************************************************
CALLS  XML  PGMCHR            Get token after call
       CALL CHKSYN            Check subprogram name
       BYTE UNQSTZ          * Must start with unquoted stri
       CH   >0F,@CHAT         * NAME TOO LONG!!
       BS   NTLERR
       DST  @PGMPTR,@VAR0     Save program pointer to name
       ST   FAC,@FAC17        Set up a pointer
       ST   @CHAT,@FAC15      Save name length
       ST   @CHAT,@FAC16      Save name length as a counter
CALL20 XML  PGMCHR            Get one byte of name
       ST   @CHAT,*FAC17      Store that character in FAC a
       INC  @FAC17            Increment pointer
       DEC  @FAC16            Decrement conter
       BR   CALL20            Get next character
*                            Exchange call list address wit
*                            symbol table address to run th
*                            same search routine used for
*                            symbol table search.
       DEX  @SYMTAB,@CALIST
       XML  SCHSYM            Search to see if name there
       DEX  @CALIST,@SYMTAB   Exchange back both addresses
       BS   SCAN67            If name found do nothing
       CZ   @RAMFLG           If not imperative and ERAM
       BS   G71AE
       XML  VPUSH             Put first 8 byte of name
       DST  @VSPTR,@VAR0      Pointing to new name location
       CGT  >08,@FAC15        If more characters in name
       BR   G71AE
       MOVE 8,@FAC8,@FAC      Move rest of the name
       XML  VPUSH             Push one more time
G71AE  CLR  @FAC
       ST   @FAC15,@FAC1      Put in name length
       DST  @CALIST,@FAC2     Put in call list link
       DST  @VAR0,@FAC4       Put in pointer to name
       XML  VPUSH             Put the entry in the VDP
       DST  @VSPTR,@CALIST    Change pointer to call list
SCAN67 XML  PGMCHR
       BR   CONSCN
***********************************************************
*                  SUBS routine
* This routine scans SUB statement in subprogram. First
* check the subprogram name and call list. Then builds
* subprogram table without argument list, scans symbols in
* the subprogram and create symbol table for the subprogram
* make entry to the subprogram table and add (if necessary)
* to call list.
***********************************************************
SUBS   CALL IMPIF             Can't be imperative or in "IF
       CZ   @FORNET           Check FOR-NEXT nesting
       BR   ERRFNN
       CLOG >01,@XFLAG        Called first time
       BR   G71D7
       CLOG >08,@XFLAG
       BR   ERRMS
* Cannot be in subprogram.  Can't start another one.
       DST  @SYMTAB,V@TABSAV  Finish off main table
* From the second SUB statement
G71D7  DCLR @SYMTAB           Start with empty symbol table
       OR   >28,@XFLAG        Set flag for SAFLG and SUBFLG
       AND  >FE,@XFLAG        Reset REMODE flag
       XML  PGMCHR            Get name behind SUB statement
       CALL CHKSYN            Make sure it's unquoted strin
       BYTE UNQSTZ
       CH   >0F,@CHAT         Length must be <= 15
       BS   NTLERR
       ST   @CHAT,@FAC1       Save name length
       DST  @PGMPTR,@FAC4     Assume pointer to VDP name
       CZ   @RAMTOP           But if ERAM save name in tabl
       BS   G720E
       CLR  @FAC
       XML  MEMCHK            FAC already has name length
       BS   ERRMEM            * MEMORY FULL
       DSUB @FAC,@FREPTR      Get pointer to put name in
       DST  @FREPTR,@EEE1     Re-do pointer to name
       DINC @EEE1             Correct for one off
       DST  @FAC,@FFF1        Set for XML GVWITE
       DST  @PGMPTR,@DDD1     Set for XML GVWITE
       XML  GVWITE            Move @FFF1 bytes from ERAM at
*                              DDD1 to VDP at EEE1
*
* Start building the subprogram table
       DST  @EEE1,@FAC4       Put pointer in VRAM to name
G720E  DST  14,@FAC           Minimum table size for subpro
       XML  MEMCHK            Make sure enough room there
       BS   ERRMEM            * MEMORY FULL
       CLR  @FAC              Prepare for name length
       ST   @CHAT,@FAC1       Get the name length
       DST  @SUBTAB,@FAC2     Save subprogram table address
       DCLR @FAC6             Mark end of argumant list
*  @FAC   = name length       @FAC2  = subprogram table lin
*  @FAC4  = pointer to name   @FAC6  = argument list = 00
*  @FAD8  = @PGMPTR           @FAC10 = @EXTRAM
*  @FAC12 = symbol table = 00
       DADD @FAC,@PGMPTR      Skip the name to look ahead
       MOVE 4,@PGMPTR,@FAC8   Copy PGMPTR and EXTRAM
       DCLR @FAC12            Assume subpgm has no symbol t
       DSUB 14,@FREPTR        Reset free pointer
       DST  @FREPTR,@SUBTAB   Copy
       DINC @SUBTAB           Set new subtable pointer
       MOVE 14,@FAC,V*SUBTAB  Put the table in!!
* Start fixing up subprogram's symbol table
       DST  @SUBTAB,V@SSTEMP  Copy address of subtable
       DADD 6,V@SSTEMP        Point to argument list
       DST  V@SSTEMP,V@SSTMP2 Duplicate for later use
       XML  PGMCHR            Get next token
       CALL CHKEND            Check if end of statement
       BS   SCAN90            Yes. Get out here quick
*                            Start looking at aruguments.
       CALL CHKSYN            Check for left parenthesis
       BYTE LPARZ
SCAN86 OR   >80,@XFLAG        Flag for ENTXFL
       CALL ENTERX            Enter next parameter
       DST  2,@FAC            Get room for ptr in sub block
       XML  MEMCHK            See if we had space for 2 byt
       BS   ERRMEM            * MEMORY FULL
       DST  V@SSTEMP,@FAC     Copy current arg list pointer
       DSUB @SYMTAB,@FAC      Find length from table addres
*                            Move symbol table down two byt
*                            to make space for next argueme
MINUST EQU  -2
       MOVE @FAC,V*SYMTAB,V@MINUST(@SYMTAB)
       DDECT @SUBTAB          Adjust the subtable pointer
       DDECT V@SSTMP2         Adjust to point to first argu
       DST  V@SSTEMP,@VAR0
       DST  @SYMTAB,V@MINUST(@VAR0)   Put pointer in subtab
       DST  @SYMTAB,@FAC      Copy symbol table address
       DDECT @FAC             Pointing to real s.t. address
SCAN88 DST  V@4(@FAC),@FAC2   Copy pointer to symbol table
       DDEC @FAC2
       DCH  @SUBTAB,@FAC2     If name moved also
       BS   G7293
       DDECT V@4(@FAC)         correct for the movement.
G7293  DCZ   V@2(@FAC)        If more symbol there
       BS   G72A4
       DDECT V@2(@FAC)        Adjust the link address also
       DST  V@2(@FAC),@FAC    Point to next s.t. address
       BR   SCAN88            Check for more s.t. adjustmen
G72A4  DST  V@SSTMP2,@FAC     Restore pointer to first argu
G72A8  DCEQ V@SSTEMP,@FAC     Fix all pointers in argument
       BS   G72B5
       DDECT V*FAC            Shift address by 2 bytes
       DINCT @FAC             Go to next argument pointer
       BR   G72A8
G72B5  DDECT @SYMTAB          Restore s.t. pointer
       DDECT @FREPTR          Restore free pointer
* Done with building a subprogram table.
       CEQ  RPARZ,@CHAT       Next character not ")" ?
       BS   G72C4
       CALL CHKSYN            Must be ","
       BYTE COMMAZ
       BR   SCAN86            Ge get more argument
G72C4  XML  PGMCHR            Finished...
       CALL CHKEND            Check if end of statement
       BR   ERRSYX            If not, error
SCAN90 AND  >DF,@XFLAG        Finished scanning sub argumen
       DADD 6,V@SSTEMP        Point to location of pointer
*                              in subtab
       BR   CONSCN            Start scanning subprogram
***********************************************************
*                 SUBNDS and SUBXTS
* This routine scans SUBEND and SUBEXIT statement
***********************************************************
SUBNDS CALL IMPILL            Can't be imperative
       CLOG >08,@XFLAG
       BS   ERRSNS
********* MUST BE IN SUBPROGRAM message above *************
       CEQ  SUBNDZ,@CHAT
       BR   G72FB             Check for end of statement
       CZ   @FORNET           Check FOR-NEXT nesting
       BR   ERRFNN
       CLOG >01,@XFLAG
       BR   ERRSNS
       CLOG >40,@XFLAG
       BR   ERRSYX
       DST  V@SSTEMP,@VAR0
       DST  @SYMTAB,V*VAR0
       OR   >01,@XFLAG
G72FB  BR   SCAN22            Check for end of statement
***********************************************************
*           ENTER and ENTERX routines
* These routines take care of entering a symbol into the
* symbol table. If a symbol is encountered which is already
* in the table, the usage of the symbol is checked for
* consistency.
***********************************************************
ENTER  CALL PGMERR            Get next token - error if EOL
ENTERW CGE  >00,@CHAT         If token - error
       BR   ERRSYX
ENTERX ST   FAC-1,@FAC15      FOR INDIRECTION IN NAME SAVE
       DST  @PGMPTR,@NMPTR    SAVE POINTER TO NAME
       DDEC @NMPTR            CORRECT FOR PGMCHR POST INCRE
******************** Accumulate the name of the symbol
ENT01  INC  @FAC15            Count the character
       CH   FAC14,@FAC15
       BS   NTLERR
       ST   @CHAT,*FAC15      Save it
       XML  PGMCHR            Get the next one
       CGT  >00,@CHAT         If not token or EOL
       BS   ENT01
       DST  @PGMPTR,@ARG16    Save text pointer to put into
       DDEC @ARG16             symbol table entry loater
       CEQ  >24,*FAC15        String variable?
       BR   G732D
       OR   >10,@XFLAG        Set string flag
G732D  SUB  FAC,@FAC15        Calculate length of name
       INC  @FAC15            + offset of 1
       CEQ  LPARZ,@CHAT       If complex
       BS   ENT22
       CLOG >80,@XFLAG        If ENTERX
       BR   ENT08
       CLOG >04,@XFLAG
       BS   ERRSYX
* If not DEF then DIM without subscripted variable
***********************************************************
*           CODE FOR SIMPLE ENTRY INTO TABLE
* This incudes all non-dimensioned variables as well as
* phony entries for no-parameter functions. ENT09 is the
* entry point for entering one of these phony entries ENT10
* is the code which checks for consistent use of symbols
* within the user's program.
***********************************************************
ENT08  DDEC @PGMPTR           Correct pointer overshoot
ENT09  DST  @PGMPTR,@CHSAV    Save character pointer
       CLR  @STKMIN+1         Zero dimensions for simple
       ST   STKMIN+1,@TOPSTK  Save top of stack
       CLOG >08,@FLAG         No search in function
       BR   ENT16
       XML  SCHSYM            Search symbol table
       BR   ENT16             Not found - must enter it
       DINC @PGMPTR           Correct pointer undershoot
* Common code used by SIMPLE and COMPLEX
* When the symbol appears in the SYMBOL TABLE. It varifies
* that the declarations are the same
* (# of paremeters/dimensions, string, funciton)
ENT10  CLOG >80,@XFLAG        Redeclaring
       BS   ERRMUV
       CLOG >24,@XFLAG        If function or sub-arg
       BR   ERRMUV            Then redefining variable UDF
       ST   V*FAC,@VAR0       Fetch declaration
       AND  >07,@VAR0         MASK FUNCTION AND STRING BITS
       CEQ  *TOPSTK,@VAR0     Not same # of dim
       BR   ERRMUV
       AND  >6B,@XFLAG        Clear FNCFLG, STRFLG and ENTE
       RTN                    All OK - Type matches perfect
ENT16  MOVE 16,@FAC,@ARG      Save name
       DST  14,@NMLEN         Need 14 bytes for a simple va
       CLOG >14,@XFLAG        String or function?
       BS   ENT61             No - allocate & update table
       BR   ENT60             Yes - need 8 bytes for them
*                              Set count to 8 and update
***********************************************************
*           CODE FOR A COMPLEX ENTER
***********************************************************
ENT22  DST  @PGMPTR,@CHSAV    Save the line pointer
       ST   STKMIN,@STACK     Initiaze base of date stack
       MOVE 16,@FAC,@ARG      Save name
       CLOG >84,@XFLAG        ENTERX or inside a DEF ?
       BR   ENT28             Yes, require special scanning
ENT24  XML  PGMCHR            Get next character
       CALL CHKSYN            Must have numeric constant
       BYTE NUMCOZ
       CALL CSINT             Convert dimension to integer
       BS   ERRBV             If got an error on conversion
       CZ   @FAC              If not BIG dim
       BR   G73A6
       CHE  @BASE,@FAC1        Dim < BASE
       BR   ERRBV
G73A6  PUSH @FAC1             Push this dimension
       PUSH @FAC              Both bytes
       CH   STKMAX,@STACK     If too many dims
       BS   ERRSYX
       CEQ  COMMAZ,@CHAT      If comma-more dims
       BS   ENT24
       CEQ  RPARZ,@CHAT       Ok if end on rpar
       BS   ENT40
       BR   ERRSYX            Didn't end on a rpar
******************* Code for a non-DIM statement
ENT28  ST   1,@VAR0           Parenthisis level counter
*                              At first level
ENT29  CALL PGMERR            Get next token - error if EOL
       CGT  >00,@CHAT
       BR   G73CD
       CLOG >20,@XFLAG        Not accepted?
       BR   ERRBA
       BR   ENT29             Get next token
G73CD  CEQ  RPARZ,@CHAT
       BS   ENT34
       CLOG >04,@XFLAG
       BR   ERRSYX
       CEQ  COMMAZ,@CHAT
       BR   G73EC
       CGT  >01,@VAR0         If not top-level command
       BS   ENT29
       PUSH @DFLTLM+1
       PUSH @DFLTLM           Push a default limit
       CGT  STKMAX,@STACK     NOT too many dim
       BR   ENT29
       BR   ERRSYX            Too many dims - so error
* Jump always
G73EC  CLOG >20,@XFLAG        * BAD ARGUMENT
       BR   ERRBA
       CEQ  STRINZ,@CHAT
       BR   G73FB
ENT30  CALL SKPSTR
       BR   ENT29
G73FB  CEQ  NUMCOZ,@CHAT
       BS   ENT30
       CEQ  LPARZ,@CHAT
       BR   G7407
       INC  @VAR0             Increase nesting level
G7407  BR   ENT29             Not anything above. Get next
ENT34  DEC  @VAR0             Decrease nesting level
       BR   ENT29             Continue scan unless through
       PUSH @DFLTLM+1         Push final default limit
       PUSH @DFLTLM
***********************************************************
* Calculate number of dims and search symbol table
***********************************************************
ENT40  ST   @STACK,@VAR0      Compute the # of dims
       SUB  STKMIN,@VAR0
       SRL  1,@VAR0           Divide by 2
       PUSH @VAR0             Push the number of dims on to
       ST   @STACK,@TOPSTK    Save stack top
       MOVE 16,@ARG,@FAC      Get name back
       XML  SCHSYM            Search symbol table for it
       BR   ENT44             Not found in table - ENTER it
       DST  @CHSAV,@PGMPTR    Restore scan restart at "("
       BR   ENT10             And check for consistency
ENT44  CLOG >24,@XFLAG        If function or subprogram
       BR   ENT60              argument then need 8 bytes
* Caculate total number of array elements
       ST   @STACK,@TOPSTK    Save stack pointer
       DEC  @STACK            Skip # of dims
       POP  @FAC              Assume base=0
       POP  @FAC1
       DINC @FAC
       CLR  @VARC             But correct if base=1
       ST   @BASE,@VARC+1     Handle 1st dim specially to
       DSUB @VARC,@FAC         Avoid 1 multiply
       DST  @FAC,@NMLEN       FAC gets # of elements in arr
       B    ENT53             Merge into loop
ENT50  POP  @FAC              Get next dimension
       POP  @FAC1
       DINC @FAC              Assume base=0
       DSUB @VARC,@FAC        But correct if base=1
       DST  @NMLEN,@ACCUM
       DMUL @FAC,@ACCUM       Accumulate size
       DCZ  @ACCUM            Out of memory
       BR   ERRMEM
       DST  @ACCUM+2,@NMLEN
ENT53  CEQ  STKMIN,@STACK
       BR   ENT50
       CLOG >E0,@NMLEN        If any of the top 3 bits set
       BR   ERRMEM             then * MEMORY FULL
       DSLL 1,@NMLEN          Assume string| memory=elemets
       CLOG >10,@XFLAG        But it numeric
       BR   G7480
       DSLL 2,@NMLEN          Memory = 4*(2 * # of elements
G7480  DADD 6,@NMLEN          Need 6 more bytes for header
       CLR  @FAC              For double
       ST   *TOPSTK,@FAC1     Get # of dimensions
       SLL  1,@FAC1           Multiply by 2
       DST  @FAC,@VARC        Save # of elements for later
       DADD @FAC,@NMLEN       Total # of bytes needed
       CARRY
       BS   ERRMEM
       BR   ENT61             Jump always
ENT60  DST  8,@NMLEN          Functions & simple strings ne
***********************************************************
* Check to see if enough memory in VDP RAM or ERAM
* Put symbol name in table if imperatively created or if
* excuting an ERAM program.
***********************************************************
ENT61  CZ   @RAMTOP           If not ERAM
       BR   G74A5
       CZ   @PRGFLG           If program mode
       BR   ENT62
G74A5  CZ   @ARG15            If 0-length (function)
       BS   ENT62
* Move the name into the symbol table
       CLR  @VAR0             Re-do name and pointer
       ST   @ARG15,@VAR0+1    Get length of name
       DST  @VAR0,@FAC        Put length for MEMCHK
       XML  MEMCHK            Check enough memory for name
       BS   ERRMEM            * MEMORY FULL
       DSUB @VAR0,@FREPTR     Get space for the name
       DST  @FREPTR,@NMPTR    Set new pointer to name
       DINC @NMPTR            New pointer to name
       MOVE @VAR0,@ARG,V*NMPTR Move the name
ENT62  CLR  @FAC7             Assume not simple numeric
       CZ   @RAMTOP           Set simple numeric variable
       BS   ENT63A
       ST   @TOPSTK,@STACK    Get # of dimensions of pareme
       POP  @FAC8
       CLOG >14,@XFLAG        If string or UDFunction
       BR   ENT62A            Yes, don't set FAC7
*                             No, if array?
       CZ   @FAC8             Not array
       BR   ENT62A
       INC  @FAC7             Has to be a simple numeric
       DST  @NMLEN,@VAR0      Check enough memory in VDP
       DST  8,@NMLEN          For later use - to locate
       DST  @NMLEN,@FAC       Check enough memory in VDP
       XML  MEMCHK
       BS   ERRMEM            * MEMORY FULL
       BR   ENT63             Check enough memory in ERAM
ENT62A CLR  @FAC6
       CLOG >04,@XFLAG
       BR   ENT63A
*                          UDFunction
       ST   @FAC8,@FAC6
       CZ   @FAC6             String or numeric array?
       BS   ENT63A
* If numeric array goto ENT62B. When checking subprogram
* arguments, numeric array is treated the same as string
* array case.
       CLOG >20,@XFLAG
       BR   ENT62C
       CLOG >10,@XFLAG
       BS   ENT62B
ENT62C CLR  @FAC6             Clear FAC6 to indicate string
       BR   ENT63A            So skip the next portion
* Numeric array case...
ENT62B DST  @NMLEN,@VAR0      Store @NMLEN in temporary
       DST  @VARC,@NMLEN      # of bytes for dimension info
       DADD 8,@NMLEN          # of bytes need in the symbol
*                              table entry in VDP RAM
       DST  @NMLEN,@FAC       Check enough memory in VDP RA
       XML  MEMCHK
       BS   ERRMEM            * MEMORY FULL
       DST  @VAR0,@FAC        Restore @NMLEN from VAR0
       DSUB @VARC,@FAC
       DSUB 6,@FAC
ENT63  DST  @RAMFRE,@FAC2     Get ERAM free pointer
       DSUB @FAC,@FAC2        Calculate lowest address need
       DINC @FAC2             One byte off here
       DCHE CPUBAS,@FAC2      * MEMORY FULL
       BR   ERRMEM
       DST  @FAC2,@RAMFRE     Set new ERAM freespace pointe
       BR   ENT65
ENT63A DST  @NMLEN,@FAC       No, # of bytes needed
       XML  MEMCHK            * MEMORY FULL
       BS   ERRMEM             in VDP RAM
* Now, construct the entry for the symbol table in the FAC
* for ease and speed. Then move it to VDP RAM
ENT65  CLR  @FAC              Clear the header byte
       CLOG >10,@XFLAG        If string
       BS   G7548
       OR   >80,@FAC          Set string bit in header
G7548  CLOG >04,@XFLAG        If UDFunction
       BS   G7550
       OR   >40,@FAC          Set function bit
G7550  ST   @TOPSTK,@STACK    Get # of dimensions or parame
       POP  @FAC8
       CZ   @FAC8             If array or parameters
       BS   ENT67
       OR   @FAC8,@FAC        Overlay # of dimensions
       CLOG >24,@XFLAG        If def or sub-arg
       BR   ENT67             Don't set opt flag
       OR   >02,@XFLAG        Array so set OPTION BASE flag
ENT67  ST   @ARG15,@FAC1      Save length of name
       DST  @SYMTAB,@FAC2     Link to previous entry
       DST  @NMPTR,@FAC4      Save pointer to the name
       DSUB @NMLEN,@FREPTR    Set new table pointer
       DINC @FREPTR
* Move the entry from the FAC to the symbol table
       MOVE 6,@FAC,V*FREPTR
       DST  @FREPTR,@SYMTAB   Pointer to beginning of table
       CLOG >08,@FLAG         If not run-function modify
       BR   G758B
       CLOG >08,@XFLAG        If not in subprogram
       BR   G758B
       DST  @SYMTAB,V@SYMBOL  Save pointer in VDP RAM
G758B  DADD 6,@FREPTR
       CZ   @RAMTOP           If ERAM exists then
       BS   G75C1
       CEQ  >01,@FAC7         If simple numeric variable
       BR   G75A8
       DST  @VAR0,@NMLEN      Restore NMLEN
       DST  @RAMFRE,V*FREPTR  Set the pointer into ERAM
       CLOG >20,@XFLAG
       BR   ENT69
       BR   G75BF
G75A8  CLOG >20,@XFLAG
       BR   ENT69
       CZ   @FAC6             If numeric array
       BS   G75BF
       DST  @VAR0,@NMLEN      Restore NMLEN
       DST  @VARC,@VAR0       Leave the space for dimension
*                              info whtich is going to be
*                              filled in later
       DADD @FREPTR,@VAR0
       DST  @RAMFRE,V*VAR0    Set pointer in ERAM
G75BF  BR   G75C6
G75C1  CLOG >20,@XFLAG
       BR   ENT69
G75C6  CLOG >04,@XFLAG        If UDF - no dimensions
       BS   G75D1
       DST  @ARG16,V*FREPTR   SAVE POINTER TO "(" OR "="
       BR   ENT69B            Jump always
**** Save the dimension information in the symbol table
G75D1  CGT STKMIN,@STACK      If non-array
       BR   ENT69
       ST   STKMIN,@STACK     Get to bottom of stack
ENT68  INC  @STACK            Point tat LSB of next entry
       CHE  @TOPSTK,@STACK    If finished, out
       BS   ENT69
       ST   *STACK,V@>01(@FREPTR)  * Put directly into tabl
       INC  @STACK            Point at MSB of next entry
       ST   *STACK,V*FREPTR   Put directly into table
       DDECT @NMLEN           Used up 2 bytes in table
       DINCT @FREPTR          Adjust pointer to unused byte
       BR   ENT68             Get next dimension
***** Now, zero the required amount of memory
ENT69  CZ   @RAMTOP           If ERAM exists
       BS   ENT69D
       CLOG >10,@XFLAG
       BR   ENT69D
       CEQ  >01,@FAC7         If simple numeric variable
       BR   G7608
       DST  8,@NMLEN          Zero 8 bytes of ERAM memory
       BR   ENT69C
G7608  CZ   @FAC6             If numeric array
       BS   G7618
       DSUB 6,@NMLEN          Calculate amount of ERAM to c
ENT69C XML  IO                Special code to clear ERAM
       BYTE 3               * Select the clear - ERAM code
       BYTE RAMFRE          * Address of ERAM address
       BYTE NMLEN           * Address of number of bytes
       DDEC @RAMFRE           Adjust ERAM free pointer
G7618  BR   ENT69B            VDP case
ENT69D DSUB 7,@NMLEN          Now clear VDP RAM
       CLR  V*FREPTR          Clear 1st byte, then the rest
       MOVE @NMLEN,V*FREPTR,V@1(@FREPTR)
ENT69B DST  @SYMTAB,@FREPTR   Set new free pointer @ then t
       DDEC @FREPTR           Now, set it at 1st free byte
       AND  >EB,@XFLAG        Clear STRFLG and FNCFLG
       CLOG >80,@XFLAG        If ENTERX call
       BS   G763D
       CLOG >20,@XFLAG        If not scanning
       BR   G763D              a subprogram argument then
       DST  @CHSAV,@PGMPTR    Restore character pointer
G763D  XML  PGMCHR            Get next character
       RTN
***********************************************************
* THIS ROUTINE READS A CHARACTER AND WILL GIVE AN ERROR IF
* IT READS AN END OF LINE (PREMATURE END)
***********************************************************
PGMERR XML  PGMCHR
       CALL CHKEND
       BS   ERRSYX            Premature EOL
       RTN
***********************************************************
* THIS ROUTINE SKIPS QUOTED STRINGS UNQUOTED STRINGS AND
* NUMERIC CONSTANTS
***********************************************************
SKPSTR XML  PGMCHR            Get the byte count
       CLR  @VARC              for double
       ST   @CHAT,@VARC+1     Get count for add
       DADD @VARC,@PGMPTR     Skip the string
       RTN
* ERROR messages called in this file
ERRIBS CALL ERRZZ             * ILLEGAL AFTER SUBPROGRAM
       BYTE 4
NTLERR CALL ERRZZ             * NAME TOO LONG
       BYTE 6
ERROBE CALL ERRZZ             * OPTION BASE ERROR
       BYTE 8
ERRMUV CALL ERRZZ             * IMPROPERLY USED NAME
       BYTE 9
ERRMEM CALL ERRZZ             * MEMORY FULL
       BYTE 11
ERRNWF CALL ERRZZ             * NEXT WITHOUT FOR
       BYTE 13
ERRFNN CALL ERRZZ             * FOR/NEXT NESTING
       BYTE 14
ERRSNS CALL ERRZZ             * MUST BE IN SUBPROGRAM
       BYTE 15
ERRMS  CALL ERRZZ             * MISSING SUBEND
       BYTE 17
ERRBA  CALL ERRZZ             * BAD ARGUMENT
       BYTE 28
ERRBV  CALL ERRZZ             * BAD VALUE
       BYTE 30
* Other error messages inside this program
* ERRSYN    * SYNTAX ERROR                         DATA  3
* ERROLP    * ONLY LEGAL IN A PROGRAM              DATA 27
* ERRPV     * PROTECTION VIOLATION                 DATA 39
***********************************************************
* Search and clean up stack and symbol table to not allow
* garbage to accumulate
***********************************************************
CLEAN  DST  @VSPTR,@FAC8      Get a temporary stack pointer
CLEAN1 DCH  @STVSPT,@FAC8     While not end of stack
       BR   G76BE
       ST   V@2(@FAC8),@FAC14 Get stack ID byte
       SUB  >66,@FAC14        Check the range
       CH   >04,@FAC14        If string, numeric, >70, >72
       BR   G7698
       XML  VPOP              Throw it away (Must be on top
       BR   CLEAN
G7698  CASE @FAC14
       BR   CLEANG            GOSUB entry                >6
       BR   CLEANF            FOR   entry                >6
       BR   CLEANU            UDF   entry                >6
       BR   CLEANE            ERROR entry                >6
       BR   CLEANS            SUB   entry                >6
CLEANE CALL SQUISH            ERROR Entry - squish it out
CLEANG DSUB 8,@FAC8           Go down 1 entry
       BR   CLEAN1            Go on to next entry
* Jump always
CLEANF DSUB 16,@FAC8          Keep it around but get below
CLEANS DSUB 16,@FAC8          16 bytes further down
       BR   CLEAN1            FOR or SUB entry
* Jump always
CLEANU DCLR @FAC4             Cause delink to work right
       CALL DELINK            Delink the symbol table entry
       BR   CLEANG
G76BE  RTN
***********************************************************
* Subroutine to convert numeric to integer
***********************************************************
CSINT  DCLR @FAC              Start with clean FAC
CSINT2 XML  PGMCHR
       SUB  >30,@CHAT         Subtract ASCII value for "0"
       CHE  >0A,@CHAT         Valid numeric
       BS   G76E3
       DMUL 10,@FAC           Multiply previous result
       DCZ  @FAC              Overflow ??????
       BR   RETSET
       ST   @CHAT,@FAC1       Get result back down
       DADD @FAC2,@FAC        Add current digit
       CARRY                  If >65535
       BS   RETSET
       CGE  >00,@FAC          Integer > 32767
       BR   RETSET
       BR   CSINT2            And loop until done
G76E3  ADD  >30,@CHAT
       RTN                    Also used somewhere else
RETSET CEQ  @>8300,@>8300
       RTNC
*
* GKXB CODE FOLLOWS ***************************************
RES1   DCLR @PGMPTR      Set flag
       DST  @STLN,@XSTLN Save STLN & ENLN
       DST  @ENLN,@XENLN
       CALL AUTON        Get first parameters
       INC  @PGMPTR      Destroy flag
       RTN
*
* RES2 entered from AUTON if more than 2 numbers entered
*
RES2   DCZ  @PGMPTR      Check flag
       BS   RES2A        Yes, continue
       B    CKOTHR       No, check for copy & move
RES2A  INC  @PGMPTR      Destroy flag
       CEQ  COMMA,@CHAT  Check for comma
       BR   ERRSY1       If no comma
       DST  @CURLIN,@XCURLI Save CURLIN & CURINC
       DST  @CURINC,@XCURIN
       DCLR @CURLIN      Clear out pointers
       DCLR @CURINC
       ST   DASH,@VARC   Separator
       CALL AUTO3        Get range
       CALL GTRANG       Find locations in line table
       DST  @XCURLI,@CURLIN Restore CURLIN & CURINC
       DST  @XCURIN,@CURINC
       DCEQ @XENLN,@ENLN See if start line is first line
       BS   RES3         Yes, continue
       DST  @XENLN,@FAC  Copy start addr to FAC
       DINC @FAC         Point to next lower table entry
       CALL GRSUB3       Get line # of line before start
       BYTE FAC-PAD
       DCH  @EEE1,@CURLIN New start # must be higher than
*                         last # in preceding segment
       BR   ERRBLN       Bad line number if not!
RES3   RTN
*
RES4   DST  @ENLN,@PGMPTR Moved from RES routine
       CZ   V@CRNBUF     Called from RES?
       BS   RES4B        No, skip a few lines
       DCEQ @XSTLN,@STLN Renumbering to end of prog?
       BS   RES4A        Yes, skip the check
       DST  @XSTLN,@FAC  Check for high # overlap
       DSUB 4,@FAC       Point to entry after RES segment
       CALL GRSUB3       Get that line #
       BYTE FAC-PAD
RES4B  DCHE @EEE1,@CURLIN Check that CURLIN is'nt higher
*                         or equal
       BS   ERRBLN       If so, bad line number
RES4A  RTN
*
RES5   CEQ  6,V@CRNBUF   A true RES?
       BS   TOPL25       Yes, return to basic
       RTN               No, just do a return
*
* Code for new commands DEL, COPY, and MOVE
*
* NOTICE !!!!!
* RAM BANK 2 CHANGED AS FOLLOWS-----
* 7D1B changed from >08 to >0B
* 7D35 changed from >08 to >0C
*
*
NEWCMD CH   >0B,V@CRNBUF If higher than MOVE token,
       BS   SZRUN4        continue with old stuff
       DST  CRNBUF+1,@PGMPTR Anticipate usage of PGMCHR
       XML  PGMCHR       Setup CHAT
       ST   V@CRNBUF,@FAC Copy token
       SUB  9,@FAC       Adjust for CASE
       CASE @FAC         Select the keyword
       BR   DEL
       BR   COPY
       BR   MOVE
*
* Patch to change to default colors on RUN
*
RUNPAT CZ   @PRGFLG      Program already running?
       BR   RUNRET       Yes, do nothing
       BACK 7            Screen color
       ST   >10,V@>80F   Character colors
       MOVE 16,V@>80F,V@>810
RUNRET CLR  @PRGFLG      Moved from RUN routine
       B    G6504        Return
*
* DEL routine... Allows the deletion of a program segment
*
DEL    ST   DASH,@VARC   Select separator
       DCLR @CURLIN      Clear variables
       DCLR @CURINC
       CALL AUTO1        Get parameters
       DST  @STLN,@XSTLN Save pointers
       DST  @ENLN,@XENLN
       CALL GTRANG       Get the range to delete
*
DEL01  DST  @ENLN,@XCURLI Store a copy of ENLN
*
       DST  @XENLN,@FAC  Check to see if we need
       DSUB 3,@FAC        to delete another line
       DCHE @XSTLN,@FAC
       BR   DELEND       We're through
*
       CALL GRSUB3       Get line # of line to delete
       BYTE FAC-PAD
       DST  @EEE1,@FAC   Store number in FAC
       ST   1,@CHAT      Flag to delete line
       CALL EDITLN       Delete the line
*
       DADD 4,@XSTLN     Adjust for deleted line
 
       DST  @ENLN,@FAC   New ENLN value
       DSUB @XCURLI,@FAC How much did we delete?
       DADD @FAC,@XSTLN  New XSTLN value
       DADD @FAC,@XENLN  New XENLN value
       B    DEL01        Loop
DELEND B    TOPL20       Return to basic
 
* GTRANG - Sets XSTLN & XENLN as a line #
* table for a range of line #s in CURLIN
* & CURINC. XSTLN & XENLN should contain
* the values in STLN & ENLN when called.
* A bad line number error is generated if
* the range does not contain at least one
* valid program line. If CURINC is zero,
* then the line # in CURLIN must be a valid
* program line. A syntax error is occurs if
* both CURLIN & CURINC are zero.
*
GTRANG DCEQ @STLN,@ENLN  If no program, then error
       BS   ERRNPP
       DST  @ENLN,@FAC   Get first line #
       DSUB 3,@FAC       FAC=source addr in ERAM/VDP
 
       DCZ  @CURLIN      Beginning line specified?
       BR   GTRAN0       Yes, get it
       DCZ  @CURINC      Ending line also zero?
       BS   ERRSY        Yes, syntax error
GTRAN0 CALL GRSUB3       Read the line #
       BYTE FAC-PAD
       DCHE @CURLIN,@EEE1 Check for good number
       BS   GTRAN2       Good number
       DSUB 4,@FAC       Get next table entry
       DCHE @STLN,@FAC   Make sure we're still in table
       BS   GTRAN0       Loop till good number found
       BR   ERRBL        Bad line number error
GTRAN2 DST  @FAC,@XENLN  Store for RES routine
       DADD 3,@XENLN     Fake an ENLN entry
* Evaluate what's in CURINC
GTRAN1 DCZ  @CURINC      Zero?
       BR   GTRAN4       No, go get a line #
       DST  @VARW,@FAC2  Store screen pointer
GTRAN3 DDEC @FAC2        Back up one space on screen
       CEQ  OSPACE,V*FAC2 Is it a space?
       BS   GTRAN3       Yes, loop till no space
       CEQ  DASH+OFFSET,V*FAC2 Is it a dash?
       BS   GTRAN7       Yes, use default for STLN
       BR   GTRAN8       Just one # entered, check it!
GTRAN4 DCH  @CURINC,@CURLIN End line higher than start?
       BR   GTRAN5       No, go get end line
       DST  @CURLIN,@CURINC Make a good line #
GTRAN5 CALL GRSUB3       Get next line #
       BYTE FAC-PAD
       DCH  @CURINC,@EEE1 Gone too far?
       BS   GTRAN6       Yes, we're done
       DSUB 4,@FAC       Next table entry
       DCHE @STLN,@FAC   Make sure we're still in table
       BS   GTRAN5       Loop
       BR   GTRAN7       End of table, use default
GTRAN6 DADD 4,@FAC       Back up one entry
GTRAN9 DST  @FAC,@XSTLN  Put it in place
GTRAN7 DCH  @XENLN,@XSTLN If XSTLN > XENLN then error
       BS   ERRBL
       RTN
GTRAN8 CH   9,V@CRNBUF   Called from RES or DEL?
       BS   GTRAN9       No, skip this check
       DCEQ @EEE1,@CURLIN Check that line found is good
       BR   ERRBL        Bad line number if not
       BR   GTRAN9       Set XSTLN and return
*
ERRSY  B    ERRSY1
ERRBL  B    ERRBLN
ERRNPP B    >64EF        No program present
*
* CKOTHR - Intercepts error from AUTON if more than
* two line #s are entered.
*
CKOTHR CH   >B,V@CRNBUF  Error if higher than MOVE
       BS   ERRSY
       CH   >9,V@CRNBUF  Error if lower than COPY
       BR   ERRSY
       CEQ  COMMA,@CHAT  Check separator
       BR   ERRSY        Error if not
       RTN               Return if OK
*
* GETPAR - gets a line # range and a new starting
* # and increment for MOVE & COPY
*
GETPAR DST  @ENLN,@XENLN Load segment pointers
       DST  @STLN,@XSTLN
       DCLR @CURLIN      Set up variables
       DCLR @CURINC
       ST   DASH,@VARC   Separator
       CALL AUTO1        Get segment start, end
       CALL GTRANG       Get line table range
       DCZ  @CURINC      Fix XSTLN if necessary
       BR   GETPA3
       DST  @STLN,@XSTLN
* Now get new starting # and increment
GETPA3 DCLR @CURLIN      Clear start line#
       DINC @VARW        So AUTON don't screw up
       CLR  V@CRNBUF     So AUTON checks EOS correctly
       CALL AUTO4        Get numbers
       DCZ  @CURLIN      Must specify starting line #
       BS   ERRSY        Syntax error if not
* Find out where to move/copy the segment
       DST  @ENLN,@FAC   End of table to FAC
       DSUB 3,@FAC       Adjust
GETPA1 CALL GRSUB3       Get line # from table
       BYTE FAC-PAD
       DCHE @CURLIN,@EEE1 If high, segment gets moved here
       BS   GETPA2       Go move it!
       DSUB 4,@FAC       Next table entry
       DCHE @STLN,@FAC   Make sure we're still in table
       BS   GETPA1       Search some more
       DST  >8000,@EEE1  To satisfy RES routine
       CEQ  @FAC,@FAC    Set COND bit
       RTNC              Return w/COND
GETPA2 RTN               Return
*
* MOVE -Moves a program segment within a program
* If the new starting line is within the segment to
* be moved, then the segment is just renumbered.
*
MOVE   CALL GETPAR       Get the parameters
       BS   MOVE09       Segment goes to end of program
* Check to see if new start line is inside moved segment
       DCH  @XENLN,@FAC  If FAC is higher than segment end
       BS   MOVE03        then continue
       DCH  @FAC,@XSTLN  If FAC is lower than segment start
       BS   MOVE03        then continue
* Segment need not be moved, just RES
       INC  V@CRNBUF     Fake a RES, almost
       CALL RES6         Do the RES
       BR   MOVE99       Return
* If new start line is a valid program line outside of
* segment to be moved, then error!
MOVE03 DCEQ @EEE1,@CURLIN Check for equal #s
       BS   ERRBL        Bad line number error
* New location found.
MOVE09 DST  @FAC,@XCURLI Save FAC
       DADD 3,@XCURLI    Adjust to end of pointer
       DST  @XENLN,@VARA Find out how many bytes to move
       DSUB @XSTLN,@VARA
       DINC @VARA
       CALL MEMFLL       See if there's enough memory
       DADD @VARA,@STLN  Correct STLN
       CALL RES6         RES the segment
       CALL CLSALL       Close all open files
       CALL KILSYM       Kill the symbol tables
* Now redo the line number table
* First make space for moved segment
       DCH  @XCURLI,@STLN If moving to end of prog
       BS   MOVE05         then skip this part
       DST  @XCURLI,@ARG Figure byte count
       DSUB @STLN,@ARG
       DINC @ARG
       DST  @STLN,@VAR9  Source address
       DST  @STLN,@VAR0  Figure destination addr
       DSUB @VARA,@VAR0
       CZ   @RAMTOP      If pgm in VDP
       BR   MOVE04
       MOVE @ARG,V*VAR9,V*VAR0 Move it!
       BR   MOVE05
MOVE04 XML  MVUP         If pgm in ERAM
* Space now available to move the segment
* Figure whether up or down move
MOVE05 DST  @VARA,@ARG   Byte count for next move
       DCH  @XCURLI,@XSTLN
       BS   MOVE06       Moving to a higher line #
* Move from a higher # to a lower #
       DST  @XSTLN,@VAR0
       DDEC @VAR0        Source address
       DST  @XCURLI,@VARY2 Destination address
       XML  MVDN         Move it
       DST  @XSTLN,@ARG  Figure byte count
       DSUB @STLN,@ARG
       DCZ  @ARG         Don't move zero bytes
       BS   MOVE99
       DST  @XSTLN,@VARY2 Figure destination address
       DDEC @VARY2
       DST  @VARY2,@VAR0 Figure source address
       DSUB @VARA,@VAR0
       XML  MVDN         Move again
MOVE99 CALL CLSALL
       B    TOPL10       Return to basic
* Move from a lower # to a higher #
MOVE06 DST  @XSTLN,@VAR9 Source address
       DST  @XCURLI,@VAR0 Figure destination address
       DSUB @VARA,@VAR0
       DINC @VAR0
       CZ   @RAMTOP      If pmg in VDP
       BR   MOVE07
       MOVE @ARG,V*VAR9,V*VAR0 Move it!
       BR   MOVE08
MOVE07 XML  MVUP         If pgm in ERAM
MOVE08 DST  @XENLN,@ARG  Figure byte count
       DSUB @STLN,@ARG
       DINC @ARG
       DST  @XSTLN,@VAR0 Figure source address
       DDEC @VAR0
       DST  @XENLN,@VARY2 Destination address
       XML  MVDN         Move again
       BR   MOVE99       Return
*
* COPY - copies a block of program lines to any
* other location in the program
*
COPY   CALL GETPAR       Get the parameters
       DCEQ @EEE1,@CURLIN Error if trying to copy
       BS   ERRBL         to a valid line.
       DST  4,@XCURLI    Set a variable
       DST  @EEE1,@XCURIN Save EEE1
* Check to see if new start line is inside copied segment
       DCH  @XENLN,@FAC  If FAC is higher than segment end
       BS   COPY03        then continue
       DCH  @FAC,@XSTLN  If FAC is lower than segment start
       BS   COPY04        then continue
       DADD 3,@FAC       One last chance
       DCEQ @FAC,@XENLN  Make sure we're going lower
       BS   COPY03
COPY05 BR   ERRBL        Error if we get here
COPY03 DSUB 4,@XCURLI    New variable
COPY04 DST  @XENLN,@FAC  Compute # of increments required
       DSUB @XSTLN,@FAC  # of table entries
       DSRL 2,@FAC       # of lines
       DST  @FAC,@XENLN  Save count
       DINC @XENLN       Adjust
       DMUL @CURINC,@FAC Compute space taken by increment
       DCZ  @FAC         Check overflow
       BR   ERRBL        Error if > 65536
       DADD @FAC2,@CURLIN Compute highest line #
       CARR              Test carry bit
       BS   ERRBL        Error if > 65536
       CH   >7F,@CURLIN  Error if > 32767
       BS   ERRBL
       DCHE @XCURIN,@CURLIN Error if last line overlaps
       BS   ERRBL
* Do the actual COPY
       DINCT @XSTLN      Point to line location
COPY00 CALL GRSUB2       Get the location
       BYTE XSTLN-PAD
       DST  @EEE1,@FAC   Copy EEE1
       DDEC @FAC         Point to length byte
       CALL GRSUB2       Get the length byte
       BYTE FAC-PAD
       ST   @EEE1,@CHAT  Store the length in CHAT
       ST   @EEE1,@FFF1+1 Also use for count
       CLR  @FFF1        Assure correct count
       DINC @FAC         FAC points to program text
       CZ   @RAMTOP      If zero, then pgm in VDP
       BS   COPY01
* If program in ERAM
       DST  @FAC,@DDD1   Source address
       DST  CRNBUF,@EEE1 Destination address
       XML  GVWITE       Move to VDP
       BR   COPY02
* If program in VDP
COPY01 MOVE @FFF1,V*FAC,V@CRNBUF Move into CRNBUF
*
COPY02 DST  @CURLIN,@FAC Line # to FAC
       CALL EDITLN       Edit the line into program
       CLR  @FAC         Find next line in table
       ST   @CHAT,@FAC1
       DINC @FAC
       DSUB @FAC,@XSTLN
       DADD @XCURLI,@XSTLN
       DSUB @CURINC,@CURLIN Next new line #
*
       DDEC @XENLN       Count -1
       BR   COPY00       Loop if not done
       B    TOPL20       Return
*
* Code to pick up line # range and record
* length for LIST routine
*
GTLIST CLR  @XSTLN       Clear for record length
       CLR  @VARC        Force an error, maybe
       CALL AUTO1        Get a number
* If we get here, only one number has
* been entered so just return
       RTN
*
CKLIST CZ   @VARC        Limit check to LIST
       BR   ERRSY
       CEQ  COLON,@CHAT  Record length
       BR   CKLI01       No
       DDEC @PGMPTR      Back up to last CHAT
       XML  PGMCHR       Get it
       CZ   @CHAT        File specified?
       BS   ERRSY        No, error out
       DCH  >FF,@CURLIN  Number OK?
       BS   ERRBL        No, indicate an error
       ST   @CURLIN+1,@XSTLN Everything OK
       DCLR @CURLIN      Set up to get range
       ST   DASH,@VARC
       B    AUTO3        Get range and return
CKLI01 CEQ  DASH,@CHAT   Better be a dash!
       BR   ERRSY        Nope
       B    AUTO5        Finish up
***********************************************************
CTRLS  CEQ  147,@RKEY         CTRL S
       BR   CTRLD             No, check more
       DST  @VARW,@ARG5       Force cursor to start
*                              ARG5 = current position
       BR   RBACK             Now process like FCTN S
CTRLD  CEQ  132,@RKEY         CTRL D
       BR   CTRLE             No, check more
       DST  @VARA,@ARG5       Force cursor to end
       CALL SPACES            Look for space
       BR   RFORW             Process like FCTN D
CTRLE  CEQ  133,@RKEY         CTRL E
       BR   CTRLX             No, check more
       DSUB 32,@ARG5          Up one line
       DCH  @ARG5,@VARW       Check range
       BR   READZ1            Ok, go on
       DADD 32,@ARG5          No, redo
       BR   READZ1            And continue
CTRLX  CEQ  152,@RKEY         CTRL X
       BR   CTRL              Resume where left off
       DADD 32,@ARG5          Next line
       DCHE @ARG5,@VARA       Check range
       BS   READZ1            Ok, continue
       DSUB 32,@ARG5          No, redo
       BR   READZ1            Now, go on
CTRL   CHE  >20,@RKEY         Control character!!!!
       BS   G6BD0
       BR   G6ADC
SPACES CEQ  >80,V*ARG5        SPACE?
       BR   SPACE2
       DDEC @ARG5
       BR   SPACES
SPACE2 CEQ  >7F,V*ARG5        CURSOR?
       BS   SPACE3
       RTN
SPACE3 DSUB 4,@ARG5
       BR   SPACES
       BR   G6A86
************************************
MYRUN  OR   >10,@>83C2        QUIT KEY
       DST  @YPT,@VARY        Save Row/Col values
       BACK >01
       ALL  >80
       FMT
       SCRO >60
       ROW  0
       COL  8
       HTEX 'FIRMWARE CONTROL'
       ROW  1
       COL  0
       HCHA 32,95
       ROW  4
       COL  6                      *******************
       HCHA 19,42                  * version = 2001  *
       ROW  4                      *******************
       COL  6                      *      R X B      *
       VCHA 8,42                   *                 *
       ROW  4                      *     creator     *
       COL  24                     *                 *
       VCHA 8,42                   * RICH GILBERTSON *
       ROW  5                      *******************
       COL  8
       HTEX 'version = 2011'
       ROW  6
       COL  6
       HCHAR 19,42
       ROW  7
       COL  13
       HTEX 'R X B'
       ROW  9
       COL  12
       HTEX 'creator'
       ROW  11
       COL  8
       HTEX 'RICH GILBERTSON'
       ROW  12
       COL  6
       HCHA 19,42
       FEND
       CEQ  '1',V@LODFLG
 
       BS   SCNKEY
       CZ   V@LODFLG
       BS   SCNKEY
       CEQ  >3A,V@LODFLG
       BS   TOPLEV
       SCAN
       CEQ  >FF,@RKEY
       BR   LDKEY
       ST   V@LODFLG,V@>0824
       BR   SRCHLP
SCNKEY FMT
       SCRO >60
       ROW  13
       COL  0
       HTEX '>> press ============= result <<'
       ROW  15
       COL  2
       HTEX 'ANY KEY    = DSK#.LOAD'
       ROW  17
       COL  2
       HTEX 'ENTER      = DSK#.UTIL1'
       ROW  19
       COL  2
       HTEX '(COMMA) ,  = DSK#.BATCH'
       ROW  21
       COL  2
       HTEX 'SPACE BAR  = RXB COMMAND MODE'
       ROW  23
       COL  2
       HTEX '(PERIOD) . = EDITOR ASSEMBLER'
       FEND
       DCEQ >994A,V@>2254
       BS   XBRUN
       DST  >0800,@FAC+14     DELAY VALUE
RSCAN  DST  >0F12,@YPT
       CALL CBKEY
       BS   RSCAN2
       DDEC @FAC+14
       BS   SRCHLP
       BR   RSCAN
RSCAN2 CEQ  >0D,@RKEY         ENTER?
       BS   UTIL1
       CEQ  >2C,@RKEY         COMMA?
       BS   BATCH
       CEQ  >2E,@RKEY         PERIOD?
       BS   UTIL4
LDKEY  CLR  V@LODFLG
       ST   @RKEY,V@>0824
SRCHLP MOVE 351,V@>019F,V@>01A0
       DCLR V@>2254           Clear flag
       ST   V@>0824,@RKEY
       FMT
       SCRO >60
       ROW  20
       COL  9
       HTEX 'Searching ....'
       ROW  22
       FEND
       CLR  @VAR0             Row=0
       ST   V@>0820,@FAC      Get string length
       CHE  32,@FAC           Higher 32?
       BS   STLFSC            Yes
       ST   32,@VAR0          Row=32
       SUB  @FAC,@VAR0        32-String length
       SRL  1,@VAR0           Divide by 2
STLFSC ST   @VAR0,@XPT        Load Column
       DST  >0821,@FAC2       String address
DLOOP  ST   V*FAC2,@VAR0      Character
       ADD  >60,@VAR0         Offset
       FMT
       BYTE >E0
       BYTE >00
       FEND
       DINC @FAC2             Address+1
       DEC  @FAC              Count-1
       BR   DLOOP
       DST  @VARY,@YPT        Restore YPT/XPT
       B    SZRUNL
XBRUN  MOVE 50,V@>2256,V@>0820
       CLR  V@LODFLG
       BR   SRCHLP
***********************************************************
UTIL1  CLR  V@>2256
       FMT
       COL  0
       ROW  15
       HCHA 32,32
       FEND
       CLR  @FAC
       DST  >0800,@FAC+14
       ST   >35,@CHAT
UTIL2  DST  >1112,@YPT
       CALL CBKEY
       BS   UTIL3
       DDEC @FAC+14
       BS   UTIL5
       BR   UTIL2
UTIL3  CEQ  >0D,@RKEY         ENTER?
       BS   UTIL2
       CEQ  >20,@RKEY         SPACE?
       BS   LDKEY
       CEQ  >2C,@RKEY         COMMA?
       BS   BATCH
       CEQ  >2E,@RKEY         PERIOD?
       BS   UTIL6
UTIL4  MOVE 12,G@EAU1,V@>2256
       ST   @RKEY,V@>225A
UTIL5  B    GE025
UTIL6  CLR  @CHAT
       BR   UTIL5
*********************************
BATCH  MOVE 128,V@>01E0,V@>01E1
       DST  >0800,@FAC+14     LOAD DELAY
       CLR  @FAC
BATCH1 DST  >1312,@YPT        ROW/COL
       CALL CBKEY
       BS   BATCH2
       DDEC @FAC+14
       BS   BATCH3
       BR   BATCH1
BATCH2 CEQ  >0D,@RKEY         ENTER?
       BS   SCNKEY
       CEQ  >20,@RKEY         SPACE?
       BS   SCNKEY
       CEQ  >2C,@RKEY         COMMA?
       BS   BATCH1
       CEQ  >2E,@RKEY         PERIOD?
       BS   SCNKEY
       BR   BATCH4
BATCH3 ST   >31,@RKEY         1 IN RKEY
BATCH4 ST   >20,V@>08C0
       MOVE 80,V@>08C0,V@>08C1
       MOVE 20,G@UBATCH,V@>08C0
       ST   @RKEY,V@>08CD
       CLR  V@LODFLG
       BR   SZNEW
*********************************
CBKEY  CLOG >01,@FAC+15
       BR   CBKEY2
       EX   @>837D,@FAC
       SCAN
CBKEY2 RTNC
*********************************
* RXB USER
*
DUSER  DCEQ >0900,V@>08C2     PAB there?
       BR   NOUSER            No
       CEQ  >02,V@>08C0       READ code?
       BS   RUSER             READ file
       CALL UDSR              OPEN
       BYTE >00
       BS   USEERR
       ST   V@>08C1,@>8356
       SRL  5,@>8356
       CZ   @>8356
       BR   USEERR
       DST  NLNADD,@VARW      Reset screen address
READLP DCLR V@>0956           Clear counter
       CALL UDSR              READ
       BYTE >02
       BS   CUSER
       ST   V@>08C1,@>8356
       SRL  5,@>8356
       CZ   @>8356
       BR   CUSER
RUSER  DST  V@>0956,@>8376    Get counter
       CEQ  @>8377,V@>08C5    Counter= # bytes
       BS   READLP            yes
       MOVE 1,V@>0900(@>8376),@RKEY
       DINC V@>0956           Counter+1
       BR   USERTN            done
UDSR   MOVE 30,@FAC,V@>03C0   Save FAC
       FETCH @>8356           Get opcode
       ST    @>8356,V@>08C0
       ST    >14,V@>08C1      File type
       DST   >08C9,@>8356
       CALL  LINK
       BYTE  >08
       MOVE  30,V@>03C0,@FAC  Restore FAC
       RTNC
CUSER  CALL UDSR              CLOSE
       BYTE >01
       CALL CLRUSR            Clear USER PAB
NOUSER SCAN
       RAND 99
       RTNC
CLRUSR CLR  V@>08C0
       MOVE 80,V@>08C0,V@>08C1
       RTN
USEERR CALL CLRUSR
       MOVE 14,G@ERRUSE,V@>02E2
       XML  SCROLL
       ST   >0D,@RKEY
       CALL TONE2
USERTN CEQ  @VAR0,@VAR0
       RTNC
***********************************************************
CHARS  EQU  >9CEA             * GROM ADDRESS FOR CHAR TABLE
CHRTBL DST  CHARS,@FAC4
       DST  >400,@FAC
CHRLP  DCLR V*FAC
       MOVE 7,G@0(@FAC4),V@1(@FAC)
       DADD >0008,@FAC
       DADD >0007,@FAC4
       DEC  @FAC2
       BR   CHRLP
       RTN
***********************************************************
* EDITOR ASSEMBLER
EAU1   STRI 'DSK1.UTIL1'
       BYTE >0D
* USER PAB & BATCH FILE
UBATCH BYTE 0,>14,9,0,80,0,0,0,0
       STRI 'DSK1.BATCH'
* USER ERROR *
ERRUSE BYTE 138,128,181,179,165,178,128
       BYTE 165,178,178,175,178,128,128
***************************************
* RXB SEARCH DISK
MYSRCH CZ   V@LODFLG
       BR   NXTDSK
       AND  >F7,@FLAG
       B    G63E0
NXTDSK INC  V@LODFLG
       BR   SZNEW
**************************
* RXB TURN SEARCH OFF
SCHOFF CLR  V@LODFLG
       B    G6A70
**************************************
* MESSAG    'Bytes of Assembly'
MESSAG DATA >A2D9,>D4C5,>D380,>CFC6
       DATA >80A1,>D3D3,>C5CD,>C2CC
       BYTE >D9
* AMSMSG    'K AMS '
AMSK   DATA >AB80,>A1AD,>B380
 
* AMSMSG    'BANKS of 4K Pages '
AMSP   DATA >A2A1,>AEAB,>B380,>CFC6
       DATA >8094,>AB80,>B0C1,>C7C5
       DATA >D380
***********************************************************
* CART   MOVE 32,G@CPUPGM,@>8300 * Put assembly into fast R
       ST   >FF,@FAC           * Byte to load and check for
       XML  >F0                * Execute assembly.
       CZ   @FAC               * Is this a RXB Cartridge?
       BS   SZEXIT             * No, exit to reset.
CART   RTN                     * Yes, continue on.
***********************************************************
*            * CPU PROGRAM FOR >8300 FAST RAM SUBROUTINE FO
CPUPGM DATA >8302 * CPUPGM DATA >8302          * First addr
       DATA >D820 *        MOVB @>834A,@>6FFF  * Turn on ba
       DATA >834A *
       DATA >6FFF *
       DATA >9820 *        CB   @>834A,@>6FFF  * Is it a ca
       DATA >834A *
       DATA >6FFF *
       DATA >1302 *        JEQ  CARTOK         * Yes.
       DATA >04E0 *        CLR  @>834A         * No.
       DATA >834A *
       DATA >D820 * CARTOK MOVB @>834A,@>6000  * Turn on ba
       DATA >834A *
       DATA >6000 *
       DATA >04E0 *        CLR  @>837C         * Clear for
       DATA >837C *
       DATA >045B *        RT                  * Return to
***********************************************************
* AMS SIZE
AMSSIZ DCLR @FAC              * ISR ADDRESS BUFFER
ISROFF EQU  >D0FE
       CALL ISROFF            * >D0FE
AMSON  EQU  >D0FA
       CALL AMSON             * >D0FA
       ST   @>5FFE,@FAC12     * SAVE >F000 mapper
       CEQ  >0F,@FAC12        * Initialized
       BR   NOAMS             * Not Initalized, end SIZE.
       DST  512,@FAC8         * PAGE#
       ST   @>401E,@FAC10     * SAVE PAGE #
NXTPG  DST  @>FFFE,@>8300     * Save bytes
       ST   @FAC10,@>401E     * Pass mode page
       DST  >AAAA,@>FFFE      * Test bytes
       DCEQ >AAAA,@>FFFE      * Test for bytes
       BR   NOAMS             * No memory
       DST  @>8300,@>FFFE     * Restore bytes
       DSRL 1,@FAC8           * PAGE # * 2
       DCEQ 32,@FAC8          * Largest page #
       BS   SHOWIT            * Just show it
       DEC  @FAC9             * PAGE # -1
       ST   @FAC9,@>401E      * >F000 mapper
       INC  @FAC9             * PAGE # +1
       DST  @>FFFE,@>8300     * Save bytes
       DST  >9999,@>FFFE      * Test bytes
       DCEQ >9999,@>FFFE      * Test for bytes
       BR   NXTPG             * Continue loop
SHOWIT DST  >8300,@>FFFE      * Restore bytes
       ST   @FAC10,@>401E     * Restore PAGE
NOAMS  DCZ  @FAC              * ISR?
       BS   NOISR             * No
ISRON  EQU  >D0FC
       CALL ISRON             * >D0FC
AMSOFF EQU  >D0F8
NOISR  CALL AMSOFF            * >D0F8
       CEQ  >0F,@FAC12
       BR   NOAMS2
       DSLL 2,@FAC8           * PAGES * 2 = K
       DST  @FAC8,@ARG2       * SHOW K
       CALL SDISO
       MOVE 6,G@AMSK,V@1(@VARW)
       XML  SCROLL
       DSRL 2,@FAC8           * PAGE /4
       SUB  17,@FAC9          * PAGES-OS
       DST  @FAC8,@ARG2       * SHOW PAGES
       CALL SDISO
       MOVE 18,G@AMSP,V@1(@VARW)
NOAMS2 BR   G6621
***********************************************************
       END
 

Spoiler

***********************************************************
       TITL 'MYXB4'
       GROM >8000
***********************************************************
       TITL 'EQUATES FLMGR-359'
***********************************************************
CPUBAS EQU  >A040             Expansion RAM base
***********************************************************
*           GROM ADDRESSES
MZMSG  EQU  >6038             Start of message area
***********************************************************
GTLIST EQU  >7A06             GKXB address
KEYTAB EQU  >CB00
ERRTAB EQU  >CD77
TRACBK EQU  >CE1F
RETNOS EQU  >CF68
EDTZZ0 EQU  >76EB             Edit a line or display it tab
EDTZ00 EQU  >76F7             Edit a line or display it
SAVLIN EQU  >7795             Save input line address
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS
 
TOPL15 EQU  >6012             RETURN FROM OLD  or SAVE
INITPG EQU  >6014             Initialize program space
TOPL10 EQU  >601A             Return to main and re-init
KILSYM EQU  >6022             KILL SYMBOL TABLE ROUTINE
AUTO1  EQU  >602E             Get arguments for LIST comman
TOPL02 EQU  >6030             RTN address for failing AUTOL
EDITLN EQU  >6032             Edit a line into the program
GWSUB  EQU  >6036             Write a few bytes of data to
MSGTA  EQU  >6053             Message "try again"
LLIST  EQU  >6A74             List a line
READLN EQU  >6A76             Read a line from keyboard
WARNZZ EQU  >6A82             WARNING MESSAGE ROUTINE
ERRZZ  EQU  >6A84             ERROR MESSAGE ROUTINE
ERRZ   EQU  >6A84             ERRor routine
READL1 EQU  >6A86             Read a line from keyboard
LITS05 EQU  >A002             Literal string common code
EXEC   EQU  >A004
LINE   EQU  >A006             GET LINE NUMBER ROUTINE
DATAST EQU  >A008             SEARCH FOR NEXT "DATA" STATEM
ASC    EQU  >A00A
EXEC1  EQU  >A00C             EXECute a program statememt
EXEC6D EQU  >A00E
DELINK EQU  >A010
CONVER EQU  >A012             CONVERT WITH WARNING
SQUISH EQU  >A014
VALCD  EQU  >A016             CONVERT STRING TO NUMBER
INTRND EQU  >A018             Initilize random number
UBSUB  EQU  >A020             CLEAR BREAKPOINTS IN LN # TAB
LINK1  EQU  >A026             LINK to subprogram
ATNZZ  EQU  >0022             Arctangent routine
***********************************************************
*    Equates for routine in MONITOR
CALDSR EQU  >10               CALL DEVICE SERVICE ROUTINE
CFI    EQU  >12               CONVERT TO TWO BYTE INTEGER
TONE1  EQU  >34               ACCEPT TONE
TONE2  EQU  >36               BAD TONE
CHAR2Z EQU  >18               CHARACTER TABLE ADDRESS
CHAR3Z EQU  >4A               CHARACTER TABLE ADDRESS
***********************************************************
*    Equates for XMLs
SYNCHK EQU  >00               SYNCHK XML selector
FILSPC EQU  >01               Fill-space utility
CSTRIN EQU  >02               Copy-string utility
SEETWO EQU  >03               SEETWO XML selector
COMPCT EQU  >70               PREFORM A GARBAGE COLLECTION
GETSTR EQU  >71               SYSTEM GET STRING
MEMCHK EQU  >72               MEMORY check routine: VDP
CNS    EQU  >73               Convert number to string
* Warning Default changed in >0073
PARSE  EQU  >74               Parse a value
CONT   EQU  >75               Continue parsing
VPUSH  EQU  >77               Push on value stack
VPOP   EQU  >78               Pop off value stack
PGMCHR EQU  >79               GET PROGRAM CHARACTER
SYM    EQU  >7A               Find SYMBOL entry
SMB    EQU  >7B               Also for ARRAYS
ASSGNV EQU  >7C               Assign VARIABLE
SCHSYM EQU  >7D               Search symbol table
SPEED  EQU  >7E               SPEED UP XML
CRUNCH EQU  >7F               Crunch an input line
CIF    EQU  >80               Convert INTEGER to FLOATING P
CONTIN EQU  >81               Continue after a break
SCROLL EQU  >83               SCROLL THE SCREEN
IO     EQU  >84               IO utility (KW table search)
GREAD  EQU  >85               READ DATA FROM ERAM
GWRITE EQU  >86               WRITE DATA TO ERAM
DELREP EQU  >87               REMOVE CONTENT FROM VDP/ERAM
MVDN   EQU  >88               MOVE DATA IN VDP/ERAM
MVUP   EQU  >89               MOVE DATA IN VDP/ERAM
VGWITE EQU  >8A               MOVE DATA FROM VDP TO ERAM
GVWITE EQU  >8B               WRITE DATA FROM GRAM TO VRAM
GREAD1 EQU  >8C               READ DATA FROM ERAM
GDTECT EQU  >8E               ERAM DETECT&ROM PAGE 1 ENABLE
SCNSMT EQU  >8F               SCAN STATEMENT FOR PRESCAN
***********************************************************
*    Temporary workspaces in EDIT
VAR0   EQU  >8300            TEMPORARY
VARV   EQU  >8301            TEMPORARY
ACCUM  EQU  >8302            # OF BYTES ACCUMULATOR (4 BYTE
STPT   EQU  >8302            TWO BYTES
MNUM   EQU  >8302            Ussually a counter
AAA1   EQU  >8302
VARY   EQU  >8304
PABPTR EQU  >8304            Pointer to current PAB
VARY2  EQU  >8306            Use in MVDN only
DFLTLM EQU  >8306            Default array limit (10)
CCPPTR EQU  >8306            OFFSET WITHIN RECORED (1)
*                             or Pointer to current column
RECLEN EQU  >8307            LENGTH OF CURRENT RECORD (1)
CCPADR EQU  >8308            RAM address of current refs
*                             or Actual buffer address or c
VARC   EQU  >8308
CCPADD EQU  >8308            RAM address of current color
CCC1   EQU  >8308
CALIST EQU  >830A            Call list for resolving refs
RAMPTR EQU  >830A            Pointer for crunching
STADDR EQU  >830A            Start address - usually for co
BYTES  EQU  >830C            BYTE COUNTER
*                             or String length for GETSTR
NMPTR  EQU  >830C            Pointer save for pscan
BBB1   EQU  >830C
CHSAV  EQU  >830E
CURINC EQU  >830E            Increment for auto-num mode
VAR4   EQU  >830E
TOPSTK EQU  >8310            Top of data stack pointer
VAR5   EQU  >8310
VAR6   EQU  >8311
LINUM  EQU  >8312            Used to determine end of scan
NMLEN  EQU  >8314            Current line for auto-num
CURLIN EQU  >8314            Current line for auto-num
*                             or Starting line number for L
VAR9   EQU  >8316
XFLAG  EQU  >8316            SCAN FLAG-BITS USED AS BELOW
DSRFLG EQU  >8317            INTERNAL =60, EXTERNAL =0 (1)
OPTFLG EQU  >8317            Option flag byte during OPEN
FORNET EQU  >8317            Nesting level of for/next
FNUM   EQU  >8317            Current file number for search
***********************************************************
*    Permanent workspace variables
STRSP  EQU  >8318            String space begining
STREND EQU  >831A            String space ending
SREF   EQU  >831C            Temporary string pointer
SMTSRT EQU  >831E            Start of current statement
VARW   EQU  >8320            Screen address (CURSOR)
ERRCOD EQU  >8322            Return error code from ALC
STVSPT EQU  >8324            Value-stack base
RTNG   EQU  >8326            Return vector from 9900 code
NUDTAB EQU  >8328            Start of NUD table
VARA   EQU  >832A            Ending display location
PGMPTR EQU  >832C            Program text pointer (TOKEN)
EXTRAM EQU  >832E            Line number table pointer
STLN   EQU  >8330            Start of line number table
ENLN   EQU  >8332            End of line number table
DATA   EQU  >8334            Data pointer for READ
LNBUF  EQU  >8336            Line table pointer for READ
INTRIN EQU  >8338            Add of intrinsic poly constant
SUBTAB EQU  >833A            Subprogram symbol table
IOSTRT EQU  >833C            PAB list/Start of I/O chain
SYMTAB EQU  >833E            Symbol table pointer
FREPTR EQU  >8340            Free space pointer
CHAT   EQU  >8342            Current charater/token
BASE   EQU  >8343            OPTION BASE value
PRGFLG EQU  >8344            Program/imperative flag
FLAG   EQU  >8345            General 8-bit flag
BUFLEV EQU  >8346            Crunch-buffer destruction leve
LSUBP  EQU  >8348            Last subprogram block on stack
* FAC  EQU  >834A            Floating-point ACcurmulator
FAC1   EQU  FAC+1
FAC2   EQU  FAC+2
AAA    EQU  FAC+2
FAC3   EQU  FAC+3
FAC4   EQU  FAC+4
CCC    EQU  FAC+4
FFF    EQU  FAC+4
FAC5   EQU  FAC+5
FAC6   EQU  FAC+6
BBB    EQU  FAC+6
EEE    EQU  FAC+6
FAC7   EQU  FAC+7
FAC8   EQU  FAC+8
FAC9   EQU  FAC+9
FAC10  EQU  FAC+10
DDD1   EQU  FAC+10
FAC11  EQU  FAC+11
FAC12  EQU  FAC+12
FFF1   EQU  FAC+12
FAC13  EQU  FAC+13
FAC14  EQU  FAC+14
EEE1   EQU  FAC+14
FAC15  EQU  FAC+15
FAC16  EQU  FAC+16
FAC17  EQU  FAC+17
* ARG  EQU  >835C             Floating-point ARGument
ARG1   EQU  ARG+1
ARG2   EQU  ARG+2
ARG3   EQU  ARG+3
ARG4   EQU  ARG+4
ARG5   EQU  ARG+5
ARG6   EQU  ARG+6
ARG7   EQU  ARG+7
ARG8   EQU  ARG+8
XSTLN  EQU  >8364            GKXB variable
TEMP5  EQU  >8366
ARG11  EQU  ARG+11
ARG15  EQU  ARG+15
ARG16  EQU  ARG+16
* VSPTR  EQU  >836E          Value stack pointer
***********************************************************
*    GPL Status Block
STACK  EQU  >8372             STACK FOR DATA
KEYBD  EQU  >8374             KEYBOARD SELCTION
RKEY   EQU  >8375             KEY CODE
EXPZ   EQU  >8376             Exponent in floating-point
RANDOM EQU  >8378             RANDOM NUMBER GENERATOR
TIMER  EQU  >8379             TIMING REGISTER
MOTION EQU  >837A             NUMBER OF MOVING SPRITES
VDPSTS EQU  >837B             VDP STATUS REGISTER
ERCODE EQU  >837C             STATUS REGISTER
***********************************************************
RAMTOP EQU  >8384            Highest address in ERAM
RAMFRE EQU  >8386            Free pointer in the ERAM
RSTK   EQU  >8388            Subroutine stack base
*                             (Starts at >8A)
RAMFLG EQU  >8389            ERAM flag
STKMIN EQU  >83AF            Base of data stack
STKMAX EQU  >83BD            Top of data stack
PRTNFN EQU  >83CE            Sound - previous tone finished
***********************************************************
*    VDP addresses
SCRNBS EQU  >02E0             Screen base addr for last lin
NLNADD EQU  >02E2             New LiNe ADDress
ENDSCR EQU  >02FE             END of SCReen address
LODFLG EQU  >0371             Auto-boot needed flag
START  EQU  >0372             Line to start execution at
* Temporary
NOTONE EQU  >0374             NO-TONE for SIZE in ACCEPT us
*                              in FLMGRS (4 bytes used)
SYMBOL EQU  >0376             Saved symbol table pointer
SPGMPT EQU  >0382             Saved PGMPTR for continue
SBUFLV EQU  >0384             Saved BUFLEV for contiue
SEXTRM EQU  >0386             Saved EXTRAM for continue
SAVEVP EQU  >0388             Saved VSPRT for continue
ERRLN  EQU  >038A             On-error line pointer
BUFSRT EQU  >038C             Edit recall start addr (VARW)
BUFEND EQU  >038E             Edit recall end addr (VARA)
CSNTMP EQU  >0390             Use as temporary stored place
*                          or CSN TEMPORARY FOR FAC12
TABSAV EQU  >0392             Saved main symbol table ponte
AUTTMP EQU  >0394             AUTOLD TEMPORARY IN SIDE ERRZ
SLSUBP EQU  >0396             Saved LSUBP for continue
SFLAG  EQU  >0398             Saved on-warning/break bits
SSTEMP EQU  >039A             To save subprogram program ta
SSTMP2 EQU  >039C             Same as above. Used in SUBPRO
MRGPAB EQU  >039E             MERGEd temporary for pab ptr
INPUTP EQU  >03AA             INPUT TEMPORARY FOR PTR TO PR
ACCVRW EQU  >03AC             Temoporary used in ERRZZ, als
*                              used in FLMGRS
*                             or temporary for @VARW, @VARA
ACCVRA EQU  >03AE             TRY AGAIN
VALIDP EQU  >03B0             Use as two values passing fro
*                          or PTR TO STANDARD STRING IN VAL
VALIDL EQU  >03B2             VALIDATE code to READL1
*                          or Length of string in validate
SIZCCP EQU  >03B4             SIZE TEMPORARY FOR CCPADR
SIZREC EQU  >03B6             SIZE TEMPORARY FOR RECLEN
*                            Also used as temporary in RELO
*----------------------------------------------------------
* Added 6/8/81 for NOPSCAN feature
PSCFG  EQU  >03B7
*----------------------------------------------------------
ACCTRY EQU  >03B7             ACCEPT "TRY AGAIN" FLAG
SIZXPT EQU  >03B8             Save XPT in SIZE when "try ag
SAPROT EQU  >03B9             PROTECTION flag in SAVE
CSNTP1 EQU  >03BA             CSN TEMPORARY FOR FAC10
*----------------------------------------------------------
*    Flag 0:  99/4  console, 5/29/81
*         1:  99/4A console
CONFLG EQU  >03BB
*----------------------------------------------------------
OLDTOP EQU  >03BC             Temporary used in ERRZZ, also
*                          or Old top of memory for RELOCA
CPTEMP EQU  >03BC             CCPPTR, RECLEN temp in INPUT
NEWTOP EQU  >03BE             New top of memory for RELOCA
CRNBUF EQU  >0820             CRuNch BUFfer address
CRNEND EQU  >08BE             CRuNch buffer END
RECBUF EQU  >08C0             Edit RECall BUFfer
VRAMVS EQU  >0958             Default base of value stack
***********************************************************
*    IMMEDITATE VALUES
NUMBR  EQU  >00               NUMERIC validate
LISTZ  EQU  >02
OLDZ   EQU  >05
RESEQZ EQU  >06
SAVEZ  EQU  >07
MERGEZ EQU  >08
DWNARR EQU  >0A
UPARR  EQU  >0B
CHRTN  EQU  >0D
BKGD   EQU  >20               BACKGROUND CHARACTER
OFFSET EQU  >60               OFFSET FOR VIDEO TABLES
STRVAL EQU  >65               Value in accum. is string val
***********************************************************
* Editting command equates
BREAK  EQU  >02               Break key
DLETE  EQU  >03               Delete key
INSRT  EQU  >04               Insert key
RECALL EQU  >06               Edit-buffer recall
CLRLN  EQU  >07               Clear-line key
BACK   EQU  >08               Back-space key
FORW   EQU  >09               Forward-space key
DOWN   EQU  >0A               Down-arrow key
UPMV   EQU  >0B               Up-arrow key
VWIDTH EQU  >1C               Screen width (PRINT)
SPACE  EQU  >20               Space key
QUOTE  EQU  >22               "
DOLLAR EQU  >24               $
CURSOR EQU  >1E+OFFSET        CURSOR
EDGECH EQU  >1F+OFFSET        EDGE character
COMMA  EQU  >2C               ,
MINUS  EQU  >2D               -
***********************************************************
* PAB offset
CZOPEN EQU  0                 OPEN CODE
CZCLOS EQU  1                 CLOSE CODE
FIL    EQU  2                 File number within BASIC(0-25
CZREAD EQU  2                 READ CODE
OFS    EQU  3                 Offset within record
CZWRIT EQU  3                 WRITE CODE
COD    EQU  4                 I/O code
CZREST EQU  4                 RESTORE/REWIND CODE
FLG    EQU  5                 I/O mode flag byte
CZLOAD EQU  5                 LOAD CODE
BUF    EQU  6                 Start of data buffer
CZSAVE EQU  6                 SAVE CODE
CZDELE EQU  7                 DELETE CODE
LEN    EQU  8                 Record length
CZSCR  EQU  8                 SCRATCH CODE
CNT    EQU  9                 Character count
CZSTAT EQU  9                 STATUS CODE
RNM    EQU  10                Record number
SCR    EQU  12                Screen base offset
NLEN   EQU  13                Length of file descriptor
PABLEN EQU  14                PAB LENGTH
***********************************************************
*    BASIC TOKEN TABLE
*      EQU  >80               spare token
ELSEZ  EQU  >81               ELSE
SSEPZ  EQU  >82               ::
TREMZ  EQU  >83               $
IFZ    EQU  >84               IF
GOZ    EQU  >85               GO
GOTOZ  EQU  >86               GOTO
GOSUBZ EQU  >87               GOSUB
RETURZ EQU  >88               RETURN
DEFZ   EQU  >89               DEF
DIMZ   EQU  >8A               DIM
ENDZ   EQU  >8B               END
FORZ   EQU  >8C               FOR
LETZ   EQU  >8D               LET
BREAKZ EQU  >8E               BREAK
UNBREZ EQU  >8F               UNBREAK
TRACEZ EQU  >90               TRACE
UNTRAZ EQU  >91               UNTRACE
INPUTZ EQU  >92               INPUT
DATAZ  EQU  >93               DATA
RESTOZ EQU  >94               RESTORE
RANDOZ EQU  >95               RANDOMIZE
NEXTZ  EQU  >96               NEXT
READZ  EQU  >97               READ
STOPZ  EQU  >98               STOP
DELETZ EQU  >99               DELETE
REMZ   EQU  >9A               REM
ONZ    EQU  >9B               ON
PRINTZ EQU  >9C               PRINT
CALLZ  EQU  >9D               CALL
OPTIOZ EQU  >9E               OPTION
OPENZ  EQU  >9F               OPEN
CLOSEZ EQU  >A0               CLOSE
SUBZ   EQU  >A1               SUB
DISPLZ EQU  >A2               DISPLAY
IMAGEZ EQU  >A3               IMAGE
ACCEPZ EQU  >A4               ACCEPT
ERRORZ EQU  >A5               ERROR
WARNZ  EQU  >A6               WARNING
SUBXTZ EQU  >A7               SUBEXIT
SUBNDZ EQU  >A8               SUBEND
RUNZ   EQU  >A9               RUN
LINPUZ EQU  >AA               LINPUT
*      EQU  >AB               spare token (LIBRARY)
*      EQU  >AC               spare token (REAL)
*      EQU  >AD               spare token (INTEGER)
*      EQU  >AE               spare token (SCRATCH)
*      EQU  >AF               spare token
THENZ  EQU  >B0               THEN
TOZ    EQU  >B1               TO
STEPZ  EQU  >B2               STEP
COMMAZ EQU  >B3               ,
SEMICZ EQU  >B4               ;
COLONZ EQU  >B5               :
RPARZ  EQU  >B6               )
LPARZ  EQU  >B7               (
CONCZ  EQU  >B8               &          (CONCATENATE)
*      EQU  >B9               spare token
ORZ    EQU  >BA               OR
ANDZ   EQU  >BB               AND
XORZ   EQU  >BC               XOR
NOTZ   EQU  >BD               NOT
EQUALZ EQU  >BE               =
LESSZ  EQU  >BF               <
GREATZ EQU  >C0               >
PLUSZ  EQU  >C1               +
MINUSZ EQU  >C2               -
MULTZ  EQU  >C3               *
DIVIZ  EQU  >C4               /
CIRCUZ EQU  >C5               ^
*      EQU  >C6               spare token
STRINZ EQU  >C7               QUOTED STRING
UNQSTZ EQU  >C8               UNQUOTED STRING
NUMZ   EQU  >C8               ALSO NUMERICAL STRING
NUMCOZ EQU  >C8               ALSO UNQUOTED STRING
LNZ    EQU  >C9               LINE NUMBER CONSTANT
*      EQU  >CA               spare token
ABSZ   EQU  >CB               ABS
ATNZ   EQU  >CC               ATN
COSZ   EQU  >CD               COS
EXPZZ  EQU  >CE               EXP
INTZ   EQU  >CF               INT
LOGZ   EQU  >D0               LOG
SGNZZ  EQU  >D1               SGN
SINZ   EQU  >D2               SIN
SQRZ   EQU  >D3               SQR
TANZ   EQU  >D4               TAN
LENZ   EQU  >D5               LEN
CHRZZ  EQU  >D6               CHR$
RNDZ   EQU  >D7               RND
SEGZZ  EQU  >D8               SEG$
POSZ   EQU  >D9               POS
VAL    EQU  >DA               VAL
STRZZ  EQU  >DB               STR$
ASCZ   EQU  >DC               ASC
PIZ    EQU  >DD               PI
RECZ   EQU  >DE               REC
MAXZ   EQU  >DF               MAX
MINZ   EQU  >E0               MIN
RPTZZ  EQU  >E1               RPT$
*      EQU  >E2               unused
*      EQU  >E2               unused
*      EQU  >E3               unused
*      EQU  >E4               unused
*      EQU  >E5               unused
*      EQU  >E6               unused
*      EQU  >E7               unused
NUMERZ EQU  >E8               NUMERIC
DIGITZ EQU  >E9               DIGIT
UALPHZ EQU  >EA               UALPHA
SIZEZ  EQU  >EB               SIZE
ALLZ   EQU  >EC               ALL
USINGZ EQU  >ED               USING
BEEPZ  EQU  >EE               BEEP
ERASEZ EQU  >EF               ERASE
ATZ    EQU  >F0               AT
BASEZ  EQU  >F1               BASE
*      EQU  >F2               spare token (TEMPORARY)
VARIAZ EQU  >F3               VARIABLE
RELATZ EQU  >F4               RELATIVE
INTERZ EQU  >F5               INTERNAL
SEQUEZ EQU  >F6               SEQUENTIAL
OUTPUZ EQU  >F7               OUTPUT
UPDATZ EQU  >F8               UPDATE
APPENZ EQU  >F9               APPEND
FIXEDZ EQU  >FA               FIXED
PERMAZ EQU  >FB               PERMANENT
TABZ   EQU  >FC               TAB
NUMBEZ EQU  >FD               #
VALIDZ EQU  >FE               VALIDATE
*      EQU  >FF               ILLEGAL VALUE
***********************************************************
       TITL 'FLMGR-359'
***********************************************************
*                        GROM HEADER
***********************************************************
*    Branch table routines
***********************************************************
       BR   DISPL1            DISPLAY routine
       BR   DELET             DELETE routine
       BR   PRINT             PRINT routine
       BR   INPUT             INPUT routine (not yet impele
       BR   OPEN              OPEN routine
       BR   CLOSE             CLOSE routine
       BR   RESTOR            RESTORE routine
       BR   READ              READ routine
       BR   GETDAT            Get DATA from ERAM/VDP (not u
       BR   CLSALL            CLOSE ALL OPEN FILES subrouti
       BR   SAVE              SAVE routine
       BR   OLD               LOAD routine
       BR   LIST              LIST routine
       BR   OUTREC            Output record routine
       BR   EOF               End of file routine
       BR   ACCEPT            ACCEPT routine
       BR   SRDATA            Search "DATAZ" routine
       BR   SUBREC            RECORD routine
       BR   CHKEND            Check EOS
       BR   OLD1              A subroutine for LOAD
       BR   MERGE             MERGE a program
       BR   GRMLST            List a line out of ERAM
       BR   GRSUB2            Read 2 bytes of data from ERA
       BR   GRSUB3            Read 2 bytes of data from ERA
*                             with resetting possible break
       BR   LINPUT              LINPUT statement
***********************************************************
*               OPEN STATEMENT HANDLER
* Handle the BASIC OPNE statement. A legal syntax can only
* be something like
*      OPEN #{exp}:{string-exp}[,{open-options}]
* in which {open-option} is any of the following
* DISPLAY, INPUT, VARIABLE, RELATIVE, INTERNAL, SEQUENTIAL,
* OUTPUT, UPDATE, APPEND, FIXED or PERMANENT
*
* Each keyword can only be used once, which is being checke
* with an OPTFLG-bit. For each specific option please refer
* to the related routine.
* Scanning stops as soon as no next field starting with a
* comma can be found.
* NOTE: After the actual DSR OPEN has been preformed, the
*       length of the record, whether VARIABLE or FIXED,
*       has to be non-zero. A zero length will cause an
*       INCORRECT STATEMENT error.
***********************************************************
OPEN   CALL CHKFN             See if we specified any file
       BS   ERRFE             Definitely not... no # or #0
       CALL CHKCON            Check and search given filenu
       BS   ERRFE             *** FILE NUMBER EXISTS ***
* ERROR IF NOT STOPPED ON COLON
       XML  SPEED             Must be at a
       BYTE SYNCHK          *  colon or else
       BYTE COLONZ          *   its an error
       CALL PARFN             Parse filename and create PAB
       DDEC @PGMPTR           Backup pgm pointer for next t
OPTION XML  PGMCHR            Get next program character
* Next field should start with a comma
OPTIZ0 CEQ  COMMAZ,@CHAT
       BR   CHECK
* Enter HERE after comma exit in "SEQUENTIAL"
OPTIZ1 XML  PGMCHR            Next token please...
* Treat DISPLAY and INPUT as special cases
       CEQ  DISPLZ,@CHAT
       BS   OPTZ6
       CEQ  INPUTZ,@CHAT
       BS   OPTZ7
       SUB  VARIAZ,@CHAT      Reduce keyword offset to 0
       CHE  9,@CHAT           Keyword to high
       BS   OPERR
       CASE @CHAT             JUST IN CASE
       BR   OPTZ01            Option VARIABLE
       BR   OPTZ02                   RELATIVE
       BR   OPTZ03                   INTERNAL
       BR   OPTZ1                    SEQUENTIAL
       BR   OPTZ2                    OUTPUT
       BR   OPTZ3                    UPDATE
       BR   OPTZ4                    APPEND
       BR   OPTZ5                    FIXED
*      BR   OPTZ0                    PERMANENT       <<<<<<
* CASE 0 - "PERMANENT" ************************************
*  Only check for multiple usage. Since PERMANENT is the
*  default, we might as well ignore it...
OPTZ0  CLOG >04,@OPTFLG
       BR   OPERR
       OR   >04,@OPTFLG       Not used ... use now
       BR   OPTION            Treat as simple default
* CASE 2 - "RELATIVE" *************************************
*  Select relative record file in PAB and fall through in
*  SEQUENTIAL code for multiple usage check. Also handle
*  initial file-size there.
OPTZ02 OR   >01,V@FLG(@PABPTR) Indicate RELATIVE RECORD
* CASE 4 - "SEQUENTIAL" ***********************************
*  Checks for multiple usage. Remainder of syntax demads th
*  we have something like:
*                         [{numeric expression}],...
*  In case only a comma is found, we use the default.
*  Everything else has to be evaluated as a numeric
*  expression, convertable to a 16-bit integer value.
OPTZ1  CLOG >08,@OPTFLG
       BR   OPERR
       OR   >08,@OPTFLG       First time usage, ok
       XML  PGMCHR            Check next token for default
* Comma means default has been used
       CEQ  COMMAZ,@CHAT
       BS   OPTIZ1
       CALL CHKEND            Check for end of statement
       BS   CHECK
       CALL CHKPAR            Preform combined checking & p
       DST  @FAC,V@RNM(@PABPTR) Non-zero result
       BR   OPTIZ0            Scan other options
* Parse and check a numeric argument in here....
CHKPAR XML  PARSE             If not ... parse up to comma
       BYTE COMMAZ
       CALL CHKCNV            Check and convert to integer
       BS   OPERR             Oops..., someone made a mista
       RTN                    Return to caller
* CASE 5 - "OUTPUT" ***************************************
*  Select mode code "01" and check for multiple usage. Use
*  MFLAG bit in OPTFLG for checking.
OPTZ2  OR   >02,V@FLG(@PABPTR)  Mode code = 01
* CASE 6 - "UPDATE" ***************************************
*  Default ... Check for multiple usage only...
*  Test for previous usage of any mode setting
OPTZ3  CLOG >01,@OPTFLG
       BR   OPERR
       OR   >01,@OPTFLG       If not... set "MODE USED" bit
       BR   OPTION            Continue option scan
* CASE 7 - "APPEND" ***************************************
*  Mode code "11" indicates APPEND mode.
OPTZ4  OR   >06,V@FLG(@PABPTR)  Mode code = 11
       BR   OPTZ3
* CASE 1 - "VARIABLE" *************************************
*  Change record type to VARIABLE and continue as FIXED
OPTZ01 OR   >10,V@FLG(@PABPTR)  Indicate variable length mo
 
* CASE 8 - "FIXED" ****************************************
*  Fixed is default. Don't change anything, unless argument
*  is given. In this case evaluate as numeric expression an
*  check for 8-bit integer range...
*  This routine is also used for VARIABLE !!!!!
OPTZ5  XML  PGMCHR            Get next character
       CEQ  COMMAZ,@CHAT      Could be some argument
       BS   OPTZ55
       CALL CHKEND            Could also be end of statemen
       BS   OPTZ55            It is an EOS
       CALL CHKPAR            Check & parse expression
* Check for byte overflow (records can only be up to 255
* bytes in length)
       CZ   @FAC
       BR   OPERR
       ST   @FAC1,V@LEN(@PABPTR) Select non-zero rec-size
OPTZ55 CLOG >10,@OPTFLG
       BR   OPERR
       OR   >10,@OPTFLG       Prevent to much usage of mode
       BR   OPTIZ0             Continue option scan
* CASE 3 - "INTERNAL" *************************************
*  Select INTERANL file type and continue in DIPLAY
OPTZ03 OR   8,V@FLG(@PABPTR)  Select INTERNAL type
* CASE 9 - "DISPLAY" **************************************
*  Default. Only check for multiple usage of either DISPLAY
*  or INTERNAL...
OPTZ6  CLOG >02,@OPTFLG
       BR   OPERR
       OR   >02,@OPTFLG       Else set "DISPLAY/INTERAL" fl
       BR   OPTION            Continue... DISPLAY is defaul
* CASE 10 "INPUT" *****************************************
*  Same as any other I/O type definition. Mode code "10" ..
*  Continue in OPTZ3
OPTZ7  OR   >04,V@FLG(@PABPTR) Mode code = 10
       BR   OPTZ3
* CLRFRE deallocates previously alocated (parts of) PAB's a
* return with an error message
CLRFRE CLR  @MNUM             Undo any allocation
       ST   V@OFS(@PABPTR),@MNUM+1  We need the length for
*                                    that
*      V@OFS(@PABPTR) Was set up in PARFN routine
       DADD @MNUM,@FREPTR     Update the first free world
       RTN                    And return
OPERR  CALL CLRFRE            First undo the allocation
ERRSYN CALL ERRZZ             Then give an error
       BYTE 3                 * SYNTAX ERROR
* Continue with CHECK to conplete the actual OPEN
CHECK  CALL CHKEND            Check EOS
       BR   OPERR             Not EOS  : SYNTAX ERROR
* If the user hasn't specified VARIABLE or FIXED, the
* default specification depends on the file type.
* Change current default (=VARIABLE) to FIXED for
* RELATIVE files.
       CLOG >01,V@FLG(@PABPTR) RELATIVE RECORD
       BS   G8127
       CLOG >10,V@FLG(@PABPTR) VARIABLE RECORD
       BS   G8125
FILZZ  CALL CLRFRE            Undo the PAB allocation
       BR   ERRFE             FILE ERROR
G8125  BR   G8131             Sequential file, check rec. m
G8127  CLOG >10,@OPTFLG       No definition yet
       BR   G8131
       OR   >10,V@FLG(@PABPTR) Force VARIABLE mode
G8131  CALL CDSR              Call the DSR, return with err
       BR   ERRZ2B             indication in COND...
       DCLR V@RNM(@PABPTR)    Make sure we start with recor
* Check for undefined record length. The record length for
* any type might be defined by the DSR
       CZ   V@LEN(@PABPTR)
       BS   FILZZ
       ST   V@LEN(@PABPTR),@MNUM+1 Get record length
       CLR  @MNUM             Create two byte result and
       CLR  V@OFS(@PABPTR)     allocate - remove offset for
*                              later use
       DST  @MNUM,@FAC        - prepare for space claim
* Check for special case : no PAB's yet
       DCZ  @IOSTRT
       BR   G8157
       DST  @PABPTR,@IOSTRT   Simply enter the first pointe
       BR   G8169
G8157  DST  @IOSTRT,@STADDR   Search for the end of the cha
G815A  DCZ  V*STADDR
       BS   G8165
       DST  V*STADDR,@STADDR  Keep on deferring
       BR   G815A
G8165  DST  @PABPTR,V*STADDR  Update last chain link
G8169  DST  @PABPTR,V@BUF(@PABPTR) Set empty buffer first
       XML  MEMCHK            Check memory overflow & strin
       BS   ERRMEM            * MEMORY FULL
       DSUB @MNUM,@FREPTR     Compute buffer entry address
       DSUB @MNUM,V@BUF(@PABPTR) Correct buffer address in
       XML  CONT              Return to the parser
***********************************************************
*                    DELETE ROUTINE
* Use file # 0 for this operation. Parse the file name
* string-expression as usual, and delete the PAB before
* actually calling the DSR.
***********************************************************
DELET  CLR  @FNUM             Create file #0 - non-existing
       CALL PARFN             Handle as normal PAB OPEN
       CALL CHKEND            Check EOS first
       BR   OPERR             Not EOS : go undo PAB allocat
*                              and print SYNTAX ERROR
       CLR  @MNUM       *  Delete PAB again before calling
       ST   V@OFS(@PABPTR),@MNUM+1  Create double byte PAB
 
       DADD @MNUM,@FREPTR     Update free word pointer
       CALL IOCALL            Preform I/O call for actual d
       BYTE CZDELE
       XML  CONT
***********************************************************
*                    CLOSE ROUTINE
* Syntax could be
* CLOSE #{ num exp }  or CLOSE #{ num exp }:DELETE
*
* Possibly output pending records before closing or
* deleting the file.
***********************************************************
CLOSE  CALL CHKFN             Check for "no #" / "#0" cases
       BS   ERRFE             Not for "CLOSE" you don't
       CALL CHKCON            Check file number etc...
       BR   ERRFE             *** FILE NUMBER NOT IN SYSTEM
       CALL OUTEOF            Output pending records
       ST   CZCLOS,V@COD(@PABPTR) Default to CLOSE I/O code
       CEQ  COLONZ,@CHAT      Check for ":DELETE" spec.
       BR   G81B8
       XML  PGMCHR            Request next input token
       XML  SPEED             Must be at a
       BYTE SYNCHK          *  "DELETE" else
       BYTE DELETZ          *   its an error
       ST   CZDELE,V@COD(@PABPTR) Change CLOSE to DELETE
G81B8  CALL CHKEND            EOS?
       BR   ERRSYN            NO:SYNTAX ERROR
       CALL CDSR              Call DSR with whatever we hav
       BR   CLOSZ1            Reset means error....
       CALL DELPAB            Delete PAB and data-buffer
       XML  CONT              Return to parser routine
CLOSZ1 DST  V@4(@PABPTR),@ARG Save error code for message
       CALL DELPAB            Now delete the PAB
       DST  @FREPTR,@PABPTR   Store error-code in free memo
       DSUB 6,@PABPTR         Create standard size PAB
       DST  @ARG,V@4(@PABPTR) Copy error-code
       BR   ERRIO             Exit to error-routine
***********************************************************
*                   CLOSE ALL ROUTINE
* CLOSE all the existing PABs ... ignore errors
*
* NOTE: "CLSLBL" is used in the I/O error routine to
*       determine if a warning should be given rather than
*       an error.
***********************************************************
G81DD  DST  V*PABPTR,@PABPTR
CLSAZ0 DCZ  V*PABPTR          Find last PAB in chain
       BR   G81DD
       CALL OUTEOF            Take care of pending records
CLSLBL ST   CZCLOS,V@COD(@PABPTR) Select CLOSE code
       CALL CDSR              CLOSE to DSR routine
       CALL DELPAB            Delete PAB - ignore CLOSE err
CLSALL DST  @IOSTRT,@PABPTR   Start at beginning of chain
       DCZ  @IOSTRT           Continue until done
       BR   CLSAZ0
       RTN                    And return
***********************************************************
*                   RESTORE ROUTINE
* RESTORE can have any of four forms:
*
* RESTORE                     Restore to first DATA
* RESTORE 20                  Restore DATA pointer
* RESTORE #1                  Rewind file number 1
* RESTORE #1, REC 2           Position file 1 at record 2
***********************************************************
RESTOR DCLR @FAC              Assume simple RESTORE
       CEQ  NUMBEZ,@CHAT
       BR   OLDCD
       CALL CHKFN             Check for #<filenumber>
       DCZ  @FAC              Found equivalent of #0
       BS   OLDCZ0
       CALL CHKCON            Check and decode file #
       BR   ERRFE             Give error if file not there
       CALL OUTEOF            Output pending record
       DCLR V@RNM(@PABPTR)    Initialize to record 0
       CALL PARREC            Parse possible record clause
       CALL IOCALL            Call DSR routine with
       BYTE CZREST          *   RESTORE I/O code
       XML  CONT              Return if no error found
* Following code is for handling RESTORE to line number
* within program
OLDCD  CALL CHKEND            Check for start with end
       BS   OLDCZ0            If we have anything else
       CALL LINE               in FAC (double)
OLDCZ0 DCEQ @ENLN,@STLN
       BR   G8233
WRNNPP CALL WARNZZ            * NO PROGRAM PRESENT *
       BYTE 29
       B    TOPL15            Go back to toplevel
G8233  DST  @ENLN,@LNBUF      Start at beginning of program
       DSUB 3,@LNBUF          Backup for first line number
* Check against given line number
OLDCZ1 CALL GRSUB3            Read 2 bytes of line ptr from
*                              line # table which is in ERA
       BYTE LNBUF           * Source address on ERAM/VDP
*                             @EEE1: Destination addr on CP
       DCH  @EEE1,@FAC        Try to get something higher
       BR   G824E
       DCEQ @STLN,@LNBUF      Last line in program
       BS   ERRDAT
       DSUB 4,@LNBUF          Get next entry in line # tabl
       BR   OLDCZ1            Try again with next line
G824E  DADD 3,@LNBUF          Undo subtraction
       CALL DATAST            Setup pointer for READ
       XML  CONT              Continue PARSE
***********************************************************
*                 DISPLAY ROUTINE
* DISPLAY handles all random screen access stuff..
* the AT-clause, and the BEEP, ERASE ALL and SIZE clause.
***********************************************************
DISPL1 CALL DISACC            Evaluate DISPLAY options
       BS   EOLEX             EXIT directly on end-of-state
* If anything is specified it has to be a colon
       CZ   @PABPTR           Nothing was specified
       BS   PRINZ1
* At this point we MUST have a colon, or else we error off
* (SYNTAX ERROR)
       XML  SPEED             Check for a colon
       BYTE SYNCHK          *  and continue
       BYTE COLONZ          *   it approved
       BR   PRINZ1            Continue with PRINT items
***********************************************************
*                    PRINT ROUTINE
* MAIN-HANDLER FOR ALL PRINT-FUNCTIONS
***********************************************************
PRINT  CALL INITKB            Initialize keyboard I/O
       CEQ  NUMBEZ,@CHAT      Could still be anything
       BR   PRINZ1
       CALL CHKFN             Check if default or open chan
       DCZ  @FAC              Default intended
       BS   PRNZ10
       CALL CHKCON            Check and convert expression
       BR   ERRFE             Error if PAB not in system
* PRINT allowed in output, append or update modes
*       Not allowed in input mode
       CLOG >04,V@FLG(@PABPTR)
       BS   G8288
       CLOG >02,V@FLG(@PABPTR)
       BS   ERRFE
G8288  CEQ  CZREAD,V@COD(@PABPTR)
       BR   G8293
       CLR  V@OFS(@PABPTR)    Unpend pending INPUTs
G8293  ST   CZWRIT,V@COD(@PABPTR) uncomplete PRINTs
       CALL PRINIT            Initialize some variables
* Next character has to be either EOL, COMMA, or COLON
       CALL CHKEND
       BS   EOLEX              exit on end of statement
       CALL PARREC            Parse possible record clause
       BS   PRINZ0            found "," but no REC clause
PRNZ10 CALL CHKEND
       BS   EOLEX             Exit on end of statement for
*                       "PRINT #0" or "PRINT file position"
       CEQ  COMMAZ,@CHAT
       BR   G82BE
       XML  PGMCHR            Get next in line
PRINZ0 CZ   @PABPTR           For "PRINT #0"
       BS   USING
*         Interal type of file?
       CLOG >08,V@FLG(@PABPTR)
       BR   ERRFE
       BR   USING             Execute USING clause
G82BE  XML  SPEED             Must be at a
       BYTE SYNCHK          *   colon at this point
       BYTE COLONZ          *     and error off on others
       BR   CONPRT            Make it a short branched ELSE
PRINZ1 CEQ  USINGZ,@CHAT
       BS   USING             End standard initialization
* Test standard separators
CONPRT CALL TSTSEP            Test separator character
       CEQ  TABZ,@CHAT        Handle TABs
       BS   PRTAB
* At this point we've checked TAB and ; , :
* The only remaining print items have to be expressions
*  All expressions are being handled below.
* If the result of the expression is a numeric, the string
* is transformed into a string and printed. Strings are
* printed "as is".
*  The code for strings and converted numerics cannot be ma
* common, since numerics may require an extra space behind
* the item, depending upon the current position in the reco
*  Either way, the string is chunked up into little pieces
* it won't fit in an empty record.
       XML  PARSE             Evaluate the expression
       BYTE COLONZ
* Special code for INTERNAL file handling
*  Translate numeric datums into string format and indicate
* length 8. Then check to see if the item fits within the
* current record. If not, it is an error, since each item
* has to fit.
       CALL TSTINT            Test for internal files
       BS   OTHEZ1            Nope, something different
       CEQ  STRVAL,@FAC2      Change numerics
       BS   G82EC
       ST   8,@FAC12          To string length 8
       MOVE 8,@FAC,@ARG       Save in ARG
       ST   ARG,@FAC11        And use this as source
       CALL RSTRING           Reserve some string space
G82EC  ST   @RECLEN,@ARG      Compute remaining space to EO
       SUB  @CCPPTR,@ARG       for space checking
       INC  @ARG              Make it real space
       CHE  @ARG,@FAC7        Not enough!!!!!
       BS   ERRFE
* The = check includes length byte
       ST   @FAC7,V*CCPADR    Prestore string length
       DINC @CCPADR           Update actual RAM address
       INC  @CCPPTR            and internal column pointer
       BR   OTHEZ0
OTHEZ1 CEQ  STRVAL,@FAC2      Print the string result
       BR   G830D
OTHEZ0 CALL OSTRNG            Output the string to the reco
       BR   CHKSEP
G830D  CLR  @FAC11            Select standard BASIC format
       XML  CNS               Convert number to string
       CALL RSTRING           Reserve and copy string
       CALL OSTRNG            Output the string
* Possibly add an extra space if we're not at the end of th
* current record.
       CHE  @CCPPTR,@RECLEN   Enough space left
       BR   CHKSEP
       ST   SPACE,V*CCPADR    Add trailing space
       ADD  @DSRFLG,V*CCPADR  Take care of screen I/O
       DINC @CCPADR           Update current column address
       INC  @CCPPTR            and base 1 pointer
CHKSEP CALL TSTSEP            Check for legal delimiter
       BR   ERRSYN            Illegal delimiter. SYNTAX ERR
*                              Unconditional branch
* PRTAB - Print TAB as part of PRINT command
PRTAB  CALL TSTINT            Watch out for INTERAL file ty
       BR   ERRFE             They can't handle TABs
       XML  PGMCHR            Skip TAB keyword
       CEQ  LPARZ,@CHAT
       BR   ERRSYN
       XML  PARSE             Parse TAB expression
       BYTE RPARZ
       CALL CNVDEF            Check and convert to integer
       ST   @RECLEN,@FAC2     Set modulo number
       CALL COMMOD            Compute remainder
       CH   @FAC1,@CCPPTR     Position on next output recor
       BR   G834F
       CALL OUTREC            Output current record - no pe
       BS   CHKSEP             react on SIZE block!!!
G834F  CEQ  @FAC1,@CCPPTR     Stay here
       BS   CHKSEP
       ST   @FAC1,@MNUM+1     Fill with spaces
       XML  IO                OK, go ahead... fill'r up
       BYTE FILSPC
       BR   CHKSEP            And check separator again
* Comma is similar to TAB, except that it generates at leas
* one space. The exact number of spaces generated depends
* upon the current position within the record. If the next
* fixed tab-position is outside the record, the record, the
* current record is output and the column pointer is reset
* to column 1 of the next record.
PRTCOM ST   @CCPPTR,@MNUM+1   Compute initial # of spaces
       DEC  @MNUM+1           Decrecment for 0 origin
       CLR  @MNUM             Clear high byte of double
       DIV  14,@MNUM          TABs are 14 spaces apart
       INC  @MNUM             Compute next TAB-stop
       MUL  14,@MNUM           and actual position
       CH   @MNUM+1,@RECLEN   Within this record
       BR   PRCOL
       INC  @MNUM+1           Convert to real position
       XML  IO                Fill spaces to new location
       BYTE FILSPC
       BR   PRSEM             Outside current record
* The ":" (colon) separator is used to output the current
* record, and proceed to position 1 of the next record.
PRCOL  CALL OUTREC            Output the current record
* The ";" (semi-colon) generates the null string. Since all
* print items should be separated by a separator, this one
* has been introduced to separate without moving to another
* position. Notice that all separators join up here.
PRSEM  XML  PGMCHR            Skip the separator
       CALL CHKEND            Exit on end of line
       BR   CONPRT            Continue if not end of line
PRSMZ1 CZ   @DSRFLG           For screen output continue
       BS   PREXIT
       CLOG >08,@PABPTR       Check SIZE clause
       BS   PREXIT
       CALL OUTREC            Output current record (blank
       ST   @CCPADR+1,@CCPPTR Compute correct value for CCP
       SUB  >E1,@CCPPTR       Subtract current screen base
       BR   PREXIT             and exit form this command
* End of line exit routine for PRINT statement
EOLEX  CZ   @DSRFLG           I/O - remove blocks if
       BS   G83A1
       CLOG >04,@PABPTR        " AT" clause unused
       BR   G83A1
       AND  >E7,@PABPTR        remove flag 3 (SIZE used)
G83A1  CALL OUTREC            Output pending record
* Continue here if record remains pending
PREXIT CZ   @DSRFLG           Regular file/device I/O
       BR   G83B1
       DEC  @CCPPTR           Back to actual offset
       ST   @CCPPTR,V@OFS(@PABPTR) Save for next statement
       XML  CONT              Continue with next statement
*                              End external I/O handling
* Reset of code is for internal I/O handling (VDP)
G83B1  CLOG >04,@PABPTR       Is not used
       BR   G83BB
       ST   @CCPPTR,@XPT      Save current value of pointer
       INCT @XPT              CCPPTR: 1-28
G83BB  CLOG >02,@PABPTR       Used BEEP clause
       BS   G83C3
       CALL TONE1             ---------- BEEP ------------
G83C3  XML  CONT              Continue in PARSE routine
* TSTINT - test for INTERAL type files, set COND if file
*          is NOT INTERNAL
TSTINT CZ   @DSRFLG           Couldn't possibly be INTERNAL
       BR   RTC
       CLOG >08,V@FLG(@PABPTR) Set COND according to bit 3
       RTNC                   Return without changing COND
********* PRINT / DISPLAY USING SECTION *******************
* Arrive here after the keyword "USING" has been rejected.
USING  XML  SPEED
       BYTE SYNCHK          * Get first character of format
       BYTE USINGZ          *  after (double) checking USIN
       CEQ  LNZ,@CHAT         Pick up the line number
       BR   G8430
       XML  PGMCHR            Get high address
       ST   @CHAT,@FAC
       XML  PGMCHR             and low address
       ST   @CHAT,@FAC1
       XML  PGMCHR              get next program character
       DST  @EXTRAM,@FAC2        in SEETWO : EXTRAM value w
*                                 changed
       XML  SPEED
       BYTE SEETWO          *  Find the line # in the progr
       DEX  @EXTRAM,@FAC2      result in SEETWO is in EXTRA
*                               and restore EXTRAM value
       BR   USNGZ1               has to match exactly
       DINCT @FAC2            Move up to the pointer field
       DST   @DATA,@FAC8      Save DATA pointer for READ fi
       CALL GRSUB2            Read 2 bytes of data from ERA
       BYTE FAC2           *  @FAC2 : Source address on ERA
       DST  @EEE1,@DATA       @EEE1 : Destination addr. on
*                              Put it in @DATA
       ST   IMAGEZ,@FAC2      Search for an IMAGE token
       CALL SEARCH             at beginning of an statement
       BS   USNGZ1            Error if not found on this li
       CALL GETGFL            Get first part of format stri
       CALL CHKSTR            Prepare data for string assig
       DST  @FAC6,@BYTES      Copy actual string length in
       DST  @FAC8,@DATA       Restore original DATA pointer
       CALL CTSTR             Create a temporary string
       DCZ  @FAC6
       BS   G842E
       CZ   @RAMTOP           Data from RAM
       BR   G8423
       MOVE @FAC6,V*TEMP5,V*SREF
       BR   G842E
G8423  DST  @FAC6,@FFF1       FFF1 : byte count
       DST  @TEMP5,@DDD1      DDD1 : source address in ERAM
       DST  @SREF,@EEE1       EEE1 : destination address on
       XML  GVWITE            Write data from ERAM to VDP
G842E  BR   G8438
G8430  XML  PARSE             Parse up to the ending ":"
       BYTE COLONZ
       CEQ  STRVAL,@FAC2      * IMAGE ERROR *
       BR   USNGZ1
G8438  CEQ  COLONZ,@CHAT      Probably no variable list
       BS   G8448
       CALL CHKEND            We better check that through
       BR   ERRSYN             something sneaky sneaked in
       CZ   @FAC7             End of line exit
       BS   EOLEX
       BR   G8463             Look for format item
G8448  CZ   @FAC7             Exclude null strings
       BS   USNGZ1
       DST  @FAC4,@ARG        Get start address for string
       ST   @FAC7,@ARG2       Get format string length
USNGZ0 CEQ  >23,V*ARG         Found no format item yet
       BS   G8460
       DINC @ARG              Try next address
       DEC  @ARG2             Update address
       BR   USNGZ0            Try up to the end of the stri
USNGZ1 BR   ERRIM             * IMAGE ERROR
* Now we're sure that we have at least one legal format ite
* (anything with a "#" in it)
G8460  ST   COMMAZ,@CHAT      Fake comma seperator for prin
G8463  XML  VPUSH             Current string might be tempo
       DST  @FAC6,@BYTES      Create a workstring for outpu
       INC  @BYTES+1          Create space for end of strin
       CARRY                  String would be too long
       BS   USNGZ1
       XML  GETSTR            Length whold equal format str
       DST  @SREF,@CURLIN     Create a temporary string
       DADD @FAC6,@SREF       Compute last position in stri
       CLR  V*SREF            Set end of string indicator
USNGZ3 DST  V@4(@VSPTR),@FAC4 Update FAC4 area in case garb
       MOVE @FAC6,V*FAC4,V*CURLIN Copy format
       DST  @CURLIN,@FAC4     Complete preps for VPUSH
       DST  >001C,@FAC        SREF = >001C
       DINC @FAC6             Include 0 in string length
       XML  VPUSH             Make the string temporary
       DST  V@4(@VSPTR),@CURLIN Update current line pointer
USNGZ4 CEQ  >23,V*CURLIN      Try to locate the next format
       BS   G84C3
       CZ   V*CURLIN          Not end of string yet
       BS   G84A2
       DINC @CURLIN           Update pointer if not found
       BR   USNGZ4             and continue searching
G84A2  CEQ  COMMAZ,@CHAT      Stop on last variable
       BR   USNGZ9
       XML  VPOP              Restore original workstring d
       ST   @FAC7,@BYTES      Pring the current format stri
       DEC  @BYTES            Don't count the last "0"
       ST   1,@MNUM+1         Indicate direct output withou
       CALL CHKRZ0            Copy string to output record
       CALL OUTREC            Also output current record
* FAC still contains the right data, however it is easier j
* to copy the original string again.
       DST  @FAC4,@CURLIN     Reconstruct CRULIN
       XML  VPOP              Copy original string info
       XML  VPUSH             Without actually removing it
       DSUB @FAC6,@CURLIN     Reconstruct start address
       BR   USNGZ3            Continue for the next variabl
G84C3  DCEQ V@4(@VSPTR),@CURLIN Avoid "#" as count
       BS   USNZ42
       DDEC @CURLIN           Backup to the sign
       CEQ  >2E,V*CURLIN      Used ".#####"
       BR   G84DB
       DCEQ V@4(@VSPTR),@CURLIN
       BS   USNZ42
       DDEC @CURLIN           Avoid checking count bit
G84DB  CEQ  >2D,V*CURLIN      Check for minus
       BS   USNZ42
       CEQ  >2B,V*CURLIN      Check for plus
       BS   USNZ42
       DINC @CURLIN           It's neither, so we undo
* Check for availability of variables
USNZ42 CEQ  COMMAZ,@CHAT      Exit if no more pt item
       BR   USNGZ9
       XML  PGMCHR            Get next expression
       DSUB V@4(@VSPTR),@CURLIN Make CURLIN offset for
*                                garbage collection
       XML  PARSE             Parse up to ";" or ","
       BYTE SEMICZ
       DADD V@4(@VSPTR),@CURLIN Reconstruct new CLN after
*                                garbage collection
       DCLR @FAC8             Start with clean sheet for co
       DCLR @FAC11
       CLR  @FAC13
       DST  @CURLIN,@VAR4     Now start checking process
       CEQ  >2E,V*CURLIN
       BS   USNGZ5
       CEQ  >23,V*CURLIN      Has to be "+" or "-"
       BS   G8527
       CEQ  >2D,V*CURLIN
       BR   G851B
       OR   >02,@FAC11        Set explict sign flag for CNS
G851B  CEQ  >2B,V*CURLIN
       BR   G8527
       OR   >02,@FAC11        Set explict sign flag for CNS
       OR   >04,@FAC11        Set positive sign flag for CN
G8527  CALL ACCNM             Accept first character plus "
       ST   @FAC9,@FAC12      Set up FAC12 for CNS
       CEQ  >2E,V*VAR4        Found decimal point
       BR   G8540
USNGZ5 CLR  @FAC9             Prepare for use as counter of
*                              of # sign after decimal poin
       CALL ACCNM             Accept some more "#"'s
       ST   @FAC9,@FAC13      Set up FAC13 for CNS
       ADD  @FAC12,@FAC9      FAC9 now contains the total n
*                              of "#" sign, decimal point a
*                              maybe a sign bit
       DEC  @FAC9             Exclude the decimal point
G8540  DCEQ >5E5E,V*VAR4      Attempt to decode  ^^
       BR   USNZ55
       DINCT @VAR4            Update address
       DCEQ  >5E5E,V*VAR4
       BR   G8562
       DINCT @VAR4            Update address
       OR   >08,@FAC11        Set E-format bit for CNS
       CEQ  >5E,V*VAR4
       BR   USNZ55
       DINC @VAR4             Update end address
       OR   >10,@FAC11        Set extended E-format bit for
       BR   USNZ55
G8562  DDECT @VAR4            Correct for previous errors
* At this point, CURLIN is pointing at the first item of th
* format, VAR4 is pointing at the character following the i
USNZ55 CHE  >64,@FAC2         Detected numerical argument
       BS   G8596
       CLOG >02,@FAC11        Exclude the sign count
       BS   G8570
       DEC  @FAC9             FAC9 : Number of significant
G8570  CLOG >08,@FAC11        If E-format is used
       BS   G857C
       CGT  >0A,@FAC9         More than 10 significant digi
       BS   ERRIM
       BR   G8581
G857C  CGT  14,@FAC9          More than 14 significant digi
       BS   ERRIM
G8581  OR   >01,@FAC11        Set fixed format output it fo
       XML  CNS               Convert number to fixed forma
* FAC11 points to the beginning of the string after supress
* leading 0's, FAC12 contains the length of the string
       ST   @FAC11,@FAC13     FAC13 now point to beginning
*                              the string
       CLR  @FAC11            Clear high byte
       MOVE @FAC11,*FAC13,V*CURLIN Copy the result string f
*                                   temporary
       DST  @VAR4,@CURLIN     Move pointer behind print fie
       BR   USNGZ4            Continue after printing
G8596  DST  @VAR4,@FAC10      Compute total length
       DSUB @CURLIN,@FAC10
       CH   @FAC11,@FAC7      String exceeds limits
       BR   G85B1
       ST   >2A,@VAR0         Prepare a "*****.." string
G85A4  ST   @VAR0,V*CURLIN    Fill the remainder of field
       DINC @CURLIN           Up to the end
USNZ67 DCEQ @VAR4,@CURLIN     Which is stored in VAR4
       BR   G85A4
       BR   USNGZ4
G85B1  DCZ  @FAC6
       BS   USNZ68
       MOVE @FAC6,V*FAC4,V*CURLIN Copy result string
       DADD @FAC6,@CURLIN     And update address in string
USNZ68 ST   SPACE,@VAR0       Fill remainder with spaces
       BR   USNZ67
USNGZ9 XML  VPOP              Temporary string back out
       ST   @CURLIN+1,@BYTES  Output up to the current
*                              position
       SUB  @FAC5,@BYTES      Create one byte result
       BS   USNZ95            Avoid empty strings
       ST   1,@MNUM+1         Prevent skip if field too sma
       CALL CHKRZ0            Preform all nomal I/O stuff
USNZ95 XML  VPOP              Remove source format string
       CALL CHKEND            Check for end of line exit
       BS   EOLEX             Take end of line exit
       XML  SPEED
       BYTE SYNCHK          * Then it HAS to be a ";"
       BYTE SEMICZ
       CALL CHKEND            Now - must be EOS
       BS   PRSMZ1            Supressed end of record, make
*                              it a pending record
       BR   ERRSYN            SYNTAX ERROR
* Collect string of "#"'s
ACCNM  INC  @FAC9             Update item count
       DINC @VAR4              and item address
       CEQ  >23,V*VAR4        Decode as many "#"'s as
*                              possible
       BS   ACCNM
       RTN                    Return from duty
***********************************************************
*                    INPUT ROUTINE
* First check for file or screen I/O. If file I/O then chec
* for pending output and print that. If screen I/O then
* check for input prompt:
* Next collect the INPUT variable list on the V-stack. Get
* enough input form either file or keyboard, and compare
* types with entries on V-stack. After verification and
* approval, assign the values.
***********************************************************
INPUT  CALL INITKB            Assume keyboard INPUT
       CEQ  NUMBEZ,@CHAT      Might be #0 or #1-255
       BR   G875A
       CALL CHKFN             Check for default #0
       DCZ  @FAC              If luno #0
       BR   G860B
       DST  @PGMPTR,V@INPUTP  Save PGMPTR for "try again"
       DINC V@INPUTP          Pass the ":" for the
*                              "prompt" code handler
*                              later, (using #0 will not
*                              take care the prompt in
*                              INPUT)
       CALL INPUZ2            #0 is equivalent to no #
       BR   INPZ2
G860B  CALL INSU1             Get info about file
* INTERNAL files get special treatment
       CLOG >08,V@FLG(@PABPTR) INTERNAL file
       BS   G86AD
       CZ   V@OFS(@PABPTR)    Fresh start
       BR   G861E
INTRZ0 CALL IOCLZ1            Get a new record through
*                              the DSR
G861E  ST   V@OFS(@PABPTR),@VARA+1 Regain possible offset
       CLR  @VARA             Make that a two byte constant
       DST  V@BUF(@PABPTR),@TEMP5 Get first address
       DADD @VARA,@TEMP5      Compute actual address
*                              within record
INTRZ1 CALL BUG01             Get the symbol table entry
* Above call fixes bug, of the given variable
       XML  VPUSH             And save it on the stack
       DCLR @BYTES            Assume no data available
       CHE  V@CNT(@PABPTR),@VARA+1 Pick up data
       BS   G8643
       ST   V*TEMP5,@BYTES+1  Length byte first
       DINC @TEMP5            Update both actual address
       INC  @VARA+1            and offset
G8643  CEQ  >65,@FAC2         Has to be string variable
       BR   G8650
       DST  @BYTES,@FAC6      Set length of string
       CALL CTMPST            Create temporary string
       BR   G867E
G8650  CEQ  >08,@BYTES+1      * FILE ERROR
       BR   ERRFE
       MOVE @BYTES,V*TEMP5,@FAC  Copy value
       DCZ  @FAC              Watch out for non-scaled stuf
       BS   G867C
       ST   FAC7,@ARG         Test for legal numeric
G8661  CH   99,*ARG           * FILE ERROR
       BS   ERRFE
       DEC  @ARG              Next digit for test
       CEQ  FAC1,@ARG
       BR   G8661
       DST  @FAC,@ARG         Copy in ARG for some testing
       DABS @ARG              Be sure we're positive
* If first byte after expon. byte=0 : incorrect
* normalization has occured : FILE ERROR
* Or >99 : illegal numeric  : FILE ERROR
       DEC  @ARG1             0 would cause underflow here
       CH   98,@ARG1
       BS   ERRFE
       BR   G867E
G867C  DCLR @FAC2             Be sure FAC2 = 0 (no strings)
G867E  DADD @BYTES,@TEMP5     Update address and
       ADD  @BYTES+1,@VARA+1   offset again
       XML  ASSGNV            Assign value to variable
       CLR  V@OFS(@PABPTR)    Undo allocated offsets
       CEQ  COMMAZ,@CHAT
       BR   G86AB
       XML  PGMCHR            Get next text character
       CALL CHKEND            Check for end of statement
       BS   INTRZ2            OK, EOS is fine
       CHE  V@CNT(@PABPTR),@VARA+1
       BS   INTRZ0
       BR   INTRZ1            Still something left
INTRZ2 CHE  V@CNT(@PABPTR),@VARA+1
       BS   G86AB
       ST   @VARA+1,V@OFS(@PABPTR) Save value of offset
G86AB  XML  CONT              And CONTINUE
G86AD  CALL GETVAR            Collect variable list on stac
       DST  @STADDR,@CURLIN   Save it in temp
       DST  CRNBUF,@RAMPTR    Initialize crunch buffer poin
       CLR  @RECLEN           Initialize field counter
       ST   CZREAD,V@COD(@PABPTR) Select READ operation
       CZ   V@OFS(@PABPTR)
       BR   INPZ31
       BR   INPZ3             Adjust for used record usage
G86C6  ST   COMMAZ,V@-1(@RAMPTR) Fake legal separator
INPZ3  CALL IOCLZ1            Get next input record
       CLR  V@OFS(@PABPTR)    Reset offset within record
       CALL RECENT
       ST   V@CNT(@PABPTR),@VARA Get record length
G86DB  CZ   @VARA
       BS   INPZ31
       ADD  OFFSET,V*VARW     Add video offset for normal
       DINC @VARW             Screen-type crunch - proceed
       DEC  @VARA              for entire record
       BR   G86DB
INPZ31 CALL RECENT            Compute actual record entry
       ST   V@CNT(@PABPTR),@VARA+1  Compute end of record
       CLR  @VARA             Make that a double byte
       DADD V@BUF(@PABPTR),@VARA  Add buffer start addr
       DDEC @VARA             Point to last position in rec
       CLR  @VAR6             Assume no values input
       XML  CRUNCH            Scan data fields as in DATA s
       BYTE 1               * Indicate input stmt crunch
       DCZ  @ERRCOD           If some crunch error
       BR   ERRINP
       INC  @VAR6             Get correct # of fields (one
       ADD  @VAR6,@RECLEN     Update # of fields up to now
       CHE  @VAR5,@RECLEN     OK, THAT'S ENOUGH!!!!
       BR   G86C6
       DDECT @PGMPTR          Backup program pointer
       XML  PGMCHR            Re-inspect last token before
       CALL RECENT            Precompute record entry
       CLR  V@OFS(@PABPTR)    Assume no pending record
       CEQ  COMMAZ,@CHAT      Make record pending
       BR   G8752
       CEQ  @VAR5,@RECLEN     Enough left pending
       BS   G8752
       SUB  @VAR5,@RECLEN     Compute remaining # of fields
       SUB  @RECLEN,@VAR6     # of fields used in last reco
INPZ32 CEQ  >82,V*VARW        +OFFSET
       BR   G873A             Skip quoted strings
G872E  DINC @VARW
       CEQ  >82,V*VARW        +OFFSET
       BR   G872E
       DINC @VARW
       BR   INPZ32            Search for Nth data item
G873A  DINC @VARW             Update pointer
       CEQ  >8C,V@-1(@VARW) * ","+OFFSET = >8C
       BR   G873A
       DEC  @VAR6             Commas denote end of field
       BR   INPZ32            Continue until done
       DSUB V@BUF(@PABPTR),@VARW Compute current offset
       ST   @VARW+1,V@OFS(@PABPTR) Store for next round
G8752  ST   @VAR5,@VAR6       Copy # of variables for check
       DST  @CURLIN,@STADDR   Restore from temp
       BR   G8786
G875A  CALL INITKB            Initialize some variables for
       DST  @PGMPTR,V@INPUTP  Save for "try agian" case
       DST  @CCPPTR,V@CPTEMP  Save CCPPTR, RECLEN for "try
*                         Entry point for "try again" case
INPZ33 CALL INSUB1            Put out prompt
INPZ2  CALL GETVAR            Get variable list on V-stack
INPUZ3 CALL INSUB2            Read from the screen
       CLR  @VAR6             Assume no values input
       XML  CRUNCH            Crunch the input line
       BYTE 1               * Indicate input stmt scan
       DST  @CURLIN,@STADDR   Restore from temp
       DCZ  @ERRCOD           If got some crunch error
       BR   WRNINP
       XML  SCROLL            Scroll up after crunching
       ST   3,@XPT            Reset XPT too - pending recor
       INC  @VAR6             # fields = # of commas + 1
       CEQ  @VAR6,@VAR5       # of variables wrong
       BR   WRNINP
* Once we're here, all information should be availiable
* After type verification for input and variables, push
* all value entries on the V-stack.
* VAR6 = VAR5 = number of variables
G8786  DST  @DATA,@CURLIN     Save current DATA pointer
       DST  CRNBUF,@DATA      Get crunch entry
       DST  @VAR4,@MNUM       Get entry in V-stack before P
INPUZ4 DADD 8,@MNUM           Point to first symbol table e
       DST  V*MNUM,@CCPPTR    Get immedediate result
       CALL GETRAM            Get value descriptor from RAM
       CLOG >80,V*CCPPTR      Numerical value
       BR   G87CF
       CALL CHKNUM            Check entered value against n
       BR   INPUZ5            Found error
       CZ   @DSRFLG           Do not check overflow in file
*                              supply machine infinity with
*                              appropriate sign and continu
       BS   INPUZ6
       CZ   V@CSNTP1          Watch out for overflow in scr
       BS   INPUZ6
       DST  @CURLIN,@DATA     Restore DATA pointer
       BR   WRZZ5             Ask for input re-enter
INPUZ5 CZ   @DSRFLG           FILE I/O IS FATAL
       BS   ERRINP
       DST  @CURLIN,@DATA     Restore DATA pointer on error
WRNINP CALL WARNZZ            Go here for simple warnings t
       BYTE 32              * INPUT ERROR - TRY AGAIN
WRZZ5  CALL SCRZ              Scroll the screen and reset C
       DST  V@INPUTP,@PGMPTR  Restore ptr to "prompt" if an
       DST  V@CPTEMP,@CCPPTR  Restore CCPPTR, RECLEN, for t
       DST  @VAR4,@VSPTR      Restore original stack ptr
       BR   INPZ33
G87CF  CALL CHKSTR            Check string input
       BS   INPUZ5            ERROR ... CHECK I/O TYPE
INPUZ6 CALL GETRAM            Get separation character (RAM
       CEQ  COMMAZ,@VAR0+1
       BS   G87E6
       DEC  @VAR6             Has to be end of data
       BR   INPUZ5            If not ... ERROR
       CZ   @VAR0+1
       BR   INPUZ5
       BR   G87EA
G87E6  DEC  @VAR6             Count number of value entries
       BR   INPUZ4            Continue
* Assign cycle - assign values to variables because it resc
* the program line, this code can not be udes for inperativ
* statements , since the crunch buffer get's destroyed on
* input. The rescan is necessary because subscripts should
* evaluated AFTER all previous values have been assigned. i
*        INPUT I,A(I)      with values 2,3
* Should assign value 3 to A(2) !!!!!!!!!
* No error-checking is done here, since types are already
* validated. We might get subscripts out of range though!!!
G87EA  DST  CRNBUF,@DATA      Prepare for input rescan
       DST  @STADDR,@PGMPTR   Restore token pointer for res
       DDEC @PGMPTR           Backup on token
       DST  @VAR4,@VSPTR      Restore original stack pointe
INPZ65 XML  PGMCHR            Get next program characters
       CALL CHKEND            Might have , before EOS
       BS   INPUZ7
       CALL BUG01             Rescan variable name
* Above call fixes bug.       Get correct entry for arrays
       XML  VPUSH             Save on stack for ASSGNV
       CALL GETRAM            Get first token of input valu
       CEQ  STRVAL,@FAC2      Numerical case
       BS   G880F
       CALL CHKNUM            Check for numerical value
       BS   INPZ67            COND should be set (valid num
G880F  CALL CHKSTR            Get the correct string value
       DST  @FAC6,@BYTES      Length for temporary string
       CALL CTMPST            Create temporary string
INPZ67 XML  ASSGNV            Assign value to variable
       CALL GETRAM            Skip separator (already check
       CALL CHKEND            Check for end to statement
       BR   INPZ65            Found it
INPUZ7 DST  @CURLIN,@DATA     Restore DATA pointer
       XML  CONT              Contiue in PARSE
RECENT ST   V@OFS(@PABPTR),@VARW+1  Get record offset
       CLR  @VARW             Double byte value required
       DADD V@BUF(@PABPTR),@VARW   Got it
       RTN                    AND NOW, THE END IS NEAR...
CHKRM  DCH  SCRNBS+29,@CCPADR Not enough room for "?"
       BR   G8840
SCRZ   XML  SCROLL            Scroll one line for "?"
       DST  SCRNBS+2,@CCPADR   and update CCPADR accordingl
G8840  RTN
***********************************************************
*                LINPUT ROUTINE
* If file-I/O then
*             Get file number and check it
*             Internal file not allowed
* End if
* Get variable info
* Must be string variable
* If file I/O then
*           If no-partial-record of REC clause included
*           Read new record
*     End if
*     Set up copy pointers
* Else
*     Call readline to read from keyboard
*     Copy to crunch buffer adjustin g for screen offset
* End if
* Get string of proper length
* Move data into string
* Assign string
* Done.
***********************************************************
LINPUT CALL INITKB            Assume input from keyboard
       CEQ  NUMBEZ,@CHAT      If "#" - then device
       BR   G885C
       CALL CHKFN             Check for default = 0
       DCZ  @FAC              #0 is assumed
       BS   LINP10
       CALL INSU1             Parse the device #
       CLOG >08,V@FLG(@PABPTR)
       BR   ERRFE
       BR   LINP10
G885C  CALL INSUB1            Handle possible prompt
LINP10 DST  @VSPTR,@VAR4      Save original V-pointer
*                              incase BREAK in READLN
       CALL BUG01             Get info about the symbol
* Above call fixes bug.       Get value pointer and type
       CEQ  STRVAL,@FAC2      Must be string
       BR   ERRMUV
       XML  VPUSH
       CZ   @DSRFLG           If device I/O
       BR   G88AF
       CZ   V@OFS(@PABPTR)    If new record
       BR   G887B
       CALL IOCLZ1            Read the record
       BR   G8893
G887B  ST   V@CNT(@PABPTR),@BYTES Get length of record
       DST  V@BUF(@PABPTR),@TEMP5 Get address of buffer
G8885  CZ   @BYTES            While characters in buffer
       BS   G8893
       SUB  OFFSET,V*TEMP5    Remove INPUT's offset
       DINC @TEMP5            Increment pointer
       DEC  @BYTES            Decrement count
       BR   G8885             Drop out directly when done
G8893  CLR  @TEMP5            Need a word value
       ST   V@OFS(@PABPTR),@TEMP5+1  Restore value
       CLR  @BYTES            Need a word value
       ST   V@CNT(@PABPTR),@BYTES+1  Get the length
       DSUB @TEMP5,@BYTES     Calcualte length
       DADD V@BUF(@PABPTR),@TEMP5  Current buffer address
       CLR  V@OFS(@PABPTR)    Read next record next time
       BR   G88E1             Else if keyboard input
G88AF  CALL INSUB2            Clear line and call READLN
       DCLR @BYTES            Initialize byte counter
       DST  @RAMPTR,@TEMP5    Initialize "crunch" pointer
       CEQ  SPACE+OFFSET,V*VARA     If space
       BR   G88BF
       DDEC @VARA             Don't include space on end
G88BF  DCGT @VARA,@VARW       While not at end
       BS   G88DC
       ST   V*VARW,@VAR0      Get the character
       CEQ  EDGECH,@VAR0      If not at edge character
       BS   G88D8
       SUB  OFFSET,@VAR0      Subtract screen offset
       ST   @VAR0,V*RAMPTR    And put into crunch buffer
       DINC @BYTES            Count it
       DINC @RAMPTR           And update "crunch" pointer
G88D8  DINC @VARW             Update input pointer
       BR   G88BF
G88DC  XML  SCROLL            Scroll the screen
       ST   3,@XPT            Initialize x-pointer
G88E1  CALL CTMPST            Create temporary string
       XML  ASSGNV            Assign the value to it
       XML  CONT              And continue execution
* Get file number and info about the file
INSU1  CALL CHKCON            Check & convert & search
       BR   ERRFE             Give error if required
* INPUT allowed for input and update modes
       CLOG >02,V@FLG(@PABPTR)
       BR   ERRFE
       CALL OUTEOF            Output pending PRINT stuff
       ST   CZREAD,V@COD(@PABPTR)   Ensure read operation
       CALL PARREC            Parse REC clause
       XML  SPEED             Must be at a
       BYTE SYNCHK          *  colon else
       BYTE COLONZ          *   its and error
       CLR  @DSRFLG           Clear keyboard input flag
       RTN
* Parse and put out input prompt
INSUB1 DST  @PGMPTR,@STADDR   Save pointer for prompt check
       DDEC @STADDR           Backup to previous token
*                              Go into a tight loop
G890B  CALL NXTCHR            Get next program character
       BS   INPZ37            Detected end of statement
       CEQ  COLONZ,@CHAT      Stop if we find a colon
       BR   G890B
       DST  @STADDR,@PGMPTR   Backup for actual prompt scan
       XML  PGMCHR            Jump into 1st char of prompt
       XML  PARSE             And try to decode string expr
       BYTE COLONZ
       CEQ  STRVAL,@FAC2      Number prompt illegal
       BR   ERRSNM
       CALL OSTRNG            Output the given prompt
       BR   INPZ39            Exit without prompt backup
INPZ37 DST  @STADDR,@PGMPTR   Backup to beginning of line
       ST   COLONZ,@CHAT      Fake prompt with ":"
INPUZ2 CALL CHKRM             Check for room for ?
       ST   >9F,V*CCPADR      Display ?
       DINCT @CCPADR          Count it too
INPZ39 XML  SPEED             Must be at a
       BYTE SYNCHK          *  colon else
       BYTE COLONZ          *   its an error
       RTN
* Issue 'BEEP' and call read line to read form screen
INSUB2 CALL CHKRM             Check for room for answer
       DST  @CCPADR,@VARW     Copy current cursor position
G8941  ST   >80,V*CCPADR      Clear the remainder
       DINC @CCPADR            of the current line
       DCHE >02FE,@CCPADR     Stop if we're there
       BR   G8941
       DST  >7F7F,V@>02FE     Replace edgechars
       CZ   @PRTNFN           If previous tone finished
       BR   G895A
       CALL TONE1             ---------- BEEP -------------
G895A  DEX  @VAR4,@VSPTR      Don't destroy V-stack on BREA
       CALL READLN            Input a line from the keyboar
       DEX  @VAR4,@VSPTR      Restore V-stack pointer
       DST  @STADDR,@CURLIN   Save in a temp
       DST  CRNBUF,@RAMPTR    Init crunch buffer pointer
       RTN
***********************************************************
*                   ACCEPT STATEMENT
* Accept input anywhere on the screen. The total number of
* input variables is limited to one. On an ACCEPT AT( , ),
* the maximum number that can be accepted is up to the righ
* margin!!!! If SIZE() is used, the maximum number is
* limited to the given SIZE, or to the number of characters
* remaining on the line, whichever is the lesser.
***********************************************************
ACCEPT CLR  V@ACCTRY          Clear "try again" flag
       CALL DISACC            Use common code for DISPLAY/A
       BS   ERRSYN             COND set means end of statem
       ST   >FF,@ARG7         Assume we don't have VALIDATE
************ VALIDATE OPTION HANDLING *********************
       CEQ  VALIDZ,@CHAT      Detected VALIDATE option
       BR   G89FD
       XML  PGMCHR            Next character should start o
       CEQ  LPARZ,@CHAT       "* SYNTAX ERROR *"
       BR   ERRSYN
       OR   >40,@PABPTR       Indicate usage of validate cl
       DST  1,@VARA           Use VARA as length of option
       DCLR @VARW             VARW= options used, VARW+1=#0
*                              stack entries for strings
G898B  XML  PGMCHR            Skip separator token
       CHE  NUMERZ,@CHAT      Could be valid option
       BR   G89AA
       CHE  UALPHZ+1,@CHAT    It is ....
       BS   G89AA
       ST   1,@ARG            Select bit 0 as number option
       SUB  NUMERZ,@CHAT      Create correct offset
       BS   SETVW             Skip the shift stat.
       SLL  @CHAT,@ARG        Then select whatever option w
SETVW  OR   @ARG,@VARW        Remember options in VARW
*                              stack entries for strings
       XML  PGMCHR            Get next token
       B    VLIDZ0            Must use a long branch here
G89AA  XML  PARSE             Try to decode a string expres
       BYTE RPARZ
       CEQ  STRVAL,@FAC2      String-number mismatch
       BR   ERRSNM
       CZ   @FAC7             Only count non-null strings
       BS   VLIDZ0
       ADD  @FAC7,@VARA+1     Now watch out for overflow
       CARRY                  Sting truncated
       BR   G89C0
       CALL ERRZZ             * STRING TRUNCATED ERROR *
       BYTE 19
G89C0  XML  VPUSH             Push the result for future re
       INC  @VARW+1           Count number of entries on st
VLIDZ0 CEQ  COMMAZ,@CHAT      Evaluate all fields
       BS   G898B
       XML  SPEED
       BYTE SYNCHK          * Check for ")" on end
       BYTE RPARZ           * If not, "* SYNTAX ERROR *"
       CALL DISPZ1            Try to evaluate further optio
       BS   ERRSYN            Premature end of statement
       DST  @VARA,@BYTES      Allocate string for character
       XML  GETSTR
       DST  @SREF,@ARG        Get start of allocated string
       ST   @VARW,V*ARG       Get start of allocated string
       DINC @ARG              Leave room form standard opti
G89E0  CZ   @VARW+1           Copy all available informatio
       BS   G89F3
       XML  VPOP              Regain stack-entry
       MOVE @FAC6,V*FAC4,V*ARG Copy string
       DADD @FAC6,@ARG        Update destination address
       DEC  @VARW+1           Count # of stack entries
       BR   G89E0
G89F3  DST  @SREF,V@VALIDP    Copy start address of string
       DST  @VARA,V@VALIDL     and total string length
       CLR  @ARG7             Indicate VALIDATE usage of RE
G89FD  DST  @CCPADR,@VARW     Save start address of the fie
       DST  @VARW,@VARA       Set default highest address u
       DST  @CCPADR,@ARG2     Select absolute highest usabl
       DADD 290,@ARG2         290=2+32*9 maximum of 254 cha
       CH   >FC,@VARA+1       Start at the end of line
       BR   G8A13
       DADD 4,@ARG2
G8A13  CZ   @PABPTR           We used some options like AT,
       BS   G8A66
       XML  SPEED
       BYTE SYNCHK          * Should always end on ":"
       BYTE COLONZ
       CLOG >02,@PABPTR       Used BEEP clause
       BS   G8A23
       CALL TONE1             Wake up the user
G8A23  CLOG >04,@PABPTR       Used AT option, SIZE!!!
       BS   G8A35
       CLOG >08,@PABPTR       Use defualt SIZE option
       BR   G8A33
       ST   VWIDTH,@PABPTR+1  Limit current record length
       CALL SIZE1
G8A33  BR   ACCPZ1
G8A35  CLOG >08,@PABPTR       SIZE option used somewhere
       BS   G8A66
* We're sure now that SIZE has been used WITHOUT the AT
* option, this means that we should set XPT to point behind
* the SIZE field. This can be done by adding the record
* length to the current screen base address and the line's
* screen base address
       ST   @CCPADR+1,@XPT    Start of with current address
       ADD  @RECLEN,@XPT      Add in the current record len
       SUB  >DF,@XPT          And subtract the lower base a
*                             Also adjust for edge characte
       ST   @XPT,V@SIZXPT     Save it for "try again" case
*                              in WARNING, XPT gets changed
ACCPZ1 DST  @CCPADR,V@SIZCCP  Save for "try again" case
       ST   @RECLEN,V@SIZREC  Save for "try again" case
***********************************************************
* ENTRY POINT FOR "TRY AGAIN" CASE WHEN SIZE OR ACCEPT USED
***********************************************************
ACCPZ9 CLOG >80,@PABPTR       Blank current field
       BR   G8A58
       ST   SPACE+OFFSET,V*CCPADR
G8A58  DINC @CCPADR           Update screen address
       DEC  @RECLEN           Reduce count, always at least
       BR   ACCPZ9            Loop until at end of field
       DDEC @CCPADR           Fix end of field for maximum
       DST  @CCPADR,@VARA     Set highest location availabl
       DST  @VARA,@ARG2       Also highest location availab
*                              OK all set to go
G8A66  CEQ  1,V@ACCTRY        Skip if in "try again"
       BS   ACCPZ7
       DST  @VSPTR,@VAR4      Save first entry in V-stack
       CALL BUG01             Collect the symbol designator
* Above call fixes bug.       Take care of arrays too
       XML  VPUSH             Save symbol table entry
ACCPZ7 DST  @VARW,V@ACCVRW    Save for trying again case
       DST  @VARA,V@ACCVRA    Save for trying again case
***********************************************************
* ENTRY POINT FOR "TRY AGAIN" WHEN NEITHER SIZE OR ACCEPT I
***********************************************************
* In case a CALL CLEAR or ERASE ALL or CALL HCHAR has just
* processed, EDGE CHARS, are gone at the bottom line
ACCPZ5 CLOG >0C,@PABPTR       If AT/SIZE used, maximum fiel
       BR   AZ1                is line, so no need to worry
*                              about it
       DST  >7F7F,V@>02FE     Put the EDGE CHAR back
AZ1    DEX  @VSPTR,@VAR4      Don't destroy V-stack on BREA
       CALL READL1            Ask for some input that can b
*                             used
       DEX  @VSPTR,@VAR4      Resote V-stack pointer
* At this point, VARA contains the highest location used,
* and VARW contains the string's start address
ACCPZ2 DCEQ @VARW,@VARA       Only non-empty string
       BS   G8A9E
       DDEC @VARA             Go to the next position
       CEQ  SPACE+OFFSET,V*VARA
       BS   ACCPZ2
       DINC @VARA             Back to the last space
G8A9E  XML  VPOP              Check the symbol designator i
       XML  VPUSH             a string or numeric variable
       CEQ  >65,@FAC2         If numeric : empty string is
       BS   G8AB2
       DCEQ @VARA,@VARW       If an empty string was entere
       BR   G8AB2
       CALL WARNZZ            *** INPUT ERROR ***
       BYTE 32
       BR   ACCPZ8
G8AB2  DCLR @BYTES            Compute length of input strin
       DST  @VARW,@SREF       Use SREF as temporary variabl
G8AB7  DCEQ @VARA,@SREF
       BS   G8AC8
       CEQ  EDGECH,V*SREF     Exclude edge character
       BS   G8AC4
       DINC @BYTES
G8AC4  DINC @SREF             Decrement the counter
       BR   G8AB7
G8AC8  CALL CTSTR0            Create a temporary string
ACCPZ3 DCEQ @VARA,@VARW
       BS   G8AEB
       CEQ  EDGECH,V*VARW     Skip the edge character
       BR   G8ADC
       DADD 4,@VARW
       BR   ACCPZ3
G8ADC  ST   V*VARW,V*SREF     Copy the string
       SUB  OFFSET,V*SREF     Subtract the screen offset
       DINC @VARW             Update pointers
       DINC @SREF
       BR   ACCPZ3            Result can't be 0
G8AEB  CEQ  STRVAL,@FAC2      Numerical variable
       BS   ACCPZ6
       ST   STRVAL,@FAC2      Create temp string
       CALL VALCD             Use VAL code for translation
       BR   ACCPZ6            No error - ok go on
WRNSNM CALL WARNZZ            Error
       BYTE 7               * STRING NUMBER MISMATCH
ACCPZ8 CLOG >08,@PABPTR       If SIZE is used
       BS   G8B0A
       CLOG >04,@PABPTR       Also AT is not used
       BR   G8B0A
       ST   V@SIZXPT,@XPT     Restore XPT : in WARNING XPT
G8B0A  DST  V@ACCVRW,@VARW    Restore @VARA, @VARW
       DST  V@ACCVRA,@VARA
       ST   1,V@ACCTRY        Set the "try again" flag
       CLOG >08,@PABPTR       If SIZE is not used
       BR   G8B20
* IF ACCEPT ALSO NOT USED. GOTO "TRY AGAIN" FORM HERE
       CLOG >04,@PABPTR
       BS   ACCPZ5
* IF "EITHER SIZE OR ACCEPT IS USED" THEN
G8B20  DST  V@SIZCCP,@CCPADR  Restore CCPADR
       ST   V@SIZREC,@RECLEN  Restore RECLEN
       BR   ACCPZ9            Go blanking the field and
*                              "try again"
ACCPZ6 XML  ASSGNV            Should be ok now
       CLOG >0C,@PABPTR       Test usage of AT and/or SIZE
       BR   ACCPZ4            At least one of the two used
       XML  SCROLL            Scroll the screen up
       ST   3,@XPT            And reset XPT
ACCPZ4 XML  CONT
***********************************************************
*                  READ STATEMENT
* Assign DATA values to variables in READ-list one at a
* time. Possibly search for new DATA statements if the
* current DATA statement has been used. Be careful with
* null entries...!!!
***********************************************************
G8B38  XML  PGMCHR            Get character following ","
READ   CALL BUG01             Get pointers and correct entr
* Above call fixes bug.        also allow for array variabl
       XML  VPUSH             Push on Vstack for assignment
       CZ   @DATA             DATA ERROR
       BS   ERRDAT
       CALL GETGFL            Get next data item (RAM/GROM)
       CEQ  STRVAL,@FAC2
       BS   G8B6B
       CEQ  NUMZ,@VAR0+1      Not a numeric
       BR   ERRSNM
*                              string-number mismatch error
       CALL CHKSZ0            Build up string info
       DINC @FAC6             Force legal delimiter on end
       CALL LITS05            Copy numeric into string spac
       DST  @SREF,@FAC12      Copy string start address
       DADD @FAC6,@SREF       Compute end address of string
       DDEC @SREF             Back up over delimiter
       CALL CONVER            Convert string to number
       DCEQ @SREF,V@CSNTMP    WRONG!!!!!!!
       BR   ERRDAT
       BR   G8B73
G8B6B  CALL CHKSTR            Check string input
       BS   ERRDAT            Give error on error
       CALL LITS05            Allocate string in string spa
G8B73  XML  ASSGNV            Assign variable
       CALL GETGFL            Get next datum from DATA stmt
       CEQ  COMMAZ,@VAR0+1    Has to be an end of DATA
       BS   G8B8F
       CZ   @VAR0+1           Check for end of data
       BR   ERRDAT
       DDECT @LNBUF           Pointer to line # of DATA stm
       CLR  @DATA             Assume the worst - no more DA
       DCEQ @STLN,@LNBUF
       BS   G8B8F
       DDEC @LNBUF            Next line's 1st token address
       CALL DATAST            Get next DATA statement
G8B8F  CEQ  COMMAZ,@CHAT      Worry about junk in CONT
       BS   G8B38
       XML  CONT
* SRDATA-Search for DATA statements (DATA statement must
* be the only statement on one line)
* SEARCH-also used for searching IMAGE statement.
SRDATA ST   DATAZ,@FAC2       Search for a DATA token
SEARCH DEX  @DATA,@PGMPTR     Exchange with normal PC
       EX   @CHAT,@VAR0+1     Preserve current PGM characte
       CZ   @PRGFLG           If imperative statement
       BR   G8BB3
       CZ   @RAMTOP           With ERAM : text itself in ER
       BS   G8BB3
       ST   >FF,@RAMFLG       Fake RAMFLG in this case
       XML  PGMCHR            Get first character on the li
       CLR  @RAMFLG           Restore it back
       BR   SRDAZ1            Skip that PGMCHR
G8BB3  XML  PGMCHR            Get first character on the li
SRDAZ1 CEQ  @FAC2,@CHAT       Search for specific token
       BS   SRDAZ0
       CEQ  @>8300,@>8300     Set COND if no DATA found
SRDAZ0 DEX  @DATA,@PGMPTR     Exchange won't affect the CON
       EX   @CHAT,@VAR0+1     Situation ok
       RTNC                   Return to caller with COND
***********************************************************
*                     OLD STATEMENT
* A normal load:
*   Get a program from an external device to VDP and
*   reinitialize the program pointers. Also update the line
*   pointer table, since the memory size of the machine on
*   which the program was created doesn't have to be the
*   same as on the current system!!!! Then check if ERAM
*   existed, move it to ERAM if does exist (in relocated
*   from)
* Load a sequential file:
*   When program is bigger than 13.5K and ERAM exists,
*   maximum-length record reads are preformed to read the
*   file and each record is copied into the ERAM as it is
*   read.
***********************************************************
OLD    CALL OLD1              Make OLD1 a subroutine for LO
       B    TOPL15            Go back to top level
OLD1   CALL GPNAME            Get program name & reinitiali
       XML  PGMCHR            Check for EOL
       DST  @PABPTR,@STADDR   Compute memory start address
       DADD V@NLEN-1(@PABPTR),@STADDR    Add PAB-name lengt
       DADD PABLEN-4,@STADDR              and PAB length
       DST  @>8370,V@RNM(@PABPTR)  Compute # of availiable
       DSUB @STADDR,V@RNM(@PABPTR)
       DINC V@RNM(@PABPTR)    Include current address
       DST  @STADDR,V@BUF(@PABPTR) for copy start
       ST   CZLOAD,V@COD(@PABPTR)   Select LOAD I/O code
       CALL CDSR              Call device service routine
       BR   OLDZ3             Not a program file, may be a
*                              sequential file
* STADDR still points to the info bytes
       DST  V@2(@STADDR),@MNUM First test checksum
       DXOR V@4(@STADDR),@MNUM  which is a simple XOR
       DCEQ @MNUM,V*STADDR     Try PROTECTION option
       BS   G8C15
       DNEG @MNUM
       DCEQ @MNUM,V*STADDR    No-ERROR
       BR   OLDER
       OR   >80,@FLAG         Yes, set LIST/EDIT PROTECTION
       BR   G8C17
G8C15  CLR  @FLAG             Otherwise clear protection
G8C17  DST  V@2(@STADDR),@ENLN  Copy new ENLN,
       DST  V@4(@STADDR),@STLN   STLN and
       DST  V@6(@STADDR),V@OLDTOP top of memory info
       DADD 8,@STADDR         Point to program data
       DST  @>8370,V@NEWTOP   Set up the new top
       CALL RELOCA            Relocate according to @>8370
OLDZ5  CZ   @RAMTOP           ERAM present?
       BS   LRTOPZ
*                             No, go back to toplevel
*                             Yes, move from VDP to ERAM
*                             (in relocated form)
************ Move to the ERAM from CPUBAS first ***********
       DST  @>8370,@VAR0
       DSUB @STLN,@VAR0
       DINC @VAR0             # of bytes to move
       DST  @VAR0,@CCC        @CCC : Byte count for VGWITE
       DST  CPUBAS,@BBB       @BBB : Destination addr on ER
       DST  @BBB,@STADDR      For later use as the base of
*                              current program image in REL
       DST  @STLN,@AAA        @AAA : Source address on ERAM
       XML  VGWITE            Move from VDP to ERAM
       DST  @>8370,V@OLDTOP   Set up old memory top
       DST  @RAMTOP,V@NEWTOP  Set up new memory top
       CALL RELOCA            Relocate the program image
OLDZ7  DST  @STLN,@RAMFRE     Reset the RAMFRE on ERAM
       DDEC @RAMFRE
       BR   LRTOPZ            Go back to toplevel
***********************************************************
* At this point : if ERAM not exist - ERROR off else open
* sequential file to load program to ERAM through VDP RAM
***********************************************************
OLDZ3  CZ   @RAMTOP
       BS   OLDER
* Set up PAB for OPEN
* File type : Sequential file,
* Mode of operation : Input
* Date type : internal
* Record type : Variable length records
* Logical record length : 254 maximum
       MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB          <<
       DST  @>8370,@FAC       Compute the data buffer addre
       DSUB 253,@FAC
       DST  @FAC,@AAA         Save it for later use in VGWI
       DST  @FAC,V@BUF(@PABPTR)
       CALL CDSR              Call the device service routi
       BR   ERRZ2B            Return with ERROR indication
*                              in COND
* Start to read in file
       CALL IOCALL            Read in the first record
       BYTE CZREAD          *
* Check the control information
       CEQ  10,V@CNT(@PABPTR) * 10 bytes contr info
       BR   OLDER
* >ABCD is the flag set at SAVE time indicating a program f
       DCEQ >ABCD,V*FAC
       BR   OLDER
       DINCT @FAC
       DST  V*FAC,@STLN       Copy the new STLN
       DINCT @FAC
       DST  V*FAC,@ENLN       ENLN too
       DST  @ENLN,@MNUM       Test checksum
       DXOR @STLN,@MNUM
       DINCT @FAC
       DCEQ @MNUM,V*FAC       Try PROTECTION option
       BS   G8CBD
       DNEG @MNUM
       DCEQ @MNUM,V*FAC       No, ERROR
       BR   OLDER
       OR   >80,@FLAG         Yes, set LIST/EDIT PROTECTION
       BR   G8CBF
G8CBD  CLR  @FLAG             Otherwise clear protection fl
G8CBF  DINCT @FAC
* Check is there enough memory in ERAM
       DST  V*FAC,@MNUM       Get the old top of memory out
       DST  @MNUM,V@OLDTOP    For later use in RELOCA
       DSUB @STLN,@MNUM
       DINC @MNUM             Total # of bytes in program
       DST  @MNUM,@CCC1       For later use as the byte cou
       DADD CPUBAS,@MNUM      Add the total # of bytes to C
* Check if enough memory in ERAM
       GT                     Greater than >FFFF case
       BS   OLDER
       DCH  @RAMTOP,@MNUM     Greater than >DFFF case
       BS   OLDER
* Move to ERAM starting from CPUBAS first,
* then relocate according the new top of memory in ERAM
OLZZ   DST  CPUBAS,@BBB       @BBB : Destination addr in
*                                    ERAM FOR VGWITE
       DST  @BBB,@STADDR      For later use as base of the
*                      current program image in ERAM RELOCA
*      DST  >8370,@AAA        @AAA has been set up before
*      DSUB 253,@AAA          For copy start on VDP RAM
* @CCC1 : Total # of bytes to move to ERAM, set up above
       CALL IOCALL            Read in the second record
       BYTE CZREAD
* Read in the file and each record
* Should be a full (maximum length 254) record at this time
* because program supposed to be bigger than 13.5K
G8CE9  CEQ  254,V@CNT(@PABPTR)
       BR   OLDER
       DST  254,@CCC          @CCC : # of bytes to move
       XML  VGWITE            Move data from VDP to ERAM
       DADD 254,@BBB          Update the destination addres
*                              on ERAM
       DSUB 254,@CCC1         # of bytes left to move
       BS   OLDZ9             No more bytes to move
       CALL IOCALL            Read in the file and each rec
       BYTE CZREAD          * Copied into ERAM as it is rea
       DCHE 254,@CCC1         Leave the last record alone
       BS   G8CE9
* The record length should be the same as the # of bytes le
* to move at this time
       CEQ  @CCC1+1,V@CNT(@PABPTR)
       BR   OLDER
       DST  @CCC1,@CCC        Set up byte count for the las
       XML  VGWITE            Move data from VDP to ERAM
OLDZ9  CALL IOCALL            Close the file
       BYTE CZCLOS
       DST  @RAMTOP,V@NEWTOP  New top of memory
* V@OLDTOP : old top of memory, set up above
* @STADDR  : base of current program image in ERAM, set abo
       CALL RELOCA            Relocate the program
       BR   OLDZ7             Go to set the RAMFRE and back
*                              toplevel
PAB3   BYTE >00,>1C,>00,>00,>FE,>00,>00,>00,OFFSET
* OLD error exit code, don't kill machine
OLDER  CALL INITPG            Initialize program space
       BR   ERRZ2             And take error exit
LRTOPZ CALL KILSYM            Release string space/symbol t
       RTN
***********************************************************
* RELOCATE THE PROGRAM IMAGE ACCORDING TO THE NEW TOP OF
* MEMORY:
*         STLN         : old STLN
*         ENLN         : old ENLN
*         V@OLDTOP     : old top of memory
*         V@NEWTOP     : new top of memory
*         @STADDR      : current base for the old image
***********************************************************
RELOCA DST  @PABPTR,V@SIZCCP  Save in temp.
       DST  V@OLDTOP,@MNUM    Get the old top of memory
       DST  V@NEWTOP,@PABPTR  Get the new top of memory
       DSUB @MNUM,@ENLN       Compute ENLN relative to top
       DSUB @MNUM,@STLN       Compute STLN relative to top
       DSUB @STLN,@STADDR     Highest memory address used
       DCLR @MNUM             Total # of bytes to be moved
       DSUB @STLN,@MNUM       STLN = -(# bytes -1)
       DINC @MNUM             Take care of that one
       DADD @PABPTR,@ENLN     Compute new address of ENLN
       DADD @PABPTR,@STLN      and STLN
* @PABPTR : destination address, @STADDR : source address
       DST  @MNUM,@ARG        @ARG   : byte count
       DST  @STADDR,@VAR0     @VAR0  : source addr for MVDN
       DST  @CCPPTR,@VAR5     Save in temp (CCPPTR, VARY2 E
       DST  @PABPTR,@VARY2    @VARY2 : destination addr for
       DCEQ @RAMTOP,V@NEWTOP  Relocate the program
       BR   G8D6F              in ERAM
       XML  MVDN              Move from lower memory to hig
*                              memory one byte at a time
       BR   G8D7E
G8D6F  DCLR V@SIZREC          Clear a temporary variable
       DEX  @RAMTOP,V@SIZREC  Save the RAMTOP, also fake as
*                         if ERAM not exist for MVDN in thi
       XML  MVDN              Move in VDP
       DEX  @RAMTOP,V@SIZREC  Restore RAMTOP
G8D7E  DST  @VAR5,@CCPPTR     Restore back
* Update line # links according to new size
       DST  V@OLDTOP,@MNUM    Old memory top
       DSUB V@NEWTOP,@MNUM    Stop if sizes are same
       BS   RELOZ1
       DST  @STLN,@STADDR     Start relocation at STLN
OLDZ2  DCHE @STADDR,@ENLN      and continue up to ENLN
       BR   RELOZ1
       DINCT @STADDR          Skip the line #
       CEQ  @RAMTOP,V@NEWTOP  If in ERAM
       BR   G8DAB
       CALL GRSUB2            Read the link out
       BYTE STADDR
       DSUB @MNUM,@EEE1       Update
       CALL GWSUB             Write it back
       BYTE >0A,>58,>02     * STADDR,EEE1,2
       BR   G8DAF
G8DAB  DSUB @MNUM,V*STADDR    Upadate the link
G8DAF  DINCT @STADDR          Skip the link, next line #
       BR   OLDZ2             And continue until done
RELOZ1 DST  V@SIZCCP,@PABPTR  Restore from temp
       RTN
***********************************************************
*                    SAVE STATEMENT
* SAVE "NAME", MERGE : Save in crunched form in program
*  into a file one line at at time with the line number.
*  File opened with sequential accessed, variable-length
*  records (161 max), display type & output mode, move one
*  line number and one in text to the crunch buffer then
*  write to the file one line at a time.
* A normal SAVE : When ERAM not exist or the size of the
*  program and line number table in ERAM can fit in VDP
*  (can be moved into VDP from ERAM once), then the save
*  statement saves a program image to an external device,
*  including all the information the system needs for
*  rebuilding the program image on a machine with a
*  different memory size, also included is a checksum for
*  rudimentary error checking and for PROTECTION VIOLATION
* A sequential SAVE : Maximum-length records are performed
*  to write the file and each record is copied into the VDP
*  from ERAM before it is written.
***********************************************************
SAVE   CLOG >80,@FLAG         * PROTECTION VIOLATION
       BR   ERRPV
       CALL GPNAME            This will also close all file
* Check SAVE "NAME", MERGE or SAVE "NAME", PROTECTED first
       CLR  V@SAPROT          Clear "PROTECTED" flag
       XML  PGMCHR
       CZ   @CHAT             EOL?
       BS   SAZ1              Yes, no need to check any opt
       CEQ  COMMAZ,@CHAT      Has to be a comma here
       BR   ERRSYN
       DCEQ >C805,V*PGMPTR    Unquoted string with length 5
*                              has to be MERGE at this time
       BR   G8DF4
       DCEQ >4D45,V@2(@PGMPTR) "ME" of MErge
       BR   ERRSYN             If not : SYNTAX ERROR
       DCEQ >5247,V@4(@PGMPTR) "RG" of meRGe
       BR   ERRSYN             If not : SYNTAX ERROR
       CEQ  >45,V@6(@PGMPTR)   "E" of mergE
       BR   ERRSYN             If not : SYNTAX ERROR
       CZ   V@7(@PGMPTR)      Check for EOL
       BR   ERRSYN            Not EOL : SYNTAX ERROR
       BR   SAVMG             Go to handle this option
* Has to be PROTECTED option here, crunched as unquoted str
G8DF4  DCEQ >C809,V*PGMPTR    Unquoted string with length 9
*                              has to be PROTECTED
       BR   ERRSYN
       DCEQ >5052,V@2(@PGMPTR) "PR" of PRotected
       BR   ERRSYN             If not : SYNTAX ERROR
       DCEQ >4F54,V@4(@PGMPTR) "OT" of prOTected
       BR   ERRSYN             If not : SYNTAX ERROR
       DCEQ >4543,V@6(@PGMPTR) "EC" of protECted
       BR   ERRSYN             If not : SYNTAX ERROR
       DCEQ >5445,V@8(@PGMPTR) "TE",of protecTEd
       BR   ERRSYN             If not : SYNTAX ERROR
       CEQ  >44,V@10(@PGMPTR)  "D" of protecteD
       BR   ERRSYN             If not : SYNTAX ERROR
       CZ   V@11(@PGMPTR)     Check EOL
       BR   ERRSYN
       INC  V@SAPROT
***********************************************************
SAZ1   CZ   @RAMTOP           If ERAM NOT present then
       BR   G8E42
***** CLEAR THE BREAKPOINT IN VDP ALONE TO SPEED UP *******
       DST  @STLN,@FAC8       End of line # buffer
G8E33  AND  >7F,V*FAC8        Clear the breakpoint
       DADD 4,@FAC8           Move to the next one
       DCH  @ENLN,@FAC8       Until done
       BR   G8E33
       BR   VSAVZ
G8E42  CALL UBSUB             Clear the breakpoint in ERAM
       DST  @RAMTOP,@MNUM     Top of memory in ERAM
       DSUB @STLN,@MNUM
       DINC @MNUM             # of bytes total in ERAM
       DST  @>8370,@VAR0      Top of memory in VDP
       DSUB @MNUM,@VAR0
       DINC @VAR0
* Check is there enough memory in VDP to move the program
*  text and line number table from ERAM to VDP
       GT                  Not enough memory in VDP for sur
       BR   GSAVE
       DST  VRAMVS+64+256,@VAR5 * 64 bytes ar for safety bu
 
* DSR routine give file error when loading a program which
*  VDP maximum size and was saved from VDP to be a program
*  on disk when ERAM not exist. In order to fix this proble
*  restrict the program memory to be 256 bytes less then th
*  real space in VDP when ERAM not exist.
       DCHE @VAR5,@VAR0       Not enough memory in VDP, do
*                              sequential file save
       BR   GSAVE
       DSUB 10,@VAR5        * 10 bytes for control informat
       CALL GVMOV             Enough memory in VDP, move it
*                             over and do the normal save l
**************** Without ERAM, or after GVMOV *************
**************** do the normal save           *************
VSAVZ  DST  @FREPTR,@STADDR   Store additional control info
       DDEC @STADDR           Back up some more for 2 byte
       DST  @>8370,V*STADDR   First current top of memory
       DDECT @STADDR
       DST  @STLN,V*STADDR    Then STLN
       DDECT @STADDR
       DST  @ENLN,V*STADDR    Then ENLN
       DDECT @STADDR          Then
       DST  @STLN,V*STADDR
       DXOR @ENLN,V*STADDR    STLN XORed with ENLN
       CEQ  1,V@SAPROT        Check is there PROTECTED opti
       BR   G8E91
       DNEG V*STADDR          Negate the CHECKSUM to indica
*                             LIST/EDIT protection
G8E91  DST  @STADDR,V@BUF(@PABPTR)  Save start address in P
       DDEC @STADDR
       DST  @>8370,V@RNM(@PABPTR)   Compute # of bytes used
       DSUB @STADDR,V@RNM(@PABPTR)   and store that in PAB
       CZ   @RAMTOP           If ERAM exists then
       BS   G8EAD
       DST  @BBB1,@STLN       Restore the original STLN, EN
       DST  @CCC1,@ENLN        which points to ERAM
G8EAD  CALL IOCALL            Call Device Service Routine f
       BYTE CZSAVE          * SAVE operation
LRTOPL CALL KILSYM            Release string space/symbol t
       B    TOPL15            Go back to toplevel
***********************************************************
* Open the sequential file, set the PAB
* File type             : sequential file
* Mode of operation     : output
* Data type             : internal
* Record type           : variable length records
* Logical record length : 254 maximum
GSAVE  MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB
       DECT V@FLG(@PABPTR)    Put in the correct I/O mode :
* Compute the data buffer address
       DST  @>8370,@FAC
       DSUB 253,@FAC
       DST  @FAC,V@BUF(@PABPTR)
       DST  @FAC,@EEE1     Save it for later use in GVWITE
       CALL CDSR           Call device service routine to o
       BR   ERRZ2B         Return with ERROR indication in
*                          Put 8 bytes control info at the
*                          beginning of the data buffer
       DST  >ABCD,V*FAC       >ABCD indentifies a program f
       DINCT @FAC              when doing LOAD later
       DST  @STLN,V*FAC       Save STLN in control info
       DINCT @FAC
       DST  @ENLN,V*FAC       ENLN too
       DINCT @FAC
       DST  @STLN,V*FAC
       DXOR @ENLN,V*FAC       Save the checksum
       CEQ  1,V@SAPROT        Check is there PROTECTED opti
       BR   G8EFB
       DNEG V*FAC             Negate the CHECKSUM to indica
*                              the LIST/EDIT protection
G8EFB  DINCT @FAC
       DST  @RAMTOP,V*FAC     Save the top of memory info
       ST   10,V@CNT(@PABPTR) Set the caracter count in PAB
       CALL IOCALL            Call device service routine
       BYTE CZWRIT          * With I/O opcode : write, to s
*                       the control info for the first reco
* Now start to use maximum-length record to write the file
* and each record is copied into the VDP from ERAM bofore i
* is written
       DST  @STLN,@DDD1       Starting address on ERAM
*      DST  @>8370,@EEE1      @EEE1 has been set up before
*      DST  253,@EEE1         Starting address of the data
*                              buffer on VDP
       DST  @RAMTOP,@CCC1
       DSUB @STLN,@CCC1
       DINC @CCC1
       ST   254,V@CNT(@PABPTR) Set the character count of P
G8F1C  DST  254,@FFF1         @FFF1 byte count
       XML  GVWITE            Move data from ERAM to VDP
       CALL IOCALL            Call device service routine
       BYTE CZWRIT
       DADD 254,@DDD1         Update the source addr on ERA
       DSUB 254,@CCC1         # of bytes left to move
       BS   GSAV1             No more bytes to save
       DCHE 254,@CCC1         Leave the last record alone
       BS   G8F1C
* Move the last @CCC1 bytes from ERAM to VDP
       DST  @CCC1,@FFF1       @FFF1 : Byte count
       XML  GVWITE            Write data from ERAM to VDP
       ST   @CCC1+1,V@CNT(@PABPTR) Update the character cou
*                                   in PAB
       CALL IOCALL            Call device service routine
       BYTE CZWRIT
GSAV1  CALL IOCALL
       BYTE CZCLOS          * Close the file
       BR   LRTOPL            Continue
***********************************************************
* Move the program text & line # table to VDP, and relocate
GVMOV  DST  @STLN,@BBB1       Save STLN, ENLN for later use
       DST  @ENLN,@CCC1
       DST  @STLN,@DDD1       Source addr on ERAM
       DST  @VAR5,@EEE1       Destination addr on VDP
       DST  @EEE1,@STADDR     Use later for RELOCA
       DST  @RAMTOP,@FFF1
       DSUB @STLN,@FFF1       # of bytes to move
       DINC @FFF1             @FFF1 : byte count for GVWITE
       XML  GVWITE            Move from ERAM to VDP
       DST  @RAMTOP,V@OLDTOP  Set up @RAMTOP for old top
*                             of memory
       DST  @>8370,V@NEWTOP   Set up @>8370 for new top
*                             of memory
       CALL RELOCA            Relocate the program
       DST  @STLN,@FREPTR     Set up @FREPTR
       DDEC @FREPTR
       RTN
***********************************************************
* Save the crunched form of a program into a file.
* Move the line number and text to the crunch buffer, then
* write to the file one line at a time.
***********************************************************
* Open the file with:
*  I/O opcode            : OPEN
*  File type             : SEQUENTIAL file
*  Mode of operation     : OUTPUT
*  Data type             : DISPLAY type data
*  Record type           : VARIABLE LENGTH records
*  Data buffer address   : Crunch buffer address
*  Logical record length : 163 (length of curnch buffer + 2
*                                bytes for line #) maximum
SAVMG  MOVE 9,G@PAB1,V@4(@PABPTR) Build PAB
       CALL IOCLZ1         Call the DSR routine to open fil
       DST  @ENLN,@FAC6    Start from the first line #
       DSUB 3,@FAC6        @FAC6 now points to the 1st line
*                          Write to the file from crunch bu
*                           one line at a time
G8F88  CLR  @VAR0             Make it a two byte later
       CZ   @RAMTOP           If ERAM exists then
       BS   G8FB6
       DST  @FAC6,@DDD1       Write the 4 bytes (line # and
*                              line pointer) from ERAM to
*                              crunch buffer
*                             @DDD1 : Source address on ERA
       DST  CRNBUF,@EEE1      @EEE1 : Destination address
*                                      on VDP
       DST  4,@FFF1           @FFF1 : byte count
       XML  GVWITE            Write data from ERAM to VDP
       DST  V@CRNBUF+2,@DDD1  Line pointer now points to
*                              length byte
       DDEC @DDD1             Get the length of this line
*                             @DDD1 : Source address on ERA
       DINC @FFF1             @FFF1 : Byte count, coming ba
*                                     from GVWITE above, =0
       XML  GREAD1            Read the length byte from ERA
       ST   @EEE1,@VAR0+1     @EEE1 : Destination addr on C
       DST  CRNBUF+2,@EEE1    Write the text from ERAM to 3
*                             byte of crunch buffer
*                             @EEE1 : Destination addr on V
*                             @DDD1 : Source addr on ERAM
       DINC @DDD1             Back to point to the text
       DST  @VAR0,@FFF1       @FFF1 : Byte count
       XML  GVWITE            Write data from ERAM to VDP
       BR   G8FCD             ERAM not exist : line # table
*                              and text in VDP
G8FB6  DST  V*FAC6,V@CRNBUF   PUT THE LINE # IN
       DST  V@2(@FAC6),@FAC2  Get the line pointer out
       DDEC @FAC2             Line pointer now points to th
*                              length byte
       ST   V*FAC2,@VAR0+1    Get the length out
* Move the text into the crunch buffer
       MOVE @VAR0,V@1(@FAC2),V@CRNBUF+2
G8FCD  AND  >7F,V@CRNBUF      Reset possible breakpoint
       DINCT @VAR0    * Total length=text length+line # len
       ST   @VAR0+1,V@CNT(@PABPTR) Store in the cahracter c
       CALL IOCALL            Call the device service routi
       BYTE CZWRIT          * Write
       DSUB 4,@FAC6           Go to the next line #
       DCHE @STLN,@FAC6       Finish moving all
       BS   G8F88
       DST  >FFFF,V@CRNBUF    Set up a EOF for the last rec
       ST   2,V@CNT(@PABPTR)  Only write this 2 bytes
       CALL IOCALL            Call the device service routi
       BYTE CZWRIT          * Write
       CALL IOCALL            Call the device service routi
       BYTE CZCLOS          * Close the file
       BR   LRTOPL            Go back to top level
PAB1   BYTE >00,>12,>08,>20,>A3,>00,>00,>00,>60
*           >0820 = CRNBUF
*           >A3   = 163
*           >60   = OFFSET
***********************************************************
*                   MERGE ROUTINE
* MERGE load a file which is in crunched program form into
* the CRNBUF one record (one in) at a time then take the
* line # out in FAC, text length into @CHAT, and edit it
* into the program. Identify EOF by the last record which
* is set up at SAVE time.
***********************************************************
MERGE  CALL GPNAME            Close all file, set up PAB
       CLOG >80,@FLAG         Check PROTECTION VIOLATION
       BR   ERRPV
* To fix the bug #06 in MERGE
       XML  PGMCHR            Check EOL
       CZ   @CHAT
       BR   ERRSYN            Not EOL : SYNTAX ERROR
* Open the file with
*  I/O opcode            : OPEN
*  File type             : SEQUENTIAL file
*  Mode of operation     : INPUT
*  Data type             : DISPLAY type data
*  Record type           : VARIABLE LENGTH records
*  Data buffer address   : crunch address
*  Logical record length : 163 maximum
       MOVE 9,G@PAB1,V@4(@PABPTR)  Set up PAB
       INCT V@FLG(@PABPTR)    Put in correct I/O mode : >14
       CALL IOCLZ1            Call the device service routi
*                              to open the file
       CALL IOCALL            Call the device service routi
       BYTE CZREAD          *  to read
       DCEQ >FFFF,V@CRNBUF    If 1st rec is EOF
       BS   ERRZ2B
G902A  DCLR @>83D6            Read in one line and edit it
*                              program
       ST   V@CNT(@PABPTR),@CHAT Length of this record
       DECT @CHAT             Text length = total length-2
*                                          (line # length)
*                              Put it in @CHAT for EDITLN
       DST  V@CRNBUF,@FAC     Put the line # in @FAC for ED
       CLR  @FAC12            Make it a double byte
       ST   @CHAT,@FAC13
* Move the text up 2 bytes
       MOVE @FAC12,V@CRNBUF+2,V@CRNBUF
       DST  @PABPTR,V@MRGPAB  SAVE PAB POINTER
       CALL EDITLN            EDIT IT TO THE PROGRAM
       DCLR @PABPTR           Clear temporary PAB pointer
       DEX  V@MRGPAB,@PABPTR  Restore old PAB pointer
       CALL IOCALL            CALL THE DEVICE SERVICE ROUTI
       BYTE CZREAD          *  read another record or anoth
*                              line
       DCEQ >FFFF,V@CRNBUF    End of EOF
       BR   G902A
* Double check EOF record
MERGZ1 CEQ  2,V@CNT(@PABPTR)  I/O ERROR
       BR   ERRZ2B
       CALL IOCALL            Call the device service routi
       BYTE CZCLOS          *  close the file
       BR   LRTOPL            Go back to top level
***********************************************************
*                  LIST ROUTINE
* List lists a readable copy of the current program imnage
* to the specified device. In case no device is specified,
* the listing is copied to the screen.
*  This routine uses the fact that ERRZZ returns to the
* caller if the call has been issued in EDIT which will
* reinitiate the variable stuff.
***********************************************************
LIST   CLOG >80,@FLAG         PROTECTION VILOATION ERROR  <
       BR   ERRPV                                         <
       DCLR @CURLIN           Create some kind of control <
       DCLR @CURINC            for defaults               <
       ST   MINUS,@VARC       Select "-" as separator     <
* GKXB GKLIST label
       CALL GTLIST            GKXB pick up length
* If either CURLIN or CURINC is non-zero, use it
* For zero values replace the default (ENLN-3, STLN)
       DCZ  @CURLIN
       BR   G9094
       DST  @ENLN,@DDD1       Get the first lines line #
       DSUB 3,@DDD1           DDD1 : Source address on ERAM
       CALL GRSUB3            Read the line # from ERAM/VDP
       BYTE DDD1            * @DDD1 : Source address on ERA
*                             Reset possible breakpoint too
       DST @EEE1,@CURLIN      Use standard default
       DCZ @CURINC
       BR  G9094
LISTZ0 CALL GRSUB3            Read last line # from ERAM/VD
       BYTE STLN           *  @STLN : Source address on ERA
*                             Reset possible breakpoint too
       DST  @EEE1,@CURINC     @EEE1 : Destination address o
*                             Also default for end line
* Now first evaluate what we've got in CURLIN
G9094  DCZ  @CURINC           Check for combination xxx-
       BR   G90A6
G9098  DDEC @VARW             Backup to the separation mark
       CEQ  SPACE+OFFSET,V*VARW
       BS   G9098
       CEQ  MINUS+OFFSET,V*VARW Select last
       BS   LISTZ0
G90A6  DCHE @CURLIN,@CURINC   If something like LIST 15-11
       BS   G90AE
       DST  @CURLIN,@CURINC   Replace byt LIST 15-15
G90AE  DST  @CURLIN,@FAC      Prepare for line # search
       XML  SPEED             Search the line number table
       BYTE SEETWO
       DST  @EXTRAM,@CURLIN   Get first real line # in CURL
       DST  @CURINC,@FAC
       XML  SPEED
       BYTE SEETWO          * Evaluate second line #
       CALL GRSUB3            Read 2 bytes of data from ERA
       BYTE EXTRAM          * @EXTRAM : Source addr on ERAM
*                             Reset possible breakpoint too
       DCH  @CURINC,@EEE1
       BR   G90CA
       DADD 4,@EXTRAM         Else take next lower line
G90CA  DST  @EXTRAM,@CURINC   Which could be equal to CURLI
       DST  @CURLIN,@EXTRAM   For use below by LIST
       DDEC @PGMPTR           Backup to last CHAT
       XML  PGMCHR            Retrieve last CHAT
       CZ   @CHAT             Device name available
       BS   G9132
       CALL CLSALL            Close all files that are open
       DST  VRAMVS,@VSPTR     Re-initialize the V-stack
       DST  @VSPTR,@STVSPT    And it's base
       XML  PGMCHR            Get name length in CHAT
       DST  VRAMVS+16,@PABPTR Get entrypoint in PAB
       CLR  @DSRFLG           Indicate device I/O
       MOVE 9,G@PAB,V@4(@PABPTR)
       DST  VRAMVS+16+NLEN,@CCPADR Select start address
*                                   for copy
* GKXB GTLENGTH label
       CALL GTLENG            GKXB Set length in PAB
       INC  @FAC2             Plus length byte
LISTZ1 ST   @CHAT,V*CCPADR    Copy the bytes one by one
       XML  PGMCHR            Get next character
       DINC @CCPADR           CCPADR ends up with highest a
       DEC  @FAC2             Count total # of characters
       BR   LISTZ1
       CALL IOCLZ1            Preform OPEN on DSR
       CLR  @FAC              Create double byte PAB length
       ST   V@LEN(@PABPTR),@RECLEN Get record length
       ST   @RECLEN,@FAC1     Get highest address used
       DADD @CCPADR,@FAC      Compute record length
       DST  @CCPADR,V@BUF(@PABPTR) Store it
       CZ   @RAMTOP           If ERAM exists then
       BS   G9128
       DCH  @>8370,@FAC       Compare with top of
*                    VDP : if higher then 'not enough room'
       BS   ERRIO
       BR   G912D
G9128  DCH  @STLN,@FAC        Not enough room
       BS   ERRIO
G912D  ST   1,@CCPPTR         Clear first line in output
       BR   G9138
G9132  ST   VWIDTH+3,@XPT     For common code usage
       CALL INITKB            Reset current record length
G9138  CZ   @RAMTOP           If ERAM exist then
       BS   G9140
       CALL GRMLST            Fake it : move each line to t
*                              CRUNCH buffer form ERAM
G9140  CALL LLIST             List the current line
       SCAN                   Test for a break key
       BR   LISTZ3            No key
       CEQ  BREAK,@RKEY
       BS   LISTZ4
LISTZ5 SCAN
       BR   LISTZ5
LISTZ3 CZ   @RAMTOP           If ERAM exists
       BS   G9156
       DST  @FAC14,@EXTRAM    Restore the @EXTRAM
G9156  DSUB 4,@EXTRAM         Pointer to next line
       DCH  @EXTRAM,@CURINC   Display all lines in range
       BR   G9138
LISTZ4 CZ   @DSRFLG           Device I/O -> output last rec
       BR   G916D
       CALL OUTREC            Output the last record
       CALL IOCALL            Close the device properly
       BYTE CZCLOS
       B    TOPL10
G916D  B    TOPL15            Restart the variable too
* PAB image used in LIST function
PAB    BYTE 0,>12,0,0,0,0,0,0,OFFSET
* Move each line in ERAM to CRNBUF area, put line number in
* (CRNBUF), put CRNBUF+4 in (CRNBUF+2) which is the line
* pointer field, put the text itself from ERAM to (CRNBUF+4
* before call LLIST, trick it by moving CRNBUF to @EXTRAM
GRMLST CALL GRSUB3            Get line # from ERAM(use GREA
       BYTE EXTRAM          * @EXTRAM : Source address on E
*                             Reset possible breakpoint too
       DST  @EEE1,V@CRNBUF    Put it in CRNBUF
       DST  CRNBUF+4,V@CRNBUF+2 Put CRNBUF+4 into
*                              the line pointer field
       DINCT @DDD1            Get the pointer to the text
*                              from GRAM
       CALL GRSUB4            Read the line pointer in (use
*                              GREAD1)
       DDEC @EEE1             Get the ptr to the length byt
       CALL GRSUB2            Read th length from ERAM, use
       BYTE EEE1           *   GREAD1, @EEE1 : Source addre
*                               on ERAM
       ST   @EEE1,@FFF1+1     Use the length as byte count
*                             to move the text from ERAM to
*                             VDP CRNBUF+4 area
       DST  CRNBUF+4,@EEE1    EEE1 : Destination address on
       DINC @DDD1             DDD1 : Source address on ERAM
       XML  GVWITE            Move data from ERAM to VDP
       DST  @EXTRAM,@FAC14    Save for later use
       DST  CRNBUF,@EXTRAM    Fake it
       RTN
* SUBROUTINE TO READ 2 BYTES OF DATA FROM ERAM OR VDP WITH
* THE OPTION TO RESET THE POSSIBLE BREAKPOINT
GRSUB2 FETCH @FFF1            Fetch the source address on
       DST  *FFF1,@DDD1        ERAM or VDP
 
*                             @DDD1 : Source addr  on ERAM
*                             or VDP
GRSUB4 CZ   @RAMTOP           If ERAM exists
       BS   G91B7
       DST  2,@FFF1           @FFF1 : Byte count
       XML  GREAD1            Read data from ERAM to CPU
       BR   G91BB
G91B7  DST  V*DDD1,@EEE1      Read data from VDP to CPU
G91BB  RTN
GRSUB3 FETCH @FFF1            Fetch the source addr on ERAM
       DST  *FFF1,@DDD1        or VDP
*                             @DDD1 : Source addr on ERAM/V
       CALL GRSUB4            Do the actual read
       DAND >7FFF,@EEE1       Reset possible breakpoint
       RTN
*********** REC ROUTINE ***********************************
* REC(X) returns the current record to which file X is
*  positioned.
SUBREC DST  @PABPTR,@ARG      Save the current PAB & set ne
       CALL SUBEOF            Try to find the correct PAB
       DEX  @PABPTR,@ARG      @ARG : new PAB
*                             @PABPTR : restore current PAB
       BR   EOFZ2             Didn't find the corresponding
       DST  V@RNM(@ARG),@FAC  Obtain integer record number
       XML  CIF               Convert integer to floating
       XML  CONT               and continue
***********************************************************
*                         EOF ROUTINE
* EOF(X) returns status codes on file X. The meaning of the
* result codes is:
*           -1  Physical End Of File
*            0  Not at End Of File yet
*            1  Logical End Of File
***********************************************************
EOF    DST  @PABPTR,@ARG      Save the current PAB and set
*                              the new one in SUBEOF
       CALL SUBEOF            Try to find the PAB somewhere
       BR   ERRFE             Can't file
       ST   CZSTAT,@ARG2      Select status code without
       EX   @ARG2,V@COD(@PABPTR) destorying original code
       CALL IOCLZ1            Get the info from DSR
       DEX  @ARG,@PABPTR      Restore original PAB and orig
       ST   @ARG2,V@COD(@ARG)  I/O code
       ST   V@SCR(@ARG),@ARG2 And pick up STATUS
       MOVE 8,G@FLOAT1,@FAC   Get floating 1
       CLOG 3,@ARG2           Test EOF bits
       BS   EOFZ2             No EOF indication
       CLOG 2,@ARG2           Physical EOF
       BS   G9210
       DNEG @FAC              Make result -1
G9210  XML  CONT
EOFZ2  DCLR @FAC              Create result 0
       XML  CONT
FLOAT1 BYTE >40,1,0,0,0,0,0,0   * Floating point -1
SUBEOF CEQ  LPARZ,@CHAT       * SYNTAX ERROR
       BR   ERRSYN
       XML  PARSE             Parse up to the matching ")"
       BYTE >FF
       CALL CHKCNV            Convert and search for PAB
       BS   ERRBV             Avoid 0's and negatives bad v
       ST   @DSRFLG,@ARG6     @DSRFLG got changed in CHKCON
       CALL CHKCON            Check and search tiven filenu
       ST   @ARG6,@DSRFLG     @DSRFLG to changed CHKCON
       RTNC                   Condition set : file # exists
***********************************************************
*      LOAD / SAVE / MERGE UTILITY ROUTINE
* GPNAME gets program name from OLD and SAVE
* Can also be used for future implementation of REPLACE
* statement. Also gives valuable contribution to updating
* of program pointers (VSPTR, STVSPT, FLAG, etc...) and
* creation of LOAD/SAVE PAB
***********************************************************
GPNAME AND  >80,@FLAG         Avoid returns from ERRZZ rout
       CEQ  STRINZ,@CHAT
       BS   G9242
       CEQ  NUMZ,@CHAT        * SYNTAX ERROR
       BR   ERRSYN
G9242  CALL CLSALL            First close all open files
       CALL KILSYM            Kill the symbol table
       DST  VRAMVS+8,@PABPTR  Create PAB as low as possible
       CLR  V*PABPTR          Clear PAB with ripple-move
       MOVE PABLEN-5,V*PABPTR,V@1(@PABPTR)
       XML  PGMCHR            Get length of file-specificat
       DSUB 4,@PABPTR         Make it a regular PAB
       ST   @CHAT,V@NLEN(@PABPTR) Copy name length to PAB
       DST  V@NLEN-1(@PABPTR),@STADDR Avoid problems(bugs!)
       CZ   @RAMFLG           If ERAM not exist or imperati
       BR   G9275
       MOVE @STADDR,V*PGMPTR,V@NLEN+1(@PABPTR)
       BR   G9284
G9275  DST  @STADDR,@FFF1     @FFF1 : Byte count
       DST  @PGMPTR,@DDD1     Source address on ERAM
       DST  @PABPTR,@EEE1
       DADD NLEN+1,@EEE1      Destination address on VDP
       XML  GVWITE            Write from ERAM to VDP
G9284  DADD @STADDR,@PGMPTR   Skip the string
* OLD and SAVE can only be imperative
       CLR  @DATA             Clear DATA line
       RTN                    That's all folks
***********************************************************
*           READ / INPUT UTILITY ROUTINES
***********************************************************
GETVAR DST  @PGMPTR,@STADDR   Save token pointer to first c
       CLR  @VAR5             Clear # of parsed variables
       DST  @VSPTR,@VAR4      Save first entry in V-stack
* Start parse cycle for IMPUT statement
GETVZ0 CHE  >80,@CHAT         Make sure of varialbe name
       BS   ERRSYN
       XML  SYM               Get correct symbol table entr
       CLR  @VAR6             Start with zero paren nesting
GETVZ1 CEQ  LPARZ,@CHAT       Increment counter for "("
       BR   G92A2
       INC  @VAR6
G92A2  CZ   @VAR6             Watch out for final balance
       BS   G92B6
       CALL CHKEND            Check for unbalenced parenthe
       BS   ERRSYN            Somebody forgot something!!!!
       CEQ  RPARZ,@CHAT       Decrement for ")"
       BR   G92B2
       DEC  @VAR6
G92B2  XML  PGMCHR            Get character following last
       BR   GETVZ1
G92B6  XML  VPUSH             Push entry to V-stack
       INC  @VAR5             Count all pushed variables
       CALL CHKEND            Next should either be EOS or
       BS   GETVZ2            Found it EOS!!!!
       XML  SPEED             Must be at a
       BYTE SYNCHK          *  comma else
       BYTE COMMAZ          *   its an error
       CALL CHKEND            Check for end of statement
       BR   GETVZ0            Haven't found it yet
       CZ   @DSRFLG           Error for keyboard I/O
       BR   ERRSYN
GETVZ2 RTN
* Create a temporary string in memory. BYTES contains the l
CTSTR  DST  >6500,@FAC2       Indicate string in FAC
CTSTR0 DST  @BYTES,@FAC6      Copy string length in FAC6
       XML  GETSTR            Reserve the string
       DST  @SREF,@FAC4       Copy start address of string
       DST  >001C,@FAC        And indicate temp. string >00
       RTN
* Create a temporary string from TEMP5. Length is given
* in BYTES.
CTMPST CALL CTSTR             Create the temporary string
       CZ   @FAC7
       BS   G92EB
       MOVE @BYTES,V*TEMP5,V*SREF
G92EB  RTN                    Non-empty
* CHKNUM - Check for numeric argument
CHKNUM CEQ  NUMZ,@VAR0+1
       BR   G9303
       CALL GETRAM            Get string length
       DST  @DATA,@FAC12      Store entry for conversion
       CLR  @VAR0             Prepare for double action
       DADD @VAR0,@DATA       Get end of data field
       CALL CONVER            Convert data to FAC #
* Conversion should also end at end of field
       DCEQ @DATA,V@CSNTMP    Set COND according to equalit
G9303  RTNC                   Back to caller
GETGFL ST   @RAMTOP,@FAC3     Select target memory
GETDAT CZ   @FAC3             Get everything from RAM
       BR   G9314
GETRAM ST   V*DATA,@VAR0+1    Get data in VAR0+1
       CLR  @FAC3             Be sure FAC3 = 0 !!!!
       BR   G9320
G9314  DST  1,@FFF1           FFF1 : byte count
       DST  @DATA,@DDD1       DDD1 : source addr on ERAM
       XML  GREAD1            Read data from ERAM
       ST   @EEE1,@VAR0+1     EEE1 : Destination addr on CP
G9320  DINC @DATA             Go to next datum for next tim
       RTN
CHKSTR DCLR @FAC6             Assume we'll have an empty st
       CEQ  STRINZ,@VAR0+1
       BS   CHKSZ0
       CEQ  NUMZ,@VAR0+1      See ............
       BR   EMPSTR
CHKSZ0 CALL GETDAT            Next datum is length byte
       CLR  @FAC6             Be sure high byte = 0 !!!!
       ST   @VAR0+1,@FAC7     Prepare FAC for string assign
       DST  @DATA,@TEMP5      Save string addr for assignme
       DADD @FAC6,@DATA       Update DATA for end of field
       RTN
* Empty strings are handled below
EMPSTR CEQ  COMMAZ,@VAR0+1
       BS   G9348
       CALL DATEND            Check for end of data stateme
       BR   RTC               Return with COND if not EOS
G9348  DDEC @DATA             Backup data pointer for empti
       RTN
DATEND EX   @VAR0+1,@CHAT
       CALL CHKEND            Check for EOS (=EOL or "::")
       EX   @VAR0+1,@CHAT     Restore original situation
       RTNC
***********************************************************
*           OPEN / CLOSE / RESTORE UTILITY ROUTNE
* CHKFN - Check for token = "#" and collect and check
* filenumber. Also convert filenumber to (two byte) integer
* and check for range 0<x<256
***********************************************************
CHKFN  XML  SPEED             Must be at a
       BYTE SYNCHK         *   '#' else
       BYTE NUMBEZ         *    its an error
       XML  PARSE             Parse argument up to ":"
       BYTE COLONZ
* Code to check for negative or zero result in floating poi
* accumilator. If not... convert to integer and return two
* byte integer in FAC
CHKCNV CEQ  STRVAL,@FAC2      String/number mismatch
       BS   ERRSNM
       CLR  @FAC10            Clear error-code byte
       XML  CFI               Convert to two byte integer
       CZ   @FAC10            BAD VALUE ERROR
       BR   ERRBV
       CLOG >80,@FAC          Negative result
       BR   RTC
       DCZ  @FAC              And return with COND set/rese
       RTNC
CHKCON ST   @FAC1,@FNUM       Move result into FNUM
* Check for high byte not zero (>0255)
       CZ   @FAC              Bad value error
       BR   ERRBV
* Search routine - Search for a given file number in the
* chain of allocated PABs.
* IOSTRT contains the start of the PAB - chain
       DST  @IOSTRT,@PABPTR   Get first link in the chain
* Check for last PAB in the chain and exit if found
CHKFZ1 DCZ  @PABPTR           Check if file # is correct
       BS   G938F
       CEQ  @FNUM,V@FIL(@PABPTR)
       BS   RTC
       DST  V*PABPTR,@PABPTR  Try the next PAB
       BR   CHKFZ1
RTC    CEQ  @>8300,@>8300     Force COND to "SET"
G938F  RTNC                   Exit with no COND change
***********************************************************
* OUTEOF outputs the last record if this record is
* non-empty, and if the PAB is open for non-imput mode
* (UPDATE, APPEND or OUTPUT).
***********************************************************
OUTEOF CLR  @DSRFLG
       CEQ  CZWRIT,V@COD(@PABPTR) Non-input mode
       BR   G93A5
       CZ   V@OFS(@PABPTR)    Non-empty record
       BS   G93A5
       CALL PRINIT            Initiate for output
       CALL OUTREC            Output and remove pending con
G93A5  RTN                    Return to whoever called
***********************************************************
* DELPAB routine - delete a given PAB from chain under the
* assumption that the PAB exists
***********************************************************
* First compute start and end address for block move
DELPAB DST  V@BUF(@PABPTR),@STADDR Get lowest used address
       DDEC @STADDR           Make that an addr following P
       CLR  @CCPADR           Get highest addr in CCPADR (2
       ST   V@NLEN(@PABPTR),@CCPADR+1 complete the two byte
       ADD  PABLEN-1,@CCPADR+1 Add PAB length-1
       DADD @PABPTR,@CCPADR   Compute actual addr within RA
       DCEQ @PABPTR,@IOSTRT   Watch out for first PAB
       BS   G93E6
       DST  @IOSTRT,@MNUM     Figure out where link to PAB
G93C2  DCEQ @PABPTR,V*MNUM    Continue while not found
       BS   G93CE
       DST  V*MNUM,@MNUM      Defer to next link in chain
       BR   G93C2             Short end for code-savings
G93CE  DST  V*PABPTR,V*MNUM   Copy link over deleted PAB
       DCZ  V*MNUM            Adjust link only if not done
       BS   G93E0
       DADD @CCPADR,V*MNUM    Add deleted # of bytes for
       DSUB @STADDR,V*MNUM     link correction
G93E0  DST  V*MNUM,@PABPTR    Get new PABPTR
       BR   G93F7
G93E6  DST  V*PABPTR,@IOSTRT  Update first link
       DCZ  @IOSTRT           Only adjust if not last link
       BS   G93F4
       DADD @CCPADR,@IOSTRT   Add deleted # of bytes
       DSUB @STADDR,@IOSTRT
G93F4  DST  @IOSTRT,@PABPTR   Get new PABPTR
* Move the bytes below the deleted block up in memory. This
* includes both variables and PABs
G93F7  DST  @STADDR,@MNUM     Get # of bytes to move
       DSUB @FREPTR,@MNUM
       DST  @CCPADR,@CCPPTR   Save destination address
G9400  DCZ  @MNUM
       BS   G9411
       ST   V*STADDR,V*CCPADR Move byte by byte
       DDEC @STADDR           Update source
       DDEC @CCPADR            and destination pointers
       DDEC @MNUM             Also update counter value
       BR   G9400
G9411  DSUB @STADDR,@CCPADR   Compute # of bytes of old PAB
       DCZ  @PABPTR           Avoid trouble with last PAB
       BS   G9431
G9418  DCZ  V*PABPTR          Ad infinitum (or fundum)
       BS   G942C
       DADD @CCPADR,V*PABPTR  Adjust link to next PAB
       DADD @CCPADR,V@BUF(@PABPTR) Update the buffer link
       DST  V*PABPTR,@PABPTR  Get next link in chain
       BR   G9418
G942C  DADD @CCPADR,V@BUF(@PABPTR) Update buffer link
* Adjust symbol table links
G9431  DCZ  @SYMTAB
       BS   G94B4
       DCGE @CCPPTR,@SYMTAB   Only update lower links
       BS   G94B4
       DADD @CCPADR,@SYMTAB   Get symbol table pointer back
       DST  @SYMTAB,@PABPTR   Get pointer for update
DELPZ1 CZ   @RAMTOP
       BR   DELPZ2
       DCGE @STLN,V@4(@PABPTR) If imperative
       BS   G9451
DELPZ2 DADD @CCPADR,V@4(@PABPTR) Adjust name pointer
G9451  CGE  0,V*PABPTR        If string-fix breakpoints
       BS   G949B
       ST   >07,@FAC          Mask to get # of dims
       AND  V*PABPTR,@FAC     Get # of dims
       DST  @PABPTR,@FAC2     Pointer to 1st dim max
       DADD 6,@FAC2            or string pointer
       DST  1,@FAC6           Number of pointers to change
       CLR  @FAC4             For 2 byte use of option base
G946B  CZ   @FAC              While more dimendions
       BS   G9483
       ST   1,@FAC5           Assume option base 0
       SUB  @BASE,@FAC5       But correct if base 1
       DADD V*FAC2,@FAC4      Get dim maximum
       DMUL @FAC6,@FAC4       Multiply it in
       DEC  @FAC              Next dim
       DINCT @FAC2
       B    G946B
* FAC2 now points at the 1st string pointer
* FAC6 contains the # of pointers that need to be changed
G9483  DCZ  @FAC6             While pointers to cheange
       BS   G949B
       DST  V*FAC2,@FAC       Get pointer to string
       DCZ  @FAC              If sting is non-null
       BS   G9495
       DST  @FAC2,V@-3(@FAC)  Fix backpointer
G9495  DINCT @FAC2            Point to next pointer
       DDEC @FAC6             One less pointer to change
       BR   G9483
G949B  DCZ  V@2(@PABPTR)
       BS   G94B4
       DCGE @CCPPTR,V@2(@PABPTR)
       BS   G94B4
       DADD @CCPADR,V@2(@PABPTR) Adjust next value link
       DST  V@2(@PABPTR),@PABPTR Next entry
       BR   DELPZ1
G94B4  DADD @CCPADR,@FREPTR   Update free word pointer
       RTN
***********************************************************
* CNVDEF - Convert to 2 byte integer and default to 1 on
*          negative or 0 ....
***********************************************************
CNVDEF CALL CHKCNV            Check and convert
       BR   CNVDZ0
       DST  1,@FAC            Default to 1 or minus and 0
CNVDZ0 RTN                    And return without COND set
***********************************************************
* PARREC parses a possible REC clause in INPUT, PRINT or
* RESTORE. In case a comma is detected without a REC clause
* following it, the COND is set upon return. In case a REC
* clause is specified for a file opened for SEQUENTIAL
* access, a * FILE ERROR is given.
***********************************************************
PARREC CEQ  COMMAZ,@CHAT      Only check if we have a ","
       BR   G94EE
       XML  PGMCHR            Check next token for REC
       CEQ  RECZ,@CHAT        May be USING clause
       BR   RTC
       CLOG 1,V@FLG(@PABPTR)
       BS   ERRFE
       XML  PGMCHR            Get first character of expres
       CALL OUTEOF            Output possible pending outpu
       CLR  V@OFS(@PABPTR)    Clear record offset
       XML  PARSE             Translate the expression in R
       BYTE COLONZ
       CALL CHKCNV            Check numeric and convert to
       CGE  0,@FAC             2 byte integer, Bad Value
       BR   ERRBV
       DST  @FAC,V@RNM(@PABPTR) Store actual record number
G94EE  RTN
***********************************************************
*              DISPLAY / ACCEPT UTILITIES
***********************************************************
DISACC CALL INITKB            PABPTR is used as flag (no DS
DISPZ1 CEQ  ERASEZ,@CHAT      Check for ERASE ALL
       BR   G9518
       CLOG 1,@PABPTR          already used once
       BR   ERRSYN
       XML  PGMCHR            Check next token for ALL
       XML  SPEED
       BYTE SYNCHK          *  has to be ALL
       BYTE ALLZ
       ALL  BKGD+OFFSET       Clear screen to background co
       ST   3,@XPT            Reset pending output pointer
       CLOG 4,@PABPTR         Didn't use AT yet
       BR   G9513
       ST   1,@CCPPTR         Reset column pointer
       DST  SCRNBS+2,@CCPADR   and screen base address
G9513  OR   1,@PABPTR         Set "ERASE USED" flag
       BR   DISPZ1            Try next token
G9518  CEQ  BEEPZ,@CHAT        delay action for BEEP
       BR   G9529
       CLOG 2,@PABPTR         Use it only once
       BR   ERRSYN
       OR   2,@PABPTR         No syntax error detected here
       XML  PGMCHR            Evaluate next token
       BR   DISPZ1            Get set for second pass
G9529  CEQ  ATZ,@CHAT         Generate "AT" clause
       BR   G9571
       CLOG 4,@PABPTR         Second usage not
       BR   ERRSYN
       XML  PGMCHR             allowed....
       XML  SPEED
       BYTE SYNCHK          * Skip left parenthesis
       BYTE LPARZ
       XML  PARSE             Now parse any expression
       BYTE COMMAZ
       XML  SPEED
       BYTE SYNCHK          * Check for "," and skip it
       BYTE COMMAZ
       CALL CNVDEF            Convert to 2 byte numeric
       ST   24,@FAC2          Convert modulo 24 (# screen l
       CALL COMMOD            Compute remainder
       DEC  @FAC1             Convert back to 0 (range was
       MUL  32,@FAC1          Convert to line base address
       DST  @FAC1,@CCPADR     And repalce CCPADR
       XML  PARSE             Parse column expression
       BYTE RPARZ
       XML  SPEED
       BYTE SYNCHK          * Check for ")" at end
       BYTE RPARZ
       CALL CNVDEF            Again convert to two byte int
       ST   VWIDTH,@FAC2      Convert modulo video width
       CALL COMMOD            Compute remainder
       ST   @FAC1,@CCPPTR     Select current column
       DADD @FAC,@CCPADR      Compute full address
       DINC @CCPADR           Adjust for column 0 (offset-1
       OR   4,@PABPTR         Set "AT-CLAUSE" used flag
       OR   32,@PABPTR        Set "NON-STANDARD SCREEN ADDR
       BR   DISPZ1            Continue for next item
G9571  CEQ  SIZEZ,@CHAT       "SIZE" clause
       BR   G95A0
       CLOG 8,@PABPTR         Only use once
       BR   ERRSYN
       XML  PGMCHR            Get character following the S
       CEQ  LPARZ,@CHAT        has to open "("
       BR   ERRSYN
       XML  PARSE             And close again ")"
       BYTE VALIDZ
       CGE  0,@FAC            Change to positive argument
       BS   G958F
       DNEG @FAC              For ACCEPT statement with siz
       OR   >80,@PABPTR        indicate in highest bit
G958F  CALL CHKCNV
       BS   ERRBV             * BAD VALUE
       CZ   @FAC              Also for args >255 (less then
       BR   ERRBV
       ST   @FAC1,@PABPTR+1   Copy to PABPTR (always used)
       OR   8,@PABPTR         Prevent further use
       BR   DISPZ1             and go on
G95A0  CEQ  VALIDZ,@CHAT      Exclude VALIDATE option
       BS   G95B9
* Start evaluating ERASE clause here
       CLOG 8,@PABPTR
       BS   CHKEND
       CALL SIZE1             Evaluate field defined in SIZ
* If it's no DISPLAY keyword ( AT, SIZE, BEEP or USING) it
* has to be a print separator or colon ":"
* If anything is specified is has to be a colon or end of
* line... for end-of-line output current record
* Check for end of statement
CHKEND CLOG >80,@CHAT
       BS   G95B7
       CHE  TREMZ+1,@CHAT
       BR   RTC
G95B7  CZ   @CHAT             Set COND according to CHAT
G95B9  RTNC
***********************************************************
* NXTCHR - Get next program character - skip all strings,
*          numerics and line references...
***********************************************************
NXTCHR CALL CHKEND            Check for end of statements
       BS   RTC               Avoid end of statement
       CEQ  STRINZ,@CHAT      Skip all strings
       BS   NXTCZ0
       CEQ  NUMZ,@CHAT         and numerics/unquoted string
       BR   G95D5
NXTCZ0 XML  PGMCHR            Get string length
       ST   @CHAT,@FAC1       Make that a double please...
       CLR  @FAC              Hic.... Oops, sorry
       DADD @FAC,@PGMPTR      Back to the serious stuff
       BR   G95DC
G95D5  CEQ  LNZ,@CHAT         Line # = skip 2 tokens
       BR   G95DC
       DINCT @PGMPTR          <----------- That's the skip
G95DC  XML   PGMCHR           Get the next token
       RTN
***********************************************************
*                 PRINT / DISPLAY UTILITES
* Use the parameters specified in SIZE for further
* evaluation of the limited field length
***********************************************************
SIZE1  CLOG 4,@PABPTR         Not "AT" clause used
       BR   G95FC
       CEQ  1,@CCPPTR         Might have to print current
       BS   G95FC
       ST   @CCPPTR,@FAC      Compute final position after
       ADD  @PABPTR+1,@FAC     in FAC and compare with reco
       DEC  @FAC
       CH   @RECLEN,@FAC      Size clause too long
       BR   G95FC
* We can't get here for AT( , ) output, since right margin
* limited there
       CALL OUTREC            Advance to next line
       CALL SCRO              Scroll the screeen
G95FC  SUB  @CCPPTR,@RECLEN   Limit field size to available
       INC  @RECLEN            space... including current p
       CH   @PABPTR+1,@RECLEN
       BR   INITZ1
       ST   @PABPTR+1,@RECLEN Only accept if available
       BR   INITZ1            Reinitialize CCPPTR
* Copy (converted) numerical datum in string
RSTRING ST  @FAC12,@BYTES+1   Get actual string length
       CLR  @BYTES            Create double byte value
       CALL CTSTR             Create a temporary string
       MOVE @BYTES,*FAC11,V*SREF Copy value string
       RTN
* COMMOD - Compute FAC module FAC2
COMMOD DIV  @FAC2,@FAC        Compute remainder
       CZ   @FAC1             Avoid zero remainders
       BR   G9624
       ST   @FAC2,@FAC1       Assume maximum remainder
G9624  CLR  @FAC              Clear upper byte
       RTN
* TSTSEP tests for separator in print and branches to the
* correct evaluation routine.
* If no separator is found, simple return.
* Test case end of line
TSTSEP CALL CHKEND
       BR   TSTSZ0
       DST  EOLEX,*SUBSTK     Replace return address with E
TSTSZ0 CHE  COMMAZ,@CHAT
       BR   TSTSZ1
       CH   COLONZ,@CHAT
       BS   TSTSZ1
       DST  PRSEM,*SUBSTK     Expect it to be a ";"
       CALL TSTINT            Test for INTERNAL files
       BR   TSTSZ1            Treat all separators as ";"
       CEQ  COMMAZ,@CHAT
       BR   G964F
       DST  PRTCOM,*SUBSTK
G964F  CEQ  COLONZ,@CHAT
       BR   TSTSZ1
       DST  PRCOL,*SUBSTK
TSTSZ1 RTN
* PARFN - Parse string expression and create PAB automatica
*         continue in CSTRIN for copy string to PAB
* Exit on non-string values
*
* First evaluate string expression
PARFN  XML  PARSE             Parse up to next comma    <<<
       BYTE COMMAZ          *                           <<<
       CEQ  STRVAL,@FAC2      Check for "STRING"        <<<
       BR   ERRSNM
       DST  @FAC6,@MNUM       Copy length byte in MNUM
       ADD  PABLEN,@MNUM+1    Account for PAB length+contro
       XML  VPUSH             Save start of string somewher
       DST  @MNUM,@FAC        Setup for MEMCHK - check for
       XML  MEMCHK             memory overflow
       BS   ERRMEM            * MEMORY FULL
       XML  VPOP              Restore all FAC information a
       DSUB @MNUM,@FREPTR     Update free word pointer
       DST  @FREPTR,@PABPTR   Assign PAB entry address
       DINC @PABPTR           Correct for byte within PAB
       CLR  V*PABPTR          Clear PAB plus control info
       MOVE PABLEN-1,V*PABPTR,V@1(@PABPTR)  Ripple byte
       ST   @MNUM+1,V@OFS(@PABPTR) Save length of PAB
       ST   @FAC7,@MNUM       Compute # of bytes in name
       ST   @FAC7,V@NLEN(@PABPTR) Store name length
       ST   @FNUM,V@FIL(@PABPTR) Copy file number in PAB
       DST  @PABPTR,@CCPADR   Get start addr for string des
       DADD NLEN+1,@CCPADR    Add offset to actual start ad
* TRICKY - OPTFLG also results offset added in CSTRIN
       CLR  @OPTFLG           Clear all option flags
       XML  IO                CSTRIN I/O UTILITY
       BYTE CSTRIN
       RTN
***********************************************************
*                      OUTREC
* OUTREC and INITRC are used to output a record to either
* screen or external I/O devices, and to initiate pointers
* for further I/O.
***********************************************************
OUTREC ST   @RECLEN,@MNUM+1   Compute number of characters
       INC  @MNUM+1            positions we should fill
       CZ   @DSRFLG           Screen I/O
       BS   G96D3
       XML  IO                Fill the remainder of the rec
       BYTE FILSPC          *  with appropriate fillers
       CLOG 8,@PABPTR           block output on size
       BR   RTC
       CLOG 4,@PABPTR         "AT CLAUSE USED"
       BS   SCRO
* Next test for xing the end of screen
       DADD 4,@CCPADR
       CHE  3,@CCPADR
       BR   INITZ1
       DST  2,@CCPADR         Restart at upper left hand
*                              corner of screen
INITZ1 ST   1,@CCPPTR         Reset current column pointer
       RTN
SCRO   XML  SCROLL            Scroll the screen one line
       ST   1,@CCPPTR         Reinitialize CCPPTR
       BR   INTKB0             and reinitialize
* This is also entry for last record output
G96D3  CLOG >10,V@FLG(@PABPTR) FIXED records
       BR   G96E2
       ST   @RECLEN,@MNUM+1   Ready for space filling
       INC  @MNUM+1           Move to first position outsid
*                              record
       XML  IO                And do it up to end of record
       BYTE FILSPC
G96E2  DEC  @CCPPTR           Update last character positio
       ST   @CCPPTR,V@CNT(@PABPTR) Store # of characters
       CLR  V@OFS(@PABPTR)    Undo pending record offsets
       CALL IOCALL            Call DSR
       BYTE CZWRIT          *  for WRITE mode
       CLR  @CCPADR+1         Get address at buffer start
       BR   PRZZ0
* PRINIT initializes the variable CCPADR, CCPPTR, RECLEN an
* DSRFLG, for a given PABPTR.
PRINIT CLR  @DSRFLG           Indicate external I/O in DSRF
       ST   V@LEN(@PABPTR),@RECLEN  Pick up record length
       ST   V@OFS(@PABPTR),@CCPADR+1 Get offset in record
PRZZ0  ST   @CCPADR+1,@CCPPTR  Compute columnar position
       INC  @CCPPTR           And convert from offset
       CLR  @CCPADR           Clear upper byte
       DADD V@BUF(@PABPTR),@CCPADR Compute actual address
       RTN
***********************************************************
* OSTRNG - Copy the value of the string expression to the
*          screen.
***********************************************************
OSTRNG ST   @FAC7,@BYTES      Pick up the string length
G9711  CZ   @BYTES            Output as many records as req
       BS   G973E
* CHKREC check available space in current record.
* If the string to be output is too long, it is chuncked up
* into digestable pieces. If the current record is partly
* filled up, it is output before any chuncking is done.
CHKREC ST   @CCPPTR,@MNUM+1   Use MNUM for current offset i
CHKRZ0 ST   @RECLEN,@MNUM     Compute remaining area
       SUB  @CCPPTR,@MNUM      between column and end
       INC  @MNUM             Also count current column
       CHE  @BYTES,@MNUM      Won't fit in current record
       BS   G9730
       CEQ  1,@MNUM+1         Unused record
       BS   CHKRZ1
       CALL OUTREC            Output whatever we have
       BR   CHKREC            And try again
       RTN
G9730  ST   @BYTES,@MNUM      Use actual count if fit
CHKRZ1 SUB  @MNUM,@BYTES      Update remaining chars count
       ADD  @MNUM,@CCPPTR     Also new column pointer
       XML  IO                Copy string to output
       BYTE CSTRIN
       BR   G9711             Continue as long as needed
G973E  RTN
***********************************************************
* INITKB - Initialize the variable needed for keyboard outp
***********************************************************
INITKB CLR  @PABPTR           Don't use any DISPLAY options
       ST   OFFSET,@DSRFLG    Load for correction of screen
       ST   1,@CCPPTR         Assume un-initialized XPT
       CH   2,@XPT            * Patch for un-initialized XP
       BR   G9751
       ST   @XPT,@CCPPTR      Initialize CCPPTR
       DECT @CCPPTR           Correct for incorrect XPT off
G9751  ST   VWIDTH,@RECLEN    Get video screen width
INTKB0 ST   @CCPPTR,@CCPADR+1 Initialize screen address
       CLR  @CCPADR           Clear upper byte CCPADR
       DADD SCRNBS+1,@CCPADR  Add start-addr plus comenstat
       RTN
IOCALL FETCH @FAC12           I/O code to FAC12 (BUG!!!)
       ST   @FAC12,V@COD(@PABPTR) Pick up the I/O code
IOCLZ1 CALL CDSR              Call the DSR routine
       BR   ERRZ2             Give I/O error on error
       RTN                    Or else return
* DSR CALL ROUTINE - NORMAL ENTRY
CDSR   ST   OFFSET,V@SCR(@PABPTR)   Always set screen offse
       MOVE 30,@FAC,V@>03C0   Save FAC area
       DST  @PABPTR,@FAC12    Get PAB pointer in FAC
       DADD NLEN,@FAC12       Get PAB pointer in FAC
       AND  >1F,V@FLG(@PABPTR) Clear error bits for ON ERRO
*                       time, I/O process can still be
*                        continued
       CALL CALDSR            Call actual DSR link routine
       BYTE 8
       MOVE 30,V@>03C0,@FAC
* MOVE does not affect status
       BS   CDSRZ0            ERROR = ERROR = ERROR
       CLOG >E0,V@FLG(@PABPTR) Set COND if no error
CDSRZ0 RTNC
* ERROR MESSAGES
ERRZ2B CALL CLRFRE            Undo allocation of PAB
* First check is it error coming from AUTOLD
* If it is then do not print the error messege and
*  go back to TOPL02
ERRZ2  MOVE 2,G@TOPL02,V@AUTTMP
       DCEQ V@AUTTMP,@RSTK+2
       BR   G97A9
       ST   RSTK+2,@SUBSTK
       RTN
***********************************************************
* Next code is to avoid recursion of errors in CLSALL
* routine. If this entry is taken from CLSALL, the stack
* will contain CLSLBL as a retrun address in the third leve
***********************************************************
G97A9  SUB  4,@SUBSTK
       DCEQ CLSLBL,*SUBSTK
       BR   G97B8
WRNIO  CALL WARNZZ            Give warning to the user
       BYTE 35                * I/O ERROR but warning
       RTN                    And return to close routine
G97B8  ADD  4,@SUBSTK         Back up two levels for OLD/SA
ERRIO  CALL ERRZZ
       BYTE 36                * I/O ERROR
* ERROR messages called in this file
ERRSNM CALL ERRZZ
       BYTE 7                 * STRING-NUMBER MISMATCH
ERRIM  CALL ERRZZ
       BYTE 10                * IMAGE ERROR
ERRMEM CALL ERRZZ
       BYTE 11                * MEMORY FULL
ERRBV  CALL ERRZZ
       BYTE 30                * BAD VALUE
ERRINP CALL ERRZZ
       BYTE 32                * INPUT ERROR
ERRDAT CALL ERRZZ
       BYTE 33                * DATA ERROR
ERRFE  CALL ERRZZ
       BYTE 34                * FILE ERROR
ERRPV  CALL ERRZZ
       BYTE 39                * PROTECTION VIOLATION
ERRMUV CALL ERRZZ
       BYTE 9                 * IMPROPERLY USED NAME
* Other errors called in file
* ERRSYN    * SYNTAX ERROR                        BYTE  3
* ERRST     * STRING TRUNCATED ERROR              BYTE 19
* WRNNPP    * NO PROGRAM PRESENT                  BYTE 29
* WRNINP    * INPUT ERROR            (WARNING)    BYTE 32
* ERRIO     * I/O ERROR                           BYTE 36
* WRNIO     * I/O ERROR              (WARNING)    BYTE 36
* WRNSNM    * STRING NO. MISMATCH    (WARNING)    BYTE  7
***********************************************************
* The following section has been added to fix bugs in INPUT
* ACCEPT, and LINPUT statements.
***********************************************************
BUG01  CHE  >80,@CHAT         Make sure of variable name
       BS   ERRSYN
       XML  SYM               Get the information of the
       XML  SMB                variable.
       RTN
***********************************************************
* GKXB CODE HERE
GTLENG ST   @CHAT,@FAC+2      Moved from LIST routine
       ST   @XSTLN,V@8(@PABPTR) Store length
       RTN                       and return
***********************************************************
        AORG >1800
***********************************************************
ALCEND  DATA >205A,>24F4,>4000,>AA55
        DATA >2038,>2096,>2038,>217E
        DATA >2038,>21E2,>2038,>234C
        DATA >2038,>2432,>2038,>246E
        DATA >2038,>2484,>2038,>2490
        DATA >2038,>249E,>2038,>24AA
        DATA >2038,>24B8,>2038,>2090
        DATA >0000,>0000,>0000,>0000
        DATA >0000,>0000,>0000,>0000
        DATA >0000,>0000,>0000,>0000
        DATA >0000,>0000,>0000,>0000
        DATA >6520,>C060,>2004,>0281
        DATA >4000,>130E,>C001,>0202
        DATA >834A,>8CB0,>1606,>8CB0
        DATA >1604,>8CB0,>1602,>C030
        DATA >0450,>0221,>0008,>10EF
        DATA >0200,>2500,>C800,>8322
        DATA >02E0,>83E0,>0460,>00CE
        DATA >C81D,>8322,>10F9,>C01D
        DATA >C06D,>0002,>06A0,>20DC
        DATA >C0C1,>0603,>0223,>8300
        DATA >D0D3,>1361,>0983,>0643
        DATA >1612,>C000,>165C,>C0C5
        DATA >05C3,>06A0,>2406,>1653
        DATA >05C3,>06A0,>23CA,>0204
        DATA >834A,>0202,>0008,>DC74
        DATA >0602,>15FD,>0380,>06A0
        DATA >20F8,>10F5,>C041,>1347
        DATA >0A81,>9060,>8312,>1143
        DATA >0981,>C141,>0A35,>0225
        DATA >0008,>A160,>8310,>045B
        DATA >C24B,>0643,>1634,>C0C5
        DATA >06A0,>23CA,>C0C1,>06A0
        DATA >2406,>112D,>06A0,>211C
        DATA >06A0,>23CA,>6004,>0A30
        DATA >A040,>0459,>C28B,>0A51
        DATA >09D1,>C201,>D120,>8343
        DATA >0984,>1303,>0600,>1123
        DATA >0580,>0206,>0001,>C0C5
        DATA >0223,>0004,>06A0,>23CA
        DATA >C0C1,>0643,>05C3,>06A0
        DATA >23CA,>0581,>6044,>3981
        DATA >C186,>1611,>C187,>0608
        DATA >15F5,>0606,>A184,>8180
        DATA >150A,>05C3,>045A,>0200
        DATA >0700,>0460,>2084,>0200
        DATA >1C00,>0460,>2084,>0200
        DATA >1400,>0460,>2084,>C01D
        DATA >C06D,>0002,>06A0,>20DC
        DATA >C0C1,>0603,>0223,>8300
        DATA >D0D3,>0983,>160E,>C000
        DATA >1622,>0202,>0008,>0204
        DATA >834A,>C0C5,>06A0,>23CA
        DATA >CD01,>05C3,>0642,>15FA
        DATA >0380,>0643,>160F,>C000
        DATA >1612,>C0C5,>05C3,>06A0
        DATA >2406,>160B,>05C3,>06A0
        DATA >23CA,>C101,>0201,>834A
        DATA >0460,>20CA,>06A0,>20F8
        DATA >10F8,>0460,>2166,>0460
        DATA >216E,>C81D,>2038,>C82D
        DATA >0002,>83E2,>C82D,>0004
        DATA >2044,>02E0,>83E0,>C80B
        DATA >2040,>C020,>2044,>06A0
        DATA >20DC,>C0C1,>0603,>0223
        DATA >8300,>D0D3,>0983,>0603
        DATA >1332,>0643,>164A,>C2A0
        DATA >2038,>162D,>C0C5,>05C3
        DATA >06A0,>2406,>9801,>2058
        DATA >1620,>0206,>0008,>0204
        DATA >834A,>C0C5,>06A0,>23CA
        DATA >CD01,>05C3,>0646,>15FA
        DATA >06A0,>22DA,>0225,>0004
        DATA >C105,>C046,>06A0,>23E6
        DATA >05C4,>D050,>0981,>06A0
        DATA >23E6,>C2E0,>2040,>C820
        DATA >203E,>830C,>02E0,>2038
        DATA >0380,>0200,>0700,>C2E0
        DATA >2040,>0460,>2084,>0200
        DATA >1C00,>0460,>226E,>C08B
        DATA >0643,>16F3,>C0C5,>06A0
        DATA >23CA,>C0C1,>06A0,>2406
        DATA >1102,>0460,>226A,>C020
        DATA >2038,>06A0,>211C,>6004
        DATA >0A10,>A0C0,>06A0,>23CA
        DATA >0452,>06A0,>227E,>0206
        DATA >834A,>CD83,>DDA0,>2058
        DATA >DD84,>CD81,>C0C1,>1602
        DATA >04D6,>1005,>0603,>06A0
        DATA >2406,>0981,>C581,>C020
        DATA >2044,>06A0,>22DA,>0460
        DATA >225A,>C80B,>203A,>C805
        DATA >203C,>C2E0,>601E,>069B
        DATA >C020,>2044,>C160,>203C
        DATA >D190,>0986,>C820,>830C
        DATA >203E,>C806,>830C,>C806
        DATA >8350,>C2E0,>6012,>069B
        DATA >C020,>2044,>0206,>834A
        DATA >0204,>001C,>CD84,>DDA0
        DATA >2058,>DD84,>C5A0,>831C
        DATA >C0A0,>830C,>1309,>C116
        DATA >C0C0,>0583,>D073,>06A0
        DATA >241A,>0584,>0602,>15FA
        DATA >C2E0,>6028,>069B,>C020
        DATA >2044,>C160,>203C,>C2E0
        DATA >203A,>045B,>C01D,>C06D
        DATA >0002,>06A0,>20DC,>C0C1
        DATA >0603,>0223,>8300,>D0D3
        DATA >0983,>0603,>1302,>0643
        DATA >1623,>C000,>1628,>C02D
        DATA >0004,>C0C5,>05C3,>06A0
        DATA >2406,>9801,>2058,>161D
        DATA >05C3,>06A0,>23CA,>C041
        DATA >1307,>C181,>0601,>C0C1
        DATA >06A0,>2406,>9050,>1A15
        DATA >DC01,>1309,>C0C6,>0981
        DATA >C141,>06A0,>2406,>DC01
        DATA >0583,>0605,>15FA,>0380
        DATA >06A0,>227E,>C02D,>0004
        DATA >10E6,>0460,>2166,>0460
        DATA >216E,>0200,>1300,>0460
        DATA >2084,>06C3,>D803,>8C02
        DATA >06C3,>D803,>8C02,>1000
        DATA >D060,>8800,>06C1,>D060
        DATA >8800,>06C1,>045B,>06C4
        DATA >D804,>8C02,>06C4,>0264
        DATA >4000,>D804,>8C02,>1000
        DATA >D801,>8C00,>06C1,>D801
        DATA >8C00,>06C1,>045B,>06C3
        DATA >D803,>8C02,>06C3,>D803
        DATA >8C02,>1000,>D060,>8800
        DATA >045B,>06C4,>D804,>8C02
        DATA >06C4,>0264,>4000,>D804
        DATA >8C02,>1000,>D801,>8C00
        DATA >045B,>C83E,>83E2,>02E0
        DATA >83E0,>C80B,>204E,>C081
        DATA >0281,>0040,>1B0A,>C0A1
        DATA >6010,>0281,>0004,>1605
        DATA >C0A2,>0002,>0692,>2466
        DATA >1001,>0692,>02E0,>2038
        DATA >C80B,>83F6,>0380,>0200
        DATA >0B00,>0460,>2084,>02E0
        DATA >83E0,>C80B,>204E,>06A0
        DATA >000E,>02E0,>2038,>C80B
        DATA >83F6,>0380,>06A0,>24CA
        DATA >D82D,>0002,>8C00,>0380
        DATA >06A0,>24CA,>D831,>8C00
        DATA >0602,>16FC,>0380,>06A0
        DATA >24D0,>DB60,>8800,>0002
        DATA >0380,>06A0,>24D0,>DC60
        DATA >8800,>0602,>16FC,>0380
        DATA >C05D,>D82D,>0001,>8C02
        DATA >0261,>8000,>D801,>8C02
        DATA >0380,>0201,>4000,>1001
        DATA >04C1,>C09D,>D820,>203D
        DATA >8C02,>E081,>D802,>8C02
        DATA >C06D,>0002,>C0AD,>0004
        DATA >045B
***********************************************************
CHARS  BYTE >00,>00,>00,>00,>00,>00,>00    *      32
       BYTE >20,>20,>20,>20,>20,>00,>20    *      33
       BYTE >50,>50,>50,>00,>00,>00,>00    *      34
       BYTE >50,>50,>F8,>50,>F8,>50,>50    *      35
       BYTE >20,>78,>A0,>70,>28,>F0,>20    *      36
       BYTE >C0,>C8,>10,>20,>40,>98,>18    *      37
       BYTE >40,>A0,>A0,>40,>A8,>90,>68    *      38
       BYTE >C0,>40,>80,>00,>00,>00,>00    *      39
       BYTE >08,>10,>20,>20,>20,>10,>08    *      40
       BYTE >80,>40,>20,>20,>20,>40,>80    *      41
       BYTE >20,>A8,>70,>D8,>70,>A8,>20    *      42
       BYTE >00,>20,>20,>F8,>20,>20,>00    *      43
       BYTE >00,>00,>00,>00,>60,>20,>40    *      44
       BYTE >00,>00,>00,>F8,>00,>00,>00    *      45
       BYTE >00,>00,>00,>00,>00,>60,>60    *      46
       BYTE >00,>08,>10,>20,>40,>80,>00    *      47
       BYTE >70,>88,>98,>A8,>C8,>88,>70    *      48
       BYTE >20,>60,>20,>20,>20,>20,>70    *      49
       BYTE >70,>88,>08,>30,>40,>80,>F8    *      50
       BYTE >70,>88,>08,>30,>08,>88,>70    *      51
       BYTE >10,>30,>50,>90,>F8,>10,>10    *      52
       BYTE >F0,>80,>80,>F0,>08,>88,>70    *      53
       BYTE >70,>80,>80,>F0,>88,>88,>70    *      54
       BYTE >F8,>08,>10,>20,>40,>40,>40    *      55
       BYTE >70,>88,>88,>70,>88,>88,>70    *      56
       BYTE >70,>88,>88,>78,>08,>88,>70    *      57
       BYTE >00,>60,>60,>00,>60,>60,>00    *      58
       BYTE >00,>60,>60,>00,>60,>20,>40    *      59
       BYTE >08,>10,>20,>40,>20,>10,>08    *      60
       BYTE >00,>00,>F8,>00,>F8,>00,>00    *      61
       BYTE >80,>40,>20,>10,>20,>40,>80    *      62
       BYTE >70,>88,>10,>20,>20,>00,>20    *      63
       BYTE >70,>88,>08,>68,>A8,>A8,>58    *      64
       BYTE >70,>88,>88,>F8,>88,>88,>88    *      65
       BYTE >F0,>48,>48,>70,>48,>48,>F0    *      66
       BYTE >70,>88,>80,>80,>80,>88,>70    *      67
       BYTE >F0,>48,>48,>48,>48,>48,>F0    *      68
       BYTE >F8,>80,>80,>F0,>80,>80,>F8    *      69
       BYTE >F8,>80,>80,>F0,>80,>80,>80    *      70
       BYTE >70,>88,>80,>80,>98,>88,>78    *      71
       BYTE >88,>88,>88,>F8,>88,>88,>88    *      72
       BYTE >F8,>20,>20,>20,>20,>20,>F8    *      73
       BYTE >08,>08,>08,>08,>08,>88,>70    *      74
       BYTE >88,>90,>A0,>C0,>A0,>90,>88    *      75
       BYTE >80,>80,>80,>80,>80,>80,>F8    *      76
       BYTE >88,>D8,>A8,>A8,>88,>88,>88    *      77
       BYTE >88,>88,>C8,>A8,>98,>88,>88    *      78
       BYTE >70,>88,>88,>88,>88,>88,>70    *      79
       BYTE >F0,>88,>88,>88,>F0,>80,>80    *      80
       BYTE >70,>88,>88,>88,>A8,>90,>68    *      81
       BYTE >F0,>88,>88,>F0,>A0,>90,>88    *      82
       BYTE >70,>88,>80,>70,>08,>88,>70    *      83
       BYTE >F8,>20,>20,>20,>20,>20,>20    *      84
       BYTE >88,>88,>88,>88,>88,>88,>70    *      85
       BYTE >88,>88,>88,>88,>88,>50,>20    *      86
       BYTE >88,>88,>88,>88,>A8,>A8,>50    *      87
       BYTE >88,>88,>50,>20,>50,>88,>88    *      88
       BYTE >88,>88,>88,>50,>20,>20,>20    *      89
       BYTE >F8,>08,>10,>20,>40,>80,>F8    *      90
       BYTE >78,>40,>40,>40,>40,>40,>78    *      91
       BYTE >00,>80,>40,>20,>10,>08,>00    *      92
       BYTE >F0,>10,>10,>10,>10,>10,>F0    *      93
       BYTE >20,>50,>88,>00,>00,>00,>00    *      94
       BYTE >00,>00,>00,>00,>00,>00,>FF    *      95
       BYTE >18,>10,>08,>00,>00,>00,>00    *      96
       BYTE >00,>00,>60,>10,>70,>90,>68    *      97
       BYTE >00,>40,>40,>70,>48,>48,>B0    *      98
       BYTE >00,>00,>60,>90,>80,>90,>60    *      99
       BYTE >00,>10,>10,>70,>90,>90,>68    *     100
       BYTE >00,>00,>60,>90,>E0,>80,>70    *     101
       BYTE >00,>30,>40,>E0,>40,>40,>40    *     102
       BYTE >00,>00,>70,>90,>70,>10,>60    *     103
       BYTE >00,>80,>80,>E0,>90,>90,>90    *     104
       BYTE >00,>20,>00,>20,>20,>20,>70    *     105
       BYTE >00,>10,>00,>10,>10,>90,>60    *     106
       BYTE >00,>80,>90,>A0,>C0,>A0,>90    *     107
       BYTE >00,>60,>20,>20,>20,>20,>70    *     108
       BYTE >00,>00,>D0,>A8,>A8,>A8,>A8    *     109
       BYTE >00,>00,>B0,>48,>48,>48,>48    *     110
       BYTE >00,>00,>60,>90,>90,>90,>60    *     111
       BYTE >00,>00,>F0,>48,>48,>70,>40    *     112
       BYTE >00,>00,>78,>90,>90,>70,>10    *     113
       BYTE >00,>00,>B0,>C8,>80,>80,>80    *     114
       BYTE >00,>00,>70,>80,>70,>08,>F0    *     115
       BYTE >00,>40,>E0,>40,>40,>50,>20    *     116
       BYTE >00,>00,>90,>90,>90,>90,>68    *     117
       BYTE >00,>00,>88,>88,>88,>50,>20    *     118
       BYTE >00,>00,>88,>88,>A8,>A8,>50    *     119
       BYTE >00,>00,>88,>50,>20,>50,>88    *     120
       BYTE >00,>00,>48,>48,>38,>08,>70    *     121
       BYTE >00,>00,>F8,>10,>20,>40,>F8    *     122
       BYTE >18,>20,>20,>40,>20,>20,>18    *     123
       BYTE >20,>20,>20,>00,>20,>20,>20    *     124
       BYTE >C0,>20,>20,>10,>20,>20,>C0    *     125
       BYTE >00,>00,>40,>A8,>10,>00,>00    *     126
       BYTE >00,>00,>00,>00,>00,>00,>00    *     127
       BYTE >00,>00,>00,>00,>00,>00,>00    *     128
***********************************************************
       END
 

Spoiler

***********************************************************
       TITL 'MYXB5'
***********************************************************
       GROM >A000
***********************************************************
       TITL 'EQUATES EXEC-359'
***********************************************************
*           GROM ADDRESSES
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS
CHRTBL EQU  >6018             RXB CALL CHRTBL load char set
TOPLEV EQU  >6372             RXB CALL USER branch
SZNEW  EQU  >63A5             RXB CALL NEW branch
TOPL15 EQU  >63DD             RXB CALL USER branch
SZSIZE EQU  >65C9             RXB CALL SIZE branch
CLSALL EQU  >8012             RXB branch
GE025  EQU  >E025             RXB branch EA module
SPRINT EQU  >6016             Initialize sprites
TOPL10 EQU  >601A             Return to main and re-init
CHRTAB EQU  >601C             Load default character set
SZRUN  EQU  >601E
KILSYM EQU  >6022             KILL SYMBOL TABLE ROUTINE
AUTO1  EQU  >602E             Get arguments for LIST comman
TOPL02 EQU  >6030             RTN address for failing AUTOL
EDITLN EQU  >6032             Edit a line into the program
GRSUB1 EQU  >6034             Read data (2 bytes) from ERAM
GWSUB  EQU  >6036             Write a few bytes of data to
MSGBRK EQU  >6048             * BREAKPOINT
MSGTA  EQU  >6053             Message "try again"
CHKEND EQU  >6A78             Check end of statement
DISO   EQU  >6A7C
ENTER  EQU  >6A7E
ENT09  EQU  >6A80
WARNZZ EQU  >6A82             WARNING MESSAGE ROUTINE
ERRZZ  EQU  >6A84             ERROR MESSAGE ROUTINE
ERRZ   EQU  >6A84             ERRor routine
READL1 EQU  >6A86             Read a line from keyboard
DISPL1 EQU  >8000
DELET  EQU  >8002
PRINT  EQU  >8004
INPUT  EQU  >8006
OPEN   EQU  >8008
CLOSE  EQU  >800A
RESTOR EQU  >800C
NREAD  EQU  >800E
EOF    EQU  >801C
ACCEPT EQU  >801E
SRDATA EQU  >8020
REC    EQU  >8022
GRSUB2 EQU  >802C
GRSUB3 EQU  >802E
LINPUT EQU  >8030
GRINT  EQU  >0022             Greatest integer
***********************************************************
*    Equates for XMLs
SYNCHK EQU  >00               SYNCHK XML selector
FILSPC EQU  >01               Fill-space utility
PARCOM EQU  >01               PARse to a COMma selector
CSTRIN EQU  >02               Copy-string utility
RANGE  EQU  >02               RANGE selector
SEETWO EQU  >03               SEETWO XML selector
FADD   EQU  >06               Floating ADD
FMUL   EQU  >08               Floating MULtiply
FDIV   EQU  >09               Floating DIVide
FCOMP  EQU  >0A               Floating COMPare
SADD   EQU  >0B               Stack ADD
SSUB   EQU  >0C               Stack SUBtract
CSNUM  EQU  >10               Convert String to Number
CFI    EQU  >12               Convert to two byte integer
FLTINT EQU  >12               Convert floating to integer
COMPCT EQU  >70               PREFORM A GARBAGE COLLECTION
GETSTR EQU  >71               SYSTEM GET STRING
MEMCHK EQU  >72               MEMORY check routine: VDP
CNS    EQU  >73               Convert number to string
* Warning Defualt changfd in >0079
PARSE  EQU  >74               Parse a value
CONT   EQU  >75               Continue parsing
EXECG  EQU  >76               Execute a XB stmt or program
VPUSH  EQU  >77               Push on value stack
VPOP   EQU  >78               Pop off value stack
PGMCHR EQU  >79               GET PROGRAM CHARACTER
SYM    EQU  >7A               Find SYMBOL entry
SMB    EQU  >7B               Find symbol table entry
ASSGNV EQU  >7C               Assign VARIABLE
SCHSYM EQU  >7D               Search symbol table
SPEED  EQU  >7E               SPEED UP XML
CRUNCH EQU  >7F               Crunch an input line
CIF    EQU  >80               Convert INTEGER to FLOATING P
RTNB   EQU  >82               Return
SCROLL EQU  >83               SCROLL THE SCREEN
IO     EQU  >84               IO utility (KW table search)
GREAD  EQU  >85               READ DATA FROM ERAM
GWRITE EQU  >86               WRITE DATA TO ERAM
DELREP EQU  >87               REMOVE CONTENT FROM VDP/ERAM
MVDN   EQU  >88               MOVE DATA IN VDP/ERAM
MVUP   EQU  >89               MOVE DATA IN VDP/ERAM
VGWITE EQU  >8A               MOVE DATA FROM VDP TO ERAM
GVWITE EQU  >8B               WRITE DATA FROM GRAM TO VRAM
GREAD1 EQU  >8C               READ DATA FROM ERAM
GDTECT EQU  >8E               ERAM DETECT&ROM PAGE 1 ENABLE
SCNSMT EQU  >8F               SCAN STATEMENT FOR PRESCAN
***********************************************************
*    Temporary workspaces in EDIT
VAR0   EQU  >8300            TEMPORARY
SP00   EQU  >8300            SPRITE value
PTFBSL EQU  >8300            Ptr to 1st byte in SPEAK list
PHLEN  EQU  >8300            PHrom data LENgth
VARV   EQU  >8301            TEMPORARY
PHRADD EQU  >8301            PHRom ADDress
ACCUM  EQU  >8302            # OF BYTES ACCUMULATOR (4 BYTE
STPT   EQU  >8302            TWO BYTES
MNUM   EQU  >8302            Ussually a counter
AAA1   EQU  >8302
SP02   EQU  >8302            SPRITE value
PTLBSL EQU  >8302            Ptr to last byte in SPEAK list
VARY   EQU  >8304
PABPTR EQU  >8304            Pointer to current PAB
SP04   EQU  >8304            SPRITE value
PTEBSL EQU  >8304            Ptr to end byte in SPEAK list
* NOTE: PTEBSL points to the end of the temporary speak lis
*       whereas PTLBSL points to the last byte actually use
*       i.e.    PTFBSL <= PTLBSL <= PTEBSL
VARY2  EQU  >8306            Use in MVDN only
DFLTLM EQU  >8306            Default array limit (10)
CCPPTR EQU  >8306            OFFSET WITHIN RECORED (1)
*                             or Pointer to current column
SP06   EQU  >8306            SPRITE value
PTFCIS EQU  >8306            Ptr to 1st character in string
RECLEN EQU  >8307            LENGTH OF CURRENT RECORD (1)
CCPADR EQU  >8308            RAM address of current refs
*                             or Actual buffer address or c
VARC   EQU  >8308
CCPADD EQU  >8308            RAM address of current color
CCC1   EQU  >8308
SPSAL  EQU  >8308            Location of sprite attribute l
PTCCIS EQU  >8308            Ptr to current character in st
CALIST EQU  >830A            Call list for resolving refs
RAMPTR EQU  >830A            Pointer for crunching
STADDR EQU  >830A            Start address - usually for co
SPTMP  EQU  >830A            Temporary variable
PTLCIS EQU  >830A            Ptr to last character in strin
VAR2   EQU  >830B
BYTES  EQU  >830C            BYTE COUNTER
*                             or String length for GETSTR
NMPTR  EQU  >830C            Pointer save for pscan
BBB1   EQU  >830C
PTFCIP EQU  >830C            Ptr to 1st character in phrase
CHSAV  EQU  >830E
CURINC EQU  >830E            Increment for auto-num mode
VAR4   EQU  >830E
PTCCIP EQU  >830E            Ptr to current character in ph
TOPSTK EQU  >8310            Top of data stack pointer
VAR5   EQU  >8310            VAR5 through VAR5+3 used in RA
PTLCIP EQU  >8310            Ptr to last character in phras
VAR6   EQU  >8311
LINUM  EQU  >8312            Used to determine end of scan
PTFBPH EQU  >8312            Ptr to 1st byte in PHrom
VAR7   EQU  >8312            Used in CHARLY
STRPTR EQU  >8312            RXB PATCH CODE
NMLEN  EQU  >8314            Current line for auto-num
CURLIN EQU  >8314            Current line for auto-num
*                             or Starting line number for L
PTCCPH EQU  >8314            Ptr to current byte in PHrom
VAR9   EQU  >8314             Used in CHARLY
XFLAG  EQU  >8316            SCAN FLAG-BITS USED AS BELOW
PTLCPH EQU  >8316            Ptr to last byte in PHrom
DSRFLG EQU  >8317            INTERNAL =60, EXTERNAL =0 (1)
OPTFLG EQU  >8317            Option flag byte during OPEN
FORNET EQU  >8317            Nesting level of for/next
FNUM   EQU  >8317            Current file number for search
***********************************************************
*    Permanent workspace variables
STRSP  EQU  >8318            String space begining
STREND EQU  >831A            String space ending
SREF   EQU  >831C            Temporary string pointer
SMTSRT EQU  >831E            Start of current statement
VARW   EQU  >8320            Screen address (CURSOR)
ERRCOD EQU  >8322            Return error code from ALC
STVSPT EQU  >8324            Value-stack base
RTNG   EQU  >8326            Return vector from 9900 code
NUDTAB EQU  >8328            Start of NUD table
VARA   EQU  >832A            Ending display location
PGMPTR EQU  >832C            Program text pointer (TOKEN)
EXTRAM EQU  >832E            Line number table pointer
STLN   EQU  >8330            Start of line number table
ENLN   EQU  >8332            End of line number table
DATA   EQU  >8334            Data pointer for READ
LNBUF  EQU  >8336            Line table pointer for READ
INTRIN EQU  >8338            Add of intrinsic poly constant
SUBTAB EQU  >833A            Subprogram symbol table
IOSTRT EQU  >833C            PAB list/Start of I/O chain
SYMTAB EQU  >833E            Symbol table pointer
FREPTR EQU  >8340            Free space pointer
CHAT   EQU  >8342            Current charater/token
BASE   EQU  >8343            OPTION BASE value
PRGFLG EQU  >8344            Program/imperative flag
FLAG   EQU  >8345            General 8-bit flag
BUFLEV EQU  >8346            Crunch-buffer destruction leve
LSUBP  EQU  >8348            Last subprogram block on stack
* FAC  EQU  >834A            Floating-point ACcurmulator
CCHAR  EQU  >834A            Current character
FAC1   EQU  FAC+1
SPLFLG EQU  >834B            SPelL out phrase FLaG
FAC2   EQU  FAC+2
AAA    EQU  FAC+2
TOTTIM EQU  >834C            TOTal wait TIMe
* NOTE: DATAD must follow immediately after TOTTIM. The
*       routine STDATA is counting on this fact!
FAC3   EQU  FAC+3
DATAAD EQU  >834D            Speech DATA ADdress
FAC4   EQU  FAC+4
CCC    EQU  FAC+4
FFF    EQU  FAC+4
FAC5   EQU  FAC+5
PTLCIL EQU  >834F            Pointer To Last Character In L
FAC6   EQU  FAC+6
BBB    EQU  FAC+6
EEE    EQU  FAC+6
FAC7   EQU  FAC+7
TIMLEN EQU  >8351             TIMe LENgth of timing charact
FAC8   EQU  FAC+8
PHADDR EQU  >8352             PHrom ADDRess
FAC9   EQU  FAC+9
FAC10  EQU  FAC+10
DDD1   EQU  FAC+10
TEMP1  EQU  >8354            TEMPorary CPU location 1
FAC11  EQU  FAC+11
FAC12  EQU  FAC+12
FFF1   EQU  FAC+12
TEMP2  EQU  >8356            TEMPorary CPU location 2
FAC13  EQU  FAC+13
FAC14  EQU  FAC+14
EEE1   EQU  FAC+14
READ   EQU  >8358            Address of speech peripheral
*                             READ byte interface
FAC15  EQU  FAC+15
FAC16  EQU  FAC+16
WRITE  EQU  >835A            Address of speech peripheral
*                             WRITE byte interface
FAC17  EQU  FAC+17
* ARG  EQU  >835C            Floating-point ARGument
ARG1   EQU  ARG+1
PHDATA EQU  >835D            PHrom DATA
ARG2   EQU  ARG+2
PTCBED EQU  >835E            Ptr To Current Byte Ext Data
ARG3   EQU  ARG+3
ARG4   EQU  ARG+4
LENCST EQU  >8360            LEN of Current ext data STring
ARG5   EQU  ARG+5
ARG6   EQU  ARG+6
LENWST EQU  >8362            LEN of Whole ext data STring
ARG7   EQU  ARG+7
ARG8   EQU  ARG+8
STRLEN EQU  >8364            STRing LENgth
TEMP4  EQU  >8364
TEMP5  EQU  >8366
* NOTE: BYTE1, BYTE2, and BYTE3 must be in consecutive memo
*       locations, and in the following order for SPGET to
*       work!
BYTE1  EQU  >8366            BYTE 1
BYTE2  EQU  >8367            BYTE 2
BYTE3  EQU  >8368            BYTE 3
TEMP6  EQU  >8368
SPKSTS EQU  >8369            SPeaK StaTus
* FPERAD EQU  >836C          Value stack pointer
ARG11  EQU  ARG+11
ARG15  EQU  ARG+15
ARG16  EQU  ARG+16
* VSPTR  EQU  >836E          Value stack pointer
***********************************************************
*    GPL Status Block
* SUBSTK EQU  >8373           SUBROUTINE STACK
KEYBD  EQU  >8374             KEYBOARD SELCTION
RKEY   EQU  >8375             KEY CODE
EXPZ   EQU  >8376             Exponent in floating-point
JOYY   EQU  >8376             JOYSTICK Y POSITION
JOYX   EQU  >8377             JOYSTICK X POSITION
RANDOM EQU  >8378             RANDOM NUMBER GENERATOR
TIMER  EQU  >8379             TIMING REGISTER
MOTION EQU  >837A             NUMBER OF MOVING SPRITES
VDPSTS EQU  >837B             VDP STATUS REGISTER
VDPSTT EQU  >837B             VDP STATUS REGISTER
ERCODE EQU  >837C             STATUS REGISTER
CB     EQU  >837D             Character Buffer
***********************************************************
RAMTOP EQU  >8384            Highest address in ERAM
RAMFRE EQU  >8386            Free pointer in the ERAM
RSTK   EQU  >8388            Subroutine stack base
*                             (Starts at >8A)
RAMFLG EQU  >8389            ERAM flag
GRAMFL EQU  >8389            GRAM / VDP flag
STKMIN EQU  >83AF            Base of data stack
STKMAX EQU  >83BD            Top of data stack
PRTNFN EQU  >83CE            Sound - previous tone finished
***********************************************************
*    VDP addresses
SCRNBS EQU  >02E0             Screen base addr for last lin
NLNADD EQU  >02E2             New LiNe ADDress
ENDSCR EQU  >02FE             END of SCReen address
SPRSAL EQU  >0300             Sprite attribute list
START  EQU  >0372             Line to start execution at
* Temporary
NOTONE EQU  >0374             NO-TONE for SIZE in ACCEPT us
*                              in FLMGRS (4 bytes used)
SYMBOL EQU  >0376             Saved symbol table pointer
ONECHR EQU  >0378             Used for CHRZ
VRMSND EQU  >0379             Sound blocks
SPGMPT EQU  >0382             Saved PGMPTR for continue
SBUFLV EQU  >0384             Saved BUFLEV for contiue
SEXTRM EQU  >0386             Saved EXTRAM for continue
SAVEVP EQU  >0388             Saved VSPRT for continue
ERRLN  EQU  >038A             On-error line pointer
CSNTMP EQU  >0390             Use as temporary stored place
*                          or CSN TEMPORARY FOR FAC12
TABSAV EQU  >0392             Saved main symbol table ponte
AUTTMP EQU  >0394             AUTOLD TEMPORARY IN SIDE ERRZ
SLSUBP EQU  >0396             Saved LSUBP for continue
SFLAG  EQU  >0398             Saved on-warning/break bits
SSTEMP EQU  >039A             To save subprogram program ta
SSTMP2 EQU  >039C             Same as above. Used in SUBPRO
MRGPAB EQU  >039E             MERGEd temporary for pab ptr
RNDX2  EQU  >03A0             Random number generator seed
RNDX1  EQU  >03A5             Random number generator seed
INPUTP EQU  >03AA             INPUT TEMPORARY FOR PTR TO PR
SPNUM  EQU  >03AA             Sprite number temporary, also
*                              in INPUTP in FLMGR
ACCVRW EQU  >03AC             Temoporary used in ERRZZ, als
*                              used in FLMGRS
*                             or temporary for @VARW, @VARA
ACCVRA EQU  >03AE             TRY AGAIN
VALIDP EQU  >03B0             Use as two values passing fro
*                          or PTR TO STANDARD STRING IN VAL
VALIDL EQU  >03B2             VALIDATE code to READL1
*                          or Length of string in validate
SIZCCP EQU  >03B4             SIZE TEMPORARY FOR CCPADR
SIZREC EQU  >03B6             SIZE TEMPORARY FOR RECLEN
*
ACCTRY EQU  >03B7             ACCEPT "TRY AGAIN" FLAG
SIZXPT EQU  >03B8             Save XPT in SIZE when "try ag
CSNTP1 EQU  >03BA             CSN TEMPORARY FOR FAC10
*
OLDTOP EQU  >03BC             Temporary used in ERRZZ, also
*                          or Old top of memory for RELOCA
CPTEMP EQU  >03BC             CCPPTR, RECLEN temp in INPUT
NEWTOP EQU  >03BE             New top of memory for RELOCA
VROAZ  EQU  >03C0             Temporary roll-out area
SPRVB  EQU  >07FF             Sprite velocity block.
CRNBUF EQU  >0820             CRuNch BUFfer address
CRNEND EQU  >08BE             CRuNch buffer END
VRAMVS EQU  >0958             Default base of value stack
***********************************************************
*    IMMEDITATE VALUES
NUMBR  EQU  >00               NUMERIC validate
LISTZ  EQU  >02
X2     EQU  >03
OLDZ   EQU  >05
RESEQZ EQU  >06
SAVEZ  EQU  >07
MERGEZ EQU  >08
DWNARR EQU  >0A
UPARR  EQU  >0B
CHRTN  EQU  >0D
BKGD   EQU  >20               BACKGROUND CHARACTER
OFFSET EQU  >60               OFFSET FOR VIDEO TABLES
STRVAL EQU  >65               Value in accum. is string val
***********************************************************
* Editting command equates & keys or symbols
BREAK  EQU  >02               Break key
DLETE  EQU  >03               Delete key
INSRT  EQU  >04               Insert key
RECALL EQU  >06               Edit-buffer recall
CLRLN  EQU  >07               Clear-line key
BACK   EQU  >08               Back-space key
FORW   EQU  >09               Forward-space key
DOWN   EQU  >0A               Down-arrow key
UPMV   EQU  >0B               Up-arrow key
VWIDTH EQU  >1C               Screen width (PRINT)
SPACE  EQU  >20               Space key
QUOTE  EQU  >22               "
NUMBER EQU  >23               #
DOLLAR EQU  >24               $
CURSOR EQU  >1E+OFFSET        CURSOR
EDGECH EQU  >1F+OFFSET        EDGE character
PLUS   EQU  >2B               +
COMMAT EQU  >2C               ,
MINUS  EQU  >2D               -
HYPEN  EQU  >2D               +
PERIOD EQU  >2E               .
ZERO   EQU  >30               0
NINE   EQU  >39               9
COLON  EQU  >3A               :
SEMICO EQU  >3B               ;
LESS   EQU  >3C               <
GREAT  EQU  >3E               >
A      EQU  >41               A
F      EQU  >46               F
***********************************************************
*    BASIC TOKEN TABLE
*      EQU  >80               spare token
ELSEZ  EQU  >81               ELSE
SSEPZ  EQU  >82               ::
TREMZ  EQU  >83               $
IFZ    EQU  >84               IF
GOZ    EQU  >85               GO
GOTOZ  EQU  >86               GOTO
GOSUBZ EQU  >87               GOSUB
RETURZ EQU  >88               RETURN
DEFZ   EQU  >89               DEF
DIMZ   EQU  >8A               DIM
ENDZ   EQU  >8B               END
FORZ   EQU  >8C               FOR
LETZ   EQU  >8D               LET
BREAKZ EQU  >8E               BREAK
UNBREZ EQU  >8F               UNBREAK
TRACEZ EQU  >90               TRACE
UNTRAZ EQU  >91               UNTRACE
INPUTZ EQU  >92               INPUT
DATAZ  EQU  >93               DATA
RESTOZ EQU  >94               RESTORE
RANDOZ EQU  >95               RANDOMIZE
NEXTZ  EQU  >96               NEXT
READZ  EQU  >97               READ
STOPZ  EQU  >98               STOP
DELETZ EQU  >99               DELETE
REMZ   EQU  >9A               REM
ONZ    EQU  >9B               ON
PRINTZ EQU  >9C               PRINT
CALLZ  EQU  >9D               CALL
OPTIOZ EQU  >9E               OPTION
OPENZ  EQU  >9F               OPEN
CLOSEZ EQU  >A0               CLOSE
SUBZ   EQU  >A1               SUB
DISPLZ EQU  >A2               DISPLAY
IMAGEZ EQU  >A3               IMAGE
ACCEPZ EQU  >A4               ACCEPT
ERRORZ EQU  >A5               ERROR
WARNZ  EQU  >A6               WARNING
SUBXTZ EQU  >A7               SUBEXIT
SUBNDZ EQU  >A8               SUBEND
RUNZ   EQU  >A9               RUN
LINPUZ EQU  >AA               LINPUT
*      EQU  >AB               spare token (LIBRARY)
*      EQU  >AC               spare token (REAL)
*      EQU  >AD               spare token (INTEGER)
*      EQU  >AE               spare token (SCRATCH)
*      EQU  >AF               spare token
THENZ  EQU  >B0               THEN
TOZ    EQU  >B1               TO
STEPZ  EQU  >B2               STEP
COMMAZ EQU  >B3               ,
SEMICZ EQU  >B4               ;
COLONZ EQU  >B5               :
RPARZ  EQU  >B6               )
LPARZ  EQU  >B7               (
CONCZ  EQU  >B8               &          (CONCATENATE)
*      EQU  >B9               spare token
ORZ    EQU  >BA               OR
ANDZ   EQU  >BB               AND
XORZ   EQU  >BC               XOR
NOTZ   EQU  >BD               NOT
EQUALZ EQU  >BE               =
LESSZ  EQU  >BF               <
GREATZ EQU  >C0               >
PLUSZ  EQU  >C1               +
MINUSZ EQU  >C2               -
MULTZ  EQU  >C3               *
DIVIZ  EQU  >C4               /
CIRCUZ EQU  >C5               ^
*      EQU  >C6               spare token
STRINZ EQU  >C7               QUOTED STRING
UNQSTZ EQU  >C8               UNQUOTED STRING
NUMZ   EQU  >C8               ALSO NUMERICAL STRING
NUMCOZ EQU  >C8               ALSO UNQUOTED STRING
LNZ    EQU  >C9               LINE NUMBER CONSTANT
*      EQU  >CA               spare token
ABSZ   EQU  >CB               ABS
ATNZ   EQU  >CC               ATN
COSZ   EQU  >CD               COS
EXPZZ  EQU  >CE               EXP
INTZ   EQU  >CF               INT
LOGZ   EQU  >D0               LOG
SGNZZ  EQU  >D1               SGN
SINZ   EQU  >D2               SIN
SQRZ   EQU  >D3               SQR
TANZ   EQU  >D4               TAN
LENZ   EQU  >D5               LEN
CHRZZ  EQU  >D6               CHR$
RNDZ   EQU  >D7               RND
SEGZZ  EQU  >D8               SEG$
POSZ   EQU  >D9               POS
VAL    EQU  >DA               VAL
STRZZ  EQU  >DB               STR$
ASCZ   EQU  >DC               ASC
PIZ    EQU  >DD               PI
RECZ   EQU  >DE               REC
MAXZ   EQU  >DF               MAX
MINZ   EQU  >E0               MIN
RPTZZ  EQU  >E1               RPT$
*      EQU  >E2               unused
*      EQU  >E2               unused
*      EQU  >E3               unused
*      EQU  >E4               unused
*      EQU  >E5               unused
*      EQU  >E6               unused
*      EQU  >E7               unused
NUMERZ EQU  >E8               NUMERIC
DIGITZ EQU  >E9               DIGIT
UALPHZ EQU  >EA               UALPHA
SIZEZ  EQU  >EB               SIZE
ALLZ   EQU  >EC               ALL
USINGZ EQU  >ED               USING
BEEPZ  EQU  >EE               BEEP
ERASEZ EQU  >EF               ERASE
ATZ    EQU  >F0               AT
BASEZ  EQU  >F1               BASE
*      EQU  >F2               spare token (TEMPORARY)
VARIAZ EQU  >F3               VARIABLE
RELATZ EQU  >F4               RELATIVE
INTERZ EQU  >F5               INTERNAL
SEQUEZ EQU  >F6               SEQUENTIAL
OUTPUZ EQU  >F7               OUTPUT
UPDATZ EQU  >F8               UPDATE
APPENZ EQU  >F9               APPEND
FIXEDZ EQU  >FA               FIXED
PERMAZ EQU  >FB               PERMANENT
TABZ   EQU  >FC               TAB
NUMBEZ EQU  >FD               #
VALIDZ EQU  >FE               VALIDATE
*      EQU  >FF               ILLEGAL VALUE
***********************************************************
* NOTE: FILES EXECSD, SUBS AND PART OF PSCANS ARE IN GROM 5
*       AS BELOW:
*-------NAME------------------ADDRESS---------BYTES LEFT---
*      EXECS                  >A000 - >AD92        5
*      SUBS                   >AD98 - >B4DC        2
*      PSCANS                 >B4E0 - >B7FA        5
*
* Some of the error calls at the end of EXECS file are
* shared and directly addressed by SUBS file. Any change in
* EXECS file which affects the address of error calls will
* affect error reference in SUBS file. Make sure to edit
* SUBS file in that situation.
***********************************************************
       XML  CONT              XML CONT used by subprogram
       BR   LITS05            Build FAC entry and GETSTR
       BR   EXEC              Execute a program
       BR   LINE
       BR   DATAST
       BR   ASC
       BR   EXEC1
       BR   EXEC6D            Save information on a break
       BR   DELINK            Delink symbol table entry
       BR   CONV1
       BR   SQUISH            Called in error routine in PS
       BR   VALCD
       BR   INTRND
       BR   $
GA01C  BR   LNKRTN            Routine to go back to XB prog
GA01E  BR   SPCOL             Clear breakpoint in line # ro
       BR   UBSUB             Spare
       BR   $
       BR   $         ***     Please let me know it you add
*                     ***     branches here since it will a
*                     ***     the address of link list. Sum
LINK1  DATA LINK2
       STRI 'SOUND'
       DATA SOUND
LINK2  DATA LINK3
       STRI 'CLEAR'
       DATA CLEAR
LINK3  DATA LINK4
       STRI 'COLOR'
       DATA COLOR
LINK4  DATA LINK5
       STRI 'GCHAR'
       DATA GCHAR
LINK5  DATA LINK6
       STRI 'HCHAR'
       DATA HCHAR
LINK6  DATA LINK7
       STRI 'VCHAR'
       DATA VCHAR
LINK7  DATA LINKA
       STRI 'CHAR'
       DATA CHARLY
LINKA  DATA LINKB
       STRI 'KEY'
       DATA ZKEY
LINKB  DATA LINKC
       STRI 'JOYST'
       DATA ZJOYST
LINKC  DATA LINKD
       STRI 'SCREEN'
       DATA BORDER
LINKD  DATA LINKE
       STRI 'VERSION'
       DATA VERS
LINKE  DATA LINKS1
       STRI 'ERR'
       DATA ERRWXY
***********************************************************
*        START EXECUTION OF A PROGRAM OR STATEMENT
* DATA:
*      RAM(START) points into line number table at the
*      first line to execute
*      @PGMFLG contains >FF if executing a program or zero
*      if imperative statement
***********************************************************
EXEC   CZ   @PRGFLG           If program
       BS   GA0AE
       DST  V@START,@EXTRAM   Line to start execution at
       DINCT @EXTRAM          Pointer to text pointer
       CALL INTRND            Initialize random number
EXEC1  ST   X2,@XPT           Initialize screen display
       BR   GA0B2
GA0AE  DST  CRNBUF,@PGMPTR    Executing out of crunch buffe
GA0B2  DST  EXEC20,@RTNG      Address of return from ALC
       DST  NUDTB,@NUDTAB     NUD table address for ALC
       XML  EXECG             Execute XB
EXEC20 CASE @ERRCOD+1         Check type of return
       BR   EXECND            0 - NORMAL END
       BR   EXECBK            1 - BREAKPOINT
       BR   EXECTR            2 - TRACE
       BR   ERORZ             3 - ERROR
       BR   WARNGZ            4 - WARNING
       BR   ONERR             5 - ON ERROR
       BR   UDF               6 - FUNCTION
       BR   ONBRK             7 - ON BREAK
       BR   CONCAT            8 - CONCATENATE STRINGS "&"
       BR   ONWARN            9 - ON WARNING
       BR   GPLCAL            A - CALL STATEMENT
WARNGZ CH   >B0,@SUBSTK
       BS   ERRSO
* Stack overflow
*                    ALLOW ROOM ON STACK FOR WARNING CALLS
WRNN01 CALL WARNZZ        ONLY WARNING MSG FROM XB SUPPORT
       BYTE 2       *         NUMERIC OVERFLOW
       BR   CLRRTN            Clear ERRCOD and return
*                    NORMAL END OF EXECUTION
EXECND CZ   @PRGFLG           If imperative mode
       BR   ERRRDY
       CALL CHRTAB            Load the default character se
       B    TOPL15            Return to top-level
ERRRDY CALL ERRZZ             Display * READY *
       BYTE 0
* TRACE-MODE turned on - display line number
EXECTR CLR  @VARW             Clear upper address byte
       ST   @XPT,@VARW+1      Get current x-pointer
       DADD NLNADD-3,@VARW    Make a valid screen address
       DCH  NLNADD+22,@VARW   If might go off screen
       BR   GA102
       XML  SCROLL            SCROLL to next line
       DST  NLNADD,@VARW      Re-initialize screen address
GA102  ST   LESS+OFFSET,V*VARW Display open bracket "("
       DINC @VARW             Increment screen address
       CALL ASC               Convert line # into ASCII
       ST   GREAT+OFFSET,V*VARW Display close bracket ")"
       DSUB NLNADD-4,@VARW    Update the x-pointer
       ST   @VARW+1,@XPT
CLRRTN DCLR @ERRCOD           Clear the return vector
       XML  RTNB              Return to ALC
* BREAKPOINT OR BREAK-KEY RECIEVED
EXECBK CZ   @PRGFLG           If break or program
       BS   ERRBRK
       DST  @EXTRAM,@FAC8     @FAC8 : Source addr in ERAM
       DDECT @FAC8            Point to the line #
       CALL UBSUB1            Reset the breakpoint
       SCAN                   Get break key out of queue
EXEC6C DST  @PGMPTR,V@SPGMPT  Save text pointer
EXEC6D DST  @EXTRAM,V@SEXTRM  Save line number table pointe
       DST  @VSPTR,V@SAVEVP   Save value stack pointer
       DST  @BUFLEV,V@SBUFLV  Save crunch buffer level
       DST  @LSUBP,V@SLSUBP   Save last subprogram on stack
       ST   @FLAG,V@SFLAG     Save FLAG for continue
       AND  >63,V@SFLAG       Only warning and break bits
ERRBRK CALL ERRZZ             * BREAKPOINT
       BYTE 1
***********************************************************
*               NUD / STATEMENT BRANCH TABLE
***********************************************************
NUDTB  BR   RECX              'RECORD'                    0
       BR   NBREAK            'BREAK'                     0
       BR   NUNBRK            'UNBREAK'                   0
       BR   NTRACE            'TRACE'                     0
       BR   NUNTRC            'UNTRACE'                   0
       BR   NREADX            'READ'                      0
       BR   PRINTX            'PRINT'                     0
       BR   SZRUNX            'RUN'                       0
       BR   LINPUX            Reserved for LINPUT         1
       BR   RESTOX            'RESTORE'                   1
       BR   NRNDMZ            'RANDOMIZE'                 1
       BR   INPUTX            'INPUT'                     1
       BR   OPENX             'OPEN'                      1
       BR   CLOSEX            'CLOSE'                     1
       BR   NPI               'PI'                        1
       BR   NMAX              'MAX'                       1
       BR   NMIN              'MIN'                       2
       BR   RPTZ01            'RPT$'                      2
       BR   ACCEPX            'ACCEPT'                    2
       BR   EOFX              'EOF'                       2
       BR   ASC01             'ASC'                       2
       BR   POS01             'POS'                       2
       BR   VAL01             'VAL'                       2
       BR   STRZ01            'STR$'                      2
       BR   SEGZ01            'SEG$'                      3
       BR   DELETX            'DELETE'                    3
       BR   DISPLX            'DISPLAY'                   3
       BR   LEN01             'LEN'                       3
       BR   CHRZ01            'CHR$'                      3
       BR   NRND              'RND'                       3
* The following are long branches to another GROM
EOFX   B    EOF
SZRUNX B    SZRUN
RECX   B    REC
NREADX B    NREAD
PRINTX B    PRINT
RESTOX B    RESTOR
INPUTX B    INPUT
OPENX  B    OPEN
CLOSEX B    CLOSE
ACCEPX B    ACCEPT
DISPLX B    DISPL1
DELETX B    DELET
LINPUX B    LINPUT
***********************************************************
* FLAGS USED IN EXECUTION MODE:    this needs to be checked
*  @FLAG   BIT   RESET               SET
*           0
*           1    Warning PRINT       PRINT off
*           2    Warning NEXT        STOP
*           3    Not in UDF          Executing a UDF
*           4    TRACE mode          Normal mode
*           5
*           6    BREAK allowed       BREAK not allowed
*           7    No LST/EDT protect  LIST/EDIT protected
***********************************************************
* ON WARNING {NEXT | STOP | PRINT}
* ON WARNING NEXT  - Causes warning messages to be ignored
*                    and execution to continue as if a
*                    warning never occurred
* ON WARNING STOP  - Causes a warning to be treated as an
*                    error - i.e. the message is displayed
*                    and execution is halted
* ON WARNING PRINT - Causes the default warning handling to
*                    be in effect, i.e. any warning
*                    messages are printed and execution
*                    continues
***********************************************************
ONWARN XML  PGMCHR            GET OPTION
       CEQ  PRINTZ,@CHAT      If print
       BR   GA1B7
       AND  >F9,@FLAG         Turn on print and contiue
       B    ONWRN5
GA1B7  CEQ  STOPZ,@CHAT
       BR   GA1C4
       AND  >FD,@FLAG         Turn on print
       OR   >04,@FLAG         Turn on stop
       BR   ONWRN5
GA1C4  CEQ  NEXTZ,@CHAT       * SYNTAX ERROR
       BR   ERRSYN
       OR   >02,@FLAG         Turn off print
       AND  >FB,@FLAG         Turn off stop
ONWRN5 XML  PGMCHR            Check for EOS
ONWRN7 CALL CHKEND            Error if not EOS
       BR   ERRSYN            If not EOS
       DCLR @ERRCOD
       XML  CONT              Continue
***********************************************************
* ON ERROR {line number | STOP}
* ON ERROR line number - causes the error routine to build
*                        an error stack entry and pass
*                        control to the line specified in
*                        the most-recently executed
*                        on-error-statement
* ON ERROR STOP - causes the default error handling
*                 conditions to be in effect. i.e. any
*                 errors that occur cause execution to halt
*                 an a message to be displayed
***********************************************************
ONERR  XML  PGMCHR            Get option
       CEQ  LNZ,@CHAT         If line # then find the line
       BR   GA20E
       XML  PGMCHR            Get upper byte
       ST   @CHAT,@FAC
       XML  PGMCHR            Get lower byte
       ST   @CHAT,@FAC1
       DST  @ENLN,@FAC2
       DSUB 3,@FAC2           Pointing to 1st line #
* Consider both ERAM and RAM cases to get line # from the
* line number table. Also reset the break bit.
ONERR2 CALL GRSUB3            Get 2 bytes from either RAM/E
       BYTE FAC2            * FAC2 has the address
       DCEQ @EEE1,@FAC        If found
       BS   ONERR4
       DCH  @STLN,@FAC2       Not found
       BR   ERRLNF
       DSUB 4,@FAC2           Goto next line
       BR   ONERR2
ONERR4 DINCT @FAC2
       DST  @FAC2,V@ERRLN
       BR   GA216
GA20E  CEQ  STOPZ,@CHAT       * SYNTAX ERROR
       BR   ERRSYN
       DCLR V@ERRLN           Back to default error handlin
GA216  BR   ONWRN5            Finish up same as ON WARNING
***********************************************************
* ON BREAK {NEXT | STOP}
* ON BREAK NEXT - Causes any breakpoints which have been
*                 set on statements to be ignored when the
*                 statement is encountered and also masks
*                 the shift-C key so that it is ignored
* ON BREAK STOP - Causes the default break handling to be
*                 in force., i.e. execution is halted and
*                 the BREAKPOINT message is displayed on
*                 the screen
***********************************************************
ONBRK  XML  PGMCHR            Get next char to find option
       CEQ  STOPZ,@CHAT       If stop option specified
       BR   GA225
       AND  >BF,@FLAG         break allowed
       B    GA22D             Don't change this to BR GA22D
GA225  CEQ  NEXTZ,@CHAT       If next option number
       BR   ERRSYN            specified then syntax error
       OR   >40,@FLAG         If next option specified then
*                              break NOT allowed
GA22D  BR   ONWRN5            Finish up same as ON WARNING
***********************************************************
* GPLCAL - If a call is made to a subprogram that does not
*  not exist either in the BASIC program itself or in the
*  internal GPL subprogram list then one final attempt is
*  made to find the subprogram at execution time by
*  searching for the subprogram in the console or a
*  peripheral. If not found there, then a
*  *SUBPROGRAM NOT FOUND error occurs
*
*  Input: the subprogram name is in the FAC and the length
*         of the name is in FAC15
***********************************************************
GPLCAL CZ   @RAMFLG           Can't try if CPU program
       BR   ERRSNF
       DSRL 8,@FAC15          Make name length a double
       DSUB @FAC15,@PGMPTR    Point back at name
       DDEC @PGMPTR           Point at name length
       DST  @PGMPTR,@FAC12    Set pointer to name
       CALL LINK              Issue 'Call Program Link'
       BYTE 10              * Search subprogram lists
       BR   ONWRN7            If all ok, check-end and rtn
       BR   ERRSNF            If not found, error
***********************************************************
*                     NUD FOR PI
***********************************************************
NPI    MOVE 8,G@CONPI,@FAC    Load constant PI
       XML  CONT
CONPI  BYTE >40,3,14,15,92,65,35,90
* 3.1415992653590E+00
***********************************************************
*                     NUD FOR MAX
***********************************************************
NMAX   CALL MAXMIN            Combine MAX and MIN
       GT
       BR   GA263
NMAXZ1 MOVE 8,@ARG,@FAC
GA263  XML  CONT
***********************************************************
*                     NUD FOR MIN
***********************************************************
NMIN   CALL MAXMIN            Combine MAX and MIN again
       GT
       BR   NMAXZ1
       XML  CONT
***********************************************************
*                COMMON MAX / MIN ROUTINE
***********************************************************
MAXMIN CALL LPAR              Skip "(" parse, and insure ,
       CH   >63,@FAC2         Must be numeric
       BS   ERRSNM
       XML  VPUSH             Push l.h. arg on stack
       XML  PARSE             PARSE up to ")"
       BYTE RPARZ
       CH   >63,@FAC2         Must be numeric
       BS   ERRSNM
       XML  SPEED             Must be
       BYTE SYNCHK        *    at a
       BYTE RPARZ         *      right parenthesis
       MOVE 8,@FAC,@ARG       Save in ARG for compare
       XML  VPOP              Get l.h. arg back
       XML  FCOMP             Compare operands
       RTN
* Initialize random number generator
INTRND MOVE 10,G@X2SEED,V@RNDX2
       RTN
X2SEED BYTE >42,>03,>23,>15,>00 * =   33521, X2 INITIAL VAL
X1SEED BYTE >43,>02,>3E,>2A,>17 * = 2624223, X1 INITIAL VAL
***********************************************************
*           PSEUDO-RANDOM NUMBER GENERATOR
*      X(N+1) = (A*X(N)+C) MOD M;  RND = X/M
*    WHERE:                 X = X2 * 1E7 + X1
*                           A = A2 * 1E7 + A1
*                           C = C2 * 1E7 + C1
*                           M = 1E14
* ASSUMPTIONS:
*  (1) All numbers are integers; fractional parts are
*      truncated
*  (2) If the variables listed below start in the ranges
*     specified. They will also end in the ranges specified
*
* CONSTANTS: 0 <= A2 < 5E6 ; 0 <= C2 < 1E7
*            0 <= A1 < 5E6 ; 0 <= C1 < 1E7
* VARIABLES: 0 <= X2 < 1E7 ; 0 <= T1 <= 1E14 ; 0 <= T2 < 1E
*            0 <= X1 < 1E7 ; 0 <= T3 <= 1E14 ; 0 <= T4 < 1E
*
*        STACK USAGE:
*            CONSTANT REFS      CONTANT REFS    CONTANT REF
* +---------+      IN/OUT            IN/OUT          IN/OUT
* | STACK+4 | X2*A1(F)(H)       --    ----      --    ----
* +---------+
* | STACK+3 |   T2 (C)(J)       --    ----      --    ----
* +---------+
* | STACK+2 |   T1 (B)(D)   new X1   (E)(N)     --    ----
* +---------+
* | STACK+1 |old X1(A)(G)       T3   (K)(L) new X2   (M)(P)
* +---------+
***********************************************************
* COMPUTE NEW VALUE FOR X1, SAVE IT IN V@RNDX1
*                             STACK
*                               SREFS   FAC CONTENTS
NRND   MOVE 5,V@RNDX1,@FAC        FAC = X1
       CLR  @FAC5                 FAC = CLR
       DCLR @FAC6                 FAC = CLR
       XML  VPUSH          (A)    FAC = X1
       MOVE 8,G@RNDA1,@ARG        ARG = A1
       XML  FMUL                  FAC = X1*A1
       MOVE 8,G@RNDC1,@ARG        ARG = C1
       XML  FADD               T1=FAC = X1*A1+C1
       XML  VPUSH          (B)    FAC = T1
       MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
       XML  FMUL                  FAC = T1/1E7
       CALL GRINT              T2=FAC = INT(T1/1E7)
       XML  VPUSH          (C)    FAC = T2
       MOVE 8,G@RNDEP,@ARG        ARG = 1E7
       XML  FMUL                  FAC = T2*1E7
       DSUB 8,@VSPTR
       XML  SSUB           (D) X1=FAC = T1-T2*1E7
       MOVE 5,@FAC,V@RNDX1        FAC = X1 (new)
       XML  VPUSH          (E)    FAC = X1
* COMPUTE NEW VALUE FOR X2, SAVE IT IN V@RNDX2
       MOVE 5,V@RNDX2,@FAC        FAC = X2
       CLR  @FAC5                 FAC = CLR
       DCLR @FAC6                 FAC = CLR
       MOVE 8,G@RNDA1,@ARG        ARG = A1
       XML  FMUL                  FAC = X2*A1
       DADD 8,@VSPTR
       XML  VPUSH          (F)    FAC = X2*A1
       DSUB 24,@VSPTR
       XML  VPOP           (G)    FAC = X1
       DADD 32,@VSPTR
       MOVE 8,G@RNDA2,@ARG        ARG = A2
       XML  FMUL                  FAC = X1*A2
       XML  SADD           (H)    FAC = X2*A1+X1*A2
       MOVE 8,G@RNDC2,@ARG        ARG = C2
       XML  FADD                  FAC = X2*A1+X1*A2
       XML  SADD           (J) T3=FAC = X2*A1+X1*A2
       DSUB 16,@VSPTR
       XML  VPUSH          (K)    FAC = T3
       MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
       XML  FMUL                  FAC = T3/1E7
       CALL GRINT              T4=FAC = INT(T3/1E7)
       MOVE 8,G@RNDEP,@ARG        ARG = 1E7
       XML  FMUL                  FAC = T4*1E7
       XML  SSUB           (L) X2=FAC = T3-T4*1E7
       MOVE 5,@FAC,V@RNDX2        FAC = X2 (new)
* COMPUTE NEW VALUE FOR RND, LEAVE IT IN FAC
       MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
       XML  FMUL                  FAC = X2/1E7
       XML  VPUSH          (M)    FAC = X2/1E7
       DADD 8,@VSPTR
       XML  VPOP           (N)    FAC = X1
       XML  FMUL                  FAC = X1/1E7
       XML  FMUL                  FAC = X1/1E14
       XML  SADD           (P)RND=FAC = (X2/1E7)+(X1/1E14)
       XML  CONT
***********************************************************
* CONSTANTS FOR THE RANDOM NUMBER ROUTINE
RNDA2  BYTE >43,>01,>2B,>59,>52,>00,>00,>00 * = 1438982
RNDA1  BYTE >42,>2A,>08,>15,>00,>00,>00,>00 * = 0420821
RNDC2  BYTE >43,>02,>0B,>20,>30,>00,>00,>00 * = 2113248
RNDC1  BYTE >43,>06,>36,>05,>13,>00,>00,>00 * = 6540519
RNDEP  BYTE >43,>0A,>00,>00,>00,>00,>00,>00 * = 1E7
RNDEM  BYTE >3C,>0A,>00,>00,>00,>00,>00,>00 * = 1/1E7
***********************************************************
*                   RANDOMIZE STATEMENT
***********************************************************
NRNDMZ CALL CHKEND            Seed provider?
       BS   RNDM1             No
* RANDOMIZE given a see value
* (99,000,000,000,001 possible starting positions)
* (Place-value is ignored in the input number)
       XML  PARSE             Parse the seed
       BYTE TREMZ           * Up to end of statement
       CALL CKSTNM
       DCZ  @FAC              Check FAC for zero
       BS   GA3B6
       ST   >46,@FAC          0 < FAC < 1E14
       XML  VPUSH             Let FAC = X2*1E7+X1
       MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
       XML  FMUL                  FAC = X2+X1/1E7
       CALL GRINT                 FAC = X2
       MOVE 5,@FAC,V@RNDX2        FAC = X2
       MOVE 8,G@RNDEP,@ARG        ARG = 1E7
       XML  FMUL                  FAC = X2*1E7
       XML  SSUB                  FAC = X1
       MOVE 5,@FAC,V@RNDX1        FAC = X1
       XML  CONT                  FAC = X1
GA3B6  DST  @FAC,V@RNDX2          FAC = 0
       DST  @FAC,V@RNDX1          FAC = 0
       XML  CONT
* RANDOMIZE given number seed value (use GPL RAND function)
* (16K possible starting positions)
RNDM1  DST  >4201,@FAC            FAC = >4201
       CLR  @FAC4                 FAC4= >00
       CALL RNDMZ
       DATA RNDX1
       CALL RNDMZ             Set up seed
       DATA RNDX2
       XML  CONT              Continue on
RNDMZ  FETCH @FAC8            Fetch address of seed (high b
       FETCH @FAC9            Fetch address of seed (low by
       RAND 99                GPL Randomize
       ST   @RANDOM,@FAC2     >00<=FAC+2<=FF
       SRL  2,@FAC2           >00<=FAC+2<=3F
       RAND 99                GPL Randomize
       ST   @RANDOM,@FAC3     >00<=FAC+3<=FF
       SRL  2,@FAC3           >00<=FAC+3<=3F
       MOVE 5,@FAC,V*FAC8     Put in seed
       RTN
CKSTNM CEQ  >65,@FAC2
       BS   ERRSNM
       RTN
FLT1   BYTE >40,>01,>00,>00,>00,>00,>00,>00
***********************************************************
*                 EXTENDED STRING PACKAGE
* THE ROUTINES ARE:
*  LITS05 - Move a string literal from the program to the
*            string space
*  INTARG - Checks that an argument is a numeric and
*            converts it from floating point to an integer
*  PUSSTR - Checks that an argument is a string and pushes
*            it on the stack
*  CONCAT - Concatenates 2 strings together
*  SEG$   - Segments a string
*  LEN    - Puts the length of a string in the FAC
*  CHR$   - Converts an integer into its ASCII character
*  STR$   - Converts a number into its string equivalent
*  VAL    - Converts a string into its numeric equivalent
*  POS    - Gives the position of one string within another
*  RPT$   - Generates a single string with multiple copies
*            of the original string
*
*      AN ENTRY IN THE FAC LOOKS LIKE:
* +------------+-----+----+-------------+-----------------+
* |addr of ptr | >65 | xx | addr of str | length of str   |
* +------------+-----+----+-------------+-----------------+
*     FAC       FAC2  FAC3   FAC4           FAC6
***********************************************************
* Support routine for functions to build FAC entry
LITS05 CLR  @FAC6             Need as a double-byte value
       DST  @FAC6,@BYTES      LENGTH FOR GETSTR
       ST   @RAMTOP,@FAC8     Copy ERAM flag for later
LITS07 XML  GETSTR            ALLOCATE STRING SPACE
LITS08 DST  >001C,@FAC        SAVE ADDR OF STRING  (SREF)
       DST  @SREF,@FAC4       SAVE ADDR OF STRING
       DST  >6500,@FAC2       INDICATES A STRING CONSTANT
*********** COPY STRING INTO STRING SPACE *****************
LITS09 DCZ  @BYTES            If non-null string
       BS   GA42B
       CZ   @FAC8
       BR   GA420
       MOVE @BYTES,V*TEMP5,V*SREF
       RTN
*                             Else source string in ERAM
GA420  DST  @BYTES,@FFF1      FFF1 : BYTE COUNT
       DST  @SREF,@EEE1       EEE1 : DESTINATION ADDR ON VD
       DST  @TEMP5,@DDD1      DDD1 : Source addr in ERAM
       XML  GVWITE            Move data from ERAM to VDP
GA42B  RTN
LITS06 CLR  @FAC8             SET FLAG TO VDP
       BR   LITS07            JUMP INTO CODE
***********************************************************
* PUSSTR - Insures that the entry in the FAC is a string
*           and pushes it onto the stack.
***********************************************************
PUSSTR CEQ  >65,@FAC2
       BR   ERRSNM
       XML  VPUSH             PUSH THE ARGUMENT
       RTN
***********************************************************
* CONCAT - CONCATENATES TWO STRINGS TOGETHER
*         INPUT  : FLOATING POINT ACCUMULATOR ENTRIES
*         OUTPUT : CONCATENATED STRING AND (POSSIBLE)
*                  ZEROED BACK-POINTERS FOR THE OLD STRINGS
*         USES   : TEMP2, TEMP4 AND TEMP5 AS TEMPORARIES
***********************************************************
CONCAT CLR  @ERRCOD+1         CLEAR THE ERROR CODE
       CALL PUSSTR            Push the string & get next to
       XML  PARSE             GET THE R.H. ARGUMENT
       BYTE CONCZ
       CEQ  >65,@FAC2         If not string - error
       BR   ERRSNM
       DST  @FAC6,@BYTES      GET R.H. LENGTH
       DADD V@6(@VSPTR),@BYTES    ADD IN L.H. LENGTH
       DCH  255,@BYTES
       BR   GA45B
       DST  255,@BYTES        TRUNCATE IF TOO LONG
WRNST1 CALL WARNZZ            Display warning
       BYTE 19                * STRING TRUNCATED message
GA45B  DST  @BYTES,@TEMP6     Keep length for later
       XML  VPUSH
       XML  GETSTR            Alloccate the result string
       XML  VPOP              Retrieve R.H.
       MOVE 8,@FAC,@ARG
       XML  VPOP              Retrieve L.H.
       DST  @FAC4,@TEMP5      Set ptr to L.H. ARG(for FREST
       DST  @FAC6,@BYTES      Length of L.H. ARG
       CLR  @FAC8             Force VDP mode
       CALL LITS08            Set up FAC & copy L.H. ARG in
       DCZ  @ARG6             If R.H. =0 don't copy
       BS   CONC06
       DST  @SREF,@TEMP4      Get ptr to new string
       DADD @FAC6,@TEMP4      Ptr to where 2nd string begin
       DSUB @FAC6,@TEMP6      Length of 2nd string
*                                      (possibly truncated)
       BS   CONC06
       MOVE @TEMP6,V*ARG4,V*TEMP4     Copy in 2nd string
 
       DADD @TEMP6,@FAC6      Add in length of 2nd ARG
* NOTE: FAC6 already contained length of 1st ARG from the
*       parse that was done on it
CONC06 XML  CONT              Done.
***********************************************************
* SEG$(A$,X,Y) - Extracts the desiginated string from A$.
*     X specifies the character position within A$ at
*     which the extraction begins. Y specifies the number
*     of characters to extract.
*     If X or Y is negative an error occurs. If X=0 an
*     error occurs. If Y=0 or X > Y then a null string is
*     is returned. If the ramaining length in A$ starting
*     at the postion specified by X is less than the length
*     specified by Y, then the remainder of A$ starting at
*     position X is returned.
*   INPUT - Control is turned over to SEG$ from PARSE. The
*     only requirement is that a SEG$ was encountered.
*   OUTPUT - The Floating Point Accumulator is set up with
*     the header for the segmented string.
*   USES - TEMP2 (Others in calls to GETSTR and LITS08)
***********************************************************
SEGZ01 CALL LPAR              Insure "(" parse and check ",
       CALL PUSSTR            Push string and get next toke
       XML  SPEED             Get the position
       BYTE PARCOM       *     within the source string
       CALL INTARG            CHECK & CONVERT ARG TO INTEGE
       DCZ  @FAC               CAN'T HAVE VALUE OF 0
       BS   ERRBV
       XML  VPUSH             PUSH THE ARG
       XML  PARSE             Get extraction length
       BYTE RPARZ
       XML  SPEED             Must have
       BYTE SYNCHK       *     ended on
       BYTE RPARZ        *      a right parenthesis
       CALL INTARG            CHECK & CONVERT ARG TO INTEGE
       DST  @FAC,@ARG         Move extraction length
       XML  VPOP              Get position back
       DST  @FAC,@ARG2        Move position
       XML  VPOP              Retrieve source string
       DST  @ARG2,@TEMP2      Get position within string
       DCH  @FAC6,@TEMP2      If position > length =>null
       BS   SEGZ08
       DADD @ARG,@TEMP2       Compute end of substring
       DSUB @FAC6,@TEMP2      Compute length beyond end
       DDEC @TEMP2             string
       DCGE 0,@TEMP2
       BR   SEGZ06            Fine if substring is shorter
       DST  @FAC6,@ARG        Else, truncate length of
*                              substring
       DSUB @ARG2,@ARG        Subtract position from source
*                              length
       DINC @ARG              Increment to include last cha
SEGZ06 DST  @ARG,@BYTES       # of bytes needed for substri
       XML  VPUSH             Save source string entry
       XML  GETSTR            ALLOCATE RESULT STRING
       XML  VPOP              Restore source string entry
       DST  @FAC4,@TEMP5      Pointer to source for FRESTR
*                              LITS08
       DADD @ARG2,@TEMP5      Pointer to start of substring
       DDEC @TEMP5            Decrement since zero-based
       DST  @BYTES,@FAC6      Set length of string
       CLR  @FAC8             FORCE VDP MODE
       CALL LITS08            Copy in & set up FAC
       XML  CONT
SEGZ08 DCLR @ARG              Extract a null string
       BR   SEGZ06            >>>JUMP ALWAYS<<<
***********************************************************
* LEN(A$) - Calculate the length of a string and leave the
*           result in the FAC.
*  CONTROL - Turned over to NLEN from the parser.
*  USES    - No temporaries.
***********************************************************
LEN01  CALL PARFF             Insure left parenthesis & par
       BR   ERRSNM             If not string value
       DST  @FAC6,@FAC        Length
LEN02  XML  CIF               Convert integer to floating p
       XML  CONT
***********************************************************
* CHR$(X) - Takes integer value X and converts the number
*           into the ASCII representation for that number.
*  CONTROL - Turned over to NCHR by the parser.
*  OUTPUT  - FAC is set up with the string entry
*  USES    - Uses temproraries when invoking LITS06(LITSTR)
***********************************************************
CHRZ01 CALL PARFF             Insure left parenthesis & par
       CALL INTARG            Convert into integer
       DST  1,@BYTES          Create a length 1 string
       ST   @FAC1,V@ONECHR    Move the value to VDP(for LIT
       DST  ONECHR,@TEMP5     Address of character
       CALL LITS06            Create string and set up FAC
       DST  1,@FAC6           Length of string
       XML  CONT
***********************************************************
* ASC(A$) - Takes the numeric value of the first character
*           in A$.
***********************************************************
ASC01  CALL PARFF             Insure left parenthesis & par
       BR   ERRSNM             If not string
       CZ   @FAC7             Bad Argument?
       BS   ERRBA
       ST   V*FAC4,@FAC1      Get the first character
       CLR  @FAC
       BR   LEN02             USE COMMON CODE >>>JUMP ALWAY
***********************************************************
* STR$(X) - Takes as its imput an integer X and converts it
*           to its string representation.
*  CONTROL - Turned over to STR$ by the parser.
*  USES    - The usual temporaries used by string function
*            when it calls LITS06. Uses the Roll-out area
*            for a temporary storage area when allocating
*            the result string.
*  OUTPUT  - FAC is set up in the usual manner for a string
***********************************************************
STRZ01 CALL PARFF             Insure left parenthesis & par
       BS   ERRSNM             If not numeric-error
       CLR  @FAC11            Select XB floating type
       XML  CNS               Convert the number to string
       CEQ  SPACE,*FAC11      If leading space
       BR   GA53E
       INC  @FAC11            Suppress it out
       DEC  @FAC12            Shorten the length
GA53E  CLR  @BYTES            Prepare for 2-byte value
       ST   @FAC12,@BYTES+1   Get length of string
       MOVE @BYTES,*FAC11,V@VROAZ    Put the string in VDP
       DST  VROAZ,@TEMP5      Copy-from address(for LITSTR)
       CALL LITS06            Allocate and set up FAC
       DST  @BYTES,@FAC6      Put in the length
       XML  CONT
***********************************************************
* VAL(A$) - Takes as its input a string, A$, and converts
*           the string into a number if the string is a
*           valid representation of a number.
*  CONTROL - From the parser.
*  OUTPUT  - FAC contains the floating point number.
***********************************************************
VAL01  CALL PARFF             Insure left parenthesis & par
       BR   ERRSNM             If not string - error
       CZ   @FAC7             Can't have null string
       BS   ERRBA
       CALL VALCD             So bad argument error
       BS   ERRBA
       XML  CONT
* Short routine to parse a single argument enclosed in
*  parenthesis for a function or a subprogram and set
*  condition based upon whether the value parsed was a
*  string or a numeric.
PARFF  CEQ  LPARZ,@CHAT
       BR   ERRSYN
       XML  PARSE
       BYTE >FF               *
       CEQ  >65,@FAC2
       RTNC
VALCD  DST  @FAC4,@TEMP5      Pointer to string
       DADD @FAC6,@TEMP5      Pointer to trailing length by
       DST  @FAC6,@BYTES      For suppressing trailing blan
       DINC @BYTES            Prepare for undue subtraction
GA57C  DDEC @TEMP5            Keep track of end of string
       DDEC @BYTES            Decrease length of string
       BS   RTNSET            End up with empty string,
       CEQ  SPACE,V*TEMP5     Wild trailing blanks
       BS   GA57C
       DINC @BYTES            Allow for terminator
       XML  VPUSH             Save the ptr to the string
       XML  GETSTR            Get a new string
       XML  VPOP              Retrieve the ptr to the strin
       DST  @FAC4,@TEMP5      Get the ptr to the string
       CLR  @FAC8             Force VDP mode
       CALL LITS09            Copy the string and set up FA
       DADD @SREF,@BYTES      Point to the trailing length
       DDEC @BYTES            Point at the last character
       ST   SPACE,V*BYTES     Put in the terminator
       DST  @SREF,@FAC12      Address for the conversion
GA5A4  CEQ  SPACE,V*FAC12     While leading spaces
       BR   GA5AE
       DINC @FAC12            Skip leading blank
       BR   GA5A4
GA5AE  CLR  @FAC2             Get rid of string (in case=0)
       CLR  @FAC10            Assume no error
       XML  CSNUM             Convert it
       DCEQ @BYTES,@FAC12     Convert all of it?
       BS   WRNNO             Yes, check overflow & return
RTNSET CEQ  @>8300,@>8300     No, return with condition set
       RTNC
***********************************************************
* POS(A$,B$,X) - Attempts to match the string, B$, in A$
*    beginning at character # X in A$. If X is > LEN(A$), a
*    match is not found or A$ is the null string then the
*    returned value is 0. If B$ is the null string then the
*    returned value is 1. Otherwise, the returned value is
*    the column # of the 1st character matched in A$
*  CONTROL - Fromn the parser. Returned through common code
*            IN LEN.
*  USES    - Not temporaries - Utilizes FAC and ARG.
***********************************************************
POS01  CALL LPAR              Insure "(", parse , insure ",
       CALL PUSSTR            STACK THE STRING AND GET TOKE
       XML  SPEED             Parse the match string and
       BYTE PARCOM      *      insure end on comma
       CALL PUSSTR            STACK THE STRING AND GET TOKE
       XML  PARSE             Get position
       BYTE RPARZ
       XML  SPEED             Must have
       BYTE SYNCHK          *  ended on a
       BYTE RPARZ           *   right parenthesis
       CALL INTARG            Check and convert it
       DCZ  @FAC              Value out of range
       BS   ERRBV
       DST  @FAC,@BYTES       Keep the offset
       DDEC @BYTES            Correct for position 0
       XML  VPOP              Get match string back
       MOVE 8,@FAC,@ARG       Put match in ARG
       XML  VPOP              Get source back
       CZ   @FAC7             If source null
       BS   POS12
       CH   @BYTES+1,@FAC7    OFFSET > LENGTH?
       BR   POS12             Yes, no match possible
       CZ   @ARG7             If null string
       BS   POS06
       DADD @BYTES,@FAC4      Adjust ptr for offset
       SUB  @BYTES+1,@FAC7    Adjust length
POS02  CHE  @ARG7,@FAC7       Enough space left for a match
       BR   POS12             No, no match possible
       DST  @FAC4,@FAC        Get first ARG
       DST  @ARG4,@ARG        Get second ARG
       ST   @ARG7,@ARG8       And length of second
POS04  CEQ  V*FAC,V*ARG       Compare the characters
       BR   POS10             Didn't match
       DINC @FAC              Next in source
       DINC @ARG              Next in match
       DEC  @ARG8             Reached end of match?
       BR   POS04             Not yet, so loop
POS06  INC  @BYTES+1          Matched! Correct for 1 index
POS08  DST  @BYTES,@FAC       Character position of match
       BR   LEN02             Convert to floating point
* NOTE: Utilizes the LEN code to do the conversion and
*       finish up.
POS10  INC  @BYTES+1          Step index of match character
       DEC  @FAC7             Move 1 position down 1st
       DINC @FAC4              Argument
       BR   POS02             Try to match again
* JUMP ALWAYS
POS12  CLR  @BYTES+1          NO MATCH POSSIBLE
       BR   POS08
***********************************************************
* RPT$(A$,X) - Creates a string consisting of X copies of
*              A$. If X is negative or non-numeric, an
*              exception occurs. If A$ is not a string, an
*              exception occurs.
***********************************************************
RPTZ01 CALL LPAR              Insure "(", parse, insure ","
       CALL PUSSTR            Insure a string and push it
       XML  PARSE             Parse second argument
       BYTE RPARZ
       XML  SPEED             Must have
       BYTE SYNCHK       *     ended on a
       BYTE RPARZ        *      right parenthesis
       CALL INTARG            Check numeric and convert
       DMUL V@6(@VSPTR),@FAC  Compute result length
       DCZ  @FAC1
       BS   GA649
WRNST2 CALL WARNZZ            Give truncation message
       BYTE 19                * STRING TRUNCATED message
       DST  255,@FAC2         Make it a maximum string
GA649  DST  @FAC2,@BYTES      Copy requested string length
       XML  GETSTR            Get the new string
       XML  VPOP              Retrieve the original string
* At this point BYTES should still contain the length
       DST  @FAC6,@ARG        Copy original length in ARG
       DCZ  @BYTES            Zero copies requested
       BR   GA659
       DCLR @ARG              So we copy zero!!!!!!!
GA659  DEX  @ARG,@BYTES       Original length to BYTE
       DST  @FAC4,@TEMP5      And also original start addr
       CLR  @FAC8             Clear flag for LITS08
       CALL LITS08            Create FAC and copy on copy
* ARG contains total length now.
       DST  @ARG,@FAC6        Store new length
RPTZ02 DSUB @BYTES,@ARG       Subtract one copy
       DCZ  @ARG              <<<<<THE WAY OUT
       BS   XMLCON
       DADD @BYTES,@SREF      Compute new start address
       DCH  @ARG,@BYTES
       BR   GA679
       DST  @ARG,@BYTES       Truncate string
GA679  MOVE @BYTES,V*TEMP5,V*SREF
       BR   RPTZ02
***********************************************************
*                   TRACE STATEMENT
***********************************************************
NTRACE OR   >10,@FLAG         Set the trace bit
XMLCON XML  CONT              Continue on
***********************************************************
*                 UNTRACE STATEMENT
***********************************************************
NUNTRC AND  >EF,@FLAG         Reset the trace bit
       XML  CONT              Continue on
***********************************************************
*          BREAK AND UNBREAK STATEMENTS
***********************************************************
NBREAK ST   >FF,@ARG          BREAK flag
       CALL CHKEND            Check for end of statement
       BR   LINEGP            If not goto LINEGP
       DDEC @PGMPTR           Back up so CON will rescan en
       CZ   @PRGFLG           Rative without line #
       BR   EXEC6C
ERROLP CALL ERRZZ             Only legal in a program
       BYTE 27
NUNBRK CLR  @ARG              UNBREAK flag for common
       CALL CHKEND            Check for end of statement
       BS   UNBK01            If end then goto UNBK01
LINEGP CALL LINE              Get line #
       DST  @ENLN,@ARG2
       DSUB >03,@ARG2         1st line #
LNGP1  DCHE @STLN,@ARG2       If line not found
       BR   WRNLNF
       CALL GRSUB3            Read line # of data from ERAM
       BYTE >5E           *   (use GREAD1) or VDP
* @ARG2: Source addr in ERAM/VDP, reset possible breakpoint
       DCEQ @FAC,@EEE1        If line found
       BS   LNGP2
       DSUB 4,@ARG2           Next line in VDP or ERAM
       BR   LNGP1
* JUMP ALWAYS
LNGP2  CZ   @RAMTOP           If ERAM exists
       BS   GA6DA
       AND  >7F,@EEE1         Assume UNBREAK flag
       CZ   @ARG              If BREAK flag
       BS   GA6D1
       OR   >80,@EEE1         Set the breakpoint
GA6D1  CALL GWSUB             Write a few bytes of data to
*                              ERAM (use GWRITE)
       BYTE >5E,>58,>01     * ARG2,EEE1,1
*                            @ARG2: Destination addr on ERA
*                            @EEE1: Data
*                            1    : Byte count
       B    LNGP2B
GA6DA  AND  >7F,V*ARG2        Assume UNBREAK flag first
       CZ   @ARG              If BREAK flag
       BS   LNGP2B
       OR   >80,V*ARG2        Set the breakpoint
LNGP2B CALL CHKEND            Check for end of statement
       BS   LNGP4             If end then continue
       XML  SPEED             Must be
       BYTE SYNCHK         *     at a
       BYTE COMMAZ         *       comma now
       BR   LINEGP
* JUMP ALWAYS
WRNLNF CALL WARNZZ            Note: warning not error
       BYTE 38             *  'LINE NOT FOUND'
       BR   LNGP2B            And contiue on
* JUMP ALWAYS
UNBK01 CALL UBSUB             Clear all bkpt in line # tabl
LNGP4  XML  CONT              Contiue
*     CLEAR ALL BREAKPOINTS
UBSUB  DST  @STLN,@FAC8       END OF LINE # BUFFER
GA6FF  CALL UBSUB1            Reset one line # at a time
       DADD 4,@FAC8           Got to the next line
       DCH  @ENLN,@FAC8       End of table
       BR   GA6FF
       RTN
UBSUB1 CALL GRSUB3            Read the line # from ERAM/VDP
*                             Reset possible bkpt too
       BYTE >52            *  @FAC8: Source addr on ERAM/VD
       CALL GWSUB             Write a few bytes of data to
*                              ERAM(use GWRITE) or VDP
       BYTE >52,>58,>01    *  FAC8,EEE1,1
*                          @FAC8: Destination adr in ERAM/V
*                          @EEE1: Data
*                          1    : Byte count
       RTN
***********************************************************
*                USER DEFINED FUNCTIONS
* Subroutine to store away the information of the tokens in
* a function reference, go into the 'DEF' statement,
* calculate the value of the expression and then resume
* execution of the user's program after the reference.
* An entry in the FAC and on the stack for a function
* reference looks like:
* +--------+-----+---------------------+--------+---------+
* | PGMPTR | >68 | string/numeric flag | SYMTAB | FREPTR  |
* +--------+-----+---------------------+--------+---------+
*  FAC      FAC2  FAC3                  FAC4     FAC6
*
* The 'PGMPTR' is where execution resumes after evaluating
* the function. String (80)/numeric(00) flag is function
* type. SYMTAB is the old symbol table pointer and FREPTR
* is the old free space pointer. These are restored after
* the function is evaluated.
***********************************************************
UDF    CZ   @PRGFLG           If imperative
       BR   GA720
       CZ   @RAMTOP+1         And ERAM, error
       BR   ERROLP
GA720  CLR  @FAC7             Assume no args
       DCLR @ERRCOD           Clear the error code for cont
       CLR  @ARG2             Safety for VPUSH
       CLR  @FAC2             Sagety for VPUSH
       CEQ  LPARZ,@CHAT
       BR   GA73B
       XML  VPUSH             Save ptr to function definiti
       XML  PARSE             PARSE to get arg value
       BYTE >FF
       MOVE 8,@FAC,@ARG       Save PARSE result
       XML  VPOP              Get S.T. ptr to function defi
       INC  @FAC7             Indicate theat we have an arg
GA73B  ST   @FAC7,@TEMP5      Move the parmeter count
       DST  @FAC,@TEMP4       S.T. ptr to definition
       XML  VPUSH             Allow room for UDF result
       MOVE 8,@ARG,@FAC       Retrieve parse result
       XML  VPUSH             Save parse result
       ST   V*TEMP4,@FAC2     Get S.T. declarations
       ST   @FAC2,@FAC3       Do this to save string bit
* NOTE: THIS IS TO ALLOW THE CHECKING AFTER THE FUNCTION HA
*       BEEN EVALUATED TO MAKE SURE THE FUNCTION
*       TYPE (STRING/NUMERIC) MATCHES THE RESULT IT PRODUCE
       AND  >07,@FAC2         Mask all but # of parameters
       CEQ  @TEMP5,@FAC2
       BR   ERRIAL
* Incorrect argument list error above.
       DST  @PGMPTR,@FAC      Will resume execution here
       ST   >70,@FAC2         Entering parameter into symbo
*                    table while in UDF statement executing
       AND  >80,@FAC3         Mask all but string bit
       DSUB 16,@VSPTR         Get below parse result
 
       DST  @SYMTAB,@FAC4     Save current symbol table ptr
       DST  @FREPTR,@FAC6     Save current free space ptr
       XML  VPUSH             Save the return info
       DADD 8,@VSPTR          Get back to parse result
*********** SHIFT EXECUTION TO FUNCTION DEFINITION ********
       DST  V@6(@TEMP4),@PGMPTR    Set text ptr to definiti
       XML  PGMCHR            Get 1st character in the defi
       CH   >A4,@SUBSTK       Stack overflow
       BS   ERRSO
       MOVE 24,@>8300,V@VROAZ  Roll out temporaries
       OR   >08,@FLAG         Set function flag for ENTER
       ST   >80,@XFLAG        Make calls look like ENTERX
       CEQ  EQUALZ,@CHAT
       BR   GA79C
* NOTE: This is to keep the global/local variables correct
*       the event that a function uses another function in
*       its evaluation.
       CLR  @FAC15            Create a dummy entry in table
       CALL ENT09              for no-paremter function
       DDECT @PGMPTR          Back up to equal sign
       CLR  V@2(@VSPTR)       This is to keep ASSGNV(called
*                              below) not to screw up in
*                              case FAC2 happens to have a
*                              value (greater) >65
       BR   GA79F
GA79C  CALL ENTER             Enter the parameter
GA79F  XML  PGMCHR            Get the '=' (Checked in PSCAN
       AND  >F7,@FLAG         Reset to normal ENTERs
       MOVE 24,V@VROAZ,@>8300
       ST   >68,V@-6(@VSPTR)  Correct stack entry ID
       DST  V@SYMBOL,V@2(@SYMTAB)  Fudge link to
*                                   get global values
       DST  @SYMTAB,@FAC      Set up for SMB
       XML  SMB               Get value space
       MOVE 8,@FAC,@FAC8      Destination
       XML  VPOP              Get arg back
       MOVE 8,@FAC,@ARG       Argument value
       MOVE 8,@FAC8,@FAC      Destination
       XML  VPUSH             Push to destination
       MOVE 8,@ARG,@FAC       Argument value
       CEQ  >65,@FAC2         If a string
       BR   GA7E2
       DCEQ >001C,@FAC        If not temp
       BS   GA7E2
       DST  V*FAC,@FAC4       Get new location of string
*                             Parameter was allocated in S.
GA7E2  XML  PGMCHR            Skip the '='
       XML  ASSGNV            Assign the value to the param
       XML  PARSE             PARSE to end of function defi
       BYTE TREMZ
**** CHECK FOR TYPE MATCH (STRING/STRING OR NUM/NUM)*******
**** BETWEEN THE RESULT AND THE FUNCTION TYPE *************
       CEQ  >65,@FAC2         If result string
       BR   GA7F6
       CZ   V@3(@VSPTR)       If functional
       BS   ERRSNM
       BR   GA7FC              not a string
GA7F6  CZ   V@3(@VSPTR)       If functional
       BR   ERRSNM
***** NOW RESTORE SYMBOL TABLE AND RESUME *****************
***** EXECUTION AT THE ORIGINAL LINE **********************
GA7FC  CALL DELINK            Delink the parameter entry
       DST  V@8(@VSPTR),@PGMPTR Manual pop to get ptr back
       DDEC @PGMPTR           Back up text pointer
       XML  PGMCHR            Get next token
       XML  CONT
DELINK DST  @SYMTAB,@TEMP5    Save addr of S.T. entry just
*                             in case entry is a string
*                             (must free the string)
       MOVE 4,V@4(@VSPTR),@SYMTAB  Restore old symbol table
*                             pointer and free space pointe
*                             This handles the freeing of t
*                             string value which was assign
*                             to the parameter.
       CGE  0,V*TEMP5         If string parmeter
       BS   GA84C
       DST  V@6(@TEMP5),@TEMP5 Where the string is
       DCZ  @TEMP5            If non-null string
       BS   GA833
       DST  V@-3(@TEMP5),@TEMP2 Get backpointer
       DCHE @SYMTAB,@TEMP2    If not used
       BS   GA833
       DCLR V@-3(@TEMP5)      Free up the string
* This handles the special case of F$(X$)=X$
* The result, which was permanent, must be made a temp.
GA833  CEQ  >65,@FAC2         If string result
       BR   GA84A
       DCHE @SYMTAB,@FAC      If came from argument
       BS   GA84A
       DCZ  @FAC4             If non-null
       BS   GA846
       DCLR V@-3(@FAC4)       Clear the backpointer
GA846  DST  >001C,@FAC        Make it a temp
GA84A  BR   GA856             If numeric parameter
GA84C  CZ   @RAMTOP           If ERAM exist
       BS   GA856
       DADD 8,@RAMFRE         Remove 8 bytes of value
GA856  DSUB 8,@VSPTR          Trash the stack entry
       RTN                    And retrun
ATTNUT XML  PARSE
       BYTE RPARZ
       CALL CKSTNM            CHECK FOR NUMERIC OR STRING
       XML  SPEED             Insure argument is in
       BYTE RANGE          *   range of 0-30
       BYTE 0
       DATA 30
       SRL  1,@FAC1           0,1 : 0000        ATTENUATION
*                             2,3 : 0001
*                             4,5 : 0010
*                             6,7 : 0011        ETC...
       OR   >F0,@FAC1         REGISTER BITS
       RTN
***********************************************************
* SUBROUTINE TO SET POINTER TO EACH DATUM
***********************************************************
DATAST DDEC @LNBUF            Point to 1st byte of line ptr
       CALL GRSUB2            Read 2 bytes from VDP or ERAM
       BYTE LNBUF           *  (use GREAD1), @LNBUF: Source
*                           *  address in ERAM or VDP
       DST  @EEE1,@DATA       Put it in @DATA
       CALL SRDATA            Look for 'DATA' on the line
       BR   DATST1            OK, FOUND ANOTHER 'DATA' STMT
       DDECT @LNBUF           NO
       DCEQ  @STLN,@LNBUF
       BS   GA887
       DDEC @LNBUF            Point to 1st token address
       BR   DATAST
GA887  CLR  @DATA             Indicate no data
DATST1 RTN
***********************************************************
* Subroutine to get line number and goto routine to display
* it on the screen.
***********************************************************
ASC    CZ   @RAMFLG
       BR   GA897
       DST  V@-2(@EXTRAM),@ARG2   Get line # in
       BR   GA8A5
GA897  DST  2,@FFF1           @FFF1 : Byte count
       DST  @EXTRAM,@DDD1     @DDD1 : Source addr in ERAM
       DDECT @DDD1
       XML  GREAD1            Read data from ERAM
       DST  @EEE1,@ARG2       @EEE1 : Destination addr on C
GA8A5  AND  >7F,@ARG2         Reset the breakpoint if any
       B    DISO
***********************************************************
* Code to decode error returned from ALC
***********************************************************
ERORZ  CASE @ERRCOD           DECODE ERROR FROM INTERPRETER
       BR   ERRSYN            0 SYNTAX ERROR
       BR   ERRMEM            1 MEMORY FULL
       BR   ERRBV             2 BAD VALUE
       BR   ERRLNF            3 LINE NOT FOUND
       BR   ERRSYN            4 SYNTAX
       BR   ERRBS             5 BAD SUBSCRIPT
       BR   ERRSNM            6 STRING-NUMBER MISMATCH
       BR   ERRSO             7 STACK OVERFLOW
       BR   ERRBA             8 BAD ARGUMENT
       BR   ERRRWG            9 RETURN WITHOUT GOSUB
       BR   ERRIAL            A INCORRECT ARGUMENT LIST
       BR   ERRFNN            B FOR/NEXT NESTING
       BR   ERRNWF            C NEXT WITHOUT FOR
       BR   ERRMUV            D IMPROPERLY USED NAME
       BR   ERRIAL            E INCORRECT ARGUMENT LIST
       BR   ERRRSC            F RECURSIVE SUBPROGRAM CALL
       BR   ERRSNF           10 SUBPROGRAM NOT FOUND
       BR   ERROLP           11 ONLY LEGAL IN A PROGRAM
       BR   ERRSNS           12 MUST BE IN SUBPROGRAM
***********************************************************
* SUBROUTINE TO GET LINE # FOLLOWING 'BREAK', 'UNBREAK',
* 'RESTORE'
***********************************************************
LINE   CEQ  LNZ,@CHAT         Should be line # reference
       BR   ERRSYN
       XML  PGMCHR            Get high order line #
       ST   @CHAT,@FAC        Build result in FAC, FAC1
       XML  PGMCHR
       ST   @CHAT,@FAC1       Low order line #
       XML  PGMCHR            Get token following line #
       RTN
CONV1  CLR  @FAC10
       XML  CSNUM             Convert String to Number
***********************************************************
       ST   @FAC10,V@CSNTP1
       DST  @FAC12,V@CSNTMP Save those in temporary, becaus
*                            in ERROV : WARNING routine hav
*                            FAC12 and FAC10 values changed
***********************************************************
WRNNO  CZ   @FAC10            Numeric overflow
       BS   GA8F9
       CALL WARNZZ
       BYTE 2
GA8F9  RTN
***********************************************************
*                SUBROUTINE FOR 'GCHAR'
***********************************************************
GCHAR  CALL GPHV              Get X,Y values
GCHAR2 CALL NUMVAR            Get pointer to return variabl
       MOVE 8,G@FLT1,@FAC     Clear FAC
       ST   @CB,@FAC1         Get the character
       SUB  OFFSET,@FAC1      Remove screen offset
       CHE  100,@FAC1
       BR   GA919
       EX   @FAC1,@FAC2
       DIV  100,@FAC1
       INC  @FAC
GA919  XML  ASSGNV            Assign the value to the symbo
* RXB PATCH CODE
       BR   GCHARA
***********************************************************
*               SUBROUTINE FOR 'COLOR'
***********************************************************
COLOR  XML  SPEED             Must be
       BYTE SYNCHK        *     at a
       BYTE LPARZ         *       left parenthesis
* RXB PATCH CODE
COL08  DCLR @VAR0             Clear ALL pointer
       CEQ  ALLZ,@CHAT        ALL?
       BR   COL09             No.
       ST   ALLZ,@VAR0        Yes, store it in pointer
       DCLR @FAC              Set 0
       XML  PGMCHR            Skip ALL token.
       CALL COMMA2            Skip comma.
       BR   COL21             Start ALL RXB routine
COL09  CEQ  NUMBEZ,@CHAT      If sprite number specified
       BR   COL20
       CALL CHAR1             Check sprite number (SPNUM3)
COL10  CALL SPCOL             Put the color in SAL
       CEQ  COMMAZ,@CHAT      More color changes
       BR   LNKRTN
       CALL CHAR2             Skip and get sprite number (S
       BR   COL10
* This part for regular color change routine
COL20  XML  SPEED             Parse the character
       BYTE PARCOM         *   set and insure a comma
       XML  SPEED             Insure in range of
       BYTE RANGE          *   0<= x <= 14
* RXB PATCH CODE
*      BYTE 0,0,14
       BYTE 0,0,16
COL21  DADD >080F,@FAC        Color table addr(>0810 - >081
       XML  VPUSH             Push table set address
       XML  SPEED             Parse the foreground color
       BYTE PARCOM         *   and insure a comma
       CALL RAN16             Error if >16 or <1
       ST   @FAC1,@VAR4       Save it
       SLL  4,@VAR4           Foreground color in 4 MSBits
       XML  PARSE             Get background color
       BYTE RPARZ
       CALL RAN16             Error if >16 or <1
       OR   @FAC1,@VAR4       Background color in 4 LSBits
       XML  VPOP              Get color table address
       ST   @VAR4,V*FAC       Load the colors into the tabl
* RXB PATCH CODE
       CEQ  ALLZ,@VAR0        ALL in pointer.
       BR   COL22             No.
       MOVE 14,V*FAC,V@1(@FAC) Fill color table with values
COL22  CEQ  COMMAZ,@CHAT      End of call. Go back.
       BR   LNKRTN
       XML  PGMCHR            Skip ","
       BR   COL08             Take care of the next set
*      CALL SPCOL -- Changes color of sprite.
*                    Called also from SPRITE.
SPCOL  XML  PARSE
       BYTE RPARZ          *  Get the color number
       CALL RAN16             Check range 1 - 16
       ST   @FAC1,V@3(@SPSAL) Store in SAL
       RTN
***********************************************************
* INTARG - Insures that the value in FAC is a numeric,
*          converts it to integer, issues error message if
*          necessary or returns.
***********************************************************
INTARG CH   >63,@FAC2         If string - error
       BS   ERRSNM
       CLR  @FAC10            ASSUME NO ERROR OR WARNING
       DCLR @FPERAD
       XML  FLTINT
       CZ   @FAC10            If error
       BR   ERRBV
       CGE  0,@FAC            Can't be < zero
       BR   ERRBV
       RTN
* FAC IS SET UP WITH F.P. 1
JOYXY  ST   @VAR0,@FAC1
       CZ   @VAR0             If <>0
       BR   GA995
       CLR  @FAC              (>0000000000000000)
       BR   GA99D
GA995  CGE  0,@VAR0
       BS   GA99D
       ST   >BF,@FAC
GA99D  XML  ASSGNV            Assign the value
       RTN
KEYJOY ST   @FAC1,@VAR0       Keyboard selection
       CALL NUMVAR            Get variable for key-code
       CEQ  COMMAZ,@CHAT      If not comma - error
       BR   ERRSYN
       XML  PGMCHR            Get next character
       CALL NUMVAR            Get variable for key-status
       ST   @VAR0,@KEYBD      Keyboard selection
       MOVE 8,G@FLT1,@FAC     Set up float
* RXB PATCH CODE *************
*      SCAN                   SCAN the keyboard
*      CLR  @KEYBD            Clear the code(No affect on s
       CALL KEYSTR            * RXB KEY STRING COMPARISON *
       RTNC                   Return scan condition code
NUMVAR XML  SYM               Get the symbol name
       CLOG >C0,V*FAC         Can't be string or function
       BR   ERRMUV            It is, IMPROPERLY USED NAME E
       XML  SMB               Get value pointer
       XML  VPUSH             Put on stack for ASSGNV
       RTN                    And return
ATTREG DATA >8000,>A000,>C000,
       BYTE >9F,>BF,>DF,>FF,>00,>06
COMB   CEQ  LPARZ,@CHAT       If not '(' - error
       BR   ERRSYN
       RTN
SQUISH MOVE 8,V*FAC8,@FAC     Sneak it out
       DST  @VSPTR,@FAC14     Now move stack to squish it
       DSUB @FAC8,@FAC14        out - # of bytes to move
       BS   SQU05             If none to move
       MOVE @FAC14,V@8(@FAC8),V@-16(@FAC8)
SQU05  DSUB 8,@VSPTR
       RTN
***********************************************************
*                 SUBPROGRAM FOR CLEAR
***********************************************************
CLEAR  ALL  SPACE+OFFSET      Clear the screen
       ST   3,@XPT            Initialize screen pointer
       BR   LNKRT2            Return to caller
***********************************************************
*               SUBPROGRAM FOR VERSION
***********************************************************
VERS   CALL COMB              Insure have left parenthesis
       CALL ERRC05            Get symbol information
*----------------------------------------------------------
* Change version number to 110     6/16/81
       DST  2001,@FAC
       XML  CIF               Convert to floating point
*----------------------------------------------------------
       BR   ASSRTN            Assign and return to caller
* INIALIZATION DATA FOR SOUND
FLTS   BYTE >42,>0B,>12,>22,>00,>00,>00,>00
SNDREG BYTE >01,>FF,>01,>04,>9F,>BF,>DF,>FF,>00
***********************************************************
*                SUBPROGRAM FOR 'SOUND'
* Builds 2 blocks in VDP RAM
* 1st BLOCK : >01,<ATTENUATION FOR NOISE>,<INTERRUPT COUNT>
* 2nd BLOCK : >04,>9F,>BF,>DF,>FF,>00
***********************************************************
SOUND  DCEQ VRMSND,@>83CC     Insure previous sound started
       BS   SOUND
       MOVE 9,G@SNDREG,V@VRMSND
       CALL LPAR              Duration in milliseconds
       CGE  0,@FAC            Don't wait for completion
       BS   GAA39
       DNEG @FAC                of previous sound
       DCLR @PRTNFN           Make GPL interpeters stop pre
GAA39  XML  SPEED             Insure duration
       BYTE RANGE           *  is in range
       BYTE 1               *   of 1 - 4250
       DATA 4250
* Convert duration into 1/60s of a second
       DMUL 6,@FAC            Duration * 6
       DDIV 100,@FAC          (duration * 6) / 100
       CZ   @FAC1             If duration =0
       BR   GAA4D
       INC  @FAC1             Set it to 1/60th of a second
GAA4D  ST   @FAC1,V@VRMSND+2    3rd byte of the 1st block
*                          | INTERUPT COUNT
***********************************************************
*      SOUND TABLE OF 10 BYTES IN CPU RAM (>00 - >09)
* >00 - >05 : FREQUENCY CONTROL
* >06 - >08 : ATTENUATION CONTROL
* >09       : NOISE CONTROL(non-zero = noise encountered)
* >0A       : POINTER FOR CURRENT FREQENCY CONTROL
* >0B       : POINTER FOR CURRENT ATTENUATION CONTROL
*                    >00 , >01 FOR REG 0;
*                    >02 , >03 FOR REG 1;
*                    >04 , >05 FOR REG 2;
* REG0 : >8000, REG1 : >A000, REG3 : >C000
* INITIALIZE ATTENUATION CONTROL
* REG0 : >9F, REG1 : >BF, REG2 : >DF
***********************************************************
       MOVE 12,G@ATTREG,@>8300
SOUND1 XML  SPEED             Parse the frequency value
       BYTE PARCOM         *   and insure a comma
       CALL CKSTNM            Must be a numeric
       CGE  0,@FAC            Noise if negative
       BR   SOUND2
       MOVE 8,G@FLTS,@ARG     Constant 111834
       XML  FDIV              P = 111834/FREQUENCY
       XML  SPEED             Insure in range
       BYTE RANGE
       BYTE 3               * Range: 3 - 1023
       DATA 1023
* GET THE 4 L.S.Bits BITS AND 6 M.S.Bits OF 'P'
       DSRC 4,@FAC
       SRL  4,@FAC
       DOR  @FAC,*STADDR  1st byte of frequency control byt
*                         BIT   7   6   5   4   3   2   1
*                               1  <REG>    0  <L.S.B. 4 OF
*                         2nd byte of frequency control byt
*                               0   0   <M.S.B. 6 of 'P'
       INCT @STADDR           Advance ponter for next time
       CALL ATTNUT            Get attenuation
*                        BIT    7   6   5   4   3   2   1
*                               1   <REG>   1   0   0   0
       AND  @FAC1,*VAR2         1   <REG>   1   <ATTN/2 DB>
       INC  @VAR2             Advance pointer for next time
* CHECK FOR END OF SOUND CALL
SOUND3 CEQ  RPARZ,@CHAT       End of statement?
       BS   SOUND5
       XML  SPEED             If not right parenthesis
       BYTE SYNCHK        *    then must be at
       BYTE COMMAZ        *      a comma
       CEQ  6,@STADDR         If not 3 regs yet
       BR   SOUND1
* 3 sound regs already - so must be noise control
       XML  SPEED             Get frequency (should be nois
       BYTE PARCOM        *     and insure a comma
       CALL CKSTNM            Must be a numeric value
       CGE  0,@FAC            If not noise-error
       BS   ERRBV
* NOISE CONTROL
SOUND2 CEQ  >FF,@>8309        * BAD ARGUMENT ERROR
       BR   ERRBA
       DNEG @FAC              -(FREQUENCY)
       XML  SPEED             Insure in range
       BYTE RANGE         *    of 1 - 8
       BYTE 1             *
       DATA 8
       DEC  @FAC1             0 - 7 (2nd BIT: 'T')
*                                           OTH, 1ST BITS:
       ST   @FAC1,@>8309
       OR   >E0,@>8309        Noise control byte:
*                        BIT  7   6   5   4   3   2   1   0
*                             1   1   1   0   0  <T>  < S >
* PUT ATTENUATION IN THE 2ND BYTE OF 1ST BLOCK
       CALL ATTNUT
       ST   @FAC1,V@VRMSND+1
*                             1   1   1   1   < ATTN/2  DB>
       BR   SOUND3            Go check for end of list
SOUND5 CLR  @VAR5             Pointer to sound table
SND05  CZ   @PRTNFN           Wait untild previous
       BS   SOUND6
       SCAN                   Is finished and
       BR   SND05              look for a break-key
       CEQ  BREAK,@RKEY       If not break-key
       BR   SND05
       BR   EXEC6C            If BREAK-KEY encountered
* LOAD SOUND TABLE
SOUND6 ST   *VAR5,@>8400      SOUND ADDRESS PORT
       INC  @VAR5             Next byte in table
       CEQ  >0A,@VAR5         If not finished
       BR   SOUND6
       DST  VRMSND,@FAC       Where the 2 blocks are
       I/O  1,@FAC            Start sound from VDP list
       BR   LNKRTN            Return to caller
***********************************************************
*                SUBPROGRAM FOR 'HCHAR'
***********************************************************
HCHAR  CALL HVCHR             Get X, Y values character, #
       DCZ  @FAC              If 0 characters
       BS   HCHAR2
HCHAR1 BYTE >08,>E0,>00,>FB  * FMT '@VAR0'   Display horizo
       DDEC @FAC              Done yet?
       BR   HCHAR1            No, finish it
* RXB PATCH CODE
HCHAR2 CEQ  COMMAZ,@CHAT
       BS   HCHAR
XPTRTN ST   @MNUM,@XPT        Restore X-pointer
LNKRTN XML  SPEED             Must be at
       BYTE SYNCHK        *     a right
       BYTE RPARZ         *      parenthesis
LNKRT2 CALL CHKEND            Check end of statement
       BR   ERRSYN            If not end-of-stmt , error
       CALL RETURN            Return to caller
***********************************************************
*                SUBPROGRAM FOR 'VCHAR'
***********************************************************
VCHAR  CALL HVCHR             Get X, Y values character, #
       DCZ  @FAC              If 0 characters
       BS   VCHAR2
VCHAR1 BYTE >08,>E0,>00,>9E,>FB * FMT '@VAR0',>31 Display v
       DDEC @FAC              Done yet?
       BS   VCHAR2            Yes, return
       CZ   @YPT              If not at start of colunm
       BR   VCHAR1
       INC  @XPT              Move X-ptr to right one colun
       B    VCHAR1
* RXB PATCH CODE
VCHAR2 CEQ  COMMAZ,@CHAT
       BS   VCHAR
       BR   XPTRTN
***********************************************************
*               SUBPROGRAM FOR 'CHAR'
***********************************************************
CHARLY CALL COMB
CHAR5  XML  PGMCHR            Skip "(" or ","
* RXB PATCH CODE
       CEQ  ALLZ,@CHAT
       BR   GAB1F
       XML  PGMCHR
       CALL COMMA2
       ST   ALLZ,@VAR0
       DST  32,@FAC
       BR   GAB28
GAB1F  XML  SPEED             Get the first value
       BYTE PARCOM         *    and insure a comma
       XML  SPEED             Insure in range
       BYTE RANGE          *   of 32 - 143
* RXB PATCH CODE
       BYTE 30
       DATA 159
GAB28  DSLL 3,@FAC            Convert chr number to address
       DADD >0300,@FAC        CORRECT FOR OFFSET
       DST  @FAC,@VARY        Save it
       XML  PARSE             Get string
       BYTE RPARZ
       CEQ  >65,@FAC2         MUST BE STRING
       BR   ERRSNM
       MOVE 4,@FAC4,@VAR5     VAR5 pointer to string value
* Start defining character description.
*    VARY    Address of RAM for character description.
*    VAR5    Pointer to string value.
*    VAR7    Length of string value.
*    VAR9    Temporary counter.
*    VAR9+1  Temporary counter.
       DCH  64,@VAR7          Max 4 characters at a time
       BR   CHAR40
       DST  64,@VAR7          IGNORE THE EXCESSES
CHAR40 DCHE SPRVB,@VARY       Don't have space for
       BS   CHARL4
       ST   ZERO,@FAC         Floating Point Accumulator (>
       MOVE 15,@FAC,@FAC1
       DCZ  @VAR7             Fill with zero
       BS   CHAR50
       DCHE 16,@VAR7
       BS   GAB6B
       MOVE @VAR7,V*VAR5,@FAC Move whatever
       DCLR @VAR7
       BR   CHAR50
GAB6B  MOVE 16,V*VAR5,@FAC    Move one character
       DSUB 16,@VAR7          Less num of bytes to move
       DADD 16,@VAR5          Move pointer
CHAR50 ST   >4A,@VAR9         Move pointer (>4A=FAC)
       ST   1,@VAR9+1
       B    GAB84
GAB82  INC  @VAR9+1
GAB84  CGT  8,@VAR9+1
       BS   GABC3
       CLR  @BYTES            Clear dot-building byte
CHARL2 SLL  4,@BYTES          For loop(2 chars per byte)
       ST   *VAR9,@ARG
       CHE  ZERO,@ARG         If < 0
       BR   ERRBV
       CGT  NINE,@ARG         If in 0-9
       BR   CHARL3
       CHE  A,@ARG            If > 9 but < A
       BR   ERRBV
       CH   F,@ARG            If > F
       BS   ERRBV
CHARL3 SUB  ZERO,@ARG         Character - >30
       CH   10,@ARG           If in A-F
       BR   GABB1
       SUB  7,@ARG            Correct for that too
GABB1  OR   @ARG,@BYTES       Dot expression
       INC  @VAR9
       CLOG 1,@VAR9           1st half of row finished?
       BR   CHARL2            Yes, do 2nd half
*                              (each takes half byte)
       ST   @BYTES,V*VARY     Load characters
       DINC @VARY
       BR   GAB82             Load characters on next row
GABC3  DCZ  @VAR7             More char to describe
       BR   CHAR40
* RXB PATCH CODE
       CEQ  ALLZ,@VAR0
       BR   CHARL4
       DCLR @VAR0
CHRFIL MOVE 8,V@>0400,V@>0408(@VAR0)
       DADD 8,@VAR0
       DCEQ 94*8,@VAR0
       BR   CHRFIL
CHARL4 CEQ  COMMAZ,@CHAT      More specified?
       BS   CHAR5
       BR   LNKRTN            Return
***********************************************************
*              SUBPROGRAM FOR 'KEY'
***********************************************************
KEY    CALL SPAR              GET KEY UNIT
* RXB PATCH LABEL ************
GABD1  XML  SPEED             Insure in range
       BYTE RANGE          *   of 0 - 5
       BYTE 0
       DATA 5
       CALL KEYJOY            Get variables for code and st
*                              and scan keyboard
*                             KEYJOY returns key status
       BS   KEY1B             KEY STATUS = 1
       DNEG @FAC              Assume status = -1
       CEQ  >FF,@RKEY         But correct if = 0
       BR   KEY1B
       DCLR @FAC              KEY STATUS = 0
KEY1B  XML  ASSGNV            Assign value in variable
       DST  >4001,@FAC        Re-store F.P. 1 in FAC
       CZ   @RKEY             If key-code = 0
       BS   KEY2
       CEQ  >FF,@RKEY         No key depressed,
       BS   KEY1C              key code assigned to -1
* FORMAT FOR KEYCODES ABOVE 99 ADDED FOR 99/4A HIGHEST
* KEYCODE (OTHER THAN >FF) IS >C6=198
* 5/7/81
       CHE  100,@RKEY
       BR   GAC04
       INC  @FAC
       SUB  100,@RKEY
       ST   @RKEY,@FAC2       FLOATING FORMAT (>4001__00000
       B    GAC07
GAC04  ST   @RKEY,@FAC1       FLOATING FORMAT (>40__0000000
GAC07  BR   KEY2A
KEY1C  DNEG @FAC              KEY CODE ASSIGNED TO -1
       BR   KEY2A
KEY2   DCLR @FAC              (>000000000000000)
KEY2A  XML  ASSGNV            ASSIGN VALUE TO VARIABLE
* RXB PATCH CODE *************
*      BR   LNKRTN
       BR   SUBRTN
***********************************************************
*                  SUBPROGRAM FOR 'JOYSTICK'
***********************************************************
JOYST  CALL SPAR              KEY UNIT
* RXB PATCH LABEL ************
GAC16  XML  SPEED             Insure in range
       BYTE RANGE          *   of 1 - 4
       BYTE 1
       DATA 4
       CALL KEYJOY            GET VARIABLES FOR X, Y
*                              AND SCAN KEYBOARD
       ST   @JOYY,@VAR0       JOYSTICK Y POSITION
       CALL JOYXY             -4 to +4
       DST  >4001,@FAC        Re-store F.P. 1 in FAC
       ST   @JOYX,@VAR0       JOYSTICK X POSITION
       CALL JOYXY             -4 to +4
* RXB PATCH CODE *************
*      BR   LNKRTN
       BR   SUBRTN
***********************************************************
* INSURE LEFT PARENTHESIS AND THEN PARSE TO A COMMA
***********************************************************
* RXB PATCH CODE
LPAR   CEQ  COMMAZ,@CHAT
       BS   CPAR
       XML  SPEED             Must be
       BYTE SYNCHK          *  at a
       BYTE LPARZ           *    left parenthesis
       BR   GAC35
CPAR   XML  SPEED
       BYTE SYNCHK
       BYTE COMMAZ
* RXB PATCH LABEL ***********
GAC35  XML  PARSE             Do the parse
       BYTE COMMAZ          * Stop on a comma
       XML  SPEED             Must be
       BYTE SYNCHK          *  at a
       BYTE COMMAZ          *   comma
       RTN
***********************************************************
* SUBROUTINE FOR 'RANGE' USED IN ALL SOUND AND GRAPHICS
***********************************************************
RAN16  XML  SPEED             Insure in range
       BYTE RANGE          *   of 1 to 16
       BYTE 1
       DATA 16
       DEC  @FAC1             Adjust to internal range
       RTN
***********************************************************
* SUBROUTINE TO GET ROW, COLUMN VALUES
***********************************************************
* RXB PATCH CODE
GPHV   CALL LPAR              Insure '(', parse, insure ','
* RXB PATCH CODE
GPHVRC XML  SPEED             Insure in range
       BYTE RANGE           *  of 1 - 24
       BYTE 1
       DATA 24
       DEC  @FAC1             Adjust to internal range
       ST   @XPT,@MNUM
       ST   @FAC1,@YPT        Set row pointer
       XML  SPEED             Get column value
       BYTE PARCOM          *  and insure a comma
       XML  SPEED             Insure in range
       BYTE RANGE           *  of 1 to 32
       BYTE 1
       DATA 32
       DEC  @FAC1             Internal range: 0 - 31
       ST   @FAC1,@XPT        Set column pointer
       RTN
*  Subroutine to control border color
* Character background is also affected since transparent
*  is used.
BORDER CALL PARFF             Insure '(' , and parse
       CALL RAN16             Check 1 - 16 & put in interna
       MOVE 1,@FAC1,#7        Load VDP register
       BR   LNKRT2            Return to XB program
* Get ROW, COLUMN VALUES AND NUMBER OF CHARACTERS
HVCHR  CALL GPHV              Get X, Y VALUES
       XML  PARSE
       BYTE RPARZ
       CALL INTARG
       ADD  OFFSET,@FAC1
       ST   @FAC1,@VAR0       SAVE THE CHARACTER
       DST  1,@FAC            ASSUME 1 CHARACTER
       CEQ  RPARZ,@CHAT       If not right parenthesis
       BS   GAC95
       XML  SPEED             Must be
       BYTE SYNCHK          *   at a
       BYTE COMMAZ          *    comma
       XML  PARSE             # OF CHARACTERS
       BYTE RPARZ
       CALL INTARG            FLOATING TO INTEGER
GAC95  RTN
***********************************************************
* ERRWXY - Is the subroutine for CALL ERR(W,X,Y,Z)
*  The parameters indicate:
*   W - The error code # of the error
*   X - Indicates whether execution(-1) error or
*       I/O (0-255) error on LUNO 0-255
*   Y - Indicates the severity code of the error
*   Z - Line number of the error
*   ERR Can be called with 2 forms:
*       CALL ERR(W,X,Y,Z) and CALL ERR(W,X)
*   If ERR is called and no error has occured then all
*   values returned are zero.
***********************************************************
ERRWXY DST  @VSPTR,@FAC8      Get a temp VSPTR
GAC99  DCH  @STVSPT,@FAC8     While not a bottom of stack
       BR   GACD0
       ST   V@2(@FAC8),@ARG   Keep ID code in ARG area
       CEQ  >69,@ARG          *** ERROR entry
       BR   GACAF
       CALL SQUISH            Squish it out of the stack
       XML  VPUSH             Put permanent copy of error
*                              entry on stack
       BR   ERR10             Jump out now
* Jump always
GACAF  CEQ  >67,@ARG          *** FOR entry
       BR   GACBA
       DSUB 32,@FAC8          Skip it
       BR   GACCE
GACBA  CEQ  >66,@ARG          *** GOSUB entry
       BR   GACC5
       DSUB 8,@FAC8           Skip it
       BR   GACCE
GACC5  CEQ  >6A,@ARG          * SYNTAX ERROR
       BR   ERRSYN
       DSUB 16,@FAC8          Skip it
GACCE  BR   GAC99
GACD0  DST  >0080,@FAC        No error entry there so
       DST  >6900,@FAC2        fake one
       DCLR @FAC4
       DCLR @FAC6
ERR10  XML  VPUSH             Push the temporary entry on
*                              top of stack
* Code to get "W" in
       CALL COMB              Check for left parenthesis
       CALL ERRC05            Pick up user's symbol
       ST   V@-8(@VSPTR),@FAC1 Get error code
       XML  CIF               Convert it to floating
       XML  ASSGNV            Assign it
* Code to get "X" in
       CALL ERRCOM            Check syntax & get user's sym
       CLOG >80,V@-7(@VSPTR)  If execution
       BR   GAD03
       MOVE 8,G@FLT1,@FAC     Make it such
       DNEG @FAC              Make it a negative
       BR   GAD0B
GAD03  ST   V@-5(@VSPTR),@FAC1 Get I/O LUNO number
       XML  CIF               Convert it to floating
GAD0B  XML  ASSGNV
* Code to get "Y" in
       CEQ  RPARZ,@CHAT       If long form of CALL ERR
       BS   GAD42
       CALL ERRCOM            Check syntax & get user's sym
       ST   V@-7(@VSPTR),@FAC1 Get severity code
       AND  >7F,@FAC1         Reset execution  /  I/O flag
       XML  CIF               Convert it
       XML  ASSGNV            Assign it
* Code to get "Z" in
       CALL ERRCOM            Check syntax & get symbol
       DST  V@-2(@VSPTR),@FAC2 Get line pointer
       DST  @FAC2,@FAC
       DCZ  @FAC2             If line number exists
       BS   GAD3E
       DDECT @FAC2            Point to the line #
       CALL GRSUB1            Read line # (2 bytes) from VD
*                              or ERAM (use GREAD)
       BYTE >4C             * @FAC2: Source addr on ERAM/VD
       DST  @EEE,@FAC         Put the line # in FAC
       AND  >7F,@FAC          Reset the breakpoint if any
GAD3E  XML  CIF               Convert it
       XML  ASSGNV            Assign it
GAD42  XML  VPOP              Trash the temporary entry
       B    LNKRTN            Return from subprogram
* Must be long branch because of AND above
ERRCOM CEQ  COMMAZ,@CHAT      Check for comma
       BR   ERRSYN
ERRC05 XML  PGMCHR            Get the next character
       XML  SYM               Collect name & s.t. entry
       XML  SMB               Get value space
       XML  VPUSH             Push it
       CLR  @FAC              Set up for conversion
       RTN
* CHANGE IN ADDRESS OF THE ERROR CALLS WILL AFFECT
* THE FILE SUBS.....
*     ERROR messages called from this file
ERRSYN CALL ERRZZ             * SYNTAX ERROR
       BYTE 3             *   (shared by SUBS)
ERRSNM CALL ERRZZ             * STRING-NUMBER MISMATCH
       BYTE 7             *   (shared by SUBS)
ERRMUV CALL ERRZZ             * IMPROPERLY USED NAME
       BYTE 9
ERRMEM CALL ERRZZ             * MEMORY FULL
       BYTE 11
ERRSO  CALL ERRZZ             * STACK OVERFLOW
       BYTE 12
ERRNWF CALL ERRZZ             * NEXT WITHOUT FOR
       BYTE 13
ERRFNN CALL ERRZZ             * FOR/NEXT NESTING
       BYTE 14
ERRSNS CALL ERRZZ             * MUST BE IN SUBPROGRAM
       BYTE 15
ERRRSC CALL ERRZZ             * RECURSIVE SUBPROGRAM CALL
       BYTE 16
ERRRWG CALL ERRZZ             * RETURN WITHOUT GOSUB
       BYTE 18
ERRBS  CALL ERRZZ             * BAD SUBSCRIPT
       BYTE 20
ERRLNF CALL ERRZZ             * LINE NOT FOUND
       BYTE 22
ERRBA  CALL ERRZZ             * BAD ARGUMENTS
       BYTE 28
ERRBV  CALL ERRZZ             * BAD VALUE
       BYTE 30            *   (shared by SUBS)
ERRIAL CALL ERRZZ             * INCORRECT ARGUMENT LIST
       BYTE 31            *   (shared by SUBS)
ERRSNF CALL ERRZZ             * SUBPROGRAM NOT FOUND
       BYTE 37
* Other error messages appear in this program
* ERRRDY      * READY                        DATA 0
* ERRBRK      * BREAK POINT                  DATA 1
* ERROLP      * ONLY LEGAL IN A PROGRAM      DATA 27
*
* WRNN01      * NUMERIC OVERFLOW             DATA 2
* WRNS02
* WRNST1      * STRING TRUNCATED             DATA 19
* WRNST2
* WRNLNF      * LINE NOT FOUND               DATA 38
*
***********************************************************
       AORG >0E00
* SPRITE SUBROUTINES BRANCH TABLE
CHAR1  BR   SPNUM3            Called in CHARLY.    EXEC
CHAR2  BR   SPNUM2            Called in CHARLY.    EXEC
       BR   $                 Called in CHARLY.    EXEC
* SUBROUTINE LINK LIST
LINKS1 DATA LINKS2
       STRI 'SPRITE'
       DATA SPRTE
LINKS2 DATA LINKS3
       STRI 'DELSPRITE'
       DATA SPRDEL
LINKS3 DATA LINKS4
       STRI 'POSITION'
       DATA SPRPOS
LINKS4 DATA LINKS5
       STRI 'COINC'
       DATA ZSCOI
LINKS5 DATA LINKS6
       STRI 'MAGNIFY'
       DATA SPRMAG
LINKS6 DATA LINKS7
       STRI 'MOTION'
       DATA SPRMOV
LINKS7 DATA LINKS8
       STRI 'LOCATE'
       DATA SPRLOC
LINKS8 DATA LINKS9
       STRI 'PATTERN'
       DATA SPRPAT
LINKS9 DATA LINKSA
       STRI 'DISTANCE'
       DATA ZSDIST
LINKSA DATA LINKSB
       STRI 'SAY'
       DATA SAY
LINKSB DATA LINKSC
       STRI 'SPGET'
       DATA SPGET
LINKSC DATA LINKSD
       STRI 'CHARSET'
       DATA CHRSET
***********************************************************
* CALL SPRITE(#SPRITE,CHAR,COLOR,Y,X,(YSPEED,XSPEED),...)
***********************************************************
SPRTE  CALL SPNUM1            Check sprite mode and skip "(
       CALL SPNUM2            Get sprite number
SPRT3  CALL SPCHR             Put character number for spri
       XML  SPEED
       BYTE SYNCHK
       BYTE COMMAZ         *  Check for comma and skip it
       CALL GA01E             Put sprite color in SAL  (SPC
       XML  SPEED             Insure at a comma
       BYTE SYNCHK
       BYTE COMMAZ
       CALL SPLOC             Put location of sprite in SAL
       DST  @SP04+1,V*SPSAL   Put in location of sprite
* Finish defining SAL. Check if velocity is specified
SPRT4  CEQ  COMMAZ,@CHAT      Finished!!!!!
       BR   GB0F2
       XML  PGMCHR
       CEQ  NUMBEZ,@CHAT      Next sprite specified
       BR   GAEBB
       CALL SPNUM3            Get the next sprite number
       BR   SPRT3             And go!
GAEBB  CALL SPMOVE            Get the velocity first
       BR   SPRT4
***********************************************************
* CALL DELSPRITE(#SPR,.......)  or CALL DESPRITE(ALL)
***********************************************************
SPRDEL CALL SPNUM1            Insure at '('
SPDEL1 XML  PGMCHR            Skip "(" or ","
       CEQ  NUMBEZ,@CHAT      If sprite number
       BR   GAEF6
       XML  PGMCHR            Skip "#"
       XML  PARSE             Parse the sprite number
       BYTE RPARZ
       CALL SPNUM4            Check and convert number
       DCLR V@>0480(@SPSAL)   Stop motion if moving
       DST  >C000,V*SPSAL     Hide the sprite off screen
*----------------------------------------------------------
* Add following 7 lines for speeding up XBASIC
       CEQ  @MOTION,V@SPNUM   Check current sprite
       BR   SPDEL2
* no. against sprite motion count
* yes, change to as low as possible
GAEE1  DEC  @MOTION
       BS   SPDEL2
       DSUB 4,@SPSAL
       DCZ  V@>0480(@SPSAL)
       BS   GAEE1
*----------------------------------------------------------
SPDEL2 CEQ  COMMAZ,@CHAT      If more sprites
       BS   SPDEL1
       BR   GAEFD
GAEF6  XML  SPEED             Must have 'ALL' else error
       BYTE SYNCHK
       BYTE ALLZ
       CALL SPRINT            Reinitialize all sprites
GAEFD  BR   GB0F2             Return to caller
***********************************************************
* CALL POSTION(#SPR,Y,X,...)
***********************************************************
SPRPOS CALL SPNUM1            Check for sprites and skip "(
SPRP02 CALL SPNUM2            Check sprite number
       CALL PREPN             Prepare Y-position return var
       XML  SPEED             Insure at a comma
       BYTE SYNCHK
       BYTE COMMAZ
       DST  V*SPSAL,@SP00     Read X, Y position
       ST   @SP00,@FAC1       Get Y position
       CEQ  >FE,@FAC1
       BR   GAF1C
       DINCT @FAC             Get 256 as an output
       BR   GAF1E
GAF1C  INCT @FAC1             Regular adjustment for user
GAF1E  CALL SPRP03            Check, convert & assign value
       CALL PREPN             Prepare X-pos return variable
       ST   @SP00+1,@FAC1     Get X position
       DINC @FAC              Adjust for the user
       CALL SPRP03            Check, convert & assign value
       CEQ  COMMAZ,@CHAT      If not finished
       BS   SPRP02
       BR   GB0F2             Return
SPRP03 XML  CIF               Convert integer to float
       DCEQ >C000,@SP00       If hidden sprite
       BR   GAF3D
       DCLR @FAC              Return value zero
GAF3D  XML  ASSGNV            Assign to variable
       RTN
***********************************************************
* CALL COINC(#SPR,#SPR,TOLERANCE,CODE)
* CALL COINC(#SPR,YLOC,XLOC,TOLERANCE,CODE)
* CALL COINC(ALL)
***********************************************************
SPRCOI CALL SPNUM1
       XML  PGMCHR            Skip "("
       CEQ  ALLZ,@CHAT        Check coinc of all sprites
       BR   GAF56
       XML  PGMCHR            Skip "ALL"
       CALL COMMA2            Check and skip ","
       CLOG >20,@VDPSTT       Check VDP status
* RXB PATCH CODE ************
*      BS   NULRTN
       BS   NR
       BR   GAF6C
* RXB PATCH CODE ************
GAF56  CALL CODIST            Get distance of 2 sprites
       CALL COMMA             Get tolerance level
       XML  SPEED
       BYTE RANGE           * Check against range
       BYTE 0               * FAC has tolerance level
       DATA 255
       DCH  @FAC,@SP00        Y-loc out of range
* RXB PATCH CODE ************
*      BS   NULRTN
       BS   NR
       DCH  @FAC,@SP04        X-loc out of range
* RXB PATCH CODE ************
*      BS   NULRTN
       BS   NR
* If no conincidence just return zero
GAF6C  CALL PREPN             Prepare for numeric output
       DST  >BFFF,@FAC        Store -1 in FAC
* RXB PATCH CODE ************
*      BR   ASSRTN
       BR   AR
***********************************************************
* CALL MAGNIFY(magnification factor=1 - 4)
***********************************************************
SPRMAG CALL SPNUM1            Insure at "("
       XML  PGMCHR            Skip the "("
       XML  PARSE             Parse the magnification facto
       BYTE RPARZ
       XML  SPEED
       BYTE RANGE
       BYTE 1
       DATA 4
* Next statement adding >DF to subtract 1 from FAC
       ADD  >DF,@FAC1         Turn on screen and interrupt
       MOVE 1,@FAC1,#1        Store it to VDP register 1
       BR   GB0F2
***********************************************************
* CALL MOTION(#SPR,YSPEED,XSPEED,...)
***********************************************************
SPRMOV CALL SPNUM1            Insure at "("
* RXB PATCH CODE *************
* SPRMV2 CALL SPNUM2            Get sprite number
SPRMV2 B    SPGS              GO or STOP
SPRMV3 CALL SPMOVE            Store velocity
SPRMV4 CEQ  COMMAZ,@CHAT      Loop if more
       BS   SPRMV2
       BR   GB0F2
***********************************************************
* CALL LOCATE(#SPR,YLOC,XLOC,...)
***********************************************************
SPRLOC CALL SPNUM1            Insure at "("
SPRLC2 CALL SPNUM2            Check sprite number
       CALL SPLOC             Read location
       DST  @SP04+1,V*SPSAL   Put in sprite location
       CEQ  COMMAZ,@CHAT      Loop if more
       BS   SPRLC2
       BR   GB0F2
***********************************************************
* CALL PATTERN(#SPR,CHAR,...)
***********************************************************
SPRPAT CALL SPNUM1            Insure at "("
SPRPT2 CALL SPNUM2            Get sprite number
       CALL SPCHR             Set the sprite character
       CEQ  COMMAZ,@CHAT      Loop if more
       BS   SPRPT2
       BR   GB0F2
***********************************************************
* CALL DISTANCE(#1,#2,DISTANCE)
* CALL DISTANCE(#1,Y,X,DISTANCE)
***********************************************************
DIST   CALL SPNUM1            Insure at "("
* RXB PATCH LABEL ************
GAFC4  XML  PGMCHR            Skip "("
       CALL CODIST            Get distance in Y and X
       CALL PREPN             Prepare return variable
       DMUL @SP00,@SP00       X=X*X
       DMUL @SP04,@SP04       Y=Y*Y
       DADD @SP06,@SP02       @SP02=X*X+Y*Y
       OVF                    Checking overflow bit
       BS   OVER              If overflow-indicate maximum
       DST  @SP02,@FAC        Put distance squared in FAC
       DCH  >7FFF,@SP02       If bigger then 128
       BR   GAFE5
OVER   DST  >7FFF,@FAC        Put maximum value
GAFE5  XML  CIF               Convert to floating format
* RXB PATCH CODE
*      BR   ASSRTN            Assign value and return
       BR   AR
***********************************************************
* CODIST routine gets locations of two sprites or one
*  sprite and Y and X position specified by a user and
*  calculates absolute value of Y and X distance.
***********************************************************
CODIST CLR  @SP00
       MOVE 7,@SP00,@SP00+1   Clear up first 8 bytes
       CEQ  NUMBEZ,@CHAT      Check for #
       BR   ERRSYN
       CALL SPNUM3            Get the first sprite
       DST  V*SPSAL,@SP00+1   Location of first sprite
       INC  @SP00+1           Increment to make range 1-256
       ST   @SP02,@SP02+1     Put X in SP02+1
       CLR  @SP02             Y in SP00+1
       CEQ  NUMBEZ,@CHAT      Get 2nd sprite
       BR   GB011
       CALL SPNUM3            Get the next sprite
       DST  V*SPSAL,@SP04+1   Location of second sprite
       BR   GB017
GB011  CALL SPLOC             Get Y and X location
       CALL COMMA2            Check for comma and skip
GB017  INC  @SP04+1           Increment to make range 1-256
       DSUB @SP04,@SP00       Difference in Y at SP00
       DABS @SP00             Get absolute value
       CLR  @SP04+1           Clear byte before X
       DSUB @SP02,@SP04+1     Difference in Y at SP04
       DABS @SP04+1           get the absolute value
       ST   @SP06,@SP04+1     Put in the right place
       RTN
***********************************************************
* CHRSET restores the standard character set and the
*  standard colors for the standard character set
*  (black on transparent)
***********************************************************
CHRSET CALL CHKEND            Must be at EOS now
       BR   ERRSYN            Else its an error
       ST   >40,@FAC2         Number of characters to load
       CALL CHRTBL            Call RXB routine to load
       ST   >10,V@>080F       Set 1st set to black on tranp
       MOVE 16,V@>080F,V@>0810  Ripple for rest
       CALL RETURN            Return to the caller
******************************
* SPNUM1 ROUTINE             *
******************************
SPNUM1 CEQ  LPARZ,@CHAT       Should be "("
       BR   ERRSYN
       RTN
******************************
* SPNUM2 ROUTINE             *
******************************
SPNUM2 XML  PGMCHR            Get the next character
SPNUM6 CEQ  NUMBEZ,@CHAT      Must be "#"
       BR   ERRSYN
SPNUM3 XML  PGMCHR            Get next character
       CALL COMMA             Parse up to comma and skip it
SPNUM4 XML  SPEED
       BYTE RANGE           * Verify the value is in range
       BYTE 1               * Sprite number 1 - 28
       DATA 28
*----------------------------------------------------------
* Insert a line here in sprite handling code for speeeding
*  up XB    5/22/81
* RXB PATCH LABLE ************
SPNUM5 ST   @FAC1,V@SPNUM     Keep sprite number
*----------------------------------------------------------
       DEC  @FAC1             Adjust for internal use
       DSLL 2,@FAC            Get location of SAL
       DADD >0300,@FAC        Sprite # * 4 + >0300
       DST  @FAC,@SPSAL       Save SAL location
       RTN
******************************
* SPLOC ROUTINE              *
******************************
SPLOC  CALL COMMA             Parse up to comma and skip it
       XML  SPEED
       BYTE RANGE           * Range of Y: 1 - 256
       BYTE 1
       DATA 256
       DECT @FAC1             Adjust for internal use: FF -
       DST  @FAC,@SP04        Store in SP04 area
       XML  PARSE
       BYTE RPARZ           * Parse to ")" or less
       XML  SPEED
       BYTE RANGE           * Get X value. Range: 1 - 256
       BYTE 1
       DATA 256
       DEC  @FAC1             Adjust for internal use: 0 -
       ST   @FAC1,@SP06       SP04+1=Y-loc and SP06=X-loc
       RTN
******************************
* SPCHR ROUTINE              *
******************************
SPCHR  XML  PARSE
       BYTE RPARZ
       XML  SPEED
       BYTE RANGE           * Check upper range
* RXB PATCH CODE
*      BYTE 32              * Character value 32 - 144
*      DATA 143
       BYTE 30
       DATA 159
       ADD  >60,@FAC1         Add offset to character numbe
       ST   @FAC1,V@2(@SPSAL) Store the character value
       RTN
******************************
* SPMOVE ROUTINE             *
******************************
SPMOVE CALL COMMA             Parse up to comma and skip
       CALL RANGEV            Check if numeric and convert
*                              to integer
       ST   @FAC1,@SPTMP      Store Y velocity
       XML  PARSE             Get X velocity
       BYTE RPARZ           * Check for ")" or less
       CALL RANGEV            Numeric check and convert
*                              to integer
SPMOVF ST   @SPTMP,@FAC     * @FAC=Y velocity, @FAC1=X velo
       DST  @FAC,V@>0480(@SPSAL)  Store velocities in SAL
*----------------------------------------------------------
* Add the following 3 lines for speeding up XB
       CH   @MOTION,V@SPNUM   Check current sprite
       BR   GB0BD              against sprite motion
*                                counter
       ST   V@SPNUM,@MOTION       higher? Yes, replace it
*----------------------------------------------------------
GB0BD  RTN
RANGEV CH   >63,@FAC2         The same as INTARG
       BS   ERRSNM
       CLR  @FAC10
       DCLR @FPERAD
       XML  FLTINT
       CZ   @FAC10
       BR   ERRBV
       DCGE 0,@FAC            If positive number,
       BR   GB0DB
       DCH  >007F,@FAC         should be 0 - 127
       BS   ERRBV
       BR   GB0E1             If negative number,
GB0DB  DCHE >FF80,@FAC         Should be -1 to -128
       BR   ERRBV
GB0E1  RTN                    Otherwise its ok.
******************************
* COMMA ROUTINE              *
******************************
COMMA  XML  PARSE
       BYTE COMMAZ
COMMA2 CEQ  COMMAZ,@CHAT
       BR   ERRSYN
       XML  PGMCHR            Get next character
       RTN
******************************
* LINK BACK TO XB            *
******************************
NULRTN CALL PREPN
ASSRTN XML  ASSGNV
GB0F2  B    GA01C                               (LNKRTN)
*******************************
* PREPARE FOR PASSING ARGUMENT*
*******************************
PREPN  XML  SYM               Pick up name & search table
       XML  SMB               Evaluate any subscripts
       CH   >63,@FAC2         If not numeric, error
       BS   ERRIAL
       XML  VPUSH             Save entry on stack
       CLR  @FAC              Clear FAC for new value
       MOVE 7,@FAC,@FAC1
       RTN
***********************************************************
* CALL SAY(....................)
*  Decode given parameter(s). Store all data first, then go
*   speak it all at once.
***********************************************************
SAY    CEQ  LPARZ,@CHAT       Must start with "("
       BR   ERRSYN
       DST  @VSPTR,@FAC2      Save current top of stack on
       XML  VPUSH              the stack
       DST  255,@BYTES        255 bytes = 85 3 byte entires
       XML  GETSTR            Get temp speech list string
       DST  >001C,@FAC        Indicate it is temp string (S
       DST  >6500,@FAC2       Indicate it is string entry
       DST  @SREF,@FAC4       Save pointer to temp string
       DST  @BYTES,@FAC6      Length is 255
       XML  VPUSH             Make it semi-permenant
* Set up pointers into the speak list
       DST  @FAC4,@PTFBSL     Front points to begining
       DST  @FAC4,@PTLBSL     Last now points to beginning
       DST  @PTFBSL,@PTEBSL
       DADD @FAC6,@PTEBSL     End points to the end+1
       CALL SETRW             Set PHROM read/write address
       CALL WAIT              Wait till no one is speaking
DIRSPK CALL GETPRM            Get next parameter
       BS   NEXT1             If non-null ASCII string
       DST  @FAC4,@PTFCIS     Set up pointer to first char
       DST  @FAC6,@PTLCIS     Set ptr-to-last-char-in-strin
       DADD @PTFCIS,@PTLCIS    by adding length-of-string
       DDEC @PTLCIS            and subtracting 1
* Make a speech list
       CALL SETRW             Set speech read/write addrs
       DST  @PTFCIS,@PTCCIS   Start at beginning of string
       CLR  @TOTTIM           Clear total time delay
       CALL GETTIM            Get first timing mark
       CALL TIMING            Get any subsequent marks
* The total first time delay is in TOTTIM now
GB158  DCH  @PTLCIS,@PTCCIS   While more string
       BS   GB1A7
       CALL PHRASE            Get next phrase
* If spell flag is 0, try to look the phrase up. If it
* can not be found, then set the spell flag, and it will be
* spelled out. If found, save on speak list.
       CZ   @SPLFLG           There is a phrase
       BR   GB173
       CALL LOOKUP            Try to look it up in the PHRO
       DCZ  @DATAAD           If not found then
       BR   GB170
       ST   1,@SPLFLG         Set the spell flag
       BR   GB173
GB170  CALL STDATA            Store data in list
* If spell flag is 1, set time delay to >3C, and take the
* phrase one character at a time (spell it). Look up each
* character: if not found, use 'UHOH' data instead.
* Regardless, store data on speak list.
GB173  CEQ  1,@SPLFLG         Need to spell it out?
       BR   GB1A0
       DST  @PTLCIP,@PTLCIL   Est last char to spell out
       ST   >3C,@TOTTIM       >3C used because sounds good
*                      Take each single character
* Skip over any embedded spaces encountered in a phrase
GB17E  CEQ  SPACE,V*PTFCIP
       BR   GB188
       DINC @PTFCIP
       BR   GB17E
* Set first and last pointers to same one character
GB188  DST  @PTFCIP,@PTLCIP
       CALL LOOKUP            Try to look it up
* If not found, use data to 'UHOH'
       DCZ  @DATAAD
       BR   GB196
       DST  >71F4,@DATAAD     Put addr of 'UHOH' in
GB196  CALL STDATA            Store data on speak list
       DINC @PTFCIP           Go on to next character
       DCH  @PTLCIL,@PTFCIP   Until done all
       BR   GB17E
* At this point, get next timing group. The first timing
* character has already been found, and it's value is still
* in TIMLEN. Therefore, initiatory call to GETTIM not
* needed. Simply clear TOTTIM and call TIMING.
GB1A0  CLR  @TOTTIM
       CALL TIMING
       BR   GB158
* At this point, finished all the phrases in this string.
* TOTTIM should equal >FE, it indicate end of sting If it
* doesn't equal >FE, it indicates that a timing group was
* put on the end of the string. Therefore, save the timing
* group with a null data address to show it is only timing.
GB1A7  CEQ  >FE,@TOTTIM
       BS   NEXT1
       DCLR @DATAAD
       CALL STDATA
* Next item could be direct string.
NEXT1  CEQ  COMMAZ,@CHAT      If direct string present
       BR   SPEAK
       CALL GETPRM            Get the next parameter
       BS   NEXT2             If non-null direct string
       ST   >FF,@TOTTIM       Mark TOTTIM as direct string
       XML  VPUSH             Save direct string on stack
       DST  @VSPTR,@DATAAD    Store stack addr on string
       CALL STDATA            And add to the speak list
* If the next character is a comma, loop thru it again
NEXT2  CEQ  COMMAZ,@CHAT
       BS   DIRSPK
* If end fall into SPEAK
***********************************************************
* SPEAK will actually speak the speech list. It tests the
* timing byte to see if it is an >FF. If it is, then the
* data following it points to a direct speech data string
* in VDP. If it is not, then the data following it points
* to a PHROM speech data list. In the first case, this
* routine will issue a speak external command to the PHROM
* and then feed bytes out to the PHROM as it requests them.
* In the second case, the address will be loaded out to the
* PHROM, and then a speak command will be issued.
***********************************************************
SPEAK  CALL SETRW             Set read/write address
GB1CE  DCHE @PTLBSL,@PTFBSL   More speech list to go
       BS   GB258
       CALL WAIT              Yes, wait until previous
*                              speech is though
       CEQ  >FF,V*PTFBSL      External speech data
       BS   GB1FE
       ST   V*PTFBSL,@TIMER   No, load timer
       NEG  @TIMER             and neg it to correct
       DST  V@1(@PTFBSL),@PTFBPH   Put addr into PTFBPH
       DADD 3,@PTFBSL               and skip to next node
LOOP1  CGE  0,@TIMER          Wait for time delay
       BR   LOOP1
       CZ   @PTFBPH           If there is data
       BS   GB1FC
       CALL LOADAD            Load the addr to PHROM
       ST   >50,@>8300(@WRITE)  and issue speak command
GB1FC  BR   CONTIN
GB1FE  DINC @PTFBSL           Speak external, skip over >FF
       DST  V*PTFBSL,@PTCBED  Set up pointer to 1st byte
       DST  V@4(@PTCBED),@PTCBED    in external speech data
       DINCT @PTFBSL          Skip addr bytes
       ST   V@-1(@PTCBED),@LENWST  Get Len of whole string
DIRSPH SUB  3,@LENWST         Minus 3 bytes overhead
* All external speech strings start with a >60
       CEQ  >60,V*PTCBED      Bad speech string
       BR   ERRBV
       CALL WAIT              Wait for go ahead
       DINCT @PTCBED          Skip spk ext & 1st byte len
       ST   V*PTCBED,@LENCST  Get len of current string
       DINC @PTCBED           Skip len byte to 1st real byt
       ST   16,@TEMP2         Do 1st 16 bytes (fill buff)
       ST   >60,@>8300(@WRITE) Start Speak External
LOOPR  ST   V*PTCBED,@>8300(@WRITE) Write byte to PHROM
       DINC @PTCBED           Go to next byte
       DEC  @LENWST           1 less char in whole string
       BS   CONTIN            Finished whole string?
       DEC  @LENCST           1 less char in curr string
       BS   DIRSPH            Finished current string?
       DEC  @TEMP2            1 less char in this loop
       BR   LOOPR             Not finished curr loop yet?
GB241  ST   @>8300(@READ),@SPKSTS   Read status from PHROM
 
* If the next statement is true, it means that speak was
* probably interupted and that it is shot at this point.
* Therefore, we are going to quit now.
       CLOG >80,@SPKSTS
       BS   CONTIN
       CLOG >40,@SPKSTS       Loop till buff below half
       BS   GB241
       ST   8,@TEMP2          Put 8 more bytes to PHROM
       BR   LOOPR              and go do these
CONTIN B    GB1CE             We've said it all!!
* Now pop all entries off stack that we put on!
GB258  XML  VPOP              Free up a temporary string
       DCEQ @FAC2,@VSPTR
       BR   GB258
       BR   GB0F2             And return to the caller
***********************************************************
* SPGET subprogram. Load speech data from external device.
*       Use standard file I/O
***********************************************************
SPGET  CEQ  LPARZ,@CHAT       Must have left parenthesis
       BR   ERRSYN
       CALL SETRW             Set PHROM read/write address
       CALL WAIT              Wait till no one is speaking
NXTPAR CALL GETPRM            Get the next parameter
       DCZ  @FAC6             If non-null ASCII string
       BS   GB318
       DST  @FAC4,@PTFCIS     Pointer to 1st char in string
       DST  @FAC6,@PTLCIS     Pointer to last-char-in-strin
       DADD @PTFCIS,@PTLCIS    by adding length-of-string
       DDEC @PTLCIS             and subtracting 1
       CALL SETRW             Set the speech read/write add
       DST  @PTFCIS,@PTCCIS   Set curr char to first char
       CLR  @TOTTIM           Clear total time delay
       CALL GETTIM            Get first timing mark
       CALL TIMING            Get any subsquent marks
* Get one phrase, and look it up. If the phrase is not foun
* substitute in 'UHOH'.
       DCH  @PTLCIS,@PTCCIS   Possible phrase
       BS   GB318
       CALL PHRASE            Yes, go get it
       CEQ  1,@SPLFLG         Spell flag set then set
       BR   GB29C
       DST  @PTFCIP,@PTLCIP    last ptr to first (1 char)
GB29C  CALL LOOKUP            Look up the phrase
       DCZ  @DATAAD           If not there,
       BR   GB2AA
       DST  >71F4,@DATAAD      use 'UHOH' data addr
       ST   >51,@STRLEN        'UHOH' data length
* Data must be in PHRADD and PHLEN, so move it
GB2AA  DST  @DATAAD,@PHRADD
       ST   @STRLEN,@PHLEN
       ADD  3,@PHLEN          For overhead info
* There must be a variable to put this data in. If not, err
       XML  SPEED
       BYTE SYNCHK
       BYTE COMMAZ
       XML  SYM               Find symbol in table
       XML  SMB               Evaluate andy subscripts
       XML  VPUSH             Save for assignment
       CLR  @BYTES            Two byte value
       ST   @PHLEN,@BYTES+1   Length of string needed
       XML  GETSTR            Get a string for the data
       CALL SETRW             Set up speech read/write addr
       DST  >001C,@FAC        Now build string FAC entry
       DST  >6500,@FAC2       String ID
       DST  @SREF,@FAC4       Pointer to string
       DST  @BYTES,@FAC6      Length of string
       DST  >6000,V*SREF      Mark string as speech data
       ST   @PHLEN,V@2(@SREF) Put in string length
       DSUB 3,V@1(@SREF)       minus thei info
* LOADAD expects addr to be in PTFBPH, so move it.
       DST  @PHRADD,@PTFBPH
       CALL LOADAD
* Going to copy string from PHROM to VDP. The actual data
* from PHROM is in bit-reversed order, so must reverse the
* order after reading in the order. Remember that 3 bytes
* PHLEN are our own overhead, so don't copy all
GB2EB  CH   3,@PHLEN
       BR   GB316
       ST   >10,@>8300(@WRITE) Issue read byte command
       ST   @>8300(@READ),@BYTE3 Read the byte
* the following code is somewhat tricky. It will bit
* reverse the contents of BYTE3 into BYTE1 through
* BYTE2 by means of word shifts. Note the definition of
* BYTE1 , BYTE2, and BYTE3 in EQU's. You might try an
* example if it isn't clear what is going on.
       CLR  @BYTE2
       ST   >08,@TEMP1
RNDAG  DSRC 1,@BYTE2
       DSLL 1,@BYTE1
       DEC  @TEMP1
       BR   RNDAG
* Store the bit-corrected byte into the string & inc str pt
       ST   @BYTE1,V@3(@SREF)
       DINC @SREF
       DEC  @PHLEN            Dec the string length
       BR   GB2EB             Go do next char if there is o
GB316  XML  ASSGNV            Assign the string to variable
GB318  CEQ  COMMAZ,@CHAT      If more go do
       BS   NXTPAR
       BR   GB0F2
***********************************************************
* GETPAM gets the next string paameter passed to the
* routine. If that parameter is non-exist or null, then
* condition bit is set. If the parameter is there then
* condition bit is reset and the FAC entry describes the
* string. In either case, return with condition is done.
***********************************************************
GETPRM XML  PGMCHR            Get next token
       CEQ  COMMAZ,@CHAT      Go set condition no parm
       BS   SETCB
       XML  PARSE
       BYTE RPARZ
       CEQ  >65,@FAC2         If not string, error
       BR   ERRSNM
       DCZ  @FAC6             Set cond if null string
       RTNC                   Else return
SETCB  CEQ  @>8300,@>8300     Set condition bit
       RTNC
***********************************************************
* Get the next phrase out of the current string. The phrase
* may begin with a #, which means it will continue to the
* next #, or it many begin with an ordinary character, in
* which case it will end with the character just before the
* first timing character encountered. In either case, the
* end of the string will indicate a legal end of phrase if
* it occurs before the usual indicator!
***********************************************************
PHRASE CEQ  NUMBER,@CCHAR     Phrase start with #?
       BR   GB370
       DINC @PTCCIS           Yes, inc CC ptr past #
GB33C  CEQ  SPACE,V*PTCCIS    Skip spaces
       BR   GB346
       DINC @PTCCIS
       BR   GB33C
GB346  CEQ  NUMBER,V*PTCCIS   All spaces?
       BR   GB34F
       DINC @PTCCIS           Yes, skip this # too
       RTN                    And ignore this phrase
GB34F  DST  @PTCCIS,@PTFCIP   Save 1st char in phrase
GB352  DINC @PTCCIS           Go on to next char
* Got to watch for end of string. If encountered before a
* #, act like char after string is #. Then last char will
* be char before, or the last char in the string!!
       DCH  @PTLCIS,@PTCCIS
       BS   FNDNUM
       ST   V*PTCCIS,@CCHAR   No, get char in CCHAR
       CEQ  NUMBER,@CCHAR     If not # continue looking
       BR   GB352
FNDNUM DST  @PTCCIS,@PTLCIP   Last char in phrase is one
       DDEC @PTLCIP            before the #
       DINC @PTCCIS           Point to char after #
       CALL GETTIM            Get 1st timing char after phr
       CLR  @SPLFLG           Indicate don't spell
       BR   GB38B             No # as 1st char in phrase
GB370  DST  @PTCCIS,@PTFCIP   Curr char is 1st char phrase
       CLR  @SPLFLG           Assume don't spell
       CHE  >41,@CCHAR        If not alphabetic   (>41="A")
       BS   GB37C
       INC  @SPLFLG            set spell flag
* Need to find end of phrase, which is char before next
* timing char we find. Therefore, look for a timing char!
GB37C  DINC @PTCCIS
       CALL GETTIM
       CEQ  >FF,@TIMLEN       If not timing, loop
       BS   GB37C
       DST  @PTCCIS,@PTLCIP   Char before curr char is
       DDEC @PTLCIP            the last char in phrase
GB38B  RTN
***********************************************************
* TIMING will loop through chars in string until it finds
* non-timing char. Non-timing chars have TIMLEN values of
* >FE or >FF. GETTIM must be called before this routine to
* establish a correct value of TIMLEN. Also, most likely
* TOTTIM should have been cleared.
***********************************************************
TIMING CHE  >FE,@TIMLEN
       BS   GB39B
       DADD @TIMLEN,@TOTTIM
       DINC @PTCCIS
       CALL GETTIM
       BR   TIMING
GB39B  RTN
***********************************************************
* GETTIM will examine the current char in the string and
* set TIMLEN to the appropriate time delay value. TIMLEN
* can take on the following values:
*           >00 if char is timing '+'
*           >06 if char is timing ' '
*           >0C if char is timing '-'
*           >12 if char is timing ','
*           >1E if char is timing ';'
*           >30 if char is timing ':'
*           >3C if char is timing '.'
*           >FE if char is out of stirng bounds
*           >FF if char is not timing
* Note that to test timing, some manipulation of PTCCIS
* would be neccesary, so it is stored and used in TEMP1
***********************************************************
GETTIM ST   V*PTCCIS,@CCHAR   Get the char
       DST  @PTCCIS,@TEMP1     store curr ptr in TEMP1
       DCH  @PTLCIS,@TEMP1     out of string bounds?
       BR   GB3AC
       ST   >FE,@TIMLEN       Yes, load value and return
       RTN
GB3AC  CH   SEMICO,@CCHAR     Can not be timing
       BS   NOTIME
       CEQ  SPACE,@CCHAR
       BR   GB3C5
       ST   6,@TIMLEN
GB3B9  CEQ  SPACE,V@1(@PTCCIS) While spaces
       BR   GB3C4
       DINC @PTCCIS           Skip them
       BR   GB3B9
GB3C4  RTN
GB3C5  CEQ  PLUS,@CCHAR
       BR   GB3D4
       DINC @TEMP1            Need to test the next char
       CALL NUMERC            Is it numeric
       BS   NOTIME            Was numeric => not timing cha
       CLR  @TIMLEN           Not numeric => set as no timi
       RTN
GB3D4  CEQ  COMMAT,@CCHAR
       BR   GB3DD
       ST   >12,@TIMLEN
       RTN
GB3DD  CEQ  PERIOD,@CCHAR
       BR   GB3F4
       DDEC @TEMP1            Go back to preceding char
       CALL NUMERC            Is it numeric?
       BR   PTIME             No, so it is timing
       DINCT @TEMP1           Yes, on to following char
       CALL NUMERC            Is it numeric too?
       BS   NOTIME            Yes, both numeric => not timi
PTIME  ST   >3C,@TIMLEN       Both not numeric  => timing
       RTN
GB3F4  CEQ  HYPEN,@CCHAR
       BR   GB404
       DINC @TEMP1            Check next char
       CALL NUMERC            Is it numeric?
       BS   NOTIME            Was numeric => not a timing c
       ST   >0C,@TIMLEN       Was not numeric => set as tim
       RTN
GB404  CEQ  COLON,@CCHAR
       BR   GB40D
       ST   >30,@TIMLEN
       RTN
GB40D  CEQ  SEMICO,@CCHAR
       BR   NOTIME
       ST   >1E,@TIMLEN
       RTN
NOTIME ST   >FF,@TIMLEN       Set as no timing char present
       RTN
***********************************************************
* NUMERC tests the char pointed to by PTCCIS and verifies
* the following:
*  1 - it is within the current string boundaries
*  2 - it is numeric (i.e. between '0' and '9')
* If both of the above conditions are true, COND is set
* upon return, otherwise COND is reset
***********************************************************
NUMERC DCH  @PTLCIS,@TEMP1
       BS   GB430
       DCH  @TEMP1,@PTFCIS
       BS   GB430
       CHE  >30,V*TEMP1
       BR   GB430
       CH   >39,V*TEMP1
       BR   SETCB
GB430  RTNC
***********************************************************
* LOOKUP is a prolong routine to SEARCH. In each PHROM,
* there may be 2 trees, one starting at >0000 and the other
* at >8000. Either may or may not be present. Presences is
* determined if a >AA byte is at the starting location.
* LOOKUP determines if the tree at >0000 is in, and if so,
* calls SEARCH with that addr. If that tree is not present
* or the phrase couldn't be found in it, LOOKUP then checks
* if the tree at >8000 is present, and again, if so, calls
* SEARCH with that tree address. If the word was found in
* the first tree, or after searching the second tree, the
* routine will return.
***********************************************************
LOOKUP DCLR @BYTE1            BYTE1 contains addr of curr t
TRYAGN DST  @BYTE1,@PTFBPH    Look for >AA tree header
       CALL LOADAD            LOADAD expects addr in PTFBPH
       ST   >10,@>8300(@WRITE) Put out read byte command
       CEQ  >AA,@>8300(@READ)  Tree out there?
       BR   GB44E
       DINC @PTFBPH           Skip the tree header
       CALL SEARCH            Go search this PHROM tree
       DCZ  @DATAAD           Phrase found => exit
       BR   FOUND
GB44E  DADD >8000,@BYTE1      Go to start of next PHROM tre
* Note >8000 + >8000 = >0000 => tried both trees
       DCZ  @BYTE1
       BR   TRYAGN
       DCLR @DATAAD           Didnt find phrase in either t
FOUND  RTN
***********************************************************
* SEARCH actually searches the PHROM tree for the phrase.
* The PHROM tree organization is as follows:
*        (i.e. this is one phrase node)
*              phrase ASCII length      1 byte
*              actual ASCII characters  n bytes
*              less then pointer        2 bytes
*              greater then pointer     2 bytes
*              speech data pointer      3 bytes
*              speech data length       1 byte
* The comparison of two words proceeds on a char by char
* basis, where length is secondary to char values, i.e.
* move > answer; number < we; eight < eighty; etc...
***********************************************************
SEARCH CALL LOADAD            Set PHROM to start phrase nod
       ST   >10,@>8300(@WRITE) Issue read byte command
       CLR  @PTLCPH           Length of phrase => PTLCPH
       ST   @>8300(@READ),@PTLCPH+1 (stored as 2 byte value
       DADD @PTFBPH,@PTLCPH   Add front ptr giving end ptr
       DST  @PTFBPH,@PTCCPH   Set up curr char as 1 beyond
       DINC @PTCCPH            length byte
       DST  @PTFCIP,@PTCCIP   Reset current ptr into phrase
* Compare two characters
NEXT   ST   >10,@>8300(@WRITE) Issue read byte command
       ST   @>8300(@READ),@PHDATA Get char in from PHROM
       CEQ  V*PTCCIP,@PHDATA  Compare the char
       BR   GB4D1
       DINC @PTCCPH           Equal, advance both pointers
       DINC @PTCCIP
       CEQ  SPACE,V*PTCCIP    Skip extra spaces
       BR   GB4A1
GB48D  CEQ  SPACE,V@1(@PTCCIP) While spaces
       BR   GB498
       DINC @PTCCIP           Skip them
       BR   GB48D
* By skipping extra spaces, might have reached end of phras
* If this is true, next char in phrase = #. If so, advance
* the pointer to be beyond end of phrase.
GB498  CEQ  NUMBER,V@1(@PTCCIP)
       BR   GB4A1
       DINC @PTCCIP
GB4A1  DCH  @PTLCPH,@PTCCPH   End of PHROM word?
       BR   GB4C6
       DCH  @PTLCIP,@PTCCIP   Yes, end of phrase
       BR   GB4C0
       DST  @PTLCPH,@PTFBPH   Yes, word found
* Skip 5 bytes down from last char to data pointer
       DADD 6,@PTFBPH
       CALL READAD            Set data addr => DATAAD
       ST   >10,@>8300(@WRITE) Issue read byte command
       ST   @>8300(@READ),@STRLEN Get length of speech data
       RTN
GB4C0  DST  3,@PTFBPH         Move 3 bytes past PTLCPH
       BR   NXTPHR
GB4C6  DCH  @PTLCIP,@PTCCIP   2 characters
       BR   NEXT
       DST  1,@PTFBPH         Phrase linger: use LT ptr
       BR   NXTPHR
* Two characters compared were not equal
GB4D1  DST  3,@PTFBPH         3 bytes past last to GT
       CH   V*PTCCIP,@PHDATA  After phrase
       BR   NXTPHR
       DDECT @PTFBPH          Back up 2 bytes to LT link
* Go get next phrase out of the PHROM to compare
NXTPHR DADD @PTLCPH,@PTFBPH   Add displacement to last char
       CALL READAD             and get the new address
       DCZ  @DATAAD           More leaves on this tree
       BR   GB4E8
       RTN                    No, return empty handed
GB4E8  DST  @DATAAD,@PTFBPH   Store new addr in PTFBPH
       BR   SEARCH            Go compare this new word!
* The program should never reach this point!! It should
* return somewhere up above.
***********************************************************
* LOADAD will set the addr out in the PHROM to the addr
* found in PTFBPH. Note that the PHROM is expecting five
* nybbles to be written out as the address.
***********************************************************
LOADAD DST  @PTFBPH,@TEMP1    This is destructive, so copy
       DST  @PTFBPH,@TEMP2     address into temporary areas
       SRL  4,@TEMP1          Isolate the MSN of the MSB
       SRL  4,@TEMP1+1        Isolate the MSN of the LSB
       DAND >0F0F,@TEMP2      Isolate the LSN of the MSB, L
       DOR  >4040,@TEMP1      Include a 4 as MSN of all 4 n
       DOR  >4040,@TEMP2       to indicate a Load Address C
       ST   @TEMP2+1,@>8300(@WRITE) Write out the LSN of th
       ST   @TEMP1+1,@>8300(@WRITE) Write out the LSN of th
       ST   @TEMP2,@>8300(@WRITE)   Write out the MSN of th
       ST   @TEMP1,@>8300(@WRITE)   Write out the MSN of th
       ST   >40,@>8300(@WRITE)      Write out 0 as fifth ny
       RTN
***********************************************************
* READAD will read an address from the PHROM and store it
* in DATAAD. Note that PTFBPH should contain the addr of
* the PHROM location to be read so LOADAD will work.
***********************************************************
READAD CALL LOADAD            Set the addr of the PHROM
       ST   >10,@>8300(@WRITE) Get high byte of addr
       ST   @>8300(@READ),@DATAAD Stroe it in DATAAD
       ST   >10,@>8300(@WRITE) Get low byte of addr
       ST   @>8300(@READ),@DATAAD+1 Store it in DATAAD+1
       RTN
***********************************************************
* STDATA will store the data in DATAAD and TOTTIM onto the
* speech list. It will also check that there is room on the
* speech list for this entry, and abort with error if not.
***********************************************************
STDATA DCEQ @PTEBSL,@PTLBSL   Is there room?
       BS   ERRSSL
       MOVE 3,@TOTTIM,V*PTLBSL   Put data in list
       DADD 3,@PTLBSL              and inc top of list
       RTN
***********************************************************
* WAIT loops until the speech peripheral goes idle.
***********************************************************
*    ( Loop until nobody is talking)
WAIT   ST   @>8300(@READ),@SPKSTS  Read status from PHROM
       CLOG >80,@SPKSTS
       BR   WAIT
       RTN
***********************************************************
* SETRW moves addrs of speech read/write from GROM to VDP
***********************************************************
SETRW  MOVE 4,G@>0046,@READ
       RTN
***********************************************************
*                    ERROR MESSAGES
***********************************************************
*      The following calls are in EXECS file.
* ERRSYN CALL ERRZZ           * SYNTAX ERROR
*        BYTE 3
* ERRSNM CALL ERRZZ           * STRING-NUMBER MISMATCH
*        BYTE 7
* ERRBV  CALL ERRZZ           * BAD VALUE
*        BYTE 30
* ERRIAL CALL ERRZZ           * INCORRECT ARGUMENT LIST
*        BYTE 31
***********************************************************
ERRSSL CALL ERRZZ             * SPEECH STRING TOO LONG
       BYTE 21
***********************************************************
* RXB
* GCHAR PATCH FOR COMMA
GCHARA CEQ  COMMAZ,@CHAT      ,?
       BS   GCHAR
       BR   XPTRTN
 
* MOTION PATCH for GO and STOP
SPGS   XML  PGMCHR            ( or ,
       CEQ  ALLZ,@CHAT        ALL?
       BR   SPGS1             No.
       XML  PGMCHR            Skip ALL
       XML  PGMCHR            Skip ,
       DST  1,@FAC            First sprite
       CALL SPNUM5            Get sprite table
       CALL SPMOVE            Store velocity
       ST   28,@FAC           Last sprite
       DCLR @VAR0             Index
SPGSA  MOVE 2,V@>0780,V@>0780(@VAR0)
       DADD 4,@VAR0           Index +4
       DEC  @FAC              Sprite -1
       BR   SPGSA             Done?
       B    SPRMV4            No.
SPGS1  CEQ  NUMBEZ,@CHAT      #?
       BR   SPGS2             No.
       CALL SPNUM6            Standard routine.
       B    SPRMV3
SPGS2  CEQ  GOZ,@CHAT         GO?
       BR   SPGS3             No.
       AND  >BF,@>83C2        GO!!!
       B    SPGS4             Done.
SPGS3  CEQ  STOPZ,@CHAT       STOP?
       BR   ERRSYN            No
       OR   >40,@>83C2        STOP!!!
SPGS4  XML  PGMCHR            Skip GO or STOP
       B    SPRMV4
***********************************************************
* RXB
**************************
SUBRTN RTN
**************************
STRFCH XML  PGMCHR
       XML  PARSE
       BYTE >B6
       RTN
STRGET CALL STRFCH
       CEQ  >65,@FAC2
       BR   ERRSNM      * STRING NUM MISMATCH
       RTN
NUMFCH CALL STRFCH
       CEQ  >65,@FAC2
       BS   ERRSNM      * STRING NUM MISMATCH
       RTN
CFIFCH XML  CFI
       CEQ  >03,@FAC+10
       BS   ERRBV       * NUMERIC OVERFLOW
       RTN
GETNUM CALL SUBLP3
       CEQ  >B3,@CHAT
       BR   ERRSYN
       RTN
ROWCOL CALL GETNUM
       DCGT 24,@FAC
       BS   ERRBV
       DDEC @FAC
       ST   @XPT,@MNUM
       ST   @FAC1,@YPT
       CALL GETNUM
       DCGT 32,@FAC
       BS   ERRBV
       DDEC @FAC
       ST   @FAC1,@XPT
       RTN
NGOOD  XML  PGMCHR
NGOOD1 CHE  >80,@CHAT
       BS   ERRSYN         * ?
       CALL SNDER
       CEQ  >65,@FAC2
       BR   ERRSNM         * STRING NUMBER MISMATCH
       DST  >001C,@FAC
       DST  @SREF,@FAC4
       DST  @BYTES,@FAC6
       BR   SNDASS
SNDER  XML  SYM
       XML  SMB
       XML  VPUSH
       RTN
CIFSND XML  CIF
SNDASS XML  ASSGNV
       RTN
GETLP  ST   @CB,@VAR0
       ST   @CB,@VARV
       SUB  OFFSET,@VARV
       ST   @VARV,V@0(@STRPTR)
       DINC @STRPTR
       RTN
PUTLP  ST   V@0(@FAC4),@VAR0
       ADD  OFFSET,@VAR0
       DINC @FAC4
       RTN
HFMT   FMT
       DATA >E000
       FEND
       RTN
VFMT   FMT
       DATA >E000
       BYTE >9E
       FEND
       RTN
SUBLP3 CALL NUMFCH
       CALL CFIFCH
       RTN
CLRFAC CLR  @FAC
       MOVE 7,@FAC,@FAC1
       RTN
**************************
ERRFE  CALL ERRZZ        *
       BYTE 34           *
DSKDSR DCHE 256,@VAR0    *
       BR   DSRDSS       *
       ADD  >10,@>03C1   *
DSRDSS DST  >03C0,@FAC12 *
       CALL LINK         *
       BYTE >0A          *
       ST   @>837C,@VAR2 *
       SRL  4,@FAC6      *
       CZ   @FAC6        *
       BR   ERRFE        *
       CEQ  >20,@VAR2    *
       BS   ERRFE        *
       RTN               *
***********************************************************
* RXB
***********************************************************
ZKEY   CALL KEY          *    KEY
KEYAGN CEQ  COMMAZ,@CHAT *
       BS   ZKEY         *
       BR   LNKRTN       *
**************************
ZJOYST CALL JOYST        *    JOYST
JOYAGN CEQ  COMMAZ,@CHAT *
       BR   LNKRTN       *
       CALL CPAR2        *
       CALL GAC16        *
       BR   JOYAGN       *
*****************************
SPAR   CEQ  LPARZ,@CHAT       (?
       BS   SPAR1             Yes.
       CEQ  COMMAZ,@CHAT      ,?
       BR   ERRSYN            No.
SPAR1  XML  PGMCHR            Skip ( or ,
       XML  PARSE             Get string or value.
       BYTE RPARZ
       CEQ  >65,@FAC2         String?
       BR   SPAR2             No.
       DST  @FAC4,@>8304      Save address.
       DST  @FAC6,@>8306      Save length.
       DST  >994A,@>8310      Set flag.
       CALL LPAR
       RTN
SPAR2  XML  SPEED
       BYTE SYNCHK
       BYTE COMMAZ
       RTN
*****************************
KEYSTR DCEQ >994A,@>8310      Flag set?
       BR   RSCAN3            No.
RSCAN  SCAN                   Any key?
       BR   RSCAN             No.
       DCZ  @>8306            Length 0?
       BS   RSCAN4            Yes.
       DST  @>8304,@>8308     String address.
       DST  @>8306,@>8302     Copy length.
RSCAN2 CEQ  V*>8308,@RKEY     Same?
       BS   RSCAN5            Yes.
       DINC @>8308            Address +1
       DDEC @>8302            Length -1
       BR   RSCAN2            No matcth.
       B    RSCAN             Restart.
RSCAN3 SCAN                   Normal key scan.
RSCAN4 CLR  @KEYBD
       DCLR @>8310            Clear flag.
       RTNC
RSCAN5 CALL RSCAN4
       CEQ  @0,@0             Force condition bit on.
       RTNC
*****************************
CPAR2  XML  SPEED           * Similar to LPAR
       DATA COMMAZ          * Syntax check ,
       BR   GAC35           * Parse value
*****************************
ZSCOI  CALL SPRCOI       *    COINC
COINLP CEQ  >B3,@CHAT    *
       BR   LNKRTN       *
       XML  PGMCHR       *
       CALL GAF56        *
       BR   COINLP       *
**************************
NR     CALL PREPN        *
AR     XML  ASSGNV       *
       RTN               *
**************************
ZSDIST CALL DIST         *    DISTANCE
DISLP  CEQ  >B3,@CHAT    *
       BR   LNKRTN       *
       CALL GAFC4        *
       BR   DISLP        *
***********************************************************
LINKSD DATA LINKSE
       STRI 'GMOTION'
       DATA $+2
       CALL SPNUM1            GMOTOIN
GMAGN  CALL SPNUM2
       ST   >02,@TEMP1
       DST  V@>0480(@SPSAL),@TEMP2
GMO1   CALL PREPN
       ST   @TEMP2,@FAC+1
       CH   >7F,@FAC+1
       BR   GMO2
       NEG  @FAC+1
       DNEG @FAC
GMO2   CALL CIFSND
       CEQ  >01,@TEMP1
       BS   GMO3
       XML  SPEED
       DATA >00B3
GMO3   EX   @TEMP2,@TEMP2+1
       DEC  @TEMP1
       BR   GMO1
       CEQ  >B3,@CHAT
       BS   GMAGN
       BR   LNKRTN
**************************
LINKSE DATA LINKSF
       STRI 'RMOTION'
       DATA $+2
       CALL SPNUM1       *    RMOTION
RMAGN  XML  PGMCHR
       CEQ  >EC,@CHAT
       BR   NOALL
       XML  SPEED
       DATA >00EC
       DST  >001C,@VAR0
NXALL  DST  @VAR0,@FAC
       CALL SPNUM5
       BR   RMALL
NOALL  DST  >0001,@VAR0
       CEQ  >FD,@CHAT
       BR   ERRSYN
       CALL NUMFCH
       CALL SPNUM4
RMALL  DST  V@>0480(@SPSAL),@TEMP1
       ST   >02,@TEMP2
RMOTLP CZ   @TEMP1
       BS   J2
       CEQ  >80,@TEMP1
       BS   J3
       CH   >7F,@TEMP1
       BS   J1
       NEG  @TEMP1
       BR   J2
J1     ABS  @TEMP1
J2     EX   @TEMP1,@TEMP1+1
       DEC  @TEMP2
       BR   RMOTLP
       DST  @TEMP1,V@>0480(@SPSAL)
J3     DDEC @VAR0
       BR   NXALL
       CEQ  >B3,@CHAT
       BS   RMAGN
       BR   LNKRTN
*****************************************
S1ET9F XML  SPEED  * CHECK FROM
       DATA >021E  * 30 TO 159
       DATA >009F  *
       RTN         *
*****************************************
LINKSF DATA LINK10
       STRI 'INVERSE'
       DATA $+2
       CALL SPNUM1            INVERSE(CHAR#)
INVAGN XML  PGMCHR
       CEQ  >EC,@CHAT
       BR   INOALL
       XML  SPEED
       DATA >00EC
       DST  >001E,@FAC
       DSLL 3,@FAC
       DST  >01C8,@TEMP1
       BR   INVLP
INOALL XML  PARSE
       BYTE >B6
       CALL S1ET9F
       DSLL 3,@FAC
       DST  >0004,@TEMP1
INVLP  DINV V@>0300(@FAC)
       DADD >0002,@FAC
       DDEC @TEMP1
       BR   INVLP
INVNOK CEQ  >B3,@CHAT
       BS   INVAGN
       BR   LNKRTN
*****************************************
SSDSLL CALL STRFCH
       CALL S1ET9F
       DSLL 3,@FAC
       RTN
*****************************************
LINK10 DATA LINK11
       STRI 'SWAPCHAR'
       DATA $+2
       CALL SPNUM1            SWAPCHAR(CHAR#,CHAR#)
SWCHAG CALL SSDSLL
       DST  @FAC,@VAR4
       CEQ  >B3,@CHAT
       BR   ERRSYN
       CALL SSDSLL
       DST  @FAC,@VAR5
       MOVE 8,V@>0300(@VAR4),@FAC
       MOVE 8,V@>0300(@VAR5),V@>0300(@VAR4)
       MOVE 8,@FAC,V@>0300(@VAR5)
       CEQ  >B3,@CHAT
       BS   SWCHAG
       BR   LNKRTN
******************************************
LINK11 DATA LINK12
       STRI 'DUPCHAR'
       DATA $+2
       CALL SPNUM1            DUPCHAR(CHAR#,CHAR#)
DCHAGN CALL SSDSLL
       DST  @FAC,@VAR4
       CEQ  >B3,@CHAT
       BR   ERRSYN
       CALL SSDSLL
       MOVE 8,V@>0300(@VAR4),V@>0300(@FAC)
       CEQ  >B3,@CHAT
       BS   DCHAGN
       BR   LNKRTN
******************************************
S00T10 XML  SPEED  * CHECK FROM
       DATA >0200  * 0 TO 16
       DATA >0010  *
       RTN         *
******************************************
LINK12 DATA LINK13
       STRI 'SWAPCOLOR'
       DATA $+2
       XML  SPEED             SWAPCOLOR(SET#,SET#)
       DATA >00B7
SCOL10 CEQ  >FD,@CHAT
       BR   SCOL20
       CALL SPNUM3
       ST   V@>0003(@FAC),@VAR4
       DST  @FAC,@VAR5
       CEQ  >FD,@CHAT
       BR   ERRSYN
       CALL STRFCH
       CALL SPNUM4
       ST   V@>0003(@FAC),V@>0003(@VAR5)
       ST   @VAR4,V@>0003(@FAC)
       CEQ  >B3,@CHAT
       BR   LNKRTN
       XML  PGMCHR
       BR   SCOL10
SCOL20 XML  SPEED
       BYTE >01
       CALL S00T10
       DADD >080F,@FAC
       DST  @FAC,@VAR4
       XML  PARSE
       BYTE >B6
       CALL S00T10
       DADD >080F,@FAC
       ST   V*FAC,@VAR0
       ST   V*VAR4,V*FAC
       ST   @VAR0,V*VAR4
       CEQ  >B3,@CHAT
       BR   LNKRTN
       XML  PGMCHR
       BR   SCOL20
******************************************
LINK13 DATA LINK14
       STRI 'DUPCOLOR'
       DATA $+2
       XML  SPEED             DUPCOLOR(SET#,SET#)
       DATA >00B7
DCOL10 CEQ  >FD,@CHAT
       BR   DCOL20
       CALL SPNUM3
       ST   V@>0003(@FAC),@VAR4
       CEQ  >FD,@CHAT
       BR   ERRSYN
       CALL STRFCH
       CALL SPNUM4
       ST   @VAR4,V@>0003(@FAC)
       CEQ  >B3,@CHAT
       BR   LNKRTN
       XML  PGMCHR
       BR   DCOL10
DCOL20 XML  SPEED
       BYTE >01
       CALL S00T10
       DADD >080F,@FAC
       ST   V*FAC,@VAR0
       XML  PARSE
       BYTE >B6
       CALL S00T10
       DADD >080F,@FAC
       ST   @VAR0,V*FAC
       CEQ  >B3,@CHAT
       BR   LNKRTN
       XML  PGMCHR
       BR   DCOL20
******************************************
LINK14 DATA LINK15
       STRI 'LDIAG'
       DATA $+2
LDIAG  CALL HVCHR             LDIAG(R,C,CHAR#,REP)
       DCZ  @FAC
       BS   XPTRTN
LLPD   CALL VFMT
       DEC  @XPT
       DDEC @FAC
       BS   LCOMMA
       CZ   @YPT
       BR   LLPD
       DEC  @XPT
       BR   LLPD
LCOMMA CEQ  COMMAZ,@CHAT
       BS   LDIAG
       BR   XPTRTN
******************************************
LINK15 DATA LINK16
       STRI 'RDIAG'
       DATA $+2
RDIAG  CALL HVCHR             RDIAG(R,C,CHAR#,REP)
       DCZ  @FAC
       BS   RCOMMA
RLPD   CALL VFMT
       INC  @XPT
       DDEC @FAC
       BS   RCOMMA
       CZ   @YPT
       BR   RLPD
       INC  @XPT
       BR   RLPD
RCOMMA CEQ  COMMAZ,@CHAT
       BS   RDIAG
       BR   XPTRTN
******************************************
LINK16 DATA LINK17
       STRI 'MOVES'
       DATA $+2
       CALL SPNUM1            MOVES(TYPE$,BYTES,$,TO)
*                          or MOVES(TYPE$,BYTES,FROM,$)
MOVESA CALL STRGET          * ( or ,
       DST  V*FAC4,@VAR5    * TYPE "VRG"
       CALL GETNUM          * ,BYTES
       DCZ  @FAC
       BS   ERRBV
       DST  @FAC,@BYTES
       CALL STRFCH          * ,FROM
       CEQ  36,@VAR5
       BR   MOVESX
       CHE  @FAC6,@BYTES+1
       BS   MOVESB
       CLR  @BYTES
       ST   @FAC6,@BYTES+1
       BR   MOVESB
MOVESX CALL CFIFCH
       DST  @FAC,@FAC4
MOVESB DST  @FAC4,@VARY
       CEQ  36,@VAR6
       BR   MOVESN
       DCHE 256,@BYTES
       BS   ERRBV
       XML  GETSTR
       CALL NGOOD
       DST  @SREF,@FAC
       BR   MOVESC
MOVESN CALL SUBLP3          * ,TO
MOVESC DST  @FAC,@VARY2
       CEQ  36,@VAR5        * VDP FROM
       BR   MTYPES
       ST   86,@VAR5
MTYPES CEQ  36,@VAR6
       BR   MTYPE
       ST   86,@VAR6
MTYPE  CEQ  86,@VAR5        * VDP FROM
       BR   MTYPE3
       CEQ  86,@VAR6        * VDP TO
       BR   MTYPE1
MTYPE0 MOVE @BYTES,V@0(@VARY),V@0(@VARY2)
MTYPE1 CEQ  82,@VAR6        * RAM TO
       BR   MTYPE2
       MOVE @BYTES,V@0(@VARY),@0(@VARY2)
MTYPE2 CEQ  71,@VAR6        * GRAM TO
       BR   MTYPE3
       MOVE @BYTES,V@0(@VARY),G@0(@VARY2)
MTYPE3 CEQ  82,@VAR5        * RAM FROM
       BR   MTYPE7
       CEQ  86,@VAR6        * VDP TO
       BR   MTYPE5
MTYPE4 MOVE @BYTES,@0(@VARY),V@0(@VARY2)
MTYPE5 CEQ  82,@VAR6        * RAM TO
       BR   MTYPE6
       MOVE @BYTES,@0(@VARY),@0(@VARY2)
MTYPE6 CEQ  71,@VAR6        * GRAM TO
       BR   MTYPE7
       MOVE @BYTES,@0(@VARY),G@0(@VARY2)
MTYPE7 CEQ  71,@VAR5        * GRAM FROM
       BR   MOVESD
       CEQ  86,@VAR6        * VDP TO
       BR   MTYPE9
MTYPE8 MOVE @BYTES,G@0(@VARY),V@0(@VARY2)
MTYPE9 CEQ  82,@VAR6        * RAM TO
       BR   MTYPEA
       MOVE @BYTES,G@0(@VARY),@0(@VARY2)
MTYPEA CEQ  71,@VAR6        * GRAM TO
       BR   MOVESD
       MOVE @BYTES,G@0(@VARY),G@0(@VARY2)
MOVESD CEQ  >B3,@CHAT
       BS   MOVESA
       BR   LNKRTN
*******************************
LINK17 DATA LINK18
       STRI 'HEX'             HEX
       DATA $+2
       CALL SPNUM1
HEXAGN CALL STRFCH            Get STRING or NUMBER
       CEQ  >65,@FAC2         STRING?
       BS   HEXSTR            Yes
       CALL CFIFCH            No
       DST  @FAC,@TEMP2
       DST  >0004,@BYTES
       XML  GETSTR
       DST  @SREF,@STRPTR
       ST   @TEMP2,@VAR0
       SRL  4,@VAR0
       CALL HEXNS
       ST   @TEMP2,@VAR0
       SLL  4,@VAR0
       SRL  4,@VAR0
       CALL HEXNS
       ST   @TEMP2+1,@VAR0
       SRL  4,@VAR0
       CALL HEXNS
       ST   @TEMP2+1,@VAR0
       SLL  4,@VAR0
       SRL  4,@VAR0
       CALL HEXNS
       CEQ  COMMAZ,@CHAT
       BR   ERRSYN
       CALL NGOOD
       BR   HEXDON
HEXNS  CHE  >0A,@VAR0
       BR   HEXNS2
       ADD  >07,@VAR0
HEXNS2 ADD  >30,@VAR0
       ST   @VAR0,V*STRPTR
       DINC @STRPTR
       RTN
HEXSTR DCLR @TEMP2
       DST  @FAC4,@STRPTR
       DCHE 5,@FAC6
       BS   HEXS4
       CASE @FAC7
       BR   HEXS0
       BR   HEXS1
       BR   HEXS2
       BR   HEXS3
       BR   HEXS4
HEXS4  CALL HEXSN
       SLL  4,@VAR0
       ADD  @VAR0,@TEMP2
HEXS3  CALL HEXSN
       ADD  @VAR0,@TEMP2
HEXS2  CALL HEXSN
       SLL  4,@VAR0
       ADD  @VAR0,@TEMP2+1
HEXS1  CALL HEXSN
       ADD  @VAR0,@TEMP2+1
HEXS0  XML  PGMCHR
       CALL SNDER
       CALL CLRFAC
       DST  @TEMP2,@FAC
       CALL CIFSND
HEXDON CEQ  COMMAZ,@CHAT
       BS   HEXAGN
       BR   LNKRTN
HEXSN  ST   V*STRPTR,@VAR0
       CHE  103,@VAR0         * g ?
       BS   ERRBA
       CHE  97,@VAR0          * a ?
       BR   HEXSN2
       SUB  32,@VAR0          * -32
HEXSN2 CHE  71,@VAR0          * G ?
       BS   ERRBA
       CHE  65,@VAR0          * A ?
       BR   HEXSN3
       SUB  55,@VAR0          * -55
       BR   HEXSN4
HEXSN3 CHE  58,@VAR0          * : ?
       BS   ERRBA
       CHE  48,@VAR0          * 0 ?
       BR   ERRBA
       SUB  48,@VAR0          * -48
HEXSN4 DINC @STRPTR
       RTN
**************************
LINK18 DATA LINK19
       STRI 'IO'              IO
       DATA $+2
       CALL SPNUM1
IOAGN  CALL GETNUM       * TYPE 0-6
       CHE  >07,@FAC1
       BS   ERRBV
       ST   @FAC1,@VARY
       CALL SUBLP3       * ADDRESS/
       CASE @VARY        * BITS/BYTES
       BR   SOG
       BR   SOV
       BR   CRUI
       BR   CRUO
       BR   CSW
       BR   CSR
       BR   CSV
SOG    I/O  0,@FAC
       BR   IODONE
SOV    I/O  1,@FAC
       BR   IODONE
CRUI   CALL CRUSET
       I/O  2,@VAR4
       XML  PGMCHR
       CALL SNDER
       CALL CLRFAC
       ST   @VAR0,@FAC1
       CALL CIFSND       * VARIABLE1
       CHE  >09,@VARY
       BS   CRUI16
       BR   IODONE
CRUI16 XML  PGMCHR
       CALL SNDER
       CALL CLRFAC
       ST   @VARV,@FAC1
       CALL CIFSND       * VARIABLE2
       BR   IODONE
CRUO   CALL CRUSET
       CALL SUBLP3       * VARIABLE1
       DCHE >0100,@FAC
       BS   ERRBV
       CHE  >09,@VARY
       BS   CRUO16
       ST   @FAC1,@VAR0
       BR   CRUO8
CRUO16 DST  @FAC,@VAR0
       CALL SUBLP3       * VARIABLE2
       DCHE >0100,@FAC
       BS   ERRBV
       ST   @FAC1,@VARV
CRUO8  I/O  3,@VAR4
       BR   IODONE
CSW    CALL CSLOAD
       I/O  4,@VAR4
       BR   IODONE
CSR    CALL CSLOAD
       I/O  5,@VAR4
       BR   IODONE
CSV    CALL CSLOAD
       I/O  6,@VAR4
IODONE CEQ  >B3,@CHAT
       BS   IOAGN
       BR   LNKRTN
CRUTMP DST  @FAC,@VAR4
       DCLR @VAR5
       DCLR @VAR0
       RTN
CRUSET CZ   @FAC1
       BS   ERRBV
       CHE  >11,@FAC
       BS   ERRBV
       ST   @FAC1,@VARY
       CALL SUBLP3       * CRU-ADDRESS
       CALL CRUTMP
       ST   @VARY,@VAR5
       RTN
CSLOAD CALL CRUTMP
       CALL SUBLP3       * ADDRESS
       DST  @FAC,@VAR5
       RTN
*******************************
HVPNUM CLR  @FAC11            Select XB FLP
       XML  CNS
       CEQ  SPACE,*FAC11      Leading space?
       BR   HVPUTN
       INC  @FAC11            Supress space out
       DEC  @FAC12            Shorten length
HVPUTN CLR  @BYTES
       ST   @FAC12,@BYTES+1        Length
       XML  GETSTR
       MOVE @BYTES,*FAC11,V*SREF   Store in VDP rollout
       DST  @SREF,@FAC4            VDP rollout address
       DST  @BYTES,@FAC6           Store length
       RTN
*******************************
LINK19 DATA LINK1A
       STRI 'HPUT'
       DATA $+2
       CALL SPNUM1
HPAGIN CALL ROWCOL            Get ROW & COL
       CALL STRFCH            Get string or number
       CEQ  >65,@FAC2         String?
       BS   HPUTS             Yes
       CALL HVPNUM            No, CNS
HPUTS  DCZ  @FAC6
       BS   HPOUT
       DCLR @FAC
HPUTLP CALL PUTLP
       CALL HFMT
       DDEC @FAC6
       BR   HPUTLP
HPOUT  CEQ  >B3,@CHAT
       BS   HPAGIN
       BR   XPTRTN
**************************
LINK1A DATA LINK1B
       STRI 'VPUT'
       DATA $+2
       CALL SPNUM1
VPAGIN CALL ROWCOL            Get ROW & COL
       CALL STRFCH            Get string or number
       CEQ  >65,@FAC2         String?
       BS   VPUTS             Yes
       CALL HVPNUM            No, CNS
VPUTS  DCZ  @FAC6
       BS   VPOUT
       DCLR @FAC
VPUTLP CALL PUTLP
       CALL VFMT
       DDEC @FAC6
       BS   VPOUT
       CZ   @YPT
       BR   VPUTLP
       INC  @XPT
       B    VPUTLP
VPOUT  CEQ  >B3,@CHAT
       BS   VPAGIN
       BR   XPTRTN
****************************
HVGETS CALL ROWCOL
       CALL GETNUM
       DCGT >00FF,@FAC
       BS   ERRBV        * BAD VALUE
       DST  @FAC,@BYTES
       DST  @FAC,@TEMP1
       XML  GETSTR
       DST  @SREF,@STRPTR
       RTN
****************************
LINK1B DATA LINK1C
       STRI 'HGET'
       DATA $+2
       CALL SPNUM1
HAGAIN CALL HVGETS
LP2    CALL GETLP
       CALL HFMT
       DDEC @TEMP1
       BR   LP2
HDONE  CALL NGOOD
       CEQ  >B3,@CHAT
       BS   HAGAIN
       BR   XPTRTN
**************************
LINK1C DATA LINK1D
       STRI 'VGET'
       DATA $+2
       CALL SPNUM1
VAGAIN CALL HVGETS
LP1    CALL GETLP
       CALL VFMT
       DDEC @TEMP1
       BS   VDONE
       CZ   @YPT
       BR   LP1
       INC  @XPT
       B    LP1
VDONE  CALL NGOOD
       CEQ  >B3,@CHAT
       BS   VAGAIN
       BR   XPTRTN
*******************************************************
* CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE EXECUTE *
*******************************************************
*                          AORG >8300
CPUPGM DATA >8302 * CPUPGM DATA >8302  First address. *
       DATA >0420 *        BLWP >834A  Switch contex  *
       DATA >834A *                    FAC not used   *
       DATA >04E0 *        CLR  @>837C Clear for GPL  *
       DATA >837C *                                   *
       DATA >045B *        RT          Return to GPL. *
                  *        END                        *
*******************************************************
LINK1D DATA LINK1E
       STRI 'EXECUTE'         EXECUTE
       DATA $+2
       CALL SPNUM1
EXAGN  CALL SUBLP3
       MOVE 12,@>8300,V@>03C0
       MOVE 12,G@CPUPGM,@>8300
       DST  @FAC,@>8304
       XML  >F0
       MOVE 12,V@>03C0,@>8300
       CEQ  >B3,@CHAT
       BS   EXAGN
       BR   LNKRTN
***********************************************************
LINK1E DATA LINK1F
       STRI 'SIZE'            SIZE
       DATA $+2
       B    SZSIZE
LINK1F DATA LINK20
       STRI 'CLSALL'          CLSALL
       DATA $+2
       CALL CLSALL
       BR   LNKRT2
LINK20 DATA LINK21
       STRI 'BYE'             BYE
       DATA $+2
       CALL CLSALL
       EXIT
LINK21 DATA LINK22
       STRI 'NEW'             NEW
       DATA $+2
RXBNEW CLR  V@>0371           Clear AUTOLOAD flag
       CALL CLSALL
       B    SZNEW
LINK22 DATA LINK23
       STRI 'BIAS'            BIAS
       DATA $+2
       CALL SPNUM1
BIASAG CALL GETNUM
       DST  @FAC,@VAR0
       CALL STRGET
       DST  @FAC4,@VARY
       DST  @FAC6,@VARY2
BIASLP ST   V*VARY,@FAC1      * Character.
       DCZ  @VAR0             * 0?
       BS   BIASM             * Yes.
       ADD  96,@FAC1          * ADD OFFSET
       BR   BIASSV
BIASM  SUB  96,@FAC1          * MINUS OFFSET
BIASSV ST   @FAC1,V*VARY
       DINC @VARY
       DDEC @VARY2
       BR   BIASLP
       CEQ  >B3,@CHAT
       BS   BIASAG
       BR   LNKRTN
LINK23 DATA LINK24
       STRI 'EALR'            EALR
       DATA $+2
       CALL EASAVE
       BYTE >33
LINK24 DATA LINK25
       STRI 'EAPGM'           EAPGM
       DATA $+2
       CALL EASAVE
       BYTE >35
LINK25 DATA LINK26
       STRI 'EAED'            EAED
       DATA $+2
XEAED  CALL EASAVE
       BYTE >31
LINK26 DATA LINK27
       STRI 'EA'              EA menu
       DATA EAMENU
EASAVE CALL SPNUM1
       CALL STRGET
       ST   @FAC,V@>2256
       ADD  1,V@>2256
       MOVE @FAC6,V@0(@FAC4),V@>2257
       ST   >0D,V@>2257(@FAC6)
       FETCH @CHAT
EAMENU CALL CLSALL
       B    GE025
LINK27 DATA LINK28
       STRI 'XB'              XB menu
       DATA $+2
XBMENU CALL CLSALL
       BR   RXBRUN
LINK28 DATA LINK29
       STRI 'XBPGM'          XBPGM
       DATA $+2
       CALL SPNUM1
       CALL CLSALL
       CALL STRGET
       DCZ  @FAC6
       BS   RXBXBP
       CLR  V@>2254
       MOVE 50,V@>2254,V@>2255
       DST  >994A,V@>2254
       ST   @FAC7,V@>2256
       MOVE @FAC6,V@0(@FAC4),V@>2257
RXBXBP CEQ  >B3,@CHAT
       BR   RXBRUN
       CALL RXBFIL
RXBRUN B    TOPLEV
LINK29 DATA >C010
       STRI 'FILES'         FILES
       DATA $+2
       CALL SPNUM1
       CALL CLSALL
       CALL RXBFIL
       BR   RXBNEW
RXBFIL CALL SUBLP3
       DCZ  @FAC
       BS   ERRBV
       DCHE 16,@FAC
       BS   ERRBV
       CEQ  RPARZ,@CHAT
       BR   ERRSYN
       XML  PGMCHR
       DCLR @FAC2
       ST   @FAC1,@FAC2
       DST  >0116,V@>03C0
       CALL DSKDSR
       RTN
********************************************************************************
       END
 

Spoiler

***********************************************************
       TITL 'MYXB6'
***********************************************************
       GROM >C000
***********************************************************
       TITL 'EQUATES ALCS-359'
***********************************************************
FSLOC  EQU  >2002             Free Start LOCation in ERAM
*                             Free end must follow it.
INITF  EQU  >2006             INIT flag address INIT has be
*                             called if ERAM (INITF)=>AA55
* Free end initialized to >4000, (>FFF8 for debugger)
* Free start is initialized to the first useable memory
*  location for assembly language code
CPUBAS EQU  >A040             Expansion RAM base
***********************************************************
*           GROM ADDRESSES
CHRTBL EQU  >6018             RXB CALL CHRTBL load char set
MZMSG  EQU  >6038             Start of message area
MZSUB  EQU  >AE00             Module SPRITE branch table ad
***********************************************************
MSGFST EQU  >6040
MSG10  EQU  >6065
MSG14  EQU  >6076
MSG16  EQU  >6083
MSG17  EQU  >609C
MSG19  EQU  >60AD
MSG24  EQU  >60BB
MSG25  EQU  >60D2
MSG28  EQU  >60E4
MSG34  EQU  >60F9
MSG36  EQU  >6110
MSG39  EQU  >611C
MSG40  EQU  >6128
MSG43  EQU  >6137
MSG44  EQU  >6148
MSG47  EQU  >6159
MSG48  EQU  >616F
MSG49  EQU  >6189
MSG51  EQU  >6198
MSG54  EQU  >61AD
MSG57  EQU  >61BE
MSG60  EQU  >61CC
MSG61  EQU  >61DB
MSG67  EQU  >61EB
MSG69  EQU  >61FA
MSG70  EQU  >6215
MSG74  EQU  >622D
MSG78  EQU  >623A
MSG79  EQU  >624D
MSG81  EQU  >6257
MSG83  EQU  >626F
MSG84  EQU  >627B
MSG97  EQU  >6286
MSG109 EQU  >629B
MSG130 EQU  >62A6
MSG135 EQU  >62B0
MSG62  EQU  >62C5
MSGCIS EQU  >630A
MSGCF  EQU  >6319
MSG56  EQU  >6324
TOPLEV EQU  >6372             RXB PATCH for XBPGM
SZNEW  EQU  >63A5             RXB PATCH for NEW
TOPL15 EQU  >63DD             * Return from OLD or SAVE
TOPL42 EQU  >6433
TOPL55 EQU  >6462
ILLST  EQU  >64EF
SZSIZE EQU  >65C9             RXB PATCH for SIZE
EDITLN EQU  >66CF             * Edit a line into a program
READL3 EQU  >6A8A
G6D78  EQU  >6D78             * GKXB ERR routine
ERPRNT EQU  >6E0E
ERPNT5 EQU  >6E1B
DISO   EQU  >6FBA
GRMLST EQU  >802A
ALCEND EQU  >9800             RXB moved INIT here
ASC    EQU  >A00A
LNKRTN EQU  >A01C
GE025  EQU  >E025             RXB PATCH for EA
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS
INITPG EQU  >6014             Initialize program space
SPRINT EQU  >6016             Initialize sprites
TOPL10 EQU  >601A             Return to main and re-init
CHRTAB EQU  >601C             Load default character set
SZRUN  EQU  >601E
KILSYM EQU  >6022             KILL SYMBOL TABLE ROUTINE
AUTO1  EQU  >602E             Get arguments for LIST comman
TOPL02 EQU  >6030             RTN address for failing AUTOL
GRSUB1 EQU  >6034             Read data (2 bytes) from ERAM
GWSUB  EQU  >6036             Write a few bytes of data to
MSGBRK EQU  >6048             * BREAKPOINT
MSGTA  EQU  >6053             Message "try again"
LLIST  EQU  >6A74             List a line
READLN EQU  >6A76             Read a line from keyboard
CHKEND EQU  >6A78             Check end of statement
ENTER  EQU  >6A7E
ENT09  EQU  >6A80
WARNZZ EQU  >6A82             WARNING MESSAGE ROUTINE
ERRZZ  EQU  >6A84             ERROR MESSAGE ROUTINE
ERRZ   EQU  >6A84             ERRor routine
READL1 EQU  >6A86             Read a line from keyboard
DISPL1 EQU  >8000
DELET  EQU  >8002
PRINT  EQU  >8004
INPUT  EQU  >8006
OPEN   EQU  >8008
CLOSE  EQU  >800A
RESTOR EQU  >800C
NREAD  EQU  >800E
CLSALL EQU  >8012
EOF    EQU  >801C
ACCEPT EQU  >801E
SRDATA EQU  >8020
REC    EQU  >8022
GRSUB2 EQU  >802C
GRSUB3 EQU  >802E
LINPUT EQU  >8030
CONVER EQU  >A012             CONVERT WITH WARNING
CPL    EQU  >0010             Call Program Link
RPL    EQU  >0012             Return Program Link
GRINT  EQU  >0022             Greatest integer
ATNZZ  EQU  >0032             Arctangent routine
***********************************************************
*    Equates for routine in MONITOR
DSR    EQU  >10               CALL DEVICE SERVICE ROUTINE
TONE1  EQU  >34               ACCEPT TONE
TONE2  EQU  >36               BAD TONE
CHAR2Z EQU  >18               CHARACTER TABLE ADDRESS small
CHAR3Z EQU  >4A               CHARACTER TABLE ADDRESS
***********************************************************
*    Equates for XMLs
SYNCHK EQU  >00               SYNCHK XML selector
FILSPC EQU  >01               Fill-space utility
PARCOM EQU  >01               PARse to a COMma selector
CSTRIN EQU  >02               Copy-string utility
RANGE  EQU  >02               RANGE selector
SEETWO EQU  >03               SEETWO XML selector
FADD   EQU  >06               Floating ADD
FMUL   EQU  >08               Floating MULtiply
FDIV   EQU  >09               Floating DIVide
FCOMP  EQU  >0A               Floating COMPare
SADD   EQU  >0B               Stack ADD
SSUB   EQU  >0C               Stack SUBtract
CSNUM  EQU  >10               Convert String to Number
CFI    EQU  >12               Convert to two byte integer
FLTINT EQU  >12               Convert floating to integer
ALSUP  EQU  >20               XML to user AssembLy SUBrouti
COMPCT EQU  >70               PREFORM A GARBAGE COLLECTION
GETSTR EQU  >71               SYSTEM GET STRING
MEMCHK EQU  >72               MEMORY check routine: VDP
CNS    EQU  >73               Convert number to string
* Warning Defualt changed in >0159
PARSE  EQU  >74               Parse a value
CONT   EQU  >75               Continue parsing
EXECG  EQU  >76               Execute a XB stmt or program
VPUSH  EQU  >77               Push on value stack
VPOP   EQU  >78               Pop off value stack
PGMCHR EQU  >79               GET PROGRAM CHARACTER
SYM    EQU  >7A               Find SYMBOL entry
SMB    EQU  >7B               Find symbol table entry
ASSGNV EQU  >7C               Assign VARIABLE
SCHSYM EQU  >7D               Search symbol table
SPEED  EQU  >7E               SPEED UP XML
CRUNCH EQU  >7F               Crunch an input line
CIF    EQU  >80               Convert INTEGER to FLOATING P
RTNB   EQU  >82               Return
SCROLL EQU  >83               SCROLL THE SCREEN
IO     EQU  >84               IO utility (KW table search)
GREAD  EQU  >85               READ DATA FROM ERAM
GWRITE EQU  >86               WRITE DATA TO ERAM
DELREP EQU  >87               REMOVE CONTENT FROM VDP/ERAM
MVDN   EQU  >88               MOVE DATA IN VDP/ERAM
MVUP   EQU  >89               MOVE DATA IN VDP/ERAM
VGWITE EQU  >8A               MOVE DATA FROM VDP TO ERAM
GVWITE EQU  >8B               WRITE DATA FROM GRAM TO VRAM
GREAD1 EQU  >8C               READ DATA FROM ERAM
GDTECT EQU  >8E               ERAM DETECT&ROM PAGE 1 ENABLE
SCNSMT EQU  >8F               SCAN STATEMENT FOR PRESCAN
***********************************************************
*    Temporary workspaces in EDIT
CPUOFF EQU  >8300             CPU RAM OFFSET
VAR0   EQU  >8300            TEMPORARY
SP00   EQU  >8300            SPRITE value
PTFBSL EQU  >8300            Ptr to 1st byte in SPEAK list
PHLEN  EQU  >8300            PHrom data LENgth
VARV   EQU  >8301            TEMPORARY
PHRADD EQU  >8301            PHRom ADDress
ACCUM  EQU  >8302            # OF BYTES ACCUMULATOR (4 BYTE
STPT   EQU  >8302            TWO BYTES
MNUM   EQU  >8302            Ussually a counter
AAA1   EQU  >8302
SP02   EQU  >8302            SPRITE value
PTLBSL EQU  >8302            Ptr to last byte in SPEAK list
CHKSUM EQU  >8302            Check sum word
PC     EQU  >8304            Address in ERAM to load next v
VARY   EQU  >8304
PABPTR EQU  >8304            Pointer to current PAB
SP04   EQU  >8304            SPRITE value
PTEBSL EQU  >8304            Ptr to end byte in SPEAK list
* NOTE: PTEBSL points to the end of the temporary speak lis
*       whereas PTLBSL points to the last byte actually use
*       i.e.    PTFBSL <= PTLBSL <= PTEBSL
VARY2  EQU  >8306            Use in MVDN only
DFLTLM EQU  >8306            Default array limit (10)
CCPPTR EQU  >8306            OFFSET WITHIN RECORED (1)
*                             or Pointer to current column
SP06   EQU  >8306            SPRITE value
PTFCIS EQU  >8306            Ptr to 1st character in string
OFFADD EQU  >8306            OFFADD of relocatable programs
*                             loaded into ERAM.
RECLEN EQU  >8307            LENGTH OF CURRENT RECORD (1)
CCPADR EQU  >8308            RAM address of current refs
*                             or Actual buffer address or c
VARC   EQU  >8308
CCPADD EQU  >8308            RAM address of current color
CCC1   EQU  >8308
SPSAL  EQU  >8308            Location of sprite attribute l
PTCCIS EQU  >8308            Ptr to current character in st
FRESTA EQU  >8308            Start of free memory in ERAM
*                         the end of the reloacatable progr
*                         (start of next program) is stored
*                         in FRESTA once a "0" tag is found
FREEND EQU  >830A            End of free memory in ERAM -
*                         points to 1st character of last
*                         entry into routine name table.
*                         (must follow FRESTA!!!)
CALIST EQU  >830A            Call list for resolving refs
RAMPTR EQU  >830A            Pointer for crunching
STADDR EQU  >830A            Start address - usually for co
SPTMP  EQU  >830A            Temporary variable
PTLCIS EQU  >830A            Ptr to last character in strin
VAR2   EQU  >830B
BYTES  EQU  >830C            BYTE COUNTER
*                             or String length for GETSTR
NMPTR  EQU  >830C            Pointer save for pscan
BBB1   EQU  >830C
PTFCIP EQU  >830C            Ptr to 1st character in phrase
BUFPNT EQU  >830E            I/O buffer pointer
CHSAV  EQU  >830E
CURINC EQU  >830E            Increment for auto-num mode
VAR4   EQU  >830E
PTCCIP EQU  >830E            Ptr to current character in ph
TOPSTK EQU  >8310            Top of data stack pointer
VAR5   EQU  >8310            VAR5 through VAR5+3 used in RA
PTLCIP EQU  >8310            Ptr to last character in phras
TAG    EQU  >8310            TAG FIELD
OLDS   EQU  >8310            FLAG BITS
TBLPTR EQU  >8310            Table pointer (CHARPAT)
FIELD  EQU  >8311            Value after TAG field, 4 bytes
*                             (must follow TAG!!!)
VAR6   EQU  >8311
LINUM  EQU  >8312            Used to determine end of scan
PTFBPH EQU  >8312            Ptr to 1st byte in PHrom
VAR7   EQU  >8312            Used in CHARLY
COUNT  EQU  >8312            FLAG BITS
STRPTR EQU  >8312            String pointer (CHARPAT)
NMLEN  EQU  >8314            Current line for auto-num
CURLIN EQU  >8314            Current line for auto-num
*                             or Starting line number for L
PTCCPH EQU  >8314            Ptr to current byte in PHrom
VAR9   EQU  >8314            Used in CHARLY
STORE  EQU  >8314            FLAG BITS
INDEXC EQU  >8315            Byte index for computing check
VARB   EQU  >8316            Source address for XML MVUP
XFLAG  EQU  >8316            SCAN FLAG-BITS USED AS BELOW
PTLCPH EQU  >8316            Ptr to last byte in PHrom
TEMP   EQU  >8316            FLAG BITS
DFLAG  EQU  >8316            Disk/Hard FLAG
DEVNUM EQU  >8317            DEVice NUMber for Hard drive
DSRFLG EQU  >8317            INTERNAL =60, EXTERNAL =0 (1)
OPTFLG EQU  >8317            Option flag byte during OPEN
FORNET EQU  >8317            Nesting level of for/next
FNUM   EQU  >8317            Current file number for search
***********************************************************
*    Permanent workspace variables
STRSP  EQU  >8318            String space begining
STREND EQU  >831A            String space ending
SREF   EQU  >831C            Temporary string pointer
SMTSRT EQU  >831E            Start of current statement
VARW   EQU  >8320            Screen address (CURSOR)
ERRCOD EQU  >8322            Return error code from ALC
STVSPT EQU  >8324            Value-stack base
RTNG   EQU  >8326            Return vector from 9900 code
NUDTAB EQU  >8328            Start of NUD table
VARA   EQU  >832A            Ending display location
PGMPTR EQU  >832C            Program text pointer (TOKEN)
EXTRAM EQU  >832E            Line number table pointer
STLN   EQU  >8330            Start of line number table
ENLN   EQU  >8332            End of line number table
DATA   EQU  >8334            Data pointer for READ
LNBUF  EQU  >8336            Line table pointer for READ
INTRIN EQU  >8338            Add of intrinsic poly constant
SUBTAB EQU  >833A            Subprogram symbol table
IOSTRT EQU  >833C            PAB list/Start of I/O chain
SYMTAB EQU  >833E            Symbol table pointer
FREPTR EQU  >8340            Free space pointer
CHAT   EQU  >8342            Current charater/token
BASE   EQU  >8343            OPTION BASE value
PRGFLG EQU  >8344            Program/imperative flag
FLAG   EQU  >8345            General 8-bit flag
BUFLEV EQU  >8346            Crunch-buffer destruction leve
LSUBP  EQU  >8348            Last subprogram block on stack
* FAC  EQU  >834A            Floating-point ACcurmulator
CCHAR  EQU  >834A            Current character
FAC1   EQU  FAC+1
SPLFLG EQU  >834B            SPelL out phrase FLaG
FAC2   EQU  FAC+2
AAA    EQU  FAC+2
TOTTIM EQU  >834C            TOTal wait TIMe
* NOTE: DATAD must follow immediately after TOTTIM. The
*       routine STDATA is counting on this fact!
FAC3   EQU  FAC+3
DATAAD EQU  >834D            Speech DATA ADdress
FAC4   EQU  FAC+4
CCC    EQU  FAC+4
FFF    EQU  FAC+4
FAC5   EQU  FAC+5
PTLCIL EQU  >834F            Pointer To Last Character In L
FAC6   EQU  FAC+6
BBB    EQU  FAC+6
EEE    EQU  FAC+6
FAC7   EQU  FAC+7
TIMLEN EQU  >8351             TIMe LENgth of timing charact
FAC8   EQU  FAC+8
PHADDR EQU  >8352             PHrom ADDRess
FAC9   EQU  FAC+9
FAC10  EQU  FAC+10
DDD1   EQU  FAC+10
TEMP1  EQU  >8354            TEMPorary CPU location 1
FAC11  EQU  FAC+11
FAC12  EQU  FAC+12
FFF1   EQU  FAC+12
TEMP2  EQU  >8356            TEMPorary CPU location 2
FAC13  EQU  FAC+13
FAC14  EQU  FAC+14
EEE1   EQU  FAC+14
READ   EQU  >8358            Address of speech peripheral
*                             READ byte interface
FAC15  EQU  FAC+15
FAC16  EQU  FAC+16
WRITE  EQU  >835A            Address of speech peripheral
*                             WRITE byte interface
FAC17  EQU  FAC+17
* ARG  EQU  >835C            Floating-point ARGument
ARG1   EQU  ARG+1
PHDATA EQU  >835D            PHrom DATA
ARG2   EQU  ARG+2
PTCBED EQU  >835E            Ptr To Current Byte Ext Data
INDEX  EQU  >835E            Label or program ID - 8 bytes
ARG3   EQU  ARG+3
ARG4   EQU  ARG+4
LENCST EQU  >8360            LEN of Current ext data STring
ARG5   EQU  ARG+5
ARG6   EQU  ARG+6
LENWST EQU  >8362            LEN of Whole ext data STring
STRLEN EQU  >8364            STRing LENgth
TEMP4  EQU  >8364
TEMP5  EQU  >8366
* NOTE: BYTE1, BYTE2, and BYTE3 must be in consecutive memo
*       locations, and in the following order for SPGET to
*       work!
BYTE1  EQU  >8366            BYTE 1
BYTE2  EQU  >8367            BYTE 2
BYTE3  EQU  >8368            BYTE 3
TEMP6  EQU  >8368
SPKSTS EQU  >8369            SPeaK StaTus
FPERAD EQU  >836C            Value stack pointer
* VSPTR  EQU  >836E          Value stack pointer
***********************************************************
*    GPL Status Block
STACK  EQU  >8372             STACK FOR DATA
SUBSTK EQU  >8373             SUBROUTINE STACK
KEYBD  EQU  >8374             KEYBOARD SELCTION
RKEY   EQU  >8375             KEY CODE
SIGNZ  EQU  >8375
EXPZ   EQU  >8376             Exponent in floating-point
JOYY   EQU  >8376             JOYSTICK Y POSITION
JOYX   EQU  >8377             JOYSTICK X POSITION
RANDOM EQU  >8378             RANDOM NUMBER GENERATOR
TIMER  EQU  >8379             TIMING REGISTER
MOTION EQU  >837A             NUMBER OF MOVING SPRITES
VDPSTS EQU  >837B             VDP STATUS REGISTER
VDPSTT EQU  >837B             VDP STATUS REGISTER
ERCODE EQU  >837C             STATUS REGISTER
CB     EQU  >837D             Character Buffer
***********************************************************
RAMTOP EQU  >8384            Highest address in ERAM
*                             = 0 if ERAM not present
RAMFRE EQU  >8386            Free pointer in the ERAM
RSTK   EQU  >8388            Subroutine stack base
*                             (Starts at >8A)
RAMFLG EQU  >8389            ERAM flag
GRAMFL EQU  >8389            GRAM / VDP flag
STKMIN EQU  >83AF            Base of data stack
STKMAX EQU  >83BD            Top of data stack
GKFLAG EQU  >83C2            GKXB flag for PEEK/LOAD VDP/GR
PRTNFN EQU  >83CE            Sound - previous tone finished
***********************************************************
*    VDP addresses
SCRNBS EQU  >02E0             Screen base addr for last lin
NLNADD EQU  >02E2             New LiNe ADDress
ENDSCR EQU  >02FE             END of SCReen address
SPRSAL EQU  >0300             Sprite attribute list
LODFLG EQU  >0371             Auto-boot needed flag
START  EQU  >0372             Line to start execution at
* Temporary
NOTONE EQU  >0374             NO-TONE for SIZE in ACCEPT us
*                              in FLMGRS (4 bytes used)
SYMBOL EQU  >0376             Saved symbol table pointer
ONECHR EQU  >0378             Used for CHRZ
VRMSND EQU  >0379             Sound blocks
SPGMPT EQU  >0382             Saved PGMPTR for continue
SBUFLV EQU  >0384             Saved BUFLEV for contiue
SEXTRM EQU  >0386             Saved EXTRAM for continue
SAVEVP EQU  >0388             Saved VSPRT for continue
ERRLN  EQU  >038A             On-error line pointer
BUFSRT EQU  >038C             Edit recall start addr (VARW)
BUFEND EQU  >038E             Edit recall end addr (VARA)
CSNTMP EQU  >0390             Use as temporary stored place
*                          or CSN TEMPORARY FOR FAC12
TABSAV EQU  >0392             Saved main symbol table ponte
AUTTMP EQU  >0394             AUTOLD TEMPORARY IN SIDE ERRZ
SLSUBP EQU  >0396             Saved LSUBP for continue
SFLAG  EQU  >0398             Saved on-warning/break bits
SSTEMP EQU  >039A             To save subprogram program ta
SSTMP2 EQU  >039C             Same as above. Used in SUBPRO
MRGPAB EQU  >039E             MERGEd temporary for pab ptr
RNDX2  EQU  >03A0             Random number generator seed
RNDX1  EQU  >03A5             Random number generator seed
INPUTP EQU  >03AA             INPUT TEMPORARY FOR PTR TO PR
SPNUM  EQU  >03AA             Sprite number temporary, also
*                              in INPUTP in FLMGR
ACCVRW EQU  >03AC             Temoporary used in ERRZZ, als
*                              used in FLMGRS
*                             or temporary for @VARW, @VARA
ACCVRA EQU  >03AE             TRY AGAIN
VALIDP EQU  >03B0             Use as two values passing fro
*                          or PTR TO STANDARD STRING IN VAL
VALIDL EQU  >03B2             VALIDATE code to READL1
*                          or Length of string in validate
SIZCCP EQU  >03B4             SIZE TEMPORARY FOR CCPADR
SIZREC EQU  >03B6             SIZE TEMPORARY FOR RECLEN
*                            Also used as temporary in RELO
*----------------------------------------------------------
* Added 6/8/81 for NOPSCAN feature
PSCFG  EQU  >03B7
*----------------------------------------------------------
ACCTRY EQU  >03B7             ACCEPT "TRY AGAIN" FLAG
SIZXPT EQU  >03B8             Save XPT in SIZE when "try ag
SAPROT EQU  >03B9             PROTECTION flag in SAVE
CSNTP1 EQU  >03BA             CSN TEMPORARY FOR FAC10
*----------------------------------------------------------
*    Flag 0:  99/4  console, 5/29/81
*         1:  99/4A console
CONFLG EQU  >03BB
*----------------------------------------------------------
OLDTOP EQU  >03BC             Temporary used in ERRZZ, also
*                          or Old top of memory for RELOCA
CPTEMP EQU  >03BC             CCPPTR, RECLEN temp in INPUT
NEWTOP EQU  >03BE             New top of memory for RELOCA
VROAZ  EQU  >03C0             Temporary roll-out area
SPRVB  EQU  >0780             Sprite velocity block.
CRNBUF EQU  >0820             CRuNch BUFfer address
CRNEND EQU  >08BE             CRuNch buffer END
RECBUF EQU  >08C0             Edit RECall BUFfer
VRAMVS EQU  >0958             Default base of value stack
***********************************************************
*    IMMEDITATE VALUES
NUMBR  EQU  >00               NUMERIC validate
LISTZ  EQU  >02
X2     EQU  >03
OLDZ   EQU  >05
RESEQZ EQU  >06
SAVEZ  EQU  >07
MERGEZ EQU  >08
DWNARR EQU  >0A
UPARR  EQU  >0B
CHRTN  EQU  >0D
BKGD   EQU  >20               BACKGROUND CHARACTER
OFFSET EQU  >60               OFFSET FOR VIDEO TABLES
STRVAL EQU  >65               Value in accum. is string val
STRING EQU  >65               String ID # for FAC
***********************************************************
* Editting command equates & keys or symbols
BREAK  EQU  >02               Break key
DLETE  EQU  >03               Delete key
INSRT  EQU  >04               Insert key
RECALL EQU  >06               Edit-buffer recall
CLRLN  EQU  >07               Clear-line key
BACK   EQU  >08               Back-space key
FORW   EQU  >09               Forward-space key
DOWN   EQU  >0A               Down-arrow key
UPMV   EQU  >0B               Up-arrow key
VWIDTH EQU  >1C               Screen width (PRINT)
SPACE  EQU  >20               Space key
QUOTE  EQU  >22               "
NUMBER EQU  >23               #
DOLLAR EQU  >24               $
CURSOR EQU  >1E+OFFSET        CURSOR
EDGECH EQU  >1F+OFFSET        EDGE character
PLUS   EQU  >2B               +
COMMAT EQU  >2C               ,
MINUS  EQU  >2D               -
HYPEN  EQU  >2D               +
PERIOD EQU  >2E               .
ZERO   EQU  >30               0
NINE   EQU  >39               9
COLON  EQU  >3A               :
SEMICO EQU  >3B               ;
LESS   EQU  >3C               <
GREAT  EQU  >3E               >
A      EQU  >41               A
F      EQU  >46               F
***********************************************************
* PAB offset
FLG    EQU  1                 FLAG BYTE ENTRY
BUF    EQU  2                 BUFFER ENTRY
LEN    EQU  4                 RECORD LENGTH ENTRY
CHRCNT EQU  5                 CHARACTER COUNT
RNM    EQU  6                 RECORD NUMBER
SCR    EQU  8                 SCREEN OFFSET ENTRY
NLEN   EQU  9                 NAME LENGTH
PABLEN EQU  10                ACTUAL PAB LENGTH
***********************************************************
*    BASIC TOKEN TABLE
*      EQU  >80               spare token
ELSEZ  EQU  >81               ELSE
SSEPZ  EQU  >82               ::
TREMZ  EQU  >83               $
IFZ    EQU  >84               IF
GOZ    EQU  >85               GO
GOTOZ  EQU  >86               GOTO
GOSUBZ EQU  >87               GOSUB
RETURZ EQU  >88               RETURN
DEFZ   EQU  >89               DEF
DIMZ   EQU  >8A               DIM
ENDZ   EQU  >8B               END
FORZ   EQU  >8C               FOR
LETZ   EQU  >8D               LET
BREAKZ EQU  >8E               BREAK
UNBREZ EQU  >8F               UNBREAK
TRACEZ EQU  >90               TRACE
UNTRAZ EQU  >91               UNTRACE
INPUTZ EQU  >92               INPUT
DATAZ  EQU  >93               DATA
RESTOZ EQU  >94               RESTORE
RANDOZ EQU  >95               RANDOMIZE
NEXTZ  EQU  >96               NEXT
READZ  EQU  >97               READ
STOPZ  EQU  >98               STOP
DELETZ EQU  >99               DELETE
REMZ   EQU  >9A               REM
ONZ    EQU  >9B               ON
PRINTZ EQU  >9C               PRINT
CALLZ  EQU  >9D               CALL
OPTIOZ EQU  >9E               OPTION
OPENZ  EQU  >9F               OPEN
CLOSEZ EQU  >A0               CLOSE
SUBZ   EQU  >A1               SUB
DISPLZ EQU  >A2               DISPLAY
IMAGEZ EQU  >A3               IMAGE
ACCEPZ EQU  >A4               ACCEPT
ERRORZ EQU  >A5               ERROR
WARNZ  EQU  >A6               WARNING
SUBXTZ EQU  >A7               SUBEXIT
SUBNDZ EQU  >A8               SUBEND
RUNZ   EQU  >A9               RUN
LINPUZ EQU  >AA               LINPUT
*      EQU  >AB               spare token (LIBRARY)
*      EQU  >AC               spare token (REAL)
*      EQU  >AD               spare token (INTEGER)
*      EQU  >AE               spare token (SCRATCH)
*      EQU  >AF               spare token
THENZ  EQU  >B0               THEN
TOZ    EQU  >B1               TO
STEPZ  EQU  >B2               STEP
COMMAZ EQU  >B3               ,
SEMICZ EQU  >B4               ;
COLONZ EQU  >B5               :
RPARZ  EQU  >B6               )
LPARZ  EQU  >B7               (
CONCZ  EQU  >B8               &          (CONCATENATE)
*      EQU  >B9               spare token
ORZ    EQU  >BA               OR
ANDZ   EQU  >BB               AND
XORZ   EQU  >BC               XOR
NOTZ   EQU  >BD               NOT
EQUALZ EQU  >BE               =
LESSZ  EQU  >BF               <
GREATZ EQU  >C0               >
PLUSZ  EQU  >C1               +
MINUSZ EQU  >C2               -
MULTZ  EQU  >C3               *
DIVIZ  EQU  >C4               /
CIRCUZ EQU  >C5               ^
*      EQU  >C6               spare token
STRINZ EQU  >C7               QUOTED STRING
UNQSTZ EQU  >C8               UNQUOTED STRING
NUMZ   EQU  >C8               ALSO NUMERICAL STRING
NUMCOZ EQU  >C8               ALSO UNQUOTED STRING
LNZ    EQU  >C9               LINE NUMBER CONSTANT
EOFZ   EQU  >CA               EOF
ABSZ   EQU  >CB               ABS
ATNZ   EQU  >CC               ATN
COSZ   EQU  >CD               COS
EXPZZ  EQU  >CE               EXP
INTZ   EQU  >CF               INT
LOGZ   EQU  >D0               LOG
SGNZZ  EQU  >D1               SGN
SINZ   EQU  >D2               SIN
SQRZ   EQU  >D3               SQR
TANZ   EQU  >D4               TAN
LENZ   EQU  >D5               LEN
CHRZZ  EQU  >D6               CHR$
RNDZ   EQU  >D7               RND
SEGZZ  EQU  >D8               SEG$
POSZ   EQU  >D9               POS
VALZ   EQU  >DA               VAL
STRZZ  EQU  >DB               STR$
ASCZ   EQU  >DC               ASC
PIZ    EQU  >DD               PI
RECZ   EQU  >DE               REC
MAXZ   EQU  >DF               MAX
MINZ   EQU  >E0               MIN
RPTZZ  EQU  >E1               RPT$
*      EQU  >E2               unused
*      EQU  >E2               unused
*      EQU  >E3               unused
*      EQU  >E4               unused
*      EQU  >E5               unused
*      EQU  >E6               unused
*      EQU  >E7               unused
NUMERZ EQU  >E8               NUMERIC
DIGITZ EQU  >E9               DIGIT
UALPHZ EQU  >EA               UALPHA
SIZEZ  EQU  >EB               SIZE
ALLZ   EQU  >EC               ALL
USINGZ EQU  >ED               USING
BEEPZ  EQU  >EE               BEEP
ERASEZ EQU  >EF               ERASE
ATZ    EQU  >F0               AT
BASEZ  EQU  >F1               BASE
*      EQU  >F2               spare token (TEMPORARY)
VARIAZ EQU  >F3               VARIABLE
RELATZ EQU  >F4               RELATIVE
INTERZ EQU  >F5               INTERNAL
SEQUEZ EQU  >F6               SEQUENTIAL
OUTPUZ EQU  >F7               OUTPUT
UPDATZ EQU  >F8               UPDATE
APPENZ EQU  >F9               APPEND
FIXEDZ EQU  >FA               FIXED
PERMAZ EQU  >FB               PERMANENT
TABZ   EQU  >FC               TAB
NUMBEZ EQU  >FD               #
VALIDZ EQU  >FE               VALIDATE
*      EQU  >FF               ILLEGAL VALUE
***********************************************************
* ASSEMBLY LANGUAGE SUPPORT FOR 99/4
*
* LOAD, INIT, PEEK, LINK, CHARPAT      JDH  08/21/80
***********************************************************
* FORMAT FOR LOAD:
*  CALL LOAD open load-directive (comma load-directive)
*            close
*    load-directive = file-name / address (comma data)
*                     (null / file-name)
*    file-name      = string-expression
*    address        = numeric-expression
*    data           = numeric-expression
*
*  FILE TYPE = FIXED 80, DISPLAY , SEQUENTIAL FILE
*
* FUNCTION:
*  LOADS ASSEMBLY LANGUAGE CODE INTO EXPANSION RAM
*  ADDRESSES: >2000 - >>3FFF RELOCATING
*  RELOCATABLE CODE INTO AVAILABLE MEMORY, ABSOLUTE CODE
*  IS LOADED
*  INTO ITS ABSOLUTE ADDRESS, ENTRY POINTS ARE DEFINED BY
*  'DEF' STATEMENTS, AND ARE LOADED INTO HIGH END OF ERAM
*
*  RELOACATABLE OR ABSOLUTE CODE MAY BE STORED ON A FILE
*  9900 OBJECT CODE FORMAT.
*   VALID TAGS = 0, 5, 6, 7, 9, A, B, C, F,:
*         TAGS 1, 2, I, M, ARE IGNORED
*  THE SYMT OPTION IS NOT SUPPORTED.
*  ABSOLUTE CODE MAY BE LOADED DIRECTLY FROM PROGRAM
*  BY SPECIFYING AN ADDRESS INSTEAD OF A FILE NAME,
*  FOLLOWED BY THE DATA TO BE LOADED (WHICH IS PUT IN THE
*   RANGE 0 to 255
*  THE RANGE OF THE ADDRESS OR DATA IS LIMITED TO
*   32767 to -32768
*  MULTIPLE DIRECT LOADS CAN BE IN THE SAME LOAD COMMAND
*  PROVIDED THEY ARE SEPARATED BY EITHER A FILENAME OR A
*   NULL STRING.
*
*  MVUP WAS USED TO TRANSFER DATA FROM CPU RAM TO ERAM
*  SINCE IT WAS NOT KNOWN AT FIRST THAT THE MOVE
*  INSTRUCTION COULD TRANSFER FROM CPU RAM TO ERAM
*   (PROVIDED THAT >8300 IS SUBTRACTED FROM THE ADDRESSES)
***********************************************************
******************* LINKAGE AND HEADER ********************
       BYTE >AA
       BYTE 0,0,0
       BYTE 0,0,0,0,0,0
       DATA 0
       BYTE 0,0,0,0
LINK1  DATA LINK2
       STRI 'LINK'
       DATA LINKIT
LINK2  DATA LINK3
       STRI 'LOAD'
       DATA LOAD
LINK3  DATA LINK4
       STRI 'INIT'
       DATA INIT
* GKXB new entry point for PEEK
LINK4  DATA LINK5
       STRI 'PEEK'
       DATA GKPEEK
* GKXB new subprograms
LINK5  DATA QTON
       STRI 'CHARPAT'
       DATA GETCHR
* LOAD - LDP1 - LDP4 - LDP5
** CHKSUM is also used as a flag to test if a file has been
** opened (so that it gets closed)
** it is initialized to >0001 and will be changed to some
** other value if a file is used
LOAD   DST  >0001,@CHKSUM     {INITIALIZE FILE FLAG}
* GKXB Change load routine. Delete check for INIT
*      add to clear flag bits.
       CALL GKLOAD
GC047  CEQ  LPARZ,@CHAT       SYNTAX ERROR if no "("
       BR   ERRSY1
       XML  PGMCHR            Skip over
* MAIN PARESE LOOP *
* Check for file-name or address
LDP1   XML  PARSE
       BYTE RPARZ           * PARSE up to ")" or ","
       CEQ  STRING,@FAC2      Process file name
       BS   LDP2
* Otherwise it is an address
* Convert address to integer, save in @PC
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Check for overflow
       BS   ERRN01
       DST  @FAC,@PC          Save in ERAM location pointer
* Check for "," if there then data should folow
*  else end of load statement, goto LDP5
LDP4   CEQ  COMMAZ,@CHAT
       BR   LDP5
* DATA follows or a STRING if no more data
       XML  PGMCHR            Skip ","
       XML  PARSE             Get data value or string if
*                              end of data
       BYTE RPARZ           * Parse up to ")" or ","
       CEQ  STRING,@FAC2      No more data
       BS   LDP2
* FAC contains a numeric
       XML  CFI               FAC to INTEGER
       CEQ  3,@FAC10          Check for overflow
       BS   ERRN01
* GKXB Code for CPU write moved to LOADDT. Add code to
*      check VDP or GRAM bits and write to VDP.
       CLOG >08,@GKFLAG       Check VDP bit
       BS   LDGRAM            No, check GRAM bit
       ST   @FAC1,V*PC        Yes, write to VDP
       DINC @PC               Point to next byte
       B    LDP4              Continue with LOAD routine
* ?????????????????????????????????????????????????????????
       AORG >0088
* Check for ")"  IF there return ELSE SYNTAX ERROR
LDP5   CEQ  RPARZ,@CHAT       Return
       BS   LDRET
       B    ERRSY1            SYNTAX ERROR
* LDP2
* Process file name
LDP2   CZ   @FAC7             Check for null string
       BS   LDNE2
* GKXB Change 'LOAD FILE' to check for INIT
       CALL GKINIT
*************** LOAD DATA INTO ERAM ***********************
* LOAD FRESTA, FREEND from ERAM
       DST  FSLOC,@VARB           Source
       DST  FRESTA,@VAR0          Destination
       DST  4,@ARG                # of bytes to move
       XML  MVUP                  Load
* Initialize PC, OFFSET in case of no "0" tag
       DST  @FRESTA,@PC
       DST  @FRESTA,@OFFADD   Base address for load module
* Read in one record, evaluate the TAG field
* LDRD - LDTG
LDRD   DST  0,@CHKSUM         Clear check sum
       CALL READIT            Rear in a record
LDTG   MOVE 5,V*BUFPNT,@TAG   Get TAG & field
       CALL LDIPCS            Add 5 to BUFPNT, add ASCII
       BYTE 5               * Value of chars. Read to check
* Convert @FIELD to numeric (from ASCII hex value)
* Store result: HIGH BYTE to FIELD, LOW BYTE to FIELD+1
* Convert HIGH BYTE first: @FIELD & @FIELD+1
* Store result in field
       SUB  >30,@FIELD        >30 = "0"
       CGT  9,@FIELD          Subtract ASCII difference
*                              between "9" and "A"
       BR   GC0C7
       SUB  7,@FIELD
GC0C7  SLL  4,@FIELD          FIELD=FILED*32
       SUB  >30,@FIELD+1
       CGT  9,@FIELD+1
       BR   GC0D5
       SUB  7,@FIELD+1
GC0D5  ADD  @FIELD+1,@FIELD   Add to HIGH BYTE
* Now convert LOW BYTE: @FIELD+2 & @FIELD+3
* Store result in LOW BYTE of FIELD to FIELD+1
       SUB  >30,@FIELD+2
       CGT  9,@FIELD+2
       BR   GC0E3
       SUB  7,@FIELD+2
GC0E3  ST   @FIELD+2,@FIELD+1 Store in LOW byte of result
       SLL  4,@FIELD+1        FIELD+1 = FIELD+1*32
       SUB  >30,@FIELD+3
       CGT  9,@FIELD+3
       BR   GC0F4
       SUB  7,@FIELD+3
GC0F4  ADD  @FIELD+3,@FIELD+1 Add to low byte
* Branch to evaluation procedure for TAG
       SUB  >30,@TAG          >30 = "0"
       CGE  0,@TAG            If TAG < "0" ILLEGAL CHAR
       BR   ERRUC1
       CGT  >0A,@TAG          TAGS "0" to ":"
       BS   GC11C
       CASE @TAG
       BR   TAG0              "0" RELOCATABLE LENGTH
       BR   LDTG              IGNORE "1" TAG
       BR   LDTG              IGNORE "2" TAG
       BR   ERRUC1            No external REF "3"
       BR   ERRUC1            No external REF "4"
       BR   TAG5              "5" relocatable entry DEF
       BR   TAG6              "6" Absolute entry    DEF
       BR   TAG7              "7" check sum
       BR   LDTG              "8" ignore check sum
       BR   TAG9              "9" Absolute LOAD address
       BR   LDDNE             ":" end of file
GC11C  SUB  >11,@TAG          Subtract offset so
*                              that "A" is =0
       CGE  0,@TAG            ";" to "@" illegal char
       BR   ERRUC1
* Skip over "I" tag - 8 char, program ID that follows
       CEQ  8,@TAG
       BS   LDTG2
* Skip over "M" TAG -10 char, program ID that follows
       CEQ  12,@TAG
       BR   LDTG3
       CALL LDIPCS
       BYTE 10
       B    LDTG
LDTG3  CGT  5,@TAG            TAGS "G" are legal
       BS   ERRUC1
       CASE @TAG
       BR   TAGA              "A" RELOCATABLE PROGRAM ADDRE
       BR   TAGB              "B" ABSOLUTE VALUE
       BR   TAGC              "C" RELATIVE ADDRESS
       BR   ERRUC1            "D" ERROR
       BR   ERRUC1            "E" ERROR - UNDEFINED
       BR   LDRD              "F" END OF RECORD
* TAG0 to TAGB
* EVALUATE TAG FIELDS
TAG0   DST  @FRESTA,@OFFADD   NEW BASE ADDRESS
       DST  @FRESTA,@PC       NEW PC
       DADD @FIELD,@FRESTA    ADD LENGTH TO FIND END OF
*                              RELOCATABLE PROGRAM WHICH IS
*                              START OF NEXT PROGRAM
* Make sure we won't run into routine name table now, so we
*  don't have to check every time we load a value into ERAM
*  routine table must make sure it doesn't run into
*  relocatable assembly language code through.
       DCHE @FREEND,@FRESTA   OUT OF MEMORY
       BS   ERRMF1
* SKIP OVER PROGRAM ID - 8 BYTES
LDTG2  CALL LDIPCS
       BYTE 8               * INC BUFPNT, COMPUTE CHECKSUM
       B    LDTG
TAG5   DADD @OFFADD,@FIELD    Add starting offset
* TAG6 is an absolute address so do not need to add offset
TAG6   MOVE 6,V*BUFPNT,@INDEX    Get symbol name
       CALL LDIPCS            INC BUPNT, COMPUT CHECKSUM
       BYTE 6              *  We read 6 chars
* Add symbol and its address - stopped in field - to the
*  routine entry table. It is put at the end of the table
*  (the end of the table is towards the low end of memory)
*  Since the table is searched from the end first, if there
*  are any duplicate labels the last one entered will have
*  precedence over the early one(s).
       DDECT @FREEND          Set to address field
* Load address (stored in field in CPU RAM) into routine
*  Name table which is in expansion RAM
       DST  FIELD,@VARB        Source
       DST  @FREEND,@VAR0      Destination
       DST  2,@ARG             # bytes to move
       XML  MVUP              CPUR RAM to ERAM
* Load symbol into routine name table
       DSUB 6,@FREEND         Set to symbol field
       DST  INDEX,@VARB         Source
       DST  @FREEND,@VAR0       Destination
       DST  6,@ARG              Move 6 bytes
       XML  MVUP              CPU RAM to ERAM
* Check to see if we've run into assembly language code
       DCHE @FREEND,@FRESTA   Out of memory
       BS   ERRMF1
       B    LDTG              If not then continue
***********************************************************
* ROUTINE NAME TABLE ENTRY
*
*                     0   1   2   3   4   5   6  7
*                   -----------------------------------
*        FREEND     | S | Y | M | B | O | L | ADDRESS |
*    (AFTER ENTRY)  -----------------------------------
*        FREEND     |   |   |   |   |   |   |         |
*    (BEFORE ENTRY) -----------------------------------
*
*  FREEND is initialized to >4000 by INIT, address is at
*   a higher memory location then symbol
***********************************************************
TAG7   DNEG @FIELD            Checksum is 1's compelement
       DCEQ @FIELD,@CHKSUM    Check sum error
       BR   ERRDE1
       B    LDTG
TAGA   DADD @OFFADD,@FIELD    PC = OFFADD ^ FIELD
* TAG 9 is an absolute address so no need to add offset
TAG9   DST  @FIELD,@PC
       B    LDTG
TAGC   DADD @OFFADD,@FIELD
* TAG B is an absolute entry so no need to add offset
* Relocatable code is checked to see if it will run into
*  is no need to check now. Absolute code can go anywhere.
*
* Load field into expansion RAM using MVUP routine
TAGB   DST  @PC,@VAR0           Destination
       DST  FIELD,@VARB         Source
       DST  2,@ARG              Move 2 bytes
       XML  MVUP              CPU RAM to ERAM
       DINCT @PC              We loaded 2 bytes
       B    LDTG
********* END OF LOAD FOR CURRENT FILE ********************
*
* FRESTA & FREEND are stored in CPU RAM (>8308)
* While loading a file into expansion RAM.
* So if the values of FRESTA or FREEND are to be changed
* then word locations >8308 and >830A must be changed and
* not expansion RAM.
*
* LDDNE - LDNE2
*
*   DONE WITH LOAD
* Put FRESTA, FREEND back into expansion RAM
* If FRESTA is odd then make it even
*  so that the next program starts on an even boundry
LDDNE  CLOG 1,@FRESTA+1       Low byte odd?
       BS   GC1C1
       DINC @FRESTA           Force to next even boundry
GC1C1  DST  FRESTA,@VARB          Source
       DST  FSLOC,@VAR0           Destination
       DST  4,@ARG                Load 4 bytes
       XML  MVUP              CPU RAM to ERAM
       CALL CLSIT             Close file
* Check for end of load command ")"
LDNE2  CEQ  RPARZ,@CHAT       Check for ")"
       BS   LDRET
       CEQ  COMMAZ,@CHAT      Syntax error
       BR   ERRSY1
       XML  PGMCHR            Skip comma
       B    LDP1              Continue in main loop
*************** LDRET - LDRET2 ****************************
*
* Return to calling routine
LDRET  XML  PGMCHR            Skip over
* Entry point for INIT
LDRET2 CALL CHKEND            Check for end of statement
       BR   ERRSY1            If not end then syntax error
       CALL RPL               Return to caller
********************** CHKIN ******************************
* Check for INIT-FLAG = >AA55
* MOVE ERAM(INITF) to CPU *FAC
PAGE   EQU  $
CHKIN  DST  FAC,@VAR0         Destination
       DST  INITF,@VARB       Source
       DST  2,@ARG            2 bytes
       XML  MVUP              Move it
       DCEQ >AA55,@FAC        Syntax error
       BR   ERRSYN
* No files have been opened so if there is a syntax error
*  goto ERRSYN!
       RTN
*********************** FILE ROUTINES *********************
***********************************************************
* INCREMENT BUFFER POINTER by value after call statement
* ADD VALUES READ TO CHECKSUM unless the first character
* is a "7" = >37 , then add only "7" character to checksum
* (other value is the checksum)
*
*************************** LDIPCS ************************
LDIPCS FETCH @INDEXC          Index = # of bytes read
       CEQ  >37,V*BUFPNT
       BR   GC213
       DADD >0037,@CHKSUM     Add value of "7" to checksum
       DADD 5,@BUFPNT         1 for "7", 4 for checksum
       B    GC224
GC213  ST   V*BUFPNT,@FAC1    Convert to 2 byte value
       CLR  @FAC              -----------------------------
       DADD @FAC,@CHKSUM      Add char to checksum
       DINC @BUFPNT
       DEC  @INDEXC           Do it index # of times
       CZ   @INDEXC
       BR   GC213
GC224  RTN
********************** OPENIT *****************************
OPENIT DST  @FAC6,@BYTES      Store actual spec length
       DADD PABLEN+80,@BYTES  Add in the PAB length and
*                              buffer length
       XML  VPUSH             Push possible temp string
       XML  GETSTR             and try to allocate space
       XML  VPOP              Restore original string data
*
* THE FOLLOWING VARIABLES CONTAIN IMPORTANT INFO
*
*   FAC4, FAC5    Start address of original device specific
*   FAC6, FAC7    Length of original device specifications
*   SREF          Location of PAB in VDP memory
*   BYTES         Length of entire PAB including specificat
       MOVE @FAC6,V*FAC4,V@PABLEN(@SREF)
       CLR  V*SREF               Clear the entire PAB
       MOVE PABLEN-1,V*SREF,V@1(@SREF)
       ST   @FAC7,V@NLEN(@SREF)  Copy specifications length
       ST   >60,V@SCR(@SREF)     Screen offset
       ST   4,V@FLG(@SREF)       Dis, fix, seq, input
       DADD @SREF,@FAC6          Calculate the address of
       DADD PABLEN,@FAC6          the buffer
       DST  @FAC6,V@BUF(@SREF) Store buffer address in PAB
       CALL DSRCAL
       RTN
***********************************************************
READIT DST  V@BUF(@SREF),@BUFPNT   INIT buffer pointer
       ST   2,V*SREF
       ST   V@LEN(@SREF),V@CHRCNT(@SREF)
       CALL DSRCAL
       RTN
************************* CLSIT ***************************
CLSIT  ST   1,V*SREF          Prepare to close
******************** DSRCAL - DSKERR **********************
DSRCAL DST  @SREF,@FAC12      Compute start address of spec
       DADD NLEN,@FAC12       Ready to call DSR routine
       CALL DSR               Call DSR thourgh program link
       BYTE 8               * Type = DSR (8)
       BS   DSKERR            Couldn't find the DSR
       CLOG >E0,V@FLG(@SREF)  Set condition bit if no error
       BR   DSKERR
       RTN
DSKERR DST  @FREPTR,@PABPTR   Set up dummy PAB
       DSUB 6,@PABPTR         Make it standard size
       DST  V*SREF,V@4(@PABPTR) Store error code
       CALL CLSNOE              Close File
       CALL ERRZZ               Issue I/O error
       BYTE 36              *
********************** CLSNOE *****************************
* Try to close the current file
* Ignore any errors from the closing of the file.
* Since the PAB is not in the normal PAB list
*  then we have to close the file in the load routine.
* ERRZZ will close the rest of the files.
*
** CLOSE IT ONLY IF IT HAS BEEN OPENED
CLSNOE DCEQ 1,@CHKSUM         Check file flag
       BS   GC2B9
       ST   1,V*SREF          Store close file code
       DST  @SREF,@FAC12      Compute start address of spec
       DADD NLEN,@FAC12       Ready to CALL DSR
       CALL DSR               CALL DSR through program link
       BYTE 8               * "8" is type of DSR
GC2B9  RTN
***********************************************************
* INIT                        JDH   9/02/80
***********************************************************
* Check if expansion RAM present
* Load support into expansion RAM from GROM
INIT   CZ   @RAMTOP           If no ERAM, SYNTAX ERROR
       BS   ERRSYN
** Load Assembly header, support routines **
* GKXB Correct INIT routine.
       MOVE >04EA,G@ALCEND,@>2000
       B    LDRET2
***********************************************************
* PEEK INSTRUCTION            JDH   9/04/80
***********************************************************
*
* FORMAT:
*  CALL PEEK open address (comma numeric-variable) * close
* FUNCTION:
*  RETURNS THE VALUE AT address IN ERAM INTO numeric-variab
*  IF MORE THAN ONE numeric-variable IS SPECIFIED THEN
*  address IS INCREMENTED AND THE VALUE IN ERAM AT THE NEW
*  address IS ASSIGNED TO THE NEXT VARIABLE AND SO ON.
*
PEEK   CEQ  LPARZ,@CHAT       Chat = "("
       BR   ERRSYN
       XML  PGMCHR            Skip "("
       XML  PARSE             Get value of address
       BYTE RPARZ
       CEQ  STRING,@FAC2      Address MUST BE NUMERIC
       BS   ERRSNM
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Overflow?
       BS   ERRNO
       DST  @FAC,@PC          Save peek address
       CEQ  COMMAZ,@CHAT      CHAT = "," ?
       BR   ERRSYN
PEEK2  XML  PGMCHR            Skip ","
* The following check has been put in SYM, 5/26/81
* If @CHAT >= >80 then ERRSYN (Don't allow token)
       XML  SYM               Get symbol name
       XML  SMB               Get value pointer
       XML  VPUSH             Save FAC on stack for ASSGNV
       CZ   @FAC2             Must be numeric
       BR   ERRSNM
       CLR  @FAC
       MOVE 7,@FAC,@FAC1      Clear FAC
** GET PEEK VALUE FROM ERAM INTO  @FAC1
* GKXB Change PEEK routine to read VDP/GRAM. Move CPU read
*      code to PEEKDT and add code for bite check and VDP
*      read.
       CLOG >08,@GKFLAG       Check VDP bit
       BS   PKGRAM            No, check GROM bit
       ST   V*PC,@FAC1        Yes, read VDP
       B    GC308
* ?????????????????????????????????????????????????????????
       AORG >0308
GC308  XML  CIF               Convert FAC to F.P. value
       XML  ASSGNV            Assign to numeric-variable
       CEQ  COMMAZ,@CHAT
       BR   PEEK5
       DINC @PC               INC pointer to next ERAM addr
       B    PEEK2
* CHECK FOR ")" AND END OF STATEMENT
* IF ALL OK, THEN RETURN TO CALLER
* GETCHR ALSO RETURNS TO HERE
PEEK5  CEQ  RPARZ,@CHAT
       BR   ERRSYN
       XML  PGMCHR            Skip "("
       CALL CHKEND
       BR   ERRSYN
       CALL RPL               RETURN TO CALLER
***********************************************************
* LINK INSTRUCTION : SE Sep 1980
***********************************************************
*  FORMAT:
*  CALL LINK("file-name",parameter1,parameter2,...)
*
*  LINK ROUTINE READS THE FILE NAME SPECIFIED BY THE USER A
*  SAVE THE ADDRESS OF THE NAME FOR LATER USE. THE FILE WIL
*  BE SEARCHED IN UTILITY CODE LATER ON.
*
*  PARAMETERS ARE PASSED EITHER BY REFERENCE OR BY VALUE.
*  NUMERIC OR STRING VARIABLES AND NUMERIC OR STRING ARRAYS
*  ARE PASSED BY REFERENCE AND ALL OTHERS INCLUDING A USER
*  DEFINED FUNCTION ARE PASSED BY VALUE.
*
*  PARAMETER INFORMATION IS STORED IN CPU >8300 THROUGH >83
*  THAT GIVES A PARAMETER TYPE CODE OF EACH PARAMETER.
*        CODE 0 ... Numeric expression
*        CODE 1 ... String experession
*        CODE 2 ... Numeric variable
*        CODE 3 ... String variable
*        CODE 4 ... Numeric array
*        CODE 5 ... String array
*
*  IF A PARAMETER IS PASSED AS A NUMERIC EXPRESSION ITSL
*  ACTUAL VALUE GETS PUSHED INTO THE VALUE STACK. IN CASE O
*  A STRING EXPRESSION , ITS VALUE STACK CONTAINS AN ID(>65
*  POINTER TO THE VALUE SPACE AND ITS LENGTH. IF A PARAMETE
*  GETS PASSED AS A REFERENCE THE PRODUCT OF XML SYM AND XM
*  SMB IN THE @FAC AREA GETS PUSHED INTO STACK.
*
*  AFTER AN ASSEMBLY LANGUAGE SUBPROGRAM IS EXECUTED LINK
*  ROUTINE WILL POP THE STACK TO GET RID OF PARAMETER
*  INFORMATION. CONTROL WILL BE TRANSFERED TO THE XB MAIN
*  PROGRAM AFTERWARDS.
*
***********************************************************
* CALL LINK program
***********************************************************
LINKIT CALL CHKIN             Check if INIT has been called
       DST  @VSPTR,@OLDS      Save VSPTR for later use
       CEQ  LPARZ,@CHAT       Check for "("
       BR   ERRSYN
       XML  PGMCHR            Advance program pointer
       XML  PARSE             Get the routine name.
       BYTE RPARZ           * Read up to ")"
       CEQ  >65,@FAC2         Should be a string
       BR   ERRBA
       DCZ  @FAC6             Don't accept null string
       BS   ERRBA
       CH   6,@FAC7           Should be less then 6 char
       BS   ERRBA
       XML  VPUSH             Push to make it semi-permanen
       CLR  @COUNT            Initialize parameter counter
***********************************************************
* PARAMETERS get evaluated here
***********************************************************
PAR01  CEQ  RPARZ,@CHAT       No arg. So execute it
       BS   EXE01
       CEQ  COMMAZ,@CHAT      Should have a comma
       BR   ERRSYN
       DST  @PGMPTR,@ERRCOD   Save text pointer
       XML  PGMCHR            Get the character
       CHE  >80,@CHAT         Must be an expression
       BS   VAL01
* If CHAT = LPARZ then pass by expression
       CALL CLRFAC            Clear FAC entry for SYM
       XML  SYM               Read in the symbol table info
* After XML SYM @FAC area contains a pointer to symbo table
* Below statement checks if it is a UDF.
       CLOG >40,V*FAC         Pass by value
       BR   VAL01
       CEQ  COMMAZ,@CHAT      Pass by reference
       BS   REF01
       CEQ  RPARZ,@CHAT       Pass by reference
       BS   REF01
       CEQ  LPARZ,@CHAT       An array
       BS   ARRAY
       CHE  >80,@CHAT         Pass by value
       BS   VAL01
       BR   ERRSYN
***********************************************************
* ARRAY case gets checked here
***********************************************************
* Should look like A(,,) etc.
* Stack entry for an array will look like
* +--------------+-------+---+-------------+---------------
* | Pointer to   |  >00  |   | Pointer to  |
* | symbol table |   or  |   | dim info in |
* | entry        |  >65  |   | real v.s.   |
* +- FAC --------+ FAC2 -+---+- FAC4 ------+- FAC6 --------
*
ARRAY  XML  PGMCHR            Get the next character
       CEQ  RPARZ,@CHAT       Pass by reference
       BS   ARRAY2
       CEQ  COMMAZ,@CHAT      More array information
       BS   ARRAY
       DDEC @PGMPTR           Adjust the pointer
       ST   LPARZ,@CHAT
       BR   REF01             Pass by reference
* In array cases the symbol table address gets stored at FA
* area, and the pointer to the value space (dimension info)
* goes into FAC4
ARRAY2 XML  PGMCHR            Advance the program pointer
       CLOG >80,V*FAC         Test string bit
       BR   GC39D
       ST   4,*COUNT          Numeric array
       BR   GC3A1
GC39D  ST   5,*COUNT          String array case
* Check if array is being shared. If it is then go back
* through the linkage to get the actuals symbol table
* pointer. Put the pointer to the value space (dimension in
* into FAC4.
GC3A1  CLOG >20,V*FAC         Shared array?
       BS   GC3BE
       MOVE 2,V@6(@FAC),@FAC4 If so, get pointer
       CLOG >20,V@-6(@FAC4)   Shared also?
       BS   GC3BC
       MOVE 2,V*FAC4,@FAC4    Array is not shared
GC3BC  BR   GC3C5
GC3BE  DST  @FAC,@FAC4        Array is not shared
       DADD 6,@FAC4           Point to value space
GC3C5  BR   PUSH
***********************************************************
* VALUE
*  Passing the parameter by value
***********************************************************
VAL01  DST  @ERRCOD,@PGMPTR   Restore program pointer
       XML  PGMCHR            Skip the first character
       DST  @BYTES,@TEMP      In case of passing a string
       XML  PARSE             Parsing up to comma
       BYTE RPARZ
       DST  @TEMP,@BYTES      Restore the value in >0C area
* After parsing @FAC area contains its actual numeric value
*  in a numeric case, and the following information in a
*  string case.
* +----------------+-----+--+------------+-----------------
* | >001C  or      | >65 |  | Pointer to | Length of string
* | value pointer  |     |  | string     | string
* | address        |     |  |            |
* +- FAC ----------+-FAC2+--+-FAC4 ------+- FAC6 ----------
*
       CGT  >63,@FAC2         If more then 99 then
       BR   GC3E0
       ST   1,*COUNT          Store flag for string express
       BR   GC3E3
GC3E0  CLR  *COUNT            Otherwise it is a numeric exp
GC3E3  BR   PUSH              Push into stack
***********************************************************
* REFERENCE
*   Passing the parameter by reference
***********************************************************
* Variables, array element and whole array passing.
*
* After SMB @FAC entry shold look like;
* +--------------+------+-----+-------------+--------------
* | Pointer to   | >00  |     | Pointer to  |
* | symbol table |      |     | value space |
* | entry        |      |     |             |
* +-- FAC -------+ FAC2 +-----+- FAC4 ------+- FAC6 -------
*  for numeric case, and
* +--------------+------+-----+-------------+--------------
* | Pointer to   | >65  |     | Pointer to  | String
* | value space  |      |     | string      | length
* | entry        |      |     |             |
* +- FAC --------+ FAC2 +-----+- FAC4 ------+- FAC6 -------
* for a string case.
REF01  XML  SMB               Get the location
       CHE  >B8,@CHAT         Pass array expression
       BS   VAL01
       CZ   @FAC2
       BR   GC3F6
       ST   2,*COUNT          Must be a numeric variable
       BR   PUSH
GC3F6  ST   3,*COUNT          Must be a string variable
***********************************************************
* PUSH routine
*  Pushes @FAC entry into a value stack.
***********************************************************
PUSH   INC  @COUNT
       CGT  16,@COUNT         Too many parameters
       BS   ERRBA
       XML  VPUSH
       BR   PAR01             Get the next argument.
***********************************************************
* EXECUTE routine
*  Restore file name info transfer control over to ALC
***********************************************************
EXE01  ST   >20,@FAC          Store blank in the FAC area.
       MOVE 5,@FAC,@FAC1
       MOVE 4,V@12(@OLDS),@STORE   Get the file name info
       MOVE @STORE+2,V*STORE,@FAC  Move to FAC
       DCLR @ERRCOD           Clear program pointer for
*                              error code
       XML  ALSUP             Go to CPU at >2000 to execute
       BS   ERROR             Error found
*                             If no error, start checking s
***********************************************************
* RETURN to the XB main program.
***********************************************************
NOERR  DCH  @OLDS,@VSPTR      Pop the stack
       BR   GC429
       XML  VPOP              Pop the stack
       B    NOERR
GC429  B    LNKRTN            Check ")" and end of statemen
***********************************************************
* SUBROUTINES used in this file.
***********************************************************
CLRFAC CLR  @FAC
       MOVE 7,@FAC,@FAC1
       RTN
***********************************************************
* CHARPAT ROUTINE             99/4A - JDH 10/01/80
***********************************************************
*
* FORMAT:
*  CALL CHARPAT open (numeric expression, string expression
*
*  FUNCTION:
*   RETURNS THE CHARACTER DEFINITION PATTERN FOR CHARACTER
*   NUMBER <numeric expression> INTO <string expression>
*
******************* GETCHR - GETCHR2***********************
GETCHR CEQ  LPARZ,@CHAT
       BR   ERRSYN
GCHR2  XML  PGMCHR
       XML  PARSE
       BYTE RPARZ
       CEQ  STRING,@FAC2      Can't be a string
       BS   ERRSNM
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Range 32 to 143
       BS   ERRBA
       DCGE 30,@FAC           30
       BR   ERRBA
       DCGT 159,@FAC          159
       BS   ERRBA
       DSLL 3,@FAC            8 bytes / entry so times 8
       DST  >0300,@TBLPTR     Base of char table less 32*8
       DADD @FAC,@TBLPTR      Add in arg offset
       DST  16,@BYTES         16 byte string in string spac
       XML  GETSTR
       DST  @SREF,@STRPTR     Save pointer to string
       ST   8,@INDEXC         Loop counter
GC46D  ST   V*TBLPTR,V*STRPTR
       SRL  4,V*STRPTR        Get rid of low nibble
       ADD  >30,V*STRPTR      Add ASCII "0"
       CGT  >39,V*STRPTR      >39 = ASCII "9"
       BR   GCHR3
       ADD  7,V*STRPTR        Value "A" to "F"
GCHR3  DINC @STRPTR
       ST   V*TBLPTR,V*STRPTR
       AND  >0F,V*STRPTR
       ADD  >30,V*STRPTR      Add ASCII "0"
       CGT  >39,V*STRPTR
       BR   GCHR4
       ADD  7,V*STRPTR        Value "A" to "F"
GCHR4  DINC @TBLPTR
       DINC @STRPTR
       DEC  @INDEXC
       CZ   @INDEXC
       BR   GC46D
* NOW assign the string just created to the string
*  variable following
       XML  PGMCHR            Skip comma
* The following check has been put in SYM, 5/26/81
* If CHAT >= >80 then ERRSYN (Do not allow token).
       XML  SYM           Get symbol table info for next ar
       XML  SMB
       XML  VPUSH         Save on stack for ASSGNV
       CEQ  STRING,@FAC2      Must be a stirng variable
       BR   ERRSNM
       DST  >001C,@FAC        Temp string so use SREF as ad
       DST  @SREF,@FAC4       Pointer to string
       DST  16,@FAC6          String length
       XML  ASSGNV            Assign to string variable
       CEQ  COMMAZ,@CHAT
       BS   GCHR2
       B    PEEK5
***********************************************************
************** ERROR BRANCH TABLE FOR LINK ****************
***********************************************************
ERROR  CASE  @ERRCOD
       BR   NOERR
       BR   NOERR
       BR   ERRNO             2 Numeric Overflow
       BR   ERRSYN            3 SYNtax error
       BR   ERRIBS            4 Illegal after subprogram
       BR   ERRNQS            5 unmatched quotes
       BR   ERRNTL            6 Name Too Long
       BR   ERRSNM            7 String Number Mismatch
       BR   ERROBE            8 Option Base Error
       BR   ERRMUV            9 iMproperly Used name
       BR   ERRIM            10 IMage error
       BR   ERRMEM           11 MEMory full
       BR   ERRSO            12 Stack Overflow
       BR   ERRNWF           13 Next Without For
       BR   ERRFNN           14 For Next Nesting
       BR   ERRSNS           15 must be in subprogram
       BR   ERRRSC           16 Recursive Subprogram Call
       BR   ERRMS            17 Missing Subend
       BR   ERRRWG           18 Return Without Gosub
       BR   ERRST            19 String Truncated
       BR   ERRBS            20 Bad Subscript
       BR   ERRSSL           21 Speech String too Long
       BR   ERRLNF           22 Line Not Found
       BR   ERRBLN           23 Bad Line Number
       BR   ERRLTL           24 Line Too Long
       BR   ERRCC            25 Can't Continue
       BR   ERRCIP           26 Command Illegal in Program
       BR   ERROLP           27 Only Legal in a Program
       BR   ERRBA            28 Bad Argument
       BR   ERRNPP           29 No Program Present
       BR   ERRBV            30 Bad Value
       BR   ERRIAL           31 Incorrect Argument List
       BR   ERRINP           32 INPut error
       BR   ERRDAT           33 DATa error
       BR   ERRFE            34 File Error
       BR   NOERR
       BR   ERRIO            36 I/O error
       BR   ERRSNF           37 Subprogram Not Found
       BR   NOERR
       BR   ERRPV            39 Protected Violation
       BR   ERRIVN           40 unrecognized Character
       BR   WRNNO            41 Numeric Number Overflow
       BR   WRNST            42 String Truncated
       BR   WRNNPP           43 No Program Present
       BR   WRNINP           44 INPut error
       BR   WRNIO            45 I/O error
       BR   WRNLNF           46 Line Not Found
***********************************************************
**************** ERROR HANDLING SECTION *******************
***********************************************************
ERRN01 CALL CLSNOE            * ENTRY FOR LOAD
ERRNO  CALL ERRZZ             * Numeric Overflow
       BYTE 2
ERRSY1 CALL CLSNOE            * ENTRY FOR LOAD
ERRSYN CALL ERRZZ             * SYNtax error
       BYTE 3
ERRIBS CALL ERRZZ             * Illegal after subprogram
       BYTE 4
ERRNQS CALL ERRZZ             * uNmatched QuoteS
       BYTE 5
ERRNTL CALL ERRZZ             * Name Too Long
       BYTE 6
ERRSNM CALL ERRZZ             * String Number Mismatch
       BYTE 7
ERROBE CALL ERRZZ             * Option Base Error
       BYTE 8
ERRMUV CALL ERRZZ             * Improperly used name
       BYTE 9
ERRIM  CALL ERRZZ             * Image Error
       BYTE 10
ERRMF1 CALL CLSNOE            * ENTRY FOR LOAD
ERRMEM CALL ERRZZ             * MEMory full
       BYTE 11
ERRSO  CALL ERRZZ             * Stack Overflow
       BYTE 12
ERRNWF CALL ERRZZ             * Next Without For
       BYTE 13
ERRFNN CALL ERRZZ             * For-Next Nesting
       BYTE 14
ERRSNS CALL ERRZZ             * must be in subprogram
       BYTE 15
ERRRSC CALL ERRZZ             * Recursive Subprogram Call
       BYTE 16
ERRMS  CALL ERRZZ             * Missing Subend
       BYTE 17
ERRRWG CALL ERRZZ             * Return Without Gosub
       BYTE 18
ERRST  CALL ERRZZ             * String Truncated
       BYTE 19
ERRBS  CALL ERRZZ             * Bad Subscript
       BYTE 20
ERRSSL CALL ERRZZ             * Speech String too Long
       BYTE 21
ERRLNF CALL ERRZZ             * Line Not Found
       BYTE 22
ERRBLN CALL ERRZZ             * Bad Line Number
       BYTE 23
ERRLTL CALL ERRZZ             * Line Too Long
       BYTE 24
ERRCC  CALL ERRZZ             * Can't Continue
       BYTE 25
ERRCIP CALL ERRZZ             * Command Illegal in Program
       BYTE 26
ERROLP CALL ERRZZ             * Only Legal in a Program
       BYTE 27
ERRBA  CALL ERRZZ             * Bad Argument
       BYTE 28
ERRNPP CALL ERRZZ             * No Program Present
       BYTE 29
ERRBV  CALL ERRZZ             * Bad Value
       BYTE 30
ERRIAL CALL ERRZZ             * Incorrect Argument List
       BYTE 31
ERRINP CALL ERRZZ             * INPut error
       BYTE 41
ERRDE1 CALL CLSNOE            * ENTRY FOR LOAD
ERRDAT CALL ERRZZ             * DATa error / Checksum error
       BYTE 33
ERRFE  CALL ERRZZ             * File Error
       BYTE 34
ERRIO  CALL ERRZZ             * I/O error
       BYTE 36
ERRSNF CALL ERRZZ             * Subprogram Not Found
       BYTE 37
ERRPV  CALL ERRZZ             * Protection Violation
       BYTE 39
ERRUC1 CALL CLSNOE            * ENTRY FOR LOAD
ERRIVN CALL ERRZZ             * Unrecognized character / il
       BYTE 40
WRNNO  CALL WARNZZ            * Numeric Overflow
       BYTE 2
       BR   NOERR
WRNST  CALL WARNZZ            * String Truncated
       BYTE 19
       BR   NOERR
WRNNPP CALL WARNZZ            * No Program Present
       BYTE 29
       BR   NOERR
WRNINP CALL WARNZZ            * INPut Error
       BYTE 32
       BR   NOERR
WRNIO  CALL WARNZZ            * I/O error
       BYTE 35
       BR   NOERR
WRNLNF CALL WARNZZ            * Line Not Found
       BYTE 38
       BR   NOERR
***********************************************************
* RXB move INIT code to >9800
***********************************************************
*
* CALL QUITON routine
*
QTON   DATA QTOFF
       STRI 'QUITON'
       DATA QTON1
QTON1  AND  >EF,@GKFLAG  Reset QUIT bit
       B    LDRET2       Return
*
* CALL QUITOFF routine
*
QTOFF  DATA POKEV
       STRI 'QUITOFF'
       DATA QTOFF1
QTOFF1 OR   >10,@GKFLAG  Set QUIT bit
       BR   LDRET2       Return
*
* Set-up for CALL GKLOAD routine
*
GKLOAD AND  >F0,@GKFLAG  Reset flag bits
       RTN               Return
*
* POKEV routine
*
POKEV  DATA PEEKV
       STRI 'POKEV'
       DATA POV
POV    CALL GKSETV       Set VDP bit
       DST  1,@CHKSUM    For GKLOAD routine
       B    GC047        Goto GKLOAD
*
* Check for CALL GKINIT on 'LOAD FILE'
*
GKINIT XML  VPUSH        Save FAC
       CALL CHKIN        Check for GKINIT
       XML  VPOP         Restore FAC
       CLOG >C,@GKFLAG   Error if POKEG or POKEV
       BR   ERRSYN
       B    OPENIT       Open the file
*
* New entry point for CALL PEEK,
* clears flag bits.
*
GKPEEK AND  >F0,@GKFLAG
       B    PEEK
*
* PEEKV routine
*
PEEKV  DATA PEEKG
       STRI 'PEEKV'
       DATA PKV
PKV    CALL GKSETV       Set VDP bit
       B    PEEK         Use PEEK routine
*
* Set flag bit for VDP read & write
*
GKSETV AND  >F0,@GKFLAG  Reset both bits
       OR   8,@GKFLAG    Set VDP bit
       RTN               Return
*
* Set flag bit for GROM read & write
*
GKSETG AND  >F0,@GKFLAG  Reset both bits
       OR   4,@GKFLAG    Set GROM bit
       RTN               Return
*
* PEEKG routine
*
PEEKG  DATA POKEG
       STRI 'PEEKG'
       DATA PKG
PKG    CALL GKSETG       Set flag bit
       B    PEEK         Use PEEK routine
*
* POKEG routine
*
POKEG  DATA CATLOG
       STRI 'POKEG'
       DATA POG
POG    CALL GKSETG       Set flag bit
       DST  1,@CHKSUM    For LOAD routine
       B    GC047        Use LOAD routine
*
* Routine to write to GRAM
*
LDGRAM CLOG 4,@GKFLAG    Check GROM bit
       BS   LOADDT       No, CPU load
       MOVE 1,@FAC1,G@0(@PC) Write to GRAM
       DINC @PC          Point to next byte
       B    LDP4         Continue
*
* Relocated data from GKLOAD routine.
*
LOADDT MOVE 1,@FAC1,@0(@PC)   Read byte
       DINC @PC                INC ERAM address
       B    LDP4              Continue with next byte
*
* Routine to read GRAM/GROM
*
PKGRAM CLOG 4,@GKFLAG    Check flag
       BS   PEEKDT       No, CPU peek
       MOVE 1,G@0(@PC),@FAC1 Yes, read GRAM
       B    GC308        Continue
*
* Relocated data for CPU PEEK
*
PEEKDT MOVE 1,@0(@PC),@FAC1        Read byte
       B    GC308              Continue
***********************************************************
*
* Disk catalog routine
*
CATLOG DATA POKER
       STRI 'CAT'             CALL CAT(path)
       DATA GKCAT
*
*
*  X-BASIC DEVICE CATALOGER
*  Accessed with a CALL
*  PAB is installed in crunch buffer area
*
*  D.C. Warren 12/17/85
*  with modifications by Danny Michael, Jan. 86
*
*
GKCAT  CALL GLPARZ            Do we have a '(' ?
GKCATA CALL DSKNAM            Get path
*
* Set up PAB at V>8C0
*  Put disk information on the screen
*
       ALL  >80                 Clear screen
       DST  @FAC6,@VARB         Get name length
       DST  150,@BYTES          Length of CAT PAB use
       XML  GETSTR              Get some string space
       MOVE 150,V@>08C0,V*SREF  Save USER PAB area
       MOVE 9,G@GKPABD,V@>08C0  Install PAB
       ST   @FAC7,V@>08C9
       MOVE @VARB,V*FAC4,V@>08CA
*
* Open Device
*
       CALL GKDSRL            Link to device
*
* Read first record
*
       DST  >020D,V@>08C0     Make PAB a read
GKCAT2 CALL GKDSRL            Link to device
*
       ST   >B9,@AAA1         Y with offset
       CALL GKSCRN            Set up header
       CLR  @VARV             For GKSCRL routine
GKCATL CALL GKTKEY            Check for pause or quit
       BS   GKDONE            Stop!
       CALL GKSCRL            Scroll the screen
       CALL GKDSRL            Read a record
       CALL GKFNAM            Print it on screen
       BS   GKDONE            If finished
       BR   GKCATL            Loop
GKDONE CALL GKCLSF            Close file
       CEQ  COMMAZ,@CHAT      Comma?
       BS   GKCATA            Yes, another drive.
       CEQ  RPARZ,@CHAT       Last char a ) ?
       BR   ERRSYN            No, error
       XML  PGMCHR            Parse past ')'
       CALL CHKEND            SYNTAX error if not end
       BR   ERRSYN               .
       CALL RPL               Return to X-BASIC
*
* File error
*
GKERR  DST  >08C0-4,@PABPTR   Fake a BASIC PAB
       DST  V@>08C0,@VAR5     Save error
       CALL GKCLSF            Close file
       CALL G6D78             Return through ERR
       BYTE 36 *              I/O ERROR XX
*
*
* Subroutines
*
*
* Close file
*
GKCLSF DST  >010D,V@>08C0      A close operation
       CALL GKDSR              Link to device
       MOVE 150,V*SREF,V@>08C0 Restore USER PAB area
       RTN                     Return to caller
*
* DSR LINK with error handling
*
GKDSRL CALL GKDSR
       BS   GKERR             Branch on no-device
       CEQ  >0D,V@>08C1       Check for device errors
       BR   GKERR                .
       RTN                    Return to caller
*
* DSR LINK routine
*
GKDSR  DST  >08C9,@FAC12      Name length pointer
       CALL >10               Call DSR
       BYTE 8 *               DSR call
       RTNC                   Return with COND bit
GKPABD BYTE 0,>D,9,0,0,0,0,0,0
*
* Screen - prints initial screen and disk info
*
GKSCRN FMT
        SCRO >60
        ROW  1
        COL  2
        HTEX 'DIRECTORY='
        ROW 2
        COL 2
        HTEX 'Free=          Used='
        ROW  22
        COL 3
        HTEX 'Filename  Size    Type     P'
        ROW+ 1
        COL 2
        HTEX '---------- ---- ----------- -'
       FEND
       CALL GKDSTR       Get string into FAC
       CZ   @FAC+1       Skip if zero length
       BS   GKCAT3
       FMT
        SCRO >60
        ROW 1
        COL 13
        HSTR 10,@FAC+2
       FEND
GKCAT3 DADD @FAC,@VAR5   Go to next field
       DADD 19,@VAR5     Continue to last field
       DST  73,@VAR9     Set up screen addr
       CALL GKDNUM       Display available space
* Display used space
       DSUB 9,@VAR5      Point to formatted space
       MOVE 8,V*VAR5,@ARG Move it to ARG
       XML  FSUB         Develop used value
       DST  88,@VAR9     Set up screen addr
       CALL GKDNU1       Display used space
       RTN               Return
*
* Test for space and FCTN 4
*
GKTKEY SCAN              Scan the keyboard
       BR   GKTKE1       Continue if no new key
       CEQ  SPACE,@RKEY  SPACE key?
       BR   GKTKE2       NO! Abort.
GKTKE3 SCAN              Scan keyboard
       BR   GKTKE3       Loop until new key press
       CEQ  SPACE,@RKEY  SPACE key?
       BR   GKTKE2       NO! Abort.
GKTKE1 RTN               Return
GKTKE2 CLR  @VAR0        Clear a byte
       CZ   @VAR0        Set COND bit
       RTNC              Return w/COND
*
* Scroll the screen
*
GKSCRL CH   18,@VARV           Check line counter
       BS   GKSCL1             Short scroll
       INC  @VARV              Line count +1
       MOVE >280,V@>80,V@>60   Scroll screen
GKSCL2 ST   SPACE,V@>2E0       Clear last line
       ADD  >60,V@>2E0
       MOVE >1F,V@>2E0,V@>2E1
       RTN                     Return
GKSCL1 MOVE >240,V@>C0,V@>A0
       BR   GKSCL2
*
* Display one file on screen
*
GKFNAM CALL GKDSTR       Get string into FAC
       CZ   @FAC+1       Skip display if zero
       BS   GKCAT5        length
       FMT
        SCRO >60         Put disk name on screen
        ROW   23            .
        COL   02            .
        HSTR 10,@FAC+2      .
       FEND                 .
GKCAT5 DADD @FAC,@VAR5   Go to next field
       DADD 10,@VAR5     Continue another field
       DCZ  V*VAR5       Time to get out if
       BS   GKFNA1        zero file size
       DST  >2EA,@VAR9   Set up screen address
       CALL GKDNUM       Display file length
       DSUB 9,@VAR5      Back a field
       MOVE 8,V*VAR5,@FAC Move it into FAC
       XML  CFI          Convert it to an int.
       CZ   @FAC         Non-negative?
       BS   GKCAT7       YES! File not protected
       ST   185,V@>02FE   Put a 'Y' on screen
       DNEG @FAC         Make number positive
GKCAT7 DEC  @FAC+1       Adjust for CASE
       CASE @FAC+1       Show file type
       BR   GKDF
       BR   GKDV
       BR   GKIF
       BR   GKIV
       BR   GKPR
       BR   GKDIR
GKDF   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Dis/Fix'
       FEND
       BR   GKCAT6
GKDV   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Dis/Var'
       FEND
       BR   GKCAT6
GKIF   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Int/Fix'
       FEND
       BR   GKCAT6
GKIV   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Int/Var'
       FEND
       BR   GKCAT6
GKPR   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Program'
       FEND
       RTN
GKDIR  FMT
       SCRO  >60
       ROW   23
       COL   18
       HTEX  'Directory'
       FEND
       RTN               Return
GKCAT6 DADD 18,@VAR5     Advavce two fields
       DST  >2F6,@VAR9   Set up screen address
       CALL GKDNUM       Display record length
       RTN               Return
GKFNA1 CLR  @VAR0        Clear a byte
       CZ   @VAR0        Set COND bit
       RTNC              Return w/COND
* Display number subroutine
*  ENTER: Floating number in FAC for GKDNU1
*         Screen address in VAR9
*
GKDNUM MOVE 8,V*VAR5,@FAC Move FLP number to FAC
 
GKDNU1 CLR  @FAC+11      Indicate a free format
       XML  CNS          Convert FAC to a string
       DST  7,@VARB      Right justify number
       SUB  @FAC+12,@VARB+1
       DADD @VARB,@VAR9
GKDNU2 ADD  >60,*FAC+11     Add offset to string
       ST   *FAC+11,V*VAR9  Put a char on the screen
       DINC @VAR9           Increment screen addr.
       INC  @FAC+11         Increment FAC addr.
       DEC  @FAC+12         Decrement string length count
       BR   GKDNU2          Loop until done
       RTN                  Return to caller
*
* Prepare a VDP string for FORMAT statement
*  LEAVE: FAC has string length (word)
*         FAC+2 has string
*         VAR5 pointing to next string in record
*
GKDSTR DST  >0900,@VAR5   Get buffer address
       CLR  @FAC          Clear MSB of FAC word
       ST   V*VAR5,@FAC+1 Store disk name length
       DINC @VAR5         Point to string
       ST   >20,@FAC+2    Clear out string space
       MOVE 9,@FAC+2,@FAC+3  .
       MOVE @FAC,V*VAR5,@FAC+2 Move disk name into FAC
       RTN
***********************************************************
       AORG >0B00
***********************************************************
*                BASIC KEYWORD TABLE
*      THE TOKEN IS ITS LEFT BINDING POWER
***********************************************************
KEYTAB DATA CHAR1,CHAR2,CHAR3,CHAR4,CHAR5
       DATA CHAR6,CHAR7,CHAR8,CHAR9,CHARA
CHAR1  TEXT '!'
       BYTE TREMZ             *  !
       TEXT '#'
       BYTE NUMBEZ            *  #
       TEXT '&'
       BYTE CONCZ             *  &
       TEXT '('
       BYTE LPARZ             *  (
       TEXT ')'
       BYTE RPARZ             *  )
       TEXT '*'
       BYTE MULTZ             *  *
       TEXT '+'
       BYTE PLUSZ             *  +
       TEXT ','
       BYTE COMMAZ            *  ,
       TEXT '-'
       BYTE MINUSZ            *  -
       TEXT '/'
       BYTE DIVIZ             *  /
       TEXT ':'
       BYTE COLONZ            *  :
       TEXT ';'
       BYTE SEMICZ            *  ;
       TEXT '<'
       BYTE LESSZ             *  <
       TEXT '='
       BYTE EQUALZ            *  =
       TEXT '>'
       BYTE GREATZ            *  >
       TEXT '^'
       BYTE CIRCUZ            *  ^
       BYTE >FF
CHAR2  TEXT '::'
       BYTE SSEPZ             *  ::
       TEXT 'AT'
       BYTE ATZ               *  AT
       TEXT 'GO'
       BYTE GOZ               *  GO            <<<<< RXB MO
       TEXT 'IF'
       BYTE IFZ               *  IF
       TEXT 'ON'
       BYTE ONZ               *  ON
       TEXT 'OR'
       BYTE ORZ               *  OR
       TEXT 'PI'
       BYTE PIZ               *  PI
       TEXT 'TO'
       BYTE TOZ               *  TO
       BYTE >FF
CHAR3  TEXT 'ABS'
       BYTE ABSZ              *  ABS
       TEXT 'ALL'
       BYTE ALLZ              *  ALL
       TEXT 'AND'
       BYTE ANDZ              *  AND
       TEXT 'ASC'
       BYTE ASCZ              *  ASC
       TEXT 'ATN'
       BYTE ATNZ              *  ATN
       TEXT 'BYE'
       BYTE >03               *  BYE
       TEXT 'CON'
       BYTE >01               *  CONtinue
       TEXT 'COS'
       BYTE COSZ              *  COS
       TEXT 'DEF'
       BYTE DEFZ              *  DEF
* GKXB added token
       TEXT 'DEL'
       BYTE >09               *  DEL
       TEXT 'DIM'
       BYTE DIMZ              *  DIM
       TEXT 'END'
       BYTE ENDZ              *  END
       TEXT 'EOF'
       BYTE EOFZ              *  EOF
       TEXT 'EXP'
       BYTE EXPZZ             *  EXP
       TEXT 'FOR'
       BYTE FORZ              *  FOR
       TEXT 'INT'
       BYTE INTZ              *  INT
       TEXT 'LEN'
       BYTE LENZ              *  LEN
       TEXT 'LET'
       BYTE LETZ              *  LET
       TEXT 'LOG'
       BYTE LOGZ              *  LOG
       TEXT 'MAX'
       BYTE MAXZ              *  MAX
       TEXT 'MIN'
       BYTE MINZ              *  MIN
       TEXT 'NEW'
       BYTE >00               *  NEW
       TEXT 'NOT'
       BYTE NOTZ              *  NOT
       TEXT 'NUM'
       BYTE >04               *  NUMber
       TEXT 'OLD'
       BYTE >05               *  OLD
       TEXT 'POS'
       BYTE POSZ              *  POS
       TEXT 'REC'
       BYTE RECZ              *  REC
       TEXT 'REM'
       BYTE REMZ              *  REMark
       TEXT 'RES'
       BYTE >06               *  RESequence
       TEXT 'RND'
       BYTE RNDZ              *  RND
       TEXT 'RUN'
       BYTE RUNZ              *  RUN
       TEXT 'SGN'
       BYTE SGNZZ             *  SGN
       TEXT 'SIN'
       BYTE SINZ              *  SIN
       TEXT 'SQR'
       BYTE SQRZ              *  SQR
       TEXT 'SUB'
       BYTE SUBZ              *  SUB
       TEXT 'TAB'
       BYTE TABZ              *  TAB
       TEXT 'TAN'
       BYTE TANZ              *  TAN
       TEXT 'VAL'
       BYTE VALZ              *  VAL
       TEXT 'XOR'
       BYTE XORZ              *  XOR
       BYTE >FF
CHAR4  TEXT 'BASE'
       BYTE BASEZ             *  BASE
       TEXT 'BEEP'
       BYTE BEEPZ             *  BEEP
       TEXT 'CALL'
       BYTE CALLZ             *  CALL
       TEXT 'CHR$'
       BYTE CHRZZ             *  CHR$
* GKXB added token
       TEXT 'COPY'
       BYTE >0A               *  COPY
       TEXT 'DATA'
       BYTE DATAZ             *  DATA
       TEXT 'ELSE'
       BYTE ELSEZ             *  ELSE
       TEXT 'GOTO'
       BYTE GOTOZ             *  GOTO
       TEXT 'LIST'
       BYTE >02               *  LIST
* GKXB added token
       TEXT 'MOVE'
       BYTE >0B               *  MOVE
       TEXT 'NEXT'
       BYTE NEXTZ             *  NEXT
       TEXT 'OPEN'
       BYTE OPENZ             *  OPEN
       TEXT 'READ'
       BYTE READZ             *  READ
       TEXT 'RPT$'
       BYTE RPTZZ             *  RPT$
       TEXT 'SAVE'
       BYTE >07               *  SAVE
       TEXT 'SEG$'
       BYTE SEGZZ             *  SEG$
       TEXT 'SIZE'
       BYTE SIZEZ             *  SIZE
       TEXT 'STEP'
       BYTE STEPZ             *  STEP
       TEXT 'STOP'
       BYTE STOPZ             *  STOP          <<<< RXB MOT
       TEXT 'STR$'
       BYTE STRZZ             *  STR$
       TEXT 'THEN'
       BYTE THENZ             *  THEN
       BYTE >FF
CHAR5  TEXT 'BREAK'
       BYTE BREAKZ            *  BREAK
       TEXT 'CLOSE'
       BYTE CLOSEZ            *  CLOSE
       TEXT 'DIGIT'
       BYTE DIGITZ            *  DIGIT
       TEXT 'ERASE'
       BYTE ERASEZ            *  ERASE
       TEXT 'ERROR'
       BYTE ERRORZ            *  ERROR
       TEXT 'FIXED'
       BYTE FIXEDZ            *  FIXED
       TEXT 'GOSUB'
       BYTE GOSUBZ            *  GOSUB
       TEXT 'IMAGE'
       BYTE IMAGEZ            *  IMAGE
       TEXT 'INPUT'
       BYTE INPUTZ            *  INPUT
       TEXT 'MERGE'
       BYTE >08               *  MERGE
       TEXT 'PRINT'
       BYTE PRINTZ            *  PRINT
       TEXT 'TRACE'
       BYTE TRACEZ            *  TRACE
       TEXT 'USING'
       BYTE USINGZ            *  USING
       BYTE >FF
CHAR6  TEXT 'ACCEPT'
       BYTE ACCEPZ            *  ACCEPT
       TEXT 'APPEND'
       BYTE APPENZ            *  APPEND
       TEXT 'DELETE'
       BYTE DELETZ            *  DELETE
       TEXT 'LINPUT'
       BYTE LINPUZ            *  LINPUT
       TEXT 'NUMBER'
       BYTE >04               *  NUMBER
       TEXT 'OPTION'
       BYTE OPTIOZ            *  OPTION
       TEXT 'OUTPUT'
       BYTE OUTPUZ            *  OUTPUT
       TEXT 'RETURN'
       BYTE RETURZ            *  RETURN
       TEXT 'SUBEND'
       BYTE SUBNDZ            *  SUBEND
       TEXT 'UALPHA'
       BYTE UALPHZ            *  UALPHA
       TEXT 'UPDATE'
       BYTE UPDATZ            *  UPDATE
       BYTE >FF
CHAR7  TEXT 'DISPLAY'
       BYTE DISPLZ            *  DISPLAY
       TEXT 'NUMERIC'
       BYTE NUMERZ            *  NUMERIC
       TEXT 'RESTORE'
       BYTE RESTOZ            *  RESTORE
       TEXT 'SUBEXIT'
       BYTE SUBXTZ            *  SUBEXIT
       TEXT 'UNBREAK'
       BYTE UNBREZ            *  UNBREAK
       TEXT 'UNTRACE'
       BYTE UNTRAZ            *  UNTRACE
       TEXT 'WARNING'
       BYTE WARNZ             *  WARNING
       BYTE >FF
CHAR8  TEXT 'CONTINUE'
       BYTE >01               *  CONTINUE
       TEXT 'INTERNAL'
       BYTE INTERZ            *  INTERNAL
       TEXT 'RELATIVE'
       BYTE RELATZ            *  RELATIVE
       TEXT 'VALIDATE'
       BYTE VALIDZ            *  VALIDATE
       TEXT 'VARIABLE'
       BYTE VARIAZ            *  VARIABLE
       BYTE >FF
CHAR9  TEXT 'RANDOMIZE'
       BYTE RANDOZ            *  RANDOMIZE
       BYTE >FF
CHARA  TEXT 'SEQUENTIAL'
       BYTE SEQUEZ            *  SEQUENTIAL
       BYTE >FF
* ?????????????????????????????????????????????????????????
       AORG >0D76
       BYTE >00               * RXB patch to even out addre
***********************************************************
* ERRTAB - Error table containing all of the error messages
*          error numbers and the severity code for each
*          error. The error call number is the data byte
*          that must follow the CALL ERRZZ or CALL WARNZZ.
*          Messages with severity of zero are system
*          messages and not error messages.
*
*  Message, Error #, Severity                     CALL #
***********************************************************
ERRTAB DATA MSGFST            * "READY"
       BYTE 0,0
       DATA MSGBRK            * "BREAKPOINT"
       BYTE 0,0
       DATA MSG10             * "NUMERIC OVERFLOW"
       BYTE 10,1
       DATA MSG14             * "SYNTAX ERROR"
       BYTE 14,9
       DATA MSG16             * "ILLEGAL AFTER SUBPROGRAM"
       BYTE 16,9
       DATA MSG17             * "UNMATCHED QUOTES"
       BYTE 17,9
       DATA MSG19             * "NAME TOO LONG"
       BYTE 19,9
       DATA MSG24             * "STRING-NUMBER MISMATCH"
       BYTE 24,9
       DATA MSG25             * "OPTION BASE ERROR"
       BYTE 25,9
       DATA MSG28             * "IMPROPERLY USED NAME"
       BYTE 28,9
       DATA MSG36             * "IMAGE ERROR"
       BYTE 36,9
       DATA MSG39             * "MEMORY FULL"
       BYTE 39,9
       DATA MSG40             * "STACK OVERFLOW"
       BYTE 40,9
       DATA MSG43             * "NEXT WITHOUT FOR"
       BYTE 43,9
       DATA MSG44             * "FOR-NEXT NESTING"
       BYTE 44,9
       DATA MSG47             * "MUST BE IN SUBPROGRAM"
       BYTE 47,9
       DATA MSG48             * "RECURSIVE SUBPROGRAM CALL"
       BYTE 48,9
       DATA MSG49             * "MISSING SUBEND"
       BYTE 49,9
       DATA MSG51             * "RETURN WITHOUT GOSUB"
       BYTE 51,9
       DATA MSG54             * "STRING TRUNCATED"
       BYTE 54,1
       DATA MSG57             * "BAD SUBSCRIPT"
       BYTE 57,9
       DATA MSG56             * "SPEECH STRING TOO LONG"
       BYTE 56,9
       DATA MSG60             * "LINE NOT FOUND"
       BYTE 60,9
       DATA MSG61             * "BAD LINE NUMBER"
       BYTE 61,9
       DATA MSG62             * "LINE TOO LONG"
       BYTE 62,9
       DATA MSG67             * "CAN'T CONTINUE"
       BYTE 67,9
       DATA MSG69             * "COMMAND ILLEGAL IN PROGRAM
       BYTE 69,9
       DATA MSG70             * "ONLY LEGAL IN A PROGRAM"
       BYTE 70,9
       DATA MSG74             * "BAD ARGUMENT"
       BYTE 74,9
       DATA MSG78             * "NO PROGRAM PRESENT"
       BYTE 78,1
       DATA MSG79             * "BAD VALUE"
       BYTE 79,9
       DATA MSG81             * "INCORRECT ARGUMENT LIST"
       BYTE 81,9
       DATA MSG83             * "INPUT ERROR" (WARNING)
       BYTE 83,1
       DATA MSG84             * "DATA ERROR"
       BYTE 84,9
       DATA MSG109            * "FILE ERROR"
       BYTE 109,9
       DATA MSG130            * "I/O ERROR" (WARNING)
       BYTE 130,1
       DATA MSG130            * "I/O ERROR"
       BYTE 130,9
       DATA MSG135            * "SUBPROGRAM NOT FOUND"
       BYTE 135,9
       DATA MSG60             * "LINE NOT FOUND" (WARNING)
       BYTE 60,1
       DATA MSG97             * "PROTECTION VIOLATION"
       BYTE 97,9
       DATA MSG34             * "UNRECOGNIZED CHARACTER"
       BYTE 20,9
* Following message is added 6/24/81 for the INPUT bug.
       DATA MSG83             * "INPUT ERROR"
       BYTE 83,9
***********************************************************
* TRACBK - Is used to trace back the error levels through
*          nested function references and subprogram calls.
*          It takes care of issuing the trace back info
*          messages in these two cases. It leaves the stack
*          unchanged except in the case of a prescan error
*          occurring in an external subprogram. If any
*          messages are issued, it returns with the staus
*          set, else reset.
***********************************************************
TRACBK DST  @VSPTR,@FAC8      Get a temp stack pointer
GCE22  DCH  @STVSPT,@FAC8     While not end of stack
       BR   GCE48
       CEQ  >68,V@2(@FAC8)    If UDF entry
       BS   TRAC05
       CEQ  >70,V@2(@FAC8)    If temp UDF entry
       BR   GCE3B
       DSUB 8,@VSPTR          Trash it so DELINK won't
       BR   TRAC05             mess up the symbol table
GCE3B  CEQ  >6A,V@2(@FAC8)    If subprogram
       BS   TRAC50
       DSUB 8,@FAC8           Goto next entry on stack
       BR   GCE22
GCE48  RTN                    If no UDF or subprograms acti
* Trace back UDF reference
TRAC05 CLR  @FAC12            To cheat on ERPRNT
       EX   @PRGFLG,@FAC12    Force line # NOT to be printe
       CEQ  1,@FAC13          If warning message
       BR   GCE58
* Place for the message already set in WRNZZ3
       CALL ERPNT5            Don't restore char set
       BR   GCE5B
GCE58  CALL ERPRNT            Print the real error messgae
GCE5B  ST   @FAC12,@PRGFLG    Restore program/imperative fl
       DST  @PGMPTR,@ARG      Get the place of error for FN
       CALL FNDLNE            Find the line that the error
*                              is in
       DST  >A9AE,V@NLNADD+2  Say 'in' xx
       DST  NLNADD+5,@VARW    Start place of line number
       CALL DISO              Put out the line number
       XML  SCROLL
TRAC09 DST  V*FAC8,@ARG       Save PGMPTR from the entry
TRAC10 DSUB 8,@FAC8           Go on to next entry
       DCH  @STVSPT,@FAC8     If not end of stack
       BR   GCEE2
       CEQ  >68,V@2(@FAC8)    If function entry
       BR   GCEC8
       DCEQ @ARG,V*FAC8       If recursive
       BR   GCEB3
       MOVE 15,G@MSGCIS,V@NLNADD+2
       XML  SCROLL            * CALLS ITSELF
TRAC12 DSUB 8,@FAC8           Goto next entry on stack
GCE99  CEQ  >68,V@2(@FAC8)    While functions
       BR   GCEAC
       DCEQ @ARG,V*FAC8
       BR   TRAC09
       DSUB 8,@FAC8           Goto next entry on stack
       BR   GCE99
GCEAC  CGT  >65,V@2(@FAC8)    If string is numeric
       BR   TRAC12
GCEB3  MOVE 11,G@MSGCF,V@NLNADD+2
       CALL FNDLNE            Find the line
       DST  NLNADD+14,@VARW   Place to display it
       CALL DISO              Display the line number
       XML  SCROLL            * CALLED FROM
       BR   TRAC09            Go on
* Jump always
GCEC8  CHE  >66,V@2(@FAC8)    If not permanent
       BR   TRAC10
GCECF  DCH  VRAMVS,@FAC8      While still not at bottom
       BR   GCEE2
       CEQ  >6A,V@2(@FAC8)    If subprogram
       BS   TRAC51
       DSUB 8,@FAC8           Go down an entry
       BR   GCECF
GCEE2  CZ   @PRGFLG           If not imperative
       BS   GCEF6
       MOVE 11,G@MSGCF,V@NLNADD+2
       DST  NLNADD+14,@VARW   Place to display line #
       CALL ASC               Display it
       XML  SCROLL
GCEF6  BR   RTNSET            Return with condition set
* Trace back subprogram calls
TRAC50 CEQ  1,@FAC13          If warning message only
       BR   GCF02
       CALL ERPNT5            Don't restore char set
       BR   GCF05
GCF02  CALL ERPRNT            Print the real message
GCF05  CZ   @PRGFLG
       BS   RTNSET
TRAC51 CZ   @PRGFLG
       BS   RETNOS
       DST  >A9AE,V@NLNADD+2  Display 'IN'
       DST  NLNADD+6,@FAC12   Display location of name
TRAC55 DST  V*FAC8,@FAC16     Get S.T. pointer
       CLR  @FAC10            Need a double length
       ST   V@1(@FAC16),@FAC10+1 Get the name length
       DST  V@4(@FAC16),@FAC16   Get the name pointer
       MOVE @FAC10,V*FAC16,V*FAC12   Display
GCF2C  ADD  OFFSET,V*FAC12
       DINC @FAC12
       DDEC @FAC10
       DCZ  @FAC10
       BR   GCF2C
       XML  SCROLL            Scroll the screen 'CALLED FRO
       MOVE 11,G@MSGCF,V@NLNADD+2
       DST  @FAC8,@FAC10      In case at top level
       DST  V@6(@FAC8),@FAC8  Get LSUBP off stack
       DCZ  @FAC8             If not top level call
       BS   GCF53
       DST  NLNADD+15,@FAC12  Display location of name
       BR   TRAC55
* Now find original number
GCF53  DST  V@-6(@FAC10),@ARG2 Get pointer to line number
       CALL GETLN2            Get the actual line number
       DST  NLNADD+15,@VARW   Place to put line number
       CALL DISO              Display the line number
       XML  SCROLL            Scroll the mess up
* RETURN WITH CONDITION BIT SET
RTNSET CEQ  @>8300,@>8300     SET CONDITION BIT
RETNOS RTNC
GETLN2 DDECT @ARG2
       CALL GRSUB2            Read 2 bytes of data from ERA
       BYTE >5E             * (use GREAD1) or VDP   (>5E=AR
       DST  @EEE1,@ARG2       Put the result into @ARG2
       RTN
* Given a specific PGMPTR (in ARG) find the line number of
* the line it points into and put the actual line number
* in ARG2
FNDLNE DST  @STLN,@ARG4       Get pointer into # buffer
       DINCT @ARG4            Point at the line pointer
       DST  @ARG4,@ARG2       Get line pointer
       DCLR @ARG6             Start with a zero value
GCF7D  DCHE @ENLN,@ARG4       While in line buffer
       BS   GCF9C
       CALL GRSUB2            Get the line # from ERAM/VDP
       BYTE >60             * @ARG4: Source address on ERAM
       DCGT @ARG,@EEE1
       BS   GCF96
       DCH  @ARG6,@EEE1       If closer
       BR   GCF96
       DST  @ARG4,@ARG2       Make it the one
       DST  @EEE1,@ARG6
GCF96  DADD 4,@ARG4           Goto next line in buffer
       BR   GCF7D
GCF9C  CALL GETLN2            Get the line number
       AND  >7F,@ARG2         Reset the breakpoint if any
       RTN
***********************************************************
       AORG >1000
***********************************************************
* EDIT routine - display requested line and edit any change
*                in the program segment.
*
* FAC contains the line number just read in
EDTZZ0 DCEQ @ENLN,@STLN       If no program
       BR   GD008
       B    ILLST
GD008  XML  SPEED
       BYTE SEETWO          * Try to find the line (# in FA
       BR   EDTZ08            * LINE NOT FOUND
EDTZ00 ST   29,@CCPPTR        Force new record on first lin
* The entry in the line number table is in EXTRAM
       ST   OFFSET,@DSRFLG    Set screen output mode
       ST   28,@RECLEN        Select standard record length
       DCLR @PABPTR           I/O to the screen
       CZ   @RAMTOP           If ERAM
       BS   GD020
       CALL GRMLST            Prepare to list from ERAM
GD020  CALL LLIST             List the line
* VARW contains the position of the first character followi
*      the line number.
       CH   @RECLEN,@CCPPTR   Exactly at end of line
       BR   GD032
       XML  SCROLL            Scroll up one line
       DSUB 32,@VARW          And correct both VARW
       DSUB 28,@CCPADR          and CCPADR
GD032  DST  @VARW,@ARG2       Set cursor at start position
       AND  >E0,@ARG3         Back to beginning of line
       DADD 157,@ARG2         Compute theoretically highest
       DST  @CCPADR,@VARA     Use current high position
*                              as high
       DCHE @VARA,@ARG2       If > 4 then lines-correct
       BS   GD048
       DST  >031D,@ARG2       Allow for one more line
*----------------------------------------------------------
* Fix "You cannot add characters to a line whose number is
*      multiple of 256, if that line was reached ty typing
*      either an up arrow or a down arrow from a previous
*      line" bug, the following line is changed
*      CALL READL1            Allow user to make change
GD048  CALL READL3            Allow user to make change
*----------------------------------------------------------
       CALL SAVLIN            Save the line for recall
       CZ   @RAMTOP           If ERAM exists
       BS   GD056
       DST  @FAC14,@EXTRAM     saves EXTRAM in FAC
GD056  CLOG 1,@FLAG           Autonumber
       BR   EDTZ01
       CEQ  UPARR,@RKEY       Ended in UP arrow
       BR   GD06B
       DADD 4,@EXTRAM         Point at next line to list
       DCH  @ENLN,@EXTRAM     Doesn't exist
       BS   EDTZ01
       BR   EDTZ02
GD06B  CEQ  DWNARR,@RKEY      Want next program line
       BR   GD085
       DSUB 4,@EXTRAM         Point at next line to list
       DCHE @STLN,@EXTRAM     Passed high program
       BS   EDTZ02
EDTZ01 ST   CHRTN,@RKEY       Set no more editing
       BR   GD085
EDTZ02 CALL GRSUB3            Read from  ERAM, use GREAD
*                              or VDP, Reset possible
*                              breakpoint too
       BYTE >2E             * @EXTRAM: Source address on ER
       DST  @EEE1,@ARG6       Save for general use
GD085  CZ   @ARG4             If current, the line was chan
       BR   GD0A1
       DST  CRNBUF,@RAMPTR    Initialize crunch pointer
       XML  CRUNCH            Crunch the input line
       BYTE 0               * Normal crunch mode
       DCZ  @ERRCOD           If error
       BS   GD097
       B    TOPL42
*----------------------------------------------------------
* Fix "Illegal line number 0 can be created by editting a
*      line" bug, 5/23/81
*  Add the following line, and the label TOPL55 at line
*   (TOPL45+9)
GD097  DCZ  @FAC              If line number has
       BR   GD09E              been deleted - treated as
       B    TOPL55              imperative state
*----------------------------------------------------------
GD09E  CALL EDITLN            And edit into program buffer
GD0A1  DST  @ARG6,@FAC        Line number for next line
       CEQ  CHRTN,@RKEY       Stop on carriage return
       BR   GD008
       B    TOPL15            Don't kill the symbol table
* JUMP ALWAYS
G698C  EQU  >698C
EDTZ08 B    G698C             LINE NOT FOUND
* Save input line for edit recall
SAVLIN AND  >E0,@VARW+1       Correct in case autonumber
       INCT @VARW+1           Skip edge characters
       DST  @VARA,@FAC        Get pointer to end of line
       DSUB @VARW,@FAC        Compute length of line
       BS   SAVLN5            If zero, length line
       DCH  160,@FAC          If line longer then buffer
       BR   GD0C6
       DST  160,@FAC          Default to max buffer size
* RXB PATCH CODE FOR USER ****
* GD0C6  MOVE @FAC,V*VARW,V@RECBUF  Save line
GD0C6  MOVE @FAC,V*VARW,V*VARW
SAVLN5 DST  @VARW,V@BUFSRT    Save pointer to line start
       DST  @VARA,V@BUFEND    Save pointer to line end
GD0D4  DCHE >0262,V@BUFSRT    If try more than 160
       BS   GD0E7
*----------------------------------------------------------
* Fix bug "Delete characters while in REDO mode, next REDO
*          still may show those deleted characters, 5/26/81
*   Replace following line
*      DST  >02FE,V@BUFEND    Update pointer to line end
       DADD 32,V@BUFEND       Shift the whole buffer 32
*                              down at a time
*----------------------------------------------------------
       DADD 32,V@BUFSRT       Update pointer for 160 chars
       BR   GD0D4
*----------------------------------------------------------
* Also add following 3 lines for the bug above
GD0E7  DCH  >02FE,V@BUFEND    Update pointer to line end
       BR   GD0F3
       DST  >02FE,V@BUFEND
*----------------------------------------------------------
GD0F3  RTN
***********************************************************
* RXB
*******************************************************
* AMS BRANCH TABLE FOR AMS ROUTINES  *    FIXED       *
       BR   AMSMAP                   *     AT         *
       BR   AMSPAS                   *    >D0F4       *
       BR   AMSOFF                   *  PERMANENTLY   *
       BR   AMSON                    *   ADD TO THE   *
       BR   SISRON                   *    TABLE IF    *
       BR   SISROF                   *    NEEDED.     *
*******************************************************
GLPARZ CEQ  LPARZ,@CHAT
       BR   ERRSYN
       RTN
STRFCH XML  PGMCHR
       XML  PARSE
       BYTE >B6
       RTN
STRGET CALL STRFCH
       CEQ  >65,@FAC2
       BR   ERRSNM      * STRING NUM MISMATCH
       RTN
NUMFCH CALL STRFCH
       CEQ  >65,@FAC2
       BS   ERRSNM      * STRING NUM MISMATCH
       RTN
CFIFCH XML  CFI
       CEQ  >03,@FAC+10
       BS   ERRBV       * NUMERIC OVERFLOW
       RTN
GETNUM CALL SUBLP3
       CEQ  >B3,@CHAT
       BR   ERRSYN
       RTN
NGOOD  XML  PGMCHR
       CEQ  >80,@CHAT
       BS   ERRSYN         * ?
       CALL SNDER
       CEQ  >65,@FAC2
       BR   ERRBA          * BAD ARGUMENT
       DST  >001C,@FAC
       DST  @SREF,@FAC4
       DST  @BYTES,@FAC6
       BR   SNDASS
SNDER  XML  SYM
       XML  SMB
       XML  VPUSH
       RTN
CIFSND XML  CIF
SNDASS XML  ASSGNV
       RTN
SUBLP3 CALL NUMFCH
       CALL CFIFCH
       RTN
DSKSUB TEXT 'DSK#.'
DEVNAM XML  PGMCHR            Advance program pointer
       XML  PARSE             Parse to ')'
       BYTE RPARZ
       CEQ  >65,@FAC2         Do we have a string?
       BS   DEV1              YES, normal execution
       XML  CFI               Convert FAC to integer
       CEQ  >03,@FAC10        OK?
       BS   ERRBV             No.
       CHE  30,@FAC1          ASCII?
       BS   DEVASC            Yes.
       CHE  10,@FAC1          Higher then 9?
       BS   ERRBV             No, error
       ADD  48,@FAC1          Make it ASCII.
DEVASC ST   @FAC1,@TEMP1      Save the number
DEV0   DST  5,@BYTES          Set up for a string
       XML  GETSTR            Get string space
       MOVE 5,G@DSKSUB,V*SREF Save the string
       ST   @TEMP1,V@3(@SREF) Store the number
       DST  @BYTES,@FAC6      Copy string length.
       DST  @SREF,@FAC4       Copy string address.
DEV1   DCZ  @FAC6             Is it a null string?
       BS   ERRBA             YES! Bad Argument
       ST   V*FAC4,@TEMP1
       CEQ  1,@FAC7
       BS   DEV0
       RTN
***********************************************************
POKER  DATA BEEP
       STRI 'POKER'           CALL POKER(vdpr#,value)
       DATA $+2
       CALL GLPARZ
POKAGN CALL GETNUM
       DCHE 8,@FAC
       BS   ERRBV
       ST   @FAC1,@VAR0
       CALL SUBLP3
       CASE @VAR0
       BR   PREG0
       BR   PREG1
       BR   PREG2
       BR   PREG3
       BR   PREG4
       BR   PREG5
       BR   PREG6
       MOVE 1,@FAC1,#7
       BR   POKEND
PREG6  MOVE 1,@FAC1,#6
       BR   POKEND
PREG5  MOVE 1,@FAC1,#5
       BR   POKEND
PREG4  MOVE 1,@FAC1,#4
       BR   POKEND
PREG3  MOVE 1,@FAC1,#3
       BR   POKEND
PREG2  MOVE 1,@FAC1,#2
       BR   POKEND
PREG1  MOVE 1,@FAC1,#1
       BR   POKEND
PREG0  MOVE 1,@FAC1,#0
POKEND CEQ  COMMAZ,@CHAT
       BS   POKAGN
       BR   PEEK5
******************************
BEEP   DATA HONK
       STRI 'BEEP'            CALL BEEP
       DATA $+2
       CALL ACCTON
       BR   LDRET2
HONK   DATA DIRECT
       STRI 'HONK'            CALL HONK
       DATA $+2
       CALL BADTON
       BR   LDRET2
******************************
DIRECT DATA AMAP
       STRI 'DIR'             CALL DIR(pathname)
       DATA GKCAT
******************************
AMAP   DATA APASS
       STRI 'AMSMAP'          CALL AMSMAP
       DATA $+2
       CALL AMSMAP
       BR   LDRET2
AMSMAP CALL AMSSUB
       DST  >1D01,@STORE
       XML  >F0
       RTN
APASS  DATA ARWOFF
       STRI 'AMSPASS'         CALL AMSPASS
       DATA $+2
       CALL AMSPAS
       BR   LDRET2
AMSPAS CALL AMSSUB
       DST  >1E01,@STORE
       XML  >F0
       RTN
ARWOFF DATA ARWON
       STRI 'AMSOFF'          CALL AMSOFF
       DATA $+2
       CALL AMSOFF
       BR   LDRET2
AMSOFF CALL AMSSUB
       DST  >1E00,@STORE
       XML  >F0
       RTN
ARWON  DATA ISRON
       STRI 'AMSON'           CALL AMSON
       DATA $+2
       CALL AMSON
       BR   LDRET2
AMSON  CALL AMSSUB
       DST  >1D00,@STORE
       XML  >F0
       RTN
AMSSUB MOVE 24,G@AMSCRU,@>8300
       RTN
******************************************************
* CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE AMSCPU *
***********************************************************
*                 *        AORG >8300
AMSCRU DATA >8302 * CPUPGM DATA >8302      * First address.
       DATA >0420 *        BLWP @AMSCPU    * Switch contex
       DATA >830C *
       DATA >04E0 *        CLR  @>837C     * Clear for GPL
       DATA >837C *
       DATA >045B *        RT              * Return to GPL.
******************************************************
*                 * AMS CPU SUBPROGRAM
       DATA >834A * AMSCPU DATA >834A
       DATA >8310 *        DATA AMSCRU
       DATA >020C * AMSCRU LI   R12,>1E00
       DATA >1E00 *
       DATA >1D00 *        SBO  0
       DATA >0380 *        RTWP
***********************************************************
*                 *        END
******************************************************
ISRON  DATA ISROFF
       STRI 'ISRON'           CALL ISRON(variable)
       DATA $+2
       CALL GLPARZ
       CALL SUBLP3
       DCZ  @FAC
       BS   ERRBV
       CALL SISRON
       BR   PEEK5
SISRON MOVE 14,G@GISRON,@>8300
       XML  >F0
       RTN
******************************************************
* CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK ON  *
******************************************************
*                  *        AORG >8300
GISRON DATA >8302  *        DATA >8302
       DATA >C820  *        MOV  @>834A,@>83C4
       DATA >834A  *
       DATA >83C4  *
       DATA >04E0  * EXIT   CLR  @>837C
       DATA >837C  *
       DATA >045B  *        RT
*                  *        END
******************************************************
ISROFF DATA ABANK
       STRI 'ISROFF'          CALL ISROFF(variable)
       DATA $+2
       CALL GLPARZ
       CALL SISROF
       XML  PGMCHR
       DST  @FAC,@VAR0
       CALL SNDER
       CALL CLRFAC
       DST  @VAR0,@FAC
       CALL CIFSND
       BR   PEEK5
SISROF DST  @>8318,@FAC4
       MOVE 26,G@GISROF,@>8300
       XML  >F0
       DST  @FAC4,@>8318
       RTN
******************************************************
* CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK OFF *
******************************************************
*                          AORG >8300
GISROF DATA >8302 *        DATA >8302
       DATA >C820 * ISROFF MOV  @>83C4,@>83C4
       DATA >83C4 *
       DATA >83C4 *
       DATA >1305 *        JEQ  NHOOK
       DATA >C820 *        MOV  @>83C4,@>834A
       DATA >83C4 *
       DATA >834A *
       DATA >04E0 * NHOOK  CLR  @>83C4
       DATA >83C4 *
       DATA >04E0 *        CLR  @>837C
       DATA >837C *
       DATA >045B *        RT
*                 *        END
******************************************************
ABANK  DATA AINIT
       STRI 'AMSBANK'         CALL AMSBANK(bank-number)
       DATA $+2
       CALL GLPARZ            * ( ?
       CALL GETNUM            * Get low page.
       DCHE 240,@FAC          * Too high?
       BS   ERRBV             * ERROR BAD VALUE.
       ADD  16,@FAC1          * Add 16 to it.
       XML  VPUSH             * Save low page.
       CALL SUBLP3            * Get high page.
       DCHE 240,@FAC          * Too high?
       BS   ERRBV             * ERROR BAD VALUE.
       ADD  16,@FAC1          * Add 16 to it.
       ST   @FAC1,@ARG1       * Save high page.
       CALL AMSMAP            * AMSMAP
       CALL AMSON             * AMSON
       XML  VPOP              * Fetch low page.
       ST   @FAC1,@ARG        * Save low page.
       ST   @>4004,@FAC       * Save old page.
       ST   @>4006,@FAC1      * Save old page 2.
       ST   @ARG,@>4004       * Load new low page.
       DST  @>2000,@FAC6      * Save new low first bytes.
       ST   @ARG,@>4006       * Duplicate new low page.
       DST  >5555,@>2000      * Write test bytes.
       DCEQ >5555,@>3000      * Did it write?
       BR   AMSERR            * No, ERROR.
       DST  @FAC6,@>2000      * Restore new low bytes.
       ST   @ARG1,@>4004      * Load new high page.
       DST  @>2000,@FAC6      * Save new high first bytes.
       ST   @ARG1,@>4006      * Duplicate new high page.
       DST  >9999,@>2000      * Write test bytes.
       DCEQ >9999,@>3000      * Did it write?
       BR   AMSERR            * No, ERROR.
       DST  @FAC6,@>2000      * Restore new high bytes.
       ST   @ARG,@>4004       * Load new low page.
       ST   @ARG1,@>4006      * Load new high page.
       CALL AMSOFF            * AMSOFF
       BR   PEEK5
*******************************
AMSERR ST   @FAC,@>4004       * Restore old page.
       ST   @FAC1,@>4006      * Restore old page 2.
       CALL AMSOFF            * AMSOFF
       XML  SCROLL
       FMT
       SCRO >60
       ROW  23
       COL  2
       HTEX '* WARNING AMS BANK ERROR *'
       FEND
       BR   ERRBV
*******************************
AINIT  DATA CHRALL
       STRI 'AMSINIT'         CALL AMSINIT
       DATA $+2
       CALL AMSON
       DST  >5FFE,@FAC
       ST   >0F,@FAC2
AINITL MOVE 1,@FAC2,@0(@FAC)
       DDECT @FAC
       DEC  @FAC2
       BR   AINITL
       CALL AMSOFF
       CALL AMSMAP
       BR   LDRET2
*******************************
CHRALL DATA USER
       STRI 'CHARSETALL'      CALL CHARSETALL
       DATA $+2
       ST   95,@FAC2           All 95 charaters
       CALL CHRTBL             Load RXB character set
       ST   >10,V@>080F        Set 1st set to Black on Tran
       MOVE 16,V@>080F,V@>0810 Ripple the rest
       BR   LDRET2             Return to XB
*******************************
UPAB   BYTE 0,>14,>09,>00,80,0,0,0,0,0
USER   DATA BASIC
       STRI 'USER'            CALL USER(path-string)
       DATA $+2
       CALL GLPARZ
       CALL STRGET
       ST   >20,V@>08C0
       MOVE 80,V@>08C0,V@>08C1
       MOVE 10,G@UPAB,V@>08C0
       ST   @FAC7,V@>08C9
       MOVE @FAC6,V*FAC4,V@>08CA
       BR   PEEK5
**************************
BASIC  DATA BSAVE
       STRI 'BASIC'           CALL BASIC
       DATA $+2
       CALL CLSALL
GBASIC EQU  >216F
       B    GBASIC
**************************
BSAVE  DATA BLOAD
       STRI 'BSAVE'           CALL BSAVE(pathstring)
       DATA $+2
       CALL MYSAL             * Get pathname
       ST   >06,V@>1000       * LOAD opcode
       MOVE 8192,@>2000,V@>1020
       CALL MYDOIT            * DSRLNK opcode
       BR   PEEK5             * Done
BLOAD  DATA RENAME
       STRI 'BLOAD'           CALL BLOAD(pathstring)
       DATA $+2
       CALL MYSAL             * Get pathname
       ST   >05,V@>1000       * LOAD opcode
       CALL MYDOIT            * DSRLNK opcode
       MOVE 8192,V@>1020,@>2000
       BR   PEEK5             * Done
MYDOIT DST  >1009,@FAC12      * Get buffer address in VDP
       CALL LINK              * DSRLNK
       BYTE >08
       BS   ERRFE             * File Error
       CLOG >E0,V@>1001       * Set error bits
       BR   ERRFE
       RTN
MYSAL  XML  COMPCT            * GARBAGE COLLECTION
       DST  @STREND,@ARG2     * String end
       DSUB @VSPTR,@ARG2      * Value Stack PoinTeR
       DSUB 63,@ARG2          * Size of Value Stack
       DCHE >2021,@ARG2       * Size of buffer
       BR   ERRSO             * Error Stack Overflow
       CALL GLPARZ            * (
       CALL STRGET            * Pathstring
       CLR  V@>1000           * 0 BYTE
       MOVE >2020,V@>1000,V@>1001 * Ripple
       DST  >1020,V@>1002     * Buffer address
       DST  >2000,V@>1006     * Number of bytes
       ST   @FAC7,V@>1009     * Length byte
       MOVE @FAC6,V*FAC4,V@>100A * Pathstring
       RTN
*******************************
DSKDSR FETCH @FAC16           * Get Length of name
       FETCH @FAC17           * Get Subroutine #
       DST   @FAC16,V@>03C0   * Load into PAB
       DST   >03C0,@FAC12     * PAB address in VDP
       CALL  LINK             * DSRLNK
       BYTE  >0A              * Subroutine
       BS    ERRFE            * File Error
       SRL   5,@FAC6          *
       CZ    @FAC6            *
       BR    ERRFE            * File Error
       RTN                    *
*******************************
DSKNAM CALL DEVNAM            * DSK# or SCS# or WDS#
       MOVE 5,V*FAC4,@ARG     * Get device name
       ST   @ARG3,@DEVNUM     * Save device number characte
       DCEQ 'DS',@ARG
       BR   DSKNA2
       CEQ  'K',@ARG2
       BR   ERRBA             * Error Bad Argument
       CLR  @DFLAG            * Set DSK flag
       BR   DSKNA4
DSKNA2 DCEQ 'SC',@ARG
       BS   DSKNA3
       DCEQ 'WD',@ARG
       BR   ERRBA             * Error Bad Argument
DSKNA3 CEQ  'S',@ARG2
       BR   ERRBA             * Error Bad Argument
       ST   >FF,@DFLAG        * Set SCS or WDS flag
       DST  @FAC4,@VAR5       * Get string address
       DDEC @VAR5             * Point to PATH string length
DSKNA4 SUB  48,@DEVNUM        * DSK# or SCS# or WDS# -1
       RTN
*******************************
GETFN  CALL STRGET            * Get string
       CH   10,@FAC7          * Length > 10?
       BS   ERRNTL            * Error Name Too Long
       DCZ  @FAC6             * Length = 0?
       BS   ERRBA             * Error Bad Argument
       ST   >20,V@>03C0       * Clear PATH buffer
       MOVE 31,V@>03C0,V@>03C1
       MOVE @FAC6,V*FAC4,V@>03C2 * File name
       RTN
*******************************
PATH   ST   @DEVNUM,@FAC2     * Device #
       DST  @VAR5,@FAC4       * Pathname address lenght/st[
       DST  >0127,V@>03C0     * Opcode of PATHNAME subrouti
       CALL RWDSR             * Read/Write DSR LINK
       RTN
*******************************
RENAME DATA PROT
       STRI 'RENAME'          CALL RENAME(pathname,oldname,
       DATA $+2
       CALL GLPARZ            * (
RENAGN CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BS   RENNP             * Yes
       CALL PATH              * Set PATH
RENNP  CALL GETFN             * Old name
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL STRGET            * New name
       CH   10,@FAC7          * Length > 10?
       BS   ERRNTL            * Error Name Too Long
       MOVE @FAC6,V*FAC4,V@>03D0
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03D0,@FAC4       * New name
       DST  >03C2,@FAC6       * Old name
       CZ   @DFLAG            * DSK?
       BS   RENDSK            * Yes
       CALL DSKDSR            * DSKLNK
       DATA >0123             * Opcode RENAME HARD
       B    RENEND
RENDSK CALL DSKDSR            * DSKLNK
       DATA >0113             * Opcode RENAME DISK
RENEND CEQ  COMMAZ,@CHAT      * ,
       BS   RENAGN            * Redo again
       BR   PEEK5
*******************************
PROT   DATA SCSI
       STRI 'PROTECT'         CALL PROTECT(pathname,filenam
       DATA $+2
       CALL GLPARZ            * (
PROAGN CALL DSKNAM            * Get pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BS   PRONP             * Yes
       CALL PATH              * Set PATH
PRONP  CALL GETFN             * Get filename
       CALL SUBLP3            * Option number
       CLR  @FAC3             * UNPROTECT
       DCZ  @FAC              * Unprotect?
       BS   UNPRO
       ST   >FF,@FAC3         * PROTECT
UNPRO  ST   @DEVNUM,@FAC2     * DSK#
       DST  >03C2,@FAC4       * Filename
       CZ   @DFLAG            * DSK?
       BS   PRODSK            * Yes
       CALL DSKDSR            * DSRLNK
       DATA >0122             * Opcode PROTECT HARD
       B    PROEND
PRODSK CALL DSKDSR            * DSRLNK
       DATA >0112             * Opcode PROTECT DISK
PROEND CEQ  COMMAZ,@CHAT      * ,
       BS   PROAGN            * Redo again
       BR   PEEK5
*******************************
SCSI   DATA MKDIR
       STRI 'SCSI'            CALL SCSI(pathname,string-var
       DATA $+2
       CALL GLPARZ            * (
SCSAGN CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  44,@BYTES         * Length of buffer
       XML  GETSTR            * Get string space
       ST   @DEVNUM,@FAC2     * SCS#
       DST  @SREF,@FAC4       * String address
       CALL DSKDSR            * DSRLNK
       DATA >011C             * Opcode EXAMINE SCSI
       CALL NGOOD             * Assign string to variable
       CEQ  COMMAZ,@CHAT      * ,
       BS   SCSAGN            * Redo again
       BR   PEEK5
*******************************
MKDIR  DATA RMDIR
       STRI 'MKDIR'           CALL MKDIR(pathname,directory
       DATA $+2
       DST  255,@BYTES        * For sector 0 access
       XML  GETSTR            * Get string space
       DST  @SREF,@VAR0       * Buffer address
       DDEC @VAR0             * Make it 256 byte buffer
       CALL GLPARZ            * (
MKDIR2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BR   MKDIR3            * No, Hard
       CH   5,@FAC7           * Length > 5?
       BS   ERRNTL            * Error Name Too Long
       CALL GETFN             * Filename
       ST   >FF,@FAC3         * Set to READ SECTOR
       BR   VOL1ST
VOL2ND CLR  @FAC3             * Set to WRITE SECTOR
VOL1ST DCLR @FAC              * Returned SECTOR
       ST   @DEVNUM,@FAC2     * DSK#
       DST  @VAR0,@FAC4       * Buffer Address
       DCLR @FAC6             * Sector number 0 DSK
       CALL DSKDSR            * DSRLNK
       DATA >0110             * Opcode SECTOR DISK
       MOVE 10,V@>03C2,V*VAR0 * Copy VOLUME name over old n
       CZ   @FAC3             * First pass?
       BR   VOL2ND            * No, again
       B    MKDIR4
MKDIR3 CALL PATH              * Set PATH
       CALL GETFN             * Directory name
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >0128             * Opcode MAKE DIRECTORY HARD
MKDIR4 CEQ  COMMAZ,@CHAT      * ,
       BS   MKDIR2            * Redo again
       BR   PEEK5
*******************************
RMDIR  DATA CUTDIR
       STRI 'RMDIR'           CALL RMDIR(pathname,directory
       DATA $+2
       CALL GLPARZ            * (
RMDIR2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL PATH              * Set PATH
       CALL GETFN             * Directory name
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >0129             * Opcode REMOVE DIRECTORY HAR
       CEQ  COMMAZ,@CHAT      * ,
       BS   RMDIR2            * Redo again
       BR   PEEK5
*******************************
CUTDIR DATA FCOPY
       STRI 'CUTDIR'          CALL CUTDIR(pathname,director
       DATA $+2
       CALL GLPARZ            * (
CUTDI2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL GETFN             * Set PATH
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >012A             * Opcode CUT DIRECTORY HARD
       CEQ  COMMAZ,@CHAT      * ,
       BS   CUTDI2            * Redo again
       BR   PEEK5
*******************************
FCOPY  DATA SECTOR
       STRI 'FCOPY'           CALL FCOPY(pathname,filename,
       DATA $+2
       XML  COMPCT            * GARBAGE COLLECT
       DST  @STREND,@ARG2     * String end
       DSUB @VSPTR,@ARG2      * Value Stack PoinTeR address
       DSUB 63,@ARG2          * Value stack size
       DCHE >1001,@ARG2       * Buffer size
       BR   ERRSO             * Error Stack Overflow
       CALL GLPARZ            * (
FCOPY1 CLR  @VAR0             * Clear Additional info Buffe
       MOVE 12,@VAR0,@VARV    * Ripple
       CALL DSKNAM            * 1st pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  @DFLAG,V@BUFSRT   * FLAG/DSK#
       DST  @VAR5,@STRPTR     * 1st pathname
       CALL GETFN             * 1st filename
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL DSKNAM            * 2nd pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  @DFLAG,V@BUFEND   * FLAG/DSK#
       DST  @VAR5,@CURLIN     * 2nd pathname
       CALL STRGET            * 2nd filename
       CH   10,@FAC7          * Length > 10 ?
       BS   ERRNTL            * Error Name Too Long
       CZ   @FAC7             * Length = 0?
       BS   ERRBA             * Error Bad Argument
       MOVE @FAC6,V*FAC4,V@>03D0 * 2nd filename into buffer
       CLR  @FAC3             * ADDitional INFO ACCESS CODE
       CALL FREAD             * READ FILE HEADER
       DST  @MNUM,@SREF       * Save number of Sectors of F
       CLR  @FAC3             * ADDITIONAL INFO ACCESS CODE
       CALL FWRTE             * WRITE FILE HEADER
       DST  @SREF,@ARG        * Get Total number of Sectors
       DCLR @FAC              * Clear PASS counter
FCOPY2 DCHE 4,@ARG            * ARG>=4 Sectors?
       BS   FCOPY3            * Yes
       INC  @FAC              * PASS+1
       ST   @ARG1,@FAC1       * Save number of sectors left
       B    FCOPY4            * Done
FCOPY3 DSUB 3,@ARG            * Sectors-3
       INC  @FAC              * PASS+1
       B    FCOPY2            * Loop
FCOPY4 DST  @FAC,@SREF        * PASS/Number of sectors left
       DCLR @CURINC           * Sector Pointer
FCOPY5 CEQ  1,@SREF           * Last PASS?
       BR   FCOPY6            * No
       ST   @SREF+1,@FAC3     * Number of sectors Left to r
       B    FCOPY7            * Continue
FCOPY6 ST   3,@FAC3           * 3 Sectors to read
FCOPY7 DST  @CURINC,V@>03BA   * Save SECTOR NUMBER TO USE
       DST  @CURINC,@MNUM     * SECTOR NUMBER TO USE
       CALL FREAD             * READ FILE SECTOR
       CEQ  1,@SREF           * Last PASS?
       BR   FCOPY8            * No
       ST   @SREF+1,@FAC3     * Number of sectors left to w
       B    FCOPY9            * Continue
FCOPY8 ST   3,@FAC3           * 3 Sectors to write
FCOPY9 DST  V@>03BA,@CURINC   * Get sectors to write
       DST  @CURINC,@MNUM     * SECTOR NUMBER TO USE
       CALL FWRTE             * WRITE FILE SECTOR
       DADD 3,@CURINC         * SECTOR+3
       DEC  @SREF             * PASS-1
       BR   FCOPY5            * 0=END
       CEQ  COMMAZ,@CHAT      * ,
       BS   FCOPY1            * Redo again
       BR   PEEK5
*******************************
FREAD  DST  V@BUFSRT,@DFLAG   * 1st FLAG/DSR#
       CZ   @DFLAG            * DSK?
       BS   FREAD1            * Yes
       DST  @STRPTR,@VAR5     * 1st path
       CALL PATH              * Set PATH
FREAD1 DST  >1000,@VAR0       * Buffer address in Add info
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03C2,@FAC4       * 1st filename
       CLR  @FAC6             * Pointer to Additional info
       CZ   @DFLAG            * DSK?
       BS   FREAD2            * Yes
       DST  >0124,V@>03C0     * Opcode INPUT HARD
       B    FREAD3
FREAD2 DST  >0114,V@>03C0     * Opcode INPUT DISK
FREAD3 CALL RWDSR             * DSRLNK
       RTN
*******************************
FWRTE  DST  V@BUFEND,@DFLAG   * 2nd FLAG/DSK#
       CZ   @DFLAG            * DSK?
       BS   FWRTE1            * Yes
       DST  @CURLIN,@VAR5     * 2nd PATH
       CALL PATH              * Set PATH
FWRTE1 DST  >1000,@VAR0       * Buffer Address in Add info
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03D0,@FAC4       * 2nd Filename
       CLR  @FAC6             * Pointer to Add info block
       CZ   @DFLAG            * DSK#
       BS   FWRTE2            * Yes
       DST  >0125,V@>03C0     * Opcode OUTPUT HARD
       B    FWRTE3
FWRTE2 DST  >0115,V@>03C0     * Opcode OUTPUT DISK
FWRTE3 CALL RWDSR             * DSKLNK
       RTN
*******************************
RWDSR  DST >03C0,@FAC12       * Buffer address
       CALL LINK              * DSRLNK
       BYTE >0A               * Subroutine
       CZ   @FAC6             * ERRORS?
       BR   ERRFE             * Yes, File Error
       RTN
*******************************
SECTOR DATA >0000
       STRI 'SECTOR'          CALL SECTOR(pathname,RWflag,#
       DATA $+2
       XML  COMPCT
       DST  @STREND,@ARG2
       DSUB @VSPTR,@ARG2
       DSUB 63,@ARG2
       DCHE 260,@ARG2
       BR   ERRSO
       CALL GLPARZ            * (
SECTOS CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL GETNUM            * R/W Flag
       CLR  @VAR0             * WRITE Flag
       DCZ  @FAC              * 0000?
       BS   SECTO1
       INC  @VAR0             * READ Flag
SECTO1 CALL GETNUM            * #SECTORS
       DCZ  @FAC              * 0000?
       BS   ERRBV
       DCHE 33,@FAC           * Only 32 sectors allowed.
       BS   ERRBV
       ST   @FAC1,@VARV       * Save # SECTORS
       CALL STRGET            * SECTOR $
       DCZ  @FAC6             * 0 string length?
       BS   ERRBV
       CZ   @DFLAG            * DSK?
       BR   SECTO2            * No.
       DCHE 5,@FAC6           * String to long?
       BS   ERRBV
SECTO2 DCHE 9,@FAC6           * String to long HARD?
       BS   ERRBV
       DST  @FAC6,@BYTES      * Save string length value.
       DADD @FAC6,@FAC4       * Point past end of string.
       DDEC @FAC4             * Offset to end of string.
       CLR  @FAC6             * Sector # buffer.
       MOVE 4,@FAC6,@FAC7     * Clear buffer.
       DST  >03C3,@ARG        * # number pointer
       CLR  V@>03C0
       MOVE 4,V@>03C0,V@>03C1
SECTO3 CLR  @FAC
SECTO4 ST   V*FAC4,@FAC       * Get character.
       CHE  71,@FAC           * G or higher?
       BS   ERRBA
       CHE  65,@FAC           * A or higher?
       BS   SECTO5
       CHE  58,@FAC           * : or higher?
       BS   ERRBA
       CHE  48,@FAC           * 0 or higher?
       BR   ERRBA
SECTO5 SUB  48,@FAC           * - 0
       CHE  10,@FAC           * 10 or higher?
       BR   SECTO6
       SUB  >07,@FAC          * - 7
SECTO6 ST   @FAC,@FAC2        * Save nibble.
       DDEC @FAC4             * $ pointer - 1
       DDEC @BYTES            * $ length - 1
       BR   SECTO7
       ST   @FAC2,V*ARG       * Save #
       B    SECTOA            * End routine.
SECTO7 ST   V*FAC4,@FAC       * Get character.
       CHE  71,@FAC           * G or higher?
       BS   ERRBA
       CHE  65,@FAC           * A or higher?
       BS   SECTO8
       CHE  58,@FAC           * : or higher?
       BS   ERRBA
       CHE  48,@FAC           * 0 or higher?
       BR   ERRBA
SECTO8 SUB  48,@FAC           * - 0
       CHE  10,@FAC           * 10 or higher?
       BR   SECTO9
       SUB  >07,@FAC          * - 7
SECTO9 SLL  4,@FAC            * Swap nibbles.
       ADD  @FAC2,@FAC        * Add old nibble.
       ST   @FAC,V*ARG        * Save #
       DDEC @ARG              * # pointer - 1
       DDEC @FAC4             * $ pointer - 1
       DDEC @BYTES            * $ length - 1
       BR   SECTO3
SECTOA MOVE 4,V@>03C0,@FAC6   * Get #
       CZ   @DFLAG            * DSK?
       BR   SECTOB            * No.
       DST  @FAC8,@FAC6       * DISK
SECTOB DCLR @SREF             * CPU BUFFER
SECTOC DCLR @FAC              * Clear Returned Sector.
       ST   @DEVNUM,@FAC2     * UNIT#
       ST   @VAR0,@FAC3       * R/W Flag.
       DST  >1000,@FAC4       * VDP BUFFER
       CZ   @DFLAG            * DSK?
       BS   SECTOD            * Yes.
       DST  >0120,V@>03C0     * HARD
       B    SECTOE
SECTOD DST  >0110,V@>03C0     * DISK
SECTOE CZ   @VAR0             * WRITE FLAG?
       BR   SECRD             * NO
       MOVE 256,@>2000(@SREF),V@>1000  * WRITE CPU BUFFER
SECRD  CALL RWDSR             * DSR Access.
       CZ   @VAR0             * WRITE FLAG?
       BS   SECWRT            * YES
       MOVE 256,V@>1000,@>2000(@SREF)  * READ VDP BUFFER
SECWRT DADD 256,@SREF         * CPU BUFFER + 256
       CZ   @DFLAG            * DSK?
       BS   SECTOH            * Yes.
       DCEQ >FFFF,@FAC8       * Overflow one word?
       BS   SECTOG            * Yes.
       DINC @FAC8             * SECTOR# - 1 HARD
       B    SECTOI            * No.
SECTOG DCLR @FAC8             * HARD
SECTOH DINC @FAC6             * SECTOR# + 1 DISK & HARD
SECTOI DEC  @VARV             * #SECTORS - 1
       BR   SECTOC
       CEQ  COMMAZ,@CHAT      * ,?
       BS   SECTOS            * Repeat.
       BR   PEEK5
***********************************************************
       END

 

 

 

Link to comment
Share on other sites

Rich Editor Assembly from 2001 but all the original Editor Assembler GPL code is there also.

Spoiler

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0001 
Version 2.0 (Weiand 1985)     Options : LCSFPF                                  
[0001]                
[0002]               ***********************************************************
[0003]                      COPY 'DSK5.MYXB7-A'
<0001>                      TITL 'REA GROM 7'
<0002>               *
<0003>               * GROM
<0004>               *
<0005> 0000          G0000  EQU   >0000
<0006> 0001          G0001  EQU   >0001
<0007> 0010          DSRLNK EQU   >0010
<0008> 0012          DSRRET EQU   >0012
<0009> 001C          BERR   EQU   >001C
<0010> 0038          BGETSS EQU   >0038
<0011> 6372          RXB    EQU   >6372
<0012>               *
<0013>               * CPU
<0014>               *
<0015> 8318          CHRCUR EQU   >8318
<0016> 831C          PABPTR EQU   >831C
<0017> 831E          COUNT  EQU   >831E            CATALOG COUNT FILES
<0018> 8320          CURADD EQU   >8320
<0019> 8322          CODE   EQU   >8322
<0020> 8324          STLN   EQU   >8324
<0021> 8326          ENDLN  EQU   >8326
<0022> 8342          XTOKEN EQU   >8342
<0023> 8347          LDFLAG EQU   >8347
<0024> 8348          FLAG   EQU   >8348
<0025> 8349          FLAG2  EQU   >8349
<0026> 834A          FAC    EQU   >834A
<0027> 834B          FAC1   EQU   >834B
<0028> 834C          FAC2   EQU   >834C
<0029> 834D          FAC3   EQU   >834D
<0030> 834E          FAC4   EQU   >834E
<0031> 834F          FAC5   EQU   >834F
<0032> 8350          FAC6   EQU   >8350
<0033> 8351          FAC7   EQU   >8351
<0034> 8352          FAC8   EQU   >8352
<0035> 8353          FAC9   EQU   >8353
<0036> 8354          ERCODE EQU   >8354
<0037> 8355          FAC11  EQU   >8355
<0038> 8356          FAC12  EQU   >8356
<0039> 8356          VPAB   EQU   >8356
<0040> 835C          ARG    EQU   >835C
<0041> 836E          VSTACK EQU   >836E
<0042> 8373          SUBSTK EQU   >8373
<0043> 8374          KBNO   EQU   >8374
<0044> 8375          KEY    EQU   >8375
<0045> 8379          ITIMER EQU   >8379
<0046> 837D          VCHAR  EQU   >837D
<0047>               *
<0048>               * GENERAL
<0049>               *
<0050> 0001          AID    EQU   1
<0051> 0002          CLEAR  EQU   2
<0052> 0006          REDO   EQU   6
<0053> 000C          PROCD  EQU   12
<0054> 000D          ENTER  EQU   13
<0055> 000E          BEGIN  EQU   14
<0056> 000F          BACK   EQU   15
<0057> 0020          SPACE  EQU   32
<0058>               * XML's ************
<0059> 0002          ROUND  EQU   >02
<0060> 0023          CIF    EQU   >23
<0061>               * VDP **************
<0062> 077F          COLOR  EQU   >077F

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0002 
REA GROM 7
<0063>               ***********************************************************
<0064>                      GROM >E000
<0065>                      AORG >0000
<0066>                      TITL  'E/A GROM'
<0067>               * GROM Header
<0068> E000 AA,10,01        BYTE  >AA,>10,>01,>00
       E003 00
<0069>               * RXB PATCH CODE FOR RXB MODULE *
<0070> E004 00,00           DATA >0000             * POWER UP
<0071> E006 E0,10           DATA  MENU             * Cartridge menu
<0072> E008 FC,B7           DATA  VEIW40           * DSRs
<0073> E00A 00,00           DATA  >0000            * SUBROUTINES
<0074> E00C 00,00,00        DATA  >0000,>0000
       E00F 00
<0075> E010 00,00    MENU   BYTE  >00,>00
<0076> E012 E0,25           DATA  SOLDEA
<0077> E014 10,52,58        STRI  'RXB SUPER E/A   '
       E017 42,20,53
       E01A 55,50,45
       E01D 52,20,45
       E020 2F,41,20
       E023 20,20
<0078> E025 06,E6,DB SOLDEA CALL  NESCRN
<0079> E028 CA,42,38 OLDEA  CHE   >38,@XTOKEN
<0080> E02B 60,32           BS    CLREA
<0081> E02D CA,42,31        CHE   >31,@XTOKEN
<0082> E030 60,37           BS    NEWEA
<0083> E032 06,EF,65 CLREA  CALL  CLRREA
<0084> E035 86,42           CLR   @XTOKEN
<0085> E037 87,8F,9D NEWEA  DCLR  @>2000
       E03A 00
<0086> E03B 06,E6,E1 GE029  CALL  EASCRN
<0087> E03E 86,44           CLR   @>8344           * SEARCH FLAG
<0088> E040 BF,4A,0B        DST   >0B00,@FAC
       E043 00
<0089> E044 06,00,4A        CALL  UPCASE
<0090> E047 86,74    GE056  CLR   @KBNO
<0091> E049 BF,4A,09        DST   >0900,@FAC
       E04C 00
<0092> E04D 06,00,18        CALL  LOCASE
<0093> E050 86,A8,00        CLR   V@>0800
<0094> E053 35,00,FF        MOVE  >00FF,V@>0800,V@>0801
       E056 A8,01,A8
       E059 00
<0095> E05A 39,00,06        MOVE  6,G@VREGS,#1
       E05D 01,ED,DC
<0096> E060 06,EE,22        CALL  BUGS
<0097> E063 31,00,10        MOVE  16,G@CURPAT,V@>08F0
       E066 A8,F0,ED
       E069 CC
<0098> E06A 31,00,10        MOVE  16,G@DARROW,V@>0C10
       E06D AC,10,E1
       E070 7F
<0099>               *
<0100>               *  Display Main Menu
<0101>               *
<0102> E071 BE,73,7E MMENU  ST    >7E,@SUBSTK
<0103> E074 87,22           DCLR  @CODE
<0104> E076 87,48           DCLR  @FLAG
<0105> E078 86,47           CLR   @LDFLAG
<0106> E07A 07,20           ALL   SPACE
<0107> E07C CA,42,38 GE116  CHE   >38,@XTOKEN
<0108> E07F 60,86           BS    MSCRN
<0109> E081 CA,42,31        CHE   >31,@XTOKEN

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0003 
E/A GROM
<0110> E084 61,8F           BS    MYEAXB
<0111> E086 87,7E    MSCRN  HOME
<0112> E088 08              FMT
<0113> E089 FF,08           COL   8
<0114> E08B 0F,46,49        HTEX  'FIRMWARE CONTROL'
       E08E 52,4D,57
       E091 41,52,45
       E094 20,43,4F
       E097 4E,54,52
       E09A 4F,4C
<0115> E09C A0              ROW+  1
<0116> E09D FF,00           COL   0
<0117> E09F 5F,5F           HCHAR 32,95
<0118> E0A1 A0              ROW+  1
<0119> E0A2 FF,02           COL   2
<0120> E0A4 1C,52,58        HTEX  'RXB Editor & Assembler V=2001'
       E0A7 42,20,45
       E0AA 64,69,74
       E0AD 6F,72,20
       E0B0 26,20,41
       E0B3 73,73,65
       E0B6 6D,62,6C
       E0B9 65,72,20
       E0BC 56,3D,32
       E0BF 30,30,31
<0121> E0C2 A0              ROW+  1
<0122> E0C3 FF,00           COL   0
<0123> E0C5 5F,5F           HCHA  32,95
<0124> E0C7 A0              ROW+  1
<0125> E0C8 FF,08           COL   8
<0126> E0CA 11,30,20        HTEX  '0    SCREEN COLORS'
       E0CD 20,20,20
       E0D0 53,43,52
       E0D3 45,45,4E
       E0D6 20,43,4F
       E0D9 4C,4F,52
       E0DC 53
<0127> E0DD A1              ROW+  2
<0128> E0DE FF,08           COL   8
<0129> E0E0 0A,31,20        HTEX  '1    EDITOR'
       E0E3 20,20,20
       E0E6 45,44,49
       E0E9 54,4F,52
<0130> E0EC A1              ROW+  2
<0131> E0ED FF,08           COL   8
<0132> E0EF 0D,32,20        HTEX  '2    ASSEMBLER'
       E0F2 20,20,20
       E0F5 41,53,53
       E0F8 45,4D,42
       E0FB 4C,45,52
<0133> E0FE A1              ROW+  2
<0134> E0FF FF,08           COL   8
<0135> E101 10,33,20        HTEX  '3    LOAD and RUN'
       E104 20,20,20
       E107 4C,4F,41
       E10A 44,20,61
       E10D 6E,64,20
       E110 52,55,4E
<0136> E113 A1              ROW+  2
<0137> E114 FF,08           COL   8
<0138> E116 07,34,20        HTEX  '4    RUN'
       E119 20,20,20
       E11C 52,55,4E
<0139> E11F A1              ROW+  2

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0004 
E/A GROM
<0140> E120 FF,08           COL   8
<0141> E122 14,35,20        HTEX  '5    RUN PROGRAM FILE'
       E125 20,20,20
       E128 52,55,4E
       E12B 20,50,52
       E12E 4F,47,52
       E131 41,4D,20
       E134 46,49,4C
       E137 45
<0142> E138 A1              ROW+  2
<0143> E139 FF,08           COL   8
<0144> E13B 11,36,20        HTEX  '6    R X B  LOADER'
       E13E 20,20,20
       E141 52,20,58
       E144 20,42,20
       E147 20,4C,4F
       E14A 41,44,45
       E14D 52
<0145> E14E A1              ROW+  2
<0146> E14F FF,08           COL   8
<0147> E151 0D,37,20        HTEX  '7    DIRECTORY'
       E154 20,20,20
       E157 44,49,52
       E15A 45,43,54
       E15D 4F,52,59
<0148> E160 A1              ROW+  2
<0149> E161 FF,08           COL   8
<0150> E163 09,2E,20        HTEX  '.    R X B'
       E166 20,20,20
       E169 52,20,58
       E16C 20,42
<0151> E16E FB              FEND
<0152> E16F 03       NEWSCN SCAN
<0153> E170 41,6F           BR    NEWSCN
<0154> E172 D6,75,2E        CEQ   >2E,@KEY
<0155> E175 61,7C           BS    RTRXB
<0156> E177 D6,75,0F        CEQ   BACK,@KEY
<0157> E17A 41,99           BR    GE11F
<0158> E17C 05,63,72 RTRXB  B     RXB
<0159> E17F 00,10,18 DARROW DATA  >0010,>18FC,>1810,>0000 * RIGHT ARROW
       E182 FC,18,10
       E185 00,00
<0160> E187 00,20,60        DATA  >0020,>60FC,>6020,>0000 * LEFT ARROW
       E18A FC,60,20
       E18D 00,00
<0161> E18F 87,AF,22 MYEAXB DCLR  V@>2250
       E192 50
<0162> E193 BC,75,42        ST    @XTOKEN,@KEY
<0163> E196 BE,42,EA        ST    >EA,@XTOKEN
<0164> E199 A6,75,30 GE11F  SUB   >30,@KEY
<0165> E19C CA,75,0A        CHE   >0A,@KEY
<0166> E19F 61,6F           BS    NEWSCN
<0167> E1A1 8A,75           CASE  @KEY
<0168> E1A3 41,B7           BR    COLORS           * SCREEN COLOR 0
<0169> E1A5 42,46           BR    EDITOR                          1
<0170> E1A7 48,2D           BR    ASSEM                           2
<0171> E1A9 49,E4           BR    LANDR            * EA3          3
<0172> E1AB 4A,59           BR    RUN                             4
<0173> E1AD 47,16           BR    PRGRM            * EA5          5
<0174> E1AF 4E,D9           BR    XBINP            * XBINPT       6
<0175> E1B1 56,C4           BR    DIRECT           * DIRECTORY    7
<0176> E1B3 40,28           BR    OLDEA                           8
<0177> E1B5 40,28           BR    OLDEA                           9
<0178>               *******************************

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0005 
E/A GROM
<0179>               *
<0180> E1B7 07,20    COLORS ALL   SPACE
<0181> E1B9 06,E6,E1        CALL  EASCRN
<0182> E1BC 08              FMT
<0183> E1BD FF,0B           COL   >0B
<0184> E1BF FE,01           ROW   1
<0185> E1C1 09,2A,20        HTEX  '* COLORS *'
       E1C4 43,4F,4C
       E1C7 4F,52,53
       E1CA 20,2A
<0186> E1CC FF,03           COL   3
<0187> E1CE A2              ROW+  3
<0188> E1CF 0D,46,4F        HTEX  'FORGROUND  = F'
       E1D2 52,47,52
       E1D5 4F,55,4E
       E1D8 44,20,20
       E1DB 3D,20,46
<0189> E1DE FF,03           COL   3
<0190> E1E0 A2              ROW+  3
<0191> E1E1 0D,42,41        HTEX  'BACKGROUND = B'
       E1E4 43,4B,47
       E1E7 52,4F,55
       E1EA 4E,44,20
       E1ED 3D,20,42
<0192> E1F0 FF,03           COL   3
<0193> E1F2 A4              ROW+  5
<0194> E1F3 1A,41,4E        HTEX  'ANY OTHER KEY FOR MAIN MENU'
       E1F6 59,20,4F
       E1F9 54,48,45
       E1FC 52,20,4B
       E1FF 45,59,20
       E202 46,4F,52
       E205 20,4D,41
       E208 49,4E,20
       E20B 4D,45,4E
       E20E 55
<0195> E20F FB              FEND
<0196> E210 03       COLSCN SCAN
<0197> E211 42,10           BR   COLSCN
<0198> E213 BC,00,A7        ST   V@COLOR,@>8300    * Get COLOR byte
       E216 7F
<0199> E217 E6,00,04        SRL  4,@>8300          * Foreground
<0200> E21A BC,01,A7        ST   V@COLOR,@>8301    * Get COLOR byte
       E21D 7F
<0201> E21E E2,01,04        SLL  4,@>8301          * Strip left bits
<0202> E221 E6,01,04        SRL  4,@>8301          * Restore bits
<0203> E224 D6,75,46        CEQ  'F',@KEY
<0204> E227 42,2D           BR   COLBAC
<0205> E229 90,00           INC  @>8300            * Foreground+1
<0206> E22B 42,3A           BR   COLEND
<0207> E22D D6,75,42 COLBAC CEQ  'B',@KEY
<0208> E230 40,3B           BR   GE029
<0209> E232 90,01           INC  @>8301            * Background+1
<0210> E234 E2,01,04        SLL  4,@>8301          * Strip left bits
<0211> E237 E6,01,04        SRL  4,@>8301          * Restore bits
<0212> E23A E2,00,04 COLEND SLL  4,@>8300          * Restore left bits
<0213> E23D A0,00,01        ADD  @>8301,@>8300     * Get Background
<0214> E240 BC,A7,7F        ST   @>8300,V@COLOR    * Add to COLOR
       E243 00
<0215> E244 41,B7           BR   COLORS
<0216>               *
<0217>               *  Main Menu Option 1: EDIT
<0218>               *
<0219> E246 06,E6,E1 EDITOR CALL  EASCRN

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0006 
E/A GROM
<0220> E249 87,48           DCLR  @FLAG
<0221> E24B 86,47           CLR   @LDFLAG
<0222> E24D 08              FMT
<0223> E24E FF,0B           COL   >0B
<0224> E250 FE,01           ROW   1
<0225> E252 09,2A,20        HTEX  '* EDITOR *'
       E255 45,44,49
       E258 54,4F,52
       E25B 20,2A
<0226> E25D A2              ROW+  3
<0227> E25E FF,03           COL   3
<0228> E260 08,31,20        HTEX  '1    LOAD'
       E263 20,20,20
       E266 4C,4F,41
       E269 44
<0229> E26A A0              ROW+  1
<0230> E26B 96              COL+  23
<0231> E26C 08,32,20        HTEX  '2    EDIT'
       E26F 20,20,20
       E272 45,44,49
       E275 54
<0232> E276 A0              ROW+  1
<0233> E277 96              COL+  23
<0234> E278 08,33,20        HTEX  '3    SAVE'
       E27B 20,20,20
       E27E 53,41,56
       E281 45
<0235> E282 A0              ROW+  1
<0236> E283 96              COL+  23
<0237> E284 09,34,20        HTEX  '4    PRINT'
       E287 20,20,20
       E28A 50,52,49
       E28D 4E,54
<0238> E28F A0              ROW+  1
<0239> E290 95              COL+  22
<0240> E291 09,35,20        HTEX  '5    VIEW '
       E294 20,20,20
       E297 56,49,45
       E29A 57,20
<0241> E29C A0              ROW+  1
<0242> E29D 95              COL+  22
<0243> E29E 09,36,20        HTEX  '6    PURGE'
       E2A1 20,20,20
       E2A4 50,55,52
       E2A7 47,45
<0244> E2A9 A0              ROW+  1
<0245> E2AA 95              COL+  22
<0246> E2AB FB              FEND
<0247> E2AC 87,48           DCLR  @FLAG
<0248> E2AE BE,73,7E        ST    >7E,@SUBSTK
<0249> E2B1 BF,20,00        DST   >0082,@CURADD
       E2B4 82
<0250> E2B5 03       GE19B  SCAN
<0251> E2B6 42,B5           BR    GE19B
<0252> E2B8 D6,75,0F        CEQ   BACK,@KEY
<0253> E2BB 60,32           BS    CLREA
<0254> E2BD A6,75,31        SUB   >31,@KEY
<0255> E2C0 CA,75,06        CHE   >06,@KEY
<0256> E2C3 62,B5           BS    GE19B
<0257> E2C5 BC,00,75        ST    @KEY,@>8300
<0258> E2C8 AA,00,40        MUL   >40,@>8300
<0259> E2CB A1,20,00        DADD  @>8300,@CURADD
<0260> E2CE BE,B0,20        ST    130,V*CURADD
       E2D1 82

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0007 
E/A GROM
<0261> E2D2 BC,04,75        ST    @KEY,@>8304
<0262> E2D5 D6,75,05        CEQ   >05,@KEY         * PURGE?
<0263> E2D8 42,FF           BR    GE1E4            * No, next check
<0264>               *  Edit Menu Option 6: PURGE
<0265> E2DA 08              FMT
<0266> E2DB A1              ROW+  2
<0267> E2DC 13,41,72        HTEX  'Are you sure (Y/N)? '
       E2DF 65,20,79
       E2E2 6F,75,20
       E2E5 73,75,72
       E2E8 65,20,28
       E2EB 59,2F,4E
       E2EE 29,3F,20
<0268> E2F1 FB              FEND
<0269> E2F2 06,E9,B7        CALL  YESNO
<0270> E2F5 D6,75,59        CEQ   >59,@KEY
<0271> E2F8 42,46           BR    EDITOR
<0272> E2FA 06,E7,08        CALL  CLRXOP
<0273> E2FD 42,46    GE1E2  BR    EDITOR
<0274> E2FF D6,75,03 GE1E4  CEQ   >03,@KEY         * PRINT?
<0275> E302 63,54           BS    GE1FC            * YES!
<0276> E304 D6,75,04        CEQ   >04,@KEY         * VIEW
<0277> E307 63,54           BS    GE1FC
<0278> E309 D7,8F,9D        DCEQ  >55AA,@>2000     * EDIT1 loaded?
       E30C 00,55,AA
<0279> E30F 63,54           BS    GE1FC            * Yes
<0280> E311 35,00,63        MOVE  99,V@>2250,@>EA00
       E314 8F,67,00
       E317 AF,22,50
<0281> E31A BC,8F,7C        ST    @XTOKEN,@>FFFB
       E31D FB,42
<0282> E31F 86,42           CLR   @XTOKEN
<0283> E321 31,00,08        MOVE  8,G@CUREDP,V@>08F0
       E324 A8,F0,ED
       E327 C4
<0284> E328 06,E7,AE        CALL  LODPGM           * Load EDIT1
<0285> E32B E8,28           DATA  DEDIT1
<0286> E32D 06,EE,3C        CALL  DEVICE
<0287> E330 D6,75,0F        CEQ   BACK,@KEY
<0288> E333 62,46           BS    EDITOR
<0289> E335 BE,47,01        ST    1,@LDFLAG        * Set Editor flag
<0290> E338 06,E7,D9 GE1F6  CALL  PGMLOD
<0291> E33B D7,8F,9D        DCEQ  >55AA,@>2000
       E33E 00,55,AA
<0292> E341 42,46           BR    EDITOR
<0293> E343 06,E7,08        CALL  CLRXOP
<0294> E346 35,00,63        MOVE  99,@>EA00,V@>2250
       E349 AF,22,50
       E34C 8F,67,00
<0295> E34F BC,42,8F        ST    @>FFFB,@XTOKEN
       E352 7C,FB
<0296> E354 D6,04,01 GE1FC  CEQ   >01,@>8304       * Edit?
<0297> E357 63,CF           BS    EMOPT2           * Yes
<0298> E359 D6,04,02        CEQ   >02,@>8304       * Save?
<0299> E35C 43,90           BR    GE237            * No
<0300>               *  Edit Menu Option 3: SAVE
<0301> E35E 86,42           CLR   @XTOKEN
<0302> E360 08              FMT
<0303> E361 FF,02       COL   2
<0304> E363 FE,10       ROW   16
<0305> E365 12,44,56    HTEX  'DV80 Format (Y/N)? '
       E368 38,30,20
       E36B 46,6F,72
       E36E 6D,61,74

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0008 
E/A GROM
       E371 20,28,59
       E374 2F,4E,29
       E377 3F,20
<0306> E379 FB          FEND
<0307> E37A 06,E9,B7        CALL  YESNO
<0308> E37D D6,75,59        CEQ   >59,@KEY
<0309> E380 43,85           BR    GE22C
<0310> E382 B6,49,02        OR    >02,@FLAG2
<0311> E385 D6,75,0F GE22C  CEQ   BACK,@KEY
<0312> E388 62,46           BS    EDITOR
<0313> E38A BF,20,02        DST   >0262,@CURADD
       E38D 62
<0314> E38E 43,9B           BR    GE23B
<0315> E390 BF,20,02 GE237  DST   >0202,@CURADD    * Print or View or Load
       E393 02
<0316> E394 35,00,FF        MOVE  255,V@>0200,V@>201
       E397 A2,01,A2
       E39A 00
<0317> E39B 31,00,0A GE23B  MOVE  10,G@GE25B,V*CURADD
       E39E B0,20,E3
       E3A1 C5
<0318> E3A2 A3,20,00        DADD  >0040,@CURADD
       E3A5 40
<0319> E3A6 BF,1C,10        DST   >1000,@PABPTR
       E3A9 00
<0320> E3AA 06,E5,1D        CALL  GETALL
<0321> E3AD D6,75,0F        CEQ   BACK,@KEY        * BACK?
<0322> E3B0 60,32           BS    CLREA
<0323> E3B2 D6,04,02        CEQ   >02,@>8304       * Save?
<0324> E3B5 64,31           BS    GE2B5
<0325> E3B7 D6,04,03        CEQ   >03,@>8304       * Print?
<0326> E3BA 64,55           BS    GE2D9
<0327> E3BC D6,04,04        CEQ   >04,@>8304       * View?
<0328> E3BF 64,06           BS    VIT40
<0329> E3C1 8E,04           CZ    @>8304           * Load?
<0330> E3C3 63,DC           BS    GE272
<0331> E3C5 46,49,4C GE25B  TEXT  'FILE NAME?'
       E3C8 45,20,4E
       E3CB 41,4D,45
       E3CE 3F
<0332>               *  Edit Menu Option 2: EDIT
<0333> E3CF 0F,23    EMOPT2 XML   >23
<0334> E3D1 6B,3C           BS    GE8B0
<0335> E3D3 39,00,01        MOVE  1,G@GE271,#1
       E3D6 01,E3,DB
<0336> E3D9 42,46           BR    EDITOR
<0337> E3DB E0       GE271  BYTE  >E0
<0338> E3DC 06,E3,E5 GE272  CALL  GE27B
<0339> E3DF 0F,21           XML   >21
<0340> E3E1 6B,3F           BS    GE8B3
<0341> E3E3 42,46           BR    EDITOR
<0342> E3E5 BE,E0,01 GE27B  ST    >04,V@>0001(@PABPTR)
       E3E8 1C,04
<0343> E3EA B2,49,FD        AND   >FD,@FLAG2
<0344> E3ED BD,56,1C GE283  DST   @PABPTR,@VPAB
<0345> E3F0 A3,56,00        DADD  >0009,@VPAB
       E3F3 09
<0346> E3F4 06,00,10        CALL  DSRLNK
<0347> E3F7 08              BYTE  >08
<0348> E3F8 6B,E4           BS    CHKERR
<0349> E3FA DA,E0,01        CLOG  >E0,V@>0001(@PABPTR)
       E3FD 1C,E0
<0350> E3FF 44,18           BR    GE29C
<0351> E401 BE,B0,1C        ST    >02,V*PABPTR

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0009 
E/A GROM
       E404 02
<0352> E405 00              RTN
<0353> E406 BE,42,EA VIT40  ST    >EA,@XTOKEN
<0354> E409 31,00,05        MOVE  5,G@VIEWR,V@>2256
       E40C AF,22,56
       E40F E4,13
<0355> E411 44,55           BR    GE2D9
<0356> E413 03,56,34 VIEWR  STRI  'V40'
       E416 30
<0357> E417 0D              BYTE  >0D
<0358> E418 BC,00,E0 GE29C  ST    V@>0001(@PABPTR),@>8300
       E41B 01,1C
<0359> E41D B2,00,1F        AND   >1F,@>8300
<0360> E420 D6,00,04        CEQ   >04,@>8300
<0361> E423 44,2F           BR    GE2B3
<0362> E425 BE,E0,01        ST    >14,V@>0001(@PABPTR)
       E428 1C,14
<0363> E42A B6,49,02        OR    >02,@FLAG2
<0364> E42D 43,ED           BR    GE283
<0365> E42F 4B,E4    GE2B3  BR    CHKERR
<0366> E431 BE,E0,01 GE2B5  ST    >02,V@>0001(@PABPTR)
       E434 1C,02
<0367> E436 DA,49,02        CLOG  >02,@FLAG2
<0368> E439 64,40           BS    GE2C4
<0369> E43B BE,E0,01        ST    >12,V@>0001(@PABPTR)
       E43E 1C,12
<0370> E440 06,E5,6A GE2C4  CALL  DOIO
<0371> E443 BE,B0,1C        ST    >03,V*PABPTR
       E446 03
<0372> E447 BE,E0,05        ST    >50,V@>0005(@PABPTR)
       E44A 1C,50
<0373> E44C 0F,22           XML   >22
<0374> E44E 6B,3F           BS    GE8B3
<0375> E450 06,E5,66        CALL  CLOSE
<0376> E453 42,46           BR    EDITOR
<0377>               * Edit Menu Option 4 or 5: PRINT or VIEW output
<0378> E455 06,E3,E5 GE2D9  CALL  GE27B
<0379> E458 08              FMT
<0380> E459 FF,02           COL   2
<0381> E45B FE,14           ROW   20
<0382> E45D 0B,44,45        HTEX  'DEVICE NAME?'
       E460 56,49,43
       E463 45,20,4E
       E466 41,4D,45
       E469 3F
<0383> E46A FB              FEND
<0384> E46B BF,20,02        DST   >02C2,@CURADD    * Cursor Address
       E46E C2
<0385> E46F BF,1C,11        DST   >1100,@PABPTR    * PAB address
       E472 00
<0386> E473 D6,04,04        CEQ   >04,@>8304       * VIEW?
<0387> E476 64,7D           BS    VFILE            * No
<0388> E478 86,42           CLR   @XTOKEN
<0389> E47A 06,EF,65        CALL  CLRREA
<0390> E47D 06,E5,1D VFILE  CALL  GETALL
<0391> E480 86,42           CLR   @XTOKEN
<0392> E482 BE,E0,05        ST    >50,V@>0005(@PABPTR)
       E485 1C,50
<0393> E487 BE,E0,01 GE30A  ST    >12,V@>0001(@PABPTR)
       E48A 1C,12
<0394> E48C BF,E0,02        DST   >1080,V@>0002(@PABPTR)
       E48F 1C,10,80
<0395> E492 06,E5,6A        CALL  DOIO
<0396> E495 D6,E0,04        CEQ   >20,V@>0004(@PABPTR)

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0010 
E/A GROM
       E498 1C,20
<0397> E49A 44,9F           BR    GE322
<0398> E49C B6,48,02        OR    >02,@FLAG
<0399> E49F BE,B0,1C GE322  ST    >03,V*PABPTR
       E4A2 03
<0400> E4A3 DA,48,02        CLOG  >02,@FLAG
<0401> E4A6 65,0A           BS    GE38D
<0402> E4A8 BF,1C,10 GE32B  DST   >1000,@PABPTR
       E4AB 00
<0403> E4AC 06,E5,51        CALL  BLNKBU
<0404> E4AF 06,E5,6A        CALL  DOIO
<0405> E4B2 BF,1C,11        DST   >1100,@PABPTR
       E4B5 00
<0406> E4B6 BF,00,10        DST   >1080,@>8300
       E4B9 80
<0407> E4BA A3,00,00        DADD  >004F,@>8300
       E4BD 4F
<0408> E4BE BE,02,50        ST    >50,@>8302
<0409> E4C1 BC,03,B0 GE344  ST    V*>8300,@>8303
       E4C4 00
<0410> E4C5 D6,03,20        CEQ   >20,@>8303
<0411> E4C8 64,DE           BS    GE361
<0412> E4CA D6,03,0C        CEQ   >0C,@>8303
<0413> E4CD 44,DC           BR    GE35F
<0414> E4CF BE,B0,00        ST    >20,V*>8300
       E4D2 20
<0415> E4D3 06,E5,6A        CALL  DOIO
<0416> E4D6 06,E5,6A        CALL  DOIO
<0417> E4D9 06,E5,6A        CALL  DOIO
<0418> E4DC 44,E4    GE35F  BR    GE367
<0419> E4DE 93,00    GE361  DDEC  @>8300
<0420> E4E0 92,02           DEC   @>8302
<0421> E4E2 44,C1           BR    GE344
<0422> E4E4 06,E5,6A GE367  CALL  DOIO
<0423> E4E7 A6,02,20        SUB   >20,@>8302
<0424> E4EA CE,02,00        CGT   >00,@>8302
<0425> E4ED 44,FD           BR    GE380
<0426> E4EF A3,E0,02        DADD  >0020,V@>0002(@PABPTR)
       E4F2 1C,00,20
<0427> E4F5 BC,E0,05        ST    @>8302,V@>0005(@PABPTR)
       E4F8 1C,02
<0428> E4FA 05,E4,E4        B     GE367
<0429> E4FD BF,E0,02 GE380  DST   >1080,V@>0002(@PABPTR)
       E500 1C,10,80
<0430> E503 BE,E0,05        ST    >20,V@>0005(@PABPTR)
       E506 1C,20
<0431> E508 44,A8           BR    GE32B
<0432> E50A BF,1C,10 GE38D  DST   >1000,@PABPTR
       E50D 00
<0433> E50E 06,E5,51        CALL  BLNKBU
<0434> E511 06,E5,6A        CALL  DOIO
<0435> E514 BF,1C,11        DST   >1100,@PABPTR
       E517 00
<0436> E518 06,E5,6A        CALL  DOIO
<0437> E51B 45,0A           BR    GE38D
<0438> E51D 06,E5,51 GETALL CALL  BLNKBU
<0439>               *  Build PAB with name
<0440> E520 06,E5,7F BLDPAB CALL  VZERO
<0441> E523 BD,E0,02        DST   @PABPTR,V@>0002(@PABPTR)
       E526 1C,1C
<0442> E528 A3,E0,02        DADD  >0080,V@>0002(@PABPTR)
       E52B 1C,00,80
<0443> E52E BE,E0,08        ST    >00,V@>0008(@PABPTR)
       E531 1C,00

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0011 
E/A GROM
<0444> E533 BF,E0,04        DST   >5000,V@>0004(@PABPTR)
       E536 1C,50,00
<0445> E539 87,AF,22        DCLR  V@>2250
       E53C 50
<0446> E53D 06,E5,8B        CALL  GETINP
<0447> E540 8F,50           DCZ   @FAC6
<0448> E542 65,50           BS    GE3CF
<0449> E544 34,50,E0 PABNAM MOVE  @FAC6,V*FAC4,V@>000A(@PABPTR)
       E547 0A,1C,B0
       E54A 4E
<0450> E54B BC,E0,09        ST    @FAC7,V@>0009(@PABPTR)
       E54E 1C,51
<0451> E550 00       GE3CF  RTN
<0452> E551 A3,1C,00 BLNKBU DADD  >0080,@PABPTR
       E554 80
<0453> E555 BE,B0,1C        ST    >20,V*PABPTR
       E558 20
<0454> E559 35,00,4F        MOVE  >004F,V*PABPTR,V@>0001(@PABPTR)
       E55C E0,01,1C
       E55F B0,1C
<0455> E561 A7,1C,00        DSUB  >0080,@PABPTR
       E564 80
<0456> E565 00              RTN
<0457> E566 BE,B0,1C CLOSE  ST    >01,V*PABPTR
       E569 01
<0458> E56A BD,56,1C DOIO   DST   @PABPTR,@VPAB
<0459> E56D A3,56,00        DADD  >0009,@VPAB
       E570 09
<0460> E571 06,00,10        CALL  DSRLNK
<0461> E574 08              BYTE  >08
<0462> E575 6B,E4           BS    CHKERR
<0463> E577 DA,E0,01        CLOG  >E0,V@>0001(@PABPTR)
       E57A 1C,E0
<0464> E57C 4B,E4           BR    CHKERR
<0465> E57E 00              RTN
<0466> E57F 86,B0,1C VZERO  CLR   V*PABPTR
<0467> E582 35,00,45        MOVE  >0045,V*PABPTR,V@>0001(@PABPTR)
       E585 E0,01,1C
       E588 B0,1C
<0468> E58A 00              RTN
<0469> E58B 06,E5,BE GETINP CALL  GETKEY
<0470> E58E BD,20,24        DST   @STLN,@CURADD
<0471> E591 BE,00,3C        ST    >3C,@>8300
<0472> E594 87,50           DCLR  @FAC6
<0473> E596 D6,B0,20 GE415  CEQ   SPACE,V*CURADD
       E599 20
<0474> E59A 45,AC           BR    GE42B
<0475> E59C 91,20           DINC  @CURADD
<0476> E59E 92,00           DEC   @>8300
<0477> E5A0 45,96           BR    GE415
<0478> E5A2 BD,20,24        DST   @STLN,@CURADD
<0479> E5A5 DA,48,04        CLOG  >04,@FLAG
<0480> E5A8 45,BD           BR    GE43C
<0481> E5AA 45,8B           BR    GETINP
<0482> E5AC BD,4E,20 GE42B  DST   @CURADD,@FAC4
<0483> E5AF D6,B0,20 GE42E  CEQ   SPACE,V*CURADD
       E5B2 20
<0484> E5B3 65,BD           BS    GE43C
<0485> E5B5 91,50           DINC  @FAC6
<0486> E5B7 91,20           DINC  @CURADD
<0487> E5B9 92,00           DEC   @>8300
<0488> E5BB 45,AF           BR    GE42E
<0489> E5BD 00       GE43C  RTN
<0490>               *  Key input routine

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0012 
E/A GROM
<0491> E5BE BE,18,1F GETKEY ST    >1F,@CHRCUR
<0492> E5C1 BD,26,20        DST   @CURADD,@ENDLN
<0493> E5C4 BD,24,20        DST   @CURADD,@STLN
<0494> E5C7 86,79    GE446  CLR   @ITIMER
<0495> E5C9 C0,18,B0        EX    V*CURADD,@CHRCUR
       E5CC 20
[0004]               ***********************************************************
[0005]                      COPY 'DSK5.MYXB7-B'
<0001>               *  REPEAT KEYS
<0002> E5CD 03       GE44C  SCAN
<0003> E5CE 65,F6           BS    GE456
<0004> E5D0 CA,79,07        CHE   7,@ITIMER
<0005> E5D3 45,CD           BR    GE44C
<0006> E5D5 D6,42,EA        CEQ   >EA,@XTOKEN      * ANYTHING
<0007> E5D8 45,C7           BR    GE446
<0008> E5DA BD,76,AF PSCANX DST   V@>2250,@>8376
       E5DD 22,50
<0009> E5DF BC,75,EF        ST    V@>2257(@>8376),@KEY
       E5E2 22,57,76
<0010> E5E5 91,76           DINC  @>8376
<0011> E5E7 BD,AF,22        DST   @>8376,V@>2250
       E5EA 50,76
<0012> E5EC D4,AF,22        CEQ   @>8376,V@>2256
       E5EF 56,76
<0013> E5F1 45,F6           BR    GE456
<0014> E5F3 BE,75,0D        ST    >0D,@KEY         * Store ENTER
<0015> E5F6 D6,B0,20 GE456  CEQ   >1F,V*CURADD
       E5F9 1F
<0016> E5FA 46,00           BR    GE460
<0017> E5FC C0,18,B0        EX    V*CURADD,@CHRCUR
       E5FF 20
<0018> E600 BD,00,20 GE460  DST   @CURADD,@>8300
<0019> E603 A5,00,24        DSUB  @STLN,@>8300
<0020> E606 C6,75,19        CH    >19,@KEY         * SPACE key and higher?
<0021> E609 66,21           BS    GE46B
<0022> E60B D6,75,07        CEQ   7,@KEY           * FCTN 3?
<0023> E60E 46,3B           BR    GE485
<0024> E610 BE,B0,24        ST    SPACE,V*STLN
       E613 20
<0025> E614 35,00,3F        MOVE  >003F,V*STLN,V@1(@STLN)
       E617 E0,01,24
       E61A B0,24
<0026> E61C BD,20,24        DST   @STLN,@CURADD
<0027> E61F 45,BE           BR    GETKEY
<0028> E621 DA,48,01 GE46B  CLOG  >01,@FLAG
<0029> E624 46,93           BR    GE4DD
<0030> E626 BC,B0,20 GE470  ST    @KEY,V*CURADD
       E629 75
<0031> E62A C5,20,26        DCH   @ENDLN,@CURADD
<0032> E62D 46,32           BR    GE47C
<0033> E62F BD,26,20        DST   @CURADD,@ENDLN
<0034> E632 C6,01,3F GE47C  CH    >3F,@>8301
<0035> E635 65,C7           BS    GE446
<0036> E637 91,20           DINC  @CURADD
<0037> E639 45,C7           BR    GE446
<0038> E63B B2,48,FE GE485  AND   >FE,@FLAG
<0039> E63E D6,75,0F        CEQ   BACK,@KEY
<0040> E641 46,4F           BR    GE499
<0041> E643 DA,48,20        CLOG  >20,@FLAG
<0042> E646 40,32           BR    CLREA            * GE97F
<0043> E648 DA,48,04        CLOG  >04,@FLAG
<0044> E64B 40,32           BR    CLREA
<0045> E64D 42,46           BR    EDITOR
<0046> E64F D6,75,09 GE499  CEQ   >09,@KEY

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0013 
E/A GROM
<0047> E652 66,32           BS    GE47C
<0048> E654 D6,75,08        CEQ   >08,@KEY
<0049> E657 46,61           BR    GE4AB
<0050> E659 8E,01           CZ    @>8301
<0051> E65B 65,C7           BS    GE446
<0052> E65D 93,20           DDEC  @CURADD
<0053> E65F 45,C7           BR    GE446
<0054> E661 D6,75,0D GE4AB  CEQ   >0D,@KEY
<0055> E664 66,B9           BS    GE503
<0056> E666 D6,75,03        CEQ   >03,@KEY
<0057> E669 46,89           BR    GE4D3
<0058> E66B BE,B0,20        ST    SPACE,V*CURADD
       E66E 20
<0059> E66F BD,00,26        DST   @ENDLN,@>8300
<0060> E672 A5,00,20        DSUB  @CURADD,@>8300
<0061> E675 CE,01,00        CGT   >00,@>8301
<0062> E678 45,C7           BR    GE446
<0063> E67A 34,00,B0        MOVE  @>8300,V@>0001(@CURADD),V*CURADD
       E67D 20,E0,01
       E680 20
<0064> E681 BE,B0,26        ST    SPACE,V*ENDLN
       E684 20
<0065> E685 93,26           DDEC  @ENDLN
<0066> E687 45,C7           BR    GE446
<0067> E689 D6,75,04 GE4D3  CEQ   >04,@KEY
<0068> E68C 46,B7           BR    GE501
<0069> E68E B6,48,01        OR    >01,@FLAG
<0070> E691 45,C7           BR    GE446
<0071> E693 BD,00,26 GE4DD  DST   @ENDLN,@>8300
<0072> E696 A5,00,24        DSUB  @STLN,@>8300
<0073> E699 C6,01,3F        CH    >3F,@>8301
<0074> E69C 65,C7           BS    GE446
<0075> E69E BD,00,26        DST   @ENDLN,@>8300
<0076> E6A1 A5,00,20        DSUB  @CURADD,@>8300
<0077> E6A4 91,00           DINC  @>8300
<0078> E6A6 34,00,A3        MOVE  @>8300,V*CURADD,V@>03C0
       E6A9 C0,B0,20
<0079> E6AC 34,00,E0        MOVE  @>8300,V@>03C0,V@>0001(@CURADD)
       E6AF 01,20,A3
       E6B2 C0
<0080> E6B3 91,26           DINC  @ENDLN
<0081> E6B5 46,26           BR    GE470
<0082> E6B7 45,C7    GE501  BR    GE446
<0083> E6B9 00       GE503  RTN
<0084>               *  Check for Expansion Memory
<0085> E6BA BC,00,8F EXPMEM ST    @>2000,@>8300
       E6BD 9D,00
<0086> E6BF BE,8F,9D        ST    >FF,@>2000
       E6C2 00,FF
<0087> E6C4 D6,8F,9D        CEQ   >FF,@>2000
       E6C7 00,FF
<0088> E6C9 4B,A4           BR    GE91D
<0089> E6CB 86,8F,9D        CLR   @>2000
       E6CE 00
<0090> E6CF 8E,8F,9D        CZ    @>2000
       E6D2 00
<0091> E6D3 4B,A4           BR    GE91D
<0092> E6D5 BC,8F,9D        ST    @>8300,@>2000
       E6D8 00,00
<0093> E6DA 00              RTN
<0094> E6DB 04,F4    NESCRN BACK  >F4
<0095> E6DD BE,A7,7F        ST    >F4,V@COLOR
       E6E0 F4
<0096> E6E1 BE,A3,00 EASCRN ST    >D0,V@>0300

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0014 
E/A GROM
       E6E4 D0
<0097> E6E5 BC,A3,80        ST    V@COLOR,V@>0380
       E6E8 A7,7F
<0098> E6EA 35,00,1F        MOVE  31,V@>0380,V@>0381
       E6ED A3,81,A3
       E6F0 80
<0099> E6F1 07,20           ALL   SPACE
<0100> E6F3 3D,00,01        MOVE  1,V@COLOR,#7
       E6F6 07,A7,7F
<0101> E6F9 00              RTN
<0102> E6FA BE,A3,80 USSCRN ST    >13,V@>0380
       E6FD 13
<0103> E6FE 35,00,1F        MOVE  31,V@>0380,V@>0381
       E701 A3,81,A3
       E704 80
<0104> E705 07,20           ALL   SPACE
<0105> E707 00              RTN
<0106> E708 86,8F,7C CLRXOP CLR   @>FFD8
       E70B D8
<0107> E70C 35,00,05        MOVE  5,@>FFD8,@>FFD9
       E70F 8F,7C,D9
       E712 8F,7C,D8
<0108> E715 00              RTN
<0109>               *
<0110>               *  Main Menu Option 5: RUN PROGRAM FILE
<0111>               *
<0112> E716 07,20    PRGRM  ALL   SPACE
<0113> E718 08              FMT
<0114> E719 FF,06           COL   6
<0115> E71B FE,01           ROW   1
<0116> E71D 13,2A,20        HTEX  '* RUN PROGRAM FILE *'
       E720 52,55,4E
       E723 20,50,52
       E726 4F,47,52
       E729 41,4D,20
       E72C 46,49,4C
       E72F 45,20,2A
<0117> E732 FB              FEND
<0118> E733 D6,42,FF        CEQ   >FF,@XTOKEN
<0119> E736 47,44           BR    NOEABF
<0120> E738 35,00,40        MOVE  64,V@>2400,V@>2255
       E73B AF,22,55
       E73E AF,24,00
<0121> E741 BE,42,EA        ST    >EA,@XTOKEN
<0122> E744 06,ED,E2 NOEABF CALL  BINIT2              * INITILIZE LOW8K
<0123> E747 B6,49,08        OR    >08,@FLAG2
<0124> E74A BF,20,01        DST   >0102,@CURADD
       E74D 02
<0125> E74E 31,00,0A        MOVE  10,G@GE25B,V*CURADD * FILE NAME?
       E751 B0,20,E3
       E754 C5
<0126> E755 A3,20,00        DADD  >0040,@CURADD
       E758 40
<0127> E759 B6,48,04        OR    >04,@FLAG
<0128> E75C 06,E5,8B        CALL  GETINP
<0129> E75F D6,51,01        CEQ   1,@FAC7
<0130> E762 47,85           BR    NO1KEY
<0131> E764 BF,AF,24        DST   >000B,V@>2400
       E767 00,00,0B
<0132> E76A 31,00,05        MOVE  5,G@DDSK1,V@>2402
       E76D AF,24,02
       E770 E8,23
<0133> E772 BC,AF,24        ST    V*STLN,V@>2405
       E775 05,B0,24

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0015 
E/A GROM
<0134> E778 31,00,06        MOVE  6,G@DUTIL1,V@>2407
       E77B AF,24,07
       E77E EE,17
<0135> E780 BE,42,FF        ST    >FF,@XTOKEN
<0136> E783 47,16           BR    PRGRM
<0137> E785 8F,50    NO1KEY DCZ   @FAC6               * ENTER?
<0138> E787 47,93           BR    GE597               * No
<0139> E789 BE,44,31        ST    '1',@>8344          * Search flag
<0140> E78C 06,E7,AE MYSRCH CALL  LODPGM              * Load DATA
<0141> E78F EE,17           DATA  DUTIL1              * DSK1.UTIL1
<0142> E791 47,A2           BR    GE5A6
<0143> E793 06,E7,BB GE597  CALL  LODUSR
<0144> E796 06,E5,44        CALL  PABNAM
<0145> E799 D7,B0,4E        DCEQ  >4353,V*FAC4     * CS ??
       E79C 43,53
<0146> E79E 47,A2           BR    GE5A6            * ?????
<0147> E7A0 07,20           ALL   SPACE
<0148> E7A2 06,E7,D9 GE5A6  CALL  PGMLOD
<0149> E7A5 06,E6,FA        CALL  USSCRN
<0150> E7A8 0F,F0           XML   >F0
<0151> E7AA 6B,6F           BS    GE8E3
<0152> E7AC 4B,34           BR    GE8A8
<0153> E7AE 88,10    LODPGM FETCH @>8310
<0154> E7B0 88,11           FETCH @>8311
<0155> E7B2 33,00,05        MOVE  5,G@G0000(@>8310),V@>100F
       E7B5 AF,10,0F
       E7B8 00,00,10
<0156> E7BB 87,00    LODUSR DCLR  @>8300
<0157> E7BD BF,1C,10        DST   >1000,@PABPTR
       E7C0 00
<0158> E7C1 31,00,0F        MOVE  15,G@PAB,V*PABPTR
       E7C4 B0,1C,E8
       E7C7 19
<0159> E7C8 8E,44           CZ    @>8344               * Check Search flag
<0160> E7CA 67,D1           BS    PMSG                 * No, go on
<0161> E7CC BC,E0,0D        ST    @>8344,V@13(@PABPTR) * Yes, store next drive #
       E7CF 1C,44
<0162> E7D1 31,00,0F PMSG   MOVE  15,G@PLEASE,V@>02A2
       E7D4 A2,A2,E9
       E7D7 A8
<0163> E7D8 00              RTN
<0164>               *  Load Program
<0165> E7D9 06,E5,6A PGMLOD CALL  DOIO
<0166> E7DC 35,00,06        MOVE  6,V@>1380,@>8310
       E7DF 10,AF,13
       E7E2 80
<0167> E7E3 8F,00           DCZ   @>8300
<0168> E7E5 47,EA           BR    GE5E5
<0169> E7E7 BD,00,14        DST   @>8314,@>8300
<0170> E7EA A7,14,83 GE5E5  DSUB  >8300,@>8314
       E7ED 00
<0171> E7EE 34,12,C0        MOVE  @>8312,V@>1386,@>8300(@>8314)
       E7F1 00,14,AF
       E7F4 13,86
<0172> E7F6 8F,10           DCZ   @>8310
<0173> E7F8 68,0A           BS    GE605
<0174> E7FA 87,02           DCLR  @>8302
<0175> E7FC BC,03,AF        ST    V@>1009,@>8303
       E7FF 10,09
<0176> E801 A3,02,10        DADD  >1009,@>8302
       E804 09
<0177> E805 90,B0,02        INC   V*>8302
<0178> E808 47,D9           BR    PGMLOD
<0179> E80A BE,A2,A2 GE605  ST    SPACE,V@>02A2

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0016 
E/A GROM
       E80D 20
<0180> E80E 35,00,13        MOVE  19,V@>02A2,V@>02A3
       E811 A2,A3,A2
       E814 A2
<0181> E815 06,E5,7F        CALL  VZERO
<0182> E818 00              RTN
<0183> E819 05,00,13 PAB    BYTE  >05,>00,>13,>80,>00,>00,>21,>00
       E81C 80,00,00
       E81F 21,00
<0184> E821 00,0A    DLEN   BYTE  >00,>0A
<0185> E823 44,53,4B DDSK1  TEXT  'DSK1.'
       E826 31,2E
<0186> E828 45,44,49 DEDIT1 TEXT  'EDIT1'
       E82B 54,31
<0187>               ***********************************************************
<0188>               *
<0189>               * Main Menu Option 2: ASSEMBLER
<0190>               *
<0191> E82D 07,20    ASSEM  ALL   SPACE
<0192> E82F 08              FMT
<0193> E830 FF,0A       COL   10
<0194> E832 FE,01       ROW   1
<0195> E834 0C,2A,20    HTEX  '* ASSEMBLER *'
       E837 41,53,53
       E83A 45,4D,42
       E83D 4C,45,52
       E840 20,2A
<0196> E842 FB          FEND
<0197> E843 87,48           DCLR  @FLAG
<0198> E845 86,47           CLR   @LDFLAG
<0199> E847 BE,73,7E        ST    >7E,@SUBSTK
<0200> E84A B6,48,20        OR    >20,@FLAG
<0201> E84D D7,8F,9D        DCEQ  >AA55,@>2000
       E850 00,AA,55
<0202> E853 68,80           BS    GE687
<0203> E855 35,00,63        MOVE  99,V@>2250,@>EA00
       E858 8F,67,00
       E85B AF,22,50
<0204> E85E BC,8F,7C        ST    @XTOKEN,@>FFFB
       E861 FB,42
<0205> E863 86,42           CLR   @XTOKEN
<0206> E865 06,E7,AE        CALL  LODPGM
<0207> E868 EE,12           DATA  DASSM1
<0208> E86A 06,EE,3C        CALL  DEVICE
<0209> E86D D6,75,0F        CEQ   BACK,@KEY
<0210> E870 60,32           BS    CLREA
<0211> E872 BE,47,02        ST    2,@LDFLAG
<0212> E875 06,E7,D9 GE654  CALL  PGMLOD
<0213> E878 D7,8F,9D        DCEQ  >AA55,@>2000
       E87B 00,AA,55
<0214> E87E 48,2D           BR    ASSEM
<0215>               *  CALL FILES (4)
<0216> E880 BF,AF,13 GE687  DST   >0116,V@>1380
       E883 80,01,16
<0217> E886 BF,56,13        DST   >1380,@VPAB
       E889 80
<0218> E88A BE,4C,04        ST    >04,@FAC2
<0219> E88D 06,00,10        CALL  DSRLNK
<0220> E890 0A              BYTE  >0A
<0221> E891 35,00,63        MOVE  99,@>EA00,V@>2250
       E894 AF,22,50
       E897 8F,67,00
<0222> E89A BC,42,8F        ST    @>FFFB,@XTOKEN
       E89D 7C,FB

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0017 
E/A GROM
<0223> E89F 07,20           ALL   32
<0224> E8A1 08              FMT
<0225> E8A2 FF,0A           COL   10
<0226> E8A4 FE,01           ROW   1
<0227> E8A6 0C,2A,20        HTEX  '* ASSEMBLER *'
       E8A9 41,53,53
       E8AC 45,4D,42
       E8AF 4C,45,52
       E8B2 20,2A
<0228> E8B4 FF,02           COL   2
<0229> E8B6 FE,04           ROW   4
<0230> E8B8 10,53,6F        HTEX  'Source File Name?'
       E8BB 75,72,63
       E8BE 65,20,46
       E8C1 69,6C,65
       E8C4 20,4E,61
       E8C7 6D,65,3F
<0231> E8CA FB              FEND
<0232> E8CB BF,1C,10        DST   >1000,@PABPTR
       E8CE 00
<0233> E8CF BF,20,00        DST   >00C2,@CURADD
       E8D2 C2
<0234> E8D3 06,E5,20        CALL  BLDPAB
<0235> E8D6 D6,75,0F        CEQ   BACK,@KEY        * BACK?
<0236> E8D9 60,32           BS    CLREA
<0237> E8DB BF,E0,02        DST   >1080,V@>0002(@PABPTR)
       E8DE 1C,10,80
<0238> E8E1 06,E3,E5        CALL  GE27B
<0239> E8E4 86,42           CLR   @XTOKEN
<0240> E8E6 08              FMT
<0241> E8E7 FF,02           COL   2
<0242> E8E9 FE,08           ROW   8
<0243> E8EB 10,4F,62        HTEX  'Object File Name?'
       E8EE 6A,65,63
       E8F1 74,20,46
       E8F4 69,6C,65
       E8F7 20,4E,61
       E8FA 6D,65,3F
<0244> E8FD FB              FEND
<0245> E8FE BF,1C,11        DST   >1100,@PABPTR
       E901 00
<0246> E902 BF,20,01        DST   >0142,@CURADD
       E905 42
<0247> E906 06,E5,20        CALL  BLDPAB
<0248> E909 BE,E0,01        ST    >00,V@>0001(@PABPTR)
       E90C 1C,00
<0249> E90E BF,E0,02        DST   >1180,V@>0002(@PABPTR)
       E911 1C,11,80
<0250> E914 06,E5,6A        CALL  DOIO
<0251> E917 B6,48,40        OR    >40,@FLAG
<0252> E91A 08              FMT
<0253> E91B FF,02           COL   2
<0254> E91D FE,0C           ROW   12
<0255> E91F 0E,4C,69        HTEX  'List File Name?'
       E922 73,74,20
       E925 46,69,6C
       E928 65,20,4E
       E92B 61,6D,65
       E92E 3F
<0256> E92F FB              FEND
<0257> E930 BF,1C,12        DST   >1200,@PABPTR
       E933 00
<0258> E934 B6,48,04        OR    >04,@FLAG
<0259> E937 BF,20,01        DST   >01C2,@CURADD

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0018 
E/A GROM
       E93A C2
<0260> E93B 06,E5,20        CALL  BLDPAB
<0261> E93E 8F,50           DCZ   @FAC6
<0262> E940 69,53           BS    GE736
<0263> E942 BE,E0,01        ST    >12,V@>0001(@PABPTR)
       E945 1C,12
<0264> E947 BF,E0,02        DST   >1280,V@>0002(@PABPTR)
       E94A 1C,12,80
<0265> E94D 06,E5,6A        CALL  DOIO
<0266> E950 B6,48,80        OR    >80,@FLAG
<0267> E953 08       GE736  FMT
<0268> E954 FF,02           COL   2
<0269> E956 FE,10           ROW   16
<0270> E958 07,4F,70        HTEX  'Options?'
       E95B 74,69,6F
       E95E 6E,73,3F
<0271> E961 FB              FEND
<0272> E962 BF,20,02        DST   >0242,@CURADD
       E965 42
<0273> E966 06,E5,8B        CALL  GETINP
<0274> E969 B2,48,FB        AND   >FB,@FLAG
<0275> E96C 8F,50           DCZ   @FAC6
<0276> E96E 49,73           BR    GE756
<0277> E970 BD,4E,20        DST   @CURADD,@FAC4
<0278> E973 35,00,0F GE756  MOVE  15,V*FAC4,@>20D2
       E976 8F,9D,D2
       E979 B0,4E
<0279> E97B 06,E7,08        CALL  CLRXOP
<0280> E97E 07,20           ALL   SPACE
<0281> E980 0F,21           XML   >21
<0282> E982 6B,3F           BS    GE8B3
<0283> E984 06,E7,08 GE767  CALL  CLRXOP
<0284> E987 BF,1C,10        DST   >1000,@PABPTR
       E98A 00
<0285> E98B 06,E5,66        CALL  CLOSE
<0286> E98E BF,1C,11        DST   >1100,@PABPTR
       E991 00
<0287> E992 06,E5,66        CALL  CLOSE
<0288> E995 DA,48,80        CLOG  >80,@FLAG
<0289> E998 69,A1           BS    GE784
<0290> E99A BF,1C,12        DST   >1200,@PABPTR
       E99D 00
<0291> E99E 06,E5,66        CALL  CLOSE
<0292> E9A1 86,48    GE784  CLR   @FLAG
<0293> E9A3 06,EC,C4        CALL  WENTER
<0294> E9A6 40,28           BR    OLDEA
<0295> E9A8 50,6C,65 PLEASE TEXT  'Please wait ...'
       E9AB 61,73,65
       E9AE 20,77,61
       E9B1 69,74,20
       E9B4 2E,2E,2E
<0296>               *  Get Yes/No reply
<0297> E9B7 BE,18,1F YESNO  ST    >1F,@CHRCUR
<0298> E9BA 86,79    GE7A2  CLR   @ITIMER
<0299> E9BC C0,18,7D        EX    @VCHAR,@CHRCUR
<0300> E9BF BE,74,03 GE7A7  ST    >03,@KBNO
<0301> E9C2 03              SCAN
<0302> E9C3 69,CC           BS    GE7B1
<0303> E9C5 CA,79,06        CHE   >06,@ITIMER
<0304> E9C8 49,BF           BR    GE7A7
<0305> E9CA 49,BA           BR    GE7A2
<0306> E9CC D6,75,0F GE7B1  CEQ   BACK,@KEY
<0307> E9CF 69,DB           BS    GE7C0
<0308> E9D1 D6,75,59        CEQ   >59,@KEY

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0019 
E/A GROM
<0309> E9D4 69,DB           BS    GE7C0
<0310> E9D6 D6,75,4E        CEQ   >4E,@KEY
<0311> E9D9 49,BA           BR    GE7A2
<0312> E9DB BC,7D,75 GE7C0  ST    @KEY,@VCHAR
<0313> E9DE BE,74,05        ST    >05,@KBNO
<0314> E9E1 86,42           CLR   @XTOKEN
<0315> E9E3 00              RTN
<0316>               *
<0317>               *  Main Menu Option 3: LOAD AND RUN
<0318>               *
<0319> E9E4 87,48    LANDR  DCLR  @FLAG
<0320> E9E6 B6,49,01        OR    >01,@FLAG2
<0321> E9E9 07,20           ALL   SPACE
<0322> E9EB 08              FMT
<0323> E9EC FF,08           COL   8
<0324> E9EE FE,00           ROW   0
<0325> E9F0 0F,2A,20        HTEX  '* LOAD and RUN *'
       E9F3 4C,4F,41
       E9F6 44,20,61
       E9F9 6E,64,20
       E9FC 52,55,4E
       E9FF 20,2A
<0326> EA01 89              COL+  10
<0327> EA02 A1              ROW+  2
<0328> EA03 09,46,49        HTEX  'FILE NAME?'
       EA06 4C,45,20
       EA09 4E,41,4D
       EA0C 45,3F
<0329> EA0E FB              FEND
<0330> EA0F 06,E6,BA        CALL  EXPMEM
<0331> EA12 B6,49,40        OR    >40,@FLAG2
<0332> EA15 BE,A0,A2 GE7F2  ST    SPACE,V@162
       EA18 20
<0333> EA19 35,00,3B        MOVE  >003B,V@162,V@163
       EA1C A0,A3,A0
       EA1F A2
<0334> EA20 BF,20,00        DST   162,@CURADD
       EA23 A2
<0335> EA24 B6,48,04        OR    >04,@FLAG
<0336> EA27 BF,1C,10        DST   >1000,@PABPTR
       EA2A 00
<0337> EA2B 06,E5,1D        CALL  GETALL
<0338> EA2E 86,42           CLR   @XTOKEN
<0339> EA30 8F,50           DCZ   @FAC6
<0340> EA32 4A,3B           BR    GE816
<0341> EA34 06,ED,E2        CALL  BINIT2
<0342> EA37 4A,59           BR    RUN
<0343> EA39 4A,46           BR    GE821
<0344> EA3B DA,49,40 GE816  CLOG  >40,@FLAG2
<0345> EA3E 6A,46           BS    GE821
<0346> EA40 06,ED,EA        CALL  BINIT3
<0347> EA43 B2,49,BF        AND   >BF,@FLAG2
<0348> EA46 BE,E0,01 GE821  ST    >04,V@>0001(@PABPTR)
       EA49 1C,04
<0349> EA4B BD,56,1C GE826  DST   @PABPTR,@VPAB
<0350> EA4E A3,56,00        DADD  >0009,@VPAB
       EA51 09
<0351> EA52 0F,22           XML   >22
<0352> EA54 6B,3F           BS    GE8B3
<0353> EA56 05,EA,15        B     GE7F2
<0354>               *
<0355>               *  Main Menu Option 4: RUN
<0356>               *
<0357> EA59 07,20    RUN    ALL   SPACE

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0020 
E/A GROM
<0358> EA5B BE,73,7E GE848  ST    >7E,@SUBSTK
<0359> EA5E 08              FMT
<0360> EA5F FE,00           ROW   0
<0361> EA61 FF,02           COL   2
<0362> EA63 06,2A,20        HTEX  '* RUN *'
       EA66 52,55,4E
       EA69 20,2A
<0363> EA6B A1              ROW+  2
<0364> EA6C FF,02           COL   2
<0365> EA6E 0C,50,52        HTEX  'PROGRAM NAME?'
       EA71 4F,47,52
       EA74 41,4D,20
       EA77 4E,41,4D
       EA7A 45,3F
<0366> EA7C FB              FEND
<0367> EA7D 06,E6,BA        CALL  EXPMEM
<0368> EA80 86,42           CLR   @XTOKEN
<0369> EA82 BF,06,00        DST   194,@>8306       * Screen location LOCATION
       EA85 C2
<0370> EA86 BF,08,3F        DST   >3FF8,@>8308     * Locataion of LINK TABLE
       EA89 F8
<0371> EA8A BD,02,08 FNDLNK DST   @>8308,@>8302    * Copy it.
<0372> EA8D BE,04,06        ST    6,@>8304         * Length of each name.
<0373> EA90 CA,CF,7D FNDLP  CHE   128,@0(@>8302)   * ~?
       EA93 00,02,80
<0374> EA96 6A,ED           BS    FNDDON           * Yes, done.
<0375> EA98 CA,CF,7D        CHE   32,@0(@>8302)    * Space or higher?
       EA9B 00,02,20
<0376> EA9E 4A,ED           BR    FNDDON           * No, done.
<0377> EAA0 D6,CF,7D        CEQ   32,@0(@>8302)    * Space?
       EAA3 00,02,20
<0378> EAA6 4A,AD           BR    FNDSHO           * No.
<0379> EAA8 D6,04,06        CEQ   6,@>8304         * 6?
<0380> EAAB 6A,ED           BS    FNDDON           * Yes.
<0381> EAAD BC,E0,00 FNDSHO ST    @0(@>8302),V@0(@>8306)
       EAB0 06,CF,7D
       EAB3 00,02
<0382> EAB5 91,06           DINC  @>8306           * COL+1
<0383> EAB7 CB,06,03        DCHE  768,@>8306       * End of screen?
       EABA 00
<0384> EABB 4A,DC           BR    MORSCN
<0385> EABD 31,00,14        MOVE  20,G@OUTSCN,V@>8
       EAC0 A0,08,EA
       EAC3 CA
<0386> EAC4 06,00,36        CALL  BADTON
<0387> EAC7 05,EA,ED        B     FNDDON
<0388> EACA 2A,20,37 OUTSCN TEXT  '* 72 NAMES SHOWN *'
       EACD 32,20,4E
       EAD0 41,4D,45
       EAD3 53,20,53
       EAD6 48,4F,57
       EAD9 4E,20,2A
<0389> EADC 91,02    MORSCN DINC  @>8302           * Next character.
<0390> EADE 92,04           DEC   @>8304           * Length-1
<0391> EAE0 4A,90           BR    FNDLP            * No, keep looping.
<0392> EAE2 95,06           DINCT @>8306           * Reset next column
<0393> EAE4 A7,08,00        DSUB  8,@>8308         * Link Table Address+8
       EAE7 08
<0394> EAE8 D6,08,00        CEQ   >2600,@>8308     * Last Table name?
<0395> EAEB 4A,8A           BR    FNDLNK           * No
<0396> EAED BF,20,00 FNDDON DST   130,@CURADD      * Yes, screen input address
       EAF0 82
<0397> EAF1 B6,48,04        OR    >04,@FLAG
<0398> EAF4 06,E5,8B        CALL  GETINP

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0021 
E/A GROM
<0399> EAF7 8F,50           DCZ   @FAC6
<0400> EAF9 6B,11           BS    GE883
<0401> EAFB BD,20,4E        DST   @FAC4,@CURADD
<0402> EAFE C7,50,00        DCH   >0006,@FAC6
       EB01 06
<0403> EB02 6B,CB           BS    GE944
<0404> EB04 BE,4A,20        ST    SPACE,@FAC
<0405> EB07 35,00,05        MOVE  5,@FAC,@FAC1
       EB0A 4B,4A
<0406> EB0C 34,50,4A        MOVE  @FAC6,V*CURADD,@FAC
       EB0F B0,20
<0407> EB11 D7,8F,9D GE883  DCEQ  >A55A,@>2000
       EB14 00,A5,5A
<0408> EB17 4B,9D           BR    GE916
<0409> EB19 06,E6,FA        CALL  USSCRN
<0410> EB1C 87,22    GE88E  DCLR  @CODE
<0411> EB1E 0F,21           XML   >21
<0412> EB20 6B,6F           BS    GE8E3
<0413> EB22 DA,49,20        CLOG  >20,@FLAG2
<0414> EB25 6B,31           BS    GE8A3
<0415> EB27 94,73           INCT  @SUBSTK
<0416> EB29 BF,90,73        DST   GE88E,*SUBSTK
       EB2C EB,1C
<0417> EB2E 94,73           INCT  @SUBSTK
<0418> EB30 00              RTN
<0419> EB31 05,EB,34 GE8A3  B     GE8A8
<0420> EB34 06,E6,E1 GE8A8  CALL  EASCRN
<0421> EB37 06,EC,C4        CALL  WENTER
<0422> EB3A 40,3B           BR    GE029
<0423> EB3C 06,E6,E1 GE8B0  CALL  EASCRN
<0424> EB3F 06,EB,88 GE8B3  CALL  GE8FC
<0425> EB42 CA,22,08        CHE   >08,@CODE
<0426> EB45 4B,E4           BR    CHKERR
<0427> EB47 A6,22,08        SUB   >08,@CODE
<0428> EB4A C6,22,05        CH    >05,@CODE
<0429> EB4D 6B,60           BS    GE8D4
<0430> EB4F 06,EC,30        CALL  CLSALL
<0431> EB52 8A,22           CASE  @CODE
<0432> EB54 4B,96           BR    GE90F
<0433> EB56 4B,8F           BR    GE908
<0434> EB58 4B,AF           BR    GE928
<0435> EB5A 4B,B6           BR    GE92F
<0436> EB5C 4B,BD           BR    GE936
<0437> EB5E 4B,C4           BR    GE93D
<0438> EB60 DA,48,20 GE8D4  CLOG  >20,@FLAG
<0439> EB63 49,84           BR    GE767
<0440> EB65 DA,49,01        CLOG  >01,@FLAG2
<0441> EB68 49,E4           BR    LANDR
<0442> EB6A 06,EC,4D        CALL  CLSPAB
<0443> EB6D 42,46           BR    EDITOR
<0444> EB6F 06,EB,88 GE8E3  CALL  GE8FC
<0445> EB72 06,E6,E1        CALL  EASCRN
<0446> EB75 D6,22,0F        CEQ   >0F,@CODE
<0447> EB78 4B,81           BR    GE8F5
<0448> EB7A 06,EC,6D        CALL  ERRMSG
<0449> EB7D ED,B2           DATA  ERRPNF
<0450> EB7F 4B,D0           BR    GE949
<0451> EB81 06,EC,6D GE8F5  CALL  ERRMSG
<0452> EB84 ED,48           DATA  ERRC
<0453> EB86 40,3B           BR    GE029
<0454> EB88 39,00,01 GE8FC  MOVE  1,G@GE271,#1
       EB8B 01,E3,DB
<0455> EB8E 00       GE907  RTN
<0456> EB8F 06,EC,61 GE908  CALL  WRNMSG

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0022 
E/A GROM
<0457> EB92 ED,53           DATA  CCRMSG
<0458> EB94 4B,60           BR    GE8D4
<0459> EB96 06,EC,6D GE90F  CALL  ERRMSG
<0460> EB99 ED,0B           DATA  ERRMF
<0461> EB9B 4B,60           BR    GE8D4
<0462> EB9D 06,EC,6D GE916  CALL  ERRMSG
<0463> EBA0 ED,B2           DATA  ERRPNF
<0464> EBA2 40,28           BR    OLDEA
<0465> EBA4 DA,48,08 GE91D  CLOG  >08,@FLAG
<0466> EBA7 4B,A9           BR    GE9E2
<0467> EBA9 06,EC,6D GE9E2  CALL  ERRMSG
<0468> EBAC ED,26           DATA  ERRNME
<0469> EBAE 0B              EXIT
<0470> EBAF 06,EC,6D GE928  CALL  ERRMSG
<0471> EBB2 ED,6D           DATA  ERRIT
<0472> EBB4 49,E4           BR    LANDR
<0473> EBB6 06,EC,6D GE92F  CALL  ERRMSG
<0474> EBB9 ED,79           DATA  ERRCE
<0475> EBBB 49,E4           BR    LANDR
<0476> EBBD 06,EC,6D GE936  CALL  ERRMSG
<0477> EBC0 ED,88           DATA  ERRDD
<0478> EBC2 49,E4           BR    LANDR
<0479> EBC4 06,EC,6D GE93D  CALL  ERRMSG
<0480> EBC7 ED,9D           DATA  ERRUR
<0481> EBC9 49,E4           BR    LANDR
<0482> EBCB 06,EC,6D GE944  CALL  ERRMSG
<0483> EBCE ED,3A           DATA  ERRNTL
<0484> EBD0 8F,50    GE949  DCZ   @FAC6
<0485> EBD2 6B,DF           BS    GE958
<0486> EBD4 BE,B0,4E        ST    SPACE,V*FAC4
       EBD7 20
<0487> EBD8 34,50,E0        MOVE  @FAC6,V*FAC4,V@>0001(@FAC4)
       EBDB 01,4E,B0
       EBDE 4E
<0488> EBDF 06,EC,D4 GE958  CALL  CLRMSG
<0489> EBE2 4A,5B           BR    GE848
[0006]               ***********************************************************
[0007]                      COPY 'DSK5.MYXB7-C'
<0001> EBE4 8E,44    CHKERR CZ    @>8344           * Check Search flag
<0002> EBE6 6B,EF           BS    CHKER2           * Yes, normal error
<0003> EBE8 90,44           INC   @>8344           * Drive # + 1
<0004> EBEA D6,44,3A        CEQ   58,@>8344        * Last drive?
<0005> EBED 47,8C           BR    MYSRCH           * No, continue Search
<0006> EBEF BC,4E,E0 CHKER2 ST    V@>0001(@PABPTR),@FAC4
       EBF2 01,1C
<0007> EBF4 B2,4E,E0        AND   >E0,@FAC4
<0008> EBF7 E6,4E,05        SRL   >05,@FAC4
<0009> EBFA B6,4E,30        OR    >30,@FAC4
<0010> EBFD B2,E0,01        AND   >1F,V@>0001(@PABPTR)
       EC00 1C,1F
<0011> EC02 D6,4E,35        CEQ   >35,@FAC4        Error Read past EOF
<0012> EC05 4C,0D           BR    GE97A
<0013> EC07 06,EC,30        CALL  CLSALL
<0014> EC0A 05,E2,46        B     EDITOR
<0015> EC0D 06,EC,6D GE97A  CALL  ERRMSG
<0016> EC10 ED,17           DATA  ERRIOC
<0017> EC12 D6,47,01        CEQ   1,@LDFLAG
<0018> EC15 62,46           BS    EDITOR
<0019> EC17 D6,47,02        CEQ   2,@LDFLAG
<0020> EC1A 68,2D           BS    ASSEM
<0021> EC1C 06,EC,30 GE97F  CALL  CLSALL
<0022> EC1F DA,48,20        CLOG  >20,@FLAG
<0023> EC22 40,28           BR    OLDEA
<0024> EC24 DA,49,01        CLOG  >01,@FLAG2

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0023 
E/A GROM
<0025> EC27 49,E4           BR    LANDR
<0026> EC29 DA,49,08        CLOG  >08,@FLAG2
<0027> EC2C 40,28           BR    OLDEA
<0028> EC2E 42,46           BR    EDITOR
<0029> EC30 BF,1C,10 CLSALL DST   >1000,@PABPTR
       EC33 00
<0030> EC34 06,EC,4D        CALL  CLSPAB
<0031> EC37 BF,1C,11        DST   >1100,@PABPTR
       EC3A 00
<0032> EC3B 06,EC,4D        CALL  CLSPAB
<0033> EC3E BF,1C,12        DST   >1200,@PABPTR
       EC41 00
<0034> EC42 06,EC,4D        CALL  CLSPAB
<0035> EC45 BF,1C,13        DST   >1300,@PABPTR
       EC48 00
<0036> EC49 06,EC,4D        CALL  CLSPAB
<0037> EC4C 00              RTN
<0038> EC4D BD,56,1C CLSPAB DST   @PABPTR,@VPAB
<0039> EC50 A3,56,00        DADD  >0009,@VPAB
       EC53 09
<0040> EC54 BE,B0,1C        ST    >01,V*PABPTR
       EC57 01
<0041> EC58 06,00,10        CALL  DSRLNK
<0042> EC5B 08              BYTE  >08
<0043> EC5C 86,E0,09        CLR   V@>0009(@PABPTR)
       EC5F 1C
<0044> EC60 00              RTN
<0045> EC61 06,EC,D4 WRNMSG CALL  CLRMSG
<0046> EC64 31,00,0B        MOVE  11,G@WARN,V@>02A2
       EC67 A2,A2,ED
       EC6A 00
<0047> EC6B 4C,77           BR    GE9DA
<0048> EC6D 06,EC,D4 ERRMSG CALL  CLRMSG
<0049> EC70 31,00,09        MOVE  9,G@ERROR,V@>02A2
       EC73 A2,A2,EC
       EC76 E0
<0050> EC77 88,4A    GE9DA  FETCH @FAC
<0051> EC79 88,4B           FETCH @FAC1
<0052> EC7B 86,4C           CLR   @FAC2
<0053> EC7D 33,00,01        MOVE  1,G@G0000(@FAC),@FAC3
       EC80 4D,00,00
       EC83 4A
<0054> EC84 32,4C,A2        MOVE  @FAC2,G@G0001(@FAC),V@>02C2
       EC87 C2,00,01
       EC8A 4A
<0055> EC8B D7,4A,ED        DCEQ  ERRIOC,@FAC
       EC8E 17
<0056> EC8F 4C,95           BR    GE9F8
<0057> EC91 BC,A2,D2        ST    @FAC4,V@>02D2
       EC94 4E
<0058> EC95 D7,4A,ED GE9F8  DCEQ  ERRC,@FAC
       EC98 48
<0059> EC99 4C,C4           BR    WENTER
<0060> EC9B E7,22,00        DSRL  >0004,@CODE
       EC9E 04
<0061> EC9F E6,23,04        SRL   >04,@>8323
<0062> ECA2 C6,22,09        CH    >09,@CODE
<0063> ECA5 4C,AF           BR    GEA12
<0064> ECA7 C6,22,0F        CH    >0F,@CODE
<0065> ECAA 6C,C4           BS    WENTER
<0066> ECAC A2,22,07        ADD   >07,@CODE
<0067> ECAF C6,23,09 GEA12  CH    >09,@>8323
<0068> ECB2 4C,BC           BR    GEA1F
<0069> ECB4 C6,23,0F        CH    >0F,@>8323

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0024 
E/A GROM
<0070> ECB7 6C,C4           BS    WENTER
<0071> ECB9 A2,23,07        ADD   >07,@>8323
<0072> ECBC A3,22,30 GEA1F  DADD  >3030,@CODE
       ECBF 30
<0073> ECC0 BD,A2,D0        DST   @CODE,V@>02D0
       ECC3 22
<0074>               *  Wait for ENTER
<0075> ECC4 31,00,17 WENTER MOVE  23,G@PRESS,V@>02E2
       ECC7 A2,E2,EC
       ECCA E9
<0076> ECCB 03       GEA2E  SCAN
<0077> ECCC 4C,CB           BR    GEA2E
<0078> ECCE D6,75,0D        CEQ   >0D,@KEY
<0079> ECD1 4C,CB           BR    GEA2E
<0080> ECD3 00              RTN
<0081> ECD4 BE,A2,A0 CLRMSG ST    SPACE,V@>02A0
       ECD7 20
<0082> ECD8 35,00,5F        MOVE  >005F,V@>02A0,V@>02A1
       ECDB A2,A1,A2
       ECDE A0
<0083> ECDF 00              RTN
<0084> ECE0 2A,20,45 ERROR  TEXT  '* ERROR *'
       ECE3 52,52,4F
       ECE6 52,20,2A
<0085> ECE9 50,72,65 PRESS  TEXT  'Press ENTER to continue'
       ECEC 73,73,20
       ECEF 45,4E,54
       ECF2 45,52,20
       ECF5 74,6F,20
       ECF8 63,6F,6E
       ECFB 74,69,6E
       ECFE 75,65
<0086> ED00 2A,20,57 WARN   TEXT  '* WARNING *'
       ED03 41,52,4E
       ED06 49,4E,47
       ED09 20,2A
<0087> ED0B 0B,4D,45 ERRMF  STRI  'MEMORY FULL'
       ED0E 4D,4F,52
       ED11 59,20,46
       ED14 55,4C,4C
<0088> ED17 0E,49,2F ERRIOC STRI  'I/O ERROR CODE'
       ED1A 4F,20,45
       ED1D 52,52,4F
       ED20 52,20,43
       ED23 4F,44,45
<0089> ED26 13,4E,4F ERRNME STRI  'NO MEMORY EXPANSION'
       ED29 20,4D,45
       ED2C 4D,4F,52
       ED2F 59,20,45
       ED32 58,50,41
       ED35 4E,53,49
       ED38 4F,4E
<0090> ED3A 0D,4E,41 ERRNTL STRI  'NAME TOO LONG'
       ED3D 4D,45,20
       ED40 54,4F,4F
       ED43 20,4C,4F
       ED46 4E,47
<0091> ED48 0A,45,52 ERRC   STRI  'ERROR CODE'
       ED4B 52,4F,52
       ED4E 20,43,4F
       ED51 44,45
<0092> ED53 19,43,4F CCRMSG STRI  'CONTROL CHARACTER REMOVED'
       ED56 4E,54,52
       ED59 4F,4C,20

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0025 
E/A GROM
       ED5C 43,48,41
       ED5F 52,41,43
       ED62 54,45,52
       ED65 20,52,45
       ED68 4D,4F,56
       ED6B 45,44
<0093> ED6D 0B,49,4C ERRIT  STRI  'ILLEGAL TAG'
       ED70 4C,45,47
       ED73 41,4C,20
       ED76 54,41,47
<0094> ED79 0E,43,48 ERRCE  STRI  'CHECKSUM ERROR'
       ED7C 45,43,4B
       ED7F 53,55,4D
       ED82 20,45,52
       ED85 52,4F,52
<0095> ED88 14,44,55 ERRDD  STRI  'DUPLICATE DEFINITION'
       ED8B 50,4C,49
       ED8E 43,41,54
       ED91 45,20,44
       ED94 45,46,49
       ED97 4E,49,54
       ED9A 49,4F,4E
<0096> ED9D 14,55,4E ERRUR  STRI  'UNRESOLVED REFERENCE'
       EDA0 52,45,53
       EDA3 4F,4C,56
       EDA6 45,44,20
       EDA9 52,45,46
       EDAC 45,52,45
       EDAF 4E,43,45
<0097> EDB2 11,50,52 ERRPNF STRI  'PROGRAM NOT FOUND'
       EDB5 4F,47,52
       EDB8 41,4D,20
       EDBB 4E,4F,54
       EDBE 20,46,4F
       EDC1 55,4E,44
<0098> EDC4 FF,FF,FF CUREDP BYTE  >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF
       EDC7 FF,FF,FF
       EDCA FF,FF
<0099> EDCC 81,00,00 CURPAT BYTE  >81,>00,>00,>00,>00,>00,>00,>81
       EDCF 00,00,00
       EDD2 00,81
<0100> EDD4 84,00,00        BYTE  >84,>00,>00,>00,>00,>00,>00,>84
       EDD7 00,00,00
       EDDA 00,84
<0101> EDDC E0,00,0E VREGS  BYTE  >E0,>00,>0E,>01,>06,>00
       EDDF 01,06,00
<0102>               *
<0103>               *  CALL INIT
<0104>               *
<0105> EDE2 D7,8F,9D BINIT2 DCEQ  >A55A,@>2000
       EDE5 00,A5,5A
<0106> EDE8 6E,11           BS    GEBBD
<0107> EDEA 06,E6,BA BINIT3 CALL  EXPMEM
<0108> EDED BE,4A,03        ST    >03,@FAC
<0109> EDF0 BF,4C,EF        DST   GF000,@FAC2
       EDF3 94
<0110> EDF4 33,00,04 GEBA0  MOVE  4,G@G0000(@FAC2),@FAC4
       EDF7 4E,00,00
       EDFA 4C
<0111> EDFB A3,4C,00        DADD  >0004,@FAC2
       EDFE 04
<0112> EDFF 32,4E,CF        MOVE  @FAC4,G@G0000(@FAC2),@0(@FAC6)
       EE02 7D,00,50
       EE05 00,00,4C

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0026 
E/A GROM
<0113> EE08 A1,4C,4E        DADD  @FAC4,@FAC2
<0114> EE0B 92,4A           DEC   @FAC
<0115> EE0D 4D,F4           BR    GEBA0
<0116> EE0F 47,08           BR    CLRXOP
<0117> EE11 00       GEBBD  RTN
<0118>                
<0119> EE12 41,53,53 DASSM1 TEXT  'ASSM1'
       EE15 4D,31
<0120> EE17 55,54,49 DUTIL1 TEXT  'UTIL1'
       EE1A 4C,31
<0121> EE1C 0D              BYTE  >0D
<0122> EE1D 4C,4F,41 DLOAD  TEXT  'LOAD'
       EE20 44
<0123> EE21 0D              BYTE  >0D
<0124>               * NEW PATCH STUFF *****************************************
<0125>                
<0126> EE22 86,AF,10 BUGS   CLR   V@>1000          * CLEAR PAB AREAS
       EE25 00
<0127> EE26 35,03,80        MOVE  >0380,V@>1000,V@>1001
       EE29 AF,10,01
       EE2C AF,10,00
<0128> EE2F B2,80,C2        AND   >EF,@>83C2
       EE32 EF
<0129> EE33 00              RTN
<0130>               *******************************
<0131> EE34 86,4A    CLRFAC CLR   @FAC
<0132> EE36 35,00,07        MOVE  7,@FAC,@FAC1
       EE39 4B,4A
<0133> EE3B 00              RTN
<0134>               *******************************
<0135> EE3C 06,E6,BA DEVICE CALL  EXPMEM                Clear expansion memory
<0136> EE3F 35,00,80        MOVE  128,V@>027F,V@>0280
       EE42 A2,80,A2
       EE45 7F
<0137> EE46 BC,06,75        ST    @KEY,@>8306           Save key
<0138> EE49 08              FMT
<0139> EE4A FE,10           ROW   16
<0140> EE4C FF,02           COL   2
<0141> EE4E 0B,53,65        HTEX  'Select DSK#.'
       EE51 6C,65,63
       EE54 74,20,44
       EE57 53,4B,23
       EE5A 2E
<0142> EE5B FB              FEND
<0143> EE5C 35,00,05        MOVE  5,V@>100F,V@>020E     EDIT1 or ASSM1
       EE5F A2,0E,AF
       EE62 10,0F
<0144> EE64 03       DEV1   SCAN                        KEY?
<0145> EE65 4E,64           BR    DEV1                  No.
<0146> EE67 D6,75,20        CEQ   SPACE,@KEY            SPACE BAR?
<0147> EE6A 6E,81           BS    DEV4                  Yes
<0148> EE6C D6,75,0F        CEQ   BACK,@KEY             BACK?
<0149> EE6F 6E,80           BS    DEV3                  Yes
<0150> EE71 BC,A2,0C        ST    @KEY,V@>020C          Any other key SAVE
       EE74 75
<0151> EE75 BC,AF,10        ST    @KEY,V@>100D          Put into PAB
       EE78 0D,75
<0152> EE7A BC,75,06 DEVNO  ST    @>8306,@KEY           Restore old key
<0153> EE7D 06,E7,D1 DEV2   CALL  PMSG                  PLEASE WAIT...
<0154> EE80 00       DEV3   RTN
<0155> EE81 08       DEV4   FMT
<0156> EE82 FE,10           ROW   16
<0157> EE84 FF,02           COL   2
<0158> EE86 10,45,78        HTEX  'Example: WDS1.EA.'

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0027 
E/A GROM
       EE89 61,6D,70
       EE8C 6C,65,3A
       EE8F 20,57,44
       EE92 53,31,2E
       EE95 45,41,2E
<0159> EE98 FE,12           ROW   18
<0160> EE9A FF,02           COL   2
<0161> EE9C 0E,46,55        HTEX  'FULL PATH NAME?'
       EE9F 4C,4C,20
       EEA2 50,41,54
       EEA5 48,20,4E
       EEA8 41,4D,45
       EEAB 3F
<0162> EEAC FB              FEND
<0163> EEAD 35,00,05        MOVE  5,V@>100F,V@>0213     EDIT1 or ASSM1
       EEB0 A2,13,AF
       EEB3 10,0F
<0164> EEB5 BF,20,02        DST   >0282,@CURADD
       EEB8 82
<0165> EEB9 86,44           CLR   @>8344                Clear search flag
<0166> EEBB B6,48,04        OR    >04,@FLAG             Set return flag
<0167> EEBE 06,E5,8B        CALL  GETINP
<0168> EEC1 BD,00,20        DST   @CURADD,@>8300
<0169> EEC4 A6,01,82        SUB   >82,@>8301
<0170> EEC7 BC,AF,10        ST    @>8301,V@>1009
       EECA 09,01
<0171> EECC 34,00,AF        MOVE  @>8300,V@>0282,V@>100A
       EECF 10,0A,A2
       EED2 82
<0172> EED3 BE,48,20        ST    >20,@FLAG
<0173> EED6 05,EE,7A        B     DEVNO
<0174>               ********************************************
<0175> EED9 07,20    XBINP  ALL   SPACE
<0176> EEDB BE,4A,01        ST    1,@FAC
<0177> EEDE 08       XBAGN  FMT
<0178> EEDF FF,08            COL   8
<0179> EEE1 FE,01            ROW   1
<0180> EEE3 08,2A,20         HTEX  '* R X B *'
       EEE6 52,20,58
       EEE9 20,42,20
       EEEC 2A
<0181> EEED A3               ROW+  4
<0182> EEEE FF,02            COL   2
<0183> EEF0 09,46,49         HTEX  'FILE NAME?'
       EEF3 4C,45,20
       EEF6 4E,41,4D
       EEF9 45,3F
<0184> EEFB FB              FEND
<0185> EEFC 92,4A           DEC   @FAC
<0186> EEFE 4E,DE           BR    XBAGN
<0187> EF00 D6,42,FF        CEQ   >FF,@XTOKEN
<0188> EF03 4F,11           BR    XBINP1
<0189> EF05 35,00,40        MOVE  64,V@>2400,V@>2255
       EF08 AF,22,55
       EF0B AF,24,00
<0190> EF0E BE,42,EA        ST    >EA,@XTOKEN
<0191> EF11 BF,20,01 XBINP1 DST   >0102,@CURADD
       EF14 02
<0192> EF15 BF,1C,10        DST   >1000,@PABPTR
       EF18 00
<0193> EF19 B6,48,20        OR    >20,@FLAG
<0194> EF1C 06,E5,1D        CALL  GETALL
<0195> EF1F 8F,50           DCZ   @FAC6
<0196> EF21 6F,5B           BS    XBINP3

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0028 
E/A GROM
<0197> EF23 D6,51,01        CEQ   1,@FAC7
<0198> EF26 4F,49           BR    XBINP2
<0199> EF28 BF,AF,24        DST   >000A,V@>2400
       EF2B 00,00,0A
<0200> EF2E 31,00,05        MOVE  5,G@DDSK1,V@>2402
       EF31 AF,24,02
       EF34 E8,23
<0201> EF36 BC,AF,24        ST    V*STLN,V@>2405
       EF39 05,B0,24
<0202> EF3C 31,00,05        MOVE  5,G@DLOAD,V@>2407
       EF3F AF,24,07
       EF42 EE,1D
<0203> EF44 BE,42,FF        ST    >FF,@XTOKEN
<0204> EF47 4E,D9           BR    XBINP
<0205> EF49 06,EF,65 XBINP2 CALL  CLRREA
<0206> EF4C BF,AF,22        DST   >994A,V@>2254
       EF4F 54,99,4A
<0207> EF52 35,00,50        MOVE  80,V@9(@PABPTR),V@>2256
       EF55 AF,22,56
       EF58 E0,09,1C
<0208> EF5B 86,00    XBINP3 CLR   @>8300
<0209> EF5D 35,00,6E        MOVE  >006E,@>8300,@>8301
       EF60 01,00
<0210> EF62 05,63,72        B     RXB
<0211>               ********************************************
<0212> EF65 86,AF,22 CLRREA CLR   V@>2250
       EF68 50
<0213> EF69 35,00,50        MOVE 80,V@>2250,V@>2251
       EF6C AF,22,51
       EF6F AF,22,50
<0214> EF72 00              RTN
<0215> EF73 D6,E0,09 ONEKEY CEQ  1,V@9(@PABPTR)    One character for drive#?
       EF76 1C,01
<0216> EF78 4F,93           BR   TWOKEY            No, normal continue
<0217> EF7A BC,80,C0        ST   V@10(@PABPTR),@>83C0    Yes, save # character
       EF7D E0,0A,1C
<0218> EF80 31,00,05        MOVE 5,G@DDSK1,V@10(@PABPTR) DSK1. loaded into pab
       EF83 E0,0A,1C
       EF86 E8,23
<0219> EF88 BE,E0,09        ST   >05,V@9(@PABPTR)        DSK1. has 5 characters
       EF8B 1C,05
<0220> EF8D BC,E0,0D        ST   @>83C0,V@13(@PABPTR)    Load charcter drive#/le
       EF90 1C,80,C0
<0221> EF93 00       TWOKEY RTN
<0222>               ***********************************************************
<0223>               *
<0224>               *  Data for Initialization of
<0225>               *  Memory Expansion
<0226>               *
<0227> EF94 00,08,20 GF000 DATA  >0008,>2000,>A55A,>2128,>2398,>225A,>0654
       EF97 00,A5,5A
       EF9A 21,28,23
       EF9D 98,22,5A
       EFA0 06,54
<0228> EFA2 20,22,00       DATA  >2022,>0000,>A000,>FFD7,>2676,>3F38
       EFA5 00,A0,00
       EFA8 FF,D7,26
       EFAB 76,3F,38
<0229> EFAE 00,00,00       DATA  0,0,0,0,0,0,0,0,0
       EFB1 00,00,00
       EFB4 00,00,00
       EFB7 00,00,00
       EFBA 00,00,00
       EFBD 00,00,00

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0029 
E/A GROM
<0230> EFC0 00,00,00       DATA  0,0,0,0,0,0,0,0
       EFC3 00,00,00
       EFC6 00,00,00
       EFC9 00,00,00
       EFCC 00,00,00
       EFCF 00
<0231> EFD0 00,00,00       DATA  0,0,0,0,0,0,0
       EFD3 00,00,00
       EFD6 00,00,00
       EFD9 00,00,00
       EFDC 00,00
<0232> EFDE 00,00,00       DATA  0,0,0,0,0,0,0,0
       EFE1 00,00,00
       EFE4 00,00,00
       EFE7 00,00,00
       EFEA 00,00,00
       EFED 00
<0233> EFEE 00,00,00       DATA  0,0,0,0,0,0,0
       EFF1 00,00,00
       EFF4 00,00,00
       EFF7 00,00,00
       EFFA 00,00
<0234> EFFC 00,00,00       DATA  0,0,0,0,0,0,0,0
       EFFF 00,00,00
       F002 00,00,00
       F005 00,00,00
       F008 00,00,00
       F00B 00
<0235> F00C 00,00,00       DATA  0,0,0,0,0,0,0
       F00F 00,00,00
       F012 00,00,00
       F015 00,00,00
       F018 00,00
<0236> F01A 00,00,00       DATA  0,0,0,0,0,0,0,0
       F01D 00,00,00
       F020 00,00,00
       F023 00,00,00
       F026 00,00,00
       F029 00
<0237> F02A 00,00,00       DATA  0,0,0,0,0,0,0
       F02D 00,00,00
       F030 00,00,00
       F033 00,00,00
       F036 00,00
<0238> F038 00,00,00       DATA  0,0,0,0,0,0,0,0
       F03B 00,00,00
       F03E 00,00,00
       F041 00,00,00
       F044 00,00,00
       F047 00
<0239> F048 00,00,00       DATA  0,0,0,0,0,0,0
       F04B 00,00,00
       F04E 00,00,00
       F051 00,00,00
       F054 00,00
<0240> F056 00,00,00       DATA  0,0,0,0,0,0,0,0
       F059 00,00,00
       F05C 00,00,00
       F05F 00,00,00
       F062 00,00,00
       F065 00
<0241> F066 00,00,00       DATA  0,0,0,0,0,0,0
       F069 00,00,00
       F06C 00,00,00

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0030 
E/A GROM
       F06F 00,00,00
       F072 00,00
<0242> F074 00,00,00       DATA  0,0,0,0,>0064,>2000,>2EAA,>2094
       F077 00,00,00
       F07A 00,00,00
       F07D 64,20,00
       F080 2E,AA,20
       F083 94
<0243> F084 21,C4,20       DATA  >21C4,>2094,>2196,>2094,>21DE,>2094,>21F4
       F087 94,21,96
       F08A 20,94,21
       F08D DE,20,94
       F090 21,F4
<0244> F092 20,94,22       DATA  >2094,>2200,>2094,>220E,>2094,>221A,>2094,>2228
       F095 00,20,94
       F098 22,0E,20
       F09B 94,22,1A
       F09E 20,94,22
       F0A1 28
<0245> F0A2 20,9A,22       DATA  >209A,>22B2,>20DA,>23BA,>C80B,>2030,>D060,
       F0A5 B2,20,DA
       F0A8 23,BA,C8
       F0AB 0B,20,30
       F0AE D0,60
<0246> F0B0 83,49,20       DATA  >8349,>2060,>20FC,>132A,>C020,>8350,>1311,>06A0
       F0B3 60,20,FC
       F0B6 13,2A,C0
       F0B9 20,83,50
       F0BC 13,11,06
       F0BF A0
<0247> F0C0 26,46,10       DATA  >2646,>101E,>0281,>3F38,>1319,>C001,>0202
       F0C3 1E,02,81
       F0C6 3F,38,13
       F0C9 19,C0,01
       F0CC 02,02
<0248> F0CE 83,4A,8C       DATA  >834A,>8CB0,>1611,>8CB0,>160F,>8CB0,>160D,>C810
       F0D1 B0,16,11
       F0D4 8C,B0,16
       F0D7 0F,8C,B0
       F0DA 16,0D,C8
       F0DD 10
<0249> F0DE 20,22,02       DATA  >2022,>02E0,>20BA,>C020,>2022,>1309,>0690
       F0E1 E0,20,BA
       F0E4 C0,20,20
       F0E7 22,13,09
       F0EA 06,90
<0250> F0EC 02,E0,83       DATA  >02E0,>83E0,>C2E0,>2030,>045B,>0221,>0008,>10E4
       F0EF E0,C2,E0
       F0F2 20,30,04
       F0F5 5B,02,21
       F0F8 00,08,10
       F0FB E4
<0251> F0FC 02,00,0F       DATA  >0200,>0F00,>D800,>8322,>02E0,>83E0,>0460
       F0FF 00,D8,00
       F102 83,22,02
       F105 E0,83,E0
       F108 04,60
<0252> F10A 00,CE,58       DATA  >00CE,>5820,>20FC,>8349,>02E0,>2094,>0380,>C83E
       F10D 20,20,FC
       F110 83,49,02
       F113 E0,20,94
       F116 03,80,C8
       F119 3E
<0253> F11A 83,E2,02       DATA  >83E2,>02E0,>83E0,>C80B,>20AA,>C081,>0281

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0031 
E/A GROM
       F11D E0,83,E0
       F120 C8,0B,20
       F123 AA,C0,81
       F126 02,81
<0254> F128 80,00,1B       DATA  >8000,>1B07,>09C1,>0A11,>0A42,>09B2,>A0A1,>0CFA
       F12B 07,09,C1
       F12E 0A,11,0A
       F131 42,09,B2
       F134 A0,A1,0C
       F137 FA
<0255> F138 C0,92,06       DATA  >C092,>0692,>02E0,>2094,>C80B,>83F6,>0380
       F13B 92,02,E0
       F13E 20,94,C8
       F141 0B,83,F6
       F144 03,80
<0256> F146 D0,60,83       DATA  >D060,>8373,>0981,>C87E,>8304,>F820,>20FC,>8349
       F149 73,09,81
       F14C C8,7E,83
       F14F 04,F8,20
       F152 20,FC,83
       F155 49
<0257> F156 02,E0,83       DATA  >02E0,>83E0,>C2E0,>2030,>045B,>02E0,>83E0
       F159 E0,C2,E0
       F15C 20,30,04
       F15F 5B,02,E0
       F162 83,E0
<0258> F164 C8,0B,20       DATA  >C80B,>20AA,>06A0,>000E,>02E0,>2094,>C80B,>83F6
       F167 AA,06,A0
       F16A 00,0E,02
       F16D E0,20,94
       F170 C8,0B,83
       F173 F6
<0259> F174 03,80,06       DATA  >0380,>06A0,>223A,>D82D,>0002,>8C00,>0380
       F177 A0,22,3A
       F17A D8,2D,00
       F17D 02,8C,00
       F180 03,80
<0260> F182 06,A0,22       DATA  >06A0,>223A,>D831,>8C00,>0602,>16FC,>0380,>06A0
       F185 3A,D8,31
       F188 8C,00,06
       F18B 02,16,FC
       F18E 03,80,06
       F191 A0
<0261> F192 22,40,DB       DATA  >2240,>DB60,>8800,>0002,>0380,>06A0,>2240
       F195 60,88,00
       F198 00,02,03
       F19B 80,06,A0
       F19E 22,40
<0262> F1A0 DC,60,88       DATA  >DC60,>8800,>0602,>16FC,>0380,>C05D,>D82D,>0001
       F1A3 00,06,02
       F1A6 16,FC,03
       F1A9 80,C0,5D
       F1AC D8,2D,00
       F1AF 01
<0263> F1B0 8C,02,02       DATA  >8C02,>0261,>8000,>D801,>8C02,>0380,>0201
       F1B3 61,80,00
       F1B6 D8,01,8C
       F1B9 02,03,80
       F1BC 02,01
<0264> F1BE 40,00,10       DATA  >4000,>1001,>04C1,>C09D,>D820,>2099,>8C02,>E081
       F1C1 01,04,C1
       F1C4 C0,9D,D8
       F1C7 20,20,99
       F1CA 8C,02,E0

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0032 
E/A GROM
       F1CD 81
<0265> F1CE D8,02,8C       DATA  >D802,>8C02,>C06D,>0002,>C0AD,>0004,>045B
       F1D1 02,C0,6D
       F1D4 00,02,C0
       F1D7 AD,00,04
       F1DA 04,5B
<0266> F1DC 02,04,83       DATA  >0204,>834A,>C014,>C184,>04F6,>04F6,>C140,>1323
       F1DF 4A,C0,14
       F1E2 C1,84,04
       F1E5 F6,04,F6
       F1E8 C1,40,13
       F1EB 23
<0267> F1EC 07,40,02       DATA  >0740,>0203,>0040,>04F6,>04D6,>0280,>0064
       F1EF 03,00,40
       F1F2 04,F6,04
       F1F5 D6,02,80
       F1F8 00,64
<0268> F1FA 1A,13,02       DATA  >1A13,>0280,>2710,>1A08,>0583,>C040,>04C0,>3C20
       F1FD 80,27,10
       F200 1A,08,05
       F203 83,C0,40
       F206 04,C0,3C
       F209 20
<0269> F20A 20,FA,D9       DATA  >20FA,>D920,>83E3,>0003,>0583,>C040,>04C0
       F20D 20,83,E3
       F210 00,03,05
       F213 83,C0,40
       F216 04,C0
<0270> F218 3C,20,20       DATA  >3C20,>20FA,>D920,>83E3,>0002,>D920,>83E1,>0001
       F21B FA,D9,20
       F21E 83,E3,00
       F221 02,D9,20
       F224 83,E1,00
       F227 01
<0271> F228 D5,20,83       DATA  >D520,>83E7,>0545,>1101,>0514,>045B,>C17E
       F22B E7,05,45
       F22E 11,01,05
       F231 14,04,5B
       F234 C1,7E
<0272> F236 53,E0,20       DATA  >53E0,>20FC,>C020,>8356,>C240,>0229,>FFF8,>0420
       F239 FC,C0,20
       F23C 83,56,C2
       F23F 40,02,29
       F242 FF,F8,04
       F245 20
<0273> F246 21,14,D0       DATA  >2114,>D0C1,>0983,>0704,>0202,>208C,>0580
       F249 C1,09,83
       F24C 07,04,02
       F24F 02,20,8C
       F252 05,80
<0274> F254 05,84,80       DATA  >0584,>80C4,>1306,>0420,>2114,>DC81,>9801,>20FE
       F257 C4,13,06
       F25A 04,20,21
       F25D 14,DC,81
       F260 98,01,20
       F263 FE
<0275> F264 16,F6,C1       DATA  >16F6,>C104,>1352,>0284,>0007,>154F,>04E0
       F267 04,13,52
       F26A 02,84,00
       F26D 07,15,4F
       F270 04,E0
<0276> F272 83,D0,C8       DATA  >83D0,>C804,>8354,>C804,>2036,>0584,>A804,>8356
       F275 04,83,54
       F278 C8,04,20

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0033 
E/A GROM
       F27B 36,05,84
       F27E A8,04,83
       F281 56
<0277> F282 C8,20,83       DATA  >C820,>8356,>2038,>02E0,>83E0,>04C1,>020C
       F285 56,20,38
       F288 02,E0,83
       F28B E0,04,C1
       F28E 02,0C
<0278> F290 0F,00,C3       DATA  >0F00,>C30C,>1301,>1E00,>022C,>0100,>04E0,>83D0
       F293 0C,13,01
       F296 1E,00,02
       F299 2C,01,00
       F29C 04,E0,83
       F29F D0
<0279> F2A0 02,8C,20       DATA  >028C,>2000,>1332,>C80C,>83D0,>1D00,>0202
       F2A3 00,13,32
       F2A6 C8,0C,83
       F2A9 D0,1D,00
       F2AC 02,02
<0280> F2AE 40,00,98       DATA  >4000,>9812,>20FF,>16EE,>A0A0,>20A4,>1003,>C0A0
       F2B1 12,20,FF
       F2B4 16,EE,A0
       F2B7 A0,20,A4
       F2BA 10,03,C0
       F2BD A0
<0281> F2BE 83,D2,1D       DATA  >83D2,>1D00,>C092,>13E6,>C802,>83D2,>05C2
       F2C1 00,C0,92
       F2C4 13,E6,C8
       F2C7 02,83,D2
       F2CA 05,C2
<0282> F2CC C2,72,D1       DATA  >C272,>D160,>8355,>1309,>9C85,>16F2,>0985,>0206
       F2CF 60,83,55
       F2D2 13,09,9C
       F2D5 85,16,F2
       F2D8 09,85,02
       F2DB 06
<0283> F2DC 20,8C,9C       DATA  >208C,>9CB6,>16ED,>0605,>16FC,>0581,>C801
       F2DF B6,16,ED
       F2E2 06,05,16
       F2E5 FC,05,81
       F2E8 C8,01
<0284> F2EA 20,3A,C8       DATA  >203A,>C809,>2034,>C80C,>2032,>0699,>10E2,>1E00
       F2ED 09,20,34
       F2F0 C8,0C,20
       F2F3 32,06,99
       F2F6 10,E2,1E
       F2F9 00
<0285> F2FA 02,E0,20       DATA  >02E0,>209A,>C009,>0420,>2114,>09D1,>1604
       F2FD 9A,C0,09
       F300 04,20,21
       F303 14,09,D1
       F306 16,04
<0286> F308 03,80,02       DATA  >0380,>02E0,>209A,>04C1,>06C1,>D741,>F3E0,>20FC
       F30B E0,20,9A
       F30E 04,C1,06
       F311 C1,D7,41
       F314 F3,E0,20
       F317 FC
<0287> F318 03,80,C8       DATA  >0380,>C80B,>2030,>02E0,>20BA,>0420,>2124
       F31B 0B,20,30
       F31E 02,E0,20
       F321 BA,04,20
       F324 21,24
<0288> F326 02,E0,83       DATA  >02E0,>83E0,>1303,>C2E0,>2030,>045B,>D820,>20BA

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0034 
E/A GROM
       F329 E0,13,03
       F32C C2,E0,20
       F32F 30,04,5B
       F332 D8,20,20
       F335 BA
<0289> F336 83,22,04       DATA  >8322,>0460,>00CE,>04E0,>2022,>53E0,>20FC
       F339 60,00,CE
       F33C 04,E0,20
       F33F 22,53,E0
       F342 20,FC
<0290> F344 C0,20,83       DATA  >C020,>8356,>0420,>2120,>0008,>1332,>0220,>FFF7
       F347 56,04,20
       F34A 21,20,00
       F34D 08,13,32
       F350 02,20,FF
       F353 F7
<0291> F354 02,01,02       DATA  >0201,>0200,>0420,>210C,>0580,>C800,>202E
       F357 00,04,20
       F35A 21,0C,05
       F35D 80,C8,00
       F360 20,2E
<0292> F362 C1,E0,20       DATA  >C1E0,>2024,>C147,>04CC,>06A0,>25E0,>0283,>0001
       F365 24,C1,47
       F368 04,CC,06
       F36B A0,25,E0
       F36E 02,83,00
       F371 01
<0293> F372 16,24,05       DATA  >1624,>058C,>04C3,>1023,>0283,>0046,>161E
       F375 8C,04,C3
       F378 10,23,02
       F37B 83,00,46
       F37E 16,1E
<0294> F380 04,C2,06       DATA  >04C2,>06A0,>262E,>0283,>003A,>16F7,>C020,>202E
       F383 A0,26,2E
       F386 02,83,00
       F389 3A,16,F7
       F38C C0,20,20
       F38F 2E
<0295> F390 06,00,02       DATA  >0600,>0201,>0100,>0420,>210C,>06A0,>25E0
       F393 01,01,00
       F396 04,20,21
       F399 0C,06,A0
       F39C 25,E0
<0296> F39E C0,20,20       DATA  >C020,>2022,>1307,>06A0,>2646,>1005,>CB4E,>0016
       F3A1 22,13,07
       F3A4 06,A0,26
       F3A7 46,10,05
       F3AA CB,4E,00
       F3AD 16
<0297> F3AE C3,A0,20       DATA  >C3A0,>2022,>0380,>D740,>F3E0,>20FC,>0380
       F3B1 22,03,80
       F3B4 D7,40,F3
       F3B7 E0,20,FC
       F3BA 03,80
<0298> F3BC 06,A0,25       DATA  >06A0,>25C2,>04C4,>D123,>2662,>0974,>C808,>202C
       F3BF C2,04,C4
       F3C2 D1,23,26
       F3C5 62,09,74
       F3C8 C8,08,20
       F3CB 2C
<0299> F3CC 06,A0,25       DATA  >06A0,>2594,>0464,>23F8,>0580,>0240,>FFFE
       F3CF 94,04,64
       F3D2 23,F8,05
       F3D5 80,02,40

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0035 
E/A GROM
       F3D8 FF,FE
<0300> F3DA C1,20,20       DATA  >C120,>2024,>A100,>1808,>8804,>2026,>1B05,>C160
       F3DD 24,A1,00
       F3E0 18,08,88
       F3E3 04,20,26
       F3E6 1B,05,C1
       F3E9 60
<0301> F3EA 20,24,C8       DATA  >2024,>C804,>2024,>100A,>C120,>2028,>A100
       F3ED 04,20,24
       F3F0 10,0A,C1
       F3F3 20,20,28
       F3F6 A1,00
<0302> F3F8 88,04,20       DATA  >8804,>202A,>140C,>C160,>2028,>C804,>2028,>C1C5
       F3FB 2A,14,0C
       F3FE C1,60,20
       F401 28,C8,04
       F404 20,28,C1
       F407 C5
<0303> F408 02,09,00       DATA  >0209,>0008,>06A0,>262E,>0609,>16FC,>10B6
       F40B 08,06,A0
       F40E 26,2E,06
       F411 09,16,FC
       F414 10,B6
<0304> F416 02,00,08       DATA  >0200,>0800,>10CC,>A005,>C800,>2022,>10AF,>A800
       F419 00,10,CC
       F41C A0,05,C8
       F41F 00,20,22
       F422 10,AF,A8
       F425 00
<0305> F426 20,2C,13       DATA  >202C,>13AC,>0200,>0B00,>10C2,>A005,>C1C0
       F429 AC,02,00
       F42C 0B,00,10
       F42F C2,A0,05
       F432 C1,C0
<0306> F434 10,A6,A0       DATA  >10A6,>A005,>DDC0,>DDE0,>20DB,>10A1,>A005,>06A0
       F437 05,DD,C0
       F43A DD,E0,20
       F43D DB,10,A1
       F440 A0,05,06
       F443 A0
<0307> F444 25,66,C0       DATA  >2566,>C000,>1316,>0226,>FFF8,>8106,>1B02
       F447 00,13,16
       F44A 02,26,FF
       F44D F8,81,06
       F450 1B,02
<0308> F452 05,14,10       DATA  >0514,>1096,>8594,>16F8,>89A4,>0002,>0002,>16F4
       F455 96,85,94
       F458 16,F8,89
       F45B A4,00,02
       F45E 00,02,16
       F461 F4
<0309> F462 89,A4,00       DATA  >89A4,>0004,>0004,>16F0,>C0E6,>0006,>C250
       F465 04,00,04
       F468 16,F0,C0
       F46B E6,00,06
       F46E C2,50
<0310> F470 C4,03,C0       DATA  >C403,>C009,>16FC,>0224,>0008,>C804,>202A,>10EA
       F473 09,16,FC
       F476 02,24,00
       F479 08,C8,04
       F47C 20,2A,10
       F47F EA
<0311> F480 A0,05,06       DATA  >A005,>06A0,>2566,>0226,>FFF8,>8106,>13E3
       F483 A0,25,66

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0036 
E/A GROM
       F486 02,26,FF
       F489 F8,81,06
       F48C 13,E3
<0312> F48E C2,96,15       DATA  >C296,>1501,>050A,>8294,>16F7,>89A4,>0002,>0002
       F491 01,05,0A
       F494 82,94,16
       F497 F7,89,A4
       F49A 00,02,00
       F49D 02
<0313> F49E 16,F3,89       DATA  >16F3,>89A4,>0004,>0004,>16EF,>C296,>1516
       F4A1 A4,00,04
       F4A4 00,04,16
       F4A7 EF,C2,96
       F4AA 15,16
<0314> F4AC C0,E6,00       DATA  >C0E6,>0006,>C253,>C4C0,>C0C9,>16FC,>C246,>6244
       F4AF 06,C2,53
       F4B2 C4,C0,C0
       F4B5 C9,16,FC
       F4B8 C2,46,62
       F4BB 44
<0315> F4BC C2,86,02       DATA  >C286,>022A,>0008,>C0C6,>0643,>064A,>C693
       F4BF 2A,00,08
       F4C2 C0,C6,06
       F4C5 43,06,4A
       F4C8 C6,93
<0316> F4CA 06,49,16       DATA  >0649,>16FB,>0224,>0008,>C804,>202A,>10D9,>CB44
       F4CD FB,02,24
       F4D0 00,08,C8
       F4D3 04,20,2A
       F4D6 10,D9,CB
       F4D9 44
<0317> F4DA 00,02,02       DATA  >0002,>0200,>0C00,>0460,>2432,>0460,>2494
       F4DD 00,0C,00
       F4E0 04,60,24
       F4E3 32,04,60
       F4E6 24,94
<0318> F4E8 C2,8B,02       DATA  >C28B,>0209,>0006,>C1A0,>202A,>0226,>FFF8,>C106
       F4EB 09,00,06
       F4EE C1,A0,20
       F4F1 2A,02,26
       F4F4 FF,F8,C1
       F4F7 06
<0319> F4F8 88,06,20       DATA  >8806,>2028,>1AF3,>C806,>202A,>06A0,>262E
       F4FB 28,1A,F3
       F4FE C8,06,20
       F501 2A,06,A0
       F504 26,2E
<0320> F506 DD,A0,20       DATA  >DDA0,>20E1,>0609,>16FA,>C580,>0206,>4000,>045A
       F509 E1,06,09
       F50C 16,FA,C5
       F50F 80,02,06
       F512 40,00,04
       F515 5A
<0321> F516 C2,8B,04       DATA  >C28B,>04C0,>C30C,>1308,>06A0,>262E,>D020
       F519 C0,C3,0C
       F51C 13,08,06
       F51F A0,26,2E
       F522 D0,20
<0322> F524 20,E1,06       DATA  >20E1,>06A0,>262E,>A003,>045A,>0209,>0004,>06A0
       F527 A0,26,2E
       F52A A0,03,04
       F52D 5A,02,09
       F530 00,04,06
       F533 A0

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0037 
E/A GROM
<0323> F534 26,2E,06       DATA  >262E,>06A0,>25C2,>0A40,>A003,>0609,>16F8
       F537 A0,25,C2
       F53A 0A,40,A0
       F53D 03,06,09
       F540 16,F8
<0324> F542 04,5A,02       DATA  >045A,>0223,>FFD0,>0283,>000A,>1A05,>0223,>FFF9
       F545 23,FF,D0
       F548 02,83,00
       F54B 0A,1A,05
       F54E 02,23,FF
       F551 F9
<0325> F552 02,83,00       DATA  >0283,>0019,>1B01,>045B,>0200,>0A00,>0460
       F555 19,1B,01
       F558 04,5B,02
       F55B 00,0A,00
       F55E 04,60
<0326> F560 24,32,02       DATA  >2432,>02E0,>83E0,>0200,>2032,>C330,>C270,>C830
       F563 E0,83,E0
       F566 02,00,20
       F569 32,C3,30
       F56C C2,70,C8
       F56F 30
<0327> F570 83,54,C8       DATA  >8354,>C830,>8356,>C050,>1D00,>9820,>4000
       F573 30,83,56
       F576 C0,50,1D
       F579 00,98,20
       F57C 40,00
<0328> F57E 20,FF,16       DATA  >20FF,>161D,>0699,>101B,>1E00,>02E0,>20DA,>C020
       F581 1D,06,99
       F584 10,1B,1E
       F587 00,02,E0
       F58A 20,DA,C0
       F58D 20
<0329> F58E 20,2E,02       DATA  >202E,>0201,>20DB,>0202,>0004,>0420,>2118
       F591 01,20,DB
       F594 02,02,00
       F597 04,04,20
       F59A 21,18
<0330> F59C 70,00,09       DATA  >7000,>0950,>1610,>0982,>C001,>0201,>203C,>0420
       F59F 50,16,10
       F5A2 09,82,C0
       F5A5 01,02,01
       F5A8 20,3C,04
       F5AB 20
<0331> F5AC 21,18,04       DATA  >2118,>04C8,>0602,>11D7,>D0F1,>0983,>A203
       F5AF C8,06,02
       F5B2 11,D7,D0
       F5B5 F1,09,83
       F5B8 A2,03
<0332> F5BA 04,5B,02       DATA  >045B,>02E0,>20DA,>04C0,>06C0,>0460,>2432,>0201
       F5BD E0,20,DA
       F5C0 04,C0,06
       F5C3 C0,04,60
       F5C6 24,32,02
       F5C9 01
<0333> F5CA 3F,40,02       DATA  >3F40,>0221,>FFF8,>C011,>1105,>8060,>202A
       F5CD 21,FF,F8
       F5D0 C0,11,11
       F5D3 05,80,60
       F5D6 20,2A
<0334> F5D8 16,F9,05       DATA  >16F9,>05CB,>045B,>0200,>0D00,>045B,>2D52,>5163
       F5DB CB,04,5B
       F5DE 02,00,0D
       F5E1 00,04,5B

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0038 
E/A GROM
       F5E4 2D,52,51
       F5E7 63
<0335> F5E8 64,83,84       DATA  >6483,>8455,>045C,>5B5F,>5EF0,>F003,>F0F0
       F5EB 55,04,5C
       F5EE 5B,5F,5E
       F5F1 F0,F0,03
       F5F4 F0,F0
<0336> F5F6 47,00,00       DATA  >4700,>00C8,>3F38,>5554,>4C54,>4142,>2022,>5041
       F5F9 C8,3F,38
       F5FC 55,54,4C
       F5FF 54,41,42
       F602 20,22,50
       F605 41
<0337> F606 44,20,20       DATA  >4420,>2020,>8300,>4750,>4C57,>5320,>83E0
       F609 20,83,00
       F60C 47,50,4C
       F60F 57,53,20
       F612 83,E0
<0338> F614 53,4F,55       DATA  >534F,>554E,>4420,>8400,>5644,>5052,>4420,>8800
       F617 4E,44,20
       F61A 84,00,56
       F61D 44,50,52
       F620 44,20,88
       F623 00
<0339> F624 56,44,50       DATA  >5644,>5053,>5441,>8802,>5644,>5057,>4420
       F627 53,54,41
       F62A 88,02,56
       F62D 44,50,57
       F630 44,20
<0340> F632 8C,00,56       DATA  >8C00,>5644,>5057,>4120,>8C02,>5350,>4348,>5244
       F635 44,50,57
       F638 41,20,8C
       F63B 02,53,50
       F63E 43,48,52
       F641 44
<0341> F642 90,00,53       DATA  >9000,>5350,>4348,>5754,>9400,>4752,>4D52
       F645 50,43,48
       F648 57,54,94
       F64B 00,47,52
       F64E 4D,52
<0342> F650 44,20,98       DATA  >4420,>9800,>4752,>4D52,>4120,>9802,>4752,>4D57
       F653 00,47,52
       F656 4D,52,41
       F659 20,98,02
       F65C 47,52,4D
       F65F 57
<0343> F660 44,20,9C       DATA  >4420,>9C00,>4752,>4D57,>4120,>9C02,>5343
       F663 00,47,52
       F666 4D,57,41
       F669 20,9C,02
       F66C 53,43
<0344> F66E 41,4E,20       DATA  >414E,>2020,>000E,>584D,>4C4C,>4E4B,>2104,>4B53
       F671 20,00,0E
       F674 58,4D,4C
       F677 4C,4E,4B
       F67A 21,04,4B
       F67D 53
<0345> F67E 43,41,4E       DATA  >4341,>4E20,>2108,>5653,>4257,>2020,>210C
       F681 20,21,08
       F684 56,53,42
       F687 57,20,20
       F68A 21,0C
<0346> F68C 56,4D,42       DATA  >564D,>4257,>2020,>2110,>5653,>4252,>2020,>2114
       F68F 57,20,20

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0039 
E/A GROM
       F692 21,10,56
       F695 53,42,52
       F698 20,20,21
       F69B 14
<0347> F69C 56,4D,42       DATA  >564D,>4252,>2020,>2118,>5657,>5452,>2020
       F69F 52,20,20
       F6A2 21,18,56
       F6A5 57,54,52
       F6A8 20,20
<0348> F6AA 21,1C,44       DATA  >211C,>4453,>524C,>4E4B,>2120,>4C4F,>4144,>4552
       F6AD 53,52,4C
       F6B0 4E,4B,21
       F6B3 20,4C,4F
       F6B6 41,44,45
       F6B9 52
<0349> F6BA 21,24,47       DATA  >2124,>4750,>4C4C,>4E4B,>2100
       F6BD 50,4C,4C
       F6C0 4E,4B,21
       F6C3 00
<0350>               ***********************************************************
<0351>               *
<0352>               * CATALOG HARD/DISK
<0353>               *
<0354> F6C4 06,F6,C9 DIRECT CALL DMENU
<0355> F6C7 57,56           BR   DIREC2
<0356> F6C9 07,20    DMENU  ALL  SPACE             Clear screen
<0357> F6CB 08              FMT
<0358> F6CC FF,09           COL 9
<0359> F6CE FE,01           ROW 1
<0360> F6D0 0E,2A,20        HTEX '* DIRECTORY *  '
       F6D3 44,49,52
       F6D6 45,43,54
       F6D9 4F,52,59
       F6DC 20,2A,20
       F6DF 20
<0361> F6E0 A3              ROW+ 4
<0362> F6E1 89              COL+ 10
<0363> F6E2 0B,44,65        HTEX 'Device Name?'
       F6E5 76,69,63
       F6E8 65,20,4E
       F6EB 61,6D,65
       F6EE 3F
<0364> F6EF A7              ROW+ 8
<0365> F6F0 FF,03           COL  3
<0366> F6F2 17,41,43        HTEX 'ACTIVE KEYS: CLEAR, AID,'
       F6F5 54,49,56
       F6F8 45,20,4B
       F6FB 45,59,53
       F6FE 3A,20,43
       F701 4C,45,41
       F704 52,2C,20
       F707 41,49,44
       F70A 2C
<0367> F70B A1              ROW+ 2
<0368> F70C FF,03           COL  3
<0369> F70E 14,28,41        HTEX '(ARROWS), E, e, X, x,'
       F711 52,52,4F
       F714 57,53,29
       F717 2C,20,45
       F71A 2C,20,65
       F71D 2C,20,58
       F720 2C,20,78
       F723 2C
<0370> F724 A1              ROW+ 2

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0040 
E/A GROM
<0371> F725 FF,03           COL  3
<0372> F727 14,42,45        HTEX 'BEGIN, PROCEED, REDO,'
       F72A 47,49,4E
       F72D 2C,20,50
       F730 52,4F,43
       F733 45,45,44
       F736 2C,20,52
       F739 45,44,4F
       F73C 2C
<0373> F73D A1              ROW+ 2
<0374> F73E FF,03           COL  3
<0375> F740 12,42,41        HTEX 'BACK, and SPACE BAR'
       F743 43,4B,2C
       F746 20,61,6E
       F749 64,20,53
       F74C 50,41,43
       F74F 45,20,42
       F752 41,52
<0376> F754 FB              FEND
<0377> F755 00              RTN
<0378> F756 86,74    DIREC2 CLR  @KBNO             Clear keyboard number
<0379> F758 BF,20,01        DST  >0102,@CURADD     Prompt location
       F75B 02
<0380> F75C BF,1C,10        DST  >1000,@PABPTR     Use first PAB area
       F75F 00
<0381> F760 B6,48,20        OR   >20,@FLAG         Set return bit for error
<0382> F763 06,E5,1D        CALL GETALL            Input the filename
<0383> F766 86,42    DIREC3 CLR  @XTOKEN
<0384> F768 06,EF,65        CALL CLRREA
<0385> F76B 31,00,09        MOVE 9,G@CATDAT,V*PABPTR Prepare PAB
       F76E B0,1C,FA
       F771 A1
<0386> F772 06,EF,73        CALL ONEKEY
<0387> F775 06,E5,6A        CALL DOIO              Open the file
<0388> F778 BF,B0,1C        DST  >020D,V*PABPTR    Read opcode to PAB
       F77B 02,0D
<0389> F77D 06,E5,6A        CALL DOIO              Read first record
<0390> F780 07,20           ALL  SPACE             Clear screen again
<0391> F782 06,FA,B2        CALL SCREEN            Set up header
<0392> F785 BE,AF,25        ST   >20,V@>2500
       F788 00,20
<0393> F78A 35,11,00        MOVE >1100,V@>2500,V@>2501
       F78D AF,25,01
       F790 AF,25,00
<0394> F793 BF,40,25        DST  >2580,@>8340
       F796 80
<0395> F797 BE,02,59        ST   >59,@>8302        Y
<0396> F79A 03       TSTKEY SCAN                   Scan the keyboard
<0397> F79B 57,B5           BR   TSTKE5            Any key?
<0398> F79D D6,75,20        CEQ  SPACE,@KEY        SPACE KEY?
<0399> F7A0 77,B2           BS   TSTKE4            Yes, wait.
<0400> F7A2 D6,75,0F        CEQ  BACK,@KEY         BACK key?
<0401> F7A5 57,AE           BR   TSTKE3            No
<0402> F7A7 86,42    TSTKE2 CLR  @XTOKEN           Yes, so restart
<0403> F7A9 06,E5,66        CALL CLOSE             Close disk
<0404> F7AC 56,C4           BR   DIRECT            Start Catalog again
<0405> F7AE 86,42    TSTKE3 CLR  @XTOKEN           Clear flag
<0406> F7B0 57,BF           BR   ARROWS
<0407> F7B2 03       TSTKE4 SCAN                   Wait for any key.
<0408> F7B3 57,B2           BR   TSTKE4            Loop
<0409> F7B5 06,E5,6A TSTKE5 CALL DOIO              Read file info
<0410> F7B8 06,FB,9F        CALL FILNAM            Put it on screen
<0411> F7BB 57,9A           BR   TSTKEY            Loop till done
<0412> F7BD 92,1E           DEC  @COUNT            COUNT-1

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0041 
E/A GROM
<0413> F7BF 06,EE,34 ARROWS CALL CLRFAC
<0414> F7C2 BC,4B,1E        ST   @COUNT,@FAC1
<0415> F7C5 CB,4A,00        DCHE 100,@FAC
       F7C8 64
<0416> F7C9 57,D3           BR   ARROW1
<0417> F7CB A7,4A,00        DSUB 100,@FAC
       F7CE 64
<0418> F7CF BE,A0,1C        ST   49,V@28           Show it 1__
       F7D2 31
<0419> F7D3 CB,4A,00 ARROW1 DCHE 9,@FAC
       F7D6 09
<0420> F7D7 57,EC           BR   ARROW2
<0421> F7D9 AE,4A,0A        DIV  10,@FAC
<0422> F7DC A2,4A,30        ADD  >30,@FAC
<0423> F7DF BC,A0,1D        ST   @FAC,V@29         Show it _#_
       F7E2 4A
<0424> F7E3 A2,4B,30        ADD  >30,@FAC1
<0425> F7E6 BC,A0,1E        ST   @FAC1,V@30        Show it __#
       F7E9 4B
<0426> F7EA 57,F3           BR   ARROW3
<0427> F7EC A2,4B,30 ARROW2 ADD  >30,@FAC1
<0428> F7EF BC,A0,1E        ST   @FAC1,V@30
       F7F2 4B
<0429> F7F3 BF,10,00 ARROW3 DST  >0081,@>8310      Arrows location
       F7F6 81
<0430> F7F7 BF,04,25        DST  >2580,@>8304      Recall buffer
       F7FA 80
<0431> F7FB 35,02,60 OKKEY  MOVE >0260,V*>8304,V@>0080 Fill screen
       F7FE A0,80,B0
       F801 04
<0432> F802 BE,B0,10 NOKEY  ST   130,V*>8310       Left arrow
       F805 82
<0433> F806 BE,E0,0B        ST   131,V@11(@>8310)  Right arrow
       F809 10,83
<0434> F80B 03              SCAN
<0435> F80C D6,75,01        CEQ  AID,@KEY          AID
<0436> F80F 58,2A           BR   NAID
<0437> F811 35,03,00        MOVE 768,V@0,V@>2000   Save screen
       F814 AF,20,00
       F817 A0,00
<0438> F819 06,F6,C9        CALL DMENU
<0439> F81C 03       YAID   SCAN                   Any key?
<0440> F81D 58,1C           BR   YAID              No.
<0441> F81F 35,03,00        MOVE 768,V@>2000,V@0   Restore screen
       F822 A0,00,AF
       F825 20,00
<0442> F827 03       WAID   SCAN                   Any key?
<0443> F828 58,27           BR   WAID
<0444> F82A D6,75,02 NAID   CEQ  CLEAR,@KEY        CLEAR
<0445> F82D 77,A7           BS   TSTKE2
<0446> F82F D6,75,0C        CEQ  PROCD,@KEY        PROCEED
<0447> F832 79,08           BS   ENTER0
<0448> F834 D6,75,06        CEQ  REDO,@KEY         REDO
<0449> F837 77,A7           BS   TSTKE2
<0450> F839 D6,75,0F BACK0  CEQ  BACK,@KEY         BACK
<0451> F83C 58,75           BR   BEGIN0
<0452> F83E D7,AF,10        DCEQ 'DS',V@>100A      DS?   DISK ONLY?
       F841 0A,44,53
<0453> F844 77,A7           BS   TSTKE2
<0454> F846 06,F9,0E        CALL CLRBUF            Clear buffers and FAC
<0455> F849 BD,4A,AF        DST  V@>1008,@FAC      Get length
       F84C 10,08
<0456> F84E D7,4A,00        DCEQ 5,@FAC            DSK#. or SCS#. or WDS#.
       F851 05

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0042 
E/A GROM
<0457> F852 78,A3           BS   BEGIN3
<0458> F854 CB,4A,00        DCHE 4,@FAC
       F857 04
<0459> F858 58,A3           BR   BEGIN3
<0460> F85A 06,F9,0E        CALL CLRBUF            Clear buffers and FAC
<0461> F85D BD,4A,AF        DST  V@>1008,@FAC      Get length
       F860 10,08
<0462> F862 93,4A    BACK1  DDEC @FAC              Length -1
<0463> F864 D6,EF,10        CEQ  >2E,V@>1009(@FAC) .?
       F867 09,4A,2E
<0464> F86A 58,62           BR   BACK1             No, keep searching
<0465> F86C CB,4A,00        DCHE 5,@FAC            DSK. or SCS. or WDS. or DSK#.
       F86F 05
<0466> F870 78,A3           BS   BEGIN3
<0467> F872 BE,75,0E BACK3  ST   BEGIN,@KEY
<0468> F875 D6,75,0E BEGIN0 CEQ  BEGIN,@KEY        BEGIN
<0469> F878 58,C2           BR   FCTNUP
<0470> F87A 06,EE,34        CALL CLRFAC            Clear buffers and FAC
<0471> F87D BD,4A,AF        DST  V@>1008,@FAC      Get length
       F880 10,08
<0472> F882 D7,4A,00        DCEQ 5,@FAC            DSK#. or SCS#. or WDS#.
       F885 05
<0473> F886 78,9A           BS   BEGIN2
<0474> F888 87,4A           DCLR @FAC              Clear FAC
<0475> F88A 91,4A    BEGIN1 DINC @FAC              COUNT +1
<0476> F88C D6,EF,10        CEQ  >2E,V@>1009(@FAC) .?
       F88F 09,4A,2E
<0477> F892 58,8A           BR   BEGIN1            No, keep searching
<0478> F894 D7,4A,00        DCEQ 4,@FAC            DSK. Length?
       F897 04
<0479> F898 78,8A           BS   BEGIN1            Yes, look for Volume.
<0480> F89A 91,4A    BEGIN2 DINC @FAC              LENGTH+1
<0481> F89C BF,EF,10        DST  >0D0D,V@>1009(@FAC)
       F89F 09,4A,0D
       F8A2 0D
<0482> F8A3 BD,AF,10 BEGIN3 DST  @FAC,V@>1008
       F8A6 08,4A
<0483> F8A8 A3,4A,00        DADD 2,@FAC
       F8AB 02
<0484> F8AC 34,4A,AF        MOVE @FAC,V@>1008,V@>2255
       F8AF 22,55,AF
       F8B2 10,08
<0485> F8B4 34,4A,AF        MOVE @FAC,V@>1008,V@>2400
       F8B7 24,00,AF
       F8BA 10,08
<0486> F8BC BE,42,37        ST   >37,@XTOKEN
<0487> F8BF 05,E0,28        B    OLDEA
[0008]               ***********************************************************
[0009]                      COPY 'DSK5.MYXB7-D'
<0001>                
<0002>                
<0003> F8C2 D6,75,0B FCTNUP CEQ  11,@KEY           FCTN UP
<0004> F8C5 79,FE           BS   UPKEY
<0005> F8C7 D6,75,45        CEQ  'E',@KEY          UP (E)
<0006> F8CA 79,FE           BS   UPKEY
<0007> F8CC D6,75,65        CEQ  'e',@KEY          UP (e)
<0008> F8CF 79,FE           BS   UPKEY
<0009> F8D1 D6,75,0A        CEQ  10,@KEY           FCTN DOWN
<0010> F8D4 7A,16           BS   DKEY
<0011> F8D6 D6,75,58        CEQ  'X',@KEY          DOWN (X)
<0012> F8D9 7A,16           BS   DKEY
<0013> F8DB D6,75,78        CEQ  'x',@KEY          DOWN (x)
<0014> F8DE 7A,16           BS   DKEY
<0015> F8E0 D6,75,08        CEQ  8,@KEY            FCTN LEFT

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0043 
E/A GROM
<0016> F8E3 7A,3A           BS   LKEY
<0017> F8E5 D6,75,53        CEQ  83,@KEY           LEFT (S)
<0018> F8E8 7A,3A           BS   LKEY
<0019> F8EA D6,75,73        CEQ  115,@KEY          LEFT (s)
<0020> F8ED 7A,3A           BS   LKEY
<0021> F8EF D6,75,09        CEQ  9,@KEY            FCTN RIGHT
<0022> F8F2 7A,5F           BS   RKEY
<0023> F8F4 D6,75,44        CEQ  68,@KEY           RIGHT (D)
<0024> F8F7 7A,5F           BS   RKEY
<0025> F8F9 D6,75,64        CEQ  100,@KEY          RIGHT (d)
<0026> F8FC 7A,5F           BS   RKEY
<0027> F8FE D6,75,20        CEQ  ' ',@KEY          SPACE BAR
<0028> F901 79,08           BS   ENTER0
<0029> F903 D6,75,0D        CEQ  ENTER,@KEY        ENTER
<0030> F906 58,02           BR   NOKEY
<0031> F908 06,F9,0E ENTER0 CALL CLRBUF
<0032> F90B 05,F9,29        B    ENTR
<0033> F90E BE,AF,22 CLRBUF ST   ENTER,V@>2257     Clear buffer
       F911 57,0D
<0034> F913 35,00,3F        MOVE 63,V@>2257,V@>2258
       F916 AF,22,58
       F919 AF,22,57
<0035> F91C 35,00,3F        MOVE 63,V@>2257,V@>2402
       F91F AF,24,02
       F922 AF,22,57
<0036> F925 06,EE,34        CALL CLRFAC
<0037> F928 00              RTN
<0038> F929 BD,06,AF ENTR   DST  V@>1008,@>8306    Get length of device
       F92C 10,08
<0039> F92E BE,EF,10        ST   >2E,V@>1009(@>8306)
       F931 09,06,2E
<0040> F934 34,06,AF        MOVE @>8306,V@>100A,V@>2402
       F937 24,02,AF
       F93A 10,0A
<0041> F93C BD,4C,10        DST  @>8310,@FAC2
<0042> F93F 90,11           INC  @>8311
<0043> F941 90,4D    ENTER1 INC  @FAC3             Index+1
<0044> F943 90,4B           INC  @FAC1             Count+1
<0045> F945 D6,B0,4C        CEQ  SPACE,V*FAC2      Space?
       F948 20
<0046> F949 79,50           BS   ENTER2            Yes
<0047> F94B D6,4B,0B        CEQ  11,@FAC1          To long?
<0048> F94E 59,41           BR   ENTER1
<0049> F950 BE,B0,4C ENTER2 ST   ENTER,V*FAC2      cr
       F953 0D
<0050> F954 D7,E0,10        DCEQ 'Di',V@16(@>8310) Directory?
       F957 10,44,69
<0051> F95A 59,6A           BR   NODIR             No
<0052> F95C D6,E0,12        CEQ  'r',V@18(@>8310)
       F95F 10,72
<0053> F961 59,6A           BR   NODIR
<0054> F963 BF,B0,4C        DST  >2E0D,V*FAC2      .cr
       F966 2E,0D
<0055> F968 90,4A           INC  @FAC              Count+1
<0056> F96A 34,4A,EF NODIR  MOVE @FAC,V*>8310,V@>100A(@>8306)
       F96D 10,0A,06
       F970 B0,10
<0057> F972 A1,4A,06        DADD @>8306,@FAC
<0058> F975 34,4A,AF        MOVE @FAC,V@>100A,V@>2257
       F978 22,57,AF
       F97B 10,0A
<0059> F97D BD,AF,22        DST  @FAC,V@>2255
       F980 55,4A
<0060> F982 90,07           INC  @>8307

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0044 
E/A GROM
<0061> F984 BD,AF,24        DST  @>8306,V@>2400
       F987 00,06
<0062> F989 06,E5,66        CALL CLOSE
<0063>                
<0064> F98C BE,42,EA        ST   >EA,@XTOKEN       Set flag
<0065>                
<0066> F98F D6,75,20        CEQ  32,@KEY           SPACE BAR
<0067> F992 79,D8           BS   XBPGM
<0068> F994 D7,E0,10        DCEQ 'Di',V@16(@>8310) Directory?
       F997 10,44,69
<0069> F99A 59,A3           BR   PORVI
<0070> F99C D6,E0,12        CEQ  'r',V@18(@>8310)
       F99F 10,72
<0071> F9A1 76,C4           BS   DIRECT
<0072> F9A3 D6,E0,10 PORVI  CEQ  'P',V@16(@>8310)  Program?
       F9A6 10,50
<0073> F9A8 67,16           BS   PRGRM
<0074> F9AA D6,E0,14        CEQ  'V',V@20(@>8310)  Variable?
       F9AD 10,56
<0075> F9AF 59,C7           BR   DORF80
<0076> F9B1 D6,E0,10        CEQ  'I',V@16(@>8310)  Internal?
       F9B4 10,49
<0077> F9B6 59,C7           BR   DORF80
<0078> F9B8 D7,E0,18        DCEQ '25',V@24(@>8310) Length 25_?
       F9BB 10,32,35
<0079> F9BE 59,C7           BR   DORF80
<0080> F9C0 D6,E0,1A        CEQ  '4',V@26(@>8310)  Length 254?
       F9C3 10,34
<0081> F9C5 6E,D9           BS   XBINP
<0082> F9C7 D7,E0,19 DORF80 DCEQ '80',V@25(@>8310) Length 80?
       F9CA 10,38,30
<0083> F9CD 40,71           BR   MMENU
<0084> F9CF D6,E0,14        CEQ  'F',V@20(@>8310)  Fixed?
       F9D2 10,46
<0085> F9D4 69,E4           BS   LANDR
<0086> F9D6 40,71           BR   MMENU
<0087> F9D8 D6,E0,10 XBPGM  CEQ  'P',V@16(@>8310)  Program?
       F9DB 10,50
<0088> F9DD 6E,D9           BS   XBINP
<0089> F9DF D6,E0,14        CEQ  'V',V@20(@>8310)  Variable?
       F9E2 10,56
<0090> F9E4 40,71           BR   MMENU
<0091> F9E6 D6,E0,10        CEQ  'I',V@16(@>8310)  Internal?
       F9E9 10,49
<0092> F9EB 40,71           BR   MMENU
<0093> F9ED D7,E0,18        DCEQ '25',V@24(@>8310) Length 25_?
       F9F0 10,32,35
<0094> F9F3 40,71           BR   MMENU
<0095> F9F5 D6,E0,1A        CEQ  '4',V@26(@>8310)  Length 254?
       F9F8 10,34
<0096> F9FA 6E,D9           BS   XBINP
<0097> F9FC 40,71           BR   MMENU
<0098>                
<0099> F9FE D7,10,00 UPKEY  DCEQ >0081,@>8310      Top of screen?
       FA01 81
<0100> FA02 7A,0A           BS   GLESS             So scroll screen down
<0101> FA04 A7,10,00        DSUB 32,@>8310         Up one.
       FA07 20
<0102> FA08 5A,14           BR   GLESS2            Return
<0103> FA0A D7,04,25 GLESS  DCEQ >2580,@>8304      Start of buffer?
       FA0D 80
<0104> FA0E 77,FB           BS   OKKEY             Yes
<0105> FA10 A7,04,00        DSUB >20,@>8304        One more line down
       FA13 20

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0045 
E/A GROM
<0106> FA14 57,FB    GLESS2 BR   OKKEY
<0107> FA16 D6,E0,01 DKEY   CEQ  >20,V@1(@>8310)   Blank line?
       FA19 10,20
<0108> FA1B 79,FE           BS   UPKEY
<0109> FA1D D7,10,02        DCEQ >02C1,@>8310      Bottom of screen?
       FA20 C1
<0110> FA21 7A,29           BS   GMORE             So scroll screen up
<0111> FA23 A3,10,00        DADD 32,@>8310         Down one.
       FA26 20
<0112> FA27 57,FB           BR   OKKEY             No
<0113> FA29 D5,04,40 GMORE  DCEQ @>8340,@>8304     End of buffer?
<0114> FA2C 77,FB           BS   OKKEY             Yes
<0115> FA2E D6,A0,A2        CEQ  >20,V@>00A2       Last line in buffer?
       FA31 20
<0116> FA32 77,FB           BS   OKKEY             Yes
<0117> FA34 A3,04,00        DADD >20,@>8304        One more line up
       FA37 20
<0118> FA38 57,FB           BR   OKKEY
<0119> FA3A BE,76,12 LKEY   ST   18,@>8376         Line Counter
<0120> FA3D D7,10,00 LUPKEY DCEQ >0081,@>8310      Top of screen?
       FA40 81
<0121> FA41 7A,49           BS   LGLESS            So scroll screen down
<0122> FA43 A7,10,00        DSUB 32,@>8310         Up one.
       FA46 20
<0123> FA47 5A,53           BR   LGLES2            Return
<0124> FA49 D7,04,25 LGLESS DCEQ >2580,@>8304      Start of buffer?
       FA4C 80
<0125> FA4D 7A,55           BS   LOKKEY            Yes
<0126> FA4F A7,04,00        DSUB >20,@>8304        One more line down
       FA52 20
<0127> FA53 5A,55    LGLES2 BR   LOKKEY
<0128> FA55 06,FA,90 LOKKEY CALL FLSCR
<0129> FA58 92,76           DEC  @>8376            Line counter -1
<0130> FA5A 5A,3D           BR   LUPKEY            Continue Loop
<0131> FA5C 05,F8,02        B    NOKEY             Done.
<0132> FA5F BE,76,12 RKEY   ST   18,@>8376         Line Counter
<0133> FA62 D6,E0,01 RDKEY  CEQ  >20,V@1(@>8310)   Blank line?
       FA65 10,20
<0134> FA67 79,FE           BS   UPKEY
<0135> FA69 D7,10,02        DCEQ >02C1,@>8310      Bottom of screen?
       FA6C C1
<0136> FA6D 7A,75           BS   RGMORE            So scroll screen up
<0137> FA6F A3,10,00        DADD 32,@>8310         Down one.
       FA72 20
<0138> FA73 5A,86           BR   ROKKEY            No
<0139> FA75 D5,04,40 RGMORE DCEQ @>8340,@>8304     End of buffer?
<0140> FA78 7A,86           BS   ROKKEY            Yes
<0141> FA7A D6,A0,A2        CEQ  >20,V@>00A2       Last line in buffer?
       FA7D 20
<0142> FA7E 7A,86           BS   ROKKEY            Yes
<0143> FA80 A3,04,00        DADD >20,@>8304        One more line up
       FA83 20
<0144> FA84 5A,86           BR   ROKKEY
<0145> FA86 06,FA,90 ROKKEY CALL FLSCR
<0146> FA89 92,76           DEC  @>8376            Line counter -1
<0147> FA8B 5A,62           BR   RDKEY             Continue Loop
<0148> FA8D 05,F8,02        B    NOKEY             Done.
<0149> FA90 35,02,60 FLSCR  MOVE >0260,V*>8304,V@>0080 Fill screen
       FA93 A0,80,B0
       FA96 04
<0150> FA97 BE,B0,10        ST   130,V*>8310       Left arrow
       FA9A 82
<0151> FA9B BE,E0,0B        ST   131,V@11(@>8310)  Right arrow
       FA9E 10,83

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0046 
E/A GROM
<0152> FAA0 00              RTN
<0153>               *
<0154>               * PAB data
<0155>               *
<0156> FAA1 00,0D,08 CATDAT BYTE 0,>D,8,>36,0,0,0,0,0
       FAA4 36,00,00
       FAA7 00,00,00
<0157>               *
<0158> FAAA 40,02,00 HALVE  BYTE >40,>02,0,0,0,0,0,0
       FAAD 00,00,00
       FAB0 00,00
<0159>               *
<0160>               * Screen - prints initial screen and disk info
<0161>               *
<0162> FAB2 08       SCREEN FMT
<0163> FAB3 FE,00            ROW  0
<0164> FAB5 FF,02            COL  2
<0165> FAB7 1C,44,69         HTEX 'Directory=           Files000'
       FABA 72,65,63
       FABD 74,6F,72
       FAC0 79,3D,20
       FAC3 20,20,20
       FAC6 20,20,20
       FAC9 20,20,20
       FACC 20,46,69
       FACF 6C,65,73
       FAD2 30,30,30
<0166> FAD5 A0               ROW+ 1
<0167> FAD6 FF,02            COL  2
<0168> FAD8 14,46,72         HTEX 'Free=           Used='
       FADB 65,65,3D
       FADE 20,20,20
       FAE1 20,20,20
       FAE4 20,20,20
       FAE7 20,20,55
       FAEA 73,65,64
       FAED 3D
<0169> FAEE A0               ROW+ 1
<0170> FAEF FF,02            COL  2
<0171> FAF1 1C,20,46         HTEX ' Filename  Size    Type     P'
       FAF4 69,6C,65
       FAF7 6E,61,6D
       FAFA 65,20,20
       FAFD 53,69,7A
       FB00 65,20,20
       FB03 20,20,54
       FB06 79,70,65
       FB09 20,20,20
       FB0C 20,20,50
<0172> FB0F A0               ROW+ 1
<0173> FB10 FF,02            COL  2
<0174> FB12 1C,2D,2D         HTEX '---------- ---- ----------- -'
       FB15 2D,2D,2D
       FB18 2D,2D,2D
       FB1B 2D,2D,20
       FB1E 2D,2D,2D
       FB21 2D,20,2D
       FB24 2D,2D,2D
       FB27 2D,2D,2D
       FB2A 2D,2D,2D
       FB2D 2D,20,2D
<0175> FB30 FB              FEND
<0176> FB31 86,1E           CLR  @COUNT            Clear file counter
<0177> FB33 06,FC,9D        CALL DISSTR            Get string into FAC

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0047 
E/A GROM
<0178> FB36 8E,4B           CZ   @FAC1             Skip if zero length
<0179> FB38 7B,42           BS   CAT3
<0180> FB3A 08              FMT
<0181> FB3B FE,00            ROW 0
<0182> FB3D FF,0C            COL 12
<0183> FB3F E9,4C            HSTR 10,@FAC2
<0184> FB41 FB              FEND
<0185> FB42 A1,10,4A CAT3   DADD @FAC,@>8310       Go to next field
<0186> FB45 A3,10,00        DADD 19,@>8310         Continue to last field
       FB48 13
<0187> FB49 BF,14,00        DST  >28,@>8314        Set up screen addr
       FB4C 28
<0188> FB4D D7,AF,10        DCEQ >4453,V@>100A     DSK?
       FB50 0A,44,53
<0189> FB53 5B,5B           BR   CAT4              No, must be HARD
<0190> FB55 06,FC,7A        CALL DISNUM            Display available DSK space
<0191> FB58 05,FB,6E        B    CAT4A
<0192> FB5B 35,00,08 CAT4   MOVE 8,V*>8310,@ARG    Get Available space *2
       FB5E 5C,B0,10
<0193> FB61 31,00,08        MOVE 8,G@HALVE,@FAC    Get divisor
       FB64 4A,FA,AA
<0194> FB67 0F,09           XML  FDIV
<0195> FB69 0F,02           XML  ROUND
<0196> FB6B 06,FC,80        CALL DISNU1            Display available HARD space
<0197>               * Display used space
<0198> FB6E 35,00,08 CAT4A  MOVE 8,V*>8310,@FAC    Get Available space
       FB71 4A,B0,10
<0199> FB74 A7,10,00        DSUB 9,@>8310          Point to formatted space
       FB77 09
<0200> FB78 35,00,08        MOVE 8,V*>8310,@ARG    Move it to ARG
       FB7B 5C,B0,10
<0201> FB7E 0F,07           XML  FSUB              Develop used value *2
<0202> FB80 BF,14,00        DST  >38,@>8314        Set up screen addr
       FB83 38
<0203> FB84 D7,AF,10        DCEQ >4453,V@>100A     DSK?
       FB87 0A,44,53
<0204> FB8A 7B,9B           BS   CAT4B             Yes, must be DISK
<0205> FB8C 35,00,08        MOVE 8,@FAC,@ARG       Get Unused space *2
       FB8F 5C,4A
<0206> FB91 31,00,08        MOVE 8,G@HALVE,@FAC    Get divisor
       FB94 4A,FA,AA
<0207> FB97 0F,09           XML  FDIV
<0208> FB99 0F,02           XML  ROUND
<0209> FB9B 06,FC,80 CAT4B  CALL DISNU1            Display used space
<0210> FB9E 00              RTN                    Return
<0211>               *
<0212>               * Display one file on screen
<0213>               *
<0214> FB9F 06,FC,9D FILNAM CALL DISSTR            Get string into FAC
<0215> FBA2 90,1E           INC  @COUNT            FILE COUNT +1
<0216> FBA4 8E,4B           CZ   @FAC1             Skip display if zero
<0217> FBA6 7B,B0           BS   CAT5              length
<0218> FBA8 08              FMT                    Put disk name on screen
<0219> FBA9 FE,17            ROW   23              .
<0220> FBAB FF,02            COL   02              .
<0221> FBAD E9,4C            HSTR 10,@FAC2         .
<0222> FBAF FB              FEND                   .
<0223> FBB0 A1,10,4A CAT5   DADD @FAC,@>8310       Go to next field
<0224> FBB3 A3,10,00        DADD 10,@>8310         Continue another field
       FBB6 0A
<0225> FBB7 8F,B0,10        DCZ  V*>8310           Time to get out if
<0226> FBBA 7C,75           BS   FILNA1            zero file size
<0227> FBBC BF,14,02        DST  >2EA,@>8314       Set up screen address
       FBBF EA

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0048 
E/A GROM
<0228> FBC0 06,FC,7A        CALL DISNUM            Display file length
<0229> FBC3 A7,10,00        DSUB 9,@>8310          Back a field
       FBC6 09
<0230> FBC7 35,00,08        MOVE 8,V*>8310,@FAC    Move it into FAC
       FBCA 4A,B0,10
<0231> FBCD 0F,12           XML  CFI               Convert it to an int.
<0232> FBCF 8E,4A           CZ   @FAC              Non-negative?
<0233> FBD1 7B,D9           BS   CAT5A             YES! File not protected
<0234> FBD3 BC,A2,FE        ST   @>8302,V@>2FE     Put a 'Y' on screen
       FBD6 02
<0235> FBD7 83,4A           DNEG @FAC              Make number positive
<0236> FBD9 92,4B    CAT5A  DEC  @FAC1             Adjust for CASE
<0237> FBDB 8A,4B           CASE @FAC1             Show file type
<0238> FBDD 5B,E9           BR   DF                .
<0239> FBDF 5B,F9           BR   DV                .
<0240> FBE1 5C,09           BR   IF                .
<0241> FBE3 5C,19           BR   IV                .
<0242> FBE5 5C,29           BR   PR                .
<0243> FBE7 5C,39           BR   DI
<0244> FBE9 08       DF     FMT
<0245> FBEA FE,17            ROW   23
<0246> FBEC FF,12            COL   18
<0247> FBEE 06,44,69         HTEX 'Dis/Fix'
       FBF1 73,2F,46
       FBF4 69,78
<0248> FBF6 FB              FEND
<0249> FBF7 5C,4B           BR   CAT6
<0250> FBF9 08       DV     FMT
<0251> FBFA FE,17            ROW   23
<0252> FBFC FF,12            COL   18
<0253> FBFE 06,44,69         HTEX 'Dis/Var'
       FC01 73,2F,56
       FC04 61,72
<0254> FC06 FB              FEND
<0255> FC07 5C,4B           BR   CAT6
<0256> FC09 08       IF     FMT
<0257> FC0A FE,17            ROW   23
<0258> FC0C FF,12            COL   18
<0259> FC0E 06,49,6E         HTEX 'Int/Fix'
       FC11 74,2F,46
       FC14 69,78
<0260> FC16 FB              FEND
<0261> FC17 5C,4B           BR   CAT6
<0262> FC19 08       IV     FMT
<0263> FC1A FE,17            ROW   23
<0264> FC1C FF,12            COL   18
<0265> FC1E 06,49,6E         HTEX 'Int/Var'
       FC21 74,2F,56
       FC24 61,72
<0266> FC26 FB              FEND
<0267> FC27 5C,4B           BR   CAT6
<0268> FC29 08       PR     FMT
<0269> FC2A FE,17            ROW   23
<0270> FC2C FF,12            COL   18
<0271> FC2E 06,50,72         HTEX 'Program'
       FC31 6F,67,72
       FC34 61,6D
<0272> FC36 FB              FEND
<0273> FC37 5C,56           BR   CAT7              Return
<0274> FC39 08       DI     FMT
<0275> FC3A FE,17            ROW    23
<0276> FC3C FF,12            COL    18
<0277> FC3E 08,44,69         HTEX 'Directory'
       FC41 72,65,63

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0049 
E/A GROM
       FC44 74,6F,72
       FC47 79
<0278> FC48 FB              FEND
<0279> FC49 5C,56           BR   CAT7
<0280> FC4B A3,10,00 CAT6   DADD 18,@>8310         Advavce two fields
       FC4E 12
<0281> FC4F BF,14,02        DST  >2F6,@>8314       Set up screen address
       FC52 F6
<0282> FC53 06,FC,7A        CALL DISNUM            Display record length
<0283> FC56 35,00,1F CAT7   MOVE >1F,V@>02E0,V@0(@>8340)
       FC59 E0,00,40
       FC5C A2,E0
<0284> FC5E A3,40,00        DADD >20,@>8340
       FC61 20
<0285>               *
<0286>               * Scroll the screen
<0287>               *
<0288> FC62 35,02,60 SCROLL MOVE >260,V@>A0,V@>80  Scroll screen
       FC65 A0,80,A0
       FC68 A0
<0289> FC69 BE,A2,E0        ST   SPACE,V@>2E0      Clear last line
       FC6C 20
<0290> FC6D 35,00,1F        MOVE >1F,V@>2E0,V@>2E1
       FC70 A2,E1,A2
       FC73 E0
<0291> FC74 00              RTN                    Return
<0292> FC75 87,12    FILNA1 DCLR @>8312            Clear a byte
<0293> FC77 8E,12           CZ   @>8312            Set COND bit
<0294> FC79 01              RTNC                   Return w/COND
<0295>               * Display number subroutine
<0296>               *  ENTER: Floating number in FAC for DISNU1
<0297>               *         Screen address in >8314
<0298>               *
<0299> FC7A 35,00,08 DISNUM MOVE 8,V*>8310,@FAC    Move FLP number to FAC
       FC7D 4A,B0,10
<0300> FC80 86,55    DISNU1 CLR  @FAC11            Indicate a free format
<0301> FC82 06,00,14        CALL CNS               Convert FAC to a string
<0302> FC85 BF,16,00        DST  7,@>8316          Right justify number
       FC88 07
<0303> FC89 A4,17,56        S    @FAC12,@>8317
<0304> FC8C A1,14,16        DADD @>8316,@>8314
<0305> FC8F BC,B0,14 DISNU2 ST   *FAC11,V*>8314    Put a char on the screen
       FC92 90,55
<0306> FC94 91,14           DINC @>8314            Increment screen addr.
<0307> FC96 90,55           INC  @FAC11            Increment FAC addr.
<0308> FC98 92,56           DEC  @FAC12            Decrement string length count
<0309> FC9A 5C,8F           BR   DISNU2            Loop until done
<0310> FC9C 00              RTN                    Return to caller
<0311>               *
<0312>               * Prepare a VDP string for FORMAT statement
<0313>               *  LEAVE: FAC has string length (word)
<0314>               *         FAC2  has string
<0315>               *         >8310 pointing to next string in record
<0316>               *
<0317> FC9D BF,10,08 DISSTR DST  >0836,@>8310      Get buffer address
       FCA0 36
<0318> FCA1 86,4A           CLR  @FAC              Clear MSB of FAC word
<0319> FCA3 BC,4B,B0        ST   V*>8310,@FAC1     Store disk name length
       FCA6 10
<0320> FCA7 91,10           DINC @>8310            Point to string
<0321> FCA9 BE,4C,20        ST   >20,@FAC2         Clear out string space
<0322> FCAC 35,00,09        MOVE 9,@FAC2,@FAC3     .
       FCAF 4D,4C
<0323> FCB1 34,4A,4C        MOVE @FAC,V*>8310,@FAC2 Move disk name into FAC

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0050 
E/A GROM
       FCB4 B0,10
<0324> FCB6 00              RTN
<0325>               ***********************************************************
<0326> FCB7 FD,33    VEIW40 DATA EADSR             * Viewer 40 Column
<0327> FCB9 FC,BF           DATA MV40
<0328> FCBB 03,56,34        STRI 'V40'
       FCBE 30
<0329>               *******************************
<0330> FCBF BD,58,56 MV40   DST  @>8356,@>8358
<0331> FCC2 A5,58,54        DSUB @>8354,@>8358
<0332> FCC5 35,00,0A        MOVE 10,V@-10(@>8358),@FAC
       FCC8 4A,EF,FF
       FCCB F6,58
<0333> FCCD B2,EF,FF        AND  >1F,V@-9(@>8358)
       FCD0 F7,58,1F
<0334> FCD3 C6,4A,04        CH   >04,@FAC
<0335> FCD6 7D,16           BS   DSREXT
<0336> FCD8 8A,4A           CASE @FAC
<0337> FCDA 5C,F6           BR   VOPEN         * OPEN
<0338> FCDC 5D,19           BR   VCLOSE        * CLOSE
<0339> FCDE 5D,16           BR   DSREXT        * READ
<0340> FCE0 35,03,70        MOVE 880,V@80,V@0  * WRITE
       FCE3 A0,00,A0
       FCE6 50
<0341> FCE7 35,00,50        MOVE 80,V*FAC2,V@880
       FCEA A3,70,B0
       FCED 4C
<0342> FCEE 03              SCAN
<0343> FCEF 5D,16           BR   DSREXT
<0344> FCF1 03       FREEZE SCAN
<0345> FCF2 5C,F1           BR   FREEZE
<0346> FCF4 5D,16           BR   DSREXT
<0347> FCF6 35,00,80 VOPEN  MOVE 128,V@>0380,V@-128(@>8370)
       FCF9 EF,FF,80
       FCFC 70,A3,80
<0348> FCFF BE,4A,F0        ST   >F0,@FAC
<0349> FD02 3D,00,01        MOVE 1,@FAC,#1
       FD05 01,4A
<0350> FD07 BE,80,D4        ST   >F0,@>83D4
       FD0A F0
<0351> FD0B BE,A0,00        ST   >20,V@0
       FD0E 20
<0352> FD0F 35,03,BF        MOVE 959,V@0,V@1
       FD12 A0,01,A0
       FD15 00
<0353> FD16 06,00,12 DSREXT CALL RETURN
<0354> FD19 03       VCLOSE SCAN
<0355> FD1A 5D,19           BR   VCLOSE
<0356> FD1C 35,00,80        MOVE 128,V@-128(@>8370),V@>0380
       FD1F A3,80,EF
       FD22 FF,80,70
<0357> FD25 BE,00,E0        ST   >E0,@>8300
<0358> FD28 3D,00,01        MOVE 1,@>8300,#1
       FD2B 01,00
<0359> FD2D BE,80,D4        ST   >E0,@>83D4
       FD30 E0
<0360> FD31 5D,16           BR   DSREXT
<0361>               ************************************
<0362> FD33 FD,3A    EADSR  DATA SEADSR
<0363> FD35 E0,28           DATA OLDEA
<0364> FD37 02,45,41        STRI 'EA'
<0365> FD3A FD,41    SEADSR DATA XBDSR
<0366> FD3C E0,28           DATA OLDEA
<0367> FD3E 02,65,61        STRI 'ea'

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0051 
E/A GROM
<0368>               ************************************
<0369> FD41 FD,48    XBDSR  DATA SXBDSR
<0370> FD43 63,72           DATA RXB
<0371> FD45 02,58,42        STRI 'XB'
<0372> FD48 FD,4F    SXBDSR DATA BASIC
<0373> FD4A 63,72           DATA RXB
<0374> FD4C 02,78,62        STRI 'xb'
<0375>               ************************************
<0376> FD4F FD,59    BASIC  DATA SBASIC
<0377> FD51 21,6F           DATA >216F
<0378> FD53 05,42,41        STRI 'BASIC'
       FD56 53,49,43
<0379> FD59 00,00    SBASIC DATA >0000
<0380> FD5B 21,6F           DATA >216F
<0381> FD5D 05,62,61        STRI 'basic'
       FD60 73,69,63
<0382>               ************************************
<0383>                      END

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0052 
E/A GROM
Symbol Table #1 (New,alpha)  
0001 AID        835C ARG        F7D3 ARROW1     F7EC ARROW2     F7F3 ARROW3     
F7BF ARROWS     E82D ASSEM      000F BACK       F839 BACK0      F862 BACK1      
F872 BACK3      FD4F BASIC      000E BEGIN      F875 BEGIN0     F88A BEGIN1     
F89A BEGIN2     F8A3 BEGIN3     001C BERR       0038 BGETSS     EDE2 BINIT2     
EDEA BINIT3     E520 BLDPAB     E551 BLNKBU     EE22 BUGS       FB42 CAT3       
FB5B CAT4       FB6E CAT4A      FB9B CAT4B      FBB0 CAT5       FBD9 CAT5A      
FC4B CAT6       FC56 CAT7       FAA1 CATDAT     ED53 CCRMSG     EBEF CHKER2     
EBE4 CHKERR     8318 CHRCUR     0023 CIF        0002 CLEAR      E566 CLOSE      
F90E CLRBUF     E032 CLREA      EE34 CLRFAC     ECD4 CLRMSG     EF65 CLRREA     
E708 CLRXOP     EC30 CLSALL     EC4D CLSPAB     8322 CODE       E22D COLBAC     
E23A COLEND     077F COLOR      E1B7 COLORS     E210 COLSCN     831E COUNT      
8320 CURADD     EDC4 CUREDP     EDCC CURPAT     E17F DARROW     EE12 DASSM1     
E823 DDSK1      E828 DEDIT1     EE64 DEV1       EE7D DEV2       EE80 DEV3       
EE81 DEV4       EE3C DEVICE     EE7A DEVNO      FBE9 DF         FC39 DI         
F756 DIREC2     F766 DIREC3     F6C4 DIRECT     FC80 DISNU1     FC8F DISNU2     
FC7A DISNUM     FC9D DISSTR     FA16 DKEY       E821 DLEN       EE1D DLOAD      
F6C9 DMENU      E56A DOIO       F9C7 DORF80     FD16 DSREXT     0010 DSRLNK     
0012 DSRRET     EE17 DUTIL1     FBF9 DV         FD33 EADSR      E6E1 EASCRN     
E246 EDITOR     E3CF EMOPT2     8326 ENDLN      000D ENTER      F908 ENTER0     
F941 ENTER1     F950 ENTER2     F929 ENTR       8354 ERCODE     ED48 ERRC       
ED79 ERRCE      ED88 ERRDD      ED17 ERRIOC     ED6D ERRIT      ED0B ERRMF      
EC6D ERRMSG     ED26 ERRNME     ED3A ERRNTL     ECE0 ERROR      EDB2 ERRPNF     
ED9D ERRUR      E6BA EXPMEM     834A FAC        834B FAC1       8355 FAC11      
8356 FAC12      834C FAC2       834D FAC3       834E FAC4       834F FAC5       
8350 FAC6       8351 FAC7       8352 FAC8       8353 FAC9       F8C2 FCTNUP     
FC75 FILNA1     FB9F FILNAM     8348 FLAG       8349 FLAG2      FA90 FLSCR      
EAED FNDDON     EA8A FNDLNK     EA90 FNDLP      EAAD FNDSHO     FCF1 FREEZE     
0000 G0000      0001 G0001      E03B GE029      E047 GE056      E07C GE116      
E199 GE11F      E2B5 GE19B      E2FD GE1E2      E2FF GE1E4      E338 GE1F6      
E354 GE1FC      E385 GE22C      E390 GE237      E39B GE23B      E3C5 GE25B      
E3DB GE271      E3DC GE272      E3E5 GE27B      E3ED GE283      E418 GE29C      
E42F GE2B3      E431 GE2B5      E440 GE2C4      E455 GE2D9      E487 GE30A      
E49F GE322      E4A8 GE32B      E4C1 GE344      E4DC GE35F      E4DE GE361      
E4E4 GE367      E4FD GE380      E50A GE38D      E550 GE3CF      E596 GE415      
E5AC GE42B      E5AF GE42E      E5BD GE43C      E5C7 GE446      E5CD GE44C      
E5F6 GE456      E600 GE460      E621 GE46B      E626 GE470      E632 GE47C      
E63B GE485      E64F GE499      E661 GE4AB      E689 GE4D3      E693 GE4DD      
E6B7 GE501      E6B9 GE503      E793 GE597      E7A2 GE5A6      E7EA GE5E5      
E80A GE605      E875 GE654      E880 GE687      E953 GE736      E973 GE756      
E984 GE767      E9A1 GE784      E9BA GE7A2      E9BF GE7A7      E9CC GE7B1      
E9DB GE7C0      EA15 GE7F2      EA3B GE816      EA46 GE821      EA4B GE826      
EA5B GE848      EB11 GE883      EB1C GE88E      EB31 GE8A3      EB34 GE8A8      
EB3C GE8B0      EB3F GE8B3      EB60 GE8D4      EB6F GE8E3      EB81 GE8F5      
EB88 GE8FC      EB8E GE907      EB8F GE908      EB96 GE90F      EB9D GE916      
EBA4 GE91D      EBAF GE928      EBB6 GE92F      EBBD GE936      EBC4 GE93D      
EBCB GE944      EBD0 GE949      EBDF GE958      EC0D GE97A      EC1C GE97F      
EC77 GE9DA      EBA9 GE9E2      EC95 GE9F8      ECAF GEA12      ECBC GEA1F      
ECCB GEA2E      EDF4 GEBA0      EE11 GEBBD      E51D GETALL     E58B GETINP     
E5BE GETKEY     EF94 GF000      FA0A GLESS      FA14 GLESS2     FA29 GMORE      
FAAA HALVE      FC09 IF         8379 ITIMER     FC19 IV         8374 KBNO       
8375 KEY        E9E4 LANDR      8347 LDFLAG     FA53 LGLES2     FA49 LGLESS     
FA3A LKEY       E7AE LODPGM     E7BB LODUSR     FA55 LOKKEY     FA3D LUPKEY     
E010 MENU       E071 MMENU      EADC MORSCN     E086 MSCRN      FCBF MV40       
E18F MYEAXB     E78C MYSRCH     F82A NAID       E6DB NESCRN     E037 NEWEA      
E16F NEWSCN     E785 NO1KEY     F96A NODIR      E744 NOEABF     F802 NOKEY      
F7FB OKKEY      E028 OLDEA      EF73 ONEKEY     EACA OUTSCN     E819 PAB        
E544 PABNAM     831C PABPTR     E7D9 PGMLOD     E9A8 PLEASE     E7D1 PMSG       
F9A3 PORVI      FC29 PR         ECE9 PRESS      E716 PRGRM      000C PROCD      
E5DA PSCANX     FA62 RDKEY      0006 REDO       FA75 RGMORE     FA5F RKEY       
FA86 ROKKEY     0002 ROUND      E17C RTRXB      EA59 RUN        6372 RXB        
FD59 SBASIC     FAB2 SCREEN     FC62 SCROLL     FD3A SEADSR     E025 SOLDEA     
0020 SPACE      8324 STLN       8373 SUBSTK     FD48 SXBDSR     F7A7 TSTKE2     
F7AE TSTKE3     F7B2 TSTKE4     F7B5 TSTKE5     F79A TSTKEY     EF93 TWOKEY     

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0053 
E/A GROM
F9FE UPKEY      E6FA USSCRN     837D VCHAR      FD19 VCLOSE     FCB7 VEIW40     
E47D VFILE      E413 VIEWR      E406 VIT40      FCF6 VOPEN      8356 VPAB       
EDDC VREGS      836E VSTACK     E57F VZERO      F827 WAID       ED00 WARN       
ECC4 WENTER     EC61 WRNMSG     EEDE XBAGN      FD41 XBDSR      EED9 XBINP      
EF11 XBINP1     EF49 XBINP2     EF5B XBINP3     F9D8 XBPGM      8342 XTOKEN     
F81C YAID       E9B7 YESNO      

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0054 
E/A GROM
Symbol Table #2 (New,value)  
0000 G0000      0001 AID        0001 G0001      0002 CLEAR      0002 ROUND      
0006 REDO       000C PROCD      000D ENTER      000E BEGIN      000F BACK       
0010 DSRLNK     0012 DSRRET     001C BERR       0020 SPACE      0023 CIF        
0038 BGETSS     077F COLOR      6372 RXB        8318 CHRCUR     831C PABPTR     
831E COUNT      8320 CURADD     8322 CODE       8324 STLN       8326 ENDLN      
8342 XTOKEN     8347 LDFLAG     8348 FLAG       8349 FLAG2      834A FAC        
834B FAC1       834C FAC2       834D FAC3       834E FAC4       834F FAC5       
8350 FAC6       8351 FAC7       8352 FAC8       8353 FAC9       8354 ERCODE     
8355 FAC11      8356 FAC12      8356 VPAB       835C ARG        836E VSTACK     
8373 SUBSTK     8374 KBNO       8375 KEY        8379 ITIMER     837D VCHAR      
E010 MENU       E025 SOLDEA     E028 OLDEA      E032 CLREA      E037 NEWEA      
E03B GE029      E047 GE056      E071 MMENU      E07C GE116      E086 MSCRN      
E16F NEWSCN     E17C RTRXB      E17F DARROW     E18F MYEAXB     E199 GE11F      
E1B7 COLORS     E210 COLSCN     E22D COLBAC     E23A COLEND     E246 EDITOR     
E2B5 GE19B      E2FD GE1E2      E2FF GE1E4      E338 GE1F6      E354 GE1FC      
E385 GE22C      E390 GE237      E39B GE23B      E3C5 GE25B      E3CF EMOPT2     
E3DB GE271      E3DC GE272      E3E5 GE27B      E3ED GE283      E406 VIT40      
E413 VIEWR      E418 GE29C      E42F GE2B3      E431 GE2B5      E440 GE2C4      
E455 GE2D9      E47D VFILE      E487 GE30A      E49F GE322      E4A8 GE32B      
E4C1 GE344      E4DC GE35F      E4DE GE361      E4E4 GE367      E4FD GE380      
E50A GE38D      E51D GETALL     E520 BLDPAB     E544 PABNAM     E550 GE3CF      
E551 BLNKBU     E566 CLOSE      E56A DOIO       E57F VZERO      E58B GETINP     
E596 GE415      E5AC GE42B      E5AF GE42E      E5BD GE43C      E5BE GETKEY     
E5C7 GE446      E5CD GE44C      E5DA PSCANX     E5F6 GE456      E600 GE460      
E621 GE46B      E626 GE470      E632 GE47C      E63B GE485      E64F GE499      
E661 GE4AB      E689 GE4D3      E693 GE4DD      E6B7 GE501      E6B9 GE503      
E6BA EXPMEM     E6DB NESCRN     E6E1 EASCRN     E6FA USSCRN     E708 CLRXOP     
E716 PRGRM      E744 NOEABF     E785 NO1KEY     E78C MYSRCH     E793 GE597      
E7A2 GE5A6      E7AE LODPGM     E7BB LODUSR     E7D1 PMSG       E7D9 PGMLOD     
E7EA GE5E5      E80A GE605      E819 PAB        E821 DLEN       E823 DDSK1      
E828 DEDIT1     E82D ASSEM      E875 GE654      E880 GE687      E953 GE736      
E973 GE756      E984 GE767      E9A1 GE784      E9A8 PLEASE     E9B7 YESNO      
E9BA GE7A2      E9BF GE7A7      E9CC GE7B1      E9DB GE7C0      E9E4 LANDR      
EA15 GE7F2      EA3B GE816      EA46 GE821      EA4B GE826      EA59 RUN        
EA5B GE848      EA8A FNDLNK     EA90 FNDLP      EAAD FNDSHO     EACA OUTSCN     
EADC MORSCN     EAED FNDDON     EB11 GE883      EB1C GE88E      EB31 GE8A3      
EB34 GE8A8      EB3C GE8B0      EB3F GE8B3      EB60 GE8D4      EB6F GE8E3      
EB81 GE8F5      EB88 GE8FC      EB8E GE907      EB8F GE908      EB96 GE90F      
EB9D GE916      EBA4 GE91D      EBA9 GE9E2      EBAF GE928      EBB6 GE92F      
EBBD GE936      EBC4 GE93D      EBCB GE944      EBD0 GE949      EBDF GE958      
EBE4 CHKERR     EBEF CHKER2     EC0D GE97A      EC1C GE97F      EC30 CLSALL     
EC4D CLSPAB     EC61 WRNMSG     EC6D ERRMSG     EC77 GE9DA      EC95 GE9F8      
ECAF GEA12      ECBC GEA1F      ECC4 WENTER     ECCB GEA2E      ECD4 CLRMSG     
ECE0 ERROR      ECE9 PRESS      ED00 WARN       ED0B ERRMF      ED17 ERRIOC     
ED26 ERRNME     ED3A ERRNTL     ED48 ERRC       ED53 CCRMSG     ED6D ERRIT      
ED79 ERRCE      ED88 ERRDD      ED9D ERRUR      EDB2 ERRPNF     EDC4 CUREDP     
EDCC CURPAT     EDDC VREGS      EDE2 BINIT2     EDEA BINIT3     EDF4 GEBA0      
EE11 GEBBD      EE12 DASSM1     EE17 DUTIL1     EE1D DLOAD      EE22 BUGS       
EE34 CLRFAC     EE3C DEVICE     EE64 DEV1       EE7A DEVNO      EE7D DEV2       
EE80 DEV3       EE81 DEV4       EED9 XBINP      EEDE XBAGN      EF11 XBINP1     
EF49 XBINP2     EF5B XBINP3     EF65 CLRREA     EF73 ONEKEY     EF93 TWOKEY     
EF94 GF000      F6C4 DIRECT     F6C9 DMENU      F756 DIREC2     F766 DIREC3     
F79A TSTKEY     F7A7 TSTKE2     F7AE TSTKE3     F7B2 TSTKE4     F7B5 TSTKE5     
F7BF ARROWS     F7D3 ARROW1     F7EC ARROW2     F7F3 ARROW3     F7FB OKKEY      
F802 NOKEY      F81C YAID       F827 WAID       F82A NAID       F839 BACK0      
F862 BACK1      F872 BACK3      F875 BEGIN0     F88A BEGIN1     F89A BEGIN2     
F8A3 BEGIN3     F8C2 FCTNUP     F908 ENTER0     F90E CLRBUF     F929 ENTR       
F941 ENTER1     F950 ENTER2     F96A NODIR      F9A3 PORVI      F9C7 DORF80     
F9D8 XBPGM      F9FE UPKEY      FA0A GLESS      FA14 GLESS2     FA16 DKEY       
FA29 GMORE      FA3A LKEY       FA3D LUPKEY     FA49 LGLESS     FA53 LGLES2     
FA55 LOKKEY     FA5F RKEY       FA62 RDKEY      FA75 RGMORE     FA86 ROKKEY     
FA90 FLSCR      FAA1 CATDAT     FAAA HALVE      FAB2 SCREEN     FB42 CAT3       
FB5B CAT4       FB6E CAT4A      FB9B CAT4B      FB9F FILNAM     FBB0 CAT5       

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0055 
E/A GROM
FBD9 CAT5A      FBE9 DF         FBF9 DV         FC09 IF         FC19 IV         
FC29 PR         FC39 DI         FC4B CAT6       FC56 CAT7       FC62 SCROLL     
FC75 FILNA1     FC7A DISNUM     FC80 DISNU1     FC8F DISNU2     FC9D DISSTR     
FCB7 VEIW40     FCBF MV40       FCF1 FREEZE     FCF6 VOPEN      FD16 DSREXT     
FD19 VCLOSE     FD33 EADSR      FD3A SEADSR     FD41 XBDSR      FD48 SXBDSR     
FD4F BASIC      FD59 SBASIC     

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0056 
E/A GROM
Symbol Table #4 (Def,alpha)  
0034 ACCTON     835C ARG        0032 ATN        0036 BADTON     003B BITREV     
0012 CFI        0014 CNS        002C COS        0010 CSN        8372 DATSTK     
0001 DIVZER     0003 ERRIOV     0006 ERRLOG     0005 ERRNIP     0002 ERRSNN     
0004 ERRSQR     0028 EXP        834A FAC        0006 FADD       000A FCOMP      
0009 FDIV       0008 FMUL       836C FPERAD     0007 FSUB       0038 GETSPACE   
0022 INT        0010 LINK       0018 LOCASE     002A LOG        8370 MEMSIZ     
003D NAMLNK     8300 PAD        0024 PWR        0012 RETURN     000B SADD       
000F SCOMP      000E SDIV       8375 SGN        002E SIN        000D SMUL       
8400 SOUND      0026 SQR        000C SSUB       837C STATUS     0016 STCASE     
8373 SUBSTK     0030 TAN        0007 TRIGER     004A UPCASE     836E VSPTR      
0001 WRNOV      837F XPT        837E YPT        

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0057 
E/A GROM
Symbol Table #8 (Def,value)  
0001 DIVZER     0001 WRNOV      0002 ERRSNN     0003 ERRIOV     0004 ERRSQR     
0005 ERRNIP     0006 ERRLOG     0006 FADD       0007 FSUB       0007 TRIGER     
0008 FMUL       0009 FDIV       000A FCOMP      000B SADD       000C SSUB       
000D SMUL       000E SDIV       000F SCOMP      0010 CSN        0010 LINK       
0012 CFI        0012 RETURN     0014 CNS        0016 STCASE     0018 LOCASE     
0022 INT        0024 PWR        0026 SQR        0028 EXP        002A LOG        
002C COS        002E SIN        0030 TAN        0032 ATN        0034 ACCTON     
0036 BADTON     0038 GETSPACE   003B BITREV     003D NAMLNK     004A UPCASE     
8300 PAD        834A FAC        835C ARG        836C FPERAD     836E VSPTR      
8370 MEMSIZ     8372 DATSTK     8373 SUBSTK     8375 SGN        837C STATUS     
837E YPT        837F XPT        8400 SOUND      

 

  • Like 1
Link to comment
Share on other sites

On 9/27/2020 at 1:22 PM, webdeck said:

Thanks for the pointer to the development resources thread - great stuff there.  I'm surprised that more original source code hasn't surfaced over the years, like the GPL source for GROMs 0-2.

TI Intern by Heimer Martin has the commented disassembly. Link copied from Retrocloud's essential Development Resources thread linked above.

 

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...