*DECK C$RLOC
          IDENT  C$RLOC 
          SST 
          TITLE  C$RLOC - RELATIVE I-O OPEN/CLOSE + COMMON ROUTINES 
          B1=1
          COMMENT  RELATIVE I-O OPEN/CLOSE + COMMON ROUTINES
* 
**        CBRLOC - RELATIVE I-O OPEN-CLOSE ROUTINE
* 
*         CALLING SEQUENCE
*                SB3  REWIND OPTION (IGNORED EXCEPT FOR LOCK) 
*                SA0  FIT 
*                SB6  RETURN
*                SB5  OPEN ROUTINE IN CBCOMIO 
*                EQ   =XC.OPRL
* 
*         THIS DECK ALSO CONTAINS THE COMMON ROUTINES FOR BOTH RANDOM 
*         AND SEQUENTIAL I-O. 
* 
*CALL IOMICROS
*CALL IODEFSC 
 #LHDR#   EQU    3           LENGTH OF VERSION 5 RELATIVE FILE HEADER 
 HDRBFSZ  EQU    5           SIZE OF HEADER BUFFER
          TITLE  C.OPXRL - OPEN ROUTINES
 OPEN     EJECT 
          ENTRY  C.OPRL 
 C.OPRL   BSS    0
          RJ     =XC.SFEQ    SET FILE EQUIVALENCE AND SAVE PTRS 
          STORE  A0,REOI=NO  CLEAR AT END POSITION IF SET 
          SA5    B6-B1       GET LINE NUMBER
          BX7    X5 
          SA7    OPRTN-1     SAVE FOR POSSIBLE DIAGS
          STORE  A0,WRIF=NO  CLEAR WRITE FLAG 
          STORE  A0,LORD=NO  CLEAR LAST OP READ FLAG
          STORE  A0,OPOF=NO  CLEAR OPEN OUTPUT FLAG 
          SB6    OPRTN
          JP     B5          GO TO PROPER OPEN ROUTINE
          DATA   0           LINE NUMBER SAVED HERE 
 OPRTN    BSS    0
          FETCH  A0,PD,X2    GET PROCESSING DIRECTION 
          SX2    X2-#OUTPUT#
          ZR     X2,OPNOUT   JUMP IF OUTPUT 
          FETCH  A0,FNEX,X5 
          NG     X5,=XC.NORRT  EXIT IF FILE NOT THERE 
*      READ EXISTING FILE HEADER
          STORE  A0,DX=NOFL  SET DATA EXIT INCASE FILE EMPTY
          GET    A0,HDRBUF,HDRBFSZ*10,NOFL,1   READ HEADER
          SX0    HDRBUF      POINT TO HEADER
          STORE  A0,V4FL=NO 
          FETCH  X0,HHFL,X2  GET HEADER FLAG
          SA3    V5HDRFL
          SX4    #LHDR#      LENGTH OF HEADER 
          IX5    X3-X2
          NZ     X5,V4HDR    JP IF NOT V5 HEADER - MAY BE VERS 4
          FETCH  X0,HPRUF,X5  GET PRU FILE FLAG FROM HEADER 
          PL     X5,ISHDR    JP IF IT IS NOT A PRU FILE 
          SX4    64          DATA STARTS AT 64 FOR PRU FILE 
          EQ     ISHDR
 V4HDR    BSS    0
          SA4    V4HDRFL
          IX4    X4-X2
          NZ     X4,NOTV4HD  JUMP IF NOT VERSION 4 HEADER 
*      VERSION 4 HEADER READ -
          STORE  A0,V4FL=YES  SET VERS 4 FLAG 
          FETCH  X0,MVF,X5   MULTI-VOLUME FLAG
          PL     X5,MVOK     JUMP IF NOT MULTI-VOLUME 
