perm filename CREMEM[GEM,BGB] blob sn#050721 filedate 1973-08-08 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00007 PAGES 
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00002 00002	TITLE CREMEM  -  MEMORY MANAGEMENT  -  BGB  -  16 APRIL 1973.
00500	 00004 00003	SUBR(MKNODD)TYPE.		MAKE A NODE.
00600	 00006 00004	MORCOR:		GET MORE CORE.
00700	 00008 00005	SUBR(SHRINQ).		SHRINQ NODE SPACE.
00800	 00009 00006		SHRINQ - CONTINUED.
00900	 00011 00007	SUBR(RELLOC)BASE.		MEMORY RELLOCATOR.
01000	 00013 ENDMK
01100	⊗;
     

00100	TITLE CREMEM  -  MEMORY MANAGEMENT  -  BGB  -  16 APRIL 1973.
00200	
00300	;CRE DECLARATIONS.
00400		INTERN HI,HEADER,VSEG,HSEG,HISTO,COLPTR,ROWPTR
00500		INTERN TVBUF,PAC,SKY
00600		INTERN FTVSIX,FTVHIS
00700	
00800	;CAREYE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
00900	;=10 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.
01000	;=118 WORD TRAILER.
01100	
01200		HI ←← 400000
01300	
01400		PAC ← HI ↔ HI ←← HI + =1728	;PICTURE ACCUMULATOR.
01500		VSEG← HI ↔ HI ←← HI + =1729	;VERTICAL SEGMENTS.
01600		HSEG← HI ↔ HI ←← HI + =1736	;HORIZONTAL SEGMENTS.
01700	
01800			   HI ←← HI + =86	;NEGATIVE ROWS.
01900	HEADER←HI	↔  HI ←← HI + =128
02000	TVBUF ←HI	↔  HI ←← HI + =10368	;TV BUFFER 6 BITS PER PIXEL.
02100	SKY←HI		↔  HI ←← HI + =31500	;SKY ARRAY.
02200	
02300	;POINTERS TO TV BUFFER.
02400	TV:	0
02500		POINT 6,-1,29	;COLUMN -2.
02600		POINT 6,-1,35	;COLUMN -1.
02700	COLPTR:	FOR I←0,=48{
02800		I+<POINT 6,0,05>↔I+<POINT 6,0,11>↔I+<POINT 6,0,17>
02900		I+<POINT 6,0,23>↔I+<POINT 6,0,29>↔I+<POINT 6,0,35>}
03000	ROWPTR:	FOR I←0,=216{
03100		I*=48+TVBUF}
03200		TVSEG:	0
03300	
03400	;POINTERS TO SKY ARRAY.
03500		INTERN PUTSKY,GETSKY
03600		PUTSKY:	FOR I←0,=108{DIP 0,SKY+=289*I(3)
03700	}↔		FOR I←1,=108{DAP 0,SKY+=289*I(3)
03800	}↔	GETSKY:	FOR I←0,=108{CAR 1,SKY+=289*I(3)
03900	}↔		FOR I←1,=108{CDR 1,SKY+=289*I(3)
04000	}
04100		INTERN QIMAGE,QNODE
04200		QIMAGE:0↔BLOCK 8
04300		QNODE:0↔BLOCK 8
04400	HISTO:	BLOCK =64
04500	FTVSIX: 0
04600	FTVHIS: 0
     

