ASMB,R
*USE 'ASMB,R,N' (RTE-M II) OR 'ASMB,R,Z' (RTE-M III)
* 
*     IFN OPTION
*     NAME:   $MCL
*     SOURCE: 92064-18023 
*     RELOC:  92064-16011 
*     PROGMR: E.J.W.
* 
*     IFZ OPTION
*     NAME  : $MCL3 
*     SOURCE: 92064-18023 
*     RELOC:  92064-16015 
*     PROGMR: E.J.W.
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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.        * 
*  **************************************************************** 
* 
* 
      IFN 
* BEGIN NON-DMS CODE ***************
      NAM $MCL,0  92064-16011  REV.1808  771028 
*** END NON-DMS CODE ***************
      XIF 
      IFZ 
***** BEGIN DMS CODE ***************
      NAM $MCL3,0  92064-16015  REV.1808  771028
******* END DMS CODE ***************
      XIF 
* 
* 
      ENT $S.CL,$I.CL,$C.CL,$G.CL 
      EXT $IDNO,$CLAS,$BLUP,$QCHK,$ALC,$LIST,$XEQ 
      EXT $SCD3,$RTN,$ERAB
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ***************
      EXT .MVW
*** END NON-DMS CODE ***************
      XIF 
      SPC 1 
* 
A     EQU 0 
B     EQU 1 
* 
* 
$S.CL NOP           START-UP INITIALIZATION 
      LDA DCLAS     GET DIRECT ADDR 
      RAL,CLE,SLA,ERA    OF SYSTEM POINTERS 
      LDA A,I 
      STA DCLAS     CLASS TABLE POINTER 
      CMA,INA 
      STA MCLAS     NEGATIVE OF CLASS TABLE PTR 
      JMP $S.CL,I   DONE
      HED ** RTE-M CLASS I/O MODULE  -  INITIATION CALL **
* 
* 
*     CLASS I/O  ALLOCATE CLASS FROM HIGH END OF TABLE
*                IF HE DID NOT SPECIFY A CLASS. 
* 
*      LDA WORD2     (A) = CONTROL WORD 
*      LDB TEMP6     (B) = BUFFER PRIORITY OF REQUEST 
*     JSB $I.CL     CALL FROM $MIO MODULE 
*     <JMP L.10>    P+1: DO NORMAL UNBUFFERED I/O 
*     <STA TEMP1>   P+2: (A) = ADDR OF NEW I/O BLOCK
*     JMP L.132      DO THE I/O, CLASS QUEUED ALREADY 
* 
$I.CL NOP           CALLED BY $MIO MODULE 
      STA WORD2     SAVE CONTROL WORD 
      STB BPRIO 
      LDA RQP1      GET ORIGINAL REQUEST CODE 
      AND B17       KEEP ONLY LOW 4 BITS
      STA RQPX      SAVE CLASS REQUEST CODE 
      STA B 
      CLA,CLE       E=0 IF USE OLD CLASS NUMBER 
      STA XA,I      A=0 FOR INIT.GOOD RETURN
      LDA RQP7       ADDR FROM THE REQUEST
      CPB .3        IF CONTROL REQUEST (19) 
      LDA RQP4       USE THE CONTROL CLASS WORD 
      SZA,RSS       IF CLASS WORD ADDR = 0
      JMP ERR01      FLUSH IT OUT.
      STA TEMP3     SAVE ADDR OF CLASS WORD 
      LDA B160K      GET BITS 15,14, AND 13 FROM
      AND TEMP3,I     USER'S CLASS WORD 
      STA SECCD 
L.025 LDA TEMP3,I   GET CLASS WORD
      STA CLASS     SET THE CLASS WORD
      AND B377      MASK TO THE CLASS DEF.
      STA B          SAVE CLASS NUMBER IN B 
      CMA,INA,SZA   IF SUPPLIED 
      JMP L.021     SKIP ALLOCATION CODE
