ASMB,R,L,C   ** RT EXEC CENTRAL CONTROL MODULE ** 
      HED ** REAL-TIME EXECUTIVE  CENTRAL CONTROL MODULE ** 
*     NAME:   EXECM 
*     SOURCE: 92060-18018 
*     RELOC:  92060-16018 
*     PGMR:   G.A.A.,L.W.A. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 EXECD,0 92060-16018 REV.1740 770814 
* 
***** AMD-DAS ***** FEB,72 ***** REV.LWH *****
* 
      ENT EXEC,$ERMG,$RQST,$OTRL
      ENT $LIBR,$LIBX,$DREQ,$DREL,$SDRL,$SDSK 
      ENT $ERAB,$PVCN,$REIO,$CREL,$RSRE,$ABRE 
      ENT $PDSK 
      ENT $PWR5,$MVBF,$SGAF 
* 
      EXT $CVT3,$SYMG,$LIST,$XEQ
      EXT $RENT,$CVEQ,$ABRT 
      EXT $CGRN,$SCLK,$ALC,$RTN 
      EXT $MRMP,$PBUF 
      SUP 
$PDSK EQU 0         DEFINE DEFAULT FOR DISC PROTECT 
* 
*****  < EXEC >   PROGRAM  DESCRIPTION  ***** 
* 
*  THE PRIMARY FUNCTION OF THIS PROGRAM IS
* TO PROVIDE GENERAL CHECKING AND EXAMINATION 
* OF SYSTEM SERVICE REQUESTS AND TO CALL THE
* APPROPRIATE PROCESSING ROUTINE IN OTHER 
* SECTIONS OF THE REAL-TIME EXECUTIVE.
* 
*  THIS PROGRAM IS CALLED DIRECTLY FROM THE 
* CENTRAL INTERRUPT CONTROL <CIC> SECTION 
* WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED.
* ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A 
* PROTECT VIOLATION.
* 
*   SYSTEM REQUEST FORMAT:
*   ----------------------
* 
*     THE GENERAL FORMAT OF A SYSTEM REQUEST IS 
*    A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION 
*    TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS
*    LIST OF PARAMETERS. THE FIRST PARAMETER IS 
*    A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. 
*    THE LENGTH OF THE PARAMETER LIST VARIES
*    ACCORDING TO THE AMOUNT OF INFORMATION RE- 
*    QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN
*    A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM 
*    REQUESTS TO BE SPECIFIED IN A FORTRAN CALL 
*    STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. 
* 
*        CALL  EXEC  (P1,P2,...PN)
* 
*     OR
* 
*        EXT   EXEC 
*        JSB   EXEC   (CAUSES MEMORY PROTECT VIOLATION) 
*        DEF   *+1+N  DEFINE EXIT POINT, N= # PARAMETERS
*        DEF   RCODE  DEFINE REQUEST CODE 
*        DEF   P1     DEFINE PARAMETER LIST, 1 TO N 
*        .
*        .            (PARAMETERS MAY BE INDIRECTLY 
*        .             REFERENCED, E.G. DEF P3,I) 
*        DEF   PN 
*       - EXIT POINT -
* 
*     RCODE  DEC  N 
*     P1     DEC/OCT/DEF,ETC  TO DEFINE A VLAUE 
* 
* 
*   RE-ENTRANT LIBRARY REQUEST
*   --------------------------
* 
*     THE SYSTEM LIBRARY (RESIDENT) CONTAINS
*    PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT 
*    OR IN 'PRIVILEGED' EXECUTION FORMAT. 
* 
*     - RE-ENTRANT FORMAT ALLOWS A LIBRARY
*    PROGRAM TO BE RE-ENTERED BY A CALL FROM
*    A HIGHER-PRIORITY PROGRAM DURING THE 
*    PROCESSING OF A CALL FROM A LOWER-PRIORITY 
*    PROGRAM. 
* 
*     - PRIVILEGED EXECUTION FORMAT ALLOWS A
*    SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED 
*    WITH THE INTERRUPT SYSTEM DISABLED.
* 
* 
* 
*  MEMORY PROTECT ERROR:
*  ---------------------
* 
*    IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION 
*   IS NOT A JSB EXEC OR A JSB TO LIBRARY 
*   PROGRAM, THEN A USER PROGRAM ERROR IS 
*   ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM 
*   TELETYPE LISTING THE PROGRAM NAME AND ADDRESS 
*   OF VIOLATING INSTRUCTION AND THE PROGRAM IS 
*   SET DORMANT IN THE PROGRAM ABORT PROCEDURE. 
* 
      SKP 
