--	File IntUtilities.mesa
--	March 12, 1981  3:46 PM

DIRECTORY

ParserTypeDefs: FROM "ParserTypeDefs" USING
	[Point, RemovePoint, Path, AppendPoint, CopyPath, PathLength, FreePath, FreeUserNode],

IntStorageDefs: FROM "IntStorageDefs" USING
	[ObjectRecord, ObjectName, FetchObject, BBoxRecord, DeleteObject,
	ReplaceObject, StoreObject, NilObjectName],

InlineDefs: FROM "InlineDefs" USING [LowHalf],

IntUtilityDefs: FROM "IntUtilityDefs",

IntSetsDefs: FROM "IntSetsDefs" USING
	[EnumerateSet, FreeSet, InsertSet, StripSet, RemoveFromSet],

IntDefs: FROM "IntDefs" USING [SemanticError],

ParserErrorDefs: FROM "ParserErrorDefs" USING [ErrorType, Report];

IntUtilities: PROGRAM
IMPORTS ParserErrorDefs, IntDefs, IntStorageDefs, InlineDefs, ParserTypeDefs, IntSetsDefs
EXPORTS IntUtilityDefs =

	BEGIN OPEN IntStorageDefs;

	aScale, bScale: LONG CARDINAL;		-- scale factors for DS
	tooBigLong: LONG CARDINAL;		-- largest number that can be scaled without overflow
	tooBigInt: LONG INTEGER;
	noScale: BOOLEAN;		-- identity flag for scale
	errorCount: CARDINAL;
	warned: BOOLEAN;

	TableSize: CARDINAL = 199;		-- symbol table size
	sTable: ARRAY [0..TableSize) OF ObjectName;

	MaxMMStack: CARDINAL = 50;		-- max depth minmax stack
	left,right,bottom,top: ARRAY [1..MaxMMStack] OF LONG INTEGER;
	mmPtr: CARDINAL;						-- minmax stack pointer

	InitUtilities: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
		BEGIN
		i: CARDINAL;
		FOR i IN [0..TableSize) DO sTable[i] _ IntStorageDefs.NilObjectName; ENDLOOP;
--		sTable _ ALL[IntStorageDefs.NilObjectName];
		mmPtr _ 0;
		warned _ FALSE;
		errorCount _ 0;
		noScale _ TRUE;
		RETURN[TRUE];
		END;

	FinishUtilities: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
		BEGIN
		RETURN[TRUE];
		END;

	LogError: PUBLIC PROCEDURE [s: STRING] =
		BEGIN OPEN ParserErrorDefs;
		errorCount _ errorCount + 1;
		Report[s,FatalSemantic];
		ERROR IntDefs.SemanticError[];
		END;

	OKToContinue: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
		BEGIN
		IF errorCount > 0 AND NOT warned THEN
			BEGIN
			warned _ TRUE;
			ParserErrorDefs.Report["Fatal Semantic Errors Exist, Strange Results May Occur If You Proceed", Advisory];
			RETURN [FALSE];
			END
		ELSE RETURN[TRUE];
		END;

	-- reentrant minimum/maximum stuff for finding bounding boxes
	InitMM: PUBLIC PROCEDURE [x,y: LONG INTEGER] =
		BEGIN
		IF (mmPtr _ mmPtr+1) > MaxMMStack THEN
			BEGIN
			ParserErrorDefs.Report["InitMM: no stack space", FatalInternal];
			RETURN;
			END
		ELSE
			BEGIN
			left[mmPtr] _ x; right[mmPtr] _ x;
			bottom[mmPtr] _ y; top[mmPtr] _ y;
			RETURN;
			END;
		END;

	MinMax: PUBLIC PROCEDURE [x,y: LONG INTEGER] =
		BEGIN
		IF x > right[mmPtr] THEN right[mmPtr] _ x
		ELSE BEGIN IF x < left[mmPtr] THEN left[mmPtr] _ x; END;
		IF y > top[mmPtr] THEN top[mmPtr] _ y
		ELSE BEGIN IF y < bottom[mmPtr] THEN bottom[mmPtr] _ y; END;
		END;

	Extent: PUBLIC PROCEDURE RETURNS [l,r,b,t: LONG INTEGER] =
		BEGIN
		RETURN [left[mmPtr],right[mmPtr],bottom[mmPtr],top[mmPtr]];
		END;

	DoneMM: PUBLIC PROCEDURE =
		BEGIN
		IF mmPtr = 0 THEN ParserErrorDefs.Report["DoneMM: empty stack", FatalInternal]
		ELSE mmPtr _ mmPtr-1;
		END;(635)\54b9B275i13I309b12B411i9I59i9I19i10I78i10I68b13B282b15B72b8B105i13I45b12B213i8I122b6B74i10I67i13I141b6B264b6B132b6B95i13I

	-- kludge to effectively achieve StoreObject[@Constructor[...]] by
	-- calling StoreObjectRecord[Constructor[...]]
	StoreObjectRecord: PROCEDURE [object: ObjectRecord] RETURNS[ObjectName] = INLINE
		BEGIN
		RETURN[StoreObject[@object]];
		END;

	LinkObject: PUBLIC PROCEDURE [this,that: ObjectName] =
		BEGIN
		objRec: ObjectRecord;
		FetchObject[this,@objRec];
		WITH objRec SELECT FROM
			STEntry => guts _ that;
			Call => next _ that;
			Box => next _ that;
			MBox => next _ that;
			Flash => next _ that;
			Polygon => next _ that;
			Wire => next _ that;
			User => next _ that;
			ENDCASE =>
				ParserErrorDefs.Report["LinkObject Error", FatalInternal];
		ReplaceObject[@objRec,this];
		END;
