         TITLE    '***** EDITOR CODE SEGMENT *****'                             
*                 MODE = 1 FOR BTM VERSION                                      
*                      = 2 FOR UTS VERSION                                      
*                                                                               
*                      = 3 FOR CPR VERSION                                      
MODE     EQU      3                                                             
*                                                                               
S        FNAME                                                                  
         PROC                                                                   
         PEND     S:UFV(AF(MODE))                                               
*                                                                               
         SYSTEM SIG7FD                                                          
         DO       S(1,1,0)                                                      
         SYSTEM   BPM                                                           
         ELSE                                                                   
         SYSTEM   CPR                                                           
         FIN                                                                    
*                                                                               
*                                                                               
         CSECT    S(0,1,1)                                                      
ESEGBASE RES      0                                                             
         REF      STACK                                                         
         REF      STACKDW                                                       
         REF      DMY%TYPECERR                                                  
         REF      DMY%TYPEPERR                                                  
         REF      DMY%TPM                                                       
         DO       MODE=1                                                        
         REF      EDIT%TCB                                                      
         REF      EDIT%TSTK                                                     
         REF      EDIT%DCBT                                                     
         FIN                                                                    
         REF      MVD:REC:CNT                                                   
         REF      CHG:STG:CNT                                                   
         REF      DEL:REC:CNT                                                   
         REF      BUILDFLAG                                                     
         REF      CFLAG                                                         
         REF      INTFLAG1                                                      
         REF      INTFLAG2                                                      
         REF      TABERRFLAG                                                    
         REF      TABCFLAG                                                      
         REF      TABXFLAG                                                      
         REF      TSADDR                                                        
         REF      XEQFLAG                                                       
         REF      TPC%BUF                                                       
         DO       S(1,1,0)                                                      
         REF      O%NAME                                                        
         REF      O%FPT                                                         
         REF      O%ACCT                                                        
         REF      O%PASS                                                        
         REF      O2%NAME                                                       
         REF      O2%FPT                                                        
         REF      O2%ACCT                                                       
         REF      O2%PASS                                                       
         FIN                                                                    
         REF      ALLFLAG                                                       
         REF      ALLOK                                                         
         REF      BLANKCNT                                                      
         REF      BPFLAG                                                        
         REF      CARDIMG                                                       
         REF      CDT                                                           
         REF      CDTADR                                                        
         REF      CHARPSN                                                       
         REF      COPYFL                                                        
         REF      CRFLAG                                                        
         REF      DFLTINCR                                                      
         REF      EODCLMN                                                       
         REF      ERRORCNT                                                      
         REF      FID1ADR                                                       
         REF      FID2ADR                                                       
         REF      FIELDCNT                                                      
         REF      FILETYPE                                                      
         REF      FRSTCLMN                                                      
         REF      FIRSTFROM                                                     
         REF      FIRSTSET                                                      
         REF      GOSEQ                                                         
         REF      KBUF                                                          
         REF      LASTCLMN                                                      
         REF      LASTFROM                                                      
         REF      LASTKEY                                                       
         REF      LASTSET                                                       
         REF      MAXSEQ                                                        
         REF      NOCHGFLG                                                      
         REF      NXINSRT                                                       
         REF      PARAMBUF                                                      
         REF      PARAMPSN                                                      
         REF      PRMBUFSZ                                                      
         REF      RECSIZE                                                       
         REF      SETADR                                                        
         REF      SETFLAG                                                       
         REF      SIEOF                                                         
         REF      STEPFLAG                                                      
         REF      STOPCLMN                                                      
         REF      SV1STSET                                                      
         REF      SVBPFLAG                                                      
         REF      TEMPBLCK                                                      
         REF      TEXTCADR                                                      
         REF      TTYIMG                                                        
         REF      TTYIMGSZ                                                      
         REF      DELNXT                                                        
         REF      MSGBUF                                                        
         REF      PROMPT                                                        
         DO       S(0,0,1)                                                      
         REF      EOFORMAT                                                      
         REF      EOFSIZE                                                       
         REF      EORSIZE                                                       
         REF      FORCESV                                                       
         REF      SAVEFID                                                       
         REF      SAVESEQ                                                       
         REF      SAVON                                                         
         REF      SUBJFID                                                       
         REF      SCRFID                                                        
         FIN                                                                    
         DO       MODE=1                                                        
         REF      F:EI                                                          
         REF      F:EO                                                          
         FIN                                                                    
         DEF      MASTERPARSER                                                  
         DO       S(1,1,0)                                                      
         DEF      O%ABN                                                         
         DEF      O2%ABN                                                        
         FIN                                                                    
         DEF      TYPECERR                                                      
         DEF      TYPEPERR                                                      
         DEF      TYPEMSG                                                       
         REF      EDITBASE                                                      
         DEF      ESEGBASE                                                      
         DEF      BEGINEDITOR                                                   
         DO       S(0,1,1)                                                      
         DO       S(0,1,0)                                                      
         REF      M:UC                                                          
         ELSE                                                                   
         REF      M:C                                                           
         FIN                                                                    
         REF      M:LL                                                          
         REF      M:EI,M:EO                                                     
         REF      M:SI,M:LO                                                     
         ELSE                                                                   
         DEF      F:EI,F:EO                                                     
         FIN                                                                    
*                                                                               
         PAGE                                                                   
*************************                                                       
*  REGISTER ALLOCATION  *                                                       
*************************                                                       
*                                                                               
*                                                                               
*  REGISTERS 1-13 MUST BE PRESERVED BY ANY SUBR WHICH USES THEM                 
*                                                                               
X3       EQU      1                                                             
X4       EQU      2                                                             
X1       EQU      3                                                             
X2       EQU      4                                                             
P1       EQU      5                                                             
P2       EQU      6                                                             
LNK      EQU      7                                                             
T1       EQU      8                                                             
T2       EQU      9                                                             
P3       EQU      10                                                            
R1       EQU      11                                                            
R2       EQU      12                                                            
R3       EQU      P3                                                            
F:LNK    EQU      13                                                            
R:LNK    EQU      13                                                            
I:LNK    EQU      13                                                            
*                                                                               
*  REGISTERS 0,14-15 ARE NEVER SAVED BY SUBRS                                   
*                                                                               
R0       EQU      0                                                             
D0       EQU      14                                                            
D1       EQU      15                                                            
*                                                                               
         DO       S(0,0,1)                                                      
K:MDNAME EQU      X'212'            DISK AREA NAME TABLE POINTER                
         FIN                        S(0,0,1)                                    
         PAGE                                                                   
***********************                                                         
*  SYSTEM PROCEDURES  *                                                         
***********************                                                         
*                                                                               
*                                                                               
GEN4     COM,8,8,8,8    AF(1),AF(2),AF(3),AF(4)                                 
*                                                                               
*                                                                               
PUSH     CNAME                                                                  
         PROC                                                                   
         LOCAL    I                                                             
LF       EQU      %                                                             
I        DO       NUM(AF)                                                       
         DO       NUM(AF(I))=1                                                  
         PSW,AF(I) STACKDW                                                      
         ELSE                                                                   
         LCI      (AF(I,2)-AF(I,1)+1)&X'F'                                      
         PSM,AF(I,1) STACKDW                                                    
         FIN                                                                    
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
PULL     CNAME                                                                  
         PROC                                                                   
         LOCAL    I,K                                                           
LF       EQU      %                                                             
I        DO       NUM(AF)                                                       
K        SET      NUM(AF)-I+1                                                   
         DO       NUM(AF(K))=1                                                  
         PLW,AF(K) STACKDW                                                      
         ELSE                                                                   
         LCI      (AF(K,2)-AF(K,1)+1)&X'F'                                      
         PLM,AF(K,1) STACKDW                                                    
         FIN                                                                    
         FIN                                                                    
         PEND                                                                   
*                                                                               
*                                                                               
PURGE    CNAME                                                                  
         PROC                                                                   
         LOCAL    I,N                                                           
N        SET      0                                                             
I        DO       NUM(AF)                                                       
         DO       NUM(AF(I))=1                                                  
N        SET      N+1                                                           
         ELSE                                                                   
N        SET      N+((AF(I,2)-AF(I,1))&X'F')+1                                  
         FIN                                                                    
         FIN                                                                    
LF       LI,0     -N                                                            
         MSP,0    STACKDW                                                       
         PEND                                                                   
*                                                                               
*                                                                               
         OPEN     BIL,BOL                                                       
BIL      CNAME    X'68'                                                         
BOL      CNAME    X'69'                                                         
         PROC                                                                   
         GEN,1,7,4,3,17  AFA,NAME,9,AF(2),AF(1)                                 
         PEND                                                                   
         PAGE                                                                   
***********************                                                         
*  PARSER PROCEDURES  *                                                         
***********************                                                         
*                                                                               
*                                                                               
END      EQU      0                                                             
NAME     EQU      1                                                             
SEQ      EQU      2                                                             
SEQ2     EQU      3                                                             
INTG     EQU      4                                                             
STRG     EQU      5                                                             
ALPH     EQU      6                                                             
COM      EQU      7                                                             
SCOL     EQU      8                                                             
LPAR     EQU      9                                                             
RPAR     EQU      10                                                            
PERIOD   EQU      11                UTS FILE SEPARATOR                          
BLANK    EQU      12                                                            
*                                                                               
*                                                                               
NXTNAM   CNAME    GETNEXTNAME                                                   
NXTPRM   CNAME    GETNEXTPARAM                                                  
         PROC                                                                   
         LOCAL    I,N                                                           
N        SET      NUM(AF)-1                                                     
LF       BAL,LNK  NAME(1)                                                       
         GEN,8,1,23 N,AFA(1),AF(1)                                              
I        DO       N                                                             
         ERROR,1,NUM(AF(I+1))~=2 'ILGL SYNTAX'                                  
         DO       AFA(I+1,2)=1                                                  
         GEN,8,24 AF(I+1,1),%+N-I+AF(I+1,2)+1                                   
         ELSE                                                                   
         GEN,8,24 AF(I+1,1),AF(I+1,2)                                           
         FIN                                                                    
         FIN                                                                    
         PEND                                                                   
         PAGE                                                                   
***************************                                                     
*  ADJUSTABLE PARAMETERS  *                                                     
***************************                                                     
*                                                                               
*                                                                               
DFLTSEQ  EQU      1000              DEFAULT STARTING SEQ. #                     
MAXCLMN  EQU      140                                                           
SEQLIM   EQU      9999999           FOR MAX. SEQ. NO.                           
STACKSZ  EQU      125               SIZE OF TEMP STACK                          
*                                                                               
FIRST%F:CMND      EQU 1                                                         
FIRST%I:CMND      EQU 30                                                        
FIRST%R:CMND      EQU 10                                                        
LAST%R:CMND       EQU 24                                                        
I:DE%CMND%NR  EQU  47                                                           
I:TS%CMND%NMR     EQU 42                                                        
I:TY%CMND%NMR     EQU 43                                                        
R:TS%CMND%NMR     EQU 21                                                        
R:TY%CMND%NMR     EQU 22                                                        
*                                                                               
*                                                                               
BL       EQU      ' '                                                           
CM       EQU      ','                                                           
CR       EQU      S(X'15',X'0D',X'0D')                                          
EOF      EQU      10000000                                                      
EOM      EQU      X'08'                                                         
SYNC     EQU      X'16'             SYNC CHAR                                   
LF       EQU      S(X'25',X'15',X'15')                                          
PR       EQU      '.'                                                           
LP       EQU      '('                                                           
RP       EQU      ')'                                                           
SC       EQU      ';'                                                           
         PAGE                                                                   
*******************                                                             
*  CONSTANT DATA  *                                                             
*******************                                                             
*                                                                               
*                                                                               
K1       DATA     1                                                             
K10      DATA     10                                                            
KPE      DATA     '.'                                                           
*                                                                               
XF       DATA     X'F'                                                          
XF0      DATA     X'F0'                                                         
XFF00    DATA     X'FF00'                                                       
XFFFF    DATA     X'FFFF'                                                       
X1FFFF   DATA     X'1FFFF'                                                      
XFFFFFF  DATA     X'FFFFFF'                                                     
X800000  DATA     X'800000'                                                     
*                                                                               
4BLNKS   DATA     '    '                                                        
         BOUND    8                                                             
DMYSTKDW DATA     STACK                                                         
         DATA,2   STACKSZ,0                                                     
HEXCHAR  TEXT     '0123456789ABCDEF'                                            
X:NS     TEXTC    'NS'                                                          
X:ON     TEXTC    'ON'                                                          
X:OVER   GEN4     4,'O','V','E'                                                 
X:INTO   GEN4     4,'I','N','T'                                                 
X:TO     TEXTC     'TO'                                                         
         DO       MODE=2                                                        
X:F      TEXTC    'F'                                                           
X:M      TEXTC    'M'                                                           
X:S      TEXTC    'S'                                                           
*                                                                               
         FIN                                                                    
*                                                                               
*  SPECIAL LIMITS                                                               
*                                                                               
         BOUND    8                                                             
DIGITS   DATA     '0','9'                                                       
LETTERS  DATA     'A','Z'                                                       
HEXVALUE DATA     0,15                                                          
         DO       S(0,1,1)                                                      
LCLETTERS DATA    X'81',X'A9'                                                   
         FIN                                                                    
         PAGE                                                                   
*****************************************************************               
*        PROCEDURE TO MOVE MESSAGES INTO BUFFER FOR ALTERATIONS *               
*****************************************************************               
MOVEMSG  CNAME                                                                  
         PROC                                                                   
         LB,AF(2) AF(1)                                                         
         STB,AF(2) MSGBUF                                                       
         LB,CF(2) AF(1),AF(2)                                                   
         STB,CF(2) MSGBUF,AF(2)                                                 
         BDR,AF(2) %-2                                                          
         PEND                                                                   
         PAGE                                                                   
********************                                                            
*  ERROR MESSAGES  *                                                            
********************                                                            
*                                                                               
*                                                                               
ERRC1    TEXTC    '--C1:OVERFLOW'                                               
ERRC2    TEXTC    '--C1:UNDERFLOW'                                              
ERRC3    TEXTC    '-C1:NO SUCH REC'                                             
ERRC4    TEXTC    '-C1:CMND ILGL HERE'                                          
ERRC5    TEXTC    '--C1:NO SUCH STRG'                                           
ERRC6    TEXTC    '--C1:COL>LIMIT'                                              
ERRC7    TEXTC    '--C1:''ALL'' IGNORED'                                        
ERRC8    TEXTC    '-C1:UNKN CMND'                                               
ERRC9    TEXTC    '-C1:ILGL SYNTAX'                                             
ERRC10   TEXTC    '--C1:COL<LIMIT'                                              
ERRC11   TEXTC    '-BAD COL. NO. PAIR'                                          
*                                                                               
*                                                                               
ERRM1    TEXTC    '--EOF HIT AFTER YYYY.YYY'                                    
ERRM3    TEXTC    '--OVERFLOW'                                                  
ERRM4    TEXTC    '-RNG OVERLAP'                                                
ERRM5    TEXTC    '-NOT ON/OFF'                                                 
ERRM6    TEXTC    '--NONE'                                                      
ERRM8    TEXTC    '-MISSING SE'                                                 
         DO1      S(1,1,0)                                                      
ERRM12   TEXTC    '-FILE NOT KEYED; MUST COPY'                                  
ERRM13   TEXTC    '-NO FILE NAMED'                                              
ERRM14   TEXTC    '-NO SUCH FILE'                                               
ERRM14A  TEXTC    'NONEXISTANT SCRATCH FILE'                                    
ERRM15   TEXTC    '-FILE EXISTS; CAN''T BUILD'                                  
*                                                                               
ERRM16   TEXTC    '-NOTHING TO MOVE'                                            
         DO       S(1,1,0)                                                      
ERRM17   TEXTC   '-MERGE SOURCE NOT KEYED'                                      
ERRM18   TEXTC  '-MERGE DESTINATION NOT KEYED'                                  
ERRM19   TEXTC    '-SORRY... NO PASSWORD ALLOWED HERE.'                         
         FIN                                                                    
ERRM20   TEXTC    '-MAX. SEQ. NO. EXCEEDED'                                     
ERRM21   TEXTC    '-CANT DELETE ALL BLANKS WITH BP OFF'                         
ERRM22   TEXTC    '--RNG EMPTY'                                                 
*                                                                               
ERRP1    TEXTC    '-P1:NO SUCH REC'                                             
ERRP2    TEXTC    '-P2:REC EXISTS'                                              
ERRP3    TEXTC    '-P1:BAD FID'                                                 
ERRP4    TEXTC    '-P1:ILGL SYNTAX'                                             
ERRP5    TEXTC    '-P1:NOT SEQ #'                                               
ERRP6    TEXTC    '-P1:NOT INCR'                                                
ERRP7    TEXTC    '-P1:NOT COL #'                                               
ERRP8    TEXTC    '-P1:NOT STRG'                                                
ERRP9    TEXTC    '-P1:NOT CNT'                                                 
ERRP10   TEXTC    '-P1:ILGL SEQ #'                                              
ERRP11   TEXTC    '-P1:SEQ2<SEQ1'                                               
ERRP12   TEXTC    '-P1:NO SUCH FILE'                                            
ERRP13   TEXTC    '-P2:FILE EXISTS'                                             
ERRP14   TEXTC    '-P2:COL ERROR'                                               
ERRP14A  EQU      ERRP14                                                        
ERRP15   TEXTC    '-P1:ILGL STRG'                                               
         DO1      S(1,1,0)                                                      
ERRP16   TEXTC    '-P1:FILE NOT KEYED & P3 NULL'                                
ERRP17   TEXTC    '-P1:PARAM MISSING'                                           
ERRP18   TEXTC    '-P1:NULL STRG'                                               
*                                                                               
*                                                                               
MSG0     GEN4     3,S(CR,BL,BL),S(LF,0,0),S(EOM,0,0)                            
         DO       S(1,1,0)                                                      
MSG1     TEXTC    '..COPYING'                                                   
MSG2     TEXTC    '..COPY DONE'                                                 
MSG3     TEXTC    '..DELETED'                                                   
MSG4     TEXTC    '..EDIT STOPPED'                                              
MSG5     TEXTC    '..MERGE STARTED'                                             
         FIN                                                                    
MSG6     TEXTC   '         RECORDS DELETED'                                     
MSG7     TEXTC     ' 0000000 RECORDS MOVED'                                     
MSG8     TEXTC    '         STRINGS CHANGED'                                    
*                                                                               
*                                                                               
IOERRMSG DATA     X'0060C2C1'+((IOERRCOD+1-IOERRMSG)*4-1)**24                   
         TEXT     'D I/O; ABN CODE'                                             
IOERRCOD DATA     '    '            ABN CODE PUT IN LAST TWO BYTES              
*                                                                               
*                                                                               
MVEMSG1  TEXTC    '--DONE AT '                                                  
         RES      3                                                             
MVEMSG2  TEXTC    '--CUTOFF AT '                                                
         RES      5                                                             
         PAGE                                                                   
***********************************                                             
*  EDIT TASK CONTROL BLOCK, ETC.  *                                             
***********************************                                             
*                                                                               
*                                                                               
         DO       S(0,1,1)                                                      
*                                                                               
**************************************************                              
*        UTS INTERFACE PARAMETERS AND MESSAGES.  *                              
**************************************************                              
*                                                                               
PR%1AS   GEN4     2,'*',EOM,0                                                   
PR%2AS   GEN4     3,'*','*',EOM                                                 
PR%PR    GEN4     2,PR,EOM,0                                                    
PR%NULL  DATA     0                                                             
BR%FPT   GEN,8,24  X'10',S(0,M:UC,M:C) READ AFTER BREAK                         
         DATA     X'34000010',CFLAG,1,0                                         
TPC%FPT  GEN,8,24 X'11',M:LO                                                    
         DATA     X'30000010'                                                   
         DATA     TPC%BUF                                                       
         PZE      *X2                                                           
TYPM%FPT GEN,8,24 X'11',M:LL                                                    
         DATA     X'34000010'                                                   
         PZE      *LNK                                                          
         PZE      *X2                                                           
         DATA      1                                                            
         DO       S(1,1,0)                                                      
RT%FPT   GEN,8,24 X'10',M:SI                                                    
         DATA     X'74000010'                                                   
         PZE      RT%ABN                                                        
         PZE      *X1                                                           
         DATA     MAXCLMN                                                       
         DATA     0                                                             
         ELSE                                                                   
RT%FPT   M:READ,FPT  M:SI,(ABN,RT%ABN),;                                        
                     (BUF,*X1),(SIZE,MAXCLMN),(PROMPT,0),WAIT                   
         FIN                                                                    
*                                                                               
RT%ABN   LB,D1    10                                                            
         CI,D1    X'05'                                                         
         BE       %+3                                                           
         CI,D1    X'06'                                                         
         BNE      BADIO             B IF NOT EOF ABNORMAL                       
         MTW,0    SIEOF                                                         
         BEZ      %+2               B IF PRIOR READ WAS NOT EOF                 
         M:EXIT                                                                 
         MTW,1    SIEOF             FLAG THAT EOF WAS READ ON SI                
         LI,R0    X'0100'                                                       
         STW,T1   CDT+1                                                         
         LI,R0    CDT+1                                                         
         STW,R0   CDTADR                                                        
         LI,R0    0                                                             
         STW,R0   CDT                                                           
         LI,P1    6                 END COMMAND NR                              
         BAL,LNK  NEWCDTENTRY                                                   
         DATA     1                                                             
         B        MASTEREXECUTIVE   SIMULATE END COMMAND                        
*                                                                               
*                                                                               
*                                                                               
UTSM1    TEXTC    'EDIT HERE'                                                   
UTSM2    TEXTC    '* '              * + EOM                                     
         DO1      S(0,1,0)                                                      
UTSM3    TEXTC    '-NOT F/M/S'                                                  
UTSM4    TEXTC    '--INTRA-RECORD COMMAND INTERRUPT AT '                        
         RES      3                                                             
UTSM5    TEXTC    '--COMMAND INTERRUPT AT '                                     
         RES      7                                                             
UTSM6   TEXTC    '-- X TO ABORT.'                                               
UTSM7    TEXTC    'WHILE DELETING)'                                             
         DO1      S(0,1,0)                                                      
UTSM8    TEXTC   '--TAB CHAR. FOUND; ''TA'' NEEDED FOR COL. SIMULATION'         
*                                            *****                              
BDISPTBL EQU      %-1               THESE COMMANDS REQUIRE DISPLAY              
         GEN,8,24 4,'COP'           OF SEQ. NUMBERS SET UP IN                   
         GEN,8,24 5,'MER'           INTFLAG1 AND INTFLAG2, WHEN                 
         TEXTC    'MK'              INTERRUPTED BY THE BREAK KEY                
         TEXTC    'MD'                                                          
BDT2NR   EQU      %-BDISPTBL-1      BEFORE HERE ARE 2-NR COMMANDS,              
*                                   AFTER ARE 1-NR COMMANDS                     
         TEXTC    'DE'                                                          
         TEXTC    'FD'                                                          
         TEXTC    'FT'                       *****                              
         DO       S(0,0,1)                                                      
         GEN,8,24 4,'EDI'                                                       
         GEN,8,24 4,'SAV'                                                       
         TEXTC    'END'                                                         
         FIN                                                                    
BDTL     EQU      %-BDISPTBL-1      LENGTH OF TABLE                             
*                                                                               
         FIN                                                                    
         DO       S(0,1,0)                                                      
RELATIVE DATA,1      6,32,0,0       THIS IS AN FPT FOR                          
         DATA        1**29          SETTING RELATIVE TABS.                      
         DATA,2       X'80',X'80'                                               
         FIN                                                                    
         DO       S(0,1,1)                                                      
F:EI     EQU      M:EI                                                          
         FIN                                                                    
         DO       S(0,1,1)                                                      
F:EO     EQU      M:EO                                                          
         FIN                                                                    
         PAGE                                                                   
***********************************                                             
*                                 *                                             
*     B E G I N   E D I T O R     *                                             
*                                 *                                             
***********************************                                             
*                                                                               
*                                                                               
*                                                                               
BEGINEDITOR       EQU %                                                         
         B        BGD10           :::ENTER HERE AT NORMAL START                 
         DO       MODE=1                                                        
         MTW,0    FILETYPE        :::ENTER HERE AT BREAK                        
         BLZ      %+2               RE-OPEN FILE IF ONE WAS OPEN                
         BAL,LNK  REOPEN                                                        
         LI,T1    0                 RESET ASSORTED FLAGS, ETC.                  
         STW,T1   LASTKEY                                                       
         STW,T1   NOCHGFLG                                                      
         STW,T1   SETFLAG                                                       
         STW,T1   STEPFLAG                                                      
         LI,T1    -1                                                            
         STW,T1   ALLFLAG                                                       
*                                                                               
*  FINISH INITIALIZATION                                                        
*                                                                               
BGD10    LI,R0    4                 SET ACTIVATION TYPE = 4                     
         CAL3,2   0                                                             
         BAL,LNK  TYPEMSG           TYPE: L/F + C/R                             
         DATA     MSG0                                                          
*                                                                               
         LI,T1    EDITBASE          CONVERT BASE TO                             
         SLS,T1   -9                PAGES.                                      
*                                                                               
         LI,LNK   BEGINEDITOR       CONVERT PROGRAM TO NEXT                     
         AI,LNK   X'1FF'            HIGHER PAGE, PUT                            
         SLS,LNK  -9                                                            
         STW,LNK  R0                IN R0.                                      
*                                                                               
         SW,R0    T1                CONVERT R0 TO PROGRAM DATA                  
         STB,LNK  R0                PAGE COUNT.                                 
*                                                                               
         LI,T1    ENDEDITOR         COMPUTE PURE PROCEDURE PAGE COUNT           
         AI,T1    X'1FF'                                                        
         SLS,T1   -9                                                            
         SW,T1    LNK               END-BEGIN                                   
*                                                                               
         LI,X3    0                 SET UP REGISTER 1,                          
         STB,T1   X3                                                            
         CAL3,11  0                 SET SWAP SIZE                               
         ELSE                                                                   
BGD10    EQU      %                                                             
         STW,R0   TSADDR                                                        
*                                                                               
         DO       S(1,1,0)                                                      
         CAL1,8      RELATIVE       TABING                                      
         BAL,LNK  TYPEMSG                                                       
         DATA     UTSM1                                                         
         FIN                                                                    
         M:INT    BRK%KEY                                                       
         DO       S(1,1,0)                                                      
         M:OPEN   M:LO,SAVE                                                     
         M:OPEN   M:LL,SAVE                                                     
         FIN                                                                    
         FIN                                                                    
         B        MASTERPARSER1                                                 
         PAGE                                                                   
*************************************                                           
*                                   *                                           
*     M A S T E R   P A R S E R     *                                           
*                                   *                                           
*************************************                                           
*                                                                               
*                                                                               
*                                                                               
MASTERPARSER      EQU %                                                         
         DO       S(0,0,1)                                                      
         LC       X'4E'                                                         
         BCR,4    %+2               B IF NOT BACKGROUND                         
         M:WAIT                                                                 
         FIN                                                                    
         LI,T1    -1                                                            
         STW,T1   GOSEQ             RESET EXECUTE FROM EDIT FILE FLAG           
MASTERPARSER1  RES  0                                                           
         DO       S(0,1,1)                                                      
         LW,T1    PR%1AS                                                        
         STW,T1   PROMPT                                                        
         DO       S(1,1,0)                                                      
         M:DEVICE M:LO,NOVFC                                                    
         ELSE                                                                   
         M:VFC    M:LO,NOVFC                                                    
         FIN                                                                    
         LI,T1    -1                                                            
         STW,T1   INTFLAG1                                                      
         STW,T1   INTFLAG2                                                      
         STW,T1    ALLFLAG          RESET ALL FLAG                              
         STW,T1   XEQFLAG                                                       
         FIN                                                                    
         LD,T1    DMYSTKDW          PURGE STACK                                 
         STD,T1   STACKDW                                                       
         LI,T1    0                                                             
         DO1      S(0,0,1)                                                      
         STW,T1   NOBRKFLG          FLAG:  BREAK PERMITTED                      
         STW,T1   CDT               SET # OF CMNDS = 0                          
         STW,T1    MVD:REC:CNT      SET MVD:REC:CNT = 0                         
         STW,T1    CHG:STG:CNT      SET CHG:STG:CNT = 0                         
         STW,T1   DEL:REC:CNT       SET DEL:REC:CNT = 0                         
         LI,T1    X'0100'           PUT 'END OF CDT' MARKER IN CDT              
         STW,T1   CDT+1                                                         
         LI,T1    CDT+1             INIT CDTADR=1ST CMND ADDR                   
         STW,T1   CDTADR                                                        
         LI,T1    500000            SET TO PRINT ALL ERROR MSGS                 
         STW,T1   ERRORCNT                                                      
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE                      
         BEZ      %+3                                                           
         DO       MODE=1                                                        
         LI,R0    '*'               YES - TYPE: '*'                             
         CAL3,1   0                                                             
         LI,R0    '*'               TYPE PROMPT: '*'                            
         CAL3,1   0                                                             
         ELSE                                                                   
         LW,R0    PR%2AS                                                        
         STW,R0   PROMPT            SET PROMPT TO  **                           
         FIN                                                                    
PRS5     RES      0                 BRANCH TO READ CONTINUATION                 
         BAL,LNK  READTELETYPE2     READ IN COMMANDS                            
         AI,R1    -1                SAVE CNT OF # OF CHARS INPUT,               
         STW,R1   TTYIMGSZ           LESS C/R                                   
         LI,T1    0                                                             
         STW,T1   CHARPSN           SET NEXT CHAR TO SCAN TO 0                  
*                                                                               
*                                                                               
*                                                                               
RESUME%PARSING    EQU %             (ENTER HERE AFTER SEMI-COLON FOUND)         
         LB,T1    *CDTADR           INCR CDTADR TO NEXT ENTRY                   
         AWM,T1   CDTADR                                                        
         LI,T1    4                 SET PSN OF NEXT PARAM = 1                   
         STW,T1   PARAMPSN                                                      
         MTW,1    CDT               INCR OCUNT OF # OF ENTRIES                  
         NXTPRM   ERRC9,;                                                       
                  (INTG,PARSE:I:CMND%INTG),;                                    
                  (STRG,PARSE:I:CMND%STRG),;                                    
                  (ALPH,*),;                                                    
                  (END,CMND%CONT)                                               
         LI,X1    CTBLSZ                                                        
         LW,T1    PARAMBUF          SEARCH FOR COMMAND NAME IN TABLE            
         CW,T1    CNAMETBL,X1                                                   
         BE       PRS10             FOUND - GO PROCESS                          
         BDR,X1   %-2               LOOP                                        
         BAL,LNK  TYPECERR          NOT IN TBL - TYPE: '-CN:UNKN CMND'          
         DATA     ERRC8                                                         
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  COMMAND FOUND: GO PROCESS ITS PARAMETERS                                     
*                                                                               
PRS10    LB,P1    CNMRTBL,X1        SET P1=CMND NUMBER                          
         EXU      CBRCHTBL,X1       GO PROCESS CMND PARAMS                      
*                                                                               
*                                                                               
*                                                                               
ILGL%SEMICOLON    EQU %             (ENTER HERE IF ; AFTER F: OR R:CMND)        
         LI,T1    X'0100'           INCR TO TYPE # OF NEXT CMND                 
         AWM,T1   CDT                                                           
         BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'                  
         DATA     ERRC4                                                         
         B        MASTERPARSER                                                  
*                                                                               
*        LINE END FOUND INSTEAD OF NEXT COMMAND                                 
*        COMMAND CONTINUATION OR NULL LINE                                      
*                                                                               
CMND%CONT RES     0                                                             
         LW,R0    CHARPSN                                                       
         CI,R0    1                                                             
         BE       MASTEREXECUTIVE   B IF NULL LINE                              
         MTW,-1   CDT               BACK UP COMMAND COUNTER                     
         B        PRS5              B TO GET CONTINUATION LINE                  
*                                                                               
*  COMMAND NAME TABLE                                                           
*                                                                               
CNAMETBL EQU      %-1                                                           
         TEXTC    'BP'               1: BP                                      
         DO       S(1,1,0)                                                      
         GEN,8,24 5,'BUI'            2: BUILD                                   
         GEN,8,24 4,'COP'            3: COPY                                    
         GEN,8,24 6,'DEL'            4: DELETE                                  
         ELSE                                                                   
         GEN,8,24 4,'SAV'           2: SAVE                                     
         FIN                                                                    
         GEN,8,24 4,'EDI'            5: EDIT                                    
         TEXTC    'END'              6: END                                     
         DO       S(1,1,0)                                                      
         TEXTC    'TA'               7: TAB                                     
         TEXTC    'CR'               8: CR                                      
         GEN,8,24 5,'MER'            9: MERGE                                   
         ELSE                                                                   
         TEXTC    'SEQ'             8: SEQ                                      
         FIN                                                                    
         TEXTC    'CM'              10: CM                                      
         TEXTC    'DE'              11: DE                                      
         TEXTC    'FD'              12: FD                                      
         TEXTC    'FT'              13: FT                                      
         TEXTC    'IN'              14: IN                                      
         TEXTC    'IS'              15: IS                                      
         TEXTC    'MD'              16: MD                                      
         TEXTC    'MK'              17: MK                                      
         TEXTC    'RN'              18: RN                                      
         TEXTC    'SS'              19: SS                                      
         TEXTC    'ST'              20: ST                                      
         TEXTC    'TS'              21: TS                                      
         TEXTC    'TY'              22: TY                                      
         TEXTC    'TC'              23: TC                                      
         TEXTC    'FS'              24: FS                                      
         TEXTC    'GO'              25: GO                                      
         TEXTC    'RET'             26: RET                                     
         TEXTC    'SE'              30: SE                                      
         TEXTC    'JU'              39: JU                                      
         TEXTC    'NO'              40: NO                                      
         TEXTC    'RF'              41: RF                                      
         TEXTC    'C'               48: C                                       
         TEXTC    'CL'              49: CL                                      
CTBLSZ   EQU      %-CNAMETBL-1                                                  
*                                                                               
*  COMMAND BRANCH TABLE                                                         
*                                                                               
CBRCHTBL EQU      %-1                                                           
         B        PARSE:BP           1: BP                                      
         DO       S(1,1,0)                                                      
         B        PARSE:BUILD        2: BUILD                                   
         B        PARSE:COPY         3: COPY                                    
         B        PARSE:DELETE       4: DELETE                                  
         ELSE                                                                   
         B        PARSE:SAVE        2: SAVE                                     
         FIN                                                                    
         B        PARSE:EDIT         5: EDIT                                    
         B        PARSE:END          6: END                                     
         DO       S(1,1,0)                                                      
         B        PARSE:TA           7: TAB                                     
         B        PARSE:CR           8: CR                                      
         B        PARSE:MERGE        9: MERGE                                   
         ELSE                                                                   
         B        PARSE:SEQ         8: SEQ                                      
         FIN                                                                    
         B        PARSE:CM          10: CM                                      
         B        PARSE:DE          11: DE                                      
         B        PARSE:FD          12: FD                                      
         B        PARSE:FT          13: FT                                      
         B        PARSE:IN          14: IN                                      
         B        PARSE:IS          15: IS                                      
         B        PARSE:MD          16: MD                                      
         B        PARSE:MK          17: MK                                      
         B        PARSE:RN          18: RN                                      
         B        PARSE:SS          19: SS                                      
         B        PARSE:ST          20: ST                                      
         B        PARSE:TS          21: TS                                      
         B        PARSE:TY          22: TY                                      
         B        PARSE:TC          23: TC                                      
         B        PARSE:FS          24: FS                                      
         B        PARSE:GO          25: GO                                      
         B        PARSE:RET         26: RET                                     
         B        PARSE:SE          30: SE                                      
         B        PARSE:JU          39: JU                                      
         B        PARSE:NO          40: NO                                      
         B        PARSE:RF          41: RF                                      
         B        PARSE:C           48: C                                       
         B        PARSE:CL          49: CL                                      
*                                                                               
*  COMMAND NUMBER TABLE                                                         
*                                                                               
CNMRTBL  EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   1                  1: BP                                      
         DO       S(1,1,0)                                                      
         DATA,1   2                  2: BUILD                                   
         DATA,1   3                  3: COPY                                    
         DATA,1   4                  4: DELETE                                  
         ELSE                                                                   
         DATA,1   2                 2: SAVE                                     
         FIN                                                                    
         DATA,1   5                  5: EDIT                                    
         DATA,1   6                  6: END                                     
         DO       S(1,1,0)                                                      
         DATA,1   7                  7: TAB                                     
         DATA,1   8                  8: CR                                      
         DATA,1   9                  9: MERGE                                   
         ELSE                                                                   
         DATA,1   8                 8: SEQ                                      
         FIN                                                                    
         DATA,1   10                10: CM                                      
         DATA,1   11                11: DE                                      
         DATA,1   12                12: FD                                      
         DATA,1   13                13: FT                                      
         DATA,1   14                14: IN                                      
         DATA,1   15                15: IS                                      
         DATA,1   16                16: MD                                      
         DATA,1   17                17: MK                                      
         DATA,1   18                18: RN                                      
         DATA,1   19                19: SS                                      
         DATA,1   20                20: ST                                      
         DATA,1   21                21: TS                                      
         DATA,1   22                22: TY                                      
         DATA,1   23                23: TC                                      
         DATA,1   24                24: FS                                      
         DATA,1   25                25: GO                                      
         DATA,1   26                26: RET                                     
         DATA,1   30                30: SE                                      
         DATA,1   39                39: JU                                      
         DATA,1   40                40: NO                                      
         DATA,1   41                41: RF                                      
         DATA,1   48                48: C                                       
         DATA,1   49                49: CL                                      
         BOUND    4                                                             
         PAGE                                                                   
********************************                                                
*  PROCESS INTRALINE COMMANDS  *                                                
********************************                                                
*                                                                               
*                                                                               
PARSE:I:CMND%STRG EQU %                                                         
         LI,P1    0                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0             
         DATA     3                                                             
         LI,P1    STRG                                                          
         BAL,LNK  ADDCDTPARAM       PUT STRING IN CDT                           
         NXTPRM   ERRC9,;                                                       
                  (ALPH,ICS10)                                                  
*                                                                               
*                                                                               
PARSE:I:CMND%INTG EQU %                                                         
         LI,P1    0                                                             
         LW,T1    PARAMBUF          SAVE INTEGER                                
         NXTPRM   ERRC9,;                                                       
                  (ALPH,ICS50),;                                                
                  (STRG,*)                                                      
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0             
         DATA     4                                                             
         XW,T1    PARAMBUF          SAVE STRING AND PUT INTG IN PARAMBUF        
         LI,T2    1                 SAVE PARAMBUF SIZE FOR STRING AND           
         XW,T2    PRMBUFSZ           SET IT = 1                                 
         LI,P1    INTG              PUT INTG IN CDT                             
         BAL,LNK  ADDCDTPARAM                                                   
         STW,T1   PARAMBUF          RESTORE STRING                              
         STW,T2   PRMBUFSZ          RESTORE PARAMBUF SIZE                       
         LI,P1    STRG              PUT STRING IN CDT                           
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   ERRC9,;                                                       
                  (ALPH,*)                                                      
*                                                                               
*  COMMAND NAME FOUND: IDENTIFY IT                                              
*                                                                               
ICS10    LI,X1    ICTBLSZ                                                       
         LW,T1    PARAMBUF          SEARCH TABLE FOR CMND NAME                  
         CW,T1    ICNAMETBL,X1                                                  
         BE       ICS20             FOUND - GO PROCESS                          
         BDR,X1   %-2               LOOP                                        
         BAL,LNK  TYPECERR          TYPE: '-CN:UNKN CMND'                       
         DATA     ERRC8                                                         
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  COMMAND IDENTIFIED: GO PROCESS LAST PARAMETER                                
*                                                                               
ICS20    LI,X2    1                 PUT CMND NUMBER IN CDT                      
         LB,P1    ICNMRTBL,X1                                                   
         STB,P1   *CDTADR,X2                                                    
         EXU      ICBRCHTBL,X1      GO PROCESS LAST PARAM                       
*                                                                               
*  FORM FOUND IS:  C X -  , PROCESS THIS                                        
*                                                                               
ICS50    BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0             
         DATA     3                                                             
         XW,T1    PARAMBUF          PUT INTG IN PARAMBUF AND SAVE NAME          
         LI,P1    INTG              PUT INTG IN CDT                             
         BAL,LNK  ADDCDTPARAM                                                   
         STW,T1   PARAMBUF          RESTORE CMND NAME                           
         B        ICS10             GO IDENTIFY CMND                            
*                                                                               
*  FINISH TYPE ALPHA:  - X /STR2/                                               
*                                                                               
TYPE%ALPHA        EQU %                                                         
         NXTPRM   ERRP8,;                                                       
                  (STRG,*)                                                      
         LI,P1    STRG              PUT STRING IN CDT                           
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*  FINISH TYPE BETA:  - X N                                                     
*                                                                               
TYPE%BETA         EQU %                                                         
         NXTPRM   ERRP9,;                                                       
                  (INTG,*)                                                      
         LI,P1    INTG              PUT COUNT IN CDT                            
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*        FINISH TYPE GAMA:  X /STR/   OR                                        
*                             X N/STR/   OR                                     
*                           X  C                                                
*                                                                               
TYPE%GAMA  RES    0                                                             
         NXTPRM   ERRP4,;                                                       
                  (INTG,*),;                                                    
                  (STRG,GAMA1)                                                  
         LI,P1    INTG                                                          
         BAL,LNK  ADDCDTPARAM       PUT AWAY INTEGER (IF FOUND)                 
         NXTPRM   ERRP4,;                                                       
                  (STRG,*),;                                                    
                  (END,MASTEREXECUTIVE),;                                       
                  (SCOL,RESUME%PARSING)                                         
GAMA1    RES      0                                                             
         LI,P1    STRG                                                          
         BAL,LNK  ADDCDTPARAM       PUT AWAY STRING                             
GAMA2    RES      0                                                             
         NXTPRM   *ERRP4,;                                                      
                  (END,MASTEREXECUTIVE),;                                       
                  (SCOL,RESUME%PARSING)                                         
*                                                                               
*  INTRALINE COMMANDS 'D' OR 'S' FOUND: CHECK THAT FORM IS: /STR1/ D(S)         
*                                                                               
TYPE%I:CMND%D     EQU %                                                         
         LI,X4    1                 USE X4=1 FOR 'D'                            
         B        TYPE%I:CMND%S+1                                               
*                                                                               
*                                                                               
TYPE%I:CMND%S     EQU %                                                         
         LI,X4    0                 USE X4=0 FOR 'S'                            
         LI,X1    3                                                             
         LB,T1    *CDTADR,X1        GET # OF PARAMS IN CDT                      
         CI,T1    4                 IS NR PARAMS = 4                            
         BE       ICS90             YES - FORM MUST BE: N /ST1/ D(S) -          
         LI,X1    4                                                             
         LB,T1    *CDTADR,X1        NO - GET TYPE OF PARAM1                     
         CI,T1    STRG              IS TYPE='STRING'                            
         BE       ICS90             YES - FORM MUST BE: /ST1/ D(S) -            
         MTW,-2   PARAMPSN          NO - ADJ PARAM PSN FOR ERROR MSG            
         BAL,LNK  TYPEPERR          TYPE: '-P1:NOT STRNG'                       
         DATA     ERRP8                                                         
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  FORM OF 'D' OR 'S' IS OK: GO PARSE FURTHER                                   
*                                                                               
ICS90    B        %+1,X4                                                        
         B        TYPE%ALPHA                                                    
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*  INTRALINE COMMAND NAME TABLE                                                 
*                                                                               
ICNAMETBL         EQU %-1                                                       
         TEXTC    'D'               31: D                                       
         TEXTC    'E'               32: E                                       
         TEXTC    'F'               33: F                                       
         TEXTC    'L'               34: L                                       
         TEXTC    'O'               35: O                                       
         TEXTC    'P'               36: P                                       
         TEXTC    'R'               37: R                                       
         TEXTC    'S'               38: S                                       
         TEXTC    'A'               44: A                                       
         TEXTC    'Y'               45: Y                                       
         TEXTC    'N'               46: N                                       
ICTBLSZ  EQU      %-ICNAMETBL-1                                                 
*                                                                               
*  INTRALINE COMMAND NUMBER TABLE                                               
*                                                                               
ICNMRTBL EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   31                31: D                                       
         DATA,1   32                32: E                                       
         DATA,1   33                33: F                                       
         DATA,1   34                34: L                                       
         DATA,1   35                35: O                                       
         DATA,1   36                36: P                                       
         DATA,1   37                37: R                                       
         DATA,1   38                38: S                                       
         DATA,1   44                44: A                                       
         DATA,1   45                45: Y                                       
         DATA,1   46                46: N                                       
         BOUND    4                                                             
*                                                                               
*  INTRALINE COMMAND BRANCH TABLE                                               
*                                                                               
ICBRCHTBL         EQU %-1                                                       
         B        TYPE%I:CMND%D     31: D                                       
         B        TYPE%ALPHA        32: E                                       
         B        TYPE%ALPHA        33: F                                       
         B        TYPE%BETA         34: L                                       
         B        TYPE%ALPHA        35: O                                       
         B        TYPE%ALPHA        36: P                                       
         B        TYPE%BETA         37: R                                       
         B        TYPE%I:CMND%S     38: S                                       
         B        TYPE%GAMA         44: A                                       
         B        TYPE%I:CMND%D     45: Y                                       
         B        TYPE%I:CMND%D     46: N                                       
         PAGE                                                                   
*****************************                                                   
*  PARSE FORM:  BP ON(OFF)  *                                                   
*  PARSE FORM:  TA F(M,S)   *                                                   
*****************************                                                   
*                                                                               
*                                                                               
PARSE:BP EQU      %                                                             
         DO       S(1,1,0)                                                      
PARSE:CR EQU      %                                                             
PARSE:TA EQU      %                                                             
         ELSE                                                                   
PARSE:SEQ  EQU    %                                                             
         FIN                                                                    
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     1                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'BP' IS FIRST CMND                
         NXTPRM   ERRP4,;                                                       
                  (ALPH,*)                                                      
         LI,P1    ALPH              PUT ALPHA TEXT IN CDT                       
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         PAGE                                                                   
         DO       S(1,1,0)                                                      
************************************                                            
*  PARSE FORM:  BUILD FID(,N(,I))  *                                            
************************************                                            
*                                                                               
*                                                                               
PARSE:BUILD       EQU %                                                         
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'BUILD' IS FIRST CMND             
         BAL,LNK  GETFILEID         GET FILE ID                                 
         LI,P1    NAME              PUT IT IN CDT                               
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
         FIN                                                                    
*                                                                               
*                                                                               
GET%SEQ%INCR      EQU %             (ENTER HERE FOR FORM:  N(,I) )              
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PBU10),;                                                 
                  (SEQ2,ILGL%SEQ2)                                              
         BAL,LNK  ADJINT                                                        
*                                                                               
*  PUT SEQ # IN CDT                                                             
*                                                                               
PBU10    LI,P1    SEQ               PUT SEQ # IN CDT                            
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
*                                                                               
*                                                                               
GET%INCREMENT     EQU %             (ENTER HERE FOR FORM:  (,I) )               
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         NXTPRM   ERRP6,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PBU20)                                                   
         BAL,LNK  ADJINT                                                        
*                                                                               
*  PUT INCREMENT IN CDT                                                         
*                                                                               
PBU20    LI,P1    SEQ               PUT INCR IN CDT                             
         MTW,0    PARAMBUF          MAY NOT BE ZERO.                            
         BEZ      ILGL%SEQ2                                                     
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*                                                                               
*                                                                               
ILGL%SEQ2         EQU %                                                         
         BAL,LNK  TYPEPERR          TYPE: 'PN:ILGL SEQ #'                       
         DATA     ERRP10                                                        
         B        MASTERPARSER      GO TO PARSER                                
         PAGE                                                                   
         DO       S(1,1,0)                                                      
********************************************                                    
*  PARSE FORM:  COPY FID1 TO FID2(,N(,I))  *                                    
********************************************                                    
*                                                                               
*                                                                               
PARSE:COPY        EQU %                                                         
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     5                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'COPY' IS FIRST CMND              
         BAL,LNK  GETFILEID         GET FILE ID 1                               
         LI,P1    NAME              PUT IT IN CDT                               
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   ERRC9,;                                                       
                  (ALPH,*)                                                      
         LW,T1     PARAMBUF                                                     
         CW,T1     X:TO                                                         
         BNE       PCO3                                                         
         LW,T1     X:ON                                                         
         STW,T1    PARAMBUF                                                     
         FIN                                                                    
PCO3     EQU       %                                                            
         LI,P1    ALPH              PUT 'ON(OVER)' IN CDT                       
         BAL,LNK  ADDCDTPARAM                                                   
         LW,T1    PARAMBUF                                                      
         CW,T1    X:ON              DOES PARAM2='ON' OR 'OVER'                  
         BE       PCO10                                                         
         CW,T1    X:OVER                                                        
         BE       PCO10                                                         
PCO5     EQU      %                                                             
         BAL,LNK  TYPECERR          NO - TYPE: '-CN:ILGL SYNTAX'                
         DATA     ERRC9                                                         
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  GET 2ND FID AND THEN GO PROCESS FORM: (,N(,I))                               
*                                                                               
PCO10    BAL,LNK  GETFILEID         GET FILE ID 2                               
         BAL,LNK  ADDCDTPARAM       PUT IT IN CDT                               
         NXTPRM   *ERRP4,;                                                      
                  (COM,GET%SEQ%INCR),;                                          
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
         PAGE                                                                   
*****************************************************************               
         DO       S(1,1,0)                                                      
*  PARSE FORM:    MERGE FID1(,N1(-N2)) INTO FID2,N3(-N4)(,I)    *               
*****************************************************************               
*                                                                               
*                                                                               
PARSE:MERGE       EQU %                                                         
         BAL,LNK  NEWCDTENTRY       SET UP NEW ENTRY.                           
         DATA     6                                                             
         BAL,LNK  CHECK1CDTENTRY    MUST BE FIRST.                              
         BAL,LNK  GETFILEID         GET THE FID,                                
         LI,P1    NAME              AND ADD IT TO THE CDT.                      
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
         NXTPRM   *ERRP4,;          CHECK FOR SPECIFIC RECORD RANGE.            
                  (COM,*),;                                                     
                  (ALPH,PME20),;                                                
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
         NXTPRM   ERRP5,;           CONVERT SEQUENCE SPECIFICATION.             
                  (INTG,*),;                                                    
                  (SEQ,PME5),;                                                  
                  (SEQ2,PME15)                                                  
*                                                                               
         BAL,LNK  ADJINT            ADJUST INTEGER,                             
PME5     BAL,LNK  REPSEQ            DUPLICATE SINGLE VALUE.                     
PME15    LI,P1    SEQ2                                                          
         BAL,LNK  ADDCDTPARAM       PUT SEQ # PAIR IN CDT.                      
*                                                                               
         NXTPRM   ERRC9,;           VERIFY 'INTO' NEXT.                         
                  (ALPH,*)                                                      
PME20    LI,P1    ALPH              ADD STRING TO CDT.                          
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
         LW,T1    PARAMBUF          MAKE SURE OF PARAMETER.                     
         CW,T1    X:INTO                                                        
         BNE      PCO5              BRANCH ON ERROR.                            
*                                                                               
         BAL,LNK  GETFILEID         COLLECT FID2                                
         LI,P1    NAME              AND ADD TO CDT.                             
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
         NXTPRM   ERRC9,;           VERIFY PRESENCE OF DESTINATION              
                  (COM,*),;         SEQ #.                                      
                  (END,PME40),;                                                 
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
         NXTPRM   ERRP5,;           CONVERT SPECIFICATION.                      
                  (INTG,*),;                                                    
                  (SEQ,PME30),;                                                 
                  (SEQ2,PME35)                                                  
*                                                                               
         BAL,LNK  ADJINT                                                        
PME30    BAL,LNK  REPSEQ                                                        
PME35    LI,P1    SEQ2              ADD TO CDT.                                 
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
         B        GET%INCREMENT     GO PROCESS POSSIBLE INCREMENT.              
*                                                                               
PME40    BAL,LNK  TYPEPERR                                                      
        DATA     ERRP17                                                         
         B        MASTERPARSER                                                  
         FIN                                                                    
         PAGE                                                                   
******************************                                                  
*  PARSE FORMS:  DELETE FID  *                                                  
*                EDIT   FID  *                                                  
******************************                                                  
*                                                                               
*        CPR:     EDIT FID1 (OVER FID2(,N(,I)))                                 
*                                                                               
         DO1      S(1,1,0)                                                      
PARSE:DELETE      EQU %                                                         
PARSE:EDIT        EQU %                                                         
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     S(1,1,4)          NR OF POSSIBLE PARAMETERS                   
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'DELETE(EDIT)' IS 1ST CMND        
         BAL,LNK  GETFILEID         GET FILE ID                                 
         LI,P1    NAME              PUT IT IN CDT                               
         BAL,LNK  ADDCDTPARAM                                                   
         DO       S(0,0,1)                                                      
         NXTPRM   ERRC9,;                                                       
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE),;                                       
                  (ALPH,*)                                                      
         LW,T1    PARAMBUF                                                      
         CW,T1    X:OVER                                                        
         BNE      PCO5              B IF NOT 'OVER'                             
         B        PCO10                                                         
         ELSE                                                                   
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         FIN                                                                    
         DO       S(0,0,1)                                                      
         PAGE                                                                   
*****************************************                                       
*        PARSE FORMS:  SAVE ON FID                                              
*                      SAVE OVER FID                                            
*****************************************                                       
*                                                                               
*                                                                               
PARSE:SAVE  RES  0                                                              
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                 NR OF POSSIBLE PARAMS                       
         BAL,LNK  CHECK1CDTENTRY    MUST BE FIRST COMMAND IN LINE               
*                                                                               
         NXTPRM   ERRC9,;                                                       
                  (ALPH,PSV08),;                                                
                  (SEQ2,PSV03),;                                                
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
PSV03    RES      0                 SEQ NR LIMITS FOUND                         
         LI,P1    SEQ2                                                          
         BAL,LNK  ADDCDTPARAM       ADD SEQ NR LIMITS TO CDT                    
*                                                                               
         NXTPRM   ERRC9,;                                                       
                  (ALPH,PSV08),;                                                
                  (END,MASTEREXECUTIVE)                                         
PSV08    RES      0                 TO/ON/OVER, HOPEFULLY                       
         LW,T1    PARAMBUF                                                      
         CW,T1    X:TO                                                          
         BNE      PSV10             B IF KEYWORD IS NOT 'TO'                    
         LW,T1    X:ON                                                          
         STW,T1   PARAMBUF          REPLACE 'TO' WITH 'ON'                      
PSV10    RES      0                                                             
         LI,P1    ALPH                                                          
         BAL,LNK  ADDCDTPARAM       ADD PARAMETER TO CDT                        
         LW,T1    PARAMBUF                                                      
         CW,T1    X:ON              B IF PARAMETER WAS 'ON'                     
         BE       PSV20                                                         
         CW,T1    X:OVER                                                        
         BNE      PCO5              B IF PARAMETER WAS NOT 'OVER'               
PSV20    RES      0                                                             
         BAL,LNK  GETFILEID                                                     
         LI,P1    NAME                                                          
         BAL,LNK  ADDCDTPARAM       ADD SAVE FILE ID TO CDT                     
         NXTPRM   *ERRC9,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         FIN                                                                    
         PAGE                                                                   
***********************                                                         
*  PARSE FORMS:  END  *                                                         
*                NO   *                                                         
*                 RET                                                           
***********************                                                         
*                                                                               
*                                                                               
PARSE:END         EQU %                                                         
         DO       S(0,0,1)                                                      
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     1                 POSSIBLY ONE PARAMETER                      
         BAL,LNK  CHECK1CDTENTRY    MUST BE FIRST COMMAND ON LINE               
         NXTPRM   ERRC9,;                                                       
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (ALPH,*),;                                                    
                  (END,MASTEREXECUTIVE)                                         
         LW,T1    PARAMBUF                                                      
         CW,T1    X:NS                                                          
         BNE      PCO5              B IF NOT 'NS' (ERROR)                       
         LI,P1    ALPH                                                          
         BAL,LNK  ADDCDTPARAM       ADD PARAMETER TO CDT                        
         NXTPRM   ERRC9,;                                                       
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         FIN                                                                    
PARSE:NO          EQU %                                                         
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     0                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'END(NO)' IS FIRST CMND           
         NXTPRM   ERRC9,;                                                       
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
         PAGE                                                                   
*                                                                               
***************************************                                         
*        PARSE FORM: C N                                                        
***************************************                                         
*                                                                               
PARSE:C  RES      0                                                             
         BAL,LNK  NEWCDTENTRY       BUILD CDT ENTRY                             
         DATA     1                 ONE PARAMETER PERMITTED                     
         NXTPRM   ERRP5,;                                                       
                  (SEQ,PARSE:C2),;                                              
                  (INTG,*),;                                                    
                  (SEQ2,ILGL%SEQ2),;                                            
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         BAL,LNK  ADJINT            CONVERT INTEGER TO SEQ NR                   
PARSE:C2 RES      0                                                             
         LI,P1    SEQ                                                           
         BAL,LNK  ADDCDTPARAM       PUT SEQ NR IN CDT                           
         NXTPRM   *ERRP4,;                                                      
                  (END,MASTEREXECUTIVE),;                                       
                  (SCOL,RESUME%PARSING)                                         
         PAGE                                                                   
*                                                                               
************************************                                            
*        PARSE FORM:  CL (C1(,C2)) *                                            
************************************                                            
*                                                                               
PARSE:CL RES      0                                                             
         BAL,LNK  NEWCDTENTRY       BUILD CDT ENTRY                             
         DATA     2                 TWO PARAMETERS PERMITTED                    
         NXTPRM   ERRP7,;                                                       
                  (INTG,*),;                                                    
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         LI,P1    INTG                                                          
         BAL,LNK  ADDCDTPARAM       PUT C1 IN CDT                               
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         NXTPRM   ERRP7,;                                                       
                  (INTG,*)                                                      
         LI,P1    INTG                                                          
         BAL,LNK  ADDCDTPARAM       PUT C2 IN CDT                               
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         PAGE                                                                   
*************************                                                       
*  PARSE FORM:  CM N,C  *                                                       
*************************                                                       
*                                                                               
*                                                                               
PARSE:CM EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'CM' IS FIRST CMND                
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PCM10),;                                                 
                  (SEQ2,ILGL%SEQ2)                                              
         BAL,LNK  ADJINT                                                        
*                                                                               
*  SEQ # GIVEN: PUT IT IN CDT AND PROCESS COLUMN NUMBER                         
*                                                                               
PCM10    LI,P1    SEQ               PUT SEQ # IN CDT                            
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,PCM20),;                                                
                  (END,PCM20)                                                   
         B        PDE30             GET COL LIMITS                              
*                                                                               
*  ERROR: SECOND PARAMETER MISSING                                              
*                                                                               
PCM20    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'                   
         DATA     ERRP17                                                        
         B        MASTERPARSER      GO TO PARSER                                
         PAGE                                                                   
************************************                                            
*  PARSE FORMS:  DE N(-M)          *                                            
*                SE N(-M)(,C(,D))  *                                            
************************************                                            
*                                                                               
*                                                                               
PARSE:DE EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     1                                                             
         NXTPRM   ERRP5,;                                                       
                  (INTG,PDE5),;                                                 
                  (SEQ,PDE10),;                                                 
                  (SEQ2,PDE15),;                                                
                  (END,*),;                                                     
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
*        INTRARECORD FORM OF DE                                                 
         LW,T1    *CDTADR                                                       
         AND,T1   XFF00                                                         
         STW,T1   *CDTADR           DELETE CDT ENTRY                            
         LI,P1    I:DE%CMND%NR                                                  
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     0                 NO PARAMETERS                               
         B        MASTEREXECUTIVE                                               
*                                                                               
*                                                                               
PARSE:SE EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         NXTPRM   ERRP5,;                                                       
                  (END,MASTEREXECUTIVE),;                                       
                  (SCOL,RESUME%PARSING),;                                       
                  (INTG,PDE5),;                                                 
                  (SEQ,PDE10),;                                                 
                  (SEQ2,PDE15)                                                  
*                                                                               
*  SEQ. # IS AN INTEGER: ADJUST IT                                              
*                                                                               
PDE5     BAL,LNK  ADJINT                                                        
*                                                                               
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT                                          
*                                                                               
PDE10    BAL,LNK  REPSEQ                                                        
*                                                                               
*  PUT SEQ. # PAIR IN CDT AND CHECK IF COMMAND IS FIRST FOR 'DE'                
*                                                                               
PDE15    BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'DE(SE)' IF FIRST CMND            
         LW,T1    P1                SAVE CMND #                                 
         LI,P1    SEQ2              PUT SEQ # PAIR IN CDT                       
         BAL,LNK  ADDCDTPARAM                                                   
         CI,T1    FIRST%I:CMND      IS CMND='DE'                                
         BGE      PDE20             NO - CMND='SE'                              
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*  FINISH UP 'SE'                                                               
*                                                                               
PDE20    NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
PDE30    RES      0                                                             
         NXTPRM   ERRP7,;                                                       
                  (INTG,*)                                                      
         LI,P1    INTG                                                          
         BAL,LNK  ADDCDTPARAM       PUT 1ST COL # IN CDT                        
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         NXTPRM   ERRP7,;                                                       
                  (INTG,*)                                                      
         BAL,LNK  ADDCDTPARAM       PUT 2ND COL # IN CDT                        
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         PAGE                                                                   
*******************************************                                     
*  PARSE FORMS:  FD N(-M),/STRG/(,C(,D))  *                                     
*                FT N(-M),/STRG/(,C(,D))  *                                     
*******************************************                                     
*                                                                               
*                                                                               
PARSE:FD EQU      %                                                             
PARSE:FS EQU      %                                                             
PARSE:FT EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     4                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'FD(FT)' IS FIRST CMND            
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PFD10),;                                                 
                  (SEQ2,PFD15)                                                  
         BAL,LNK  ADJINT                                                        
*                                                                               
*  ONLY ONE SEQ # GIVEN: DUPLICATE IT                                           
*                                                                               
PFD10    BAL,LNK  REPSEQ                                                        
*                                                                               
*  PUT SEQ # PAIR IN CDT AND GET 2ND PARAMETER                                  
*                                                                               
PFD15    LI,P1    SEQ2              PUT 'SEQ # PAIR' PARAM IN CDT               
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,PFD20),;                                                
                  (END,PFD20)                                                   
         NXTPRM   ERRP8,;                                                       
                  (STRG,*)                                                      
         LI,P1    STRG              PUT 'STRING' PARAM IN CDT                   
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
*                                                                               
GET%COL#%PAIR     EQU %                                                         
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         NXTPRM   ERRP7,;                                                       
                  (INTG,*)                                                      
         LI,P1    INTG              PUT 1ST 'COL #' IN CDT                      
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         NXTPRM    ERRP7,;                                                      
                   (INTG,*)                                                     
         BAL,LNK  ADDCDTPARAM       PUT 2ND 'COL #' IN CDT                      
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*  ERROR: SECOND PARAMETER MISSING                                              
*                                                                               
PFD20    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'                   
         DATA     ERRP17                                                        
         B        MASTERPARSER      GO TO PARSER                                
         PAGE                                                                   
*                                                                               
*****************************                                                   
*        PARSE FORM: GO                                                         
*                    JU                                                         
*****************************                                                   
*                                                                               
PARSE:GO RES      0                                                             
PARSE:JU  RES     0                                                             
         BAL,LNK  NEWCDTENTRY                                                   
         DATA     1                 SET UP NEXT CDT ENTRY                       
         NXTPRM   ERRP5,;                                                       
                  (SEQ,PGO2),;                                                  
                  (INTG,*),;                                                    
                  (SEQ2,ILGL%SEQ2)                                              
         BAL,LNK  ADJINT            CONVERT SEQ NR TO INTEGER                   
PGO2     RES      0                                                             
         LI,P1    SEQ                                                           
         BAL,LNK  ADDCDTPARAM       PUT AWAY SEQ NR                             
         NXTPRM   *ERRP4,;                                                      
                  (END,MASTEREXECUTIVE),;                                       
                  (SCOL,ILGL%SEMICOLON)                                         
         PAGE                                                                   
*****************************                                                   
*  PARSE FORM:  IN (N(,I))  *                                                   
*****************************                                                   
*                                                                               
*                                                                               
PARSE:IN EQU      %                                                             
PARSE:IS EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     2                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'IN' IS FIRST CMND                
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PIN10),;                                                 
                  (SEQ2,ILGL%SEQ2),;                                            
                  (END,MASTEREXECUTIVE)                                         
         BAL,LNK  ADJINT            CONVERT INTEGER TO SEQ NR                   
PIN10    RES      0                                                             
         LI,P1    SEQ                                                           
         BAL,LNK  ADDCDTPARAM       PUT SEQ NR IN CDT                           
         B        GET%INCREMENT     GET INCREMENT IF IT EXISTS                  
         PAGE                                                                   
**************************************                                          
*  PARSE FORMS:  MD N(-M),K(-L)(,I)  *                                          
*                MK N(-M),K(-L)(,I)  *                                          
**************************************                                          
*                                                                               
*                                                                               
PARSE:MD EQU      %                                                             
PARSE:MK EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'MD(MK)' IS FIRST CMND            
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PMD10),;                                                 
                  (SEQ2,PMD15)                                                  
         BAL,LNK  ADJINT                                                        
*                                                                               
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT                                          
*                                                                               
PMD10    BAL,LNK  REPSEQ                                                        
*                                                                               
*  PUT FIRST SEQ # PAIR IN CDT AND GET 2ND PARAMETER                            
*                                                                               
PMD15    LI,P1    SEQ2              PUT 'SEQ # PAIR' PARAM IN CDT               
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (END,MASTEREXECUTIVE),;                                       
                  (COM,*)                                                       
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PMD20),;                                                 
                  (SEQ2,PMD25)                                                  
         BAL,LNK  ADJINT                                                        
*                                                                               
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT                                          
*                                                                               
PMD20    BAL,LNK  REPSEQ                                                        
*                                                                               
*  PUT 2ND SEQ # PAIR IN CDT AND GO PROCESS INCREMENT                           
*                                                                               
PMD25    BAL,LNK  ADDCDTPARAM       PUT 'SEQ # PAIR' IN CDT                     
         B        GET%INCREMENT     GO PROCESS INCR                             
         PAGE                                                                   
*                                                                               
*                                                                               
*        PARSE FORM:  RET                                                       
***************************                                                     
*                                                                               
PARSE:RET  RES    0                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEXT CDT ENTRY                        
         DATA     0                 NO PARAMETERS                               
         NXTPRM   ERRC9,;                                                       
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
         PAGE                                                                   
*************************                                                       
*  PARSE FORM:  RN N,K  *                                                       
*************************                                                       
*                                                                               
*                                                                               
PARSE:RN EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     2                                                             
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'RN' IS FIRST CMND                
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PRN10),;                                                 
                  (SEQ2,ILGL%SEQ2)                                              
         BAL,LNK  ADJINT                                                        
*                                                                               
*  PUT SEQ # IN CDT AND GET 2ND SEQ #                                           
*                                                                               
PRN10    LI,P1    SEQ               PUT SEQ # IN CDT                            
         BAL,LNK  ADDCDTPARAM                                                   
         NXTPRM   *ERRP4,;                                                      
                  (COM,*),;                                                     
                  (SCOL,PRN30),;                                                
                  (END,PRN30)                                                   
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PRN20)                                                   
         BAL,LNK  ADJINT                                                        
*                                                                               
*  PUT 2ND SEQ # IN CDT AND FINISH UP                                           
*                                                                               
PRN20    BAL,LNK  ADDCDTPARAM       PUT 2ND SEQ # IN CDT                        
         NXTPRM   *ERRP4,;                                                      
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*  ERROR: SECOND PARAMETER MISSING                                              
*                                                                               
PRN30    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'                   
         DATA     ERRP17                                                        
         B        MASTERPARSER      GO TO PARSER                                
         PAGE                                                                   
********************************                                                
*  PARSE FORMS:  SS N(,C(,D))  *                                                
*                ST N(,C(,D))  *                                                
********************************                                                
*                                                                               
*                                                                               
PARSE:SS EQU      %                                                             
PARSE:ST EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         NXTPRM   ERRP5,;                                                       
                  (INTG,*),;                                                    
                  (SEQ,PSS10),;                                                 
                  (SEQ2,ILGL%SEQ2)                                              
         BAL,LNK  ADJINT                                                        
*                                                                               
*  PUT SEQ # IN CDT AND MAKE SURE CMND IS FIRST FOR 'SS' AND 'ST'               
*                                                                               
PSS10    RES      0                                                             
         BAL,LNK  CHECK1CDTENTRY    NO - MAKE SURE 'SS(ST)' IS 1ST CMND         
         LI,P1    SEQ               PUT SEQ # IN CDT                            
         BAL,LNK  ADDCDTPARAM                                                   
         B        GET%COL#%PAIR                                                 
         PAGE                                                                   
*********************                                                           
*  PARSE FORM:  RF  *                                                           
*********************                                                           
*                                                                               
*                                                                               
PARSE:RF EQU      %                                                             
         BAL,LNK  NEWCDTENTRY                                                   
         DATA     0                                                             
         NXTPRM   ERRC9,;                                                       
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
         PAGE                                                                   
***********************************                                             
*  PARSE FORMS:  TS N(-M)  &  TS  *                                             
*                TY N(-M)  &  TN  *                                             
*                TC N(-M)         *                                             
***********************************                                             
*                                                                               
*                                                                               
PARSE:TC EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
         DATA     3                                                             
         NXTPRM   ERRP5,;           'TC' MUST SPECIFY RECORD.                   
                  (INTG,PTY5),;                                                 
                  (SEQ,PTY10),;                                                 
                  (SEQ2,PTY15)                                                  
*                                                                               
PARSE:TS EQU      %                                                             
PARSE:TY EQU      %                                                             
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY                         
        DATA     3                                                              
         NXTPRM   ERRC9,;                                                       
                  (INTG,PTY5),;                                                 
                  (SEQ,PTY10),;                                                 
                  (SEQ2,PTY15),;                                                
                  (SCOL,*),;                                                    
                  (END,*)                                                       
         MTW,-1   CHARPSN           SET TO RESCAN LAST CHAR                     
         LW,T1    *CDTADR           MUST BE INTRALINE 'TS' OR 'TY' SO           
         AND,T1   XFF00              WIPE OUT CDT ENTRY JUST BUILT              
         STW,T1   *CDTADR                                                       
         LI,T1    I:TS%CMND%NMR                                                 
         CI,P1    R:TS%CMND%NMR     IS CMND 'TS'                                
         BE       %+2                                                           
         LI,T1    I:TY%CMND%NMR     NO - MUST BE 'TY'                           
         LW,P1    T1                BUILD ENTRY IN CDT FOR THIS CMND            
         BAL,LNK  NEWCDTENTRY                                                   
         DATA     0                                                             
         NXTPRM   ERRC9,;                                                       
                  (SCOL,RESUME%PARSING),;                                       
                  (END,MASTEREXECUTIVE)                                         
*                                                                               
*                                                                               
PTY5     BAL,LNK  ADJINT            SCALE INTEGER TO SEQ #.                     
PTY10    BAL,LNK  REPSEQ            REPLICATE SINGLE SEQ #.                     
PTY15    BAL,LNK  CHECK1CDTENTRY    INSURE TY(TS) IS FIRST COMMAND.             
*                                                                               
         LI,P1    SEQ2              ADD SEQ # PAIR TO COMMAND TABLE.            
         BAL,LNK  ADDCDTPARAM                                                   
*                                                                               
         B        GET%COL#%PAIR     NOW GET OPTIONAL COLUMN NUMBERS.            
         PAGE                                                                   
******************************                                                  
*  PARSER UTILITY ROUTINES   *                                                  
******************************                                                  
*                                                                               
*                 FORM SEQUENCE NUMBER AS INTEGER*1000.                         
*                                                                               
ADJINT   LW,D1    PARAMBUF                                                      
         MI,D1    1000                                                          
         STW,D1   PARAMBUF                                                      
         B        *LNK                                                          
*                                                                               
*                 REPLICATE SINGLE SEQUENCE NUMBER IN PARAMBUF+1.               
*                                                                               
REPSEQ   LW,T1    PARAMBUF                                                      
         STW,T1   PARAMBUF+1                                                    
         MTW,1    PRMBUFSZ                                                      
         B        *LNK                                                          
*                                                                               
*                                                                               
         PAGE                                                                   
***********************************                                             
*                                 *                                             
*  BREAK-KEY INTERRUPT HANDLER    *                                             
*  UTS ONLY.                      *                                             
*                                 *                                             
***********************************                                             
*                                                                               
         DO       S(0,1,1)                                                      
BRK%KEY  RES      0                                                             
         M:INT    0                 TURN OFF BREAK HANDLING                     
         PUSH     X3                SAVE POINTER TO PUSHED CONTEXT              
         DO       S(0,0,1)                                                      
         LW,X3    NOBRKFLG                                                      
         BEZ      BRK1              B IF OK TO BREAK NOW                        
         LI,X3    2                                                             
         STW,X3   NOBRKFLG          FLAG TO BREAK WHEN OK                       
         B        CONTINUE          B TO IGNORE BREAK FOR NOW                   
BRK1     RES      0                                                             
         FIN                                                                    
         BAL,LNK   TYPEMSG          MOVE TO A CLEAN LINE ON USER                
         DATA     MSG0              TERMINAL.                                   
         MTW,0    GOSEQ                                                         
         BGEZ     BRK30             B IF EXECUTING FROM EDIT FILE               
         MTW,0    XEQFLAG           IF NOT EXECUTING, GET NEXT COMMAND.         
         BLZ       BRK99                                                        
         MTW,0    STEPFLAG          IF STEPPING, SKIP DISPLAY CHECK.            
         BNEZ     BRK80                                                         
         MTW,0    SETFLAG           IS SYSTEM IN SET MODE-                      
         BEZ      BRK30             ZERO SAYS NO.                               
*                                                                               
         LW,P1    INTFLAG1          IF DISPLAY FLAG SET,                        
         BLZ      BRK80                                                         
         MOVEMSG,P2  UTSM4,X1                                                   
         LI,P2    BA(MSGBUF)+37     BUILD SEG # INTO MESSAGE AND                
         BAL,LNK  MOVESEQ           SEND IT OUT.                                
         GEN4     0,0,0,0                                                       
         AI,R1    36                ADJUST COUNT OF FULL STRING                 
         STB,R1   MSGBUF                                                        
         BAL,LNK  TYPEMSG                                                       
         DATA     MSGBUF                                                        
         B        BRK80             NOW ASK ABOUT CONTINUE.                     
*                                                                               
*                                                                               
BRK30    RES      0                 EXECUTING FILE OR EDIT COMMAND.             
         MOVEMSG,X2  UTSM5,X1                                                   
         MTW,0    XEQFLAG                                                       
         BLZ      BRK80             B IF NOT EXECUTING                          
         LI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET COMMAND NUMBER AND RETRIEVE             
         BEZ       BRK99            ORIGINAL EBCDIC.                            
         LI,X1    CTBLSZ                                                        
         CB,X2    CNMRTBL,X1        FIND COMMAND NAME INDEX                     
         BE       %+3               B IF FOUND                                  
         BDR,X1   %-2                                                           
         B        BRK99             NOT FOUND                                   
         LW,X1    CNAMETBL,X1       GET NAME, AND CHECK DISPLAY TBL FOR         
         LI,X2    BDTL              PRESENCE OF THIS COMMAND                    
         CW,X1    BDISPTBL,X2                                                   
         BE       BRK40                                                         
         BDR,X2   %-2               IF NOT FOUND,                               
         B        BRK80             ASK TO CONTINUE.                            
*                                                                               
BRK40    CI,X2    BDT2NR                                                        
         BLE      BRK50                                                         
         LW,P1    INTFLAG1          THESE COMMANDS TAKE SINGLE SEQUENCE         
         BLZ      BRK80             NUMBER -  DE,FD,FT                          
         LI,P2    BA(MSGBUF)+24                                                 
         BAL,LNK  MOVESEQ                                                       
         GEN4     0,0,0,0                                                       
         AI,R1    23                                                            
         STB,R1   MSGBUF                                                        
         BAL,LNK  TYPEMSG                                                       
         DATA     MSGBUF                                                        
         B        BRK80                                                         
*                                                                               
BRK50    LW,P1    INTFLAG1          THESE COMMANDS TAKE A DOUBLE SEQ. #         
         BLZ      BRK80             DISPLAY                                     
         LI,P2    BA(MSGBUF)+24                                                 
         BAL,LNK  MOVESEQ           SET UP DDD.DD (                             
         GEN4     BL,LP,0,0                                                     
         AW,P2    R1                INCR MSG BYTE ADDR                          
         AI,R1    23                AND MSG LENGTH                              
         LW,P1    INTFLAG2          IF SECOND SEQ. # NOT SET UP,                
         BGEZ     BRK60             WE MUST BE DELETING.                        
         LB,X1    UTSM7                                                         
         AW,R1    X1                THEREFORE, INSERT DELETING                  
         LI,X2    1                 MESSAGE.                                    
BRK53    LB,P1    UTSM7,X2                                                      
         STB,P1   0,P2                                                          
         AI,P2    1                                                             
         AI,X2    1                                                             
         BDR,X1   BRK53                                                         
BRK55    STB,R1   MSGBUF            ADJUST BYTE COUNT OF TOTAL                  
         BAL,LNK  TYPEMSG           MESSAGE.                                    
         DATA     MSGBUF                                                        
         B        BRK80             THEN ASK ABOUT CONTINUE.                    
*                                                                               
BRK60    LW,T1    R1                SAVE MSG LENGTH                             
         BAL,LNK  MOVESEQ           MOVE SECOND SEQ # NUMBER INTO               
         GEN4     RP,0,0,0          MESSAGE.                                    
         AW,R1    T1                INCREMENT MSG LENGTH                        
         B        BRK55                                                         
*                                                                               
BRK80    BAL,LNK  TYPEMSG           ASK FOR A CHARACTER.                        
         DATA     UTSM6                                                         
         CAL1,1   BR%FPT            READ IT.                                    
         BAL,LNK  TYPEMSG           RETURN CARRIAGE.                            
         DATA     MSG0                                                          
         LB,X1    CFLAG             IF CHARACTER IS NOT X                       
         CI,X1    'X'               CONTINUE COMMAND.                           
         BE        STOPLASTCMD                                                  
CONTINUE RES      0                                                             
         PULL      X3               STRAIGHTEN OUT STACK                        
M:TRTN   M:INT    BRK%KEY           RESTORE BREAK HANDLING                      
         DO       S(1,1,0)                                                      
         M:TRTN                                                                 
         ELSE                                                                   
         M:TRTY                                                                 
         FIN                                                                    
BRK90    LI,T1     0                START CLEAN UP                              
         STW,T1   LASTKEY                                                       
         STW,T1   NOCHGFLG                                                      
         STW,T1   STEPFLAG                                                      
         LI,T1    -1                                                            
         STW,T1   ALLFLAG                                                       
         LCW,R1   SETFLAG                                                       
         BLEZ     %+2               B IF NOT WITHIN A SET RANGE                 
         STW,R1   SETFLAG           FORCE REINIT OF SET RANGE                   
         LW,R1    L(X'00200000')    IF OPEN FOR OUTPUT,                         
         CW,R1    F:EO                                                          
         DO       S(0,1,0)                                                      
         BAZ      %+2                                                           
         BAL,LNK  CLOSE2            CLOSE ANY COPY OR MERGE FILE.               
         ELSE                                                                   
         BAZ      %+3               B IF NOT OPEN                               
         LI,LNK   %+2               DCB ERROR RETURN (IGNORE)                   
         M:CLOSE  M:EO,IGNERR                                                   
         FIN                                                                    
         MTW,0    FILETYPE          CLOSE INPUT FILE, UNLESS OPEN               
         BGZ      MASTERPARSER      FOR EDIT.                                   
         CW,R1    F:EI                                                          
         BAZ      %+2                                                           
         BAL,LNK  S(CLOSE,CLOSE,CLOSESCR)                                       
         B        MASTERPARSER                                                  
STOPLASTCMD PULL   X3               POINTER OF PSD IN STACK.                    
         LI,T2     X'1FFFF'         SET A MASK                                  
         LI,T1     BRK90            RETURN ADR. WANTED.                         
         STS,T1    0,X3                                                         
         B         M:TRTN                                                       
BRK99     EQU     %              PREPARE A CLEAN EXIT.                          
         PULL      X3               GET THE STACK POINTER.                      
         LI,T2     X'1FFFF'         MASK                                        
         LI,T1     MASTERPARSER     ADR. OF RETURN.                             
         STS,T1    0,X3                                                         
         B         M:TRTN                                                       
         FIN                                                                    
         DO       S(0,0,1)                                                      
BRKSIM   RES      0                                                             
         M:TRAP   BRKSIM1,(TRAP,NAO) PREPARE TO SIMULATE BREAK WITH             
         PZE      0                 A NONEXIST INST TRAP                        
BRKSIM1  RES      0                                                             
         M:TRAP   (ABORT,NAO)       CLEAR THE TRAP HANDLER                      
         LI,T2    X'1FFFF'                                                      
         LW,T1    LNK+2,X3          GET LNK REG FROM STACK                      
         STS,T1   0,X3              BRKSIM ENTERED WHEN A B *LNK                
         B        BRK%KEY           IS ALMOST TO BE USED                        
*                                   THE TRAP PSD IS CHANGED TO                  
*                                   RETURN VIA R7.                              
         FIN                                                                    
         PAGE                                                                   
***************************************                                         
*                                     *                                         
*     M A S T E R   P R O G R A M     *                                         
*                                     *                                         
*         T O   E X E C U T E         *                                         
*                                     *                                         
*      E D I T   C O M M A N D S      *                                         
*                                     *                                         
***************************************                                         
*                                                                               
*                                                                               
MASTEREXECUTIVE   EQU %                                                         
         LI,T1    CDT+1             SET CDTADR=FIRST COMMAND IN CDT             
         STW,T1   CDTADR                                                        
         LW,T1    SVBPFLAG          RESTORE LAST DFLT VALUE OF BPFLAG           
         STW,T1   BPFLAG                                                        
         DO       S(0,1,1)                                                      
         LI,T1    1                                                             
         STW,T1   XEQFLAG                                                       
        LI,T1    0                                                              
        STW,T1   TABCFLAG                                                       
        STW,T1   TABXFLAG                                                       
         FIN                                                                    
*                                                                               
*                                                                               
*                                                                               
RESTART%EXECUTIVE EQU %             (INTRALINE CMND LOOP ENTERS HERE)           
         LI,X1    0                 INDICATE 'ALL' MODE IS                      
         STW,X1   ALLOK             POTENTIALLY LEGAL                           
         LI,X1    1                 GET NUMBER OF COMMAND                       
         LB,X2    *CDTADR,X1                                                    
         BEZ      EXC50             IS CMND=0 (END OF CDT)                      
         CI,X2    FIRST%R:CMND      NO - IS IT A FILE COMMAND                   
         BL       EXC5              B IF FILE-LEVEL                             
         MTW,0    FILETYPE          NO - IS INP FILE PRESENT AND KEYED          
         BLZ      EXC40             NO - ERROR                                  
         CI,X2    FIRST%I:CMND      IS IT AN I:CMND (EXCEPT 'SE')               
         BLE      EXC5                                                          
         LI,T1    -2                 IF ERRORCNT -2 OR LESS                     
        CW,T1     ERRORCNT          SET LOOP EXECUTED ONCE                      
        BGE       %+2               DONT TYPE ANY MORE CERRS                    
        STW,X1    ERRORCNT          ONE CERR PER I:COMMAND                      
         MTW,0    SETFLAG           YES - IS SYSTEM IN SET MODE                 
         BNEZ     EXC20             YES - GO CHECK ON CMND                      
         BAL,LNK  TYPEMSG           NO - TYPE: '-MISSING SET'                   
         DATA     ERRM8                                                         
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  F:CMND, R:CMND, OR 'SE': CHECK TO SEE THAT SYSTEM IS NOT IN STEP MODE        
*                                                                               
EXC5     MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE                      
         BNEZ     EXC30             YES - ERROR                                 
         CI,X2    LAST%R:CMND                                                   
         BG       EXC10             B IF CMND DOESNT CHANGE SET                 
         LI,T1    0                 TURN OFF 'SET MODE' FLAG                    
         STW,T1   SETFLAG                                                       
*                                                                               
*  EXECUTE CURRENT COMMAND IN CDT                                               
*                                                                               
EXC10    EXU      CMNDTBL,X2        EXECUTE COMMAND                             
         MTW,0    ALLFLAG           WAS CMND AN I:CMND WITH PARAM1=ALL          
         BGEZ     EXC15             YES - EXECUTE IT UNTIL FLAG GOES OFF        
         LB,T1    *CDTADR           INCR CDTADR TO NEXT COMMAND                 
         AWM,T1   CDTADR                                                        
         B        RESTART%EXECUTIVE GO PROCESS NEW COMMAND                      
*                                                                               
*  ALLFLAG SET: RE-EXECUTE INTRALINE COMMAND UNTIL ALL OCCURRENCES ARE          
*  PROCESSED                                                                    
*                                                                               
EXC15    LI,X1    1                 GET NUMBER OF COMMAND                       
         LB,X2    *CDTADR,X1                                                    
         B        EXC10             GO EXECUTE COMMAND                          
*                                                                               
*  COMMAND IS INTRALINE (EXCEPT 'SE'): TURN ON 'I:CMND EXECUTED' FLAG;          
*  IF COMMAND IS FIRST IN CDT DO A DUMMY I:SET USING PARAMETERS FROM            
*  LAST ACTUAL I:SET                                                            
*                                                                               
EXC20    MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE                      
         BNEZ     EXC10                                                         
         MTW,0    SETFLAG           NO - MUST SET LOOP BE INITIALIZED           
         BLZ      EXC10             NO - GO EXECUTE I:CMND                      
         LI,T1    -1                SET SETFLAG=-1 TO INDICATE THAT SET         
         STW,T1   SETFLAG            LOOP HAS BEEN INITIALIZED                  
         LW,T1    CDTADR            SAVE ADDR OF CMND IN CDT (IN                
         STW,T1   SETADR             SETADR) FOR LATER I:CMND LOOP              
         LW,P1    SV1STSET                                                      
         BAL,LNK  READNXTRANDOM                                                 
         STW,R1   P1                SAVE FIRST SEQUENCE NR                      
         STW,R1   FIRSTSET                                                      
         CW,R1    LASTSET                                                       
         BLE      EXC25             B IF STILL RECORDS IN RANGE                 
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM22            RNG EMPTY                                   
         LI,T1    0                                                             
         STW,T1   SETFLAG           NO LONGER IN SET MODE                       
         B        MASTERPARSER1     GET NEXT CMND                               
EXC25    RES      0                                                             
         BAL,LNK  SETEOD            SET EOD MARKER                              
         B        EXC10             GO EXECUTE COMMAND                          
*                                                                               
*  ERROR: GIVEN COMMAND IS ILLEGAL WHEN SYSTEM IS IN STEP MODE                  
*                                                                               
EXC30    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'                  
         DATA     ERRC4                                                         
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  ERROR: NO SOURCE FILE NAMED                                                  
*                                                                               
EXC40    BAL,LNK  TYPEMSG           TYPE: '-NO FILE NAMED'                      
         DATA     ERRM13                                                        
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  END OF CDT: IF IN SET OR STEP MODES, GO TO APPROPRIATE LOOP                  
*                                                                               
EXC50    MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE                      
         BNEZ     STEP%LOOP         YES - GO TO STEP LOOP                       
         MTW,0    TTYIMGSZ          WAS INPUT LINE NULL                         
         BEZ      EXC55             YES - ERROR                                 
         MTW,0    SETFLAG           IS SYSTEM IN SET MODE                       
         BNEZ     SET%LOOP          YES - GO TO SET LOOP                        
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  ERROR: NULL COMMAND                                                          
*                                                                               
EXC55     EQU      %                                                            
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  FILE COMMANDS CAN ONLY APPEAR ONE PER LINE                                   
*                                                                               
CMNDTBL  EQU       %-1                                                          
         BAL,F:LNK F:BLANK%PRESERV   1: BP                                      
         DO       S(1,1,0)                                                      
         BAL,F:LNK F:BUILD           2: BUILD                                   
         BAL,F:LNK F:COPY            3: COPY                                    
         BAL,F:LNK F:DELETE          4: DELETE                                  
         ELSE                                                                   
         BAL,LNK  F:SAVE            2: SAVE                                     
         RES      2                                                             
         FIN                                                                    
         BAL,F:LNK F:EDIT            5: EDIT                                    
         BAL,F:LNK F:END             6: END                                     
         DO       S(1,1,0)                                                      
         BAL,F:LNK S(MASTERPARSER,F:TA,MASTERPARSER)                            
         BAL,F:LNK F:CR              8: CR                                      
         BAL,F:LNK F:MERGE           9: MERGE                                   
         ELSE                                                                   
         RES      1                                                             
         BAL,F:LNK F:SEQ            8: SEQ                                      
         RES      1                                                             
         FIN                                                                    
*                                                                               
*  RECORD COMMANDS CAN ONLY APPEAR ONE PER LINE                                 
*                                                                               
         BAL,F:LNK R:COMMENTARY     10: CM                                      
         BAL,F:LNK R:DELETE         11: DE                                      
         BAL,R:LNK R:FIND%DELETE    12: FD                                      
         BAL,R:LNK R:FIND%TYPE      13: FT                                      
         BAL,R:LNK R:INSERT         14: IN                                      
         BAL,R:LNK R:INSERT%SUP%SEQ 15: IS                                      
         BAL,R:LNK R:MOVE%DELETE    16: MD                                      
         BAL,R:LNK R:MOVE%KEEP      17: MK                                      
         BAL,R:LNK R:RENUMBER       18: RN                                      
         BAL,R:LNK R:SET%STEP       19: SS                                      
         BAL,R:LNK R:SET%STEP%TYPE  20: ST                                      
         BAL,R:LNK R:TYPE%SUP%SEQ   21: TS                                      
         BAL,R:LNK R:TYPE           22: TY                                      
         BAL,R:LNK R:TYPE%COMPRESSED 23: TC                                     
         BAL,R:LNK R:FIND%SEQUENCE  24: FS                                      
         BAL,R:LNK R:GO             25: GO                                      
         BAL,R:LNK R:RET            26: RET                                     
         RES      3                                                             
*                                                                               
*  INTRALINE COMMANDS MAY BE COMPOUNDED ON ONE LINE                             
*                                                                               
         BAL,I:LNK I:SET            30: SE (MUST BE FIRST I:CMND)               
         BAL,I:LNK I:DELETE         31: D                                       
         BAL,I:LNK I:OVERWR%EXTEND  32: E                                       
         BAL,I:LNK I:FOLLOW%BY      33: F                                       
         BAL,I:LNK I:SHIFT%LEFT     34: L                                       
         BAL,I:LNK I:OVERWRITE      35: O                                       
         BAL,I:LNK I:PRECEDE%BY     36: P                                       
         BAL,I:LNK I:SHIFT%RIGHT    37: R                                       
         BAL,I:LNK I:SUBSTITUTE     38: S                                       
         BAL,I:LNK I:JUMP           39: JU                                      
         BAL,I:LNK I:NO%CHANGE      40: NO                                      
         BAL,I:LNK I:REVERSE%BPFLAG 41: RF                                      
         BAL,I:LNK I:TYPE%SUP%SEQ   42: TS                                      
         BAL,I:LNK I:TYPE           43: TY                                      
         BAL,I:LNK I:ALIGN          44: A                                       
         BAL,I:LNK I:YES%CONTINUE   45: Y                                       
         BAL,I:LNK I:NO%CONTINUE    46: N                                       
         BAL,I:LNK  I:DEL%REC       47: DE                                      
         BAL,I:LNK  I:COPY%REC      48: C                                       
         BAL,I:LNK  I:COL%LIMS      49: CL                                      
         PAGE                                                                   
******************************************                                      
*  FILE COMMAND: SET BLANK PRESERVATION  *                                      
******************************************                                      
*                                                                               
*                                                                               
F:BLANK%PRESERV   EQU %                                                         
         LI,X1    5                 SET TO GET PARAMETER FROM CDT               
         LB,X2    *CDTADR,X1                                                    
         LW,T1    *CDTADR,X2        GET 'ON' OR 'OFF' AS A TEXTC-STRING         
         CW,T1    BPVON                                                         
         BNE      BPV5              IS STRING='ON'                              
         LI,T1    1                 YES - SET BPFLAG=1                          
         STW,T1   SVBPFLAG                                                      
         B        *F:LNK            EXIT                                        
*                                                                               
*  TEST FOR 'OFF'                                                               
*                                                                               
BPV5     CW,T1    BPVOFF                                                        
         BNE      BPV10             IS STRING='OFF'                             
         LI,T1    0                 YES - SET BPFLAG=0                          
         STW,T1   SVBPFLAG                                                      
         B        *F:LNK            EXIT                                        
*                                                                               
*  ERROR: NOT ON OR OFF                                                         
*                                                                               
BPV10    BAL,LNK  TYPEMSG           TYPE: '-NOT ON/OFF'                         
         DATA     ERRM5                                                         
         B        *F:LNK            EXIT                                        
*                                                                               
*                                                                               
BPVON    TEXTC    'ON'                                                          
BPVOFF   TEXTC    'OFF'                                                         
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*************************                                                       
*  FILE COMMAND: BUILD  *                                                       
*************************                                                       
*                                                                               
*                                                                               
F:BUILD  EQU      %                                                             
         BAL,LNK  TESTEDITACTIVE    CHECK IF EDIT FILE ACTIVE                   
         LI,X1    5                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT                    
         AW,P1    CDTADR                                                        
         DO1      S(0,1,1)                                                      
         LW,R2    P1                SAVE FID ADDRESS                            
         BAL,LNK  OPENNEW           OPEN OUTPUT ONLY FILE                       
         BCR,8    BLD40             DOES FILE ALREADY EXIST                     
         DO       S(0,1,1)                                                      
         LW,T1    PR%NULL                                                       
         STW,T1   PROMPT                                                        
         FIN                                                                    
         LI,P1    DFLTSEQ           NO - SET P1=DEFAULT SEQ #                   
         LI,T1    1000                       T1=1 (DEFAULT INCR)                
         LI,X1    6                                                             
         LB,R1    *CDTADR,X1        GET PARAM2 TYPE                             
         BEZ      BLD5              TEST IF PARAM2 PRESENT                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET P1=SEQ # FROM CDT                 
         LW,P1    *CDTADR,X2                                                    
*                                                                               
*  PROCESS INCREMENT PARAMETER                                                  
*                                                                               
BLD5     LI,X1    8                                                             
         LB,R1    *CDTADR,X1        GET PARAM3 TYPE                             
         BEZ      BLD08             TEST IF PARAM3 PRESENT                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT                  
         LW,T1    *CDTADR,X2                                                    
*                                                                               
BLD08   MTW,0    BUILDFLAG                                                      
        BEZ      BLD12                                                          
         DO       S(0,1,1)                                                      
BLD10    CI,R2    0                 HAVE WE BUILT FIRST LINE                    
         BEZ      BLD12               YES--BYPASS RE-OPEN                       
         BAL,LNK  CLOSE               CLOSE AND SAVE BUILD FILE                 
         XW,P1    R2                POSITION FID FOR OPENING                    
         BAL,LNK  OPEN              REOPEN IN INOUT SO ESC LEAVES INTACT        
         LW,P1    R2                RESET P1 TO SEQ. #                          
         LI,R2    1                 NOW MARK FILE AS IF WE ARE IN               
         STW,R2   FILETYPE            EDIT MODE - RECORD COMM 0.K.              
         LI,R2    0                 AND R2 SO WILL NOT RE-OPEN EO               
         STW,R2   TABERRFLAG        EDIT WOULD DO THIS, SO SHALL BUILD          
         FIN                                                                    
*  TYPE NEXT SEQ # AND READ INPUT LINE                                          
*                                                                               
BLD12    BAL,LNK  TYPESEQ  TYPE 'DDDD.DDD'                                      
         GEN4     BL,EOM,0,0                                                    
         DO       S(0,1,1)                                                      
         LI,D1    9                                                             
         FIN                                                                    
         BAL,LNK  READTELETYPE      READ INPUT LINE                             
         CI,R1    1                                                             
         BE       BLD30                                                         
          LW,X2     R1           GET BYTE CNT.. INTO INDEX REG.                 
         AI,X2     -1               MAKE X2 A BINARY COUNT                      
         LB,D1     CARDIMG,X2       GET LAST BYTE INPUT                         
         CI,D1    CR                                                            
         BNE      %+4               B IF LINE DOESNT END WITH CR                
         LI,D1     ' '              BLANK OUT C/R                               
         STB,D1    CARDIMG,X2                                                   
         MTW,-1    R1               IF CR DECREMENT CHAR. COUNT.                
         STW,R1   RECSIZE                                                       
         CI,R1    MAXCLMN                                                       
         BLE      BLD25                                                         
         BAL,LNK  TYPEMSG           NO - TYPE: '--OVERFLOW'                     
         DATA     ERRM3                                                         
*                                                                               
*  WRITE INPUT LINE AND INCREMENT SEQ. #                                        
*                                                                               
BLD25    BAL,LNK  SETEOD            FINDS COL. OF LAST NON-BLANK                
         BAL,LNK  WRITERANDOM       WRITE CARD IMAGE; P1 CONTAINS SEQ. #        
         AW,P1    T1                INCREMENT SEQ. #                            
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG                         
         BLE      BLD10             NO.  GO READ MORE INPUT                     
         BAL,LNK  TYPEMSG           YES.                                        
         DATA     ERRM20                                                        
         CW,R2    BUILDFLAG         DID I COME FROM A BANG BUILD                
         BCS,7    BLD30             OR A BANG EDIT. IF BY BANG                  
*                                     BUILD DONT SAVE THE FILE.                 
         BAL,LNK  CLOSE                                                         
*                                                                               
*  NULL INPUT LINE: EXIT                                                        
*                                                                               
BLD30    EQU      %                                                             
         DO       S(0,1,1)                                                      
         MTW,0    BUILDFLAG         IF ENTERED BY BUILD COMMAND, EXIT           
         BEZ      F:END             TO TEL.                                     
         FIN                                                                    
         BAL,LNK  SET%DEFAULTS                                                  
         SW,P1    T1                LAST INSERT LINE                            
         STW,P1   SV1STSET                                                      
         STW,P1   LASTSET           DEFAULT SET LIMITS AS FOR INSERT            
         B        *F:LNK            EXIT                                        
*                                                                               
*  ERROR: NAMED FILE ALREADY EXISTS                                             
*                                                                               
BLD40    BAL,LNK  TYPEMSG           TYPE: '-FILE EXISTS; CAN'T BUILD'           
         DATA     ERRM15                                                        
         BAL,LNK  CLOSE             CLOSE F:EI                                  
         B        BLD30                                                         
         PAGE                                                                   
************************                                                        
*  FILE COMMAND: COPY  *                                                        
************************                                                        
*                                                                               
*                                                                               
F:COPY   EQU      %                                                             
         BAL,LNK  TESTEDITACTIVE    CHECK IF EDIT FILE ACTIVE                   
         LI,X3    0                 INITIALIZE FLAG FOR                         
         STW,X3   COPYFL              FID1=FID2                                 
         LI,X1    5                 OBTAIN FID 1 AND FID 2                      
         LB,P1    *CDTADR,X1          AS                                        
         AW,P1    CDTADR            BYTE                                        
         LI,X1    9                   ADDRESSES                                 
         LB,P2    *CDTADR,X1          IN                                        
         AW,P2    CDTADR              REGISTERS                                 
         SLS,P1   2                   P1 AND                                    
         SLS,P2   2                   P2                                        
*                                                                               
*  SEARCH LOOP TO DETERMINE IF FID1 = FID2                                      
*                                                                               
CPY1     AI,P1    1                                                             
*                 (OK TO BYPASS TEXTC BYTE IN COMPR)                            
         AI,P2    1                                                             
         LB,X1    0,P1              GET FID 1 BYTE                              
         BEZ      CPY1A               QUIT WHEN END OF FID                      
         CB,X1    0,P2                                                          
         BNE      CPY1B               OR WHEN NOT EQUAL                         
         B        CPY1              LOOP                                        
*                                                                               
*  FINISH FID COMPARISON - FID STRING HAS ENDED                                 
*                                                                               
CPY1A    CB,X1    0,P2              CHECK LAST BYTE                             
         BE       CPY32                                                         
CPY1B    LI,X1    7                 FIND OUT WHETHER ON                         
         LB,X2    *CDTADR,X1        OR OVER SPECIFIED                           
         LW,T1    *CDTADR,X2        T1='ON' OR 'OVER'                           
         CW,T1    X:OVER                                                        
         BNE      CPY30             NOT EQUAL --> ON                            
*                                                                               
*  OPEN FOR COPY A OVER B                                                       
*                                                                               
CPY2     LI,X1    5                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID1 IN CDT                   
         AW,P1    CDTADR                                                        
         LI,X4    0                 SET X4=0 TO SHOW FILE UNKEYED               
         BAL,LNK  OPEN1             OPEN INPUT FILE WITH THIS FID               
         BCS,8    CPY40             DOES FILE EXIST                             
         BCS,4    %+2               YES - IS FILE KEYED                         
         LI,X4    1                 YES - SET X4=1 TO SHOW FILE KEYED           
         LI,X1    9                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID2 IN CDT                   
         AW,P1    CDTADR                                                        
         BAL,LNK  OPEN2             OPEN COPY FILE WITH THIS FID                
         BCS,8    CPY3              FILE 2 NO EXIST YET                         
         BAL,LNK  CLOSE3            .. EXISTS-RELEASE GRANS                     
         BAL,LNK  OPEN3             OPEN FOR OUTPUT                             
*                                                                               
*  FINISH INITIALIZATION AND PROCESS PARAMETER 4                                
*                                                                               
CPY3     BAL,LNK  TYPEMSG           TYPE: '..COPYING'                           
         DATA     MSG1                                                          
         LI,X1    10                                                            
         LB,R2    *CDTADR,X1        IS 'STARTING SEQ #' PARAM PRESENT           
         BNEZ     CPY10             YES - GO COPY AND RESEQ                     
*                                                                               
*  COPY SOURCE FILE THROUGH EOF                                                 
*                                                                               
CPY5     BAL,LNK  READSEQUEN        READ SOURCE RECORD                          
         CW,R1    L(EOF)            IS IT AN EOF                                
         BE       CPY20             YES - GO FINISH UP                          
         CI,X4    1                                                             
         BNE      CPY50                                                         
CPY5A    LW,P1    R1                GET SEQ # IN P1                             
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE                   
         DO       S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         STW,R1   INTFLAG2                                                      
         FIN                                                                    
         B        CPY5              NO - LOOP                                   
*                                                                               
*  PROCESS STARTING SEQ. # AND INCREMENT PARAMETERS                             
*                                                                               
CPY10    LI,X1    11                                                            
         LB,X2    *CDTADR,X1                                                    
         LW,P1    *CDTADR,X2        SET P1=STARTING SEQ #                       
         LI,T1    1000                  T1=1 (DEFAULT INCR)                     
         LI,X1    12                                                            
         LB,R2    *CDTADR,X1        GET PARAM4 TYPE                             
         BEZ      CPY15             TEST IF PARAM4 PRESENT                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT                  
         LW,T1    *CDTADR,X2                                                    
*                                                                               
*  COPY AND RESEQUENCE SOURCE FILE THROUGH EOF                                  
*                                                                               
CPY15    BAL,LNK  READSEQUEN        READ SOURCE RECORD                          
         CW,R1    L(EOF)            IS IT AN EOF                                
         BE       CPY20             YES - GO FINISH UP                          
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE                   
         BCS,8    CPY50             DOES RECORD ALREADY EXIST                   
         DO       S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         STW,P1   INTFLAG2                                                      
         FIN                                                                    
         AW,P1    T1                NO - INCR SEQ #                             
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG                         
         BLE      CPY15             NO.                                         
         BAL,LNK  TYPEMSG           YES.                                        
         DATA     ERRM20                                                        
*                                                                               
*  EOF FOUND: CLOSE COPY FILE AND EXIT                                          
*                                                                               
CPY20    BAL,LNK  CLOSE             CLOSE INPUT FILE                            
         BAL,LNK  CLOSE2            CLOSE COPY FILE                             
         BAL,LNK  TYPEMSG           TYPE: '..COPY DONE'                         
         DATA     MSG2                                                          
         B        *F:LNK            EXIT                                        
*                                                                               
*  OPEN FOR COPY A ON B                                                         
*                                                                               
CPY30    LI,X1    9                                                             
         LB,P1    *CDTADR,X1        P1=ADR OF FID2 IN CDT                       
         AW,P1    CDTADR                                                        
         BAL,LNK  OPEN2             OPEN INOUT-CHNGD TO OUT                     
         BCR,8    CPY35             ERROR IF FILE 2 EXISTS                      
         LI,X1    5                 OBTAIN FID 1 AND FID 2                      
         LB,P1    *CDTADR,X1          AS                                        
         AW,P1    CDTADR            BYTE                                        
         LI,X4    0                 X4=4 MEANS NOT KEYED                        
         BAL,LNK  OPEN1                                                         
         BCS,8    CPY36             IF FILE DOES NOT EXIST                      
         BCS,4    CPY3              IS FILE KEYED                               
         LI,X4    1                   MARK AS KEYED                             
         B        CPY3              GO TO BODY OF COPY                          
*                                                                               
*  OPEN FOR COPY A OVER A  OR  A ON A                                           
*                                                                               
CPY32    LI,X1    5                 CHECK FID1 FOR PASSWORD                     
         MTW,1    COPYFL            SET TO SHOW FID1=FID2                       
         LB,P1    *CDTADR,X1                                                    
         AW,P1    CDTADR            P1 = FILE NAME                              
         LB,X1    *P1               BYTE CNT OF FILE NAME                       
         SLS,X1   -2                BYTE TO WORD COUNT                          
         AI,X1    1                 GET NEXT WORD                               
         AW,P1    X1                                                            
         LB,X1    *P1               BYTE CNT OF ACCOUNT                         
         SLS,X1   -2                                                            
         AI,X1    1                 POINT TO PASSWORD                           
         AW,P1    X1                                                            
         LW,X1    *P1               FETCH PASSWORD                              
         BNEZ     CPY60             PASSWORD GIVEN - ERROR                      
         LI,X1    9                 NOW GO DO SAME FOR FID2                     
         LB,P1    *CDTADR,X1                                                    
         AW,P1    CDTADR            P1 = FILE NAME                              
         LB,X1    *P1               BYTE CNT OF FILE NAME                       
         SLS,X1   -2                BYTE TO WORD COUNT                          
         AI,X1    1                 GET NEXT WORD                               
         AW,P1    X1                                                            
         LB,X1    *P1               BYTE CNT OF ACCOUNT                         
         SLS,X1   -2                                                            
         AI,X1    1                 POINT TO PASSWORD                           
         AW,P1    X1                                                            
         LW,X1    *P1               FETCH PASSWORD                              
         BNEZ     CPY60             PASSWORD GIVEN - ERROR                      
*                                                                               
         LI,X1    5                 OBTAIN FID 1 AND FID 2                      
         LB,P1    *CDTADR,X1          AS                                        
         AW,P1    CDTADR            BYTE                                        
         BAL,LNK  OPEN3             OPEN FOR OUTPUT                             
         LI,X1    5                 OBTAIN FID1 AND FID2                        
         LB,P1    *CDTADR,X1          AS                                        
         AW,P1    CDTADR            BYTE                                        
         LI,X4    0                 X4=4 MEANS NOT KEYED                        
         BAL,LNK  OPEN1             OPEN1 OPEN1 IN. CONTINUE                    
         BCS,8    CPY36             IF FILE DOES NOT EXIST                      
         BCS,4    CPY3              IS FILE KEYED                               
         LI,X4    1                   MARK AS KEYED                             
         B        CPY3              GO TO BODY OF COPY                          
*                                                                               
*  ERROR: COPY FILE EXISTS AND PARAMETER 2 IS 'ON'                              
*                                                                               
CPY35    BAL,LNK  TYPEMSG           TYPE: '-P2:FILE EXISTS'                     
         DATA     ERRP13                                                        
         BAL,LNK  CLOSE2                                                        
         B        *F:LNK            EXIT                                        
*                                                                               
*  ERROR: SOURCE FILE NAMED DOESN'T EXIST                                       
*                                                                               
CPY36    BAL,LNK  CLOSE3                                                        
         B        CPY40                                                         
CPY37    BAL,LNK  CLOSE2            CLOSE EO WITH SAVE                          
         BAL,LNK  CLOSE                                                         
CPY40    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH FILE'                    
         DATA     ERRP12                                                        
         B        *F:LNK            EXIT                                        
*                                                                               
*  ERROR: DUPLICATE RECORD COPIED                                               
*                                                                               
CPY50    BAL,LNK  TYPEMSG           TYPE: '-P1:FILE NOT SEQD & P3 NULL'         
         DATA     ERRP16                                                        
         BAL,LNK  CLOSE             CLOSE INPUT FILE                            
         MTW,0    COPYFL            DON'T DELETE INPUT FILE IF                  
         BNEZ     CPY56               FID1=FID2                                 
         BAL,LNK  CLOSE2            CLOSE COPY FILE                             
         LI,X1    9                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID2 IN CDT                   
         AW,P1    CDTADR                                                        
         BAL,LNK  DELETEFILE        DELETE COPY FILE                            
         B        CPY58             EXIT IF FID1 NOT= FID2                      
CPY56    BAL,LNK  CLOSE3            DELETE COPY FILE, FID1=FID2                 
CPY58    B        *F:LNK            EXIT                                        
CPY60    BAL,LNK  TYPEMSG           TYPE: 'PASSWORD ERROR'                      
         DATA     ERRM19                                                        
         B        *F:LNK            EXIT                                        
         PAGE                                                                   
**************************************************                              
*  FILE COMMAND: SET TERMINATOR (X'15') MODE     *                              
**************************************************                              
*                                                                               
*                                                                               
F:CR     EQU      %                                                             
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1                                                    
         LW,T1    *CDTADR,X2        GET PARAMETER AS A TEXTC STRING.            
         CW,T1    BPVON             CHECK FOR 'ON'                              
         BNE      CR5                                                           
*                                                                               
         LI,T1    0                 TURN 'ON'                                   
CR3      STW,T1   CRFLAG            SET FLAG TO INCLUDE TERMINATOR              
         B        *F:LNK            IN OUTPUT RECORDS.                          
*                                                                               
CR5      CW,T1    BPVOFF            CHECK FOR 'OFF'                             
         BE       CR3               TURN 'OFF'                                  
*                                                                               
         B        BPV10             ERROR: -NOT ON/OFF                          
         PAGE                                                                   
**************************                                                      
*  FILE COMMAND: DELETE  *                                                      
**************************                                                      
*                                                                               
*                                                                               
F:DELETE EQU      %                                                             
         BAL,LNK  TESTEDITACTIVE                                                
         LI,X1    5                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT                    
         AW,P1    CDTADR                                                        
         BAL,LNK  DELETEFILE        DELETE FILE                                 
         BCS,8    DLT10             DID FILE EXIST                              
*                                                                               
*  TYPE MESSAGE AND EXIT                                                        
*                                                                               
DLT5     BAL,LNK  TYPEMSG           TYPE: '..DELETED'                           
         DATA     MSG3                                                          
         B        *F:LNK            YES - EXIT                                  
*                                                                               
*  ERROR: FILE TO DELETE DOESN'T EXIST                                          
*                                                                               
DLT10    BAL,LNK  TYPEMSG           TYPE: '-NO SUCH FILE'                       
         DATA     ERRM14                                                        
         B        *F:LNK                                                        
         FIN                                                                    
         PAGE                                                                   
************************                                                        
*  FILE COMMAND: EDIT  *                                                        
************************                                                        
*                                                                               
*                                                                               
F:EDIT   EQU      %                                                             
         DO       S(1,1,0)                                                      
         MTW,0    FILETYPE          FILETYPE=-1 NEVER OPENED                    
         BLZ      EDT5                       +1 OPENED AS INOUT, KEYED          
         BAL,LNK  CLOSE             CLOSE FILE IF EVER OPENED                   
*                                                                               
*  OPEN FILE AND SET FILE TYPE                                                  
*                                                                               
EDT5     LI,X1    5                                                             
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT                    
         AW,P1    CDTADR                                                        
         BAL,LNK  OPEN              OPEN FILE                                   
         BCS,8    EDT10             DOES FILE EXIST                             
         BCS,4    EDT20             YES - IS IT KEYED                           
         BAL,LNK  SET%DEFAULTS      SET STARTUP DEFAULTS                        
         DO       MODE=2                                                        
         LI,T1    0                                                             
         STW,T1   TABERRFLAG                                                    
         FIN                                                                    
         B        *F:LNK            EXIT                                        
*                                                                               
*  ERROR: SOURCE FILE DOESN'T EXIST                                             
*                                                                               
EDT10    BAL,LNK  TYPEMSG           TYPE: '-NO SUCH FILE'                       
         DATA     ERRM14                                                        
EDT15    LI,T1    -1                SHOW UNSUCCESSFUL OPEN                      
         STW,T1   FILETYPE                                                      
         B        *F:LNK                                                        
*                                                                               
*  FILE EXISTS BUT IS NOT KEYED                                                 
*                                                                               
EDT20    BAL,LNK  CLOSE             CLOSE FILE                                  
         BAL,LNK  TYPEMSG           TYPE: '-FILE NOT KEYED; MUST COPY'          
         DATA     ERRM12                                                        
         B        EDT15             EXIT.                                       
         ELSE                                                                   
         MTW,0    FILETYPE                                                      
         BLZ      EDT10                                                         
         LCI      5                                                             
         LM,P1    SUBJFID                                                       
         STM,P1   SAVEFID           SET SAVE FILE ID TO SUBJECT FILE            
         CI,P1    0                                                             
         BL       EDT10                                                         
         LI,R0    0                                                             
         STW,R0   FORCESV           DONT SAVE IF FILE TOO SMALL                 
         STW,R0   SAVON             FILE MAY PREVIOUSLY EXIST                   
         STW,R0   FIRSTFROM         SET DEFAULT SAVE START                      
         LW,R0    L(9999999)                                                    
         STW,R0   LASTFROM          SET DEFAULT SAVE END                        
         BAL,LNK  SAVESCR           PERFORM THE SAVE                            
EDT10    RES      0                                                             
         BAL,LNK  CLOSESCR          CLOSE THE SCRATCH FILE                      
         LH,R0    F:EO                                                          
         CI,R0    X'0020'                                                       
         BAZ      EDT20             B IF F:EO NOT OPEN                          
         LI,LNK   EDT20             ERROR EXIT                                  
         M:CLOSE  M:EO,(ERR,EDT20),(ABN,EDT20)                                  
EDT20    RES      0                                                             
         LI,R0    -1                                                            
         STW,R0   FILETYPE          FLAG:  NOT READY TO EDIT YET                
         STW,R0   SUBJFID           SET SUBJECT FILE UNSPECIFIED                
         LI,X1    5                                                             
         LB,P1    *CDTADR,X1                                                    
         AW,P1    CDTADR            GET FID1 POINTER                            
         LI,P2    SUBJFID           WHERE TO PUT FILE ID                        
         BAL,LNK  UNPK%CPR%FID      UNPACK FILE ID FROM CDT                     
         M:ASSIGN M:EO,(FILPTR,SUBJFID),(ACNTPTR,SUBJFID+3),;                   
                  (ERR,EDTERR)                                                  
*        SET M:EO TO SUBJECT FILE                                               
         BAL,LNK  GETEO             GET EO FILE STRUCTURE                       
         CI,R3    0                                                             
         BE       EDT81             B IF NONEXIST FILE OR AREA                  
         LI,R0    1000                                                          
         STW,R0   LASTKEY           DEFAULT START                               
         STW,R0   DFLTINCR          DEFAULT STEP                                
         LI,R0    0                                                             
         STW,R0   ISNRREQ           FLAG: INPUT SEQ NRS NOT REQD                
         LI,X1    7                 SEE IF SCRATCH FILE ID (FID2)               
         LB,P1    *CDTADR,X1                                                    
         BNEZ     EDT30                                                         
*                                                                               
         CI,R1    0                 UNBLOCKED                                   
         BNE      EDT25                                                         
         CI,R2    1024                                                          
         BE       EDT60             FID1 IS KEYED                               
EDT25    RES      0                                                             
         LCI      4                                                             
         LM,R0    JNFPT                                                         
         M:STATUS,CAL               R0                                          
*                                                                               
* R2,R3 = JOBNAME                                                               
*                                                                               
         LI,R0    'D1'              BUILD FID2 DEFAULT NAME                     
         STW,R0   SCRFID                                                        
         LW,R0    4BLNKS                                                        
         STW,R0   SCRFID+3                                                      
         STW,R0   SCRFID+4                                                      
         STW,2    SCRFID+1                                                      
         STW,3    SCRFID+2                                                      
         LI,3     ':'                                                           
         LI,1     7                                                             
         LB,0     SCRFID+1,1                                                    
         CI,0     X'40'                                                         
         BNE      %+2                                                           
         STB,3    SCRFID+1,1                                                    
         BDR,1    %-4                                                           
         B        EDT45                                                         
JNFPT    M:STATUS,FPT (JOB,0)                                                   
EDT30    RES      0                                                             
         LI,X1    9                 GET START                                   
         LB,X2    *CDTADR,X1                                                    
         BEZ      EDT45             B IF NOT SPECIFIED                          
         LW,P1    *CDTADR,X2                                                    
         STW,P1   LASTKEY           SET START                                   
         LI,X1    11                GET STEP                                    
         LB,X2    *CDTADR,X1                                                    
         BEZ      EDT40             B IF NOT SPECIFIED                          
         LW,P1    *CDTADR,X2                                                    
         STW,P1   DFLTINCR          SET STEP                                    
EDT40    RES      0                                                             
         LCW,R0   DFLTINCR          ADJUST SO FIRST STEP                        
         AWM,R0   LASTKEY           ENDS ATD START                              
         B        EDT50                                                         
EDT45    RES      0                                                             
         MTW,0    SAVESEQ                                                       
         BEZ      EDT40             B IF SAVE FILE SEQUENCING OFF               
*                                   TO USE DEFAULT START/STEP                   
         BAL,LNK  BLANKBUF          PREPARE TO READ FIRST RECORD                
         LI,LNK   EDT47             DCB ERROR EXIT                              
         M:OPEN   M:EO,(ERR,CPRIOER),(ABN,CPRIOER)                              
         LI,LNK   EDT46             DCB ERROR EXIT                              
         M:READ   M:EO,(SIZE,MAXCLMN),(BUF,CARDIMG),WAIT,IGNERR                 
EDT46    RES      0                                                             
         LI,LNK   EDT47             DCB ERROR EXIT                              
         M:CLOSE  M:EO,IGNERR                                                   
EDT47    RES      0                                                             
         LW,R0    M:EO+4                                                        
         SLS,R0   -17               GET ACTUAL RECORD SIZE                      
         STW,R0   RECSIZE                                                       
         BAL,LNK  INSEQNR           CHECK FOR INPUT SEQUENCE NR                 
         CI,10    0                                                             
         BNE      EDT40             B IF THERE IS NONE (USE DEFAULTS)           
         LI,R0    1                                                             
         STW,R0   ISNRREQ           FLAG: INPUT SEQUENCE NRS ARE REQD           
         LI,R0    -1                                                            
         STW,R0   LASTKEY           SET TO ACCEPT ANY FIRST KEY VALUE           
EDT50    RES      0                                                             
         LI,X1    7                 GET SCRATCH FILE ID (FID2)                  
         LB,P1    *CDTADR,X1                                                    
         BEZ      EDT50B            NONE, USE DEFAULT IN D1                     
         AW,P1    CDTADR                                                        
         LI,P2    SCRFID                                                        
         BAL,LNK  UNPK%CPR%FID                                                  
EDT50B   RES      0                                                             
*      EDT50B MUST BE THE ADDRESS OF THE FOLLOWING CAL                          
         M:ASSIGN M:EI,(FILPTR,SCRFID),(ACNTPTR,SCRFID+3),;                     
                  (ERR,EDTERR)                                                  
         BAL,LNK  BUILDSCR          BUILD THE SCRATCH FILE                      
         B        EDT70                                                         
EDT60    RES      0                                                             
*        LCI      5                                                             
*        LM,R0    SUBJFID                                                       
*        STM,R0   SCRFID                                                        
         LI,X1    -1                                                            
         STW,X1   SUBJFID           SET FLAG = SUB FILE UNSPECIFIED             
         LI,X1    5                 FID1 IS SCRATCH                             
         LB,P1    *CDTADR,X1                                                    
         AW,P1    CDTADR                                                        
         LI,P2    SCRFID                                                        
         BAL,LNK  UNPK%CPR%FID                                                  
         M:ASSIGN M:EI,(FILPTR,SCRFID),(ACNTPTR,SCRFID+3),;                     
                  (ERR,EDTERR)                                                  
         BAL,LNK  OPENSCR           REOPEN SCRATCH FILE                         
         B        EDT70                                                         
*                                                                               
EDT70    RES      0                                                             
         BAL,LNK  SET%DEFAULTS      SET STARTUP DEFAULTS                        
         B        *F:LNK                                                        
*                                                                               
EDT81    RES      0                                                             
         CI,8     EDT50B+1            IS IT THE SCRATCH FILE                    
         BNE      EDT81A              NO  BRANCH                                
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM14A             NONEXISTANT SCRATCH FILE                  
         B        MASTERPARSER                                                  
EDT81A   RES      0                                                             
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM14            NONEXIST FILE OR AREA                       
         B        MASTERPARSER                                                  
*                                                                               
EDTERR   RES      0                                                             
         LB,R0    10                                                            
         CI,R0    FNXTYC                                                        
         BE       EDT81                                                         
         CI,R0    ANXTYC            AREA NONEXIST                               
         BE       EDT81                                                         
         BNE      BADIO1                                                        
         FIN                                                                    
         PAGE                                                                   
***********************                                                         
*  FILE COMMAND: END  *                                                         
***********************                                                         
*                                                                               
*                                                                               
F:END    EQU      %                                                             
         DO       S(0,0,1)                                                      
         MTW,0    FILETYPE                                                      
         BLZ      END10             B IF NOT CURRENTLY EDITING                  
         LI,X1    5                                                             
         LB,P1    *CDTADR,X1                                                    
         BNEZ     END05             B IF 'NS' WAS SPECIFIED                     
         LCI      5                                                             
         LM,P1    SUBJFID                                                       
         STM,P1   SAVEFID           USE SUBJECT FILE AS SAVE FILE               
         CI,P1    0                                                             
         BL       END05             B IF NO SAVE FILE                           
         LI,R0    0                                                             
         STW,R0   FORCESV           RESET FORCED SAVE FLAG                      
         STW,R0   SAVON             RESET SAVE 'ON' FLAG                        
         STW,R0   FIRSTFROM         SET DEFAULT SAVE START                      
         LW,R0    L(9999999)                                                    
         STW,R0   LASTFROM          SET DEFAULT SAVE END                        
         BAL,LNK  SAVESCR           PERFORM THE SAVE                            
END05    RES      0                                                             
         BAL,LNK  CLOSESCR          CLOSE THE SCRATCH FILE                      
END10    RES      0                                                             
         M:EXIT                                                                 
         ELSE                                                                   
         MTW,0    FILETYPE          WAS INPUT FILE EVER NAMED                   
         BLZ      %+2               NO - SKIP CLOSE                             
         BAL,LNK  CLOSE             CLOSE INPUT FILE                            
         DO1      S(0,1,0)                                                      
         BAL,LNK  CLOSE4            CLOSE LO WITH SAVE                          
         DO       MODE=1                                                        
         CAL3,6   0                 EXIT TO BTM                                 
         ELSE                                                                   
         M:EXIT                     EXIT TO UTS.                                
         FIN                                                                    
         FIN                                                                    
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*************************                                                       
*  FILE COMMAND: MERGE  *                                                       
*************************                                                       
*                                                                               
*                                                                               
F:MERGE  BAL,LNK  TESTEDITACTIVE                                                
         LI,X1     0                RESET THE RECORD CNT.                       
         STW,X1    MVD:REC:CNT                                                  
         LI,X1    5                 SET P1 TO ADDRESS OF FID1 IN CDT.           
         LB,P1    *CDTADR,X1                                                    
         AW,P1    CDTADR                                                        
         STW,P1   FID1ADR                                                       
         BAL,LNK  OPEN1             OPEN MERGE SOURCE IN INPUT MODE.            
         BCS,8    CPY40             ERROR IF NON-EXISTENT                       
         BCS,4    MRG80             OR NOT HEYED.                               
*                                                                               
         LI,P1    0                                                             
         STW,P1   FIRSTFROM         SET UP INPUT RANGE AS DEFALT                
         LW,P1    L(EOF)            ENTIRE FILE.                                
         STW,P1   LASTFROM                                                      
*                                                                               
         AI,X1    1                                                             
         LB,P1    *CDTADR,X1        BUT READJUST IF SPECIFIL RANGE              
         AI,X1    1                 GIVEN                                       
         CI,P1    SEQ2                                                          
         BNE      MRG10                                                         
*                                                                               
         LB,P1    *CDTADR,X1        COMPUTE ADDRESS OF SEQUENCE PAIR            
         AW,P1    CDTADR                                                        
         LW,P2    *P1               AND STORE THEM AWAY.                        
         STW,P2   FIRSTFROM                                                     
         AI,P1    1                                                             
         LW,P2    *P1                                                           
         STW,P2   LASTFROM                                                      
         AI,X1    2                 STEP AROUND 'INTO'                          
*                                                                               
MRG10    LW,P1    FIRSTFROM         VERIFY EXISTENCE OF RECORDS TO              
         BAL,LNK  READNXTRANDOM     MOVE.                                       
         CW,R1    L(EOF)            IF RECORD READ WAS 'EOF',                   
         BGE      MRG70             OR GREATER THAN LAST FROM, THEN             
         CW,R1    LASTFROM                                                      
         BG       MRG70             'NOTHING TO MOVE'                           
*                                                                               
         BAL,LNK  CLOSE             YES. CLOSE FILE SO WE CAN                   
*                                   USE F:EI ROUTINES TO DELETE                 
         AI,X1    2                 'TO' RANGE.                                 
         LB,P1    *CDTADR,X1        STEP TO FID2 AND OPEN                       
         AW,P1    CDTADR                                                        
         STW,P1   FID2ADR                                                       
         BAL,LNK  OPEN                                                          
         BCS,8    MRG30             IF NON-EXISTENT,CREATE NEW FILE.            
         BCS,4    MRG82             ERROR IF NOT KEYED                          
*                                                                               
         AI,X1    2                 NOW GET SEQUENCE NUMERS OF 'TO'             
         LB,T1    *CDTADR,X1        RANGE                                       
         AW,T1    CDTADR                                                        
         LW,P1    *T1               IN P1,PL - TEMPORARILY.                     
         AI,T1    1                                                             
         LW,P2    *T1                                                           
*                                                                               
         BAL,LNK  DELETE            DELETE'TO' RANGE                            
         BCS,8    %+2               GET 'STOP' SEQ # IF LAST 'TO'               
         BAL,LNK  READSEQUEN        NOT HIT EXACTLY.                            
         LW,X3    R1                'STOP' SEQ # TO X3                          
         STW,P1   T1                                                            
         STW,P2   T2                                                            
*                                                                               
MRG13   BAL,LNK  CLOSE             CLOSE FID2 AS F:EI                           
MRG14    LI,P3    1000              DEFAULT INCREMENT                           
         AI,X1    1                                                             
         LB,P1    *CDTADR,X1                                                    
         BEZ      MRG15                                                         
         AI,X1    1                 INCREMENT GIVEN.                            
         LB,P3    *CDTADR,X1                                                    
         AW,P3    CDTADR                                                        
         LW,P3    *P3                                                           
         STW,P3   DFLTINCR                                                      
*                                                                               
MRG15    LW,P1    FID1ADR           R-OPEN FILES IN PROPER MODE.                
         BAL,LNK  OPEN1             SOURCE IN INPUT.                            
         LW,P1    FID2ADR                                                       
         BAL,LNK  OPEN2                                                         
*                                                                               
         BAL,LNK  TYPEMSG                                                       
         DATA     MSG5                                                          
MRG17    LW,P1    FIRSTFROM         GET FIRST 'FROM' RECORD IN FILE 1.          
         BAL,LNK  READNXTRANDOM                                                 
         LW,P1    T1                FIRST 'TO' SEG # TO P1.                     
MRG20    CW,R1    L(EOF)            IF EOF READ,                                
         BGE      MRG55             WE'RE DONE.                                 
         CW,R1    LASTFROM          IF SEQ # READ GREATER TRAN LAST             
         BG       MRG55             'FROM' WE'RE DONE.                          
         STW,R1    T2                                                           
         SW,T2    LASTFROM                                                      
*                                                                               
         BAL,LNK  WRITE2            WRITE RECORD INTO FILE2.                    
         MTW,1     MVD:REC:CNT      COUNT REC.S MOVED.                          
         DO       S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         STW,P1   INTFLAG2                                                      
         FIN                                                                    
         AW,P1    P3                POINT TO NEXT WRITE SEQ NR                  
         CI,T2    0                                                             
         BE       MRG55             B IF ALL RECS MOVED (HIT LAST)              
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG                         
         BLE      MRG25             NO.                                         
         BAL,LNK  TYPEMSG           YES.                                        
         DATA     ERRM20                                                        
         B        MRG55                                                         
MRG25    CW,P1    X3                IF CURRENT WRITE SE # MEETS                 
         BGE      MRG65             'STOP' SEQ # WE'RE CUT OFF.                 
         BAL,LNK  READSEQUEN        GET NEXT 'FROM' RECORD.                     
         B        MRG20                                                         
*                                                                               
*                                                                               
*                                                                               
MRG30   EQU      %                 OUTPUT FILE DOESN'T EXIST.                   
         AI,X1    2                 GET STARTING OUTPUT SEQUENCE.               
         LB,T1    *CDTADR,X1                                                    
         AW,T1    CDTADR                                                        
         LW,T1    *T1                                                           
MRG35    LW,X3    L(EOF)            SET 'STOP' SEQUENCE TO EOF.                 
         B        MRG14                                                         
*                                                                     BL        
*                                                                               
*                                                                               
MRG55    RES      0                 DONE MERGING.                               
*        CLOSE FILES, THEN USE 'MK' CODE FOR MESSAGES                           
         BAL,LNK  CLOSE                                                         
         BAL,LNK  CLOSE2                                                        
         B        MVE40                                                         
*                                                                               
MRG65    STW,R1   LASTFROM          SET LAST SEQ # READ.                        
         BAL,LNK  CLOSE                                                         
         BAL,LNK  CLOSE2                                                        
         B        MVE56             THEN USE 'MK' CODE.                         
*                                                                               
MRG70    BAL,LNK  CLOSE             CLOSE INPUT FILE                            
         B        MVE58             THEN USE 'MK' ROUTINE                       
MRG80   BAL,LNK  CLOSE                                                          
        BAL,LNK  TYPEMSG                                                        
         DATA     ERRM17            'SOURCE NOT KEYED'                          
         B       *F:LNK                                                         
*                                                                               
MRG82   BAL,LNK  CLOSE                                                          
        BAL,LNK  TYPEMSG                                                        
        DATA     ERRM18            DEST. NOT KEYED                              
        B        *F:LNK                                                         
*                                                                               
         ELSE                                                                   
         PAGE                                                                   
**************************************                                          
*        FILE COMMAND:  F:SAVE       *                                          
***************************************                                         
*                                                                               
*                                                                               
F:SAVE   RES      0                                                             
         MTW,0    FILETYPE                                                      
         BLZ      EXC40             B IF NOT EDITTING YET                       
         LI,R0    0                                                             
         STW,R0   FORCESV           FLAG: IF SAVE FILE TOO SMALL,               
*                                   DONT TRY TO SAVE                            
         STW,R0   SAVON             FLAG: SAVE OVER (NOT SAVE ON)               
         STW,R0   FIRSTFROM         SET DEFAULT SAVE START                      
         LW,R0    L(9999999)                                                    
         STW,R0   LASTFROM          SET DEFAULT SAVE END                        
*                                                                               
         LI,X1    4                                                             
         LB,P1    *CDTADR,X1        GET FIRST PARAM TYPE                        
         CI,P1    SEQ2                                                          
         BNE      SAV30             B IF NOT SAVE LIMITS                        
*                                                                               
         AI,X1    1                                                             
         LB,P1    *CDTADR,X1        GET FIRST PARAM POINTER                     
         LW,R0    *CDTADR,P1                                                    
         STW,R0   FIRSTFROM         SET SAVE START                              
         AI,P1    1                                                             
         LW,R0    *CDTADR,P1                                                    
         STW,R0   LASTFROM          SET SAVE END                                
         AI,X1    1                 INDEX TO NEXT PARAM TYPE                    
SAV30    RES      0                                                             
         AI,X1    3                 INDEX TO FILE NAME POINTER                  
         LB,P1    *CDTADR,X1                                                    
         BEZ      SAV50             B IF FID NOT SPECIFIED                      
         LI,R0    1                                                             
         STW,R0   FORCESV           SAVE EVEN IF SAVE FILE TOO SMALL            
         AW,P1    CDTADR            ADDRESS OF FID PARAMETER                    
         LI,P2    SAVEFID           WHERE TO PUT FILE ID                        
         BAL,LNK  UNPK%CPR%FID      UNPACK SAVE FILE ID FROM CDT                
         AI,X1    -2                INDEX TO PRIOR PARAM POINTER                
         LB,P1    *CDTADR,X1        GET 'ON'/'OVER'                             
         LW,R0    *CDTADR,P1                                                    
         CW,R0    X:ON                                                          
         BNE      SAV90             B IF NOT 'ON'                               
         LI,R0    1                                                             
         STW,R0   SAVON             SET FLAG TO SAVE 'ON'                       
         B        SAV90                                                         
SAV50    RES      0                                                             
         LCI      5                                                             
         LM,P1    SUBJFID           SET SUBJECT FILE ID                         
         STM,P1   SAVEFID           AS SAVE FILE ID                             
         CI,P1    0                                                             
         BL       SAV95             B IF SUBJECT FILE NOT DEFINED               
SAV90    RES      0                                                             
         BAL,LNK  SAVESCR           PERFORM THE SAVE                            
SAV95    RES      0                                                             
         B        *F:LNK                                                        
         PAGE                                                                   
*                                                                               
*        FILE COMMAND:  SET SAVE FILE SEQUENCING MODE                           
*                                                                               
*                                                                               
*                                                                               
F:SEQ    RES      0                                                             
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1                                                    
         LW,T1    *CDTADR,X2        GET PARAMETER FROM CDT                      
         CW,T1    X:ON                                                          
         BNE      SEQ5              B IF NOT 'ON'                               
         LI,T1    1                                                             
         STW,T1   SAVESEQ           SET FLAG                                    
         B        *F:LNK                                                        
SEQ5     RES      0                                                             
         CW,T1    BPVOFF                                                        
         BNE      BPV10             B IF NOT 'OFF'                              
         LI,T1    0                                                             
         STW,T1   SAVESEQ           RESET FLAG                                  
         B        *F:LNK                                                        
         FIN                                                                    
         PAGE                                                                   
         DO       S(0,1,0)                                                      
*************************                                                       
*  FILE COMMAND: TA     *                                                       
*************************                                                       
*                                                                               
*                                                                               
F:TA     EQU      %                                                             
         LI,X1    5                 COMPUTE ADDRESS OF TAB SPECIFIER            
         LB,P1    *CDTADR,X1        IN CDT.                                     
         AW,P1    CDTADR                                                        
*                                                                               
         LW,P1    *P1               GET SPECIFIER                               
         LI,X1    3                 AND CHECK VALIDITY.                         
         CW,P1    X:F-1,X1                                                      
         BE       TA5                                                           
         BDR,X1   %-2                                                           
*                                                                               
         BAL,LNK  TYPEMSG           ERROR: NOT F,M,S.                           
         DATA     UTSM3                                                         
         B        MASTERPARSER                                                  
*                                                                               
TA5      EXU      TABSET-1,X1       CHANGE MUC TABS FOR F,M OR S                
*                                                                               
         B        *F:LNK            RETURN                                      
TABSET   M:DEVICE M:UC,(TAB,7,0,0,0)      FTABS                                 
         M:DEVICE M:UC,(TAB,10,19,37,0)   MTABS                                 
         M:DEVICE M:UC,(TAB,8,16,30,0)    STABS                                 
         FIN                                                                    
         PAGE                                                                   
************************************                                            
*  RECORD COMMAND: ADD COMMENTARY  *                                            
************************************                                            
*                                                                               
*                                                                               
R:COMMENTARY      EQU %                                                         
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        SET P1=STARTING SEQ #                       
         LW,P1    *CDTADR,X2                                                    
         LI,X1    6                 INDEX TO COL LIMS PARAM TYPE                
         BAL,LNK  PROCESSCOL#PAIR   USE EM                                      
         BAL,LNK  READRANDOM        READ FIRST RECORD                           
         BCS,8    CMT50             DOES IT EXIST (IF NO, ERROR)                
*                                                                               
*  TYPE SEQ. # AND READ IN COMMENTARY                                           
*                                                                               
CMT10    BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD'                            
         GEN4     BL,EOM,0,0                                                    
         BAL,LNK  READTELETYPE2     READ COMMENTARY                             
         AI,R1    -1                SET R1=# OF CHARS READ, LESS C/R            
         BEZ      *R:LNK            IF ONLY  C/R READ - EXIT                    
         LI,X1    0                                                             
         LW,X2    FRSTCLMN          GET START COL FOR INSERT                    
         LI,T2    ' '                                                           
*                                                                               
*  MOVE COMMENTARY INTO SPECIFIED COLUMN OF CARD                                
*                                                                               
CMT15    LB,D0    TTYIMG,X1         MOVE COMMENTARY INTO SPECIFIED              
         STB,D0   CARDIMG,X2         COLUMN                                     
         AI,X1    1                                                             
         AI,X2    1                                                             
         BDR,R1   %+2               TEST IF ANY MORE CHARS LEFT TO MOVE         
         B        CMT20             NO - GO FINISH UP                           
         CW,X2    LASTCLMN          YES - SPACE LEFT IN FIELD                   
         BL       CMT15             YES - LOOP                                  
         CB,T2    TTYIMG,X1         NO - TEST IF REMAINING CHARS ARE ALL        
         BNE      CMT70              BLANKS (IF NOT, ERROR)                     
         AI,X1    1                                                             
         BDR,R1   %-3               LOOP                                        
*                                                                               
*  BLANK OUT REST OF CARD AFTER NEW COMMENTARY                                  
*                                                                               
CMT20    RES      0                 BLANK OUT REST OF FIELD                     
         CW,X2    LASTCLMN                                                      
         BGE      CMT30                                                         
         STB,T2   CARDIMG,X2                                                    
         AI,X2    1                                                             
         B        CMT20                                                         
*                                                                               
*  WRITE NEW RECORD AND THEN GET NEXT RECORD TO PROCESS                         
*                                                                               
CMT30    BAL,LNK  SETEOD                                                        
         BAL,LNK  WRITERANDOM                                                   
         BAL,LNK  READSEQUEN        READ NEXT RECORD                            
         CW,R1    L(EOF)            WAS IT AN EOF                               
         BE       CMT60             YES - ERROR                                 
         LW,P1    R1                SET P1=SEQ # OF RECORD                      
         B        CMT10             GO GET MORE COMMENTARY                      
*                                                                               
*  ERROR: SPECIFIED COLUMN NUMBER > MAX COLUMN NUMBER                           
*                                                                               
CMT40    BAL,LNK  TYPEMSG           TYPE: '-P2:COL>72'                          
         DATA     ERRP14                                                        
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  ERROR: INITIAL SEQ. # DOESN'T EXIST                                          
*                                                                               
CMT50    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH REC'                     
         DATA     ERRP1                                                         
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
CMT60    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  ERROR: COMMENTARY OVERFLOWS CARD                                             
*                                                                               
CMT70    BAL,LNK  TYPEMSG           TYPE: '--OVERFLOW'                          
         DATA     ERRM3                                                         
         B        CMT30             GO CONTINUE WITH NEXT RECORD                
         PAGE                                                                   
****************************                                                    
*  RECORD COMMAND: DELETE  *                                                    
****************************                                                    
*                                                                               
*                                                                               
R:DELETE EQU      %                                                             
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ # IN CDT              
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #                          
         AI,X2    1                     P2=LAST SEQ #                           
         LW,P2    *CDTADR,X2                                                    
         DO1      MODE=2                                                        
         MTW,1    TABXFLAG                                                      
         BAL,LNK  DELETE            DELETE ALL BETWEEN THESE SEQ #'S            
         B        *R:LNK            EXIT                                        
         PAGE                                                                   
********************************************                                    
*  RECORD COMMANDS: FIND AND DELETE(TYPE)  *                                    
********************************************                                    
*                                                                               
*                                                                               
R:FIND%SEQUENCE   EQU %                                                         
         LI,X4    2                 USE X4=2 FOR 'FS'.                          
         B        R:FIND%TYPE+1                                                 
*                                                                               
*                                                                               
R:FIND%DELETE     EQU %                                                         
         LI,X4    0                 USE X4=0 FOR 'FD'                           
         B        R:FIND%TYPE+1                                                 
*                                                                               
*                                                                               
R:FIND%TYPE       EQU %                                                         
         LI,X4    1                 USE X4=1 FOR 'FT'                           
         LI,P3    0                 USE P3 TO COUNT # OF MATCHES FOUND          
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1                                                    
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ # IN CDT                   
         STW,P1   FIRSTSET              FIRSTSET=1ST SEQ # IN CDT               
         STW,T1   FIRSTSET          SET FIRSTSET=1ST SEQ # IN CDT               
         AI,X2    1                     LASTSET=2ND SEQ # IN CDT                
         LW,T1    *CDTADR,X2                                                    
         STW,T1   LASTSET                                                       
         LI,X1    7                                                             
         LB,P2    *CDTADR,X1        SET P2=ABSOLUTE ADDR OF STRING TO           
         AW,P2    CDTADR             MATCH                                      
         LI,X1    8                                                             
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS                        
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST            
*                                                                               
*  READ EACH RECORD AND SEE IF IT CONTAINS THE SPECIFIED STRING                 
*                                                                               
FND20    CW,R1    L(EOF)            WAS IT AN EOF                               
         BE       FND70             YES - ERROR                                 
         CW,R1    LASTSET           WAS INPUT SEQ # > LAST SEQ #                
         BG       FND50             YES - FINISH UP                             
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #                         
         LW,P1    FRSTCLMN          CHECK IF REC CONTAINS STRING                
FNDTYP   BAL,LNK   FINDMATCH        STARTING AT SPECIFIED COL. #                
         BCS,8    FND40                                                         
         AI,P3    1                 YES - INCR MATCH COUNT                      
         EXU      FNDTBL1,X4        GO PERFORM APPRO ACTION                     
*                                                                               
*  'FD' USED: DELETE RECORD                                                     
*                                                                               
FND30    BAL,LNK  DELETERECORD      DELETE RECORD                               
         B        FND40             GO ON TO NEXT RECORD                        
*                                                                               
*  'FT' USED: TYPE SEQ #, AND RECORD                                            
*                                                                               
FND32    LW,P1    FIRSTSET                                                      
         BAL,LNK  SETEOD                                                        
         BAL,LNK  TYPECARD                                                      
         B        FND40                                                         
*                                                                               
*  'FS' USED: TYPE SEQ #                                                        
*                                                                               
FND35    LW,P1    FIRSTSET          GET SEQ #                                   
         LI,R0    -1                                                            
         STW,R0   EODCLMN                                                       
         BAL,LNK  TYPECARD                                                      
*                                                                               
*  TEST IF LAST RECORD HIT: IF YES, GO FINISH UP                                
*                                                                               
FND40    LW,R1    FIRSTSET          TEST IF LAST SEQ # = SEQ # TO STOP          
         DO1      S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         CW,R1    LASTSET            AT                                         
         BE       FND50                                                         
         BAL,LNK  READSEQUEN        NO - READ NEXT RECORD                       
         B        FND20             LOOP                                        
*                                                                               
*  SEQ. # TO STOP AT HIT OR PASSED: FINISH UP                                   
*                                                                               
FND50    EXU      FNDTBL2,X4        GO FINISH UP                                
*                                                                               
*  'FD' USED: TYPE '--NNN RECS DLTED'                                           
*                                                                               
FND60    LW,D1    P3                                                            
         BEZ      FND65A            WERE ANY MATCHES FOUND                      
         MOVEMSG,P1  MSG6,X4                                                    
         LW,P1     P3               GET RECORD COUNT IN P1                      
         LI,P2    BA(MSGBUF)+1      GET BYTE ADR OF PLACE TO PUT CNT            
         BAL,LNK   BINTODEC         GO PUT THE NUMBER THER                      
         BAL,LNK   TYPEMSG                                                      
         DATA     MSGBUF                                                        
         B        *R:LNK            EXIT                                        
*                                                                               
*  'FT' USED: TYPE '--NONE' IF NO MATCHES FOUND                                 
*                                                                               
FND65    CI,P3    0                 WERE ANY MATCHES FOUND                      
         BNE      *R:LNK            YES - EXIT                                  
FND65A   BAL,LNK  TYPEMSG           NO - TYPE: '--NONE'                         
         DATA     ERRM6                                                         
         B        *R:LNK            EXIT                                        
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
FND70    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        FND50             GO FINISH UP                                
*                                                                               
*                                                                               
FNDTBL1  EQU      %                                                             
         B        FND30                                                         
         B        FND32                                                         
         B        FND35                                                         
*                                                                               
*                                                                               
FNDTBL2  EQU      %                                                             
         B        FND60                                                         
         B        FND65                                                         
         B        FND65                                                         
         PAGE                                                                   
*******************************************************                         
*  RECORD COMMANDS: INSERT(SUPPRESSING SEQ. NUMBERS)  *                         
*******************************************************                         
*                                                                               
*                                                                               
R:INSERT%SUP%SEQ  EQU %                                                         
         LI,X4    2                 USE X4=2 FOR 'IS'                           
         DO1      S(0,1,1)                                                      
         LW,T1    PR%PR                                                         
         B        INS01                                                         
*                                                                               
*                                                                               
R:INSERT EQU      %                                                             
         LI,X4    0                 USE X4 = 0 FOR 'IN'                         
         DO1      S(0,1,1)                                                      
         LW,T1    PR%NULL                                                       
INS01    RES      0                                                             
         DO1      S(0,1,1)                                                      
         STW,T1   PROMPT                                                        
         LW,P1    NXINSRT           GET DEFAULT INSERT START                    
         LI,X1    4                                                             
         LB,X2    *CDTADR,X1        GET FIRST PARAM TYPE                        
         BEZ      INS04             B IF NOT SPECIFIED                          
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        SET P1=STARTING SEQ #                       
         LW,P1    *CDTADR,X2                                                    
INS04    RES      0                                                             
         LW,T1    DFLTINCR          SET T1=LAST INCR USED                       
         DO1      MODE=2                                                        
         MTW,1    TABXFLAG                                                      
         LI,X1    6                                                             
         LB,R1    *CDTADR,X1        GET PARAM2 TYPE                             
         BEZ      INS10             TEST IF PARAM2 PRESENT                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT                  
         LW,T1    *CDTADR,X2                                                    
         STW,T1   DFLTINCR          SET NEW DEFAULT INCR                        
*                                                                               
*  GET SEQ. # AT WHICH TO STOP INSERTING                                        
*                                                                               
INS10    BAL,LNK  READNXTRANDOM     READ 1ST SEQ # OR NEXT HIGHEST              
         BCS,8    %+2               WAS NEXT HIGHEST READ                       
         BAL,LNK  READSEQUEN        NO - SO READ NEXT HIGHEST                   
         LW,T2    R1                SET T2=SEQ # AT WHICH TO STOP INSERT        
*                                                                               
         STW,P1   NXINSRT           SET DEFAULT INSERT SEQ NR                   
*                                                                               
*  TYPE NEXT SEQ. # AND READ INPUT LINE                                         
*                                                                               
INS20    B        %+1,X4            TYPE 'DDDD.DDD' AS REQD                     
         BAL,LNK  TYPESEQ                                                       
         GEN4     BL,EOM,0,0                                                    
         BAL,LNK  READTELETYPE      READ INSERT                                 
         CI,R1    1                                                             
         BE       INS40                                                         
          LW,X2     R1           GET BYTE CNT.. INTO INDEX REG.                 
         AI,X2     -1               MAKE X2 A BINARY COUNT                      
         LB,D1     CARDIMG,X2       GET LAST BYTE INPUT                         
         CI,D1    CR                                                            
         BNE      %+4               B IF LINE DIDNT END WITH CR                 
         LI,D1     ' '              BLANK OUT C/R                               
         STB,D1    CARDIMG,X2                                                   
         MTW,-1    R1               IF CR DECREMENT CHAR. COUNT.                
         STW,R1   RECSIZE                                                       
         CI,R1    MAXCLMN                                                       
         BLE      INS35                                                         
         BAL,LNK  TYPEMSG           NO - TYPE: '--OVERFLOW'                     
         DATA     ERRM3                                                         
*                                                                               
*  WRITE INPUT IMAGE, INCREMENT SEQ. #, AND CHECK AGAINST # TO STOP AT          
*                                                                               
INS35    BAL,LNK  SETEOD                                                        
         BAL,LNK  WRITERANDOM       WRITE CARD IMAGE                            
         LI,X1    1                                                             
         STW,X1   SETFLAG           TURN ON SE MODE                             
         STW,P1   SV1STSET          EDIT  RANGE IS LAST LINE INSERTED           
         STW,P1   LASTSET                                                       
         LI,X1    0                                                             
         STW,X1   FRSTCLMN          FROM COL 0                                  
         LI,X1    MAXCLMN                                                       
         STW,X1   LASTCLMN          TO COL (BIGGEST PERMITTED)                  
         AW,P1    T1                INCR SEQ #                                  
         STW,P1   NXINSRT           SET DEFAULT INSERT SEQ NR                   
         CW,P1    T2                                                            
         BL       INS20             IS NEW SEQ # > SEQ # TO STOP AT             
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG                         
         BLE      INS38             NO.                                         
         BAL,LNK  TYPEMSG           YES.                                        
         DATA     ERRM20                                                        
INS38    BAL,LNK  TYPEMSG           RING BELL TWICE                             
         DATA     INSMSG                                                        
INS40    RES      0                                                             
         B        *R:LNK            RETURN                                      
INS50    LI,D1    9                                                             
         NOP      0                 X4 IS NEVER ONE                             
         LI,D1    1                 OFFSET FOR PROMPT ONLY                      
*                                                                               
*                                                                               
INSMSG   TEXTC    '   '             X'07'+X'07'+EOM                             
         PAGE                                                                   
********************************************                                    
*  RECORD COMMANDS: MOVE AND DELETE(KEEP)  *                                    
********************************************                                    
*                                                                               
*                                                                               
R:MOVE%DELETE     EQU %                                                         
         LI,X4    0                 USE X4=0 TO SIGNAL MD                       
         B        R:MOVE%KEEP+1                                                 
*                                                                               
*                                                                               
R:MOVE%KEEP       EQU %                                                         
         LI,X4    1                 USE X4=1 TO SIGNAL MK                       
*                                                                               
*  GET 'FROM' SEQ. # PAIR IN T1-2, 'TO' SEQ # PAIR IN P1-2, AND                 
*  INCREMENT IN P3                                                              
*                                                                               
         LI,X1     0                                                            
         STW,X1    MVD:REC:CNT      ZERO OUT MOVED REC. COUNT.                  
*        SET IMPLICIT SE COL LIMITS                                             
         STW,X1   FRSTCLMN          FROM COL 0                                  
         LI,X1    MAXCLMN                                                       
         STW,X1   LASTCLMN          TO COL (BIGGEST PERMITTED)                  
MVE10    LI,X1    5                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF 1ST 'FROM' SEQ # IN CDT         
         LW,T1    *CDTADR,X2        SET T1=FIRST 'FROM' SEQ NR                  
         AI,X2    1                     T2=LAST 'FROM' SEQ NR                   
         LW,T2    *CDTADR,X2                                                    
         LW,P1    NXINSRT           DEFAULT FIRST 'TO' SEQ NR                   
         LW,P2    NXINSRT           DEFAULT LAST 'TO' SEQ NR                    
         LI,X1    7                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF 1ST 'TO' SEQ # IN CDT           
         BEZ      MVE15             B IF 'TO' SEQ NRS NOT SPECIFIED             
         LW,P1    *CDTADR,X2        SET P1=FIRST 'TO' SEQ #                     
         AI,X2    1                     P2=LAST 'TO' SEQ #                      
         LW,P2    *CDTADR,X2                                                    
MVE15    RES      0                                                             
         LW,P3    DFLTINCR          SET P3=LAST INCR USED                       
         LI,X1    8                                                             
         LB,R1    *CDTADR,X1        GET PARAM3 TYPE                             
         BEZ      MVE20             TEST IF PARAM3 PRESENT                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET P3=INCR FROM CDT                  
         LW,P3    *CDTADR,X2                                                    
         STW,P3   DFLTINCR          SET NEW DEFAULT INCR                        
*                                                                               
*  CHECK FOR OVERLAPPING SEQ #'S AND SET UP MOVE                                
*                                                                               
MVE20    LW,D0    T1                PUT 'FROM' SEQ #'S IN DW                    
         LW,D1    T2                                                            
         CLM,P1   D0                MAKE SURE 'TO' AND 'FROM' RANGES            
         BIL      MVE50              ARE MUTUALLY EXCLUSIVE                     
         CLM,P2   D0                                                            
         BIL      MVE50                                                         
         LW,D0     P1                                                           
         LW,D1     P2                                                           
       CLM,T1    D0                                                             
       BIL       MVE50                                                          
       CLM,T2    D0                                                             
       BIL       MVE50                                                          
         XW,T1    P1                EXCHANGE FIRST 'FROM' AND 'TO'              
       BAL,LNK    READNXTRANDOM     CHECK 'FROM' RANGE                          
         XW,T1    P1               RESTORE                                      
         CW,R1    L(EOF)       M    IF RECORD READ WAS AN EOF,                  
         BE       MVE58                                                         
         CW,R1    T2                OR SEQUENCE GREATER THAN SECOND             
         BG       MVE58             'FROM', NOTHING TO MOVE                     
         BAL,LNK  DELETE            DELETE 'TO' RECORDS                         
         BCS,8    %+2               WAS LAST 'TO' SEQ # HIT BY DELETE           
         BAL,LNK  READSEQUEN        YES - READ NEXT RECORD                      
         LW,X3    R1                SET X3=SEQ # AT WHICH TO STOP MOVE          
         XW,P1    T1                                                            
         BAL,LNK  READNXTRANDOM     READ 1ST 'FROM' REC OR NEXT HIGHEST         
         LW,P1    T1                SET P1=NEW FIRST 'TO' SEQ NR                
*                                                                               
*  READ EACH 'FROM' RECORD AND WRITE UNDER 'TO' SEQ #                           
*                                                                               
MVE30    CW,R1    L(EOF)            WAS AN EOF READ                             
         BE       MVE53             YES - GO TYPE ERROR MESSAGE                 
         CW,T2    R1                WAS 'FROM' SEQ # >= LAST 'FROM' SEQ         
         BL       MVE40             B IF PAST LAST 'FROM' SEQ NR                
         CW,P1    X3                IS NEW 'TO' SEQ # > SEQ # TO STOP AT        
         BGE      MVE56             YES - GO TYPE ERROR MESSAGE                 
         STW,R1   LASTFROM                                                      
         B        %+1,X4            DELETE 'FROM' RECORD AS REQD                
         BAL,LNK  DELETERECORD                                                  
         MTW,1     MVD:REC:CNT      INCERMENT REC. COUT                         
         BAL,LNK  WRITERANDOM       WRITE RECORD WITH NEW 'TO' SEQ #            
         DO       S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         STW,P1   INTFLAG2                                                      
         FIN                                                                    
         MTW,0    SETFLAG                                                       
         BNEZ     %+3               B IF START OF SE RANGE ALREADY SET          
         MTW,1    SETFLAG           TURN ON SE MODE                             
         STW,P1   SV1STSET          START OF SE RANGE IS FIRST MOVED            
*                                   LINE                                        
         STW,P1   LASTSET           END OF SE RANGE IS LAST                     
*                                   MOVED LINE                                  
         AW,P1    P3                NEXT 'TO' SEQ NR                            
         STW,P1   NXINSRT           DEFAULT NEXT INSERTION LINE                 
         CW,T2    R1                                                            
         BE       MVE40             B IF EQUAL TO LAST 'FROM'SEQ NR             
         XW,P1    LASTFROM          MUST REREAD LAST 'FROM' RECORD TO           
         BAL,LNK  READRANDOM         GET DCB BACK IN SEQ                        
         XW,P1    LASTFROM          RESTORE P1 AND LASTFROM                     
         BAL,LNK  READSEQUEN        READ NEXT 'FROM' RECORD                     
         B        MVE30             LOOP                                        
*                                                                               
*  LAST 'FROM' SEQ # HIT OR PASSED: FINISH UP                                   
*                                                                               
*                                                                               
*  TYPE OUT LAST 'TO' SEQ # AND EXIT                                            
*                                                                               
MVE40    RES      0                 BUILD MSG: '--DONE AT DD.D'+NL              
         SW,P1    P3                POINT TO LAST LINE MOVED                    
         MOVEMSG,P2  MVEMSG1,X4                                                 
         LI,P2    BA(MSGBUF)+11                                                 
         BAL,LNK  MOVESEQ            FROM LAST 'TO' SEQ #                       
         GEN4     0,0,0,0                                                       
         AI,R1    10                ADJ CNT OF TEXTC-STRING                     
         STB,R1   MSGBUF                                                        
         BAL,LNK  TYPEMSG           TYPE MSG                                    
         DATA     MSGBUF                                                        
         MOVEMSG,P2  MSG7,X4                                                    
         LI,P2    BA(MSGBUF)+1                                                  
         LW,P1     MVD:REC:CNT      GET THE NUMBER OF REC.S MOVED               
         BAL,LNK   BINTODEC         CONVERT IT, STUFF IT AWAY                   
         BAL,LNK   TYPEMSG          AND PRINT IT OUT.                           
         DATA     MSGBUF                                                        
         B        *R:LNK            EXIT                                        
*                                                                               
*  ERROR: SEQ #'S OVERLAP                                                       
*                                                                               
MVE50    BAL,LNK  TYPEMSG           TYPE; '-RNG OVERLAP'                        
         DATA     ERRM4                                                         
         B        *R:LNK            EXIT                                        
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
MVE53    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        MVE40             GO EXIT                                     
*                                                                               
*  ERROR: 'TO' SEQ # HIT NEXT UNDELETED RECORD                                  
*                                                                               
MVE56    SW,P1    P3                ADJ P1 TO LAST 'TO' SEQ #                   
         MOVEMSG,P2  MVEMSG2,X4                                                 
         LI,P2    BA(MSGBUF)+13     BUILD MSG: '--CUTOFF AT DDD.D ('            
         BAL,LNK  MOVESEQ            WITH LAST 'TO' SEQ #                       
         GEN4     BL,LP,0,0                                                     
         AW,P2    R1                INCR MSG BYTE ADDR                          
         AI,R1    12                CALC AND SAVE MSG LENGTH                    
         LW,T1    R1                                                            
         LW,P1    LASTFROM          BUILD: 'DD.DD)' + NL  FROM LAST             
         BAL,LNK  MOVESEQ            'FROM' SEQ #                               
         GEN4     RP,0,0,0                                                      
         AW,T1    R1                ADJ CNT OF TEXTC-STRING                     
         STB,T1   MSGBUF                                                        
         BAL,LNK  TYPEMSG           TYPE: '--CUTOFF AT DDD.D (DD.DD)' +         
         DATA     MSGBUF                                                        
         B        *R:LNK            EXIT                                        
*                                                                               
MVE58    BAL,LNK  TYPEMSG                                                       
         DATA     ERRM16                                                        
         B        *R:LNK                                                        
         PAGE                                                                   
******************************                                                  
*  RECORD COMMAND: RENUMBER  *                                                  
******************************                                                  
*                                                                               
*                                                                               
R:RENUMBER        EQU %                                                         
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        SET P1=OLD SEQ #                            
         LW,P1    *CDTADR,X2                                                    
         LI,X1    7                                                             
         LB,X2    *CDTADR,X1        SET T1=NEW SEQ #                            
         LW,T1    *CDTADR,X2                                                    
         BAL,LNK  READRANDOM        READ OLD RECORD                             
         BCS,8    RNM10             DID IT EXIST                                
         LW,P1    T1                YES - SET P1=NEW SEQ #                      
         BAL,LNK  WRITENEWRANDOM    WRITE RECORD UNDER NEW SEQ #                
         BCS,8    RNM13             DID THIS SEQ # ALREADY EXIST                
         BAL,LNK  DELETERECORD      NO - DELETE OLD RECORD                      
         B        *R:LNK            EXIT                                        
*                                                                               
*  ERROR: OLD RECORD DOESN'T EXIST                                              
*                                                                               
RNM10    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH REC'                     
         DATA     ERRP1                                                         
         B        *R:LNK            EXIT                                        
*                                                                               
*  ERROR: NEW RECORD ALREADY EXISTS                                             
*                                                                               
RNM13    BAL,LNK  TYPEMSG           TYPE: '-P2:REC EXISTS'                      
         DATA     ERRP2                                                         
         B        *R:LNK            EXIT                                        
         PAGE                                                                   
**********************************************                                  
*  RECORD COMMANDS: SET AND STEP (AND TYPE)  *                                  
**********************************************                                  
*                                                                               
*                                                                               
R:SET%STEP        EQU %                                                         
         LI,X1    1                 USE STEPFLAG=1 FOR 'SS'                     
         B        R:SET%STEP%TYPE+1                                             
*                                                                               
*                                                                               
R:SET%STEP%TYPE   EQU %                                                         
         LI,X1    -1                USE STEPFLAG=-1 FOR 'ST'                    
         MTW,0    GOSEQ                                                         
         BGEZ     EXC30             B IF IN GO MODE (ERROR)                     
         STW,X1   STEPFLAG          TURN ON 'SET AND STEP MODE' FLAGS           
         STW,X1   SETFLAG                                                       
         LI,X1    5                 GET STARTING SEQ # FROM CDT                 
         LB,X2    *CDTADR,X1                                                    
         LW,P1    *CDTADR,X2                                                    
         LI,X1    6                                                             
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS                        
         BAL,LNK   READNXTRANDOM                                                
         STW,R1    P1               PUT FIRST REC. NO. IN P1.                   
         STW,R1    FIRSTSET         NO , SO USE THE FIRST RECORD                
         B         FINISH%STEP%LOOP NUMBER FOUND THAT IS HIGHER                 
*                                   THAN THE INPUT RECORD NO.                   
*                                                                               
*  NULL COMMAND OR ERROR: TURN OFF 'SET MODE' AND 'STEP MODE' FLAGS             
*                                                                               
STP10    LI,T1    0                 TURN OFF MODE FLAGS                         
         STW,T1   SETFLAG                                                       
         STW,T1   STEPFLAG                                                      
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*                                                                               
*                                                                               
STEP%LOOP         EQU %             (EXC ENTERS HERE AT 'END OF CDT')           
         MTW,-1   NOCHGFLG          WAS INPUT A 'NO' COMMAND                    
         BEZ      SPL10             YES - SKIP WRITE                            
         LW,P1    FIRSTSET          WRITE CURRENT RECORD                        
         BAL,LNK  WRITERANDOM                                                   
         MTW,0    TTYIMGSZ          WAS INPUT A NULL COMMAND                    
         BEZ      STP10             YES - GO EXIT                               
*                                                                               
*  READ NEXT INPUT RECORD AND TYPE AS REQUIRED                                  
*                                                                               
SPL10    BAL,LNK  READSEQUEN        READ NEXT RECORD                            
         CW,R1    L(EOF)            WAS IT AN EOF                               
         BE       SPL20             YES - ERROR                                 
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #                         
         LW,P1    FIRSTSET                                                      
*                                                                               
*                                                                               
*                                                                               
FINISH%STEP%LOOP  EQU %             ('JU' ENTERS HERE TO FINISH)                
         BAL,LNK  SETEOD            SET EOD MARKER                              
         LI,T1    0                                                             
         STW,T1   NOCHGFLG          FLAG: DONT SUPPRESS REWRITE                 
         MTW,0    STEPFLAG                                                      
         BGZ      SPL15             WAS 'ST' CMND USED                          
         BAL,LNK  TYPECARD          YES - TYPE CARD IMAGE                       
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  'SS' COMMAND USED: JUST TYPE SEQ #                                           
*                                                                               
SPL15    BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD:'                           
         GEN4     EOM,0,0,0                                                     
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
SPL20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        STP10             GO EXIT                                     
         PAGE                                                                   
*****************************************************                           
*  RECORD COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)  *                           
*****************************************************                           
*                                                                               
R:TYPE%COMPRESSED EQU %                                                         
*                                                                               
R:TYPE   EQU      %                                                             
         LI,X4    1                 USE X4=1 FOR 'TY'                           
         B        R:TYPE%SUP%SEQ+1                                              
*                                                                               
*                                                                               
R:TYPE%SUP%SEQ    EQU %                                                         
         LI,X4    0                 USE X4=0 FOR 'TS'                           
         LI,X1     1                                                            
         STW,X1    SETFLAG          SET THE SETFLAG TO ONE                      
*                                   THE RANGE FROM TY IS USED FOR               
*                                   AN SE COMMAND.                              
         LI,R2    0                 START COUNT OF RECORDS OUTPUT.              
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ % IN CDT              
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #                          
         AI,X2    1                     P2=LAST SEQ #                           
         LW,P2    *CDTADR,X2                                                    
         STW,P2    LASTSET          SAVE ENDING SEQ #                           
         AI,X1    1                 SET UP COL. NUMBERS                         
         BAL,LNK  PROCESSCOL#PAIR                                               
         DO       MODE=2                                                        
         LW,X1    FRSTCLMN          MUST EXPAND TABS, IF                        
         BNEZ     TYP5                                                          
         LW,X1    LASTCLMN          COL. NO. SPECIFIED, OR                      
         CI,X1    MAXCLMN                                                       
         BL       TYP5                                                          
         LI,X1    1                                                             
         LB,X1    *CDTADR,X1                                                    
         CI,X1    R:TY%CMND%NMR     'TC'                                        
         BG       TYP5                                                          
         MTW,1    TABXFLAG                                                      
         B        %+1,X4                                                        
         B        TYP5                                                          
         LI,D1    9                 OFFSET FOR SEQ                              
TYP5     RES      0                                                             
         FIN                                                                    
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST            
         STW,R1    SV1STSET         SET UP FIRST RECORD NO.                     
         STW,R1    FIRSTSET         AS IF A SET COMMAND WERE GIVIN.             
*                                                                               
*  READ AND TYPE UNTIL LAST SEQ # READ OR PASSED                                
*                                                                               
TYP10    CW,R1    L(EOF)            WAS IT AN EOF                               
         BE       TYP20             YES - GO TYPE ERROR MESSAGE                 
         CW,P2    R1                WAS INPUT SEQ # >= LAST SEQ #               
         BLE      TYP15             YES - FINISH UP                             
         LW,P1    R1                                                            
         B        %+1,X4            SET TO TYPE SEQ # AS REQD                   
         LI,P1    -1                                                            
         BAL,LNK  TYP40                                                         
         BAL,LNK  SETEOD            SET EOD MARKER                              
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITH INPUT SEQ #            
         AI,R2    1                                                             
         BAL,LNK  READSEQUEN        READ NEXT RECORD                            
         B        TYP10             LOOP                                        
*                                                                               
*  LAST SEQ # HIT OR PASSED: FINISH UP                                          
*                                                                               
TYP15    BL       TYP17             WAS LAST SEQ # PASSED                       
         LW,P1    R1                NO, WAS HIT - PREPARE TO TYPE CARD          
         B        %+1,X4            SET TO TYPE SEQ # AS REQD                   
         LI,P1    -1                                                            
         BAL,LNK  TYP40                                                         
         BAL,LNK  SETEOD            SET EOD MARKER                              
         BAL,LNK  TYPECARD          TYPE CARD IMAGE                             
         AI,R2    1                                                             
TYP17    AI,R2    0                 CHECK OUTPUT COUNT                          
         BLEZ     TYP25                                                         
         B        TYP90                                                         
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
TYP20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        TYP90                                                         
*                                                                               
TYP25    BAL,LNK  TYPEMSG           TYPE: '--NONE'                              
         DATA     ERRM22            RNG EMPTY                                   
         B        TYP90                                                         
*                                                                               
*                                                                               
TYP40    LW,X1    FRSTCLMN          ADJUST THE IMAGE FOR COLUMN BOUNDS          
         BEZ      TYP50             OR COMPRESSION.                             
         LI,X2    0                 MOVE (FIRSTCLMN,LASTCLMN-1), DOWN TO        
TYP42    LB,R0    CARDIMG,X1        ZERO.                                       
         STB,R0   CARDIMG,X2                                                    
         AI,X2    1                 INCREMENT DEST. COL. #                      
         AI,X1    1                 INCREMENT TO NEXT BYTE.                     
         CW,X1    LASTCLMN          CHECK IF DONE.                              
         BGE      TYP45             YES                                         
         B        TYP42                                                         
TYP45    STW,X2   X1                                                            
         B        %+2               SET FINISH COULUMN FOR NEXT ROUTINE         
TYP50    LW,X1    LASTCLMN          IF LESS THAN FULL IMAGE DESIRED,            
         STW,X1   D0                SAVE TERMINAL POSITION FOR COMPRESS         
         CI,X1    MAXCLMN                                                       
         BGE      TYP60                                                         
         LI,X2    ' '               BLANK OUT REGION                            
TYP55    STB,X2   CARDIMG,X1        (LASTCLMN,MAXCLMN-1)                        
         AI,X1    1                                                             
         CI,X1    MAXCLMN-1                                                     
         BLE      TYP55                                                         
*                                                                               
TYP60    LI,X1    1                 FINALLY CHECK FOR COMPRESSION .             
         LB,X2    *CDTADR,X1                                                    
         CI,X2    R:TY%CMND%NMR                                                 
         BG       TYP70             YES.  OTHERWISE,                            
*                                                                               
TYP65    B        0,LNK             EXIT                                        
*                                                                               
*                                                                               
TYP70    LI,X1    0                 IN RANGE (0,LASTCLMN) COMPRESS              
         LI,R0    ' '               BLANK STRINGS TO LENGTH ONE.                
         LI,X2    0                                                             
TYP72    CB,R0    CARDIMG,X2        CHECK FOR BLANK IN CURRENT POSITION-        
         BE       TYP80             IF NOT,                                     
TYP75    LB,D1    CARDIMG,X2        MOVE NON-BLANK STRING DOWN.                 
         STB,R0   CARDIMG,X2        BLANKING VACATED POSITIONS.                 
         STB,D1   CARDIMG,X1                                                    
         AI,X1    1                 INCREMENT TO AND                            
         AI,X2    1                 FROM BYTE POINTERS.                         
         CW,X2    D0                IF AT UPPRR LIMIT-                          
         BL       TYP72                                                         
         B        0,LNK             THEN RETURN                                 
*                                                                               
*                                                                               
TYP80    AI,X1    1                 INCREMENT 'TO' POINTER TO LEAVE THIS        
TYP82    AI,X2    1                 BLANK.  SKIP TO NON-BLANK.                  
         CW,X2    D0                                                            
         BGE      0,LNK                                                         
         CB,R0    CARDIMG,X2                                                    
         BE       TYP82                                                         
         B        TYP75             MOVE NEXT STRING DOWN.                      
TYP90    RES      0                                                             
         B        *R:LNK                                                        
         PAGE                                                                   
*                                                                               
**********************************************************                      
*        RECORD COMMANDS:  GO TO LINE FOR COMMANDS                              
*                           RETURN TO M:SI FOR COMMANDS                         
**********************************************************                      
*                                                                               
R:RET    RES      0                                                             
         LI,T1    -1                                                            
         B        GORET                                                         
R:GO     RES      0                                                             
         LI,X1    5                                                             
         LB,X1    *CDTADR,X1        GET POINTER TO SEQ NR                       
         LW,T1    *CDTADR,X1        GET SEQ NR                                  
GORET    RES      0                                                             
         STW,T1   GOSEQ             SET IT                                      
         MTW,0    SETFLAG                                                       
         BGEZ     *R:LNK            RETURN IF NOT IN SET LOOP                   
         LW,P1    FIRSTSET                                                      
         B        STL1              B TO CLEAN UP SET LOOP                      
         PAGE                                                                   
****************************                                                    
*  INTRALINE COMMAND: SET  *                                                    
****************************                                                    
*                                                                               
*                                                                               
I:SET    EQU      %                                                             
         LI,T1    1                 TURN 'SET MODE' FLAG ON                     
         STW,T1   SETFLAG                                                       
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ # IN CDT              
         BNEZ     SET03             B IF SPECIFIED                              
         LI,P1    0                 DEFAULT FIRST LINE NR                       
         LW,P2    L(9999999)        DEFAULT LAST LINE NR                        
         B        SET06                                                         
*                                                                               
SET03    RES      0                                                             
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #                          
         AI,X2    1                     P2=LAST SEQ #                           
         LW,P2    *CDTADR,X2                                                    
SET06    RES      0                                                             
         STW,P1   SV1STSET          START OF SE RANGE                           
         STW,P2   LASTSET                                                       
         LI,X1    6                                                             
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS                        
         LW,X1    CDTADR            CALC X1=ADDR IN CDT OF NEXT COMMAND         
         LB,R1    *CDTADR            AFTER 'SE'                                 
         AW,X1    R1                                                            
         STW,X1   SETADR            PUT THIS IN SETADR FOR I:CMND LOOP          
         BAL,LNK   READNXTRANDOM READ FIRST RECORD IN RANGE.                    
         STW,R1    P1                                                           
         CW,R1     LASTSET          MAKE SURE THAT THE FIRST RECORD IS          
         BLE       SET10            IN TH P1-P2 RANGE.                          
         BAL,LNK  TYPEMSG           NO - TYPE: '-P1:NO SUCH REC'                
         DATA     ERRM22            RNG EMPTY                                   
         LI,T1    0                 TURN OFF 'SET MODE' FLAG                    
         STW,T1   NOCHGFLG          FLAG: DONT SUPPRESS REWRITE                 
         STW,T1   SETFLAG                                                       
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  SET EOD MARKER AND EXIT                                                      
*                                                                               
SET10    BAL,LNK  SETEOD            SET EOD MARKER                              
         B        *I:LNK            EXIT                                        
*                                                                               
*                                                                               
*                                                                               
SET%LOOP EQU      %                 (EXC ENTERS HERE AT 'END OF CDT')           
         MTW,0    SETFLAG           HAS ANY INTRALINE CMND BUT 'SE'             
         BGZ      MASTERPARSER1     EXIT TO PARSER                              
         LW,P1    FIRSTSET          YES - HAS LAST RECORD IN RANGE OF           
         CW,P1    LASTSET            I:SET BEEN PROCESSED                       
         BNE      STL10             NO - GO PROCESS MORE                        
STL1     RES      0                                                             
         MTW,-1   NOCHGFLG                                                      
         BEZ      %+2               B IF MUST SUPPRESS REWRITE                  
         BAL,LNK  WRITERANDOM       YES - WRITE LAST RECORD                     
         DO1      S(0,1,1)                                                      
         STW,P1   INTFLAG1                                                      
*                                                                               
*  AT END OF SET LOOP: MARK SETFLAG SO LOOP WILL BE RESTARTED IF                
*  ANOTHER I:CMND IS GIVEN                                                      
*                                                                               
STL5     RES      0                                                             
         LW,P1     CHG:STG:CNT      GET THE NO. OF STRINGS CHANGED              
         CI,P1     1                CHECK FOR ONLY 1 HIT.                       
         BLE      STL30             B IF 1 OR NONE                              
         MOVEMSG,P2  MSG8,X2                                                    
         LI,P2    BA(MSGBUF)+1                                                  
         BAL,LNK   BINTODEC                                                     
         BAL,LNK   TYPEMSG                                                      
         DATA     MSGBUF                                                        
STL30    EQU       %                                                            
         LW,P1    DEL:REC:CNT                                                   
         BEZ      STL35             B IF NO DELETIONS                           
         MOVEMSG,P2  MSG6,X2                                                    
         LI,P2    BA(MSGBUF)+1                                                  
         BAL,LNK  BINTODEC          CONVERT DELETION COUNT                      
         BAL,LNK  TYPEMSG           OUTPUT MESSAGE                              
         DATA     MSGBUF                                                        
STL35    RES      0                                                             
         LI,P1     0                CLEAR THE CHANGED STRING COUNT              
         STW,P1    CHG:STG:CNT                                                  
         STW,P1   DEL:REC:CNT       AND DELETED RECORD COUNT                    
         LI,T1    1                                                             
         STW,T1   SETFLAG            NEXT I:CMND                                
         B        MASTERPARSER1     EXIT TO PARSER                              
*                                                                               
*  MORE RECORDS ARE LEFT IN RANGE OF LAST I:SET TO BE PROCESSED                 
*                                                                               
STL10    RES      0                                                             
         MTW,-1   NOCHGFLG                                                      
         BEZ      %+2               B IF MUST SUPPRESS REWRITE                  
         BAL,LNK  WRITERANDOM                                                   
         DO1      S(0,1,1)                                                      
         STW,P1   INTFLAG1                                                      
         BAL,LNK  READSEQUEN        READ NEXT RECORD                            
         CW,R1    L(EOF)            WAS IT AN EOF                               
         BE       STL20             YES - ERROR                                 
         CW,R1    LASTSET           IS INPUT SEQ # > SEQ # TO STOP AT           
         BG       STL5              YES - GO EXIT                               
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #                         
         LI,T1    0                                                             
         STW,T1   NOCHGFLG          FLAG: DONT SUPPRESS REWRITE                 
         LI,T1    -2                SUPPRESS CERRS FOR  LOOPS                   
         STW,T1   ERRORCNT          TWO AND FF.                                 
         LW,T1    SETADR            SET CDTADR BACK TO BEGINNING OF LOOP        
         STW,T1   CDTADR                                                        
         BAL,LNK  SETEOD            SET EOD MARKER                              
         LW,T1    SVBPFLAG           REATORE LAST DFLT VALUE                    
         STW,T1   BPFLAG            OF BPFLAG FOR NEXT ITRATION                 
         B        RESTART%EXECUTIVE GO RESTART I:CMND LOOP                      
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
STL20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        STL5              GO EXIT                                     
         PAGE                                                                   
***********************************                                             
*  INTRALINE COMMAND: 'DELETE' X  *                                             
***********************************                                             
*                                                                               
*                                                                               
I:DELETE EQU      %                                                             
*                                                                               
*        IT IS AN ERROR TO DELETE ALL BLANKS IF BP IS OFF                       
*                                                                               
         MTW,0     ALLFLAG          SEE IF ALL FLAG IS SET.                     
         BLZ       I:DELETE01                                                   
         MTW,0    BPFLAG                                                        
         BNEZ     I:DELETE01        B IF BP ON (DELETE BLANKS OK)               
         LB,X1     *TEXTCADR        GET THE CHARACTER COUNT.                    
I:DELETE02 LB,P2   *TEXTCADR,X1     SERACH THE STRING FOR ANY                   
         CI,P2     X'40'            NON BLANK CHARACTER.                        
         BNE       I:DELETE01       CONTINUE                                    
         BDR,X1    I:DELETE02                                                   
         BAL,LNK   TYPEMSG          ALL BLANKS MESSAGE                          
         DATA      ERRM21                                                       
         B         MASTERPARSER                                                 
I:DELETE01    EQU  %                                                            
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AW,P1    P2                SET P1=CHAR AFTER PARAM STRING              
         LW,P3    P2                    P2=0 (FIELD WIDTH)                      
         LI,P2    0                     P3=# TO SHIFT (=LENGTH OF STRG)         
         BAL,LNK  SHIFTLEFT         SHIFT LEFT TO DELETE STRING                 
         SW,P1    P3                IF ALLFLAG IS ON, SET TO RESUME             
         BAL,LNK  ADJUSTALLFLAG      MATCHING AFTER X AS DELETED                
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         LW,T1    ALLFLAG                                                       
         CW,T1    EODCLMN                                                       
         BLE      *I:LNK            EXIT IF NOT ALL MODE PAST EOD               
         LI,T1    -1                                                            
         STW,T1   ALLFLAG           RESET ALL MODE                              
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
******************************************************                          
*  INTRALINE COMMAND: 'OVERWRITE AND EXTEND' X BY Y  *                          
******************************************************                          
*                                                                               
*                                                                               
I:OVERWR%EXTEND   EQU %                                                         
         STW,I:LNK ALLOK                                                        
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK                                                        
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,P2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT               
         AW,P2    CDTADR            SET P2=ABSOLUTE ADDR OF STRING              
         BAL,LNK  MOVESTRING        OVERWRITE WITH NEW STRING                   
         LB,T1    *P2               SET P1=COL. AFTER LAST NEW CHAR             
         AW,P1    T1                                                            
         LI,T1    ' '                                                           
*                                                                               
*  BLANK OUT REST OF CARD IMAGE                                                 
*                                                                               
OEX10    CW,P1    LASTCLMN          BLANK OUT BUFFER FROM CHAR AFTER            
         BGE      OEX20              LAST NEW CHAR TO COL. TO STOP AT           
         STB,T1   CARDIMG,P1                                                    
         AI,P1    1                                                             
         B        OEX10                                                         
*                                                                               
*  SET EOD AND EXIT                                                             
*                                                                               
OEX20    BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
****************************************                                        
*  INTRALINE COMMAND: 'FOLLOW' X BY Y  *                                        
****************************************                                        
*                                                                               
*                                                                               
I:FOLLOW%BY       EQU %                                                         
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AW,P1    P2                SET P1=CHAR AFTER PARAM STRING              
         LI,P2    0                     P2=0 (FIELD WIDTH)                      
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT               
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING              
         LB,P3    *X2                   P3=LENGTH OF STRING                     
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND            
         LW,P2    X2                 STRING                                     
         BAL,LNK  MOVESTRING        MOVE STRING INTO HOLE                       
         AW,P1    P3                IF ALLFLAG IS ON, SET TO RESUME             
         BAL,LNK  ADJUSTALLFLAG      MATCHING AFTER Y AS ADDED                  
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
********************************************                                    
*  INTRALINE COMMAND: SHIFT X 'LEFT' BY N  *                                    
********************************************                                    
*                                                                               
*                                                                               
I:SHIFT%LEFT      EQU %                                                         
         STW,I:LNK ALLOK                                                        
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF N IN CDT                        
         LW,P3    *CDTADR,X2        SET P3=NUMBER TO SHIFT (N)                  
         BEZ      *I:LNK            IF N=0 - EXIT                               
         BAL,LNK  SHIFTLEFT         SHIFT LEFT N SPACES                         
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
*******************************************                                     
*  INTRALINE COMMAND: 'OVERWRITE' X BY Y  *                                     
*******************************************                                     
*                                                                               
*                                                                               
I:OVERWRITE       EQU %                                                         
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,P2    *CDTADR,X1        GET ADR OF 2ND STRING IN CDT                
         AW,P2    CDTADR            CALC P2=ABSOLUTE ADDR OF STRING             
         BAL,LNK  MOVESTRING        OVERWRITE WITH NEW STRING                   
         LB,X1    *P2               IF ALLFLAG IS ON, SET TO RESUME             
         AW,P1    X1                 MATCHING AFTER Y AS OVERWRITTEN            
         BAL,LNK  ADJUSTALLFLAG                                                 
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
*****************************************                                       
*  INTRALINE COMMAND: 'PRECEDE' X BY Y  *                                       
*****************************************                                       
*                                                                               
*                                                                               
I:PRECEDE%BY      EQU %                                                         
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT               
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING              
         LB,P3    *X2                   P3=LENGTH OF STRING                     
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND            
         XW,P2    X2                 STRING                                     
         BAL,LNK  MOVESTRING        MOVE STRING INTO HOLE                       
         AW,P1    X2                IF ALLFLAG IS ON, SET TO RESUME             
         AW,P1    P3                 MATCHING AFTER X AS PRECEDED BY Y          
         BAL,LNK  ADJUSTALLFLAG                                                 
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
*********************************************                                   
*  INTRALINE COMMAND: SHIFT X 'RIGHT' BY N  *                                   
*********************************************                                   
*                                                                               
*                                                                               
I:SHIFT%RIGHT     EQU %                                                         
         STW,I:LNK ALLOK                                                        
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE - FOUND ERROR                          
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF N IN CDT                        
         LW,P3    *CDTADR,X2        SET P3=NUMBER TO SHIFT (N)                  
         BEZ      *I:LNK            IF N=0 - EXIT                               
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT N SPACES                        
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
*********************************************                                   
*  INTRALINE COMMAND: FOR X 'SUBSTITUTE' Y  *                                   
*********************************************                                   
*                                                                               
*                                                                               
I:SUBSTITUTE      EQU %                                                         
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM           
         BCS,8    *I:LNK            NONE FOUND - EXIT                           
         MTW,1    CHG:STG:CNT                                                   
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT               
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING              
         LB,P3    *X2                   P3=LENGTH OF STRING                     
         LW,T1    P1                SAVE P1                                     
         AW,P1    P2                SET P1=CHAR AFTER PARAM1 STRING             
         SW,P3    P2                CALC NUMBER TO SHIFT IN P3                  
         BLEZ     SBS10             IS NEW STRING LONGER THAN OLD STRING        
         LI,P2    0                 YES - SET P2=0 (FIELD WIDTH)                
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT AMOUNT OF DIFFERENCE            
         B        SBS15             GO TO MOVE IN NEW STRING                    
*                                                                               
*  NEW STRING SHORTER OR EQUAL THAN OLD ONE                                     
*                                                                               
SBS10    BE       SBS15             ARE NEW AND OLD STRINGS OF = LENGTH         
         LCW,P3   P3                NO - NEW SHORTER                            
         LI,P2    0                 SET P2=0 (FIELD WIDTH)                      
         BAL,LNK  SHIFTLEFT         SHIFT LEFT AMOUNT OF DIFFERENCE             
*                                                                               
*  MOVE NEW STRING INTO POSITION                                                
*                                                                               
SBS15    LW,P1    T1                SET P1=COL. OF PARAM1 STRING                
         LW,P2    X2                    P2=ADDR OF NEW STRING                   
         BAL,LNK  MOVESTRING        MOVE NEW STRING IN PLACE                    
         LB,T1    *P2               IF ALLFLAG IS ON, SET TO RESUME             
         AW,P1    T1                 MATCHING AFTER Y AS SUBSTITUTED            
         BAL,LNK  ADJUSTALLFLAG                                                 
         BAL,LNK  SETEOD            RESET EOD MARKER                            
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
*****************************                                                   
*  INTRALINE COMMAND: JUMP  *                                                   
*****************************                                                   
*                                                                               
*                                                                               
I:JUMP   EQU      %                                                             
         MTW,0    STEPFLAG          IS SYSTEM IN 'STEP MODE'                    
         BEZ      JMP10             NO - ERROR                                  
         LW,P1    FIRSTSET                                                      
         BAL,LNK  WRITERANDOM       WRITE CURRENT RECORD                        
         LI,X1    5                 GET SEQ # FOR JUMP FROM CDT                 
         LB,X2    *CDTADR,X1                                                    
         LW,P1    *CDTADR,X2                                                    
         BAL,LNK  READRANDOM        READ THIS RECORD                            
         BCS,8    JMP15             DID IT EXIST                                
         STW,P1   FIRSTSET          SAVE NEW SEQ #                              
         B        FINISH%STEP%LOOP  YES - GO FINISH JUMP                        
*                                                                               
*  ERROR: 'JU' ILLEGAL AT THIS POINT                                            
*                                                                               
JMP10    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'                  
         DATA     ERRC4                                                         
         B        *I:LNK            EXIT                                        
*                                                                               
*  ERROR: RECORD TO JUMP TO DOESN'T EXIST                                       
*                                                                               
JMP15    BAL,LNK  TYPECERR          TYPE: '-CN:NO SUCH REC'                     
         DATA     ERRC3                                                         
         LW,P1    FIRSTSET                                                      
         BAL,LNK  READRANDOM        RESTORE OLD RECORD                          
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
**********************************                                              
*  INTRALINE COMMAND: NO CHANGE  *                                              
**********************************                                              
*                                                                               
*                                                                               
I:NO%CHANGE       EQU %                                                         
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE                      
         BEZ      NCG10             NO - ERROR                                  
         LI,T1    1                                                             
         STW,T1   NOCHGFLG          TURN ON 'NO CHANGE' FLAG                    
         B        *I:LNK            EXIT                                        
*                                                                               
*  ERROR: 'NO' ILLEGAL AT THIS POINT                                            
*                                                                               
NCG10    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'                  
         DATA     ERRC4                                                         
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
********************************************************                        
*  INTRALINE COMMAND: REVERSE BLANK PRESERVATION FLAG  *                        
********************************************************                        
*                                                                               
*                                                                               
I:REVERSE%BPFLAG  EQU %                                                         
         LW,T1    BPFLAG            REVERSE BPFLAG                              
         EOR,T1   K1                                                            
         STW,T1   BPFLAG                                                        
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
********************************************************                        
*  INTRALINE COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)  *                        
********************************************************                        
*                                                                               
*                                                                               
I:TYPE   EQU      %                                                             
         LW,P1    FIRSTSET          GET SEQ #                                   
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITH SEQ #                  
         B        *I:LNK            EXIT                                        
*                                                                               
*                                                                               
I:TYPE%SUP%SEQ    EQU %                                                         
         LI,P1    -1                                                            
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITHOUT SEQ #               
         B        *I:LNK            EXIT                                        
         PAGE                                                                   
***************************************************                             
*        INTRALINE COMMAND:  ALIGN X AT COLUMN Y  *                             
***************************************************                             
*                                                                               
*                                                                               
I:ALIGN  RES      0                                                             
         STW,I:LNK ALLOK            DONT PERMIT 'ALL OCCURRENCES'               
         BAL,LNK  FINDCOLUMN        FIND COLUMN TO ALIGN                        
         BCS,8    *I:LNK            RETURN IF NOT FOUND                         
         PUSH     P1                                                            
         BAL,LNK  FINDCOL2          FIND COLUMN TO ALIGN WITH                   
         BCS,8    *I:LNK            B IF NOT FOUND                              
         MTW,1    CHG:STG:CNT                                                   
         LW,P3    P1                                                            
         PULL     P1                                                            
         SW,P3    P1                NR OF COLUMNS DISPLACEMENT                  
         BEZ      *I:LNK            B IF NO DISPLACEMENT                        
         BLZ      %+3               B IF LEFT DISPLACEMENT                      
         BAL,LNK  SHIFTRIGHT                                                    
         B        %+3                                                           
         LCW,P3   P3                                                            
         BAL,LNK  SHIFTLEFT                                                     
         BAL,LNK  SETEOD            SET NEW EOD POINTER                         
         B        *I:LNK            RETURN                                      
         PAGE                                                                   
*                                                                               
*******************************************************************             
*        INTRALINE COMMAND:   CONTINUE IF YES (STRING FOUND)      *             
*                             CONTINUE IF NO (STRING NOT FOUND)   *             
*******************************************************************             
*                                                                               
I:YES%CONTINUE RES  0                                                           
         LI,T1    0                 FLAG:  Y                                    
         B        YORN1                                                         
I:NO%CONTINUE RES  0                                                            
         LI,T1    1                 FLAG:  N                                    
YORN1    RES      0                                                             
         STW,LNK  ALLOK             DONT PERMIT 'ALL OCCURRENCES'               
         BAL,LNK  FINDCOLUMN        FIND STRING                                 
         BCS,8    YORN3             B IF NOT FOUND                              
         CI,T1    0                                                             
         BE       *I:LNK            B IF Y TO CONTINUE                          
         B        YORN5             B IF N TO QUIT COMMAND LINE                 
YORN3    RES      0                                                             
         CI,T1    0                                                             
         BE       YORN5             B IF Y TO QUIT COMMAND LINE                 
         B        *I:LNK            B IF N TO CONTINUE                          
YORN5    RES      0                                                             
         LI,X1    1                                                             
YORN7    RES      0                                                             
         LB,X2    *CDTADR           LENGTH OF CURRENT CMND ENTRY                
         LW,R0    *CDTADR,X2        FIRST WORD OF NEXT ENTRY                    
         MTB,0    R0,X1                                                         
         BEZ      *I:LNK            B IF END OF CMND LIST                       
         AWM,X2   CDTADR            POINT TO NEXT CMND ENTRY                    
         B        YORN7                                                         
         PAGE                                                                   
*                                                                               
**************************************************                              
*        INTRALINE COMMAND: DELETE CURRENT LINE                                 
**************************************************                              
*                                                                               
I:DEL%REC  RES    0                                                             
         LW,P1    FIRSTSET                                                      
         LW,P2    P1                RANGE TO DELETE IS CURRENT REC              
         BAL,LNK  DELETE            DELETE IT                                   
         LI,T1    1                                                             
         STW,T1   NOCHGFLG          SET FLAG: DONT WRITE OUT RECORD             
         MTW,1    DEL:REC:CNT       COUNT DELETED RECORD                        
         B        *I:LNK                                                        
         PAGE                                                                   
*                                                                               
********************************************************************            
*        INTRALINE COMMAND:  COPY CURRENT RECORD TO ANOTHER LINE                
********************************************************************            
*                                                                               
I:COPY%REC  RES   0                                                             
         LI,X1    5                                                             
         LB,X1    *CDTADR,X1        GET SEQ NR POINTER                          
         BEZ      %+3               B IF NOT SPECIFIED                          
         LW,P1    *CDTADR,X1        GET SPECIFIED SEQ NR                        
         B        COPYREC2                                                      
         LW,P1    NXINSRT           GET NEXT DEFAULT INSERT SEQ NR              
         CW,P1    MAXSEQ            COMPARE WITH LIMIT SIZE                     
         BLE      COPYREC2          B IF OK                                     
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM20            SEQ NR TOO BIG                              
         LW,P1    FIRSTSET                                                      
         B        STL1              B TO QUIT LINE                              
*                                                                               
COPYREC2  RES     0                                                             
         BAL,LNK  WRITERANDOM       WRITE LINE AT NEW LOCATION                  
         AW,P1    DFLTINCR          GENERATE NEW DFLT INSERT SEQ NR             
         STW,P1   NXINSRT           SAVE IT                                     
         B        *I:LNK                                                        
*                                                                               
***************************************************                             
*        INTRALINE COMMAND:  SET COLUMN LIMITS    *                             
***************************************************                             
*                                                                               
I:COL%LIMS  RES   0                                                             
         LI,P1    0                 DEFAULT LOW LIMIT                           
         LI,P2    MAXCLMN           DEFAULT HIGH LIMIT+1                        
         LI,X1    4                                                             
         LB,X2    *CDTADR,X1                                                    
         BEZ      COLLIM10          B IF BOTH DEFAULT                           
         LI,X1    5                                                             
         LB,X2    *CDTADR,X1                                                    
         LW,P1    *CDTADR,X2        GET LOW LIMIT                               
         AI,P1    -1                IN INTERNAL FORM                            
         LI,X1    6                                                             
         LB,X2    *CDTADR,X1                                                    
         BEZ      COLLIM10          B IF HIGH LIMIT DEFAULTS                    
         LI,X1    7                                                             
         LB,X2    *CDTADR,X1                                                    
         LW,P2    *CDTADR,X2        GET HIGH LIMIT                              
COLLIM10 RES      0                                                             
         STW,P1   FRSTCLMN          SET LOW COL LIM                             
         STW,P2   LASTCLMN          SET HIGH COL LIM                            
         B        *I:LNK                                                        
         PAGE                                                                   
******************************                                                  
*  ADD NEW PARAMETER TO CDT  *                                                  
*    P1 = TYPE OF PARAMETER  *                                                  
******************************                                                  
*                                                                               
*                                                                               
ADDCDTPARAM       EQU %                                                         
         PUSH     (X1,P1)           SAVE REGS                                   
         LW,X1    PARAMPSN          BUILD CONTROL HW FOR PARAM IN CDT:          
         STB,P1   *CDTADR,X1          BYTE 0: PARAM TYPE                        
         AI,X1    1                   BYTE 1: LOC OF PARAM VALUE RELA-          
         LB,P1    *CDTADR                      TIVE TO CURRENT CDTADR           
         STB,P1   *CDTADR,X1                                                    
         MTW,2    PARAMPSN          INCR TO NEXT HW                             
         AW,P1    PRMBUFSZ          ADJUST COUNT OF # OF WORDS IN ENTRY         
         STB,P1   *CDTADR            BY SIZE OF PARAM                           
         SW,P1    PRMBUFSZ                                                      
         AW,P1    CDTADR            SET P1=ABSOLUTE ADR TO PUT VALUE AT         
         LW,X1    PRMBUFSZ                                                      
         LI,X2    0                                                             
         LW,D0    PARAMBUF,X2       MOVE PARAM VALUE TO CDT ENTRY               
         STW,D0   *P1,X2                                                        
         AI,X2    1                                                             
         BDR,X1   %-3                                                           
         LW,X1    *CDTADR           BUILD 'END OF CDT' MARKER USING             
         AND,X1   XFF00              NUMBER OF NEXT CMND IN CDT                 
         AI,X1    X'0100'                                                       
         STW,X1   *P1,X2            SET 'END OF CDT' MARKER                     
         PULL     (X1,P1)           RESTORE REGS                                
         B        0,LNK             EXIT                                        
         PAGE                                                                   
************************************                                            
*  CHECK IF ONLY ONE ENTRY IN CDT  *                                            
************************************                                            
*                                                                               
*                                                                               
CHECK1CDTENTRY    EQU %                                                         
         LW,D0    CDT               CHECK IF ONLY ONE ENTRY IN CDT              
         CI,D0    1                                                             
         BE       0,LNK             YES - EXIT                                  
         BAL,LNK  TYPECERR          NO - TYPE: '-CN: CMND ILGL HERE'            
         DATA     ERRC4                                                         
         B        MASTERPARSER      EXIT TO PARSER                              
         PAGE                                                                   
****************************************                                        
*  GET FILE IDENTIFICATION             *                                        
****************************************                                        
*                                                                               
*                                                                               
GETFILEID         EQU %                                                         
         PUSH     (X1,T1)           SAVE REGS                                   
         LI,X1    0                 USE X1 AS COUNT OF # OF WDS PUSHED          
         DO       S(1,1,0)                                                      
         NXTNAM   ERRP3,;                                                       
                  (NAME,*)                                                      
         LB,T1    PARAMBUF          ALLOW ONLY <= 31 BYTES IN FILE              
         CI,T1    31                NAME.                                       
         BLE      %+3                                                           
GF5      LI,LNK   L(ERRP3)                                                      
         B        GETNEXT%ERROR                                                 
         BAL,LNK  GF%PUSH%SUBR      PUSH 'FILE NAME' PARAM                      
         LW,T1    CHARPSN           SAVE NEXT SCAN PSN                          
         NXTNAM   ERRP4,;                                                       
                  (NAME,*),;                                                    
                  (S(LPAR,PERIOD,PERIOD),GF10),;                                
                  (SCOL,ILGL%SEMICOLON),;                                       
                  (COM,*),;                                                     
                  (END,*)                                                       
         STW,T1   CHARPSN           RESTORE TO SCAN , OR C/R AGAIN              
         LI,P2    0                                                             
         PUSH     P2                SET 'ACCT #' & 'PASSWORD' PARAMS =0         
         PUSH     P2                                                            
         AI,X1    2                 ADJ PUSH COUNT                              
         B        GF30              GO FINISH UP                                
*                                                                               
*        GET ACCOUNT NR                                                         
*                                                                               
GF10     NXTNAM   ERRP3,;                                                       
                  (NAME,GF15),;                                                 
                  (S(COM,PERIOD,PERIOD),*)                                      
         LI,P2    0                                                             
         PUSH     P2                SET 'ACCT #' PARAM = 0                      
         AI,X1    1                                                             
         B        GF18              GO PROCESS 'PASSWORD'                       
*                                                                               
*        ACCOUNT NR FOUND.  PROCESS IT                                          
*                                                                               
GF15     LB,T1    PARAMBUF          8 CHARACTERS MAX.                           
         CI,T1    8                                                             
         BG       GF5                                                           
         BAL,LNK  GF%PUSH%SUBR                                                  
         DO1      S(0,1,1)                                                      
         LW,T1    CHARPSN                                                       
         NXTNAM   ERRP3,;                                                       
                  (S(COM,PERIOD,PERIOD),GF18),;                                 
                  (S(RPAR,NAME,NAME),GF20),;                                    
                  (S(RPAR,COM,COM),GF20),;                                      
                  (S(RPAR,END,END),GF20)                                        
*                                                                               
*  PASSWORD PRESENT: GET AND PROCESS IT                                         
*                                                                               
GF18     NXTNAM   ERRP3,;                                                       
                  (NAME,*)                                                      
         LB,T1    PARAMBUF          8 CHARACTERS MAX.                           
         CI,T1    8                                                             
         BG       GF5                                                           
         BAL,LNK  GF%PUSH%SUBR      PUSH 'PASSWORD' PARAM                       
         DO1      S(0,1,1)                                                      
         LW,T1    CHARPSN                                                       
         NXTNAM   ERRP3,;                                                       
                  (S(RPAR,NAME,NAME),GF30),;                                    
                  (S(RPAR,COM,COM),GF30),;                                      
                  (S(RPAR,END,END),GF30)                                        
*                                                                               
*  NO PASSWORD PRESENT                                                          
*                                                                               
GF20     LI,P2    0                                                             
         PUSH     P2                SET 'PASSWORD' PARAM = 0                    
         AI,X1    1                                                             
         PAGE                                                                   
         ELSE                       S(1,1,0)                                    
*                                                                               
*        GET FILE NAME                                                          
*                                                                               
         NXTNAM   ERRP3,;                                                       
                  (NAME,*)                                                      
         LI,LNK   L(ERRP3)          ERROR MESSAGE IF NEEDED                     
         LB,T1    PARAMBUF          LENGTH OF STRING SCANNED                    
         CI,T1    8                                                             
         BG       GETNEXT%ERROR     B IF TOO LONG                               
         BAL,LNK  GF%PUSH%SUBR      SAVE FILE NAME STRING                       
*                                                                               
*        GET AREA NAME                                                          
*                                                                               
         LW,T1    CHARPSN           SAVE POSITION IN CASE PAST END              
         NXTNAM   ERRP4,;                                                       
                  (NAME,GF18),;                                                 
                  (COM,GF18),;                                                  
                  (END,GF18),;                                                  
                  (PERIOD,*),;                                                  
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
         LW,T1    CHARPSN           SAVE POSITION IN CASE PAST END              
         NXTNAM   ERRP3,;                                                       
                  (NAME,*),;                                                    
                  (PERIOD,GF16),;                                               
                  (COM,GF18),;                                                  
                  (END,GF18),;                                                  
                  (SCOL,ILGL%SEMICOLON)                                         
         LB,T1    PARAMBUF          GET NAME LENGTH                             
         CI,T1    2                                                             
         BNE      GF14              B IF NOT AN AREA NAME                       
         LW,T1    PARAMBUF                                                      
         SLS,T1   8                                                             
         LH,T1    T1                GET NAME RT-ALIGNED SIGN-EXTENDED           
         LB,X2    K:MDNAME          LENGTH OF AREA NAME TABLE                   
*        FIND NAME IN AREA NAME TABLE IF ITS THERE                              
GF12     RES      0                                                             
         AI,X2    -1                                                            
         BLZ      GF14              B IF NO MATCH: NOT AN AREA NAME             
         CH,T1    *K:MDNAME,X2                                                  
         BNE      GF12              B IF NOT FOUND YET                          
*        IT IS AN AREA NAME                                                     
         BAL,LNK  GF%PUSH%SUBR      SAVE THE AREA NAME                          
         B        GF20                                                          
*                                                                               
GF14     RES      0                 GOT A NAME, BUT NOT DISK AREA               
         LI,P2    0                                                             
         PUSH     P2                SAVE UNSPECIFIED AREA FLAG                  
         AI,X1    1                 COUNT THE PUSH                              
         B        GF24              PROCESS NAME AS AN ACCOUNT NAME             
*                                                                               
GF16     RES      0                 EXPLICITLY NULL AREA NAME                   
         LI,P2    0                                                             
         PUSH     P2                SAVE UNSPECIFIED AREA FLAG                  
         AI,X1    1                 COUNT THE PUSH                              
         B        GF22              GO GET NEXT ELEMENT                         
*                                                                               
GF18     RES      0                 END OF FILE ID FOUND                        
         LI,P2    0                                                             
         PUSH     P2                SAVE UNSPECIFIED AREA FLAG                  
         PUSH     P2                SAVE UNSPECIFIED ACCOUNT FLAG               
         AI,X1    2                 COUNT THE PUSHES                            
         B        GF30                                                          
*                                                                               
*        GET ACCOUNT NAME                                                       
*                                                                               
GF20     RES      0                                                             
         LW,T1    CHARPSN           SAVE POSITION IN CASE END IS HIT            
         NXTNAM   ERRP4,;                                                       
                  (NAME,GF28),;                                                 
                  (COM,GF28),;                                                  
                  (END,GF28),;                                                  
                  (PERIOD,*),;                                                  
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
GF22     RES      0                 NAME SHOULD FOLLOW                          
         LW,T1    CHARPSN           SAVE POSITION IN CASE END IS HIT            
         NXTNAM   ERRP3,;                                                       
                  (NAME,*),;                                                    
                  (PERIOD,GF26),;                                               
                  (COM,GF28),;                                                  
                  (END,GF28),;                                                  
                  (SCOL,ILGL%SEMICOLON)                                         
*                                                                               
GF24     RES      0                 GOT AN ACCOUNT NAME                         
         LI,LNK   L(ERRP3)          MESSAGE IN CASE OF ERROR                    
         LB,T1    PARAMBUF          LENGTH OF NAME                              
         CI,T1    8                                                             
         BG       GETNEXT%ERROR     B IF TOO LONG                               
         BAL,LNK  GF%PUSH%SUBR      SAVE THE ACCOUNT NAME                       
*                                                                               
GF26     RES      0                 INSURE FILE ID TERMINATES OK                
         LW,T1    CHARPSN           SAVE POSITION IN CASE END IS HIT            
         NXTNAM   ERRP4,;                                                       
                  (NAME,GF30),;                                                 
                  (COM,GF30),;                                                  
                  (END,GF30),;                                                  
                  (SCOL,ILGL%SEMICOLON)                                         
*****                                                                           
GF28     RES      0                 ACCOUNT NAME UNSPECIFIED                    
         LI,P2    0                                                             
         PUSH     P2                SAVE ACCOUNT UNSPECIFIED FLAG               
         AI,X1    1                 COUNT THE PUSH                              
*                                                                               
         FIN                        S(1,1,0)                                    
         PAGE                                                                   
*                                                                               
*  RECONSTRUCT FILE ID IN 'PARAMBUF'                                            
*                                                                               
GF30     STW,X1   PRMBUFSZ          SET # OF PARAMS = X1                        
         DO1      S(0,1,1)                                                      
         STW,T1   CHARPSN           SET TO RE-SCAN LAST POSITION                
         PULL     P2                RECONSTRUCT FID IN PARAMBUF                 
         STW,P2   PARAMBUF-1,X1                                                 
         BDR,X1   %-2                                                           
         PULL     (X1,T1)           RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
*  SUBR TO PUSH A NAME ONTO THE STACK                                           
*                                                                               
GF%PUSH%SUBR      EQU %                                                         
         LB,P1    PARAMBUF          SET P1=LENGTH OF NAME IN BYTES              
         AI,P1    4                 ADD 1 AND ROUND SO P1=LENGTH OF             
         SLS,P1   -2                 TEXTC-STRING IN WDS                        
         AW,X1    P1                ADJ PUSH COUNT                              
         LI,X2    0                                                             
         LW,P2    PARAMBUF,X2       PUSH TEXTC-STRING ONTO STACK                
         PUSH     P2                 BACKWARDS                                  
         AI,X2    1                                                             
         BDR,P1   %-3               LOOP                                        
         B        0,LNK             EXIT                                        
         PAGE                                                                   
*************************************************                               
*  GET NEXT NAME FROM TELETYPE INPUT BUFFER     *                               
*    GEN,8,24  # OF BRANCHES,ADDR OF ERROR MSG  *                               
*    GEN,8,24  TYPE 1,BRANCH ADDR 1             *                               
*      ...        ...  ...  ...                 *                               
*    GEN,8,24  TYPE N,BRANCH ADDR N             *                               
*************************************************                               
*                                                                               
*                                                                               
GETNEXTNAME       EQU %                                                         
         PUSH     (X1,P2)           SAVE REGS                                   
         LW,P2    CHARPSN           SET P2=PSN OF NEXT INPUT CHAR               
         LB,P1    TTYIMG,P2         GET INPUT CHAR                              
         AI,P2    1                 INCR CHAR PSN                               
         CI,P1    ' '               SKIP LEADING BLANKS                         
         BE       %-3                                                           
         LI,X1    GNTBL1SZ          CHECK IF CHAR CORRESPONDS TO ONE            
         CB,P1    GNTBL1,X1          OF THE 'GETNEXTNAME' TYPES                 
         BE       GN50                                                          
         BDR,X1   %-2               NO - LOOP                                   
         LI,X2    1                 USE X2 AS INDEX INTO PARAMBUF               
*                                                                               
*  TEST IF CHAR CAN BELONG TO A FILE ID 'NAME'; IF SO, BUILD NAME               
*  IN PARAMBUF                                                                  
*                                                                               
GN10     CLM,P1   LETTERS           IS CHAR A LETTER OR DIGIT                   
         BIL      GN30                                                          
         CLM,P1   DIGITS                                                        
         BIL      GN30                                                          
         DO       S(0,1,1)                                                      
         CLM,P1   LCLETTERS                                                     
         BIL      GN30                                                          
         FIN                                                                    
         LI,X1    GNTBL2SZ          NO - IS CHAR ONE OF THE OTHER LEGAL         
         CB,P1    GNTBL2,X1          'NAME' CHARS                               
         BE       GN30              YES - GO PUT CHAR IN PARAMBUF               
         BDR,X1   %-2               LOOP                                        
         CI,X2    1                 NOT A 'NAME' CHAR - WERE ANY SUCH           
         BG       GN35               CHARS FOUND (IF NO, ERROR)                 
*                                                                               
*                                                                               
*                                                                               
GETNEXT%ERROR     EQU %             (ENTER HERE IF NO LEGAL TYPE FOUND)         
         LW,P1    0,LNK             GET ADDR OF ERROR MSG                       
         CW,P1    X800000           TEST IF 'DECR PARAMPSN' BIT SET             
         BAZ      %+2                                                           
         MTW,-2   PARAMPSN          YES - DECR PARAM PSN BY 1                   
         AND,P1   X1FFFF                                                        
         CI,P1    ERRP1             IS IT A 'P' ERROR                           
         BL       GN25              NO - IT IS A 'C' ERROR                      
         STW,P1   DMY%TYPEPERR+1    PUT ERROR MSG ADDR IN DUMMY CALL            
         B        DMY%TYPEPERR      GO PRINT ERROR MSG                          
*                                                                               
*  ERROR TYPE 'C': GO TO PRINT MESSAGE                                          
*                                                                               
GN25     STW,P1   DMY%TYPECERR+1    PUT ERROR MSG ADDR IN DUMMY CALL            
         B        DMY%TYPECERR      GO PRINT ERROR MSG                          
*                                                                               
*  A LEGAL 'NAME' CHAR FOUND: PROCESS THIS                                      
*                                                                               
GN30     STB,P1   PARAMBUF,X2       PUT CHAR IN PARAMBUF                        
         AI,X2    1                 INCR PARAMBUF INDEX                         
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         CI,P1    ' '               IS CHAR=BLANK                               
         BNE      GN10              NO - GO GET NEXT CHAR                       
*                                                                               
*  END OF 'NAME' FOUND: ADD TRAILING BLANKS AND FINISH BUILDING PARAMBUF        
*                                                                               
GN35     LI,X1    3                                                             
         LI,P1    ' '                                                           
         STB,P1   PARAMBUF,X2       PUT 3 TRAILING BLANKS ON 'NAME'             
         AI,X2    1                                                             
         BDR,X1   %-2                                                           
         AI,X2    -4                PUT COUNT IN PARAMBUF TO FORM               
         STB,X2   PARAMBUF           TEXTC-STRING                               
         AI,X2    4                 SET PARAMBUF SIZE = # WDS OF TEXT           
         SLS,X2   -2                                                            
         LI,P1    NAME              SET TYPE='NAME'                             
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR            
*                                                                               
*                                                                               
*                                                                               
GETNEXT%FINISH    EQU %             (ENTER HERE IF LEGAL TYPE FOUND)            
         STW,X2   PRMBUFSZ          SET PARAMBUF SIZE                           
         LB,X1    *LNK              SET X1=# OF BRANCHES                        
         LI,X2    4                 SET X2=INDEX INTO PARAM LIST                
         CB,P1    *LNK,X2           SEARCH FOR CORRES TYPE IN LIST              
         BE       GN45                                                          
         AI,X2    4                 INCR INDEX                                  
         BDR,X1   %-3               LOOP                                        
         B        GETNEXT%ERROR     NONE FOUND - ERROR                          
*                                                                               
*  MATCHING BRANCH FOUND: GO EXECUTE IT                                         
*                                                                               
GN45     SLS,X2   -2                SET D1=BRANCH ADDR                          
         LW,D1    *LNK,X2                                                       
         STW,P2   CHARPSN           RESET CHAR PSN                              
         PULL     (X1,P2)           RESTORE REGS                                
         B        *D1               GO TO BRANCH ADDR                           
*                                                                               
*  A LEGAL 'GETNEXTNAME' TYPE FOUND                                             
*                                                                               
GN50     LB,P1    GNTYTBL1,X1       SET P1=TYPE OF MATCH FOUND                  
         B        GETNEXT%FINISH    GO FINISH UP                                
*                                                                               
*  TABLE OF LEGAL 'GETNEXTNAME' MATCH CHARS                                     
*                                                                               
GNTBL1   EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   CR                 0: C/R HIT                                 
         DATA,1   CM                7: COMMA                                    
         DATA,1   S(LP,PR,PR)                                                   
         DATA,1   S(RP,LF,LF)                                                   
GNTBL1SZ EQU      BA(%)-BA(GNTBL1)-1                                            
         BOUND    4                                                             
*                                                                               
*  TABLE OF TYPES CORRESPONDING TO LEGAL CHARS                                  
*                                                                               
GNTYTBL1 EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   0                  0: C/R HIT                                 
         DATA,1   7                 7: COMMA                                    
         DATA,1   S(9,11,11)        L PAREN, PERIOD, PERIOD                     
         DATA,1   S(10,0,0)         R PAREN, LF, LF                             
         DATA,1   S(10,0)           10,0 : RIGHT PAREN, LINE FEED.              
         BOUND    4                                                             
*                                                                               
*  TABLE OF LEGAL SPECIAL CHARS IN A 'NAME'                                     
*                                                                               
GNTBL2   EQU      %                                                             
         DATA,1   0                                                             
         DATA,1   'ž'                                                           
         DATA,1   '%'                                                           
         DATA,1   '*'                                                           
         DATA,1   '-'                                                           
         DATA,1   '%'                                                           
         DATA,1   ':'                                                           
         DATA,1   '#'                                                           
         DATA,1   '@'                                                           
GNTBL2SZ EQU      BA(%)-BA(GNTBL2)-1                                            
         BOUND    4                                                             
         PAGE                                                                   
***************************************************                             
*  GET NEXT PARAMETER FROM TELETYPE INPUT BUFFER  *                             
*    GEN,8,24  # OF BRANCHES,ADDR OF ERROR MSG    *                             
*    GEN,8,24  TYPE 1,BRANCH ADDR 1               *                             
*      ...        ...  ...  ...                   *                             
*    GEN,8,24  TYPE N,BRANCH ADDR N               *                             
***************************************************                             
*                                                                               
*                                                                               
GETNEXTPARAM      EQU %                                                         
         PUSH     (X1,P2)           SAVE REGS                                   
         LW,P2    CHARPSN           SET P2=PSN OF NEXT INPUT CHAR               
         LB,P1    TTYIMG,P2         GET INPUT CHAR                              
         AI,P2    1                 INCR CHAR PSN                               
         CI,P1    ' '               SKIP LEADING BLANKS                         
         BE       %-3                                                           
         LI,X1    GPTBLSZ           CHECK IF CHAR CORRESPONDS TO ONE            
         CB,P1    GPTBL,X1           OF THE 'GETNEXTPARAM' TYPES                
         BE       GP20                                                          
         BDR,X1   %-2               NO - LOOP                                   
         CLM,P1   DIGITS            CHECK IF CHAR IS A DIGIT                    
         BIL      GP50                                                          
         CI,P1    '.'               CHECK IF CHAR IS A '.'                      
         BE       GP50                                                          
         LI,X2    1                 NO - USE X2 AS INDEX INTO PARAMBUF          
         CI,P1    '/'               CHECK IF A STRING FOUND                     
         BE       GP30                                                          
         CI,P1    '#'                                                           
         BE       GP25              B IF HEX BYTE FOLLOWS                       
         DO       S(0,1,1)                                                      
         CLM,P1   LCLETTERS                                                     
         BIL      GP10                                                          
         FIN                                                                    
         CLM,P1   LETTERS           NO - CHECK IF ALPHA TEXT FOUND              
         BOL      GETNEXT%ERROR     NO - ERROR                                  
*                                                                               
*  ALPHABETIC TEXT FOUND: BUILD TEXTC-STRING IN PARAMBUF                        
*                                                                               
GP10     RES      0                                                             
         DO1      S(0,1,1)                                                      
         OR,P1    4BLNKS            FORCE UPPERCASE                             
         STB,P1   PARAMBUF,X2       PUT CHAR IN PARAMBUF                        
         AI,X2    1                 INCR PARAMBUF INDEX                         
         LB,P1    TTYIMG,P2         GET NEXT CHAR                               
         AI,P2    1                 INCR CHAR PSN                               
         DO       S(0,1,1)                                                      
         CLM,P1   LCLETTERS                                                     
         BIL      GP10                                                          
         FIN                                                                    
         CLM,P1   LETTERS           IS CHAR A LETTER                            
         BIL      GP10              YES - LOOP                                  
         LI,P1    ALPH              NO - SET TYPE='ALPH'                        
         B        GP41              GO FINISH UP                                
*                                                                               
*  A LEGAL 'GETNEXTPARAM' TYPE  FOUND                                           
*                                                                               
GP20     LB,P1    GPTYTBL,X1        SET P1=TYPE OF MATCH FOUND                  
         B        GETNEXT%FINISH    GO FINISH UP                                
*                                                                               
*  STRING FOUND: BUILD TEXTC-STRING IN PARAMBUF                                 
*                                                                               
*        TRANSLATE SINGLE HEX BYTE INTO STRING                                  
*                                                                               
GP25     RES      0                                                             
         LB,P1    TTYIMG,P2         GET NEXT TEXT CHAR                          
         AI,P2    1                 INCREMENT TEXT POINTER                      
         AI,P1    -'0'                                                          
         BGEZ     %+2                                                           
         AI,P1    '0'-'A'+10        CONVERT TO VALUE                            
         CLM,P1   HEXVALUE                                                      
         BOL      GP45              B IF OUT OF LIMITS                          
         LW,X1    P1                SAVE FIRST DIGIT                            
         LB,P1    TTYIMG,P2         GET NEXT TEXT CHAR                          
         AI,P2    1                 INCREMENT TEXT POINTER                      
         AI,P1    -'0'                                                          
         BGEZ     %+2                                                           
         AI,P1    '0'-'A'+10        CONVERT TO VALUE                            
         CLM,P1   HEXVALUE                                                      
         BOL      GP45              B IF OUT OF LIMITS                          
         SLS,X1   4                                                             
         AW,P1    X1                COMBINE DIGITS                              
         CW,P2    TTYIMGSZ                                                      
         BG       GP45              B IF FELL OFF END OF CMND                   
         STB,P1   PARAMBUF,X2       SET CHARACTER IN TEXTC STRING               
         AI,X2    1                 INCREMENT TEXTC POINTER                     
         LB,P1    TTYIMG,P2         GET NEXT CHAR                               
         AI,P2    1                 INCR CHAR PSN                               
         B        GP40              B TO TEST FOR MORE STRING                   
*                                                                               
*        CONVERT EBCDIC STRING                                                  
*                                                                               
GP30     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         CW,P2    TTYIMGSZ          CHECK IF END OF CMND HIT                    
         BG       GP45              YES - ERROR                                 
         CI,P1    '/'               IS CHAR='/'                                 
         BE       GP35                                                          
GP30A    STB,P1   PARAMBUF,X2       NO - PUT CHAR IN PARAMBUF                   
         AI,X2    1                 INCR PARAMBUF INDEX                         
         B        GP30              LOOP                                        
*                                                                               
*  '/' FOUND: DETERMINE IF IT IS END OF STRING OR '//'                          
*                                                                               
GP35     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         CI,P1    '/'               IS IT A '/' ALSO                            
         BE       GP30A             YES - PUT ONE '/' IN PARAMBUF               
*                                                                               
GP40     RES      0                                                             
         CI,P1    '#'                                                           
         BE       GP25              B IF A HEX BYTE FOLLOWS                     
         CI,P1    '/'               B IF AN EBCDIC STRING FOLLOWS               
         BE       GP30              B IF AN EBCDIC STRING FOLLOWS               
         LI,P1    STRG              SET PARAM TYPE                              
GP41     RES      0                 CLEANUP FOR ALPHA OR STRING                 
         LI,X1    3                                                             
         LI,D1    ' '                                                           
         STB,D1   PARAMBUF,X2       PUT 3 TRAILING BLANKS ON TEXT OR            
         AI,X2    1                  STRING                                     
         BDR,X1   %-2                                                           
         AI,X2    -4                CALC LENGTH OF STRING                       
         BEZ      GP43              IS LENGTH=0                                 
         STB,X2   PARAMBUF          NO - BUILD TEXTC-STRING WITH LENGTH         
         AI,X2    4                 SET PARAMBUF SIZE = # OF WDS OF TEXT        
         SLS,X2   -2                                                            
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR            
         B        GETNEXT%FINISH    GO FINISH UP                                
*                                                                               
*  ERROR: STRING IS NULL                                                        
*                                                                               
GP43     BAL,LNK  TYPEPERR          TYPE: '-PN:NULL STRNG'                      
         DATA     ERRP18                                                        
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  ERROR: STRING TOO LONG TO FIT IN BUFFER                                      
*                                                                               
GP45     BAL,LNK  TYPEPERR          TYPE: '-PN:ILGL STRG'                       
         DATA     ERRP15                                                        
         B        MASTERPARSER      EXIT TO PARSER                              
*                                                                               
*  DIGIT OR DECIMAL POINT FOUND: INITIALIZE                                     
*                                                                               
GP50     LI,X1    0                 USE X1 TO INDICATE 1ST OR 2ND SEQ #         
         LI,X2    -1                USE X2 TO SHOW INTG(-1) OR SEQ(>=0)         
         LI,D1    0                 USE D1 AS ACCUMULATOR                       
*                                                                               
*  DETERMINE WHAT WAS FOUND: IF DIGIT, ACCUMULATE DIGITS AS A BINARY            
*  NUMBER                                                                       
*                                                                               
GP52     CLM,P1   DIGITS            IS CHAR A DIGIT                             
         BIL      GP52A             YES - GO ACCUMULATE IT                      
         CI,P1    '.'               IS CHAR A '.'                               
         BNE      GP60                                                          
         LI,X2    3                 YES - USE X3 TO CNT DIGITS AFTER '.'        
         B        GP53              GO PROCESS '.'                              
GP52A    MI,D1    10                ACCUMULATE DIGIT                            
         AI,P1    -'0'                                                          
         AW,D1    P1                                                            
         CW,D1    L(10000)                                                      
         BGE      GP53A                                                         
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         B        GP52              LOOP                                        
*                                                                               
*  DECIMAL POINT FOUND: ACCUMULATE DIGITS AFTER IT                              
*                                                                               
GP53     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         CLM,P1   DIGITS            IS CHAR A DIGIT                             
         BOL      GP55                                                          
         MI,D1    10                YES - ACCUMULATE IT                         
         AI,P1    -'0'                                                          
         AW,D1    P1                                                            
         AI,X2    -1                CHECK IF >3 DIGITS FOUND                    
         BGEZ     GP53              NO - LOOP                                   
GP53A    BAL,LNK  TYPEPERR          YES - TYPE: '-PN:ILGL SEQ #'                
         DATA     ERRP10                                                        
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  END OF DIGITS AFTER DECIMAL POINT                                            
*                                                                               
GP55     CI,X2    0                 WERE EXACTLY 3 DIGITS FOUND                 
         BE       GP60                                                          
         MI,D1    10                NO - ADJ SEQ # FOR MISSING DIGITS           
         BDR,X2   %-1                                                           
*                                                                               
*  END OF INTEGER OR SEQ #: SEE IF SEQ # PAIR PRESENT                           
*                                                                               
GP60     CI,X1    1                 WAS THIS 2ND SEQ # OF PAIR                  
         BE       GP63                                                          
         CI,P1    '-'               NO - DOES A '-' FOLLOW FIRST                
         BNE      GP66                                                          
         CI,X2    -1                YES - WAS FIRST AN INTEGER                  
         BNE      %+2                                                           
         MI,D1    1000              YES - CONVERT TO A SEQ #                    
         STW,D1   PARAMBUF          PUT VALUE IN PARAMBUF                       
         LI,X1    1                 SET X1=2ND SEQ #                            
         LI,X2    -1                RESET X2 & D1                               
         LI,D1    0                                                             
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR                         
         AI,P2    1                 INCR CHAR PSN                               
         CLM,P1   DIGITS            IS CHAR A DIGIT                             
         BIL      GP52A             YES - GO ACCUMULATE IT                      
         CI,P1    '.'               IS CHAR A '.'                               
         BNE      GP53A             NO - ERROR                                  
         LI,X2    3                 YES - USER X3 TO CNT DIGITS AFTER '.'       
         B        GP53              GO PROCESS '.'                              
*                                                                               
*  DONE WITH SECOND SEQ # OF PAIR: FINISH UP                                    
*                                                                               
GP63     CI,X2    -1                WAS SECOND AN INTEGER                       
         BNE      %+2                                                           
         MI,D1    1000              YES - CONVERT TO A SEQ #                    
         STW,D1   PARAMBUF+1        PUT VALUE IN PARAMBUF                       
         LI,P1    SEQ2              SET TYPE='SEQ2'                             
         LI,X2    2                 SET PARAMBUF SIZE = 2                       
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR            
         CW,D1    PARAMBUF          IS SEQ # 2 >= SEQ # 1                       
         BGE      GETNEXT%FINISH    YES - GO FINISH UP                          
         BAL,LNK  TYPEPERR          NO - TYPE: '-PN:SEQ2<SEQ1'                  
         DATA     ERRP11                                                        
         B        MASTERPARSER      GO TO PARSER                                
*                                                                               
*  NO '-' FOLLOWS FIRST: FINISH UP                                              
*                                                                               
GP66     LI,P1    SEQ               SET TYPE='INTG' OR 'SEQ' AS APPRO           
         CI,X2    -1                                                            
         BNE      %+2                                                           
         LI,P1    INTG                                                          
         STW,D1   PARAMBUF          PUT VALUE IN PARAMBUF                       
         LI,X2    1                 SET PARAMBUF SIZE = 1                       
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR            
         B        GETNEXT%FINISH    GO FINISH UP                                
*                                                                               
*  TABLE OF LEGAL 'GETNEXTPARAM' MATCH CHARS                                    
*                                                                               
GPTBL    EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   CR                 0: C/R HIT                                 
         DATA,1   LF                 0: LINE FEED HIT.                          
         DATA,1   CM                 7: COMMA                                   
         DATA,1   SC                 8: SEMI-COLON                              
GPTBLSZ  EQU      BA(%)-BA(GPTBL)-1                                             
         BOUND    4                                                             
*                                                                               
*  TABLE OF TYPES CORRESPONDING TO LEGAL CHARS                                  
*                                                                               
GPTYTBL  EQU      %                                                             
         DATA,1   0                 (FILLER)                                    
         DATA,1   0                  0: C/R HIT                                 
         DATA,1   0                  0: LINE FEED HIT.                          
         DATA,1   7                  7: COMMA                                   
         DATA,1   8                  8: SEMI-COLON                              
         BOUND    4                                                             
         PAGE                                                                   
*********************************************                                   
*  CREATE NEW ENTRY IN CDT                  *                                   
*    P1 = NUMBER OF COMMAND TO ADD          *                                   
*    WORD AFTER BAL = NUMBER OF PARAMETERS  *                                   
*********************************************                                   
*                                                                               
*                                                                               
NEWCDTENTRY       EQU %                                                         
         PUSH     (P1,P2)           SAVE REGS                                   
         SLS,P1   8                 BUILD CONTROL WORD OF ENTRY:                
         OR,P1    CDT                 BYTE 0: LENGTH OF ENTRY (=0)              
         SLS,P1   8                   BYTE 1: COMMAND #                         
         OR,P1    0,LNK               BYTE 2: # OF ENTRY IN CDT                 
         STW,P1   *CDTADR             BYTE 3: # OF PARAMETERS                   
         LW,P2    0,LNK             COMPUTE LENGTH OF ENTRY =                   
         AI,P2    3                   (# OF PARAMETERS)/2+1                     
         SLS,P2   -1                                                            
         STB,P2   *CDTADR           PUT THIS IN BYTE 0                          
         AND,P1   XFF00             BUILD 'END OF CDT' MARKER USING             
         AI,P1    X'0100'            NUMBER OF NEXT CMND IN CDT                 
         STW,P1   *CDTADR,P2        PUT IT AFTER PARAM CONTROL HW'S             
         LI,P1    0                                                             
         B        %+2                                                           
         STW,P1   *CDTADR,P2        SET ALL PARAM CONTROL HW'S TO ZERO          
         BDR,P2   %-1                                                           
         PULL     (P1,P2)           RESTORE REGS                                
         B        1,LNK             EXIT                                        
         PAGE                                                                   
************************************************                                
*  ADJUST ALL FLAG                             *                                
*    P1 = COLUMN NUMBER TO RESUME MATCHING AT  *                                
************************************************                                
*                                                                               
*                                                                               
ADJUSTALLFLAG     EQU %                                                         
         MTW,0    ALLFLAG           IS ALLFLAG ON                               
         BLZ      0,LNK             NO - EXIT                                   
         STW,P1   ALLFLAG           YES - SET IT TO COL. TO RESUME MATCH        
         B        0,LNK             EXIT                                        
         PAGE                                                                   
******************************************************************              
*  ANALYZE COMPOSITION OF FIELD TO RIGHT                         *              
*    P1 = COLUMN AT WHICH TO START ANALYZE                       *              
*    R1 (BP OFF) = NUMBER OF NON-BLANKS TO 1ST BLANK             *              
*    R1 (BP ON)  = NUMBER OF CHARS TO LAST NON-BLANK ON CARD     *              
*    R2 (BP OFF) = NUMBER OF BLANKS (-1) FROM 1ST BLANK TO NEXT  *              
*                   NON-BLANK                                    *              
*    R2 (BP ON)  = NUMBER OF TRAILING BLANKS ON CARD             *              
*    CC1=1 IF INITIAL P1>END OF BUFFER, CC1=0 OTHERWISE          *              
******************************************************************              
*                                                                               
*                                                                               
ANLZRIGHT         EQU %                                                         
         PUSH     (P1,P2)           SAVE REGS                                   
         CI,P1    MAXCLMN           IS START OF FIELD PAST END OF BUFFER        
         BL       AR10              NO - GO ON                                  
         LI,R1    0                 SET R1=R2=0                                 
         LI,R2    0                                                             
         PURGE    (P1,P2)           YES - CLEAR STACK                           
         LCI      8                 SET CC1=1                                   
         B        0,LNK             EXIT                                        
*                                                                               
*  TEST BP FLAG, IF OFF CALC R1=NUMBER OF NON-BLANKS                            
*                                                                               
AR10     LI,R1    0                 SET R1=0                                    
         CW,P1    EODCLMN           IS START OF FIELD PAST LAST NON-BLNK        
         BG       AR12                                                          
         MTW,0    BPFLAG            NO - IS BLANK PRES. ON                      
         BNEZ     AR20                                                          
         LI,R2    0                 NO - SET R2=0                               
         LI,P2    ' '                                                           
AR10A    CB,P2    CARDIMG,P1        IS CHAR AT P1=BLANK                         
         BE       AR15+1            YES - GO COUNT BLANKS                       
         AI,R1    1                 NO - INCR R1 & P1                           
         AI,P1    1                                                             
         CW,P1    EODCLMN           IS P1 PAST LAST NON-BLANK                   
         BLE      AR10A             NO - CONTINUE SCAN                          
*                                                                               
*  NOW PAST LAST NON-BLANK, CALC R2=NUMBER OF BLANKS TO END                     
*                                                                               
AR12     LI,R2    MAXCLMN           CALC R2=DISTANCE FROM P1 TO END OF          
         SW,R2    P1                 BUFFER                                     
         B        AR18              GO EXIT                                     
*                                                                               
*  AT END OF NON-BLANKS, COUNT BLANK FIELD                                      
*                                                                               
AR15     AI,R2    1                 INCR R2 & P1                                
         AI,P1    1                                                             
         CB,P2    CARDIMG,P1        IS CHAR AT P1=BLANK                         
         BE       AR15              YES - KEEP COUNTING BLANKS                  
*                                                                               
*  EXIT WITH CC1=0                                                              
*                                                                               
AR18     PULL     (P1,P2)           RESTORE REGS                                
         LCI      0                 SET CC1=0                                   
         B        0,LNK             EXIT                                        
*                                                                               
*  BP FLAG ON, CALC R1 & R2                                                     
*                                                                               
AR20     LW,R1    EODCLMN           CALC R1=DISTANCE FROM P1 TO LAST            
         SW,R1    P1                 NON-BLANK                                  
         AI,R1    1                                                             
         LI,R2    MAXCLMN-1         CALC R2=NUMBER OF TRAILING BLANKS           
         SW,R2    EODCLMN                                                       
         B        AR18              GO EXIT                                     
         PAGE                                                                   
*******************************************************                         
*  EVALUATE FIRST PARAMETERS FOR INTRALINE COMMANDS   *                         
*    CDTADR = ADDR OF CURRENT COMMAND IN CDT          *                         
*    RESULTS: P1 = COLUMN COMPUTED FROM PARAMETERS    *                         
*             P2 = WIDTH OF FIELD AT THIS COLUMN      *                         
*             X1 = POSITION OF NEXT CDT CONTROL BYTE  *                         
*    CC1=1 IF NO COLUMN FOUND; CC1=0 OTHERWISE        *                         
*******************************************************                         
*                                                                               
FINDCOLUMN        EQU %                                                         
         PUSH     X2,(LNK,T1)       SAVE REGS                                   
         LI,X1    5                 INDEX TO 1ST PARAM POINTER                  
         LI,T1    0                 SET T1=ALL OCCURRENCES                      
         LW,P1    ALLFLAG               P1=COL. TO START MATCHING AT            
         BGEZ     FC15              IS SYSTEM IN 'ALL' MODE                     
         LW,P1    FRSTCLMN          NO - SET P1=COL. TO START AT                
         LI,X1    4                                                             
         LI,T1    1                                                             
         LB,X2    *CDTADR,X1        NO - GET PARAM1 TYPE                        
         LI,X1    5                                                             
         CI,X2    STRG              IS IT A STRING                              
         BE       FC15A             YES - FORM IS: /ST/ X -                     
         LI,X2    3                                                             
         LB,X2    *CDTADR,X2        GET NR PARAMS POSSIBLE                      
         CI,X2    4                                                             
         BE       FC10              B IF 4  (MEANS FORM  IS N/STR/)             
FC05     RES      0                 FORM IS  C                                  
         LB,X2    *CDTADR,X1        GET COLUMN NR                               
         LW,P1    *CDTADR,X2        GET COL. # FROM CDT                         
         AI,P1    -1                ADJUST TO INTERNAL COL. #                   
         BLZ      FC45              B IF TOO SMALL                              
         CI,P1    140                                                           
         BL       FC08              B IF IN BOUNDS                              
         AI,P1    -997              GET COL NR REL TO LAST COLUMN               
* 998 (999 EXTERNAL) IS LAST COLLUMN +1.                                        
* NEARBY NUMBERS N ARE DISPLACED FROM THE LAST+1 BY N-998 (999)                 
         AW,P1    EODCLMN           OFFSET BY LAST COL NR                       
         BLZ      FC45              B IF TOO SMALL                              
         CI,P1    140                                                           
         BGE      FC40              B IF TOO BIG                                
FC08     RES      0                                                             
         LI,P2    1                 NO - SET FIELD WIDTH = 1                    
         LI,X1    6                 SET NEXT CDT CTRL BYTE = 6                  
         B        FC20              GO EXIT                                     
*                                                                               
*        FORM IS  N/STR/.  GET OCCURRENCE COUNT                                 
*                                                                               
FC10     RES      0                 ENTER WITH X1=PARAM POINTER                 
         LB,X2    *CDTADR,X1        SET T1=OCCURRENCE CNT IN CDT                
         LW,T1    *CDTADR,X2                                                    
         CI,T1    0                 CHECK IF ALL IS LEGAL FOR THIS              
         BG       FC15              COMMAND                                     
         MTW,0    ALLOK                                                         
         BEZ      FC15                                                          
         BAL,LNK  TYPECERR                                                      
         DATA     ERRC7                                                         
         MTW,1    ERRORCNT          ALLOW ONE MORE CERR                         
         LI,T1    1                 SUBSTITUTE 1                                
FC15     AI,X1    2                 POINT TO POINTER FOR /STR/                  
*                                                                               
*  FIND CORRECT OCCURRENCE OF STRING IF IT EXISTS                               
*                                                                               
FC15A    LB,P2    *CDTADR,X1        SET P2=ABSOLUTE ADDR OF PARAM2              
         AW,P2    CDTADR             STRING                                     
FC15B    RES      0                                                             
         BAL,LNK  FINDMATCH         FIND MATCH FOR STRING                       
         BCS,8    FC30              IF NONE - ERROR                             
         LW,P1    R1                SET P1=COL. TO RESUME MATCHING              
         AI,P1    1                                                             
         BDR,T1   FC15B             LOOP IF NOT CORRECT OCCURRENCE              
         CI,T1    0                 IF T1<0, 'ALL' MODE IS ACTIVE; IN           
         BGE      %+2                THIS MODE ALLFLAG>=0                       
         STW,P1   ALLFLAG                                                       
         AI,P1    -1                SET P1=COLUMN OF MATCH                      
         LB,P2    *P2                   P2=LENGTH OF STRING                     
         AI,X1    1                     X1=NEXT CDT CONTROL BYTE                
*                                                                               
*  EXIT WITH CC1=0                                                              
*                                                                               
FC20     PULL     X2,(LNK,T1)       RESTORE REGS                                
         LCI      0                                                             
         B        0,LNK             EXIT WITH CC1=0                             
*                                                                               
*  NO MATCH FOUND: IF IN 'ALL' MODE, EXIT 'ALL' MODE; OTHERWISE, ERROR          
*                                                                               
FC30     LI,T1     -1               TURN OFF ALL MODE.                          
         STW,T1   ALLFLAG                                                       
*                                                                               
*  EXIT WITH CC1=1                                                              
*                                                                               
FC35     PULL     X2,(LNK,T1)       RESTORE REGS                                
         LCI      8                                                             
         B        0,LNK             EXIT WITH CC1=1                             
*                                                                               
*  ERROR: COLUMN NUMBER BEYOND COLUMN TO STOP AT                                
*                                                                               
FC40     BAL,LNK  TYPECERR          TYPE: '--CN:COL>LIMIT'                      
         DATA     ERRC6                                                         
         B        FC35              GO TO EXIT                                  
*                                                                               
*  ERROR: COLUMN NUMBER BELOW COLUMN TO START AT                                
*                                                                               
FC45     BAL,LNK  TYPECERR          TYPE: '--CN:COL<LIMIT'                      
         DATA     ERRC10                                                        
         B        FC35              GO TO EXIT                                  
*                                                                               
*        FIND COLUMN NR SPECIFIED BY SECOND PARAM GROUP                         
*        ENTRY:   AS FOR FINDCOLUMN, BUT                                        
*                 X1=NEXT CDT CONTROL BYTE INDEX                                
*        EXIT:    AS FOR FINDCOLUMN                                             
*                                                                               
FINDCOL2 RES      0                                                             
         PUSH     X2,(LNK,T1)                                                   
         AI,X1    1                 POINT TO PARAMETER TEXT POINTER             
         LI,T1    1                 OCCURENCE COUNT DEFAULT                     
         LW,P1    FRSTCLMN          P1=COLUMN NR TO START AT                    
         LW,X2    X1                                                            
         AI,X2    -1                POINT TO PARAM TYPE CODE                    
         LB,X2    *CDTADR,X2        GET IT                                      
         CI,X2    STRG                                                          
         BE       FC15A             B IF FORM IS  /STR/                         
         LW,X2    X1                                                            
         AI,X2    1                 POINT TO NEXT PARAM CODE                    
         LB,X2    *CDTADR,X2        GET NEXT PARAM CODE                         
         BEZ      FC05              B IF NO MORE PARAMS (FORM IS C)             
         B        FC10              FORM IS  N/STR/                             
         PAGE                                                                   
***********************************************                                 
*  FIND MATCHING STRING ON CARD               *                                 
*    P1 = COLUMN AT WHICH TO START SEARCH     *                                 
*    P2 = ADDR OF TEXTC-STRING TO MATCH       *                                 
*    R1 = COLUMN AT WHICH MATCH OCCURRED      *                                 
*    CC1=0 IF MATCH FOUND, CC1=1 IF NO MATCH  *                                 
***********************************************                                 
*                                                                               
*                                                                               
FINDMATCH         EQU %                                                         
         PUSH     (X1,T2)           SAVE REGS                                   
         STW,P2   TEXTCADR          SAVE ADDR OF TEXTC-STRING                   
         LW,R1    LASTCLMN          CALC: STOPCLMN=LAST COL. # AT WHICH         
         LB,P2    *TEXTCADR          MATCH CAN TAKE PLACE                       
         SW,R1    P2                                                            
         STW,R1   STOPCLMN                                                      
         CW,P1    STOPCLMN          IS INITIAL COL.=STOPCLMN                    
         BLE      FM10                                                          
         PURGE    (X1,T2)           YES - CLEAR STACK                           
         B        FM15              GO EXIT WITH CC1=1                          
*                                                                               
*  GET 1ST CHAR OF TEXTC-STRING AND SEARCH FOR IT IN CARD                       
*                                                                               
FM10     LI,X1    1                 SET T1=1ST CHAR OF TEXTC-STRING             
         LB,T1    *TEXTCADR,X1                                                  
FM10A    CB,T1    CARDIMG,P1        DOES 1ST CHAR MATCH CHAR ON CARD            
         BE       FM20              YES - GO COMPARE REST                       
FM10B    AI,P1    1                 NO - INCR TO NEXT COLUMN                    
         CW,P1    STOPCLMN          IS NEW COLMN>STOPCLMN                       
         BLE      FM10A             NO - GO COMPARE MORE                        
         PULL     (X1,T2)           YES - RESTORE REGS                          
*                                                                               
*  EXIT WITH NO MATCH FOUND (CC1=1)                                             
*                                                                               
FM15     LCI      8                                                             
         B        0,LNK             EXIT WITH CC1=1                             
*                                                                               
*  1ST CHAR MATCH FOUND, NOW COMPARE CARD WITH REST OF TEXTC-STRING             
*                                                                               
FM20     LI,X1    1                 SET X1=POSITION IN TEXTC-STRING             
         LW,X2    P1                    X2=COL. # ON CARD                       
         LB,P2    *TEXTCADR             P2=# OF CHARS TO COMPARE                
         AI,P2    -1                                                            
         BEZ      FM30              IF STRING IS 1 CHAR LONG - EXIT             
FM20A    AI,X1    1                 INCR X1 & X2                                
         AI,X2    1                                                             
         LB,T2    *TEXTCADR,X1      DO 2 CHARS MATCH                            
         CB,T2    CARDIMG,X2                                                    
         BNE      FM10B             NO - GO START 1ST CHAR SEARCH AGAIN         
         BDR,P2   FM20A             YES - LOOP UNTIL CORRECT # MATCH            
*                                                                               
*  EXIT WITH MATCH FOUND (CC1=0)                                                
*                                                                               
FM30     LW,R1    P1                MATCH FOUND - SET R1=COL. # OF MATCH        
         PULL     (X1,T2)           RESTORE REGS                                
         LCI      0                                                             
         B        0,LNK             EXIT WITH CC1=0                             
         PAGE                                                                   
******************************************                                      
*  MOVE STRING TO CARD                   *                                      
*    P1 = COLUMN AT WHICH TO PUT STRING  *                                      
*    P2 = ADDR OF TEXTC-STRING TO MOVE   *                                      
******************************************                                      
*                                                                               
*                                                                               
MOVESTRING        EQU %                                                         
         PUSH     (X1,LNK)          SAVE REGS                                   
         SLS,P2   2                 CONVERT P2 TO A BYTE ADDR                   
         LB,X1    0,P2              SET X1=# OF CHARS TO MOVE                   
         CI,P1    MAXCLMN           IS STARTING COL. BEYOND END OF CARD         
         BGE      MS20A-1           YES - GO CHECK                              
*                                                                               
*  MOVE CHAR FROM TEXTC-STRING TO CARD                                          
*                                                                               
MS5      AI,P2    1                 INCR TO NEXT TEXTC-STRING CHAR              
         LB,X2    0,P2              MOVE CHAR TO CARD                           
         STB,X2   CARDIMG,P1                                                    
         AI,P1    1                 INCR COLUMN                                 
         CI,P1    MAXCLMN                                                       
         BGE      MS20              HAS END OF BUFFER BEEN PASSED               
         BDR,X1   MS5               NO - LOOP UNTIL ALL CHARS MOVED             
*                                                                               
*  EXIT                                                                         
*                                                                               
MS10     PULL     (X1,LNK)          RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
*  AT END OF BUFFER: IF MORE NON-BLANKS TO MOVE, TYPE ERROR MESSAGE             
*                                                                               
MS20     AI,X1    -1                END OF BUFFER: ARE THERE MORE CHARS         
         BEZ      MS10               TO MOVE                                    
         LI,X2    ' '                                                           
MS20A    AI,P2    1                 YES - IS NEXT CHAR OF TEXTC-STRING          
         CB,X2    0,P2               A BLANK                                    
         BNE      MS20B             NO - TYPE ERROR MSG                         
         BDR,X1   MS20A             YES - LOOP UNTIL ALL CHARS CHECKED          
         B        MS10              ALL BLANKS - GO EXIT                        
MS20B    BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'                       
         DATA     ERRC1                                                         
         B        MS10              GO EXIT                                     
         PAGE                                                                   
******************************************************                          
*  PROCESS COLUMN NUMBER PAIR                        *                          
*    X1 = LOC OF NEXT PARAMETER CONTROL BYTE IN CDT  *                          
******************************************************                          
*                                                                               
*                                                                               
PROCESSCOL#PAIR   EQU %                                                         
         PUSH     (X1,P2)           SAVE REGS                                   
         LI,P1    0                 SET P1=DFLT STARTING COL. #                 
         LI,P2    MAXCLMN               P2=DFLT STOPPING COL. #                 
         LB,X2    *CDTADR,X1        GET NEXT PARAM TYPE                         
         BEZ      PP10              IS PARAM PRESENT                            
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET P1=STARTING COL #                 
         LW,P1    *CDTADR,X2                                                    
         AI,P1    -1                ADJUST TO INTERNAL COL #                    
         AI,X1    -1                                                            
*                                                                               
*  PROCESS SECOND COLUMN NUMBER PARAMETER                                       
*                                                                               
PP10     AI,X1    2                                                             
         LB,X2    *CDTADR,X1        GET NEX PARAM TYPE                          
         BEZ      PP20              IS PARAM PRESENT                            
         AI,X1    1                                                             
         LB,X2    *CDTADR,X1        YES - SET P2=STOPPING COL # + 1             
         LW,P2    *CDTADR,X2                                                    
*                                                                               
*  FINISH INITIALIZATION AND EXIT                                               
*                                                                               
PP20     STW,P1   FRSTCLMN          SET STARTING AND STOPPING COL #'S           
         STW,P2   LASTCLMN                                                      
         CW,P1    P2                                                            
         BGE      PP25                                                          
         CI,P1    0                                                             
         BL       PP25                                                          
         CI,P2    MAXCLMN                                                       
         BG       PP25                                                          
         PULL     (X1,P2)           RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
PP25     BAL,LNK  TYPEMSG           TYPE: '-BAD COL. NO. PAIR'                  
         DATA     ERRC11                                                        
         LI,LNK   0                                                             
         STW,LNK  SETFLAG                                                       
         STW,LNK  STEPFLAG                                                      
         B        MASTERPARSER                                                  
         PAGE                                                                   
***********************************                                             
*  FIND COLUMN OF LAST NON-BLANK  *                                             
***********************************                                             
*                                                                               
*                                                                               
SETEOD   EQU      %                                                             
         PUSH     (X1,X2)           SAVE REGS                                   
         LI,X1    MAXCLMN/4-1                                                   
         LW,X2    4BLNKS                                                        
         CW,X2    CARDIMG,X1        MAKE GROSS COMPARISON FOR ALL               
         BNE      SRS10             BLANK WORDS.                                
         BDR,X1   %-2                                                           
*                                                                               
*                                                                               
         LI,X1    3                 CHECK FIRST WORD BY BYTE.                   
SRS5     CB,X2    CARDIMG,X1        ITERATE THROUGH BYTES OF                    
         BNE      SRS15             TARGET WORD.                                
         BDR,X1   %-2                                                           
         B        SRS15                                                         
SRS10    SLS,X1   2                 REVERT TO BYTE INDEXING, TO GET             
         AI,X1    3                 BYTE WITHIN WORD.                           
         B        SRS5                                                          
*                                                                               
SRS15    STW,X1   EODCLMN           SAVE ENDING COLUMN (BYTE INDEX)             
         AI,X1    1                                                             
         STW,X1   RECSIZE           AND RECORD SIZE (TRUE BYTE COUNT)           
         PULL     (X1,X2)                                                       
         B        0,LNK             EXIT                                        
         PAGE                                                                   
***************************************************                             
*  SHIFT STRING LEFT                              *                             
*    P1 = COLUMN AT WHICH TO START SHIFT          *                             
*    P2 = WIDTH OF FIELD STARTING AT THIS COLUMN  *                             
*    P3 = NUMBER TO SHIFT LEFT                    *                             
***************************************************                             
*                                                                               
*                                                                               
SHIFTLEFT         EQU %                                                         
         PUSH     (P1,R2)           SAVE REGS                                   
         AW,P1    P2                START ANLZ AFTER ORIG FIELD                 
         BAL,LNK  ANLZRIGHT         ANLZ FIELD AT P1                            
         BCS,8    SL30              OOPS - FIELD IS BEYOND END OF CARD          
         SW,P1    P2                RESTORE P1                                  
*                                                                               
*  COMPUTE WHERE TO SHIFT TO, COMPENSATING IF SHIFT PUSHES DATA OFF             
*  LEFT END OF CARD                                                             
*                                                                               
SL3      AW,R1    P2                SET R1=WIDTH OF FIELD AT P1 TO SHIFT        
         LW,P2    P1                CALC: P1=BEGINNING OF 'FROM' FIELD          
         SW,P2    P3                      P2=BEGINNING OF 'TO' FIELD            
         BGEZ     SL5               DOES THIS SHIFT OFF LEFT END OF CARD        
         BAL,LNK  TYPECERR          YES - TYPE: '--CN:UNDERFLOW'                
         DATA     ERRC2                                                         
         SW,P1    P2                FIX UP 'FROM' COL. AND WIDTH SO AS          
         AW,R1    P2                 TO SHIFT ONLY TO COL. 0                    
         BLEZ     SL20              DOES SHIFT PUSH ENTIRE FIELD OFF CRD        
         LI,P2    0                 NO - SET 'TO'=COL. 0                        
*                                                                               
*  SHIFT FIELD AT P1 LEFT                                                       
*                                                                               
SL5      CI,R1    0                 IS WIDTH OF FIELD TO SHIFT = 0              
         BE       SL10              YES - SKIP SHIFT                            
SL5A     LB,T1    CARDIMG,P1        SHIFT LEFT                                  
         STB,T1   CARDIMG,P2                                                    
         AI,P1    1                                                             
         AI,P2    1                                                             
         BDR,R1   SL5A                                                          
*                                                                               
*  BLANK OUT CLEARED CHARS ON RIGHT                                             
*                                                                               
SL10     LI,T1    ' '               BLANK OUT                                   
         STB,T1   CARDIMG,P2                                                    
         AI,P2    1                                                             
         BDR,P3   %-2                                                           
         PULL     (P1,R2)           RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
*  SHIFT PUSHES EVERYTHING, INCLUDING FIELD AT P1, OFF CARD, SO BLANK           
*  OUT AND EXIT                                                                 
*                                                                               
SL20     AW,P3    P2                CALC P3=# OF COLUMNS WIPED OUT              
         SW,R1    P2                                                            
         AW,P3    R1                                                            
         LI,P2    0                 SET 'TO' FOR BLANKING=0                     
         B        SL10              GO BLANK OUT                                
*                                                                               
*  FIELD TO SHIFT IS BEYOND END OF CARD: SET UP TO SHIFT IN BLANKS              
*                                                                               
SL30     SW,P1    P2                RESTORE R1                                  
         CI,P1    MAXCLMN           IS FIELD BEYOND END OF CARD                 
         BL       SL3               NO - CONTINUE NORMALLY                      
         LW,P2    P1                SET P2=COL. AT WHICH TO START               
         SW,P2    P3                 BLANKING OUT                               
         B        SL10              GO BLANK OUT                                
         PAGE                                                                   
***************************************************                             
*  SHIFT STRING RIGHT                             *                             
*    P1 = COLUMN AT WHICH TO START SHIFT          *                             
*    P2 = WIDTH OF FIELD STARTING AT THIS COLUMN  *                             
*    P3 = NUMBER TO SHIFT RIGHT                   *                             
***************************************************                             
*                                                                               
*                                                                               
SHIFTRIGHT        EQU %                                                         
         CI,P1    MAXCLMN           IS FIELD BEYOND END OF CARD                 
         BGE      0,LNK             YES - EXIT                                  
         PUSH     (X1,R2)           SAVE REGS                                   
         LI,T1    0                 SET CNTS=0                                  
         STW,T1   FIELDCNT                                                      
         STW,T1   BLANKCNT                                                      
         AW,P1    P2                START ANLZ AFTER ORIG FIELD                 
         CI,P1    MAXCLMN           DOES FIELD ABUTT END OF CARD                
         BE       SR70              YES - GO PROCESS                            
*                                                                               
*  BUILD 2-WD DATA BLOCK FOR EACH FIELD TO BE COMPRESSED AND PUSH               
*  ON STACK                                                                     
*                                                                               
SR5      BAL,LNK  ANLZRIGHT         ANLZ FIELD AT P1                            
         BCS,8    SR50              OOPS - END OF CARD                          
         AWM,R2   BLANKCNT          CNT BLNKS TO COMPRESS                       
         STH,R1   R2                                                            
         AW,R1    P1                BUILD: R1=COLUMN AT END OF NON-BLNKS        
         AI,R1    -1                       R2=(# OF NON-BLNKS,# TO SHFT)        
         MTW,1    FIELDCNT          CNT FIELDS COMPRESSED                       
         CW,P3    BLANKCNT          ARE ENOUGH BLNKS COMPRESSED YET             
         BLE      SR8               YES                                         
         PUSH     (R1,R2)           NO - SAVE FIELD DATA BLOCK                  
         LW,P1    R1                INCR P1 TO NEXT FIELD                       
         AND,R2   XFFFF                                                         
         AW,P1    R2                                                            
         AI,P1    2                                                             
         B        SR5               ANLZ NEXT FIELD                             
*                                                                               
*  INITIALIZE TO DO ACTUAL SHIFTS (I.E., COMPRESSING)                           
*                                                                               
SR8      SW,P3    BLANKCNT          ADJUST (# TO SHIFT) SPEC IN R2 TO           
         AW,R2    P3                 PRESERVE EXCESS BLNKS IN LAST FIELD        
SR8A     LW,X1    R1                AVOID: PUSH R1,R2                           
         LW,X2    R2                       PULL R1,R2                           
         LI,T1    0                                                             
         STW,T1   BLANKCNT          CLEAR BLNK CNT                              
         MTW,-1   FIELDCNT          DECR FIELD CNT                              
         BGZ      SR12              >0 - 1 OR MORE FIELDS ON STK                
         BEZ      SR10              =0 - AT 1ST FIELD (STK EMPTY)               
         LH,T1    X2                <0 - SHIFT WIPES ALL BUT ORIG FIELD         
         B        SR12A                   AT P1                                 
*                                                                               
*  READY TO SHIFT 1ST FIELD, BUT FIRST ADD ON ORIG FIELD AT P1                  
*                                                                               
SR10     AH,P2    X2                ADD LENGTH OF ORIG FIELD TO (# OF           
         AI,P2    -1                 NON-BLNKS) SPEC IN R2                      
         STH,P2   X2                                                            
*                                                                               
*  SET UP PARAMETERS FOR CURRENT SHIFT                                          
*                                                                               
SR12     LH,T1    X2                SET T1=# OF CHARS IN FIELD TO SHIFT         
         AI,T1    1                  (INCLUDING PRECEDING BLANK)                
SR12A    AND,X2   XFFFF             KEEP CUMULATIVE CNT OF BLNKS                
         AWM,X2   BLANKCNT           COMPRESSED OUT                             
         LW,X2    X1                CALC: X1=END OF 'FROM' FIELD                
         AW,X2    BLANKCNT                X2=END OF 'TO' FIELD                  
         CI,T1    0                 IS # OF CHARS TO SHIFT = 0                  
         BE       SR15A             YES - SKIP SHIFT                            
*                                                                               
*  DO CURRENT SHIFT, THEN CHECK NUMBER LEFT TO DO                               
*                                                                               
SR15     LB,T2    CARDIMG,X1        COMPRESS FIELDS                             
         STB,T2   CARDIMG,X2                                                    
         AI,X1    -1                                                            
         AI,X2    -1                                                            
         BDR,T1   SR15                                                          
SR15A    MTW,-1   FIELDCNT          DECR FIELD CNT                              
         BLZ      SR20              <0 - ALL SHIFTS DONE                        
         PULL     (X1,X2)           >=0 - GET NEXT FIELD DATA BLOCK             
         MTW,0    FIELDCNT          TEST FIELD CNT                              
         BGZ      SR12              >0 - 1 OR MORE FIELDS LEFT                  
         B        SR10              =0 - AT 1ST FIELD                           
*                                                                               
*  ALL SHIFTS DONE, SO BLANK OUT CLEARED CHARS ON LEFT                          
*                                                                               
SR20     LW,T1    BLANKCNT                                                      
SR20A    LI,T2    ' '               BLANK OUT                                   
         STB,T2   CARDIMG,X2                                                    
         AI,X2    -1                                                            
         BDR,T1   %-2                                                           
         PULL     (X1,R2)           RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
*  END-OF-BUFFER HIT: NOT ENOUGH BLANKS TO ABSORB SHIFT                         
*                                                                               
SR50     BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'                       
         DATA     ERRC1                                                         
         LI,T1    0                 CLEAR BLNK CNT                              
         XW,T1    BLANKCNT          SET T1=(# OF NON-BLNKS TO DESTROY)          
         SW,T1    P3                                                            
         PULL     (R1,R2)           START ON LAST FIELD                         
*                                                                               
*  PULL FIELD DATA BLOCKS FROM STACK AND DESTROY NON-BLANKS UNTIL               
*  ENOUGH ROOM FOUND, WHEN FOUND BUILD APPROPRIATE DATA BLOCK                   
*                                                                               
SR52     AH,T1    R2                IS CURRENT FIELD (+OTHERS ALREADY           
         BLEZ     SR55               WIPED OUT) LONG ENOUGH FOR OVERFLOW        
SR52A    SH,R1    R2                YES -BUILD R1 & R2 AS BEFORE:               
         AW,R1    T1                  R1=COLUMN AT END OF NON-BLNKS             
         AH,R2    R2                      NOT DESTROYED                         
         AND,R2   XFFFF               R2=(# OF NON-BLNKS NOT DESTROYED,         
         SW,R2    T1                      ,# TO SHIFT)                          
         AW,R2    BLANKCNT                                                      
         STH,T1   R2                                                            
         B        SR8A              GO SHIFT                                    
*                                                                               
*  NOT ENOUGH ROOM FOUND YET, GET NEXT FIELD DOWN AND DESTROY PART OF IT        
*                                                                               
SR55     LH,T2    R2                KEEP CUMULATIVE CNT OF CHARS                
         AW,T2    R2                 DESTROYED                                  
         AND,T2   XFFFF                                                         
         AWM,T2   BLANKCNT                                                      
         MTW,-1   FIELDCNT          DECR FIELD CNT                              
         BEZ      SR58              =0 - AT 1ST FIELD                           
         PULL     (R1,R2)           >0 - GET NEXT FIELD DATA BLOCK              
         AI,R1    1                 INC. FOLLOWING BLANK IN FIELD               
         AI,R2    X'10000'                                                      
         B        SR52                                                          
*                                                                               
*  AT 1ST FIELD AND STILL NOT ENOUGH ROOM                                       
*                                                                               
SR58     AW,T1    P2                ADD IN ORIG FIELD AT P1 AND CHK ROOM        
         BLEZ     SR60                                                          
         SH,R1    R2                ENOUGH FOUND - FIX R1 & R2 TO               
         LI,R2    0                  DESTROY PART OF ORIG FIELD AT P1           
         STH,P2   R2                                                            
         B        SR52A                                                         
*                                                                               
*  SHIFT PUSHS ALL FIELDS OFF CARD, SO BLANK OUT AND EXIT                       
*                                                                               
SR60     AWM,P2   BLANKCNT          SET UP TO BLANK FROM ORIG P1                
         LW,X2    P1                                                            
         AI,X2    -2                                                            
         B        SR20              GO BLANK OUT                                
*                                                                               
*  FIELD TO SHIFT ABUTTS END OF CARD: SET UP TO PERFORM THIS SHIFT              
*                                                                               
SR70     BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'                       
         DATA     ERRC1                                                         
         SW,P2    P3                DOES SHIFT PUSH ORIG FIELD OFF CARD         
         BLEZ     SR72                                                          
         STW,P3   BLANKCNT          NO - SET BLANKCNT=# OF CHARS TO             
         LI,X1    MAXCLMN-1          BLANK OUT                                  
         SW,X1    P3                SET X1=END OF 'FROM' FIELD                  
         LI,X2    MAXCLMN-1             X2=LAST COLUMN ON CARD                  
         LW,T1    P2                    T1=# OF CHARS TO SHIFT                  
         B        SR15              GO SHIFT THIS FIELD                         
*                                                                               
*  ABUTTING FIELD IS SHIFTED OFF CARD, SO SET UP TO BLANK OUT                   
*                                                                               
SR72     AW,P2    P3                SET T1=# OF CHARS TO BLANK OUT              
         LW,T1    P2                        (=ORIG FIELD WIDTH)                 
         LI,X2    MAXCLMN-1             X2=LAST COLUMN ON CARD                  
         B        SR20A             GO BLANK OUT                                
         PAGE                                                                   
***************************************                                         
*  CONVERT BINARY TO DECIMAL STRING   *                                         
*    P1 = BINARY NUMBER               *                                         
*    P2 = BYTE ADDR TO PUT STRING IN  *                                         
***************************************                                         
*                                                                               
*                                                                               
BINTODEC EQU      %                                                             
         PUSH      (P1,P2),X1       SAVE RGS                                    
         AI,P2    7                 SET P2=LAST BYTE ADDR OF STRING             
         LW,D1    P1                                                            
         LI,P1    7                 SET TO LOOP 7 TIMES                         
BD10     LI,D0    0                                                             
         DW,D0    K10               EXTRACT RIGHTMOST DIGIT                     
         AI,D0    '0'               CONVERT TO EBCDIC AND PUT IN STRING         
         STB,D0   0,P2                                                          
         AI,P2    -1                                                            
         BDR,P1   BD10              LOOP                                        
         LI,D1    ' '               SET 1ST BYTE = BLANK                        
         STB,D1   0,P2                                                          
         AI,P2      1                GET PAST THE BLANK                         
         LI,X1     6                NUMBER OF FIELDS TO CHECK.                  
         LI,D1     X'40'            NULL CHARACTER                              
         LI,P1     X'F0'                                                        
BD30     EQU       %                                                            
         CB,P1     0,P2             CHECK FOR ZERO                              
         BNE       BD20             NOT EQU IS NOT A LEADING ZERO               
         STB,D1    0,P2             MAKE IT NULL                                
         AI,P2     1                INCREMENT BYTE ADR.                         
         BDR,X1    BD30             GO FIND ANOTHER                             
BD20     EQU       %                                                            
         PULL      (P1,P2),X1                                                   
         B        0,LNK             EXIT                                        
         PAGE                                                                   
******************************                                                  
*        BLANK INPUT BUFFER  *                                                  
******************************                                                  
*                                                                               
*                                                                               
BLANKBUF PUSH     LNK                                                           
         LI,LNK   MAXCLMN/4                                                     
         LW,D1    4BLNKS                                                        
*                                                                               
         STW,D1   CARDIMG-1,LNK                                                 
         BDR,LNK  %-1                                                           
*                                                                               
         PULL     LNK                                                           
         B        0,LNK                                                         
         PAGE                                                                   
         DO       S(1,1,0)                                                      
***********************                                                         
*  CLOSE UPDATE FILE  *                                                         
***********************                                                         
*                                                                               
*                                                                               
CLOSE    EQU      %                                                             
         M:CLOSE  F:EI,(SAVE)                                                   
         B        0,LNK                                                         
*********************                                                           
*  CLOSE COPY FILE  *                                                           
*********************                                                           
*                                                                               
*                                                                               
CLOSE2   EQU      %                                                             
         M:CLOSE  F:EO,(SAVE)                                                   
         B        0,LNK                                                         
*                                                                               
*                                                                               
CLOSE3   M:CLOSE  F:EO,(REL)                                                    
         B        0,LNK                                                         
**********************************                                              
*        CLOSE LO FILE           *                                              
**********************************                                              
*                                                                               
*                                                                               
*                                                                               
*                                                                               
CLOSE4   M:CLOSE  M:LO,(SAVE)                                                   
         M:CLOSE  M:LL,SAVE                                                     
         B        0,LNK                                                         
         FIN                                                                    
         PAGE                                                                   
***************************************************                             
*  DELETE SPECIFIED RECORDS                       *                             
*    P1 = FIRST SEQ. NUMBER TO DELETE             *                             
*    P2 = LAST SEQ. NUMBER TO DELETE              *                             
*    R1 = SEQ. NUMBER OF LAST RECORD READ         *                             
*    R2 = NUMBER OF RECORDS DELETED               *                             
*    CC1=1 IF LAST SEQ # PASSED; CC1=0 OTHERWISE  *                             
***************************************************                             
*                                                                               
*                                                                               
DELETE   EQU      %                                                             
         PUSH     (X2,T1)           SAVE REGS                                   
         LI,T1    0                 USE T1 TO COUNT # OF RECS DELETED           
*                                                                               
*        DELETE RECORDS VIA:                                                    
*                 READ N                                                        
*                 READ N+1                                                      
*                 DELETE N                                                      
*                 READ N+2                                                      
*                 DELETE N+1                                                    
*                 ETC.                                                          
         BAL,LNK  READNXTRANDOM     READ 1ST SEQ # OR NEXT HIGHEST #            
*                                                                               
*  READ AND DELETE UNTIL LAST SEQ # READ OR PASSED                              
*                                                                               
DL10     CW,R1    L(EOF)            WAS AN EOF READ                             
         BE       DL30              YES - GO TYPE ERROR MESSAGE                 
         CW,P2    R1                NO - WAS INPUT SEQ # >= LAST SEQ #          
         BLE      DL15              YES - GO FINISH UP                          
         STW,R1   DELNXT            N TO DELETE BUFFER                          
         BAL,LNK  DELETERECORD                                                  
         AI,T1    1                 BUMP DELETED RECORD COUNTER                 
         LW,P1    DELNXT                                                        
         BAL,LNK  READNXTRANDOM                                                 
         DO       S(0,1,1)                                                      
         LW,P1    DELNXT                                                        
         AND,P1    =X'FFFFFF'       GET RID OF THE BYTE COUNT                   
         STW,P1   INTFLAG1                                                      
         FIN                                                                    
         B        DL10              N+1 IS OK, SET TO DELETE IT                 
*                                                                               
*  LAST SEQ # HIT OR PASSED: IF HIT, FINISH UP AND EXIT WITH CC1=0              
*                                                                               
DL15     BL       DL20              WAS LAST SEQ # PASSED                       
         BAL,LNK  DELETERECORD      NO, WAS HIT - DELETE IT                     
         DO1      S(0,1,1)                                                      
         STW,R1   INTFLAG1                                                      
         AI,T1    1                 INCR DELETE COUNT                           
        LW,P1    T1                                                             
         CI,P1     1                DON'T SAY ANYTHING IF ITS ONLY 1            
         BLE      DL17              DONT REPORT ONE OR ZERO                     
         MOVEMSG,T1  MSG6,X2                                                    
         LI,P2    BA(MSGBUF)+1                                                  
        BAL,LNK  BINTODEC                                                       
        BAL,LNK   TYPEMSG                                                       
         DATA     MSGBUF                                                        
DL17     EQU      %                                                             
         PULL     (X2,T1)           RESTORE REGS                                
         LCI      0                                                             
         B        0,LNK             EXIT WITH CC1=0                             
*                                                                               
*  LAST SEQ # WAS PASSED: EXIT WITH CC1=1                                       
*                                                                               
DL20    LW,P1    T1                                                             
         CI,P1     1                DON'T SAY ANYTHING IF ITS ONLY 1            
         BLE      DL25              B IF ZERO OR ONE DELETIONS                  
         MOVEMSG,T1  MSG6,X2                                                    
         LI,P2    BA(MSGBUF)+1                                                  
         BAL,LNK  BINTODEC                                                      
         BAL,LNK  TYPEMSG                                                       
         DATA     MSGBUF                                                        
DL25     EQU      %                                                             
         PULL     (X2,T1)            RESTORE REGS                               
         LCI      8                                                             
         B        0,LNK             EXIT WITH CC1=1                             
*                                                                               
*  ERROR: EOF HIT                                                               
*                                                                               
DL30     BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'                           
         DATA     MSGBUF                                                        
         B        DL20              GO EXIT WITH CC1=1                          
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*****************************************************                           
*  DELETE FILE                                      *                           
*    P1 = ADDR OF FILE ID IN CDT                    *                           
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *                           
*****************************************************                           
*                                                                               
*                                                                               
         LOCAL    %20,%50                                                       
DELETEFILE        EQU %                                                         
         PUSH     (X1,P3)                                                       
         LI,P2    DF%ABN                                                        
         STW,P2   O2%FPT+2                                                      
         LI,P2    4                 INOUT                                       
         STW,P2   O2%FPT+5                                                      
         LI,T1    O2%NAME                                                       
         LI,T2    O2%ACCT                                                       
         LI,P3    O2%PASS                                                       
         BAL,LNK  OPENINIT                                                      
         CAL1,1   O2%FPT                                                        
         M:CLOSE  F:EO,(REL)        FILE EXISTS, SO CLOSE AND RELEASE           
         PULL     (X1,P3)                                                       
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
DF%ABN   RES      0                                                             
         LB,X1    P3                                                            
         CI,X1    3                                                             
         BNE      BADIO1                                                        
         PULL     (X1,P3)                                                       
         LCI      8                                                             
         B        0,LNK                                                         
         FIN                                                                    
*                                                                               
*  ERROR: BAD I/O                                                               
*                                                                               
BADIO    RES      0                                                             
         LW,X1    D1                MOVE CODE TO X1.                            
BADIO1   RES      0                 ENTER HERE IF CODE IN X1.                   
         MOVEMSG,D1  IOERRMSG,X2                                                
         SCS,X1   -4                BUILD ERROR CODE                            
         LB,X2    HEXCHAR,X1                                                    
         STB,X2   MSGBUF+IOERRCOD-IOERRMSG                                      
         SLS,X1   -28                                                           
         LB,X2    HEXCHAR,X1                                                    
         LI,X3    1                                                             
         STB,X2   MSGBUF+IOERRCOD-IOERRMSG,X3                                   
         BAL,LNK  TYPEMSG                                                       
         DATA     MSGBUF                                                        
         DO       MODE=1                                                        
         CAL3,6   0                                                             
         ELSE                                                                   
         M:XXX                                                                  
         FIN                                                                    
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*****************************                                                   
*  DELETE LAST RECORD READ  *                                                   
*****************************                                                   
*                                                                               
*                                                                               
DELETERECORD      EQU %                                                         
         M:DELREC F:EI,(KEY,LASTKEY)                                            
         B        0,LNK                                                         
         FIN                                                                    
         PAGE                                                                   
****************************************************                            
*  MOVE SEQUENCE NUMBER                            *                            
*    P1 = SEQ. NUMBER TO CONVERT                   *                            
*    P2 = BYTE ADDR AT WHICH TO PUT STRING         *                            
*    WORD AFTER BAL = 4 CHARS TO APPEND TO STRING  *                            
*    R1 = NUMBER OF CHARS IN RESULTANT STRING      *                            
****************************************************                            
*                                                                               
*                                                                               
MOVESEQ  EQU      %                                                             
         PUSH     (X4,LNK)          SAVE REGS                                   
         LW,X4    LNK               SAVE LINK                                   
         STW,P2   TEMPBLCK+3        SAVE P2                                     
         LI,P2    BA(TEMPBLCK)                                                  
         BAL,LNK  BINTODEC          CONVERT SEQ # TO EBCDIC: ' DDDDDDD'         
         LW,P2    TEMPBLCK+3        RESTORE P2                                  
         LI,X1    1                                                             
         DO       0                 DONT DO                                     
         LI,X2    3                                                             
         LI,D0    ' '                                                           
         CB,D0    TEMPBLCK,X1       CALC X1=POSITION OF 1ST NON-ZERO            
         BNE      MQ10               CHAR OR 4TH DIGIT                          
         AI,X1    1                                                             
         BDR,X2   %-3                                                           
         FIN                                                                    
*                                                                               
*  SUPPRESS TRAILING ZEROES                                                     
*                                                                               
MQ10     LI,P1    7                                                             
         DO       0                 DONT DO                                     
         LI,X2    3                                                             
         CB,D0    TEMPBLCK,P1       CALC P1=POSITION OF 1ST NON-ZERO            
         BNEZ     MQ20               DIGIT FROM RIGHT OF 4TH DIGIT              
         AI,P1    -1                                                            
         BDR,X2   %-3                                                           
         FIN                                                                    
*                                                                               
*  BUILD STRING TO LEFT OF DECIMAL POINT                                        
*                                                                               
MQ20     LB,D0    TEMPBLCK,X1       MOVE NON-ZERO DIGITS TO LEFT OF             
         STB,D0   0,P2               DEC. PT. TO ADDR IN P2 (AT LEAST           
         AI,P2    1                  1 DIGIT MOVED)                             
         AI,X1    1                                                             
         CI,X1    4                                                             
         BLE      MQ20                                                          
         LI,D0    '.'               MOVE '.' TO ADDR IN P2                      
         STB,D0   0,P2                                                          
         AI,P2    1                                                             
*                                                                               
*  BUILD STRING TO RIGHT OF DECIMAL POINT                                       
*                                                                               
MQ25     CW,P1    X1                MOVE (IF ANY) DIGITS TO RIGHT OF            
         BL       MQ30               DEC. PT. TO ADDR IN P2                     
         LB,D0    TEMPBLCK,X1                                                   
         CI,D0    ' '                                                           
         BNE      %+2                                                           
         LI,D0    '0'               BLANK MEANS SUPPRESSED LEADING 0            
         STB,D0   0,P2                                                          
         AI,P2    1                                                             
         AI,X1    1                                                             
         B        MQ25                                                          
*                                                                               
*  APPEND 4 SPECIFIED CHARS                                                     
*                                                                               
MQ30     LI,X1    0                                                             
         LI,X2    4                                                             
MQ30A    LB,D0    *X4,X1            MOVE 4 CHARS SPECIFIED TO END OF            
         BEZ      %+3                THIS STRING, SKIPPING 0 CHARS              
         STB,D0   0,P2                                                          
         AI,P2    1                                                             
         AI,X1    1                                                             
         BDR,X2   MQ30A                                                         
         LW,R1    P2                                                            
         PULL     (X4,LNK)          RESTORE REGS                                
         SW,R1    P2                CALC R1=NUMBER OF CHARS IN STRING           
         B        1,LNK             EXIT                                        
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*****************************************************                           
*  OPEN UPDATE FILE                                 *                           
*  OPEN UPDATE FILE (OPEN1 OPENS COPY INPUT FILE)   *                           
*    P1 = ADDR OF FILE ID IN CDT                    *                           
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *                           
*    CC2=1 IF FILE IS NOT KEYED; CC2=0 OTHERWISE    *                           
*****************************************************                           
*                                                                               
*                                                                               
         LOCAL    %20,%90                                                       
OPEN     EQU      %                                                             
         PUSH     (X1,P3)                                                       
         LI,P2    4                 INOUT                                       
         DO       S(1,1,0)                                                      
         B        %20                                                           
*                                                                               
*                                                                               
OPEN1    EQU      %                                                             
         PUSH     (X1,P3)                                                       
         LI,P2    1                 INPUT                                       
         FIN                                                                    
*                                                                               
*                                                                               
%20      RES      0                                                             
         STW,P2   O%FPT+5                                                       
         LI,P2    O%ABN                                                         
         STW,P2   O%FPT+2                                                       
         LI,T1    O%NAME            SET ADDRESS REGISTERS FOR                   
         LI,T2    O%ACCT                STORING PARAMETERS INTO                 
         LI,P3    O%PASS                FPT.                                    
         BAL,LNK  OPENINIT                                                      
         CAL1,1   O%FPT             OPEN FILE                                   
         LW,X1    F:EI+5            FILE EXISTS.                                
         SLS,X1   -4                ORGANIZATION SHOULD BE KEYED.               
         AND,X1   XF                                                            
         CI,X1    2                                                             
         BNE      %90                                                           
         PULL     (X1,P3)           IT IS.                                      
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
%90      RES      0                                                             
         PULL     (X1,P3)                                                       
         LCI      4                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
O%ABN    RES      0                                                             
         LB,X1    P3                                                            
         CI,X1    3                                                             
         BNE      BADIO1                                                        
         PULL     (X1,P3)           NO FILE.                                    
         LCI      8                                                             
         B        0,LNK                                                         
         PAGE                                                                   
*****************************************************                           
*  OPEN (OUTPUT) FILE FOR COPYING                   *                           
*    P1 = ADDR OF FILE ID IN CDT                    *                           
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *                           
*****************************************************                           
*                                                                               
*                                                                               
         LOCAL    %20                                                           
OPEN3    PUSH     (X1,P3)                                                       
         LI,P2    2                 OUTPUT                                      
         B        %20                                                           
*                                                                               
*                                                                               
OPEN2    EQU      %                                                             
         PUSH     (X1,P3)                                                       
         LI,P2    4                 INOUT                                       
%20      STW,P2   O2%FPT+5                                                      
         LI,P2    O2%ABN                                                        
         STW,P2   O2%FPT+2                                                      
*                                                                               
         LI,T1    O2%NAME           SAME.                                       
         LI,T2    O2%ACCT                                                       
         LI,P3    O2%PASS                                                       
         BAL,LNK  OPENINIT                                                      
         CAL1,1   O2%FPT                                                        
         PULL     (X1,P3)                                                       
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
O2%ABN   RES      0                                                             
         LB,X1    P3                                                            
         CI,X1    3                                                             
         BNE      BADIO1                                                        
         LI,X1    2                 NO PREVIOUS FILE, OPEN FOR OUTPUT.          
         STW,X1   O2%FPT+5                                                      
         CAL1,1   O2%FPT                                                        
         PULL     (X1,P3)                                                       
         LCI      8                                                             
         B        0,LNK                                                         
         PAGE                                                                   
***********************************************                                 
*  INITIALIZE OPEN FPT                        *                                 
*    P1 = ADDR OF FILE ID IN CDT              *                                 
*    T1 = FPT ENTRY TO PUT FILE NAME IN       *                                 
*    T2 = FPT ENTRY TO PUT ACCOUNT NUMBER IN  *                                 
*    P3 = FPT ENTRY TO PUT PASSWORD IN        *                                 
***********************************************                                 
*                                                                               
*                                                                               
         LOCAL    %50,%60,%65,%70,%80                                           
OPENINIT EQU      %                                                             
         LW,X1    4BLNKS                                                        
         STW,X1   *T2                                                           
         STW,X1   *P3                                                           
         LI,X2    1                                                             
         STW,X1   *T2,X2                                                        
         STW,X1   *P3,X2                                                        
         LI,X2    -1                                                            
         LW,X1    L(X'02000202')    INITIALIZE ACCOUNT AND PASS CONTROLS        
         STW,X1   *T2,X2                                                        
         LW,X1    L(X'03010202')                                                
         STW,X1   *P3,X2                                                        
         LB,X2    *P1               MOVE FILE NAME TO BUFFER.                   
         STB,X2   *T1                   P1 POINTS TO IT.                        
         LB,X1    *P1,X2                                                        
         STB,X1   *T1,X2                                                        
         BDR,X2   %-2                                                           
         LB,X2    *T1               SKIP TO ACCOUNT. BYTE COUNT FROM FPT        
         AI,X2    4                                                             
         SLS,X2   -2                                                            
         AW,P1    X2                P1 NOW AT ACCOUNT                           
         LB,X2    *P1                                                           
         BEZ      %50               NO ACCOUNT                                  
         LB,X1    *P1,X2            MOVE ACCOUNT TO BUFFER                      
         AI,X2    -1                THIS LOOP PUTS NO BYTE COUNT INTO           
         STB,X1   *T2,X2            FPT.                                        
         AI,X2    0                                                             
         BGZ      %-4                                                           
         LB,X2    *P1               SKIP TO PASS               &                
         AI,X2    4                                                             
         SLS,X2   -2                                                            
         AW,P1    X2                P1 NOW POINTS TO PASS                       
         B        %60                                                           
*                                                                               
*                                                                               
%50      RES      0                                                             
         AI,P1    1                 STEP TO PASS                                
         LI,X1    -2                SET FPT FOR NO ACCOUNT, BY SAYING           
         STB,X2   *T2,X1                NO USABLE WORDS.                        
*                                                                               
*                                                                               
%60      RES      0                                                             
         LB,X2    *P1                                                           
         BEZ      %70               NO PASS                                     
*                                                                               
*                                                                               
%65      RES      0                                                             
         LB,X1    *P1,X2            MOVE PASSWORD WITH BYTE COUNT               
         AI,X2    -1                                                            
         STB,X1   *P3,X2                                                        
         AI,X2    0                                                             
         BGZ      %65                                                           
         B        %80                                                           
*                                            &                                  
*                                                                               
%70      RES      0                                                             
         LI,X1    -2                SET FPT FOR NO PASS, BY SAYING              
         STB,X2   *P3,X1                NO USABLE WORDS.                        
*                                                                               
*                                                                               
%80      RES      0                                                             
         B        0,LNK                                                         
         PAGE                                                                   
*****************************************************                           
*  OPEN NEW (OUTPUT ONLY) FILE                      *                           
*    P1 = ADDR OF FILE ID IN CDT                    *                           
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *                           
*****************************************************                           
*                                                                               
*                                                                               
OPENNEW  EQU      %                                                             
         PUSH     (X1,P3)                                                       
         LI,P2    ON%ABN                                                        
         STW,P2   O%FPT+2                                                       
         LI,P2    4                 INOUT                                       
         STW,P2   O%FPT+5                                                       
         LI,T1    O%NAME                                                        
         LI,T2    O%ACCT                                                        
         LI,P3    O%PASS                                                        
         BAL,LNK  OPENINIT                                                      
         CAL1,1   O%FPT                                                         
         PULL     (X1,P3)           FILE EXISTS.                                
         LCI      0                 NOTE.                                       
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
ON%ABN   RES      0                                                             
         LB,X1    P3                                                            
         CI,X1    3                                                             
         BNE      BADIO1                                                        
         LI,X1    2                 OPEN FOR OUTPUT.                            
         STW,X1   O%FPT+5                                                       
         CAL1,1   O%FPT                                                         
         PULL     (X1,P3)                                                       
         LCI      8                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
************************************************************                    
*        VERIFY CARRIAGE RETURN EXISTS ON OUTPUT RECORD.   *                    
************************************************************                    
*                                                                               
PUTCR    PUSH     LNK                                                           
         DO1      MODE=2                                                        
         BAL,LNK  TABCOMPRESS                                                   
         LW,LNK   CRFLAG            DO NOT INSERT CR WHEN FLAG IS               
         BNEZ     PUTCR2            NON-ZERO                                    
         LW,LNK   RECSIZE                                                       
         AI,LNK   -1                                                            
         LI,D1    X'15'                                                         
         CB,D1    CARDIMG,LNK                                                   
         BE       PUTCR2                                                        
*                                                                               
         AI,LNK   1                 IF NO CR                                    
         CI,LNK   MAXCLMN                                                       
         BL       %+3                                                           
         LI,LNK   MAXCLMN-1         (DO NOT GO BEYOND COL. 140)                 
         STW,LNK  RECSIZE                                                       
         STB,D1   CARDIMG,LNK       INSERT ONE                                  
         MTW,1    RECSIZE                                                       
*                                                                               
PUTCR2   PULL     LNK                                                           
         B        0,LNK                                                         
         FIN                                                                    
         PAGE                                                                   
***********************************************                                 
*  READ RANDOM RECORD OR NEXT HIGHEST ONE     *                                 
*    P1 = SEQ. NUMBER TO READ                 *                                 
*    R1 = SEQ. NUMBER ACTUALLY READ           *                                 
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *                                 
***********************************************                                 
*                                                                               
*                                                                               
         LOCAL    %20                                                           
READNXTRANDOM     EQU %                                                         
         PUSH     LNK                                                           
         BAL,LNK  READRANDOM                                                    
         BCS,8    %20                                                           
         LW,R1    LASTKEY           GOT IT, RETURN KEY.                         
         AND,R1   XFFFFFF                                                       
         PULL     LNK                                                           
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
%20      RES      0                                                             
         BAL,LNK  READSEQUEN        NOW GET NEXT KEY, IN R1.                    
         PULL     LNK                                                           
         LCI      8                                                             
         B        0,LNK                                                         
         PAGE                                                                   
         DO       S(1,1,0)                                                      
***********************************************                                 
*  READ RANDOM RECORD                         *                                 
*    P1 = SEQ. NUMBER TO READ                 *                                 
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *                                 
***********************************************                                 
*                                                                               
*                                                                               
READRANDOM        EQU %                                                         
         PUSH     (LNK,P3)                                                      
         BAL,LNK  BLANKBUF                                                      
         BAL,LNK  SETKEY            (P1) ARE KEY,I.E. SEQUENCE                  
         DO1      S(0,1,1)                                                      
         M:SETDCB F:EI,(ERR,RR%ERR)                                             
         M:READ   F:EI,;                                                        
                  (ERR,RR%ERR),;                                                
                  (WAIT),;                                                      
                  (SIZE,MAXCLMN),;                                              
                  (KEY,KBUF)                                                    
         BAL,LNK  SETLASTKEY                                                    
         PULL     (LNK,P3)                                                      
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
RR%ERR   RES      0                                                             
         LB,D1    P3                                                            
         CI,D1    X'43'                                                         
         BNE      BADIO                                                         
         PULL     (LNK,P3)                                                      
         LCI      8                                                             
         B        0,LNK                                                         
         PAGE                                                                   
********************************                                                
*  READ SEQUENTIAL RECORD      *                                                
*    R1 = SEQ. NUMBER READ IN  *                                                
********************************                                                
*                                                                               
         LOCAL    %10,%20                                                       
*                                                                               
READSEQUEN        EQU %                                                         
         PUSH     (LNK,P3)                                                      
         BAL,LNK  BLANKBUF                                                      
         DO1      S(0,1,1)                                                      
         M:SETDCB F:EI,(ABN,RS%ABN)                                             
         M:READ   F:EI,;                                                        
                  (WAIT),;                                                      
                  (SIZE,MAXCLMN),;                                              
                  (ABN,RS%ABN)                                                  
         BAL,LNK  SETLASTKEY                                                    
         LW,D1    F:EI+5            CHECK ORGANIZATION                          
         SLS,D1   -4                                                            
         AND,D1   XF                                                            
         LW,R1    *F:EI+10          RETURN SEQUENCE                             
         AND,R1   XFFFFFF                                                       
         CI,D1    2                                                             
         BE       %+2                                                           
         LI,R1    0                 ZERO IF NOT KEYED.                          
         PULL     (LNK,P3)                                                      
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
RS%ABN   RES      0                                                             
         LB,D1    P3                                                            
         CI,D1    6                                                             
         BNE      BADIO                                                         
         PULL     (LNK,P3)                                                      
         LW,R1    L(EOF)                                                        
*                                   PUT LAST SEQ # IN EOF MESG                  
         PUSH     (P1,R1)                                                       
         LI,P1    0                 INITIALIZE LASTKEY IN CASE SEQ              
         STW,P1   LASTKEY           BELOW TAKES ABN EXIT                        
         M:PRECORD F:EI,(ABN,RS%ABNABN),(REV)  POSN BEFORE LAST REC             
         M:READ   F:EI,(ERR,RS%ABNABN),(SIZE,MAXCLMN)  AND GET KEY              
         BAL,LNK  SETLASTKEY        IN CORE LOC LASTKEY                         
         FIN                                                                    
RS%ABNABN         EQU %               OR BYPASS SETTING IF TROUBLES             
         LI,R1    21                NUMBER OF TEXTC BYTES                       
         LW,P1    LASTKEY           LAST SEQ # READ                             
         AND,P1   XFFFFFF           ZAP TEXTC BYTE IN KEY                       
         MOVEMSG,P2  ERRM1,LNK                                                  
         LI,P2    BA(MSGBUF)+17                                                 
         BAL,LNK  MOVESEQ                                                       
         GEN4     EOM,0,0,0                                                     
         LI,P1    1                 START PAST TEXTC COUNT                      
RS%ABNEOM EQU     %                                                             
         LB,P2    MSGBUF,P1         GET BYTE LOOKING FOR EOM                    
         CI,P2    EOM                                                           
         BE       RS%ABNOUT         EXIT WHEN FOUND                             
         AI,P1    1                                                             
         B        RS%ABNEOM         KEEP GOING TILL FOUND                       
RS%ABNOUT       EQU %                                                           
         AI,P1    -1                POINT TO BYTE BEFORE EOM                    
         STB,P1   MSGBUF                                                        
         PULL     (P1,R1)                                                       
         B        0,LNK                                                         
         PAGE                                                                   
*********************************                                               
*  READ TELETYPE                *                                               
*    R1 = NUMBER OF CHARS READ  *                                               
*********************************                                               
*                                                                               
*                                                                               
READTELETYPE2     EQU %                                                         
         PUSH     (X1,X2),LNK                                                   
         LI,X2    1                 USE X2=1 FOR 'READTELETYPE2'                
         B        RT5                                                           
*                                                                               
*                                                                               
READTELETYPE      EQU %                                                         
         PUSH     (X1,X2),LNK                                                   
         LI,X2    0                 USE X2=0 FOR 'READTELETYPE'                 
RT5      RES      0                                                             
         DO       MODE=1                                                        
         CAL3,0   0                 READ A CHAR                                 
         EXU      RTSTBTBL,X2       PUT CHAR IN BUFFER                          
         AI,X1    1                 INCR CHAR COUNT                             
         CI,R0    CR                                                            
         BNE      %-4               LOOP UNTIL C/R                              
         LW,R1    X1                SET R1=COL. # OF C/R                        
         ELSE                                                                   
         LI,X1    1                                                             
         STW,X1   BUILDFLAG         NOT BUILD COMMAND                           
*                                                                               
RT10     LW,X1    RTADDTBL,X2                                                   
         LW,R0    PROMPT                                                        
         BEZ      %+3                                                           
         BAL,LNK  TYPEMSG                                                       
         DATA     PROMPT                                                        
         MTW,0    GOSEQ                                                         
         BLZ      RT11              B IF INPUT FROM SI                          
         MTW,0    FILETYPE                                                      
         BLZ      RT105             B IF NO EDIT FILE                           
         PUSH     P1,R1                                                         
         LW,P1    GOSEQ                                                         
         BAL,LNK  READNXTRANDOM     GET LINE                                    
         STW,R1   GOSEQ                                                         
         MTW,1    GOSEQ             NEXT LINE TO READ                           
         PULL     P1,R1                                                         
         LW,R0    L(EOF)                                                        
         CW,R0    GOSEQ                                                         
         BLE      RT105             B IF PAST EOF                               
         LI,X1    MAXCLMN-1                                                     
         LB,R0    CARDIMG,X1                                                    
         EXU      RTSTBTBL,X2                                                   
         BDR,X1   %-2               MOVE LINE INTO INPUT BUFFER                 
         LB,R0    CARDIMG                                                       
         EXU      RTSTBTBL,X2                                                   
         LW,X1    RECSIZE                                                       
         STB,X1   TPC%BUF           SET SIZE OF INPUT FOR LOGGING               
         B        RT12              B TO LOG                                    
RT105    RES      0                                                             
         LI,R0    -1                                                            
         STW,R0   GOSEQ             RESET GOSEQ                                 
RT11     RES      0                                                             
         PUSH     (T1,P3)           IN CASE OF EOF ABNORMAL                     
         CAL1,1   RT%FPT                                                        
         LI,R0    0                                                             
         STW,R0   SIEOF             FLAG: LAST READ WAS NOT EOF                 
         DO       S(1,1,0)                                                      
         M:DEVICE M:SI,(CORRES,M:LL)                                            
         ELSE                                                                   
         M:CORRES  (DCB1,M:SI),(DCB2,M:LL)                                      
         FIN                                                                    
         LW,R0    8                                                             
         LW,X1    M:SI+4            NR OF CHARS IN LINE                         
         SLS,X1   -17               RIGHT-JUSTIFIED                             
         STB,X1   TPC%BUF           SET IN LINE FOR TYPEMSG AND SAVE            
         PULL     (T1,P3)                                                       
         CI,R0    0                                                             
         BNE      RT15              DON'T LOG COMMAND IF SI=LL                  
RT12     AI,X1    -1                                                            
         EXU      RTLBTBL,X2                                                    
         AI,X1    1                                                             
         STB,R0   TPC%BUF,X1        MOVE INPUT LINE INTO BUFFER TO LOG          
         BDR,X1   RT12                                                          
         LI,X1    TPC%BUF                                                       
         STW,X1   DMY%TPM+1         SET UP CALL TO TYPEMSG                      
         BAL,X1   DMY%TPM           AND GO CALL IT                              
*                                                                               
RT15     LB,R1    TPC%BUF           RECOVER LENGTH                              
         FIN                                                                    
         LW,X1    R1                                                            
RT16     RES      0                                                             
         AI,X1    -1                                                            
         CI,X1    0                                                             
         BL       RT165             B IF NO BYTES LEFT                          
         EXU      RTLBTBL,X2        GET NEXT LOWER BYTE FROM INPUT              
         CI,R0    BL                                                            
         BE       RT16              B IF BLANK                                  
         CI,R0    CR                NON-BLANK FOUND                             
         BE       RT16              B IF CR                                     
         CI,X1    MAXCLMN-1         MUST ADD CR AS TERMINATOR                   
         BGE      %+2               B IF NO ROOM FOR ADDING A CR                
RT165    RES      0                 INCREMENT POINTER, INSERT CR                
         AI,X1    1                 INCREMENT CHARACTER POINTER                 
         LI,R0    CR                                                            
         EXU      RTSTBTBL,X2       INSERT OR ADD CR                            
         LW,R1    X1                                                            
         AI,R1    1                 SET NR OF BYTES RETURNED                    
         LI,R0    BL                BLANK                                       
RT17     RES      0                 BLANK OUT REST OF BUFFER                    
         AI,X1    1                                                             
         CI,X1    MAXCLMN                                                       
         BGE      %+3               B IF DONE                                   
         EXU      RTSTBTBL,X2       BLANK NEXT CHARACTER                        
         B        RT17                                                          
*                                                                               
         PULL     (X1,X2),LNK                                                   
         B        0,LNK             EXIT                                        
*                                                                               
*                                                                               
RTLBTBL  EQU      %                                                             
         LB,R0    CARDIMG,X1                                                    
         LB,R0    TTYIMG,X1                                                     
*                                                                               
RTSTBTBL EQU      %                                                             
         STB,R0   CARDIMG,X1                                                    
         STB,R0   TTYIMG,X1                                                     
*                                                                               
RTSTWTBL EQU      %                                                             
         STW,R0   CARDIMG-1,X1                                                  
         STW,R0   TTYIMG-1,X1                                                   
*                                                                               
         DO       S(0,1,1)                                                      
RTADDTBL EQU      %                                                             
         DATA     CARDIMG                                                       
         DATA     TTYIMG                                                        
         FIN                                                                    
         PAGE                                                                   
         DO       S(1,1,0)                                                      
******************************                                                  
*  RE-OPEN LAST UPDATE FILE  *                                                  
******************************                                                  
*                                                                               
*                                                                               
REOPEN   EQU      %                                                             
         CAL1,1   O%FPT                                                         
         B        0,LNK                                                         
         FIN                        S(1,1,0)                                    
         PAGE                                                                   
*                                                                               
*                                                                               
**************************************                                          
*                                    *                                          
*        SET STARTUP DEFAULTS        *                                          
*                                    *                                          
**************************************                                          
*                                                                               
*                                                                               
SET%DEFAULTS  RES   0                                                           
         PUSH     (P1,T1)                                                       
         LI,T1    0                                                             
         STW,T1   SV1STSET          START OF IMPLICIT SE                        
         STW,T1   FRSTCLMN          LOWER COL LIMIT                             
         LI,T1    1                                                             
         STW,T1   FILETYPE          EDIT IN PROGRESS FLAG                       
         STW,T1   SETFLAG           IMPLICIT SE FLAG                            
         LI,T1    MAXCLMN                                                       
         STW,T1   LASTCLMN          UPPER COL LIMIT+1                           
         LW,P1    L(9999999)                                                    
         STW,P1   LASTSET           END OF IMPLICIT SE                          
         BAL,LNK    READNXTRANDOM   FIND LAST REC OF FILE                       
         LW,R1    LASTKEY           GET LAST SEQ NR OF FILE                     
         AND,R1   XFFFFFF                                                       
         AW,R1    DFLTINCR          GET STARTUP NEXT INSERT                     
         CW,R1    L(9999999)                                                    
         BLE      %+2               B IF NOT TOO BIG                            
         LI,R1    0                 SET OK                                      
         STW,R1   NXINSRT           SET DEFAULT NEXT INSERT LINE                
         PULL     (P1,T1)                                                       
         B        *LNK                                                          
         DO       S(1,1,0)                                                      
         PAGE                                                                   
**************************************                                          
*  SET KEY FOR READ OR WRITE         *                                          
*    P1 = SEQ. NUMBER TO PUT IN KEY  *                                          
**************************************                                          
*                                                                               
*                                                                               
SETKEY   EQU      %                                                             
         STW,P1   KBUF                                                          
         LI,D1    3                                                             
         STB,D1   KBUF                                                          
         B        0,LNK                                                         
         FIN                                                                    
*                                                                               
*  SAVE KEY FROM LAST READ                                                      
*                                                                               
SETLASTKEY        EQU %                                                         
         PUSH     LNK                                                           
         DO       S(1,1,0)                                                      
         LW,D1    *F:EI+10                                                      
         STW,D1   LASTKEY                                                       
         LW,LNK   F:EI+4            SET RECORD SIZE RECEIVED                    
         SLS,LNK  -17                                                           
         STW,LNK  RECSIZE                                                       
         AI,LNK   -1                DELETE CR FROMIMAGE.  CHECKBOTH             
         LI,D1    X'15'             BTM                                         
         CB,D1    CARDIMG,LNK                                                   
         BE       SETK2                                                         
         LI,D1    X'0D'             AND UTS CR'S                                
         CB,D1    CARDIMG,LNK                                                   
         BE       SETK2                                                         
         BAL,LNK  SETEOD                                                        
         B        SETK6                                                         
SETK2    LI,D1    ' '               BLANK WILL NOT INTERFERE                    
         STB,D1   CARDIMG,LNK       WITH STRING EDITING.                        
         STW,LNK  RECSIZE                                                       
         ELSE                                                                   
         LW,R0    RSKEY             LAST KEY READ                               
         STW,R0   LASTKEY           LAST KEY FOR EDIT REFERENCE                 
         BAL,LNK  SETEOD            SET LINE LENGTH                             
         FIN                                                                    
SETK6    DO1      MODE=2                                                        
         BAL,LNK  TABEXPAND                                                     
         PULL     LNK                                                           
*                                                                               
*                                                                               
         B        0,LNK                                                         
         PAGE                                                                   
**************************************************                              
*  IN UTS VERSION, EACH RECORD SUBJECT TO        *                              
*  EDITING WILL HAVE EMBEDDED TAB CHARACTERS     *                              
*  EXPANDED ACCORDING TO THE CURRENT TAB         *                              
*  STOPS CONTAINED IN THE M:UC DCB.              *                              
**************************************************                              
*                                                                               
         DO       MODE=2                                                        
TABEXPAND         EQU %                                                         
         MTW,0    FILETYPE          IF NOT EDITING,                             
         BLZ      0,LNK             EXIT.                                       
         MTW,0    TABXFLAG                                                      
        BNEZ     0,LNK                                                          
         PUSH     (X3,LNK)                                                      
         LI,X3    0                 START AT FIRST TAB IN DCB.                  
         LI,X4    0                 START AT FIRST CHAR. IN CARDIMG             
         STW,X4   TABCFLAG          INDICATE DONT COMPRESS                      
TABX4    LI,P1    X'05'                                                         
TABX5    CB,P1    CARDIMG,X4                                                    
         BE       TABX10                                                        
         AI,X4    1                                                             
         CW,X4    RECSIZE                                                       
         BL       TABX5             WHEN OUT OF CHARACTERS,                     
*                                                                               
TABX7    PULL     (X3,LNK)          EXIT                                        
         B        0,LNK                                                         
*                                                                               
TABX10   LB,X1    M:UC+15,X3                                                    
         BNEZ     TABX15                                                        
*                                                                               
         AI,X3    0                 IF NO MORE TABS IN DCB, WE CAN              
         BNEZ     TABX7             EXIT, UNLESS THERE WERE NO TABS             
TABX12   MTW,0    TABERRFLAG        AT ALL.                                     
         BNEZ     TABX7                                                         
         MTW,1    TABERRFLAG                                                    
         BAL,LNK  TYPEMSG           IN THAT CASE, ERROR.                        
         DATA     UTSM8                                                         
         B        TABX7                                                         
*                                                                               
TABX15   AI,X1    -1                IS THIS TAB POSITION GREATER THAN           
         CW,X1    X4                POSITION OF TAB CODE.                       
         BG       TABX17                                                        
         AI,X3    1                 IF NOT, TRY NEXT TAB POSITION,              
         CI,X3    16                IF NOT AT MAX NBR OF TABS.                  
         BL       TABX10                                                        
         B        TABX7                                                         
*                                                                               
TABX17   LI,P1    ' '               PUT A BLANK OVER ACTUAL TAB CODE.           
         STB,P1   CARDIMG,X4                                                    
         MTW,1    TABCFLAG          TO INDICATE COMPRESS                        
         AI,X4    1                 INCREMENT TO NEXT BYTE.                     
         LW,X2    RECSIZE                                                       
         AI,X2    -1                DETERMINE LAST BYTE POSITION.               
*                                                                               
         SW,X1    X4                COMPUTE NUMBER OF BLANKS TO INSERT.         
         BEZ      TABX4             IF ZERO, ITERATE.                           
         AW,X1    X2                INCREMENT TO NEW LAST BYTE.                 
         STW,X1   RECSIZE           SET NEW RECORD SIZE.                        
         MTW,1    RECSIZE                                                       
TABX19   LB,P2    CARDIMG,X2        MOVE BYTES UP, STARTING AT TOP,             
         STB,P1   CARDIMG,X2        BLANKING AS WE GO.                          
         STB,P2   CARDIMG,X1                                                    
         AI,X1    -1                                                            
         AI,X2    -1                                                            
         CW,X2    X4                GO DOWN ONLY TO BYTE JUST ABOVE             
         BGE      TABX19            TAB BLANK.                                  
*                                                                               
         LW,X4    X1                INCREMENT BYTE POSITION TO LAST             
         AI,X3    1                                                             
         B        TABX4             MOVED, AND LOOK FOR MORE TAB CODES.         
*                                                                               
*                                                                               
*********************************************                                   
*  ACCORDINGLY, EACH RECORD WRITTEN MUST BE *                                   
*  RE-COMPRESSED IN ORDER TO MINIMIZE RAD   *                                   
*  STORAGE PER RECORD.                      *                                   
*********************************************                                   
*                                                                               
*                                                                               
TABCOMPRESS       EQU %                                                         
        MTW,0    FILETYPE                                                       
        BLZ      0,LNK                                                          
         MTW,0    TABCFLAG          IF NO COMPRESSION NEEDED, EXIT.             
         BEZ      0,LNK                                                         
         PUSH     (X3,P2)                                                       
         LI,X3    0                                                             
         LB,X1    M:UC+15,X3                                                    
         BNEZ     TABC13                                                        
TABC5    PULL     (X3,P2)           EXIT.                                       
         B        0,LNK                                                         
TABC10   LB,X1    M:UC+15,X3        SKIP TO LAST TAB POSITION+1                 
         BEZ      TABC15            IN DCB.                                     
TABC13   AI,X3    1                                                             
         CI,X3    16                                                            
         BL       TABC10                                                        
TABC15   AI,X3    -1                MOVE DOWN TO NEXT LOWER TAB                 
         BLZ      TABC5             POSITION. IF ALL GONE, EXIT.                
         LB,X1    M:UC+15,X3                                                    
         CW,X1    RECSIZE           DONT PUT ANY TAB CHARACTERS                 
         BG       TABC15            PAST END OF RECORD                          
         AI,X1    -2                MAKE INDEX TO NEXT LOWER BYTE.              
         LI,P1    ' '               IS NEXT LOWER BYTE A BLANK.                 
         CB,P1    CARDIMG,X1                                                    
         BNE      TABC15            IF NOT, WE CAN'T COMPRESS IMAGE.            
         LW,X4    X3                IF BLANK, WE CAN COMPRESS DOWN              
         AI,X4    -1                                                            
         BLZ      TABC17            TO NEXT LOWER TAB POSITION.                 
         LB,X4    M:UC+15,X4                                                    
         AI,X4    -2                TAB POSITION,                               
TABC17   LW,X2    X1                CREATE NEW INDEX,                           
TABC18   CB,P1    CARDIMG,X2        MOVE IT DOWN TO                             
         BNE      TABC20            A NON-BLANK,                                
         AI,X2    -1                                                            
         CW,X2    X4                OR TAB BOUNDARY.                            
         BG       TABC18                                                        
*                                                                               
TABC20   AI,X2    1                 MOVE BACK UP TO BLANK.                      
         AI,X1    1                 MOVE BACK UP TO TAB COLUMN.                 
         LI,P2    X'05'             PUT TAB CHARACTER OVER BLANK,               
         STB,P2   CARDIMG,X2                                                    
         AI,X2    1                 INCREMENT, AND CHECK IF MORE SPACE          
         CW,X2    X1                EXISTS BETWEEN INDICES.                     
         BE       TABC15            IF NOT, TRY NEXT LOWER TAB.                 
*                                                                               
TABC25   LB,P2    CARDIMG,X1        MOVE BYTES DOWN, STARTING AT TAB            
         STB,P2   CARDIMG,X2        COLUMN, AND CONTINUING UP TO END            
         AI,X2    1                 OF RECORD.                                  
         AI,X1    1                                                             
         CW,X1    RECSIZE                                                       
         BL       TABC25                                                        
*                                                                               
         STW,X2   RECSIZE           SET NEW, SMALLER RECORD SIZE,               
         B        TABC15            AND GET NEXT TAB.                           
         FIN                                                                    
         PAGE                                                                   
         DO       S(1,1,0)                                                      
*********************************                                               
*  TEST IF EDIT FILE IS ACTIVE  *                                               
*********************************                                               
*                                                                               
*                                                                               
TESTEDITACTIVE    EQU %                                                         
         MTW,0    FILETYPE          TEST IF EDIT FILE ACTIVE                    
         BLZ      0,LNK             NO - EXIT                                   
         PUSH     LNK               SAVE REG                                    
         BAL,LNK  CLOSE             CLOSE IT                                    
         BAL,LNK  TYPEMSG           TYPE: '..EDIT STOPPED'                      
         DATA     MSG4                                                          
         LI,D1    -1                SET FILETYPE=-1 (NOT OPEN)                  
         STW,D1   FILETYPE                                                      
         PULL     LNK               RESTORE REG                                 
         B        0,LNK             EXIT                                        
         FIN                                                                    
         PAGE                                                                   
********************************                                                
*  TYPE CARD IMAGE             *                                                
*    P1 = SEQ. NUMBER TO TYPE  *                                                
********************************                                                
*                                                                               
*                                                                               
TYPECARD EQU      %                                                             
         PUSH     (X1,LNK)          SAVE REGS                                   
         LW,X2    EODCLMN           SET X2=NUMBER OF SIGNIFICANT CHARS          
         AI,X2    1                                                             
         CI,P1    0                 IS SEQ # < 0 (MEANING DON'T TYPE IT)        
         BGE      TC25                                                          
*                                                                               
         DO       MODE=1                                                        
        LI,P1    72                72 CHARACTERS IF NO SEQ #                    
TC5      LI,X1    0                 INITIALIZE CHARACTER POSITION.              
         CI,X2    0                                                             
         BE       TC15              B IF LINE LENGTH IS ZERO                    
TC10     LB,R0    CARDIMG,X1        SEND CHARACTER                              
         CAL3,1   0                                                             
         AI,X1    1                 UPDATE CHARACTER POSITION.                  
         AI,X2    -1                IF ALL CHARACTERS GONE, GET OUT.            
         BLEZ     TC15                                                          
         BDR,P1   TC10                                                          
*                                                                               
         BAL,LNK  TYPEMSG           INTERSPERSE WITH CR/LF.                     
         DATA     MSG0                                                          
         LI,P1    72                NOW ITERATE ON 72.                          
         B        TC10                                                          
*                                                                               
TC15     BAL,LNK  TYPEMSG                                                       
         DATA     MSG0                                                          
         ELSE                                                                   
TC5      LW,X1    EODCLMN                                                       
         BLZ      TC20              B IF NONE                                   
         PUSH     X2                SAVE NR CHARS OF LINE                       
         AI,X2    -1                INDEX TO LAST CHAR IN LINE                  
TC10     LB,R0    CARDIMG,X1                                                    
         STB,R0   TPC%BUF,X2        MOVE CARD IMAGE INTO BUFFER                 
         AI,X2    -1                                                            
         AI,X1    -1                                                            
         BGEZ     TC10                                                          
         PULL     X2                RECOVER LINE LENGTH                         
TC20     RES      0                                                             
         PAGE                                                                   
         CAL1,1   TPC%FPT           WRITE LINE                                  
         FIN                                                                    
         PULL     (X1,LNK)          RESTORE REGS                                
         B        0,LNK             EXIT                                        
*                                                                               
*                                                                               
         DO       MODE=1                                                        
TC25     BAL,LNK  TYPESEQ           TYPE SEQ #                                  
         GEN4     BL,EOM,0,0                                                    
        LI,P1    62                62 CHARACTERS ALOWWS FOR SEQ #               
         ELSE                                                                   
TC25     LI,P2    BA(TPC%BUF)                                                   
         BAL,LNK  MOVESEQ           MOVE LINE NR INTO BUFFER                    
         GEN4     BL,BL,BL,BL       WITH FOUR TRAILING BLANKS                   
         AI,X2    9                 ADD NINE BYTES FOR LINE NR                  
         FIN                                                                    
         B        TC5                                                           
         PAGE                                                                   
**************************************************                              
*  TYPE COMMAND OR PARAMETER ERROR               *                              
*    WORD AFTER BAL = WORD ADDR OF TEXTC-STRING  *                              
**************************************************                              
*                                                                               
*                                                                               
TYPECERR EQU      %                                                             
         MTW,-1   ERRORCNT          IS ERROR CNT EXHAUSTED                      
         BLZ      1,LNK             YES - SKIP PRINTING ERROR MSG               
         PUSH     (X1,P1),LNK                                                   
         LW,P1    0,LNK                                                         
         MOVEMSG,D1  *P1,X1                                                     
         LI,X1    2                                                             
         LI,X2    'C'                                                           
         LB,D0    *CDTADR,X1        GET # OF CURRENT CMND IN CDT                
         B        TP10                                                          
*                                                                               
*                                                                               
TYPEPERR EQU      %                                                             
         PUSH     (X1,P1),LNK                                                   
         LW,P1    0,LNK             SET P1=ADDR OF STRING                       
         MTW,-1   CDT               TEST IF ONLY ONE CMND IN CDT                
         BGZ      TP20              NO - GO FIX UP ERROR MSG                    
         MOVEMSG,D1  *P1,X1                                                     
*                                                                               
*  ONLY ONE COMMAND IN CDT: PRINT 'P' ERROR AS IT STANDS                        
*                                                                               
TP5      LI,X2    'P'                                                           
         LW,D0    PARAMPSN          CALC POSITION OF CURRENT PARAMETER          
         AI,D0    -2                                                            
         SLS,D0   -1                                                            
*                                                                               
*  SEARCH FOR FIRST 'C(P)'                                                      
*                                                                               
TP10     RES      0                                                             
         LI,P1    BA(MSGBUF)                                                    
         LW,X1    P1                                                            
         AI,X1    1                 SEARCH DOWN STRING TO FIRST 'C(P)'          
         CB,X2    0,X1                                                          
         BNE      %-2                                                           
         AI,X1    1                 SET X1=ADDR OF CHAR AFTER 'C(P)'            
         OR,D0    XF0               CONVERT COUNT TO EBCDIC (MOD 10)            
         STB,D0   0,X1               AND PUT IN STRING                          
         DO       MODE=1                                                        
         LB,X2    0,P1              SET X2=LENGTH OF STRING                     
         AI,P1    1                                                             
         LB,R0    0,P1              GET CHAR FROM STRING                        
         CAL3,1   0                 TYPE IT                                     
         BDR,X2   %-3               LOOP                                        
         LI,R0    CR                TYPE: L/F + C/R                             
         CAL3,1   0                                                             
         LI,R0    LF                                                            
         CAL3,1   0                                                             
         ELSE                                                                   
         SLS,P1   -2                GO BACK TO WORD ADDRESS.                    
         STW,P1   DMY%TPM+1         SET UP ADDRESS FOR TYPEMSG.                 
         BAL,X1   DMY%TPM                                                       
         FIN                                                                    
         PULL     (X1,P1),LNK                                                   
         B        1,LNK             EXIT                                        
*                                                                               
* THERE IS MORE THAN ONE COMMAND IN CDT: ADD 'CN' TO ERROR MSG                  
*                                                                               
TP20     LW,D1    TPMSG             PUT '-C1' IF TEMPBLCK                       
         STW,D1   MSGBUF                                                        
         LB,X1    *P1               GET LENGTH OF ERROR MSG                     
         LW,X2    X1                                                            
         AI,X2    2                                                             
         STB,X2   MSGBUF            PUT LENGTH+2 IN MSGBUF                      
         LB,D1    *P1,X1            MOVE MSG TO MSGBUF AFTER                    
         STB,D1   MSGBUF,X2         '-C1'                                       
         AI,X2    -1                                                            
         BDR,X1   %-3               LOOP                                        
         LI,X1    2                                                             
         LB,D0    *CDTADR,X1        GET # OF CMND IN CDT                        
         AI,D0    '0'               CONVERT TO EBCDIC                           
         LI,X1    3                                                             
         STB,D0   MSGBUF,X1         PUT IT AFTER 'C' FOR FORM:                  
*                                   '-CNP1:ERROR MESSAGE'                       
         B        TP5               GO PROCESS 'P'                              
*                                                                               
*                                                                               
TPMSG    TEXTC    '-C1'                                                         
         PAGE                                                                   
**************************************************                              
*  TYPE MESSAGE                                                                 
*    WORD AFTER BAL = WORD ADDR OF TEXTC-STRING  *                              
**************************************************                              
*                                                                               
*                                                                               
TYPEMSG  EQU      %                                                             
         PUSH     (X1,X2),LNK       SAVE REGS                                   
         DO       MODE=1                                                        
         LW,X1    0,LNK             SET X1=BYTE ADDR OF STRING                  
         SLS,X1   2                     X2=NUMBER OF CHARS TO TYPE              
         LB,X2    0,X1                                                          
         AI,X1    1                                                             
         LB,R0    0,X1              GET CHAR FROM STRING                        
         CI,R0    EOM               IS CHAR=EOM                                 
         BE       TM5               YES - STOP TYPING                           
         CAL3,1   0                 TYPE IT                                     
         BDR,X2   %-5               LOOP                                        
         LI,R0    CR                TYPE: L/F + C/R                             
         CAL3,1   0                                                             
         LI,R0    LF                                                            
         CAL3,1   0                                                             
         ELSE                                                                   
         LW,LNK   0,LNK             GET ADDRESS OF MESSAGE AND BYTE             
         LI,X1    0                                                             
         LB,X2    *LNK                                                          
*                                   NOW RUN DOWN TO FIRST NON-ZERO              
*                                   CHARACTER                                   
         CB,X1    *LNK,X2                                                       
         BNE      %+2                                                           
         BDR,X2   %-2                                                           
*                                                                               
         LI,R0    EOM               IF EOM, DO NOT PRINT IT.                    
         CB,R0    *LNK,X2           BUT MARK NOT TO RETURN CARRIAGE.            
         BNE      TM4                                                           
*                                                                               
         DO       S(0,1,0)                                                      
         LW,X1    X2                                                            
         LB,R0    *LNK,X1           GET NEXT CHAR FROM MSG                      
         STB,R0   TPC%BUF,X1        STORE IN OUTPUT BUFFER                      
         BDR,X1   %-2                                                           
         LI,R0    SYNC                                                          
         STB,R0   TPC%BUF,X2        SYNC AT END:  NO CR/LF                      
         LI,LNK   TPC%BUF           ADDR OF CONVERTED MESSAGE                   
TM4      RES      0                                                             
         CAL1,1   TYPM%FPT                                                      
         ELSE                                                                   
         AI,X2    -1                STOP SHORT OF EOM                           
         M:DRC    M:LL,DRC          SET TO OUTPUT WITHOUT TRAILING CR           
TM4      RES      0                                                             
         CAL1,1   TYPM%FPT                                                      
         M:DRC    M:LL,NODRC        SET TO OUTPUT WITH TRAILING CR              
         FIN                                                                    
         FIN                                                                    
TM5      PULL     (X1,X2),LNK       RESTORE REGS.                               
         B        1,LNK             EXIT                                        
         PAGE                                                                   
***************************************************                             
*  TYPE SEQUENCE NUMBER                           *                             
*    P1 = SEQ. NUMBER TO TYPE                     *                             
*    WORD AFTER BAL = 4 CHARS TO APPEND TO SEQ #  *                             
***************************************************                             
*                                                                               
*                                                                               
TYPESEQ  EQU      %                                                             
         PUSH     (X2,LNK)          SAVE REGS                                   
         LW,X2    LNK                                                           
         LI,P2    BA(TEMPBLCK)                                                  
         BAL,LNK  BINTODEC          CONVERT SEQ # TO EBCDIC: ' DDDDDDD'         
         LW,D0    TEMPBLCK+1        PUT A '.' BETWEEN 4TH AND 5TH               
         LW,D1    0,X2               DIGITS AND APPEND 4 SPECIFIED              
         SLD,D0   -8                 CHARS TO END                               
         LB,P1    TEMPBLCK+1                                                    
         SLS,P1   8                                                             
         OR,P1    KPE                                                           
         STW,D0   TEMPBLCK+1        PUT THIS BACK IN TEMP BLOCK                 
         STH,P1   TEMPBLCK+1                                                    
         STW,D1   TEMPBLCK+2                                                    
         LW,P1    0,X2              GET 4TH SPECIFIED CHAR AND PUT              
         SLS,P1   24                 IN TEMP BLOCK                              
         STW,P1   TEMPBLCK+3                                                    
         LI,D0     ' '              ADD ZEROS BETWEEN DECIMAL                   
         LI,D1     '0'              POINT AND ANY NUMBER                        
         LI,X2     BA(TEMPBLCK)+6                                               
         CB,D0     0,X2             IF NECCESSARY.                              
         BNE       TS10             ZEROS COULD ONLY BE NEEDED                  
         STB,D1    0,X2             IN TEMPBLCK +6 AND +7.                      
         AI,X2     1                                                            
         CB,D0     0,X2             SEE IF SECOND ONE IS NECCESSARY             
         BNE       TS10                                                         
         STB,D1    0,X2                                                         
*                                                                               
*  MAKE STRING INTO A TEXTC-STRING AND TYPE                                     
*                                                                               
TS10     LI,P1    12                ATTACH COUNT TO MAKE A TEXTC-STRING         
         STB,P1   TEMPBLCK                                                      
         BAL,LNK  TYPEMSG           TYPE: 'DDD.DDDXXX' WITH LEADING             
         DATA     TEMPBLCK           0'S SUPPRESSED                             
         PULL     (X2,LNK)          RESTORE REGS                                
         B        1,LNK             EXIT                                        
         PAGE                                                                   
************************************************                                
*  UNPACK CDT FILE ID TO 5-WORD BLOCK FOR CP-R *                                
*   P1=WORD ADDRESS OF FILE ID STRING IN CDT   *                                
*   P2=WORD ADDRESS OF 5-WORD BLOCK            *                                
************************************************                                
UNPK%CPR%FID  RES  0                                                            
         PUSH     (X1,P2)                                                       
         LI,R0    0                                                             
         STW,R0   *P2               DEFAULT AREA NAME                           
         LW,R0    4BLNKS                                                        
         LI,X1    4                                                             
         STW,R0   *P2,X1            DEFAULT FILE AND ACCOUNT NAMES              
         BDR,X1   %-1                                                           
*                                                                               
         AI,P2    1                 FILE NAME ADDRESS                           
         LB,X1    *P1               FILE NAME LENGTH                            
UCF10    RES      0                                                             
         LB,R0    *P1,X1                                                        
         AI,X1    -1                                                            
         STB,R0   *P2,X1            MOVE FILE NAME                              
         BGZ      UCF10             B IF MORE BYTES TO MOVE (X1>0)              
*                                                                               
         AI,P2    -1                AREA NAME ADDRESS                           
         LB,X1    *P1               LENGTH OF FILE NAME (BYTES                  
         AI,X1    4                 ROUND UP TO WORDS                           
         SLS,X1   -2                                                            
         AW,P1    X1                POINT TO AREA NAME IN CDT                   
         LB,X1    *P1                                                           
         BEZ      UCF25             B IF AREA NAME UNSPECIFIED                  
*                                                                               
         LW,R0    *P1               GET AREA NAME (ALWAYS 1 WORD)               
         SLS,R0   -8                RT-ALIGN IT                                 
         AND,R0   XFFFF             MASK TWO CHARACTERS                         
         STW,R0   *P2               STORE IN BLOCK                              
*                                                                               
UCF25    RES      0                                                             
         AI,P2    3                 ACCOUNT NAME ADDRESS                        
         AI,P1    1                 POINTER TO ACCOUNT NAME IN CDT              
         LB,X1    *P1               ACCOUNT NAME LENGTH                         
         BEZ      UCF35             B IF NOT SPECIFIED                          
UCF30    RES      0                                                             
         LB,R0    *P1,X1                                                        
         AI,X1    -1                                                            
         STB,R0   *P2,X1            MOVE ACCOUNT NAME                           
         BGZ      UCF30             B IF MORE BYTES TO MOVE (X1>0)              
*                                                                               
UCF35    RES      0                                                             
         PULL     (X1,P2)                                                       
         B        *LNK                                                          
         PAGE                                                                   
         DO       S(1,1,0)                                                      
***********************************************                                 
*  WRITE RECORD IN COPY FILE                  *                                 
*    P1 = SEQ. NUMBER TO WRITE                *                                 
*    CC1=1 IF RECORD EXISTS; CC1=0 OTHERWISE  *                                 
***********************************************                                 
*                                                                               
*                                                                               
WRITE2   EQU      %                                                             
         PUSH     (LNK,P3)                                                      
         BAL,LNK  SETKEY                                                        
         BAL,LNK  PUTCR                                                         
         DO1      S(0,1,1)                                                      
         M:SETDCB F:EO,(ABN,W2%ABN)                                             
         M:WRITE  F:EO,;                                                        
                  (WAIT),;                                                      
                  (KEY,KBUF),;                                                  
                  (NEWKEY),;                                                    
                  (ABN,W2%ABN),;                                                
                  (SIZE,*RECSIZE)                                               
         PULL     (LNK,P3)                                                      
         LCI      0                 NON-EXISTENT                                
         B        0,LNK                                                         
*                                                                               
*                                                                               
W2%ABN   RES      0                                                             
         LB,D1    P3                                                            
         CI,D1    X'16'                                                         
         BNE      BADIO                                                         
*                                                                               
         PULL     (LNK,P3)                                                      
         LCI      8                 RECORD EXISTED                              
         B        0,LNK                                                         
         PAGE                                                                   
***********************************************                                 
*  WRITE NEW RANDOM RECORD                    *                                 
*    P1 = SEQ. NUMBER TO WRITE                *                                 
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *                                 
***********************************************                                 
*                                                                               
*                                                                               
WRITENEWRANDOM    EQU %                                                         
         PUSH     (LNK,P3)                                                      
         BAL,LNK  SETKEY                                                        
         BAL,LNK  PUTCR                                                         
         DO1      S(0,1,1)                                                      
         M:SETDCB F:EI,(ABN,WNR%ABN)                                            
         M:WRITE  F:EI,;                                                        
                  (WAIT),;                                                      
                  (KEY,KBUF),;                                                  
                  (NEWKEY),;                                                    
                  (SIZE,*RECSIZE),;                                             
                  (ABN,WNR%ABN)                                                 
         PULL     (LNK,P3)                                                      
         LCI      0                                                             
         B        0,LNK                                                         
*                                                                               
*                                                                               
*                                                                               
WNR%ABN  RES      0                                                             
         LB,D1    P3                                                            
         CI,D1    X'16'                                                         
         BNE      BADIO                                                         
         PULL     (LNK,P3)                                                      
         LCI      8                                                             
         B        0,LNK                                                         
         PAGE                                                                   
*********************************                                               
*  WRITE RANDOM RECORD          *                                               
*    P1 = SEQ. NUMBER TO WRITE  *                                               
*********************************                                               
*                                                                               
*                                                                               
WRITERANDOM       EQU %                                                         
         PUSH     LNK                                                           
         BAL,LNK  SETKEY                                                        
         BAL,LNK  PUTCR                                                         
         M:WRITE  F:EI,;                                                        
                  (WAIT),;                                                      
                  (KEY,KBUF),;                                                  
                  (ONEWKEY),;                                                   
                  (SIZE,*RECSIZE)                                               
         PULL     LNK                                                           
         B        0,LNK                                                         
         ELSE                                                                   
         TITLE    '***** CP-R INDEXED FILE MAINTENANCE *****'                   
         REF      DGRANIN                                                       
         REF      XGRANIN                                                       
         REF      DGRANALT                                                      
         REF      XGRANALT                                                      
         REF      GPRBFLAG                                                      
         REF      NOBRKFLG                                                      
         REF      DUPREC                                                        
         REF      ORDREC                                                        
         REF      ISNRREQ                                                       
         REF      DGRANNR                                                       
         REF      XGRANNR                                                       
         REF      NAVGRAN                                                       
         REF      LDGRAN                                                        
         REF      LWRGRAN                                                       
         REF      NAVDBYTE                                                      
         REF      RSKEY                                                         
         REF      ENTRYKEY                                                      
         REF      ENTRYGNR                                                      
         REF      ENTRYBD                                                       
         REF      ENTRYDBL                                                      
         REF      ENTRYFLG                                                      
         REF      GETXGRAN                                                      
         REF      GETXNR                                                        
         REF      GETXTOT                                                       
         REF      GETXKEY                                                       
         REF      GETXGNR                                                       
         REF      GETXBD                                                        
         REF      GETXDBL                                                       
         REF      GETXCSZ                                                       
         REF      GETXOXG                                                       
         REF      GETXSXG                                                       
         REF      GETXNEM                                                       
         REF      XBUFF                                                         
         REF      DBUFF                                                         
         PAGE                                                                   
*                                                                               
*        ASSEMBLY PARAMETERS FOR CP-R INDEXED FILE MANAGEMENT                   
*                                                                               
WXBLINK  EQU      0                 BACKWARD LINK IN INDEX GRAN                 
WXFLINK  EQU      1                 FOREWARD LINK IN INDEX GRAN                 
HXNAV    EQU      4                 NEXT AV ENTRY IN INDEX GRAN                 
BLENTRY  EQU      10                BYTE LENGTH OF INDEX ENTRY                  
BD1STENT EQU      12                BYTE DISPLACEMENT TO FIRST                  
*                                   ENTRY IN AN INDEX GRANULE                   
CF       EQU      1                 INDEX ENTRY CONTINUATION FLAG               
DF       EQU      2                 INDEX ENTRY DELETED FLAG                    
MAXNAV   EQU      101               NR OF ENTRIES IN INDEX GRAN                 
EOR      EQU      X'FB'             END OF COMPRESSED RECORD CODE               
MBLANK   EQU      X'FC'             MULTI-BLANK CODE                            
OFLOTYC  EQU      X'1C'             SCRATCH FILE OVERFLOW TYC                   
NOKEYTYC EQU      X'43'             KEY DOES NOT EXIST TYC                      
EOFTYC   EQU      X'06'             KEY PAST EOF TYC                            
EODTYC   EQU      X'05'             END OF DATA TYC                             
BSDRTYC  EQU      X'07'             BUF SMALLER THAN DATA READ                  
FNXTYC   EQU      X'03'             FILE NONEXISTENT                            
ANXTYC   EQU      X'70'             AREA NONEXISTENT                            
EOTTYC   EQU      OFLOTYC                                                       
         PAGE                                                                   
*                                                                               
*        CONSTANTS FOR CP-R INDEXED FILE MANAGEMENT                             
*                                                                               
ALLOT0   DATA     X'5A800000'       ALLOT FPT WORD 0                            
ALLOT1   DATA     X'FB040010'       ALLOT FPT WORD 1                            
         PAGE                                                                   
*                                                                               
*        MESSAGES ADDED FOR CP-R VERSION                                        
*                                                                               
CPRM1    TEXTC    '-SCRATCH FILE OVERFLOW'                                      
CPRM2    TEXTC    '-ILLEGAL LINE NR IN SUBJECT FILE'                            
CPRM3    TEXTC    '--REPEATED LINE NR...DELETED'                                
CPRM4    TEXTC    '--LINES REORDERED'                                           
CPRM5    DATA,1   BA(CPRM5E)-BA(CPRM5)-1                                        
         DATA,3   '-SA'                                                         
         TEXT     'VE FILE TOO SMALL:  FSI='                                    
CPRM5A   TEXT     '        '                                                    
CPRM5E   RES      0                                                             
CPRM6    TEXTC    '-FILE NOT KEYED'                                             
CPRM7    TEXTC    '-CAN''T ALLOT SAVE FILE'                                     
         TITLE    '***** OPENSCR *****'                                         
*                                                                               
*        PURPOSE: OPEN THE CP-R INDEXED SCRATCH FILE                            
*                                                                               
*        CALL:    BAL,LNK  OPENSCR                                              
*                                                                               
*        INPUT:   DCB F:EI MUST BE ASSIGNED TO THE SCRATCH FILE                 
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   6                                                             
*                                                                               
*        SUBROUTINES:  READX, OPENSCRI, CLOSESCR, UPKENTRY                      
*                                                                               
OPENSCR  RES      0                                                             
         PUSH     (X1,LNK),10                                                   
         LI,R0    0                                                             
         STW,R0   DGRANIN                                                       
         STW,R0   XGRANIN                                                       
         STW,R0   NAVDBYTE          NEXT AVAILABLE DATA BYTE                    
         LI,R0    1                                                             
         STW,R0   LDGRAN            LAST DATA GRAN                              
         LI,R0    2                                                             
         STW,R0   NAVGRAN           SET NEXT AVAILABLE GRAN                     
         LI,LNK   OPENSERR                                                      
         M:OPEN   F:EI,(ERR,CPRIOER),(ABN,CPRIOER)                              
         M:GETASN F:EI,(ORG,*R0),(GSI,*LNK)                                     
         CI,R0    0                                                             
         BNE      OPENSFNK          B IF FORMAT NOT UNBLOCKED                   
         CI,LNK   1024                                                          
         BNE      OPENSFNK          B  IF GSI NOT RIGHT                         
         LI,X1    0                 NEXT INDEX GRAN TO READ                     
         LW,P1    X1                                                            
         BAL,LNK  READX             SEE IF FILE HAS BEEN WRITTEN                
         LB,R0    10                                                            
         CI,R0    EODTYC                                                        
         BE       OPENS40           B IF NOT                                    
         LI,X2    -1                EXPECTED BACK LINK                          
OPENS10  RES      0                                                             
         CW,X1    NAVGRAN                                                       
         BL       %+3               B IF NEXT INDEX BLOCK NOT                   
*                                   PAST CURRENT KNOWN EOD                      
         STW,X1   NAVGRAN                                                       
         MTW,1    NAVGRAN           SET NEW END OF KNOWN DATA                   
         LW,P1    X1                GET NEXT INDEX GRAN NR                      
         BAL,LNK  READX             READ NEXT INDEX GRAN                        
         CI,10    0                 CHECK FOR ERRORS                            
         BNE      OPENSFNK          B IF EOD OR EOT                             
         LW,X1    XBUFF+WXBLINK     CHECK BACK LINK                             
         CW,X1    X2                                                            
         BNE      OPENSFNK          B IF NOT AS EXPECTED                        
         LW,X1    XBUFF+WXFLINK     CHECK FORWARD LINK                          
         CI,X1    -1                                                            
         BL       OPENSFNK          B IF TOO SMALL                              
         CI,X1    0                                                             
         BE       OPENSFNK          B IF FLINK TO ZERO                          
         LI,P1    HXNAV                                                         
         LH,X2    XBUFF,P1          CHECK NAV FIELD                             
         CI,X2    MAXNAV                                                        
         BG       OPENSFNK          B IF TOO BIG                                
         CI,X2    0                                                             
         BL       OPENSFNK          B IF TOO SMALL                              
         LI,P1    -1                INITIALIZE ENTRY POINTER                    
OPENS20  RES      0                                                             
         AI,P1    1                 POINT TO NEXT ENTRY                         
         CW,P1    X2                                                            
         BGE      OPENS30           B IF END OF THIS GRAN                       
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYGNR          ATTACHED DATA GRAN NR                       
         CI,R0    1                                                             
         BL       OPENSFNK          B IF TOO SMALL                              
         LW,D0    ENTRYBD           BYTE DISPLACEMENT TO DATA                   
         AW,D0    ENTRYDBL          ADD BYTE LENGTH                             
         CW,R0    LDGRAN                                                        
         BL       OPENS20           B IF NEW DATA BEFORE OLD                    
         BG       %+3               B IF DEFINITELY PAST OLD                    
         CW,D0    NAVDBYTE                                                      
         BL       OPENS20           B IF SAME GRAN BUT SOONER                   
         STW,R0   LDGRAN                                                        
         STW,D0   NAVDBYTE                                                      
         CW,R0    NAVGRAN                                                       
         BL       OPENS20           B IF DATA GRAN NOT PAST                     
*                                   KNOWN EOD                                   
         PUSH     R0,P1                                                         
         LW,P1    R0                                                            
         BAL,LNK  READD             READ DATA GRAN TO INSURE OK                 
         PULL     R0,P1                                                         
         CI,10    0                                                             
         BNE      OPENSFNK          B IF EOD OR EOT ON READ                     
         STW,R0   NAVGRAN                                                       
         MTW,1    NAVGRAN           SET NEW KNOWN EOD                           
         B        OPENS20                                                       
OPENS30  RES      0                                                             
         LW,X2    XGRANNR           GET EXPECTED BACK LINK                      
         CI,X1    0                                                             
         BGE      OPENS10           B IF MORE INDEX GRANS                       
         LW,R0    NAVGRAN           GET NEXT AVAILABLE GRAN                     
         AI,R0    -1                                                            
         STW,R0   LWRGRAN           SAVE NR OF LAST GRAN WRITTEN                
         B        OPENS90                                                       
OPENS40  RES      0                                                             
         BAL,LNK  CLOSESCR                                                      
         BAL,LNK  OPENSCRI          OPEN AND INITIALIZE                         
OPENS90  RES      0                                                             
         PULL     (X1,LNK),10                                                   
         B        *LNK                                                          
*                                                                               
OPENSFNK RES      0                 ERROR:  FILE NOT KEYED                      
         BAL,LNK  TYPEMSG                                                       
         DATA     CPRM6                                                         
         LI,LNK   MASTERPARSER      DCB ERROR RETURN                            
         M:CLOSE  M:EI,IGNERR                                                   
         B        MASTERPARSER                                                  
*                                                                               
OPENSERR RES      0                                                             
         LB,X1    10                ERROR CODE IN X1                            
         CI,X1    ANXTYC                                                        
         BE       %+3               B IF NONEXIST AREA                          
         CI,X1    FNXTYC                                                        
         BNE      BADIO1            B IF NOT NONEXIST FILE                      
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM14                                                        
         B        MASTERPARSER                                                  
*                                                                               
CPRIOER  RES      0                 CP-R DCB ERROR ROUTINE                      
         B        *LNK              GO TO ADDRESS IN LNK                        
         TITLE    '***** CLOSESCR *****'                                        
*                                                                               
*        PURPOSE: CLOSE THE CP-R INDEXED SCRATCH FILE                           
*                                                                               
*        CALL:    BAL,LNK  CLOSESCR                                             
*                                                                               
*        INPUT:   DCB F:EI MUST BE ASSIGNED TO THE SCRATCH FILE                 
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES:  WRGRANS                                                  
*                                                                               
CLOSESCR RES      0                                                             
         PUSH     LNK,10                                                        
         BAL,LNK  WRGRANS           WRITE OUT LAST DATA AND INDEX               
         LI,LNK   %+2               ERROR RETURN                                
         M:CLOSE  F:EI                                                          
         PULL     LNK,10                                                        
         B        *LNK                                                          
         TITLE    '***** WRGRANS *****'                                         
*                                                                               
*        PURPOSE: WRITE OUT INDEX AND DATA GRANULES FOR                         
*                 CP-R INDEXED SCRATCH FILE                                     
*                                                                               
*        CALL:    BAL,LNK  WRGRANS                                              
*                                                                               
*        INPUT:   NONE                                                          
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   1                                                             
*                                                                               
*        SUBROUTINES: NONE                                                      
*                                                                               
WRGRANS  RES      0                                                             
         PUSH     LNK                                                           
         LI,LNK   WRGERR            DCB ERROR ROUTINE                           
         LW,R0    DGRANIN                                                       
         BEZ      WRG50             B IF DATA GRAN NOT IN                       
         LW,R0    DGRANALT                                                      
         BEZ      WRG50             B IF DATA GRAN NOT ALTERED                  
         M:WRITE  F:EI,(ERR,WRGERR),(ABN,WRGERR),;                              
                  (BUF,DBUFF),(SIZE,1024),(BLOCK,*DGRANNR),WAIT                 
WRG50    RES      0                                                             
         LW,R0    XGRANIN                                                       
         BEZ      WRG100            B IF INDEX GRAN NOT IN                      
         LW,R0    XGRANALT                                                      
         BEZ      WRG100            B IF INDEX GRAN NOT ALTERED                 
         M:WRITE  F:EI,(ERR,WRGERR),(ABN,WRGERR),;                              
                  (BUF,XBUFF),(SIZE,1024),(BLOCK,*XGRANNR),WAIT                 
WRG100   RES      0                                                             
         LW,R0    DGRANALT                                                      
         OR,R0    XGRANALT                                                      
         BEZ      WRG110            B IF NO GRANS REWRITTEN                     
         LW,R0    XGRANNR           GET INDEX GRAN NR                           
         CW,R0    DGRANNR                                                       
         BGE      %+2               B IF INDEX GRAN IS LAST                     
         LW,R0    DGRANNR           GET DATA GRAN NR                            
         CW,R0    LWRGRAN                                                       
         BLE      WRG110            B IF NO NEW GRANS WRITTEN                   
         M:CLOSE  F:EI              FORCE DIRECTORY UPDATE                      
         STW,R0   LWRGRAN           SAVE NEW LAST GRAN NR WRITTEN               
WRG110   RES      0                                                             
         LI,R0    0                                                             
         STW,R0   DGRANALT                                                      
         STW,R0   XGRANALT                                                      
         PULL     LNK                                                           
         B        *LNK                                                          
*                                                                               
WRGERR   LB,X1    10                GET ERROR CODE IN X1                        
         B        BADIO1            REPORT ERROR AND ABORT                      
         TITLE    '***** OPENSCRI *****'                                        
*                                                                               
*        PURPOSE: OPEN AND INITIALIZE THE CP-R INDEXED                          
*                 SCRATCH FILE                                                  
*                                                                               
*        CALL:    BAL,LNK  OPENSCRI                                             
*                                                                               
*        INPUT:   DCB F:EI MUST BE ASSIGNED TO THE SCRATCH FILE                 
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES:  WRGRANS                                                  
*                                                                               
OPENSCRI RES      0                                                             
         PUSH     X2,LNK                                                        
         LI,R0    0                                                             
         LI,X2    256                                                           
         STW,R0   XBUFF-1,X2                                                    
         BDR,X2   %-1               CLEAR THE INDEX BUFFER                      
         LI,R0    -1                                                            
         STW,R0   XBUFF+WXBLINK     NO BACKWARDS LINK                           
         STW,R0   XBUFF+WXFLINK     NO FOREWARDS LINK                           
         STW,R0   LWRGRAN           SAVE NR OF LAST GRAN WRITTEN                
         LI,R0    0                                                             
         STW,R0   XGRANNR           CURRENT INDEX GRAN IS ZERO                  
         STW,R0   DGRANIN           DATA GRAN NOT IN                            
         STW,R0   NAVDBYTE          SET NEXT AVAILABLE BYTE                     
*                                   IN LAST DATA GRAN                           
         STW,R0   XGRANIN           INDEX GRAN NOT IN                           
         LI,R0    1                                                             
         STW,R0   LDGRAN            SET LAST DATA GRAN ALLOTTED                 
         LI,R0    2                                                             
         STW,R0   NAVGRAN           SET NEXT AVAILABLE GRAN NR                  
         LI,LNK   OPENSIER          ERROR RETURN                                
         M:OPEN   F:EI,(ERR,CPRIOER),(ABN,CPRIOER)                              
         M:REW    F:EI                                                          
         M:WEOF   F:EI                                                          
*        SET GRANULE SIZE FOR CP-R SCRATCH FILE                                 
         M:DFMODE F:EI,(GSI,1024),(ORG,U)                                       
         LI,R0    1                                                             
         STW,R0   XGRANIN           INDEX GRAN IS IN                            
         STW,R0   XGRANALT          AND ALTERED                                 
         BAL,LNK  WRGRANS           WRITE OUT INITIALIZED GRANULE               
         PULL     X2,LNK                                                        
         B        *LNK                                                          
OPENSIER  EQU     OPENSERR                                                      
         TITLE    '***** READD *****'                                           
*                                                                               
*        PURPOSE: READ IN A DATA GRANULE FROM CP-R SCRATCH FILE                 
*                                                                               
*        CALL:    BAL,LNK  READD                                                
*                                                                               
*        INPUT:   P1=GRANULE NUMBER                                             
*                                                                               
*        OUTPUT:  NORMAL:  10=0                                                 
*                 SCRATCH FILE OVERFLOW:  OFLOTYC IN REG 10 BYTE 0              
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES:  WRGRANS                                                  
*                                                                               
READD    RES      0                                                             
         PUSH     LNK,T1                                                        
         LI,10    0                                                             
         LW,R0    DGRANIN                                                       
         BEZ      READD10           B IF NO DATA GRAN IN                        
         CW,P1    DGRANNR                                                       
         BE       READD99           B IF REQD GRAN ALREADY IN                   
READD10  RES      0                                                             
         BAL,LNK  WRGRANS           WRITE OUT CURRENT GRANULES                  
         LI,R0    0                                                             
         STW,R0   DGRANIN           SET FLAG:  DATA GRAN NOT IN                 
         LI,LNK   READDERR          DCB ERROR ROUTINE                           
         M:READ   F:EI,(ERR,READDERR),(ABN,READDERR),;                          
                  (SIZE,1024),(BUF,DBUFF),(BLOCK,*P1),WAIT                      
         LI,R0    0                                                             
         STW,R0   DGRANALT          DATA GRAN NOT ALTERED                       
         LI,R0    1                                                             
         STW,R0   DGRANIN           DATA GRAN READ IN                           
         STW,P1   DGRANNR           SET CURRENT DATA GRAN NR                    
READD99  RES      0                                                             
         PULL     LNK,T1                                                        
         B        *LNK                                                          
*                                                                               
READDERR RES      0                                                             
         LB,R0    10                                                            
         CI,R0    EODTYC                                                        
         BE       *8                RETURN IF EOD ABNORMAL                      
         CI,R0    OFLOTYC                                                       
         BNE      WRGERR            B IF NOT EOF ERROR                          
         PULL     LNK,T1                                                        
         B        *LNK                                                          
         TITLE    '***** READX *****'                                           
*                                                                               
*        PURPOSE: READ IN AN INDEX GRANULE FROM CP-R SCRATCH FILE               
*                                                                               
*        CALL:    BAL,LNK  READX                                                
*                                                                               
*        INPUT:   P1=GRANULE NUMBER                                             
*                                                                               
*        OUTPUT:  NORMAL:  10=0                                                 
*                 SCRATCH FILE OVERFLOW:  OFLOTYC IN REG 10 BYTE 0              
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES:  WRGRANS                                                  
*                                                                               
READX    RES      0                                                             
         PUSH     LNK,T1                                                        
         LI,10    0                                                             
         LW,R0    XGRANIN                                                       
         BEZ      READX10           B IF NO INDEX GRAN IN                       
         CW,P1    XGRANNR                                                       
         BE       READX99           B IF REQD GRAN ALREADY IN                   
READX10  RES      0                                                             
         BAL,LNK  WRGRANS           WRITE OUT CURRENT GRANULES                  
         LI,R0    0                                                             
         STW,R0   XGRANIN           SET FLAG:  INDEX GRAN NOT IN                
         LI,LNK   READXERR          DCB ERROR ROUTINE                           
         M:READ   F:EI,(ERR,READXERR),(ABN,READXERR),;                          
                  (SIZE,1024),(BUF,XBUFF),(BLOCK,*P1),WAIT                      
         LI,R0    0                                                             
         STW,R0   XGRANALT          INDEX GRAN NOT ALTERED                      
         LI,R0    1                                                             
         STW,R0   XGRANIN           INDEX GRAN READ IN                          
         STW,P1   XGRANNR           SET CURRENT INDEX GRAN NR                   
READX99  RES      0                                                             
         PULL     LNK,T1                                                        
         B        *LNK                                                          
*                                                                               
READXERR EQU      READDERR                                                      
         TITLE    '***** UPKENTRY *****'                                        
*                                                                               
*        PURPOSE: UNPACK AN INDEX ENTRY FROM THE                                
*                 CP-R SCRATCH FILE                                             
*                                                                               
*        CALL:    BAL,LNK  UPKENTRY                                             
*                                                                               
*        INPUT:   P1=ENTRY NUMBER IN GRANULE                                    
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES: NONE                                                      
*                                                                               
UPKENTRY RES      0                                                             
         PUSH     (X2,P1)                                                       
         MI,P1    BLENTRY                                                       
         AI,P1    BD1STENT          P1=DISPLACEMENT TO FIRST BYTE               
         LI,X2    -4                                                            
         LB,R0    XBUFF,P1                                                      
         STB,R0   ENTRYKEY+1,X2                                                 
         AI,P1    1                                                             
         BIR,X2   %-3               GET KEY VALUE                               
         LI,X2    -4                                                            
         LB,R0    XBUFF,P1                                                      
         STB,R0   D1,X2                                                         
         AI,P1    1                                                             
         BIR,X2   %-3               GET GRAN NR AND BYTE DISPL                  
         SLD,D0   -10                                                           
         STW,D0   ENTRYGNR          GET ENTRY GRAN NR                           
         LI,D0    0                                                             
         SLD,D0   10                                                            
         STW,D0   ENTRYBD           GET ENTRY BYTE DISPLACEMENT                 
         LB,R0    XBUFF,P1                                                      
         STW,R0   ENTRYDBL          DATA BYTE LENGTH                            
         AI,P1    1                                                             
         LB,R0    XBUFF,P1                                                      
         STW,R0   ENTRYFLG          FLAGS                                       
         PULL     (X2,P1)                                                       
         B        *LNK                                                          
         TITLE    '***** PKENTRY *****'                                         
*                                                                               
*        PURPOSE: PACK AN INDEX ENTRY INTO THE CP-R SCRATCH                     
*                 FILE INDEX BUFFER                                             
*                                                                               
*        CALL:    BAL,LNK  PKENTRY                                              
*                                                                               
*        INPUT:   P1=ENTRY NR IN GRANULE                                        
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   2                                                             
*                                                                               
*        SUBROUTINES:  NONE                                                     
*                                                                               
PKENTRY  RES      0                                                             
         PUSH     (X2,P1)                                                       
         MI,P1    BLENTRY                                                       
         AI,P1    BD1STENT          P1=DISPLACEMENT TO FIRST BYTE               
         LI,X2    -4                                                            
         LB,R0    ENTRYKEY+1,X2                                                 
         STB,R0   XBUFF,P1                                                      
         AI,P1    1                                                             
         BIR,X2   %-3               PACK KEY VALUE                              
         LW,D0    ENTRYBD           GET BYTE DISPLACEMENT                       
         SLD,D0   -10                                                           
         LW,D0    ENTRYGNR          GET GRANULE NR                              
         SLD,D0   10                                                            
         LI,X2    -4                                                            
         LB,R0    D1,X2                                                         
         STB,R0   XBUFF,P1                                                      
         AI,P1    1                                                             
         BIR,X2   %-3               PACK GRAN NR AND BYTE DISPL                 
         LW,R0    ENTRYDBL                                                      
         STB,R0   XBUFF,P1          PACK DATA BYTE LENGTH                       
         AI,P1    1                                                             
         LW,R0    ENTRYFLG                                                      
         STB,R0   XBUFF,P1          PACK FLAGS                                  
         PULL     (X2,P1)                                                       
         B        *LNK                                                          
         TITLE    '***** FINDX *****'                                           
*                                                                               
*        PURPOSE: FIND INDEX ENTRY FOR SPECIFIED KEY                            
*                 IN CP-R SCRATCH FILE                                          
*                                                                               
*        CALL:    BAL,LNK  FINDX                                                
*                                                                               
*        INPUT:   P1=KEY VALUE                                                  
*                                                                               
*        OUTPUT:  R1=ENTRY NR OF ENTRY RETURNED                                 
*                 IF KEY IS FOUND:                                              
*                 ENTRY FOR KEY IS RETURNED, AND UNPACKED                       
*                 10=0                                                          
*                 IF KEY FOUND BUT DELETED:                                     
*                 ENTRY FOR KEY IS RETURNED, AND UNPACKED                       
*                 10=NOKEYTYC                                                   
*                 ENTRY NOT FOUND, NOT PAST END OF FILE:                        
*                 ENTRY FOR FIRST KEY FOLLOWING SPECIFIED                       
*                 ONE IS RETURNED, AND UNPACKED                                 
*                 10=NOKEYTYC                                                   
*                 ENTRY NOT FOUND, AND PAST EOF:                                
*                 NEXT AVAILABLE ENTRY IN LAST INDEX GRANULE                    
*                 IS RETURNED, NOT UNPACKED (SINCE NOT YET WRITTEN)             
*                 10=NOKEYTYC                                                   
*                                                                               
*        STACK:   6                                                             
*                                                                               
*        SUBROUTINES:  READX,UPKENTRY                                           
*                                                                               
FINDX    RES      0                                                             
         PUSH     (X2,T1)                                                       
         LI,10    0                                                             
         LW,P2    P1                GET KEY IN P2                               
         LI,T1    1                 INDICATE BACKWARD SCAN                      
         LW,R0    XGRANIN                                                       
         BNEZ     FINDX20           B IF INDEX GRAN IS IN                       
         LI,P1    0                 INDEX GRANULE TO READ                       
FINDX10  RES      0                                                             
         BAL,LNK  READX             READ THE INDICATED INDEX GRAN               
FINDX20  RES      0                                                             
         LI,P1    0                                                             
         BAL,LNK  UPKENTRY          BREAK OUT FIRST ENTRY IN GRAN               
         CW,P2    ENTRYKEY                                                      
         BGE      FINDX30           B IF KEY NOT BEFORE HERE                    
         CI,T1    0                                                             
         BEZ      FINDX40           B IF SCANNING FORWARD                       
         LW,P1    XBUFF+WXBLINK     GET BACKWARDS LINK                          
         BGEZ     FINDX10           B IF THERE IS A PRIOR GRAN                  
         B        FINDX40           ELSE, USE FIRST GRAN                        
FINDX30  RES      0                                                             
         LI,X2    HXNAV                                                         
         LH,P1    XBUFF,X2                                                      
         AI,P1    -1                LAST USED ENTRY                             
         BAL,LNK  UPKENTRY          UNPACK THE ENTY                             
         CW,P2    ENTRYKEY                                                      
         BLE      FINDX40           B IF KEY NOT PAST HERE                      
         LW,P1    XBUFF+WXFLINK     GET FORWARD LINK                            
         BLZ      FINDX40           B IF NO FOLLOWING INDEX GRAN                
         LI,T1    0                 SET FOR FORWARD SCAN                        
         B        FINDX10                                                       
FINDX40  RES      0                                                             
         LI,P1    0                 FIRST ENTRY IN GRANULE                      
         LI,X2    HXNAV             FOR LATER COMPARES                          
         LH,T1    XBUFF,X2                                                      
FINDX50  RES      0                                                             
         CW,P1    T1                                                            
         BGE      FINDX90           B IF PAST END OF GRAN                       
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         CW,P2    ENTRYKEY                                                      
         BLE      FINDX90           B IF PAST OR SAME AS GIVEN KEY              
         AI,P1    1                                                             
         B        FINDX50           CHECK NEXT ENTRY                            
FINDX90  RES      0                                                             
         LW,R1    P1                SET RETURN PARAMETER                        
         PULL     (X2,T1)                                                       
         CW,P1    ENTRYKEY                                                      
         BNE      FINDX95           B IF KEY FOUND NOT KEY NEEDED               
         LW,R0    ENTRYFLG                                                      
         CI,R0    DF                                                            
         BAZ      FINDX99           B IF KEY NOT DELETED                        
FINDX95  RES      0                                                             
         LI,R0    NOKEYTYC                                                      
         STB,R0   10                SET COMPLETION CODE                         
FINDX99  RES      0                                                             
         B        *LNK                                                          
         TITLE    '***** FINDNXX *****'                                         
*                                                                               
*        PURPOSE: FIND INDEX ENTRY FOR NEXT KEY AFTER                           
*                 SPECIFIED ONE.  IF NONE, INDICATE                             
*                 ENTRY FOR LAST KEY IN FILE.                                   
*                                                                               
*        INPUT:   P1=KEY FOR WHICH TO FIND SUCCESSOR                            
*                                                                               
*        OUTPUT:  SUCCESSOR FOUND:                                              
*                 R1=ENTRY NR OF SUCCESSOR,                                     
*                 XBUFF CONTAINS CORRECT INDEX GRAN                             
*                 10=0                                                          
*                 SUCCESSOR NOT FOUND:                                          
*                 R1=ENTRY NR OF LAST KEY OF FILE,                              
*                 XBUFF CONTAINS ITS INDEX GRAN,                                
*                 10=EOFTYC IN BYTE ZERO                                        
*                                                                               
*        STACK:   4                                                             
*                                                                               
*        SUBROUTINES:  FINDX, READX, UPKENTRY                                   
*                                                                               
FINDNXX  RES      0                                                             
         PUSH     (X2,LNK)                                                      
         LW,P2    P1                SAVE KEY IN P2                              
         BAL,LNK  FINDX             TRY TO FIND SPECIFIED KEY                   
         LI,10    0                                                             
         LW,P1    R1                GET ENTRY NR FOUND                          
FINDN10  RES      0                                                             
         LI,X2    HXNAV                                                         
         CH,P1    XBUFF,X2                                                      
         BGE      FINDN30           B IF PAST LAST ENTRY IN GRAN                
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYFLG                                                      
         CI,R0    DF                                                            
         BANZ     FINDN20           B IF DELETED ENTRY                          
         CW,P2    ENTRYKEY                                                      
         BL       FINDN99           B IF NEXT (NONDELETED) KEY                  
FINDN20  RES      0                                                             
         AI,P1    1                 SKIP CURRENT ENTRY                          
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BAZ      FINDN10           B IF NOT CONTINUED                          
         BAL,LNK  UPKENTRY          UNPACK NEXT ENTRY                           
         B        FINDN20           B TO SKIP IT, TOO                           
*        WE HAVE SCANNED PAST THE END OF THE INDEX GRANULE.                     
FINDN30  RES      0                                                             
         AI,P1    -1                BACK TO LAST USED ENTRY                     
         LW,R0    XBUFF+WXFLINK                                                 
         BLZ      FINDN40           B IF NO SUCCESSOR GRANULE                   
         LW,P1    R0                                                            
         BAL,LNK  READX             READ SUCCESSOR INDEX GRANULE                
         LI,P1    0                 POINT AT ITS FIRST ENTRY                    
         B        FINDN10                                                       
*        WE HAVE SCANNED PAST LAST KEY OF FILE                                  
*        SCAN BACK TO LAST ACTIVE KEY                                           
FINDN40  RES      0                                                             
         CI,P1    0                                                             
         BLE      FINDN41           B IF BACK TO GRAN START                     
         AI,P1    -1                FIND LAST KEY OF FILE                       
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BANZ     FINDN40           B IF CONTINUED                              
         AI,P1    1                 NEXT ENTRY IS FIRST OF SET                  
FINDN41  RES      0                                                             
         BAL,LNK  UPKENTRY          UNPACK IT                                   
         LW,R0    ENTRYFLG                                                      
         CI,R0    DF                                                            
         BAZ      FINDN43           B IF OK                                     
         AI,P1    -1                CANT USE DELETED ENTRY.                     
         BLZ      FINDN45           B IF MUST GET PRIOR GRAN                    
         B        FINDN40           B TO CONTINUE SCAN.                         
FINDN43  RES      0                                                             
         LI,R0    EOFTYC            EOF                                         
         STB,R0   10                                                            
         B        FINDN99                                                       
*        BACKED UP PAST GRAN START                                              
FINDN45  RES      0                                                             
         LW,P1    XBUFF+WXBLINK                                                 
         BGEZ     %+3               B IF PRIOR INDEX GRAN FOUND                 
         LI,P1    0                 POINT TO INDEX ENTRY 0                      
         B        FINDN43           END SEARCH                                  
         BAL,LNK  READX             READ THE PRIOR INDEX GRAN                   
         LI,X2    HXNAV                                                         
         LH,P1    XBUFF,X2          GET LAST ENTRY PLUS 1                       
         AI,P1    -1                LAST ENTRY NR                               
         B        FINDN40           B TO RESUME BACK SCAN                       
*        ENTRY FOUND                                                            
FINDN99  RES      0                                                             
         LW,R1    P1                SET RETURN PARAMETER                        
         PULL     (X2,LNK)                                                      
         B        *LNK                                                          
         TITLE    '***** GETX *****'                                            
*                                                                               
*        PURPOSE: TO GET THE NECESSARY INDEX ENTRIES                            
*                 FOR WRITING A RECORD TO THE CP-R                              
*                 SCRATCH FILE.  TO USE EXISTING AND DELETED                    
*                 ENTRIES WHEN POSSIBLE.  TO INSURE THAT                        
*                 THE ENTRIES OBTAINED INCLUDE ENOUGH ATTACHED                  
*                 DATA SPACE.                                                   
*                                                                               
*        CALL:    BAL,LNK  GETX                                                 
*                                                                               
*        INPUT:   P1=KEY VALUE.                                                 
*                 RECORD TEXT IS IN THE BUFFER LABELLED CARDIMG                 
*                                                                               
*        OUTPUT:  NORMAL:                                                       
*                 10=0 IF KEY PREVIOUSLY EXISTED, =NOKEYTYC IF NOT              
*                 CORRECT INDEX GRAN READ IN,                                   
*                 R1=ENTRY NR FOR FIRST ENTRY OBTAINED                          
*                 SCRATCH FILE OVERFLOW:                                        
*                 10=EOFTYC IN BYTE ZERO                                        
*                                                                               
*        STACK:   6                                                             
*                                                                               
*        SUBROUTINES: FINDX, READX, WRGRANS, PKENTRY                            
*                                                                               
GETX     RES      0                                                             
         PUSH     (X2,T2)                                                       
         LI,10    0                                                             
         PAGE                                                                   
*                                                                               
*        DETERMINE SIZE OF COMPRESSED RECORD                                    
         LI,X2    0                 BYTE POINTER IN RECORD                      
         LI,T1    0                 BLANK COUNT                                 
         LI,T2    1                 RECORD SIZE (START WITH EOR)                
         LW,P2    RECSIZE           LENGTH OF RECORD                            
GETX10   RES      0                                                             
         LB,R0    CARDIMG,X2        GET NEXT BYTE                               
         CI,R0    BL                                                            
         BNE      GETX12            B IF NOT BLANK                              
         AI,T1    1                 INCREMENT BLANK COUNT                       
         B        GETX18                                                        
GETX12   RES      0                                                             
         CI,T1    2                                                             
         BLE      %+2               B IF 2 OR LESS BLANKS                       
         LI,T1    2                 MORE THAN 2 USES ONLY 2 CHARS               
         AW,T2    T1                ADD BLANKS                                  
         AI,T2    1                 ADD CURRENT CHARACTER                       
         LI,T1    0                 RESET BLANK COUNT                           
GETX18   RES      0                                                             
         AI,X2    1                 INCREMENT BYTE POINTER                      
         BDR,P2   GETX10            DECR AND TEST BYTE COUNT                    
         CI,T1    2                                                             
         BLE      %+2               B IF 2 OR LESS BLANKS                       
         LI,T1    2                 MORE THAN 2 USES ONLY 2 CHARS               
         AW,T2    T1                ADD BLANKS                                  
         PAGE                                                                   
*                                                                               
*        FIND ANY EXISTING ENTRIES FOR THE KEY                                  
         STW,T2   GETXCSZ           SAVE COMPRESSED SIZE                        
         LI,R0    0                                                             
         STW,R0   GETXTOT           RESET NR OF ENTRIES FOUND                   
         STW,P1   GETXKEY           SAVE FOR LATER                              
         BAL,LNK  FINDX             FIND POSITION FOR INDEX ENTRY               
         STW,R1   GETXNR            SAVE FIRST ENTRY FOUND                      
         LW,R0    XGRANNR                                                       
         STW,R0   GETXGRAN          AND ITS GRAN NR                             
         CW,P1    ENTRYKEY                                                      
         BNE      GETX20            B IF KEY NOT FOUND                          
         LW,P1    GETXNR            GET FIRST ENTRY NR                          
GETX19   RES      0                                                             
         MTW,1    GETXTOT           INCREMENT NR OF ENTRIES TO USE              
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BAZ      GETX20            B IF NOT CONTINUED                          
         AI,P1    1                 INCREMENT ENTRY POINTER                     
         BAL,LNK  UPKENTRY          UNPACK NEXT ENTRY                           
         B        GETX19                                                        
         PAGE                                                                   
*                                                                               
*        DETERMINE AMOUNT OF DATA SPACE OBTAINED SO FAR                         
GETX20   RES      0                                                             
         LI,T1    0                 SPACE FOUND SO FAR                          
         LW,P1    GETXNR            GET NR OF FIRST ENTRY TO USE                
         LW,P2    GETXTOT           NR OF ENTRIES TO USE                        
         BEZ      GETX21            B IF NO ENTRIES YET                         
GETX202  RES      0                                                             
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         AW,T1    ENTRYDBL          ADD ATTACHED DATA LENGTH                    
         AI,P1    1                 POINT TO NEXT ENTRY                         
         BDR,P2   GETX202           UNPACK IT IF IT IS TO BE USED               
         CW,T1    GETXCSZ                                                       
         BGE      GETX90            B IF ENUF SPACE FOUND                       
         PAGE                                                                   
*                                                                               
*        TRY TO GET AN ADJACENT DELETED ENTRY                                   
*        FIRST CHECK THE ENTRY GROUP FOR THE FOLLOWING KEY                      
GETX21   RES      0                                                             
         LW,P1    GETXNR            FIRST ENTRY OBTAINED                        
         AW,P1    GETXTOT           FIRST ENTRY OF FOLLOWING GROUP              
         LI,X2    HXNAV                                                         
         CH,P1    XBUFF,X2                                                      
         BGE      GETX215           B IF PAST LAST ENTRY IN GRAN                
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYFLG                                                      
         CI,R0    DF                                                            
         BANZ     GETX219           B IF DELETED ENTRY                          
*                                                                               
*        FOLLOWING ENTRIES UNUSABLE. CHECK PRIOR GROUP.                         
GETX215  RES      0                                                             
         LW,P1    GETXNR            FIRST ENTRY OBTAINED                        
         BEZ      GETX22            NO PRIOR ENTRY                              
         AI,P1    -1                                                            
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYFLG                                                      
         CI,R0    DF                                                            
         BAZ      GETX22            B IF NOT A DELETED ENTRY                    
*        GET ALL CONTINUATIONS                                                  
GETX216  RES      0                                                             
         CI,P1    0                                                             
         BLE      GETX217           B IF NO PRIOR ENTRY                         
         AI,P1    -1                CHECK PRIOR ENTRY                           
         BAL,LNK  UPKENTRY          UNPACK ENTRY                                
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BANZ     GETX216           B IF CONTINUED                              
         AI,P1    1                 FIRST OF CONTINUED GROUP                    
GETX217  RES      0                                                             
         STW,P1   GETXNR            NEW FIRST ENTRY NR                          
GETX219  RES      0                                                             
         MTW,1    GETXTOT           COUNT THE CURRENT ENTRY                     
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BAZ      GETX20            B IF NOT CONTINUED                          
         AI,P1    1                 POINT TO CONTINUATION ENTRY                 
         B        GETX219                                                       
         PAGE                                                                   
*                                                                               
*        MUST BUILD A NEW ENTRY FOR MORE DATA SPACE                             
*        FIRST FIND THE ADDITIONAL DATA SPACE NEEDED                            
GETX22   RES      0                                                             
         SW,T1    GETXCSZ                                                       
         LCW,T1   T1                NR DATA BYTES STILL NEEDED                  
         CI,T1    BLENTRY           TRY TO GET AT LEAST AS MUCH                 
         BGE      %+2               AS IT TAKES TO INDEX IT                     
         LI,T1    BLENTRY                                                       
         STW,T1   GETXDBL           SAVE DATA BYTE LENGTH TO ATTACH             
         LI,R0    1024                                                          
         SW,R0    NAVDBYTE          BYTES LEFT IN LAST DATA GRAN                
         CW,R0    T1                                                            
         BL       GETX24            B IF NOT ENOUGH                             
*                                                                               
*        ENOUGH SPACE IN CURRENT DATA GRANULE                                   
GETX23   RES      0                                                             
         LW,P1    LDGRAN            LAST GRAN ALLOTED FOR DATA                  
         AW,T1    NAVDBYTE                                                      
         XW,T1    NAVDBYTE          ALLOT NEEDED BYTES FROM IT                  
         B        GETX25                                                        
         PAGE                                                                   
*                                                                               
*        MUST ALLOT A NEW DATA GRANULE                                          
GETX24   RES      0                                                             
         LI,LNK   GETXIOER          DCB ERROR RETURN                            
*        WRITE NEXT AVAILABLE GRANULE TO CHECK FOR OVERFLOW                     
         M:WRITE  F:EI,WAIT,(ERR,GETXIOER),(ABN,GETXIOER),;                     
                  (BUF,K1),(SIZE,1),(BLOCK,*NAVGRAN)                            
         LW,P1    NAVGRAN           NEXT AVAILABLE GRANULE IN FILE              
         BAL,LNK  READD             READ NEXT GRANULE                           
         LB,R0    10                                                            
         BNEZ     GETXIOER                                                      
         STW,P1   LDGRAN            SET LAST GRAN ALLOTTED FOR DATA             
         STW,T1   NAVDBYTE          SET NEXT AVAILABLE DATA BYTE                
         LI,T1    0                 DATA BYTE TO USE                            
         MTW,1    NAVGRAN           UPDATE NEXT AVAILABLE GRAN                  
GETX25   RES      0                                                             
         STW,T1   GETXBD            SET DATA BYTE DISPLACEMENT                  
         STW,P1   GETXGNR           SET DATA GRAN NR                            
         PAGE                                                                   
*                                                                               
*        NOW FIND THE INDEX ENTRY TO ADD                                        
GETX26   RES      0                                                             
         LI,X2    HXNAV                                                         
         LH,R0    XBUFF,X2          GET NEXT AVAILABLE INDEX ENTRY              
         CI,R0    MAXNAV                                                        
         BGE      GETX30            B IF NO ROOM IN THIS INDEX GRAN             
*                                                                               
*        BUILD NEW INDEX ENTRY IN CURRENT INDEX GRAN                            
*        FIRST MAKE SPACE AT THE RIGHT SPOT                                     
         MTH,1    XBUFF,X2          INCREMENT NAV                               
         LW,P1    R0                                                            
         MI,P1    BLENTRY                                                       
         LW,X2    P1                                                            
         AI,X2    -1+BD1STENT       BD OF LAST BYTE TO MOVE                     
         SW,R0    GETXNR                                                        
         LW,P1    R0                                                            
         MI,P1    BLENTRY                                                       
         LW,R0    P1                NR OF BYTES TO MOVE                         
         LW,P1    X2                                                            
         AI,P1    BLENTRY           DESTINATION OF LAST BYTE                    
GETX265  RES      0                                                             
         LB,P2    XBUFF,X2                                                      
         STB,P2   XBUFF,P1                                                      
         AI,X2    -1                                                            
         AI,P1    -1                                                            
         BDR,R0   GETX265           MAKE SPACE FOR NEW ENTRY                    
*        INSERT NEW ENTRY                                                       
         LCI      4                                                             
         LM,X2    GETXKEY           GET ENTRY BEING BUILT                       
         STM,X2   ENTRYKEY          PUT IN PACKING AREA                         
         LI,R0    0                                                             
         STW,R0   ENTRYFLG                                                      
         LW,P1    GETXNR                                                        
         BAL,LNK  PKENTRY           PACK ENTRY INTO GRANULE                     
         MTW,1    GETXTOT           COUNT ADDED ENTRY                           
         B        GETX90                                                        
         PAGE                                                                   
*                                                                               
*        A NEW ENTRY MUST BE INSERTED, AND THERE IS NOT                         
*        ENOUGH ROOM IN THE CURRENT INDEX GRANULE, SO                           
*        IT WILL BE SPLIT APPROXIMATELY IN HALF BETWEEN                         
*        ITSELF AND A NEWLY CREATED SUCCESSOR GRANULE                           
*                                                                               
GETX30   RES      0                                                             
         LW,R0    XGRANNR                                                       
         STW,R0   GETXOXG           SAVE ORIGINAL INDEX GRANULE                 
         LW,R0    XBUFF+WXFLINK                                                 
         STW,R0   GETXSXG           SAVE ITS CURRENT SUCCESSOR                  
*                                                                               
*        FIND THE START OF THE INDEX GROUP WHICH SPANS                          
*        THE MIDDLE OF THE CURRENT INDEX GRANULE.                               
*        IT WILL BE THE FIRST INDEX ENTRY TO MOVE                               
*                                                                               
         LI,P1    (MAXNAV+1)/2      PTR TO MIDDLE OF INDEX GRAN                 
GETX32   RES      0                                                             
         AI,P1    -1                                                            
         BAL,LNK  UPKENTRY          UNPACKTHE ENTRY                             
         LW,R0    ENTRYFLG                                                      
         CI,R0    CF                                                            
         BANZ     GETX32            B IF CONTINUED                              
GETX34   RES      0                                                             
         AI,P1    1                 NR OF FIRST ENTRY TO MOVE                   
*        IF THE INSERT POSITION WILL BE MOVED, CORRECT IT                       
         CW,P1    GETXNR                                                        
         BG       GETX40            B IF INSERT WILL NOT MOVE                   
         LW,R0    NAVGRAN                                                       
         STW,R0   GETXGRAN          NEW INSERTION GRAN NR                       
         LCW,R0   P1                                                            
         AWM,R0   GETXNR            NEW INSERT POSITION                         
GETX40   RES      0                                                             
         AI,P1    -MAXNAV           CONVERT MOVE POSITION                       
         LCW,P1   P1                TO                                          
         STW,P1   GETXNEM           NR OF ENTRIES TO MOVE                       
         PAGE                                                                   
*                                                                               
*        BUILD NEW GRANULE AND LINK IT IN                                       
*                                                                               
GETX50   RES      0                                                             
         LI,LNK   GETXIOER          DCB ERROR RETURN                            
*        WRITE NEXT AVAILABLE GRAN TO CHECK FOR OVERFLOW                        
         M:WRITE  F:EI,WAIT,(ERR,GETXIOER),(ABN,GETXIOER),;                     
                  (BUF,K1),(SIZE,1),(BLOCK,*NAVGRAN)                            
*                                                                               
*        UPDATE THE HEADER OF THE CURRENT GRANULE                               
*                                                                               
         LI,X2    HXNAV                                                         
         LH,R0    XBUFF,X2          OLD NEXT AVAILABLE ENTRY                    
         SW,R0    GETXNEM           MINUS NR OF ENTRIES TO MOVE                 
         STH,R0   XBUFF,X2          IS NEW NEXT AVAILABLE ENTRY                 
         LW,R0    NAVGRAN           NEXT AVAILABLE GRANULE                      
         STW,R0   XBUFF+WXFLINK     IS NEW SUCCESSOR GRANULE                    
         MTW,1    XGRANALT          FLAG INDEX GRAN ALTERED                     
         BAL,LNK  WRGRANS           WRITE OUT GRANULES (FREE DATA BUF)          
         LI,R0    0                                                             
         STW,R0   DGRANIN           MARK DATA GRAN NOT IN BUFFER                
*                                                                               
*        SAVE ENTRIES TO BE MOVED IN DATA BUFFER                                
*                                                                               
         LI,P2    MAXNAV*BLENTRY+BD1STENT-1  LAST BYTE TO MOVE                  
         LW,P1    GETXNEM                                                       
         MI,P1    BLENTRY                                                       
         LW,R0    P1                NR OF BYTES TO MOVE                         
         AI,P1    -1                LAST BYTE DESTINATION IN DATA BUF           
GETX69   RES      0                                                             
         LB,T1    XBUFF,P2                                                      
         STB,T1   DBUFF,P1                                                      
         AI,P2    -1                                                            
         AI,P1    -1                                                            
         BDR,R0   GETX69            MOVE ENTRIES INTO DATA BUFF                 
*                                                                               
*        UPDATE THE HEADER OF THE FORMER SUCCESSOR INDEX GRANULE                
*                                                                               
         LW,P1    GETXSXG           GRAN NR OF SUCCESSOR                        
         BLZ      GETX70            B IF THERE WAS NO SUCCESSOR                 
         BAL,LNK  READX             READ THE SUCCESSOR                          
         LW,R0    NAVGRAN           NEXT AVAILABLE GRANULE                      
         STW,R0   XBUFF+WXBLINK     IS NEW PREDECESSOR GRANULE                  
         MTW,1    XGRANALT          FLAG INDEX GRAN ALTERED                     
         PAGE                                                                   
*                                                                               
*        BUILD THE NEW INDEX GRANULE                                            
*                                                                               
GETX70   RES      0                                                             
         BAL,LNK  WRGRANS           FREE THE INDEX BUFFER                       
         MTW,1    XGRANIN           FLAG INDEX GRANULE IN BUFFER                
         MTW,1    XGRANALT          FLAG INDEX GRANULE ALTERED                  
         LW,R0    NAVGRAN                                                       
         STW,R0   XGRANNR           SET NEW INDEX GRAN NR                       
         MTW,1    NAVGRAN           UPDATE NEXT AVAILABLE GRAN NR               
*                                                                               
         LI,R0    0                                                             
         LI,X2    256                                                           
         STW,R0   XBUFF-1,X2        CLEAR THE NEW GRAN                          
         BDR,X2   %-1                                                           
*                                                                               
         LW,R0    GETXOXG                                                       
         STW,R0   XBUFF+WXBLINK     SET PREDECESSOR GRAN NR                     
         LW,R0    GETXSXG                                                       
         STW,R0   XBUFF+WXFLINK     SET SUCCESSOR GRAN NR                       
         LW,R0    GETXNEM                                                       
         LI,X2    HXNAV                                                         
         STH,R0   XBUFF,X2          SET NEXT AVAILABLE ENTRY NR                 
*                                                                               
         LI,P2    BD1STENT          BYTE DISP TO 1ST ENTRY                      
         LW,P1    GETXNEM           NR ENTRIES MOVED                            
         MI,P1    BLENTRY           TIMES BYTES PER ENTRY                       
         LW,R0    P1                R0=NR BYTES TO MOVE                         
         AI,P1    -1                P1=LAST BYTE IN DATA BUF                    
         AW,P2    P1                P2=DESTINATION OF LAST BYTE                 
GETX73   RES      0                                                             
         LB,T1    DBUFF,P1                                                      
         STB,T1   XBUFF,P2                                                      
         AI,P1    -1                                                            
         AI,P2    -1                                                            
         BDR,R0   GETX73            MOVE ENTRIES FROM PRIOR GRAN                
         LW,P1    GETXGRAN                                                      
         BAL,LNK  READX             READ INDEX GRAN FOR NEW ENTRY               
         B        GETX26            GO INSERT THE NEW ENTRY                     
         PAGE                                                                   
*                                                                               
*        INDEX ENTRIES AND DATA SPACE OBTAINED.                                 
*        LINK TOGETHER THE ENTRIES, AND KEY THEM.                               
GETX90   RES      0                                                             
         LW,X2    GETXTOT           NR OF ENTRIES OBTAINED                      
         LW,P1    GETXNR            ENTRY NR OF FIRST ONE                       
         LW,T1    GETXKEY           KEY FOR THIS ENTRY GROUP                    
         LI,T2    CF                CONTINUATION FLAG                           
GETX95   RES      0                                                             
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         STW,T1   ENTRYKEY          SET THE KEY                                 
         CI,X2    1                                                             
         BG       %+2               B IF NOT LAST ENTRY                         
         LI,T2    0                 NO CONTINUATION FLAG                        
         STW,T2   ENTRYFLG          SET FLAGS                                   
*        REMAINDER OF DATA IS ALREADY IN PLACE                                  
         BAL,LNK  PKENTRY           REPACK THE ENTRY                            
         AI,P1    1                                                             
         BDR,X2   GETX95                                                        
         MTW,1    XGRANALT          SET FLAG: INDEX GRAN ALTERED                
         LW,R1    GETXNR            SET RETURN PARAMETER                        
         PULL     (X2,T2)                                                       
         B        *LNK                                                          
*                                                                               
GETXIOER RES      0                                                             
         LB,R0    10                GET ERROR CODE                              
         CI,R0    OFLOTYC                                                       
         BNE      WRGERR            B IF NOT SCRATCH FILE OVERFLOW              
         PULL     (X2,T2)                                                       
         B        *LNK                                                          
         TITLE    '***** DATA PACK/UNPACK CONVENTIONS *****'                    
*                                                                               
*        THE FOLLOWING DEFINITIONS DESCRIBE REGISTER USE                        
*        CONVENTIONS IN THE SUBROUTINES USED TO MOVE                            
*        AND PACK/UNPACK DATA BETWEEN THE USER BUFFERS                          
*        AND THE DATA GRANULE BUFFER.  THESE SUBROUTINES                        
*        ARE                                                                    
*                 GETREC                                                        
*                 PUTREC                                                        
*                 GETRBYTE                                                      
*                 PUTRBYTE                                                      
*                                                                               
         OPEN     BLANKCT,NEXTX,STRPTR,STRCT,RECPTR,RECCT                       
BLANKCT  EQU      P2                BLANK COUNT FOR MULTIPLE                    
*                                   BLANK EXPANSION/COMPRESSION                 
NEXTX    EQU      P1                NEXT INDEX ENTRY TO ACCESS                  
*                                   WHEN CURRENT DATA AREA USED UP              
STRPTR   EQU      X1                POINTER TO NEXT BYTE IN USER                
*                                   I/O BYTE STRING                             
STRCT    EQU      X2                REMAINING BYTE COUNT FOR USER               
*                                   I/O BYTE STRING                             
RECPTR   EQU      X3                POINTER TO NEXT BYTE IN DATA                
*                                   GRANULE BUFFER                              
RECCT    EQU      X4                REMAINING BYTE COUNT FOR                    
*                                   CURRENT BLOCK OF DATA IN                    
*                                   DATA GRANULE BUFFER                         
         TITLE    '***** GETREC *****'                                          
*                                                                               
*        PURPOSE: GET A DATA RECORD GIVEN ITS INDEX ENTRIES                     
*                                                                               
*        CALL:    BAL,LNK  GETREC                                               
*                                                                               
*        INPUT:   P1=NEXTX=ENTRY NR FOR FIRST INDEX ENTRY TO USE                
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   8                                                             
*                                                                               
*        SUBROUTINES:  GETRBYTE                                                 
*                                                                               
*        NOTE:    SEE DATA PACK/UNPACK CONVENTIONS                              
*                                                                               
GETREC   RES      0                                                             
         PUSH     (X3,T1)                                                       
         LI,STRPTR  BA(CARDIMG)                                                 
         LI,STRCT   MAXCLMN                                                     
         LI,RECPTR  0                                                           
         LI,RECCT   0                                                           
         LI,BLANKCT 0                                                           
GETR10   RES      0                                                             
         CI,STRCT  0                                                            
         BLE      GETR90            B IF ENOUGH CHARACTERS IN                   
         CI,BLANKCT  0                                                          
         BNE      GETR30            B IF CURRENTLY EXPANDING BLANKS             
         BAL,LNK  GETRBYTE          GET NEXT BYTE FROM RECORD                   
         CI,T1    EOR                                                           
         BE       GETR90            B IF END OF RECORD ENCOUNTERED              
         CI,T1    MBLANK                                                        
         BE       GETR20            B IF MULTI-BLANK CODE                       
         STB,T1   0,STRPTR          PUT BYTE IN USER STRING                     
         AI,STRPTR  1                                                           
         AI,STRCT  -1                                                           
         B        GETR10                                                        
*        SET MULTI-BLANK COUNT                                                  
GETR20   RES      0                                                             
         BAL,LNK  GETRBYTE          GET NEXT BYTE FROM RECORD                   
         LW,BLANKCT  T1             SET BLANK COUNT                             
*        EXPAND MULTI-BLANK REPRESENTATION                                      
GETR30   RES      0                                                             
         LI,T1    BL                                                            
         STB,T1   0,STRPTR          PUT BLANK IN USER STRING                    
         AI,STRPTR  1                                                           
         AI,STRCT  -1                                                           
         AI,BLANKCT  -1             DECREMENT BLANK COUNT                       
         B        GETR10                                                        
GETR90   RES      0                                                             
         PULL     (X3,T1)                                                       
         B        *LNK                                                          
         TITLE    '***** PUTREC *****'                                          
*                                                                               
*        PURPOSE: PUT A DATA RECORD INTO THE CP-R INDEXED                       
*                 SCRATCH FILE, GIVEN THE INDEX ENTRIES FOR THE                 
*                 RECORD                                                        
*                                                                               
*        CALL:    BAL,LNK  PUTREC                                               
*                                                                               
*        INPUT:   P1=NEXTX=ENTRY NR FOR FIRST INDEX ENTRY TO USE                
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   8                                                             
*                                                                               
*        SUBROUTINES:  PUTRBYTE                                                 
*                                                                               
*        NOTE:    SEE DATA PACK/UNPACK CONVENTIONS                              
*                                                                               
PUTREC   RES      0                                                             
         PUSH     (X3,T1)                                                       
         LI,STRPTR  BA(CARDIMG)                                                 
         LW,STRCT   RECSIZE                                                     
         LI,RECPTR  0                                                           
         LI,RECCT   0                                                           
         LI,BLANKCT 0                                                           
PUTR10   RES      0                                                             
         CI,STRCT  0                                                            
         BLE      PUTR90            B IF END OF USER STRING                     
         LB,T1    0,STRPTR          GET NEXT USER BYTE                          
         AI,STRPTR  1                                                           
         AI,STRCT  -1                                                           
         CI,T1    BL                                                            
         BNE      PUTR20            B IF NOT BLANK                              
         AI,BLANKCT  1              INCREMENT BLANK COUNT                       
         B        PUTR10                                                        
PUTR20   RES      0                                                             
         CI,BLANKCT  1                                                          
         BL       PUTR50            B IF NO ACCUMULATED BLANKS                  
         BG       PUTR30            B IF MORE THAN ONE BLANK                    
         LI,T1    BL                                                            
         BAL,LNK  PUTRBYTE          PUT BLANK IN RECORD                         
         B        PUTR40                                                        
PUTR30   RES      0                                                             
         LI,T1    MBLANK                                                        
         BAL,LNK  PUTRBYTE          PUT MULTIPLE BLANK CODE IN                  
*                                   RECORD                                      
         LW,T1    BLANKCT                                                       
         BAL,LNK  PUTRBYTE          PUT BLANK COUNT IN RECORD                   
PUTR40   RES      0                                                             
         LI,BLANKCT  0              SET BLANK COUNT TO ZERO                     
         AI,STRPTR  -1                                                          
         LB,T1    0,STRPTR          GET THE BYTE WHICH ENDED BLKS               
         AI,STRPTR  1                                                           
PUTR50   RES      0                                                             
         BAL,LNK  PUTRBYTE          PUT NEXT BYTE IN RECORD                     
         B        PUTR10                                                        
PUTR90   RES      0                                                             
         CI,BLANKCT  1                                                          
         BL       PUTR95            B IF NO ACCUMULATED BLANKS                  
         BG       PUTR92            B IF MORE THAN ONE BLANK                    
         LI,T1    BL                                                            
         BAL,LNK  PUTRBYTE          PUT BLANK IN RECORD                         
         B        PUTR95                                                        
PUTR92   RES      0                                                             
         LI,T1    MBLANK            PUT MULTIPLE BLANK CODE                     
         BAL,LNK  PUTRBYTE          IN RECORD                                   
         LW,T1    BLANKCT           PUT BLANK COUNT                             
         BAL,LNK  PUTRBYTE          IN RECORD                                   
PUTR95   RES      0                                                             
         LI,T1    EOR                                                           
         BAL,LNK  PUTRBYTE          PUT EOR IN RECORD                           
         PULL     (X3,T1)                                                       
         B        *LNK                                                          
         TITLE    '***** GETRBYTE/PUTRBYTE *****'                               
*                                                                               
*        PURPOSE: GET/PUT ONE BYTE OF CP-R INDEXED FILE                         
*                 DATA                                                          
*                                                                               
*        CALL:    BAL,LNK  GETRBYTE                                             
*                        OR                                                     
*                 BAL,LNK  PUTRBYTE                                             
*                                                                               
*        INPUT:   REGISTERS SET UP AS IN DATA PACK/UNPACK                       
*                 CONVENTIONS                                                   
*                 FOR PUTRBYTE ONLY:                                            
*                 T1= BYTE TO INSERT                                            
*                                                                               
*        OUTPUT:  FOR GETRBYTE ONLY:                                            
*                 T1= BYTE OBTAINED                                             
*                                                                               
*        STACK:   1                                                             
*                                                                               
*        SUBROUTINES:  READD                                                    
*                                                                               
GETRBYTE RES      0                                                             
         LI,D0    0                 FLAG: GETRBYTE                              
         B        GPRB10                                                        
PUTRBYTE RES      0                                                             
         LI,D0    1                 FLAG: PUTRBYTE                              
GPRB10   RES      0                                                             
         PUSH     LNK                                                           
         STW,D0   GPRBFLAG          SAVE FLAG                                   
         CI,RECCT  0                                                            
         BLE      GPRB50            B IF NO MORE DATA ATTACHED                  
*                                   TO CURRENT INDEX ENTRY                      
GPRB20   RES      0                                                             
         MTW,0    GPRBFLAG                                                      
         BNEZ     GPRB30            B IF PUTRBYTE BEING EXECUTED                
         LB,T1    0,RECPTR          GET BYTE FROM RECORD                        
GPRB40   RES      0                                                             
         AI,RECPTR  1                                                           
         AI,RECCT  -1                                                           
         PULL     LNK                                                           
         B        *LNK                                                          
GPRB30   RES      0                                                             
         STB,T1   0,RECPTR                                                      
         MTW,1    DGRANALT          FLAG: DATA GRANULE ALTERED                  
         B        GPRB40                                                        
*        MUST GET DATA ATTACHED TO NEXT INDEX ENTRY                             
GPRB50   RES      0                                                             
         BAL,LNK  UPKENTRY          UNPACK NEXT ENTRY                           
         LW,RECPTR  P1              SAVE P1                                     
         LW,P1    ENTRYGNR          DATA GRAN TO READ                           
         BAL,LNK  READD             READ IT IN                                  
         LW,P1    RECPTR            RESTORE P1                                  
         LW,RECPTR  ENTRYBD         SET RECORD POINTER                          
         AI,RECPTR  BA(DBUFF)                                                   
         LW,RECCT   ENTRYDBL        SET DATA BYTE LENGTH                        
         AI,NEXTX  1                UPDATE NEXT INDEX ENTRY NR                  
         B        GPRB20                                                        
*                                                                               
         CLOSE    BLANKCT,NEXTX,STRPTR,STRCT,RECPTR,RECCT                       
         TITLE    '***** DELETERECORD *****'                                    
*                                                                               
*        PURPOSE: DELETE THE MOST RECENTLY READ RECORD                          
*                                                                               
*        CALL:    BAL,LNK  DELETERECORD                                         
*                                                                               
*        INPUT:   NONE                                                          
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   4                                                             
*                                                                               
*        SUBROUTINES:  FINDX, UPKENTRY, PKENTRY                                 
*                                                                               
DELETERECORD  RES  0                                                            
         PUSH     P1,LNK,10,R1                                                  
         LW,P1    LASTKEY           GET KEY OF LAST RECORD READ                 
         BAL,LNK  FINDX             FIND ITS INDEX ENTRY                        
         CI,10    0                                                             
         BNE      DLREC99           B IF NOT FOUND                              
         LW,P1    R1                SAVE ENTRY NR                               
DLREC10  RES      0                                                             
         LI,R0    1                                                             
         STW,R0   NOBRKFLG          SET FLAG: BREAK NOT PERMITTED               
         LI,R1    DF                                                            
         OR,R1    ENTRYFLG                                                      
         STW,R1   ENTRYFLG          SET ENTRY DELETED                           
         BAL,LNK  PKENTRY           REPACK THE INDEX ENTRY                      
         MTW,1    XGRANALT          FLAG: INDEX GRAN ALTERED                    
         CI,R1    CF                                                            
         BAZ      DLREC99           B IF NO CONTINUATION                        
         AI,P1    1                                                             
         BAL,LNK  UPKENTRY          UNPACK NEXT ENTRY                           
         B        DLREC10                                                       
DLREC99  RES      0                                                             
         PULL     P1,LNK,10,R1                                                  
         LI,R0    0                                                             
         XW,R0    NOBRKFLG                                                      
         CI,R0    2                                                             
         BE       BRKSIM            B IF DEFERRED BREAK TO DO                   
         B        *LNK                                                          
         TITLE    '***** WRITERANDOM *****'                                     
*                                                                               
*        PURPOSE: WRITE A RECORD INTO THE CP-R INDEXED                          
*                 SCRATCH FILE                                                  
*                                                                               
*        CALL:    BAL,LNK  WRITERANDOM                                          
*                                                                               
*        INPUT:   P1=KEY                                                        
*                 DATA TO WRITE IN CARDIMG                                      
*                 RECORD LENGTH IN RECSIZE                                      
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   4                                                             
*                                                                               
*        SUBROUTINES:  GETX, PUTREC, SCROFLO                                    
*                                                                               
WRITERANDOM  RES  0                                                             
         PUSH     P1,LNK,10,R1                                                  
         LI,LNK   1                                                             
         STW,LNK  NOBRKFLG          SET FLAG: BREAK NOT PERMITTED NOW           
         LI,10    0                 NO ERROR                                    
         BAL,LNK  GETX              GET INDEX FOR RECORD                        
         LB,R0    10                                                            
         CI,R0    OFLOTYC                                                       
         BE       SCROFLO           B IF SCRATCH FILE OVERFLOW                  
         LW,P1    R1                GET FIRST ENTRY NR                          
         BAL,LNK  PUTREC            PUT RECORD INTO FILE                        
         PULL     P1,LNK,10,R1                                                  
         LI,R0    0                                                             
         XW,R0    NOBRKFLG                                                      
         CI,R0    2                                                             
         BE       BRKSIM            B IF DEFERED BREAK TO DO                    
         B        *LNK                                                          
         TITLE    '***** WRITENEWRANDOM *****'                                  
*                                                                               
*        PURPOSE: WRITE A NEW RECORD INTO THE CP-R INDEXED                      
*                 SCRATCH FILE                                                  
*                                                                               
*        CALL:    BAL,LNK  WRITENEWRANDOM                                       
*                                                                               
*        INPUT:   P1=KEY                                                        
*                 DATA TO WRITE IN CARDIMG                                      
*                 RECORD LENGTH IN RECSIZE                                      
*                                                                               
*        OUTPUT:  NEW ENTRY: CC=0                                               
*                 NOT NEW ENTRY: CC=8                                           
*                                                                               
*        STACK:   4                                                             
*                                                                               
*        SUBROUTINES:  FINDX, GETX, PUTREC, SCROFLO                             
*                                                                               
WRITENEWRANDOM  RES  0                                                          
         PUSH     P1,LNK,10,R1                                                  
         LI,10    0                                                             
         BAL,LNK  FINDX             SEE IF THERE IS ALREADY                     
*                                   AN ENTRY                                    
         LB,R0    10                                                            
         CI,R0    NOKEYTYC                                                      
         BE       WNR10             B IF KEY NOT NOW DEFINED                    
         PULL     P1,LNK,10,R1                                                  
         LCI      8                 INDICATE KEY EXISTS                         
         B        *LNK                                                          
WNR10    RES      0                                                             
         LI,LNK   1                                                             
         STW,LNK  NOBRKFLG          SET FLAG: BREAK NOT PERMITTED NOW           
         LI,10    0                                                             
         BAL,LNK  GETX              GET INDEX FOR RECORD                        
         LB,R0    10                                                            
         CI,R0    OFLOTYC                                                       
         BE       SCROFLO           B IF SCRATCH FILE OVERFLOW                  
         LW,P1    R1                GET FIRST ENTRY NR                          
         BAL,LNK  PUTREC            PUT DATA IN RECORD                          
         PULL     P1,LNK,10,R1                                                  
         LI,R0    0                                                             
         XW,R0    NOBRKFLG                                                      
         CI,R0    2                                                             
         BNE      %+3               B IF NO DEFFERED BREAKTO DO                 
         LCI      0                                                             
         B        BRKSIM            B TO DO DEFERRED BREAK                      
         LCI      0                 INDICATE KEY CREATED                        
         B        *LNK                                                          
         TITLE    '***** SCROFLO *****'                                         
*                                                                               
*        PURPOSE: OUTPUT SCRATCH FILE OVERFLOW MESSAGE                          
*                 AND RETURN TO MASTERPARSER                                    
*                                                                               
SCROFLO  RES      0                                                             
         BAL,LNK  TYPEMSG                                                       
         DATA     CPRM1                                                         
         LW,R0    FILETYPE                                                      
         BLZ      BSCR85            B IF DURING SCR FILE BUILD                  
         B        MASTERPARSER                                                  
         TITLE    '***** READRANDOM *****'                                      
*                                                                               
*        PURPOSE: READ A RECORD FROM THE CP-R INDEXED SCRATCH                   
*                 FILE                                                          
*                                                                               
*        CALL:    BAL,LNK  READRANDOM                                           
*                                                                               
*        INPUT:   P1=KEY                                                        
*                 DATA BYTE LENGTH IN RECSIZE                                   
*                                                                               
*        OUTPUT:  KEY FOUND:                                                    
*                 CC=0                                                          
*                 DATA IN CARDIMG                                               
*                 KEY NOT FOUND:                                                
*                 CC=8                                                          
*                                                                               
*        STACK:   4                                                             
*                                                                               
*        SUBROUTINES:  BLANKBUF, FINDX, GETREC, SETLASTKEY                      
*                                                                               
READRANDOM  RES   0                                                             
         PUSH     P1,LNK,10,R1                                                  
         STW,P1   RSKEY             KEY FOR NEXT READ SEQUENTIAL                
         BAL,LNK  BLANKBUF                                                      
         LI,10    0                                                             
         BAL,LNK  FINDX             FIND THE INDEX FOR THE KEY                  
         CI,10    0                                                             
         BNE      RR50              B IF KEY NOT DEFINED                        
         XW,P1    R1                GET FIRST ENTRY NR                          
         BAL,LNK  GETREC            GET THE DATA                                
         XW,P1    R1                GET KEY READ                                
         BAL,LNK  SETLASTKEY        SET LAST KEY READ                           
         PULL     P1,LNK,10,R1                                                  
         LCI      0                 INDICATE RECORD READ                        
         B        *LNK                                                          
RR50     RES      0                                                             
         PULL     P1,LNK,10,R1                                                  
         LCI      8                 INDICATE NO SUCH RECORD                     
         B        *LNK                                                          
         TITLE    '***** READSEQUEN *****'                                      
*                                                                               
*        PURPOSE: READ SEQUENTIALLY A CP-R INDEXED SCRATCH FILE                 
*                                                                               
*        CALL:    BAL,LNK  READSEQUEN                                           
*                                                                               
*        INPUT:   DATA BYTE LENGTH IN RECSIZE                                   
*                                                                               
*        OUTPUT:  DATA IN CARDIMG                                               
*                 R1=KEY OF RECORD READ                                         
*                                                                               
*        STACK: 6                                                               
*                                                                               
*        SUBROUTINES:  BLANKBUF, FINDNXX, GETREC, SETLASTKEY                    
*                                                                               
READSEQUEN  RES   0                                                             
         PUSH     (P1,10)                                                       
         BAL,LNK  BLANKBUF                                                      
         LI,10    0                                                             
         LW,P1    RSKEY             LAST KEY READ (OR ATTEMPTED TO)             
         BAL,LNK  FINDNXX           FIND NEXT INDEX                             
         LW,P1    ENTRYKEY          GET KEY OF ENTRY READ                       
         STW,P1   RSKEY             SET FOR NEXT TIME                           
         LB,R0    10                                                            
         CI,R0    EOFTYC                                                        
         BE       RS50              B IF PAST EOF                               
         XW,P1    R1                GET INDEX ENTRY NR                          
         BAL,LNK  GETREC            GET RECORD INTO USER STRING                 
         LW,P1    R1                GET KEY READ                                
         BAL,LNK  SETLASTKEY        SET LAST KEY READ                           
         PULL     (P1,10)                                                       
         B        *LNK                                                          
RS50     RES      0                                                             
         LW,P1    ENTRYKEY          LAST KEY OF FILE                            
         BAL,LNK  SETLASTKEY        SET LAST KEY READ TO                        
*                                   LAST OF FILE                                
         LW,R1    L(EOF)            INDICATES PAST EOF                          
         PULL     (P1,10)                                                       
         PUSH     (P1,R1)                                                       
         B        RS%ABNABN                                                     
         TITLE    '***** BUILDSCR *****'                                        
*                                                                               
*        PURPOSE: TO BUILD THE CP-R INDEXED SCRATCH FILE                        
*                 FROM THE SUBJECT FILE                                         
*                                                                               
*        CALL:    BAL,LNK  BUILDSCR                                             
*                                                                               
*        INPUT:   M:EI SET TO SCRATCH FILE, M:EO SET TO                         
*                 SUBJECT FILE.  BOTH DCBS CLOSED.                              
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   7                                                             
*                                                                               
*        SUBROUTINES:  OPENSCRI, WRITENEWRANDOM, WRITERANDOM                    
*                                                                               
BUILDSCR RES      0                                                             
         PUSH     (P1,R1)                                                       
         LI,R0    0                                                             
         STW,R0   DUPREC            NO DUPLICATE RECORD NRS                     
         STW,R0   ORDREC            NO REORDERED RECORDS                        
         LI,LNK   BSCRERR           ERROR EXIT                                  
         LI,10    0                                                             
         M:OPEN   F:EO,(ERR,CPRIOER),(ABN,CPRIOER)                              
         BAL,LNK  OPENSCRI          OPEN THE SCRATCH FILE DCB                   
         LI,P1    0                 AND INITIALIZE ITS CONTROLS                 
BSCR10   RES      0                                                             
         STW,P1   INTFLAG1          LINE NR IN CASE OF BREAK                    
         LI,LNK   BSCREREO          ERROR EXIT                                  
         M:READ   F:EO,(ABN,BSCREREO),(ERR,BSCREREO),;                          
                  (SIZE,MAXCLMN),(BUF,CARDIMG),WAIT                             
         LW,R0    F:EO+4                                                        
         SLS,R0   -17               GET ACTUAL RECORD SIZE                      
         STW,R0   RECSIZE           SET IT                                      
         MTW,0    ISNRREQ                                                       
         BEZ      BSCR30            B IF INPUT SEQ NR NOT REQUIRED              
         BAL,LNK  INSEQNR           GET INPUT SEQUENCE NR                       
         CI,10    0                                                             
         BNE      BSCR82            B IF NOT FOUND                              
         CW,R1    LASTKEY                                                       
         BGE      BSCR20            B IF IN ORDER                               
         MTW,0    ORDREC                                                        
         BNEZ     BSCR20            B IF MSG ALREADY OUTPUT                     
         BAL,LNK  TYPEMSG                                                       
         DATA     CPRM4             GENERATE WARNING MESSAGE                    
         MTW,1    ORDREC            SET FLAG FOR REORDERED RECS                 
BSCR20   RES      0                                                             
         STW,R1   P1                SET FOR SCR FILE WRITE                      
         B        BSCR40                                                        
BSCR30   RES      0                                                             
         LW,P1    LASTKEY           GET PRIOR KEY                               
         AW,P1    DFLTINCR          ADD INCREMENT                               
BSCR40   RES      0                                                             
         CW,P1    MAXSEQ                                                        
         BG       BSCR83            B IF SEQ NR TOO BIG                         
         STW,P1   LASTKEY           SET FOR LATER                               
         MTW,0    SAVESEQ                                                       
         BEZ      BSCR50            B IF SAVE FILE SEQUENCING OFF               
         BAL,LNK  INSEQNR                                                       
         CI,10    -1                                                            
         BE       BSCR50            B IF SEQ NR NOT FOUND                       
         MTW,-8   RECSIZE           REMOVE SEQ NR FROM RECORD                   
BSCR50   RES      0                                                             
         BAL,LNK  WRITENEWRANDOM    WRITE THE RECORD ON THE                     
*                                   SCRATCH FILE                                
         BCR,8    BSCR10            B IF WRITTEN OK                             
         MTW,0    DUPREC                                                        
         BNEZ     BSCR70            B IF WARNING ALREADY OUT                    
         BAL,LNK  TYPEMSG                                                       
         DATA     CPRM3             OUTPUT WARNING                              
         MTW,1    DUPREC            SET FLAG FOR DUPLICATE REC NRS              
BSCR70   RES      0                                                             
         BAL,LNK  WRITERANDOM       WRITE RECORD OVER PREVIOUS ONE              
         B        BSCR10                                                        
BSCR81   RES      0                                                             
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM3             LINE OVERFLOW                               
         B        BSCR85                                                        
BSCR82   RES      0                                                             
         BAL,LNK  TYPEMSG                                                       
         DATA     CPRM2             ILLEGAL INPUT SEQ NR                        
         B        BSCR85                                                        
BSCR83   RES      0                                                             
         BAL,LNK  TYPEMSG                                                       
         DATA     ERRM20            MAX SEQ NR EXCEEDED                         
BSCR85   RES      0                                                             
         M:CLOSE  F:EO              CLOSE SUBJECT FILE                          
         BAL,LNK  CLOSESCR          CLOSE SCRATCH FILE                          
         B        MASTERPARSER                                                  
BSCR90   RES      0                                                             
         M:CLOSE  F:EO              CLOSE SUBJECT FILE                          
         PULL     (P1,R1)                                                       
         B        *LNK                                                          
*                                                                               
BSCREREO RES      0                                                             
         LB,R0    10                GET TYC                                     
         CI,R0    EODTYC                                                        
         BE       BSCR90            GO TO CLEANUP IF EOD ABNORMAL               
         CI,R0    EOFTYC                                                        
         BE       BSCR90            GO TO CLEANUP IF EOF ABNORMAL               
         CI,R0    BSDRTYC                                                       
         BE       BSCR81            B IF BUF SMALLER THAN DATA                  
         B        BSCRERR                                                       
*                                                                               
BSCRERR  EQU      WRGERR            FATAL ERROR                                 
         TITLE    '***** INSEQNR *****'                                         
*                                                                               
*        PURPOSE: TRANSLATE A LINE NR IN A SUBJECT FILE RECORD                  
*                                                                               
*        CALL:    BAL,LNK  INSEQNR                                              
*                                                                               
*        INPUT:   NONE                                                          
*                                                                               
*        OUTPUT:  IF FOUND,                                                     
*                 10=0                                                          
*                 R1=VALUE TIMES 1000                                           
*                 IF NOT FOUND,                                                 
*                 10=-1                                                         
*                                                                               
*        STACK:   3                                                             
*                                                                               
*        SUBROUTINES:  INTERNAL ONLY                                            
*                                                                               
INSEQNR  RES      0                                                             
         PUSH     (P2,T1)                                                       
         LW,P2    RECSIZE                                                       
         AI,P2    -8                POINT AT LAST EIGHT BYTES                   
         LI,10    0                 ERROR FLAG INITIALLY RESET                  
         LI,D0    0                 DIGITS ENCOUNTERED: NO                      
         BAL,LNK  INSEQBL           SKIP LEADING BLANKS                         
         BAL,LNK  INSEQZ            SKIP LEADING ZEROS                          
         LI,D1    4                 MAX NR BYTES NEXT FIELD                     
         BAL,LNK  INSEQDD           EVALUATE DECIMAL STRING                     
         MI,R1    1000              OFFSET FOR INTEGER PART                     
         LW,R0    R1                SAVE IT                                     
         LB,R1    CARDIMG,P2                                                    
         CI,R1    '.'                                                           
         BNE      INSEQ10           B IF NO FRACTION                            
         MTW,1    P2                SKIP DECIMAL POINT                          
         LI,D1    3                 MAX NR BYTES NEXT FIELD                     
         BAL,LNK  INSEQDD           EVALUATE DECIMAL STRING                     
         CI,D1    0                                                             
         BE       %+3               B IF 3 DECIMAL PLACES                       
         MI,R1    10                                                            
         BDR,D1   %-1               ACCOUNT FOR FEWER                           
         AW,R0    R1                ACCUMULATE FRACTION PART                    
         BAL,LNK  INSEQZ            SKIP TRAILING ZEROS                         
INSEQ10  RES      0                                                             
         BAL,LNK  INSEQBL           SCAN OFF TRAILING BLANKS                    
         CW,P2    RECSIZE                                                       
         BL       INSEQ95           B IF WHOLE FIELD NOT SCANNED                
         CI,D0    0                                                             
         BE       INSEQ95           B IF NO DIGITS FOUND                        
         LW,R1    R0                                                            
         PULL     (P2,T1)                                                       
         B        *LNK                                                          
*                                                                               
INSEQBL  RES      0                                                             
         LI,T1    ' '               SKIP BLANKS                                 
         B        INSEQBLZ                                                      
INSEQZ   RES      0                                                             
         LI,T1    '0'               SKIP ZEROS                                  
INSEQBLZ RES      0                                                             
         CW,P2    RECSIZE                                                       
         BGE      *LNK              RETURN IF END OF CARD                       
         CB,T1    CARDIMG,P2                                                    
         BNE      *LNK              B IF NOT BLANK (ZERO)                       
         AI,P2    1                 INCREMENT BYTE POINTER                      
         CI,T1    '0'                                                           
         BNE      INSEQBLZ          B IF SKIPPING BLANKS                        
         LI,D0    1                 FLAG:  DIGIT FOUND                          
         B        INSEQBLZ                                                      
*                                                                               
INSEQDD  RES      0                                                             
         LI,R1    0                                                             
INSEQDD1 RES      0                                                             
         CW,P2    RECSIZE                                                       
         BGE      *LNK              RETURN IF END OF CARD                       
         CI,D1    0                                                             
         BLE      *LNK              RETURN IF CHAR COUNT OUT                    
         LB,T1    CARDIMG,P2                                                    
         CI,T1    '0'                                                           
         BL       *LNK              B IF NOT DECIMAL DIGIT                      
         CI,T1    '9'                                                           
         BG       *LNK              B IF NOT DECIMAL DIGIT                      
         AI,T1    -'0'              CONVERT TO NUMBER                           
         MI,R1    10                                                            
         AW,R1    T1                ACCUMULATE DIGIT                            
         AI,P2    1                 INCREMENT CHAR PTR                          
         AI,D1    -1                DECREMENT CHAR COUNT                        
         LI,D0    1                 SET FLAG: DIGIT FOUND                       
         B        INSEQDD1                                                      
*                                                                               
INSEQ95  RES      0                                                             
         LI,10    -1                INPUT SEQUENCE NR NOT FOUND                 
         PULL     (P2,T1)                                                       
         B        *LNK                                                          
         TITLE    '***** SAVESCR *****'                                         
*                                                                               
*        PURPOSE: TO BUILD A STANDARD CPR FILE                                  
*                 FROM THE CPR INDEXED SCRATCH FILE                             
*                                                                               
*        CALL:    BAL,LNK  SAVESCR                                              
*                                                                               
*        INPUT:   M:EI AND M:EO ASSIGNED, M:EI OPEN                             
*                                                                               
*        OUTPUT:  NONE                                                          
*                                                                               
*        STACK:   10                                                            
*                                                                               
*        SUBROUTINES:  READSEQUENTIAL, READX, UPKENTRY                          
*                                                                               
SAVESCR  RES      0                                                             
         PUSH     (X1,R2)                                                       
         LI,P1    0                 FIRST INDEX GRAN NR                         
         LI,P2    0                 NR OF ACTIVE RECORDS COUNT                  
         LI,T1    CF+DF             CONTINUED AND DELETED FLAGS                 
SAVES10  RES      0                                                             
         BAL,LNK  READX             READ NEXT INDEX GRAN                        
         CI,10    0                                                             
         BNE      SAVER1            B IF ERROR                                  
         LI,X2    HXNAV                                                         
         LH,X2    XBUFF,X2          GET NR OF ENTRIES                           
         LI,P1    0                 FIRST ENTRY NR                              
SAVES12  RES      0                                                             
         CW,P1    X2                                                            
         BGE      SAVES14           B IF PAST LAST ENTRY                        
         BAL,LNK  UPKENTRY          UNPACK THE ENTRY                            
         CW,T1    ENTRYFLG                                                      
         BANZ     %+2               B IF DELETED OR CONTINUED                   
         AI,P2    1                 COUNT IT (REPRESENTS A RECORD)              
         AI,P1    1                                                             
         B        SAVES12                                                       
SAVES14  RES      0                                                             
         LW,P1    XBUFF+WXFLINK     GET NR OF NEXT INDEX GRAN                   
         BGEZ     SAVES10           B IF NOT END OF INDEX                       
         LW,R0    SUBJFID                                                       
         BLZ      SAVES16           B IF SUBJECT FILE NOT DEFINED               
         M:ASSIGN M:EO,(FILPTR,SUBJFID),(ACNTPTR,SUBJFID+3),;                   
                  (ERR,SAVER1)                                                  
*        SET M:EO TO SUBJECT FILE                                               
         BAL,LNK  GETEO             GET STRUCTURE                               
         STW,R1   EOFORMAT          SAVE ITS FORMAT                             
         STW,R2   EORSIZE           RECORD SIZE                                 
         STW,R3   EOFSIZE           AND FILE SIZE                               
         LW,X1    EORSIZE           EO FILE RECORD SIZE                         
         LW,X2    EOFORMAT          EO FILE FORMAT                              
         B        SAVES18                                                       
SAVES16  RES      0                                                             
         LI,X2    2                 COMPRESSED FORMAT                           
         STW,X2   EOFORMAT          SET IT                                      
         LI,X1    1024                                                          
         STW,X1   EORSIZE           SET RECORD SIZE                             
SAVES18  RES      0                                                             
         CI,X2    2                                                             
         BNE      %+3               B IF NOT COMPRESSED                         
         LW,LNK   NAVGRAN           NR OF GRANS = SCRATCH FILE SIZE             
         B        SAVES195                                                      
         CI,X2    0                                                             
         BNE      %+3               B IF NOT UNBLOCKED                          
         LI,LNK   1                 NR RECS PER GRAN                            
         B        SAVES19                                                       
         LI,LNK   1024                                                          
         DW,LNK   X1                NR RECS PER GRAN                            
SAVES19  RES      0                                                             
         AW,P2    LNK                                                           
         AI,P2    -1                ROUND UPWARD                                
         XW,P2    LNK                                                           
         DW,LNK   P2                NR OF GRANS NEEDED                          
SAVES195 RES      0                                                             
         STW,LNK  EOFSIZE           SAVE FOR LATER                              
         M:ASSIGN M:EO,(FILPTR,SAVEFID),(ACNTPTR,SAVEFID+3),;                   
                  IGNERR                                                        
*        SET EO DCB TO THE SAVE FILE                                            
         BAL,LNK  GETEO             GET SAVE FILE STRUCTURE                     
         CI,R3    0                                                             
         BNE      SAVES20           B IF SAVE FILE EXISTS                       
         LW,X1    ALLOT0            FPT CODE                                    
         OR,X1    SAVEFID           AREA NAME                                   
         LW,X2    ALLOT1            FLAG WORD                                   
         LI,P1    SAVES81           ERROR EXIT                                  
         LI,P2    0                 FORMAT UNBLOCKED                            
         LW,LNK   SAVEFID+1         FILE NAME                                   
         LW,T1    SAVEFID+2                                                     
         LW,T2    EOFSIZE           FSIZE                                       
         LI,R3    10                EXTENT SIZE IN GRANS, SINCE UNBLKED         
         LI,R1    256               GRANULE SIZE IN WORDS                       
         LI,R2    SAVEFID+3         ACNTPTR                                     
         CAL1,7   X1                ALLOT THE FILE                              
         LI,R0    1                                                             
         STW,R0   SAVON             FLAG: FILE WAS ALLOTTED                     
         B        SAVES40                                                       
SAVES20  RES      0                                                             
         LW,R0    SAVON                                                         
         BNEZ     SAVES82           B IF MUST BE NEW FILE                       
SAVES30  RES      0                                                             
         LW,R0    EOFSIZE           GET NEEDED FILE SIZE                        
         CW,R0    R3                                                            
         BLE      SAVES40           B IF EXISTING FILE BIG ENUF                 
         LW,R0    FORCESV                                                       
         BEZ      SAVES83           B IF MUST NOT ATTEMPT SAVE                  
SAVES40  RES      0                                                             
         LI,LNK   SAVER1            DCB ERROR RETURN                            
         M:OPEN   M:EO,(ERR,CPRIOER),(ABN,CPRIOER)                              
         M:DFMODE M:EO,(ORG,*EOFORMAT),(RSI,*EORSIZE),(GSI,1024)                
*        SET SAVE FILE TO SUBJECT FILE STRUCTURE                                
         LW,P1    FIRSTFROM         START OF SAVE                               
         BAL,LNK  READRANDOM        TRY FOR LINE NR 0                           
         BCR,8    SAVES42           B IF FOUND                                  
SAVES41  RES      0                                                             
         BAL,LNK  READSEQUEN        READ NEXT HIGHER LINE                       
         CW,R1    LASTFROM                                                      
         BG       SAVES90           B IF PAST END OF SAVE                       
         LW,P1    R1                GET SEQ NR OF LINE READ                     
SAVES42  RES      0                                                             
         LW,P2    RECSIZE           GET BL OF RECORD READ                       
         LW,R0    SAVESEQ                                                       
         BEZ      %+2               B IF SVE FILE SEQ OFF                       
         AI,P2    8                 ADD SPACE FOR SEQ NR                        
         CI,P2    80                                                            
         BGE      %+2               B IF ALREADY MORE THAN 80 CHARS             
         LI,P2    80                TRY TO OUTPUT 80-CHAR LINE                  
         CI,P2    MAXCLMN                                                       
         BLE      %+2               B IF NOT TOO BIG                            
         LI,P2    MAXCLMN           OUTPUT MAXIMUM PERMITTED                    
         LW,R0    EOFORMAT                                                      
         CI,R0    2                                                             
         BE       %+2               B IF COMPRESSED  SAVE FILE                  
         LW,P2    EORSIZE           FIXED RECORD SIZE                           
         LW,R0    SAVESEQ                                                       
         BEZ      SAVES45           B IF SAVE FILE SEQ OFF                      
         AI,P2    -8                                                            
         AI,P2    BA(CARDIMG)       BA TO INSERT SEQ NR                         
         BAL,LNK  MOVESEQ           SEQUENCE THE LINE                           
         DATA     0                 (NO FOLLOWON TEXT)                          
         AI,P2    8                 RESTORE LINE LENGTH                         
         AI,P2    -BA(CARDIMG)                                                  
SAVES45  RES      0                                                             
         LI,LNK   SAVER2            DCB ERROR EXIT                              
         M:WRITE  M:EO,(ERR,SAVER2),(ABN,SAVER2),;                              
                  (BUF,CARDIMG),(SIZE,*P2),WAIT                                 
         STW,P1   INTFLAG1          LINE NR IN CASE OF BREAK                    
         B        SAVES41                                                       
*                                                                               
SAVES81  RES      0                                                             
         BAL,LNK  TYPEMSG           ERROR IN ALLOT ATTEMPT                      
         DATA     CPRM7                                                         
         B        SAVES91                                                       
*                                                                               
SAVES82  RES      0                                                             
         BAL,LNK  TYPEMSG           FILE EXISTS, CANT SAVE ON                   
         DATA     ERRM15                                                        
         B        SAVES91                                                       
*                                                                               
SAVES83  RES      0                                                             
         MOVEMSG,P1  CPRM5,P2                                                   
         LW,P1    EOFSIZE           SAVE FILE TOO SMALL                         
         LI,P2    BA(MSGBUF+CPRM5A-CPRM5)                                       
         BAL,LNK  BINTODEC          PUT NEEDED SIZE IN MSG                      
         BAL,LNK  TYPEMSG                                                       
         DATA     MSGBUF                                                        
         LI,LNK   SAVES91           DCB ERROR RETURN (IGNORE)                   
         M:CLOSE  M:EO,IGNERR                                                   
SAVES91  RES      0                                                             
         B        MASTERPARSER                                                  
*                                                                               
SAVES90  RES      0                                                             
         LI,LNK   SAVER1            DCB ERROR RETURN                            
         M:WEOF   M:EO                                                          
         M:CLOSE  M:EO,(ERR,SAVER1),(ABN,SAVER1)                                
         PULL     (X1,R2)                                                       
         B        *LNK                                                          
*                                                                               
SAVER1   EQU      WRGERR                                                        
*                                                                               
SAVER2   RES      0                                                             
         LB,R0    10                                                            
         CI,R0    EOTTYC                                                        
         BNE      SAVER1            B IF NOT EOT ERROR                          
         B        SAVES83                                                       
         TITLE    '***** GETEO *****'                                           
*                                                                               
*        PURPOSE: DETERMINE THE NATURE OF THE EO FILE                           
*                                                                               
*        CALL:    BAL,LNK  GETEO                                                
*                                                                               
*        INPUT:   M:EO ASSIGNED TO A FILE                                       
*                                                                               
*        OUTPUT:  IF FILE AND AREA EXIST,                                       
*                 R1 = FILE ORGANIZATION CODE                                   
*                      0 FOR UNBLOCKED                                          
*                      1 FOR BLOCKED                                            
*                      2 FOR COMPRESSED                                         
*                 R2 = RECORD SIZE IF R1=1                                      
*                 R3 = EOF (10000000) IF FILE IS EXTENSIBLE                     
*                    = FILE SIZE IN 256-WORD GRANULES IF NOT EXTENSIBLE         
*                 IF FILE OR AREA NONEXISTENT, R3 = 0                           
*                                                                               
*        STACK:   1                                                             
*                                                                               
*        SUBROUTINES:  NONE                                                     
*                                                                               
GETEO    RES      0                                                             
         PUSH     LNK                                                           
         LI,LNK   GETEOER           ERROR RETURN                                
         M:OPEN   M:EO,(ABN,CPRIOER),(ERR,CPRIOER)                              
         M:GETASN M:EO,(ERR,GETEOER),(BOT,*D0),(EOT,*D1),;                      
                  (ESI,*R0),(FOR,*R1),(RSI,*R2),(MODLPTR,LNK)                   
         LW,R3    L(EOF)            FILE SIZE FOR EXTENSIBLE FILE               
         CI,R0    0                                                             
         BNE      GETEO50           B IF FILE IS EXTENSIBLE                     
         SW,D1    D0                                                            
         AI,D1    1                 NR SECTORS IN FILE                          
         SLS,LNK  16                                                            
         LB,LNK   LNK                                                           
         CI,LNK   '5'                                                           
         BE       %+3               B IF '725X' DEVICE                          
         CI,LNK   '0'                                                           
         BNE      %+3               B IF NOT A '720X' DEVICE                    
         LI,D0    3                                                             
         DW,D1    D0                NR OF 256-WORD GRANS IN FILE                
         LW,R3    D1                                                            
GETEO50  RES      0                                                             
         LI,LNK   WRGERR            DCB ERROR RETURN                            
         M:CLOSE  M:EO,(ERR,WRGERR),(ABN,WRGERR)                                
         PULL     LNK                                                           
         B        *LNK                                                          
GETEOER  RES      0                                                             
         PULL     LNK                                                           
         LB,R0    10                                                            
         LI,R3    0                                                             
         CI,R0    FNXTYC                                                        
         BE       *LNK              B IF NONEXIST FILE                          
         CI,R0    ANXTYC                                                        
         BE       *LNK              B IF NONEXIST AREA                          
         B        BADIO1                                                        
         FIN                                                                    
ENDEDITOR         EQU    %+10                                                   
         END      BEGINEDITOR                                                   