*      ERROR - MULTI-VOLUME CANNOT BE PROCESSED 
          SX1    #RLMSG1
          RJ     =XC.FIOER   ABORT
 MVOK     BSS    0
          FETCH  X0,LRL,X3   GET REC LENGTH 
          STORE  X0,HLRL=X3  PUT IT IN VERS 5 PLACE 
          FETCH  X0,LLB,X4   GET LENGTH OF LABEL BLOCK
          FETCH  X0,PRF,X5
          PL     X5,ISHDR    JP IF NOT A PRU FILE 
          STORE  X0,HPRUF=YES  SET PRU FLAG IN C5 HEADER PLACE
          SX4    100B        DATA STARTS AT 100 
 ISHDR    BSS    0
*      MOVE STUFF FROM HEADER TO FIT FIELDS 
          STORE  A0,DPTR=X4  STORE POINTER TO DATA
          FETCH  X0,HLRN,X4  LAST REC ON FILE 
          STORE  A0,LREC=X4  SAVE IT
          FETCH  X0,HHDT,X4  HASHED DAY-TIME
          STORE  A0,HDTT=X4  SAVE IT
          FETCH  X0,HLRL,X1  REC LENGTH IN HEADER 
          FETCH  A0,RLWD,X2  LENGTH IN PROGRAM
          IX3    X2-X1
          FETCH  X0,HPRUF,X4 PRU FILE FLAG
          FETCH  A0,PRUF,X5  SAME FROM PROGRAM
          BX6    X4-X5
          PL     X6,OP2      JP IF PROG AND HEADER MATCH
          PL     X4,OP1      JP IF FILE NOT PRUF=YES
          NZ     X3,OP1ER    JP IF REC LENGTHS DIFFER 
          STORE  A0,PRUF=YES SET PROGRAM TO PRUF=YES - WILL WORK
          EQ     OPNRTN 
 OP1ER    BSS    0
          SX1    #RLPRUM     ERROR - FILE SAYS PRUF AND PROG DOESNT 
          RJ     =XC.FIOER   EXIT TO ERROR ABORT
 OP1      BSS    0
          STORE  A0,PRUF=NO  CHANGE PROGRAM TO NOT PRUF 
          NG     X3,OP3      JP IF FILE RL > PROG RL
          STORE  A0,RLWD=X1  CHANGE PROG RL TO FILE RL
          EQ     OPNRTN 
 OP2      BSS    0
          ZR     X3,OPNRTN   JP IF REC LENGTHS SAME 
 OP3      BSS    0
          SX1    #RLMSG2
          RJ     =XC.FIOER   ERROR - RECORD SIZES DIFFER
 OPNRTN   BSS    0
          STORE  A0,NREC=1   SET NEXT REC POINTER TO 1
          STORE  A0,DX==XC.EX  SET EXITS - ALL ARE ERROR
          STORE  A0,EX==XC.EX 
          FETCH  A0,OF,X2    GET OPEN FLAG
          SX3    X2-#E# 
          NZ     X2,=XC.NORRT  RETURN IF NOT OPEN EXTEND
          FETCH  A0,LREC,X2  GET LAST REC 
          SX3    B1 
          IX4    X3+X2       BUMP 
          STORE  A0,NREC=X4  NEXT REC NOW HERE
          STORE  A0,OF=R     SET TO CLEAR EXTEND
          EQ     =XC.NORRT   RETURN 
 OPNOUT   BSS    0           OPEN OUTPUT