* 
* 
*     ALLOCATE A CLASS FROM THE HIGH END OF THE TABLE 
* 
      LDB XEQT      GET ID SEG ADDR 
      JSB $IDNO      CONVERT TO ID #
      LDA B37        FOR USE AS SECURITY CODE 
      AND B 
      ALF,ALF 
      IOR SECCD     FILL IN USER'S BIT15,14,13
      STA TEMP3,I    FOR RETURN AS CLASS NUMBER 
* 
      LDA $CLAS     GET THE LENGTH OF THE TABLE 
      SZA,RSS       IF NO CLASSES DEFINED 
      JMP ERR00      REJECT THE CALL
      ADA DCLAS     ADD THE TABLE ADDRESS 
* 
L.022 LDB A,I       GET THE ENTRY TO B
      CCE,SZB,RSS   IF FREE (0) 
      JMP L.023     GO USE IT 
      ADA N1        NO STEP TO NEXT ONE 
      CPA DCLAS     END OF TABLE? 
      CCA,RSS       YES SKIP (A = -1) 
      JMP L.022     NO - GO TEST NEXT ONE.
* 
L.026 STA XA,I      SET REASON FOR REJECT IN A REG. 
      LDB DCLAS     SET B=CLASS TABLE ADDR
      LDA CLASS      FOR L.013 IN CASE OF SUSPEND 
      SSA           NO-WAIT REQUESTED?
      JMP L.16       NO, GIVE NO CLASS STATUS 
      JMP L.013      YES, SUSPEND UNTIL CLASS AVAILABLE 
* 
L.023 LDB A         SET B TO ADR OF CLASS QUEUE WORD
      ADA MCLAS     SUBTRACT THE CLASS TABLE ADDRESS
      IOR TEMP3,I    ADD SECURITY CODE AND USER BIT 
      STA TEMP3,I   RETURN NEW CLASS WORD TO USER 
      AND B174C     GET SECURITY CODE FOR CLASS QUEUE-HEAD
      RAL,ERA        SET THE ALLOCATED BIT
      STA B,I       PUT INTO CLASS QUEUE
      CCE           SET E=1 AGAIN FOR NEW ALLOC 
      JMP L.025     GO SET UP 
* 
L.021 ADB DCLAS     USE CLASS# (IN B) TO INDEX AND
      STB PTR       SET POINTER TO TABLE
      STA B 
      LDA CLASS     GET CLASS WORD
      AND B174C      SAVE REAL SECURITY CODE
      STA SECCD 
      LDA PTR,I     GET CONTENTS
      SEZ,CLE,RSS   IF NOT NEW ALLOCATION 
      SZA            AND NOT ALLOCATED, FORCE ERROR 
      ADB $CLAS     IF OUTSIDE OF TABLE 
      CLB,SEZ,RSS    THEN 
      JMP ERR00     SEND ERROR 'IO00' 
* 
      LDA PTR 
L.13A STA B         SET B TO ADDR OF QUEUE ENTRY
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      SSA,RSS       A POINTER?
      JMP L.13A      YES, TRACE IT MORE 
* 
      AND B174C     GET SECURITY CODE FROM QUEUE
      CPA SECCD     COMPARE IT WITH USER'S
      RSS           DOES IT MATCH?
      JMP ERR00      NO, ERROR 'IO00' 
* 
      STB SECCD     SAVE QUEUE ENTRY ADDR IN SECCD
* 
* AUTOMATIC BUFFERING SECTION 
* 
      CLA 
      STA TMP6      CLEAR 2ND BUFF SIZE 
      LDB RQP4,I
      CLE,SSB,RSS   BUFFER HAS -CHAR SIZE ? 
      JMP L.028      NO, SKIP BUFF SIZE CONVERT 
* 
      BRS            YES, CONVERT TO +WORDS 
      CMB,INB 
L.028 STB TMP8      SAVE +WORDS BUFF SIZE 
* 
      LDB RQPX      GET THE MASKED REQUEST CODE 
