*************************************************************      
       GROM >E000
       AORG >0000
       TITL  'Rich E/A GROM'
*************************************************************
* CPU
*
TMP    EQU   >8300
TMP1   EQU   >8301
TMP2   EQU   >8302
TMP3   EQU   >8303
TMP4   EQU   >8304
TMP6   EQU   >8306
TMP7   EQU   >8307
TMP8   EQU   >8308
SCADD  EQU   >8310
SCADE  EQU   >8311
TEMP   EQU   >8316
TEMP1  EQU   >8317
CHRCUR EQU   >8318
PABPTR EQU   >831C
COUNT  EQU   >831E            CATALOG COUNT FILES
CURADD EQU   >8320
CODE   EQU   >8322
STLN   EQU   >8324
ENDLN  EQU   >8326
XTOKEN EQU   >8342
LDFLAG EQU   >8347
FLAG   EQU   >8348
FLAG2  EQU   >8349
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
VPAB   EQU   >8356
ARG    EQU   >835C
ARG1   EQU   >835D
ARG2   EQU   >835E
ARG4   EQU   >8360
ARG6   EQU   >8362
VSTACK EQU   >836E
SUBSTK EQU   >8373
KBNO   EQU   >8374
KEY    EQU   >8375
ITIMER EQU   >8379
VCHAR  EQU   >837D
********************
* GENERAL
*
AID    EQU   1
CLEAR  EQU   2
REDO   EQU   6
PROCD  EQU   12
ENTER  EQU   13
BEGIN  EQU   14
BACK   EQU   15
SPACE  EQU   32
* XML's ************
*
ROUND  EQU   >02
CIF    EQU   >23
* VDP **************
*
COLOR  EQU   >077F
* GROM *************
*
DSRLNK EQU   >0010
DSRRET EQU   >0012
BERR   EQU   >001C
BGETSS EQU   >0038
RXB    EQU   >6372
***********************************************************
* GROM Header
       BYTE  >AA              * Header byte
       BYTE  11               * Version #
       BYTE  1                * # programs
       BYTE  0                * Reserved
       DATA >0000             * POWER UP
       DATA  MENU             * Cartridge menu
       DATA  EADSR            * DSRs
       DATA  >0000            * Subroutines
       DATA  >0000            * Interupts
       DATA  >0000            * TI BASIC
MENU   DATA  >0000
       DATA  SETUP
       STRI  'REA VERSION 2015'
*********************************************************
* Set up configure paths       
SETUP  CEQ   >99,V@>0EFF      PREVIOUS RUN FLAG SET?
       BS    SOLDEA           Yes
       ST    >99,V@>0EFF      No, SET PREVIOUS RUN FLAG
       CLR   V@>0F00      
       MOVE  >FF,V@>0F00,V@>0F01
       MOVE  11,G@C1,V@>0F00  DSK1.EDIT1
       MOVE  11,G@C2,V@>0F28  DSK1.ASSM1
       MOVE  12,G@C3,V@>0F50  DSK1.SOURCE 
       MOVE  12,G@C4,V@>0F78  DSK1.OBJECT
       MOVE  10,G@C5,V@>0FA0  DSK1.LIST
       MOVE  2,G@C6,V@>0FC8   L
* NORMAL RXB START OF EA MODULE      
SOLDEA CALL  NESCRN
OLDEA  CHE   >38,@XTOKEN      Flag to high?
       BS    CLREA            Yes
       CHE   >31,@XTOKEN      Flag set?
       BS    NEWEA            yes
CLREA  CALL  CLRREA
       CLR   @XTOKEN          Reset RXB flag
       CLR   V@>3EF0   Clear RXB MENU Flag
NEWEA  DCLR  @>2000
GE029  CALL  EASCRN
       CLR   @>8344           * Disk SEARCH FLAG
       DST   >0B00,@FAC
       CALL  UPCASE
GE056  ST    5,@KBNO
       DST   >0900,@FAC
       CALL  LOCASE
       CLR   V@>0800
       MOVE  >00FF,V@>0800,V@>0801
       MOVE  6,G@VREGS,#1
       CLR   V@>1000          * CLEAR PAB AREAS
       MOVE  >0380,V@>1000,V@>1001
       AND   >EF,@>83C2
       MOVE  16,G@CURPAT,V@>08F0
       MOVE  16,G@DARROW,V@>0C10
*
*  Display Main Menu
*
MMENU  ST    >7E,@SUBSTK       * Set SUBSTACK
       DCLR  @CODE
       DCLR  @FLAG
       CLR   @LDFLAG
       ALL   SPACE
GE116  CHE   >38,@XTOKEN
       BS    MSCRN
       CHE   >31,@XTOKEN
       BS    MYEAXB
MSCRN  HOME
       FMT
       COL   1
       HTEX  'Rich Editor & Assembler V=2015'
       ROW+  1
       COL   0
       HCHA  32,95
       ROW+  2
       COL   6
       HTEX  'S    SET PATH NAMES'
       ROW+  4
       COL   6
       HTEX  'D    DIRECTORY' 
       ROW+  3
       COL   6
       HTEX  'A    ASSEMBLER'
       ROW+  2
       COL   6
       HTEX  'E    EDITOR'
       ROW+  2
       COL   6
       HTEX  'X    XB PROGRAM'   
       ROW+  2
       COL   6
       HTEX  'L    LOAD and RUN'
       ROW+  2
       COL   6
       HTEX  'P    PROGRAM FILE'
       ROW+  4
       COL   6
       HTEX  '.    R X B'
       FEND
NEWSCN SCAN
       BR    NEWSCN
       CEQ   >2E,@KEY         * .?
       BR    NSCAN            * Yes
RTRXB  B     RXB              * Go RXB
MYEAXB DCLR  V@>2250          * Clear Pass flag
       ST    @XTOKEN,@KEY
       ST    >EA,@XTOKEN      * Load Flag
NSCAN  CEQ   'L',@KEY         * L?
       BS    NSCAN1
       CEQ   'l',@KEY         * l?
       BS    NSCAN1
       CEQ   '3',@KEY         * 3?
       BR    NSCAN2
NSCAN1 ST    >33,@KEY         * Set LOAD & RUN
       CEQ   >33,@KEY         * LOAD AND RUN?
       BS    LANDR
NSCAN2 CEQ   'P',@KEY         * P?
       BS    NSCAN3
       CEQ   'p',@KEY         * p?
       BS    NSCAN3
       CEQ   '5',@KEY         * 5
       BR    NSCAN4
NSCAN3 ST    >35,@KEY         * SET RUN PROGRAM
       CEQ   >35,@KEY         * PROGRAM?
       BS    PRGRM
NSCAN4 CEQ   'A',@KEY         * A?
       BS    NSCAN5
       CEQ   'a',@KEY         * a?
       BS    NSCAN5
       CEQ   '2',@KEY         * 2?
       BR    NSCAN6 
NSCAN5 ST    >32,@KEY         * SET ASSEMBLER
       CEQ   >32,@KEY         * ASSEMBLER?
       BS    ASSEM                         
NSCAN6 CEQ   'E',@KEY         * E?
       BS    NSCAN7
       CEQ   'e',@KEY         * e?
       BS    NSCAN7
       CEQ   '1',@KEY         * 1?
       BR    NSCAN8
NSCAN7 ST    >31,@KEY         * SET EDITOR
       CEQ   >31,@KEY         * EDITOR? 
       BS    EDITOR
NSCAN8 CEQ   'D',@KEY         * D?  
       BS    DIRECT
       CEQ   'd',@KEY         * d?
       BS    DIRECT       
       CEQ   'X',@KEY         * X?
       BS    XBINP
       CEQ   'x',@KEY         * x?
       BS    XBINP
       CEQ   'S',@KEY         * S?
       BS    CONFIG
       CEQ   's',@KEY         * s?
       BR    NEWSCN
******************************************************
* CONFIGURE PATHS
*
CONFIG CALL  EASCRN
       CLR   @XTOKEN
       CALL  CLRREA
       ALL   SPACE
       HOME
       FMT
       COL   6
       HTEX  '* CONFIGURE PATHS *'
       FEND
       ST    49,V@65            1
       MOVE  40,V@>0F00,V@67    DSK1.EDIT1
       ST    50,V@161           2
       MOVE  40,V@>0F28,V@163   DSK1.ASSM1
       ST    51,V@257           3
       MOVE  40,V@>0F50,V@259   DSK1.SOURCE
       ST    52,V@353 
       MOVE  40,V@>0F78,V@355   DSK1.OBJECT
       ST    53,V@449           5
       MOVE  40,V@>0FA0,V@451   DSK1.LIST
       FMT
       ROW   17
       COL   1
       HTEX  '6  OPTIONS:'
       ROW   21
       COL   4
       HTEX  'CTRL 1 - 5 DRIVE SELECTION'
       ROW   23
       COL   4
       HTEX  'ANY OTHER KEY TO MAIN MENU'
       FEND
       MOVE  40,V@>0FC8,V@556   OPTIONS: L
CONFIH SCAN
       BR    CONFIH 
       CHE   '7',@KEY        <7?
       BS    CONFIL          Exit out
       CHE   '1',@KEY        1 to 6 only valid
       BR    CLREA           Exit out
       DST   65,@CURADD      Cursor Location 
       CHE   >30,@KEY        KEY>48?
       BR    CONFIH
       SUB   >30,@KEY        KEY-48
       ST    @KEY,@TMP       Save key 0-5
       ST    @KEY,@TMP8      Save key 1-6
       DEC   @TMP            -1
       MUL   96,@TMP         Add 64 Cursor Address
       DADD  @TMP,@CURADD    Cursor address   
       ST    130,V*CURADD    Left Arrow
       DADD  35,@CURADD      Cursor
       DST   @CURADD,@TMP4   Save address 
CONFIJ CALL  GETINP          Get input
       DCZ   @FAC6           Length 0?
       BS    CONFIG
       CHE   39,@FAC         <39?
       BS    CONFIG
       DCLR  @TMP6           Index