************MEU INSTRUCTIONS***************** 
EXEC  NOP 
      HLT 0        PROTECTION AGAINST DIRECT CALL.
* 
$RQST LIB 5        GET ADDRESS OF VIOLATION.
      LIA 4         DO NOT REARRANGE!!! 
      CPA D4       POWER FAIL?
      LDB $PWR5     YES, USE LAST INTERRUPT ADDR. 
      STF 5         REENABLE PARITY ERROR OPTION. 
      STB VADR     SAVE VIOLATION ADDRESS.
      STB XSUSP,I  SET AS POINT OF SUSPENSION.
      STB $LIBR    SAVE (P+1) OF
      ISZ $LIBR     CALL. 
      SFC 5         IF FLAG CLEAR,NOT MEU VIOL
      JMP MEUER 
      UJP *+2 
      RBL,CLE,SLB,ERB CHECK FOR PARITY  ERROR 
      HLT 5         FOUND ONE!!!!!
      LDA B,I      GET WORD.
      AND B074K    ISOLATE INSTR. CODE. 
      CPA JSBI     IF INSTRUCTION IS JSB
      JMP *+2       CHECK OPERAND ADDRESS.
      JMP MPERR     -MEMORY PROTECT ERROR-
      LDA B,I       CHECK FOR EFFECTIVE 
      AND B2000     ADDRESS 
      SZA           LINK THRU CURRENT PAGE? 
      LDA VADR       YES, USE CURRENT PAGE BITS 
      XOR VADR,I    MIRGE THE PAGE OFFSET 
      AND G76       UNDER THE RULES OF WOO. 
      XOR VADR,I    NOW HAVE THE ADDRESS
      RAL,CLE,SLA,ERA IF INDIRECT 
INDR  LDA A,I       GET NEXT LEVEL
      RAL,CLE,SLA,ERA CHECK FOR MULTI LEVEL 
      JMP INDR      FOUND ONE SO LOOP (MUST END)
* 
      CPA EXECA     -EXEC-. 
      JMP R0        YES, REQUEST TO BE ANALYSED.
      CPA LIBRA    -LIBRARY ROUTINE CALLING FOR 
      JMP LIBRC     RE-ENTRANT OR PRIVILEGED RUN. 
      CPA LIBXA    -LIBRARY ROUTINE RETURNING 
      JMP LIBXC     TO CALLER.
* 
* CHECK FOR USER CALL TO LIBRARY PROGRAM
* 
      STA B        SAVE OPERAND ADDRESS.
      LDA LBORG    SUBTRACT LIBRARY 
      CMA,CLE,INA   AREA ORIGIN FROM
      ADA B          OPERAND ADDRESS. 
      LDA B         (E = 0 IF SYSTEM VIOLATION )
      CMA,SEZ,CLE,INA SKIP IF VIOLATION ALREADY ELSE
      ADA $SGAF     TEST FOR ABOVE LIB. 
      SEZ,RSS      IF NOT CALL TO LIBRARY RESIDENT, 
      JMP MPERR     THEN VALID MEMORY PROTECT ERROR.
      LDA $LIBR    -CALL TO LIBRARY.
      STA B,I       SET (P+1) ADDRESS IN ENTRY POINT
      ADB D2        SET (P+1) OF
      STB $LIBR      JSB  $LIBR IN -$LIBR-. 
      JMP LIBRC     - TRANSFER TO $LIBR SECTION 
$SGAF NOP           SSGA START ADR
      SPC 1 
JSBI  JSB 0 
B074K OCT 074000
G76   OCT 76000 
EXECA DEF EXEC
RQP1A DEF RQP1
VADR  NOP 
$PWR5 NOP            ADDR OF INTERRUPT BEFORE POWER FAIL
DM9   DEC -9
* 
* ANALYZE SYSTEM REQUEST
* 
R0    LDA $LIBR,I   (A) = RETURN ADDRESS OF JSB EXEC. 
      ISZ $LIBR     SET $LIBR TO FIRST PRAM. (RQ) ADDRESS.
      STA RQRTN     SAVE IN BASE PAGE 
      LDB $LIBR     CACULATE THE NUMBER OF
      CMB,CLE       PARAMETERS IN REQUEST 
      ADB A         LESS THE REQUEST CODE.
      STB RQCNT     AND SAVE # OF ACTUAL PARAMETERS.
      STB A 
      CMB,SEZ,CME   SKIP IF RETURN IS BAD (< JSB +2)