\1b1B67b1B47b18B64b1B7b1B31b1B8b10B135i7I20i4I20i3I20i4I20i5I20i7I20i4I20i4I78i13I
	-- redefine a bound symbol, return a new name
	RedefineSymbol: PUBLIC PROCEDURE [symNumber: LONG CARDINAL] RETURNS [IntStorageDefs.ObjectName] =
		BEGIN
		oldObj: ObjectName;
		oldObjRec: STEntry ObjectRecord;

		oldObj _ LookUp[symNumber];
		FetchObject[oldObj,@oldObjRec];

		IF NOT (oldObjRec.defined AND oldObjRec.bound) THEN
			BEGIN
			ParserErrorDefs.Report["RedefineSymbol: cond not met", FatalInternal];
			RETURN[NilObjectName];
			END
		ELSE
			BEGIN
			-- mark old one deleted, create new STEntry
			oldObjRec.deleted _ TRUE;
			ReplaceObject[@oldObjRec,oldObj];
			FixUpAncestors[symNumber];
			RemoveFromCBY[symNumber];		-- this symbol calls no others (yet)
			RETURN [LookUp[symNumber]];
			END;
		END;

	-- union the aSet (modifying aSet) with bSet
	Union: PROCEDURE [aSet,bSet: ObjectName] RETURNS [ObjectName] =
		BEGIN OPEN IntSetsDefs;
		Dummy: PROCEDURE [ignore: ObjectName,contents: LONG CARDINAL] RETURNS [BOOLEAN] =
			BEGIN
			aSet _ InsertSet[aSet,contents];
			RETURN [FALSE];
			END;
		[] _ EnumerateSet[bSet,Dummy];
		RETURN[aSet];
		END;

	--	returns the set of ancestors for this STEntry
	FindAncestors: PROCEDURE [sym: LONG CARDINAL] RETURNS [IntStorageDefs.ObjectName] =
		BEGIN OPEN IntSetsDefs;
		ans: ObjectName _ NilObjectName;
		obj: ObjectName;
		objRec: STEntry ObjectRecord;

		-- union the ancestors with ans
		UnionAncestors: PROCEDURE [ignore: ObjectName,symNumber: LONG CARDINAL] RETURNS [BOOLEAN] =
			BEGIN
			tempSet: ObjectName _ FindAncestors[symNumber];
			ans _ Union[ans,tempSet];
			FreeSet[tempSet];
			RETURN [FALSE];
			END;

		obj _ LookUp[sym];
		FetchObject[obj,@objRec];
		ans _ Union[ans,objRec.cby];
		[] _ EnumerateSet[objRec.cby,UnionAncestors];
		RETURN [ans];
		END;