*                   USE 5 WORDS FOR CONTROL REQUEST 
      CPB .3       IF REQUEST IS FOR -CONTROL-, 
      JMP L.03      SKIP BUFFER SIZE CHECK. 
* 
      LDA TMP8      GET THE XFER LENGTH 
      STA TEMP3     -SET AS MOVE INDEX- 
      LDB RQP2,I    IF DOUBLE BUFFER REQUEST
      BLF,SLB       THEN
      RSS 
      JMP L.03
* 
      CLA           CLEAR (A) IN CASE RQP6=0
      LDB RQP6,I
      SSB,RSS       2ND BUFFER SIZE NEGATIVE? 
      JMP L.029      NO, SKIP 2ND BUFF SIZE CONVERT 
* 
      BRS            YES, CONVERT TO +WORDS 
      CMB,INB 
L.029 LDA B 
      ADA TMP8       ADD 1ST BUFF SIZE
      STB TMP6      SAVE 2ND BUFF SIZE
L.03  ADA .8       ADD 8 FOR BLOCK CONTROL WORDS. 
      STA L.04       AND SET UP IN CALL 
* 
      LDA N41       IF PRIORITY LT 41,
      ADA BPRIO 
      SSA 
      JMP L.031      THEN SKIP BUFFER LIMIT TEST
* 
      LDB $BLUP     CHECK IF BEYOND THE LIMIT IN WORDS
      JSB $QCHK     ON THIS DEVICE
      JMP L.040     YES GO CHECK FOR CLASS RQ 
* 
* ALLOCATE BLOCK IN TEMPORARY STORAGE 
* 
L.031 JSB $ALC     CALL AT SYSTEM ENTRY POINT 
L.04   NOP          - REQUESTED LENGTH OF BLOCK - 
       JMP ERR04    NEVER ANY MEMORY, REJECT. 
       JMP L.042    NO MEMORY NOW, SUSPEND. 
      JMP L.06       ALLOCATION OK. 
* 
L.040 LDA CLASS     IF CLASS AND NO SUSP. 
      SSA,RSS       ON BUFFER LIMIT SKIP TO EXIT
      JMP L.013     ELSE GO SUSPEND 
* 
* NO MEMORY AVAILABLE FOR BLOCK - CALLING USER
*  PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION 
*  $LIST AND RE-SCHEDULED AT POINT OF REQUEST 
*  WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. 
* 
L.042 LDA N2        IF CLASS I/O CHECK
      LDB CLASS     FOR NO SUSP OPTION
      SSB            IF SET 
      JMP L.026     GO SET FLAG AND EXIT
* 
      JSB $LIST    CALL TO LINK PROGRAM INTO
       OCT 504      MEMORY SUSPENSION LIST. 
      JMP $XEQ
* 
* 
SECCD NOP 
N41   DEC -41 
* 
* 
*  SET REQUEST PARAMETERS, PROGRAM PRIORITY AND 
*   USER BUFFER INTO TEMPORARY BLOCK. 
* 
L.06  STB L.04     SET ACTUAL BLOCK LENGTH. 
      STA BADDR    SAVE BLOCK FOR USE IN LINK CALL
      CCE,INA 
      STA B          SAVE ADDRESS 
      LDA WORD2     GET CONTROL WORD
      IOR B140K     SET THE <T> FIELD TO 3
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       AND SET IN WORD 2 OF BLOCK. 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       AND SET IN WORD 2 OF BLOCK. 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      INB 
      LDA BPRIO    SET REQ PRIORITY (=1 IF LU LOCKED) 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       IN WORD 3.
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       IN WORD 3.
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      INB 
      LDA L.04     SET BLOCK LENGTH IN
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       WORD 4. 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       WORD 4. 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      INB 
      LDA CLASS     SET THE CLASS 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       WORD 5. 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       WORD 5. 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      INB            THE BUFFER 