*      COMPUTE HASHED DATE-TIME FOR UNIQUE IDENTIFICATION 
          JDATE  =SDATE      GET JULIAN DATE
          CLOCK  =SCLOCK     GET TIME 
          SA2    DATE 
          SA3    CLOCK
          MX0    48 
          AX3    6           OFF UNUSED CHAR
          BX4    -X0*X3      HUNDRETHS
          AX3    12 
          BX5    -X0*X3      SECS 
          IX4    X5+X4       ADD THEM 
          AX3    18 
          AX3    18 
          BX6    -X0*X3      MINS 
          MX0    30 
          IX4    X4+X6       ALL ADDED
          BX2    -X0*X2 
          IX6    X4+X2       PLUS JULIAN DATE 
          STORE  A0,HDTT=X6  SAVE IT
          STORE  A0,LREC=0   SET FILE EMPTY 
          SX6    #LHDR#      DATA STARTS AFTER HEADER ON NON-PRU FILE 
          FETCH  A0,PRUF,X5  GET PRU FILE FLAG
          PL     X5,NTPRUF   JP IF NOT PRU FILE 
          SX6    64          PRU SIZE - DATA STARTS ON PRU BOUNDARY 
 NTPRUF   BSS    0
          STORE  A0,DPTR=X6  POINT TO DATA STARTING POS 
          FETCH  A0,CF,X6 
          SA6    =SSAVECF    SAVE CLOSE FLAG
          CLOSEM A0,R        CLOSE  TEMPORARILY 
          SA1    SAVECF 
          STORE  A0,CF=X1    RESTORE CLOSE FLAG 
          OPENM  A0,I-O      REOPEN AS IO SINCE WE MUST READ KEY
          STORE  A0,OPOF=YES SET OPEN OUTPUT FLAG 
          EQ     OPNRTN      EXIT 
 NOTV4HD  BSS    0
          SX1    #RLMSG3
          RJ     =XC.FIOER
 NOFL     DATA   0           DATA OR ERROR EXIT IF NO FILE ON LABEL READ
          SX1    #RLMSG4
          RJ     =XC.FIOER   EXIT TO ERROR ABORT
 V4HDRFL  VFD    42/0,18/520012B
 V5HDRFL  VFD    42/0,18/521432B
 C.CLORL  EJECT 
          TITLE  C.CLORL - RELATIVE CLOSE ROUTINE 
* 
**        C.CLORL - RELATIVE CLOSE ROUTINE
* 
*         CALLING SEQUENCE
*                SA0  FIT 
*                SB3  REWIND OPTION 
*                SB6  RETURN
*                EQ   C.CLORL 
* 
*         RETURNS NOTHING 
* 
          ENTRY  C.CLORL
 C.CLORL  BSS    0
          RJ     =XC.SVRTN   SAVE RETURN
          STORE  A0,RWDF=B3  SAVE REWIND FLAG 
          FETCH  A0,OC,X5 
          SX5    X5-#OPE# 
          NZ     X5,CLOSEX   JP IF NOT OPEN - CLOSE WILL DIAGNOSE 
          FETCH  A0,PD,X2    GET PROCESSING DIRECTION 
          SX3    X2-#INPUT# 
          ZR     X3,CLOSEX   JUMP IF INPUT
          FETCH  A0,OPOF,X5  GET OPEN OUTPUT FLAG 
          NG     X5,NOTIO    JPIF OPEN OUTPUT - OTHERWISE IS OPEN IO
          FETCH  A0,WRIF,X5  GET WRITE FLAG (SET IF SOMETHING WRITTEN)
          PL     X5,CLOSEX   WAS NEVER WRITTEN - DO NOT REWRITE HEADER
 NOTIO    BSS    0
          MX6    0
          SB3    HDRBFSZ-1   LENGTH OF HEADER BUFF
          SA6    HDRBUF 
 CLRHDR   BSS    0           CLEAR HEADER 
          SB3    B3-B1
          SA6    A6+B1
          NZ     B3,CLRHDR
          SX0    HDRBUF      SET UP HEADER FIELDS 
          FETCH  A0,HDTT,X4 
          STORE  X0,HHDT=X4 
          FETCH  A0,LREC,X4 
          STORE  X0,HLRN=X4 
          FETCH  A0,RLWD,X4 
          STORE  X0,HLRL=X4 
          SA4    V5HDRFL
          STORE  X0,HHFL=X4 
          FETCH  A0,PRUF,X4  PRU FILE FLAG
          LX4    1           POSITION TO BOTTOM OF WORD 
          STORE  X0,HPRUF=X4
          FETCH  A0,V4FL,X5 
          SX3    #LHDR#*10   SIZE OF HEADER IN CHARS
          PL     X5,NOTCLV4  JUMP IF NOT A VERSION 4 FILE 
          GET    A0,HDRBUF,50,,1  READ OLD HEADER 
          FETCH  A0,LREC,X4  GET LAST RECORD NUMBER 
          STORE  HDRBUF,HLRN=X4    PUT IT IN HEADER 
          SX3    50          SIZE OF V4 HEADER
 NOTCLV4  BSS    0
          PUT    A0,HDRBUF,X3,,1  WRITE NEW HEADER
 CLOSEX   BSS    0
          FETCH  A0,RWDF,X2  GET SAVED REWIND FLAG
          SB3    X2 
          RJ     =XC.GETRT   GET RETURN 
          EQ     =XC.CLOSE   GO TO CBCOMIO CLOSE ROUTINE
          TITLE  COMMON UTILITY ROUTINES
 C.BMPRP  EJECT 
