TITLE LAMBDA
TS==1
MEMTOP==40000

;; 1 CAN BE CLOBBERED WHEN E IS 0
T=2
A=3
CP=4	;END OF CODE PTR
S=11	;TOP OF MEMORY
I=12	;INST PTR
C=13	;CONTINUATION PTR
E=14	;ENV PTR
F=15	;FREE LIST
P=16	;PDL PTR

;   CLOSURE LAYOUT:
; ENV,,NEXT
; TERM,,REFS

GO:	CLEARB C,E
	MOVEI S,MEMTOP-2
	MOVEI I,CODE
	CLEARM F
	MOVE P,S
	SUBI P,2000	;TMP PDL
	MOVEI CP,MAIN	;START OF LAMBDA CODE
	PUSHJ P,PARSE
	HRLM A,MAIN-1	;SET SIZE OF MAIN
	MOVEI A,GRO
	MOVEM A,(CP)
	MOVE P,CP
	PUSHJ P,NL
	JRST NEXT+1

GC:	JUMPE A,CPOPJ
	SOS T,1(A)	;DEC REF
	TRNE T,-1
CPOPJ:	POPJ P,		;STILL REFS
	HRLM A,(P)	;SAVE A
	HRRZ A,(A)	;NEXT
	PUSHJ P,GC
	HLRZ A,(P)	;RESTORE A
	HRRM F,(A)
	MOVE F,A	;ADD TO FREE LIST
	HLRZ A,(A)	;ENV
	JRST GC

VAR:	MOVE A,E	;REMEMBER ENV FOR GC
	HLRZ T,(I)	;GET VAR INDEX
VAR1:	JUMPE T,VAR2
	HRRZ E,(E)	;NEXT
	SOJA T,VAR1
VAR2:	HLRZ I,1(E)	;SET INST PTR
	HLRZ E,(E)	;GET NEW ENV
	AOS 1(E)	;INC REF
	PUSHJ P,GC
	JRST NEXT+1

ABS:	JUMPE C,BYE
	MOVE T,C
	HRRZ C,(T)	;REMOVE FROM CONT
	HRRM E,(T)
	MOVE E,T	;PREPEND TO ENV
NEXT:	AOS I
	HRRZ T,(I)
	JRST (T)

APP:	JUMPN F,APP1
	MOVE F,S	;ALLOC TWO WORDS FROM TOP
	SUBI S,2
	CLEARM (F)
APP1:	MOVE T,F
	HRRZ F,(T)	;REMOVE FROM FREE LIST
	HLRZ (I)	;GET OFFSET
	ADD I		;MAKE ABSOLUTE
	AOBJN		;REF=1 AND TERM+1
	MOVSM 1(T)	;TERM,,REFS
	AOS 1(E)	;INC ENV REF
	HRLM E,(T)	;ENV
	HRRM C,(T)	;PREPEND TO CONT
	MOVE C,T
	JRST NEXT

IOP:	JRST .

BIT:	PUSHJ P,TYI	;RETURN A BIT IN A OR DON'T SKIP
	CAIE A,33	;TODO: DO WE EVEN WANT THIS?
	CAIN A,175
	POPJ P,
	AOS (P)
	ANDI A,1
	POPJ P,

PARSE:	PUSH P,CP	;REMEMBER START
PARSE1:	PUSHJ P,BIT
	JRST PARSE2	;END OF INPUT
	JUMPN A,PVAR
	PUSHJ P,BIT	;APP OR ABS
	JRST PERR
	JUMPN A,PAPP
	MOVEI T,ABS	;PARSE ABS
	MOVEM T,(CP)
	AOJA CP,PARSE1

PVAR:	CLEARM T	;PARSE VAR
	PUSHJ P,BIT
	JRST PERR
	SKIPE A
	AOJA T,PVAR+1
	HRLI T,VAR
	MOVSM T,(CP)
	AOJA CP,PARSE2

PAPP:	PUSH P,CP	;PARSE APP
	AOS CP
	PUSHJ P,PARSE
	POP P,T
	HRLI A,APP
	MOVSM A,(T)
	JRST PARSE1

PARSE2:	POP P,A		;POP START
	MOVNS A
	ADD A,CP	;LENGTH IN A
	POPJ P,

NL:	MOVEI A,15
	PUSHJ P,TYO
	MOVEI A,12
	JRST TYO

WR0:	SKIPA A,[60]
WR1:	MOVEI A,61
	PUSHJ P,TYO
	MOVEI I,CODE+1
	JRST NEXT+1

GRO:	PUSHJ P,BIT
	JRST GRO2
	HRLI CP,GET
	BLT CP,7(I)
	MOVEI CP,7(I)
	TRC A,1		:FLIP INPUT BIT
	HRLM A,-1(CP)
GRO1:	MOVE P,CP
	JRST NEXT+1
GRO2:	HRLI CP,GET+4	;NIL
	BLT CP,3(I)
	MOVEI CP,3(I)
	JRST GRO1

IFE TS,[
TYI:	CONSO TTY,40
	JRST .-1
	DATAI TTY,A
	ANDI A,177
	POPJ P,

TYO:	CONSZ TTY,20
	JRST .-1
	DATAO TTY,A
	POPJ P,

START:	JRST GO

BYE:	HALT
PERR:	HALT
]

IFN TS,[
INCH==1
OUTCH==2

TYI:	.IOT INCH,A
	POPJ P,

TYO:	.IOT OUTCH,A
	POPJ P,

START:	.CALL [SETZ ? SIXBIT /OPEN/
		[.UAI,,INCH] ? [SIXBIT /TTY/] ((SETZ))]
	.LOSE %LSFIL
	.CALL [SETZ ? SIXBIT /OPEN/
		[.UAO,,OUTCH] ? [SIXBIT /TTY/] ((SETZ))]
	.LOSE %LSFIL
	JRST GO

BYE:	.VALUE
PERR:	.VALUE
]

CONSTANTS

GET:	ABS	; \ [[0 \\ 0] GRO]
	5,,APP
	1,,APP
	0,,VAR
	ABS
	ABS
	0,,VAR	;PATCH THIS
	GRO

CODE:	9,,APP
	ABS
	1,,APP
	0,,VAR
	ABS
	3,,APP
	1,,APP
	0,,VAR
	WR0
	WR1
	0,,APP	;PATCH THIS AFTER PARSE
MAIN:		;COMPILED CODE GOES HERE

;IFN TS,[BLOCK MEMTOP-1-.]
LOC MEMTOP-1
-1

END START