* 
L.061 LDA RQP4,I   SET USER BUFFER LENGTH 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       IN WORD 6.
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       IN WORD 6.
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      CMA,CLE,INA   SET E IF ZERO LENGTH BUFFER 
      LDA RQP5,I    GET FIRST OPTIONAL WORD 
      INB           STEP TO STORE LOCATION
      STB TEMPW     SAVE THE ADDRESS OF THE LOCATION
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       SET IT
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       SET IT
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      INB           SET FOR NEXT WORD 
      LDA RQP6,I    GET SECOND OPTIONAL WORD
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       SET IT IN THE BUFFER
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       SET IT IN THE BUFFER
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      LDA RQP1
      CPA B23       IF CLASS CONTROL,GO 
      JMP L.078     FINISH ITS SET UP 
      CPA B21       IF CLASS READ 
      ADB TMP8       ADJUST BUFF ADDR FOR DOUBLE BUF. 
      SEZ,CLE,INB,RSS  IF LENGTH = 0, 
      CPA B21          OR CLASS READ
      JMP L.075        SKIP BUFFER MOVE.
* 
* MOVE USER BUFFER TO TEMPORARY BLOCK.
* 
      LDA RQP3     SET USER BUFFER
L.065 EQU *         ADDRESS FOR MOVE. 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      JSB .MVW
       DEF TEMP3
       NOP
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      LDX TEMP3     GET # WORDS TO MOVE 
      MWI           MOVE INTO SYSTEM MAP
******* END DMS CODE ************** 
      XIF 
      SPC 1 
* 
L.075 LDA TMP6      GET LENGTH OF SECOND BUFFER 
      STA TEMP3     SET FOR MOVE
      LDA RQP2,I    GET THE REQUEST CONTROL WORD
      ALF,SLA       IF FIRST TIME AND DOUBLE BUFFER 
      SEZ,CCE       SKIP
      JMP L.13      ELSE CONTINUE 
* 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STB TEMPW,I   SET BUFFER ADDRESS IN REQUEST 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSB TEMPW,I   SET BUFFER ADDRESS IN REQUEST 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      LDA RQP5      GET USER BUFFER ADDRESS 
      JMP L.065     GO MOVE THE BUFFER
L.078 ADB N2        CORRECT B REG 
* 
L.08  LDA  RQP3,I  FOR CONTROL REQUEST, SET WORD 3
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STA B,I       (PARAM) IN PLACE OF RECORD
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XSA B,I       (PARAM) IN PLACE OF RECORD
******* END DMS CODE ************** 
      XIF 
      SPC 1 
* 
*     CLASS I/O SO SET THE CLASS QUEUE TO SHOW
*     ANOTHER REQUEST IS PENDING. 
* 
L.13  EQU * 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      ISZ SECCD,I 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA SECCD,I 
      INA           INCREMENT CLASS QUEUE COUNT BY 1
      XSA SECCD,I 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      LDA BADDR     RETURN ADDR OF NEW BLOCK
      ISZ $I.CL     INCRE RETURN FOR CLASS I/O INIT.
L.10  JMP $I.CL,I   RETURN TO $MIO
* 
L.013 STB XTEMP,I   SET 4 IN WORD1 OF TEMPS 
      JSB $LIST      PUT PROG IN WAIT 
       OCT 503       UNTIL DEVICE COMES UP
      JMP $XEQ      EXIT THROUGH $MDI 
* 
L.16  LDA RQRTN     UPDATE THE
      STA XSUSP,I    RETURN ADDR
      JMP $XEQ       AND EXIT VIA $MDI
* 
      SKP 
      SPC 3 
