COMPIL(PIT,<PITCOP,PITBND,APPLY,PITDTM>,<GINFTB,INFTB,DATM,GDATM,GOGTAB,RECQQ,LEAP>
	,<PROCEDURE ITEM ROUTINES>,<APPL$Y>)
BEGIN PITS
FLAG←0;
PDA ← 4
NPW ← 5
FPTR←6
FRM←7
APTR←10
GLOB <
GBRK←←6000 
>;GLOB
HERE (PITBND)
	HRRZ	LPSA,-1(P)		;PICK UP PDA
	HRRZ	TEMP,PD.PPD(LPSA)	;PARENT'S PDA
	SKIPN	PD.PPD(TEMP)		;IF DADDY IS THE GLOBAL MAN (IE
	JRST	PUTDTM			;THE OUTER BLOCK -- INDICATED BY HIS
	SKIPA	USER,RF			;
CTXTLP:	HRRZ	USER,(USER)		;GO UP A LINK
	HLRZ	B,1(USER)		;PDA AT THIS LEVEL.  NOTE WE
	CAME	TEMP,B			;FIRST LOOK AT THIS GUY
	JRST	CTXTLP			;NOT THE ONE
	HRL	LPSA,USER		;NOW LPSA IS SL,,PDA
	JRST	PUTDTM			;GO PUT IN THE DATUM
HERE(PITCOP)
	MOVE	C,-1(P)			;PICK UP ITEM NO INTO B
	PUSHJ	P,PITDGT		;GET DATUM
PUTDTM:	MOVE 	C,-2(P)			;TARGET
	MOVEI	TEMP,PITTYP		;SPECIAL CODE
GLOB <
	CAIL 	C,GBRK			;IS IT GLOBAL???
	JRST	[
		TERPRI	<DON'T BIND PROCEDURES TO GLOBAL ITEMS>
		CAI	C,
		ERR	<ITEM NUMBER>,6
		]
	>;GLOB
	MOVE	USER,GOGTAB
	DPB	TEMP,INFOTAB(USER)	;PUT IN NEW DATUM TYPE
	MOVEM	LPSA,@DATAB(USER)	;SET DATUM
	SUB	P,[XWD 3,3]
	JRST	@3(P)			;RETURN
PITDGT:					;PROCEDURE TO GET PIT DATUM
	MOVE	LPSA,GOGTAB
GLOB <
	CAIL	C,GBRK			;
	MOVE	LPSA,GLUSER
>;GLOB
	LDB	B,INFOTAB(LPSA)
	CAIE	B,PITTYP		;IS IT A PROCEDURE ITEM???
	JRST	[ CAI C,
		ERR <NOT A PROCEDURE ITEM >,6]
GLOB <
	CAIL	C,GBRK
	ERR	<DRYROT AT PITDGT>
>;GLOB
	MOVE	LPSA,@DATAB(LPSA)	;FETCH DATUM
	POPJ	P,
HERE(PITDTM)
	MOVE	C,-1(P)			;PICK UP ITEM NO
	PUSHJ	P,PITDGT		;GET ITS DATUM
	MOVEM	LPSA,-1(P)		;SET IT DOWN INTO THE STACK
	POPJ	P,
HERE(APPL$Y)
	APPLY	;A FAKED UP PD SO CAN SPROUT APPLY
HERE(APPLY)
	MOVE	PDA,-2(P)
	MOVE	NPW,PD.NPW(PDA)		;THE STACK DISPLACEMENTS
	HRRZ	FPTR,PD.DLW(PDA)	;POINT AT FORMALS
NOGLOB <
	MOVE	USER,GOGTAB		;
>;NOGLOB
	SKIPN	APTR,-1(P)		;ARG LIST
	JUMPN	FPTR,NEACTS		;NULL ACTS,NON NULL FRMS
NXTP:	SOJLE	NPW,ARGSON		;HAD ENOUGH?
	HLRZ	FRM,(FPTR)		;NEXT FORMAL TYPE
	HRRZ	APTR,(APTR)		;LOOK AT NEXT ACTUAL
	JUMPE	APTR,NEACTS		;DONT HAVE ONE
	HLRZ	C,(APTR)		;THE ITEM
GLOB <
	MOVE	USER,GOGTAB		;
	CAIL	C,GBRK			;GLOBAL ??
	MOVE	USER,GLUSER		;
>;NOGLOB
	LDB	A,INFOTAB(USER)		;GET TYPE
	CAIE	A,RFITYP		;REF ITEM?
	JRST	[ PRINT <APPLY -- NON REFERENCE ITEM USED IN ACT PARAM LIST>
		JRST	BARG1
		]
	MOVE	A,@DATAB(USER)		;GET THE DATUM
	TRNE	FRM,ITEMB		;FORMAL AN ITEM?
	JRST 	FITEM			;YES
	TLNE	A,ITEMB			;ACTUAL AN ITEMVAR TYPE THING?
	JRST	BFACT			;LOSE ON CORRESP
	MOVE	B,A			;CHECK 6 BIT TYPE CORRESP
	TLC	B,(FRM)			;
	TLNE	B,MSK6BT		;TEST 6 BIT MASK
	JRST	BFACT			;MAY LATER CONSIDER COERCING
	TRNE	FRM,REFB		;
	JRST	FRMREF			;FORMAL IS A REF
	TLC	A,STTYPE⊗5		;STRING ?
	TLNN	A,MSK6BT		;WELL?
	JRST	STVPSH			;YOU BETCHA
	PUSH	P,@A			;PUSH THE VALUE OF THE ARG
	AOJA	FPTR,NXTP		;GO GET NEXT
STVPSH:	PUSH	SP,-1(A)		;PUSH A STRING
	PUSH	SP,(A)			;
	ADD	NPW,[XWD -2,1]		;FIX FOR THE SOJ AT NXTP
	AOJA	FPTR,NXTP
FRMREF:	MOVEI	A,@A			;THE ADDRESS
	PUSH	P,A			;THE REF
	AOJA	FPTR,NXTP		;NEXT
FITEM:	TLNN	A,ITEMB			;IS ACTUAL AN ITEM TOO
	JRST	BFACT			;YOU LOSE!
	MOVE	B,A			;GET ACTUAL BITS
	TLC	B,(FRM)			;6 BIT TYPES
	TRNN	FRM,MSKUNT		;FORMAL HAS 6 BIT TYPE?
	JRST	OK6BT			;NO
	TLNN	A,MSKUNT		;DOES ACT HAVE 6 BIT TYPE SPEC
	JRST	AUTITM			;NOPE
	TLNE	B,MSK6BT		;WIN?
	JRST	BFACT			;NO
OK6BT:	TLNE	B,ARY2B			;THE ARY2 BIT OK?
	JRST	BFACT			;NO
	TLNE	A,BINDB			;BINDING ACTUAL?
	JRST	BNDACT			;YES
	TLNE	A,QUESB			;? ACTUAL?
	JRST	QUEACT			;YES
	TRNE	FRM,REFB		;FORMAL REF?
	JRST	FRMREF			;YES
	PUSH	P,@A			;PUSH THE ITEM
	AOJA	FPTR,NXTP		;FETCH NEXT
BNDACT:	TRNN	FRM,QUESB		;FORMAL BETTER BE ?
	JRST 	BFACT
PSHBRF:	MOVEI	A,@A
	TLO	A,20			;TURN ON INDIR BIT
	PUSH	P,A			; @ REF
	AOJA	FPTR,NXTP		; GO DO NEXT
QUEACT:	TRNN	FRM,QUESB		;BETTER BE ?
	JRST	BFACT
	MOVE	B,@A			;GET  THE VALUE NOW
	CAIN	B,UNBND			;HAVE A BINDING?
	JRST	PSHBRF			;NO
	PUSH	P,B			;YES
	AOJA	FPTR,NXTP		;
AUTITM:					;COME HERE WHEN FORMAL SPEC & ACT UNSPEC
	TLNE	A,ARY2B			;ACT AN ARY2 THING?
	JRST	OK6BT			;YES, PRETEND THAT 6 BIT TYPES ARE OK
	TRNE	FRM,REFB!BINDB		;FORMAL REF OR BIND ?
	JRST	OK6BT			;IF SO, A REGULAR WIN
	SKIPN	C,@A			;GET ULT VALUE TO SEE IF OK
	JRST	OK6BT			;LET ANY THROUGH TOO
	CAIN	C,UNBND			;UNBOUND ? WILL ACT LIKE BIND
	TRNN	FRM,QUESB		;
	SKIPA	USER,GOGTAB		;NOT THIS BAD CASE
	JRST	OK6BT			;WAS UNBND ? IVAR
GLOB <	
	CAIL	C,GBRK
	MOVEI	USER,GLUSER
>;GLOB
	LDB	C,INFOTAB(USER)		;GET ACTUAL ITEM TYPE
	LSH	C,5			;TO LINE THINGS UP FOR THE TRC
	TRC	C,(FRM)			;CHECK 6 BIT TYPE OF THIS ACTUAL VAL ITEM
	TRNN	C,MSK6BT		;SEE IF WIN
	JRST	OK6BT			;WELL, WE HAVE REALLY WON
BFACT:	PRINT	<BAD CORRESPONDENCE BETWEEN ACTUAL & FORMAL PARAMETER TYPE>
BARG1:	JSP	TAC1,PRTARG		;
	JSP	TAC1,PITERR
	JSP	TAC1,PSPFIX		;FIX P & SP
	JRST	CRET			;EXIT FROM IT ALL
PRTARG:	MOVEI	FLAG,1(FPTR)		;FORMAL POINTER
	SUB	FLAG,PD.DLW(PDA)	;ORIGIN
	HRRZ	FLAG,FLAG		;GET THE RH OF IT
	TERPRI
	PRINT	<ARGUMENT NUMBER >
	DECPNT	FLAG
	TERPRI
	JRST	(TAC1)			;RETURN
PSPFIX:	MOVE	A,PD.NPW(PDA)
	SUB	A,NPW			;
	SUBI	P,(A)			;FIXUP RIGHT
	HRLZ	FLAG,A			;
	ADD	P,FLAG			;FIX LEFT
	MOVS	A,A
	SUBI	SP,(A)			;
	HRLZ	FLAG,A
	ADD	SP,FLAG			;FIX SP
	MOVEI	A,0
	JRST	(TAC1)			;RETURN
NEACTS: TERPRI
	PRINT	<APPLY--NOT ENOUGH ACTUAL PARAMETERS SUPPLIED >
	JRST	BARG1
ARGSON:	TLNN	PDA,-1			;WERE WE GIVEN A CONTEXT
	JRST 	CAL1			;NO
	PUSH	P,[CRET]		;PUSH	RETURN ADDRESS
	PUSH	P,RF
	HRRZ	A,PD.PPD(PDA)		;PARENTS PDA
	MOVS	B,PDA			;PDA,,STATIC LINK
	HLRZ	FRM,1(B)			;PDA OF DADDY???
	CAME	FRM,A			;????
	JRST	[
		PRINT	<CONTEXT WRONG OR CLOBBERED IN INTERP CALL>
		JSP	TAC1,PITERR
		JSP	PSPFIX
		JRST	CRET
		]
	PUSH	P,B			;STATIC LINK
	PUSH	P,SP			;
	HLRZ	A,PD.PPD(PDA)		;WORD AFTER MKSEMT
	JRST	(A)			;GO THERE
CAL1:	HRRZ	A,PD.(PDA)		;ENTRY ADDRESS
	PUSHJ	P,(A)			;CALL IT
CRET:	MOVE	PDA,-2(P)		;HERE ON RETURN
	MOVE	FRM,PD.PDB(PDA)		;PROC type
	TLC	FRM,STTYPE⊗5		;SIMPLE STRING?
	TLNN	FRM,MSK6BT!ITEMB	;WELL?
	SUB	SP,[XWD 2,2]		;POP	SP STACK
	SKIPN	B,-1(P)			;GET THE LIST
	JRST	TMIDON			;NO LIST
TMIKIL:	
	HRRZ	B,(B)			;STEP THE LIST
	JUMPE	B,TMIDON		;A ZERO MARKS THE END
	HLRZ	C,(B)			;GET ITEM NUMBER
	SKIPL	@DATM			;AT THIS POINT, KNOW IS REFITEM
	JRST	TMIKIL			; THE SIGN BIT IS TMPB (GEQ 0 MEANS PERM)
	PUSH	P,B			;SAVE LIST PTR
	PUSH	P,C			;THE ITEM NUMBER
	MOVEI	5,43			;DELETE CODE
	PUSHJ	P,LEAP			;UGH! WHAT A TERRIBLE WAY TO DO THINGS
	POP	P,B
	JRST	TMIKIL			;CONTINUE
TMIDON:
	SKIPGE	B,-1(P)			;GET THE LIST 
	PUSHJ	P,RECBQQ		;ARGL WAS TEMP, RELEASE IT
	SUB	P,[XWD 3,3]
	JRST	@3(P)			;RETURN
PITERR:	TERPRI 
	PRINT <PROCEDURE IS >
	TERPRI
	PUSHJ	P,PRPID
	ERR	<IF YOU CONTINUE, THE PROCEDURE WILL NOT BE CALLED >,1
	JRST	(TAC1)
PRPID:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	HRRZ	B,PD.ID1(PDA)
	MOVE	A,PD.ID2(PDA)
	SOJL	B,.+4
	ILDB	C,A
	TTCALL	1,C
	JRST	.-3
	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,
RECBQQ:	EXCH 	A,B
	PUSH	P,B
	PUSHJ	P,RECQQ
	POP	P,A
	POPJ	P,
BEND PITS
ENDCOM(PIT)