ASMB,R,L,C
*     NAME:   DL..  
*     SOURCE: 92064-18046 
*     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 DL..,7  92064-16017  REV.1650  760808 
* 
* 
      EXT TMP.,.DRCT,OPEN.,IDCB1,IDCB3,.ENTR,$CDIR
      EXT PNAM,READF,CLD.R,.P1,.P2,.P3,I.BUF
      EXT WRITF,CONV.,.MVW,RWNDF,RMPAR
* 
      ENT DL..
* 
      SUP 
* 
CNT   NOP 
LST   NOP 
ER    NOP 
* 
DL..  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        OPEN LIST DEVICE\LU
      DEF IDCB3 
      DEF TMP.
      DEF TMP1,I
      DEF ZERO       OPTION 
* 
RTN   LDB BLNK,I
      JSB .DRCT 
IBUFA DEF I.BUF     DEFINE INPUT BUFFER 
      STB A,I       SET FIRST WD BLANK
      INA           ALLOW FIRST WORD FOR BLANK
      STB A,I        ALSO SECOND WORD 
      INA 
      STA IBUF          ADDRESSES 
      ADA .3
      STA IBUF2 
* 
      LDA LST,I     FETCH PARM TYPE FLAG
      SZA,RSS         IF NULL THEN
      JMP ALL               COMPLETE LIST REQUESTED 
* 
      CPA .3        ALPH NOT ALLOWED
      JMP ER56
* 
      ISZ LST       ADVANCE TO REQUESTED LU 
      LDA LST,I         FETCH IT
      SZA,RSS       IF ZERO 
      JMP ALL          THEN DO EVERYTHING 
* 
      SSA,RSS       ALLOW BOTH POS AND NEG
      CMA,INA 
      STA .P2       SAVE FOR D.R CALL 
      JSB LUTNG     GO DO LU THING
      JMP DL..,I    GET OUT 
* 
      SKP 
* 
* 
* 
.5    DEC 5 
.3    OCT 3 
.2    OCT 2 
* 
* 
* 
N2    OCT -2
N3    OCT -3
N4    OCT -4
N13   DEC -13 
.4    OCT 4 
.6    OCT 6 
.10   DEC 10
.18   DEC 18
.128  DEC 128 
LUAD  NOP 
LUST  NOP 
IBUF  NOP 
IBUF2 NOP 
TMP1  NOP 
VAL   NOP 
DIRAL NOP 
LEN   NOP 
HBTE  OCT 177400
HBLK  OCT 20000 
ZERO  NOP 
N1    OCT -1
* 
* 
* 
      SKP 
WLEN  NOP 
WRIT  NOP 
      STA WBUF
      STB WLEN
      JSB WRITF 
      DEF WRITN 
      DEF IDCB3 
      DEF ER,I
WBUF  NOP 
      DEF WLEN
WRITN LDA ER,I
      SZA 
      JMP CLEAR 
      JMP WRIT,I
* 
      SPC 5 
* 
* 
SPACE NOP 
      CLB,INB 
      LDA BLNK      ADDR OF BLANK WORD
      JSB WRIT
      JMP SPACE,I 
* 
* 
STOP  NOP 
      SKP 
* 
*   LIST TYPE ZERO TABLE AND ALL MOUNTED CARTRIDGES 
* 
ALL   JSB .DRCT 
      DEF $CDIR     FETCH DIRECT ADDR OF CARTRIDGE DIR
      ADA N1        BACK UP TO STOP ADDRESS 
      LDB A,I       FETCH IT
      STB STOP      SET STOP ADDR 
      INA           ADVANCE TO FIRST ENTRY
NXT   STA DIRAL     SAVE ADDRESS
      CPA STOP      END?? 
      CLA,RSS       YES --FORCE EXIT
      LDA A,I       FETCH NEXT ENTRY
      SZA,RSS       IF ZERO-
      JMP DL..,I        ALL DONE
      CMA,INA       SET LU NEG
      STA .P2            AND SAVE FOR D.R 
* 
      JSB LUTNG     GO DO THIS LU LIST
* 
      LDA DIRAL     FETCH CART DIR ADDR 
      ADA .4        ADVANCE TO NEXT ENTRY/END 
      STA CNT       INDICATE LOCK CLEAR 
      JMP NXT       CONTINUE
      SKP 
* 
*   DIRECTORY LIST OF MOUNTED CARTRIDGE 
* 
LUTNG NOP 
      CMA,INA       MAKE LU POS 
      STA TMP1      SAVE IT FOR CONVERSION
      JSB SPACE 
      JSB CONV. 
      DEF RTNC      CONVERT DIRECTORY 
      DEF TMP1              LU
      DEF LUXA              FOR 
      DEF .2                   HEADING
* 
RTNC  LDA .3        SET FUNCTION CODE 
      STA .P1       FOR LOCK
      JSB CLD.R         VIA D.R 
* 
      JSB RMPAR 
      DEF *+2 
      DEF .P1       FETCH RETURN PARMS
* 
      LDA .P1       FETCH ERROR WORD
      SZA           EVERYTHING OK?
      JMP OK?       GO CHECK FOR EXISTING LOCK
* 
      STA CNT       INDICATE LOCK SET 
      JSB OPEN. 
      DEF LSTRT     GO OPEN 
      DEF IDCB1       LU TO BE
      DEF TMP1            LISTED
      DEF ZERO
* 
LSTRT JSB RWNDF     REWIND IT 
      DEF RWNDT 
      DEF IDCB1 
      DEF ER,I
