*DECK     OPENDRM 
          IDENT     OPEN$RM 
          LIST      C,F,X 
          SST 
          B1=1
          ENTRY     OPEN$RM,STFT$RM 
          BASE      D 
          COMMENT   CRM GENERAL OPENM CAPSULE 
          TITLE     OPEN$RM 
*#
*1CD  OPEN$RM 
*0D   PURPOSE 
*0        PREPARE A FILE FOR I/O PROCESSING AND DO SETFIT PROCESSING. 
*0D   CALL
*                   SB3       0 IF OPEN, 1 IF SETFIT
*0                  SB6       RETURN-ADDRESS
*                   EQ        =YOPEN$RM 
*0D   PARAMETERS
*0        A0        FIT ADDRESS.
*         B1        1.
*         B6        RETURN ADDRESS. 
*0D   ACTION
*0        PROCESS ZZZZZDG FILE, DEFAULT INPUT/OUTPUT/PUNCH TO BT=C, 
*         RT=Z,CHECK FOR VALID SBF FILE IF SBF=YES, DEFAULT BUFFER
*         SIZE, MAKE FIT VALIDITY CHECKS, DO CIO OPEN, AND TAKE LABEL 
*         EXIT IF APPROPRIATE. IF FO=SQ, CHECK FOR TERMINAL FILE, 
*         PROCESS S/L FIELDS, CHECK FOR VALID BUFFER SIZE, AND
*         INITIALIZE FET POINTERS. IF FO=WA, VALIDATE BLOCK AND 
*         RECORD TYPE AND GET EOI WORD ADDRESS. IF FO=AAM, DO 
*         AAM CONTROLLING ROUTINE PROCESSING. 
*0D   REGISTERS USED
*0        ALL EXCEPT A0,B1,B6 
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- ERR$RM,CAPS$RM,MISC$RM,CTL$RM,CHWR$RM,FDL.RES 
*                   CON (PP),STS (PP) 
*         MACROS-   CAP.RM,F.RM,SET.RM,SAVE,ON.RM,DEF.RM,FILESTAT,SYSY
*                   OFF.RM,CLCD.SQ,SYSTEM,RESTORE,CRMEP,CRMEI 
*0D   NARRATIVE DESCRIPTION 
*#
*CALL /EPCOM/ 
 LOFADR   BSSZ      1 
 X        EQU       DGSZ.RM+63D 
 PRUPER   EQU       X/64D 
          IFC       EQ,/"OS.NAME"/KRONOS/,1 
 OPREQ    DATA      0 
 CONWRD   BSSZ      1 
 OPEN$RM  CAP.RM    INTERMEDIATE
 STFT$RM  EQU       OPEN$RM 
          SET.RM    STFT,B3        SETFIT FLAG
          SAVE
 ONCERJ   EQ        ONCE
          OFF.RM    FFCP,NORMOPN
          SET.RM    OC,0           FORCE FILE CARD PROCESSING 
          SET.RM    PDF,0 
          SET.RM    NOFCP,0 
NORMOPN   BSS       0 
          F.RM      OC,X1 
          ZR        X1,NEVEROPN 
          SB2       X1-#OPE#
          NZ        B2,NEVEROPN    FILE NOT CURRENTLY OPENED
          SX6       51B 
          NZ        B3,=XERR$RM    SETFIT ON AN OPENED FILE 
          SX6       40B 
          EQ        =XERR$RM       REDUNDANT OPEN 
 NEVEROPN BSS       0 
          F.RM      LOP,1,X3,-#OP#,7
          NZ        X3,NOT.OPN
          SET.RM    FNF,0 
 NOT.OPN  BSS       0 
          ON.RM     FNF,=XRM$FAT
          DEF.RM    PD,#INPUT#     DEFAULT PD 
          F.RM      PDF,3 
          F.RM      STFT
          BX3       -X1*X3
          MI        X3,CHKOPN      IF OPEN AND SETFIT DID PDF PROCESSING
          SET.RM    LOP,#OP#       SET LAST OPERATION TO OPEN 
          F.RM      SBF,2          PICK UP BUFFER SUPPRESS BIT
          F.RM      WSI,1          PICK UP INTERNAL SPECIAL CASE BIT
          BX2       X1-X2 
          NG        X2,FOPEN       IF EITHER SET DO FULL OPEN 
          F.RM      OC,3
          NZ        X3,CHKOPN      IF PREVIOUSLY OPENED 
 FOPEN    BSS       0 
*#
*0        DEFAULT FILES INPUT/OUTPUT/PUNCH TO BT=C AND RT=Z.
*#
          MX1       42
          SA3       A0             PICK UP LOGICAL FILE NAME
          BX1       X1*X3 
          SX2       80
          SA3       INP.SQ
          BX3       X1-X3 
          ZR        X3,FORCZ       IF INPUT,
          SA3       PCH.SQ
          BX3       X1-X3 
          ZR        X3,FORCZ       OR PUNCH 
          SA3       OUTP.SQ 
          BX3       X1-X3 
          SX2       140 
          NZ        X3,NOFORCZ     IF NOT OUTPUT
 FORCZ    BSS       0 
          SET.RM    RT,#ZT#        FORCE RT=Z 
          SET.RM    BT,#CT#        FORCE BT=C 
          DEF.RM    FL,X2          DEFAULT FL 
 NOFORCZ  BSS       0 
          TITLE     PFILEC