00100	SUBR(MKNODD)TYPE.		MAKE A NODE.
00200	BEGIN MKNODD;-----------------------------------------------------
00300		SKIPN 1,@AVAIL2
00400		CALL(MORCOR)
00500		CDR(1)↔DAP @AVAIL2
00600		DZM(1)↔AOS @NODCNT
00700		POP P,.+3↔POP P,2(1)↔GO @.+1↔0
00800		POP1J
00900	BEND MKNODD; BGB 10 JANUARY 1973 ---------------------------------
01000	
01100	SUBR(KLNODD)NODE.		KILL A NODE.
01200	BEGIN KLNODD;-----------------------------------------------------
01300		LAC 1,ARG1
01400		SOS @NODCNT
01500		DZM(1)↔LIPI(1)↔LAPI 1(1)↔BLT NODSIZ-1(1)
01600		LAC @AVAIL2↔DAPZ(1)↔DAPZ 1,@AVAIL2
01700		POP1J
01800	BEND KLNODD; BGB 17 DECEMBER 1972 --------------------------------
01900	
02000	SUBR(RINGIN)PART,WHOLE.		ATTACH A NODE IN A RING.
02100	BEGIN RINGIN;-----------------------------------------------------
02200		LAC 1,ARG2↔LAC 3,ARG1
02300		DAD. 3,1↔SON 2,3
02400		JUMPE 2,[SON. 1,3
02500		DIP 1,(1)↔DAP 1,(1)↔POP2J]
02600		CAR 3,(2)
02700		DIP 3,(1)↔DAP 1,(3)
02800		DAP 2,(1)↔DIP 1,(2)
02900		POP2J↔LIT
03000	BEND RINGIN; BGB 6 DECEMBER 1972 ---------------------------------
     

00100	MORCOR:		;GET MORE CORE.
00200	BEGIN MORCOR;-----------------------------------------------------
00300	
00400	;INITIALIZE FILM BLOCK POINTERS WHEN NECESSARY.
00500		SKIPE CRE44↔GO L1
00600		LAC 1,44↔DAC 1,CRE44
00700		AOS 1↔DAC 1,FILM
00800		ADDI 1,3↔DAC 1,AVAIL2
00900		AOS 1↔DAC 1,NODCNT
01000		DZM REMAINDER
01100	
01200	;FOUR MORE K !
01300	L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
01400		CORE↔GO[FATAL(NO MORE CORE.)]
01500		AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
01600		DZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
01700	
01800	;MAKE AVAIL2 LIST.
01900		DIP 1,1↔ADD 1,[XWD NODSIZ,0]
02000		SKIPE@NODCNT↔GO .+3
02100		ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@NODCNT
02200		DAPZ 1,@AVAIL2
02300	L2:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
02400		CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
02500		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
02600		LACI 10000↔ADDM @FILM
02700		LAC 1,FILM↔LAC[FBIT+010000]↔DAC 2(1)
02800		LAC 1,@AVAIL2
02900		LAC 2,AC2↔POP0J
03000	BEND MORCOR; BGB 4 DECEMBER 1972 ---------------------------------
03100	;MORCOR - GET MORE CORE.
03200		INTERN CRE44,FILM,NODCNT,AVAIL2,REMAIN,FNAME,FNAME6
03300		CRE44:	0
03400		FILM:	0
03500		NODCNT: 0
03600		AVAIL2:	0
03700		REMAINDER:0
03800		FNAME: ASCIZ/TMP/↔0
03900		FNAME6:	SIXBIT/TMP/
     

00100	SUBR(SHRINQ).		SHRINQ NODE SPACE.
00200	BEGIN SHRINQ;-----------------------------------------------------
00300	
00400		ACCUMULATORS{A,HOLE,BREAK,NODE}
00500		LAC@NODCNT↔IMULI NODSIZ↔ADD FILM
00600		DAC BREAK↔LACI NODE,-NODSIZ(BREAK)↔SKIPA HOLE,FILM
00700	
00800	;FIND A HOLE BELOW THE BREAK.
00900	L1:	ADDI HOLE,NODSIZ↔CAML HOLE,BREAK↔GO L3
01000		LAC 2(HOLE)↔JUMPN 0,L1
01100	
01200	;FIND A NODE ABOVE THE BREAK.
01300	L2:	ADDI NODE,NODSIZ
01400		CAML NODE,44↔GO[FATAL({SHRINQ - NODE CNT TOO BIG.})]
01500		LAC 2(NODE)↔JUMPE 0,L2	;ARE THERE AND TYPE OR REL BITS ?
01600	
01700	;MOVE THE NODE INTO THE HOLE.
01800		DIP NODE,0↔DAP HOLE,0
01900		BLT 0,NODSIZ-1(HOLE)
02000		DAPZ HOLE,0(NODE)	;NODE'S NEW LOCATION.
02100		GO L1
02200	
     

