Google
 

Trailing-Edge - PDP-10 Archives - BB-H311D-RM - arpanet-sources/ipfree.mac
There are 9 other files named ipfree.mac in the archive. Click here to see a list.
; UPD ID= 4849, SNARK:<6.MONITOR>IPFREE.MAC.5,  17-Sep-84 11:50:03 by PURRETTA
;Update copyright notice
; 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  BE  USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION  1982, 1984.
;ALL RIGHTS RESERVED.


	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>>
; AC redefinitions:

IF1 <
BLK=1+NTEMPS+NLOCLS-3		; Holds pointer to block in question
SIZ=1+NTEMPS+NLOCLS-2		; Holds size of block
LST=1+NTEMPS+NLOCLS-1		; Holds pointer to a list of blocks
NLOCLS==NLOCLS-3
>

; 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,0,35,18)		; List of other blocks
DEFSTR(FNEXT,1,35,18)		; Next block higher in memory
FBLKSZ==2			; Size of a FREE block header

; Definitions for USED block header structure:

DEFSTR(USIZE,0,17,35)		; (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
	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

	RESCD			; 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
	MOVEM T2,.IPRBK(T1)	; SAVE IT
	SETSEC T2,INTSEC	; EXTENDED POINTER
	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

	SWAPCD			; CODE IS NOW SWAPPABLE

>				; end of IPFDSW
	SUBTTL Internet Free Space Initialization and Misc Routines

;FREINI	Initialize the Free Storage area
;	CALL FREINI
;Ret+1:	Always.

FREINI::SETZM 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-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 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

RETBLK::
	CAML T1,[INTSEC,,BF1822] ; Is this an 1822 or NI buffer?
	 CAML T1,[INTSEC,,BF1822+BF18SZ] ; ?
	  SKIPA			; no
	   JRST RETNIB		; yes
	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
	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
;SIZ/	Size of the block	; Excluding header
;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
	EXIT RETBX

RETB1:	MOVE LST,ODDBLK		; The appropriate (extended) list
	CALL SPUT		; Put block on that list
	MOVEM LST,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

SPUT:	TEMP <CUR,SUC>
	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
	EXIT SPUTX		; Return LST as new list
SPUT1:	CAML BLK,LST		; Adding to front of list?
	 JRST SPUT2		; No. Search for right spot.
	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
	SETSEC SUC,INTSEC	; Make extended address
	CAML BLK,SUC		; BLK must be below SUC
	TRNN SUC,-1		; or SUC must be (INTSEC,,) 0
				; (CUR is end of list)
	CAMG BLK,CUR		; and BLK must be above CUR
	 JRST SPUT3		; Not right place for insert
	STOR SUC,FLIST,(BLK)	; Patch in BLK between CUR and SUC
	STOR BLK,FLIST,(CUR)
SPUT4:	LOAD T4,FNEXT,(BLK)	; Word address following BLK
	JUMPE T4,SPUT5		; Beware match on INTSEC,,0
	SETSEC T4,INTSEC	; Make extended address
	CAME T4,SUC		; Combine BLK and SUC ?
	 JRST SPUT5		; No
	LOAD T3,FSIZE,(BLK)	; SUC is real block, not INTSEC,,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
SPUT5:	LOAD T3,FNEXT,(CUR)	; Address following CUR
	SETSEC T3,INTSEC	; Make extended address
	CAME T3,BLK		; Combine CUR and BLK?
	 EXIT 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:	RESTORE
	RET
	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::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
		MOVE 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]
	CALL LCKCAL		; Call the function with the lock set
	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:	LOCAL <MINSIZ>
	MOVEM T1,MINSIZ
	CALL GETBK0		; Use normal GETBLK routine
	JUMPN T1,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 either on  the
;ODDBLK list or INTBLK+n. 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
GETBB1:	JUMPE T2,GETBB2		; Jump if at end of list
	SETSEC T2,INTSEC	; Make extended address
	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
	JRST GETBB1

GETBB2:
	CAILE SIZ,BSMALL	; Unless it is a small block,
	 ANDCMI SIZ,BSQUAN-1	; Round down to the next smaller quantization
	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>)>
	IFN IPFDSW,<BUG.(HLT,INTFR7,IPFREE,SOFT,<Internet Free Space - ODDBLK list fouled>)>
