ASMB,R,L,C
      HED OPEN
*     NAME:   OPEN
*     SOURCE: 92067-18127 
*     RELOC:  92067-16125 
*     PGMR:   G.A.A.,N.J.S. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 92067-16125 REV.2001 791018
      ENT OPEN
      EXT EXEC, CLOSE, RMPAR, $OPEN 
      EXT .ENTR, IFTTY, LURQ
      EXT D.R, OVRD., SESSN, $SMID, ISMVE 
      SUP 
* 
* 
*  OPEN    IS THE FILE OPEN ROUTINE OF THE REAL TIME
*          FILE MANAGEMENT PACKAGE
* 
* 
*          THE FORTRAN CALLING SEQUENCE IS: 
* 
*          CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK)
* 
*  W H E R E: 
* 
*     IDCB          IS A 144-WORD DATA CONTROL BLOCK (ARRAY)
*                   TO BE USED WITH ALL ACCESS TO THE FILE
*                   UNDER THIS OPEN.
* 
*     IERR          IS THE RETURN ERROR CODE (ALSO RETURNED IN A) 
* 
*     NAME          IS THE 6-CHARACTER (3 WORD) NAME ARRAY. 
* 
*     IOP           (OPTIONAL); IS THE OPEN OPTION FLAG WORD
*                    OPTIONS ARE: 
*                     BIT   MEANING IF SET
*                     0     NON-EXCLUSIVE OPEN
*                     1     UPDATE OPEN 
*                     2     FORCE TO TYPE 1 OPEN
*                     3     USE SUB FUNCTION IN BITS 6-11 
*                           IF TYPE 0.
* 
*     IS            (OPTIONAL); IS THE EXPECTED SECURITY CODE.
* 
*     ILU           (OPTIONAL); IS THE DISC SPECIFIED.
*                     IF ILU >0 THEN USE DISC LABELED ILU 
*                     IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU)
* 
*     IBLK          (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF
*                     IBLK WORDS.  (NORMALLY 128 IS USED.)  MUST BE 
*                     A MULTIPLE OF 128. 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)+(1 IF REMAINDER, ELSE 0) 
* 
*       OPEN ERRORS ARE AS FOLLOWS: 
* 
*       FROM D.RTR
*     -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
*     -13   DISC LOCKED 
*     -32   CARTRIDGE NOT FOUND 
* 
*       FROM $OPEN
*     -9    ATTEMPT TO OPEN TYPE 0 AS TYPE 1
* 
*       FROM OPEN 
*     -10   NOT ENOUGH PARAMETERS 
*     -18   LOCK ERROR
*     -36   LOCK NOT GRANTED
* 
      SKP 
DCB   NOP 
ERR   NOP 
NAME  DEF ZERO
OP    DEF ZERO
SC    DEF ZERO
LU    DEF ZERO
IBLK  DEF ZERO
* 
OPEN  NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF DCB        TO LOCAL AREA
      LDA N10 
      LDB NAME      DID WE GET
      CPB DZERO      ENOUGH PARAMETERS? 
      JMP EXIT        NO - ERROR EXIT 
* 
      JSB CLOSE     CLOSE DCB 
      DEF *+2        JUST IN CASE 
      DEF DCB,I       IT'S OPEN 
      SZA           SKIP IF NO
      CPA N11        ERRORS OR IF 
      CLE,RSS         NOT OPEN ERROR
      JMP EXIT      ELSE TAKE ERROR EXIT
* 
*     SET UP AND CALL D.RTR 
* 
      LDA NAME,I    GET NAME WORD 1 
      LDB OP,I       AND OPTION WORD
      ERB           EXCLUSIVE BIT TO E
      CME            INVERT E AND 
      RAL,ERA         SET IN SIGN OF A
      STA NAME1     SET FOR CALL TO D.RTR 
      ISZ NAME      GET REST OF 
      DLD NAME,I     NAME TO STRING 
      DST NAME1+1     BUFFER FOR D.RTR CALL 
      LDA XEQT      GET CURRENT PROGRAM ID
      CCE           SET SIGN BIT TO INDICATE
      RAL,ERA        AN OPEN REQUEST
      STA ID          FOR D.RTR CALL
* 
      JSB EXEC      SCHEDULE D.RTR
      DEF SCRTN      WITH WAIT TO 
      DEF .23         OPEN THE FILE 
      DEF D.R 
      DEF ID        ID + SIGN BIT 
      DEF OVRD.     OVERRIDE BITS 
      DEF LU,I      LU OF FILE
      DEF SC,I      SECURITY CODE 
      DEF ZERO
      DEF NAME1     SEND 3-WORD STRING
      DEF .3         CONTAINING NAME
* 
SCRTN JSB RMPAR     GET RETURN PARAMETERS 
      DEF *+2 
      DEF ID
      LDA ID        GET ERROR WORD
      SSA           IF D.RTR ERROR
      JMP EXIT       JUST EXIT AND PASS IT ON 