00100		;SHRINQ - CONTINUED.
00200	;REPLACE LINKS ABOVE THE BREAK WITH THEIR NEW VALUES.
00300		DEFINE KAR(Q){
00400			CAR 1,Q(A)
00500			CAML 1,BREAK↔LAC 1,0(1)
00600			DIP 1,Q(A)↔GO .+1}
00700		DEFINE KDR(Q){
00800			CDR 1,Q(A)
00900			CAML 1,BREAK↔LAC 1,0(1)
01000			DAP 1,Q(A)↔GO .+1}
01100	
01200	L3:	LAC A,FILM	;BLOCK POINTER.
01300	L4:	RELOC 0,A↔TRNE 400000↔LACI 333333
01400		TRNE 200000↔GO[KAR 0]↔ TRNE 100000↔GO[KDR 0]
01500		TRNE 20000 ↔GO[KAR 1]↔ TRNE 10000 ↔GO[KDR 1]
01600		TRNE 2000  ↔GO[KAR 3]↔ TRNE 1000  ↔GO[KDR 3]
01700		TRNE 200   ↔GO[KAR 4]↔ TRNE 100   ↔GO[KDR 4]
01800		TRNE 20    ↔GO[KAR 5]↔ TRNE 10    ↔GO[KDR 5]
01900		TRNE 2     ↔GO[KAR 6]↔ TRNE 1     ↔GO[KDR 6]
02000		ADDI A,NODSIZ↔CAMGE A,BREAK↔GO L4
02100	
02200	;SHRINQ CORE SIZE AND RESET AVAIL2 LIST.
02300		LAC 0,BREAK↔IORI 0,1777↔CORE↔HALT	   ;SHRINQ CORE.
02400		LAC 1,BREAK↔LAC 2,44↔DAPZ 1,@AVAIL2	   ;NEW BOUNDS.
02500		LACI 0,1(1)↔DIP 1,0↔DZM(1)↔BLT(2)	   ;CLEAR AVAIL2S.
02600		LACI 1(2)↔SUB FILM↔DAC@FILM		   ;NEW CORE SIZE.
02700	
02800		LIPI 1,NODSIZ(1)↔GO L6
02900	L5:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
03000	L6:	CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
03100		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER↔POP0J
03200	
03300		LIT
03400	BEND;1/17/73------------------------------------------------------
03500	
     

00100	SUBR(RELLOC)BASE.		MEMORY RELLOCATOR.
00200	BEGIN RELLOC;-----------------------------------------------------
00300	
00400		ACCUMULATORS{A,B,C,D}
00500		DEFINE KAR(Q){CAR Q(A)↔SKIPE↔ADD B↔DIP Q(A)↔GO .+1}
00600		DEFINE KDR(Q){CDR Q(A)↔SKIPE↔ADD B↔DAP Q(A)↔GO .+1}
00700	
00800		LAC B,ARG1	;BASE ADDRESS.
00900		LAC A,FILM	;BLOCK POINTER.
01000	
01100	L1:	SKIPN(A)2↔GO[KDR 0↔GO L2]	;EMPTY BLOCK.
01200	
01300		RELOC D,A↔TRNE D,400000↔LACI D,333333
01400		TRNE D,200000↔GO[KAR 0]↔ TRNE D,100000↔GO[KDR 0]
01500		TRNE D,20000 ↔GO[KAR 1]↔ TRNE D,10000 ↔GO[KDR 1]
01600		TRNE D,2000  ↔GO[KAR 3]↔ TRNE D,1000  ↔GO[KDR 3]
01700		TRNE D,200   ↔GO[KAR 4]↔ TRNE D,100   ↔GO[KDR 4]
01800		TRNE D,20    ↔GO[KAR 5]↔ TRNE D,10    ↔GO[KDR 5]
01900		TRNE D,2     ↔GO[KAR 6]↔ TRNE D,1     ↔GO[KDR 6]
02000	
02100	L2:	ADDI A,NODSIZ+NODSIZ↔CAML A,44↔POP1J
02200		SUBI A,NODSIZ
02300		GO L1
02400		LIT
02500	BEND RELLOC; BGB 3 DECEMBER 1972 ---------------------------------
02600	
02700	END