* 
      ADA DM9       IS GREATER
      CLA,SEZ       THAN
      JMP RQERR     8.
* 
      STA RQP2      ZERO
      STA RQP3       PARAMETER
      STA RQP4
      STA RQP5       ADDRESS
      STA RQP6
      STA RQP7       AREA 
      STA RQP8
      STA RQP9
* 
      LDA RQP1A     SET TEMP2 = 
      STA TEMP2     ADDRESS OF RQP1 IN BASE PAGE
      STA TEMP3     SAVE FOR CALL BY NAME TEST
R1    LDA $LIBR    GET EFFECTIVE OPERAND ADDRESS. 
R1D1  LDA A,I       FIRST LEVEL TO A
      SZA           IF THROUGH A
      CPA D1        OR B
      JMP RQERR     BAD NEWS FELLOW!
* 
      RAL,CLE,SLA,ERA REMOVE INDIRECT BIT SKIP IF DIRECT
      JMP R1D1      STILL INDIRECT GO TRY AGAIN.
* 
      STA TEMP2,I  SET IN BASE PAGE.
      ISZ TEMP2    INDEX
      ISZ $LIBR     ADDRESSES AND 
      INB,SZB       PARAMETER COUNT.
      JMP R1       - CONTINUE - 
      SKP 
* CHECK LEGALITY OF REQUEST CODE
* 
      LDA RQP1,I  GET REQUEST CODE
      LDB XEQT     COMPUTE
      ADB D15       THE STATUS WORD 
      STB TEMP1      ADDRESS AND SAVE 
      LDB B,I      GET STATUS 
      RAL,CLE,ERA     PUT ABORT OPTION BIT
      RBL,ERB           IN SIGN OF STATUS 
      STB TEMP1,I        AND RESET IN ID-SEG. 
      SSB          IF OPTION SELECTED 
      ISZ RQRTN     STEP RETURN ADDRESS.
      STA RQP1       SAVE THE REQUEST CODE. 
      SZA           IF ZERO SKIP TO REJECT
      ADA CODE#     IF RQUEST CODE IF NOT DEFINED 
      SSA,RSS      -THEN
      JMP RQERR     TOUGH LUCK, YOUR A DEAD DUCK! 
* 
      ADA RQTBL     GET ADDRESS OF PROCESSOR TO A 
      LDA A,I       GET ADDRESS 
      SZA,RSS       IF NOT LOADED 
      JMP RQERR     THEN REQUEST CODE ERROR 
* 
      STA VADR      SAVE THE ADDRESS
* 
*     TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF 
*     THE CALL CAUSES A STORE TO THE AREA DEFINED.
* 
      LDB RQP1      USE REQUEST CODE
      CLE,ERB       TO INDEX INTO 
      ADB RQTBL     THE BY NAME TABLE 
      LDA B,I       GET THE FLAG WORD 
      LDB RQCNT     GET THE NUMBER OF PRAMS TO
      CMB,SEZ,RSS   TEST SET COUNT
      ALF,ALF       ROTATE IF ODD REQUEST CODE
      STB TEMP1     SET PRAMETER COUNT
* 
R3    ISZ TEMP3     STEP THE PRAMETER ADDRESS 
      LDB TEMP3,I   GET THE ADDRESS 
      ISZ TEMP1     SKIP IF END OF LIST 
      CMB,CLE,RSS   SET UP FOR TEST AND SKIP
      JMP VADR,I    GO EXERCISE THE REQUEST 
      SLA,RAR       IF FLAG NOT SET THEN
      ADB FENCE     SKIP THE ADD
      CLB,SEZ,RSS   SET B FOR ERROR SKIP IF ERROR 
      JMP R3        NO ERROR GO TEST NEXT PRAM
