00100	SUBTTL GARBAGE COLLECTER   --- PAGE 16
00200	
00300	GC:	PUSHJ P,AGC
00400		JRST FALSE
00500	
00600	AGC:	DAC R,RGC#
00700	GCPK1:	PUSH P,PA3
00800		PUSH P,PA4
00900		PUSH P,UBDPTR	;special atom UNBOUND; not on OBLIST
01000		PUSH P,MKNAM3
01100		PUSH P,GCMKL	;i/o channel INPOT lists and arrays
01200		PUSH P,BIND3
01300		PUSH P,INITF
01400	GCPK2:	PUSH P,[XWD 0,GCP6]	;this is a return address
01500	
01600	;save AC 0 thru 10 in (regPDL)+1 thru +11.
01700		lac  s,orgPDL
01800		addi s,11
01900		dap  s,.+2
02000		subi s,10
02100		blt  s,x
02200	;clear bit tables.
02300		lac a,orgHBT
02400		setzm (a)
02500		hrl a,a
02600		aos a
02700		lac endFBT
02800		dap .+1
02900		blt a,x
03000		setz ;indicate GC on CPU lights.
03100	;report what is exhausted.
03200		SKIPN GCGAGV
03300		JRST GCP5A
03400		SKIPN F
03500		STRTIP [SIXBIT /←FREE STG EXHAUSTED←!/]
03600		SKIPN FF
03700		STRTIP [SIXBIT /←FULL WORD SPACE EXHAUSTED←!/]
03800	;mark time of GC entry.
03900	GCP5A:	MOVEI TT,1 ;bit for marking.
04000		MOVEI A,0
04100		CALLI A,STIME	;time
04200		MOVNS A
04300		ADDM  A,GCTIM#
04400	;Initialize HBT referances.
04500		lacn A,orgHWS
04600		ash  A,-5
04700		add  A,orgHBT
04800		aos  A
04900		dap  A,GCBTP1
05000		dap  A,GCBTP2
05100		lac  A,orgFBT
05200		dap  A,C2GC
     

00100	;get a node off the PDL.
00200	GCP3:	LAC C,orgPDL	;start at the bottom of the PDL.
00300	GCP6B:	LAC S,P
00400		HLL C,P
00500		MOVEI B,0
00600	GC1:	CAMN C,S
00700		POPJ P,
00800		LAPZ A,(C)
00900	
01000	;Address Test for within LISP space.
01100	GCP:	CAMG  A,endFWS
01200		CAMGE A,orgHWS
01300		JRST GCEND
01400		CAMLE A,endHWS
01500		JRST GCMFWS
01600	
01700	;mark a LISP node of the halfword space.
01800		LAC F,(A)
01900		LSHC A,-5
02000		ROT B,5
02100		LAC AR1,GCBT(B)
02200	GCBTP2:	TDOE AR1,X(A)
02300		JRST GCEND
02400	GCBTP1:	DAC AR1,X(A)
02500		PUSH P,F
02600		LIPZ A,F
02700		JRST GCP
02800	
02900	;mark a full word.
03000	GCMFWS:	LAC  AR1,A
03100		SUB   AR1,orgFWS
03200		IDIVI AR1,44
03300		MOVNS AR2A
03400		LSH AR2A,36
03500		ADD AR2A,C2GC
03600		DPB TT,AR2A
03700	GCEND:	CAMN P,S
03800		AOJA C,GC1
03900		POP P,A
04000		HRRZS A
04100		JRST GCP
04200	
04300	GCMKL:	XWD 0,[XWD [XWD -NIOCH,CHTAB+FSTCH],0]
04400	C2GC:	XWD 430100+AR1,X	;.=bottom of fws bit table
04500	GCBT:	1B0
04600		FOR @' I←1,=31{
04700		1B'I}
     