* 
WORD2 NOP 
RQPX  NOP 
CLASS NOP 
DCLAS DEF $CLAS     CONFIGURED TO BE DIRECT.
MCLAS NOP           CONFIGURED TO BE NEGATIVE OF ABOVE. 
B174C OCT 17400     BITS 8-12 
N8    DEC -8
N2    DEC -2
N1    DEC -1
.2    DEC 2 
.3    DEC 3 
.5    DEC 5 
.8    DEC 8 
B17   OCT 17
B21   OCT 21
B23   OCT 23
B37   OCT 37
B377  OCT 377 
B140K OCT 140000
B160K OCT 160000
* 
BADDR NOP 
TEMP3 NOP 
TEMP4 NOP 
BPRIO NOP 
TEMPW NOP 
TLOG  NOP 
STAT  NOP 
TMP6  NOP 
TMP8  NOP 
      SPC 2 
      SKP 
      HED ** RTE-M CLASS I/O MODULE  -  COMPLETION CALL **
*     CLASS REQUEST COMPLETION
* 
*     CLASS COMPLETION IS HANDLED AS FOLLOWS: 
* 
*     1.  THE EXCESS BUFFER IS RETURNED ON WRITE COMPLETION 
*     2.  IF THE CLASS QUEUE IS NOT EXPECTING A REQUEST 
*         THE WHOLE BUFFER IS RELEASED AND WE EXIT. 
*     3.  IF A PROGRAM IS WAITING FOR THE REQUEST IT IS 
*         RESCHEDULED.
*     4.  THE REQUEST IS MODIFIED TO PUT THE STATUS WORD
*         AND THE TRANSMISSION LOG (TLOG) IN WORDS
*         3 (PRIORITY) AND 6 (USER LENGTH WORD) 
*     5.  THE CLASS QUEUE IS UPDATED AND WE EXIT. 
* 
*     SEE DESCRIPTION OF CLASS QUEUE IN COMMENTS AT BEGINNING 
*     OF SECTION ON USER REQUESTS.
* 
*     LDA TLOG           (A) = TRANSMISSION LOG 
*     LDB XXXXX          (B) = CLASS QUEUE POINTER  
*     JSB $C.CL           CALL FROM $MIO
*     DEF TEMP3               DRIVER STATUS RETURN
*     <JMP L.501>        RETURN. EITHER DO NEXT OR RETURN 
* 
* 
* 
$C.CL NOP 
      STA TLOG      SAVE TRANSMISSION LOG 
      STB PTR 
      INB 
      LDA B,I       GET THE CON WORD
      ADB .2        STEP TO LENGTH WORD 
      STB CLTMP     SET LENGTH ADDRESS
      SLA           IF READ 
      JMP C.03      SKIP RETURN 
* 
      LDA B,I       GET BLOCK SIZE TO A.
      ADB .5        STEP TO RETURN BUFFER ADDRESS 
      ADA N8        SUBTRACT SIZE OF OVERHEAD 
      STA CLRTN     SET RETURN SIZE 
      ADA N2        IF LESS THAN TWO WORDS
      SSA           THEN SKIP 
      JMP C.03      THE RETURN
* 
      STB CARTN     SET THE BUFFER ADDRESS
      JSB $RTN      RETURN THE WRITE BUFFER 
CARTN  NOP           BUFFER ADDRESS 
CLRTN  NOP           BUFFER LENGTH
* 
      LDA CLRTN     SET THE 
      CMA,INA       NEW BLOCK SIZE
      ADA CLTMP,I   IN THE BLOCK
      STA CLTMP,I   SET THE NEW SIZE
* 
C.03  ISZ CLTMP     STEP TO CLASS WORD
      LDA CLTMP,I   GET THE CLASS 
      AND B377      COMPUTE THE 
      ADA DCLAS     CLASS HEAD ADDRESS
* 
C.04  LDB A,I       GET THE CONTENTS OF CLASS HEAD. 
* 
      CLE,SSB,RSS   IF POSITIVE 
      JMP C.08      GO TRACK DOWN THE QUE.
* 
      STA CLASS     SAVE THE CLASS QUEUE ADDRESS
      RBL,CLE,ELB   IF PROGRAM WAITING
      SEZ,CLE,RSS 
      JMP C.05      SKIP,ELSE GO LINK IN THE RQ.
