	.TITLE	RECLAIM
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR:		GARBAGE COLLECTOR
; ENTRY:	NO ARGS
; EXIT:		1 ARG		NIL
; ERRORS:	NONE
; CALLS:	GET, SEARCH PROPERTY LIST
;		TIMER, COMPUTE ELAPSED TIME
;		PRNT, OUTPUT AN ASCIZ STRING OF CHARACTERS
;		FCO, F FORMAT CONVERSION FOR OUTPUT
;		ICO, I FORMAT CONVERSION FOR OUTPUT
; R1,R2,R3 PRESERVED
	.GLOBL	RECLAIM,ZRECLAIM,ASTART
	.GLOBL	$ALIST,ENDLSP,FSTART,SSTART,FLIST
	.GLOBL	GSW,STIME,APVAL,QTIMER,QPRNT
	.GLOBL	QFCO,QICO,QGET
RECLAIM:MOV	R3,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R5,R2	;INIT DEQUE (SPACE BETWEEN R5,R4 STACK TOPS
	MOV	R5,R3	;GUARANTEED AT LEAST 1 WD) R2,R3 POINTERS
			;R4,R5 DEQUE LIMITS
	MOV	SSTART,(PC)+	;LOWEST MEMORY LOCATION WHERE
K1:	.WORD	0	;MARK SWEEP MUST START
	CLR	R1	;HANDLE NIL SPECIALLY
	MOV	(R1)+,R0;MARK ITS CAR
	JSR	PC,MARKI
	MOV	@R1,R0	;AND ITS CDR
	JSR	PC,MARKI;BUT NOT ITS SPECIAL HEADER CELL
	MOV	$ALIST,R0
	JSR	PC,MARKI;MARK THE ASSOCIATION LIST
	MOV	ENDLSP,R1	;MARK ALL ITEMS ON THE ARG STACK
GC01:	CMP	R1,R5
	BLOS	GC02	;JUMP WHEN ALL STACK ITEMS MARKED
	MOV	-(R1),R0
	JSR	PC,MARKI
	BR	GC01
GC02:	MOV	ASTART,R1	;MARK ALL ARRAY ELEMENTS
	CLR	-(SP)	;ARRAY SIZE COUNTER
GC03:	CMP	FSTART,R1
	BLOS	2$	;JUMP WHEN ALL ARRAYS MARKED
	MOV	(R1)+,@SP	;SAVE SIZE OF NEXT ARRAY
	ROR	@SP
1$:	DEC	@SP	;NUMBER OF ELEMENTS TO MARK
	BEQ	GC03	;JUMP IF DONE WITH THIS ARRAY
	MOV	(R1)+,R0;MARK NEXT ELEMENT
	JSR	PC,MARKI
	BR	1$
2$:	TST	(SP)+
; AT THIS POINT ALL IMMEDIATELY ACCESSIBLE CELLS ARE MARKED
; THE REST ARE DEQUED.  NOW CLEAN OUT THE DEQUE.
GC04:	CMP	R2,R3
	BEQ	GC06	;JUMP WHEN DEQUE IS EMPTY
	CMP	R2,R5	;POP NEXT CELL
	BLO	.+4
	MOV	R4,R2	;WRAP AROUND
	MOV	(R2)+,R1
GC05:	MOV	(R1)+,R0;MARK ITS CAR
	JSR	PC,MARKI
	MOV	@R1,R0	;AND ITS CDR
	JSR	PC,MARKI
	BR	GC04
; AT THIS POINT THE DEQUE IS EMPTY, K1 POINTS TO THE LOWEST
; CELL WHERE THERE MIGHT BE A LEAD TO AN UNMARKED CELL
GC06:	MOV	K1,R1	;START SWEEPING
	ADD	#4,K1	;BUMP THE SWEEP POINTER
1$:	CMP	R1,SSTART
	BHIS	2$	;JUMP IF SWEEPING COMPLETED
	BIT	#1,@R1
	BEQ	GC06	;IF CELL IS MARKED, SKIP IT
	BIT	#2,@R1	;IF ITS A FULL WORD DATA STRING (I.E.
	BNE	GC06	;STRING OR NUMBER) SKIP IT SINCE IT IS
			;COMPLETELY MARKED
	BR	GC05	;ELSE RETURN TO MARK THE CAR AND CDR
2$:
; AT THIS POINT ALL CELLS TO BE SAVED HAVE BEEN MARKED (EXCEPT 
; THE SPECIAL NIL HEADER)
	MOV	FSTART,R0	;POINT TO START OF FREE SPACE
	MOV	#FLIST,R1	;POINT TO FREE LIST
	CLR	-(SP)	;RECLAIMED CELL COUNTER
