ASMB,R,L,C,Q
*     NAME:   DCMC
*     SOURCE: 92067-18176 
*     RELOC:  92067-16125 
*     PGMR:   N.J.S.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 DCMC,7 92067-16125 REV.2001 791016
      ENT DCMC
      EXT EXEC, .ENTR, RMPAR, XLUEX 
      EXT CL.BF, SM.BF, OVRD., $CL1, $CL2, $DSCS
      EXT FD.CK, NAM.., CNUMD 
      EXT GTSCB, SESSN, $SMVE, $SHED
      EXT $SMDL, $SMLK, $SMST, $SMID, $SMGP 
* 
      SUP 
* 
* 
*  DCMC    MOUNT - DISMOUNT SUBROUTINE FOR RTE
* 
* 
*  CALLING SEQUENCE 
* 
*  CALL  DCMC(ER,CODE,DISID,P/G,SIZE,IDENT,DIRTK,LABEL,SCBCD,SECT)
* 
*   WHERE 
* 
*     ER    - ERROR RETURN
* 
*     CODE  - INDICATES WHETHER THIS IS A CALL TO MOUNT OR DISMOUNT 
*             A DISC.     1 = MOUNT   2 = DISMOUNT    3 = MOUNT LU AND
*                                                     CHANGE CRN IN CL
* 
*     DISID - +CRN OR -LU OF DISC TO BE MOUNTED OR DISMOUNTED.
* 
*   PARAMETERS P/G THROUGH LABEL ARE USED ONLY FOR MOUNT CALLS. 
* 
*     P/G   - FOR MOUNT - INDICATES WHETHER DISC IS TO BE MOUNTED AS A
*             PRIVATE OR A GROUP DISC.    0 = PRIVATE   1 = GROUP 
*             DEFAULT IS PRIVATE
*             FOR DISMOUNT - CONTAINS ASCII "RR" IF THE DISC RESOURCE IS TO 
*             BE RELEASED.
*             RR WILL ALWAYS BE SET IF NOT UNDER SESSION CONTROL. 
* 
*     SIZE  - NUMBER OF TRACKS TO BE USED ON THE DISC.
*             DEFAULT WHEN DISID = -LU IS THE NUMBER OF TRACKS ON THE 
*             SUBCHANNEL.  DEFAULT WHEN DISID = +CRN IS THE SIZE OF THE 
*             DISC POOL DISC THAT IS USED (1ST FREE DISC IN DISC POOL). 
* 
*     IDENT - 6 CHAR ASCII LABEL USED IN CARTRIDGE SPECIFICATION ENTRY. 
*             DEFAULT IS DC00XX WHERE XX IS TERMINAL LU #.
* 
*     DIRTK - NEGATIVE # DIRECTORY TRACKS.     DEFAULT IS 1.
* 
*     LABEL - CARTRIDGE REFERENCE NUMBER.  THIS IS USED ONLY WHEN A -LU 
*             IS BEING MOUNTED AND -LU IS A NEW DISC THAT MUST BE INIT- 
*             IALIZED.  IN THIS CASE IT IS REQUIRED.
* 
*     SCBCD - SESSION WORD (POINTER TO SST LENGTH WORD) OF THE SCB
*             TO/FROM WHICH THE DISC IS TO BE MOUNTED/DISMOUNTED. 
* 
*     SECT  - OPTIONAL # SECTORS PER TRACK NEEDED ON THE DISC.  DEFAULTS
*             TO DON'T CARE    (USED BY READT)  ONLY VALID ON ALLOCATION
* 
* 
* 
*     NOTE:  AN MC,-LU IGNORES ANY VALUE SUPPLIED IN IDENT, DIRTK, OR 
*            LABEL UNLESS THERE IS NO VALID DIRECTORY ON THE "LAST TRACK" 
*            OF LU.  IN THIS CASE, LU IS INITIALIZED. 
* 
* 
* 
* 
*     RETURNS :   B-REG ON MOUNT CALL = -LU OF DISC MOUNTED 
*                 B-REG ON DISMOUNT CALL = B CONTAINS DISC LU NUMBER. 
*                        IF THAT DISC WAS ALSO RETURNED TO THE POOL, BIT
*                        15 IS SET.  BIT 14 = 1 IF DISMOUNTED FROM THE
*                        SYSTEM, BIT 14 = 0 IF JUST DISMOUNTED FROM SESSION.
*                        IF RR OPTION WAS NOT SPECIFIED BIT 14 = BIT 15 = 0.
*                 A-REG ON DISMOUNT CALL = CRN
* 
* 
*      NOTE :  IF CODE = 3  (ONLY FROM READT), LABEL IS 
*              PICKED UP AND PUT IN THE CL BUT THE DISC 
*              IS NOT INITIALIZED (OR THE DL CHANGED)!
*              ALSO, IF A BIG ENOUGH DISC ISN'T FOUND IN THE DISC POOL
*              THE BIGGEST DISC AVAILABLE IS MOUNTED. 
*              IF MOUNT AND JUST ACTIVATES - RETURNS ERROR -12
* 
* 
* 
* 
      SPC 5 
A     EQU 0 
B     EQU 1 
TATLG EQU 1755B 
TATSD EQU 1756B 
XEQT  EQU 1717B 
SECT2 EQU 1757B 
SECT3 EQU 1760B 
B77   OCT 77
B377  OCT 377 
B7777 OCT 7777
MSKAL OCT 177777
SIGN  OCT 100000
BIT14 OCT 040000
LUTYP OCT 34000 
DISTP OCT 14000 
STAT  OCT 100015
RDNAB OCT 100001
D.    ASC 3,D.RTR 
WD1   ASC 1,DC
ASC0  ASC 1,00
ASCRR ASC 1,RR
      UNL 
PRC   OCT 74000 
LU2   OCT 74002 
      LST 
* 
* 
ASMBF DEF SM.BF 
ACLBF DEF CL.BF 
* 
* 
INIT  NOP 
SFLAG NOP 
ERROR NOP 
IDSSW NOP 
MTDSC NOP 
DISCL NOP 
SESWD NOP 
LNGTH NOP 
MASK  NOP 
OFFST NOP 
REM   NOP 
ALU   NOP 
PENLU NOP 
ACRN  NOP 
FLAG  NOP 
TMP1  NOP           -\   MUST KEEP THESE
TMP2  NOP           -/    TWO TOGETHER
TMP3  NOP 
PTR1  NOP 
COUN1 NOP 
COUN2 NOP 
ID1   NOP 
ID2   NOP 
EQT5  NOP 
LTR   NOP 
FUNCT NOP 
TRMLU NOP 
NGLU  NOP 
FLAG3 NOP 
FREDS NOP 
DCFLG NOP 
RTFLG NOP 
* 
* 
ZERO  OCT 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.11   DEC 11
.12   DEC 12
.13   DEC 13
.16   DEC 16
.23   DEC 23
.50   DEC 50
.53   DEC 53
.54   DEC 54
.56   DEC 56
.62   DEC 62
.63   DEC 63
.64   DEC 64
.65   DEC 65
.66   DEC 66
.144  DEC 144 
.253  DEC 253 
.256  DEC 256 
A.16  DEF .16 
* 
* 
N1    DEC -1
N2    DEC -2
N3    DEC -3
* 
* 
      SKP 
* 
* 
ER    DEF ZERO
CODE  DEF ZERO
DISID DEF ZERO
P/G   DEF ZERO
SIZE  DEF ZERO
IDENT DEF ZERO
DIRTK DEF ZERO
LABEL DEF ZERO
SCBCD DEF ZERO
SECT  DEF ZERO
* 
DCMC  NOP 
      JSB .ENTR     FETCH INCOMING
      DEF ER         PARAMETERS 
* 
* 
      LDA DISID,I   WAS AN LU OR CRN
      SZA,RSS        SUPPLIED?
      JMP EX50      NO - EXIT NOT ENOUGH PARAMETERS 
* 
      LDB ASMBF     RESOLVE POSSIBLE INDIRECTS
      JSB RESLV      IN ADDRESSES OF THE BUFFER 
      STB ASMBF       USED FOR THE CL AND THE 
      LDB ACLBF        BUFFER USED FOR THE SCB. 
      JSB RESLV 
      STB ACLBF 
      CLA 
      STA DCFLG 
* 
      LDA CODE,I    TRANSFORM FROM ADDRESSES INTO VALUES
      STA CODE       ALL PARAMETERS THAT MAY BE CHANGED 
      LDB P/G,I       BY USING DEFAULT VALUES OR IN 
      CPA .2        (IF DISMOUNT CALL SKIP ROTATE)
      RSS 
      RBR,RBR         GET P/G FLAG TO BIT 14
      STB P/G          REMOUNTING LU2 OR LU3. 
      LDA SIZE,I    DISID IS EXCLUDED BECAUSE IT IS 
      STA SIZE       A VARIABLE AND THE ADDRESS IS NEEDED TO RETURN 
      LDA DIRTK,I     THE -LU OF THE DISC MOUNTED.
      STA DIRTK 
* 
REACL CLA 
      STA SFLAG     CLEAR THE IN-SESSION FLAG AND 
      STA INIT       AND THE INITIALIZE DISC FLAG 
      STA FLAG3       AND THE SPECIAL FLAG FOR READT CALL 
