ASMB,R,L,C
*     NAME:   RNRQ
*     SOURCE: 92071-18214 
*     RELOC:  92071-1X214 
*     PGMR:   HLC,DJN 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 RNRQ,6  92071-1X214  REV.2041  800620 
      ENT RNRQ
* 
      EXT $ERAB,$RNTA,$IDNO,$SCHD 
      EXT $LIBR,$PVCN,$ZPCN,.ENTP 
      EXT $LIST,$EXEX,$RQRT,$XEQ
      EXT $STAT,$XQT,$IDA,$SUSP 
      EXT .XLD,.XST 
      EXT $SJS0,$SJS1,$SJP,$ERMG
* 
      SUP 
A     EQU 0 
B     EQU 1 
* 
* 
* 
*     RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER
*      CALLS THAT CAN ALLOCATE, DEALLOCATE
*     SET AND CLEAR THE RN.  IF A RN REQUEST CAN NOT
*     BE GRANTED BECAUSE OF NONE AVAILABLE OR 
*     CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS 
*     SUSPENDED UNTIL THE RN BECOMES AVAILABLE
* 
*     THE EXEC CALL IS: 
* 
*       EXT RNRQ
* 
*       JSB RNRQ
*       DEF *+4 
*       DEF OPTION    OPTION ADDRESS
*       DEF RN        RN NUMBER ADDRESS/RETURN
*       DEF STAT      RN STATUS RETURN ADDRESS
*       <RETURN LOCATION> 
* 
*     WHERE:
* OPTIN BSS 1       OPTION WORD 
* RN    BSS 1       RN WORD 
* STAT  BSS 1       RN STATUS 
* 
*     THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE 
*     REQUEST AS FOLLOWS: 
* 
*     BIT           MEANING IF SET
*     BIT 0         SET THE RN LOCALLY
*     BIT 1         SET THE RN GLOBALLY 
*     BIT 2         CLEAR THE RN
*     BIT 3         ALLOCATE AN RN LOCALLY
*     BIT 4         ALLOCATE AN RN GLOBALLY 
*     BIT 5         DEALLOCATE THE RN 
*     BIT 14        DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B
*     BIT 15        RETURN EVEN IF REQUEST NOT GRANTED
* 
*     A LOCALLY ALLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR
*     A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER 
*     GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY
*     ANY PROGRAM.
* 
*     IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING
*     PRESEDENCE IS FOLLOWED: 
* 
*     1) LOCAL ALLOCATE (SKIP 2 IF DONE)
*     2) GLOBAL ALLOCATE
*     3) DEALLOCATE (SKIP 4, 5, & 6 IF DONE)
*     4) LOCAL SET (SKIP 5 IF DONE) 
*     5) GLOBAL SET 
*     6) CLEAR
* 
*     THIS IMPLIES THAT  RN MAY BE ALLOCATED,SET,AND CLEARED IN 
*     THE SAME REQUEST. 
*     A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. 
*     THERE ARE TWO RN CODE WORDS:
*     A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER 
*          REQUESTS). 
*     B) THE RN TABLE CODE WORD.
* 
*     THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) 
*     AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS 
* 
*     THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER
*      IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF
*      THE WORD.
* 
*     GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 
*     AVAILABLE/UNLOCKED IS CODED AS 0. 
* 
*     RN STATUS IS AS FOLLOWS:
* 
*     VALUE         MEANING 
*     0              NORMAL DEALLOCATE RETURN 
*     1              RN IS CLEAR (UNLOCKED) 
*     2              RN IS LOCKED LOCALLY TO CALLER 
*     3              RN IS LOCKED GLOBALLY
*     4              NO RN AVAILABLE NOW
*     5              NOT DEFINED
*     6              RN IS LOCKED LOCALLY TO OTHER PROGRAM
*     7              RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE.
* 
*     STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED
*     AND THE NO WAIT BIT WAS SET 
* 
*     POSSIBLE ERRORS FROM THIS CODE ARE: 
* 
*     ERROR         MEANING 
* 
*     RN00          NO BITS SET IN THE OPTION WORD. 
*     RN02          ILLEGAL RN NUMBER.
*     RN03          RELEASE OR UNLOCK OF UNOWNED RN.
*     RN REQUEST PROCESSOR
* 
      SKP 
