Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/listings/tkb-vnp/stgm.bpt
There are no other files named stgm.bpt in the archive.
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

   1	!<SAUTER.TKB20>STGM.BLI.15, 15-Dec-78 15:18:16, Edit by SROBINSON
   2	!<SAUTER.TKB20>STGM.BLI.13, 13-Dec-78 09:12:07, Edit by SROBINSON
   3	!<SAUTER.TKB20>STGM.BLI.9, 17-Nov-78 16:11:46, Edit by SROBINSON
   4	MODULE STGM (					! STORAGE MANAGER
   5			IDENT = 'X0.1-1A'
   6			) =
   7	BEGIN
   8	!
   9	!
  10	!
  11	! COPYRIGHT (C) 1978 BY
  12	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
  13	!
  14	!
  15	! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
  16	! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
  17	! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
  18	! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
  19	! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
  20	! TRANSFERRED.
  21	!
  22	!
  23	! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
  24	! AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
  25	! CORPORATION.
  26	!
  27	! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
  28	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
  29	!
  30	
  31	!++
  32	! FACILITY: TKB-20 AND VNP-20
  33	!
  34	! ABSTRACT:
  35	!
  36	!
  37	! THIS MODULE PROVIDES THREE STORAGE MANAGEMENT SUBROUTINES.
  38	!
  39	!  GETSTG(AMOUNT) GETS 'AMOUNT' OF STORAGE, RETURNING ITS
  40	!   ADDRESS AS ITS VALUE.  RETURNING A 0 INDICATES THAT NO
  41	!   STORAGE IS AVAILABLE.
  42	!
  43	!  FRESTG(ADDRESS,AMOUNT) FREES 'AMOUNT' OF STORAGE STARTING
  44	!   AT 'ADDRESS'.  IT RETURNS NO VALUE.
  45	!
  46	!  INISTG(AMOUNT) INITIALIZED STORAGE MANAGEMENT.  SUBSEQUENTLY,
  47	!   AT LEAST 'AMOUNT' OF STORAGE WILL BE AVAILABLE THROUGH GETSTG.
  48	!   RETURNING A 0 INDICATES THAT INITIALIZATION FAILED, 1 THAT IT
  49	!   SUCCEEDED.
  50	!
  51	!
  52	!
  53	! ENVIRONMENT: TOPS-20 USER MODE
  54	!
  55	! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
  56	!
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

  57	! MODIFIED BY:
  58	!
  59	!	, : VERSION
  60	! 01	-
  61	!--
  62	
  63	!<BLF/PAGE>
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

  64	!
  65	! TABLE OF CONTENTS:
  66	!
  67	
  68	FORWARD ROUTINE
  69	    INISTG : NOVALUE,				!INITIALIZE STORAGE MANAGER
  70	    GETSTG,					!GET STORAGE
  71	    COLLECT_STORAGE : NOVALUE,			!COMBINE ADJACENT STORAGE BLOCKS
  72	    FRESTG : NOVALUE,				!FREE STORAGE
  73	    GETBLK,					!GET A BLOCK
  74	    FREBLK : NOVALUE;				!FREE A BLOCK
  75	
  76	!
  77	! INCLUDE FILES:
  78	!
  79	!	NONE
  80	!
  81	! MACROS:
  82	!
  83	!	NONE
  84	!
  85	! EQUATED SYMBOLS:
  86	!
  87	
  88	LITERAL
  89	    DEBUG = 0;
  90	
  91	!
  92	! DEFINE A STRUCTURE WHICH PROVIDES ACCESS TO ADDRESSES.
  93	!  IF %BPUNIT = %BPADDR, THIS IS THE SAME AS STRUCTURE "VECTOR".
  94	!
  95	
  96	STRUCTURE
  97	    ADDRESSES [INDEX; VLENGTH] =
  98		[((VLENGTH*%BPADDR) + (%BPUNIT - 1))/%BPUNIT]
  99		(ADDRESSES + ((INDEX*%BPADDR)/%BPUNIT))<(INDEX*%BPADDR) MOD %BPUNIT, %BPADDR>;
 100	
 101	!
 102	! DEFINE THE OFFSETS IN THE HEADER FOR A STORAGE BLOCK ON THE
 103	!  FREE CHAIN.
 104	!
 105	
 106	LITERAL
 107	    FSTG_SIZE = 0,				!SIZE OF THIS BLOCK
 108	    FSTG_NEXT = 1,				!POINTER TO NEXT BLOCK, OR 0 IF NONE.
 109	    FSTG_PREV = 2,				!POINTER TO PREV BLOCK, OR 0 IF THIS IS FIRST.
 110	    FSTG_HDRL = 3;				!LENGTH OF A FREE STORAGE HEADER
 111	
 112	!
 113	! OWN STORAGE:
 114	!
 115	
 116	OWN
 117	    INITIALIZED : INITIAL (0),
 118	    FSTG_ROOT : ADDRESSES [FSTG_HDRL],
 119	    COUNTS : VECTOR [513];
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 120	
 121	!
 122	! EXTERNAL REFERENCES:
 123	!
 124	
 125	EXTERNAL ROUTINE
 126	    ERROR : NOVALUE;				!
 127	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 128	GLOBAL ROUTINE INISTG (AMOUNT) : NOVALUE = 	! INIT STORAGE MANAGER
 129	
 130	!++
 131	! FUNCTIONAL DESCRIPTION:
 132	!
 133	!	ROUTINE TO INITIALIZE THE FREE STORAGE LIST.
 134	!	AFTER INITIALIZATION IS COMPLETE A MINIMUM AMOUNT
 135	!	OF STORAGE IS GUARANTEED AVAILABLE VIA GETSTG.
 136	!
 137	! FORMAL PARAMETERS:
 138	!
 139	!	AMOUNT - MIN FREE STORAGE PERMITTED
 140	!
 141	! IMPLICIT INPUTS:
 142	!
 143	!	NONE
 144	!
 145	! IMPLICIT OUTPUTS:
 146	!
 147	!	NONE
 148	!
 149	! ROUTINE VALUE:
 150	!
 151	!	NONE
 152	!
 153	! SIDE EFFECTS
 154	!
 155	!	MAY DO A CORE UUO TO GET STORAGE
 156	!
 157	!--
 158	
 159	    BEGIN
 160	
 161	    LOCAL
 162		STG_POINTER;
 163	
 164	!
 165	    INITIALIZED = 1;
 166	    FSTG_ROOT [FSTG_NEXT] = 0;
 167	
 168	    IF ((STG_POINTER = GETSTG (.AMOUNT)) EQL 0)
 169	    THEN
 170		ERROR (UPLIT (%ASCIZ'NOT ENOUGH STORAGE FOR INITIALIZATION - INISTG'))
 171	    ELSE
 172		FRESTG (.STG_POINTER, .AMOUNT);
 173	
 174	    END;
 175	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 176	ROUTINE GET_MORE_CORE (AMOUNT) = 		!GET CORE FROM END OF PROGRAM
 177	
 178	!++
 179	! FUNCTIONAL DESCRIPTION:
 180	!
 181	!	GET CORE FROM THE END OF THE PROGRAM.
 182	!	 THE PROGRAM WILL BE EXTENDED IF NECESSARY USING THE
 183	!	 CORE UUO.
 184	!
 185	! FORMAL PARAMETERS:
 186	!
 187	!	AMOUNT - NUMBER OF WORDS TO GET
 188	!
 189	! IMPLICIT INPUTS:
 190	!
 191	!	.JBFF
 192	!	.JBREL
 193	!
 194	! IMPLICIT OUTPUTS:
 195	!
 196	!	.JBFF
 197	!	.JBREL
 198	!
 199	! ROUTINE VALUE:
 200	!
 201	!	A POINTER TO THE STORAGE GOTTEN, OR 0
 202	!	 IF THE MONITOR WON'T GIVE US ANY MORE.
 203	!
 204	! SIDE EFFECTS
 205	!
 206	!	MAY DO A CORE UUO TO GET MORE CORE
 207	!
 208	!--
 209	
 210	    BEGIN
 211	
 212	    LOCAL
 213		STG_POINTER,
 214		TEMP;
 215	
 216	    EXTERNAL LITERAL
 217		%NAME ('.JBFF'),
 218		%NAME ('.JBREL');
 219	
 220	%IF %VARIANT EQL 10
 221	%THEN
 222	
 223	    BUILTIN
 224		UUO;
 225	
 226	%FI
 227	
 228	    REGISTER
 229		R;
 230	
 231	    STG_POINTER = .(%NAME ('.JBFF'))<0, 18>;
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 232	    TEMP = .(%NAME ('.JBFF'))<0, 18> + .AMOUNT;
 233	
 234	    IF (.TEMP GEQ %O'400000')
 235	    THEN
 236		STG_POINTER = 0
 237	    ELSE
 238		BEGIN					!WE ARE UNDER 2**17 WORDS
 239		%NAME ('.JBFF')<0, 18> = .TEMP;
 240	
 241	%IF %VARIANT EQL 10
 242	%THEN
 243	
 244		IF (.(%NAME ('.JBREL'))<0, 18> LSS .(%NAME ('.JBFF'))<0, 18>)
 245		THEN
 246		    BEGIN				!GET MORE CORE FROM MONITOR
 247		    R = .(%NAME ('.JBFF'))<0, 18>;
 248	
 249		    IF (UUO (1, %O'047', R, %O'11') EQL 0) THEN STG_POINTER = 0;
 250	
 251		    END;				! OF NEED TO GET MORE CORE FROM MONITOR
 252	
 253	%FI
 254	
 255		END;
 256	
 257	    .STG_POINTER
 258	    END;					!OF ROUTINE GET_MORE_CORE
 259	!
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 260	ROUTINE SEARCH_CHAIN (AMT) = 			!SEARCH THE FREE STORAGE LIST
 261	
 262	!++
 263	! FUNCTIONAL DESCRIPTION:
 264	!
 265	!	SEARCH THE FREE STORAGE LIST FOR A FREE BLOCK BIG ENOUGH
 266	!	 TO SATISFY A REQUEST FOR AMT WORDS.
 267	!
 268	! FORMAL PARAMETERS:
 269	!
 270	!	AMT - NUMBER OF WORDS IN THE REQUEST
 271	!
 272	! IMPLICIT INPUTS:
 273	!
 274	!	THE FREE STORAGE LIST
 275	!
 276	! IMPLICIT OUTPUTS:
 277	!
 278	!	NONE
 279	!
 280	! ROUTINE VALUE:
 281	!
 282	!	A POINTER TO A SUITABLE BLOCK ON THE FREE LIST, OR
 283	!	 0 IF NO BLOCK IS SUITABLE
 284	!
 285	! SIDE EFFECTS
 286	!
 287	!	NONE
 288	!
 289	!--
 290	
 291	    BEGIN
 292	
 293	    LOCAL
 294		STG_PTR : REF ADDRESSES,
 295		BEST_PTR : REF ADDRESSES;
 296	
 297	!
 298	    STG_PTR = .FSTG_ROOT [FSTG_NEXT];
 299	    BEST_PTR = 0;
 300	
 301	    WHILE (.STG_PTR NEQ 0) DO
 302		BEGIN
 303	
 304		IF (.STG_PTR [FSTG_SIZE] GEQ .AMT)
 305		THEN
 306		    BEGIN				!REQUEST WILL FIT
 307	
 308		    IF (.BEST_PTR NEQ 0)
 309		    THEN
 310			BEGIN				!WE HAD A PREVIOUS FIT
 311	
 312			IF (.BEST_PTR [FSTG_SIZE] GTR .STG_PTR [FSTG_SIZE]) THEN BEST_PTR = .STG_PTR;
 313	
 314			END
 315		    ELSE
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 316			BEST_PTR = .STG_PTR;
 317	
 318		    END;				!OF REQUEST WILL FIT
 319	
 320		STG_PTR = .STG_PTR [FSTG_NEXT];
 321		END;					!OF SCAN OF FREE LIST
 322	
 323	    .BEST_PTR
 324	    END;					!OF ROUTINE SEARCH_CHAIN
 325	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 326	GLOBAL ROUTINE GETSTG (AMOUNT) = 		!GET STORAGE
 327	
 328	!++
 329	! FUNCTIONAL DESCRIPTION:
 330	!
 331	!	ROUTINE TO GET STORAGE.
 332	!
 333	! FORMAL PARAMETERS:
 334	!
 335	!	AMOUNT - NUMBER OF WORDS TO GET
 336	!
 337	! IMPLICIT INPUTS:
 338	!
 339	!	NONE
 340	!
 341	! IMPLICIT OUTPUTS:
 342	!
 343	!	NONE
 344	!
 345	! ROUTINE VALUE:
 346	!
 347	!	A POINTER TO THE STORAGE GOTTEN, OR 0 IF STORAGE EXHAUSTED
 348	!
 349	! SIDE EFFECTS
 350	!
 351	!	MAY DO A CORE UUO TO GET STORAGE
 352	!
 353	!--
 354	
 355	    BEGIN
 356	
 357	    LOCAL
 358		AMT,
 359		NEXT_PTR : REF ADDRESSES,
 360		PREV_PTR : REF ADDRESSES,
 361		THIS_PTR : REF ADDRESSES,
 362		RESULT : REF VECTOR,
 363		UNUSED_AMOUNT;
 364	
 365	    IF ( NOT .INITIALIZED)
 366	    THEN
 367		BEGIN
 368		ERROR (UPLIT (%ASCIZ'CALL TO GETSTG BEFORE INISTG'));
 369		0
 370		END
 371	    ELSE
 372		BEGIN
 373		AMT = .AMOUNT;				!AMOUNT OF STORAGE REQUESTED
 374	
 375		IF (((.AMT + 7)/8) GTR 512)
 376		THEN
 377		    COUNTS [512] = .COUNTS [512] + 1
 378		ELSE
 379		    COUNTS [((.AMT + 7)/8)] = .COUNTS [((.AMT + 7)/8)] + 1;
 380	
 381	!
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 382	! ROUND STORAGE REQUEST UP TO COVER SPACE NEEDED FOR FREE STORAGE
 383	!  CHAIN HEADERS.
 384	!
 385	
 386		IF ((.AMT*%BPVAL) LSS (FSTG_HDRL*%BPADDR)) THEN AMT = ((FSTG_HDRL*%BPADDR) + (%BPVAL - 1))/%BPVAL;
 387	
 388	!
 389	! SEARCH THE STORAGE CHAIN FOR A LARGE ENOUGH BLOCK
 390	!
 391	
 392		IF ((THIS_PTR = SEARCH_CHAIN (.AMT)) EQL 0)
 393		THEN
 394		    BEGIN				!NOT ENOUGH SPACE ON THE FREE STORAGE CHAIN
 395		    COLLECT_STORAGE ();			!TRY TO FIND SPACE BY COMBINING BLOCKS
 396	
 397		    IF ((THIS_PTR = SEARCH_CHAIN (.AMT)) EQL 0)
 398		    THEN
 399			BEGIN				!EVEN COMBINING BLOCKS ISN'T GOOD ENOUGH
 400	
 401			IF ((THIS_PTR = GET_MORE_CORE (.AMT)) NEQ 0) THEN FRESTG (.THIS_PTR, .AMT);
 402	
 403							!APPEND NEW STG TO FREE CHAIN
 404			COLLECT_STORAGE ();		!BE SURE NEW BLOCK COMBINED WITH OLD ONES
 405			THIS_PTR = SEARCH_CHAIN (.AMT);
 406			END;
 407	
 408		    END;				!OF NOT ENOUGH STORAGE ON FREE CHAIN
 409	
 410	!
 411	! WE HAVE THE STORAGE OR IT IS UNAVAILABLE
 412	!
 413	
 414		IF (.THIS_PTR NEQ 0)
 415		THEN
 416		    BEGIN
 417		    PREV_PTR = .THIS_PTR [FSTG_PREV];
 418		    NEXT_PTR = .THIS_PTR [FSTG_NEXT];
 419	
 420		    IF (.NEXT_PTR NEQ 0) THEN NEXT_PTR [FSTG_PREV] = .PREV_PTR ELSE FSTG_ROOT [FSTG_PREV] = .PREV_PTR;
 421	
 422		    IF (.PREV_PTR NEQ 0) THEN PREV_PTR [FSTG_NEXT] = .NEXT_PTR ELSE FSTG_ROOT [FSTG_NEXT] = .NEXT_PTR;
 423	
 424		    IF (((UNUSED_AMOUNT = .THIS_PTR [FSTG_SIZE] - .AMT)*%BPVAL) GEQ (FSTG_HDRL*%BPADDR))
 425		    THEN
 426			BEGIN				!FREE UNUSED STORAGE IN THIS BLOCK
 427			NEXT_PTR = .THIS_PTR + .AMT;
 428			FRESTG (.NEXT_PTR, .UNUSED_AMOUNT);
 429			END;
 430	
 431		    RESULT = .THIS_PTR;
 432	
 433		    INCR COUNTER FROM 0 TO .AMT - 1 DO
 434			RESULT [.COUNTER] = 0;
 435	
 436		    END;
 437	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 438		.THIS_PTR
 439		END					!OF INITIALIZED
 440	    END;
 441	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 442	ROUTINE COLLECT_STORAGE : NOVALUE = 		!COMBINE STORAGE ON FREE LIST
 443	
 444	!++
 445	! FUNCTIONAL DESCRIPTION:
 446	!
 447	!	THIS INTERNAL ROUTINE IS USED TO
 448	!	 COMBINE ADJACENT BLOCKS ON THE FREE LIST INTO SINGLE
 449	!	 BLOCKS.
 450	!
 451	!
 452	! FORMAL PARAMETERS:
 453	!
 454	!	NONE
 455	!
 456	! IMPLICIT INPUTS:
 457	!
 458	!	THE FREE STORAGE LIST
 459	!
 460	! IMPLICIT OUTPUTS:
 461	!
 462	!	AN UPDATED FREE STORAGE LIST
 463	!
 464	! ROUTINE VALUE:
 465	!
 466	!	NONE
 467	!
 468	! SIDE EFFECTS
 469	!
 470	!	NONE
 471	!
 472	!--
 473	
 474	    BEGIN
 475	
 476	    LOCAL
 477		NEXT_PTR : REF ADDRESSES,
 478		PREV_PTR : REF ADDRESSES,
 479		THIS_PTR : REF ADDRESSES;
 480	
 481	!
 482	    PREV_PTR = .FSTG_ROOT [FSTG_NEXT];
 483	
 484	    IF (.PREV_PTR NEQ 0)
 485	    THEN
 486		BEGIN					!WE HAVE A FREE LIST
 487	
 488		WHILE ((THIS_PTR = .PREV_PTR [FSTG_NEXT]) NEQ 0) DO
 489		    BEGIN				!SCAN THE FREE LIST
 490	
 491		    IF ((.PREV_PTR [FSTG_SIZE] + .PREV_PTR) EQL .THIS_PTR)
 492		    THEN
 493			BEGIN				!"PREV" AND "THIS" ARE ADJACENT
 494			NEXT_PTR = .THIS_PTR [FSTG_NEXT];
 495			PREV_PTR [FSTG_SIZE] = .PREV_PTR [FSTG_SIZE] + .THIS_PTR [FSTG_SIZE];
 496	
 497			IF (.NEXT_PTR NEQ 0)
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 498			THEN
 499			    BEGIN			!"THIS" IS NOT THE LAST ITEM IN THE FREE LIST
 500			    PREV_PTR [FSTG_NEXT] = .NEXT_PTR;
 501			    NEXT_PTR [FSTG_PREV] = .PREV_PTR;
 502			    END
 503			ELSE
 504			    BEGIN			!"THIS" IS LAST IN FREE LIST
 505			    PREV_PTR [FSTG_NEXT] = 0;
 506			    FSTG_ROOT [FSTG_PREV] = .PREV_PTR;
 507			    END;			!OF LAST IN FREE LIST PROCESSING
 508	
 509			THIS_PTR = .PREV_PTR;		!CHECK NEW BLOCK AGAINST NEXT
 510			END;				!OF COMBINING ADJACENT BLOCKS
 511	
 512		    PREV_PTR = .THIS_PTR;		!GO ON TO NEXT BLOCK (UNLESS COMBINED)
 513		    END;				!OF SCAN OF FREE LIST
 514	
 515		END;					!OF HAVING A FREE LIST
 516	
 517	    END;					!OF ROUTINE COLLECT_STORAGE
 518	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 519	GLOBAL ROUTINE FRESTG (ADDRESS, AMOUNT) : NOVALUE = 	!FREE STORAGE
 520	
 521	!++
 522	! FUNCTIONAL DESCRIPTION:
 523	!
 524	!	THIS ROUTINE RETURNS STORAGE TO THE FREE LIST
 525	!
 526	! FORMAL PARAMETERS:
 527	!
 528	!	ADDRESS - POINTER TO THE STORAGE TO FREE
 529	!	AMOUNT - LENGTH OF THAT STORAGE
 530	!
 531	! IMPLICIT INPUTS:
 532	!
 533	!	THE FREE STORAGE LIST
 534	!
 535	! IMPLICIT OUTPUTS:
 536	!
 537	!	THE FREE STORAGE LIST
 538	!
 539	! ROUTINE VALUE:
 540	!
 541	!	NONE
 542	!
 543	! SIDE EFFECTS
 544	!
 545	!	NONE
 546	!
 547	!--
 548	
 549	    BEGIN
 550	
 551	    LOCAL
 552		AMT,
 553		NEXT_PTR : REF ADDRESSES,
 554		STG_PTR : REF ADDRESSES,
 555		FOUND_PLACE;
 556	
 557	    MAP
 558		ADDRESS : REF ADDRESSES;
 559	
 560	!
 561	    AMT = .AMOUNT;				!AMOUNT OF STORAGE REQUESTED
 562	!
 563	! ROUND STORAGE REQUEST UP TO COVER SPACE NEEDED FOR FREE STORAGE
 564	!  CHAIN HEADERS.
 565	!
 566	
 567	    IF ((.AMT*%BPVAL) LSS (FSTG_HDRL*%BPADDR)) THEN AMT = ((FSTG_HDRL*%BPADDR) + (%BPVAL - 1))/%BPVAL;
 568	
 569	!
 570	! FIND PLACE TO INSERT THIS BLOCK IN THE FREE STORAGE LIST
 571	!
 572	    STG_PTR = FSTG_ROOT;
 573	    FOUND_PLACE = 0;
 574	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 575	    WHILE ((.STG_PTR NEQ 0) AND (.FOUND_PLACE EQL 0)) DO
 576		BEGIN
 577		NEXT_PTR = .STG_PTR [FSTG_NEXT];
 578	
 579		IF ((.NEXT_PTR NEQ 0) AND (.NEXT_PTR GTRA .ADDRESS)) THEN FOUND_PLACE = 1 ELSE STG_PTR = .NEXT_PTR;
 580	
 581		END;
 582	
 583	    IF (.STG_PTR EQL 0)
 584	    THEN
 585		BEGIN					!NEW BLOCK GOES AT END OF CHAIN
 586		STG_PTR = .FSTG_ROOT [FSTG_PREV];
 587		END;
 588	
 589	    ADDRESS [FSTG_SIZE] = .AMT;
 590	    ADDRESS [FSTG_PREV] = (IF (.STG_PTR EQL FSTG_ROOT) THEN 0 ELSE .STG_PTR);
 591	
 592	    IF (.STG_PTR NEQ 0)
 593	    THEN
 594		BEGIN					!THERE IS AN OLD CHAIN
 595		ADDRESS [FSTG_NEXT] = .STG_PTR [FSTG_NEXT];
 596		NEXT_PTR = .STG_PTR [FSTG_NEXT];
 597		STG_PTR [FSTG_NEXT] = .ADDRESS;
 598	
 599		IF (.NEXT_PTR NEQ 0) THEN NEXT_PTR [FSTG_PREV] = .ADDRESS ELSE FSTG_ROOT [FSTG_PREV] = .ADDRESS;
 600	
 601		END
 602	    ELSE
 603		BEGIN					!THIS IS ONLY ITEM ON LIST
 604		ADDRESS [FSTG_NEXT] = 0;
 605		FSTG_ROOT [FSTG_NEXT] = .ADDRESS;
 606		FSTG_ROOT [FSTG_PREV] = .ADDRESS;
 607		END;
 608	
 609	    COLLECT_STORAGE ();
 610	    END;
 611	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 612	GLOBAL ROUTINE GETBLK (BLOCK_TYPE, BLOCK_LENGTH) = 	!GET A BLOCK
 613	
 614	!++
 615	! FUNCTIONAL DESCRIPTION:
 616	!
 617	!	THIS ROUTINE GETS A BLOCK AND FILLS IN ITS HEADER.
 618	!
 619	! FORMAL PARAMETERS:
 620	!
 621	!	BLOCK_TYPE - THE TYPE OF THE BLOCK TO GET
 622	!	BLOCK_LENGTH - THE LENGTH OF THE BLOCK TO GET
 623	!
 624	! IMPLICIT INPUTS:
 625	!
 626	!	NONE
 627	!
 628	! IMPLICIT OUTPUTS:
 629	!
 630	!	NONE
 631	!
 632	! ROUTINE VALUE:
 633	!
 634	!	A POINTER TO THE BLOCK GOTTEN, OR 0 IF OUT OF STORAGE
 635	!
 636	! SIDE EFFECTS
 637	!
 638	!	MAY DO A CORE UUO TO GET STORAGE
 639	!
 640	!--
 641	
 642	    BEGIN
 643	
 644	    LOCAL
 645		RESULT : REF ADDRESSES;
 646	
 647	!
 648	
 649	    IF ((RESULT = GETSTG (.BLOCK_LENGTH)) NEQ 0)
 650	    THEN
 651		BEGIN
 652		RESULT [0] = .BLOCK_TYPE;
 653		RESULT [1] = .BLOCK_LENGTH;
 654		END;
 655	
 656	    .RESULT
 657	    END;
 658	
 659	!
 660	
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

 661	GLOBAL ROUTINE FREBLK (ADDRESS) : NOVALUE = 	!FREE A BLOCK
 662	
 663	!++
 664	! FUNCTIONAL DESCRIPTION:
 665	!
 666	!	THIS ROUTINE RETURNS A BLOCK GOTTEN BY GETBLK
 667	!
 668	! FORMAL PARAMETERS:
 669	!
 670	!	ADDRESS - POINTER TO THE BLOCK TO BE FREED
 671	!
 672	! IMPLICIT INPUTS:
 673	!
 674	!	NONE
 675	!
 676	! IMPLICIT OUTPUTS:
 677	!
 678	!	NONE
 679	!
 680	! ROUTINE VALUE:
 681	!
 682	!	NONE
 683	!
 684	! SIDE EFFECTS
 685	!
 686	!	NONE
 687	!
 688	!--
 689	
 690	    BEGIN
 691	
 692	    LOCAL
 693		LEN;
 694	
 695	    MAP
 696		ADDRESS : REF ADDRESSES;
 697	
 698	!
 699	    LEN = .ADDRESS [1];
 700	    FRESTG (.ADDRESS, .LEN);
 701	    END;
 702	
 703	!
 704	END
 705	
 706	ELUDOM
 707	! Local Modes:
 708	! Comment Start:!
 709	! Comment Column:36
 710	! Mode:Fundamental
 711	! Auto Save Mode:2
 712	! End:
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