k792\48b14B127i7I202i13I356b5B86b6B255b1B1b13B117i13I31i7I52b14B
	--	get ancestors for this STEntry, copy those that are bound
	FixUpAncestors: PROCEDURE [symNumber: LONG CARDINAL] =
		BEGIN OPEN IntSetsDefs;
		aSet: ObjectName;	-- set of ancestors that need copying

		aSet _ FindAncestors[symNumber];
		-- copy each ancestor in aSet, mark originals deleted, mark copies not bound
		[] _ EnumerateSet[aSet,CopySymbol];
		FreeSet[aSet];
		END;

	-- copy the guts list of a symbol (in reverse order for now)
	CopyGuts: PROCEDURE [head: ObjectName] RETURNS [newHead: ObjectName] =
		BEGIN
		prev,curr,next: ObjectName;
		currRec: ObjectRecord;

		prev _ NilObjectName;
		FOR curr _ head, next UNTIL curr = NilObjectName DO
			FetchObject[curr,@currRec];
			-- duplicate this object, link to last one stored
			WITH foo:currRec SELECT FROM
				Call =>
					BEGIN
					next _ foo.next;
					foo.uniqueID _ NilObjectName;
					foo.next _ prev;
					END;
				Wire =>
					BEGIN OPEN ParserTypeDefs;
					next _ foo.next;
					foo.next _ prev;
					END;
				Flash =>
					BEGIN
					next _ foo.next;
					foo.next _ prev;
					END;
				Polygon =>
					BEGIN OPEN ParserTypeDefs;
					next _ foo.next;
					foo.next _ prev;
					END;
				Box =>
					BEGIN
					next _ foo.next;
					foo.next _ prev;
					END;
				MBox =>
					BEGIN
					next _ foo.next;
					foo.next _ prev;
					END;
				User =>
					BEGIN
					next _ foo.next;
					foo.next _ prev;
					END;
				ENDCASE;
			prev _ newHead _ StoreObject[@currRec];
			WITH foo:currRec SELECT FROM
				Wire => ParserTypeDefs.FreePath[foo.p];
				Polygon => ParserTypeDefs.FreePath[foo.p];
				User => ParserTypeDefs.FreeUserNode[foo.data];
				ENDCASE;
			ENDLOOP;
		RETURN [newHead];
		END;
