ASMB,R,L,C
      HED (FMP) OPENF: OPEN A FILE OR LU
*     NAME:   OPENF 
*     SOURCE: 92071-18048 
*     RELOC:  92071-16048 
*     PGMR:   M.L.K.
*     MOD:    E.D.B.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
      NAM OPENF,7 92071-1X048 REV.2041 800619 
* 
      ENT OPENF 
* 
      EXT CLOSE, OPEN, GTOPN
      EXT .ENTR, LURQ, EXEC, $SETP
* 
      EXT F.DCB, F.LU,  F.FLG 
      EXT F.TYP, F.ST1, F.RCN 
      EXT F.DLU, F.EOF, F.SPC, F.RWC
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     OPENF IS THE FILE OPEN ROUTINE OF THE REAL TIME 
*           FILE MANAGEMENT PACKAGE 
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL OPENF(IDCB,IERR,NAME,IOPTN,ISECU,ICR,IDCBS)
* 
*     WHERE:
* 
*     IDCB   IS A DATA CONTROL BLOCK (144-WORD ARRAY) 
*            TO BE USED FOR ACCESSING THE FILE
*            DURING THIS OPEN.
* 
*     IERR   WILL BE THE ERROR RETURN CODE (ALSO RETURNED IN A) 
* 
*     NAME   IS THE 6-CHARACTER NAME OR LU (3-WORD ARRAY) 
*            TO OPEN. 
* 
*     IOPTN  IS THE OPEN OPTION FLAG WORD (OPTIONAL). 
*            OPTIONS ARE: 
*            BIT   MEANING IF SET 
*             0    NON-EXCLUSIVE OPEN 
*             1    UPDATE OPEN
*             2    FORCE TO TYPE 1 OPEN 
*             3    USE SUBFUNCTION IN BITS 6-11 
*                  IF TYPE 0 (LU ACCESS)
*             6-11 SUBFUNCTION CODE IF LU ACCESS
* 
*     ISECU  IS THE FILE'S SECURITY CODE (OPTIONAL).
* 
*     ICR    IS THE FILE'S CARTRIDGE REFERENCE (OPTIONAL).
*             IF ICR >0 THEN USE DISC LABELED ICR 
*             IF ICR <0 THEN USE DISC AT LOGICAL UNIT (-ICR)
* 
*     IDCBS  IS THE LENGTH OF THE PACKING BUFFER FOLLOWING THE
*            DCB HEADER (OPTIONAL, DEFAULT 128-WORDS.)
*            THE BUFFER MUST BE AN EVEN 
*            DIVISOR OF THE FILE SIZE SO ONLY PART OF 
*            THE SPECIFIED SIZE MAY BE USED.  THE USED SIZE IS: 
*            USED SIZE=FILE SIZE/N  WHERE 
*            N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0)
* 
*     POSSIBLE ERRORS:
* 
*     -1   DISC ERROR 
*     -6   FILE NOT FOUND 
*     -7   WRONG SECURITY CODE
*     -8   FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR 
*               IS CURRENTLY OPEN TO 7 OTHER PROGRAMS 
*     -9   ATTEMPT TO OPEN TYPE 0 AS TYPE 1 
*     -10  NOT ENOUGH PARAMETERS
*     -13  DISC LOCKED
*     -18  ILLEGAL LU 
*     -36  LOCK ERROR 
* 
      SKP 
* 
*     ENTRY 
* 
OPENF NOP 
      LDA DZERO      PRESET ENTRY PARMS 
      STA NAME
      STA IOPTN 
      STA ISECU 
      STA ICR 
      STA IDCBS 
      LDA OPENF 
      STA DPENF 
      JMP DPENF+1 
* 
IDCB  NOP 
IERR  NOP 
NAME  DEF ZERO
IOPTN DEF ZERO
ISECU DEF ZERO
ICR   DEF ZERO
IDCBS DEF ZERO
* 
DPENF NOP 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF IDCB       TO LOCAL AREA
* 
      LDB NAME      GET LAST REQUIRED PARAMETER 
      CPB DZERO     IF NOT ENOUGH PARAMETERS, 
      JMP ER10       THEN TAKE ERROR EXIT 
* 
      LDA IDCB      MAKE LOCAL COPY OF
      LDB F.DCB      DCB HEADER POINTERS
      JSB $SETP 
      DEF .16 
      NOP 
      SKP 
* 
*     PROCESS REQUEST 
* 
      JSB CLOSE     CLOSE 
      DEF *+2        IF 
      DEF IDCB,I      OPEN
* 
      SZA           SKIP IF NO ERRORS 
      CPA N11        OR IF NOT OPEN 
      CLE,RSS 
      JMP EREX      ELSE TAKE ERR EXIT
