***********************************************************
       TITL 'RXB 2022'
***********************************************************
       GROM >8000
***********************************************************
* RAM EXPANSION ADDRESS
CPUBAS EQU  >A040             Expansion RAM base
***********************************************************
*           GROM ADDRESSES
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS
* GROM >0000
ATNZZ  EQU  >0022             Arctangent routine
* GROM >6000
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
TOPL02 EQU  >6030             RTN address for failing AUTOLOADER
EDITLN EQU  >6032             Edit a line into the program
GWSUB  EQU  >6036             Write a few bytes of data to
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
READL1 EQU  >6A86             Read a line from keyboard
GTLIST EQU  >7A06             GKXB address
* GROM >A000
LITS05 EQU  >A002             Literal string common code
LINE   EQU  >A006             GET LINE NUMBER ROUTINE
DATAST EQU  >A008             SEARCH FOR NEXT "DATA" STATEM
CONV1  EQU  >A012             CONVERT WITH WARNING
VALCD  EQU  >A016             CONVERT STRING TO NUMBER
UBSUB  EQU  >A020             CLEAR BREAKPOINTS IN LN # TAB
***********************************************************
*    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
XCNS   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
VAR1   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
HIVDP  EQU  >8370             Highest VDP available
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
* RXB PATCH CODE * MOVED TO >03B8 SIZXPT (Size ACCEPT AT)
* MRGPAB EQU  >039E             MERGEd temporary for pab ptr
PMEM   EQU  >039E             UPPER 24K MEMORY
MRGPAB EQU  >03B8             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
VROAZ  EQU  >03C0             Temporary VDP Roll Out Area
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   * RXB REMOVED
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   DCHE >3CE2,@HIVDP      CALL FILES(0) USED ILLEGAL 
       BS   ERRMEM            ERROR MEMORY (all used)
       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  XCNS              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  XCNS    1          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.
***********************************************************
* RXB PATCH TO FIX ACCEPT USED IN EDIT MODE               
* ACCEPT CLR  V@ACCTRY          Clear "try again" flag
ACCEPT B    ACCPMM
ACCEP2 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 CONV1             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  @VAR0,@VAR0       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  @HIVDP,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  @HIVDP,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  @HIVDP,@VAR0
       DSUB @STLN,@VAR0
       DINC @VAR0             # of bytes to move
       DST  @VAR0,@CCC        @CCC : Byte count for VGWITE
* RXB PATCH CODE FOR PMEMORY UPPER 24K
*       DST  CPUBAS,@BBB       @BBB : Destination addr on ER
       DST  V@PMEM,@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  @HIVDP,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  @HIVDP,@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
* RXB PATCH CODE FOR PMEMORY UPPER 24K
*       DADD CPUBAS,@MNUM      Add the total # of bytes to C
       DADD V@PMEM,@MNUM  Add the total # of bytes to CPUBAS
* 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
* RXB PATCH CODE FOR PMEMORY UPPER 24K
* OLZZ   DST  CPUBAS,@BBB       @BBB : Destination addr in
OLDZZ  DST  V@PMEM,@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  HIVDP,@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 * IV254
* 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
* RXB PATCH CODE OPTION ADDED IV254 FOR SAVE 2015 *********
* SAVE "DSK#.FILENAME",MERGE ! SAVE MERGE FORMAT
* SAVE "DSK#.FILENAME",IV254 ! SAVE IV254 PROGRAM FORMAT
* SAVE "DSK#.FILENAME" ! NORMAL PROGRAM FORMAT OR IV254
*       BR   ERRSYN             If not : SYNTAX ERROR
       BR    CIV254            CHECK FOR IV254 OPTION
       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  @HIVDP,@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 are 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 * DV163
*           >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 CONV1             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@VROAZ   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@VROAZ,@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
***********************************************************
* RXB ROUTINE TO NOT ALLOW ACCEPT IN EDIT MODE
ACCPMM  CZ   @PRGFLG         * EDIT MODE?
        BR   ACCEP2          * No, program mode return
        XML  SCROLL          * Scroll screen for error
        CALL ERRZZ           * If imperative - error
        BYTE 27              * Only legal in a program
***********************************************************  
CIV254 DCEQ >4956,V@2(@PGMPTR) * IV?
       BR   ERRSYN
       DCEQ >3235,V@4(@PGMPTR) * 25?
       BR   ERRSYN
       CEQ  >34,V@6(@PGMPTR)   * 4?
       BR   ERRSYN
       CZ   @RAMTOP
       BS   SAZ1  
       DST  @RAMTOP,@MNUM     Top of memory in ERAM
       DSUB @STLN,@MNUM       Last line of program 
       DINC @MNUM             # of bytes total in ERAM
       DCHE 288,@MNUM         * 302 bytes
       BS   GSAVE             * IV254 FORMAT 
       BR   SAZ1              * PROGRAM FORMAT
************************************************************
       END