* 
RWNDT LDB .10 
ITLK  LDA LUHDA     ADDR OF HEAD MESS 
      JSB WRIT      WRIT IT 
* 
      CLA 
      LDB .P1       FETCH ERROR RETURN
      SZB           IF IT WAS LOCKED
      JMP LUTNG,I       ALL DONE
* 
*   FETCH ADDRESSES 
* 
      LDA .P3       FETCH CRDIR ENTRY+4(NEXT UNIT)
      ADA N2        BACK UP TO ACTUAL DIRAD(CARTRIDGE)
      LDB A,I       FETCH ACTUAL DIRECTORY ADDRESS
* 
*   THIS DEPENDS ON MC DOING THE RIGHT THING
* 
      STB LUAD      SAVE IT 
      ADB N1        BACK UP 
      LDB B,I           TO STOP ADDRESS AND FETCH 
      STB LUST      SAVE IT 
      ADA N1        BACK UP CARTRIDGE DIR POINTER TO VALIDITY ADDR
      LDA A,I             FETCH IT
      STA VAL       SAVE IT 
* 
* 
READ  JSB READF 
      DEF LURTR 
      DEF IDCB1 
      DEF ER,I
      DEF IBUF,I     SKIP BLANK WORD
      DEF .128
      DEF LEN 
* 
* 
LURTR LDB LEN 
      CPB N1        CHECK FOR EOF 
      JMP EOF       GOT IT
* 
* 
* CHECK  VALIDITY OF DIRECTORY
* 
      LDA LUAD      FETCH CURRENT DIR ADDR
      CPA LUST      END OF DIR? 
      JMP ER24      DIRECTORY MIS-MATCH ERROR 
* 
* 
      LDA LEN       FETCH READ LENGTH 
      ADA N4        MUST HAVE READ AT LEAST 4 WORDS 
      SSA           OK? 
      JMP ERN29      NO--BAD DIRECTORY ON TAPE
      LDA IBUF2,I   FETCH WORD 4 OF ENTRY 
      AND HBTE      HIBTE LEFT BYTE 
      CPA HBLK          MUST CONTAIN ASCII BLANK
      RSS             IT'S OK 
      JMP ERN29      NOPE--BAD DIRECTORY
* 
*  DIRECTORY ENTRY ON TAPE IS OK
* 
      LDA VAL,I     IF MEMORY COPY
      SZA                 IS INVALID
      JMP PDIR             JUST LIST FROM CARTRIDGE 
* 
* 
      LDA LUAD,I    FETCH NEXT ENTRY
      SZA,RSS       END?? 
      JMP ER24      END BUT NO EOF
* 
      SSA           THIS ENTRY PURGED?
      JMP WRTN2     YES GO BUMP MEM POINTER AND GET NEXT
* 
*      MOVE IN MEM RES PORTION
* 
* 
      LDA LUAD      FETCH MEM POINTER 
      LDB IBUF      DESTINATION ADDRESS 
      JSB .MVW
      DEF .4
      NOP 
* 
* 
PDIR  JSB SPACE 
      LDA IBUFA     WRITE FIRST FOUR
      LDB .6             WORDS OF ENTRY (PLUS 2 BLANK WORDS)
      JSB WRIT
* 
* 
      LDA BLNK,I
      STA IBUF2,I 
      LDA IBUF2     FETCH BUFFER ADDR FOR COMMENT FIELD 
      LDB LEN        FETCH READ LEN 
      ADB N3        COMPENSATE FOR NAME 
      JSB WRIT      GO WRIT COMMENTS
* 
WRTN2 LDA LUAD      FETCH MEM DIR ADDR
      ADA .4
      STA LUAD      ADVANCE TO NEXT ENTRY/END 
      JMP READ
* 
      SKP 
OK?   CPA N13 
      RSS 
      JMP CLEAR     NOT LOCK ERROR --GET OUT
* 
      LDA .P3       FETCH CART DIR POINTER
      ADA N1        BACK UP TO LOCK WORD
      LDA A,I       FETCH IDSEG ADDR OF LOCKING PROG
      LDB PGNMA     ADDRESS FOR PROGRAM NAME
      JSB PNAM      GO MOVE NAME IN 
      LDB .18       FETCH LENGTH FOR HEAD TO INCLUDE LOCKERS NAME 
      JMP ITLK
* 
* 
* 
LUHDA DEF LUHD
LUHD  ASC 13,   LU     DIRECTORY  LOCK
      ASC 2,BY
PGNM  BSS 3 
PGNMA DEF PGNM
LUXA  EQU           LUHD+3
BLNK  DEF LUHD
* 
* 
CLEAR STA ER,I
      JSB OFLK
      JMP DL..,I
* 
* 
* 
OFLK  NOP 
      LDA CNT 
      SZA           CONTINUE IF LOCK WAS SET
      JMP OFLK,I
      LDA TMP1
      CMA,INA 
      STA .P2 
      LDA .5        FETCH FUNCTION CODE FOR LOCK CLEAR
      STA .P1 
      JSB CLD.R 
      JMP OFLK,I
* 
* 
* 
EOF   JSB OFLK
      JMP LUTNG,I 
* 
* 
ERN29  LDA N29
      RSS 
ER24  LDA .24 
      RSS 
ER56  LDA .56 
      JMP CLEAR 
* 
.24   DEC 24
N29   DEC -29 
.56   DEC 56
* 
* 
A     EQU 0 
B     EQU 1 
* 
      END 
                                                                  