* 
      LDA RQ1       SET A FOR ERROR 
      JMP $ERAB     GO SEND 'RQ00' ERROR
      SPC 1 
D1    DEC 1 
D2    DEC 2 
D15   DEC 15
DM1   DEC -1
CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1
RQTBL DEF TBLE      ADDRESS INDIRECT OF LAST + 1. 
      HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION **
* 
* SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION
* 
*  ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS 
* IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY 
* WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE 
* LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA 
* AND JUST ABOVE THE SYSTEM AREA. 
* 
*  A USER LIBRARY CALL CAUSES A PROTECT VIOLATION.
* THIS SECTION FACILITATES ENTRY INTO THE LIBRARY 
* PROGRAM BY PERFORMING THE NECESSARY PROCESSING
* FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H=
* THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED'
* EXECUTION PROGRAM.
* 
*  RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: 
*  ---------------------------------------- 
* 
*   ENTRY   NOP 
*           JSB  $LIBR
*           DEF  TDB  (OR 'NOP' IF PRIVILEGED)
*          - FIRST INSTRUCTION FOR FUNCTION - 
*            -    CODE
*            -     TO 
*            -     PERFORM
*            -     PROGRAM FUNCTION 
*    EXIT   JSB  $LIBX
*           DEF  TDB  (OR  DEF ENTRY IF PRIVILEGED) 
*           DEC  N   RETURN ADJUSTMENT FOR RE-ENTRANT 
*            -
*   TDB     NOP    HOLDS SYSTEM POINTER TO ID-EXTENSION.
*           DEC N  LENGTH OF TEMPORARY DATA BLOCK 
*           NOP    RETURN ADDRESS OF CALL.
*         - BLOCK USED FOR
*             HOLDING TEMPORARY 
*              VALUES GENERATED 
*               BY THE ROUTINE. 
* 
* 
*  < $LIBR> IS ENTERED WHEN A LIBRARY 
* PROGRAM IS CALLED.  IF THE CALLED 
* PROGRAM IS 'RE-ENTRANT' AND IS CALLED 
* DURING THE PROCESSING OF A PREVIOUS 
* CALL, THE TEMPORARY-DATA-BLOCK IS 
* MOVED INTO A BLOCK IN AVAILABLE MEMORY
* BEFORE THE ROUTINE IS ENTERED.
* 
* 
LIBRA DEF $LIBR 
* 
$LIBR NOP           DIRECT ENTRY HAS TO BE PRIV.
      STA XA,I      AND GOING DEEPER
      LDA $LIBR,I   MAKE SURE 
      SZA           AND IF GOING RENT 
      JMP MPERR     SEND SOUTH INSTEAD. 
* 
LIBRX LDA XA,I      RESTORE AND RETURN
      ISZ $LIBR     SET RIGHT ADDRESS 
      ISZ $PVCN     AND STEP THE DEPTH COUNTER
      JMP $LIBR,I   RETURN TO USER
* 
LIBRC LDB $LIBR,I   GET (P+2) OF -$LIBR- CALL.
      SZB,RSS      IF (P+2) = 0, THEN CALLED PROGRAM
      JMP PVEXC     IS IN 'PRIVILEGED' FORMAT.
* 
      STB TEMP1    SAVE -TDB- ADDRESS.
      LDA B,I      GET WORD 1 OF DATA BLOCK.
      LDA A,I       GET ID SEG ADDRESS OR ZERO
      RAL,CLE,ERA   REMOVE POSSIBLE SIGN BIT
      CPA XEQT      RECURSIVE ENTRY?
      JMP ERE01     YES GO ABORT HIM
      INB           STEP TO LENGTH WORD IN TDB
      SZA           IF BLOCK IN USE GET LENGTH
      LDA B,I       ELSE
      ADA D4        USE JUST FOUR WORDS 
      STA TEMP4     SAVE LENGTH FOR ALLOCATE CALL 
      LDB DHED      GET POINTER TO HEAD OF RENT 
      LDA XEQT      LIST
      ADA D20       CHECK IF ALREADY IN LIST
      STA TEMP3     SAVE ID-SEG POINTER 
      LDA A,I       GET THE STATUS WORD 
      ALF,RAL       BIT 10 IS RENT BIT
      SSA,RSS       IF CLEAR THEN THIS IS FIRST ENTRY 
      JMP RE2       SO GO SET UP