* 
**        C.BMPRP - BUMPS RECORD POINTER
* 
*         ON EXIT 
*                X5, X6, X7, A5, A6 CHANGED 
*                ALL OTHER REGISTERS UNCHANGED
          ENTRY  C.BMPRP
 C.BMPRP  DATA   0
          FETCH  A0,NREC,X5 
          SX7    B1 
          IX5    X5+X7
          STORE  A0,NREC=X5 
          EQ     C.BMPRP
 C.CWARL  EJECT 
          ENTRY  C.CWARL
* 
**        C.CWARL - COMPUTES RECORD WORD ADDRESS
* 
*         USES NREC - NO INPUT REGISTERS
* 
*         ON EXIT 
*                X0 HAS NREC - NEXT REC NBR 
*                X1 HAS REC SIZE IN WORDS 
*                X2 NOT CHANGED 
*                X3 NOT CHANGED 
*                X4 HAS A 1 
*                X5 HAS WORD ADDRESS
*                X6 - X7 CLOBBERED
*                A5 CHANGED - ALL OTHER A REGS NOT
* 
 C.CWARL  DATA   0
          FETCH  A0,NREC,X0 
          FETCH  A0,RLWD,X1 
          SX4    B1 
          IX5    X0-X4
          IX6    X5*X1
          FETCH  A0,DPTR,X5 
          IX5    X5+X6
          IX5    X5+X4
          EQ     C.CWARL
 C.GETRL  EJECT 
* 
**        C.GETRL - READS A RELATIVE RECORD 
* 
*         NO INPUT REGISTERS
*                USES RECORD NBR IN NREC FIT FIELD
* 
*         ON EXIT,
*                A0 STILL HAS FIT 
*                X4 HAS A 0 IF RECORD MATCHES KEY 
*                X2 NEGATIVE IF AT END (NO MORE RECORDS)
*                ALL OTHER REGISTERS CHANGED
* 
          ENTRY  C.GETRL
 C.GETRL  DATA   0
          RJ     C.CWARL     COMPUTE ADDRESS
*      C.CWARL RETURNS REC NO IN X0, REC LEN IN X1,  1 IN X4, WA IN X5
          FETCH  A0,LREC,X3,3 
          IX2    X3-X0       LAST REC - CURRENT REC 
          NG     X2,C.GETRL  EXIT IF RECORD NOT ON FILE 
          FETCH  A0,RECA,X2,2      GET RECORD AREA ADDR 
          FETCH  A0,V4FL,X3,3      GET VERSION 4 FILE FLAG
          IX2    X2-X4       ADDR-1 - POINTS TO PLACE FOR KEY 
          SX7    X2 
          PL     X3,GETV5A   JP IF VERSION 5 FILE 
          IX4    X2+X1       POINT TO V4 KEY - AT END OF RECORD 
          SA4    X4          GET WORD THERE 
          SX2    X2+B1       POINT TO FWA OF RECORD 
          BX6    X4 
          SA6    =SSVKEYWD   SAVE THE WORD
          SX7    A4 
 GETV5A   BSS    0
          SA7    =SSVKEYAD   SAVE ADDRESS OF KEY
          SX4    10 
          IX3    X1*X4       REC SIZE IN CHARS
          GET    A0,X2,X3,,X5  READ THE REC 
