TITLE	CLEANT FOR RPGII 1
SUBTTL	SQUASH TABLES TO GAIN CORE	AL BLACKINGTON/CAM/BOB CURRIER

TWOSEG
RELOC	400000

ENTRY	CLEANT

EXTERN	CLENTX,LITLOC,NAMLOC,FREESP

;RESET TABLE SIZES

CLEANT:	MOVE	TA,CLENTX

CLENT0:	HLRZ	TD,0(TA)		; GET XLOC
	HRRZ	TE,0(TA)		; GET SQUASH CODE
	CAIN	TE,1			; IS IT "DELETE EMPTIES?"
	JRST	CLENT1			; YES -
	JUMPN	TE,CLENT2		; NO - IS IT "EMPTY IT"?

	HRRZ	TE,0(TD)		; YES - SET LH
	HRLI	TE,-1			;    OF
	MOVEM	TE,0(TD)		;    XLOC AND
	MOVEM	TE,1(TD)		;    XNXT TO -1
	JRST	CLENT3

CLENT1:	HRRZ	TE,1(TD)		; SET
	HRRZ	TC,0(TD)		;    LH OF
	SUBI	TE,-1(TC)		;    XLOC
	MOVNS	TE			;    TO BE
	HRLM	TE,0(TD)		;    NEW SIZE
	MOVSI	TE,-1			; SET LH OF XNXT
	HLLM	TE,1(TD)		;    TO -1
	JRST	CLENT3

CLENT2:	CAIE	TD,LITLOC		; IS IT LITAB?
	JRST	CLENT3			; NO -
	HLRZ	TE,0(TD)		; YES - IF
	CAIGE	TE,-^D1100		;    SIZE IS
	MOVEI	TE,-^D1100		;    GREATER THAN 1100
	HRLM	TE,0(TD)		;    RESET TO 1100

CLENT3:	AOBJN	TA,CLENT0

;THROW AWAY AIR BETWEEN TABLES

	MOVEI	TA,NAMLOC+3		; START AT FIRST TABLE AFTER NAMTAB

CLENT4:	HLRE	TD,0(TA)		; GET SIZE OF
	MOVMS	TD			;    THIS TABLE
	ADDI	TD,1			;    PLUS ONE

	ADD	TD,0(TA)		; DESTINATION ADDRESS
	HRRZ	TE,3(TA)		; IF THAT
	CAIG	TE,(TD)			;    DOES NOT CHANGE ANYTHING,
	JRST	CLENT5			;    GO TO NEXT TABLE

	HRL	TD,3(TA)		; SOURCE ADDRESS

	MOVE	TC,4(TA)		; COMPUTE
	SUB	TC,3(TA)		;    SIZE OF
	HRRZS	TC			;    NEXT TABLE

	ADDI	TC,(TD)			; NEW FINAL DESTINATION

	HRRM	TD,3(TA)		; RESET XLOC
	HRRM	TC,4(TA)		; RESET XNXT

	BLT	TD,(TC)			; MOVE DATA DOWN

CLENT5:	ADDI	TA,3			; STEP UP TO NEXT TABLE PARAMETERS
	SKIPE	3(TA)			; IF THAT IS NOT LAST TABLE,
	JRST	CLENT4			;    LOOP

	HLRE	TE,0(TA)		; IT IS - RECOMPUTE
	MOVMS	TE			;    LOCATION
	ADDI	TE,1			;    OF
	ADD	TE,0(TA)		;    FREE
	HRRM	TE,FREESP		;    CORE

	POPJ	PP,

	END