CONFIK DADD  40,@TMP6        Index+40 
       DEC   @TMP8           Copy of KEY
       BR    CONFIK
       ST    @FAC7,V@>0ED8(@TMP6)  Length
       MOVE  39,V*TMP4,V@>0ED9(@TMP6) String
       BR    CONFIG
MMMENU ST    >EA,@XTOKEN     Set flag
       BR    MMENU           Exit
* CTRL keys ***************************************
CONFIL CHE   182,@KEY        CTRL 5?
       BS    CONFIG
       CHE   177,@KEY
       BR    CONFIG
       CALL  ACCTON          ACCEPT TONE
       ST    @KEY,@TMP4      SAVE KEY
       SUB   176,@TMP4       CTRL=1 to 5
       DCLR  @ARG
       DST   -25,@TMP        SCREEN ADDRESS
       DST   >0EDC,@ARG      MEMORY ADDRESS
CONFLP DADD  40,@ARG         40*VALUE
       DADD  96,@TMP         96*VALUE 
       DEC   @TMP4
       BR    CONFLP 
       ST    30,@TMP6
CONDEU DST   >0160,@TMP2     COUNTER 
CONDEV SCAN
       BS    CONDST 
       DDEC  @TMP2           COUNTER-1
       BR    CONDEV
       EX    V*TMP,@TMP6     SWAP
       B     CONDEU
CONDST CALL  ACCTON
       ST    @KEY,V*TMP      SCREEN ADDRESS #
       ST    @KEY,V*ARG      MEMORY ADDRESS #  
       BR    CONFIG      
**************************************************
*  Main Menu Option 1: EDIT
*
EDITOR CALL  EASCRN
       DCLR  @FLAG
       CLR   @LDFLAG
       ST    >EA,@XTOKEN
       FMT
       COL   >0B
       ROW   1
       HTEX  '* EDITOR *'
       ROW+  3
       COL   3
       HTEX  '1    LOAD'
       ROW+  1
       COL+  23
       HTEX  '2    EDIT'
       ROW+  1
       COL+  23
       HTEX  '3    SAVE'
       ROW+  1
       COL+  23
       HTEX  '4    PRINT'
       ROW+  1
       COL+  22
       HTEX  '5    PURGE'
       ROW+  1
       COL+  22
       FEND
GE19B  SCAN
       BR    GE19B
       CEQ   BACK,@KEY       * BACK KEY
       BS    CLREA
       SUB   >31,@KEY
       CHE   >06,@KEY
       BS    GE19B
       DCLR  @FLAG
       ST    >7E,@SUBSTK
       ST    @KEY,@TMP       * Save KEY
       MUL   >40,@TMP
       DST   >0082,@CURADD
       DADD  @TMP,@CURADD  
       ST    130,V*CURADD    * SHOW ARROW 
       ST    @KEY,@TMP4
       CEQ   4,@KEY          * PURGE?
       BR    GE1E4           * No, next check
*  Edit Menu Option 5: PURGE
       FMT
       ROW+  2
       HTEX  'Are you sure (Y/N)? '
       FEND
       CALL  YESNO
       CEQ   >59,@KEY
       BR    EDITOR
       CALL  CLRXOP
GE1E2  BR    EDITOR
GE1E4  CEQ   >03,@KEY         * PRINT?
       BS    GE237            * YES!
       DCEQ  >55AA,@>2000     * EDIT1 loaded?
       BS    GE1FC            * Yes
       MOVE  99,V@>2250,@>EA00
       ST    @XTOKEN,@>FFFB
       CALL  P1000
       CALL  NPAB       
       MOVE  40,V@>0F00,V@>1009  Get configured path EDIT1
       ST    1,@LDFLAG           Set Editor flag
GE1F6  CALL  PGMLOD
       DCEQ  >55AA,@>2000
       BR    EDITOR
       CALL  CLRXOP
       MOVE  99,@>EA00,V@>2250
       ST    @>FFFB,@XTOKEN
GE1FC  CEQ   >01,@TMP4       * Edit?
       BS    EMOPT2          * Yes
       CEQ   >02,@TMP4       * Save?
       BR    GE237           * No
*  Edit Menu Option 3: SAVE
       CLR   @XTOKEN
       FMT
       COL   2
       ROW   16
       HTEX  'DV80 Format (Y/N)? '
       FEND
       CALL  YESNO
       CEQ   >59,@KEY
       BR    GE22C
       OR    >02,@FLAG2
GE22C  CEQ   BACK,@KEY
       BS    EDITOR
       DST   >0262,@CURADD
       BR    GE23B
GE235  CLR   @XTOKEN          * CLEAR XTOKEN FLAG
GE237  DST   >0202,@CURADD    * Print or Load
       MOVE  255,V@>0200,V@>201
GE23B  MOVE  10,G@FPATH,V*CURADD
       DADD  >0040,@CURADD
* CONFIGURE PATH SOURCE *********************************
       DCLR @TEMP
       ST   V@>0F50,@TEMP1
       DST  @TEMP,V@>2255
       MOVE @TEMP,V@>0F51,V@>2257 Save as SOURCE
       ST   >0D,V@>2258(@TEMP) 

       CHE   >02,@TMP4       SAVE, PRINT ?
       BS    EINPUT
       CEQ   >EA,@XTOKEN
       BS    EINPUT
       BR    EINPUT
       CALL  BLNKBU
       CALL  BLDPAB
       BR    EMOPT1              
EINPUT CALL  GETALL
EMOPT1 CEQ   BACK,@KEY       * BACK?
       BS    CLREA
       CEQ   >02,@TMP4       * Save?
       BS    GE2B5
       CEQ   >03,@TMP4       * Print?
       BS    GE2D9
       CZ    @TMP4           * Load?
       BS    GE272
*  Edit Menu Option 2: EDIT
EMOPT2 XML   >23
       BS    GE8B0
       CALL  GE8FC
       BR    EDITOR
GE272  ST    >EA,@XTOKEN     SET XTOKEN
       CALL  GE27B
       XML   >21
       BS    GE8B3
       BR    EDITOR
*********************************************
GE27B  ST    >04,V@1(@PABPTR)
       AND   >FD,@FLAG2
GE283  DST   @PABPTR,@VPAB
       DADD  >0009,@VPAB
       CALL  DSRLNK
       BYTE  >08
       BS    CHKERR
       CLOG  >E0,V@1(@PABPTR)
       BR    GE29C
       ST    >02,V*PABPTR
       RTN
**********************************************
GE29C  ST    V@1(@PABPTR),@TMP
       AND   >1F,@TMP
       CEQ   >04,@TMP
       BR    GE2B3
       ST    >14,V@1(@PABPTR)
       OR    >02,@FLAG2
       BR    GE283
GE2B3  BR    CHKERR
GE2B5  ST    >02,V@1(@PABPTR)
       CLOG  >02,@FLAG2
       BS    GE2C4
       ST    >12,V@1(@PABPTR)
GE2C4  CALL  DOIO
       ST    >03,V*PABPTR
       ST    >50,V@5(@PABPTR)
       XML   >22
       BS    GE8B3
       CALL  CLOSE
       BR    EDITOR
* Edit Menu Option 4 : PRINT output
GE2D9  CALL  GE27B
       FMT
       COL   2
       ROW   20
       HTEX  'DEVICE NAME?'
       FEND
       DST   >02C2,@CURADD   * Cursor Address
       DST   >1100,@PABPTR   * PAB address
       CEQ   >04,@TMP4       * VIEW?
       BS    VFILE           * No
       CLR   @XTOKEN
       CALL  CLRREA
VFILE  CALL  GETALL
       CLR   @XTOKEN
       ST    >50,V@5(@PABPTR)
GE30A  ST    >12,V@1(@PABPTR)
       DST   >1080,V@2(@PABPTR)
       CALL  DOIO
       CEQ   >20,V@4(@PABPTR)
       BR    GE322
       OR    >02,@FLAG
GE322  ST    >03,V*PABPTR
       CLOG  >02,@FLAG
       BS    GE38D
GE32B  CALL  P1000
       CALL  BLNKBU
       CALL  DOIO
       DST   >1100,@PABPTR
       DST   >1080,@TMP
       DADD  >004F,@TMP
       ST    >50,@TMP2
GE344  ST    V*TMP,@TMP3
       CEQ   >20,@TMP3
       BS    GE361
       CEQ   >0C,@TMP3
       BR    GE35F
       ST    >20,V*TMP
       CALL  DOIO
       CALL  DOIO
       CALL  DOIO
GE35F  BR    GE367
GE361  DDEC  @TMP
       DEC   @TMP2
       BR    GE344
GE367  CALL  DOIO
       SUB   >20,@TMP2
       CGT   >00,@TMP2
       BR    GE380
       DADD  >0020,V@2(@PABPTR)
       ST    @TMP2,V@5(@PABPTR)
       B     GE367
GE380  DST   >1080,V@2(@PABPTR)
       ST    >20,V@5(@PABPTR)
       BR    GE32B
GE38D  CALL  P1000
       CALL  BLNKBU
       CALL  DOIO
       DST   >1100,@PABPTR
       CALL  DOIO
       BR    GE38D
GETALL CALL  BLNKBU
*  Build PAB with name
BLDPAB CALL  VZERO
       DST   @PABPTR,V@2(@PABPTR)
       DADD  >0080,V@2(@PABPTR)
       ST    >00,V@8(@PABPTR)
       DST   >5000,V@4(@PABPTR)
       DCLR  V@>2250
       CALL  GETINP
       DCZ   @FAC6
       BS    GE3CF
PABNAM MOVE  @FAC6,V*FAC4,V@10(@PABPTR)
       ST    @FAC7,V@9(@PABPTR)
GE3CF  RTN
BLNKBU DADD  >0080,@PABPTR
       ST    >20,V*PABPTR
       MOVE  >004F,V*PABPTR,V@1(@PABPTR)
       DSUB  >0080,@PABPTR
       RTN
CLOSE  ST    >01,V*PABPTR
DOIO   DST   @PABPTR,@VPAB
       DADD  >0009,@VPAB
       CALL  DSRLNK
       BYTE  >08
       BS    CHKERR
       CLOG  >E0,V@1(@PABPTR)
       BR    CHKERR
       RTN