00100	GCP6:	LAPZ R,SC2
00200	GCP6C:	CAIL R,(SP)	;mark sp
00300		JRST GCP6A
00400		PUSH P,(R)
00500		LAPZ C,P
00600		PUSHJ P,GCP6B
00700		SUB P,[XWD 1,1]
00800		AOJA R,GCP6C
00900	
01000	GCP6A:	LAPZ R,GCMKL	;mark arrays
01100	GCP6D:	JUMPE R,GCSWP
01200		LIPZ A,(R)
01300		LAC D,(A)
01400	GCP6E:	PUSH P,(D)
01500		LAPZ C,P
01600		PUSH P,(D)
01700		MOVSS (P)
01800		PUSHJ P,GCP6B
01900		SUB P,[XWD 2,2]
02000		AOBJN D,GCP6E
02100		LAPZ R,(R)
02200		JRST GCP6D
02300	
     

00100	GFSWPP:
00200		JUMPL S,3	;0
00300		DAPZ F,(R)	;1   put R on Free List.
00400		LAPZ F,R	;2
00500		LSH S,1		;3   next bit.
00600		AOBJN R,0  	;4   address next word.
00700		LAC S,(D)	;5   get more bits from HBT.
00800		HRLI R,-40	;6   set bit counter.
00900		AOBJN D,0    	;7   increm HBT pointer.
01000		JRST X		;10  return from AC's.
01100				;11  S word from HBT.
01200				;12  D -wrdcnt,,HBT ptr.
01300				;13  R -bitcnt,,HWS ptr.
01400				;14  P
01500				;15  F free storage list.
01600	
01700	;garbage collector sweep
01800	
01900	GCSWP:	MOVSI R,GFSWPP
02000		BLT R,10
02100		MOVEI F,NIL	;will become movei f,-1
02200		lacn D,sizHBT
02300		hrlz D,D
02400		lap  D,orgHBT
02500	
02600		lac R,orgHWS
02700		andi R,37
02800		dap  R,GCBTL2
02900		subi R,=32
03000		hrlz R,R
03100		lap R,orgHWS
03200		LAC S,(D)
03300	GCBTL2:	ROT S,X
03400		hrri 10,.+2
03500		AOBJN D,0
03600	
03700		lacn A,sizFWS
03800		movss A
03900		lap A,orgFWS
04000		lac B,endHBT
04100		hrli B,100
04200	
04300		MOVEI FF,0
04400	GCS1:	ILDB C,B
04500		JUMPN C,GCS2
04600		DAPZ FF,(A)
04700		LAPZ FF,A
04800	GCS2:	AOBJN A,GCS1
     

00100		SKIPN GCGAGV
00200		JRST GCSP1
00300		LAC B,F
00400		PUSHJ P,GCPNT
00500		STRTIP [SIXBIT / FREE STG,!/]
00600		LAC B,FF
00700		PUSHJ P,GCPNT
00800		STRTIP [SIXBIT / FULL WORDS AVAILABLE←!/]
00900	GCSP1:	LAPZ  S,orgPDL
01000		AOS S
01100		MOVSS s
01200		BLT S,NACS+3	;reload ac's
01300		SUB P,[XWD GCPK2-GCPK1,GCPK2-GCPK1]	;restore p
01400		JUMPE F,[ERR2 [SIXBIT /NO FREE STG LEFT!/]]
01500		JUMPE FF,[ERR2 [SIXBIT /NO FW STG LEFT!/]]
01600		LAC R,RGC
01700		MOVEI A,0
01800		CALLI A,STIME	;time
01900		ADDM A,GCTIM
02000		POPJ P,
02100	
     

00100	;Garbage Collector Statistics.
00200	
00300	GCGAG:	EXCH A,GCGAGV#
00400		POPJ P,
00500	
00600	GCTIME:	LAC A,GCTIM
00700		JRST FIX1A
00800	
00900	TIME:	MOVEI A,0
01000		CALLI A,STIME
01100		JRST FIX1A
01200	
01300	SPEAK:	LAC A,CONSVAL#
01400		JRST FIX1A
01500	
01600	GCPNT:	MOVEI R,TTYO
01700		MOVEI A,0
01800		JUMPE B,PRINL1
01900		LAPZ B,(B)
02000		AOJA A,.-2
     