TEMP  NOP 
RTNAD NOP 
RETRY NOP 
RNTA  NOP           WILL CONTAIN STARTING ADDRESS OF RN TABLE 
RNADR NOP           WILL CONTAIN ADDRESS OF RN FOR USER CALL
LBID# NOP           USER'S ID NUMBER IN LOW BYTE
HBID# NOP           USER'S ID NUMBER IN HIGH BYTE 
* 
* USER'S PASSED PARAMATER ADDRESSES 
* 
RQOP  NOP 
RQNO  NOP 
RQST  NOP 
RNRQ  NOP           ENTRY 
      JSB $LIBR     TURN OFF MEMORY PROTECT 
      NOP 
      JSB .ENTP     GET PARAMETER ADDRESSES 
      DEF RQOP
      STA RTNAD     COMPLETION ADDRESS
      ADA =D-5
      STA RETRY     RETRY ADDRESS 
      JSB .XLD      SET UP $SUSP TO HAVE ADDRESS OF JSB RNRQ
      DEF $SUSP     THIS IS REQUIRED FOR $ERAB CALL 
      STA B 
      LDA RETRY 
      JSB .XST
      DEF B,I 
* 
      JSB .XLD
      DEF $PVCN     PRIVILEDGE CALL NEST LEVEL
      ADA =D-1
      JSB .XST
      DEF $PVCN     SHOULD BE ZERO NOW
      STA TEMP      SAVE NEST LEVEL 
      JSB .XLD
      DEF $ZPCN 
      IOR TEMP      NOT CALLABLE FROM PRIVILEGED ROUTINE
      SZA 
      JMP SRERR     ABORT CALLER
      LDB RQOP,I    GET THE OPTION WORD 
      RBL,CLE,ELB   BIT 14 TO E 
      JSB .XLD      ADDRESS OF $STAT
      DEF $STAT 
      JSB .XLD      GET STAT WORD 
      DEF A,I 
      AND =B137777  CLEAR 'NA' BIT
      SEZ,RSS 
      JMP ABCAL     NORMAL CALL 
      IOR =B40000   SET 'NA' BIT
      ISZ RTNAD     BUMP RETURN ADDRESS 
ABCAL STA TEMP      SAVE NEW STAT WORD TEMPORARILY
      JSB .XLD      GET STAT ADDRESS
      DEF $STAT 
      STA B         PUT IT IN B REG FOR XST 
      LDA TEMP      GET NEW STAT WORD 
      JSB .XST      PUT IT IN THE ID
      DEF B,I 
* 
      JSB .XLD
      DEF $XQT
      STA B         STORE IDSEG ADDRESS IN B FOR $IDNO
      JSB $SJS0     GET THE ID SEGMENT NO.
      DEF $IDNO 
      STB LBID#     SAVE ORIGINAL ID NUMBER 
* 
      LDA RQOP,I
      AND =B77
      SZA,RSS       TAKE
      JMP ERN00     ERROR EXIT
* 
      AND =B30       MASK TO THE ALLOCATE BITS
      SZA,RSS       IF NO ALLOCATION REQUESTED
      JMP DAL       GO TEST FOR DEALLOCATE
* 
      AND =B10
      SZA,RSS       GLOBAL ALLOCATE? (BIT 4)
      LDB =B377      YES, SET IDNO TO 377B
      BLF,BLF        PUT ID NUMBER IN HIGH BYTE 
      STB HBID#     SAVE A COPY 
* 
      JSB .XLD      START OF RN TABLE 
      DEF $RNTA 
      STA RNTA      SAVE LOCALLY
      STA TEMP      TEMP STORES CURRENT RN ENTRY ADDRESS
ALRN1 ISZ TEMP      POINT TO NEXT ENTRY 
      JSB  .XLD 
      DEF $IDA      IDS FOLLOW RN TABLE 
      CPA TEMP      SCANNED ALL IDS?
      JMP NONE      YES,END OF TABLE
      LDB TEMP      GET RN TABLE ENTR ADDR
      JSB .XLD      RN TABLE ENTRY
      DEF B,I 
      SZA           RN FREE?
      JMP ALRN1     RN ALLOCATED, ITERATE 