GC07:	ASR	@R0	;IS CELL MARKED?
	BCC	1$	;JUMP IF NOT
	ASL	(R0)+	;YES: UNMARK IT
	BR	2$
1$:	MOV	R0,@R1	;CHAIN UNMARKED CELLS TO FREE LIST
	CLR	(R0)+	;CLEAR CARS OF FREE LIST CELLS
	MOV	R0,R1	;POINT TO CDR OF CELL
	INC	@SP	;ONE MORE CELL RECLAIMED
2$:	TST	(R0)+	; BUMP TO CAR OF NEXT CELL
	CMP	R0,SSTART	;ANY CELLS LEFT?
	BLO	GC07	;LOOP BACK IF SO
	CLR	@R1	;OTHERWISE TERMINATE FREE LIST
	MOV	(SP)+,(PC)+	;SAVE NUMBER OF CELLS RECLAIMED
FREE:	.WORD	0
	INC	(PC)+	;INCREMENT GARBAGE COLLECTION COUNT
GCCNT:	.WORD	0
	MOV	SSTART,R1
	SUB	FSTART,R1
	CLRB	R1
	SWAB	R1	;NUMBER OF FREE CELLS / 64.
	CMP	FREE,R1
	BGE	GC08
	MOV	#WARN,R3;PRINT WARNING MESSAGE IF LESS THAN
	QPRNT		;1.5% SPACE RECOVERED
GC08:	MOV	APVAL,-(R5)	;PRINT GC MESSAGE?
	MOV	GSW,-(R5)
	QGET
	TST	(R5)+
	BEQ	GC09	;NO: JUST RETURN
	MOV	#GCBUF2,-(SP)
	MOV	#10.,-(SP)
	MOV	#3,-(SP)
	CLR	-(SP)
	MOV	#STIME+4,R0
	MOV	-(R0),-(SP)
	MOV	-(R0),-(SP)
	QTIMER		;GET ELAPSED TIME IN SECONDS
	QFCO		;CONVERT TO F10.3
	MOV	#GCBUF1,-(SP)
	MOV	#6,-(SP)
	MOV	GCCNT,-(SP)
	QICO		;COLLECTION NUMBER IN I6 FORMAT
	MOV	#GCBUF3,-(SP)
	MOV	#6,-(SP)
	MOV	FREE,-(SP)
	QICO		;NUMBER OF FREE CELLS IN I6
	MOV	#GCBUF,R3
	QPRNT		;PRINT THE MESSAGE
GC09:	MOV	(SP)+,R1	;RESTORE REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	CLR	-(R5)	;RETURN NIL
	JMP	@-(R4)
; MARK ALL IMMEDIATELY ACCESSIBLE CELLS STARTING WITH CELL @R0
	MOV	@R0,R0
MARKI:	BIC	#3,R0	;FORCE R0 TO CELL BOUNDARY
	BEQ	MARKED	;NIL IS MARKED BY DEFINITION
	CMP	R0,FSTART	;DON'T TRY TO MARK ANYTHING
	BLO	MARKED	;OUTSIDE THE FREE SPACE AREA
	CMP	R0,SSTART	;(PROTECTION FROM NON-LISP
	BHIS	MARKED	;ARGUMENTS ON THE STACK)
	BIT	#1,@R0
	BNE	MARKED	;DONE IF CELL IS MARKED ALREADY
	INC	@R0	;OTHERWISE MARK IT
	BIT	#2,@R0	;IF THIS IS A FULL WORD DATA STRING
	BNE	MARKI-2	;MARK THE WHOLE THING
	MOV	R0,-(R2)	;ELSE DEQUE THE CELL TO HAVE
	CMP	R2,R4	;ITS CAR AND CDR MARKED LATER
	BHI	.+4
	MOV	R5,R2	;WRAP AROUND
	CMP	R2,R3
	BNE	MARKED
	CMP	K1,-(R3);IF DEQUE FILLS SAVE THE NEW SWEEP POINTER
	BLO	1$
	MOV	@R3,K1
1$:	CMP	R3,R4
	BHI	.+4
	MOV	R5,R3	;WRAP AROUND
MARKED:	RTS	PC
	.NLIST	BEX
GCBUF:	.BYTE	15,12
	.ASCII	/GARBAGE COLLECTION NUMBER /
GCBUF1:	.BLKB	6
	.ASCII	/  AT  /
GCBUF2:	.BLKB	10.
	.ASCII	/  FREED  /
GCBUF3:	.BLKB	6
	.ASCII	/  CELLS/
	.BYTE	15,12,0
WARN:	.ASCIZ	<15><12>/FREE SPACE IS CROWDED/<15><12>
	.EVEN
	.LIST	BEX
ZRECLAIM=.-RECLAIM
	.END
	.TITLE	RECLAIM
