ASMB,R,L,C
      HED (FMP) CRDC: DISMOUNT DISC CARTRIDGE 
*     NAME:   CRDC
*     SOURCE: 92071-18166 
*     RELOC:  92071-16166 
*     PGMR:   E.D.B.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 CRDC,7 92071-1X166 REV.2041 800702
* 
      ENT CRDC
* 
      EXT CLD.R, .P1, .P2, .P3, .P7, .R1
      EXT .ENTR 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*      THIS ROUTINE DISMOUNTS A CARTRIDGE FROM THE RTE-L SYSTEM.
* 
*      FORTRAN CALLING SEQUENCE:
* 
*      CALL CRDC(ICR) 
* 
*      WHERE: 
* 
*      ICR    IS A CARTRIDGE IDENTIFIER (+CRN / - LU) OF
*             THE CARTRIDGE TO BE DISMOUNTED
* 
*      POSSIBLE ERRORS: 
* 
*      -10   NOT ENOUGH PARAMETERS
*       38   ATTEMPT TO REMOVE ACTIVE TYPE 6 OR SWAP FILE 
       SKP
* 
*      ENTRY
* 
CRDC  NOP 
      CLA 
      STA ICR 
      LDA CRDC
      STA DRDC
      JMP DRDC+1
* 
ICR   NOP 
* 
DRDC  NOP 
      JSB .ENTR 
      DEF ICR 
* 
      LDA ICR 
      SZA,RSS       IF NOT ENOUGH PARAMETERS, 
      JMP ER10       THEN TAKE ERROR EXIT 
      SKP 
* 
*     PROCESS REQUEST 
* 
      LDA ICR,I     FETCH CARTRIDGE IDENTIFIER
      SZA,RSS       IF ZERO,
      JMP ER32       THEN TAKE ERROR EXIT 
* 
      STA .P2       SAVE CRN FOR D.RTR
* 
      LDA .3        SET FUNCTION CODE 
      STA .P1         FOR DISC LOCK 
* 
      JSB CLD.R     CALL D.RTR
* 
      LDA .R1       FETCH ERROR CODE
      CPA N103      IF CORRUPT DIRECTORY, 
      JMP DCIT       THEN ALLOW DISMOUNT
* 
      CPA N99       IF READ/WRITE ERROR,
      JMP DCIT       THEN ALLOW DISMOUNT
* 
      CPA N1        IF DISC ERROR,
      JMP DCIT       THEN ALLOW DISMOUNT
* 
      SZA           IF ANY OTHER ERROR
      JMP EREX       THEN TAKE ERROR EXIT 
* 
*     DISC IS LOCKED SO NO OPEN FILES EXIST 
*     SET UP DISMOUNT CALL TO DIRECTORY MANAGER 
* 
DCIT  LDA .7        SET FUNCTION CODE 
      STA .P1         FOR DIRECTORY MODIFICATION
* 
      CLB           SET P3=0 & SUBFUNCTION P7 
      STB .P3        =0 FOR DISMOUNT
* 
      STB .P7       SUBFUNCTION = 0 FOR DISMOUNT
* 
      JSB CLD.R     CALL D.RTR
* 
      LDA .R1       FETCH ERROR CODE
      SZA,RSS       IF NO ERROR,
      JMP EREX
* 
      STA ERR       SAVE ERROR FOR RETURN 
* 
      LDA .5        SET FUNCTION CODE 
      STA .P1        FOR DISC UNLOCK
* 
      JSB CLD.R     CALL D.RTR
* 
      LDA ERR       GET ERROR AGAIN 
      JMP EREX       AND EXIT 
      SKP 
* 
*     EXIT
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
* 
ER32  LDA N32       CARTRIDGE NOT FOUND 
* 
EREX  JMP DRDC,I    RETURN (WITH ERROR CODE IN A-REG) 
      SKP 
* 
*     STORAGE AREA
* 
.3    DEC 3 
.5    DEC 5 
.7    DEC 7 
* 
N103  DEC -103
N99   DEC -99 
N32   DEC -32 
N10   DEC -10 
N1    DEC -1
* 
ERR   NOP 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                