* 
*     PROGRAM IS WAITING, CLEAR THE WAIT FLAG 
*     AND RESCHEDULE THE PROGRAM
* 
      ERB,RBR       CLEAR THE WAIT FLAG 
      STB A,I       AND RESET IN THE QUEUE. 
* 
      JSB $SCD3     SCHEDULE ANY PROGRAMS WAITING 
C.05  LDB CLASS,I   GET CURRENT END OF LIST 
      ADB N1        SUBTRACT ONE PENDING REQUEST
      STB PTR,I     SET IN NEW END OF LIST
      LDB PTR       SET NEW ELEMENT IN
      STB CLASS,I   THE LIST. 
* 
      ISZ PTR       STEP TO 
      ISZ PTR       PRIORITY ADDRESS
      ISZ CLTMP     STEP TO BUFFER LENGTH WORD
      LDA EQT5,I    GET CURRENT STATUS
      ALR,RAL       CLEAR DOWN/BUSY BITS. 
      LDB $C.CL,I   GET WHERE -FROM FLAG AND STAT 
      LDB B,I 
* 
      CMB,CLE,INB   IF BAD COM CODE 
      CME           SET BIT 14
      ERA,CLE,RAR   ROTATE TO CORRECT POSITION
      LDB TLOG      GET THE TRANSMISSION LOG. 
      STA PTR,I     SET THE STATUS WORD 
      STB CLTMP,I   AND THE TLOG
      ISZ $C.CL     ADJUST RETURN 
      JMP $C.CL,I   RETURN TO $MIO MODULE 
* 
C.08  LDA B         TRACK DOWN
      JMP C.04      THE END OF THE LIST 
* 
      SKP 
      HED ** RTE-M CLASS I/O MODULE  -  GET CALL ** 
*     $G.CL IS THE ENTRY POINT FOR A 'GET' EXEC CALL
* 
*     JMP $G.CL     CALL FROM $MEX
* 
* 
$G.CL EQU * 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      UJP *+2       ENABLE USER MAP 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      LDA RQP2,I    GET THE CLASS 
      AND B377      MASK
      STA B         SAVE AND
      CMA,CLE,INA,SZA,RSS     IF CLASS=0
      CLE,RSS                 SEND "IO00" 
* 
      ADA $CLAS     IF GREATER THAN MAX THEN
      CLA,SEZ,RSS   SEND
      JMP ERR00     'IO00' ERROR
* 
      ADB DCLAS     SET THE 
      STB CLASS     CLASS TABLE ADDRESS 
* 
BFCK  LDB RQP4,I    GET THE LENGTH
      CLE,SSB,RSS    CONVERT TO 
      JMP BFWDS       WORDS IF
      BRS              CHARACTERS 
      CMB,INB           SET POSITIVE AND
BFWDS STB TMP8           SAVE.
      SPC 1 
      ADB RQP3      CHECK IF AREA EXTENDS ABOVE THE 
      CMB,SEZ,CLE,INB,RSS LAST WORD 
      ADB BKLWA        OF MEMORY
      INB 
      CLB,SEZ,RSS   IF SO THEN
      JMP ERR04      ERROR 4 DIAGNOSTIC 
* 
* 
* 
G.01  LDA RQP2,I    GET SECURITY CODE 
      AND B174C      BITS FROM CLASS WORD 
      STA SECCD 
      LDB CLASS,I   GET QUEUE HEAD
      SSB           IF A COUNTER
      JMP G.06      GO SUSPEND THE PROGRAM
      SZB,RSS       IF QUEUE-HEAD = 0 
      JMP ERR00        ERROR "IO00" 
