Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64a-sb
-
10,7/who/glxxxx.mac
There are 4 other files named glxxxx.mac in the archive. Click here to see a list.
TITLE GLXMEM -- Memory Manager for GALAXY Programs
SEARCH JOBDAT,MACTEN,UUOSYM
TWOSEG 400000
RELOC 0
RELOC 400000
TF==0 ;TRUE/FALSE REGISTER, NEVER REFERENCED DIRECTLY
S1==1 ;S1 & S2 ARE ARGUMENTS TO ROUTINES
S2==2 ;AND ARE OTHERWISE SCRATCH
T1==3 ;T1 - T4 ARE TEMPORARY REGS
T2==4
T3==5
T4==6
P1==7 ;P1 - P4 ARE PRESERVED REGS
P2==10
P3==11
P4==12
P==17 ;PUSHDOWN POINTER
DEFINE FNCSKP(NEW,OLD),<
ENTRY NEW
NEW: PUSH P,TF
PUSHJ P,OLD
SKIPF
AOS -1(P)
POP P,TF
POPJ P,
>
DEFINE FNC(NEW,OLD),<
ENTRY NEW
NEW: PUSH P,TF
PUSHJ P,OLD
SKIPT
PUSHJ P,S..UFR
POP P,TF
POPJ P,
>
FNC M$INIT,M%INIT
FNCSKP M$ACQP,M%ACQP
FNCSKP M$RELP,M%RELP
FNCSKP M$GPAG,M%GPAG
FNCSKP M$RPAG,M%RPAG
FNCSKP M$IPSN,M%IPSN
FNCSKP M$NXPG,M%NXPG
FNCSKP M$IPRC,M%IPRC
FNCSKP M$IPRM,M%IPRM
FNCSKP M$AQNP,M%AQNP
FNCSKP M$RLNP,M%RLNP
FNCSKP M$CLNC,M%CLNC
FNCSKP M$FPGS,M%FPGS
FNCSKP M$GMEM,M%GMEM
FNCSKP M$RMEM,M%RMEM
FNC L$INIT,L%INIT
FNC L$CLST,L%CLST
FNC L$DLST,L%DLST
FNC L$CENT,L%CENT
FNCSKP L$CBFR,L%CBFR
FNCSKP L$DENT,L%DENT
FNCSKP L$NEXT,L%NEXT
FNC L$FIRST,L%FIRST
FNC L$LAST,L%LAST
FNC L$APOS,L%APOS
FNCSKP L$PREVIOUS,L%PREVIOUS
FNCSKP L$PREM,L%PREM
FNCSKP L$CURR,L%CURR
FNCSKP L$SIZE,L%SIZE
FNCSKP L$RENT,L%RENT
; TABLE OF CONTENTS FOR GLXXXX
;
;
; SECTION PAGE
; 1. .SAVEx routines
; 1.1 save permanent ACs................................ 4
; 2. .POPJ, .POPJ1, .RETE,.RETT & .RETF
; 2.1 Common return routines............................ 4
; 3. .ZPAGA - .ZPAGN - .ZCHNK
; 3.1 Zero out memory................................... 4
; 4. Table of contents......................................... 5
; 5. Revision History.......................................... 6
; 6. Global Storage............................................ 7
; 7. M%INIT - Initialize the memory system..................... 8
; 8. PAGFRE - Determine if a given page is free or not......... 9
; 9. M%GPAG - Acquire one free page full of zeros (address).... 10
; 10. M%ACQP - Acquire one free page full of zeros (page number) 10
; 11. M%AQNP - Acquire several free pages full of zeros......... 11
; 12. FNDPAG - Find first free page............................. 11
; 13. CREPAG - Routine to create a page......................... 12
; 14. M%NXPG - Acquire the number of a free page for IPCF reception 13
; 15. M%RLNP - Release contiguous free pages.................... 14
; 16. M%RELP - Release a single page to the free pool (by page number) 14
; 17. M%RPAG - Release a single page to the free pool (by address) 14
; 18. M%FPGS - Return number of free pages...................... 14
; 19. M%IPSN - Inform that page is about to be sent via IPCF.... 15
; 20. M%IPRC - Inform that page has been created via IPCF....... 15
; 21. M%GMEM - Allocate a chunk of memory....................... 16
; 22. APMEM - Routine to add one page to the chunk pool........ 17
; 23. PGCOLL - Routine to remove whole pages from chunk free pool 18
; 24. M%RMEM - Routine to de-allocate a memory chunk............ 19
; 25. Consistency checking routines............................. 20
; 26. M%CLNC - Routines for cleaning up core.................... 21
; 27. M%IPRM - Routine to find a free page for an IPCF receive. 22
; 28. End....................................................... 23
; 29. GLXLNK
; 29.1 GALAXY Linked List Facility....................... 24
; 30. Larry Samberg 1-Jan-82.................................. 24
; 31. Table Of Contents......................................... 25
; 32. Revision History.......................................... 26
; 33. Data Structures........................................... 27
; 34. Module Storage............................................ 29
; 35. L%INIT
; 35.1 Initialize the GLXLNK Module...................... 30
; 36. L%CLST
; 36.1 Create a list..................................... 31
; 37. MORLST
; 37.1 Make room for more lists.......................... 32
; 38. L%DLST
; 38.1 Destroy a list.................................... 33
; 39. L%CENT
; 39.1 Create a list entry............................... 34
; 40. L%CBFR
; 40.1 Create entry "before" CURRENT..................... 35
; 41. L%DENT
; 41.1 Delete list entry................................. 36
; 42. List Positioning Routines................................. 37
; 43. L%APOS - Position to the Entry whose address is in S1..... 38
; 44. Global Utilities.......................................... 40
; 45. LINKIN
; 45.1 Link an entry into a list......................... 42
; 46. FNDLST
; 46.1 Find header of list............................... 43
OPDEF JUMPT [JUMPN]
OPDEF JUMPF [JUMPE]
OPDEF SKIPT [SKIPN]
OPDEF SKIPF [SKIPE]
OPDEF $CALL [PUSHJ P,] ;;CALL
OPDEF $RET [POPJ P,] ;;RETURN
OPDEF $RETT [PJRST .RETT] ;;RETURN TRUE
OPDEF $RETF [PJRST .RETF] ;;RETURN FALSE
OPDEF $RETIT [JUMPT .POPJ] ;;RETURN IF TRUE
OPDEF $RETIF [JUMPF .POPJ] ;;RETURN IF FALSE
.NODDT JUMPT, JUMPF, SKIPT, SKIPF
.NODDT $CALL, $RET
.NODDT $RETT, $RETF, $RETIT, $RETIF
DEFINE $GDATA(NAM,SIZ<1>),<NAM: BLOCK SIZ>
DEFINE $DATA(NAM,SIZ<1>),<NAM: BLOCK SIZ>
DEFINE $STOP(PFX,TXT),<
S..'PFX:JRST [OUTSTR [ASCIZ\?
?MEM'PFX TXT
\]
EXIT]
>
DEFINE TOPS10 <REPEAT 1,>
DEFINE TOPS20 <REPEAT 0,>
...COD==0
DEFINE $RETE(COD),<
PUSHJ P,.RETE
IFNDEF ER'COD'$,<ER'COD'$==:<...COD==...COD+1>>
JUMP ER'COD'$
>
DEFINE ZERO(ADR,MSK),<
IFNB <MSK>,PRINTX ?WRONG
SETZM ADR
>
DEFINE INCR(ADR,MSK),<
IFNB <MSK>,PRINTX ?WRONG
AOS ADR
>
DEFINE LOAD(AC,ADR,MSK),<
IFB <MSK>,<MOVE AC,ADR>
IFNB <MSK>,<LDB AC,[POINTR ADR,MSK]>
>
DEFINE STORE(AC,ADR,MSK),<
IFB <MSK>,<MOVEM AC,ADR>
IFNB <MSK>,<DPB AC,[POINTR ADR,MSK]>
>
DEFINE PG2ADR(AC),<LSH AC,^D9>
DEFINE ADR2PG(AC),<LSH AC,-^D9>
$STOP (UFR,<Unexpected FALSE return from GLXLIB call>)
PAGSIZ==^D512 ;SIZE OF ONE PAGE
MEMSIZ==^D512 ;PAGES IN THE ADDRESS SPACE
ND DDCNT,5 ;PAGES ADDED TO FREE POOL BEFORE
ND DCT.MN,1 ;MINIMUM SIZE OF ENTRIES IN DICTIONARY
ND DCT.MX,^D50 ;MAXIMUM SIZE OF ENTRY IN DICT
PT.FLG==777 ;FLAG FIELD OF PAGE TABLE ENTRY
PT.USE==1B35 ;INDICATES PAGE IS IN USE
PT.ADR==1B34 ;PAGE IS ADDRESSABLE (I.E. EXISTS)
PT.INI==1B33 ;PART OF INITIAL IMAGE (I.E. CODE, ETC.)
ND IPCPAD,1 ;MINIMUM NUMBER OF PAGES THAT MUST BE FREE
;BEFORE M%NXPG WILL RETURN ONE
ND CNK.PM,^D24 ;CHUNK MANAGERS PAGE COUNT BEFORE CLEANUP
ND PAGAVL,^D10 ;MAX PAGES IN MEM MANAGER BEFORE CLEANUP
SUBTTL .SAVEx routines -- save permanent ACs
; These routines act as co-routines with the routines which call them.
; Therefore, no corresponding "restore" routines are needed. When the
; calling routine returns to its caller, it actually returns via the
; restore routines automatically. These unconventional looking routines
; actually run about 30% to 40% faster than those in SCAN or the TOPS-10
; monitor.
.SAVE1: PUSH P,P1 ;SAVE P1
PUSHJ P,@-1(P) ;CALL THE CALLER
PORTAL .+3 ;NON-SKIP RETURN
PORTAL .+1 ;SKIP RETURN
AOS -2(P) ;ADJUST RETURN PC
POP P,P1 ;RESTORE P1
SUB P,[1,,1] ;ADJUST STACK
POPJ P, ;RETURN
.SAVE2: ADD P,[2,,2] ;ADJUST STACK
DMOVEM P1,-1(P) ;SAVE P1 AND P2
PUSHJ P,@-2(P) ;CALL THE CALLER
PORTAL .+3 ;NON-SKIP RETURN
PORTAL .+1 ;SKIP RETURN
AOS -3(P) ;ADJUST RETURN PC
DMOVE P1,-1(P) ;RESTORE P1 AND P2
SUB P,[3,,3] ;ADJUST STACK
POPJ P, ;RETURN
.SAVE3: ADD P,[3,,3] ;ADJUST STACK
DMOVEM P1,-2(P) ;SAVE P1 AND P2
MOVEM P3,0(P) ;SAVE P3
PUSHJ P,@-3(P) ;CALL THE CALLER
PORTAL .+3 ;NON-SKIP RETURN
PORTAL .+1 ;SKIP RETURN
AOS -4(P) ;ADJUST RETURN PC
DMOVE P1,-2(P) ;RESTORE P1 AND P2
MOVE P3,0(P) ;RESTORE P3
SUB P,[4,,4] ;ADJUST STACK
POPJ P, ;RETURN
.SAVE4: ADD P,[4,,4] ;ADJUST STACK
DMOVEM P1,-3(P) ;SAVE P1 AND P2
DMOVEM P3,-1(P) ;SAVE P3 AND P4
PUSHJ P,@-4(P) ;CALL THE CALLER
PORTAL .+3 ;NON-SKIP RETURN
PORTAL .+1 ;SKIP RETURN
AOS -5(P) ;ADJUST RETURN PC
DMOVE P1,-3(P) ;RESTORE P1 AND P2
DMOVE P3,-1(P) ;RESTORE P3 AND P4
SUB P,[5,,5] ;ADJUST STACK
POPJ P, ;RETURN
SUBTTL .POPJ, .POPJ1, .RETE,.RETT & .RETF -- Common return routines
; $RETE calls .RETE to set up the last GALAXY error and location
; then set TF = FALSE and return.
.RETE: MOVEI S1,@(P) ;GET RETURN PC
HRRZ S1,(S1) ;GET ERROR CODE
POP P,(P) ;TRIM STACK
;FALL INTO .RETF (RETURN TO CALLER'S CALLER)
; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly. They both set the value of TF, one to TRUE and the other
; to FALSE. After doing this, they return via a POPJ P,
;
.RETF: TDZA TF,TF ;ZEROS MEAN FALSE
.RETT: SETO TF, ;ONES MEAN TRUE
POPJ P, ;RETURN
; The .POPJ and .POPJ1 routines can be jumped
; to get a return, without changing the value in the TF register
;
.POPJ1: AOS (P) ;SKIP
.POPJ: POPJ P, ;RETURN
SUBTTL .ZPAGA - .ZPAGN - .ZCHNK -- Zero out memory
;ROUTINES TO COMPLETELY ZERO A PAGE OF MEMORY. .ZPAGA IS
; CALLED WITH THE ADDRESS OF THE FIRST WORD OF THE PAGE
; IN S1 AND .ZPAGN IS CALLED WITH THE PAGE NUMBER IN S1.
; .ZCHNK IS USED TO ZERO A CHUNK OF MEMORY
; SIZE IN S1 AND LOCATION S2
; ALL ACS ARE PRESERVED
.ZPAGN: PUSH P,S1 ;SAVE PAGE NUMBER
PG2ADR S1 ;CONVERT PAGE NUMBER TO ADR
SKIPA ;DON'T SAVE S1 TWICE
.ZPAGA: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;AND S2
MOVE S2,S1 ;GET ADDRESS INTO S2
MOVX S1,PAGSIZ ;AND ONE PAGE SIZE INTO S1
PJRST ZCHN.1 ;JOIN COMMON CODE
.ZCHNK::TRNN S1,-1 ;Anything to do?
$RETT ;No..just return
PUSH P,S1 ;SAVE CALLER'S SIZE
PUSH P,S2 ;AND ADDRESS
ZCHN.1: ZERO 0(S2) ;CLEAR FIRST WORD
SOJE S1,ZCHN.2 ;COUNT OF 1,,JUST RETURN
ADDI S1,0(S2) ;COMPUTE END ADDRESS
CAIGE S1,20 ;OUT OF THE ACS?
$STOP (AZA,<Attempt to zero the ACs>) ;++LOSER
HRLS S2 ;GET ADDR,,ADDR OF CHUNK
AOS S2 ;AND NOW ADDR,,ADDR+1
BLT S2,0(S1) ;NOW CLEAR THE CHUNK
ZCHN.2: POP P,S2 ;RESTORE CALLER'S CHUNK ADDR
POP P,S1 ;AND HIS SIZE
$RETT ;AND RETURN
SUBTTL Table of contents
; TABLE OF CONTENTS FOR GLXMEM
;
;
; SECTION PAGE
; 1. Entry Points found in GLXMEM.............................. 2
; 2. Table of contents......................................... 3
; 3. Revision History.......................................... 4
; 4. Global Storage............................................ 5
; 5. M%INIT - Initialize the memory system..................... 6
; 6. PAGFRE - Determine if a given page is free or not......... 7
; 7. M%GPAG - Acquire one free page full of zeros (address)... 8
; 8. M%ACQP - Acquire one free page full of zeros (page number) 8
; 9. M%AQNP - Acquire several free pages full of zeros........ 9
; 10. FNDPAG - Find first free page............................. 9
; 11. CREPAG - Routine to create a page......................... 10
; 12. M%NXPG - Acquire the number of a free page for IPCF reception 11
; 13. M%RLNP - Release contiguous free pages.................... 12
; 14. M%RELP - Release a single page to the free pool (by page number) 12
; 15. M%RPAG - Release a single page to the free pool (by address) 12
; 16. M%FPGS - Return number of free pages...................... 12
; 17. M%IPSN - Inform that page is about to be sent via IPCF.... 13
; 18. M%IPRC - Inform that page has been created via IPCF....... 13
; 19. M%GMEM - Allocate a chunk of memory....................... 14
; 20. APMEM - Routine to add one page to the chunk pool........ 15
; 21. PGCOLL - Routine to remove whole pages from chunk free pool 16
; 22. M%RMEM - Routine to de-allocate a memory chunk............ 17
; 23. Consistency checking routines............................. 18
; 24. M%CLNC - Routines for cleaning up core.................... 19
; 25. M%IPRM - Routine to swap out anything possible............ 20
; 27. TOPS-20 Dummy routines.................................... 22
SUBTTL Revision History
COMMENT \
Edit SPR/QAR Explanation
---- ------- -----------------------------------------------------
0001 First pass at GLXMEM, remove AP usage, etc.
0002 Remove TOPS-10 PFH and move it to the GLXINI module
0003 Convert to new OTS format
0004 Move creation of data area to INIT module
0005 Add M%GPAG and M%RPAG
0006 G053 Fix M%NXPG on the -20 to clear PT.USE and PT.WRK
0007 G054 Fix GMEM and RMEM to Garbage Collected when asked for
more than CNK.PM pages and cleanup core when available
pages exceeds PAGAVL
0010 Make BPN $STOP dump out offending page number
0011 Remove usage of PJUMPE opdef
0012 Arrange to zero our own $DATA space, but keep the stuff
we need for restart. Also, comment out the zeroing of any
location that gets zeroed on initialization.
0013 On TOPS20, make M%INIT start scanning for free pages
at c(.JBFF), not page zero.
0014 Restructure GLXLIB
1) Do PFH initialization here instead of in PFH. This includes
mapping core and marking all symbol table pages.
2) Create a non-sharable page and BLT the PFH into it.
3) As part of PFH setup, add new routine PFHADR to tell the
page fault handler where some of the memory manager data
base lives.
4) Add PFHRET kludge to allow the page fault handler to return
to the library when execute-only is in effect.
5) Copy NODDT routine here from PFH.
0015 Add new bit IB.NPF in the IB to disable GLXPFH.
0016 Shuffle some variables so GLXPFH can keep its data base in
core. This is needed to avoid the possibility of getting a
fault in the PFH itself. Also, force PFHRET whether or not
GLXLIB is execute only.
0017 Shift some stuff around to preserve which locations get
zeroed on a re-start. Broken by edit 16.
0020 Fix Stevens QAR on memory management loop. Allow calls to
M%GMEM of greater then CNK.PM*PAGSIZ words.
0021 Synchronize with edit 15 to GLXPFH. Remove interface from
GLXPFH to GLXMEM.
0022 Make creating PFH more robust. Don't call CREPAG to create
page for PFH, do our own PAGE. uuo. If fails because of
physical limit, swap out page 1, create ours, then swap 1
back in.
0023 Remove GLXPFH. Set PHY core limit low and request a timer
trap to invoke the system PFH.
0024 Clean and simplify M%IPRM. Allow it to give error returns.
0025 Remove reference to obsolete PFH symbols, and fix problem
with M%CLNC not being called enough to kill pages.
0026 Don't set guidelines since PFH will work without doing that.
0027 Dont reset PT.ADR when restarting so GLXMEM doesnt stopcode.
\
SUBTTL Global Storage
RELOC
$GDATA PAGTBL,MEMSIZ ;PAGE MAP OF ALL PAGES
$DATA PAGSTA ;STARTING POINT FOR PAGSRC PAGES
$DATA MEMBEG,0 ;START OF ZEROABLE DATA FOR GLXMEM
$DATA AVBPGS ;COUNT OF RELP'D BUT IN CORE PAGES
$DATA FREPGS ;COUNT OF FREE PAGES IN ADR SPACE
$DATA FREWDS ;FREINI, EXPRESSED AS WORDS NOT PAGES
$DATA DICT,DCT.MX+1 ;CHUNK DICTIONARY OF FREQUENTLY USED SIZES
$DATA PANFLG ;FLAG FOR CHUNK MANAGER
$DATA APCNT ;COUNTER FOR COLLECT OR ADD PAGE TEST
$DATA CNT.AP ;COUNTER: PAGES ADDED TO FREE CHUNK POOL
$DATA CNT.DD ;COUNTER: TIMES DICT HAD TO BE DUMPED
$DATA CNT.PC ;COUNTER: NUMBER OF PAGES GARBAGE COLLECTED
$DATA CNT.CL ;COUNTER: TIMES RECLAIMED MEMORY
$DATA MEMEND,0 ;END OF ZEROABLE DATA FOR GLXMEM
;HERE COMES NON-ZEROABLE $DATA SPACE
$DATA MEMFLG ;-1 WHEN M%INIT HAS BEEN CALLED
$DATA FREINI ;INITIAL VALUE OF FREPGS FOR CHECKING
RELOC
SUBTTL M%INIT - Initialize the memory system
; M%INIT HAS THE TASK OF PUTTING THE PAGE TABLE AND PAGE COUNTERS INTO
; A DETERMINED STATE.
; CALL IS: NO ARGUMENTS
;
;TRUE RETURN: ALWAYS
M%INIT: MOVE S1,[MEMBEG,,MEMBEG+1] ;SETUP BLT PTR TO ZERO $DATA SPACE
SETZM MEMBEG ;ZERO OUT FIRST LOCATION
BLT S1,MEMEND-1 ;AND DO THE REST
SKIPGE MEMFLG ;HAVE WE BEEN HERE BEFORE (RESTART)?
JRST INIT.3 ;YES, RESTORE INITIAL STATE
SETOM MEMFLG ;NO, DETERMINE INITIAL STATE
MOVEI S1,0 ;START AT PAGE 0
ADR2PG S1 ;CONVERT TO PAGE NUMBER
SETOM PAGSTA ;NO PAGE MARKED AS FIRST FREE YET
INIT.1: PUSHJ P,PAGXXX ;IS THIS PAGE FREE?
JUMPN S2,INIT.2 ;IF ITS IN USE, MARK IT AS SUCH
AOS FREINI ;INCREMENT COUNT OF FREE PAGES
SKIPGE PAGSTA ;HAVE WE ALREADY FOUND ONE FREE PAGE?
MOVEM S1,PAGSTA ;NO, SO SET IT UP NOW
INIT.2: STORE S2,PAGTBL(S1),PT.INI ;SAVE INITIAL BIT (1=PART OF ORIGINAL)
STORE S2,PAGTBL(S1),PT.USE ;SET THE PAGE STATUS UP TOO
STORE S2,PAGTBL(S1),PT.ADR ;AND ADDRESSABLE
CAIE S1,MEMSIZ-1 ;LOOP FOR ALL PAGES
AOJA S1,INIT.1 ;MARKING FREE AND INUSE
JRST INIT.6 ;THEN DO COMMON SET UP
INIT.3: MOVEI S1,0 ;START AT PAGE 0
INIT.4: LOAD S2,PAGTBL(S1),PT.INI ;GET INITIAL IN-USE BIT
STORE S2,PAGTBL(S1),PT.USE ;RESET 'IN USE' BIT FOR THIS PAGE
CAIE S1,MEMSIZ-1 ;ARE WE DONE?
AOJA S1,INIT.4 ;NO, SO DO NEXT PAGE
INIT.6: MOVE S1,FREINI ;GET NUMBER OF FREE PAGES
MOVEM S1,FREPGS ;STORE CURRENT NUMBER OF FREE PAGES
PG2ADR S1 ;CONVERT TO WORDS
MOVEM S1,FREWDS ;AND STORE THAT TOO
MOVX S1,DDCNT ;RE-SET THE DICT DUMP COUNT
MOVEM S1,APCNT ;FOR M%GMEM AND M%RMEM
PUSHJ P,M%CLNC ;CLEAN UP CORE
ZERO AVBPGS ;CLEAR COUNT OF AVAILABLE PAGES
$RETT ;ALL DONE, RETURN NOW
PAGXXX: LDB S2,[POINT 9,.JBREL,26] ;GET UPPER BOUND ON LOW SEG
CAMG S1,S2 ;WITHIN LOWER?
JRST PAGX1 ;YES--EXISTS
LDB S2,[POINT 9,.JBHRL,26] ;GET UPPER BOUND ON HIGH SEG
CAIL S1,400 ;HIGH SEG?
CAMLE S1,S2 ;..
TDZA S2,S2 ;NO--DOESNT EXIST
PAGX1: MOVEI S2,1 ;YES--EXISTS
$RETT ;AND RETURN
SUBTTL PAGFRE - Determine if a given page is free or not
;CALL S1/PAGE NUMBER OF PAGE IN QUESTION
;
;TRUE RETURN: S2/0 ;IF PAGE IS FREE
; OR
; S2/1 ;IF PAGE IS IN USE
PAGFRE: MOVE S2,S1 ;GET ARGUMENT (PAGE NR.)
HRLI S2,.PAGCA ;GET PAGE ACCESS
PAGE. S2, ;LOOK UP PAGE ACESS CODE
$STOP(PEF,Page existence check failed)
TXNE S2,PA.GNE ;DOES PAGE EXIST?
TDZA S2,S2 ;NO, RETURN 0, I.E. PAGE IS FREE
MOVX S2,1 ;YES, MARK IT AS IN USE
$RETT ;IN EITHER CASE, RETURN
SUBTTL M%GPAG - Acquire one free page full of zeros (address)
;This routine is called to acquire one free page (zeroed).
;
;Call: no arguments
;
;T Ret: S1/ address of first word of page acquired
M%GPAG: PUSHJ P,M%ACQP ;GET A PAGE
PG2ADR S1 ;CONVERT PAGE NUMBER TO ADDRESS
$RETT ;AND RETURN
SUBTTL M%ACQP - Acquire one free page full of zeros (page number)
;THIS ROUTINE IS CALLED TO ACQUIRE A SINGLE FREE PAGE
;
;TRUE RETURN: S1/PAGE NUMBER OF ACQUIRED PAGE
;
;FALSE RETURN: NEVER, STOP CODE "ASE" INSTEAD
;
M%ACQP: MOVEI S1,1 ;WILL ASK FOR 1 PAGE
SKIPG AVBPGS ;ANY "GOOD" PAGES AVAILABLE?
JRST M%AQNP ;NO, TAKE ANY AVAILABLE PAGE
MOVE S1,PAGSTA ;GET STARTING POINT FOR SEARCH
ACQP.1: CAIL S1,MEMSIZ ;OFF THE TOP OF MEMORY
$STOP(CAC,Count of Available Pages Confused)
MOVE S2,PAGTBL(S1) ;GET PAGE FLAGS
TXC S2,PT.ADR ;WANT TO TEST FOR ON
TXNE S2,PT.USE!PT.ADR ;IS IT FREE AND IN-CORE NOW
AOJA S1,ACQP.1 ;NOT THE BEST, TRY THE NEXT
PJRST CREPAG ;EXIT, CREATING AND ZEROING PAGE "S1"
SUBTTL M%AQNP - Acquire several free pages full of zeros
;CALL IS: S1/NUMBER OF PAGES DESIRED (MAYBE 1 TO MEMSIZ, BUT NOT 0)
;
;TRUE RETURN: S1/PAGE NUMBER OF FIRST PAGE ACQUIRED
;
;FALSE RETURN: NEVER, STOP CODE "ASE" INSTEAD
M%AQNP: SKIPG S1 ;WANTS 1 OR MORE PAGES, RIGHT?
$STOP(RZP,Request for zero pages) ; NO, SO STOP NOW
PUSHJ P,.SAVE3 ;SAVE A COUPLE FIRST
MOVE P1,S1 ;GET THE NUMBER REQUESTED
AQNP.0: MOVE S1,PAGSTA ;FIRST PAGE TO TRY FOR
MOVEI P2,-1(P1) ;COPY THE COUNT FOR THE LOOP BELOW
PUSHJ P,FNDPAG ;GET A PAGE
JUMPF AQNP.3 ;IF NO PAGES, TRY TO ROB CHUNK POOL
JUMPE P2,AQNP.2 ;DONE IF ONLY WANTS ONE
AQNP.1: MOVE P3,S1 ;SAVE THAT NUMBER
PUSHJ P,[ AOJA S1,FNDPAG] ;TRY NEXT PAGE NOW
JUMPF AQNP.3 ;IF FAILS, TRY COLLECTING
CAIE S1,1(P3) ;ARE THEY CONTIGUOUS?
MOVEI P2,(P1) ;NO, RESET LOOP COUNT
SOJG P2,AQNP.1 ;GET MORE IF REQUIRED
AQNP.2: PUSHJ P,CREPAG ;CREATE PAGE "S1"
SOJLE P1,.RETT ;RETURN IF ALL DONE
SOJA S1,AQNP.2 ;ELSE BACK DOWN TO THE NEXT ONE
AQNP.3: SKIPE PANFLG ;CALL FROM M%GMEM?
JRST S..ASE ;YES, ITS ALL OVER
PUSHJ P,PGCOLL ;COLLECT PAGES FROM CHUNK ODD SIZE POOL
JUMPT AQNP.0 ;IF WE GOT A PAGE, TRY ALL OVER
$STOP(ASE,Addressing space exhausted) ;ELSE, REALLY NO CORE LEFT
SUBTTL FNDPAG - Find first free page
;CALL IS: S1/ STARTING POINT FOR THE SEARCH
;TRUE RETURN: S1/ FIRST FREE PAGE
;FALSE RETURN: COULD NOT FIND A FREE PAGE
FNDPAG: CAIL S1,MEMSIZ ;ONLY WANT PAGES THAT ARE UNUSED
$RETF ;IF CAN'T FIND ONE, FAIL RETURN
LOAD S2,PAGTBL(S1),PT.USE ;THIS ONE USED
JUMPE S2,.RETT ;NO, TAKE THIS ONE
AOJA S1,FNDPAG ;TRY ANOTHER
SUBTTL CREPAG - Routine to create a page
CREPAG: PUSHJ P,REDUCE ;REDUCE COUNT OF FREE PAGES
MOVX S2,PT.USE ;GET THE INUSE BIT
IORB S2,PAGTBL(S1) ;SET IN USE, GET THE OTHERS
TXNE S2,PT.ADR ;IS IT ADDRESSABLE
JRST [SOS AVBPGS ;YES--DECREMENT "GOOD" PAGES
PJRST .ZPAGN] ;AND RETURN ZEROING PAGE
PUSHJ P,.SAVE4 ;SAVE P1-P4
CREP.1: MOVE P3,S1 ;ARGUMENT FOR CREATE A PAGE
MOVEI P2,1 ;ONLY 1 ARGUMENT
MOVE P1,[.PAGCD,,P2] ;FUNCTION CREATE/DESTROY,,ARGUMENTS
PAGE. P1, ;TRY THE CREATE
JRST CREP.2 ;ANALYZE THE ERROR
MOVX S2,PT.ADR ;ADDRESSABLE
IORM S2,PAGTBL(S1) ;INCLUDE THE FLAG
PJRST .ZPAGN ;RETURN, ZEROING THE PAGE
CREP.2: PUSH P,S1 ;SAVE THE PAGE WE'RE TRYING TO CREATE
CAIE P1,PAGNS% ;OUT OF SWAPPING SPACE
JRST CREP.3 ;NO, LOOK AGAIN
MOVEI S1,5 ;TAKE A QUICK NAP FIRST
SLEEP S1, ;IN CASE SOME FREES UP
PUSHJ P,M%CLNC ;FREE SOME SWAPPING SPACE
POP P,S1 ;RESTORE PAGE NUMBER
JRST CREP.1 ;AND RETRY THE CREATE
CREP.3: CAIE P1,PAGLE% ;MY LIMIT EXCEEDED
$STOP(CCP,Cannot create page) ;
PUSHJ P,M%IPRM ;SWAP OUT ANYTHING
SKIPT ;CHECK FOR ERRORS
$STOP (NFP,<No free pages>)
POP P,S1 ;RESTORE PAGE NUMBER
JRST CREP.1 ;RETRY THE CREATE
SUBTTL M%NXPG - Acquire the number of a free page for IPCF reception
;CALL NO ARGUMENTS
;
;TRUE RETURN: S1/THE PAGE NUMBER AVAILABLE FOR IPCF RECEIVE
;FALSE RETURN: S1/?, NO PAGES AVAILABLE AT THIS TIME, TRY LATER
;
; AFTER THE RECEIVE, A CALL TO M%IPRC IS REQUIRED.
M%NXPG:
NXPG.0: MOVE S1,FREPGS ;GET COUNT OF FREE PAGES
CAILE S1,IPCPAD ;ENOUGH TO HANDLE AN INCOMING MESSAGE
JRST NXPG.1 ;YES, GO TAKE ONE
PUSHJ P,PGCOLL ;NO, TAKE ONE FROM THE FREE SPACE
JUMPF .RETF ;CAN'T GET ONE, RETURN FALSE
JRST NXPG.0 ;TRY UNTIL ENOUGH FREE
NXPG.1: PUSHJ P,NXPG.3 ;FIND A COMPLETELY MISSING PAGE
JUMPT NXPG.2 ;TAKE THIS ONE IF WE CAN
PUSHJ P,M%CLNC ;DESTROY ANY PAGES I CAN
PUSHJ P,NXPG.3 ;NOW TRY TO FIND ONE
SKIPT ;GREAT IF WE GOT ONE
$STOP(CFC,Count of Free Pages Confused)
NXPG.2: MOVX S2,PT.USE!PT.ADR ;SET THE TEMP STATE
IORM S2,PAGTBL(S1) ;OF INUSE BUT NOT ADDRESSABLE
$RETT ;RETURN OUR SUCCESS
NXPG.3: MOVE S1,PAGSTA ;START AT THE FIRST AVAILABLE PAGE
NXPG.4: CAIL S1,MEMSIZ ;END OF THE ADDRESSING SPACE
$RETF ;YES, RETURN A FAILURE
MOVE S2,PAGTBL(S1) ;GET THE TABLE ENTRY
TXNN S2,PT.USE!PT.ADR ;IS THIS PAGE THERE
$RETT ;NO BITS MEANS OK TO USE IT
AOJA S1,NXPG.4 ;WELL, TRY THE NEXT
SUBTTL M%RLNP - Release contiguous free pages
;CALL IS: S1 / NUMBER TO RELEASE
; S2 / THE FIRST PAGE
;
;TRUE RETURN: ALWAYS
M%RLNP: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY THE ARGS OVER
RLNP.1: SOJL P1,.RETT ;DECR THE COUNT AND RTN ON 0
MOVE S1,P2 ;GET THE PAGE NUMBER
PUSHJ P,M%RELP ;RELEASE IT
AOJA P2,RLNP.1 ;AND LOOP
SUBTTL M%RELP - Release a single page to the free pool (by page number)
SUBTTL M%RPAG - Release a single page to the free pool (by address)
;CALL IS: S1/ PAGE NUMBER TO RELEASE
;
;TRUE RETURN: ALWAYS
M%RPAG: ADR2PG S1 ;CONVERT ADR TO PAGE
; AND FALL INTO M%RELP
M%RELP: PUSHJ P,VALPAG ;CONSISTENCY CHECK PAGE NUMBER
MOVE S2,PAGTBL(S1) ;GET THE FLAGS
TXNE S2,PT.ADR ;IS THIS THE ONE IPCF'ED AWAY
JRST RELP.1 ;NO, GO FIX THE COUNTS
ZERO PAGTBL(S1) ;CLEAR THE ENTRY
$RETT ;AND RETURN
RELP.1: PUSHJ P,.SAVE1 ;SAVE AN AC
MOVEI P1,PAGTBL(S1) ;SAVE ADDRESS OF PAGTBL ENTRY
PUSHJ P,INCLUD ;BUMP FREE PAGE COUNT
AOS S1,AVBPGS ;BUMP COUNT OF AVAILABLE PAGES
CAILE S1,PAGAVL ;EXCEED WORKING SET SIZE
PUSHJ P,M%CLNC ;YES..CLEANUP MEMORY
RELP.2: TXZ S2,PT.USE ;CLEAR IN USE
MOVEM S2,(P1) ;SAVE THE ENTRY IN PAGE TABLE
$RETT ;NOW RETURN..
;THIS WILL ALWAYS LEAVE ONE PAGE
;FOR AVBPGS
SUBTTL M%FPGS - Return number of free pages
;CALL NO ARGUMENTS
;
;TRUE RETURN: ALWAYS, S1/THE NUMBER OF PAGES FREE
M%FPGS: MOVE S1,FREPGS ;PICK UP THE NUMBER
$RETT ;AND RETURN
SUBTTL M%IPSN - Inform that page is about to be sent via IPCF
; CALL IS: S1/ PAGE NUMBER OF IPCF'ED PAGE
;
;TRUE RETURN: ALWAYS
M%IPSN: PUSHJ P,VALPAG ;CONSISTENCY CHECK PAGE NUMBER
MOVX S2,PT.ADR ;CLEAR ADDRESSABLE
ANDCAM S2,PAGTBL(S1) ;SO THAT WE DON'T GET CONFUSED
PJRST INCLUD ;BUMP FREE PAGE COUNT AND RETURN
SUBTTL M%IPRC - Inform that page has been created via IPCF
;CALL IS: S1/PAGE NUMBER THAT RECEIVE CREATED
;
;TRUE RETURN: ALWAYS
M%IPRC: PUSHJ P,VALPAG ;CONSISTENCY CHECK PAGE NUMBER
PUSH P,S1 ;SAVE THE PAGE NUMBER
HRLI S1,.PAGCA ;CHECK ITS ACCESS BITS
PAGE. S1, ;SEE IF THE PAGE IS SWAPPED OUT
$STOP(PAF,Page access check failed)
MOVX S2,PT.ADR ;ADDRESSABLE
TXNE S1,PA.GNE ;PAGE DOESN'T EXIST
$STOP(RNF,Received non-existent page)
POP P,S1 ;RESTORE PAGE NUMBER
IORM S2,PAGTBL(S1) ;INCLUDE THE FLAG(S)
PJRST REDUCE ;REDUCE COUNT OF FREE PAGES AND RETURN
SUBTTL M%GMEM - Allocate a chunk of memory
;CALL IS: S1/ NUMBER OF WORDS WANTED
;
;TRUE RETURN: S1/ NUMBER OF WORDS OBTAINED
; S2/ ADDRESS OF FIRST WORD
M%GMEM: PUSHJ P,.SAVE2 ;GET TWO WORK REGISTERS
CAMG S1,FREWDS ;IN RANGE OF AVAILABLE SPACE?
SKIPG S1 ;OR SILLY NUMBER?
$STOP(RNW,Ridiculous number of words requested)
CAIG S1,DCT.MX ;IF REQUIRED SIZE .GT. DICTIONARY
SKIPN S2,DICT(S1) ;OR IF DICTIONARY ENTRY IS 0
JRST GMEM.0 ;GO TRY THE ODD SIZE POOL
MOVE P1,0(S2) ;GET FORWARD LINK OF CHOSEN BLOCK
MOVEM P1,DICT(S1) ;STORE INTO HEAD AS NEXT TO CHOSE
PJRST .ZCHNK ;RETURN ZEROING CHUNK
GMEM.0: MOVE P1,S1 ;SAVE THE REQUIRED BLOCK LENGTH
MOVE S1,CNT.AP ;GET FREE POOL ALLOCATED PAGE COUNT
CAIL S1,CNK.PM ;WITHIN BOUNDS OF PAGES
PUSHJ P,[PUSHJ P,PGCOLL ;NO,,GARBAGE COLLECT
SETZM CNT.AP ;CLEAR ADDED PAGE COUNT
POPJ P, ] ;RETURN
MOVE S1,P1 ;RESTORE REQUIRED BLOCK LENGTH
GMEM.1: MOVEI S2,DICT ;START WITH HEADER OF ODD LIST
GMEM.2: MOVE P1,S2 ;REMEMBER WHO POINTS TO CURRENT
HRRZ S2,0(P1) ;S2 IS NOW CURRENT BLOCK
JUMPE S2,GMEM.4 ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ P2,0(S2) ;GET SIZE OF CURRENT BLOCK
CAMGE P2,S1 ;IS IT SUFFICIENT FOR REQUEST?
JRST GMEM.2 ;NO, SO TRY NEXT BLOCK
GMEM.3: HRL S2,0(S2) ;GET LINK OF CURRENT BLOCK
HLRM S2,0(P1) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS S2 ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN P2,S1 ;IS THIS AN EXACT MATCH ON SIZE?
PJRST .ZCHNK ;YES, RETURN, ZEROING CHUNK
PUSH P,S1 ;SAVE NUMBER OF WORDS
PUSH P,S2 ;SAVE ADDRESS
ADD S2,S1 ;GET FIRST WORD TO RETURN
SUBM P2,S1 ;NUMBER OF WORDS TO RETURN
PUSHJ P,M%RMEM ;RETURN THE EXTRA WORDS
POP P,S2 ;RESTORE ADDRESS OF BLOCK
POP P,S1 ;RESTORE NUMBER OF WORDS
PJRST .ZCHNK ;YES, RETURN, ZEROING CHUNK
GMEM.4: MOVEI P2,1(S1) ;START WITH NEXT DICT SLOT
GMEM.5: CAILE P2,DCT.MX ;IS THIS STILL INSIDE DICTIONARY?
JRST GMEM.6 ;TIME FOR MORE MEMORY
SKIPN S2,DICT(P2) ;ANYTHING IN THIS DICTIONARY SLOT ???
AOJA P2,GMEM.5 ;NO, TRY NEXT LARGEST
MOVEI P1,DICT(P2) ;P1 IS CELL POINTING TO CHOSEN
JRST GMEM.3 ;EXIT RETURNING EXTRA MEMORY
GMEM.6: PUSH P,S1 ;SAVE SIZE WANTED
PUSHJ P,APMEM ;TRY TO FIX UP FREE CHUNK POOL
POP P,S1 ;RESTORE THE SIZE
JRST GMEM.1 ;AND TRY AGAIN
SUBTTL APMEM - Routine to add one page to the chunk pool
;CALL IS: No arguments
;TRUE RETURN: Always
APMEM: PUSHJ P,.SAVE2 ;GET SOME INDICES
SETOM PANFLG ;DON'T WANT ANYTHING TO GO TO DICT
SOSL APCNT ;TIME TO DUMP THE DICTIONARY?
JRST APME.4 ;NO, JUST GET A PAGE
MOVEI P1,DCT.MX ;GET MAXIMUM DICTIONARY ENTRY
APME.1: MOVE P2,DICT(P1) ;GET START OF LINKED LIST FOR SIZE
SETZM DICT(P1) ;CLEAR IT OUT
APME.2: SKIPN S2,P2 ;DO WE HAVE A VALID ADDRESS?
JRST APME.3 ;NO, PROCESS NEXT SIZE
MOVE S1,P1 ;SET SIZE OF CHUNK UP
MOVE P2,0(P2) ;GET LINK TO NEXT BLOCK
PUSHJ P,M%RMEM ;AND RETURN IT
JRST APME.2 ;REPEAT FOR POSSIBLE NEXT BLOCK
APME.3: SOJG P1,APME.1 ;DO FOR ENTIRE DICTIONARY
MOVEI P1,DDCNT ;SET COUNTER AGAIN
MOVEM P1,APCNT ;RESET IT
SETZM PANFLG ;CLEAR PANIC LEVEL FLAG
INCR CNT.DD ;DUMPED DICTIONARY AGAIN
$RETT ;AND RETURN
APME.4: AOS CNT.AP ;BUMP THE ADDED PAGE COUNT
PUSHJ P,M%ACQP ;ACQUIRE A PAGE
SETZM PANFLG ;CLEAR PANIC LEVEL FLAG
MOVE S2,S1 ;GET PAGE NUMBER
PG2ADR S2 ;CONVERT TO AN ADDRESS
MOVEI S1,PAGSIZ ;AND THE SIZE
PJRST M%RMEM ;RETURN, RETURNING TO FREE POOL
SUBTTL PGCOLL - Routine to remove whole pages from chunk free pool
;This routine is called to remove, from the odd-size pool of the chunk
;manager, whole pages so that they are available to routines needing
;whole, page-aligned areas of memory.
;CALL IS: No arguments
;TRUE RETURN: A page has been freed
;FALSE RETURN: No page could be removed
PGCOLL: AOS CNT.CL ;BUMP NUMBER OF TIMES COLLECTED
SETZM APCNT ;FORCE DICTIONARY DUMP
PUSHJ P,APMEM ;TO INSURE FREE POOL IS ALL IN ODD SIZE
PUSHJ P,.SAVE4 ;NEED LOTS OF SCRATCH SPACE
SETZM CNT.PC ;CLEAR COUNT OF PAGES GOTTEN
MOVEI P1,DICT ;SEED HEAD OF LIST AS PREVIOUS
PGCO.1: HRRZ P2,0(P1) ;GET ADDR OF NEXT CHUNK
JUMPE P2,PGCO.2 ;IF 0 LINK, WE ARE AT END
HLRZ P3,0(P2) ;GET LENGTH OF THIS CHUNK
MOVE S1,P2 ;GET ADDRESS OF CHUNK
ADDI S1,PAGSIZ-1 ;AND ROUND UP TO
TRZ S1,PAGSIZ-1 ; PAGE BOUNDARY
MOVE P4,P2 ;COPY ADDRESS OF THIS CHUNK
ADD P4,P3 ;COMPUTE FIRST ADDR NOT IN THIS CHUNK
MOVE S2,S1 ;GET START OF CHUNK
ADDI S2,PAGSIZ ;ADDR OF PAGE STARTING HERE
CAMGE P4,S2 ;IS SIZE OF PAGE WITH BOUNDS OF CHUNK?
JRST [ MOVE P1,P2 ;NO, SO STEP TO NEXT CHUNK
JRST PGCO.1 ] ;AND TRY AGAIN
MOVE P4,S2 ;REMEMBER END ADDRESS OF PAGE SIZE CHUNK
HRRZ S2,0(P2) ;GET ADDR OF NEXT CHUNK IN CHAIN
HRRM S2,0(P1) ;DE-LINK THIS CHUNK
SUB S1,P2 ;COMPUTE LN. OF LEFT HAND OVERFLOW
MOVE S2,P2 ;AND ADDRESS LH OVERFLOW STARTS AT
SUBI P3,PAGSIZ(S1) ;ADJUST COUNT TO REFLECT 1 PAGE+LH
SKIPE S1 ;IF THERE IS ANY LEFT HAND TO RETURN
PUSHJ P,M%RMEM ;DO SO NOW
DMOVE S1,P3 ;GET SIZE, ADDR OF RH OVERFLOW
SKIPE S1 ;IF THERE IS ANY RH OVERFLOW,
PUSHJ P,M%RMEM ;RETURN IT NOW
INCR CNT.PC ;COUNT PAGES COLLECTED IN THIS MANNER
MOVE S1,P4 ;GET END ADDRESS OF PAGE SIZE CHUNK
SUBI S1,PAGSIZ ;IT STARTS HERE
PUSHJ P,M%RPAG ;RETURN THE PAGE
JRST PGCO.1 ;TRY TO GET SOME MORE
PGCO.2: SKIPG CNT.PC ;DID WE GET ANY
$RETF ;NO..RETURN FALSE
$RETT ;YES..RETURN TRUE
SUBTTL M%RMEM - Routine to de-allocate a memory chunk
;CALL IS: S1/ SIZE OF CHUNK BEING RETURNED
; S2/ ADDRESS OF CHUNK BEING RETURNED
;
;TRUE RETURN: ALWAYS
M%RMEM: PUSHJ P,.SAVE2 ;GET SOME WORK SPACE
PUSHJ P,VALADR ;VALIDATE THE ADDRESS
SKIPG S1 ;REASONABLE AMOUNT BEING RETURNED?
$STOP(ZWR,Zero words of memory returned)
SKIPE PANFLG ;ARE WE IN PANIC MODE?
JRST RMEM.1 ;YES, DON'T RETURN TO DICTIONARY
CAIL S1,DCT.MN ;LESS THAN SMALLEST OR
CAILE S1,DCT.MX ;GREATER THAN MAXIMUM IN DICT?
JRST RMEM.1 ;YES, RETURN TO ODD-SIZE POOL
MOVE P1,DICT(S1) ;GET LINK OF HEADER
HRRZM P1,0(S2) ;MAKE IT CURRENT BLOCK'S HEADER
HRRZM S2,DICT(S1) ;AND MAKE HEADER POINT TO CURRENT
$RETT ;RETURN NOW
RMEM.1: MOVEI P1,DICT ;GET PREV SET UP
RMEM.2: HRRZ P2,0(P1) ;GET PREV'S LINK
SKIPE P2 ;IF CURRENT IS 0 OR
CAIL P2,0(S2) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RMEM.3 ; THEN RETURN BLOCK HERE
MOVE P1,P2 ;MAKE PREV=CURRENT
JRST RMEM.2 ;CONTINUE
RMEM.3: HLRZ P2,0(P1) ;GET SIZE OF PREVIOUS
ADD P2,P1 ;ADD SIZE PLUS ADDRESS
CAIE P2,0(S2) ;DOES THIS PUT IT AT CURRENT BLOCK?
JRST RMEM.4 ;NO, CANNOT COMBINE
MOVE S2,P1 ;CONCATENATE PREV AND CURRENT
HLRZ P2,0(P1) ;GET SIZE OF PREVIOUS AGAIN
ADD S1,P2 ;MAKE A COMBINED SIZE
RMEM.4: HRLM S1,0(S2) ;STORE SIZE OF CURRENT BLOCK
HRRZ P2,0(P1) ;GET PREV'S FORWARD LINK
HRRM P2,0(S2) ;MAKE IT CURRENT'S FORWARD LINK
CAME S2,P1 ;UNLESS PREV=CURRENT (FROM CONCATENATION)
HRRM S2,0(P1) ;MAKE PREV'S FORWARD LINK POINT TO CURR.
MOVE P1,S2 ;GET ADDRESS OF CURRENT BLOCK
ADD P1,S1 ;ADD SIZE TO THAT
CAIE P1,0(P2) ;DO WE BUTT UP AGAINST NEXT?
$RETT ;NO, CANNOT COMBINE, RETURN NOW
HRLZS S1 ;YES, POSITION SIZE OF CURRENT
ADD S1,0(P2) ;MAKE COMBINED SIZE,,LINK TO NEW NEXT
MOVEM S1,0(S2) ;STORE NEW SIZE AND LINK
$RETT ;RETURN
SUBTTL Consistency checking routines
;"REDUCE" DECREMENTS THE FREE PAGE COUNT , "INCLUD" ADDS A FREE PAGE
;
REDUCE: SOSGE FREPGS ;DECREMENT COUNT OF FREE PAGES
$STOP(FCN,Free count negative)
$RETT ;RETURN IF OK
INCLUD: AOS S1,FREPGS ;ADD A FREE PAGE
CAMLE S1,FREINI ;MORE THAN WE STARTED OUT WITH
$STOP(FCE,Free count exceeds FREINI)
$RETT ;RETURN IF OK
;VALADR VALIDATES THE RANGE OF MEMORY THAT STARTS AT ADDR IN S2
; AND CONTINUES FOR THE NUMBER OF WORDS IN S1
VALADR: PUSH P,S1 ;SAVE INPUT ARGUMENTS
PUSH P,S2 ;FROM M%RMEM
EXCH S1,S2 ;GET ADDRESS IN S1, SIZE IN S2
ADR2PG S1 ;CONVERT TO A PAGE NUMBER
VALA.1: PUSHJ P,VALPAG ;VALIDATE IT
SUBI S2,PAGSIZ ;HAVE ACCOUNTED FOR ONE PAGE
SKIPLE S2 ;DONE ENTIRE CHUNK?
AOJA S1,VALA.1 ;NO, DO THE NEXT PAGE
POP P,S2 ;RESTORE S2 (ADDRESS)
POP P,S1 ;RESTORE S1 (SIZE)
$RETT ;AND RETURN
;VALPAG VALIDATES THE PAGE NUMBER IN AC S1
VALPAG: CAIL S1,MEMSIZ ;RANGE CHECK THE PAGE NUMBER
JRST S..BPN ;OUT OF RANGE OF PAGE TABLE
PUSH P,S2 ;SAVE CALLER'S AC
MOVE S2,PAGTBL(S1) ;GET THE PAGE TABLE ENTRY FOR PAGE
TXNN S2,PT.INI ;PART OF INITIAL CORE IMAGE?
TXNN S2,PT.USE ;OR NOT IN USE?
$STOP(BPN,Bad page number ^O/S1/) ;YES, STOP NOW
POP P,S2 ;RESTORE CALLER'S S2
$RETT ;RETURN IF OK
SUBTTL M%CLNC - Routines for cleaning up core
;CALL IS: NO ARGUMENTS
;
;TRUE RETURN: ALWAYS
M%CLNC:
PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVE P4,PAGSTA ;THE FIRST AVAILABLE PAGE
CLNC.1: CAIL P4,MEMSIZ ;OFF THE END OF THE WORLD
$RETT ;YES, RETURN
MOVE P1,PAGTBL(P4) ;GET THE TABLE ENTRY
TXC P1,PT.ADR ;NEED CHECK FOR BOTH SO FLIP
TXNN P1,PT.USE!PT.ADR ;USED OR NOT ADDRESSABEL
PUSHJ P,KILPAG ;DESTROY THE PAGE (COULD BE PAGED OUT)
AOJA P4,CLNC.1 ;AND CONTINUE LOOPING
KILPAG: MOVEI P3,(P4) ;WANT IT IN P3
TXO P3,1B0 ;SET TO DESTROY
MOVEI P2,1 ;1 ARGUMENT
MOVE P1,[.PAGCD,,P2] ;CREATE/DESTROY,,ARGUMENT
PAGE. P1, ;TRY TO DESTROY IT
$STOP(PKF,Page kill failed)
ZERO P1 ;CLEAR A REG
EXCH P1,PAGTBL(P4) ;CLEAR PAGE TABLE ENTRY, GET OLD FLAGS
SOS AVBPGS ;ONE LESS "GOOD" PAGE
$RETT ;RETURN
SUBTTL M%IPRM - Routine to find a free page for an IPCF receive
; M%IPRM will find a free page for an IPCF receive. To do this
; correctly in all cases, we create a page on disk, fault it into
; core, and destroy it. This leaves us a slot in our working set
; to receive an IPCF packet.
; Call: $CALL M%IPRM
;
; TRUE return: a page free in the working set
; FALSE return: can't find a free page
;
M%IPRM:
PUSHJ P,.SAVE3 ;SAVE SOME ACS
PUSHJ P,M%NXPG ;GET A NON-EXISTANT PAGE NUMBER
JUMPF IPRM.E ;CAN'T
MOVE P1,[.PAGCD,,P2] ;SET UP UUO
MOVEI P2,1 ;ONE WORD ARGUMENT
MOVE P3,S1 ;GET THE PAGE NUMBER
TXO P3,PA.GCD ;CREATE THE PAGE ON DISK
PAGE. P1, ;CREATE THE PAGE
JRST IPRM.E ;CAN'T
MOVE P1,S1 ;GET THE PAGE NUMBER
PG2ADR P1 ;CONVERT TO AN ADDRESS
MOVE S2,(P1) ;PAGE FAULT IT INTO CORE
MOVE P1,[.PAGCD,,P2] ;SET UP UUO
MOVEI P2,1 ;ONE WORD ARGUMENT
MOVE P3,S1 ;GET THE PAGE NUMBER
TXO P3,PA.GAF ;LITE THE DESTROY BIT
PAGE. P1, ;DESTROY THE PAGE
SKIPA ;CAN'T
$RETT ;RETURN
IPRM.E: $RETE (NFP) ;?NO FREE PAGES
SUBTTL End
MEM%L:
SUBTTL GLXLNK -- GALAXY Linked List Facility
SUBTTL Larry Samberg 1-Jan-82
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
LNKEDT==11 ;MODULE EDIT LEVEL
;THE GLXLNK MODULE PROVIDES A LINKED-LIST MANIPULATION FACILITY
; FOR THE GALAXY COMPONENTS. THE FACILITIES INCLUDE
; CREATING AND DESTROYING LISTS, CREATING AND DESTROYING
; ENTRIES WITHIN A LIST, SCANNING AND REARRANGING LISTS.
SUBTTL Table Of Contents
; TABLE OF CONTENTS FOR GLXLNK
;
;
; SECTION PAGE
; 1. Larry Samberg 7 Oct 77.................................. 1
; 2. Table Of Contents......................................... 2
; 3. Revision History.......................................... 3
; 4. Data Structures........................................... 4
; 5. Module Storage............................................ 6
; 6. L%INIT -- Initialize the GLXLNK Module.................. 7
; 7. L%CLST -- Create a list................................. 8
; 8. MORLST -- Make room for more lists...................... 9
; 9. L%DLST -- Destroy a list................................ 10
; 10. L%CENT -- Create a list entry........................... 11
; 11. L%CBFR -- Create entry "before" CURRENT................. 12
; 12. L%DENT -- Delete list entry............................. 13
; 13. List Positioning Routines................................. 14
; 14. L%APOS - Position to the Entry whose address is in S1..... 15
; 15. Global Utilities.......................................... 17
; 16. LINKIN -- Link an entry into a list..................... 19
; 17. FNDLST -- Find header of list........................... 20
SUBTTL Revision History
COMMENT \
0001 Create GLXLNK module.
0002 L%DENT Did no clear "current" when deleting the only entry
1. Make L%DENT not return address of "current"
2. Make L%DENT not return ERBOL$ after deleting the first entry
3. Remove L%CFEN and add a new routine, L%CBFR
0003 Fix bugs introduce in previous edit.
0004 Make L%PREM return error code ERNRE$ instead of stopcode NRE
for No remembered entry. (GCF #2).
0005 Add routine L%APOS for positioning to an entry by address.
0006 Zero out $DATA space like all the other modules do.
0007 Restructure GLXLIB
The PHASE/DEPHASE stuff around the linked list offset definitions
confused MACRO (and me) when the library was TWOSEG'ed. Remove the
PHASE/DEPHASE and redefine the symbols another way.
0010 Remove stopcodes ENF (entry not found) and NSL (no such list).
Replace them with error returns.
0011 Add a check following each call to FNDLST to make sure that
the link'ed list exists...
\ ;End of revision history
SUBTTL Data Structures
;EACH ENTRY IN A LIST IS FORMATTED AS SHOWN BELOW. WHEN A USER
; IS RETURNED THE ADDRESS OF AN ENTRY, IT IS ACTUALLY
; THE ADDRESS OF THE FIRST "USER DATA WORD" WHICH IS
; RETURNED.
; !=======================================================!
; ! ! CHUNK SIZE !
; !-------------------------------------------------------!
; ! POINTER TO PREVIOUS ENTRY ! POINTER TO NEXT ENTRY !
; !-------------------------------------------------------!
; ! !
; \ USER DATA AREA \
; \ \
; \ \
; ! !
; !=======================================================!
LEN.SZ==-2 ;SIZE OF THE CHUNK
LE.SIZ==0,,-1 ;THE SIZE FIELD
LEN.LK==-1 ;LINK WORD
LE.PTP==-1,,0 ;POINTER TO PREVIOUS
LE.PTN==0,,-1 ;POINTER TO NEXT
LEN.DT==0 ;FIRST USER DATA WORD
LENOVH==LEN.DT-LEN.SZ ;OVERHEAD PER ENTRY
;EACH LIST HAS AN INTERNAL LIST HEADER. THIS IS FORMATTED AS FOLLOWS:
; !=======================================================!
; ! POINTER TO LAST ENTRY ! POINTER TO FIRST ENTRY !
; !-------------------------------------------------------!
; ! ADDRESS OF CURRENT ENTRY !
; !-------------------------------------------------------!
; ! ADDRESS OF REMEMBERED ENTRY !
; !=======================================================!
HDR.LK==0 ;THE LINK WORD
HD.PTL==-1,,0 ;POINTER TO LAST ITEM
HD.PTF==0,,-1 ;POINTER TO FIRST ITEM
HDR.CU==1 ;ADDRESS OF CURRENT ENTRY
HDR.RM==2 ;ADDRESS OF REMEMBERED ENTRY
HDR.SZ==3 ;SIZE OF THE HEADER
SUBTTL Module Storage
RELOC
$DATA LNKBEG,0 ;START OF ZEROABLE $DATA SPACE
$DATA LSTNUM ;NUMBER OF LIST SLOTS
$DATA LSTADR ;ADDRESS OF LIST SLOTS
$DATA LSTFRE ;NUMBER OF FREE LIST SLOTS
$DATA LNKEND,0 ;END OF ZEROABLE $DATA SPACE
RELOC
SUBTTL L%INIT -- Initialize the GLXLNK Module
L%INIT: MOVE S1,[LNKBEG,,LNKBEG+1] ;SETUP BLT PTR TO ZEROABLE $DATA SPACE
SETZM LNKBEG ;DO THE FIRST LOC
BLT S1,LNKEND-1 ;AND BLT THE REST TO ZERO
$RETT ;AND RETURN
SUBTTL L%CLST -- Create a list
;L%CLST IS CALLED TO CREATE A LINKED-LIST. THE ROUTINE CREATES
; THE LIST AND RETURNS A LIST-NAME. THE LIST IS POSITIONED
; AT THE BEGINNING.
;CALL: NO ARGUMENTS
;
;TRUE RETURN: S1/ LIST NAME
L%CLST: SKIPN LSTFRE ;ANY FREE SLOTS?
PUSHJ P,MORLST ;NO, MAKE SOME
MOVE S1,LSTADR ;GET ADDRESS OF THE SLOTS
PUSHJ P,.SAVE1 ;SAVE P1
CLST.1: SKIPE 0(S1) ;IS THIS SLOT FREE?
AOJA S1,CLST.1 ;NO, LOOP FOR A FREE ONE
MOVE P1,S1 ;YES, SAVE ITS ADDRESS
MOVEI S1,HDR.SZ ;GET HEADER SIZE
PUSHJ P,M%GMEM ;GET SOME CORE
MOVEM S2,0(P1) ;SAVE THE ADDRESS
SUB P1,LSTADR ;MAKE A LIST NAME
SOS LSTFRE ;DECREMENT FREE LIST SLOTS
MOVE S1,P1 ;PUT IT IN THE CORRECT AC
JUMPE S1,L%CLST ;NEVER RETURN LIST 0
$RETT ;AND RETURN
SUBTTL MORLST -- Make room for more lists
;MORLST IS CALLED WHEN WE RUN OUT OF FREE SLOTS WHILE TRYING TO
; CREATE A NEW LIST.
MORLST: MOVE S1,LSTNUM ;GET CURRENT NUMBER OF SLOTS
ADDI S1,^D20 ;ADD THE INCREMENT
PUSHJ P,M%GMEM ;AND GET THE SPACE
EXCH S2,LSTADR ;SAVE THE NEW ADDRESS
JUMPE S2,MORL.1 ;IF FIRST CALL, NO OLD LIST ADDR
PUSH P,S2 ;SAVE THE OLD ADDRESS
HRL S2,S2 ;START BUILDING A BLT PTR
HRR S2,LSTADR ;FINISH BUILDING A BLT POINTER
MOVE S1,LSTADR ;GET START OF NEW TABLE
ADD S1,LSTNUM ;ADD LENGTH OF OLD TABLE
BLT S2,-1(S1) ;AND BLT OLD TO NEW
POP P,S2 ;GET ADDRESS OF OLD TABLE BACK
MOVE S1,LSTNUM ;GET ITS LENGTH
PUSHJ P,M%RMEM ;RETURN THE MEMORY
MORL.1: MOVEI S1,^D20 ;GET INCREMENT SIZE
ADDM S1,LSTNUM ;INCREMENT THE TOTAL
ADDM S1,LSTFRE ;AND THE FREE CELL COUNT
$RETT ;AND RETURN
SUBTTL L%DLST -- Destroy a list
;L%DLST IS CALLED WITH A LIST NAME TO DESTROY THE LIST. ALL
; ENTRIES IN THE LIST ARE RETURNED TO THE FREE SPACE POOL
; AND THE LIST IS DESTROYED.
;CALL: S1/ LIST NAME
;
;TRUE RETURN: ALWAYS
L%DLST: PUSH P,S1 ;SAVE LIST ID
PUSHJ P,L%LAST ;POSITION TO THE LAST
JUMPF DLST.2 ;DONE ALREADY!
DLST.1: PUSHJ P,L%DENT ;DELETE THE ENTRY
JUMPT DLST.1 ;AND LOOP
DLST.2: POP P,S1 ;RESTORE LIST NAME
ADD S1,LSTADR ;GET ADDRESS OF LIST SLOT
MOVEI S2,0 ;LOAD A ZERO
EXCH S2,0(S1) ;CLEAR LST SLOT AND LD ADDRESS
MOVEI S1,HDR.SZ ;GET HEADER SIZE
PUSHJ P,M%RMEM ;RETURN THE MEMORY
AOS LSTFRE ;INCREMENT FREE SLOT COUNT
$RETT ;AND RETURN
SUBTTL L%CENT -- Create a list entry
;L%CENT IS CALLED TO CREATE AN ENTRY AND LINK IT IN "AFTER" THE
; CURRENT ENTRY IN A LIST. IF THERE IS "NO" CURRENT ENTRY,
; THE ENTRY IS LINKED AS THE FIRST ENTRY.
;
;THE NEWLY CREATED ENTRY BECOMES CURRENT.
;
;CALL: S1/ LIST NAME
; S2/ ENTRY SIZE (IN WORDS)
;
;TRUE RETURN: S1/ LIST NAME
; S2/ ADDRESS OF CURRENT ("NEW") ENTRY
L%CENT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;SAVE LIST NAME AND SIZE
PUSHJ P,FNDLST ;FIND THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
EXCH P2,S2 ;SAVE HEADER ADR GET SIZE
MOVEI S1,LENOVH(S2) ;GET SIZE+OVERHEAD IN S1
PUSHJ P,M%GMEM ;GET THE SPACE
ADDI S2,LENOVH ;POINT TO USER DATA
STORE S1,LEN.SZ(S2),LE.SIZ ;STORE CHUNK SIZE
EXCH S2,P2 ;GET HEADER ADDRESS
MOVE S1,S2 ;PUT HEADER ADDRESS IN S1
MOVE S2,P2 ;PUT ENTRY ADDRESS IN S2
PUSHJ P,LINKIN ;GO LINK IT IN
DMOVE S1,P1 ;GET LIST NAME AND ENTRY ADR
$RETT ;AND RETURN SUCCESS
SUBTTL L%CBFR -- Create entry "before" CURRENT
; L%CBFR IS CALLED TO CREATE AN ENTRY IMMEDIATELY BEFORE THE CURRENT ONE
L%CBFR: PUSHJ P,.SAVE2 ;SAFE STOREAGE
DMOVE P1,S1 ;SAVE INPUT ARGS
PUSHJ P,L%PREV ;GET PREVIOUS
JUMPF CBFR.1 ;CHECK THE ERROR
DMOVE S1,P1 ;RESTORE ARGUMENTS
PJRST L%CENT ;CREATE ENTRY HERE
CBFR.1: MOVE S1,P1 ;GET LIST NAME
PUSHJ P,FNDLST ;FIND IT
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SETZM HDR.CU(S2) ;CLEAR CURRENT ENTRY
MOVE S2,P2 ;GET THE SIZE BACK
PJRST L%CENT ;GO CREATE THE ENTRY
SUBTTL L%DENT -- Delete list entry
;L%DENT IS CALLED TO DELETE THE CURRENT ENTRY IN A LIST. AFTER THE
; ENTRY IS DELETED, THE LIST IS POSITIONED TO THE IMMEDIATELY
; PREVIOUS ENTRY. IF THE ENTRY DELETED WAS THE FIRST ENTRY,
; CURRENT IS CLEARED.
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
;FALSE RETURN: S1/ ERNCE$
L%DENT: PUSHJ P,.SAVE3 ;SAVE P1, P2, P3
PUSHJ P,FNDLST ;FIND THE LST HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
DMOVE P1,S1 ;SAVE THE RETURNED INFO
SKIPN P3,HDR.CU(S2) ;GET THE ADDRESS OF CURRENT
$RETE(NCE) ;LOSE
CAMN P3,HDR.RM(S2) ;IS THIS THE "REMEMBERED" ENTRY?
ZERO HDR.RM(S2) ;YES, CLEAR "REMEMBERED"
LOAD S1,LEN.LK(P3),LE.PTP ;GET POINTER TO PREVIOUS
LOAD S2,LEN.LK(P3),LE.PTN ;GET POINTER TO NEXT
JUMPE S1,DENT.1 ;JUMP IF IT IS THE FIRST
JUMPE S2,DENT.2 ;JUMP IF IT IS THE LAST
STORE S1,LEN.LK(S2),LE.PTP ;STORE NEXT'S PREVIOUS
STORE S2,LEN.LK(S1),LE.PTN ;STORE PREVIOUS' NEXT
MOVEM S1,HDR.CU(P2) ;STORE AS "CURRENT"
JRST DENT.4 ;AND FINISH UP
;HERE IF DESTROYING THE FIRST
DENT.1: JUMPE S2,DENT.3 ;JUMP IF THIS IS THE "ONLY"
STORE S2,HDR.LK(P2),HD.PTF ;SET NEXT TO BE FIRST
STORE S1,LEN.LK(S2),LE.PTP ;CLEAR OUT THE "PREVIOUS
PUSHJ P,DENT.4 ;DO COMMON CODE FOR DELETE
ZERO HDR.CU(P2) ;CLEAR "CURRENT"
$RETT ;AND RETURN
;HERE IF DESTROYING THE LAST
DENT.2: STORE S1,HDR.LK(P2),HD.PTL ;SET PREVIOUS TO BE LAST
STORE S2,LEN.LK(S1),LE.PTN ;CLEAR OUT THE "NEXT"
MOVEM S1,HDR.CU(P2) ;STORE NEW "CURRENT"
JRST DENT.4 ;AND FINISH UP
;HERE IF DESTROYING THE ONLY
DENT.3: SETZM HDR.LK(P2) ;CLEAR THE LINK WORDS
SETZM HDR.CU(P2) ;CLEAR THE "CURRENT" WORD
DENT.4: LOAD S1,LEN.SZ(P3),LE.SIZ ;GET ENTRY SIZE
SUBI P3,LENOVH ;POINT TO BEGINNING OF CHUNK
MOVE S2,P3 ;PUT IN IN S2
PUSHJ P,M%RMEM ;RETURN THE MEMORY
MOVE S1,P1 ;GET LIST NAME BACK
$RETT ;AND RETURN
SUBTTL List Positioning Routines
;ROUTINES TO POSITION TO VARIOUS PLACES IN A LIST
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
; S2/ ADDRESS OF CURRENT ENTRY
;
;FALSE RETURN: S1/ ERBOL$ EREOL$ ERNCE$
L%NEXT: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE LIST NAME IN P1
PUSHJ P,FNDLST ;GET THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SKIPN HDR.CU(S2) ;GET THE CURRENT
JRST L%FIRST ;NO CURRENT, USE FIRST
MOVE S1,HDR.CU(S2) ;GET "CURRENT" ENTRY
LOAD S1,LEN.LK(S1),LE.PTN ;GET POINTER TO NEXT
SKIPN S1 ;IS THERE A NEXT ONE?
$RETE(EOL) ;NO, RETURN END-OF-LIST
JRST POSRET ;FINISH UP AND RETURN
L%FIRST:
PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE LIST NAME IN P1
PUSHJ P,FNDLST ;GET THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
LOAD S1,HDR.LK(S2),HD.PTF ;GET POINTER TO FIRST
SKIPN S1 ;IS THERE ONE?
$RETE(EOL) ;NO, EOL
JRST POSRET ;FINISH UP AND RETURN
L%LAST: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE LIST NAME IN P1
PUSHJ P,FNDLST ;GET THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
LOAD S1,HDR.LK(S2),HD.PTL ;GET POINTER TO LAST
SKIPN S1 ;IS THERE ONE?
$RETE(EOL) ;NO, RETURN EOL
JRST POSRET ;CLEAN-UP AND RETURN
SUBTTL L%APOS - Position to the Entry whose address is in S1
; Call: S1/ The List Id
; S2/ The Address of the Entry to be positioned to
;
; TRUE return: S1/ The List Id
; S2/ The Address of the Current Entry
; FALSE return: S1/ ERENF$
L%APOS: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
DMOVE P1,S1 ;SAVE THE INPUT ARGS
PUSHJ P,FNDLST ;GO FIND THE LIST WE WANT
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
MOVE S1,S2 ;SAVE THE LIST HEADER ADDRESS
LOAD S2,HDR.LK(S2),HD.PTF ;GET THE ADDRESS OF THE FIRST ENTRY
SKIPA ;SKIP THE FIRST TIME THROUGH
APOS.1: LOAD S2,LEN.LK(S2),LE.PTN ;GET THE ADDRESS OF THE NEXT ENTRY
SKIPN S2 ;CAN'T BE 'END OF LIST' !!!
$RETE (ENF) ;?ENTRY NOT FOUND
CAME S2,P2 ;DO THE ADDRESSES MATCH ???
JRST APOS.1 ;NO,,TRY THE NEXT ENTRY
MOVEM S2,HDR.CU(S1) ;MAKE THIS THE CURRENT ENTRY
DMOVE S1,P1 ;RESTORE THE INPUT ARGS
$RETT ;AND RETURN
L%PREVIOUS:
PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE LIST NAME IN P1
PUSHJ P,FNDLST ;GET THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SKIPN S1,HDR.CU(S2) ;GET THE CURRENT ENTRY
$RETE(NCE) ;NO CURRENT ENTRY
LOAD S1,LEN.LK(S1),LE.PTP ;GET POINTER TO PREVIOUS
SKIPN S1 ;DID WE HIT BOL?
$RETE(BOL) ;YES, GIVE THE ERROR
JRST POSRET ;AND FINISH UP
L%PREM: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE LIST NAME IN P1
PUSHJ P,FNDLST ;GET THE HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SKIPN S1,HDR.RM(S2) ;GET "REMEMBERED"
$RETE(NRE) ;RETURN NO REMEMBERED ENTRY
JRST POSRET ;AND FINISH UP
;HERE TO FINISH UP AND RETURN AFTER POSITIONING OPERATIONS
;CALL WITH: S1/ ADDRESS OF NEW CURRENT ENTRY
; S2/ ADDRESS OF LIST HEADER
; P1/ LIST NAME
;
;RETURN WITH: S1/ LIST NAME
; S2/ ADDRESS OF CURRENT ENTRY
;
;STORES THE NEW CURRENT ENTRY IN THE HEADER ALSO.
POSRET: MOVEM S1,HDR.CU(S2) ;STORE THE NEW CURRENT
MOVE S2,S1 ;GET THE NEW CURRENT
MOVE S1,P1 ;GET THE LIST NAME
$RETT ;AND RETURN
SUBTTL Global Utilities
;L%CURR - IS CALLED TO RETURN THE ADDRESS OF THE "CURRENT" ITEM
; IN A LIST.
;
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
; S2/ ADDRESS OF "CURRENT" ENTRY
;
;FALSE RETURN: S1/ ERNCE$
L%CURR: PUSHJ P,FNDLST ;FIND THE LIST HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SKIPN S2,HDR.CU(S2) ;GET THE CURRENT ENTRY
$RETE(NCE) ;THERE IS NONE
$RETT ;RETURN TRUE
;L%SIZE - IS CALLED TO RETURN THE SIZE OF THE CURRENT ENTRY IN A
; LIST.
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
; S2/ SIZE OF "CURRENT ENTRY"
;
;FALSE RETURN: S1/ ERNCE$
L%SIZE: PUSHJ P,FNDLST ;FIND THE LIST
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
SKIPN S2,HDR.CU(S2) ;GET ADDRESS OF CURRENT ENTRY
$RETE(NCE) ;THERE IS NONE
LOAD S2,LEN.SZ(S2),LE.SIZ ;GET THE CHUNK SIZE
SUBI S2,LENOVH ;SUBTRACT OFFSET TO DATA-AREA
$RETT ;AND RETURN
;L%RENT -- CALLED TO "REMEMBER" THE ADDRESS OF THE CURRENT ENTRY
; IN A LIST.
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
; S2/ ADDRESS OF CURRENT ENTRY
;
;FALSE RETURN: S1/ ERNCE$
L%RENT: PUSHJ P,FNDLST ;GET THE LIST HEADER
JUMPF [$RET] ;NO SUCH LIST,,RETURN ERROR
PUSHJ P,.SAVE1 ;SAVE P1
SKIPN P1,HDR.CU(S2) ;GET ADDRESS OF CURRENT
$RETE(NCE) ;NONE!
MOVEM P1,HDR.RM(S2) ;REMEMBER IT
MOVE S2,P1 ;COPY ADDRESS OVER
$RETT ;AND RETURN SUCCESS
SUBTTL LINKIN -- Link an entry into a list
;CALLED TO LINK AN ENTRY INTO A LIST "AFTER" THE CURRENT ENTRY.
; IF THERE IS NO CURRENT ENTRY, THE NEW ENTRY IS LINKED
; IN AT THE BEGINNING OF THE LIST.
;CALL: S1/ HEADER ADDRESS
; S2/ ENTRY ADDRESS
;
;MAKES THE NEW ENTRY THE "CURRENT" ENTRY IN THE LIST
LINKIN: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;AND SAVE THE CALL ARGS
SKIPN S1,HDR.CU(P1) ;IS THERE A CURRENT ENTRY?
JRST LINK.1 ;NO, LINK AT THE TOP
LOAD S2,LEN.LK(S1),LE.PTN ;GET ADDRESS OF NEXT
STORE S2,LEN.LK(P2),LE.PTN ;MAKE IT NEW PTN
STORE P2,LEN.LK(S1),LE.PTN ;MAKE THIS ITS PRED.
STORE S1,LEN.LK(P2),LE.PTP ;MAKE CURR NEW PRED.
JUMPE S2,LINK.2 ;JUMP IF THIS IS THE LAST
STORE P2,LEN.LK(S2),LE.PTP ;MAKE PRED. OF SUCC.
MOVEM P2,HDR.CU(P1) ;STORE NEW CURRENT
$RETT ;AND RETURN
LINK.1: LOAD S1,HDR.LK(P1),HD.PTF ;GET POINTER TO FIRST
STORE P2,HDR.LK(P1),HD.PTF ;MAKE THIS THE FIRST
STORE S1,LEN.LK(P2),LE.PTN ;MAKE IT 2ND
JUMPE S1,LINK.2 ;JUMP IF ALSO LAST ELEMENT
STORE P2,LEN.LK(S1),LE.PTP ;STORE OLD FIRST'S PREV POINTER
SKIPA ;AND DONT STORE AS LAST
LINK.2: STORE P2,HDR.LK(P1),HD.PTL ;ELSE STORE AS LAST
MOVEM P2,HDR.CU(P1) ;STORE NEW CURRENT
$RETT ;AND RETURN
SUBTTL FNDLST -- Find header of list
;FNDLST IS CALLED WITH A LIST NAME. IT SEARCHES FOR THE LIST
; HEADER AND RETURNS IT'S ADDRESS.
;CALL: S1/ LIST NAME
;
;TRUE RETURN: S1/ LIST NAME
; S2/ ADDRESS OF LIST HEADER
;FALSE RETURN: s1/ ERNSL$
FNDLST: SKIPL S1 ;NEGATIVE OR
CAML S1,LSTNUM ;GREATER THAN ALLOWABLE?
$RETE (NSL) ;?NO SUCH LIST
MOVE S2,LSTADR ;GET ADDRESS OF LIST SLOTS
ADD S2,S1 ;ADD IN THE OFFSET
SKIPN S2,0(S2) ;GET THE HEADER ADDRESS
$RETE (NSL) ;?NO SUCH LIST
$RETT
LNK%L:
END