ASMB,R,L,C
*     NAME:   CL..  
*     SOURCE: 92064-18041 
*     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 CL..,7  92064-16017  REV.1650  761010 
* 
* 
      EXT TMP.,.DRCT,OPEN.,IDCB3,.ENTR
      EXT $CRLK,WRITF,CONV.,.MVW
* 
      ENT CL..,PNAM 
* 
      SUP 
* 
CNT   NOP 
LST   NOP 
ER    NOP 
* 
CL..  NOP 
      JSB .ENTR 
      DEF CNT 
* 
*  OPEN LIST FILE 
* 
      JSB .DRCT 
      DEF TMP.      FETCH DIRECT ADDR OF LIST INFO
* 
* 
      ADA .3
      STA TMP1      SET ADDRESS OF LIST FILE LU 
      JSB OPEN. 
      DEF RTN 
      DEF IDCB3 
      DEF TMP.
      DEF TMP1,I
      DEF ZERO       OPTION 
* 
RTN   JSB .DRCT     FETCH DIRECT
      DEF $CRLK           ADDRESS OF MASTER LOCK
      STA DIRAD     SAVE ADDRESS FOR SEARCH 
      LDA A,I            FETCH MASTER LOCK
      SZA,RSS       IS IT LOCKED? 
      JMP HEAD      NOPE--SKIP MASTER LOCK INFO 
* 
      LDB MLKAD     DESTINATION ADDRESS OF LOCKER'S NAME
      JSB PNAM      A=IDSEG ADDRESS,MOVE PROG NAME TO PRINT BUF 
* 
*  PRINT "MASTER LOCK BY PNAME" WHERE PNAME=LOCKER
* 
      JSB WRITF 
      DEF HEAD1 
      DEF IDCB3 
      DEF ER,I
      DEF MLOK
      DEF .11 
* 
HEAD1 SZA           ANY PROBLEMS? 
      JMP CL..,I
HEAD  JSB SPACE     SKIP A LINE 
* 
*    WRITE LIST HEAD
* 
      JSB WRITF 
      DEF RT2 
      DEF IDCB3     WRITE  " LU VALID  LOCK"
      DEF ER,I
      DEF CLHD
      DEF .8
* 
RT2   JSB SPACE 
      LDA DIRAD     ADVANCE 
      INA                    TO STOP ADDRESS
      LDB A,I       FETCH STOP ADDRESS
      STB STOP       AND SAVE IT
      INA .5            ADVANCE TO FWA OF CRDIR 
      STA DIRAD 
      SPC 5 
* 
*     BLANK OUT PRINT BUFFER
* 
NEXT  LDA BLNKA     ADDRESS OF ASCII BLANK WHICH
      STA B         PPRECEDES BUFFER
      INB           B NOW EQUALS PRINT BUFFER ADDRESS 
      JSB .MVW
      DEF .8        BLANK IT OUT
      NOP 
* 
*  FETCH LU OR END
* 
      LDA DIRAD     FETCH CURRENT DIR ENTRY 
      CPA STOP      END?
      CLA,RSS       FORCE EXIT
      LDA A,I       FETCH ENTRY 
      SZA           IF ZERO THEN MUST BE DONE 
      JMP COV       NO CONTINUE 
* 
      STA ER,I      CLEAR ERROR WORD
CLRTN JMP CL..,I    EXIT
* 
* 
* 
COV   JSB CONV. 
      DEF RTN3      CONVERT LU
      DEF DIRAD,I      AND SET RESULT 
      DEF LUA              INTO PRINT BUFFER
      DEF .2        2 DIGITS
* 
RTN3  ISZ DIRAD     ADVANCE TO VALIDITY ADDRESS 
      LDA DIRAD,I   FETCH VALIDITY WORD ADDRESS(WD2 OF ENTRY) 
      LDA A,I       FETCH ACTUAL VALIDITY WORD
      SZA,RSS       IF INVALID--SKIP
      JMP VAL1      GO MOVE YES IN
      LDA NO        ELSE SET
      STA VAL            "NO" INTO BUF
* 
LK?   ISZ DIRAD     ADVANCE TO
      ISZ DIRAD          LOCK WORD(THIS UNIT) 
      LDA DIRAD,I   FETCH IT
      SZA,RSS       IF NOT LOCKED--GO PRINT LINE
      JMP PRNT
* 
      LDB LKNM      FETCH DEST ADDR 
      JSB PNAM      GO MOVE NAME IN 
* 
*  PRINT A LINE 
* 
PRNT  JSB WRITF 
      DEF RTN4
      DEF IDCB3 
      DEF ER,I
      DEF BLNK
      DEF .9
* 
RTN4  ISZ DIRAD     ADVANCE TO NEXT ENTRY 
      JMP NEXT      GO DO NEXT ONE
* 
* 
* 
* 
*    TRY AND AVOID EXTRA LINKS
* 
* 
.1    OCT 1 
.2    OCT 2 
.3    OCT 3 
.8    DEC 8 
.9    DEC 9 
.11   DEC 11
TMP1  NOP 
TMP2  NOP 
ZERO  NOP 
DIRAD NOP 
STOP  NOP 
* 
* 
*  PRINT BUFFERS AND POINTERS 
* 
MLKAD DEF MK
MLOK  ASC 8, MASTER LOCK BY 
MK    BSS 3 
* 
CLHD  ASC 8,  LU VALID  LOCK
* 
BLNKA DEF BLNK
BLNK  ASC 1,
PBUF  BSS 8 
LUA   EQU PBUF
VAL EQU PBUF+2
LKNM  DEF PBUF+5
* 
YES   ASC 2,YES 
NO    ASC 1,NO
* 
* 
VAL1  DLD YES 
      DST VAL 
      JMP LK? 
* 
* 
SPACE NOP 
      JSB WRITF 
      DEF RTN5
      DEF IDCB3 
      DEF ER,I
      DEF BLNK
      DEF .1
RTN5  SZA 
      JMP CL..,I
      JMP SPACE,I 
* 
* 
* 
*  PNAM----MOVES PROGRAM NAME (IDSEG ADDRESS IN A)
*          TO PRINT BUFFER(ADDRESS IN B)
* 
PNAM  NOP 
      STB TMP1
      ADA .12       ADVANCE TO NAME 
      STA TMP2
      DLD A,I       FETCH FIRST TWO CHARS 
      DST TMP1,I
      LDB .2
      ADB TMP2      ADVANCE TO THIRD WORD 
      LDA B,I       FETCH IT
      AND HBYTE     ISOLATE LEFT BYTE 
      ADA B40       ADD BLANK 
      ISZ TMP1
      ISZ TMP1
      STA TMP1,I    SET 3RD WORD
      JMP PNAM,I
* 
B40   OCT 40
.12   DEC 12
HBYTE OCT 177400
* 
A     EQU 0 
B     EQU 1 
PLEN  EQU * 
      END 
                                                                                                                                                                    