* 
      LDA NAME,I    GET FILE NAME OR LU 
      ADA NB20K      COMPARE WITH NAME
      SSA           IF NOT FILE NAME
      JMP OPNLU      THEN TRY LU
* 
      JSB OPEN      OPEN THE FILE 
      DEF *+8 
      DEF IDCB,I
      DEF IERR,I
      DEF NAME,I
      DEF IOPTN,I 
      DEF ISECU,I 
      DEF ICR,I 
      DEF IDCBS,I 
* 
      JMP DPENF,I   AND EXIT
      SKP 
* 
*     DEVICE OPEN 
* 
OPNLU LDA NAME,I    GET LU
      SSA           IF NOT POSITIVE,
      JMP ER18       THEN ILLEGAL LU
* 
      ADA N64       COMPARE WITH 64 
      SSA,RSS       IF NOT LESS THAN 64,
      JMP ER18       THEN ILLEGAL LU
* 
      JSB EXEC      CALL FOR STATUS AND 
      DEF *+5        DEVICE TYPE
      DEF NAB15 
      DEF NAME,I
      DEF DVT6
      DEF SELCD 
      JMP ER18      ILLEGAL LU ERROR RETURN 
* 
      LDA SELCD     GET IFT 6 
      AND B77       ISOLATE SELECT CODE 
      STA SELCD      SAVE SELECT CODE FOR BIT BUCKET TEST 
* 
      LDA DVT6      GET STATUS WORD 
      ALF,ALF        ALIGN DEVICE TYPE
      AND B77         ISOLATE DEVICE TYPE 
      STA DEVTP        AND SAVE 
* 
      LDB MNDSC     GET MINIMUM DISC TYPE 
      ADB A          COMPARE DEVICE TYPE
      SSB           IF LESS THAN MINIMUM, 
      JMP NOTDS      THEN NOT DISC
* 
      LDB MXDSC     GET MAXIMUM DISC TYPE + 1 
      ADB A          COMPARE DEVICE TYPE
      SSB,RSS       IF GREATER THAN MAXIMUM,
      JMP NOTDS      THEN NOT DISC
      JMP ER17       ELSE TAKE ERROR EXIT 
* 
NOTDS LDB MXTTY     GET MAXIMUM TTY TYPE + 1
      ADB A          COMPARE DEVICE TYPE
      SSB           IF INTERACTIVE DEVICE,
      CCB,RSS        THEN SET INTERACTIVE FLAG, 
      CLB            ELSE CLEAR INTERACTIVE FLAG
      STB INT       SAVE FOR LATER TESTS
      SKP 
* 
*     SET UP DCB
* 
      CLA           GET DUMMY DCB FLAG
      STA F.LU,I     AND SAVE IN DCB
* 
*     SET FILE TYPE 
* 
      CLA           SET FILE TYPE TO 0
      STA F.TYP,I     AND SAVE IN DCB 
