ASMB,Q,C
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER :92067-18395 
* 
*     RELOCATABLE PART NUMBER : 92067-16363 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
* 
* 
*     THIS ROTINE ALLOCATES MEMORY
*     AND CLASS NUMBERS FOR THE SESSION 
*     MONITER SYSTEM. 
*     IT THEN INITIALIZES THE MEMORY
*     COPY OF THE DISC POOL.
* 
* 
*     CALLING SEQUENCE: 
*       ISIZE=NSIZE 
*       CALL INMEN(ISIZE,MAXEV,IBUF,LNGTH,OLDLN)
*       IF(ISIZE.EQ.-1) GO TO 999 
*       . . . 
*       . . . 
*       . . . 
* 999   . . .  (NOT ENOUGH MEMORY)
* 
*     WHERE:  NSIZE IS REQESTED SIZE OF MEMORY
*             ISIZE IS RETURNED SIZE OF MEMORY
*                      OR (-1) NOT ENOUGH MEMORY
*             IBUF  IS BUFFER CONTAINING DISC POOL
*             LNGTH IS BUFFER LENGTH OF DISC POOL 
*             OLDLN IS OLD BUFFER LENGTH OF DISC POOL 
* 
* 
      NAM ACINM,7 92067-16363 REV.2001 791016 
      ENT ACINM,RLMEM 
      EXT .ENTR,EXEC,$LIBR,$LIBX
      EXT $LGOF,$LGON,$STH,$DSCS
      EXT $SMVE,$SRTI,$BALC,$BRTN,$SMEM,$SALI 
* 
A     EQU 0 
B     EQU 1 
* 
ISIZE NOP 
MAXEV NOP 
IBUF  NOP 
LNGTH NOP 
OLDLN NOP 
* 
ACINM NOP 
      JSB .ENTR 
      DEF ISIZE 
* 
*     SET UP POINTERS TO $SALC
* 
      XLA $SRTI+0   POINTER TO $SRTN
      STA $SRTN 
      XLA $SALI+0   POINTER TO $SALC
      STA $SALC 
* 
*     TEST IF SYSTEM ALREADY INITIALIZED
* 
      XLA DSCS,I
      SSA,RSS       IF >=0  JUST INITIALIZE 
      JMP DISPL     DISC POOL 
* 
      LDB ISIZE,I   IF REQUESTING NONE RETURN 
      SZB 
      SSA,RSS       IF < 0  INITIALIZE EVERYTHING 
      JMP ACINM,I   ELSE RETURN 
* 
*                   DOES $SALC HAVE MEMORY
* 
      XLA SMEM1,I 
      SZA 
      JMP ACLSS     YES BYPASS MEMORY ALLOCATION
* 
* 
*     GO GET BLOCK OF MEM 
* 
      JSB $BALC 
      DEF *+4 
      DEF ISIZE,I 
      DEF IADDR 
      DEF MAXEV,I 
* 
*     WAS ANY MEMORY ALLOCATED
      LDA ISIZE,I 
      SSA 
      JMP ACINM,I   NO RETURN 
* 
*                   COMPUTE SIZE AND ADDRESS OF BLOCK 
* 
      LDA IADDR 
      CMA,INA 
      STA ADDR      NEGATIVE OF ADDRESS 
      LDB ISIZE,I 
      CMB 
      STB WRDS      1'S COMPLIMENT OF SESION LENGTH 
* 
*     TELL $SALC SIZE AND ADDRESS 
* 
      JSB $LIBR 
      NOP 
      XSA SMEM,I
      XSB SMEM1,I 
      SJS $SRTN,I 
ADDR  NOP 
WRDS  NOP 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
* 
*     ALLOCATE CLASS NUMBERS
* 
ACLSS LDA LGOF      $LGOF 
      JSB SETCL 
      LDA LGON      $LGON 
      JSB SETCL 
      LDA STH       $STH
      JSB SETCL 
* 
*     FINALLY INITIALIZE $DSCS
* 
      CLA 
      JSB $LIBR 
      NOP 
      XSA DSCS,I    $DSCS 
      JMP DISP2 
* 
*     RETURN OLD MEMORY 
* 
DISPL JSB $LIBR 
      NOP           GO PRIVILEGED 
      STA ADDR2 
      LDA OLDLN,I   OLD LENGTH
      SZA,RSS       IF NONE PREVIOUSLY
      JMP DISP2     BYPASS RETURN OF MEMORY 
      STA WRDS2 
      SJS $SRTN,I 