ADDRESS		 519	 558	 579	 589#	 590#	 595#	 597
		 599	 604#	 605	 606	 661	 696	 699
		 700
ADDRESSES	  97#	  99	 118	 294	 295	 359	 360
		 361	 477	 478	 479	 553	 554	 558
		 645	 696
AMOUNT		 128	 168	 172	 176	 232	 326	 373
		 519	 561
AMT		 260	 304	 358	 373#	 375	 379	 386#
		 392	 397	 401	 405	 424	 427	 433
		 552	 561#	 567#	 589
BEST_PTR	 295	 299#	 308	 312#	 316#	 323
BLOCK_LENGTH	 612	 649	 653
BLOCK_TYPE	 612	 652
COLLECT_STORAGE	  71	 395	 404	 442*	 609
COUNTER		 433	 434
COUNTS		 119	 377#	 379#
ERROR		 126*	 170	 368
FOUND_PLACE	 555	 573#	 575	 579#
FREBLK		  74#	 661*
FRESTG		  72	 172	 401	 428	 519*	 700
FSTG_HDRL	 110#	 118	 386	 424	 567
FSTG_NEXT	 108#	 166	 298	 320	 418	 422	 482
		 488	 494	 500	 505	 577	 595	 596
		 597	 604	 605
FSTG_PREV	 109#	 417	 420	 501	 506	 586	 590
		 599	 606
