ASMB,R,L,C
*     NAME:   MC..
*     SOURCE: 92064-18048 
*     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 MC..,7  92064-16017  REV.1709  770224 
* 
      EXT EXEC,CLD.R,.P1,.P2,.P4,.DRCT,$DIRS
      EXT PMOVE,.ENTR,$CDIR,$LCTU,$RCTU 
      EXT $LIBR,$LIBX,OPEN,IDCB1
      ENT MC..
* 
STOP  NOP 
STAT  OCT 100015
CHNL  NOP 
SUBC  NOP 
CDIR  NOP 
N3    OCT -3
CNT   NOP 
LST   NOP 
ER    NOP 
* 
MC..  NOP 
      JSB .ENTR     FETCH CALL
      DEF CNT         PARMS 
* 
      LDA LST,I     FETCH TYPE PARM 
      CPA .1        MUST BE NUMERIC 
      RSS 
      JMP ER56      NOT NUMERIC--EXIT 
* 
      ISZ LST       ADVANCE 
      LDA LST,I       TO LU AND FETCH IT
      SSA           ALLOW POS 
      CMA,INA          AND NEG LU 
      SZA,RSS 
      JMP ER56      0 NOT ALLOWED 
      STA LU        SAVE IT FOR NOW 
* 
      JSB EXEC      DO
      DEF EXR1        STATUS
      DEF STAT          ON THIS 
      DEF LU                  LU
      DEF .P1       TEMP FOR WORD 5 
      DEF CHNL      TEMP FOR WORD 4 
      DEF SUBC      TEMP FOR NEW STATUS WORD
* 
EXR1  JMP EX20      BAD LU
      LDA .P1       ISOLATE 
      AND TYPE         DRIVER TYPE
      CPA DV05      MUST BE 05? 
      CCE,RSS        SET E FOR LATER USE
      JMP ER56        ELSE INPUT ERROR
* 
*     DRIVER TYPE OK--MUST BE SUB CHANNEL 1 OR 2
* 
      LDA SUBC      FETCH WORD CONTAINING SUB CHNL
      AND B37       ISOLATE SUB CHNL
      SZA,RSS       CONTINUE IF NON ZERO
      JMP ER56      BAD PARAMETER 
      ADA N3        CAN'T BE GREATER THAN 2 
      SSA,RSS       WELL? 
      JMP ER56      TOO LARGE 
* 
* 
*  REQUEST CARTRIDGE DIRECTORY  LOCK
*    FROM D.R 
* 
      CLA           SET LU PARM=0 
      STA .P2       FOR D.R CALL
      LDA XEQT      SET ID
      STA .P4           FOR CALL--THIS WORD IS USED AS LOCK 
      LDA .11       SET FUNCTION
      STA .P1          CODE FOR MASTER LOCK 
      JSB CLD.R     CALL D.R FOR LOCK 
* 
      LDA B,I       FETCH ERROR RETURN
      SZA           SKIP IF OK
      JMP EREX      ELSE EXIT(ERROR CODE IN A)
* 
*  CALCULATE  ADDRESSES FOR SEARCH OF DIRECTORY 
* 
      JSB .DRCT     FETCH DIRECT
      DEF $CDIR       ADDRESS OF CARTRIDGE DIRECTORY
      STA CDIR      SAVE DIRECT ADDRESS 
      CCB           BACK UP 
      ADB A           TO LEGNTH(A-1)
      STB STOP      SAVE ADDRESS OF STOP WORD 
* 
*  SEARCH FOR DUPLICATE LU AND FOR ROOM 
*   A=START ADDRESS,B=STOP ADDRESS
* 
SRCH  LDB A,I       FETCH LU WORD FOR THIS CARTRIDGE
      CPB LU        THIS CARTRIDGE--DUPLICATE?
      JMP DUPID     YES--ERROR EXIT 
* 
      SZB,RSS       ROOM HERE?? 
      JMP ROOM      YEP--GO MOUNT IT
      ADA .4        NOPE--ADVANCE TO NEXT ENTRY 
      CPA STOP,I    --END OF SEARCH?
      JMP DIRFL     YES--DIR FULL EXIT(ERROR 25)
      JMP SRCH      NOPE--CONTINUE SEARCH 
* 
*  FOUND ROOM  A=FWA  B=0 
* 
ROOM  STB ER,I      CLEAR ERROR RETURN
      STA CNT       SAVE ADDRESS OF FWA OF CARTRIDGE DIRECTORY
* 
* 
*   GO PRIV--FIND FREE DIRECTORY SPACE--ASSIGN IT TO THIS LU
* 
* 
      JSB .DRCT 
      DEF $DIRS     FETCH ADDRESS OF DIRECTORY HEAD 
      INA           ADVANCE TO FIRST ASSIGNED WORD
      CCB           SET (B) NON ZERO--IN CASE 0 DIRECTORY SPACE ALLOCATED 
* 
      JSB $LIBR     GO
      NOP              PRIV 
* 
NEXT  CPA $DIRS     END OF SEARCH?
      JMP OUT       YES 
* 
      LDB A,I       FETCH CURRENT ASSIGNED FLAG 
      SZB,RSS       SKIP IF ASSIGNED
      JMP GOTIT     FOUND A FREE ONE--USE IT
* 
      STA .P4       SAVE A WHILE CHECKING TO SEE IF REALLY ASSIGNED 
* 
*  SEE IF THERE IS A MOUNTED CARTRIDGE WITH SAME LU-- 
*      IF NOT---THEN THIS ONE CAN BE USED 
* 
      LDA CDIR      DIRECT ADDRESSES WERE SET EARLIER 