* 
      LDB XEQT      NOT FIRST ENTRY SO FIND OTHERS
      JSB FINDL     USING FINDL ROUTINE 
      JMP ERE01     LIST ERROR ABORT THE PGM
      ADB D3        STEP TO SUB QUE HED 
RE2   STB TEMP2     SET POINTER TO LIST HEAD
* 
      JSB $ALC      ALLOCATE THE MEMORY 
TEMP4 NOP           NUMBER OF WORDS REQUIRED
       JMP NVRM     IF NEVER ANY MEMORY, TRY 4 ONLY 
       JMP LB05     NO MEMORY NOW, SUSPEND. 
       CCE          ALLOC DONE. 
* 
      CPB TEMP4     DID WE GET THE REQUESTED NUMBER?
B40   CLE           YES CLEAR E AS A FLAG 
* 
      XLB TEMP2,I   GET OLD POINTER 
      XSA TEMP2,I   SET NEW BLOCK ADDRESS 
      XSB A,I       LINK OLD BLOCKS INTO THE LIST 
      LDB XEQT      GET THE ID-SEG ADDRESS
      SEZ,INA       STEP A AND SKIP IF EXACT ALLOCATION 
      ADB SIGN      ELSE ADD SIGN BIT TO ID-ADDRESS 
      XSB A,I       SET IN WORD 2 
      STA TEMP4     SET TDB ADDRESS POINTER 
      INA           SET TO WORD 3 ADDRESS 
      LDB TEMP1     SET TDB ADDRESS IN WORD THREE 
      XSB A,I 
      INA           CLEAR 
      CLB            WORD 
      XSB A,I       FOUR
* 
      LDB TEMP1,I   IF BLOCK AVAILABLE THEN 
      SZB,RSS       SKIP THE
      JMP RE4       MOVE
* 
      SEZ,INA       SET A TO SAVE BLOCK ADDRESS 
      INA           (EXTRA WORD USED IN ID-EXTENSION) 
      LDB TEMP1     DIG THE TDB SIZE OUT
      CLE,INB        OF THE TDB 
      LDB B,I       AND SET IN B
      JSB MTDB      MOVE OUT THE TDB
RE4   LDA TEMP4     GET THE ADDRESS OF THE ID-SEG. ADDRESS
      STA TEMP1,I   AND SET IN THE TDB
      LDA TEMP3,I   GET THE ID-STATUS WORD
      IOR B2000     SET THE RENT BIT
      STA TEMP3,I   RESTORE THE WORD
      LDB TEMP1    (B) = ADDR. OF TDB.
      ADB D2       SET
      LDA $LIBR     (P+1) 
      ADA DM2       OF ORIGINAL 
      LDA A,I       CALL IN 
      STA B,I       WORD 3 OF TDB IN PROGRAM. 
      ISZ $LIBR    SET TO FIRST INSTR IN LIB. PROG. 
* 
      LDB $LIBR     SET RETURN ADDRESS
      STB XSUSP,I   IN THE ID-SEG.
      JMP $RENT     RETURN TO THE DISPATCHER
* 
$PVCN NOP 
      SKP 
* 
* REJECT SECTION CAUSED BY NO MEMORY
*  AVAILABLE FOR -TDB-. CALLING USER PROGRAM
*  IS SUSPENDED BACK TO POINT OF CALL AND 
*  LINKED INTO MEMORY SUSPENSION LIST.
* 
NVRM  LDA D4        NEVER ENOUGH MEMORY, REQUEST 4 NEXT TIME
      STA XTEMP,I 
LB5   JSB $LIST    SUSPEND
      OCT 504       PROGRAM 
      JMP $XEQ     TRANSFER TO EXECUTE SECTION. 
* 
LB05  LDA $LIBR    BACK UP TO 
      ADA DM2       THE ENTRY POINT.
      CCB          SUBTRACT ONE FROM THE RETURN 
      ADB A,I       ADDR TO GET ADDR OF THE CALL. 
      STB XSUSP,I    POST THIS ADDR AS SUSP.POINT.
      JMP LB5      SUSPEND PROGRAM FOR MEMORY.
* 
* 
* INITIATE PRIVILEGED EXECUTION OF USER PROGRAM 
* 
PVEXC EQU *        RESTORE REGISTERS. 
      DLD XI,I      GET X,Y TO A,B
      CAX           PUT IN X
      CBY           AND Y 