* 
      STB PTR       SAVE THE ADDRESS
      INB           GET THE CON WORD
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       AND 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       AND 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      AND .3        ISOLATE THE REQUEST CODE
      STA RQP7,I     RETURN IT TO USER'S IRCLS
      INB           STEP TO STATUS WORD 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       GET COMPLETION STATUS.
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       GET COMPLETION STATUS.
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA XA,I      AND SET IT IN THE A REG.
      INB           GET THE BUFFER LENGTH 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       AND SET IT
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       AND SET IT
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA CLTMP     FOR RETURN
      INB           STEP TO USER CLASS WORD 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       GET IT
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       GET IT
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      AND B174C     KEEP SECURITY CODE
      CPA SECCD     MATCHES CALLER'S? 
      RSS 
      JMP ERR00      NO, ERROR IO00 
* 
      INB           INDEX TO THE
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       TLOG AND
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       TLOG AND
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA XB,I      SET IT IN THE 'B' REG 
      INB           INDEX TO THE
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I       FIRST OPTIONAL WORD AND 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I       FIRST OPTIONAL WORD AND 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA RQP5,I    SET IT IN THE USERS BUFFER
      INB           NOW DO THE SECOND OPTIONAL WORD 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA B,I 
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA B,I 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA RQP6,I
* 
      STB TEMP4     SAVE THE BUFFER ADDRESS 
      LDA .8        GET THE BUFFER LENGTH 
      CMA,INA       SET NEGATIVE
      ADA CLTMP     LOP OFF THE HEAD WORDS
      STA TEMP3     SET THE MOVE COUNT
      LDB TMP8      GET THE SUPPLIED LENGTH 
      CMA,INA       SET MOVE COUNT NEG
      ADA TMP8      USE LESSOR OF THE TWO 
      SSA,RSS       COUNTS
      LDB TEMP3     USE QUEUE COUNT IF SMALLER
      SSB           IF COUNT LESS THAN ZERO THEN
      JMP G.05      THEN SKIP MOVE
* 
G.03  ISZ TEMP4     STEP THE BUFFER ADDRESS.
      LDA TEMP4     (A)= SOURCE 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      STB WORD2     SAVE COUNT
      LDB RQP3      (B)= DESTINATION
      JSB .MVW
       DEF WORD2
       NOP
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      CBX           GET MOVE COUNT
      LDB RQP3      GET DESTINATION 
      MWF           MOVE FROM SYSTM TO USER 
******* END DMS CODE ************** 
      XIF 
      SPC 1 
G.05  LDA RQP2,I    IF SAVE 
      RAL,RAL       QUEUE OPTION
      SLA,ELA       THEN
      JMP L.16      THEN EXIT 
* 
      SPC 1 
      IFN 
* BEGIN NON-DMS CODE ************** 
      LDA PTR,I     ELSE
*** END NON-DMS CODE ************** 
      XIF 
      SPC 1 
      IFZ 
***** BEGIN DMS CODE ************** 
      XLA PTR,I     ELSE
******* END DMS CODE ************** 
      XIF 
      SPC 1 
      STA CLASS,I   UPDATE THE LIST 
      SSA           IF POINTER, SKIP COUNT CHECK
      AND B37       GET # PENDING REQUESTS LEFT 
      SEZ,SZA,RSS    NO REQUESTS LEFT 
      STA CLASS,I    AND IF DEALLOCATE WANTED, DO IT. 
      JSB $RTN      RETURN THE MEMORY 
PTR    NOP           AND
CLTMP  NOP           THEN 
      JMP G.08      SCHEDULE WAITERS AND EXIT 
* 
G.06  LDA B174C     GET SECURITY CODE 
      AND B          FROM QUEUE 
      CPA SECCD     MATCH?
      RSS 
      JMP ERR00      NO, ERROR IO00 
* 
      RBL,CLE,ELB   MOVE BIT14 (SOMEONE WAITING) TO E 
G.065 LDA CLASS,I   GET CLASS WORD
      AND B377
      CMA,SEZ       ANYONE WAITING? (SET ONES COMP) 
      JMP SCEDT      YES,SORRY SOMEBODY BEAT YOU TO IT