FSTG_ROOT	 118	 166#	 298	 420#	 422#	 482	 506#
		 572	 586	 590	 599#	 605#	 606#
FSTG_SIZE	 107#	 304	 312	 424	 491	 495	 589
GETBLK		  73	 612*
GETSTG		  70	 168	 326*	 649
GET_MORE_CORE	 176*	 401
INDEX		  97	  99
INISTG		  69	 128*
INITIALIZED	 117	 165#	 365
LEN		 693	 699#	 700
NEXT_PTR	 359	 418#	 420#	 422	 427#	 428	 477
		 494#	 497	 500	 501#	 553	 577#	 579
		 596#	 599#
PREV_PTR	 360	 417#	 420	 422#	 478	 482#	 484
		 488	 491	 495#	 500#	 501	 505#	 506
		 509	 512#
R		 229	 247#	 249
RESULT		 362	 431#	 434#	 645	 649#	 652#	 653#
		 656
SEARCH_CHAIN	 260*	 392	 397	 405
STGM		   4#
STG_POINTER	 162	 168#	 172	 213	 231#	 236#	 249#
		 257
STG_PTR		 294	 298#	 301	 304	 312	 316	 320#
		 554	 572#	 575	 577	 579#	 583	 586#
		 590	 592	 595	 596	 597#
TEMP		 214	 232#	 234	 239
THIS_PTR	 361	 392#	 397#	 401#	 405#	 414	 417
		DSK:STGM.XRF[4,31]               31-Aug-79 15:02

		 418	 424	 427	 431	 438	 479	 488#
		 491	 494	 495	 509#	 512
UNUSED_AMOUNT	 363	 424#	 428
UUO		 224	 249
VLENGTH		  97	  98