RE?   LDB A,I       FETCH FIRST ENTRY 
      CPB .P4,I    MATCH ASSISNED LU? 
      JMP REAL      YES SO THIS SPACE IS REALLY ASSIGNED--CONTINUE
* 
      SZB,RSS       END?
      JMP FREE      YES--USE LAST SPACE FOUND 
      ADA .4        ADVANCE TO NEXT ENTRY 
      CPA STOP,I    END OF CARTRIDGE DIRECTORY
      JMP FREE      THIS SHOULD BE IMPOSSIBLE(WOULD MEAN CRDIR FULL)
      JMP RE?       GO CHECK THIS ONE 
* 
* 
REAL  LDA .P4       RESTORE ADDRES FOR AVAILABLE DIR CHECK
      ADA .43       ADVANCE TO NEXT POSSIBLE SPACE
      JMP NEXT      GO CHECK THIS ONE 
* 
.43   DEC 43
* 
*      WERE STILL PRIV
* 
FREE  LDA .P4       RESTORE ADDRESS OF DIRECTORY SPACE
GOTIT LDB LU        FETCH REQUESTED LU
      STB A,I       ASSIGN THIS DIRECTORY SPACE TO THIS LU
      INA           ADVANCE TO VALIDITY WORD
      STB A,I       SET DIRECTORY INVALID 
      CLB           B=0=OK EXIT 
* 
* 
OUT   JSB $LIBX 
      DEF *+1 
      DEF *+1 
* 
      SZB           IF B=0 THEN CONTINUE
      JMP DIRFL     ELSE NO ROOM
* 
      STA VALID     SET ADDRESS OF VALIDITY WORD
      ADA .2        ADVANCE TO ADDRESS OF DIRECTORY SPACE 
      STA DADD      SETIT 
* 
* 
*   DRIVER TYPE OK--SEE IF SAME CHNL
*    AS SYS CON.
* 
      LDA CHNL      FETCH STATUS WD 4 
      AND B77       ISOLATE CHNL
      STA CHNL      SAVE IT IN TEMP 
      LDA .3        CALCULATE ADDRESS 
      ADA SYSTY      OF SYS TTY EQT WD 4
      LDA A,I       AND FETCH IT
      AND B77         NOW ISOLATE CHNL
      CPA CHNL      SAME CHNL?
      JMP CONS      YES--GO GET VALIDITY ADDRESS
* 
* 
*  SO---LU WORD SET 
*       VALIDITY WORD SET 
*       DIRECTORY WORD SET
* 
*    GO PRIV AGAIN AND WRITE NEW ENTRY
* 
STVAL LDA LUAD      ADDRESS OF BUF HOLDING ENTRY
      LDB CNT       ADDRESS OF CARTRIDGE DIR FOR THIS ENTRY 
* 
      JSB PMOVE     GO PRIV AND MOVE IT IN
.4    OCT 4 
* 
*    SET VALIDITY WORD NON-ZERO 
* 
      LDA LUAD      FROM ADDRESS
      LDB VALID     TO ADDRESS
      JSB PMOVE 
.1    OCT 1 
* 
*   SET UP NEG LU FOR OPEN CALL 
* 
      LDA LU        FETCH IT
      CMA,INA       ZAP IT
      STA SUBC      SAVE IN TEMP
* 
* 
*  BRING THE NEW DIRECTORY INTO MEMORY
*     IGNORE ALL ERRORS(EXCEPT BAD DIR -29) 
* 
* 
      JSB OPEN
      DEF OPRTN 
      DEF IDCB1 
      DEF CHNL      DUMMY ERROR WORD
      DEF .25       DUMMY NAME PARM(ILLEGAL NAME) 
      DEF Z.0 
      DEF Z.0 
      DEF SUBC
* 
OPRTN CPA N29       IF NEG 29 THEN PASS IT ALONG
      STA ER,I
* 
* 
* 
EREXZ CLA           SET WORD USED FOR LOCK
      STA .P4       =0
      LDA .11       SET UP
      STA .P1              FUNCTION CODE FOR DIRECTORY MANAGER
      JSB CLD.R     GO CLEAR IT 
* 
* 
      JMP MC..,I    EXIT
* 
* 
N29   DEC -29 
.25   DEC 25
* 
* 
      SPC 3 
LUAD  DEF LU
      SKP 
EX20  LDA .20 
      RSS 
ER56  LDA .56 
EREX  STA ER,I
      JMP MC..,I
* 
DUPID LDA .12 
      RSS 
DIRFL LDA .25 
      STA ER,I
      JMP EREXZ     GO CLEAR MASTER LOCK AND EXIT 
      SPC 4 
* 
N14   DEC -14 
.56   DEC 56
.12   DEC 12
B37   OCT 37
* 
*   CHECK SUB-CHANNEL FOR 
*     1=LCTU,2=RCTU 
*    TDB4=WORD 3 OF STATUS REQUEST RETURN 
*   E=1 
* 
* 
* 
CONS  LDA SUBC      FETCH SPEC STATUS WORD
      AND B37       ISOLATE TRUE SUB CHNL 
      LDB RCTU      PRESET FOR RCTU 
      CPA .1        LCTU????
      LDB LCTU      YES FETCH ADDRESS OF LCTU VALIDITY
      JSB .DRCT 
      OCT 100001    USE THE B REG 
      STA VALID 
      JMP STVAL 
* 
* 
LCTU  DEF $LCTU 
RCTU  DEF $RCTU 
* 
LU    NOP 
VALID NOP 
DADD  NOP 
Z.0   NOP 
***************** 
* 
TYPE  OCT 37400 
DV05  OCT 2400
SYSTY EQU 1675B 
.2    OCT 2 
.3    OCT 3 
.11   DEC 11
.20   DEC 20
B77   OCT 77
* 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
* 
LEN   EQU * 
      END 
                                    