COMPIL(REC,<$REC$,FLDKIL,$RERR>
	,<RECQQ,ALLFOR,ARYEL,CORGET,CORREL,X11,GOGTAB,$DEL1B,$GET1B>
	,<SAIL RECORD HANDLER>,<$RDREF,$RALLO>);
REGL2:
BEGIN RECORD
$RDISP:	JRST	$RDREF		;DEREFERENCE ARG1
	JRST	$RALLO		;ALLOCATE RECORD WITH CLASS ARG1
$RMAX ←← (.-$RDISP)-1
HEREFK($REC$,$REC$.)		
	POP	P,C		;RET ADR
	POP	P,B
	POP	P,A
	EXCH	C,(P)		; NOW C=OP, A=ARG1, B=ARG2
	CAILE	C,$RMAX
	POPJ	P,
	JUMPN	C,@$RDISP(C)	; OBEY COMMAND
↑↑$RDREF:
	SKIPE	A		; HAVE ONE?
	SOSLE	-1(A)		; YEP, DECREMENT COUNT
	POPJ	P,		; RETURN
	PUSH	P,A			; SO CAN LATER CALL CORREL
	HRRZ	C,(A)			; CLASS ADDRESS
	ADDI	A,1			; FIRST DATA ELEMENT
	SUBI	C,(A)			; CORRECTION FACTOR
	HRLI	C,(<POINT =13,(A),=12>); DESCRIPTOR TO GET BITS
	PUSH	P,C
GETFLD:	LDB	C,(P)			; GET FIELD
	JUMPE	C,NOMORE		; NO MORE FIELDS LEFT
	DPB	C,[POINT =13,A,=12]	; PUT DESCRIPTOR BITS IN PLACE
	PUSHJ	P,FLDKIL		; GO KILL THIS FIELD
	AOJA	A,GETFLD		; GO ON TO NEXT
NOMORE:	SUB	P,X11			; JUST POP ONE OFF
	POP	P,B			; THE CORREL POINTER
	SUBI	B,1			; NOW IT IS (THE REF CNT WORD, REMEMBER)
	MOVE	USER,GOGTAB		; FREE THE SPACE UP
	MOVE	A,$FSLIS(USER)		; BY CALLING THE FREER-UPPER
	PUSHJ	P,$DEL1B		; 
	ERR	<CONFUSION IN FREEING A BLOCK>,1
	POPJ	P,
↑↑$RALLO:
	LDB	C,[POINT =13,(A),=12] ; A = RECORD CLASS ID.  GET THE WORD COUNT
	ADDI	C,1		; C = NUMBER OF WORDS+1 FOR REFCNT
	HRLI	A,20		; INDIREC BIT
	PUSH	P,A		; EVENTUALLY, BECOMES THE RECID POINTER
	MOVE	USER,GOGTAB	; GET THE SYSTEM FREE LIST
	MOVE	A,$FSLIS(USER)	;
	PUSHJ	P,$GET1B	; MAY WANT MORE EFFICIENCY LATER
	ERR	<NO CORE FOR RECORD ALLOCATION>,1,ZPOPJ
	MOVEI	A,1(B)		;THE POINTER WE WILL ACTUALLY RETURN
	ADDI	C,(B)		;STOPPING PLACE
	SETZM	(B);		;ZERO OUT (ALSO REF CNT ← 0)
	HRL	B,B		;BUILD BLT PTR
	HRRI	B,1(B)
	BLT	B,(C)		;BLT THEM AWAY
	AOS	-1(A)		;BUMP REF CNT
	POP	P,(A)		;THE RECID POINTER
	POPJ	P,		;RETURN
ZPOPJ:	MOVEI	A,0
	POPJ	P,
HEREFK($RERR,$RERR.)
	ERR	<ACCESS TO A SUBFIELD OF A NULL RECORD>,1
	POPJ	P,
