; UPD ID= 2509 on 2/14/80 at 5:41 PM by NIXON                           
TITLE	CLEANT FOR COBOL V12C
SUBTTL	SQUASH TABLES TO GAIN CORE	AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	P
	%%P==:%%P

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;********************

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000

ENTRY CLEANT
EXTERNAL LITLOC,NAMLOC,FREESP

;RESET TABLE SIZES

CLEANT:	MOVE	TA,CLENTX

CLENT0:	HLRZ	TD,0(TA)	;GET XLOC
	SKIPE	(TD)		;DOES THIS TABLE EXIST?
	JRST	CLNT0J		;YES, GO ON.
	HLRE	TC,-3(TD)	;FIGURE OUT WHERE THE LAST
	MOVMS	TC		; TABLE ENDED.
	ADD	TC,-3(TD)	;PRETEND THIS TABLE STARTS IN
	ADDI	TC,1		; THE NEXT LOCATION.
	TLO	TC,-1		;SET LH TO -1.
	MOVEM	TC,(TD)		;SET XLOC
	MOVEM	TC,1(TD)	; AND XNXT.
CLNT0J:	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)		;IS THIS THE LAST TABLE.
	JRST	CLENT4		;NO, GO SQUASH IT.

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

	POPJ	PP,		;RETURN.
DEFINE	TABSET	(A,B,C,D,E,F,G)<

IFDIF <A><NAM><EXTERNAL A'LOC
	XWD	A'LOC,E
>>

CLENTT:	TABLES
CLENTX:	XWD	CLENTT-.,CLENTT


	END