*#
*0        PROCESS INFORMATION WHICH THE FILE CONTROL CARD PLACES IN 
*         THE FILE ZZZZZDG; THIS INFORMATION IS USED TO UPDATE THE
*         FIT.
*0        (1)  IF ZZZZZDG DOES NOT EXIST (NO FILE CONTROL CARDS), 
*              EXIT.
*0        (2)  SEARCH FILE INDEX. THE FIRST 62 WORDS OF ZZZZZDG ARE 
*              A DIRECTORY TO THE REST OF THE FILE. EACH WORD CONTAINS
*              THE NAME OF A FILE MENTIONED ON A FILE CONTROL CARD. 
*               IF MORE THAN 62 FILES EXIST, THE INDEX CONTINUES IN 
*               PRU (1+N*62)+CURRENT PRU NUMBER, WHERE N IS NUMBER OF 
*               PRUS PER ENTRY (CURRENTLY 2). 
*               N TIMES THE ORDINAL OF EACH ENTRY IN THE FILE DIRECTORY 
*               + THE PRU NUMBER OF THE INDEX BLOCK IS THE PRU NUMBER OF
*               THE BLOCK CONTAINING THE FULL ENTRY FOR THE FILE.  IF NO
*               ENTRY CORRESPONDS TO THE FIT, EXIT. 
*0        (3)  UPDATE FIT WITH INFORMATION FROM ZZZZZDG.
*#
*           USE FILINFO TO FIND IF ZZZZZDF EXISTS.
*         [STATUS]=0
*         ZZZZZDF DOES NOT EXIST, DO NOTHING
*         [STATUS]=1
*         THE FIRST INDEX BLOCK IS IN THE BUFFER. 
*         [STATUS]=2
*         THE INDEX MUST BE REREAD
* 
 PFILEC   BSS       0 
          SA3       =YOFCT$RM-1 
          SA4       A0             FIT ADDRESS SAVED IN A4 TILL PFCEXIT 
          ON.RM     NOFCP,PFCEXIT  IF NO FILE CARD PROCESSING REQ, SKIP 
          BX7       X3
          SA0       DEFILE         SET FOR DEFILE I/O 
          ZR        X3,PFCEXIT     NO  FILE CARDS 
          AX7       1 
          SX3       B1             PRU OF FIRST INDEX BLOCK 
          ZR        X7,PINDEX      FIRST INDEX BLOCK IS IN BUFFER 
          AX7       1 
          ZR        X7,NOOPE       FILE IS OPEN 
          SYSY      160B,R
 .NODROP  IFNE      #NODROP#,0
          SX3       =YLFM=
          NG        X3,SKP.NAD
          SET.FS     A0,NAD 
 SKP.NAD  BSS       0 
 .NODROP  ENDIF 
          SET.RM    SRB,1 
 NOOPE    BSS       0 
          SX3       1              CODE HERE TO INFO MUST PRESERVE X3 
          SX7       B1
          SA7       STATUS
 RDINDX   BSS       0 
          SET.RM    PRUNO,X3
          SX7       DBUF
          SA7       DEFILE+2
          SYSY      10B,R          READ FILE INDEX
          ON.RM     FEOI,PFCEXIT   IF EOI REACHED EXIT
 PINDEX   BSS       0 
          SA1       A4             PICK UP LFN
          MX2       42
          BX1       X2*X1 
          SB2       B0             INITIALIZE  FILE COUNT 
 LOOP     BSS       0 
          SA2       DBUF+B2        PICK UP NEXT FILE NAME 
          ZR        X2,PFCEXIT
          SB2       B2+B1 
          BX7       X2-X1 
          ZR        X7,INFO        NAMES MATCH
          SX2       X2-1
          NZ        X2,LOOP        NOT AT END OF INDEX BLOCK
          SB3       62             IF <63 FILES CHECKED 
          SX1       PRUPER         NO. PRU-S PER LFN
          SX2       B3             ANOTHER 62 LFN-S CHECKED 
          IX4       X1*X2            SO ANOTHER PRUPER*63 PRU-S READ
          SX4       X4+B1            PLUS 1 FOR THE INDEX 
          IX3       X3+X4            SO INCREMENT INDEX PRU BY X4 
          SX7       B1+B1          ELSE,
          SA7       STATUS         SET STATUS TO INDEX NOT IN BUFFER
          EQ        RDINDX         GO READ NEXT INDEX BLOCK 
************************************************************************
*         FILE CARD FET 
 DEFILE   VFD       57/0L"DEFILE",3/3 
          VFD       14/0,2/3,20/0,6/2,18/DBUF 
          VFD       42D/0,18D/DBUF
          VFD       42D/0,18D/DBUF
+         VFD       42D/0,18D/DBUF+PRUPER*64+1
          BSSZ      2 
* 
*         BUFFER FOR FILE CARD
* 
          VFD       24/4,36/0 
 STATUS   BSSZ      1 
 DBUF     BSS 
          VFD       24D/3,36D/0 
 FIN      VFD       42D/0L"DEFILE",6/5,12D/0
          BSSZ      4 
 ONCE     BSS 
          SA1       ONCEDONE
          SA2       RA.CEJ
          BX7       X1
          SA7       ONCERJ         SO IT WONT BE DONE AGAIN.
          PL        X2,NOXJ 
          SA1       =YRM$SYS=      LOAD XJ WORD POINTER 
          SX6       013B
          SB2       X1             XJ _ (XJ)     (POST-TAF CTL) 
          LX6       -9
          LX1       30             (FORCE UPPER PACKS WITH 46000B OPS)
          PL        X1,TAFCTL      WE MUST SUPPORT PRE AND POST TAF CTL 
          SB2       A1-B1          XJ _ RM$SYS=-1(PRE-TAF CTL)
 TAFCTL   BSS       0 
          ZR        B2,NOXJ        RJ CLEARS ADDRESS, DONT STORE AGAIN
          SA6       B2+            PLUG XJ INSTRUCTION INTO RM$SYS= 
 NOXJ     BSS 
          FILINFO   FIN 
          SA1       FIN+1 
          BX7       X1
          SA7       =YOFCT$RM-1 
 ONCEDONE EQ        ONCERJ+1
          BSS 
          BSSZ      PRUPER*64+1-*+DBUF
* 
************************************************************************
 INFO     BSS       0 
          SX1       PRUPER         NO. PRU-S PER LFN
          SX2       B2-B1          INDEX INTO INDEX -1 FOR THIS LFN 
          IX4       X1*X2            TIMES 2
          SX4       X4+B1            PLUS 1 
          IX6       X3+X4            TO GET PRU NO. OF LFN-S DATA 
          SET.RM    PRUNO,X6       IF MATCH, SET PRU NUMBER 
          SX7       DBUF
          SX6       B1+B1 
          SA7       DEFILE+2       RESET IN POINTER 
          SA6       STATUS         SET STATUS TO INDEX NOT IN BUFFER
          SYSY      10B,R          READ PRU WITH FIT AND MASK 
          SA1       DBUF           READ UP LENGTH OF FIT+MASK 
          AX2       X1,B1          HALF TO GET FIT LENGTH 
          SB2       X2             SAVE FIT LENGTH
          SB3       B0             INITIALIZE WORD COUNT
          SA0       A4             RESET FIT ADDRESS
          F.RM      FWB,X2
          F.RM      BFS 
          LX2       18
          BX7       X1+X2 
          SA7       FWBBFS         SAVE FWB ANS BFS 
 NEXT     BSS       0 
          SA1       DBUF+2+B3      READ WORD OF ZZZZZDG FIT 
          SA2       A4+B3          READ WORD OF FIT 
          SA3       A1+B2          READ WORD OF PRU MASK
          BX2       -X3*X2         MASK OFF FIT WORD
          IX7       X2+X1          OR IN FILE CARD INFO 
          SB3       B3+B1          INCREMENT WORD COUNT 
          SA7       A2             RESET WORD IN FIT
          LT        B3,B2,NEXT     IF NOT LAST WORD OF FIT
          F.RM      BFS 
          SA2       FWBBFS
          MX7       42
          BX7       -X7*X2         PREVIOUS BUFFER SIZE 
          IX7       X7-X1 
          PL        X7,BUFOK       BUFFER SIZE DIDN'T INCREASE
          AX2       18
          F.RM      FWB 
          BX1       X1-X2 
          NZ        X1,BUFOK       FWB HAS ALSO BEEN CHANGED
          SET.RM    FWB,0          FORCE BUFFER REALLOCATION
BUFOK     BSS       0 
 PFCEXIT  BSS       0 
          SA0       A4             RESTORE FIT ADDRESS
          SET.RM    PDF,1          SET STATUS IN CASE THIS IS SETFIT
*     COMPLETELY CHECK VALIDITY OF FILE NAME. 
*     ALGORITHM BY R. E. JAMES, 10/77.
          SA1       A0             LFN
          SA3       Z999999        UPPER BOUND
          SA2       A3+B1          AAAAAAAAAA 
          MX7       42
          BX1       X7*X1          CLEAR CS 
          SX6       165B+1S17      INVALID FILE NAME
          ZR        X1,CALLERR
          MX0       -1
          IX4       X1+X0 
          BX5       X1-X4          MASK OVER TRAILING ZEROS 
          IX4       X3-X1          SHOULD NOT BORROW
          AX5       6 
          BX2       -X5*X2         LOWER BOUND  (SOME A-S)
          IX0       X1-X2          SHOULD NOT BORROW
          LX2       6 
          BX3       -X0-X4
          BX4       X2*X3 
          NZ        X4,CALLERR     IF LFN NOT VALID 