k792\61b16B366b8B136i13I39i13I124i4I57i13I38i4I94i5I73i7I94i3I73i4I73i4I161i4I40i7I40i4I
	-- copy a symbol, mark original deleted, mark copy not bound
	CopySymbol: PROCEDURE [ignore: ObjectName,sym: LONG CARDINAL] RETURNS [BOOLEAN] =
		BEGIN
		old,new: ObjectName;
		oldRec,newRec: STEntry ObjectRecord;

		old _ LookUp[sym];
		FetchObject[old,@oldRec];
		IF NOT oldRec.bound THEN RETURN [FALSE];	-- no need to copy
		oldRec.deleted _ TRUE;
		ReplaceObject[@oldRec,old];	-- save original, now deleted
		new _ LookUp[sym];				-- create a new STEntry
		FetchObject[new,@newRec];
		newRec.defined _ TRUE;			-- copy is defined
		newRec.guts _ CopyGuts[oldRec.guts];	-- copy contents
		ReplaceObject[@newRec,new];	-- save copy, not bound, bb not valid
		RETURN [FALSE];
		END;

	DeleteSymbol: PUBLIC PROCEDURE [definedSet: ObjectName, n: LONG CARDINAL] RETURNS [ObjectName] =
		BEGIN OPEN IntSetsDefs;
		ancSet: ObjectName _ NilObjectName;	-- set of ancestors

		-- find ancestors, mark deleted
		Delete: PROCEDURE [ignore: ObjectName,symNumber: LONG CARDINAL] RETURNS [BOOLEAN] =
			BEGIN OPEN IntSetsDefs;
			IF symNumber >= n THEN
				BEGIN
				tempSet,sym: ObjectName;
				symRec: STEntry ObjectRecord;

				tempSet _ FindAncestors[symNumber];
				ancSet _ Union[ancSet,tempSet];
				FreeSet[tempSet];

				sym _ LookUp[symNumber];
				FetchObject[sym,@symRec];
				IF NOT symRec.defined THEN
					BEGIN
					ParserErrorDefs.Report["Delete: sym not defined", FatalInternal];
					RETURN [TRUE];
					END
				ELSE symRec.deleted _ TRUE;		-- mark deleted
				IF NOT symRec.bound THEN			-- free insides if not bound
					BEGIN
					FreeGuts[symRec.guts];
					symRec.guts _ NilObjectName;
					END;
				ReplaceObject[@symRec,sym];
				END;
			RETURN [FALSE];
			END;

		[] _ EnumerateSet[definedSet,Delete];	-- also creates ancSet
		definedSet _ StripSet[definedSet,n];		-- update the defined set
		ancSet _ StripSet[ancSet,n];		-- remove ancestors that will be deleted

		[] _ EnumerateSet[ancSet,CopySymbol];	-- delete and copy the bound ancestors
		FreeSet[ancSet];
		StripCBY[n];		-- remove deleted symbols from cby sets
		RETURN [definedSet];
		END;
k792\63b10B120i7I485b12B134i13I59b6B182i7I483i13I
	LookUp: PUBLIC PROCEDURE [symNumber: LONG CARDINAL] RETURNS [ObjectName] =
		BEGIN
		hAddr: CARDINAL = Hash[symNumber];

		IF sTable[hAddr] = NilObjectName THEN
			RETURN [sTable[hAddr] _ StoreObjectRecord[
				ObjectRecord[STEntry[
					bb: BBoxRecord[left:0,right:0,bottom:0,top:0],
					bbValid: FALSE,
					guts: NilObjectName,
					symNumber: symNumber,
					deleted: FALSE, expanded: FALSE, bound: FALSE, defined: FALSE,
					overflow: NilObjectName, sameNumber: NilObjectName,
					cby: NilObjectName]]]]
		ELSE
			BEGIN
			cur,old: ObjectName;
			curRec,oldRec: STEntry ObjectRecord;
			FOR cur _ sTable[hAddr],curRec.overflow UNTIL cur = NilObjectName DO
				FetchObject[cur,@curRec];	-- get entry into core
				IF curRec.symNumber = symNumber THEN	-- found the right group
					BEGIN
					DO
						IF curRec.deleted THEN
							BEGIN
							oldRec _ curRec; old _ cur;	-- save contents,name
							cur _ curRec.sameNumber;
							IF cur = NilObjectName THEN EXIT ELSE FetchObject[cur,@curRec];
							END
						ELSE RETURN[cur];		-- found an undeleted match
						ENDLOOP;

					-- all are deleted, so create a new one
					oldRec.sameNumber _ StoreObjectRecord[
						ObjectRecord[STEntry[
						bb: BBoxRecord[left:0,right:0,bottom:0,top:0],
						bbValid: FALSE,
						guts: NilObjectName,
						symNumber: symNumber,
						deleted: FALSE, expanded: FALSE,
						bound: FALSE, defined: FALSE,
						overflow: NilObjectName, sameNumber: NilObjectName,
						cby: curRec.cby]]];			-- called by the same symbols as last deleted
					ReplaceObject[@oldRec,old];	-- save updated entry
					RETURN[oldRec.sameNumber];
					END
				ELSE
					BEGIN
					oldRec _ curRec; old _ cur;	-- save contents,name
					END;
				ENDLOOP;

			-- no matching symbol numbers, so create a new one
			oldRec.overflow _ StoreObjectRecord[
						ObjectRecord[STEntry[
						bb: BBoxRecord[left:0,right:0,bottom:0,top:0],
						bbValid: FALSE,
						guts: NilObjectName,
						symNumber: symNumber,
						deleted: FALSE, expanded: FALSE,
						bound: FALSE, defined: FALSE,
						overflow: NilObjectName, sameNumber: NilObjectName,
						cby: NilObjectName]]];
			ReplaceObject[@oldRec,old];	-- save updated entry
			RETURN[oldRec.overflow];
			END;
		END;