ADDR2 NOP 
WRDS2 NOP 
* 
*     ALOCATE MEMORY FOR DISC POOL
* 
DISP2 LDA LNGTH,I 
      SZA,RSS 
      JMP SRTN      IF NO DISC POOL THEN END
      STA WRDS3 
      SJS $SALC,I 
WRDS3 NOP 
      JMP ERR 
      JMP ERR       IF NOT ENOUGH GO TO ACERR 
* 
*     SET $DSCS AND MOVE IN POOL
* 
      STB OLDLN,I   RETURN POOL LENGTH
      STA IADDR 
      XSA DSCS,I
* 
*     TRANSFER DISC POOL
* 
      JSB $SMVE 
      DEF SRTN
      DEF D2
      DEF IADDR 
      DEF NOP 
      DEF IBUF,I
      DEF LNGTH,I 
* 
SRTN  JSB $LIBX 
      DEF ACINM 
* 
*     ACERR SET ISIZE TO -2 
* 
ERR   LDA DM2 
      STA ISIZE,I 
      JMP SRTN
* 
*     CONSTANTS AND VARIABLES 
* 
LGOF  DEF $LGOF+0 
LGON  DEF $LGON+0 
DSCS  DEF $DSCS+0 
STH   DEF $STH+0
SMEM  DEF $SMEM+0 
SMEM1 DEF $SMEM+1 
* 
$SALC BSS 1 
$SRTN BSS 1 
IADDR BSS 1 
D0    DEC 0 
D2    DEC 2 
DM1   DEC -1
DM2   DEC -2
B20K  OCT 20000 
CLASS BSS 1 
CLADR BSS 1 
D18   DEC 18
D12   DEC 12
D21   DEC 21
D20   DEC 20
SESID BSS 1 
NOP   NOP 
* 
* 
*  THIS ROUTINE WILL ALLOCATE A CLASS # AND SAVE IT IN THE LOCATION 
*  POINTED AT BY THE (A) REGISTER. THIS IS USED TO DEFINE CLASS NUMBERS 
*  USED BY MULTIPLE PROGRAMS, USING A CLASS NUMBER DEFINED IN TABLE AREA
*  ONE. 
* 
*  CALLING SEQUENCE: LDA ADDR      (OF TABLE AREA 1 ENT)
*                    JSB SETCL
*          RTN: 
*               (THE VARIABLE 'CLASS' WILL CONTAIN THE CLASS NUMBER)
* 
* 
      SPC 5 
SETCL NOP 
      LDB A,I       FETCH POSSIBLE GLOBAL DEFINITION
      STB CLASS        AND SAVE FOR LATER USE.
      SZB           IF ALREADY DEFINED
      JMP SETCL,I      RETURN-- 
* 
      STA CLADR     SAVE GLOBAL ENT FOR RESTORATION 
* 
*   GET A CLASS NUMBER
*   (MAY NEED TO DO THIS WITHOUT WAIT IN CASE NO CLASSES ARE FREE)
* 
* 
      JSB EXEC      REQUEST 
      DEF CLRTN       A 
      DEF D18           ZERO LENGTH WRITE 
      DEF NOP               TO GET A CLASS# 
      DEF * 
      DEF NOP 
      DEF * 
      DEF * 
      DEF CLASS 
* 
* 
*  GO PRIV AND SAVE CLASS# IN TABLE AREA 1 UNLESS SOMEONE BEAT US TO IT.
* 
* 
CLRTN JSB $LIBR 
      NOP 
      LDB CLADR,I   IS IT STILL ZERO? 
      SZB             OR DID SOMEONE ELSE SET IT UP?
      JMP BEAT      SOMEONE ELSE DID IT FIRST-- 
* 
      LDA CLASS     FETCH CLASS NUMBER
      IOR B20K      SET DONT DEALLOCATE 
      STA CLADR,I      AND SAVE IT FOR EVERYONE TO SEE
      STB CLADR     SET THE "WE WON" FLAG 
* 
BEAT  JSB $LIBX     EXIT PRIV MODE
      DEF *+1 
      DEF *+1 
      LDA CLADR     WHO WON?
      SZA,RSS       IF WE GOT THERE FIRST,
      JMP SETCL,I        THEN RETURN
* 
      JSB EXEC      OTHERWISE, RETURN THE CLASS 
      DEF GETRT       OBTAINED ABOVE
      DEF D21 
      DEF CLASS 
      DEF SESID     NOTHING IS TRANSFERED 
      DEF NOP 