VZERO  CLR   V*PABPTR
       MOVE  >0045,V*PABPTR,V@1(@PABPTR)
       RTN
GETINP CALL  GETKEY
       DST   @STLN,@CURADD
       ST    >3C,@TMP
       DCLR  @FAC6
GE415  CEQ   SPACE,V*CURADD
       BR    GE42B
       DINC  @CURADD
       DEC   @TMP
       BR    GE415
       DST   @STLN,@CURADD
       CLOG  >04,@FLAG
       BR    GE43C
       BR    GETINP
GE42B  DST   @CURADD,@FAC4
GE42E  CEQ   SPACE,V*CURADD
       BS    GE43C
       DINC  @FAC6
       DINC  @CURADD
       DEC   @TMP
       BR    GE42E
GE43C  RTN
*  Key input routine
GETKEY ST    >1F,@CHRCUR
       DST   @CURADD,@ENDLN
       DST   @CURADD,@STLN
GE446  CLR   @ITIMER
       EX    V*CURADD,@CHRCUR
*  REPEAT KEYS
GE44C  SCAN
       BS    GE456
       CHE   7,@ITIMER
       BR    GE44C
       CEQ   >EA,@XTOKEN      * ANYTHING
       BR    GE446
PSCANX DST   V@>2250,@>8376
       ST    V@>2257(@>8376),@KEY
       DINC  @>8376
       DST   @>8376,V@>2250
       CEQ   @>8376,V@>2256
       BR    GE456
       ST    >0D,@KEY         * Store ENTER
GE456  CEQ   >1F,V*CURADD
       BR    GE460
       EX    V*CURADD,@CHRCUR
GE460  DST   @CURADD,@TMP
       DSUB  @STLN,@TMP
       CH    >19,@KEY         * SPACE key and higher?
       BS    GE46B
       CEQ   7,@KEY           * FCTN 3?
       BR    GE485
       ST    SPACE,V*STLN
       MOVE  >003F,V*STLN,V@1(@STLN)
       DST   @STLN,@CURADD
       BR    GETKEY
GE46B  CLOG  >01,@FLAG
       BR    GE4DD
GE470  ST    @KEY,V*CURADD
       DCH   @ENDLN,@CURADD
       BR    GE47C
       DST   @CURADD,@ENDLN
GE47C  CH    >3F,@TMP1
       BS    GE446
       DINC  @CURADD
       BR    GE446
GE485  AND   >FE,@FLAG
       CEQ   BACK,@KEY
       BR    GE499
       CLOG  >20,@FLAG
       BR    CLREA            * GE97F
       CLOG  >04,@FLAG
       BR    CLREA
       BR    EDITOR
GE499  CEQ   >09,@KEY
       BS    GE47C
       CEQ   >08,@KEY
       BR    GE4AB
       CZ    @TMP1
       BS    GE446
       DDEC  @CURADD
       BR    GE446
GE4AB  CEQ   >0D,@KEY
       BS    GE503
       CEQ   >03,@KEY
       BR    GE4D3
       ST    SPACE,V*CURADD
       DST   @ENDLN,@TMP
       DSUB  @CURADD,@TMP
       CGT   >00,@TMP1
       BR    GE446
       MOVE  @TMP,V@1(@CURADD),V*CURADD
       ST    SPACE,V*ENDLN
       DDEC  @ENDLN
       BR    GE446
GE4D3  CEQ   >04,@KEY
       BR    GE501
       OR    >01,@FLAG
       BR    GE446
GE4DD  DST   @ENDLN,@TMP
       DSUB  @STLN,@TMP
       CH    >3F,@TMP1
       BS    GE446
       DST   @ENDLN,@TMP
       DSUB  @CURADD,@TMP
       DINC  @TMP
       MOVE  @TMP,V*CURADD,V@>03C0
       MOVE  @TMP,V@>03C0,V@1(@CURADD)
       DINC  @ENDLN
       BR    GE470
GE501  BR    GE446
GE503  RTN
*  Check for Expansion Memory
EXPMEM ST    @>2000,@TMP
       ST    >FF,@>2000
       CEQ   >FF,@>2000
       BR    GE91D
       CLR   @>2000
       CZ    @>2000
       BR    GE91D
       ST    @TMP,@>2000
       RTN
NESCRN BACK  >F4
       ST    >F4,V@COLOR
EASCRN ST    >D0,V@>0300
       ST    V@COLOR,V@>0380
       MOVE  31,V@>0380,V@>0381
       ALL   SPACE
       MOVE  1,V@COLOR,#7
       RTN
USSCRN ST    >13,V@>0380
       MOVE  31,V@>0380,V@>0381
       ALL   SPACE
       RTN
CLRXOP CLR   @>FFD8
       MOVE  5,@>FFD8,@>FFD9
       RTN
***********************************************************
*
* Main Menu Option 2: ASSEMBLER
*
ASSEM  ALL   SPACE
       FMT
   COL   10
   ROW   1
   HTEX  '* ASSEMBLER *'
   FEND
       DCLR  @FLAG
       CLR   @LDFLAG
       ST    >7E,@SUBSTK
       OR    >20,@FLAG
       DCEQ  >AA55,@>2000
       BS    GE687
       MOVE  99,V@>2250,@>EA00
       ST    @XTOKEN,@>FFFB
       CLR   @XTOKEN
* Replacement for LODPGM
*       CALL  LODPGM
*       DATA  DASSM1
*       CALL  DEVICE
*       CEQ   BACK,@KEY
*       BS    CLREA
       CALL  P1000
       MOVE  15,G@PAB,V*PABPTR        
       MOVE  40,V@>0F28,V@>1009  Get configured path ASSM1

       ST    2,@LDFLAG
GE654  CALL  PGMLOD
       DCEQ  >AA55,@>2000
       BR    ASSEM
*  CALL FILES (4)
GE687  DST   >0116,V@>1380
       DST   >1380,@VPAB
       ST    >04,@FAC2
       CALL  DSRLNK
       BYTE  >0A
       MOVE  99,@>EA00,V@>2250
       ST    @>FFFB,@XTOKEN
       ALL   32
       FMT
       COL   10
       ROW   1
       HTEX  '* ASSEMBLER *'
       FEND
       CALL  P1000
** CONFIGURE PATH SOURCE ************************
       CALL  VZERO
       CALL  LPAB
       DST   >1080,V@2(@PABPTR)
       ST    >00,V@8(@PABPTR)
       DST   >5000,V@4(@PABPTR)
       DCLR  V@>2250 
       MOVE  40,V@>0F50,V@9(@PABPTR)   
       DST   >1080,V@2(@PABPTR)
       CALL  GE27B
       CLR   @XTOKEN
       DST   >1100,@PABPTR
       DST   >0142,@CURADD
** CONFIGURE PATH OBJECT *************************
       CALL  VZERO
       CALL  LPAB
       ST    >00,V@1(@PABPTR)
       DST   >1180,V@2(@PABPTR)
       ST    >00,V@8(@PABPTR)
       DST   >5000,V@4(@PABPTR)
       DCLR  V@>2250     
       MOVE  40,V@>0F78,V@9(@PABPTR)
       DST   >1180,V@2(@PABPTR)
       CALL  DOIO
       OR    >40,@FLAG
       DST   >1200,@PABPTR
       OR    >04,@FLAG
** CONFIGURE PATH LIST **************************
       CALL  VZERO
       CALL  LPAB
       ST    >12,V@1(@PABPTR)
       DST  >1280,V@2(@PABPTR)
       ST    >00,V@8(@PABPTR)
       DST   >5000,V@4(@PABPTR)
       DCLR  V@>2250     
       MOVE  40,V@>0FA0,V@9(@PABPTR)
       DCZ   @FAC6
       BS    GE736
       ST    >12,V@1(@PABPTR)
       DST   >1280,V@2(@PABPTR)
       CALL  DOIO
       OR    >80,@FLAG
GE736  FMT
       COL   2
       ROW   16
       HTEX  'Options?'
       FEND
       DST   >0242,@CURADD
** CONFIGURE PATH OPTIONS ********************
       MOVE  20,V@>0FC9,V@>03C0
       AND   >FB,@FLAG
       DCZ   @FAC6
       BR    GE756
GE756  MOVE  15,V@>0FC9,@>20D2
       CALL  CLRXOP
       ALL   SPACE
       XML   >21
       BS    GE8B3
GE767  CALL  CLRXOP
       CALL  P1000
       CALL  CLOSE
       DST   >1100,@PABPTR
       CALL  CLOSE
       CLOG  >80,@FLAG
       BS    GE784
       DST   >1200,@PABPTR
       CALL  CLOSE
GE784  CLR   @FLAG
       CALL  WENTER
       BR    OLDEA
*  Get Yes/No reply
YESNO  ST    >1F,@CHRCUR
GE7A2  CLR   @ITIMER
       EX    @VCHAR,@CHRCUR
GE7A7  SCAN
       BS    GE7B1
       CHE   >06,@ITIMER
       BR    GE7A7
       BR    GE7A2
GE7B1  CEQ   BACK,@KEY
       BS    GE7C0
       CEQ   >59,@KEY
       BS    GE7C0
       CEQ   >4E,@KEY
       BR    GE7A2
GE7C0  ST    @KEY,@VCHAR
       CLR   @XTOKEN
       RTN
***************************************************
*  Main Menu Option 3: LOAD AND RUN
*
LANDR  DCLR  @FLAG
       OR    >01,@FLAG2
       ALL   SPACE
       FMT
       COL   8
       ROW   0
       HTEX  '* LOAD and RUN *'
       COL+  10
       ROW+  2
       HTEX  'PATH.NAME?'
       FEND
       CALL  EXPMEM
       OR    >40,@FLAG2
GE7F2  ST    SPACE,V@162
       MOVE  >003B,V@162,V@163
       DST   162,@CURADD
       OR    >04,@FLAG
       CALL  P1000
       CALL  GETALL
       CLR   @XTOKEN
       DCZ   @FAC6
       BR    GE816
       CALL  BINIT2
       BR    RUN
       BR    GE821