* 
      JSB EXEC      CALL EXEC TO READ 
      DEF *+7        CARTRIDGE DIRECTORY INTO 
      DEF .1          GLOBAL BUFFER D.SDR 
      DEF LU2 
      DEF CL.BF 
      DEF .256
      DEF $CL1
      DEF $CL2
* 
      JSB SESSN     GET CALLERS SESSION WORD IF THERE IS ONE
      DEF *+2 
      DEF XEQT
      SEZ,RSS       UNDER SESSION CONTROL?
      JMP INSES     YES - CALLER IS UNDER SESSION 
      LDA SCBCD,I   NO - SEE IF A SESSION WORD WAS PASSED IN CALL 
      SZA,RSS       WAS A SESSION WORD PASSED?
      JMP NTSES     NO - THIS CALL IS NOT UNDER SESSION CONTROL 
      LDB A         GET SESSION WORD TO B-REG 
INSES STB SESWD     SAVE SESSION WORD (POINTER TO SST LENGTH WORD)
      ISZ SFLAG     SET IN-SESSION FLAG 
      JSB GTSCB     READ SCB
      DEF *+5 
      DEF SM.BF 
      DEF .144
      DEF ERROR 
      DEF SESWD 
* 
      LDB ASMBF     SCB WAS READ IN AT THIS ADDRESS 
      LDA B,I       GET IDENTIFIER FROM SCB 
      STA TRMLU      AND SAVE IT  (TERMINAL LU) 
      CMB,INB       CALCULATE POINTER TO SST LENGTH WORD
      ADB $SMLK      IN SCB SO CAN USE SCB OFFSET GLOBALS 
      ADB $SMST       IN ACCESSING ELEMENTS OF THE SCB. 
      CMB,INB 
      STB IDSSW     IDSSW = A.SCB - $SMLK - $SMST 
* 
      LDA B,I       CALCULATE ADDRESS OF 1ST ENTRY
      CMA,INA        IN DISCS MOUNTED AREA OF 
      ADB .2          THE SCB USING THE POINTER 
      ADB A            TO THE SST LENGTH WORD 
      STB MTDSC     MTDCS = IDSSW + 1 + C(IDSSW)
* 
      LDB IDSSW     SAVE LENGTH OF DISCS
      ADB N1         MOUNTED AREA 
      LDB B,I 
      STB DISCL 
      LDA IDSSW,I   CALCULATE LENGTH OF DISCS MOUNTED AREA
      CMA,INA        + LENGTH OF SST + 2 AND SAVE FOR 
      ADA B           SCB UPDATE ROUTINES 
      ADA .2
      STA LNGTH 
* 
      LDB $SMID     IF DISC IS TO BE MOUNTED AS A 
      LDA P/G        PRIVATE DISC, ID1 _ USER ID
      CPA BIT14       AND ID2 _ PRIVATE ID. 
      LDB $SMGP     IF DISC IS TO BE MOUNTED AS A 
      ADB IDSSW      GROUP DISC.  ID1 _ GROUP ID
      LDB B,I         AND ID2 _ USER ID.
      STB ID1 
      LDB $SMID 
      CPA BIT14 
      RSS 
      LDB $SMGP 
      ADB IDSSW 
      LDB B,I 
      STB ID2 
* 
      LDA B7777     JUST IN CASE THIS IS AN LU 2 OR 3 
      LDB DISID,I    REMOUNT, FORCE THE ID TO 7777B 
      CPB N2
      STA ID1 
      CPB N3
      STA ID1 
* 
      LDA CODE      IS THIS AN AC OR A MC?
      CPA .2         OR DISMOUNT CALL?
      JMP DC        DISMOUNT
* 
* 
DFLTS LDB N1
      LDA DIRTK     IF # DIRECTORY TRACKS 
      SZA,RSS        WAS NOT SET
      STB DIRTK       DEFAULT TO -1 
      LDA IDENT,I 
      SZA,RSS       6-CHARACTER LABEL SPECIFIED?
      JMP CLSCH      NO 
      JSB NAM..     YES - MAKE SURE IT IS A LEGAL FMGR NAME 
      DEF *+2 
      DEF IDENT,I 
      SZA           LEGAL?
      JMP EX53      NO - BAD PARAMETER
* 
CLSCH LDA DISID,I   WAS AN LU OR CRN
      SSA           -LU OR CRN??  (MC OR AC)
      JMP MT.LU     LU - GO HANDLE A MC,-LU 
      SKP 
* 
* 
* 
*    IF CRN IS TO BE MOUNTED AS A PRIVATE DISC THEN:
* 
*    1.  IF CRN, GROUP ID IS MOUNTED TO THE SYSTEM, DON'T ALLOW 
*        THE MOUNT.  ERROR 12 
*    2.  IF CRN, USER ID IS ALREADY MOUNTED TO THE SYSTEM AND 
*        THE CALLER'S SCB, DON'T ALLOW THE MOUNT.   ERROR 12
*    3.  IF CRN, USER ID IS MOUNTED TO THE SYSTEM BUT NOT TO
*        THE CALLER'S SCB, JUST DO THAT PART OF THE MOUNT THAT
*        MOUNTS THE DISC TO THE CALLER'S SCB. 
*    4.  IF CRN, SYSTEM ID IS MOUNTED, DON'T ALLOW THE MOUNT. 
*        ERROR 12 
* 
*    SAME LOGIC (VICE VERSA) FOR A DISC THAT IS TO BE MOUNTED AS
*    A GROUP DISC.
* 
* 
* 
* 
M.CRN LDB ACLBF     SEARCH FOR CRN PASSED 
M.CR0 LDA DISID,I   START AT BEGINNING OF CARTRIDGE LIST
      JSB SERCH     SEARCH CL FOR DISID  (CRN IN THIS CASE) 
      JMP M.CR2     CRN NOT THERE 
      LDA B,I       FOUND ONE!  GET ID WORD 
      INB           STEP TO NEXT ENTRY IN CASE ID'S DON'T MATCH 
      AND B7777     MASK TO BITS 11-0 
      CPA ID2       MOUNTED TO ID2? 
      JMP EX12      AREADY ACCESSABLE BY THIS ACCOUNT 
      STA TMP3      REMEMBER THIS ID
      CPA ID1       MOUNTED TO ID1? 
      RSS           YES 
      JMP M.C05     NO - CONTINUE SEARCH AT LOCATION B IN CL
      JSB SCBCK     IS LU MOUNTED TO THIS SESSION?
      JMP EX12      YES - ERROR 12. ALREADY MOUNTED TO THIS SESSION 
      JMP M.CR1     YES - BUT IT'S INACTIVE, SO JUST REACTIVATE 
      LDA PENLU     WE'VE FOUND THE LU# OF PHYSICAL DISC BEING
      STA ALU        MOUNTED SO SAVE IT 
      ADB N2         POSITION TO CRN IN 
      LDA B,I         THIS ENTRY AND GET IT.
      JSB CKCRN      MAKE SURE THIS CRN IS NOT ALREADY MOUNTED TO SCB 
      JMP EX12       IT IS SO ERROR EXIT
      JSB ADD       GO ADD IT TO THE SCB
      JMP EX65      ERROR RETURN   SESSION LU CONFLICT IN SST 
      CLA           RETURN WITH NO
      LDB CODE      IF SPECIAL CODE FOR READT 
      CPB .3         THEN MOUNT TO SESSION AND RETURN 
      LDA .12         WITH AN ERROR -12 ANYWAY. 
      JMP EXIT       ERRORS 
* 
M.CR1 LDA PENLU     NOW HAVE THE LU # OF DISC 
      STA ALU        WE'RE WORKING WITH INTO ALU
      CLA           SET ACTIVATE CODE 
      JSB ACTIV     GO ACTIVATE THE DISC IN DISC'S MOUNTED LIST 
      CLA           CLEAR FOR ERROR CODE
      LDB CODE      IF SPECIAL CODE FOR READT 
      CPB .3         THEN ACTIVATE AND RETURN 
      LDA .12         AN ERROR -12. 
      JMP EXIT       AND RETURN 
* 
M.C05 LDA B7777     GET SYSTEM ID 
      CPA TMP3      IS THIS A SYSTEM DISC?? 
      JMP EX12      YES - IS ALREADY ACCESSABLE BY THIS ACCOUNT 
      CPA ID1       IS THIS PERSON THE SYSTEM MANAGER?
      JMP EX12      YES - CAN'T MOUNT SYSTEM DISC WITH CRN = ANY OTHER
*                               CRN IN THE SYSTEM 
      JMP M.CR0     NOPE - KEEP SEARCHING 
* 
M.CR2 LDA MTDSC     POSITION TO 
      ADA N1         DISCS MOUNTED
      LDA A,I         COUNTER IN SCB. 
      SZA,RSS       IF ZERO, CAN'T MOUNT ANY MORE 
      JMP EX63      SO RETURN ERROR 63
* 
      LDA DISID,I   WE CAN USE THIS CRN SO
      STA ACRN       SAVE IT
      LDA ACLBF     B-REG CONTAINS ADDRESS OF 1ST 
      ADA .253       EMPTY ENTRY IN DISC DIRECTORY.  MAKE 
      CMA,INA         SURE THIS IS NOT STOP WORD. 
      ADA B           I.E. IF B >= ADSDR + 252  OR
      SSA,RSS        IF B - ADSDR - 252 >= 0 THEN B IS
      JMP EX62      STOP WORD.  ALREADY 63 DISCS MOUNTED. 