; JEFFREY KODOSKY	ARL	NOV75
;
; SUBR:		GARBAGE COLLECTOR
; ENTRY:	NO ARGS
; EXIT:		1 ARG		NIL
; ERRORS:	NONE
	.GLOBL	RECLAIM,ZRECLAIM
; CALLS:	GET, SEARCH PROPERTY LIST
;		TIMER, COMPUTE ELAPSED TIME
;		PRNT, OUTPUT AN ASCIZ STRING OF CHARACTERS
;		FCO, F FORMAT CONVERSION FOR OUTPUT
;		ICO, I FORMAT CONVERSION FOR OUTPUT
; R1,R2,R3 PRESERVED
	.GLOBL	$ALIST,ENDLSP,FSTART,SSTART,FLIST
	.GLOBL	GSW,STIME,APVAL,QTIMER,QPRNT
	.GLOBL	QFCO,QICO,QGET
RECLAIM:MOV	R3,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R5,R2	;INIT DEQUE (SPACE BETWEEN R5,R4 STACK TOPS
	MOV	R5,R3	;GUARANTEED AT LEAST 1 WD) R2,R3 POINTERS
			;R4,R5 DEQUE LIMITS
	MOV	SSTART,(PC)+	;LOWEST MEMORY LOCATION WHERE
K1:	.WORD	0	;MARK SWEEP MUST START
	CLR	R1	;HANDLE NIL SPECIALLY
	MOV	(R1)+,R0;MARK ITS CAR
	JSR	PC,MARKI
	MOV	@R1,R0	;AND ITS CDR
	JSR	PC,MARKI;BUT NOT ITS SPECIAL HEADER CELL
	MOV	$ALIST,R0
	JSR	PC,MARKI;MARK THE ASSOCIATION LIST
	MOV	ENDLSP,R1	;MARK ALL ITEMS ON THE ARG STACK
GC01:	CMP	R1,R5
	BLOS	GC02	;JUMP WHEN ALL STACK ITEMS MARKED
	MOV	-(R1),R0
	JSR	PC,MARKI
	BR	GC01
GC02:	MOV	ASTART,R1	;MARK ALL ARRAY ELEMENTS
	CLR	-(SP)	;ARRAY SIZE COUNTER
GC03:	CMP	FSTART,R1
	BLOS	2$	;JUMP WHEN ALL ARRAYS MARKED
	MOV	(R1)+,@SP	;SAVE SIZE OF NEXT ARRAY
	ROR	@SP
1$:	DEC	@SP	;NUMBER OF ELEMENTS TO MARK
	BEQ	GC03	;JUMP IF DONE WITH THIS ARRAY
	MOV	(R1)+,R0;MARK NEXT ELEMENT
	JSR	PC,MARKI
	BR	1$
2$:	TST	(SP)+
; AT THIS POINT ALL IMMEDIATELY ACCESSIBLE CELLS ARE MARKED
; THE REST ARE DEQUED.  NOW CLEAN OUT THE DEQUE.
GC04:	CMP	R2,R3
	BEQ	GC06	;JUMP WHEN DEQUE IS EMPTY
	CMP	R2,R5	;POP NEXT CELL
	BLO	.+4
	MOV	R4,R2	;WRAP AROUND
	MOV	(R2)+,R1
GC05:	MOV	(R1)+,R0;MARK ITS CAR
	JSR	PC,MARKI
	MOV	@R1,R0	;AND ITS CDR
	JSR	PC,MARKI
	BC	GC04
; AT THIS POINT THE DEQUE IS EMPTY, K1 POINTS TO THE LOWEST
; CELL WHERE THERE MIGHT BE A LEAD TO AN UNMARKED CELL
GC06:	MOV	K1,R1	;START SWEEPING
	ADD	#4,K1	;BUMP THE SWEEP POINTER
1$:	CMP	R1,SSTART
	BHIS	2$	;JUMP IF SWEEPING COMPLETED
	BIT	#1,@R1
	BEQ	GC06	;IF CELL IS MARKED, SKIP IT
	BIT	#2,@R1	;IF ITS A FULL WORD DATA STRING (I.E.
	BNE	GC06	;STRING OR NUMBER) SKIP IT SINCE IT IS
			;COMPLETELY MARKED
	BR	GC05	;ELSE RETURN TO MARK THE CAR AND CDR
2$:
; AT THIS POINT ALL CELLS TO BE SAVED HAVE BEEN MARKED (EXCEPT 
; THE SPECIAL NIL HEADER)
	MOV	FSTART,R0	;POINT TO START OF FREE SPACE
	MOV	#FLIST,R1	;POINT TO FREE LIST
	CLR	-(SP)	;RECLAIMED CELL COUNTER