* 
      JSB EXEC      RETREIVE STRING PASSED
      DEF *+5        BACK FROM D.RTR
      DEF .14 
      DEF .1
      DEF DIR 
      DEF .6
* 
*     SAVE ON SYSTEM DISC INFORMATION FROM D.RTR AND CALL $OPEN TO SET UP DCB 
* 
      CLB,CLE 
      LDA DIR       GET 1ST WORD OF STRING FROM D.RTR 
      RAL,ERA       CLEAR BIT 15 AND PUT IT IN E
      SEZ           WAS BIT 15 SET?  ON 2 OR 3? 
      CCB           YES - SET B TO -1 
      STB SCFLG     IF ON 2 OR 3, SFLAG = -1, ELSE 0
      STA DIR       REPLACE WORD 1 WITH BIT 15 CLEARED
      DLD ID+1      SET UP FIRST TWO WORDS OF 
      DST DCB,I      THE DCB FROM D.RTR RETURNS 
      CLO           SET O 
      LDA OP,I       TO 
      RAR,SLA,RAR     INDICATE
      STO              UPDATE OPTION
      ERA               AND E FOR TYPE 1 OVER-RIDE
      STA LU        SAVE SUBFUNCTION FLAG 
      LDA DCB       GET DCB ADDRESS 
      LDB ADIR       AND SECURITY CODE
* 
      JSB $OPEN     GO SET UP THE DCB 
      DEF IBLK,I    ADDRESS OF BLOCK SIZE 
      DEF ID+4      ADDRESS OF NO OF SECTORS PER TRACK
      JMP OPEN2     ERROR - CLOSE AND EXIT
* 
* 
*   MUST DECIDE WHETHER TO ALLOW WRITE ACCESS TO THIS FILE.  WHEN 
*   UNDER SESSION CONTROL, LU 2 AND 3 MAY BE ACCESSED ONLY FOR READS
*   UNLESS OVERRIDE CONDITION IS SET. 
* 
*   A.  NORMAL RESTRICTIONS FOR WRITE ACCESS
*       1.  SC IN DIRECTORY IS 0    OR
*       2.  SC IN DIRECTORY IS +X AND SC PASSED IN IS +X OR -X    OR
*       3.  SC IN DIRECTORY IS -X AND SC PASSED IN IS -X
* 
*   B.  TO SET SC BIT IN DCB WORD 7 
*       1.  IF NOT IN SESSION, ONE OF A MUST BE MET 
*       2.  IF IN SESSION AND NOT ON LU 2 OR 3, ONE OF A MUST BE MET
*       3.  IF IN SESSION AND ON LU2 OR 3,
*           A.  1 OF A MUST BE MET   AND
*           B.  OVRD. MUST BE NONZERO OR CALLER MUST BE SYSTEM MANAGER
* 
* 
      JSB SESSN 
      DEF *+2 
      DEF XEQT      E=0 IF IN SESSION 
      SEZ           IN SESSION? 
      JMP OPEN0     NO - GO DO REGULAR SECURITY CHECKING
      STB NAME1     YES - SAVE SESSION WORD (JUST TEMPORARY)
* 
      JSB ISMVE     READ THE CALLER'S USER ID 
      DEF *+5        INTO TEMP SPACE
      DEF NAME1     (SESSION WORD)
      DEF $SMID     (OFFSET TO USER ID) 
      DEF CODE      (TEMP SPACE)
      DEF .1        (JUST ONE WORD) 
      LDA CODE      GET USER ID 
      CPA B7777     CALLER THE SYSTEM MANAGER?
      JMP OPEN0     YES - DO REGULAR SECURITY CHECKING
      LDA SCFLG     A(BIT 15) = 1 IF FILE ON LU 2 OR LU 3 
      LDB OVRD.     B IS #0 IF OVERRIDE CONDITION IS SET
      SSA           FILE ON 2 OR 3??
      CLE,SZB       YES - OVERRIDE? 
      RSS           NOT ON 2 OR 3 OR OVERRIDE IS SET
      JMP OPEN1     ON 2 OR 3 AND NO OVERRIDE SO READ ONLY ACCESS 
* 
*     REGULAR SECURITY CHECKS 
* 
OPEN0 CLE 
      LDB DIR+5     GET SC FROM DIRECTORY 
      SZB           ZERO? 
      CPB SC,I      OR = PASSED IN SC?
      JMP OP.0      YES - SET E FOR SC FLAG 
      SSB           IF NEGATIVE SECURITY CODE THEN NO 
      JMP OPEN1      MORE CHECKS - DON'T MATCH
      ADB SC,I      POSITIVE SC - TAKE CARE OF CASE WHERE 
      CLE           SC = +X AND -X WAS PASSED IN
      SZB,RSS       (CLEAR E IN CASE GOT SET IN ADDITION) 