GE816  CLOG  >40,@FLAG2
       BS    GE821
       CALL  BINIT3
       AND   >BF,@FLAG2
GE821  ST    >04,V@1(@PABPTR)
GE826  DST   @PABPTR,@VPAB
       DADD  >0009,@VPAB
       XML   >22
       BS    GE8B3
       B     GE7F2
***************************************************
*  Main Menu Option 4: RUN
*
RUN    ALL   SPACE
GE848  ST    >7E,@SUBSTK
       FMT
       ROW   0
       COL   1
       HTEX  '* RUN *'
       ROW+  2
       COL   1
       HTEX  'SELECT PROGRAM NAME:'
       FEND
       CALL  EXPMEM
       CLR   @XTOKEN       SET XTOKEN=0
       DST   129,@TMP6     * Screen location LOCATION
       DST   >3FF8,@TMP8   * Locataion of LINK TABLE
FNDLNK DST   @TMP8,@TMP2   * Copy it.
       ST    6,@TMP4       * MAX Length of each name.
FNDLP  CHE   128,@0(@TMP2) * ~?
       BS    FNDDON        * Yes, done.
       CHE   32,@0(@TMP2)  * Space or higher?
       BR    FNDDON        * No, done.
       CEQ   32,@0(@TMP2)  * Space?
       BR    FNDSHO        * No.
       CEQ   6,@TMP4       * 6?
       BS    FNDDON        * Yes.
FNDSHO ST    @0(@TMP2),V@0(@TMP6)
       DINC  @TMP6         * COL+1
       DCHE  768,@TMP6     * End of screen?
       BR    MORSCN
       MOVE  20,G@OUTSCN,V@>8
       CALL  BADTON
       BR    FNDDON
*
MORSCN DINC  @TMP2         * Next character.
       DEC   @TMP4         * Length-1
       BR    FNDLP         * No, keep looping.
       DINCT @TMP6         * Reset next column
       DSUB  8,@TMP8       * Link Table Address+8
       CEQ   >2600,@TMP8   * Last Table name?
       BR    FNDLNK        * No
* Get the name by using arrow keys
FNDDON OR    >04,@FLAG      
       DST   >0080,@SCADD  ARROW LOCATION
RUN00  ST    130,V*SCADD   LEFT ARROW
       ST    131,V@7(@SCADD)  RIGHT ARROW
       SCAN
       BR    RUN00
       ST    32,V*SCADD    NO LEFT ARROW
       ST    32,V@7(@SCADD) NO RIGHT ARROW
       CEQ   BACK,@KEY     BACK?
       BS    LANDR
       CEQ   11,@KEY       FCTN UP?
       BS    RUNUP
       CEQ   'E',@KEY      UP (E)?
       BR    RUN01
RUNUP  DSUB  32,@SCADD     ARROW-8
       DCHE  >007F,@SCADD  TOP LINE LEFT?
       BR    FNDDON
RUN01  CEQ   10,@KEY       FCTN DOWN?
       BS    RUNDN
       CEQ   'X',@KEY      DOWN (X)?
       BR    RUN02
RUNDN  DADD  32,@SCADD     ARROW+8
       DCHE  767,@SCADD    BOTTON LINE RIGHT?
       BS    FNDDON
       DCEQ  >2020,V@1(@SCADD) SPACE SPACE?
       BR    RUN02
       DSUB  32,@SCADD     ARROW-8
RUN02  CEQ   8,@KEY        FCTN LEFT?
       BS    RUNLT
       CEQ   83,@KEY       LEFT (S)?
       BR    RUN03
RUNLT  DSUB  8,@SCADD      ARROW-32
       DCHE  >007F,@SCADD  TOP LINE LEFT?
       BR    FNDDON
RUN03  CEQ   9,@KEY        FCTN RIGHT?
       BS    RUNRT
       CEQ   68,@KEY       RIGHT (D)?
       BR    RUN04
RUNRT  DADD  8,@SCADD      ARROW+8
       DCHE  767,@SCADD    BOTTOM LINE RIGHT? 
       BS    FNDDON
       DCEQ  >2020,V@1(@SCADD) SPACE SPACE?
       BR    RUN04
       DSUB  8,@SCADD      ARROW-8
RUN04  CEQ   ENTER,@KEY    ENTER?
       BS    RUN05   
       BR    RUN00
* Fetch the name match and address
RUN05  MOVE  6,V@1(@SCADD),@FAC          
       DST   >4000,@TEMP   * Locataion of LINK TABLE
RUN06  DSUB  8,@TEMP       * MINUS offset 
       MOVE  8,@0(@TEMP),@ARG * Copy it.
       DCEQ  @FAC,@ARG     * First two characters?
       BR    RUN06
       DCEQ  @FAC2,@ARG2   * Secod two characters?
       BR    RUN06
       DCEQ  @FAC4,@ARG4   * Third two characters?
       BR    RUN06 
       MOVE  2,@ARG6,@>2022
* Normal EA 3 start up    
GE883  DCEQ  >A55A,@>2000
       BR    GE916
       CALL  USSCRN
GE88E  DCLR  @CODE
       XML   >21
       BS    GE8E3
       CLOG  >20,@FLAG2
       BS    GE8A8
       INCT  @SUBSTK
       DST   GE88E,*SUBSTK
       INCT  @SUBSTK
       RTN
***************************************************
*
*  Main Menu Option 5: RUN PROGRAM FILE
*
PRGRM  ALL   SPACE
       FMT
       COL   6
       ROW   1
       HTEX  '* RUN PROGRAM FILE *'
       FEND
       CEQ   >FF,@XTOKEN         RXB flag set?  
       BR    NOEABF              No
       MOVE  64,V@>2400,V@>2255  Get RXB buffer
       ST    >EA,@XTOKEN         Set RXB flag
NOEABF CALL  BINIT2              * INITILIZE LOW8K
       OR    >08,@FLAG2          Set flag  
       DST   >0102,@CURADD       Cursor address   
       MOVE  10,G@FPATH,V*CURADD * FILE NAME?
       DADD  >0040,@CURADD       Cursor address+64
       OR    >04,@FLAG           Set flag
       CALL  GETINP              Get path.file
       CEQ   1,@FAC7             Length=1?           
       BR    NO1KEY              No
       DST   >000B,V@>2400       Length 
       CALL  GDDSK               Load DSK1. Address
       MOVE  6,G@DUTIL1,V@>2407  Load UTIL1
       ST    >FF,@XTOKEN         Set RXB flag
       BR    PRGRM               Restart 
NO1KEY DCZ   @FAC6               * ENTER?
       BR    GE597               * No
       ST    '1',@>8344          * Search flag
MYSRCH CALL  LODPGM              * Load DATA
       DATA  DUTIL1              * DSK1.UTIL1
       BR    GE5A6               
GE597  CALL  LODUSR
       CALL  PABNAM
       DCEQ  >4353,V*FAC4        * CS ??
       BR    GE5A6               * No
       ALL   SPACE
GE5A6  CALL  PGMLOD
       CALL  USSCRN
       XML   >F0
       BS    GE8E3
       BR    GE8A8
LODPGM FETCH @SCADD
       FETCH @SCADE
       MOVE  5,G@0(@SCADD),V@>100F
LODUSR DCLR  @TMP
       CALL  P1000
       CALL  NPAB
       CZ    @>8344               * Check Search flag
       BS    PMSG                 * No, go on
       ST    @>8344,V@13(@PABPTR) * Yes, store next drive #
PMSG   MOVE  15,G@PLEASE,V@>02A2
       RTN
*  Load Program
PGMLOD CALL  DOIO
       MOVE  6,V@>1380,@SCADD
       DCZ   @TMP
       BR    GE5E5
       DST   @>8314,@TMP
GE5E5  DSUB  TMP,@>8314
       MOVE  @>8312,V@>1386,@TMP(@>8314)
       DCZ   @SCADD
       BS    GE605
       DCLR  @TMP2
       ST    V@>1009,@TMP3
       DADD  >1009,@TMP2
       INC   V*TMP2
       BR    PGMLOD
GE605  ST    SPACE,V@>02A2
       MOVE  19,V@>02A2,V@>02A3
       CALL  VZERO
       RTN
********************************************************
* RXB Loader
XBINP  ALL   SPACE
       ST    1,@FAC
XBAGN  FMT
       COL   8
       ROW   1
       HTEX  '* R X B *'
       ROW+  4
       COL   2
       HTEX  'PATH.NAME?'
       FEND
       DEC   @FAC
       BR    XBAGN
       CEQ   >FF,@XTOKEN       XTOKEN=>EA?
       BR    XBINP1
       MOVE  64,V@>2400,V@>2255
       ST    >EA,@XTOKEN       SET XTOKEN=>EA
XBINP1 DST   >0102,@CURADD
       DST   >1000,@PABPTR
       OR    >20,@FLAG
       CALL  GETALL
       DCZ   @FAC6
       BS    XBINP3
       CEQ   1,@FAC7
       BR    XBINP2
       DST   >000A,V@>2400
       MOVE  5,G@DDSK1,V@>2402
       ST    V*STLN,V@>2405
       MOVE  5,G@DLOAD,V@>2407
       ST    >FF,@XTOKEN      SET XTOKEN=>FF
       BR    XBINP
XBINP2 CALL  CLRREA
       DST   >994A,V@>2254
       MOVE  80,V@9(@PABPTR),V@>2256
XBINP3 CLR   @TMP
       MOVE  >006E,@TMP,@TMP1
       B     RXB
***********************************************************
CLRREA CLR   V@>2250                Clear RXB buffer
       MOVE 80,V@>2250,V@>2251      Ripple
       RTN
ONEKEY CEQ  1,V@9(@PABPTR)    One character for drive#?
       BR   TWOKEY            No, normal continue
       ST   V@10(@PABPTR),@>83C0    Yes, save # character
       MOVE 5,G@DDSK1,V@10(@PABPTR) DSK1. loaded into pab
       ST   >05,V@9(@PABPTR)        DSK1. has 5 characters
       ST   @>83C0,V@13(@PABPTR)    Load charcter drive#/le