* 
      LDB TEMP      GET ADDRESS OF RN ENTRY 
      STB RNADR     SAVE IT FOR LATER 
      LDA HBID#     GET OWNER'S ID # IN HIGH BYTE 
      JSB .XST      SET OWNER ID NO. IN TABLE 
      DEF B,I 
      LDA RNTA      STARTING ADDRESS OF RN TABLE
      CMA,INA       TAKE ITS TWO'S COMPLIMENT 
      ADA B         ADD ADDRESS OF RN ENTRY 
      IOR HBID#     ADD ID NO. IN HIGH BYTE 
      STA RQNO,I    RETURN INFORMATION TO CALLER
* 
      JMP DALX      TEST FOR DEALLOCATION 
* 
NONE  CLA 
      STA RQNO,I    SET IN THE USER AREA
      STA RNADR     CLEAR RN TABLE POINTER
      LDA RNTA      ALLOCATION FLAG 
* 
RNSUS LDB RQOP,I      GET NO-WAIT OPTION FLAG 
      SSB           IF NO WAIT
      JMP EXRNW     THEN EXIT 
* 
      STA TEMP      SAVE ALLOCATION FLAG
      JSB .XLD
      DEF $XQT
      STA B         PUT ID ADDR IN B FOR $LIST
      LDA TEMP      RESTORE ALLOCATION FLAG 
      JSB $SJS1     AND PUT THE PROG IN LIST
      DEF $LIST 
      OCT 51
      LDA RETRY     GET ORIGINAL ADDRESS OF CALL
      JSB .XST      LET SYSTEM KNOW WHERE TO RESUME 
      DEF $RQRT 
      JSB $SJP      GO TO THE DISPATCHER
      DEF $EXEX 
* 
EXRN  CLB,INB,RSS 
EXRNW LDB =D5        ENTRY FOR 6/7 RETURN 
RNEX  LDA RNADR     TEST THE RN LOCATION ADDRESS
      SZA,RSS       CAN'T DO XLD IF ADDRESS IS 0
      JMP NORN      RNADR IS ZERO, RETURN STATUS 4
      STB TEMP      SAVE B FOR XLD
      JSB .XLD      GET THE RN
      DEF A,I 
      LDB TEMP      RESTORE B AS IT WAS BEFORE XLD
      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
SETST STB RQST,I    SET THE STATUS WORD 
      LDA RTNAD     GET RETURN ADDRESS
      JSB .XST      SET $RQRT TO BE THE COMPLETED RETURN
      DEF $RQRT 
      JSB $SJP       ** GO TO THE DISPATCHER ** 
      DEF $EXEX 
* 
NORN  LDB =D4       RETURN NO RN
      JMP SETST     SET STATUS WORD AND GO TO DISPATCHER
* 
DAL   JSB .XLD      PICK UP ADDR OF START OF RN TABLE 
      DEF $RNTA 
      STA RNTA      LOCAL COPY MAY NOT BE DEFINED YET ON THIS PATH
      JSB .XLD      PICK UP # OF RN FOR RANGE CHECK 
      DEF A,I 
      STA TEMP      SAVE NUMBER OF RN 
      LDA RQNO,I    GET THE RN USER SUPLIED WORD
      AND =B377     ISOLATE THE RN#.
      STA B         TEST THE RN 
      CMB,INB       TO SEE IF IN THE TABLE
      ADB TEMP
      SZA           IF ZERO OR
      SSB           BIGGER THAN LEGAL 
      JMP ERN02     GO BOOM!
* 
      ADA RNTA      INDEX INTO RN TABLE 
      STA RNADR      SET THE RN ENTRY ADDRESS 
      JSB .XLD      GET THE RN ENTRY
      DEF A,I 
      XOR RQNO,I    IS IT OWNED?
      AND =B177400      BY THE SAME USER HE THINKS? 
      SZA 
      JMP ERN03     NO TOO BAD ABOUT THAT!
* 
DALX  LDA RQOP,I      TEST FOR
      AND =B40       DEALLOCATE 
      SZA,RSS       BIT SET?
      JMP SET       NO GO DO THE SET THING