* 
      LDA N2
      STA COUN2 
M.C2  CLA           GET READY FOR NEXT BEST SIZE ALGORITHM
      STA TMP3       FOR READT MOUNT CALL 
      LDB ASMBF     GET 1ST WORD ADDRESS OF DISC POOL 
      STB PTR1       AND SAVE IT
M.C20 JSB RDSPL     READ DISC POOL INTO BUFFER SM.BF
M.C21 LDB PTR1,I    GET ENTRY FROM DISC POOL
      CPB N1        IS THIS THE END?
      JMP M.C23     YES - AND DIDN'T FIND ONE 
      CCE,SSB       IS THIS ONE MARKED USED?
      JMP M.C22     YES - GO STEP TO THE NEXT ONE 
      RBL,ERB       SET UP DOUBLE 
      STB TMP1       WORD CONTROL WORD
      CLB             FOR EXTENDED EXEC 
      STB TMP2         STATUS REQUEST 
      JSB XLUEX     STATUS CHECK
      DEF *+4 
      DEF STAT
      DEF TMP1
      DEF EQT5
      JMP M.C22     IF THIS IS A
      LDA EQT5       BAD LU, JUST 
      AND LUTYP       SKIP IT.
      CPA DISTP 
      RSS 
      JMP M.C22 
      LDB PTR1,I    GET DISC LU AGAIN 
      JSB IMPRD     MAKE IMPOSSIBLE READ TO LU TO GET SIZE
      JMP M.C22     DISC ERROR ON THIS ONE:  SKIP IT
* 
      LDA SECT,I    MAKE SURE THIS DISC HAS AT LEAST
      CMA,INA        AS MANY SECTORS PER TRACK AS 
      ADA ERROR       REQUESTED BY CALLER 
      SSA           ENOUGH SECT/TRACK?? 
      JMP M.C22     NO - SKIP TO NEXT DISC
* 
      LDA SIZE      IS THIS DISC
      CMA,INA        AT LEAST AS
      ADA B           BIG AS SIZE 
      SSA              REQUESTED? 
      JMP M.C2S     NO - SAVE SOME SIZE DATA AND GO TRY THE NEXT ONE
      LDA SIZE      YES - MAKE SURE # DIRECTORY TRACKS
      SZA,RSS        SPECIFIED IS REASONABLE
      LDA B           TEST IS:
      ADA DIRTK       # DIR TRACKS < (TOTAL TKS - #DIR TKS) 8 + 1 
      ARS,ARS 
      ARS 
      INA 
      ADA DIRTK 
      SSA,RSS       REASONABLE? 
      JMP M.C24     YES - WE'VE GOT A DISC
      LDA SIZE      IF SIZE AND DIRTK WERE BOTH SPECIFIED 
      SZA,RSS        THEN WILL NEVER FIND A DISC SO JUST
      JMP M.C22       RETURN AN ERROR NOW 
      JMP EX56
* 
M.C2S LDA TMP3      GET SIZE OF LAST DISC 
      CMA,INA        MAKE NEGATIVE
      ADA B           AND ADD THIS DISC'S SIZE
      SSA,RSS       IF THIS ONE IS BIGGER 
      STB TMP3       SAVE IT'S SIZE 
      LDB PTR1
      SSA,RSS       IF THIS ONE IS BIGGER 
      STB FREDS      SAVE POINTER TO IT 
* 
M.C22 ISZ PTR1      STEP TO NEXT DISC POOL ENTRY
      JMP M.C21      AND GO CHECK IT
* 
M.C23 ISZ COUN2     1ST TIME THRU?
      RSS           YES 
      JMP NODSC     2ND TIME THRU AND STILL NO DISCS AVAILABLE
      JSB POLCK     1ST TIME - CHECK DISC POOL FLAGS FOR VALIDITY 
      JMP M.C2       AND TRY AGAIN
* 
* 
NODSC LDB TMP3      GET BEST FIT SIZE 
      LDA CODE
      CPA .3        IF THIS IS A READT CALL 
      SZB,RSS        AND THERE WAS A SMALLER DISC FREE
      JMP EX64        MOUNT IT, ELSE ERROR 64 
      STB SIZE      SET UP SIZE PARAMETER 
      ADB N1         AND LAST TRACK 
      STB LTR 
      LDA FREDS,I   GET LU OF THIS DISC 
      STA ALU        AND MAKE IT THE CURRENT LU 
      CCA           SET A FLAG MAKING THIS
      STA FLAG3      CASE IDENTIFIABLE
      JMP DOMNT     GO DO THE MOUNT 
* 
* 
M.C24 LDA SIZE      IF USER SPECIFIED SIZE
      SZA,RSS        USE IT. IF NOT, USE
      LDA B           THE # TRACKS ON THE 
      STA SIZE         ALLOCATED DISC 
      ADA N1
      STA LTR       LTR = SIZE - 1
      LDA PTR1,I    SAVE LU # OF
      ISZ PTR1      STEP DISC POOL POINTER (THIS ONE COULD FAIL)
      STA ALU        ALLOCATED DISC.
* 
*                                   ADD ALU TO CALLER'S SCB; TO DISCS 
DOMNT JSB ADD        MOUNTED LIST, SST IF NECESSARY, STEP COUNTER 
      JMP M.C20     ERROR RTN  GO TRY ANOTHER DISC POOL DISC
      JSB ALLOC      ALLOCATE ALU IN DISC POOL
      CCA           SET NEEDS-TO-BE-INITIALIZED FLAG
      STA INIT
* 
M.C25 LDA ALU       GET LU NUMBER OF DISC BEING MOUNTED 
      CMA,INA        MAKE IT NEGATIVE,
      STA NGLU        AND USE IN SCHEDULE OF D.RTR
      LDA ID1       GET ID TO WHICH DISC IS TO BE MOUNTED 
      LDB INIT      GET INITIALIZE FLAG 
      CCE,SZB       INITIALIZE THIS DISC? 
      RAL,ERA       YES SET BIT 15 ON PARAMETER 5 
      STA TMP3      TEMP SAVE FOR PARAMETER 5 
      JSB SPECF     SET UP 16-WORD SPECIFICATION ENTRY
      LDA OVRD.     GET ANY POSSIBLE OVERRIDE BITS
      ADA .13        AND THEM TO D.RTR
      STA FUNCT        FUNCTION CODE
      JSB EXEC      SCHEDULE D.RTR TO ADD 
      DEF D.RTN      THE ENTRY TO THE CARTRIDGE 
      DEF .23         DIRECTORY AND INITIALIZE
      DEF D.           THE DIRECTORY
      DEF XEQT
      DEF FUNCT 
      DEF NGLU
      DEF SCBCD,I 
      DEF TMP3
      DEF SM.BF 
      DEF .16 
D.RTN JSB RMPAR     FETCH RETURN PARAMETERS 
      DEF *+2 
      DEF SM.BF 
      LDA SM.BF 
      SSA           ANY D.RTR ERRORS? 
      JMP CLNUP     GO CLEAN UP AFTER D.RTR ERRORS
      CLA           EXIT WITH NO
      JMP EXIT       ERRORS.
* 
* 
NTSES CLA           NOT IN SESSION SO 
      STA ID1        SET 1ST ID TO ZERO 
      LDA B7777      AND 2ND TO SYSTEM DISCS
      STA ID2 
      CMB,INB       SAVE THIS TERMINAL'S
      STB TRMLU      LOGICAL UNIT # 
      LDA CODE
      CPA .2        MC OR DC? 
      JMP DC        CONTINUE DISMOUNT 
      LDA DISID,I   SINCE NOT IN SESSION MUST 
      SSA,RSS        HAVE BEEN MC,-LU SO
      JMP EX56        IF NOT - BAD PARAMETER ERROR. 
      JMP DFLTS      CONTINUE MOUNT 
* 
* 
CLNUP STA TMP3      SAVE ERROR CODE FOR RETURN
      JSB FREE
      LDA SFLAG     IF NOT UNDER SESSION
      SZA            CONTROL THEN SKIP SCB REMOVE STUFF 
      JSB REMOV 
      LDA TMP3      GET ERROR IN CASE THERE WAS ONE 
      LDB DISID,I   FIND OUT IF WAS MC,-LU OR AN MC,+CRN
      SSB           DISID + OR -? 
      JMP EXIT      MC,-LU SO RETURN THE ERROR AND TERMINATE
      LDA FLAG3     MC,CRN   IS THIS SPECIAL READT CASE?
      CPA N1        FLAG SET? 
      JMP EX64      YES - EVEN THIS DISC DIDN'T WORK!!
      JMP M.C20     NO - GO TRY ANOTHER DISC FROM THE POOL
      SKP 
* 
* 
MT.LU CMA,CCE,INA    SET UP DOUBLE
      RAL,ERA        WORD CONTROL 
      STA TMP1        PARAMETER FOR 
      CLA              EXTENDED EXEC CALL 
      STA TMP2
      JSB XLUEX     MAKE EXEC STATUS REQUEST
      DEF *+4        TO BE SURE DISID IS REALLY 
      DEF STAT        A DISC DEVICE 
      DEF TMP1
      DEF EQT5
      JMP EX56      ERROR ON STATUS REQUEST.  LU MUST BE BAD
      LDA EQT5      GET EQT 5 STATUS WORD 
      AND LUTYP     MASK TO DEVICE TYPE 
      CPA DISTP     TYPE 30 - 39? 
      RSS           YES 
      JMP EX56      NO - ERROR BAD PARAMETER