00100	SUBTTL GETSYM     --- PAGE 17
00200	
00300	R50MAK:	PUSHJ P,PNAMUK
00400		PUSH C,[0]
00500		HRLI C,700
00600		HRRI C,(SP)
00700		MOVEI B,0
00800	MK3:	ILDB A,C
00900		LDB A,R50FLD
01000		CAMGE B,[50*50*50*50*50]
01100		SKIPN A
01200		POPJ P,
01300		IMULI B,50
01400		ADD B,A
01500		JRST MK3
01600	
01700	GETSYM:	PUSHJ P,R50MAK
01800		TLO B,040000	;04 for globals
01900		LAC C,JOBSYM
02000	MK7:	CAMN B,(C)
02100		JRST MK10	;found
02200		AOBJP C,.+2
02300		AOBJN C,MK7
02400		TLC B,140000	;10 for locals
02500		TLNE B,100000
02600		JRST MK7-1
02700		JRST FALSE
02800	
02900	MK10:	LAC A,1(C)	;value
03000		JRST FIX1A
03100	
03200	PUTSYM:	PUSH P,B
03300		PUSHJ P,R50MAK
03400		LAC A,B
03500		TLO A,040000	;make global
03600		SKIPL JOBSYM
03700		AOS JOBSYM	;increment initial symbol table pointer
03800		MOVN B,[XWD 2,2]
03900		ADDB B,JOBSYM
04000		DAC A,(B)	;name
04100		POP P,1(B)	;value
04200		JRST FALSE
04300	
04400	PATCH:	BLOCK 200
     

00100	SUBTTL ALVINE AND LOADER INTERFACES   --- PAGE 18
00200	
00300	;interface to alvine
00400	EDXX: 0
00500	
00600	ED:	MOVEI 10,EDXX
00700		JRST (10)
00800	
00900	GRINDEF: PUSH P,A
01000		PUSHJ P,ED
01100		POP P,A
01200		JRST 2(10)
01300	
01400	EXCISE:	JRST TRUE
01500	
01600	XLIST
01700	VAR
01800	LIT
01900	LIST
     

00100	SYSINI:	DAC A,NAME+1
00200		SETZM NAME+3
00300		INIT 17
00400		SIXBIT /SYS/
00500		0
00600		JRST AIN.4+1
00700		LOOKUP NAME
00800		JRST AIN.7+1
00900		INPUT [IOWD 1,NAME+3	;INPOT size of file
01000			0]
01100		HLRO A,NAME+3
01200		POPJ P,
01300	
01400	NAME:	SIXBIT /LISP/
01500		0
01600		0
01700		0
01800	
01900	SYSINP:	DAC A,LST
02000		INPUT LST
02100		STATZ 740000
02200		ERR1 AIN.8
02300		RELEASE
02400		POPJ P,
02500	
02600	LST:	0
02700		0
     

00100	;Size argument taken from A, pointer returned in A.
00200	MORCOR:	DAC 0,LISPAC
00300		LAC 0,[XWD 1,LISPAC+1]
00400		BLT 0,LISPAC+17
00500		LAC 3,A
00600		LAC 12,AC12
00700		LAC 16,AC16
00800		LAC 17,AC17
00900		PUSHJ 17,CORGET
01000		OUTSTR[ASCIZ/NO MORE CORE./]
01100		LAC A,2
01200		LAC 0,[XWD LISPAC+2,2]
01300		BLT 0,17
01400		LAC 0,LISPAC
01500		POPJ P,
01600	
01700	VAR
01800	LIT
     

02000	INTERN MEMQ,UNBOUN
02100	INTERN EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2
02200	INTERN NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS
02300	INTERN READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL,SOBST
02400	INTERN CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD
02500	INTERN GET,INTERN,REMOB,MAKNAM,GENSYM,FIX,LENGTH,READLIST,PATOM
02600	INTERN LAST,INC,OUTC,FIX1A,NUMVAL,REVERSE,MAPLIST,GC,GETL,PUTPROP
02700	INTERN ERR,MAPCAR,REMPROP,LIST,SETQ,ERRSET,REMOB,ARRAY,APPEND
02800	INTERN SPECBIND,SPECSTR,XCONS,ATOM,READCH,SET,NCONC,PRINC
02900	INTERN CONS,ACONS,CTY,FP7A1,TERPRI,LSPRET,PSAV1,BKTRC
03000	INTERN TYO,ITYO,IGSTRT,NOINFG,CHRTAB
03100	INTERN EVAL,OEVAL,.APPEND,INPOT,OUTPUT