* 
*     SET LU AND SUBFUNCTION
* 
      LDA IOPTN,I   GET THE OPTION WORD 
      RAR,RAR       PUT THE FUNCTION CODE BIT (#3)
      RAR,ERA        INTO E REGISTER
      LDA IOPTN,I   GET THE OPTION WORD AGAIN 
      AND FMASK      ISOLATE FUNCTION BITS
      SEZ           IF FUNCTION SET?
      JMP ADDLU      THEN USE FUNCTION CODE FROM A-REG
* 
      LDB INT       GET INTERACTIVE FLAG
      SZB,RSS       IF NOT INTERACTIVE DEVICE,
      CLA,RSS        THEN DEFAULT TO NONE 
      LDA ECHO       ELSE DEFAULT TO ECHO 
* 
ADDLU IOR NAME,I    ADD IN THE LU 
      STA F.DLU,I    AND SAVE IN DCB
* 
*     SET EOF CODE
* 
      LDA PAGE      GET PAGE EJECT CODE 
      LDB DEVTP      TEST DEVICE TYPE AGAINST 13 (+1) OCTAL 
      ADB N12 
      SSB           IF LINE-PRINTER (0B-13B), 
      JMP STEOF      THEN USE PAGE EJECT
* 
      LDA LEADR     GET LEADER FUNCTION CODE
      LDB DEVTP     GET DEVICE TYPE 
      CPB B26       IF PAPER TAPE DEVICE, 
      JMP STEOF      THEN USE LEADER
* 
      CPB B27       IF PAPER TAPE DEVICE, 
      JMP STEOF      THEN USE LEADER
* 
      LDA EOF       EVERYTHING ELSE USES EOF
* 
STEOF IOR NAME,I    ADD IN THE LU 
      STA F.EOF,I    AND SAVE IN DCB
* 
*     SET SPACING 
* 
      LDB DEVTP     GET DEVICE TYPE 
      ADB N16       TEST IF SPACING AVAILABLE 
      SSB           IF BELOW SPACING BOUNDARY,
      CLA,RSS        THEN SET NO SPACING
      LDA BOTH       ELSE SET BOTH SPACING
      STA F.SPC,I   SAVE IN DCB 
* 
*     SET READ/WRITE FLAG TO BOTH 
* 
      LDB SELCD     GET SELECT CODE 
      SZB,RSS       IF BIT BUCKET,
      CLA,INA,RSS    THEN SET WRITE ONLY
      LDA BOTH       ELSE SET BOTH READ AND WRITE 
      STA F.RWC,I   SAVE IN DCB 
* 
*     SET SECURITY CODE MATCH AND UPDATE MODE 
* 
      LDA SC.UP     SET BOTH SECCD-MATCH AND UPDATE-MODE
      STA F.ST1,I    SAVE IN DCB
* 
*     SET RECORD COUNT TO 1 
* 
      CLA,INA       SET 1 
      STA F.RCN,I    INTO RECORD NUMBER 
* 
*     LOCK THE DEVICE IF NOT INTERACTIVE
* 
      LDA IOPTN,I   GET OPEN OPTION 
      SLA           IF NOT EXCLUSIVE OPEN,
      JMP EXIT       THEN JUST EXIT (CAN'T LOCK)
* 
      LDA INT       GET INTERACTIVE FLAG
      SZA           IF INTERACTIVE, 
      JMP EXIT       THEN JUST EXIT (DON'T LOCK)
* 
      JSB LURQ      LOCK CALL 
      DEF *+4 
      DEF OPTN      OPTION WORD 
      DEF NAME,I    LU WORD 
      DEF .1        ONE LU
      JMP ER18      ERROR ON LOCK 
* 
      SZA           IF ANY ERROR, 
      JMP ER36       THEN TAKE ERROR EXIT 
* 
      LDA F.ST1,I   SET LOCKED FLAG 
      IOR B2
      STA F.ST1,I 
      SKP 
* 
*     EXIT
* 
EXIT  JSB GTOPN     SET OPEN FLAG 
      DEF *+1        INTO DCB 
      STA F.FLG,I 
      CLA           NO ERROR INTENDED 
      JMP EREX
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
* 
ER17  LDA N17       FMP ERROR -18 
      JMP EREX
* 
ER18  LDA N18       ILLEGAL (DISC) LU 
      JMP EREX
* 
ER36  LDA N36       LOCK ERROR
* 
EREX  STA IERR,I    SAVE IN ERROR CODE
      JMP DPENF,I    AND RETURN 
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP           DUMMY 0 
      NOP 
N10   DEC -10 
N11   DEC -11 
N12   DEC -12 
N16   DEC -16 
N17   DEC -17 
N18   DEC -18 
N36   DEC -36 
N64   DEC -64 
* 
.1    DEC 1 
.16   DEC 16
* 
NB20K OCT -20000    USED FOR LEGAL LU TEST
* 
B2    OCT 2 
B26   OCT 26
B27   OCT 27
B77   OCT 77
B377  OCT 377 
* 
NAB15 OCT 100015    STATUS EXEC W/ SIGN 
* 
MNDSC OCT -30       NEGATIVE MINIMUM VALUE FOR DISC 
MXDSC OCT -40       NEGATIVE MAXIMUM VALUE FOR DISC + 1 
MXTTY OCT -10       NEGATIVE MAXIMUM VALUE FOR TTY + 1
* 
ECHO  OCT 400       ECHO BIT FOR CONWD
PAGE  OCT 1100      PAGE EJECT CONTROL REQUEST
LEADR OCT 1000      PUNCH/READER CNTRL REQUEST
EOF   OCT 100       STANDARD EOF CONTROL REQUEST
BOTH  OCT 100001    FORWARD/BACKWARD AND READ/WRITE CODE
OPTN  OCT 140001    LURQ OPTION REQUEST 
* 
FMASK OCT 43700     BU/TR/EC/BI MASK
SC.UP OCT 100001
* 
DZERO DEF ZERO
* 
*     VARIABLES 
* 
DVT6  NOP           STORAGE FOR DVT6
SELCD NOP           STORAGE FOR IFT6 (CONTAINS SELECT CODE) 
DEVTP NOP           DEVICE TYPE 
INT   NOP           INTERACTIVE FLAG  0=NOT INT, #0=INT 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                          