* 
      STA XA,I      SET A FOR POSSIBLE RETURN 
      INA           GET CORRECT 2'S COMPLEMENT
      STA B 
      LDA RQP2,I    GET THE OPTION FLAG 
      ELA,RAL       SET E=BIT15 NO-WAIT OPT.
      SZB,RSS       IF QUEUE-HEAD = 0 
      SSA             AND BIT14 SET,
      JMP G.07        DON'T DEQUEUE 
* 
      STB CLASS,I   IF Q-H=0 AND BIT14=0 DEQUEUE! 
G.08  LDA DCLAS     NOW SCHEDULE ALL THOSE WAITING
      JSB $SCD3      FOR AN AVAILABLE CLASS NUMBER. 
      JMP L.16      RETURN
* 
G.07   SEZ,CCE
      JMP L.16      BIT15=1 FOR NO-WAIT. RETURN.
      LDB CLASS     GET CLASS ADDR IN B FOR L.013 
      LDA B,I       SET "SOMEONE IS WAITING" FLAG 
      RAL,RAL 
      ERA,RAR 
      STA B,I         AND 
      JMP L.013     PUT IT BACK INTO WAIT LIST
* 
* 
SCEDT ERB,RBR       CLEAR THE BIT AND 
      STB CLASS,I   RESET THE CLASS HEAD
      LDA CLASS     GET HEAD ADDRESS TO A AND 
      JSB $SCD3     RESCHEDULE THE WAITER IF ANY
      LDA $LIST     WAS THERE ONE?? 
      CLE,SZA 
      JMP ERR10     YES ERROR GO ABORT
* 
      JMP G.065     NO. MUST HAVE BEEN ABORTED, CONTINUE
      SPC 1 
      SKP 
ERR00 CLB,RSS       ILLEGAL CLASS# OR SECURITY CODE 
ERR01 CLB,INB       INSUFFICIENT # OF PARAMETERS
      RSS 
ERR04 LDB .4        ILLEGAL BUFFER ADDRESS
      RSS 
ERR10 LDB B400      DOUBLE REQUEST ON SAME CLASS
      LDA ERIO      (A) = ASCII "IO"
      JMP $ERAB     WRITE MESSAGE AND EXIT TO $MDI
* 
ERIO  ASC 1,IO
.4    DEC 4 
B400  OCT 400 
      SKP 
.     EQU 1650B     ESTABLISH ORIGIN OF AREA
* 
* SYSTEM TABLE DEFINITION * 
* 
* 
* I/O MODULE/DRIVER COMMUNICATION 
* 
EQT1  EQU .+8      ADDRESSES
EQT5  EQU .+12      CURRENT 
* 
* 
* SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION *
* 
RQRTN EQU .+23      RETURN POINT ADDRESS
RQP1  EQU .+24      ADDRESSES 
RQP2  EQU .+25
RQP3  EQU .+26       OF REQUEST 
RQP4  EQU .+27
RQP5  EQU .+28       PARAMETERS 
RQP6  EQU .+29
RQP7  EQU .+30       (SET FOR MAXIMUM OF
RQP8  EQU .+31        8 PARAMETERS) 
* 
* DEFINITION OF SYSTEM LISTS (QUEUES) * 
* 
* 
* DEFINITION OF EXECUTING PROGRAM  ID SEGMENT' *
* 
XEQT  EQU .+39     ID SEGMENT ADDR. OF CURRENT PROG.
XTEMP EQU .+41       'TEMPORARY (5-WORDS) 
XSUSP EQU .+48       'POINT OF SUSPENSION'
XA    EQU .+49       'A REGISTER' AT SUSPENSION 
XB    EQU .+50       'B REGISTER' 
* 
BKLWA EQU .+87      LWA OF MEMORY IN BACKGROUND 
* 
* 
      ORG *         LENGTH OF MODULE
      END $I.CL