* 
      LDA DISID,I   SEARCH FOR -LU PASSED IN
      LDB ACLBF     START SEARCH AT BEGINNING OF CL 
      JSB SERCH     LOOK FOR AN ENTRY FOR DISID 
      JMP MTLU1     NOT THERE - ALL'S CLEAR FOR MOUNT 
      LDA SFLAG     IT'S MOUNTED - IS CALLER
      SZA,RSS        UNDER SESSION CONTROL? 
      JMP EX12      NO - MUST GIVE ALREADY MOUNTED ERROR
      LDA B,I       GET ID WORD 
      AND B7777     MASK TO BITS 11-0 
      CPA ID1       MOUNTED WITH THE RIGHT ID?
      RSS           YES 
      JMP EX12      NOPE - ALREADY MOUNTED ERROR
      JSB SCBCK     YES - IS LU MOUNTED TO THIS SESSION?
      JMP EX12      YES - ALREADY MOUNTED ERROR 
      JMP MTLU0     YES - BUT INACTIVE - JUST REACTIVATE
      LDA PENLU     NO - JUST MOUNT THIS LU TO THE SESSION
      STA ALU        AND KEEP THE LU OF THE DISC BEING MOUNTED
      ADB N1         POSITION TO CRN IN THIS ENTRY
      LDA B,I         AND GET IT
      JSB CKCRN      MAKE SURE THIS CRN IS NOT ALREADY MOUNTED TO SCB 
      JMP EX12       IT IS SO ERROR EXIT
      JSB ADD       ADD ALU TO THE SESSION
      JMP EX65      SESSION LU CONFLICT IN SST ERROR RETURN 
      CLA            AND RETURN WITH
      LDB CODE      IF SPECIAL CODE FOR READT 
      CPB .3         THEN JUST MOUNT TO SESSION AND 
      LDA .12         RETURN AN ERROR -12 ANYWAY. 
      JMP EXIT        NO ERRORS 
* 
MTLU0 LDA PENLU     NOW HAVE THE LU # OF
      STA ALU        DISC INTO ALU
      CLA           SET ACTIVATE CODE 
      LDB SFLAG 
      SZB 
      JSB ACTIV     MARK DISC ACTIVE
      CLA           SET FOR ERROR CODE
      LDB CODE      IF SPECIAL CODE FOR READT 
      CPB .3         THEN JUST ACTIVATE AND 
      LDA .12         SET ERROR -12 
      JMP EXIT       AND RETURN 
* 
MTLU1 LDA SFLAG     UNDER SESSION CONTROL?
      SZA,RSS        CONTROL? 
      JMP MTL15     NO SKIP DISCS MOUNTED CNTR CHECK
      LDA MTDSC     POSITION TO 
      ADA N1         DISCS MOUNTED
      LDA A,I         COUNTER IN SCB. 
      SZA,RSS       IF ZERO CAN'T MOUNT ANY MORE
      JMP EX63       SO RETURN WITH ERROR 63
* 
MTL15 LDB DISID,I   TURN DISID INTO 
      CMB,INB        A POSITIVE LU #
      STB ALU         AND SAVE
      JSB IMPRD     MAKE AN IMPOSSIBLE READ TO ALU TO 
      JMP EXN1      DISC ERROR - LEAVE! 
      LDA SIZE      GET SIZE IN TRACKS PASSED INTO ROUTINE
      SZA,RSS       WAS SIZE SPECIFIED? 
      LDA B         NO - USE PHYSICAL # TRACKS ON DISC
      CMB,INB       PHYSICAL NUMBER OF TRACKS 
      ADB A          ON DISC - NUMBER OF TRACKS 
      CMB,INB         SPECIFIED MUST BE > OR = 0. 
      SSB           > OR = 0
      JMP EX56      NO - ERROR BAD PARAMETER
      STA SIZE      SAVE CORRECT SIZE VALUE 
      ADA N1        GET # TRACKS LESS ONE IS LAST 
      STA LTR         TRACK ON THIS SUBCHANNEL
* 
MTLU2 JSB FD.CK     IS THERE A FILE SYSTEM ON ALU?
      DEF *+3 
      DEF ALU 
      DEF LTR 
      SZA,RSS       VALID FILE SYSTEM?
      JMP OLDIS     THERE IS ONE - SKIP INITIALIZATION STUFF
      LDA LABEL,I   GET CARTRIDGE REFERENCE NUMBER
      SZA,RSS       WAS ONE SPECIFIED?
      JMP EX50      NOPE - EXIT NOT ENOUGH PARAMETERS 
      STA ACRN      YES - STUFF IN ACRN FOR SEARCH
      LDB LTR       CHECK TO MAKE SURE NUMBER 
      INB            OF DIRECTORY TRACKS
      ADB DIRTK       SPECIFIED (OR DEFAULTED)
      BRS,BRS          IS REASONABLE FOR THE SIZE 
      BRS               OF THIS DISC.  THE TEST IS: 
      INB           #DIR TK < (TOTAL TKS - DIR TKS) 8 + 1 
      ADB DIRTK 
      SSB           REASONABLE??
      JMP EX56      NO - EXIT BAD PARAMETER 
      CCA           SET NEEDS-TO-BE-INITIALIZED FLAG
      STA INIT
* 
* 
MTLU3 LDB ACLBF     SEARCH FOR CRN TO BE ASSIGNED TO DISC 
MTLU4 LDA ACRN      START SEARCH AT BEGINNING OF DIRECTORY
      JSB SERCH     LOOK THROUGH DIRECTORY FOR CRN
      JMP MTLU5     NOT THERE SO ALL'S CLEAR
      LDA B7777     IF THIS IS THE SYSTEM MANAGER AND HE IS 
      CPA ID1        MOUNTING A PRIVATE (SYSTEM) DISC IT CAN'T
      JMP EX12        HAVE CRN = ANY OTHER CRN IN THE CL
      LDA B,I       FOUND ONE.  GET ID WORD 
      INB           STEP TO NEXT ENTRY IN CASE ID'S DON'T MATCH 
      AND B7777     MASK ID WORD TO BITS 11-0 
      CPA ID1       SAME ID AS CALLER?
      JMP EX12      YES - CRN IS ALREADY MOUNTED TO CALLER
      CPA ID2       SAME ID AS CALLER?
      JMP EX12      YES - CRN IS ALREADY MOUNTED TO CALLER
      CPA B7777     SAME AS SYSTEM ID?
      JMP EX12      YES - CRN IS ACCESSIBLE TO CALLER 
      JMP MTLU4     NO - KEEP SEARCHING 
* 
MTLU5 JSB ALLOC     CHECK DISC POOL AND ALLOCATE ALU IF THERE 
      LDA SFLAG     GET IN-SESSION FLAG 
      SZA,RSS       UNDER SESSION CONTROL?
      JMP M.C25     NO - SO SKIP SCB STUFF
      JSB ADD       ADD ALU TO SST AND DISCS MOUNTED LIST 
      JMP EX65      SESSION LU CONFLICT IN SST ERROR RETURN 
      JMP M.C25     FINISH UP WITH D.RTR CALL 
* 
* 
OLDIS STB ACRN      SAVE CRN OF CURRENT DISC FOR CART DIRECT
      JMP MTLU3     SKIP INITIALIZATION STUFF.
* 
* 
* 
      SKP 
* 
* 
DC    CCA           SET DISMOUNT
      STA DCFLG       FLAG
      STA FLAG3         AND # PASSES FLAG 
DC.0  LDB ACLBF     SEARCH FOR DISID PASSED IN
DC.1  LDA DISID,I   START AT BEGINNING OF CL
      JSB SERCH     SEARCH FOR LU OR CRN
      JMP NOTFD     NOT THERE 
      LDA B,I       FOUND ONE.  GET ID WORD 
      AND B7777      AND MASK TO BITS 0-11
      CPA ID1       MATCH ID1?
      JMP DC.2      YES 
      CPA ID2       NO - MATCH ID2? 
      JMP DC.2      YES 
      LDA FLAG3     IF THIS IS THE 1ST PASS 
      SSA            THEN DON'T GIVE IT TO USER 
      JMP DC.11       JUST BECAUSE HE'S SYSTEM MANAGER
      LDA B7777     ID1 IS CALLER'S PRIVATE ID (IF IN SESSION)
      CPA ID1        SEE IF CALLER IS SYSTEM MANAGER. IF SO 
      JMP DC.21       GO AHEAD AND LET HIM DISMOUNT ANY DISC
DC.11 INB           STEP TO NEXT ENTRY
      JMP DC.1       AND KEEP SEARCHING THROUGH CL
DC.2  LDA SFLAG     GET IN SESSION FLAG 
      SZA           UNDER SESSION CONTROL?
      JSB SCBCK     YES - IS THIS DISC MOUNTED TO CALLER'S SESSION? 
      JMP DC.21     YES - GO AHEAD WITH DISMOUNT
      JMP DC.20     YES - MARKED INACTIVE - GO AHEAD WITH DISMOUNT
      JMP DC.11     NO - KEEP SEARCHING THROUGH CL