NOTMX LDA XEO,I     NOW E,O 
      CLO 
      SLA,ELA 
      STF 1 
      LDB XB,I
      JMP LIBRX     GO GET A AND EXIT 
* 
      HED RENT SUBROUTINES
*     MTDB MOVES A TDB TO SYSTEM MEMORY AND UPDATES THE LINKAGES
*     AS REQUIRED.
* 
*     CALLING SEQUENCE: 
* 
*     TEMP6 = NUMBER OF WORDS REQUIRED (IF ALLOCATION)
*     TEMP1 = ADDRESS OF TDB TO BE MOVED
*     A     = CORE ADDRESS (FROM $ALC ) 
*     B     = NUMBER OF WORDS ALLOCATED (FROM $ALC )
*     E     = 0 IF MEMORY IS ALREADY ALLOCATED
*           = 1 IF TEMP6 IS SET AND A AND B ARE NOT.
* 
*     THE SECOND WORD OF THE SAVE AREA IS SET TO THE CONTENTS 
*     OF B WHILE THE SECOND WORD OF THE TDB DETERMINS HOW 
*     MANY WORDS TO MOVE. 
* 
*     TEMP USAGE IN THIS ROUTINE IS:
* 
*     AHLD          DESTINATION ADDRESS 
*     TEMP7         ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,I) 
* 
MTDB  NOP 
      STA AHLD
      RSA           SAVE MEU STATUS 
      RAL,RAL 
      STA MVSTS 
      UJP *+2 
      SEZ,RSS       IF NO ALLOCATE OPTION 
      JMP MTDB2     SKIP ALLOCATE CALL
* 
      JSB $ALC      GET THE MEMORY
TEMP6 NOP 
       JMP MTDB0    NEVER ANY MEMORY
       JMP LB5      NO MEMORY NOW, SUSPEND PROG 
* 
      STA AHLD      SET UP DESTINATION POINTER
MTDB2 EQU * 
      LDA TEMP1,I   SAVE THE ID-EXTENSION ADDRESS 
      STA TEMP7 
      LDA TEMP1     GET THE TDB ADDRESS 
      XSA AHLD,I    AND SET IT IN THE SAVE AREA.
AHLD  EQU *-1 
      ISZ AHLD      STEP TO WORD TWO
      XSB AHLD,I    AND SET ACTUAL COUNT
      ADB DM2       ADJUST COUNT FOR MOVE 
      CBX           AND SET FOR MWI 
      ADA D2        ADJUST THE FROM ADDRESS 
      LDB AHLD      GET THE TO ADRESS 
      INB           ADJUST TO ADDRESS 
      MWI           MOVE BLOCK INTO SYSTEM MAP
* 
      CLA 
      STA TEMP1,I   SET THE TDB "FREE"
      XLB TEMP7,I   GET THE ID-SEGMENT ADDRESS FOR
      RBL,CLE,ERB   THE OWNING PROGRAM
      ADB D20       INDEX TO THE STATUS WORD
      LDA B,I       FETCH IT AND SET
      IOR B4000     THE RENT MEMORY MOVED 
      STA B,I       BIT 
      ISZ TEMP7     STEP TO THE TDB POINTER ADDRESS 
      LDA AHLD      GET THE NEW LOCATION
      ADA C100K     SUBTRACT ONE AND ADD SIGN 
      XSA TEMP7,I   AND SET IN THE EXTENSION. 
MTDBX JRS MVSTS MTDB,I
MVSTS BSS 1 
* 
MTDB0 CLA            NEVER ANY MEMORY 
      CLB            RETURN (A)=0, (B)=0
      JMP MTDBX 
      SPC 2 
*     FINDL FINDS A ID-EXTENSION GIVEN THE ID-SEGMENT ADDRESS 
* 
*     CALLING SEQUENCE: 
* 
*     LDB ID-SEG ADDRESS
*     JSB FINDL 
*     NOT FOUND RETURN
*     FOUND RETURN  B = ADDRESS OF EXTENSION,TEMP5 = ADDRESS OF 
*         PREVIOUS BLOCK IN THE LIST (FOR UNLINKING). 
*         E = 0.
* 
*     TEMP USAGE: 
* 
*     TEMP5 = LAST POINTER
*     TEMP6 = ID-SEGMENT ADDRESS
* 
FINDL NOP 
      STB TEMP6     SAVE THE ID-SEGMENT ADDRESS 
      LDB DHED      GET THE HED OF THE LIST ADDRESS 