HEREFK(FLDKIL,.FLDKI)
	TLNN	A,REFB	; IF REFB ON, THEN NO DELETION REQUIRED
	SKIPN	@A	; NOTHING TO DO IF A NULL
	POPJ	P,
	TLNE	A,ARY2B		;ITEMVAR ARRAY ??
	JRST	ARYKIL		;YEP
	TLNN	A,ITEMB		;NOTHING TO DO IF ITEM
	TLNE	A,PROCB		;OR PROCEDURE
	POPJ	P,
	LDB	TEMP,[POINT 6,A,=12] ; SIX BIT TYPE
	CAIL	TEMP,INVTYP	;VERIFY VALID
	ERR	<DRYROT -- INVALID REFERENCE TYPE IN FLDKIL>,5,RPOPJ
	CAIG	TEMP,MXSTYP	;IS THIS A LEGAL ARRAY TYPE ??
	JRST	@FKDISP(TEMP)	;NOPE DO WHATEVER YOU MUST
	MOVEI	TEMP,@FKDISP-ARRTYP(TEMP) ;FIND OUT WHAT SORT OF ARRAY YOU HAVE
	CAIN	TEMP,WZAPR	;A DONOTHING ??
	JRST	ARYKIL		;YEP
	PUSH	P,A		;HERE MUST CALL SELF RECURSIVELY TO 
	MOVEI	A,@A		;PROCESS EACH ARRAY ELEMENT
	PUSH	P,TEMP		;ROUTINE TO CALL
	HRRZ	TEMP,-1(A)	;COUNT
	JUMPE	TEMP,NOELS	;NONE
	PUSH	P,TEMP		;SAVE COUNT
DEL1EL:	SKIPE	(A)		;HAVE ONE
	PUSHJ	P,@-1(P)	;CALL THE ROUTINE
	SOSG	(P)		;DECREMENT THE COUNT
	AOJA	A,DEL1EL	;DELETE ONE ELEMENT
	POP	P,TEMP		;GET THIS OFF
NOELS:	POP	P,TEMP		;GET THIS OFF, TOO.
	JRST	.+2		;MAY AS WELL LEAVE A ON THE STACK
ARYKIL:	PUSH	P,A		;SINCE  ARYEL CLOBBERS IT
	PUSH	P,@A		;CALL TO ARYEL
	SETZM	@A		;ZAP IT
	PUSHJ	P,ARYEL		;KILL THE ARRAY
	POP	P,A		;OH WELL, GET A BACK
	POPJ	P,		;RETURN FROM KILLING THE ARRAY
FKDISP:	WZAPR			;ACTUALLY A NOTHING
	WZAPR			;1 UNTYPED
	WZAPR			;2 BTRIP
	WZAPR			;3 STRING
	WZAPR			;4 REAL
	WZAPR			;5 INTEGER
	WSLKL			;6 SET
	WSLKL			;7 LIST
	WZAPR			;8 PROCEDURE ITEM
	WZAPR			;9 PROCESS ITEM
	WZAPR			;10 EVENT TYPE
	WCTXTK			;11 CONTEXT
	WZAPR			;12 REFITEM
	WRDRF			;13 RECORD DEREFERENCING
WSLKL:	SKIPN	B,@A		;DO WE HAVE ONE
	JRST	WZAPR		;NOPE JUST WORRY ABOUT FREES
	PUSH	P,A		;WHO KNOWS WHAT EVIL LURKS IN THE HEART OF LEAP
	SETZM	@A		;CLEAR IT OUT
	MOVE	A,B		;
	MOVEI	5,0		;ALL SET UP
	PUSHJ	P,RECQQ		;RELEASE THE SET OR LIST
	POP	P,A		;GET A BACK
	JRST	WZAPR
WCTXTK:	SKIPN	B,@A		;HAVE ONE
	POPJ	P,		;YEP
	SETZM	@A		;
	PUSH	P,A		;KILLING A CONTEXT
	PUSH	P,B
	PUSHJ	P,ALLFOR	;FORGET IT
	POP	P,A		;GET BACK A
	JRST	WZAPR
WRDRF:	PUSH	P,A		;SAVE
	MOVE	A,@A		; DO DEREFERENCE
	PUSHJ	P,$RDREF	;CALL DEREFERENCER
	POP	P,A		;GET A BACK
WZAPR:	TLNN	A,TMPB		;CALLING FROM LEAP ???
RPOPJ:	POPJ	P,		;
	ERR	<FLDKIL NOT YET READY FOR CALL FOR REFITEMS>,1,RPOPJ
BEND RECORD
ENDCOM(REC)