* 
*     SET SC AND OM IN DCB
* 
OP.0  CCE 
OPEN1 LDB DCB       GET DCB ADDRESS 
      ADB .7        POSITION TO WORD WITH SC FLAG 
      LDA B,I 
      RAL,ERA       PUT E INTO BIT 15 
      STA B,I        AND RESTORE WORD 
      LDA SCFLG     GET ON SYSTEM DISC FLAG 
      ELA           IF SET, SET E 
      LDA B,I       GET DCB WORD 7 AGAIN
      SEZ           ON 2 OR 3?
      IOR BIT4      YES - SET BIT 4 
      STA B,I        AND RESTORE
      JMP OPEN3     GOOD OPEN SO SKIP CLOSE 
* 
*     CLOSE FILE - SET SUBFUNCTION CODE IF TYPE 0 
* 
OPEN2 STA ID        SAVE ERROR CODE 
      JSB CLOSE     ILLEGAL OPEN SO CLOSE 
      DEF *+2        THE
      DEF DCB,I       FILE
OPEN3 LDA ID        GET ERROR CODE
      LDB DCB       POSITION TO TYPE
      ADB .2         WORD IN THE DCB
      SSA,RSS       WAS THERE AN ERROR? 
      LDA B,I       NO - GET TYPE CODE
      SZA            IF NOT TYPE ZERO 
      JMP EXIT        THEN EXIT 
      LDB LU        GET SUBFUNCTION WORD
      ERB           GET SUBFUNCTION SET BIT IN E-REG
* 
      LDB DCB       CALCULATE DCB SUB 
      ADB .3         FUNCTION ADDRESS 
      STB SC        SAVE IT 
      LDA OP,I      GET THE OPTION SUB FUNCTION 
      AND B3700     MASK IT OFF 
      STA B          AND SAVE IT
      LDA SC,I      GET THE CURRENT SUBFUNCTION WORD
      AND B77       SAVE THE LU 
      STA LU        KEEP FOR LOCKING THE LU LATER 
      ADA B         ADD IN THE NEW SUB FUNCTION 
      SEZ           IF SUBFUNCTION BIT WAS'NT SET, DON'T STORE
      STA SC,I      SET IT IN THE DCB 
* 
      LDB DCB       POSITION TO DCB15 WORD
      ADB .15        AND SAVE ADDRESS OF THIS 
      STB SC          POSITION
      CLA,INA       PRESET TO DON'T DO AN 
      STA SC,I       UNLOCK (FOR CLOSE) 
      LDA OP,I      GET OPEN OPTION WORD
      SLA           EXCLUSIVE OPEN? 
      JMP EXOK      NO - SO DON'T LOCK THIS DEVICE
* 
      JSB IFTTY     SEE IF THIS LU IS 
      DEF *+2        AN INTERACTIVE DEVICE
      DEF LU
      SSA           INTERACTIVE?? 
      JMP EXOK      YES - DON'T LOCK IT 
* 
      LDA BIT13     SET BIT13 ON LU WORD
      ADA LU         SO 8 BITS WILL BE USED FOR 
      STA LU          LU IN THE RESULTING EXEC CALL.
* 
      JSB LURQ      LOCK CALL 
      DEF *+4 
      DEF OPTN      OPTION - LOCK WITHOUT WAIT, NO ABORT
      DEF LU        LU WITH BIT 13 SET
      DEF .1        ONE LU
      JMP EX18      ERROR ON LOCK 
      SZA           SUCCESSFUL LOCK?
      JMP EX36      NO - NO RN'S AVAILABLE OR ALREADY LOCKED
      STA SC,I      STORE LOCK SUCCESSFUL  (DO UNLOCK)
      JMP EXOK      EXIT NO ERRORS
* 
EX18  LDA N18       ERROR ON LURQ CALL
      JMP EXIT
EX36  LDA N36       LOCK NOT GRANTED
      JMP EXIT
EXOK  CLA           CLEAR A AND EXIT
EXIT  LDB DCB       IF NO ERRORS, 
      ADB .2         THEN RETURN
      SSA,RSS         THE TYPE
      LDA B,I 
      LDB DZERO     RESET THE 
Y     REP 5          DEFAULT
      STB NAME+*-Y    PARAMETERS
      STA ERR,I     SET THE ERROR CODE
      JMP OPEN,I     AND RETURN 
* 
* 
      SPC 2 
      SPC 3 
DZERO DEF ZERO
ZERO  NOP 
* 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.6    DEC 6 
.7    DEC 7 
.14   DEC 14
.15   DEC 15
.23   DEC 23
* 
N10   DEC -10 
N11   DEC -11 
N18   DEC -18 
N36   DEC -36 
* 
B77   OCT 77
B7777 OCT 7777
B3700 OCT 3700
BIT4  OCT 20
BIT13 OCT 20000 
OPTN  OCT 140001
* 
SCFLG NOP 
ID    NOP 
NAME1 BSS 3 
CODE  NOP 
DIR   BSS 6 
ADIR  DEF DIR 
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 3 
END   EQU * 
      END 
                                                                                                                                                                                                                