* 
NOTFD LDB ID1       IF THE CALLER IS THE SYSTEM 
      CPB B7777      MANAGER AND THIS IS THE 1ST
      ISZ FLAG3       TIME THROUGH THE CL THEN
      JMP EX54         DO ANOTHER PASS  -  OTHERWISE
      JMP DC.0          MUST EXIT NOT FOUND 
* 
DC.20 CCA           SET FLAG TO MAKE DISC ACTIVE SO 
      STA FLAG       D.RTR CAN FIND IT
* 
DC.21 LDA PENLU     THIS IS THE DISC WE'RE DISMOUNTING
      STA ALU        SO KEEP LU NUMBER AROUND 
      STA RTFLG     SAVE FOR RETURN PARAMETER 
      ADB N1        POSITION TO CRN 
      LDA B,I       GET IT
      STA ACRN       AND SAVE FOR RETURN PARAMETER
      LDA P/G       GET "RR" INDICATOR
      CPA ASCRR     RELEASE RESOURCES?? 
      RSS           YES - GO AHEAD WITH DISMOUNT
      JMP INACT     NO - JUST MARK DISC INACTIVE
      LDA SFLAG     ARE WE UNDER
      SZA,RSS        SESSION CONTROL? 
      JMP DC.3      NO - SKIP SCAN OF OTHER SCB'S 
      JSB SCAN      YES - IS ALU MOUNTED TO ANY OTHER SESSION?
      JMP DC.4      YES - JUST DISMOUNT FROM SESSION
      CLA           SINCE DISMOUNTING FROM SYSTEM 
      LDB FLAG       IF DISC IS INACTIVE, MUST
      CPB N1          MARK DISC ACTIVE FIRST
      JSB ACTIV        (FOR D.RTR)
* 
DC.3  LDA RTFLG     GET DISC DISMOUNTED FLAG (FOR RETURN) 
      IOR BIT14     SET FLAG THAT SAYS REALLY DISMOUNTED FROM SYSTEM
      STA RTFLG      AND SAVE IT
      LDA ALU       GET LU# OF DISC TO BE DISMOUNTED
      CMA,INA        AND MAKE IT NEGATIVE 
      STA TMP2
      LDA OVRD.     GET ANY POSSIBLE OVERRIDE BITS
      ADA .11        AND ADD THEM TO D.RTR
      STA FUNCT       DISMOUNT FUNCTION CODE. 
      JSB EXEC      SCHEDULE D.RTR TO FIND
      DEF *+7        ALU AND REMOVE IT FROM 
      DEF .23         DIRECTORY OF DISCS
      DEF D.
      DEF XEQT
      DEF FUNCT 
      DEF TMP2
      DEF SCBCD,I 
* 
      JSB RMPAR     GET RETURN PARAMETERS 
      DEF *+2 
      DEF SM.BF 
      LDA SM.BF     D.RTR PASSED BACK 
      SSA            ANY ERRORS?
      JMP EXIT      YES - RETURN WITH ERROR 
* 
      LDB ALU       DISMOUNTING LU 2 OR 3?
      CPB .2         JUST GO REMOUNT THEM 
      JMP REMNT 
      CPB .3
      JMP REMNT 
* 
      JSB FREE      FREE ALU IN DISC POOL IF THERE
DC.4  LDA SFLAG     IN SESSION
      SZA            MODE?
      JSB REMOV     YES - DISMOUNT ALU FROM SCB 
      CLA 
      JMP EXIT      RETURN
* 
* 
REMNT LDA SFLAG     IN SESSION
      SZA            MODE?
      JSB REMOV     YES - DISMOUNT ALU FROM SCB 
      LDA ALU       MAKE SURE MOUNTING -LU 2
      CMA,INA        OR -LU 3 
      STA DISID,I 
      LDA .1        CHANGE FUNCTION CODE FROM 
      STA CODE       MOUNT TO DISMOUNT
      CLA           SET UP PRIVATE GROUP INDICATOR
      STA P/G        FOR A MOUNT AS A PRIVATE DISC. 
      JMP REACL 
* 
* 
INACT LDB SFLAG 
      CLA,INA       SET INACTIVATE CODE 
      SZB 
      JSB ACTIV     GO SET DISC INACTIVE
      CLA           CLEAR FOR ERROR CODE
      JMP EXIT       AND RETURN 
      SKP 
* 
* 
* 
*  SERCH   SEARCHES CARTRIDGE DIRECTORY FOR CRN OR -LU
* 
*          ENTRY :  B-REG CONTAINS STARTING ADDRESS OF SEARCH 
*                   A-REG CONTAINS CRN OR -LU TO BE SEARCHED FOR
* 
*          EXIT  :  PENLU CONTAINS LU # OF PENDING ENTRY
*                   P+1  NOT FOUND
*                   B-REG POINTS TO 1ST WORD OF 1ST EMPTY SPOT
*                   P+2  FOUND CRN
*                   B-REG POINTS TO ID WORD OF "FOUND" ENTRY
* 
* 
SERCH NOP 
      JSB RESLV     RESOLVE INDIRECT ADDRESS IN B   JUST IN CASE
      SSA           CRN OR -LU? 
      JMP LU.SH     LU
      STA TMP2      SAVE CRN
      LDA MSKAL 
      STA MASK      DON'T NEED A MASK 
      LDA .2        WANT 3RD WORD IN ENTRY
      STA OFFST 
      JMP SER.0 
* 
LU.SH CMA,INA       MAKE LU POSITIVE
      STA TMP2       AND SAVE IT
      LDA B77       SET UP MASK FOR 
      STA MASK       BITS 0-5 
      CLA           WANT 1ST WORD IN ENTRY
      STA OFFST 
SER.0 CMA,INA 
      ADA .3
      STA REM 
SER.1 LDA B,I 
      SZA,RSS       END OF DIRECTORY? 
      JMP SERCH,I   YES - RETURN, NOT FOUND 
      AND B77       MASK TO LU# 
      STA PENLU      AND SAVE 
      ADB OFFST 
      LDA B,I       GET DISC ID FROM ENTRY
      AND MASK
      ADB REM       STEP POINTER TO ID WORD 
      CPA TMP2      IS THIS THE ONE WE WANT?
      JMP SER.2     YES 
      INB           NO - STEP TO NEXT ENTRY 
      JMP SER.1      AND GO CHECK IT OUT
SER.2 ISZ SERCH     STEP TO P+2 
      JMP SERCH,I   RETURN
      SKP 
* 
* 
* 
* SCBCK :  LU MOUNTED IN CALLERS SCB? 
*          SCANS THE DISC'S MOUNTED LIST IN SCB FOR PENLU 
* 
*          ENTRY  :  PENLU CONTAINS LU# TO BE SEARCHED FOR
* 
*          EXIT   :  P+1 - IT'S THERE AND ACTIVE
*                    P+2 - IT'S THERE BUT MARKED INACTIVE 
*                    P+3 - NOT THERE
* 
* 
* 
SCBCK NOP 
      STB TMP1
      LDA DISCL     GET # DISCS TO BE CHECKED 
      CMA,INA        AND USE AS 
      STA COUN1       A COUNTER.
      LDB MTDSC 
SCB.1 LDA B,I 
      AND B377
      CPA PENLU     THIS DISC THE ONE WE WANT?
      JMP SCB.2     YES - RETURN
      INB 
      ISZ COUN1 
      JMP SCB.1     GO LOOK AT NEXT ONE 
      ISZ SCBCK     DIDN'T FIND IT SO 
      JMP SCB.3      GO RETURN P+3
* 
SCB.2 LDA B,I       GET ENTRY AGAIN 
      ALF,RAR       ROTATE RIGHT 3 BITS 
      SLA           BIT 13 SET?  INACTIVE?
SCB.3 ISZ SCBCK     YES  SET RETURN TO P+2
      LDB TMP1
      JMP SCBCK,I    RETURN 
* 
* 
*     CKCRN  :  MAKES SURE THAT A CRN IS NOT ALREADY ACCESSIBLE TO CALLER 
*               (IN HIS DISCS MOUNTED LIST OR A SYSTEM DISC)
* 
*               ENTRY - A = CRN TO BE SEARCHED FOR
* 
*               EXIT  - P+1  A DISC THAT HAS THIS CRN IS ALREADY ACCESSIBLE 
*                            BY THE CALLER
*                       P+2  ALL'S CLEAR
* 
* 
CKCRN NOP 
      STA SAVA      KEEP CRN WE ARE SEARCHING FOR 
      LDB ACLBF     START SEARCHING AT BEGINNING OF CL
CKCR1 LDA SAVA      GET VALUE TO SEARCH FOR 
      JSB SERCH     SEARCH CL FOR VALUE IN A
      JMP CKCR3     NOT THERE SO EXIT AT P+2
      JSB SCBCK     FOUND ONE - SEE IF IT IS MOUNTED TO CALLER'S SCB
      JMP CKCRN,I   THERE AND ACTIVE - EXIT P+1 
      JMP CKCRN,I   THERE BUT INACTIVE - EXIT P+1 
      LDA B7777     IF CALLER IS THE SYSTEM MANAGER 
      CPA ID1        THEN SKIP THE SYSTEM DISC CHECK. 
      JMP CKCR2       (BECAUSE SYSTEM DISC = PRIVATE FOR HIM) 
      CPA B,I       IS THIS A SYSTEM DISC?
      JMP CKCRN,I   YES - EXIT P+1