GETBB9:	SETZB BLK,SIZ		; Failure indication
GETBBX:	HRL BLK,SIZ		; Place size for caller
	RESTORE
	RET
	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::MOVE T3,T1		; Place in right ac
	MOVEI T1,FRELCK		; Lock to set
	XMOVEI T2,GETBL0	; Address of the jacket routine
	CALL LCKCAL		; Call routine with lock set
	IFN IPFDSW,<CALL IPFTRK> ; IF DEBUGING TRACE THIS EVENT
	RET			; AND RETURN TO CALLER

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 - Bad block size request>)
	MOVEI SIZ,1		; Min size we ever hand out
GETBK1:	CAILE SIZ,INTFSZ-UBLKSZ	; Max size
	 BUG.(HLT,INTFR5,IPFREE,SOFT,<Internet Free Space - Bad block size request>)
	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.
	SETSEC T4,INTSEC	; Make extended address
	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	Carve 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.

GCARVE:	TEMP <PRV>
	SKIPN ODDBLK		; Are there any odd blocks?
	 JRST GCARV4		; No.  Try something else
	XMOVEI PRV,ODDBLK	; Address of pointer to odd block list
	LOAD BLK,FLIST,(PRV)	; Pointer to first odd block

GCARV1:	SETSEC BLK,INTSEC	; Make extended address
	LOAD T2,FSIZE,(BLK)	; Get size of this odd block
	CAME T2,SIZ		; Same as required?
	 JRST GCARV2		; No.  Keep looking.
	LOAD T3,FLIST,(BLK)	; Pointer to block after this one
	STOR T3,FLIST,(PRV)	; Is new successor to one before this
	EXIT GCARVX

GCARV2:	CAIGE T2,FBLKSZ(SIZ)	; Min we can carve succesffully
	 JRST GCARV3		; Not big enough.
	LOAD T3,FLIST,(BLK)	; Successor of this one
	STOR T3,FLIST,(PRV)	; Snip it out
	CALL CSPLIT		; Split into required plus extra
	EXIT GCARVX

GCARV3:	MOVE PRV,BLK
	LOAD BLK,FLIST,(PRV)	; Move to next odd block
	JUMPG BLK,GCARV1	; And look at it
GCARV4:	CALL BULKCV		; Above failed.  Try bulk storage
GCARVX:	RESTORE
	RET

;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:	LOAD T3,FSIZE,(BLK)	; Get size of block to be split
	MOVE T1,BLK		; Get whole block
	ADDI T1,UBLKSZ(SIZ)	; Start of fragment
	SETSEC T1,INTSEC	; Make extended address
	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:	PUSH P,SIZ		; Save SIZ
	MOVE T2,BULKND		; Current end of free storage
	JUMPE T2,BULKC3		; Jump if nothing at all left
	SUB T2,BULKST		; Compute current length
	JUMPE T2,BULKC3		; Jump if only one word left
	ADDI T2,1		; Total Length
	CAIE T2,UBLKSZ(SIZ)	; Exactly what we need?	(-1)
	 JRST BULKC1		; No.
	SETZB BLK,BULKND       	; and cancel bulk area
	EXCH BLK,BULKST		; Get beginning of block to return
	JRST BULKCX

BULKC1:	MOVE BLK,BULKST		; Start of what's left
	MOVEI T3,UBLKSZ(SIZ)	; What is needed
	CAIGE T2,FBLKSZ+1(T3)	; Big enough to carve?	(-1)
	 JRST BULKC2		; No.
	ADDM T3,BULKST		; Remove from bulk area
	JRST BULKCX

BULKC2:
	CAIGE T2,FBLKSZ		; Big enough to return?
	 JRST BULKC3		; 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

BULKC3:	SKIPN MRGFLG		; Merging return blocks possible?
	 JRST BULKC4		; No.  Try something else.
	CALL GC			; Yes. Garbage collect. (Save SIZ)
	MOVE SIZ,0(P)		; Restore SIZ
	CALL GETB		; Assign the block
	JRST BULKCX

BULKC4:
	MOVE T1,TODCLK		; NOW
	CAMG T1,INTSVT		; OK  to give another typeout?
	 JRST BULKC5		; No.  Not yet.
	MOVE T2,0(P)		; get the size desired
        BUG.(INF,INTFR6,IPFREE,SOFT,<Internet Free Space - Free storage exhausted>)
	ADDI T1,^D60000		; 1 minute interval
	MOVEM T1,INTSVT		; Next deadline