* 
GETRT LDA CLADR,I   FETCH THE CLASS NUMBER DEFINED BY SOMEONE ELSE
      STA CLASS     AND SAVE FOR OUR USE
      JMP SETCL,I 
* 
* 
*     RLMEM  RELEASES SESSION CLASS NUMBERS 
*            AND MEMORY 
* 
* 
IDSCS NOP 
ICLAS NOP 
RLMEM NOP 
      JSB .ENTR 
      DEF IDSCS 
* 
*                   RELEASE CLASS NUMBERS 
* 
      LDA ICLAS,I   RELEASE CLASS NUMBER  ICLASS
      JSB RLCL0 
      JMP RLME0 
      CLA 
      STA ICLAS,I 
RLME0 LDB STH       RELEASE $STH
      JSB RLCLS 
      LDB LGON      RELEASE $LGON 
      JSB RLCLS 
      LDB LGOF      RELEASE $LGOF 
      JSB RLCLS 
* 
      XLA SMEM,I
      STA ADDR7 
      CMA,INA 
      STA ADDR8 
      XLA SMEM1,I 
      STA WRDS7 
      CMA 
      STA WRDS8 
      CMA           SET FOR MEMORY CHECK
* 
      JSB $LIBR 
      NOP 
      LDB IDSCS,I 
      XSB DSCS,I
      SZA           IF MEMORY GONE RETURN 
      JMP RLME2 
      ISZ RLMEM 
      JSB $LIBX 
      DEF RLMEM 
RLME2 SJS $SRTN,I     GO TAKE MEMORY FROM SESSION 
ADDR7 NOP 
WRDS7 NOP 
* 
* 
      CLB 
      SSA,RSS       IF NOT DONE TAKE ACERR RETURN 
      JMP RLRT2 
* 
      XSB SMEM1,I   ELSE CLEAR MEMORY WORD COUNT
* 
      JSB $BRTN     AND RETURN MEMORY TO SYSTEM 
ADDR8 NOP 
WRDS8 NOP 
      ISZ RLMEM 
RLRT2 JSB $LIBX     THEN RETURN 
      DEF RLMEM 
* 
* 
*     RELEASE CLASS NUMBER
* 
RLCLS NOP 
      STB CLSAD     SAVE CLASS NUMBER ADDRESS 
      LDA B,I       GET CLASS NUMBER
      JSB RLCL0     GO TRY TO RELEASE 
      JMP RLCLS,I   IF NOT RELEASED JUST RETURN 
* 
      CLA           ELSE GO CLEAR ENTRY POINT 
      JSB $LIBR 
      NOP 
      XSA CLSAD,I 
      JSB $LIBX 
      DEF RLCLS 
* 
CLSAD BSS 1 
* 
* 
RLCL0 NOP 
      SZA,RSS       IF "0" RETURN 
      JMP RLCL0,I 
* 
      AND MASK      MASK SAVE BITS
      IOR SIGN      MERGE NO WAIT BIT 
      STA CLASS 
RLCLW JSB EXEC      WAIT 2 SECONDS TO CLEAR OUT 
      DEF RLCL1 
      DEF D12 
      DEF D0
      DEF D2
      DEF D0
      DEF DM2 
* 
RLCL1 JSB EXEC      TRY TO RELEASE CLASS # WITH GET 
      DEF RLCL2 
      DEF D21I
      DEF CLASS 
      DEF BUF 
      DEF D1
* 
RLCL2 JMP RLCL3     IF ABORTED CLASS IS RELEASED
      INA 
      SSA,RSS       IF DATA RETURNED OR NO BUFFERS
      JMP RLCL1     TRY AGAIN 
      JMP RLCL0,I 
* 
RLCL3 CPB A10       IF OUTSTANDING GET THEN GO DO CLASS WRITE READ
      JMP RLCL4 
      CPB A00       IF NO CLASS NUMBER IT'S RELEASED
      ISZ RLCL0     BUMP FOR RELEASED RETURN
      JMP RLCL0,I 
* 
SIGN  OCT 100000
MASK  OCT 017777
D21I  OCT 100025
BUF   BSS 1 
A00   ASC 1,00
A10   ASC 1,10
* 
*     CLASS WRITE/READ CALL 
* 
RLCL4 JSB EXEC
      DEF RLCL5 
      DEF D20 
      DEF D0
      DEF BUF 
      DEF D0
      DEF SC
      DEF DM1 
      DEF CLASS 
RLCL5 JMP RLCLW     GO TRY AGAIN
* 
D1    DEC 1 
SC    DEC -31178
* 
      END 
                                                                                                                                                                                                            