CKCR2 INB           INCREMENT POINTER AND 
      JMP CKCR1      CONTINUE SEARCH
* 
CKCR3 ISZ CKCRN     STEP RETURN ADDRESS 
      JMP CKCRN,I    AND RETURN P+2 
* 
SAVA  NOP 
* 
* 
* 
* POLCK  :  SCAN DISC POOL AND CARTRIDGE DIRECTORY AND
*           FREE ANY ENTRIES IN THE DISC POOL THAT ARE MARKED 
*           TAKEN BUT REALLY AREN'T MOUNTED.
* 
*   ENTRY : CL IS IN D.SDR
* 
* 
POLCK NOP 
      CLA           CLEAR COUNTER FOR NUMBER OF 
      STA TMP2       ENTRIES PASSED SO FAR IN POOL
      JSB RDSPL     READ DISC POOL INTO BUFFER SM.BF
      LDA ASMBF     FIRST WORD ADDRESS OF DISC POOL 
      STA PTR1
POL.1 LDA PTR1,I    GET DISC POOL ENTRY 
      CPA N1        END OF DISC POOL? 
      JMP POLCK,I   YES - CHECK IS DONE 
      SSA,RSS       THIS ENTRY MARKED TAKEN?
      JMP POL.5     NO - GO TO THE NEXT ONE 
      RAL,CLE,ERA   YES CLEAR OFF THE SIGN BIT
      STA TMP1       AND KEEP IT TEMPORARILY
      LDB ACLBF     GET ADDRESS OF DISC DIRECTORY 
POL.2 LDA B,I       LOAD LU# FROM DISC DIRECTORY ENTRY
      SZA,RSS       END OF DIRECTORY? 
      JMP POL.4     YES - DIDN'T FIND LU# SO CLEAR FLAG 
      AND B77       MASK TO LU# 
      CPA TMP1      IS THIS IT? 
      JMP POL.5     YES - THIS FLAG IS VALID
      ADB .4        POSITION TO NEXT DIRECTORY ENTRY
      JMP POL.2      AND GO CHECK IT
* 
POL.4 LDA TMP1      CLEAR "TAKEN" FLAG BECAUSE THIS LU
      RAL,CLE,ERA    ISN'T IN THE CARTRIDGE DIRECTORY 
      STA PTR1,I    CHANGE ENTRY IN COPY OF DISC POOL 
      LDB PTR1      STUFF ADDRESS OF WORD TO BE 
      STB BUFAD      UPDATED INTO PLACE IN $SMVE CALL.
      JSB WDSPL     UPDATE DISC POOL
POL.5 ISZ PTR1      STEP TO NEXT DISC POOL ENTRY
      ISZ TMP2      INCREMENT POSITION COUNTER
      JMP POL.1      AND GO CHECK IT. 
* 
* 
* 
* IMPRD   MAKE AN IMPOSSIBLE READ TO A DISC UNIT TO GET 
*         GET NUMBER OF TRACKS ON IT OR THE # SECTORS PER TRACK.
*         IF DISC IS LU 2 OR LU 3 THESE VALUES ARE CALCULATED 
*          FROM BASE PAGE AND NO READ IS MADE.
* 
*         ENTRY - B-REG = LU# OF DISC 
* 
*         EXIT  - B-REG = # TRACKS ON THE SUBCHANNEL
*                 ERROR = #SECTORS PER TRACK
* 
*                 P+1 - DISC ERROR
*                 P+2 - OK
* 
* 
IMPRD NOP 
      CPB .2
      JMP LU.2
      CPB .3
      JMP LU.3
      CCE           SET UP FIRST WORD OF DOUBLE 
      RBL,ERB        WORD CONTROL WORD AS THE 
      STB TMP1        DISC LU WITH THE SIGN BIT SET 
      LDB PRC       SECOND WORD OF THE CONTROL
      STB TMP2       WORD IS JUST FMP PRIVILEDGED BITS
      JSB XLUEX     EXTENDED EXEC IMPOSSIBLE WRITE
      DEF *+7 
      DEF RDNAB 
      DEF TMP1      ON LU + PRC  --  NOT SWITCHED 
      DEF ERROR     BUFFER
      DEF .1        ONE WORD
      DEF N1        TRACK 10,000
DEF.0 DEF ZERO      SECTOR 0
      JMP IMR.2     ERROR RETURN - SKIP STEP TO P+2 
      JMP IMR.1     OK - STEP TO P+2
LU.2  LDA SECT2     GET SECTORS/TRACK 
      LDB TATSD     GET #TRACKS ON LU2
      JMP IMR.0 
LU.3  LDA SECT3     GET SECTORS/TRACK 
      LDB TATSD     #TRACKS ON LU 3 = -TATSD-TATLG
      ADB TATLG 
      CMB,INB 
IMR.0 STA ERROR 
IMR.1 ISZ IMPRD 
IMR.2 JMP IMPRD,I   RETURN
* 
* 
*  RESLV   RESOLVES INDIRECT ADDRESS
* 
*          ENTRY :  B-REG CONTAINS WORD TO BE RESOLVED
* 
*          EXIT  :  B-REG CONTAINS RESOLVED VALUE 
* 
* 
RESLV NOP 
      SSB,RSS 
      JMP RESLV,I 
      RBL,CLE,ERB 
      LDB B,I 
      JMP *-4 
      SPC 4 
* 
* 
* 
*    ACTIV    MARKS LU IN ALU ACTIVE OR INACTIVE IN DISCS MOUNTED LIST
* 
*             ENTRY : ALU CONTAINS LU# OF DISC TO BE MARKED ACTIVE OR 
*                     INACTIVE
* 
*                     A = 0  ACTIVATE 
*                     A = 1  INACTIVATE 
*                     MTDSC, IDSSW, DISCL ARE CALCULATED FOR CURRENT SCB
* 
* 
ACTIV NOP 
      STA TMP1      SAVE DIRECTION OF ACTIVE/INACTIVE 
      JSB GTSCB     READ IN A CLEAN COPY OF THE SCB 
      DEF *+5 
      DEF SM.BF 
      DEF .144
      DEF ERROR 
      DEF SESWD 
* 
      LDA DISCL     GET LENGTH OF DISCS MOUNTED LIST
      CMA,INA        MAKE NEGATIVE AND
      STA COUN1       USE AS A COUNTER
      LDB MTDSC     GET ADDRESS OF DISCS MOUNTED LIST 
ACT.1 LDA B,I       GET ENTRY 
      AND B377      MASK TO LU #
      CPA ALU       THIS THE ONE WE'RE LOOKING FOR? 
      JMP ACT.2     YES - GO MARK IT
      INB           NO - STEP POINTER 
      ISZ COUN1      INCREMENT THE COUNTER
      JMP ACT.1     LOOK AT NEXT ENTRY
      JMP ACTIV,I   DIDN'T FIND IT SO RETURN
* 
ACT.2 LDA TMP1      GET DIRECTION 
      ERA           GET LOWER BIT OF A INTO E-REG 
      LDA B,I       GET ENTRY AGAIN 
      ALF,RAR       PUT E-REG INTO BIT 13 OF A
      ERA,RAR 
      RAR 
      STA B,I 
* 
      LDA IDSSW,I   CALCULATE OFFSET PARAMETER
      CMA,INA        FOR WRITE OF THE MODIFIED
      ADA .2          DISCS MOUNTED LIST
      STA TMP1
      JSB $SMVE     WRITE MODIFIED DISCS MOUNTED
      DEF *+6        LIST BACK TO SCB 
      DEF .2
      DEF SESWD 
      DEF TMP1
      DEF MTDSC,I 
      DEF DISCL 
      JMP ACTIV,I    RETURN 
* 
      SKP 
* 
* 
* 
*  SPECF  SETS UP 16-WORD SPECIFICATION ENTRY FOR PENDING DISC
* 
*        ENTRY - ALU CONTAINS LU# OF THE DISC 
* 
*    NOTE:  IF THERE IS A DISC ERROR ON THE IMPOSSIBLE READ, SPECF
*           DOES NOT RETURN, IT JUMPS INTO THE CLNUP SECTION. 
* 
* 
* 
SPECF NOP 
      LDB .16       CLEAR OUT 16 WORDS TO BE
      CMB,INB        FOR CARTRIDGE SPECIFICATION
      STB COUN1     ENTRY 
      LDB ASMBF 
      CLA 
      STA B,I 
      INB 
      ISZ COUN1 
      JMP *-3 
      LDA IDENT,I   WAS ASCII IDENTIFIER SPECIFIED? 
      SZA 
      JMP SPEC1     YES 
      JSB CNUMD     NO - CONVERT TERMINAL LU TO 
      DEF *+3        ASCII AND USE
      DEF TRMLU       AS IDENTIFIER 
      DEF SM.BF 
      LDA WD1       REPLACE 1ST WORD WITH 
      STA SM.BF      CHARACTERS DC
      LDA SM.BF+1   CHANGE ANY ASCII
      IOR ASC0       BLANKS IN NEXT 
      STA SM.BF+1     TWO WORDS TO
      LDA SM.BF+2      ASCII ZEROS
      IOR ASC0
      STA SM.BF+2 
      JMP SPEC2 