FIND1 STB TEMP5     SET LAST POINTER
      XLB B,I       GET THE ADDRESS OF THE EXTENSION
      SZB,RSS       END OF LIST?
      JMP FINDL,I   YES- MAKE NOT FOUND RETURN
      LDA B         ADDRESS TO A
      INA           STEP TO THE ID-ADDRESS
      XLA A,I       GET THE ADDRESS 
      RAL,CLE,ERA   CLEAR POSSIBLE SIGN BIT 
      CPA TEMP6     THIS IT?
      CLE,RSS       YES RETURN E = 0
      JMP FIND1     NO TRY NEXT ENTRY 
      ISZ FINDL     STEP TO TRUE RETURN 
      JMP FINDL,I   RETURN
      SKP 
*     RTN4 RETURNS THE FOUR WORD ID-EXTENSION AND CAN CLEAR 
*     THE PROGRAMS RENT BIT 
* 
*     CALLING SEQUENCE: 
* 
*     TEMP2 = ADDRESS OF THE FOUR WORD BLOCK
*     E     = 0 IF THE RENT BIT IS TO BE CLEARED. 
*     TEMP1 = ADDRESS OF THE TDB (TO SET FIRST WORD TO ZERO)
*     JSB RTN4
* 
*     TEMP USAGE: 
*     TEMP2 AS ABOVE
*     TEMP3 NUMBER OF WORDS TO RETURN 
*     TEMP1 AS ABOVE
* 
RTN4  NOP 
      LDA TEMP2     GET BLOCK ADDRESS 
      INA           INDEX TO ID SEG ADDRESS 
      XLB A,I       GET ID-SEG ADDRESS
      LDA D4        SET A TO THE REQUEST LENGTH 
      RBL,SLB,ERB   IF WE GOT 4 SKIP
      INA           ELSE SET TO 5.
      STA TEMP3     SET RETURN LENGTH 
      SSB           IS RENT BIT CLEAR REQUESTED?
      JMP RTNA      NO SKIP 
      ADB D20       YES INDEX TO THE BIT
      LDA B,I       GET THE WORD
      XOR B2000     ZAP THE BIT 
      STA B,I       RESET THE WORD
RTNA  CLA           CLEAR THE TDB FLAG
      STA TEMP1,I 
      JSB $RTN      RETURN THE MEMORY 
TEMP2 NOP 
TEMP3 NOP 
      JMP RTN4,I    RETURN
      SPC 2 
DHED  DEF *+1 
      NOP           HED OF ID-EXTENSION LIST
DM3   DEC -3
D20   DEC 20
B4000 OCT 4000
B2000 OCT 2000
SIGN  DEF 0,I 
      HED $REIO  RENT I/O PROCESSOR ROUTINE 
*     $REIO MOVES TO SYSTEM MEMORY THE TDB CONTAINING THE 
*     REFERENCED ADDRESS - IF ANY.  THIS ROUTINE IS CALLED
*     BY RTIOC TO ALLOW I/O FROM A RE-ENTRENT ROUTINE.
* 
*     CALLING SEQUENCE
* 
*     LDB BUFAD     BUFFER ADDRESS IN B.
*     JSB $REIO 
*     ON RETURN B IS THE NEW BUFFER ADDRESS, E IS SET.
* 
*     TEMP USAGE: 
* 
*     TEMP1 = TDB ADDRESS 
*     TEMP3 = NEG. OF PASSED BUFFER ADDRESS 
*     TEMP4 = NEXT ENTRY POINTER. 
*     TEMP5 = TDB PTR ADDRESS IN ID-EXTENSION 
* 
$REIO NOP 
      CMB,INB       SET BUFFER ADDRESS NEGATIVE FOR TESTS.
      STB TEMP3     TEST AND SAVE IT
      CLB 
      STB $MVBF     CLEAR MOVE TO REENT MEM FLAG
      LDB XEQT      GET THE ID-ADDRESS
      JSB FINDL     AND SO THE ID-EXTENSION