ASMB,R,L,C
*     NAME:   LIMEM 
*     SOURCE: 92064-18069 
*     RELOC:  92064-16065 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 LIMEM,7  92064-16065  REV.1650  760927
* 
      EXT .ENTR,$LIBR,$LIBX 
* 
      ENT LIMEM 
* 
* 
.1    OCT 1 
.3    OCT 3 
.8    DEC 8 
.9    DEC 9 
.13   DEC 13
.14   DEC 14
.15   DEC 15
* 
CURLO NOP 
TMP1  NOP 
W24   NOP 
W27   NOP 
TP24  NOP 
DLIM  DEF LIMEM 
* 
* 
*      WHEN 0 WORDS AVAIL-- 
*        RETURN=
*               IFW=0 
*              IWAS=0 
*              A,B AND SEG PARMS ARE UNDEFINED
* 
* 
* 
      SKP 
* 
*     THIS ROUTINE LOCATES AVAILABLE MEMORY AND CHANGES 
*     THE HIGH MAIN ADDRESS OF THE CALLING PROGRAMS 
*     ID-SEGMENT TO ASSIGN AVAILABLE MEMORY TO THE PROG.
*       THIS ROUTINE ALSO RESETS THE THE ABOVE MODIFIED 
*     ADDRESS IF REQUESTED TO DO SO.
* 
* 
*      CALLING SEQUENCE:
* 
*         JSB LIMEM 
*         DEF RTN 
*         DEF WHICH   <0=RELEASE \ >=0 =FETCH 
* 
*         DEF FWAM    FIRST WORD AVAIL  
*         DEF NUM     NUMBER OF WORDS AVAIL 
* 
*         DEF FWAMS   FIRST WORD AVAIL PAST CURRENT SEG 
*         DEF NUMS    NUMBER OF WORDS AVAIL PAST CURR. SEG. 
* 
*   RTN   XXX 
* 
*        NOTE!  ONLY "WHICH" IS REQUIRED
* 
* 
      SPC 5 
LIMEM NOP 
* 
      LDB DLIM
      STB IWH 
      STA IFW 
      STB IWDS
      STB IFWAS 
      STB IWS 
      LDA LIMEM 
      STA DIMEN 
      JMP DIMEN+1 
* 
* 
IWH   DEF LIMEM 
IFW   DEF LIMEM 
IWDS  DEF LIMEM 
* 
*OPTIONAL PARAMETERS
* 
IFWAS DEF LIMEM 
IWS   DEF LIMEM 
* 
DIMEN NOP 
      JSB .ENTR     FETCH PARMS 
      DEF IWH 
* 
      LDA XEQT      INITIALIZE
      ADA .14 
      STA TMP1                 CURRENT
      ADA .9
      STA W24                            ID 
      ADA .3
      STA W27 
* 
      LDB TP24      SEE IF MEMORY ASSIGNED
      CLA 
      SZB 
      JSB SETIT     YES IT WAS, GO RESET( STA TP24 --STB W24,I) 
* 
* 
* 
      LDA IWH,I     FETCH TYPE WORD 
      SSA           CHECK RELEASE OR FETCH
      JMP EXIT      IT'S RELEASE--ALL DONE
* 
* 
*      FETCH AVAILABLE MEMORY 
* 
*      DETERMINE PROGRAM TYPE 
* 
      LDA TMP1,I    FETCH WORD CONTAINING TYPE
      AND .15       ISOLATE TYPE
      CPA .1        CHECK FOR FOREGROUND TYPE(1)
      JMP SRCH      YES IT IS--GO FIND FREE MEMORY
* 
*     COULD THERE EVER BE A CONFLICT WHERE APLDR
*     MIGHT TAKE THE FREE AREA BEFORE THE IDSEG 
*     COULD BE FUDGED?  -- IF SO THIS WHOLE ROUTINE 
*     SHOULD BE PRIV. 
* 
* 
*     WE ARE IN A PARTITION-- ALLOCATE THE REST OF IT.
* 
TOP   LDB AVMEM 
HIGH  LDA W24,I      FETCH START ADDRESS(MAIN)
* 
*     GO SET INTO IDSEG 
* 
      JSB SETIT     (STA TP24 ---STB W24,I) 
* 
      RSS           SKIP 0 WORD ENTRY 