*#
*         SET UP (ULP"0), EP,XL,XP,LEN, AND CMPLT BITS
*         SET UP FET EXTENSION POINTER AND LENGTH IN FET
*#
          SX0       63B            UP,EP,X,X,XL,XP
          MX2       6 
          NE.RM     ULP,#NO#,NOUP,B2
          SX0       23B            EP,X,X,XL,XP 
NOUP      BSS       0 
          SX7       #MNF# 
          LX0       40-18          POSITION UP,EP,XL,XP 
          BX0       X0+X7 
          LX2       24
          SA1       A0+B1           LOAD FET WORD 1 
          LX0       18
          BX3       X2*X1 
          BX1       -X2*X1
          ZR        X3,DEFTL       IF SIZE FIELD EMPTY
          BX1       X3+X1 
          BX0       -X2*X0
DEFTL     BSS       0 
          BX7       X0+X1 
          SA7       A1
          SET.RM    CMPLT,1        SET COMPLETE BIT 
          SX6       A0+8D          POINTER
          SET.RM    FETX,X6 
          SX7       B1             LENGTH MUST BE 1 AS PER NOS/BE REF MN
          SA7       A0+8D 
*#
* 
*         CALL FILEINFO TO GET INFORMATION ABOUT FILE 
* 
*#
          SA2       A0             ADD FILE NAME
          F.RM      MFN,3 
          ZR        X3,NOMFN       NOT MULTIFILE
          NE.RM     FO,#SQ#,NOMFN 
          SB2       59-35 
          LX2       X3,B2          USE MFN
 NOMFN    BSS       0 
          MX5       42
          BX2       X5*X2          CLEAR FILE NAME OF GARBAGE 
          BAM.FO    NOT1           IF BAM FILE CANNOT BE DUPLICATE FIT
          F.RM      FSTT
          NZ        X1,DISK        IF AAM FILE ALREADY OPEN 
          SA3       =XLOF$RM
          SA1       X3             INITIALIZE A1 AND PICK UP HEADER 
          SB5       X3-1           SET SEARCH LIMIT 
 LOFLOP   BSS       0 
          SA1       A1+B1          PICK UP NEXT ENTRY 
          ZR        X1,NOT1        IF END OF LIST - NO DUPLICATE
          BX3       X1*X5          REMOVE FIT ADDRESS 
          BX6       X3-X2 
          SB5       B5-B1 
          ZR        X6,MATCH       DUPLICATE FIT FOUND
          GE        B5,B0,LOFLOP   IF MORE ENTRIES
          EQ        NOT1           NO MATCH FOUND 
 MATCH    BSS       0 
          SB2       A0             SAVE FIT ADDRESS 
          SA0       X1             SET A0 TO DUPLICATE FIT ADDRESS
          F.RM      BZF,3,X3
          SA0       B2             RESTORE REAL FIT ADDRESS 
          ZR        X3,LOFLOP      MUST BE CLOSED TRY AGAIN 
          RCL.RM    X3,A           ISSUE AUTO-RECALL ON BZF 
NOT1      BSS       0 
          SA1       FILI           PICK UP TEMPLATE 
          BX6       X1+X2 
          SA6       FILI$RM 
          FILINFO   FILI$RM 
          SA1       FILI$RM+1      SET DEVICE TYPE FOR LABL$RM
          BX2       X1
          AX2       48
          SX2       X2-2ROD        CHECK FOR OPTICAL DISK DEVICE
          NZ        X2,NOTOD       IF NOT OPTICAL DISK
          SB2       B6             SAVE B6
          MX3       0 
          SX2       16             LENGTH OF OD FET EXTENSION 
          SB5       =YCMM.ALF 
          SX6       346B
          NG        B5,CALLERR
          RJU       =XCMM.ALF      ALLOCATE FIXED 
          SB6       B2             RESTORE B6 
          SX2       16
          LX2       18
          BX6       X2+X1 
          SET.RM    LAL,X6         PTR AND LEN OF EXTENSION IN FET+11B
          SET.RM    JNK,0          CLEAR UPPER 24 BITS OF FET+11B 
          SET.RM    RA,0           CLEAR RANDOM ADDRESS IN FET+6
          SX5       4000B          PRU SIZE FOR OPTICAL DISK
          EQ        DISK
 NOTOD    BSS       0 
          LX1       59-24 
          SX5       100B           SET PRU SIZE FOR DISK
          PL        X1,DISK        IF NOT MAGNETIC TAPE 
          SET.RM    TAPE,B1        MT/NT=1, SET TAPE BIT
          MX7       42
          SA1       FILI$RM 
          BX7       X7*X1 
          SA7       A1             CLEAR COMPLETE BIT 
*         TAPE FRMAT IS OBTAINED FROM KEY WORD 1 OF THE 
*         EXTENDED FILINFO. 
          SA1       FILI$RM+5 
          LX1       59-5
          NG        X1,DISK        TEST STATUS OF EXTENDED FILINFO MACRO
          SX1       X1
          SX2       B1             ON FOR SOL TAPE FORMATS
          SX3       B0             ON FOR L TAPE FORMAT 
          SX5       1000B          SET PRU FOR BINARY TAPE FILE 
          SX7       X1-4
          ZR        X7,SETLBT      IF L FORMAT
          SX7       X1-3
          ZR        X7,SETSL       IF S FORMAT, SET SOL BIT 
          SX2       B0             NOT SOL TAPE FORMATS 
          SX7       X1-5
          NZ        X7,SETSL       IF NOT LI FORMAT 
 SETLBT   BSS       0 
          SX3       B1+            L OR LI FORMAT - SET LONG BLOCK FLAG 
          SX5       10000B         SET PRU SIZE FOR LI TAPE FILE
 SETSL    BSS       0 
          SET.RM    SOL,X2
          SET.RM    LBT,X3
          LX2       59
          AX2       59             CREATE MASK FOR S/L DEVICE 
          BX5       -X2*X5         SET PRUSIZ TO 0 FOR S/L TAPE 
          EQ        SETPRU
 DISK     BSS       0 
          SET.RM    UP,0           AUTOMATIC DEVICE SET SWAPPING
          F.RM      FSTT
          ZR        X1,NOT2 
          AAM.FO    CHKOPN         AAM FILE ALREADY OPENED, UPDATE LOF
NOT2      BSS       0 
          F.RM      PD,X3,-#INPUT#
          ZR        X3,POK         IF OPEN FOR INPUT PERMISSIONS OK 
          SA1       FILI$RM+1 
          MX6       12
          BX2       X6*X1          ISOLATE DEVICE TYPE
          ZR        X2,POK         IF FILE DOES NOT EXIST 
          AX1       6 
          SX2       X1             GET STATUS BITS
          SX6       16B            MASK FOR W/M/A PERMISSION BITS 
          BX1       X2*X6 
          NZ        X1,POK         IF ANY SET PERMISIONS OK 
          SX3       X3+#INPUT#-#OUTPUT# 
          SX6       301B           SET ERROR FOR NO WRITE PERMISSION
          ZR        X3,CALLERR     IF OPENM FOR OUTPUT
          SET.RM    PD,#INPUT#     FORCE PD=INPUT INSTEAD OF IO 
 POK      BSS       0 
          F.RM      PD,X3,-#OUTPUT# 
          SX1       B0
          ZR        X3,RSTWA
          SA1       FILI$RM+3 
RSTWA     BSS       0 
          SX3       B1             PICK UP NPRU 
          AX1       30             RIGHT JUSTIFY
          IX6       X1+X3          EOIWA
          SET.RM    EOIWA,X6
 SETPRU   BSS       0 
          SET.RM    PRUSIZ,X5 
          OFF.RM    STFT,OPNNONAA 
          SB4       #STF#          CURRENT OP FOR SETFIT FOR AAM
          AAM.FO    AAM 
 OPNNONAA BSS 
          NE.RM     BT,#KT#,NOT.K,B5
          DEF.RM    RB,1           FOR RT=K 
 NOT.K    BSS       0 
          OFF.RM    SBF,OPEN$MBL
 OPEN$RM  TITLE     OPEN$SBF
*#
*0        SBF IS VALID ONLY ON SQ FILES SO IF FO"SQ, BRANCH TO
*         OPEN$BFS TO DO REGULAR OPEN.
*         IF THE FILE HAS BEEN SUCCESSFULLY OPEN-SBF-D, SKIP
*         SBF BT/RT VALIDITY CHECKS; OTHERWISE CHECK RT=S OR
*         BT=K AND RB=1 AND RT=U OR F. IF NOT, BRANCH TO OPEN$BFS 
*         AND DO REGULAR OPEN.
*#
 OPEN$SBF BSS       0 
          NE.RM     FO,#SQ#,OPEN$MBL  IF NOT SQ, DO REGULAR OPEN
          F.RM      RT,X3,-#ST# 
          ZR        X3,SBF.RTOK 
          F.RM      BT,X4,-#KT# 
          NZ        X4,OPEN$MBL    RETURN TO NORMAL OPEN
          F.RM      RB,X4,-1
          NZ        X4,OPEN$MBL     RETURN TO NORMAL OPEN 
          SX3       X3+#ST#-#FT#
          NZ        X3,SBF.CHKU 
          F.RM      FL,1
          NZ        X1,SBF.RTOK 
          EQ        NLTHERR        IF RT=F, FL MUST BE SET
 SBF.CHKU BSS       0 
          SX3       X3+#FT#-#UT#
          NZ        X3,OPEN$MBL    RETURN TO NORMAL OPEN
 SBF.RTOK BSS       0 
*#
*         SET THE INTERNAL SBF FLAG WSI(RSI) TO 1 TO INDICATE 
*         A VALID SBF FILE. 
*         SET THE CHECK-S FLAG (CKS) TO INDICATE LAST OPERATION ON
*         FILE WAS CHECKED FOR I/O COMPLETION BY THE USER BEFORE
*         RE-USING HIS WSA (BUFFER).
*#
          SET.RM    WSI,1 
          SET.RM    CKS,1 
          ON.RM     STFT,XIT
          EQ        CHKOPN
 OPEN$RM  TITLE     OPEN$MBL
*#
*0        THESE CHECKS VALID FOR FO=SQ ONLY.
*         CHECK FOR BT RT CONSISTENCY AND DEFAULT OR ROUND MBL
*         AS NECESSARY FOR CURRENT BT AND DEVICE TYPE 
*#
 OPEN$MBL BSS       0 
          F.RM      FO,X2,-#SQ# 
          NZ        X2,OPEN$BFS    IF FO NE SQ
          F.RM      RT,X2,-#ST# 
          F.RM      MBL 
          BX7       X1
          SB5       CRTN
          EQ        =XCHWR$RM      GET MBL IN WORDS 
 CRTN     BSS       0 
          SX5       X7             SAVE WORD COUNT IN X5 TILL END OF OPE
          ZR        X2,RNDMBL      SAVE WD COUNT IN X5 TILL END OF OPEN 
          SET.RM    ESF,1          INITIALIZE END-OF-SECTION FLAG 
          F.RM      BT,B3 
          SB2       #CT#
          EQ        B2,B3,RNDMBL   IF BT=C
          SB2       #ET#
          EQ        B2,B3,ETYPE    IF BT=E
          SB2       #KT#
          NE        B2,B3,NOTKE    IF NOT EQUAL K 
* BT=K
* BT=E
 ETYPE    BSS       0              COMMON TO BT=K/E 
          F.RM      MRL,2 
          NE.RM     RT,#FT#,NOT.F,B4
          DEF.RM    MNR,X2
 NOT.F    BSS       0 
          SET.RM    EK,1
          NZ        X5,MBLOK       MBL NOT NULL 
          F.RM      RB
          IX2       X1*X2          MBL (CHARACTERS) 
          SX6       026B
          ZR        X2,CALLERR     MBL=0 AND MRL=0
          SET.RM    MBL,X2
          BX7       X2
          SB5       MRTN
          EQ        =XCHWR$RM      MBL IN WORDS 
MRTN      SX5       X7
MBLOK     BSS       0 
          SX6       154B
          OFF.RM    SOL,CALLERR    IF NOT S/L DEVICE
          SX6       22B 
          EQ.RM     RT,#WT#,CALLERR IF RT=W 
          SET.RM    ESF,0          CLEAR ESF, END-OF-SECTION UNDEFINED
          EQ        MBLSL          BT=K/E CHECKOUT
 NOTKE    BSS       0 
          NE        B3,B0,NOTDI    IF BT"DEFAULT
          SET.RM    BT,#IT#        SET DEFAULT TO I 
          SB3       #IT#
 NOTDI    BSS       0 
          SB2       #IT#
          SX6       20B 
          NE        B2,B3,CALLERR IF BT"I/C/K/E, ERROR
* BT=I
          SET.RM    MUL,0 
          SET.RM    MBL,5120
          SX5       1000B          DEFAULT MBL BT=I 
          F.RM      RT,X2,-#WT# 
          SX6       25B 
          NZ        X2,CALLERR    IF BT=I AND RT"W, ERROR 
* BT=C
 RNDMBL   BSS       0 
          SET.RM    EK,0
          ON.RM     SOL,MBLSL 
          F.RM      PRUSIZ,X2,-1
          IX3       X2+X5 
          BX5       -X2*X3         ROUND MBL TO PRUSIZE*N FOR BT=C/I
          SB2       3              CONVERT MBL BACK TO CHARACTERS 
          IX2       X5+X5 
          LX3       X5,B2 
          IX3       X3+X2 
          EQ        FIXMBL         RESET MBL
*#
*         ESTABLISH AN MLRS FOR S/L DEVICES 
*#
 MBLSL    BSS       0 
          F.RM      LBT,3 
          SX2       512 
          IX1       X2-X5          512-MBL
          PL        X1,MOK         IF MBL LE 512
          SX6       157B
          PL        X3,CALLERR    ELSE, IF S TAPE, ERROR
 MOK      BSS       0 
          ZR        X5,SETMBL      IF MBL NOT SPEC
          BX2       X5             MLRS = MBL (WORDS) 
 SETMBL   BSS       0 
          F.RM      MBL,X3
          BX4       X3
          NZ        X3,SETMLRS     USER SPECIFIED MBL 
          SX3       5120
          OFF.RM    LBT,STD.DEF 
          F.RM      BFS 
          ZR        X1,STD.DEF
          SX2       X1-2           MLRS (WORD COUNT)
          BX1       X2
          IX3       X2+X2 
          LX1       3 
          IX3       X1+X3          MBL (CHARACTER COUNT)
 STD.DEF  BSS       0 
          NE.RM     RT,#ST#,SETMLRS,B5
          F.RM      MRL 
          ZR        X1,SETMRL      IF MRL NOT SPEC
          BX6       X3             SAVE MBL CHARACTERS
          SX7       10
          IX7       X1+X7          MRL + 10 (IN CHARACTERS) 
          IX1       X3-X7          5120 - (MRL + 10)
          NG        X1,SETMLRS
          SB5       RTNMLRS 
          EQ        =XCHWR$RM      USE MRL+10 FOR MRLS COMPUTATION
 RTNMLRS  BSS       0 
          BX3       X6             RESTORE MBL CHARACTERS 
          EQ        MRLW
  
 SETMRL   BSS       0 
          SET.RM    MRL,X3         MRL = 5120 
          SX7       512            MLRS 
 MRLW     SX2       X7             SET MLRS TO MRL+10 (IN WORDS ...)
SETMLRS   BSS       0 
          SET.RM    MLRS,X2         SET MLRS TO MBL OR MRL+10 
          F.RM      MUL,B4
          LE        B4,B1,FIXMBL   MUL IS 0 OR 1
          PX2       X3             REDUCE MBL TO MULTIPLE OF MUL
          SX7       B4
          PX1       X7
          NX1       X1
          FX2       X2/X1 
          UX2       X2,B2          INTEGERIZE RESULT
          LX2       B2
          IX3       X7*X2 
 FIXMBL   BSS       0 
          SET.RM    MBL,X3
          F.RM      DVT,2 
          LX2       60-12 
          PL        X2,SETRCLA
          MX2       0 
          CI.SQ     NOMNB 
          F.RM      MNB 
          IX7       X4-X1 
          SX6       173B+1S17 
          NG        X7,CALLERR     USER SPEC MNB GT MBL 
          NZ        X7,SETRCLA     OLD MBL NE MNB 
          SET.RM    MNB,X3
          EQ        SETRCLA 
  
 NOMNB    BSS       0 
          F.RM      BFS 
          AX1       1 
          IX2       X1-X5          MBL-BFS/2
SETRCLA   LX2       1              BIT 0 ON IF MBL.GT.BFS/2 AND DT=TAPE 
          SET.RM    RCLA,X2,,,CHOP
 OPEN$RM  TITLE     OPEN$BFS
*#
*0        CALCULATE BUFFER SIZE NEEDED IF NOT SUPPLIED BY USER
*         VALIDATE SIZE SUPPLIED BY THE USER
*                   IF INSUFFICIENT AND 
*                    FO=SQ/WA, CHECKED LATER
*                    FO=IS/DA/AK,  RETURN VALID SIZE
*0        THIS IS FIRST TIME AAM IS NEEDED,THEREFORE IT MAY HAVE TO BE
*         LOADED
*#
 OPEN$BFS BSS       0 
          SET.RM    WSI,0          CLEAR SBF FILE FLAG
          F.RM      BFS,3 
          NZ        X3,GOTBFS 
          F.RM      FO,X2,-#WA# 
          ZR        X2,WABUF       IF FO=WA 
          IFLT      #SQ#,2,1
          IFGE      #WA#,2,1
          ERR       TEST NOT VALID DUE TO CHANGE IN FO
          PL     X2,CHKOPN         SKIP IF AAM FILES
          F.RM      MBL,3 
          BX7       X3             CONVERT MBL INTO WORDS 
          SB5       MBLWDS
          EQ        =XCHWR$RM 
MBLWDS    BSS       0 
          SX3       X7
          ON.RM     SOL,BUFSET
          F.RM      PRUSIZ,5
          IX1       X3-X5 
          PL        X1,BUFSET 
          BX3       X5
          EQ        BUFSET
  
 WABUF    BSS       0 
          ON.RM     SBF,GOTBFS     DO NOT NEED A BUFFER 
          SX3       52429 
          IX2       X3*X5 
          AX2       25             DIVIDE BY 640 TO GET NUMBER OF PRUS
          LX2       6 
          SX3       X2+65-3        ROUND UP 
  
 BUFSET   SX3       X3+3           ALLOW SLACK
          SET.RM    BFS,X3
 GOTBFS   BSS 
*#
*0        AT THIS POINT WE ARE DONE WITH SETFIT - IF THIS IS
*         SETFIT, EXIT; ELSE, CONTINUE. IF THIS IS OPENM AFTER A
*         SETFIT, CONTROL WILL COME HERE. 
*#
 OPEN$RM  TITLE     RT ERROR CHECKING 
CHKOPN    BSS       0 
          ON.RM     STFT,XIT
M.        IFC       EQ,/"OS.NAME"/KRONOS/ 
          AAM.FO    NOTMFN
          F.RM      MFN 
          ZR        X1,NOTMFN 
          F.RM      LFN,3 
          LX1       6              SET MFN ON 7 CHAR AS LFN 
          SET.RM    LFN,X1,,2 
          MX7       60-36 
          BX3       -X7*X3         PREVENTS 1ST CHAR WRAP AROUND
          SET.RM    MFN,X3         LFN W/O THE FIRST CHAR 
NOTMFN    BSS       0 
M.        ENDIF 
          MX7       42
          SA5       A0
          SX2       A0
          BX5       X7*X5 
          BX5       X5+X2 
* CALL /SETLOF/ 
*CALL /SETLOF/
*#
*0        DO RECORD TYPE PROCESSING.
* 
*#
          F.RM      FSTT
          ZR        X1,NOT3 
          SB4       #OPN# 
          AAM.FO    AAM            AAM FILE ALREADY OPENED
NOT3      BSS       0 
          F.RM      RT,B2 
          SX6       030B           ILLEGAL RT 
          NONEOF    B2,(#ZT#,#WT#,#FT#,#UT#,#ST#,#DT#,#TT#,#RT#),CALLERR
          SX2       1*2+0          GET$SQ / PUT$SQ
          SB3       #ST#
          NE        B2,B3,NONS
          SX2       0*2+0          GET$S / PUT$S
 NONS     SET.RM    DCKJ,X2 
          SX2       B2-#WT# 
          NZ        X2,ISITD       IF RT"W
          SX6       162B           RT=W AND CM=YES
          ON.RM     CM,CALLERR
 ISITD    BSS       0 
          SB3       #DT#
          EQ        B2,B3,DTYPE    IF RT=D
          SB3       #TT#
          NE        B2,B3,NTTYPE   IF RT"T
          F.RM      HL,1           IF HEADER LENGTH 
          F.RM      TL,2           OR TRAILER LENGTH
          ZR        X1,HOTLERR     ZERO, ERROR
          ZR        X2,HOTLERR
 DTYPE    BSS       0 
          F.RM      CL,1
          SX2       X1-7           IF COUNT LENGTH
          SX6       037B
          PL        X2,CALLERR     IF GREATER THAN 6
          SX6       033B
          ZR        X1,CALLERR     IF ZERO
          F.RM      CP,2           CHARACTER POSITION 
          IX3       X1+X2          PLUS CHARACTER LENGTH
          F.RM      MNR,2 
          IX1       X2-X3 
          PL        X1,CKMRL       IF MNR \ CL+CP 
          SX6       036B           KEY NOT IN MNR/HL ON RT=D/T
          NZ        X2,CALLERR
          SET.RM    MNR,X3         DEFAULT MNR = CP+CL
          BX2       X3
CKMRL     AAM.FO    RTOK           IF AAM FILE DO NOT CHECK MRL 
          F.RM      MRL,1 
          IX7       X1-X2 
          PL        X7,RTOK 
          SX6       035B           KEY OR MNR NOT IN MRL
          EQ        CALLERR 
 NLTHERR  SX6       031B           NO LENGTH ON RT=Z/F
          EQ        CALLERR 
 HOTLERR  SX6       032B           NO HL OR TL ON RT=T
          EQ        CALLERR 
 NTTYPE   BSS       0 
         AAM.FO     RTOK           IF AAM DONT CHECK FL=0 
          SB3       #ZT#
          EQ        B2,B3,ZTYPE    IF RT=Z
          SB3       #FT#
          NE        B2,B3,RTOK     OR RT=F
 ZTYPE    BSS       0 
          F.RM      FL,1
          ZR        X1,NLTHERR     AND FL=0, ERROR
          SB3       #ZT#
          NE        B2,B3,RTOK     IF NOT RT=Z
          SX7       131071
          IX1       X7-X1 
          SX6       167B
          NG        X1,CALLERR     IF FL TO LARGE 
 OPEN$RM  TITLE     LABEL PROCESSING/CIO OPEN 
 RTOK     BSS       0 
*#
*0        AT THIS POINT THE PHYSICAL OPEN IS DONE AND ALL LABEL 
*         PROCESSING IS DONE.  LABEL EXITS ARE TAKEN AS FOLLOWS:  
*         OF=R
*          LT=S 
*            PD=INPUT OR PD=I-O AND E PARAMETER ON REQUEST CARD 
*                   LX IS TAKEN BEFORE THE OPEN SO THE USER CAN PUTL
*                   HDR LABELS IN THE LABEL BUFFER TO BE CRACKED DURING 
*                   THE CIO OPEN.  LX IS TAKEN AGAIN AFTER THE OPEN 
*                   SO THE USER CAN GETL LABELS READ FROM THE DEVICE. 
*            PD=OUTPUT OR PD=I-O AND N PARAMETER ON THE REQUEST CARD
*                   LX IS TAKEN BEFORE THE OPEN ONLY. 
*                   AT THIS EXIT THE USER CAN PUTL LABELS TO THE LABEL
*                   BUFFER TO BE WRITTEN TO THE DEVICE AS PART OF THE 
*                   CIO OPEN. 
*          LT=NS
*            PD=INPUT OR PD=I-O AND E PARAMETER ON THE REQUEST CARD 
*                   LX IS TAKEN AFTER FILE IS OPENED.  AT THIS EXIT 
*                   THE USER CAN GETL LABELS FROM THE DEVICE. 
*            PD=OUTPUT OR PD=I-O AND NPARAMETER ON THE REQUEST CARD 
*                   LX IS TAKEN AFTER THE FILE IS OPENED.  AT THIS EXIT 
*                   THE USER CAN PUTL LABELS TO THE DEVICE. 
*          LT=UL/ANY               NO LABEL EXITS TAKEN 
*         OF=N/E    NO LABEL EXITS TAKEN
*#
          SET.RM    PDF,0          CLEAR FOR OPENM
*#
*         SET UP FET CIRCULAR BUFFER POINTERS SO THAT THE FILE CAN BE 
*         OPENED WITHOUT GETTING BUFFER ARGUMENT ERRORS. POINT THEM 
*         AT FIT SCRATCH STORAGE AND MAKE THEM TOO SMALL TO DO ANY I/O. 
*#
          F.RM      BFS,5          IF EITHER=0, FAKE CB POINTERS
          SX6       354B
          NG        X5,CALLERR     IF BFS NEGATIVE
          F.RM      FWB,1 
          ZR        X5,CHGPTRS
          ZR        X1,CHGPTRS
          SB2       A0+#FTL#
          SB3       X1+0
          EQ        B2,B3,CHGPTRS 
          IX5       X5+X1          PUT LIMIT VALUE IN X5
          BX6       X1             PUT FIRST,IN,OUT VALUE IN X6 
          EQ        SETPTRS 
 CHGPTRS  BSS       0 
          SX6       A0+#FTL#       FIRST,IN,OUT 
          SX5       A0+#FTL#+2     LIMIT
 SETPTRS  BSS       0 
          SET.RM    FIRST,X6
          SET.RM    IN,X6 
          SET.RM    OUT,X6
          SET.RM    LIMIT,X5
          SET.RM    FP,#BOV#
          SB4       100B           SET FUNCTION CODE TO OPEN NR 
          F.RM      OF,1           CHECK OF FOR REW (0 OR 1)
          SX2       X1-#R#
          ZR        X1,CHKLT       REWIND 
          NZ        X2,CHKPD       IF NOT OPEN REWIND 
 CHKLT    BSS       0 
          NE.RM     LT,#S#,LRTN1,B5  IF NOT STANDARD LABELS 
          SB5       LRTN1          SET RETURN ADDRESS FOR PROCESSING
          SET.RM    ULX,LRTN1      SET EXIT FOR CLOSEL TO TAKE
 LXIT     BSS       0 
          EQ.RM     ULP,#NO#,CLRLAL,B2  IF NO USER LABEL PROC REQUESTED 
          F.RM      LX,B6 
          ZR        B6,CLRLAL      IF NO LABEL EXIT SUPPLIED
          BX6       0              TO ZERO LAL IF LT=#NS# 
          EQ.RM     LT,#NS#,NOLBUF,B4 
          LOAD.BAM  LBUF
          SA1       TMPLBUF 
          BX7       X1
          NZ        X7,JP.OVER     TMPLBUF ALREADY SET - PREVIOUS LOAD
          BX7       X6             CAPSULE LOAD SET X6 TO LBUF$RM 
 JP.OVER  BSS       0 
          SA7       A1
          SX4       9*#LBLIM#      8-WD LABEL + CONTROL WD
          SX6       B5             LBUF 
          LX4       18
          BX6       X4+X6 
 NOLBUF   BSS       0 
          SET.RM    LAL,X6         36-BIT FIELD 
          SET.RM    JNK,0          CLEAR TEMP STORAGE 
          SET.RM    ULR,1          SET BIT FOR CLOSEL TO RETURN 
          JP        B6
 LBUF     FAKEPL    =YLBUF$RM 
  
 CLRLAL   BSS       0 
          F.RM      DVT,X2
          SX2       X2-2ROD        CHECK FOR OPTICAL DISK DEVICE
          ZR        X2,ODDEV1      IF OPTICAL DISK
          SET.RM    LAL,0          CLEAR LABEL ADDRESS AND LENGTH IN FET
 ODDEV1   BSS       0 
          JP        B5             EXIT PROCEEDURE
 LRTN1    BSS       0 
*                   CONTROL COMES HERE AFTER USER LX
          SB4       140B           SET FUNCTION CODE TO OPEN REWIND 
          NE.RM     FO,#SQ#,CHKPD 
          F.RM      MFN 
          ZR        X1,CHKPD       IF NO MULTI-FILE NAME
          SB4       110B           SET FUNCTION CODE FOR POSMF
          EQ        SYSOPEN        GO CHECK CM
 CHKPD    BSS       0 
          F.RM      PD,X2,-#OUTPUT# 
          NZ        X2,IOFILE 
          SB4       B4+4           PD=OUTPUT,I-O REQ=OPEN/WRITE 
          EQ        SYSOPEN 
IOFILE    BSS       0 
          SX2       X2+#OUTPUT#-#INPUT# 
          ZR        X2,SYSOPEN     PD=INPUT,I-O REQ=OPEN/READ 
*                                  UNDER NOS AND PD=I-O 
NOSIO     IFC       EQ,/"OS.NAME"/KRONOS/ 
          ON.RM     LCR,SYSOPEN      LCR=EXIST,I-O REQ=OPEN/READ
          SB4       B4+4             LCR=NEW,I-O REQ=OPEN/WRITE 
NOSIO     ENDIF 
*         UNDER NOS/BE AND PD=I-O, I-O REQ=OPEN/READ
 SYSOPEN  BSS       0 
          F.RM      CM
          NG        X1,BCDOPEN     IF CODED 
          SB4       B4+2           ELSE, SET BINARY BIT IN FUNCTION CODE
 BCDOPEN  BSS       0 
          F.RM      OF,X3,-#E#
          NZ        X3,CIOOPEN     JUMP IF NOT OPEN EXTEND
          SA1       A0+B1          CANNOT OPEN EXTEND TAPE FILES
          SX6       47B 
          NG        X1,CALLERR
          MX4       18
          SX5       17B 
          LX4       18
          SYSY      240B,R,4,5     COUNT=777777B = NO DISK ACCESS 
          SET.RM    WPN,1 
          CLCD.SQ 
 CIOOPEN  BSS       0 
          SET.RM    SRB,0          CLEAR SYSTEM RANDOM BIT
          IFC       EQ,/"OS.NAME"/KRONOS/,2 
          SX6       B4
          SA6       OPREQ          SAVE OPEN REQUEST
          SYSY      B4,R           ISSUE SYSTEM OPEN
* *****  WE JUST OPENED THE FILE  *****                            *****
          MX7       5 
          SA1       A0
          LX7       14
          BX1       X7*X1 
          ZR        X1,OPEN.OK     CHECK CIO STATUS--IF ZERO,OPEN OK
*  CIO OPEN FAILURE 
          MX7       1 
          SX6       556B
          LX7       60-FNF.P
          LX6       60-ES.P-ES.S
          BX6       X7+X6 
          EQ        CALLERR        ISSUE OPEN FATAL ERROR 
 OPEN.OK  BSS       0 
          SET.RM    OC,#OPE#
          SA1       =YOFCT$RM 
          SX6       X1+B1          INCREMENT OPEN FILES COUNT 
          SA6       A1
          SX1       X3+#E#
          SX3       X3+#E#-#R#
          ZR        X1,CHKLT2      REWIND 
          NZ        X3,LRTN2       IF NOT OPEN REWIND 
 CHKLT2   BSS       0 
          F.RM      LT,X3,-#ANY#
          ZR        X3,LRTN2       IF LT=ANY
          SX3       X3+#ANY#-#UL# 
          ZR        X3,LRTN2       IF UNLABELED 
          SX3       X3+#UL#-#NS#
          SB5       LRTN2          SET RETURN ADDRESS FOR PROCESSING
          SET.RM    ULX,LRTN2      SET CLOSEL EXIT ADDRESS
          NZ        X3,SLAB        IF NOT NON-STANDARD LABEL
          F.RM      ULP,X2,-#NO#
          NZ        X2,LXIT        IF USER PROCESSING 
          SX6       337B           ELSE ERROR (LT=NS AND ULP=NO)
          EQ        CALLERR 
 SLAB     BSS       0 
          F.RM      PD,X2,-#OUTPUT# 
          ZR        X2,LRTN2       IF LT=S AND PD=OUTPUT
          SX2       X2+#OUTPUT#-#INPUT# 
          ZR        X2,CHKULP      IF PD=INPUT
          F.RM      LCR 
          PL        X1,LRTN2       IF N ON REQUEST STATMENT 
 CHKULP   BSS       0 
          NE.RM     ULP,#NO#,LXIT,B2  IF USER PROCESSING
 LRTN2    BSS       0 
          RJ        =YRM$UTC
          F.RM      DVT,X2
          SX2       X2-2ROD        CHECK FOR OPTICAL DISK DEVICE
          ZR        X2,ODDEV2      IF OPTICAL DISK
          SET.RM    LAL,0          DELETE POINTER TO UNLOADED BUFFER
 ODDEV2   BSS       0 
          SA1       TMPLBUF 
          BX7       X1
          SA7       =XRM$TMP
          BX7       0 
          SA7       A1
          RJ        =XRM$UTC       UNLOAD LABEL BUFFER
* 
*         FILE ORGANIZATION ERRORS
* 
          F.RM      FO,B3 
          SX6       01B            SET INVALID FO ERROR STATUS
          NONEOF    B3,(#SQ#,#WA#,#IS#,#DA#,#AK#),CALLERR 
          SB2       #WA#
          SB4       #OPN#          CURRENT OPERATION
          AAM.FO    AAM,B3
          EQ        B2,B3,OPEN$WA 
 OPEN$RM  TITLE     OPEN$SQ 
*#
*0        THE FOLLOWING CODE IS EXCLUSIVE TO FO=SQ. 
*         IF THE DEVICE IS A TERMINAL, SET THE CONNECT FLAG.
*         IF NOT A TERMINAL BUT THE CONNECT FLAG IS SET, CALL CON/LFM 
*         (PP ROUTINE) TO CONNECT THE FILE. 
*         NEXT, THE PARAMETERS RELATED TO BLOCK TYPE ARE CHECKED
*         FOR VALIDITY AND CONSISTANCY
*#
 OPEN$SQ  BSS       0 
          F.RM      DVT,3 
 DTCHK    IFC       EQ,/"OS.NAME"/KRONOS/ 
          SX3       X3-2424B
 DTCHK    ELSE
          AX3       6 
          SX3       X3-61B
 DTCHK    ENDIF 
          NZ        X3,CHKCNF      NOT TERMINAL, CHECK CNF
          SET.RM    CNF,1          TERMINAL-SET CNF 
          EQ        CHKOU 
 CHKCNF   BSS       0 
          OFF.RM    CNF,CHKRTS     JUMP IF NOT CONNECTED
          SA3       66B            PICK UP JOB ORIGIN 
          SX7       1S12-1         ESABLISH MASK FOR JOB ORIGIN FIELD 
          LX3       60-24 
          BX7       X3*X7 
          SX3       X7-3
          ZR        X3,TERMINAL    IF JO IS TERMINAL, CONNECT THE FILE
          SET.RM    CNF,0 
          EQ        CHKRTS
 TERMINAL BSS       0 
          F.RM      LFN,X7
          LX7       18
          SA7       CONWRD
 DTCHK    IFC       NE,/"OS.NAME"/KRONOS/ 
          SYSTEM    CON,RCL,CONWRD,0
 DTCHK    ELSE
          SA2       66B            OBTAIN ORIGIN
          MX0       12
          AX2       24
          BX3       -X0*X2
          SB2       X3-3
          NZ        B2,CHKRTS      IF NOT TELEX 
          SYSY      70B,R          RETURN FILE
          SET.RM    DVT,2424B 
          SYSTEM    LFM,RECALL,A0,1502B   ASSIGN TELETYPE 
          SA2       OPREQ 
          SYSY      X2,R           RE-OPEN
 DTCHK    ENDIF 
 CHKOU    BSS       0 
          SET.RM    DCKJ,0*2+1     GPTM$SQ
          SET.RM    MUJ,1          SET MUJ BIT IN CASE USER SET ASCII 
 CHKRTS   BSS       0 
          ON.RM     WSI,SKPTSTS 
          ON.RM     CNF,SKPTSTS 
          F.RM      MBL 
          BX7       X1
          SB5       CTWRTN
          EQ        =XCHWR$RM 
 CTWRTN   SX5       X7             MBL IN WORDS 
*#
*         VALIDATE BUFFER SIZE TO INSURE IT IS ADDEQUATE
*#
          SX6       354B
          F.RM      SOL,B3
          F.RM      BFS 
          ZR        B3,CHKPRUSZ 
          SX3       X5+B3          MBL + 1 FOR S/L DEVICES
          IX2       X3-X1 
          PL        X2,CALLERR     FOR S/L DEV,BLOCK MUST FIT IN BUFFER 
          EQ        SKPTSTS 
 CHKPRUSZ BSS       0 
          F.RM      PRUSIZ,3
          IX1       X3-X1 
          PL        X1,CALLERR     ENSURE BFS IS GREATER THAN PRUSIZ
 SKPTSTS  BSS       0 
          SET.RM    GETJ,0
          SET.RM    PUTJ,0
* CALL /RSPTDSQ/
*CALL /RSPTDSQ/ 
*         ISSUE READ AHEAD IF PD=INPUT AND CNF=NO 
* 
*         IF SBF=1,BUFFER ADDRESS WILL BE CHANGED TO WSA BY GPWR$RM,
*         ANY DATA READ INTO CURRENT BUFFER LOCATION IS LOST. 
          ON.RM     CNF,XIT 
          ON.RM     SPR,XIT 
          ON.RM     SBF,XIT 
          F.RM      FIRST 
          SX7       A0+#FTL#
          IX1       X1-X7 
          ZR        X1,XIT         IF NO BUFFER 
          F.RM      PD,B5,-#INPUT#
          NZ        B5,XIT
          F.RM      SOL 
          SX3       260B-10B
          AX1       59
          BX2       X1*X3 
          SYSY      X2+10B
          SET.RM    PAE,0 
          EQ        XIT 
 OPEN$RM  TITLE     OPEN$WA 
*#
*0        THE FOLLOWING CODE IS EXCLUSIVE TO FO=WA. 
*         CHECK RT - ONLY W,F,U RECORDS ARE ALLOWED FOR FO=WA.
*         CHECK THAT THE FILE IS ON A RMS DEVICE. 
*#
 OPEN$WA  BSS       0 
          SX6       150B           WA FILE ON TAPE
          ON.RM     TAPE,CALLERR
          F.RM      RT,B4 
          SX6       030B           ILLEGAL RT 
          NONEOF    B4,(#WT#,#FT#,#UT#),CALLERR 
*#
*0        SET CPRU=0 SO WA KNOWS NO DATA IS IN THE BUFFER,
*         SET THE SYSTEM RANDOM BIT SO RANDOM READS AND WRITES CAN
*         BE DONE, SET FILE POSITION TO #EOR# SO WA DOESNT THINK THE
*         FILE IS IN THE MIDDLE OF A RECORD, AND SET PAE OFF. 
*#
          SET.RM    CPRU,0
          SET.RM    SRB,1 
          SET.RM    FP,#EOR#
          SET.RM    PAE,0 
*#
*0        ADJUST BUFFER SIZE TO AN INTEGRAL NUMBER OF PRU-S.
*#
          F.RM      BFS,X5
          ON.RM     SBF,SETBFS
          SX5       X5-1
          AX5       6 
          LX5       6 
          SX7       X5-13056
          NG        X7,BUFOK1      BFS .LE. 13056 
          SX5       13056          MAX BFS
 BUFOK1   BSS       0 
          SX6       354B
          ZR        X5,CALLERR
          F.RM      FIRST,B2
          SX5       X5+B1 
          SB3       A0+#FTL#
          EQ        B2,B3,SETBFS   IF NO USER BUFFER
          SET.RM    LIMIT,B2+X5 
 SETBFS   BSS       0 
          SET.RM    BFS,X5
*#
*0        SET DCKJ SO THAT THE CONTROLLER WILL LOAD GET$WA/PUT$WA 
*         ON GET/PUT CALLS. 
*#
          SET.RM    DCKJ,2*2+0     XXX$WA 
*#
*0        EXIT BY UNLOADING OPEN$RM, LOADING COMM$WA AND RESTORING B6.
*         BUT, BECAUSE WE ARE CURRENTLY IN OPEN$RM, CONTROL HAS TO DO 
*         THE UNLOAD AND LOAD.
*#
          RESTORE 
          SB2       B0             INDICATES COMM$WA
          SB3       B6             EXIT ADDR
          SA1       CAPSTAT        OPEN$RM
          BX6       X1
          SA6       =XRM$TMP       SO THAT OPEN WILL GET UNLOADED 
          EQ        =XRM$ULJ
 OPEN$RM  TITLE     AAM 
*#
*0        THE FOLLOWING CODE IS EXCLUSIVE TO FO=AAM.
*         IF THE AAM CONTROL CAPSULE IS LOADED AND NOT STATIC, INCREMENT
*         THE CAPSULE USAGE WORD.  IF ITS NOT LOADED THEN LOAD IT,
*         ISSUING ERROR 347B IF FDL ERROR.  TRANSFER TO AAM CONTROL.
*#
 AAM      BSS       0 
          SET.RM    COP,B4         SET OP CODE INTO FIT FOR AAM 
          RESTORE                  SET B6 TO USER RETURN ADDRESS
          SET.RM    OC,#NOP#
          SA1       CAPSTAT        OPEN$RM
          BX6       X1
          SA6       =XRM$TMP       SO THAT OPEN WILL GET UNLOADED 
          SB3       =YCTRL$AA 
          GT        B3,B0,=YCTRL$AA IF AAM AVAILABLE
          SX6       355B+1S17      ELSE PROBABLE FO CHANGE FROM BAM VIA 
          EQ        CALLERR        FILE CONTROL CARD OR STORE.
 OPEN$RM  TITLE     OPEN$RM EXIT
 XIT      BSS       0 
          SA1       CAPSTAT        OPEN$RM
          BX6       X1
          SA6       =XRM$TMP       SO THAT OPEN WILL GET UNLOADED 
          SET.RM    FP,#BOI#
          RESTORE 
          JP        B6             EXIT 
 CALLERR  BSS       0 
*#
*0        ERROR EXIT -- CLEAR OC IN CASE ERROR OCCURRED AFTER THE CIO 
*         OPEN WHEN OC WAS SET AND CALL ERR$RM TO ISSUE ERROR IN X6.
*#
          SA1       CAPSTAT        OPEN$RM
          BX7       X1
          SA7       =XRM$TMP
          F.RM      OC,B2,-#OPE#
          NZ        B2,=YERR$RM    IF ERROR PRECEDED OPEN STATUS
          SET.RM    OC,0
          SA1       =YOFCT$RM 
          MX2       -1
          IX7       X1+X2          UNDO OPEN FILES INCREMENT
          SA7       A1
          EQ        =XERR$RM
  
FWBBFS    BSSZ      1 
 INP.SQ   DATA      0LINPUT 
 OUTP.SQ  DATA      0LOUTPUT
 PCH.SQ   DATA      0LPUNCH 
 Z999999  CON       7LZ999999+1 
          CON       01010101010101010101B 
FILI      VFD       42D/0,6/6,12D/0  TEMPLATE FOR FILINFO 
 FILI$RM  BSS       0 
          VFD       42D/0,6/6,12D/0 
          BSSZ      4 
          VFD       54D/0,6/1      KEY WORD 1 OF EXTENDED FILINFO 
 TMPLBUF  CON       0 
          END 