TWOKEY RTN
*
NPAB   MOVE  20,G@PAB,V*PABPTR
       RTN
* 
LPAB   MOVE  10,G@PAB80,V*PABPTR
       RTN
*
GDDSK  CEQ   '0',V@>0142
       BR    GDDSKN
       MOVE  5,G@WDS1,V@>2402
       ST    '1',V@>0142
       BR    GDWDS 
GDDSKN MOVE  5,G@DDSK1,V@>2402
GDWDS  ST    V*STLN,V@>2405
       RTN
***********************************************************
*
* CATALOG HARD/DISK
*
DIRECT CALL DMENU
       BR   DIREC2
DMENU  ALL  SPACE             Clear screen
       FMT
       COL 9
       ROW 0
       HTEX '* DIRECTORY *  '
       ROW+ 4
       COL+ 10
       HTEX 'Device? (# or path)'
       ROW+ 7
       COL  2
       HTEX 'ACTIVE KEYS: CLEAR, BEGIN,'
       ROW+ 2
       COL  2
       HTEX 'BACK, PROCEED, REDO, AID,'
       ROW+ 2
       COL  2
       HTEX '(Arrows), E,e,X,x,S,s,D,d,'
       ROW+ 2
       COL  2
       HTEX 'A (Assembler), 1 (Editor)'
       ROW+ 2
       COL  2
       HTEX 'ENTER (Tag file to autorun),'
       ROW+ 2
       COL  2
       HTEX 'SPACE BAR (XB programs only).'
       FEND
       RTN
DIREC2 DST  >0102,@CURADD     Prompt location
       DST  >1000,@PABPTR     Use first PAB area
       OR   >20,@FLAG         Set return bit for error
       CALL GETALL            Input the filename
DIREC3 CLR  @XTOKEN
       CALL CLRREA
       MOVE 9,G@CATDAT,V*PABPTR Prepare PAB
       CALL ONEKEY
       CALL DOIO              Open the file
       DST  >020D,V*PABPTR    Read opcode to PAB
       CALL DOIO              Read first record
       ALL  SPACE             Clear screen again
       CALL SCREEN            Set up header
       ST   >20,V@>2500
       MOVE >1100,V@>2500,V@>2501
       DST  >2580,@>8340
       ST   >59,@TMP2         Y
TSTKEY SCAN                   Scan the keyboard
       BR   TSTKE5            Any key?
       CEQ  SPACE,@KEY        SPACE KEY?
       BS   TSTKE4            Yes, wait.
       CEQ  BACK,@KEY         BACK key?
       BR   TSTKE3            No
TSTKE2 CLR  @XTOKEN           Yes, so restart
       CALL CLOSE             Close disk
       BR   DIRECT            Start Catalog again
TSTKE3 CLR  @XTOKEN           Clear flag
       BR   ARROWS
TSTKE4 SCAN                   Wait for any key.
       BR   TSTKE4            Loop
TSTKE5 CALL DOIO              Read file info
       CALL FILNAM            Put it on screen
       BR   TSTKEY            Loop till done
       DEC  @COUNT            COUNT-1
ARROWS CALL CLRFAC
       ST   @COUNT,@FAC1
       DCHE 100,@FAC
       BR   ARROW1
       DSUB 100,@FAC
       ST   49,V@28           Show it 1__
ARROW1 DCHE 9,@FAC
       BR   ARROW2
       DIV  10,@FAC
       ADD  >30,@FAC
       ST   @FAC,V@29         Show it _#_
       ADD  >30,@FAC1
       ST   @FAC1,V@30        Show it __#
       BR   ARROW3
ARROW2 ADD  >30,@FAC1
       ST   @FAC1,V@30
ARROW3 DST  >0081,@SCADD      Arrows location
       DST  >2580,@TMP4       Recall buffer
OKKEY  MOVE >0260,V*TMP4,V@>0080 Fill screen
NOKEY  ST   130,V*SCADD       Left arrow
       ST   131,V@11(@SCADD)  Right arrow
       SCAN
       CEQ  AID,@KEY          AID
       BR   NAID
       MOVE 768,V@0,V@>2000   Save screen
       CALL DMENU
YAID   SCAN                   Any key?
       BR   YAID              No.
       MOVE 768,V@>2000,V@0   Restore screen
WAID   SCAN                   Any key?
       BR   WAID
NAID   CEQ  CLEAR,@KEY        CLEAR
       BS   TSTKE2
       CEQ  PROCD,@KEY        PROCEED
       BS   ENTER0
       CEQ  REDO,@KEY         REDO
       BS   TSTKE2
BACK0  CEQ  BACK,@KEY         BACK
       BR   BEGIN0
       DCEQ 'DS',V@>100A      DS?   DISK ONLY?
       BS   TSTKE2
       CALL CLRBUF            Clear buffers and FAC
       DST  V@>1008,@FAC      Get length
       DCEQ 5,@FAC            DSK#. or SCS#. or WDS#.
       BS   BEGIN3
       DCHE 4,@FAC
       BR   BEGIN3
       CALL CLRBUF            Clear buffers and FAC
       DST  V@>1008,@FAC      Get length
BACK1  DDEC @FAC              Length -1
       CEQ  >2E,V@>1009(@FAC) .?
       BR   BACK1             No, keep searching
       DCHE 5,@FAC            DSK. or SCS. or WDS. or DSK#.
       BS   BEGIN3
BACK3  ST   BEGIN,@KEY
BEGIN0 CEQ  BEGIN,@KEY        BEGIN
       BR   FCTNUP
       CALL CLRFAC            Clear buffers and FAC
       DST  V@>1008,@FAC      Get length
       DCEQ 5,@FAC            DSK#. or SCS#. or WDS#.
       BS   BEGIN2
       DCLR @FAC              Clear FAC
BEGIN1 DINC @FAC              COUNT +1
       CEQ  >2E,V@>1009(@FAC) .?
       BR   BEGIN1            No, keep searching
       DCEQ 4,@FAC            DSK. Length?
       BS   BEGIN1            Yes, look for Volume.
BEGIN2 DINC @FAC              LENGTH+1
       DST  >0D0D,V@>1009(@FAC)
BEGIN3 DST  @FAC,V@>1008
       DADD 2,@FAC
       MOVE @FAC,V@>1008,V@>2255
       MOVE @FAC,V@>1008,V@>2400
       ST   >37,@XTOKEN
       B    OLDEA
FCTNUP CEQ  11,@KEY           FCTN UP?
       BS   UPKEY
       CEQ  'E',@KEY          E?
       BS   UPKEY
       CEQ  'e',@KEY          e?
       BS   UPKEY
       CEQ  10,@KEY           FCTN DOWN?
       BS   DKEY
       CEQ  'X',@KEY          X?
       BS   DKEY
       CEQ  'x',@KEY          x?
       BS   DKEY
       CEQ  8,@KEY            FCTN LEFT?
       BS   LKEY
       CEQ  'S',@KEY          S?
       BS   LKEY
       CEQ  's',@KEY          s?
       BS   LKEY
       CEQ  9,@KEY            FCTN RIGHT?
       BS   RKEY
       CEQ  'D',@KEY          D?
       BS   RKEY
       CEQ  'd',@KEY          d?
       BS   RKEY
       CEQ  ' ',@KEY          SPACE BAR
       BS   ENTER0
       CEQ  'A',@KEY          A?
       BS   ENTER0
       CEQ  'a',@KEY          a?
       BS   ENTER0
       CEQ  'G',@KEY          G?
       BS   ENTER0
       CEQ  'g',@KEY          g?
       BS   ENTER0
       CEQ  ENTER,@KEY        ENTER
       BS   ENTER0
       CEQ  '1',@KEY          1=EDITOR
       BR   NOKEY
ENTER0 CALL CLRBUF
ENTR   DST  V@>1008,@TMP6    Get length of device
       ST   >2E,V@>1009(@TMP6)
       MOVE @TMP6,V@>100A,V@>2402
       DST  @SCADD,@FAC2
       INC  @SCADE
ENTER1 INC  @FAC3             Index+1
       INC  @FAC1             Count+1
       CEQ  SPACE,V*FAC2      Space?
       BS   ENTER2            Yes
       CEQ  11,@FAC1          To long?
       BR   ENTER1
ENTER2 ST   ENTER,V*FAC2      cr
       DCEQ 'Di',V@16(@SCADD) Directory?
       BR   NODIR             No
       CEQ  'r',V@18(@SCADD)
       BR   NODIR
       DST  >2E0D,V*FAC2      .cr
       INC  @FAC              Count+1
NODIR  MOVE @FAC,V*SCADD,V@>100A(@TMP6)
       DADD @TMP6,@FAC
       MOVE @FAC,V@>100A,V@>2257
       DST  @FAC,V@>2255
       INC  @TMP7
       DST  @TMP6,V@>2400
       CALL CLOSE
       ST   >EA,@XTOKEN       Set flag
       CEQ  32,@KEY           SPACE BAR
       BS   XBPGM
       DCEQ 'Di',V@16(@SCADD) Directory?
       BR   PORVI
       CEQ  'r',V@18(@SCADD)
       BS   DIRECT
PORVI  CEQ  'P',V@16(@SCADD)  Program?
       BS   PRGRM
       CEQ  'V',V@20(@SCADD)  Variable?
       BR   DORF80
       CEQ  'I',V@16(@SCADD)  Internal?
       BR   DORF80
       DCEQ '25',V@24(@SCADD) Length 25_?
       BR   DORF80
       CEQ  '4',V@26(@SCADD)  Length 254?
       BS   XBINP
DORF80 DCEQ '80',V@25(@SCADD) Length 80?
       BR   DF80      
************************** Save as SOURCE *******
       DCLR @TEMP
       ST   @TEMP,V@>0F50      clear byte at setup
       MOVE 39,V@>0F50,V@>0F51 Ripple it
       ST   V@>2256,@TEMP1     Get length byte
       DEC  @TEMP1             Length-1
       ST   @TEMP1,V@>0F50     Get length byte
       MOVE @TEMP,V@>2257,V@>0F51 Save as SOURCE 
       CALL CLRXOP             CLEAR EDIT BUFFER