* 
SPEC1 DLD IDENT,I 
      DST SM.BF 
      LDA IDENT 
      ADA .2
      LDA A,I 
      STA SM.BF+2 
SPEC2 LDA SM.BF 
      ADA SIGN
      STA SM.BF 
      LDB CODE      IF CODE = 3 AND A LABEL 
      LDA LABEL,I    WAS SPECIFIDE, CRN = LABEL,I 
      CPB .3          OTHERWISE CRN = ACRN. 
      SZA,RSS 
      LDA ACRN
      STA SM.BF+3 
      LDB ALU 
      JSB IMPRD     CALL TO GET # SECTORS PER TRACK ON ALU
      JMP CLNUP     DISC ERROR - GET THIS LU OUT OF THE SCB 
      LDA SECT,I    USE SECT\TRACK FROM IMPOSSIBLE READ IF
      SZA,RSS        NOT SPECIFIED BY THE CALLER
      LDA ERROR 
      STA SM.BF+6 
      LDA DIRTK     - # DIRECTORY TRACKS
      STA SM.BF+8 
      ADA SIZE      LAST FMP TRACK
      STA SM.BF+7 
      JMP SPECF,I 
* 
* 
      SKP 
* 
* 
* 
*   REMOV  REMOVES A DISC FROM THE DISCS MOUNTED LIST 
*          AND FROM THE SST IF NECESSARY
* 
*          ENTRY:  ALU CONTAINS LU# OF DISC TO BE REMOVED 
*                  FROM SCB.
*                  MTDSC, DISCL, IDSSW ARE CALCULATED FOR 
*                  CURRENT SESSION CONTROL BLOCK
* 
*          EXIT:   ALU IS REMOVED FROM DISCS MOUNTED LIST.  IF
*                  SIGN BIT SET ON THAT ENTRY, IT IS ALSO REMOVED 
*                  FROM THE SST.  DISCS MOUNTED COUNTER IS DECREMENTED. 
* 
* 
REMOV NOP 
      JSB GTSCB     READ CLEAN COPY OF
      DEF *+5        SCB IN CASE SST HAS
      DEF SM.BF       BEEN CHANGED
      DEF .144
      DEF ERROR 
      DEF SESWD 
* 
      LDA DISCL     GET # DISCS IN DISCS MOUNTED
      CMA,INA        LIST; MAKE NEGATIVE AND
      STA COUN1       USE AS A COUNTER
      LDB MTDSC 
REM.1 LDA B,I       GET ENTRY 
      RAL,CLE,ERA   BIT 15 TO E-REGND 15 AND
      AND B377      MASK TO LU
      CPA ALU       IS THIS THE ONE?
      JMP REM.2     YES 
      INB           NO - STEP TO NEXT ENTRY 
      ISZ COUN1     INCREMENT COUNTER 
      JMP REM.1      AND GO TRY IT
      JMP REMOV,I   NOT THERE SO JUST RETURN
