ASMB,R,L,C
*     NAME:   PU..  
*     SOURCE: 92064-18049 
*     RELOC:  92064-16017 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 PU..,7  92064-16017  REV.1650  760518 
* 
      EXT CLD.R,.P1,.P2,.P3,.P4,N.OPL 
      EXT NAM..,.DRCT,.ENTR,PMOVE 
* 
      ENT PU..
      SPC 2 
CNT   NOP 
LST   NOP 
ER    NOP 
* 
PU..  NOP 
      JSB .ENTR     FETCH CALL
      DEF CNT           PARMS 
* 
      ISZ LST       ADVANCE TO NAME PARM
      JSB NAM..     CHECK FOR 
      DEF PU2            LEGAL
      DEF LST,I             FILE NAME 
* 
PU2   STA ER,I      SET ERROR RETURN
      SZA           0=OK,15=BAD NAME
      JMP PU..,I    ERROR SO EXIT 
* 
*  NAME OK- SETUP CALL TO D.R FOR 
*  OPEN OF REQUESTED FILE.
* 
      LDA .10       SET FUNCTON 
      STA .P1           CODE FOR D.R
* 
      JSB .DRCT     FETCH DIRECT
      DEF N.OPL       ADDRESS OF SUBPARAMETER STRING
      INA           ADVANCE TO CR/LU PARM 
      LDA A,I         AND FETCH IT
      STA .P2       SET IT INTO CALL
* 
      LDA LST,I     FETCH FIRST WORD
      STA .P3       OF NAME AND SET INTO CALL 
      ISZ LST       ADVANCE TO FINAL TWO WORDS
      DLD LST,I     AND MOVE
      DST .P4               THEN INTO THE CALL
* 
*  CALL IS SETUP -SO DO IT
* 
      JSB CLD.R     CALL D.R
      LDA B,I       FETCH ERROR RETURN
      SZA,RSS       OK? 
      JMP OK        YES--CONTINUE 
* 
      CPA N130      CHECK FOR FOUND BUT LOCKED
      CCA,RSS       YES--SET (A)=-1 AS UNLOCK FLAG
      JMP EREX      NO--OTHER D.R ERROR--GO EXIT
* 
OK    STA CNT       SAVE LOCK/UNLOCK FLAG IN TEMP 
      INB           ADVANCE RETURN PARM ADDRESS 
      LDA B,I       AND FETCH LU OF FILE
      SSA           IF TYPE ZERO--NO LOCK TO CLEAR
      STA CNT       SET -1 IN LOCK FLAG 
      CMA,INA       MUST HAVE BEEN NEG FOR NOW
      STA .P2         SAVE IT FOR UNLOCK
* 
      INB           ADVANCE TO WORD HOLDING ADDRESS 
      LDB B,I       OF DIRECTORY ENTRY(FWA OF FILENAME) 
      LDA N1A       FETCH ADDRESS OF -1 
      JSB PMOVE     GO PRIV AND SET FIRST WORD=-1 
.1    OCT 1         MOVE 1 WORD 
* 
      ISZ CNT       NEED TO REMOVE LOCK?
      RSS           YES-SET (A)=1 AND SKIP
      JMP PU..,I    NO-EXIT ALL DONE(ERROR CODE CLEARED-RTN NAM..)
* 
      LDA .5        SET FUNCTION
      STA .P1         FOR UNLOCK
      JSB CLD.R     CALL D.R FOR UNLOCK 
* 
      LDA B,I       FETCH ERROR RETURN
EREX  STA ER,I      AND SET IT
      JMP PU..,I    EXIT
      SKP 
.5    OCT 5 
.10   DEC 10
* 
N1    OCT -1
N1A   DEF N1
N130  DEC -130
* 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      END 
  