******************************
DF80   CEQ  'F',V@20(@SCADD)  Fixed?
       BS   LANDR
LEAASM CEQ  'A',@KEY          Assemble file
       BS   ASSEM
       CEQ  'G',@KEY          GPL Assemble file
       BS   ASSEM
       BR   MMENU
XBPGM  CEQ  'P',V@16(@SCADD)  Program?
       BS   XBINP
       CEQ  'V',V@20(@SCADD)  Variable?
       BR   MMENU
       CEQ  'I',V@16(@SCADD)  Internal?
       BR   MMENU
       DCEQ '25',V@24(@SCADD) Length 25_?
       BR   MMENU
       CEQ  '4',V@26(@SCADD)  Length 254?
       BS   XBINP
       BR   MMENU
UPKEY  DCEQ >0081,@SCADD      Top of screen?
       BS   GLESS             So scroll screen down
       DSUB 32,@SCADD         Up one.
       BR   GLESS2            Return
GLESS  DCEQ >2580,@TMP4      Start of buffer?
       BS   OKKEY             Yes
       DSUB >20,@TMP4         One more line down
GLESS2 BR   OKKEY
DKEY   CEQ  >20,V@1(@SCADD)   Blank line?
       BS   UPKEY
       DCEQ >02C1,@SCADD      Bottom of screen?
       BS   GMORE             So scroll screen up
       DADD 32,@SCADD         Down one.
       BR   OKKEY             No
GMORE  DCEQ @>8340,@TMP4      End of buffer?
       BS   OKKEY             Yes
       CEQ  >20,V@>00A2       Last line in buffer?
       BS   OKKEY             Yes
       DADD >20,@TMP4         One more line up
       BR   OKKEY
LKEY   ST   18,@>8376         Line Counter
LUPKEY DCEQ >0081,@SCADD      Top of screen?
       BS   LGLESS            So scroll screen down
       DSUB 32,@SCADD         Up one.
       BR   LGLES2            Return
LGLESS DCEQ >2580,@TMP4       Start of buffer?
       BS   LOKKEY            Yes
       DSUB >20,@TMP4         One more line down
LGLES2 BR   LOKKEY
LOKKEY CALL FLSCR
       DEC  @>8376            Line counter -1
       BR   LUPKEY            Continue Loop
       B    NOKEY             Done.
RKEY   ST   18,@>8376         Line Counter
RDKEY  CEQ  >20,V@1(@SCADD)   Blank line?
       BS   UPKEY
       DCEQ >02C1,@SCADD      Bottom of screen?
       BS   RGMORE            So scroll screen up
       DADD 32,@SCADD         Down one.
       BR   ROKKEY            No
RGMORE DCEQ @>8340,@TMP4      End of buffer?
       BS   ROKKEY            Yes
       CEQ  >20,V@>00A2       Last line in buffer?
       BS   ROKKEY            Yes
       DADD >20,@TMP4         One more line up
       BR   ROKKEY
ROKKEY CALL FLSCR
       DEC  @>8376            Line counter -1
       BR   RDKEY             Continue Loop
       B    NOKEY             Done.
FLSCR  MOVE >0260,V*TMP4,V@>0080 Fill screen
       ST   130,V*SCADD       Left arrow
       ST   131,V@11(@SCADD)  Right arrow
       RTN
CLRBUF ST   ENTER,V@>2257     Clear buffer
       MOVE 63,V@>2257,V@>2258
       MOVE 63,V@>2257,V@>2402
       CALL CLRFAC
       RTN
*
* PAB data
*
CATDAT BYTE 0,>D,8,>36,0,0,0,0,0
*
HALVE  BYTE >40,>02,0,0,0,0,0,0
*
* Screen - prints initial screen and disk info
*
SCREEN FMT
        ROW  0
        COL  2
        HTEX 'Directory=           Files000'
        ROW+ 1
        COL  2
        HTEX 'Free=           Used='
        ROW+ 1
        COL  2
        HTEX ' Filename  Size    Type     P'
        ROW+ 1
        COL  2
        HTEX '---------- ---- ----------- -'
       FEND
       CLR  @COUNT            Clear file counter
       CALL DISSTR            Get string into FAC
       CZ   @FAC1             Skip if zero length
       BS   CAT3
       FMT
        ROW 0
        COL 12
        HSTR 10,@FAC2
       FEND
CAT3   DADD @FAC,@SCADD       Go to next field
       DADD 19,@SCADD         Continue to last field
       DST  >28,@>8314        Set up screen addr
       DCEQ >4453,V@>100A     DSK?
       BR   CAT4              No, must be HARD
       CALL DISNUM            Display available DSK space
       B    CAT4A
CAT4   MOVE 8,V*SCADD,@ARG    Get Available space *2
       MOVE 8,G@HALVE,@FAC    Get divisor 
       XML  ROUND
       CALL DISNU1            Display available HARD space
* Display used space
CAT4A  MOVE 8,V*SCADD,@FAC    Get Available space
       DSUB 9,@SCADD          Point to formatted space
       MOVE 8,V*SCADD,@ARG    Move it to ARG
       XML  FSUB              Develop used value *2
       DST  >38,@>8314        Set up screen addr
       DCEQ >4453,V@>100A     DSK?
       BS   CAT4B             Yes, must be DISK
       MOVE 8,@FAC,@ARG       Get Unused space *2
       MOVE 8,G@HALVE,@FAC    Get divisor
       XML  FDIV
       XML  ROUND
CAT4B  CALL DISNU1            Display used space
       RTN                    Return
*
* Display one file on screen
*
FILNAM CALL DISSTR            Get string into FAC
       INC  @COUNT            FILE COUNT +1
       CZ   @FAC1             Skip display if zero
       BS   CAT5              length
       FMT                    Put disk name on screen
        ROW   23              .
        COL   02              .
        HSTR 10,@FAC2         .
       FEND                   .
CAT5   DADD @FAC,@SCADD       Go to next field
       DADD 10,@SCADD         Continue another field
       DCZ  V*SCADD           Time to get out if
       BS   FILNA1            zero file size
       DST  >2EA,@>8314       Set up screen address
       CALL DISNUM            Display file length
       DSUB 9,@SCADD          Back a field
       MOVE 8,V*SCADD,@FAC    Move it into FAC
       XML  CFI               Convert it to an int.
       CZ   @FAC              Non-negative?
       BS   CAT5A             YES! File not protected
       ST   @TMP2,V@>2FE      Put a 'Y' on screen
       DNEG @FAC              Make number positive
CAT5A  DEC  @FAC1             Adjust for CASE
       CASE @FAC1             Show file type
       BR   DF                .
       BR   DV                .
       BR   IF                .
       BR   IV                .
       BR   PR                .
       BR   DI
DF     FMT
        ROW   23
        COL   18
        HTEX 'Dis/Fix'
       FEND
       BR   CAT6
DV     FMT
        ROW   23
        COL   18
        HTEX 'Dis/Var'
       FEND
       BR   CAT6
IF     FMT
        ROW   23
        COL   18
        HTEX 'Int/Fix'
       FEND
       BR   CAT6
IV     FMT
        ROW   23
        COL   18
        HTEX 'Int/Var'
       FEND
       BR   CAT6
PR     FMT
        ROW   23
        COL   18
        HTEX 'Program'
       FEND
       BR   CAT7              Return
DI     FMT
        ROW    23
        COL    18
        HTEX 'Directory'
       FEND
       BR   CAT7
CAT6   DADD 18,@SCADD         Advavce two fields
       DST  >2F6,@>8314       Set up screen address
       CALL DISNUM            Display record length
CAT7   MOVE >1F,V@>02E0,V@0(@>8340)
       DADD >20,@>8340
 
*
* Scroll the screen
*
SCROLL MOVE >260,V@>A0,V@>80  Scroll screen
       ST   SPACE,V@>2E0      Clear last line
       MOVE >1F,V@>2E0,V@>2E1
       RTN                    Return
FILNA1 DCLR @>8312            Clear a byte
       CZ   @>8312            Set COND bit
       RTNC                   Return w/COND
* Display number subroutine
*  ENTER: Floating number in FAC for DISNU1
*         Screen address in >8314
*
DISNUM MOVE 8,V*SCADD,@FAC    Move FLP number to FAC
DISNU1 CLR  @FAC11            Indicate a free format
       CALL CNS               Convert FAC to a string
       DST  7,@>8316          Right justify number
       S    @FAC12,@>8317
       DADD @>8316,@>8314
DISNU2 ST   *FAC11,V*>8314    Put a char on the screen
       DINC @>8314            Increment screen addr.
       INC  @FAC11            Increment FAC addr.
       DEC  @FAC12            Decrement string length count
       BR   DISNU2            Loop until done
       RTN                    Return to caller
*
* Prepare a VDP string for FORMAT statement
*  LEAVE: FAC has string length (word)
*         FAC2  has string
*         SCADD pointing to next string in record
*
DISSTR DST  >0836,@SCADD      Get buffer address
       CLR  @FAC              Clear MSB of FAC word
       ST   V*SCADD,@FAC1     Store disk name length
       DINC @SCADD            Point to string
       ST   >20,@FAC2         Clear out string space
       MOVE 9,@FAC2,@FAC3     .
       MOVE @FAC,V*SCADD,@FAC2 Move disk name into FAC
       RTN
***********************************************************
* ERRORS 
*
GE8A8  CALL  EASCRN
       CALL  WENTER
       BR    GE029
GE8B0  CALL  EASCRN
GE8B3  CALL  GE8FC
       CHE   >08,@CODE
       BR    CHKERR
       SUB   >08,@CODE
       CH    >05,@CODE
       BS    GE8D4
       CALL  CLSALL
       CASE  @CODE
       BR    GE90F
       BR    GE908
       BR    GE928
       BR    GE92F
       BR    GE936
       BR    GE93D
GE8D4  CLOG  >20,@FLAG
       BR    GE767
       CLOG  >01,@FLAG2
       BR    LANDR
       CALL  CLSPAB
       BR    EDITOR