*      SET RL TO LENGTH OF ACTUAL DATA RECORD 
          FETCH  A0,RLWD,X3  REC LENGTH IN WORDS
          SX4    10 
          SX5    X3-1        -1 WORD FOR HEADER 
          IX4    X4*X5       REC LENGTH IN CHARS
          SA2    SVKEYAD     ADDRESS OF KEY 
          STORE  A0,RL=X4    STORE IT 
          SA2    X2          GET KEY FROM RECORD
          FETCH  A0,CKEY,X5  GET COMPUTED KEY 
          IX4    X5-X2       SET UP FOR EXIT
          MX2    0           FLAG NOT AT END
          FETCH  A0,V4FL,X5 
          PL     X5,C.GETRL  EXIT IF A VERSION 5 FILE 
          SA5    SVKEYWD     GET SAVED WORD 
          BX6    X5 
          SA6    A2          RESTORE WORD WHERE KEY WAS 
          EQ     C.GETRL
 C.PUTRL  EJECT 
* 
**        C.PUTRL - WRITES A RELATIVE RECORD
* 
*         NO INPUT REGS - USES NREC 
* 
*         ON EXIT 
*                ALL REGS EXCEPT B1 AND A0 CHANGED
* 
          ENTRY  C.PUTRL
 C.PUTRL  DATA   0
          RJ     C.CWARL     CALC REC OFFSET
*      C.CWARL RETURNS REC NO IN X0, REC LEN IN X1,  1 IN X4, WA IN X5
          FETCH  A0,LREC,X4,4  GET LAST REC ON FILE 
          IX4    X4-X0
          PL     X4,PUTNC 
          STORE  A0,LREC=X0,4  PUT IN NEW REC 
 PUTNC    BSS    0
          FETCH  A0,CKEY,X4,4      GET COMPUTED KEY 
          FETCH  A0,RECA,X2,2  GET REC AREA ADDR
          FETCH  A0,V4FL,X3,3 
          MX7    59          -1 
          BX6    X4          KEY
          IX2    X2+X7       POINT TO RECORD AREA - 1 (WHERE V5 KEY IS) 
          SX4    X2          ADDR OF KEY
          MX7    0           FOR FLAG IN SVKEYAD
          PL     X3,PUTV5A   JP IF VERSION 5 FILE 
          IX4    X2+X1       V4 FILE - POINT TO KEY AT END OF RECORD
          SA3    X4          GET WORD THERE 
          BX6    X3 
          SA6    SVKEYWD     SAVE WORD
          SX2    X2+B1       POINT TO REAL START OF REC 
          SX7    A3 
 PUTV5A   BSS    0
          SA6    X4          PUT KEY IN CORRECT PLACE 
          SA7    SVKEYAD     SAVE ADDR OF V4 KEY OR 0 IF V5 
          SX3    10 
          IX3    X1*X3
          PUT    A0,X2,X3,,X5  WRITE THE REC
          STORE  A0,WRIF=YES FLAG THAT A WRITE WAS DONE 
          SA2    SVKEYAD     SAVED KEY ADDRESS
          ZR     X2,C.PUTRL  JP IF VERSION 5 FILE 
          SA3    SVKEYWD     GET SAVED WORD 
          BX6    X3 
          SA6    X2          PUT SAVED WORD BACK FOR V4 FILE
          EQ     C.PUTRL
 HDRBUF   BSSZ   HDRBFSZ
          END 