GC07:	ASR	@R0	;IS CELL MARKED?
	BCC	1$	;JUMP IF NOT
	ASL	(R0)+	;YES: UNMARK IT
	BR	2$
1$:	MOV	R0,@R1	;CHAIN UNMARKED CELLS TO FREE LIST
	CLR	(R0)+	;CLEAR CARS OF FREE LIST CELLS
	MOV	R0,R1	;POINT TO CDR OF CELL
	INC	@SP	;ONE MORE CELL RECLAIMED
2$:	TST	(R0)+	; BUMP TO CAR OF NEXT CELL
	CMP	R0,SSTART	;ANY CELLS LEFT?
	BLO	GC07	;LOOP BACK IF SO
	CLR	@R1	;OTHERWISE TERMINATE FREE LIST
	MOV	(SP)+,(PC)+	;SAVE NUMBER OF CELLS RECLAIMED
FREE:	.WORD	0
	INC	(PC)+	;INCREMENT GARBAGE COLLECTION COUNT
GCCNT:	.WORD	0
	MOV	SSTART,R1
	SUB	FSTART,R1
	CLRB	R1
	SWAB	R1	;NUMBER OF FREE CELLS / 64.
	CMP	FREE,R1
	BGE	GC08
	MOV	#WARN,R3;PRINT WARNING MESSAGE IF LESS THAN
	QPRNT		;1.5% SPACE RECOVERED
GC08:	MOV	APVAL,-(R5)	;PRINT GC MESSAGE?
	MOV	GSW,-(R5)
	QGET
	TST	(R5)+
	BEQ	GC09	;NO: JUST RETURN
	MOV	#GCBUF2,-(SP)
	MOV	#10.,-(SP)
	MOV	#3,-(SP)
	CLR	-(SP)
	MOV	#STIME+4,R0
	MOV	-(R0),-(SP)
	MOV	-(R0),-(SP)
	QTIMER		;GET ELAPSED TIME IN SECONDS
	QFCO		;CONVERT TO F10.3
	MOV	#GCBUF1,-(SP)
	MOV	#6,-(SP)
	MOV	GCCNT,-(SP)
	QICO		;COLLECTION NUMBER IN I6 FORMAT
	MOV	#GCBUF3,-(SP)
	MOV	#6,-(SP)
	MOV	FREE,-(SP)
	QICO		;NUMBER OF FREE CELLS IN I6
	MOV	#GCBUF,R3
	QPRNT		;PRINT THE MESSAGE
GC09:	MOV	(SP)+,R1	;RESTORE REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	CLR	-(R5)	;RETURN NIL
	JMP	@-(R4)
; MARK ALL IMMEDIATELY ACCESSIBLE CELLS STARTING WITH CELL @R0
	MOV	@R0,R0
MARKI:	BIC	#3,R0	;FORCE R0 TO CELL BOUNDARY
	BEQ	MARKED	;NIL IS MARKED BY DEFINITION
	CMP	R0,FSTART	;DON'T TRY TO MARK ANYTHING
	BLO	MARKED	;OUTSIDE THE FREE SPACE AREA
	CMP	R0,SSTART	;(PROTECTION FROM NON-LISP
	BHIS	MARKED	;ARGUMENTS ON THE STACK)
	BIT	#1,@R0
	BNE	MARKED	;DONE IF CELL IS MARKED ALREADY
	INC	@R0	;OTHERWISE MARK IT
	BIT	#2,@R0	;IF THIS IS A FULL WORD DATA STRING
	BNE	MARKI-2	;MARK THE WHOLE THING
	MOV	R0,-(R2)	;ELSE DEQUE THE CELL TO HAVE
	CMP	R2,R4	;ITS CAR AND CDR MARKED LATER
	BHI	.+4
	MOV	R5,R2	;WRAP AROUND
	CMP	R2,R3
	BNE	MARKED
	CMP	K1,-(R3);IF DEQUE FILLS SAVE THE NEW SWEEP POINTER
	BLO	1$
	MOV	@R3,K1
1$:	CMP	R3,R4
	BHI	.+4
	MOV	R5,R3	;WRAP AROUND
MARKED:	RTS	PC
	.NLIST	BEX
GCBUF:	.BYTE	15,12
	.ASCII	/GARBAGE COLLECTION NUMBER /
GCBUF1:	.BLKB	6
	.ASCII	/  AT  /
GCBUF2:	.BLKB	10.
	.ASCII	/  FREED  /
GCBUF3:	.BLKB	6
	.ASCII	/  CELLS/
	.BYTE	15,12,0
WARN:	.ASCIZ	<15><12>/FREE SPACE IS CROWDED/<15><12>
	.EVEN
	.LIST	BEX
ZRECLAIM=.-RECLAIM
	.END