GE8E3  CALL  GE8FC
       CALL  EASCRN
       CEQ   >0F,@CODE
       BR    GE8F5
       CALL  ERRMSG
       DATA  ERRPNF  * ERROR PROGRAM NOT FOUND
       BR    GE949
GE8F5  CALL  ERRMSG
       DATA  ERRC
       BR    GE029
       CALL  GE8FC
       B     GE029
GE8FC  MOVE  1,G@VREGS,#1
GE907  RTN
GE908  CALL  WRNMSG
       DATA  CCRMSG  * WARNING CONTROL CHARACTERS REMOVED
       BR    GE8D4
GE90F  CALL  ERRMSG
       DATA  ERRMF   * ERROR MEMORY FULL
       BR    GE8D4
GE916  CALL  ERRMSG
       DATA  ERRPNF  * ERROR PROGRAM NOT FOUND
       BR    OLDEA
GE91D  CLOG  >08,@FLAG
       BR    GE9E2
GE9E2  CALL  ERRMSG
       DATA  ERRNME  * ERROR NO MEMORY EXPANSION
       EXIT
GE928  CALL  ERRMSG
       DATA  ERRIT   * ERROR ILLEGAL TAG
       BR    LANDR
GE92F  CALL  ERRMSG
       DATA  ERRCE   * CHECKSUM ERROR
       BR    LANDR
GE936  CALL  ERRMSG
       DATA  ERRDD   * ERROR DUPLICATE DEFINITION
       BR    LANDR
GE93D  CALL  ERRMSG
       DATA  ERRUR   * ERROR UNRESOLVED REFERENCE
       BR    LANDR
GE944  CALL  ERRMSG
       DATA  ERRNTL  * ERROR NAME TO LONG
GE949  DCZ   @FAC6
       BS    GE958
       ST    SPACE,V*FAC4
       MOVE  @FAC6,V*FAC4,V@1(@FAC4)
GE958  CALL  CLRMSG
       BR    GE848
CHKERR CZ    @>8344           * Check Search flag
       BS    CHKER2           * Yes, normal error
       INC   @>8344           * Drive # + 1
       CHE   58,@>8344        * Last drive?
       BR    MYSRCH           * No, continue Search
CHKER2 ST    V@1(@PABPTR),@FAC4
       AND   >E0,@FAC4
       SRL   >05,@FAC4
       OR    >30,@FAC4
       AND   >1F,V@1(@PABPTR)
       CEQ   >35,@FAC4        Error Read past EOF
       BR    GE97A
       CALL  CLSALL
       CEQ   1,@LDFLAG
       BR    EDITOR           EDITOR
       CEQ   2,@LDFLAG
       BR    ASSEM            ASSEMBLER
GE97A  CALL  ERRMSG
       DATA  ERRIOC         * I O ERROR CODE
       CEQ   1,@LDFLAG
       BS    EDITOR
       CEQ   2,@LDFLAG
       BS    ASSEM
GE97F  CALL  CLSALL
       CLOG  >20,@FLAG
       BR    OLDEA
       CLOG  >01,@FLAG2
       BR    LANDR
       CLOG  >08,@FLAG2
       BR    OLDEA
       BR    EDITOR
CLSALL CALL  P1000
       CALL  CLSPAB
       DST   >1100,@PABPTR
       CALL  CLSPAB
       DST   >1200,@PABPTR
       CALL  CLSPAB
       DST   >1300,@PABPTR
       CALL  CLSPAB
       RTN
CLSPAB DST   @PABPTR,@VPAB
       DADD  >0009,@VPAB
       ST    >01,V*PABPTR
       CALL  DSRLNK
       BYTE  >08
       CLR   V@>0009(@PABPTR)
       RTN
WRNMSG CALL  CLRMSG
       MOVE  11,G@WARN,V@>02A2
       BR    GE9DA
ERRMSG CALL  CLRMSG
       MOVE  9,G@ERROR,V@>02A2
GE9DA  FETCH @FAC
       FETCH @FAC1
       CLR   @FAC2
       MOVE  1,G@0(@FAC),@FAC3
       MOVE  @FAC2,G@1(@FAC),V@>02C2
       DCEQ  ERRIOC,@FAC
       BR    GE9F8
       ST    @FAC4,V@>02D2
GE9F8  DCEQ  ERRC,@FAC
       BR    WENTER
       DSRL  >0004,@CODE
       SRL   >04,@>8323
       CH    >09,@CODE
       BR    GEA12
       CH    >0F,@CODE
       BS    WENTER
       ADD   >07,@CODE
GEA12  CH    >09,@>8323
       BR    GEA1F
       CH    >0F,@>8323
       BS    WENTER
       ADD   >07,@>8323
GEA1F  DADD  >3030,@CODE
       DST   @CODE,V@>02D0
*  Wait for ENTER
WENTER MOVE  23,G@PRESS,V@>02E2
GEA2E  SCAN
       BR    GEA2E
       CEQ   >0D,@KEY
       BR    GEA2E
       B     SETUP  cHANGED FROM RETURN
***************************************
CLRMSG ST    SPACE,V@>02A0
       MOVE  >005F,V@>02A0,V@>02A1
       RTN
********************************************
*  CALL INIT
*
BINIT2 DCEQ  >A55A,@>2000
       BS    GEBBD
BINIT3 CALL  EXPMEM
       CLR   @>2000
       MOVE  8191,@>2000,@>2001 CLEAR MEMORY
       MOVE  8,G@LOW1,@>2000
       MOVE  8,G@LOW2,@>2024
       MOVE  1403,G@LOW3,@>20FA
       MOVE  200,G@LOW4,@>3F38  
       BR    CLRXOP
GEBBD  RTN
*******************************
CLRFAC CLR   @FAC
       MOVE  7,@FAC,@FAC1
       RTN
*******************************
P1000  DST   >1000,@PABPTR
       RTN
*******************************
DEVICE CALL  EXPMEM               Clear expansion memory
       MOVE  128,V@>027F,V@>0280
       ST    @KEY,@TMP6           Save key
       FMT
       ROW   16
       COL   2
       HTEX  'Select DSK#.'
       FEND
       MOVE  5,V@>100F,V@>020E     EDIT1 or ASSM1
DEV1   SCAN                        KEY?
       BR    DEV1                  No.
       CEQ   SPACE,@KEY            SPACE BAR?
       BS    DEV4                  Yes
       CEQ   BACK,@KEY             BACK?
       BS    DEV3                  Yes
       ST    @KEY,V@>020C          Any other key SAVE
       ST    @KEY,V@>100D          Put into PAB
DEVNO  ST    @TMP6,@KEY            Restore old key
DEV2   CALL  PMSG                  PLEASE WAIT...
DEV3   RTN
DEV4   FMT
       ROW   16
       COL   2
       HTEX  'Example: WDS1.EA.'
       ROW   18
       COL   2
       HTEX  'FULL PATH?'
       FEND
       MOVE  5,V@>100F,V@>0213     EDIT1 or ASSM1
       DST   >0282,@CURADD
       CLR   @>8344                Clear search flag
       OR    >04,@FLAG             Set return flag
       CALL  GETINP
       DST   @CURADD,@TMP
       SUB   >82,@TMP1
       ST    @TMP1,V@>1009
       MOVE  @TMP,V@>0282,V@>100A
       ST    >20,@FLAG
       B     DEVNO
**********************************************************
EADSR  DATA SEADSR
       DATA SETUP
       STRI 'EA'
SEADSR DATA XBDSR
       DATA SETUP
       STRI 'ea'
************************************
XBDSR  DATA SXBDSR
       DATA RXB
       STRI 'XB'
SXBDSR DATA BASIC
       DATA RXB
       STRI 'xb'
************************************
BASIC  DATA SBASIC
       DATA >216F
       STRI 'BASIC'
SBASIC DATA >0000
       DATA >216F
       STRI 'basic'
***********************************************************
C1     STRI  'DSK1.EDIT1'
C2     STRI  'DSK1.ASSM1'
C3     STRI  'DSK1.SOURCE'
C4     STRI  'DSK1.OBJECT'
C5     STRI  'DSK1.LIST'
C6     STRI  'L'
PAB    BYTE  >05,>00,>13,>80,>00,>00,>21,>00
DLEN   BYTE  >00,>0A
DDSK1  TEXT  'DSK1.'
DEDIT1 TEXT  'EDIT1'
DASSM1 TEXT  'ASSM1'
DUTIL1 TEXT  'UTIL1'
       BYTE  >0D
DLOAD  TEXT  'LOAD'
       BYTE  >0D
PAB80  BYTE  >00,>12,>10,>00,>50,>00,>00,>00,>00,>00
ERROR  TEXT  '* ERROR *'
OUTSCN TEXT  '* 72 NAMES SHOWN *'
PRESS  TEXT  'Press ENTER to continue'
WARN   TEXT  '* WARNING *'
ERRMF  STRI  'MEMORY FULL'
ERRIOC STRI  'I/O ERROR CODE'
ERRNME STRI  'NO MEMORY EXPANSION'
ERRNTL STRI  'NAME TOO LONG'
ERRC   STRI  'ERROR CODE'
CCRMSG STRI  'CONTROL CHARACTER REMOVED'
ERRIT  STRI  'ILLEGAL TAG'
ERRCE  STRI  'CHECKSUM ERROR'
ERRDD  STRI  'DUPLICATE DEFINITION'
ERRUR  STRI  'UNRESOLVED REFERENCE'
ERRPNF STRI  'PROGRAM NOT FOUND'
FPATH  TEXT  'PATH.NAME?'
PLEASE TEXT  'Please wait ...'
WDS1   TEXT  'WDS1.'
CURPAT BYTE  >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF
       BYTE  >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF
DARROW DATA  >0010,>18FC,>1810,>0000 * RIGHT ARROW
       DATA  >0020,>60FC,>6020,>0000 * LEFT ARROW
