ASMB,R,L,C     ** $ALRN RN-LU COMMON SUBROUTINES ***
      HED $ALRN - RN-LU COMMON SUBROUTINES
*     NAME:   $ALRN 
*     SOURCE: 92067-18271 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 $ALRN,6 92067-1X271 REV.2013 770715 
* 
      EXT $RNTB,$ERAB,$LIST,$XEQ
      ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD 
      SUP 
A     EQU 0 
B     EQU 1 
* 
*     $ALRN  THIS ROUTINE ALLOCATES AN RN IF POSSIBLE 
*            TO THE USER WHOSE ID SEGMENT ADDRESS IS
*            AT XEQT. 
* 
*     OPTIONS/CALLING SEQUENCE: 
* 
*         < IDNO   MUST BE USER ID SEG #  OR  377 IF GLOBAL 
*         LDB =B1  TO ALLOCATE FROM BOTTOM OF THE RN TABLE
*         LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE 
* 
*         JSB $ALRN 
* 
*         < RETURN  A=RN WORD (USER FORMAT) IF SUCESSFUL
*                   A=0  IF NO RN'S AVAILABLE NOW 
*                   RQP6  IS SET TO RN ADDRESS IN RN TABLE
* 
* 
* 
* 
$ALRN NOP 
      STB TEMP4     SAVE THE INCREMENT
      XLA $RNTB     GET THE LENGTH OF THE RN TABLE
      STA TEMP1     SAVE LENGTH OF THE RN TABLE 
      CMA,INA       SET NEGATIVE. 
* 
      STA TEMP2     SET THE COUNT 
      LDA D$RN      GET THE RN TABLE ADDRESS
      SSB,RSS       IF BOTTOM UP
      INA,RSS       SET TO FIRST WORD 
      ADA TEMP1     ELSE SET TO LAST WORD 
* 
ALRN1 XLB A,I       SEARCH FOR
      SZB,RSS       AN AVAILABLE
      JMP ALRN2     SLOT.  FOUND
* 
      ADA TEMP4     STEP THE ADDRESS
      ISZ TEMP2     SKIP IF END 
      JMP ALRN1     ELSE TRY NEXT ONE 
* 
      CLA            NO RN'S AVAILABLE NOW
      JMP $ALRN,I   SO EXIT WITH A=0
* 
ALRN2 STA RNADR     SAVE LOCATION 
      CMA,INA       SET TO CACULATE RN NUMBER 
* 
      LDB IDNO      GET THE USER ID NUMBER
      BLF,BLF       ROTATE TO HIGH HALF 
      XSB RNADR,I   SET THE ASSIGNMENT IN THE TABLE 
      ADA D$RN      COMPUTE RN NUMBER 
      CMA,INA       SET POSTIVE 
      ADA B         ADD THE USER ID FLAG
      JMP $ALRN,I   RETURN
* 
* 
$RNSU LDB RQOP      GET NO-WAIT OPTION FLAG 
      SSB           IF NO WAIT
      JMP EXRNW     THEN EXIT 
* 
$LUSU XSA XTEMP,I   SET THE SUSPEND FLAG
      JSB $LIST     AND PUT THE PROG IN LIST
      OCT 503       NUMBER 3. 
      JMP $XEQ      GO THE THE DISPATCHER 
* 
EXRNW LDB D5        ENTRY FOR 6/7 RETURN
$RNEX LDA RNADR     TEST THE RN LOCATION ADDRESS
      CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP
      LDB D4        NO RN STATUS
      XLA RNADR,I   GET THE RN
      SEZ,SZA,RSS   SKIP IF ALLOCATE PROBLEMS 
      CLB           ELSE SET DEALLOCATED FLAG IF RN IS ZERO 
      AND B377      MASK TO LOCK BITS 
      SZA           IF LOCKED 
      INB           STEP B TO SO INDICATE 
      CPA B377      IF GLOBAL 
      INB           STEP AGAIN
      STB RQST,I    SET THE STATUS WORD 
$LUEX LDB XEQT      SET THE RN BIT IN HIS 
      ADB D20       ID-SEGMENT
      XLA B,I 
      IOR B400
      XSA B,I 
      LDA RQRTN     PUSH UP HIS 
      XSA XSUSP,I   RETURN ADDRESS
      JMP $XEQ      ** GO TO THE DISPATCHER **
* 
* 
* 
$DRAD NOP            ADDR IS GIVEN IN A 
      RSS            GET DIRECT ADDRESS 
      LDA A,I         IF NOT ALREADY
      RAL,CLE,SLA,ERA 
      JMP *-2 
      JMP $DRAD,I   RETURN DIRECT ADDR IN A 
D$RN  DEF $RNTB+0   FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR
* 
* 
D5    DEC 5 
D4    DEC 4 
D20   DEC 20
B377  OCT 377 
B400  OCT 400 
TEMP1 NOP 
TEMP2 NOP 
TEMP4 NOP 
* 
RQOP  EQU 1701B     RQP2 IS RN/LU REQUEST CODE
RQNO  EQU 1702B     RQP3 IS ADDR OF RN/LU NUMBER
RQST  EQU 1703B     RQP4 IS ADDR OF RN/LU STATUS
IDNO  EQU 1704B     RQP5 IS USERS ID SEG #
RNADR EQU 1705B     RQP6 IS ADDR OF RN IN RN TABLE
RQRTN EQU 1677B 
XEQT  EQU 1717B 
XTEMP EQU 1721B 
XSUSP EQU 1730B 
* 
      ORG *         PROGRAM LENGTH
      END 
                              