* 
      LDA RQNO,I    GET THE RN AND
      ALF,ALF       MAKE SURE HE OWNS IT
      AND =B377      OWNER ID# TO A 
      CPA =B377      IF GLOBAL
      RSS           OR
      CPA LBID#      HE IS OWNER
      CLA,RSS       THEN SKIP THE 
      JMP ERN03     ABORT 
* 
      LDB RNADR     GET ADDRESS OF RN ENTRY 
      JSB .XST      CLEAR THE RN ASSIGNMENT 
      DEF B,I 
      LDA RNTA       RESCHEDULE 
      JSB $SJS1     ALLOCATION WAITERS
      DEF $SCHD 
      OCT 51
      JMP CLRN2     GO DO CLEAR SCHEDULING
* 
SET   LDB RNADR     GET RN ENTRY ADDRESS
      JSB .XLD      GET THE RN
      DEF B,I 
      AND =B377      MASK TO CURRENT LOCK 
      LDB RQOP,I      GET THE FLAG WORD 
      CCE,SLB,RSS   IF LOCK 
      ERB,SLB       THEN
      JMP LOKRN     GO DO LOCK
* 
CLRN  LDB RQOP,I      CHECK FOR CLEAR 
      RBR,RBR       FLAG.  IF NOT 
      SLB,RSS       SET JUST
      JMP EXRN      EXIT
* 
      SZA           IF NEVER LOCKED, THEN OK. 
      CPA =B377      IF GLOBALLY LOCKED 
      RSS 
      CPA LBID#      OR LOCKED BY CALLER
      RSS           THEN OK, ELSE 
      JMP ERN03     SEND 'RN03' 
* 
      STA TEMP      SAVE RN ENTRY 
      LDB RNADR 
      JSB .XLD      CLEAR THE RN. 
      DEF B,I 
      XOR TEMP
      LDB RNADR 
      JSB .XST      RESTORE THE WORD
      DEF B,I 
* 
CLRN2 LDA RNADR     SCHEDULE THE WAITERS
      JSB $SJS1 
      DEF $SCHD 
      OCT 51
      JMP EXRN      EXIT TO DISPATCHER PROPERLY 
* 
*     LOCK RN ROUTINE 
* 
LOKRN SZA           IF NOT LOCKED 
      CPA LBID#      OR LOCKED TO CALLER
      RSS           THEN OK  CONTINUE 
      JMP LKSUS     ELSE SUSPEND THIS GUY.
* 
      STA TEMP      SAVE RN ENTRY 
      LDA RNADR 
      JSB .XLD      CLEAR THE PREVIOUS LOCK FLAG
      DEF A,I 
      XOR TEMP      OR IN RN ENTRY
      IOR LBID#    ADD THE NEW ONE
      SEZ,RSS 
      IOR =B377     GLOBAL SET
      LDB RNADR     GET ENTRY ADDRESS IN B
      JSB .XST      STORE IN THE RN TABLE 
      DEF B,I 
      AND =B377     SET A=ID OF NEW LOCKER
      JMP CLRN      GO TEST FOR CLEAR OPTION
* 
LKSUS LDA RNADR     GET THE SUSPEND FLAG
      JMP RNSUS      AND GO SUSPEND 
      SPC 2 
* 
*     SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST 
*     WITH A FLAG = (RNADR)  (USUALLY RN LOCK REQUEST SUSPEND)
* 
ERN00 CLB,RSS 
ERN02 LDB =D2       B REGISTER RETURN 
      RSS           SKIP RN03 ERROR RETURN
ERN03 LDB =D3 
      LDA RTNAD     SET $RQRT FOR NO ABORT RETURN 
      JSB .XST
      DEF $RQRT 
      LDA =ARN      USE RN AS IDENTIFIER
      JSB $SJP      GO BOOM!#$#$%&'"
      DEF $ERAB 
* 
SRERR LDA =ASR
      LDB =A
      JSB $SJS0     'PROGA ABORTED SR   45400'
      DEF $ERMG 
      JSB $SJP      HERE $XEQ IS OK SINCE THE PROG IS ABORTED 
      DEF $XEQ
* 
      ORG *         PROGRAM LENGTH
      END 
                                                                                                                            