Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-monitor/ipfree.new
There are no other files named ipfree.new in the archive.
;[SRI-NIC]SRC:<6-1-MONITOR>IPFREE.NEW.2, 6-Nov-87 00:20:28, Edit by MKL
; make new 6.1 IPFREE module from BBN source code
; UPD ID= 276, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.8, 7-Sep-84 22:54:50 by PAETZOLD
;Clean up a little. Remove repeat zeroes.
; UPD ID= 256, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.7, 26-Aug-84 17:45:45 by PAETZOLD
;NI buffers are now from IP free space. Remove RETNIB hack from RETBLK.
; UPD ID= 227, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.6, 6-Aug-84 19:12:32 by PAETZOLD
;Rewrite DNGWDS and DNFWDS to use ASGRES and friends.
; UPD ID= 147, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.5, 30-May-84 14:24:21 by PAETZOLD
;NIPLKB and NIPULK are here now.
;Make DNGWDS and DNFWDS lock and unlock the space.
; UPD ID= 97, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.4, 12-May-84 11:17:29 by PAETZOLD
;Forgot about DNFWDS
; UPD ID= 95, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.3, 12-May-84 10:51:42 by PAETZOLD
;CLRBLK now in this module. Add NISRV needed routines.
; UPD ID= 26, SNARK:<TCPIP.5.4.MONITOR>IPFREE.MAC.2, 5-Apr-84 20:52:04 by PAETZOLD
;MAXWPM is no longer 400.
; UPD ID= 4004, SNARK:<6.MONITOR>IPFREE.MAC.4, 28-Mar-84 20:56:45 by PAETZOLD
;More TCO 6.1733 - Move 1822 buffer stuff to here.
; UPD ID= 3825, SNARK:<6.MONITOR>IPFREE.MAC.3, 29-Feb-84 18:14:55 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug fixes. Cleanup.
;<TCPIP.5.3.MONITOR>IPFREE.MAC.4, 6-Dec-83 23:51:37, Edit by PAETZOLD
;<TCPIP.5.1.MONITOR>IPFREE.MAC.7, 5-Jul-83 08:25:34, Edit by PAETZOLD
;TCP changes for 5.1
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1982,1983,1984,
;BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH ANAUNV,PROLOG
TTITLE IPFREE
SUBTTL Internet Free Storage Routines
SWAPCD
COMMENT !
Routines to manage the INT freestorage area. Designed to
provide quick access to commonly used block sizes.
!
IF1 <IFN IPFDSW,<PRINTX Assembling Debuging IP Free Space>>
IFNDEF REL6,<REL6==1> ; default is release 6
IFNDEF MNTMN,<MNTMN==0>
DEFINE MNTM0(code),<IFGE MNTMN-0,<code>> ;Minimal monitoring
DEFINE MNTM2(code),<IFGE MNTMN-2,<code>> ;Low monitoring
DEFINE MNTM5(code),<IFGE MNTMN-5,<code>> ;Medium monitoring
DEFINE MNTM9(code),<IFGE MNTMN-9,<code>> ;Maximal monitoring
IFE REL6,<SWAPCD> ; THIS CODE IS SWAPPABLE
IFN REL6,<XSWAPCD> ; THIS CODE IS SWAPPABLE
; AC redefinitions:
IF1 <
BLK=P1 ; Holds pointer to block in question
SIZ=Q3 ; Holds size of block
LST=Q2 ; Holds pointer to a list of blocks
>
; Note: INTBLK(*) contains FSIZE & FLIST; i.e. a header w/o FNEXT
; Definitions for FREE block header structure:
DEFSTR(FSIZE,0,17,18) ; (User) Block size (excluding UBLKSZ)
DEFSTR(FLIST,1,35,36) ; List of other blocks
;INTBLS==2 ; Words per INTBLK entry (see ANAUNV)
DEFSTR(FNEXT,2,35,36) ; Next block higher in memory
FBLKSZ==3 ; Size of a FREE block header
; Definitions for USED block header structure:
DEFSTR(USIZE,0,17,18) ; (User) Block size (excluding UBLKSZ header)
DEFSTR(UHASH,0,35,18) ; Hash. Guards against user clobbering
UBLKSZ==1 ; Size of a USED block header
; Block size quantitization -- all blocks except very short ones
; are forced to be a multiple of this size.
BSMALL==10 ; Don't quantize this size or smaller
BSQUAN==10 ; Must be a power of 2
COMMENT !
Variables and tables related to free storage (in STG.MAC) are:
INTFSP # words of available free storage
BULKST Extended address of first word of never-used free storage,
or 0 if all has been used.
BULKND Extended address of last word of never-used free storage,
or 0 if all has been used.
INTBLK(NFIXED) Table of currently unused storage, by size; each
INTBLS words entry contains (SIZ & list), where list is an extended address.
HASHX(SIZ) provides the index.
ODDBLK List header of odd-size blocks (SIZ & list), sorted by
increasing extended address, or 0 if list is empty.
FRELCK(LOCKSZ) Lock for INTBLK and ODDBLK.
MRGFLG 0 if no free blocks can be merged into larger blocks,
Non-zero if merging might be possible.
INSVR Non-zero to scavange for more free storage.
INSVC Count of scavanges done.
INSVT TODCLK of next time an INTFR6 buginf should be reported.
!
SUBTTL IP Free Space Debugging code and storage
IFN IPFDSW,<
; Free space event ring buffer entries have the following format
.IPRFX==0 ; word 0/ 525252,,FORKX
.IPRBK==1 ; word 1/ Address of block
.IPFLG==2 ; word 2/ Flags from block
.IPRTD==3 ; word 3/ TODCLK value
.IPRHP==4 ; word 4/ HP time value
.IPSTK==5 ; word 4/ Stack Cells
.IPSTS==5 ; number of stack words to save
IPFLEN==<.IPSTK+.IPSTS>-.IPRFX+1 ; Length of ring entry
IPFRNN==^D50 ; number of entries in ring buffer
RS IPFRNG,<IPFRNN*IPFLEN> ; FREE SPACE EVENT RING BUFFER
RS IPFADR,1 ; CURRENT RING BUFFER ADDRESS
IFE REL6,<RESCD> ;1 THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ;1 THIS CODE IS RESIDENT
IPFTRK: ; TRACK IP FREE SPACE EVENTS
PUSH P,T1 ; SAVE ACS
PUSH P,T2
PUSH P,T3
PUSH P,T4
SETO T3, ; ASSUME PI IS ON
CONSO PI,PIPION ; IS PI ON?
TDZA T3,T3 ; NO SO TURN OFF FLAG
PIOFF ; YES SO MAKE THE MACHINE MINE
MOVE T1,IPFADR ; GET THE CURRENT RING POINTER
ADDI T1,IPFRNG ; OFFSET BY BASE ADDRESS OF THE RING BUFFER
HRRZ T2,FORKX ; GET OUR FORKX
HRLI T2,525252 ; GET THE MAGIC CODE
MOVEM T2,.IPRFX(T1) ; SAVE THE FIRST WORD
MOVE T2,-3(P) ; GET THE ADDRESS OF THE BLOCK (old T1)
MOVEM T2,.IPRBK(T1) ; SAVE IT
HRLI T2,INTSEC ; Make sure address is in Internet section
MOVE T2,1(T2) ; GET FLAGS FROM THE BLOCK
MOVEM T2,.IPFLG(T1) ; AND SAVE THEM AWAY
MOVE T2,TODCLK ; GET THE CURRENT TODLCK
MOVEM T2,.IPRTD(T1) ; SAVE TODCLK VALUE ALSO
PUSH P,T1 ; SAVE T1
JSP T4,MTIME ; GET THE HPTIM
MOVE T2,T1 ; GET THE TIME
POP P,T1 ; RESTORE T1
MOVEM T2,.IPRHP(T1) ; SAVE THE HPTIME VALUE
; NOW SAVE THE LAST .IPSTS STACK CELLS
HRLI T2,-<.IPSTS+2>(P) ; GET THE ADDRESS OF THE FIRST STACK WORD
HRRI T2,.IPSTK(T1) ; GET THE ADDRESS OF THE FIRST RING STACK WORD
BLT T2,<.IPSTK+.IPSTS-1>(T1) ; SAVE THE STACK CELLS
; NOW MOVE THE RING BUFFER ADDRESS
MOVE T1,IPFADR ; GET THE RING ADDRESS AGAIN
ADDI T1,IPFLEN ; BUMP THE RING POINTER
CAIL T1,<IPFLEN*IPFRNN> ; SHOULD THE POINTER LOOP AROUND?
SETZ T1, ; YES SO MAKE IT LOOP
MOVEM T1,IPFADR ; SAVE THE NEW RING POINTER
SKIPE T3 ; SHOULD WE GO PION?
PION ; YES SO GIVE BACK THE MACHINE
JRST PA4 ; POP ACS AND RETURN TO CALLER
IFE REL6,<SWAPCD> ;1 THIS CODE IS SWAPPABLE
IFN REL6,<XSWAPCD> ;1 THIS CODE IS SWAPPABLE
> ; end of IPFDSW
SUBTTL Internet Free Space Initialization and Misc Routines
;FREINI Initialize the Free Storage area
; CALL FREINI
;Ret+1: Always.
FREINI::
SETZRO FLIST,+ODDBLK ; No odd size blocks returned yet
MOVE T1,[INTBLK,,INTBLK+1] ; Set for a BLT
SETZM INTBLK ; Clear 1st word of table
BLT T1,INTBLK+<NFIXED*INTBLS>-1 ; Clear rest
MOVE T2,[INTSEC,,INTFRE] ; Pointer to the INT free area
MOVEM T2,BULKST ; Beginning of bulk storage
ADDI T2,INTFSZ-1
MOVEM T2,BULKND ; End of the bulk storage
MOVEI T4,INTFSZ
MOVEM T4,INTFSP ; Amount of free space available
SETZM MRGFLG ; No block merging possible yet.
SETZM INTSVC ; Count of scavenges done
SETZM INTSVT ; TODCLK filter of excessive BUGINF's
SETZM INTSVR ; Scavenge request flag
IFN NICSW,<
SETZM GCTAD ; last time of garbage collect
>
IFN IPFDSW,<SETZM IPFADR> ; IF DEBUGING RESET THE RING POINTER
MOVEI T1,FRELCK ; Free storage lock
CALLRET CLRLCK ; Initialize it
;FREAVL Returns amount of free storage available
;CALL FREAVL
;Ret+1: Always, number of words in T1
FREAVL::MOVE T1,INTFSP
RET
SUBTTL Internet Free Space Return Code
;RETBLK Return a block to free area
;T1/ (Extended) Pointer to the user portion of the block
; CALL RETBLK
;Ret+1: Always
RETBK2::SAVEAC <T2> ;SAME AS RETBLK BUT PRESERVES T2
RETBLK::
MNTM5 AOS CELL(INFAA,1,,INF) ; RETBLK calls
IFN IPFDSW,<CALL IPFTRK> ; IF DEBUGING TRACE THIS EVENT
XMOVEI T3,-UBLKSZ(T1) ; Pointer to free header
XMOVEI T2,RETBL1 ; Get address of worker routine
SKIPN PROC ; Have a TCP ID?
TXO T2,<100B8> ; No, use our ID (ought to fix all calls!)
MOVEI T1,FRELCK ; Lock to set
CALL LCKCAL ; Lock and call.
RET ; AND RETURN TO CALLER
RETBL1:
SAVEAC <BLK,SIZ,LST>
MOVE BLK,T1 ; Set block pointer
LOAD SIZ,USIZE,(BLK) ; and size (excluding header)
CALL RETBK0 ; Do the returning
RET
;RETBK0 Workhorse for above. Called with NOINT & FRELCK set.
;BLK/ (Extended) Pointer to the block to return
;SIZ/ Size of the block, excluding header
; CALL RETBK0
;Ret+1: Always
RETBK0: CALL CHKBLK ; Make sure header not crashed by user
MOVEI T1,UBLKSZ(SIZ) ; Total length of the block
ADDM T1,INTFSP ; Amount of free storage now available
ADD T1,BLK ; Next location in memory
STOR T1,FNEXT,(BLK) ; Save in free block
SETZRO FLIST,(BLK) ; Block may become the end of a list
SETOB T1,MRGFLG ; Say common size and merging possible
CALLRET RETB
;RETB Return the block to some list. Called with NOINT & FRELCK set.
;BLK/ (Extended) Block ; with FSIZE & FNEXT
;T1/ UserCall Flag ; Non-zero says to create a slot in
; CALL RETB
;Ret+1: Always
RETB0: ; Indicate not being returned by user
SETZ T1, ; Flag it
RETB:
PUSH P,T1 ; Save the flag
LOAD SIZ,USIZE,(BLK) ; Size excluding header
CALL HASHX ; Get -1 or index to INTBLK
POP P,T2 ; Restore the flag
JUMPL T1,RETB1 ; Jump if there is no slot for this size
JUMPE T2,RETB1 ; Jump if not a user's block size
MOVEI T2,INTBLK(T1) ; Pointer to the list head
LOAD LST,FLIST,(T2) ; Pointer to the list itself
STOR LST,FLIST,(BLK) ; Make block point to current tail
STOR BLK,FLIST,(T2) ; Make head point to new front of list
STOR SIZ,FSIZE,(T2) ; Be sure size is right in the table
JRST RETBX
; No entry in INTBLK table
RETB1: LOAD LST,FLIST,+ODDBLK ; The appropriate (extended) list
CALL SPUT ; Put block on that list
STOR LST,FLIST,+ODDBLK ; New list with block on it
RETBX: RET
SUBTTL Internet Free Space List Handling Code
;SPUT Put a block on an address ordered list
;BLK/ (Extended) Block pointer with FSIZE & FNEXT
;LST/ (Extended) List pointer
; CALL SPUT
;Ret+1: Always. New list containing Block in LST
CUR==T1
SUC==T2
SPUT: TRNE LST,-1
JRST SPUT1 ; Jump if not adding to null list
SETZRO FLIST,(BLK) ; Clear list pointer in block
MOVE LST,BLK ; New list has only this block
JRST SPUTX ; Return LST as new list
SPUT1: CAML BLK,LST ; Adding to front of list?
JRST SPUT2 ; No. Search for right spot.
; could check that FNEXT(BLK) le LST
STOR LST,FLIST,(BLK) ; Make BLK be first on the list
MOVE SUC,LST ; Init so rest works
MOVE LST,BLK ; Value to be returned
MOVE CUR,BLK ; Current block on list
JRST SPUT4
SPUT2: SKIPA CUR,LST ; Start at beginning of list
SPUT3: MOVE CUR,SUC ; Advance to next on list
LOAD SUC,FLIST,(CUR) ; Get the successor to CUR
CAML BLK,SUC ; BLK must be below SUC
TRNN SUC,-1 ; or SUC must be (section,,) 0
; (CUR is end of list)
CAMG BLK,CUR ; and BLK must be above CUR
JRST SPUT3 ; Not right place for insert
; could check that FNEXT(CUR) le BLK & FNEXT(BLK) le SUC
STOR SUC,FLIST,(BLK) ; Patch in BLK between CUR and SUC
STOR BLK,FLIST,(CUR)
; Try to merge BLK and SUC together
; CUR may equal BLK, SUC may equal (section,,0)
SPUT4: LOAD T4,FNEXT,(BLK) ; Word address following BLK
TRNN T4,-1
JRST SPUT5 ; Beware match on section,,0
CAME T4,SUC ; Combine BLK and SUC ?
JRST SPUT5 ; No
LOAD T3,FSIZE,(BLK) ; SUC is real block, not section,,0
LOAD T4,FSIZE,(SUC) ; end pointer
ADDI T3,UBLKSZ(T4) ; Size of combined block
STOR T3,FSIZE,(BLK)
LOAD T4,FNEXT,(SUC) ; End of SUC
STOR T4,FNEXT,(BLK) ; Is new end of combined block
LOAD SUC,FLIST,(SUC) ; Successor of SUC is new SUC
STOR SUC,FLIST,(BLK) ; and successor of combined BLK
; Try to merge BLK and SUC together
; CUR may equal BLK, SUC may equal (section,,0)
SPUT5: LOAD T3,FNEXT,(CUR) ; Address following CUR
CAME T3,BLK ; Combine CUR and BLK?
JRST SPUTX
LOAD T3,FSIZE,(CUR)
LOAD T4,FSIZE,(BLK)
ADDI T3,UBLKSZ(T4)
STOR T3,FSIZE,(CUR) ; Set size of combined block
LOAD T4,FLIST,(BLK) ; Successor of BLK
STOR T4,FLIST,(CUR) ; Is successor of combined block
LOAD T4,FNEXT,(BLK) ; Get thing following BLK in memory
STOR T4,FNEXT,(CUR) ; That is what follows compbined block
SPUTX: RET
PURGE CUR,SUC
SUBTTL Internet Free Space Variable Block Assignment Routines
;GETBBK Assign biggest block of free storage
;T1/ Minimum acceptable size
;T2/ Maximum usefull size
; CALL GETBBK
;Ret+1: Always. T1 has 0 or or size,,pointer
;***** N.B.: T1 does not have an extended address *****
;0 may be returned as a value meaning no space was available.
;The caller is expected to cope with this situation.
GETBBK::
MNTM5 AOS CELL(INFGK,0,,INF) ; GETBBK calls
MNTM5 CALL GETHST ; Histogram size
DMOVEM T1,T3 ; Place args for call via LCKCAL
MOVEI T1,FRELCK ; The lock to set
XMOVEI T2,[PUSH P,BLK ; Save ACs which will be
PUSH P,SIZ ; Used as globals
PUSH P,LST
HRRZ SIZ,T2 ; Max size
CALL GETBB0 ; Do the work
MOVE T1,BLK ; Value for caller
POP P,LST
POP P,SIZ
POP P,BLK
RET]
SKIPN PROC ; Have a TCP ID?
TXO T2,<120B8> ; No, use our ID (ought to fix all calls!)
CALL LCKCAL ; Call the function with the lock set
MNTM5 SKIPN T1 ; Returning something?
MNTM5 AOS CELL(INFGK,1,,INF); Count GETBBK failures
IFN IPFDSW,<CALL IPFTRK> ; IF DEBUGING TRACE THIS EVENT
RET ; AND RETURN TO CALLER
;GETBB0 Workhorse for the above. Called with NOINT & FRELCK set.
;T1/ Min. size
;SIZ/ Max. size, excluding header
;FRELCK set
;
; CALL GETBB0
;Ret+1: Always. BLK has 0 or size,,pointer
GETBB0: ACVAR <MINSIZ>
MOVEM T1,MINSIZ
CALL GETBK0 ; Use normal GETBLK routine
JUMPN BLK,GETBBX ; Exit if we got the max. size block
;Note that the fail return from GETBK0 indicates that a garbage
;collect has happened and that all free blocks are now in INTBLK+(n*INTBLS).
;Further, no block on ODDBLK is greater than or equal to the MAXSIZ.
MOVEI SIZ,0 ; Init max size seen
LOAD T2,FLIST,<+ODDBLK> ; Init pointer to first block
DO.
JUMPE T2,ENDLP. ; Jump if at end of list
LOAD T3,FSIZE,(T2) ; Get size of current block
CAMLE T3,SIZ ; Bigger than seen before?
MOVE SIZ,T3 ; Yes. Save max.
LOAD T2,FLIST,(T2) ; Point to next block
LOOP.
ENDDO.
;;; CAIG SIZ,BSMALL ; If its a small block,
;;; JRST GETBB3 ; Proceed, otherwise,
;;; SUBI SIZ,BSQUAN ; Round down to
;;; ANDCMI SIZ,BSQUAN-1 ; Smaller quantization
CAILE SIZ,BSMALL ; If it's a small block..
TRNN SIZ,BSQUAN-1 ; ..or an exact quantum,
JRST GETBB3 ; then leave it alone.
SUBI SIZ,FBLKSZ ; we will need this much extra to split it,
CAILE SIZ,BSMALL ; and unless it's now a small block,
ANDCMI SIZ,BSQUAN-1 ; round down to the next smaller quantization
GETBB3: CAMGE SIZ,MINSIZ ; Is the biggest block acceptable?
JRST GETBB9 ; No. Tell caller.
CALL GETBK0
JUMPN BLK,GETBBX ; Return if all went well.
IFE IPFDSW,<BUG.(CHK,INTFR7,IPFREE,SOFT,
<Internet Free Space - ODDBLK list fouled - want/have>,<<SIZ,D>,<MINSIZ,D>>,<
Cause: After searching for the largest available block of Internet free
storage, the largest block can not be found. The ODDBLK chain of
available storage blocks has probably been fouled.
Action: Follow the chain, to see if the reported size is wrong, or whether
the list has been fouled.
Data: Reported size of largest block, Size actually available.
>)>
IFN IPFDSW,<BUG.(HLT,INTFR7,IPFREE,SOFT,
<Internet Free Space - ODDBLK list fouled - want/have>,<<SIZ,D>,<MINSIZ,D>>,<
Cause: After searching for the largest available block of Internet free
storage, the largest block can not be found. The ODDBLK chain of
available storage blocks has probably been fouled.
Action: Follow the chain, to see if the reported size is wrong, or whether
the list has been fouled.
Data: Reported size of largest block, Size actually available.
>)>
GETBB9: SETZB BLK,SIZ ; Failure indication
GETBBX: HRL BLK,SIZ ; Place size for caller
RET
ENDAV.
SUBTTL Internet Free Space Assignment Routines
;GETBLK Assign a block of free storage
;T1/ Size
; CALL GETBLK
;Ret+1: Always. 0 or Extended Pointer to block in T1
;0 may be returned as a value meaning no space was available.
;The caller is expected to cope with this situation.
GETBL2::SAVEAC <T2>
GETBLK::
MNTM5 AOS CELL(INFGB,0,,INF) ; GETBLK calls
MNTM5 CALL GETHST ; Histogram size
MOVE T3,T1 ; Place in right ac
MOVEI T1,FRELCK ; Lock to set
XMOVEI T2,GETBL0 ; Address of the jacket routine
SKIPN PROC ; Have a TCP ID?
TXO T2,<110B8> ; No, use our ID (ought to fix all calls!)
CALL LCKCAL ; Call routine with lock set
MNTM5 SKIPN T1 ; Returning something?
MNTM5 AOS CELL(INFGB,1,,INF); Count GETBLK failures
IFN IPFDSW,<CALL IPFTRK> ; IF DEBUGING TRACE THIS EVENT
RET ; AND RETURN TO CALLER
; Histogram calls, T1 has size, preserve T1 & T2
GETHST:
MNTM5 INHIST(INFHS,INF,T1,T3,T4);Histogram block sizes (CELL()
RET
GETBL0: SAVEAC <BLK,SIZ,LST> ; Jacket routine
MOVE SIZ,T1 ; Get the requested size
CALL GETBK0 ; Do the work
MOVE T1,BLK ; Return the address of the block
RET
;GETBK0 Workhorse for above. Called with NOINT & FRELCK set.
;SIZ/ Size of block to be assigned, excluding header
; CALL GETBK0
;Ret+1: Always. 0 or Extended Pointer to block in BLK. Must save SIZ.
GETBK0: JUMPG SIZ,GETBK1
BUG.(HLT,INTFR4,IPFREE,SOFT,
<Internet Free Space - Block size requested too small - siz>,<<SIZ,D>>,<
Cause: A request for a negative or zero length block of Internet free
storage has been detected.
Action: Examine the stack (P/) to find which routine is making the bad
request.
Data: Size being requested.
>)
MOVEI SIZ,1 ; Min size we ever hand out
GETBK1: CAILE SIZ,INTFSZ-UBLKSZ ; Max size
BUG.(HLT,INTFR5,IPFREE,SOFT,
<Internet Free Space - Block size requested too large - siz>,<<SIZ,D>>,<
Cause: A request for a block of Internet free storage which exceeds
the maximum size allowed has been detected.
Action: Examine the stack (P/) to find which routine is making the bad
request.
Data: Size being requested.
>)
CAIG SIZ,BSMALL ; Don't quantize Q heads etc.
JRST GETBK2
ADDI SIZ,BSQUAN-1 ; Round up
ANDCMI SIZ,BSQUAN-1 ; To nearest bigger multiple
GETBK2: CALL GETB ; Get it from somewhere
JUMPE BLK,GETBKX ; Couldn't get the block
MOVNI T2,UBLKSZ(SIZ) ; Size of block we will hand out
ADDM T2,INTFSP ; Decrease amt of free space available
CALL HASH ; Get a random number
STOR T1,UHASH,(BLK) ; Check this when block returned
STOR SIZ,USIZE,(BLK) ; Set the block size
XMOVEI BLK,UBLKSZ(BLK) ; Value is user area of the block
GETBKX: RET
SUBTTL Internet Free Space Misc Routines
;GETB Get a block from somewhere. Called with NOINT & FRELCK set.
;SIZ/ Size, excluding header
; CALL GETB
;Ret+1: Always. 0 or (Extended) Pointer to block in BLK
GETB: SETZ T1, ; Don't create a slot
CALL HASHX ; Get index to INTBLK table
JUMPL T1,GETB2 ; Not in table.
MOVEI T3,INTBLK(T1) ; Address of list head
LOAD T4,FLIST,(T3) ; Pointer to list of blocks of this size
JUMPE T4,GETB2 ; None. Try something else.
LOAD T2,FLIST,(T4) ; Successor of 1st block on list
STOR T2,FLIST,(T3) ; Is now first thing on list
SKIPA BLK,T4 ; This block is the result
GETB2: CALL GCARVE ; Look elsewhere for a block
RET
;GCARVE Carver a block of the required size from an odd block.
;SIZ/ Size, excluding header
; CALL GCARVE
;Ret+1: Always. 0 or (Extended) Pointer to block in BLK.
PRV==T1
GCARVE:
MNTM5 AOS CELL(INFAA,2,,INF) ; GCARVE calls
XMOVEI PRV,ODDBLK ; Address of pointer to odd block list
LOAD BLK,FLIST,(PRV) ; Pointer to first odd block
JUMPLE BLK,GCARV4 ; None. Try something else
DO.
LOAD T2,FSIZE,(BLK) ; Get size of this odd block
CAME T2,SIZ ; Same as required?
IFSKP. ; Yes.
LOAD T3,FLIST,(BLK) ; Pointer to block after this one
STOR T3,FLIST,(PRV) ; Is new successor to one before this
RET
ENDIF.
CAIGE T2,FBLKSZ(SIZ) ; Min we can carve successfully
IFSKP. ; Big enough
LOAD T3,FLIST,(BLK) ; Successor of this one
STOR T3,FLIST,(PRV) ; Snip it out
CALLRET CSPLIT ; Split into required plus extra
ENDIF.
MOVE PRV,BLK
LOAD BLK,FLIST,(PRV) ; Move to next odd block
JUMPG BLK,TOP. ; And look at it
ENDDO.
GCARV4: CALLRET BULKCV ; Above failed. Try bulk storage
PURGE PRV
;CSPLIT Split an odd block into required size plus extra.
;BLK/ (Extended) BLK
;SIZ/ Required size, excluding header
; CALL CSPLIT
;Ret+1: Always. Extended pointer to block of requird size in BLK
CSPLIT:
MNTM5 AOS CELL(INFAA,3,,INF) ; CSPLIT calls
LOAD T3,FSIZE,(BLK) ; Get size of block to be split
MOVE T1,BLK ; Get whole block
ADDI T1,UBLKSZ(SIZ) ; Start of fragment
STOR SIZ,FSIZE,(BLK) ; Store size of block to be returned
SUBI T3,UBLKSZ(SIZ) ; Size of fragment
STOR T3,FSIZE,(T1) ; Store size of fragment
LOAD T4,FNEXT,(BLK) ; Block following this in memory
STOR T4,FNEXT,(T1)
PUSH P,BLK
PUSH P,SIZ
MOVE BLK,T1
CALL RETB0 ; Return the fragment to free area
POP P,SIZ
POP P,BLK
RET
SUBTTL Internet Free Space Block Carver
;BULKCV Carve block out of bulk storage. Called with NOINT & FRELCK set.
;SIZ/ Size required, excluding header
; CALL BULKCV
;Ret+1: Always. BLK has 0 or extended pointer to block
BULKCV:
MNTM5 AOS CELL(INFBC,0,,INF) ; BULKCV calls
PUSH P,SIZ ; Save SIZ
MOVE T2,BULKND ; Current end of free storage
IFN. T2 ; Have something left
SUB T2,BULKST ; Compute current length
ANDN. T2 ; Not enough
ADDI T2,1 ; Total Length
CAIE T2,UBLKSZ(SIZ) ; Exactly what we need? (-1)
IFSKP. ; Yes
SETZB BLK,BULKND ; Cancel bulk area
EXCH BLK,BULKST ; Get beginning of block to return
JRST BULKCX
ENDIF.
MOVE BLK,BULKST ; Start of what's left
MOVEI T3,UBLKSZ(SIZ) ; What is needed
CAIGE T2,FBLKSZ+1+1(T3) ; Big enough to carve? (-1)
IFSKP. ; Yes
ADDM T3,BULKST ; Remove from bulk area
JRST BULKCX
ENDIF.
CAIGE T2,FBLKSZ ; Big enough to return?
ANSKP. ; No so forget it
SUBI T2,UBLKSZ ; User SIZ
STOR T2,FSIZE,(BLK) ; Convert what is left into a block
MOVE T3,BULKND ; Current End (extended)
ADDI T3,1 ; Next location there after
STOR T3,FNEXT,(BLK) ; Fix up the block to be returned
CALL RETB0 ; Return the piece
SETZM BULKST ; Cancel bulk storage
SETZM BULKND
ENDIF.
SKIPN MRGFLG ; Merging return blocks possible?
IFSKP. ; Yes
CALL GC ; Garbage collect. (Save SIZ)
MOVE SIZ,0(P) ; Restore SIZ
CALL GETB ; Assign the block
JRST BULKCX
ENDIF.
MOVE T1,TODCLK ; NOW
CAMG T1,INTSVT ; OK to give another typeout?
IFSKP. ; Yes
MOVE T2,0(P) ; Get the size desired
BUG.(INF,INTFR6,IPFREE,SOFT,
<Internet Free Space - Free storage exhausted - siz/fre>,<<T2,D>,<INTFSP,D>>,<
Cause: This message is printed each minute that Internet free storage
has been exhausted.
Action: If the message doesn't stop shortly, it may be advisable to reload
the system. Users should be notified of the problem and given a
chance to finish work in progress, etc., according to management
policy. A dump would probably be helpful to determine what has
gone wrong.
Data: Requested block size, amount of space available (it is probably
fragmented).
>)
ADDI T1,^D60000 ; 1 minute interval
MOVEM T1,INTSVT ; Next deadline
ENDIF.
SETOM INTSVR ; And request everybody to do it
MOVEI BLK,0 ; None available. Let caller handle it.
MNTM5 AOS CELL(INFBC,1,,INF) ; Count BULKCV failures
BULKCX: POP P,SIZ ; Restore SIZ
RET
SUBTTL Internet Free Space Garbage Collector
;GC Garbage Collector. Called with NOINT & FRELCK set. Saves SIZ & LST.
GC:
IFN NICSW<
MOVE 1,TODCLK
MOVE 2,1
SUB 1,GCTAD
CAIG 1,^D30000 ;30 SECONDS
JRST [SETZM MRGFLG
RET]
MOVEM 2,GCTAD
MNTM5< AOS T1,CELL(INFAA,4,,INF)>; GC calls
BUG.(INF,IPGCOL,IPFREE,SOFT,
<Internet Free Space - Reclaiming Internet free space nth time>,<<T1,D>>,<
Cause: Internet free storage has been garbage collected for the nth time.
Action: None.
Data: Cumulative count of times collected
>)
ACVAR <ILST>
;*** will use SIZ for a local since SPUT doesn't touch it
MOVEI LST,0
EXCH LST,ODDBLK+$FLIST ; Get and clear odd block list
MOVSI SIZ,-NFIXED ; AOBJN pointer to INTBLK table
DO.
MOVEI T1,INTBLK(SIZ) ; Pointer to current list header
LOAD ILST,FLIST,(T1) ; Pointer to first block on list
IFN. ILST ; Don't copy nul list
; Merge blocks from ILST into LST
DO.
TRNN ILST,-1 ; End of ILST reached?
IFSKP. ; No
MOVE BLK,ILST ; First block on list
LOAD ILST,FLIST,(BLK) ; Get successor for next time
CALL SPUT
LOOP.
ENDIF.
ENDDO.
ENDIF.
SETZRO FSIZE,+INTBLK(SIZ) ; Nullify the list
SETZRO FLIST,+INTBLK(SIZ) ; Nullify the list
ADDI SIZ,INTBLS-1
AOBJN SIZ,TOP.
ENDDO.
; Return all free blocks to the proper place -- INTBLK or ODDBLK
MOVE ILST,LST ; List of all free memory
DO.
TRNN ILST,-1 ; End of list?
IFSKP. ; No
MOVE BLK,ILST
LOAD ILST,FLIST,(BLK) ; Successor is what to do next time
CALL RETB0 ; Return first block on the list
LOOP.
ENDIF.
ENDDO.
SETZM MRGFLG ; No merge possible now.
RET
ENDAV.
SUBTTL Internet Free Space Block Verification Routines
;CHKBLK See that the hash mark is still ok, etc.
;BLK/ (Extended) Pointer to block
;SIZ/ Size of the block, excluding UBLKSZ header
; CALL CHKBLK
;Ret+1: Always.
CHKBLK: CAML BLK,[INTSEC,,INTFRE] ; Range check pointer
CAMLE BLK,[<INTSEC,,INTFRE>+<INTFSZ-1>]
BUG.(HLT,INTFR2,IPFREE,SOFT,
<Internet Free Space - Invalid block pointer - blk>,<<BLK,D>>,<
Cause: Attempt to return a block to internet free storage with a pointer not
between INTFRE and INTFSZ.
Action: Examine the stack (P/) to see who is trying to return the block.
Data: Invalid pointer.
>)
; Note: Ought to remove first CAIL & -UBLKSZ from second
CAIL SIZ,UBLKSZ ; Min size block ever handed out
CAIL SIZ,INTFSZ-UBLKSZ ; Max size block ever handed out
BUG.(HLT,INTFR0,IPFREE,SOFT,
<Internet Free Space - Block size clobbered - siz/blk>,<<SIZ,D>,<BLK,D>>,<
Cause: A block of Internet free storage is being returned. The word
before the pointer to the block containing the block size and
a hash code has had the block size fouled.
Action: Examine the stack (P/) to see who is trying to return the block.
Data: Bad size, pointer to block.
>)
CALL HASH
LOAD T2,UHASH,(BLK) ; Get the mark we left there
CAME T1,T2 ; Is it still there?
BUG.(HLT,INTFR1,IPFREE,SOFT,
<Internet Free Space - Block hash clobbered - sb/is/blk>,
<<T1,D>,<T2,D>,<BLK,D>>,<
Cause: A block of Internet free storage is being returned. The word
before the pointer to the block containing the block size and
a hash code has had the block size fouled.
Action: Examine the stack (P/) to see who is trying to return the block.
Data: Expected hash code, actual hash code, pointer to block.
>)
RET
;HASH Return a random number based on location and size.
;BLK/ (Extended) Block location
;SIZ/ Block size
; CALL HASH
;Ret+1: Always. Hash value in T1
;This number is stored in the block header (UHASH) while the block is
;in the hands of the user. When he returns the block, a check is made
;to see that it has not been clobbered.
HASH: MOVEI T1,25252(BLK) ; Flush section number and garble a bit
IMULI T1,1234(SIZ) ; Mulitply by garbled length
TSC T1,T1
HRRZS T1
RET
;CLRBLK Clear a block to be sure unstuffed fields are 0.
;T1/ (Extended) pointer to block
;T2/ Size of block
; CALL CLRBLK
;Ret+1: Always.
CLRBLK::
MNTM5 AOS CELL(INFAA,5,,INF) ; CLRBLK calls
EXCH T1,T2 ; Size to T1, Source to T2
SUBI T1,1 ; Number of transfers is 1 less
XMOVEI T3,1(T2) ; Destination
SETZM 0(T2) ; Clear a word.
CALL XBLTA ; Clear the rest
RET
SUBTTL Internet Free Space Hash Table Routines
;HASHX Given a block size, HASHX returns the index to INTBLK.
;SIZ/ Size
;T1/ CreateFlag ; Non-0 to create slot if not there already
; CALL HASHX
;Ret+1: Always. -1 or Index in T1. Saves SIZ.
I==T1
L==T2 ; L must be I+1
Q==T3
T==T4
HASHX: ACVAR <FLAG>
MOVEM T1,FLAG
MOVSI T,-NFIXED ; Set to scan the table
DO.
MOVE I,SIZ
ADDI I,0(T) ; Add probe count
IDIVI I,NFIXED ; Rem is the hash function
MOVE I,I+1 ; (to I and L)
IMULI I,INTBLS ; Words per entry
MOVEI L,INTBLK(I) ; Pointer to head of list
LOAD Q,FSIZE,(L) ; Get size of blocks on this one
IFE. Q ; If slot free
JUMPE FLAG,HASHXM ; Return -1 if not supposed to create it
STOR SIZ,FSIZE,(L) ; Create the list
EXIT.
ENDIF.
CAMN Q,SIZ ; Size we are looking for?
EXIT. ; Yes.
AOBJN T,TOP. ; Probe again
HASHXM: SETO T1, ; Fail
ENDDO.
RET
ENDAV.
PURGE I,L,Q,T
SUBTTL 1822 Buffer Handling
REPEAT 0,<
SIZ182: EXP 400 ; 1822 buffer size
NETINI:: ; Initialize 1822 buffer area in INTSEC
MOVEI T1,BF18SZ ; Get the number of words we have
IDIV T1,SIZ182 ; Get the number of buffers possible
MOVEI T2,BF1822 ; Get the initial buffer addess
MOVE T3,SIZ182 ; Get the number of words per buffer
ADDI T3,(T2) ; Get the initial link word
SETSEC T2,INTSEC ; Buffer is in INTSEC
MOVEM T2,BF18BO ; Save the initial head pointer
NETIN2: ; Loop for initializing buffers
STOR T3,NBQUE,(T2) ; Store the forward link
ADD T2,SIZ182 ; Get the address of the next buffer
ADD T3,SIZ182 ; Get the new link word
SOJG T1,NETIN2 ; Initialize all the buffers
SUB T2,SIZ182 ; Fix up Buffer address
SETZRO NBQUE,(T2) ; This buffer is the last
MOVEM T2,BF18BI ; Save the tail pointer word
RET ; And return to caller
;Get an 1822 Buffer. Here via LCKCAL with FRELCK set
GET18B:: ; Get an 1822 buffer.
SKIPN T1,BF18BO ; Buffer Available?
RET ; nope.
SETSEC T1,INTSEC ; Buffer is in INTSEC
LOAD T2,NBQUE,(T1) ; get the buffer's link word
MOVEM T2,BF18BO ; set the new head word
SKIPN T2 ; was the link zero?
SETZM BF18BI ; yes so zero the tail pointer
SETZRO NBQUE,(T1) ; clear forward link
RET ; and return
;Return an 1822 buffer. Here via LCKCAL with FRELCK set.
RET18B:: ; Return an 1822 Buffer
CAML T1,[INTSEC,,BF1822] ; Does this buffer look ok?
CAML T1,[INTSEC,,BF1822+BF18SZ] ; ?
BUG.(HLT,IMPBAD,IMPDV,SOFT,<IMPDV: Attempt to return a buffer not in range>)
MOVN T2,[INTSEC,,BF1822] ; Get the begining of the buffer space
ADD T2,T1 ; Get the offset of this buffer
IDIV T2,SIZ182 ; Get the number of this buffer
SKIPE T3 ; Any remainder?
BUG.(HLT,IMPVBD,IPFREE,SOFT,<IMPDV: Attempt to return a buffer with the address smashed>)
SETZRO NBQUE,(T1) ; No forward link on this buffer
MOVE T2,BF18BI ; Get the old tail pointer
SETSEC T2,INTSEC ; In INTSEC
MOVEM T1,BF18BI ; We are the new tail
STOR T1,NBQUE,(T2) ; Fix up the old tails queue
SKIPN BF18BO ; Any buffers on the head?
MOVEM T1,BF18BO ; no so this is now the head
RET ; and return
> ; End of REPEAT 0
SUBTTL Temporary Free Space Routines for NISRV and Friends
IFE REL6,<
IFE REL6,<RESCD> ;1 THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ;1 THIS CODE IS RESIDENT
DNGWDS:: ;Get free space for NISRV.
HRLI T1,.RESP2 ;high priority
MOVEI T2,.RESNP ;get the space from decnet
CALL ASGRES ;get the space
RET ;non skip return means no space available
HRLI T1,MSEC1 ;in section one
RETSKP ;and return to caller
DNFWDS:: ;Release free space for NISRV.
HRRZS T1 ;zero the left half
CALL RELRES ;release the space
RET ;and return
DNGWDZ:: ;Get zeroed free space for NISRV.
STKVAR <DNGSZ> ;get some space
MOVEM T1,DNGSZ ;save the size
CALL DNGWDS ;get the space
RET ;failed to get the space
MOVE T2,DNGSZ ;get the size
MOVEM T1,DNGSZ ;save the address
CALL CLRBLK ;zero the block
MOVE T1,DNGSZ ;get the address back
RETSKP ;success return
ENDSV.
;RELJFR - Release JSB Free Space
;T2/ Location of Block to Be Returned
; CALL RELJFR
; Returns +1: Always
RELJFR::MOVEI T1,JSBFRE ;Get address of JSB Free Space Header
CALLRET RELFRE ; and call routine to release the space
> ;end of IFE REL6
SUBTTL IPNIDV Buffer Handling
IFE REL6,<SWAPCD> ;1 THIS CODE IS SWAPPABLE
IFN REL6,<XSWAPCD> ;1 THIS CODE IS SWAPPABLE
repeat 0,<
GETNIB:: ; Get an NI Buffer
MOVE T1,MAXWPM ; input buffer size
CALL GETBLK ; get a block of free space
RET ; and return to caller
RETNIB:: ; Return an NI buffer
CALL RETBLK ; return a block of internet free space
RET ; and return it to caller
> ; end of repeat 0
;NIPLKB - LOCK BUFFER
;
; Called whenever we need a buffer locked.
;
; T1/ Address of buffer to lock
; T2/ Length of buffer
;
; Returns + 1 always, T1 and T2 preserved
IFE REL6,<RESCD> ;1 THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ;1 THIS CODE IS RESIDENT
NIPLKB::SAVEAC <T1,T2>
CALL NIPLKW ;LOCK THE FIRST ADDRESS
ADD T1,T2 ;COMPUTE LAST ADDRESS
CALL NIPLKW ;LOCK DOWN THE LAST ADDRESS
RET
NIPLKW: SAVEAC <T1,T2> ;SAVE SOME ACS
CALL MLKMA ;LOCK DOWN THE PAGE
RET
;NIPULK - UNLOCK BUFFER
;
; Called whenever we need a buffer unlocked.
;
; T1/ Address of buffer to unlock
; T2/ Length of buffer
;
; Returns + 1 always, T1 and T2 preserved
IFE REL6,<RESCD> ;1 THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ;1 THIS CODE IS RESIDENT
NIPULK::SAVEAC <T1,T2>
CALL NIPULW ;UNLOCK THE FIRST ADDRESS
ADD T1,T2 ;COMPUTE LAST ADDRESS
CALL NIPULW ;UNLOCK DOWN THE LAST ADDRESS
RET
NIPULW: SAVEAC <T1,T2> ;SAVE ACS
CALL MULKSP ;UNLOCK THE PAGE
RET
TNXEND
END