k792\1b6B311i13I112i13I14i13I12i13I442i13I326i13I121i13I14i13I480i13I121i13I14i13I13i13I
	-- free the guts of a symbol
	FreeGuts: PUBLIC PROCEDURE [head: IntStorageDefs.ObjectName] =
		BEGIN OPEN IntStorageDefs, ParserTypeDefs;
		temp,nextTemp: ObjectName;
		tempRec: ObjectRecord;

		FOR temp _ head, nextTemp UNTIL temp = NilObjectName DO
			FetchObject[temp,@tempRec];		-- get next object in symbol def
			WITH foo:tempRec SELECT FROM
				Call => nextTemp _ foo.next;
				Wire =>
					BEGIN OPEN ParserTypeDefs;
					nextTemp _ foo.next;
					FreePath[foo.p];
					END;
				Flash => nextTemp _ foo.next;
				Polygon =>
					BEGIN OPEN ParserTypeDefs;
					nextTemp _ foo.next;
					FreePath[foo.p];
					END;
				Box => nextTemp _ foo.next;
				MBox => nextTemp _ foo.next;
				User =>
					BEGIN
					nextTemp _ foo.next;
					ParserTypeDefs.FreeUserNode[foo.data];
					END;
				ENDCASE;
			DeleteObject[temp];
			ENDLOOP;
		END;

	RemoveFromCBY: PROCEDURE [n: LONG CARDINAL] =
		BEGIN
		Proc: PROCEDURE [oldSet: ObjectName] RETURNS [ObjectName] =
			BEGIN
			RETURN [IntSetsDefs.RemoveFromSet[oldSet,n]];
			END;
		EnumerateCBYSets[Proc];
		END;

	StripCBY: PROCEDURE [n: LONG CARDINAL] =
		BEGIN
		Proc: PROCEDURE [oldSet: ObjectName] RETURNS [ObjectName] =
			BEGIN 	RETURN [IntSetsDefs.StripSet[oldSet,n]]; END;
		EnumerateCBYSets[Proc];
		END;

	EnumerateCBYSets: PROCEDURE [proc: PROCEDURE [ObjectName] RETURNS [ObjectName]] =
		BEGIN
		i: CARDINAL;
		locRec: STEntry ObjectRecord;
		outer,addr,next: ObjectName;

		FOR i IN [0..TableSize) DO
			FOR outer _ sTable[i], next UNTIL outer = NilObjectName DO
				FetchObject[outer,@locRec];
				next _ locRec.overflow;
				addr _ outer;
				-- grab an entry that is not deleted (or take the end of the list)
				WHILE locRec.deleted AND locRec.sameNumber # NilObjectName DO
					addr _ locRec.sameNumber;
					FetchObject[addr,@locRec];
					ENDLOOP;
				locRec.cby _ proc[locRec.cby];
				ReplaceObject[@locRec,addr];
				ENDLOOP;
			ENDLOOP;
		END;