VREGS  BYTE  >E0,>00,>0E,>01,>06,>00
***********************************************************
*
*  Data for Initialization of
*  Memory Expansion
*
LOW1  DATA  >A55A,>2128,>2398,>225A
LOW2  DATA  >A000,>FFD7,>2676,>3F38
LOW3  DATA  >0064,>2000,>2EAA,>2094
      DATA  >21C4,>2094,>2196,>2094,>21DE,>2094,>21F4
      DATA  >2094,>2200,>2094,>220E,>2094,>221A,>2094,>2228
      DATA  >209A,>22B2,>20DA,>23BA,>C80B,>2030,>D060
      DATA  >8349,>2060,>20FC,>132A,>C020,>8350,>1311,>06A0
      DATA  >2646,>101E,>0281,>3F38,>1319,>C001,>0202
      DATA  >834A,>8CB0,>1611,>8CB0,>160F,>8CB0,>160D,>C810
      DATA  >2022,>02E0,>20BA,>C020,>2022,>1309,>0690
      DATA  >02E0,>83E0,>C2E0,>2030,>045B,>0221,>0008,>10E4
      DATA  >0200,>0F00,>D800,>8322,>02E0,>83E0,>0460
      DATA  >00CE,>5820,>20FC,>8349,>02E0,>2094,>0380,>C83E
      DATA  >83E2,>02E0,>83E0,>C80B,>20AA,>C081,>0281
      DATA  >8000,>1B07,>09C1,>0A11,>0A42,>09B2,>A0A1,>0CFA
      DATA  >C092,>0692,>02E0,>2094,>C80B,>83F6,>0380
      DATA  >D060,>8373,>0981,>C87E,>8304,>F820,>20FC,>8349
      DATA  >02E0,>83E0,>C2E0,>2030,>045B,>02E0,>83E0
      DATA  >C80B,>20AA,>06A0,>000E,>02E0,>2094,>C80B,>83F6
      DATA  >0380,>06A0,>223A,>D82D,>0002,>8C00,>0380
      DATA  >06A0,>223A,>D831,>8C00,>0602,>16FC,>0380,>06A0
      DATA  >2240,>DB60,>8800,>0002,>0380,>06A0,>2240
      DATA  >DC60,>8800,>0602,>16FC,>0380,>C05D,>D82D,>0001
      DATA  >8C02,>0261,>8000,>D801,>8C02,>0380,>0201
      DATA  >4000,>1001,>04C1,>C09D,>D820,>2099,>8C02,>E081
      DATA  >D802,>8C02,>C06D,>0002,>C0AD,>0004,>045B
      DATA  >0204,>834A,>C014,>C184,>04F6,>04F6,>C140,>1323
      DATA  >0740,>0203,>0040,>04F6,>04D6,>0280,>0064
      DATA  >1A13,>0280,>2710,>1A08,>0583,>C040,>04C0,>3C20
      DATA  >20FA,>D920,>83E3,>0003,>0583,>C040,>04C0
      DATA  >3C20,>20FA,>D920,>83E3,>0002,>D920,>83E1,>0001
      DATA  >D520,>83E7,>0545,>1101,>0514,>045B,>C17E
      DATA  >53E0,>20FC,>C020,>8356,>C240,>0229,>FFF8,>0420
      DATA  >2114,>D0C1,>0983,>0704,>0202,>208C,>0580
      DATA  >0584,>80C4,>1306,>0420,>2114,>DC81,>9801,>20FE
      DATA  >16F6,>C104,>1352,>0284,>0007,>154F,>04E0
      DATA  >83D0,>C804,>8354,>C804,>2036,>0584,>A804,>8356
      DATA  >C820,>8356,>2038,>02E0,>83E0,>04C1,>020C
      DATA  >0F00,>C30C,>1301,>1E00,>022C,>0100,>04E0,>83D0
      DATA  >028C,>2000,>1332,>C80C,>83D0,>1D00,>0202
      DATA  >4000,>9812,>20FF,>16EE,>A0A0,>20A4,>1003,>C0A0
      DATA  >83D2,>1D00,>C092,>13E6,>C802,>83D2,>05C2
      DATA  >C272,>D160,>8355,>1309,>9C85,>16F2,>0985,>0206
      DATA  >208C,>9CB6,>16ED,>0605,>16FC,>0581,>C801
      DATA  >203A,>C809,>2034,>C80C,>2032,>0699,>10E2,>1E00
      DATA  >02E0,>209A,>C009,>0420,>2114,>09D1,>1604
      DATA  >0380,>02E0,>209A,>04C1,>06C1,>D741,>F3E0,>20FC
      DATA  >0380,>C80B,>2030,>02E0,>20BA,>0420,>2124
      DATA  >02E0,>83E0,>1303,>C2E0,>2030,>045B,>D820,>20BA
      DATA  >8322,>0460,>00CE,>04E0,>2022,>53E0,>20FC
      DATA  >C020,>8356,>0420,>2120,>0008,>1332,>0220,>FFF7
      DATA  >0201,>0200,>0420,>210C,>0580,>C800,>202E
      DATA  >C1E0,>2024,>C147,>04CC,>06A0,>25E0,>0283,>0001
      DATA  >1624,>058C,>04C3,>1023,>0283,>0046,>161E
      DATA  >04C2,>06A0,>262E,>0283,>003A,>16F7,>C020,>202E
      DATA  >0600,>0201,>0100,>0420,>210C,>06A0,>25E0
      DATA  >C020,>2022,>1307,>06A0,>2646,>1005,>CB4E,>0016
      DATA  >C3A0,>2022,>0380,>D740,>F3E0,>20FC,>0380
      DATA  >06A0,>25C2,>04C4,>D123,>2662,>0974,>C808,>202C
      DATA  >06A0,>2594,>0464,>23F8,>0580,>0240,>FFFE
      DATA  >C120,>2024,>A100,>1808,>8804,>2026,>1B05,>C160
      DATA  >2024,>C804,>2024,>100A,>C120,>2028,>A100
      DATA  >8804,>202A,>140C,>C160,>2028,>C804,>2028,>C1C5
      DATA  >0209,>0008,>06A0,>262E,>0609,>16FC,>10B6
      DATA  >0200,>0800,>10CC,>A005,>C800,>2022,>10AF,>A800
      DATA  >202C,>13AC,>0200,>0B00,>10C2,>A005,>C1C0
      DATA  >10A6,>A005,>DDC0,>DDE0,>20DB,>10A1,>A005,>06A0
      DATA  >2566,>C000,>1316,>0226,>FFF8,>8106,>1B02
      DATA  >0514,>1096,>8594,>16F8,>89A4,>0002,>0002,>16F4
      DATA  >89A4,>0004,>0004,>16F0,>C0E6,>0006,>C250
      DATA  >C403,>C009,>16FC,>0224,>0008,>C804,>202A,>10EA
      DATA  >A005,>06A0,>2566,>0226,>FFF8,>8106,>13E3
      DATA  >C296,>1501,>050A,>8294,>16F7,>89A4,>0002,>0002
      DATA  >16F3,>89A4,>0004,>0004,>16EF,>C296,>1516
      DATA  >C0E6,>0006,>C253,>C4C0,>C0C9,>16FC,>C246,>6244
      DATA  >C286,>022A,>0008,>C0C6,>0643,>064A,>C693
      DATA  >0649,>16FB,>0224,>0008,>C804,>202A,>10D9,>CB44
      DATA  >0002,>0200,>0C00,>0460,>2432,>0460,>2494
      DATA  >C28B,>0209,>0006,>C1A0,>202A,>0226,>FFF8,>C106
      DATA  >8806,>2028,>1AF3,>C806,>202A,>06A0,>262E
      DATA  >DDA0,>20E1,>0609,>16FA,>C580,>0206,>4000,>045A
      DATA  >C28B,>04C0,>C30C,>1308,>06A0,>262E,>D020
      DATA  >20E1,>06A0,>262E,>A003,>045A,>0209,>0004,>06A0
      DATA  >262E,>06A0,>25C2,>0A40,>A003,>0609,>16F8
      DATA  >045A,>0223,>FFD0,>0283,>000A,>1A05,>0223,>FFF9
      DATA  >0283,>0019,>1B01,>045B,>0200,>0A00,>0460
      DATA  >2432,>02E0,>83E0,>0200,>2032,>C330,>C270,>C830
      DATA  >8354,>C830,>8356,>C050,>1D00,>9820,>4000
      DATA  >20FF,>161D,>0699,>101B,>1E00,>02E0,>20DA,>C020
      DATA  >202E,>0201,>20DB,>0202,>0004,>0420,>2118
      DATA  >7000,>0950,>1610,>0982,>C001,>0201,>203C,>0420
      DATA  >2118,>04C8,>0602,>11D7,>D0F1,>0983,>A203
      DATA  >045B,>02E0,>20DA,>04C0,>06C0,>0460,>2432,>0201
      DATA  >3F40,>0221,>FFF8,>C011,>1105,>8060,>202A
      DATA  >16F9,>05CB,>045B,>0200,>0D00,>045B,>2D52,>5163
      DATA  >6483,>8455,>045C,>5B5F,>5EF0,>F003,>F0F0
      DATA  >4700,>00C8,>3F38
LOW4  DATA  >5554,>4C54,>4142,>2022,>5041,>4420,>2020,>8300
      DATA  >4750,>4C57,>5320,>83E0,>534F,>554E,>4420
      DATA  >8400,>5644,>5052,>4420,>8800,>5644,>5053,>5441
      DATA  >8802,>5644,>5057,>4420,>8C00,>5644,>5057
      DATA  >4120,>8C02,>5350,>4348,>5244,>9000,>5350,>4348
      DATA  >5754,>9400,>4752,>4D52,>4420,>9800,>4752
      DATA  >4D52,>4120,>9802,>4752,>4D57,>4420,>9C00,>4752
      DATA  >4D57,>4120,>9C02,>5343,>414E,>2020,>000E
      DATA  >584D,>4C4C,>4E4B,>2104,>4B53,>4341,>4E20,>2108
      DATA  >5653,>4257,>2020,>210C,>564D,>4257,>2020
      DATA  >2110,>5653,>4252,>2020,>2114,>564D,>4252,>2020
      DATA  >2118,>5657,>5452,>2020,>211C,>4453,>524C
      DATA  >4E4B,>2120,>4C4F,>4144,>4552,>2124,>4750,>4C4C
      DATA ,>4E4B,>2100
********************************************************************************
