ASMB,R,L,C
      HED (FMP) OPEN: OPEN A FILE 
*     NAME:   OPEN
*     SOURCE: 92071-18047 
*     RELOC:  92071-16047 
*     PGMR:   G.A.A.
*     MOD:    M.L.K., 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 OPEN,7 92071-1X047 REV.2041 800808
* 
      ENT OPEN
* 
      EXT CLOSE, $OPEN, GTOPN 
      EXT CLD.R, .P1, .P2, .P3, .P4, .P6, .R1 
      EXT .ENTR, LURQ, IFTTY, $SETP 
* 
      EXT F.DCB, F.TYP, F.FLG, F.DLU, F.ST1 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     OPEN ATTEMPTS TO OPEN A FILE. (BLAH, BLAH, BLAH)
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL OPEN(IDCB,IERR,NAME,IOPTN,ISECU,ICR,IDCBS) 
* 
*     WHERE:
* 
*     IDCB   IS A DATA CONTROL BLOCK (144-WORD ARRAY) 
*            TO BE USED FOR ACCESS TO THE FILE
*            DURING THIS OPEN.
* 
*     IERR   WILL BE THE ERROR RETURN CODE (ALSO RETURNED IN A).
* 
*     NAME   IS THE 6-CHARACTER NAME (3-WORD ARRAY).
* 
*     IOPTN  IS THE OPEN OPTION WORD (OPTIONAL).
* 
*            OPTIONS ARE: 
*             BIT   MEANING IF SET
*              0    NON-EXCLUSIVE OPEN
*              1    UPDATE OPEN (DISC FILES ONLY) 
*              2    FORCE TO TYPE 1 OPEN (DISC FILES ONLY)
*              3    USE SUB FUNCTION IN BITS 6-11 (NON-DISC FILES ONLY) 
*              4    PREVENT CREATION OF FILE EXTENTS (DISC FILES ONLY)
*             6-11  ACCESS SUBFUNCTION (NON-DISC FILES ONLY)
* 
*     ISECU   IS THE EXPECTED SECURITY CODE (OPTIONAL). 
* 
*     ICR     IS THE SPECIFIED CARTRIDGE REFERENCE. 
*              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 
*             AREA FOLLOWING HEADER (OPTIONAL). 
*             IF NOT CODED, 128-WORD BUFFER IS ASSUMED. 
*             THE BUFFER MUST EVENLY DIVIDE THE FILE SIZE,
*             HENCE, ONLY PART OF THE SPECIFIED BUFFER MAY BE USED. 
*             SIZE USED IS: 
*             SIZE USED = FILE SIZE/N  WHERE
*              N = (FILE SIZE/IDCBS)+(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
*     -36  LOCK ERROR 
      SKP 
* 
*     ENTRY 
* 
OPEN  NOP 
      LDA DZERO      PRESET ENTRY PARMS 
      STA NAME
      STA IOPTN 
      STA ISECU 
      STA ICR 
      STA IDCBS 
      LDA OPEN
      STA DPEN
      JMP DPEN+1
* 
IDCB  NOP 
IERR  NOP 
NAME  DEF ZERO
IOPTN DEF ZERO
ISECU DEF ZERO
ICR   DEF ZERO
IDCBS DEF ZERO
* 
DPEN  NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF IDCB      TO LOCAL AREA 
* 
      LDB NAME      DID WE GET
      CPB DZERO      ENOUGH PARAMETERS? 
      JMP ER10        NO; ERROR - EXIT
* 
      LDA IDCB      SET UP POINTERS INTO DCB
      LDB F.DCB 
      JSB $SETP 
      DEF .16 
      NOP 
      SKP 
* 
*     PROCESS REQUEST 
* 
      JSB CLOSE     CLOSE FILE
      DEF *+2        IF ALREADY 
      DEF IDCB,I      OPEN
* 
      SZA           SKIP IF NO ERRORS 
      CPA N11        OR IF NOT OPEN 
      RSS 
      JMP EREX      ELSE TAKE ERROR EXIT
* 
*     SET UP D.RTR OPEN REQUEST 
* 
      LDA .9        SET FUNCTION FIELD (OPEN REQUEST) 
      STA .P1        SAVE FOR D.RTR 
* 
      LDA ICR,I     FETCH -LU/+CRN/0
      STA .P2        SAVE FOR D.RTR 
* 
      LDA NAME,I    SET FILE NAME 
      LDB IOPTN,I   GET OPTION WORD 
      ERB            ISOLATE EXCLUSIVE-OPEN FLAG
      CME             COMPLEMENT
      RAL,ERA          MERGE WITH FIRST NAME WORD 
      STA .P3           AND SAVE FOR D.RTR
* 
      ISZ NAME      BUMP TO SECOND NAME WORD
      DLD NAME,I    GET REST OF NAME
      SZA,RSS       IF NULL,
      LDA BLANK      THEN FILL WITH BLANKS
      SZB,RSS       IF NULL,
      LDB BLANK      THEN FILL WITH BLANKS
      DST .P4       SAVE FOR D.RTR
* 
      LDA ISECU,I   GET SECURITY CODE 
      STA .P6        SAVE FOR D.RTR 
* 
      JSB CLD.R     CALL D.RTR
* 
      LDA .R1       GET ERROR WORD
      SSA            IF ERROR 
      JMP EREX        EXIT
      SKP 
* 
*     SET UP USER DATA CONTROL BLOCK
* 
      JSB GTOPN     GET OPEN FLAG 
      DEF *+1 
      STA F.FLG,I    AND SAVE IN DCB
* 
      LDA IDCBS,I   GET REQUESTED PACKING BUFFER SIZE 
      LDB ISECU,I   GET REQUESTED SECURITY CODE 
      JSB $OPEN     SET UP REST OF DCB
      JMP EREX1      IF ERROR, THEN TAKE ERROR EXIT 
* 
      LDA F.ST1,I   GET FIRST STATUS WORD 
      LDB IOPTN,I   GET OPEN OPTION WORD
      RBR,ERB        MOVE UPDATE MODE (BIT 1) INTO E-REG
      SSA,RSS       IF WRITE-PROTECTED ACCESS,
      CLE            THEN CLEAR UPDATE-MODE BIT 
      RAR,ELA       MOVE E-REG INTO STATUS WORD 
* 
      RBR,RBR 
      SLB           IF PREVENT-EXTENT-CREATES (BIT 4) SET,
      IOR B10        THEN SET FLAG IN STATUS WORD 
      STA F.ST1,I   SAVE STATUS WORD
* 
      ELB           MOVE BIT 2 TO SIGN, BIT 3 TO E-REG
      LDA F.TYP,I   GET FILE TYPE 
      SSB,RSS       IF NO TYPE 1 OVERRIDE (BIT 2),
      JMP OPEN1      THEN CONTINUE
* 
      SZA,RSS       IF TYPE ZERO FILE,
      JMP ER9        THEN TAKE ERROR EXIT 
* 
      CLA,INA       FORCE TO TYPE 1 
      STA F.TYP,I    AND SAVE AGAIN 
* 
OPEN1 SZA           IF NOT TYPE ZERO, 
      JMP EXIT       THEN EXIT
      SKP 
* 
*     SET UP TYPE 0 FILE ACCESS (E CONTAINS BIT 3 FROM OPTION WORD) 
* 
      LDA F.DLU,I   GET DEVICE LU 
      AND B77        ISOLATE IT 
      STA LU          SAVE FOR POSSIBLE LOCK REQUEST
* 
      LDA IOPTN,I   GET OPTION WORD AGAIN 
      AND B477K      ISOLATE SUBFUNCTION FIELD
      ADA LU          MERGE WITH OND LU 
      SEZ           IF NEW SUBFUNCTION REQUESTED, 
      STA F.DLU,I    THEN SET IT IN THE DCB 
* 
      LDA IOPTN,I   GET OPTION WORD AGAIN 
      SLA,RSS       IF NOT EXCLUSIVE OPEN (BIT 0) 
      JMP EXIT       THEN DON'T LOCK, EXIT
* 
      JSB IFTTY     TEST IF LU IS 
      DEF *+2         INTERACTIVE 
      DEF LU
* 
      SZA           IF INTERACTIVE
      JMP EXIT       THEN DON'T LOCK! 
* 
      JSB LURQ      REQUEST LU LOCK 
      DEF *+4 
      DEF OPTN      OPTION WORD 
      DEF LU        LU WORD 
      DEF .1        ONE LU
      JMP ER18      ERROR; REPORT BAD REQUEST 
* 
      SZA           NO RN?
      JMP ER36      RIGHT, ERROR
* 
      LDA F.ST1,I   GET STATUS WORD 
      IOR B2         SET LOCK BIT 
      STA F.ST1,I   SAVE AGAIN
      SKP 
* 
*     EXIT
* 
EXIT  LDA F.TYP,I   GET FILE TYPE FOR RETURN IN ERROR CODE
* 
EREX  STA IERR,I    SAVE ERROR CODE 
      JMP DPEN,I     AND RETURN 
* 
ER9   LDA N9        CANNOT OVERRIDE TYPE 0 FILE ACCESS
      JMP EREX1 
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
* 
ER18  LDA N18       ILLEGAL LU
      JMP EREX1 
* 
ER36  LDA N36       DEVICE LOCK ERROR 
* 
EREX1 STA IERR,I    SAVE ERROR CODE 
* 
      JSB CLOSE     MAKE SURE THAT FILE IS CLOSED 
      DEF *+2 
      DEF IDCB,I
* 
      LDA IERR,I    GET ERROR CODE
      JMP DPEN,I     AND RETURN 
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP 
* 
N36   DEC -36 
N18   DEC -18 
N11   DEC -11 
N10   DEC -10 
N9    DEC -9
* 
.1    OCT 1 
.9    DEC 9 
.16   DEC 16
* 
B2    OCT 2 
B10   OCT 10
B77   OCT 77
B477K OCT 47700 
* 
OPTN  OCT 140001
BLANK ASC 1,
* 
DZERO DEF ZERO
* 
LU    NOP           LOGICAL UNIT NUMBER 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                  