* 
BAD   CLB           BAD IS USED WHEN 0 WORDS ARE AVAIL (A=0)
      STA IFW,I     SET AS FWAM FOR CALLER
* 
      CMA,INA       CALCULATE 
      ADA B         NUMBER OF WORDS AVAILABLE 
      STA IWDS,I    SET FOR CALLER
* 
* 
      LDA W27,I     FETCH CURRENT SEGMENT HIGH
      SZA            ANY SEGS LOADED?S
      INA,RSS       BUMP PAST LAST WORD IN SEG
      LDA IFW,I     NO SEGMENTS HAVE BEEN LOADED
      STA IFWAS,I   CURRENT SEG HIGH OR PROG. 
      CMA,INA       CALCULATE # WORDS 
      ADB A         AVAILABLE 
      STB IWS,I     RETURN VALUE TO USER
* 
* 
EXIT  JMP DIMEN,I 
* 
* 
*   IF PROG IS NON-SEGMENTED(WD 27 OF IDSEG =0) 
* 
*   ON RETURN--A=FWA
*              B=#WDS 
*   IF SEGMENTED--
*              A=FWA PAST SEG 
*              B=#WDS AVAIL PAST SEG
* 
* 
* 
* 
      SKP 
* 
* 
SRCH  LDA INDB      FIRST TIME,INDIRECT THRU (B)
      STA CURLO 
      LDB KEYWD 
      STB SETIT SAVE IDSEG POINTER
* 
SR2   LDB SETIT,I   FETCH ADDRESS OF ID SEG 
      SZB,RSS       IF END OF KEYWD TABLE 
      JMP END 
* 
      ADB .13       ADVANCE TO TYPE WD. 
      LDA B,I       FETCH TYPE
      SZA,RSS       THIS IDSEG ASSIGNED 
      JMP NO        NOPE--TRY NEXT ONE
      INB           ADVANCE TO TYPE WORD
      LDA B,I       FETCH IT
      AND .15       ISOLATE TYPE
      CPA .1        ONLY CHECK TYPE 1 PROGS 
      JMP FG        IT'S TYPE 1--CONTINUE 
* 
NO    ISZ SETIT     DIDN'T LIKE LAST ONE--GET NEXT ONE
      JMP SR2       CONTINUE SEARCH 
* 
* 
FG    ADB .8        ADVANCE TO LOW MAIN WORD
      LDA B,I       FETCH LOW MAIN
      CMA,INA       NEGATE
      STA TMP1      SAVE FOR SECOND TEST
      ADA W24,I     IS THIS LOW MAIN > CALLERS HIGH MAIN? 
      SZA,RSS       IF EQUAL
      JMP BAD             THEN EXIT 0 WORDS AVAILABLE 
      SSA,RSS       LOW > CALLER HIGH?
      JMP NO        NO--TRY NEXT ONE
* 
*    FIRST TIME THRU--
*        B=ADDR OF LOW MAIN &CURLO POINTS AT (B),I
*           SO RESULT WILL BE ZERO AND ADDRESS WILL BE SAVED. 
* 
* 
      LDA TMP1      FETCH CURRENT -LOW MAIN 
      ADA CURLO,I   SEE IF THIS LOWEST FOUND
*   VERIFY THAT SGN WILL WORK IN ALL CASES!!!!????
* 
      SSA,RSS 
      STB CURLO     YES IT'S THE LOWEST YET-SAVE IT 
* 
      JMP NO        NOT LOWEST--TRY NEXT ONE
* 
* 
END   LDB CURLO     SEE IF ANY BODY IS ABOVE CALLER 
      CPB INDB      CHECK AGAINST RESET VALUE 
      JMP TOP       NO ONE ABOVE--ALLOCATE REST OF MEMORY 
      LDB B,I       GOT ADDRESS -- FETCH VALUE
      JMP HIGH      GOT IT--GO SET THIS AS NEW HIGH MAIN
* 
* 
* 
SETIT NOP 
      JSB $LIBR 
      NOP 
      STA TP24
      STB W24,I 
      JSB $LIBX 
      DEF SETIT 
* 
INDB  OCT 100001    FIRST TIME ADD INDIRECT THRU (B)
KEYWD EQU 1657B 
XEQT  EQU 1717B 
AVMEM EQU 1751B 
A     EQU 0 
B     EQU 1 
* 
      END 
* 
                