BULKC5:	SETOM INTSVR		; And request everybody to do it
	MOVEI BLK,0		; None available.  Let caller handle it.
BULKCX:	POP P,SIZ		; Restore SIZ
	RET
	SUBTTL Internet Free Space Garbage Collector

;GC	Garbage Collector. Called with NOINT & FRELCK set.

GC:	BUG.(INF,IPGCOL,IPFREE,SOFT,<Internet Free Space - Reclaiming internet free space>)
	LOCAL <ILST>
	MOVEI LST,0
	EXCH LST,ODDBLK		; Get and clear odd block list
	MOVSI SIZ,-NFIXED      	; AOBJN pointer to INTBLK table
GC1:	MOVEI T1,INTBLK(SIZ)	; Pointer to current list header
	LOAD ILST,FLIST,(T1)	; Pointer to first block on list
	JUMPE ILST,GC2		; Avoid overhead of LCOPY on null list
	SETSEC ILST,INTSEC	; Make extended address
LCOPY1:	TRNN ILST,-1		; End of ILST reached?
	 JRST LCOPYX		; Yes.
	MOVE BLK,ILST		; First block on list
	LOAD ILST,FLIST,(BLK)	; Get successor for next time
	SETSEC ILST,INTSEC	; Make extended address
	CALL SPUT
	JRST LCOPY1
LCOPYX:
GC2:	SETZM INTBLK(SIZ)      	; Nullify the list
	AOBJN SIZ,GC1
	MOVE ILST,LST		; List of all free memory
RETLS1:	TRNN ILST,-1		; End of list?
	 JRST RETLSX		; Yes.  Done.
	MOVE BLK,ILST
	LOAD ILST,FLIST,(BLK)	; Successor is what to do next time
	SETSEC ILST,INTSEC	; Make extended address
	CALL RETB0		; Return first block on the list
	JRST RETLS1
RETLSX:
	SETZM MRGFLG		; No merge possible now.
	RESTORE
	RET
	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.

; Note: Ought to remove first CAIL & -UBLKSZ from second

CHKBLK:	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>)
	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>)
	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
	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.

HASHX:	LOCAL <FLAG>
	TEMP <I,L,Q,T>		; L must be I+1
	MOVEM T1,FLAG
	MOVSI T,-NFIXED		; Set to scan the table
HASHX1:	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)
	MOVEI L,INTBLK(I)	; Pointer to head of list
	LOAD Q,FSIZE,(L)	; Get size of blocks on this one
	JUMPN Q,HASHX2		; Jump if slot is in use
	JUMPE FLAG,HASHXM	; Return -1 if not supposed to create it
	STOR SIZ,FSIZE,(L)	; Create the list
	EXIT HASHXX

HASHX2:	CAMN Q,SIZ		; Size we are looking for?
	 EXIT HASHXX		; Yes.
	AOBJN T,HASHX1		; Probe again
HASHXM:	SETO T1,		; Fail
HASHXX:	RESTORE
	RET
	SUBTTL 1822 Buffer Handling

NETINI::			; Initialize 1822 buffer area in INTSEC
	MOVEI T1,BF18SZ		; Get the number of words we have
	IDIV T1,MAXWPM		; Get the number of buffers possible
	MOVEI T2,BF1822		; Get the initial buffer addess
	MOVE T3,MAXWPM		; 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,MAXWPM		; Get the address of the next buffer
	ADD T3,MAXWPM		; Get the new link word
	SOJG T1,NETIN2		; Initialize all the buffers
	SUB T2,MAXWPM		; 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

GETNIB::			; Get an 1822 (and NI) buffer
	SAVEAC <T2,T3,T4>	; Save ACs
	XMOVEI T1,FRELCK	; We need FRELCK
	XMOVEI T2,GET18B	; Routine to call
	CALL LCKCAL		; Get the space
	JUMPN T1,R		; Did we get the space
	BUG.(INF,NIPABF,IPFREE,SOFT,<IPFREE: Assign of NI buffer failed>)
	RET


;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,MAXWPM		; 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 

RETNIB::			; Return NI buffer
	SAVET			; Save ACs
	MOVE T3,T1		; Get the block address
	XMOVEI T1,FRELCK	; Get the lock addres
	XMOVEI T2,RET18B	; Address to call
	CALL LCKCAL		; Lock the lock and call the routine
	RET			; and return to caller

	TNXEND
	END