ASMB,R,L,C
*     NAME:   DC..  
*     SOURCE: 92064-18043 
*     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 DC..,7  92064-16017  REV.1650  760802 
* 
      EXT CLD.R,.P1,.P2,.P3,.P4,.P5,LODCB,WRITF 
      EXT .ENTR,$CDIR,.DRCT,PMOVE,.PDCV 
* 
      ENT DC..
      SPC 2 
CNT   NOP 
LST   NOP 
ER    NOP 
* 
DC..  NOP 
      JSB .ENTR     FETCH CALL
      DEF CNT           PARMS 
* 
      ISZ LST       ADVANCE PAST FLAG WORD
      LDA LST,I     FETCH LU
      SSA,RSS       -LU ONLY,CART REF 
      JMP ER10        NOT ALLOWED 
* 
      STA .P2       SET FOR CALL TO D.R 
      LDA XEQT      SET PROG ID 
      STA .P4            FOR LOCK 
      LDA .11       SET FUNCTION
      STA .P1           CODE FOR MASTER LOCK
* 
*   CALL TO D.R SETUP 
*      SO GO REQUEST MASTER LOCK
* 
      JSB CLD.R     CALL D.R
      LDA B,I       FETCH ERROR PARAMETER 
      SZA           OK? 
      JMP EREX      NOPE--EXIT(ERROR CODE IN A) 
* 
* 
*    NOW GO LOCK REQUESTED UNIT 
* 
      LDA .3         FETCH CARTRIDGE LOCK CODE
      STA .P1        SAVE FOR D.R 
      JSB CLD.R 
      LDA B,I       ANY ERRORS ?
      SZA           OK? 
      JMP ELOK      YES--GO CLEAR MASTER LOCK 
      STA .P4       CLEAR LOCK ID PARM(THIS VALUE IS SET AS LOCK) 
* 
      ADB .2        ADVANCE RETURN PARM ADDRESS(POINT AT DIRECTORY ADDR)
      LDB B,I       FETCH CART DIR ADDR OF NEXT ENTRY 
* 
*     THIS LOCATION IS REQUESTED LU+4 
* 
      STB .P5       SAVE IN TEMP
* 
*   CLEAR WORD 1 OF DIRECTORY HEADER--CLEAR IT FOR USE
* 
      ADB N2        BACK UP DIRECTORY ADDRESS 
      LDB B,I       FETCH THAT ADDRESS
      ADB N3        NOW BACK UP TO "ASSIGNED" WORD
      CLA           USE A REG AS FROM ADDRESS 
      JSB PMOVE     GO PRIV AND CLEAR IT
      OCT 1 
* 
      LDB .P5       RESTORE POINTER TO CARTRIDGE DIRECTORY
* 
*  FETCH DIRECT ADDRESS OF CARTRIDGE DIRECTORY
*    (B) IN NOT CHANGED 
* 
      JSB .DRCT 
      DEF $CDIR 
      ADA N1        BACKUP TO END OF SEARCH WORD
      LDA A,I        WORD AND FETCH IT
      STA CNT       SAVE STOP ADDRESS 
      CPA B         IF CARTRIDGE TO BE DISMOUNTED IS LAST,
      JMP CLR        SKIP CLOSE UP OF GAP 
* 
*  CALCULATE TO,FROM AND LEGNTH WORDS FOR 
*  MOVE(CLOSE UP GAP) 
* 
*  A=STOP ADDRESS, B=NEXT DIR ADDRESS 
* 
      CMB,INB       SET NEXT ADDR NEGATIVE
      ADA B         ADD TO END OF TABLE 
      STA LN1       SAVE LEGNTH FOR MOVE
      CMB,INB       SET NEXT ADDR POSITIVE
      LDA B         SET "FROM" ADDRESS
      ADB N4        CALCULATE "TO" ADDRESS
* 
      JSB PMOVE     GO PRIV AND CLOSE UP GAP
LN1   NOP           # OF WORDS TO MOVE
* 
*  CLEAR LAST ENTRY IN TABLE
* 
CLR   LDA ZBUF      FETCH FROM ADDRESS(4 NOP'S) 
      LDB CNT       CALCULATE "TO" ADDRESS
      ADB N4        (END OF SEARCH -4)
      JSB PMOVE     GO PRIV AND MOVE IT IN
.4    OCT 4 
* 
*   CARTRIDGE ENTRY CLEARED AND 
*   POSSIBLE GAP HAS BEEN CLOSED
* 
      LDA LST,I     FETCH LU AGAIN
      CMA,INA       MAKE IT POS 
      JSB .PDCV     GO CONVERT IT TO DEC ASCII
* 
      STA LU           AND SET IT FOR MESSAGE 
* 
      JSB WRITF 
      DEF ELOK
      DEF LODCB 
      DEF ER,I
      DEF DCMES 
      DEF .14 
* 
* 
ELOK  STA ER,I      SET ERROR CODE
* 
      CLA 
      STA .P2       CLEAR CR/LU WORD
      LDA .11 
      STA .P1       RESET CODE FOR MASTER LOCK SET/CLEAR
      JSB CLD.R     GO CLEAR IT 
      JMP DC..,I
ER10  LDA .10       BAD INPUT ERROR 
EREX  STA ER,I      SET ERROR RETURN
      JMP DC..,I    EXIT
* 
N2    OCT -2
N3    OCT -3
      SKP 
.2    OCT 2 
.3    OCT 3 
.10   DEC 10
.11   DEC 11
.14   DEC 14
N1    OCT -1
N4    OCT -4
* 
*  DON'T CHANGE THIS
ZBUF  DEF *+1 
      NOP 
      NOP 
      NOP 
      NOP 
* 
DCMES ASC 13,CARTRIDGE DISMOUNTED > LU
LU    NOP 
* 
XEQT  EQU 1717B 
A     EQU 0 
B     EQU 1 
LEN   EQU * 
      END 
                                                                                                                                                                                                                    