ASMB,R,L,C
      HED "LOPEN" ROUTINE TO DO CONTENTION FMP "OPEN"'S & "CLOSE"'S 
*     NAM LOPEN,7 PRE-REL 4-17-76 (DLB) 
*     NAM LOPEN,7 09570-16515 REV. A 761013 
      NAM LOPEN,7 PRE-REL 780327 (DLB) (RTE-IV) 
* 
*-------------------------------------------------------- 
* 
*     RELOC.       09570-16515
*     SOURCE       09570-18515
* 
*     D. BASKINS         13 OCT 76 REV. A 
* 
*---------------------------------------------------------
* 
      ENT LOPEN,LCLOS 
      EXT .ENTR,OPEN,CLOSE,EXEC,IDSGA 
      EXT .XLA
      SPC 1 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
MXPRM EQU 10        MAX NUMBER OF PARAMETERS FOR OPEN ROUTINE 
      SUP PRESS MULTIPLE LISTINGS 
*  PURPOSE: 
*    TO OPEN OR CLOSE A FILE AND DO A CORE LOCK IF IT WILL NOT
*    CAUSE A DEAD LOCK IN AN RTE-II ENVIORNMENT.  THIS SUBROUTINE 
*    SHOULD BE USED INSTEAD OF THE FMP "OPEN" OR "CLOSE" ROUTINE
*    IF FASTER FILE OPEN'S AND CLOSES ARE DESIRED.  THE OVERHEAD
*    OF THIS ROUTINE IS APPROXIMENTLY ZERO, EXCEPT FOR THE CORE 
*    IT USES. 
*  CALLED:
*    THIS ROUTINE IS CALLED IN EXACTLY THE SAME WAY AS THE FMP
*    OPEN AND CLOSE SUBROUTINES ARE, EXCEPT FOR THE NAME. 
      SPC 1 
OPENI JSB OPEN      CALL OPEN OR CLOSE
DEFRN DEF *         TELL HOW MANY PASSED PARMS
      REP MXPRM     MAX PARAMETERS ABOUT 10 
      NOP 
JMPST JMP LASTP 
      SPC 1 
LOPEN NOP           ENTRY 
      JSB .ENTR     GET CALLERS PARAMETERS
      DEF DEFRN+1 
      CLA           ZERO THE UNPASSED PARAMETERS
      STB DEFRN     SAVE THE RETURN ADDRESS 
MORE  CPB RTNAD     DONE? 
      JMP CORLK     YES 
      STA B,I       NO, KEEP ON TRUCKING
      INB 
      JMP MORE
      SPC 1 
LASTP LDB OPNJS     GET OPEN JSB
      STB OPENI     RESTORE JSB OPEN INSTRUCTION
      STA LCLOS     SAVE A-REG FOR OPEN RETURN
      LDA SAVST     GET LOCK STATUS WORD
      LSR 6         POSITION CL BIT 
      SLA,RSS       SET?
      CLA           NO, DO CORE UNLOCK
      JSB CLOCK 
      LDA LCLOS     RESTORE A-REG 
      JMP LOPEN,I   RETURN
      SPC 1 
RTNAD DEF JMPST     LAST PARAMETER+1 ADDRESS
      SPC 1 
LCLOS NOP           CLOSE ENTRY 
      LDA LCLOS     GET RETURN ADDRESS
      STA LOPEN     FAKE OUT ALL
      LDA CLSJS     GET JSB CLOSE INSTRUCTION 
      STA OPENI     AND POSITION
      JMP LOPEN+1   AND DO THE THING
      SPC 1 
CORLK LDA XEQT      GET MY IDSEG ADDRESS
      ADA D14       CHECK MY OWN CORE LOCK BIT
      JSB .XLA      GET ID(15) WORD 
      DEF A,I       * LDA A,I 
      STA SAVST     SAVE THE LOCK STATUS
      JSB IDSGA     NOW CHECK D.RTR'S PARTITION 
      DEF *+2 
      DEF D.RTR     TO SEE IF SAME AS MY OWN
      ADA D14       BUMP TO IT'S TYPE 
      JSB .XLA
      DEF A,I       * LDA A,I 
      XOR SAVST     IF SAME TYPE AS ME, 
      AND O7        DO NOT CORE LOCK
      JSB CLOCK     DO CORE LOCK IF NOT = 0 
      JMP OPENI     NOW GO OPEN OR CLOSE THE FILE 
      SPC 1 
CLOCK NOP           ENTRY A=0>UNLOCK, ELSE LOCK 
      SZA           CHECK IF LOCK OR UNLOCK 
      CLA,INA 
      STA LFLAG 
      JSB EXEC
      DEF *+3 
      DEF NA22
      DEF LFLAG 
      NOP           IGNORE ABORT ERRORS 
      JMP CLOCK,I   RETURN
      SPC 1 
LFLAG NOP 
OPNJS JSB OPEN
CLSJS JSB CLOSE 
D.RTR ASC 3,D.RTR 
SAVST NOP           SAVE CORE LOCK BIT
O7    OCT 7 
D14   DEC 14
NA22  ABS 100000B+22
      END 
                                                                                                                                                