* 
REM.2 CLA           CLEAR ENTRY IN
      STA B,I        DISCS MOUNTED LIST 
      SEZ,RSS       FLAG WASN'T SET SO
      JMP REM.5      DON'T REMOVE FROM SST
      LDB IDSSW     GET SST LENGTH WORD 
      LDA B,I        (IT'S NEGATIVE) AND
      STA COUN1       USE AS A COUNTER
      INB           STEP TO SST ENTRIES 
* 
REM.3 LDA B,I       GET ENTRY 
      INA           (LU'S IN SST ARE SAVED AS LU - 1) 
      AND B377      MASK TO SYSTM LU# 
      CPA ALU       IS THIS THE ONE?
      JMP REM.4     YES 
      INB           NO - STEP TO NEXT ENTRY 
      ISZ COUN1     INCREMENT COUNT 
      JMP REM.3      AND GO TRY IT
      JMP REM.5     NOT THERE 
* 
REM.4 LDA N1        FREE UP ENTRY IN
      STA B,I        SST
REM.5 LDB MTDSC     DECREMENT DISCS MOUNTED 
      ADB N1         COUNTER
      LDA B,I 
      ADA N1
      STA B,I 
* 
      JSB $SMVE     CALL $SMVE TO UPDATE SCB
      DEF *+6 
      DEF .2
      DEF SESWD 
      DEF ZERO
      DEF IDSSW,I 
      DEF LNGTH 
* 
      JMP REMOV,I 
* 
      SKP 
* 
* 
* 
*  ADD   ADDS A DISC TO THE DISCS MOUNTED LIST
*        AND ADDS AN ENTRY FOR IT IN THE SST IF ONE 
*        IS NOT ALREADY THERE.
*        DECREMENTS NUMBER-OF-DISCS-MOUNTED COUNTER 
* 
*        ENTRY:  ALU CONTAINS LU# OF DISC TO BE ADDED TO
*                THE SCB
*                MTDSC, DISCL, IDSSW ARE CALCULATED FOR CURRENT 
*                SESSION CONTROL BLOCK. 
* 
*        EXIT:   ALU IS ADDED TO THE DISCS MOUNTED LIST.  IF NOT
*                IN THE SST, IT IS ALSO ADDED THERE.  DISCS MOUNTED 
*                COUNTER IS DECREMENTED.
* 
*                P+1   ERROR RETURN   SST CONFLICT  CAN'T ADD ALU 
*                P+2   SUCCESSFUL RETURN
* 
* 
* 
ADD   NOP 
      CLA 
      STA TMP1      HOLDS ADDRESS OF 1ST EMPTY ENTRY FOUND IN SST 
      STA FLAG      INDICATES IF ALU WAS ALREADY IN SST 
      JSB GTSCB     READ NEW COPY OF SCB
      DEF *+5        IN CASE SST HAS CHANGED
      DEF SM.BF 
      DEF .144
      DEF ERROR 
      DEF SESWD 
* 
      LDB IDSSW     GET SST LENGTH WORD 
      LDA B,I        (IT'S NEGATIVE) AND
      STA COUN1       USE AS A COUNTER
      INB 
      STB TMP2      KEEP AROUND ADDR OF 1ST SST ENTRY 
ADD.1 LDA B,I       GET SST ENTRY 
      CPA N1        EMPTY?
      STB TMP1      YES - KEEP ADDRESS FOR SPOT TO ADD
      ALF,ALF       SHIFT AND MASK
      CLE,INA       (LU'S IN SST ARE SAVED AS LU - 1) 
      AND B377       TO SYSTEM LU 
      CPA ALU       IS THIS THE ONE?
      CCE           YES - SET E = 1 IF SYSTEM LU MATCHES
      LDA B,I       GET ENTRY AGAIN 
      INA           (LU'S IN SST ARE SAVED AS LU - 1) 
      AND B377      MASK TO SESSION LU# 
      SEZ,RSS       (LU'S IN SST ARE SAVED AS LU - 1) 
      JMP ADD.2 
      CPA ALU       IS THIS SESSION LU SAME AS ALU? 
      JMP ADD.3     SYS = SES = ALU   DON'T ADD TO SST
ADD.2 CPA ALU 
      JMP ADD.6     SES = ALU # SYS  ERROR ALU IS ANOTHER SES LU
      INB           STEP TO NEXT ENTRY
      ISZ COUN1     INCREMENT COUNT 
      JMP ADD.1      AND TRY NEXT ENTRY 
* 
      LDB TMP1      GET EMPTY SPOT ADDRESS
      SZB,RSS       DID WE FIND ONE?
      JMP EX66      NO - SST'S FULL 
      LDA ALU       YES - SET UP ENTRY WITH 
      ADA N1        SUBTRACT 1 TO GET IN SST LU FORMAT
      ALF,ALF        ALU AS SYSTEM AND SESSION
      ADA ALU         LU #'S AND STUFF IT IN SST
      ADA N1        SUBTRACT 1 TO GET IN SST LU FORMAT
      STA B,I 
      LDA SIGN      SET UP TO SET SIGN BIT IN ENTRY 
      STA FLAG       IN DISCS MOUNTED LIST
* 
ADD.3 LDA DISCL     GET #ENTRIES IN DISCS MOUNTED 
      CMA,INA        LIST; MAKE NEGATIVE
      STA COUN1      AND USE AS A COUNTER 
      LDB MTDSC 
ADD.4 LDA B,I       GET ENTRY FROM DISCS MOUNTED LIST 
      SZA,RSS       EMPTY?
      JMP ADD.5     YES - CAN USE THIS ONE
      INB           NO - STEP TO NEXT ENTRY 
      ISZ COUN1 
      JMP ADD.4 
      JMP EX63      DISCS MOUNT LIST IS FULL! 
* 
ADD.5 LDA ALU       GET LU# 
      ADA FLAG      ADD POSSIBLE SIGN BIT 
      ADA P/G       SET BIT 14 IF MOUNTED AS GROUP
      STA B,I        AND STORE IN DISCS MOUNTED LIST
      LDB MTDSC     INCREMENT # DISCS 
      ADB N1         MOUNTED COUNTER
      LDA B,I 
      INA 
      STA B,I 
* 
      JSB $SMVE     CALL $SMVE TO UPDATE SCB
      DEF *+6 
      DEF .2
      DEF SESWD 
      DEF ZERO
      DEF IDSSW,I 
      DEF LNGTH 
* 
      ISZ ADD 
ADD.6 JMP ADD,I 
* 
      SKP 
* 
* 
* 
*  FREE   CLEARS BUSY BIT ON ENTRY FOR ALU
*         IF NOT THERE, JUST RETURN 
* 
*         ENTRY:  ALU CONTAINS LU# TO BE FREED
* 
* 
FREE  NOP 
      CLA           CLEAR COUNTER FOR NUMBER OF 
      STA TMP2       ENTRIES PASSED SO FAR IN POOL. 
      JSB RDSPL     READ DISC POOL INTO BUFFER SM.BF
      LDB ASMBF     GET STARTING ADDRESS OF DISC POOL 
FRE.1 LDA B,I       GET DISC POOL ENTRY 
      CPA N1        END?
      JMP FREE,I    END OF THE DISC POOL SO RETURN
      RAL,CLE,ERA   GET RID OF POSSIBLE SIGN BIT
      CPA ALU       IS THIS THE ONE?
      JMP FRE.2     YES 
      INB           NO - STEP TO NEXT ENTRY 
      ISZ TMP2      INCREMENT POSITION COUNTER
      JMP FRE.1      AND GO CHECK IT
* 
FRE.2 STA B,I       UPDATE CHANGED ENTRIES IN POOL COPY 
      STB BUFAD     STUFF ADDRESS OF WORD TO BE UPDATED 
      JSB WDSPL     GO UPDATE THIS WORD IN REAL DISC POOL 
      LDA RTFLG     DISC HAS BEEN RETURNED
      CCE            TO DISC POOL SO SET
      RAL,ERA         SIGN BIT ON DISC LU 
      STA RTFLG        AS A FLAG. 
      JMP FREE,I    RETURN
* 
* 
* 
*   ALLOC   SET BUSY BIT ON ENTRY FOR ALU 
*           IF NOT THERE, JUST RETURN 
* 
*        ENTRY:  ALU CONTAINS LU# TO BE ALLOCATED 
* 
* 
ALLOC NOP 
      CLA           CLEAR COUNTER FOR NUMBER OF 
      STA TMP2       ENTRIES PASSED SO FAR IN POOL
      JSB RDSPL     READ DISC POOL INTO BUFFER SM.BF
      LDB ASMBF     GET STARTING ADDERSS OF DISC POOL COPY
ALL.1 LDA B,I       GET DISC POOL ENTRY 
      CPA N1        END?
      JMP ALLOC,I   YES - JUST RETURN 
      CPA ALU       IS THIS THE ONE?
      JMP ALL.2     YES 
      INB           NO - STEP TO NEXT ENTRY 
      ISZ TMP2      INCREMENT POSITION COUNTER
      JMP ALL.1      AND GO CHECK IT
ALL.2 ADA SIGN      ADD SIGN BIT TO LU# 
      STA B,I       STORE LU# + FLAG BACK IN DISC POOL COPY 
      STB BUFAD     STUFF ADDRESS OF WORD TO BE UPDATED 
      JSB WDSPL     UPDATE ENTRY IN REAL DISC POOL
      JMP ALLOC,I   RETURN
* 
* 
* 
*   RDSPL   READ DISC POOL INTO BUFFER SM.BF
* 
* 
RDSPL NOP 
      XLA $DSCS     GET STARTING ADDRESS OF DISC POOL 
      ADA N1        IF $DSCS IS 0 OR LESS THAN 0
      SSA,RSS        THEN THERE IS NO DISC POOL OR
      JMP RD.1        IT IS EMPTY SO SKIP READ
      CCB           PUT A -1 IN FIRST WORD OF DISC POOL 
      STB SM.BF      BUFFER TO MAKE ROUTINES THINK IT'S THE END 
      JMP RDSPL,I     AND RETURN
RD.1  JSB $SMVE 
      DEF *+6 
      DEF .1        READ
      DEF $DSCS     ADDRESS OF DISC POOL
      DEF ZERO      NO OFFSET 
      DEF SM.BF     READ INTO BUFFER
      DEF .64       64 WORDS
      JMP RDSPL,I 
* 
* 
* 
*   WDSPL   UPDATE AN ENTRY IN THE DISC POOL
* 
*           WDSPL IS NEVER CALLED UNLESS THERE REALLY IS
*           A DISC POOL.
* 
* 
*       ENTRY:  BUFAD CONTAINS ADDRESS OF WORD TO BE UPDATED
*               TMP2  CONTAINS OFFSET IN DISC POOL WHERE ENTRY IS 
*                              TO BE REPLACED 
* 
* 
WDSPL NOP 
      JSB $SMVE 
      DEF *+6 
      DEF .2
      DEF $DSCS 
      DEF TMP2
BUFAD NOP 
      DEF .1
      JMP WDSPL,I 
      SKP 
* 
* 
* 
*  SCAN   SCANS THE DISCS MOUNTED LISTS OF EACH ACTIVE SCB
*         TO MAKE SURE THE LU# TO BE DISMOUNTED IS NOT MOUNTED
*         TO ANYONE ELSE. 
* 
*         ENTRY:  ALU CONTAINS LU# TO SEARCH FOR
*                 $SHED IS DECLARED AN EXTERNAL 
* 
*         EXIT:   BUF IS GARBAGE
*                 P+1 FOUND AT LEAST ONE OTHER SCB THAT HAS 
*                     ALU MOUNTED TO IT 
*                 P+2 NONE WERE FOUND 
* 
* 
SCAN  NOP 
      XLA $SHED     GET LIST HEADER 
      STA PTR1
SCAN1 CPA ZERO      END OF LIST?
      JMP SCAN4     YES - NONE WERE FOUND 
      LDB $SMLK     OFFSET FROM SST LENGTH TO LINK WORD 
      CMB,INB       MAKE POSITIVE 
      ADA B         ADD TO LINK WORD
      STA TMP1      HAVE EQUIVALENT TO SESSION WORD 
      LDB SESWD     IF THIS IS OUR OWN
      CPB A          SCB THEN DON'T 
      JMP SCAN3       SCAN IT 
* 
      JSB $SMVE     READ DISC LIMIT WORD
      DEF *+6        AND SST LENGTH WORD
      DEF .1
      DEF TMP1
      DEF $SMDL 
      DEF SM.BF 
      DEF .2
* 
      LDA SM.BF     SAVE DISC LIMIT 
      STA COUN1 
      LDA SM.BF+1   GET SST LENGTH WORD 
      CMA,INA       MAKE POSITIVE AND ADD 
      ADA .2         TWO (FOR 2 LENGTH WORDS) 
      STA TMP2      HAVE OFFSET FROM SST LENGTH TO 1ST WORD 
*                                    OF DISCS MOUNTED LIST
      JSB $SMVE     READ DISCS
      DEF *+6        MOUNTED LIST 
      DEF .1
      DEF TMP1
      DEF TMP2
      DEF SM.BF 
      DEF COUN1 
* 
      LDA COUN1     MAKE LENGTH OF DISCS
      CMA,INA        MOUNTED LIST A 
      STA COUN1       NEGATIVE COUNTER
      LDB ASMBF 
SCAN2 LDA B,I       GET ENTRY 
      AND B377      GET RID OF POSSIBLE SIGN BIT
      CPA ALU       IS THIS ALU?
      JMP SCAN,I    YES - FOUND AT LEAST ONE OTHER PLACE ALU MOUNTED
      INB           STEP TO NEXT ENTRY
      ISZ COUN1     INCREMENT COUNTER AND 
      JMP SCAN2      GO CHECK IT
* 
SCAN3 JSB $SMVE     DONE WITH THIS SCB
      DEF *+6        CHASE CHAIN TO 
      DEF .1          THE NEXT SCB
      DEF TMP1
      DEF $SMLK 
      DEF PTR1
      DEF .1
      LDA PTR1
      JMP SCAN1 
* 
SCAN4 ISZ SCAN      ALL THE WAY THRU AND DIDN'T 
      JMP SCAN,I     FIND ALU MOUNTED ANYWHERE ELSE 
* 
* 
* 
EXN1  LDA N1
      RSS 
EX12  LDA .12 
      RSS 
EX50  LDA .50 
      RSS 
EX53  LDA .53 
      RSS 
EX54  LDA .54 
      RSS 
EX56  LDA .56 
      RSS 
EX62  LDA .62 
      RSS 
EX63  LDA .63 
      RSS 
EX64  LDA .64 
      RSS 
EX65  LDA .65 
      RSS 
EX66  LDA .66 
EXIT  STA ER,I
      LDB ALU       PRESET FOR MOUNT CALL 
      CMB,INB       PUT -LU# IN B-REG 
      LDA DCFLG     GET FUNCTION CODE 
      SSA           WAS THIS A DISMOUNT INSTEAD?
      LDB RTFLG     YES - GET DISMOUNT RETURN 
      LDA DEF.0     CLEAR OUT INCOMING PARAMETERS 
      STA ER         FOR THE NEXT CALL TO DCMC
      STA CODE
      STA DISID 
      STA P/G 
      STA SIZE
      STA IDENT 
      STA DIRTK 
      STA LABEL 
      STA SCBCD 
      STA SECT
      LDA ACRN
      JMP DCMC,I
      END 
                                                                                                                      