k792\31b8B196i13I105i4I29i4I98i5I29i7I98i3I29i4I29i4I152b13B43b4B157b8B43b4B147b16B99i7I121i13I202i13I
	-- compare two shortnames
	FastEqualString:  PUBLIC PROCEDURE [s1,s2: STRING] RETURNS [BOOLEAN] =
		BEGIN
		IF s1.length > 4 OR s2.length > 4 THEN
			ParserErrorDefs.Report["IntUtilities.FastEqualString Length Error",FatalInternal]
		ELSE
			SELECT s1.length FROM
				0 => RETURN[s2.length=0];
				1 => RETURN[s2.length=1 AND s2[0]=s1[0]];
				2 => RETURN[s2.length=2 AND s2[1]=s1[1] AND s2[0]=s1[0]];
				3 => RETURN[s2.length=3 AND s2[2]=s1[2] AND s2[1]=s1[1] AND s2[0]=s1[0]];
				4 => RETURN[s2.length=4 AND s2[3]=s1[3] AND s2[2]=s1[2]
								AND s2[1]=s1[1] AND s2[0]=s1[0]];
				ENDCASE;
		RETURN[FALSE];
		END;

	-- set up scale factors for DS
	SetScale: PUBLIC PROCEDURE [a,b: LONG CARDINAL] =
		BEGIN
		IF a = 0 OR b = 0 THEN LogError["Illegal Scale Factor"];
		IF a = b THEN noScale _ TRUE		-- no need to do any computation
		ELSE
			BEGIN
			aScale _ a; bScale _ b;
			tooBigLong _ LAST[LONG CARDINAL]/aScale;
			tooBigInt _ LAST[LONG INTEGER]/aScale;
			noScale _ FALSE;
	--		IF ((aScale/bScale)*bScale) # aScale THEN
	--			ParserErrorDefs.Report["Scale Factor not an Integer, precision may be lost", Advisory];
			END;
		END;

	-- scale a long cardinal by factors set up by a call to SetScale
	ScaleLong: PUBLIC PROCEDURE [n: LONG CARDINAL] RETURNS [LONG CARDINAL] =
		BEGIN
		IF noScale THEN RETURN[n]
		ELSE
			BEGIN
			IF n > tooBigLong THEN
				BEGIN
				LogError["Number Too Large to Scale"];
				RETURN[LAST[LONG CARDINAL]];
				END;
			RETURN[(aScale*n)/bScale];
			END;
		END;

	-- scale all the points in a path
	ScalePath: PUBLIC PROCEDURE [s,d: ParserTypeDefs.Path] =
		BEGIN OPEN ParserTypeDefs;
			pt: Point;
			-- scale all points in path
			IF noScale THEN
				BEGIN
				CopyPath[s,d];
				RETURN;
				END
			ELSE
				THROUGH [1..PathLength[s]] DO
					[,pt] _ RemovePoint[s];
					AppendPoint[d,ScalePoint[pt]];
					ENDLOOP;
		END;

	-- scale a point by factors set up by a call to SetScale
	ScalePoint: PUBLIC PROCEDURE [p: ParserTypeDefs.Point] RETURNS [ParserTypeDefs.Point] =
		BEGIN
		temp: ParserTypeDefs.Point;
		temp.x _ ScaleLongInt[p.x];
		temp.y _ ScaleLongInt[p.y];
		RETURN[temp];
		END;

	-- scale a long integer by factors set up by a call to SetScale
	ScaleLongInt: PUBLIC PROCEDURE [n: LONG INTEGER] RETURNS [LONG INTEGER] =
		BEGIN
		IF noScale THEN RETURN[n]
		ELSE
			BEGIN
			IF ABS[n] > tooBigInt THEN
				BEGIN
				LogError["Integer Magnitude Too Large to Scale"];
				RETURN[IF n < 0 THEN FIRST[LONG INTEGER] ELSE LAST[LONG INTEGER]];
				END;
			RETURN[(aScale*n)/bScale];
			END;
		END;

	-- private procedures
	Hash: PROCEDURE [n: LONG CARDINAL] RETURNS [[0..TableSize)] = INLINE
		BEGIN
		RETURN[InlineDefs.LowHalf[n MOD TableSize]];
		END;

	END.k792\28b15B175i13I423b8B453i8I86b9B319b9B378b10B266b12B358b4B44i9I54i9I