--	NutsMain.mesa
-- Mainline CIF-to-Chipmonk conversion
--	Modifications:
--	Dillon 19-Nov-84  9:58:40. Convert rectangular polygons to boxes
--		Also convert illegal zero-width boxes to 1/2 lambda boxes
--	Dillon February 10, 1985  10:41 AM. Convert wires to boxes
--		Also implement Flashes as square Boxes
--	Last Edit: See "herald:" below.

DIRECTORY

AuxIntDefs: FROM "AuxIntDefs" USING [IGetFirstSymbol, IGetNextSymbol, IGetRootID, ISymBB, IExpand],
AuxOutputDefs: FROM "AuxOutputDefs" USING [],
ImageDefs: FROM "ImageDefs" USING [AbortMesa],
InlineDefs: FROM "InlineDefs" USING [BITOR,BITSHIFT, COPY, LowByte, LowHalf, HighHalf],
IntDefs: FROM "IntDefs" USING [InitInterpreter, FinishInterpreter, IScaleLongInt, IUserObject],
IntTransDefs: FROM "IntTransDefs" USING [Transform],
IntStorageDefs: FROM "IntStorageDefs" USING [ObjectType, ObjectName, NilObjectName],
IODefs: FROM "IODefs" USING [WriteString, WriteLine, ReadLine, ReadDecimal, WriteDecimal, Rubout, WriteChar, CR],
NutsDictDefs: FROM "NutsDictDefs" USING [AllocateDict, Record, Lookup, What, FreeDict],
OutputDefs: FROM "OutputDefs" USING [RelationType, VisibleType],
ParserDefs: FROM "ParserDefs" USING [CommandType,InitParser,FinishParser, ParseStatement],
ParserErrorDefs: FROM "ParserErrorDefs" USING [ParserAbort, ErrorType, Report],
ParserInputDefs: FROM "ParserInputDefs" USING [InFromFile],
ParserTypeDefs: FROM "ParserTypeDefs" USING [LinkedPoint, Point, Path],
Real: FROM "Real" USING [Fix, Float],
RealFns: FROM "RealFns" USING [SqRt],
Storage: FROM "Storage" USING [CopyString, FreeString, Node, StringLength],
StreamDefs: FROM "StreamDefs" USING [DiskHandle, NewWordStream, WriteAppend],
StringDefs: FROM "StringDefs" USING [AppendChar, AppendDecimal, AppendString, EqualStrings, InvalidNumber, StringToLongNumber, WordsForString, UpperCase];

NutsMain: PROGRAM IMPORTS AuxIntDefs, ImageDefs, IntDefs, IODefs, InlineDefs, NutsDictDefs, ParserDefs, ParserErrorDefs, ParserInputDefs, Real, RealFns, Storage, StreamDefs, StringDefs EXPORTS AuxOutputDefs, OutputDefs =

BEGIN

herald: STRING _ "NUTS of February 10, 1985  10:41 AM";	-- by Dillon

UCmdType: TYPE = {SymbolName,NodeName};

UserCmd: TYPE = RECORD
	[
	type: UCmdType,
	name: STRING,
	x,y: LONG INTEGER,
	stringBody: ARRAY [0..0) OF WORD];

ChipLayers: ARRAY [0..7] OF CARDINAL =
	-- Mapping from MAGIC to Chipmonk layer numbers
		[4,	-- MAGIC 0 = implant
		 1,	-- MAGIC 1 = diffusion
		 2,	-- MAGIC 2 = poly
		 0,	-- MAGIC 3 = contact
		 3,	-- MAGIC 4 = metal
		 6,	-- MAGIC 5 = buried
		 5,	-- MAGIC 6 = glass
		 7];	-- MAGIC 7 = undef

chipSymNo: CARDINAL;

ModeType: TYPE = {Idle, Marking, ScanningSymbol, CountingItems, PuttingDefn, PuttingItems};

Mode: ModeType;

itemCount: CARDINAL;

Name: STRING _ [50];
hasName: BOOLEAN _ FALSE;

CurrentSymbol: IntStorageDefs.ObjectName;	-- symbol whose definition is being processed

FileRoot: STRING _ [40];
CifFileName: STRING _ [40];
ChipFileName: STRING _ [40];
ChipFile: StreamDefs.DiskHandle;
Scale: CARDINAL _ 125;	-- Half-lambda per cif unit

prevProblem, prevPrevProblem: STRING _ NIL;  -- to avoid explosion of warnings

Mark: PROCEDURE [markee: IntStorageDefs.ObjectName] =
-- recursive procedure eliminates forward symbol references:
-- FOR all callee CALLED BY markee DO Mark[callee] ENDLOOP
-- then record markee in dictionary
	BEGIN
	IF NutsDictDefs.Lookup[markee] = 0 THEN
		BEGIN
		AuxIntDefs.IExpand[markee];	-- mark all callees
		NutsDictDefs.Record[chipSymNo,markee];	-- then record self
		chipSymNo _ chipSymNo+1;
--	ELSE already marked, nothing to do
		END;
	END;

PutChipFile: PROCEDURE =
	BEGIN
	sequenceNumber, symbolCount: CARDINAL;

	PutWord [123751B];	-- Password for Chip file.
	PutWord [4];	-- Version number

--	First count symbols, to determine size of dictionary
	symbolCount _ 0;
	CurrentSymbol _ AuxIntDefs.IGetFirstSymbol[];
	UNTIL CurrentSymbol=IntStorageDefs.NilObjectName DO
		symbolCount _ symbolCount+1;
		CurrentSymbol _ AuxIntDefs.IGetNextSymbol[];
		ENDLOOP;
	NutsDictDefs.AllocateDict[symbolCount];

	PutWord [symbolCount];

-- Go through list of symbols, looking for symbols not yet in dictionary.
-- For each such symbol, record first all symbols it calls, then itself.
-- (Initially none are recorded, but this changes quickly!)
	chipSymNo _ 1;
	SetMode[Marking];
	CurrentSymbol _ AuxIntDefs.IGetFirstSymbol[];
	UNTIL CurrentSymbol=IntStorageDefs.NilObjectName DO
		Mark[CurrentSymbol];
		CurrentSymbol _ AuxIntDefs.IGetNextSymbol[];
		ENDLOOP;

--	write out symbol definitions in sorted order
	SetMode[PuttingDefn];
	FOR sequenceNumber IN [1..symbolCount] DO
		CurrentSymbol _ NutsDictDefs.What[sequenceNumber];
		PutSymbolDef[CurrentSymbol, sequenceNumber];
		ENDLOOP;
	CurrentSymbol _ AuxIntDefs.IGetRootID[];
	SetMode[CountingItems];
	AuxIntDefs.IExpand[CurrentSymbol];	-- this time, just to count items
	PutWord[itemCount];
	SetMode[PuttingItems];
	AuxIntDefs.IExpand[CurrentSymbol];	-- now for real
	SetMode[Idle];
	END;

PutSymbolDef: PROCEDURE [symbol: IntStorageDefs.ObjectName, chipSymNo: CARDINAL] =
	BEGIN
	l,r,b,t: LONG INTEGER;	-- left,right,bottom,top of BBox in CIF units
	xSize,ySize: CARDINAL;	-- dimensions of BBox in half-lambda

	PutWord [chipSymNo];
	SetMode[ScanningSymbol];
	AuxIntDefs.IExpand[symbol];  -- count items, find name
	PutString[GetName[chipSymNo]];
	[l,r,b,t] _ AuxIntDefs.ISymBB[symbol];
	xSize _ ChipScale[r-l];
	ySize _ ChipScale[t-b];
	PutWord[xSize];
	PutWord[ySize];
	PutWord[0];	-- reserved for future Chipmonks
	PutWord[itemCount];
	SetMode[PuttingDefn];
	AuxIntDefs.IExpand[symbol];  -- list contents of symbol
	END;

ParseCifFile: PROCEDURE [fname: STRING] RETURNS [ok: BOOLEAN] =
	BEGIN
	ENABLE ParserErrorDefs.ParserAbort=>ImageDefs.AbortMesa;
	stmtCount: CARDINAL _ 0;
	IODefs.WriteString["Initializing Parser"];
	ok_ParserDefs.InitParser[];
	IF NOT ok THEN InternalError["problem Initializing Parser"];
	IODefs.WriteLine[", Interpreter"];
	ok_IntDefs.InitInterpreter[];
	IF NOT ok THEN InternalError["problem Initializing Interpreter"];
	ok _ ParserInputDefs.InFromFile[fname];
	IF ok THEN
		BEGIN
		IODefs.WriteString["Parsing "];
		IODefs.WriteString[fname];
		IODefs.WriteString["..."];
		UNTIL ParserDefs.ParseStatement[]=End DO
			stmtCount _ stmtCount + 1;
			IF stmtCount MOD 100 = 0 THEN
				BEGIN
				IODefs.WriteDecimal[stmtCount];
				IODefs.WriteString["..."];
				END;
			ENDLOOP;
		IF ParserDefs.FinishParser[] THEN IODefs.WriteLine["finished."];
		END
	END;


GetFileNames: PROCEDURE =
	BEGIN
	ENABLE IODefs.Rubout=>
		BEGIN
		IODefs.WriteLine["XXX"];
		RETRY;
		END;
	IODefs.WriteString["File Name (no extension): "];
	IODefs.ReadLine[FileRoot];
	CifFileName.length _ 0;
	StringDefs.AppendString[to: CifFileName, from: FileRoot];
	StringDefs.AppendString[to: CifFileName, from: ".cif"];
	ChipFileName.length _ 0;
	StringDefs.AppendString[to: ChipFileName, from: FileRoot];
	StringDefs.AppendString[to: ChipFileName, from: ".chip"];
	END;

GetLambda: PROCEDURE RETURNS [lambda: CARDINAL] =
	BEGIN
	ENABLE StringDefs.InvalidNumber=>
		BEGIN
		IODefs.WriteLine[" is invalid number!"];
		RETRY;
		END;
	DO
		IODefs.WriteString["Lambda (CIF units): "];
		lambda _ IODefs.ReadDecimal[]; IODefs.WriteLine[""];
		IF (lambda MOD 2) = 0 THEN RETURN[lambda];
		IODefs.WriteLine["must be even!"];
		ENDLOOP;
	END;

OpenChipFile: PROCEDURE [filename: STRING] =
	BEGIN
	ChipFile _ StreamDefs.NewWordStream[filename, StreamDefs.WriteAppend];
	IODefs.WriteString["Writing "];
	IODefs.WriteString[filename];
	IODefs.WriteString["..."];
	END;

CloseChipFile: PROCEDURE =
	BEGIN
	ChipFile.destroy[ChipFile];
	IODefs.WriteLine["finished."];
	END;

ResolveRotation: PROCEDURE [length, width: LONG CARDINAL, xRotation, yRotation: LONG INTEGER] RETURNS [xSize, ySize: LONG CARDINAL] =
	BEGIN
-- (xRotation, yRotation) is direction vector; (1,0) = no rotation
	IF xRotation # 0 AND yRotation # 0 THEN
			BEGIN
			Warning ["45-degree","taken as no rotation"];
			xSize _ width;
			ySize _ length;
			END
	ELSE SELECT TRUE FROM
		xRotation # 0 =>	-- no rotation
			BEGIN
			xSize _ length;
			ySize _ width;
			END;
		yRotation # 0 =>	-- 90 degrees
			BEGIN
			xSize _ width;
			ySize _ length;
			END;
		ENDCASE =>
			BEGIN
			Warning ["zero vector","taken as no rotation"];
			xSize _ width;
			ySize _ length;
			END;
--	Hack to allow zero-dimension boxes to be expanded to 1/2 lambda.
--	Some DRC programs outline errors with such objects.
--	Treat negative sizes as errors.
	IF xSize = 0 THEN xSize _ Scale;
	IF ySize = 0 THEN ySize _ Scale;
	END;

SetLambda: PROCEDURE [lambda: CARDINAL] =
	BEGIN
	Scale _ lambda/2;
	END;

ChipScale: PROCEDURE [cifUnits: LONG INTEGER] RETURNS [INTEGER] =
	BEGIN
	quotient: LONG INTEGER;
	IF cifUnits MOD Scale # 0 THEN
			Warning ["Non-lambda-grid item","dimension truncated"];
	quotient _ cifUnits/Scale;
	IF InlineDefs.HighHalf[quotient] NOT IN [-1..0] THEN
		BEGIN
		Warning ["Number too big to scale","taken as zero"];
		RETURN[0];
		END;
	RETURN [InlineDefs.LowHalf[quotient]];
	END;

PutNullItem: PROCEDURE[] =
	BEGIN
	PutWord[0];	-- x position
	PutWord[0];	-- y position
	PutWord[0];	-- orientation
	PutWord[0];	-- code for null item
	PutWord[0];	-- contents of null item
	PutWord[0];	-- zero properites
	END;

PutWord: PROCEDURE[word: UNSPECIFIED] =
	BEGIN
	ChipFile.put[ChipFile, word];
	END;

PutString: PROCEDURE[string: STRING] =
	BEGIN
	bflg: BOOLEAN _ FALSE;
	save: CARDINAL;
	i: CARDINAL;
	PutByte: PROCEDURE [byte: CHARACTER] =
		BEGIN
		IF bflg
			THEN PutWord[InlineDefs.BITOR[byte, save]]
			ELSE save _ InlineDefs.BITSHIFT[byte, 8];
		bflg _ NOT bflg;
		END;
	PutByte[InlineDefs.LowByte[string.length]];
	FOR i IN [0..string.length) DO PutByte[string[i]]; ENDLOOP;
	PutByte[0C];	-- complete word if odd number bytes put so far
	END;

Warning: PROCEDURE [problem, fixup: STRING] =
	BEGIN
	chipSymNo: CARDINAL;
	IF StringDefs.EqualStrings[problem, prevProblem] OR
	  StringDefs.EqualStrings[problem, prevPrevProblem] THEN RETURN;
	Storage.FreeString[prevPrevProblem]; prevPrevProblem _ prevProblem;
	prevProblem _ Storage.CopyString[problem];
	IODefs.WriteString["Warning: "];
	IODefs.WriteString[problem];
	IF (chipSymNo_NutsDictDefs.Lookup[CurrentSymbol]) > 0 THEN
		BEGIN
		IODefs.WriteString[" in "];
		IODefs.WriteString[GetName[chipSymNo]];
		END
	ELSE IF CurrentSymbol = AuxIntDefs.IGetRootID[] THEN
		IODefs.WriteString[" in top level"];
	IODefs.WriteString[" - "];
	IODefs.WriteLine[fixup];
	END;

InternalError: PROCEDURE [message: STRING] =
	BEGIN
	IODefs.WriteString["Fatal Internal Error: "];
	IODefs.WriteLine[message];
	CloseChipFile;
	ImageDefs.AbortMesa;
	END;

GetName: PROCEDURE [chipSymNo: CARDINAL] RETURNS [STRING] =
	BEGIN
	i: CARDINAL;
	IF ~hasName THEN	-- Invent name from file root, number.
		BEGIN
		Name.length _ 0;
		FOR i IN [0..FileRoot.length) DO
			StringDefs.AppendChar[Name,StringDefs.UpperCase[FileRoot[i]]];
			ENDLOOP;
		StringDefs.AppendDecimal[Name,chipSymNo];
		END;
	RETURN [Name];
	END;

SetMode: PROCEDURE [newMode: ModeType] =
	BEGIN
	Mode _ newMode;
	SELECT Mode FROM
		ScanningSymbol =>
			BEGIN
			Name.length _ 0;
			hasName _ FALSE;
			END;
		ENDCASE;
	itemCount _ 0;
	END;

CountItem: PROCEDURE =
	BEGIN
	itemCount _ itemCount + 1;
	END;

--	Each routine below implements the output of one primitive geometric construct from CIF, called by Interpreter.

WireIsBox: PROCEDURE[layerName: CARDINAL, width: LONG CARDINAL,
  a: ParserTypeDefs.Path,
  proc: PROC [layerName: CARDINAL, length, width: LONG CARDINAL,
  center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER]]
  RETURNS [isbox: BOOLEAN] =
  BEGIN
  isbox _ TRUE;  -- isbox returns false if any wire is not a box
-- Decompose the wire into boxes as suggested in Mead & Conway
-- i,j,k are previous, current, and next points on the wire's path.
  IF a^.length = 1 THEN -- make a flash
    proc[layerName, width, width, a^.first^.value, 1, 0]


  ELSE {
    halfWidth: LONG CARDINAL = (width+1)/2;
    extension, oldExtension, segLength: LONG CARDINAL;
    segment, nextSeg, bend: ParserTypeDefs.Point;
    j,n,nn:POINTER TO ParserTypeDefs.LinkedPoint;
    j _ a.first; n _ j.next;
    oldExtension _ halfWidth;
    segment _ [n^.value.x-j^.value.x, n^.value.y-j^.value.y];
--  loop invariant (true on entry) n _ j.next; nn _ n.next;
    FOR j _ j, n UNTIL n=NIL DO
      nn _ n.next;
      IF nn = NIL THEN extension _ halfWidth
      ELSE {
	nextSeg _ [nn^.value.x-n^.value.x, nn^.value.y-n^.value.y];
--	avoid long multiply overflows for Manhattan geometry
	bend _ segment;
	IF bend.x=0 THEN bend.y _ IF bend.y>0 THEN 1 ELSE -1
	ELSE IF bend.y=0 THEN bend.x _ IF bend.x>0 THEN 1 ELSE -1;
	bend _ [nextSeg.x*bend.x+nextSeg.y*bend.y,
	        nextSeg.x*bend.y-nextSeg.y*bend.x];
	extension _ halfWidth*(ABS[bend.y]/(Length[bend]+ABS[bend.x]));
	};
      segLength _ Length[segment];
      proc[layerName: layerName,
	length: segLength+extension+oldExtension,
	width: width,
	center: [(n^.value.x+j^.value.x+(extension-oldExtension)*segment.x/segLength)/2,
	  (n^.value.y+j^.value.y+(extension-oldExtension)*segment.x/segLength)/2],
	xRotation: segment.x,
	yRotation: segment.y];


      IF isbox THEN isbox _ segment.x=0 OR segment.y=0;
      segment _ nextSeg;
      oldExtension _ extension;
      n _ nn;
      ENDLOOP;
    };
  END;

AuxWire: PUBLIC PROCEDURE [layerName: CARDINAL, width: LONG CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
--	Decompose the wire into boxes as suggested in Mead & Conway
	[] _ WireIsBox[layerName, width, a, AuxBox];
	END;

Length: PROCEDURE[dif:ParserTypeDefs.Point] RETURNS [LONG CARDINAL] = {
	-- Utility to calculate length of vector dif.
	-- Avoids using SqRt in the typical case of Manhattan orientation.
	SELECT TRUE FROM
	  dif.x = 0 => RETURN[ABS[dif.y]];
	  dif.y = 0 => RETURN[ABS[dif.x]];
	  ENDCASE => {
	    x: REAL = Real.Float[dif.x];
	    y: REAL = Real.Float[dif.y];
	    RETURN[Real.Fix[RealFns.SqRt[x*x+y*y]]]
	    };
	};

AuxFlash: PUBLIC PROCEDURE [layerName: CARDINAL, diameter: LONG CARDINAL, center: ParserTypeDefs.Point] =
	BEGIN
--	Make a box of this dimension
	AuxBox[layerName, diameter, diameter, center, 1, 0];
	END;

PolygonIsBox: PROCEDURE [layerName: CARDINAL, a: ParserTypeDefs.Path,
  proc: PROC [layerName: CARDINAL, length, width: LONG CARDINAL,
  center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER]]
  RETURNS [isbox: BOOLEAN] =
  BEGIN
--  calls proc iff a describes a rectangular box
--  Special hack: convert length/width-zero polygons to 1/2 lambda boxes.
--    Some DRC programs use such polygons to outline errors.
--  Rectangular iff, for 4 points i,j,k,l (vector notation):
--  (i-j)=(l-k)   (parallelogram rule, equivalently: (i-j+k-l)=0)
--  (i-j).(i-l)=0 (right angle rule)
--  The i-j direction is the length, the i-l direction is the width.
  isbox _ FALSE;
  IF a.length = 4 THEN { -- quadralaterals only
    total: ParserTypeDefs.Point _ [0,0];
    FOR j: POINTER TO ParserTypeDefs.LinkedPoint _ a.first, j.next UNTIL j=NIL DO
      total.x _ j.value.x-total.x;
      total.y _ j.value.y-total.y;
      ENDLOOP;
    IF total = [0,0] THEN { -- parallelograms only
      OPEN i: a^.first^.value, j: a^.first^.next^.value, l: a^.last^.value;
      IF (i.x-j.x)*(i.x-l.x) + (i.y-j.y)*(i.y-l.y) = 0 THEN { -- right angles only
        xRotation: LONG CARDINAL = i.x-j.x;
        yRotation: LONG CARDINAL = i.y-j.y;
        length: LONG CARDINAL = Length[[xRotation,yRotation]];
        width: LONG CARDINAL = Length[[i.x-l.x,i.y-l.y]];
        isbox _ TRUE;
	-- Use diagonals for center
        total.x _ (j.x+l.x)/2; total.y _ (j.y+l.y)/2;
        proc[layerName, length, width, total, xRotation, yRotation];
	};
      };
    };
  END;

AuxPolygon: PUBLIC PROCEDURE [layerName: CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
--	Ignore if non-rectangular, otherwise call the Box routine.
	[] _ PolygonIsBox[layerName, a, AuxBox];
	END;

AuxBox: PUBLIC PROCEDURE [layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
	BEGIN
	manhattan: BOOLEAN _ (xRotation=0 OR yRotation=0);
	IF manhattan THEN SELECT Mode FROM
		ScanningSymbol,CountingItems => CountItem;
		PuttingDefn,PuttingItems =>
			PutBox [layerName, length, width, center, xRotation, yRotation];
		ENDCASE;
--	ELSE ignore 45's
	END;

AuxUserObject: PUBLIC PROCEDURE [layerName: CARDINAL, size: CARDINAL, data: POINTER TO UNSPECIFIED] =
	BEGIN
	u: POINTER TO UserCmd _ data;
	SELECT u^.type FROM
		SymbolName =>
			BEGIN
			SELECT Mode FROM
				ScanningSymbol =>	-- register name
					BEGIN
					i: CARDINAL;
					hasName _ TRUE;
					FOR i IN [1..u^.name.length) DO
						StringDefs.AppendChar[Name,StringDefs.UpperCase[u^.name[i]]];
						ENDLOOP;
					END;
				ENDCASE;	-- otherwise ignore
			END;
		NodeName =>
			SELECT Mode FROM
				ScanningSymbol,CountingItems => CountItem[];
				PuttingDefn,PuttingItems => PutNodeName[u^.name,u^.x,u^.y];
				ENDCASE;
		ENDCASE => InternalError["Funny User Type"];
	END;

AuxCall: PUBLIC PROCEDURE [objectname: IntStorageDefs.ObjectName, number: LONG CARDINAL, xform: IntTransDefs.Transform] =
	BEGIN
	SELECT Mode FROM
		Marking =>	Mark[objectname];
		ScanningSymbol,CountingItems => CountItem;
		PuttingDefn,PuttingItems =>
			PutCall[objectname, number, xform];
		ENDCASE;
	END;

PutBox: PROCEDURE [layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
	BEGIN
	xSize, ySize: LONG CARDINAL;
	chipX,chipY,chipOrient,chipType,chipWidth,chipLength,chipLayer: CARDINAL;
	bbrel: ParserTypeDefs.Point;

	[xSize,ySize] _ ResolveRotation[length, width, xRotation, yRotation];
	bbrel _ BBRel[center];	-- find center rel to bbox left top corner
	chipX _ ChipScale[(bbrel.x - xSize/2)];
	chipY _ ChipScale[-(bbrel.y + ySize/2)];
	IF xSize > ySize THEN	-- long ways horizontal
		BEGIN
		chipOrient _ 4;
		chipLength _ ChipScale[xSize];
		chipWidth _ ChipScale[ySize];
		END
	ELSE	-- long ways vertical
		BEGIN
		chipOrient _ 0;
		chipLength _ ChipScale[ySize];
		chipWidth _ ChipScale[xSize];
		END;
	chipLayer _ ChipLayers[layerName];
	chipType _ SELECT chipLayer FROM
		1,2,3 => 4,	-- dif,pol,met => Chip Wire
		ENDCASE	=>	5;	-- other => Chip Rectangle
	PutWord[chipX];
	PutWord[chipY];
	PutWord[chipOrient];
	PutWord[chipType];
	PutWord[chipWidth];
	PutWord[chipLength];
	PutWord[chipLayer];
	PutWord[0];	-- zero properties (for now)
	END;

PutNodeName: PROCEDURE [name: STRING, x,y: LONG INTEGER] =
	BEGIN
	orgrel: ParserTypeDefs.Point _ [x,y];
	bbrel: ParserTypeDefs.Point _ BBRel[orgrel];
	chipLayer: CARDINAL;
--	chipLayer _ ChipLayers[FindLayer[x,y]];
	chipLayer _ 3;
	Warning["Node name placed on Metal",name];
	PutWord[ChipScale[ bbrel.x]];	 -- x position
	PutWord[ChipScale[-bbrel.y]];	 -- y position
	PutWord[0];	-- orientation
	PutWord[4];	-- wire object
	PutWord[0];	-- width zero
	PutWord[0];	-- length zero
	PutWord[chipLayer];
	PutWord[1];	 -- with one property...
	PutWord[1];	 -- of type text...
	PutString[name];
	END;

FindLayer: PROCEDURE [x,y: LONG INTEGER] RETURNS [cifLayer: CARDINAL] =
	-- given point, finds layer there.
	BEGIN
-- not implemented yet
	cifLayer _ 4;
	InternalError ["FindLayer Not Implemented"];
	END;

PutCall: PROCEDURE [objectname: IntStorageDefs.ObjectName, number: LONG CARDINAL, xform: IntTransDefs.Transform] =
	BEGIN
	d,l,r,b,t,xOrigin,yOrigin,xLeft,yTop: LONG INTEGER;
	chipX,chipY: INTEGER;
	chipOrient: CARDINAL;
	matrix: RECORD[a11,a12,a21,a22: LONG INTEGER];
	leftTopRelOrigin,leftTopRelBBox: ParserTypeDefs.Point;
	[l,r,b,t] _ AuxIntDefs.ISymBB[objectname];	-- bbox of called symbol relative to its origin
	d _ Real.Fix[xform.a33];
	matrix _ [Real.Fix[xform.a11]/d, Real.Fix[xform.a12]/d,
		Real.Fix[xform.a21]/d, Real.Fix[xform.a22]/d];
	xOrigin _ Real.Fix[xform.a31]/d; yOrigin _ Real.Fix[xform.a32]/d;
	-- have origin of instance relative to origin of containing symbol
	SELECT matrix FROM
		[ 1, 0, 0, 1] => 	-- identity
			BEGIN
			chipOrient _ 0;
			xLeft _ xOrigin+l;
			yTop _ yOrigin+t;
			END;
		[-1, 0, 0, 1] => 	-- mirror x (about y)
			BEGIN
			chipOrient _ 1;
			xLeft _ xOrigin-r;
			yTop _ yOrigin+t;
			END;
		[ 0,-1, 1, 0] => 	-- rotate 90 clockwise
			BEGIN
			chipOrient _ 4;
			xLeft _ xOrigin+b;
			yTop _ yOrigin-l;
			END;
		[ 0,-1,-1, 0] => 	-- rotate 90 cw, then mirror x
			BEGIN
			chipOrient _ 5;
			xLeft _ xOrigin-t;
			yTop _ yOrigin-l;
			END;
		[-1, 0, 0,-1] => 	-- rotate 180
			BEGIN
			chipOrient _ 8;
			xLeft _ xOrigin-r;
			yTop _ yOrigin-b;
			END;
		[ 1, 0, 0,-1] => 	-- mirror y (about x)
			BEGIN
			chipOrient _ 9;
			xLeft _ xOrigin+l;
			yTop _ yOrigin-b;
			END;
		[ 0, 1,-1, 0] => 	-- rotate 90 counterclockwise
			BEGIN
			chipOrient _ 12;
			xLeft _ xOrigin-t;
			yTop _ yOrigin+r;
			END;
		[ 0, 1, 1, 0] => 	-- rotate 90 ccw, then mirror x
			BEGIN
			chipOrient _ 13;
			xLeft _ xOrigin+b;
			yTop _ yOrigin+r;
			END;
		ENDCASE => 		-- other
			BEGIN
			Warning
				["Arbitrary transformation","taken as zero transform"];
			chipOrient _ 0;
			xLeft _ xOrigin+l;
			yTop _ yOrigin+t;
			END;
	-- have left top of instance relative to origin of containing symbol
	leftTopRelOrigin _ [xLeft,yTop];
	leftTopRelBBox _ BBRel[leftTopRelOrigin];
	-- have left top of instance relative to left top of containing symbol
	chipX _ ChipScale[leftTopRelBBox.x];
	chipY _ ChipScale[-leftTopRelBBox.y];
	PutWord[chipX];	-- x position
	PutWord[chipY];	-- y position
	PutWord[chipOrient];	-- orientation
	PutWord[1];	-- code for "call" = "cell instance"
	PutWord[NutsDictDefs.Lookup[objectname]];	-- which cell
	PutWord[0];	-- no properties
	END;

BBRel: PROCEDURE [relOrigin: ParserTypeDefs.Point] RETURNS [relBBox: ParserTypeDefs.Point] =
-- given x, y of item relative to "origin" of enclosing symbol
-- returns x,y of item relative to left top corner of its BBox
	BEGIN
	IF CurrentSymbol = IntStorageDefs.NilObjectName THEN
		BEGIN
		relBBox.x _ relOrigin.x;
		relBBox.y _ relOrigin.y;
		END
	ELSE
		BEGIN
		l,r,b,t: LONG INTEGER;	-- BBox of enclosing symbol in CIF units
		[l,r,b,t] _ AuxIntDefs.ISymBB[CurrentSymbol];
		relBBox.x _ relOrigin.x - l;
		relBBox.y _ relOrigin.y - t;
		END;
	END;

InitOutput: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
	BEGIN
	InternalError["InitOutput not implemented"];
	RETURN[FALSE];
	END;

FinishOutput: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
	BEGIN
	InternalError["FinishOutput not implemented"];
	RETURN[FALSE];
	END;

SendMessage: PUBLIC PROCEDURE [type: ParserErrorDefs.ErrorType, message: STRING, wantCR: BOOLEAN _ TRUE] =
	BEGIN
	IODefs.WriteString[message];
	IF wantCR THEN IODefs.WriteChar[IODefs.CR];
	END;

-- associates a CARDINAL with a layer name - a PACKED ARRAY [0..4) OF CHARACTER, padded by spaces to make 4 characters (if necessary)
Map: PUBLIC PROCEDURE [layerName: PACKED ARRAY [0..4) OF CHARACTER] RETURNS [CARDINAL] =
	-- same layer numbers as Magic, for future compatibility
	BEGIN
	IF layerName[0] = 'N AND layerName[2] = '  AND layerName[3] = '  THEN
		SELECT layerName[1] FROM
			'I => RETURN[0];	-- implant
			'D => RETURN[1];	-- diffusion
			'P => RETURN[2];	-- poly
			'C => RETURN[3];	-- contact
			'M => RETURN[4];	-- metal
			'B => RETURN[5];	-- buried
			'G => RETURN[6];	-- glass
			ENDCASE =>
				BEGIN
				ParserErrorDefs.Report["Unrecognized layer name becomes Chipmonk layer 7",Advisory];
				RETURN[7];
				END;
	RETURN[7];	-- Never executed but necessary to keep compiler happy!
	END;

--	Each routine below implements the output of one primitive geometric construct form CIF.

OutputWire: PUBLIC PROCEDURE [visible: OutputDefs.VisibleType, layerName: CARDINAL, width: LONG CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
	InternalError["OutputWire not implemented"];
	END;

OutputFlash: PUBLIC PROCEDURE [visible: OutputDefs.VisibleType, layerName: CARDINAL, diameter: LONG CARDINAL, center: ParserTypeDefs.Point] =
	BEGIN
	InternalError["OutputFlash not implemented"];
	END;

OutputPolygon: PUBLIC PROCEDURE [visible: OutputDefs.VisibleType, layerName: CARDINAL, a: ParserTypeDefs.Path] =
	BEGIN
	InternalError["OutputPolygon not implemented"];
	END;

OutputBox: PUBLIC PROCEDURE [visible: OutputDefs.VisibleType, layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
	BEGIN
	InternalError["OutputBox not implemented"];
	END;

OutputUserCommand: PUBLIC PROCEDURE [command: [0..9], userText: STRING] =
	BEGIN
	stringWords: CARDINAL = StringDefs.WordsForString[Storage.StringLength[userText]];
	size: CARDINAL = SIZE[UserCmd] + stringWords;
	pu: POINTER TO UserCmd = Storage.Node[size];
	IF command = 9 AND userText[0] = '  THEN	-- SymbolName
		BEGIN
		pu^.type _ SymbolName;
		InlineDefs.COPY[from: userText, nwords: stringWords, to: @pu^.stringBody];
		pu^.name _ LOOPHOLE[@pu^.stringBody, STRING];
		pu^.x _ pu^.y _ 0;
		END
	ELSE IF command = 9 AND userText[0] = '4 AND userText[1] = '  THEN	-- NodeName
		BEGIN
		-- code to parse node names (hastily written, could use refinement)
		ENABLE StringDefs.InvalidNumber =>
			BEGIN
			ParserErrorDefs.Report["Fatal error, sorry: Invalid number",Fatal];
			ImageDefs.AbortMesa;
			END;
		temp: STRING _ [20];
		i: CARDINAL;

		NextNumber: PROCEDURE RETURNS [LONG CARDINAL] =
			BEGIN
			UNTIL userText[i] IN ['-..'9] DO i_i+1; ENDLOOP;	-- skip blanks etc.
			temp.length _ 0;
			WHILE userText[i] IN ['-..'9] AND i<userText.length DO
				StringDefs.AppendChar[temp,userText[i]]; i_i+1; ENDLOOP;
			RETURN
				[IntDefs.IScaleLongInt[StringDefs.StringToLongNumber[temp,10]]];
			END;

		pu^.type _ NodeName;
		pu^.name _ LOOPHOLE[@pu^.stringBody, STRING];
		InlineDefs.COPY[from: userText, nwords: stringWords, to: @pu^.stringBody];	-- hack to initialize pu^.name.maxlength
		pu^.name.length _ 0;
		i_2; UNTIL userText[i] = '  DO	-- copy up to first blank
			StringDefs.AppendChar[pu^.name,userText[i]];
			i_i+1;
			ENDLOOP;
		pu^.x _ NextNumber[];
		pu^.y _ NextNumber[];

		END
	ELSE	-- Undef;
		BEGIN
		ParserErrorDefs.Report["Undefined User Object - Ignored",Advisory];
		END;
	IntDefs.IUserObject[size,pu];
	END;


OutputUserObject: PUBLIC PROCEDURE [visible: OutputDefs.VisibleType, layerName: CARDINAL, size: CARDINAL, data: POINTER TO UNSPECIFIED] =
	BEGIN
	InternalError["OutputUserObject not implemented"];
	END;

-- establish ordering
Relation: PUBLIC PROCEDURE [left1, right1, bottom1, top1, left2, right2, bottom2, top2: LONG INTEGER] RETURNS [OutputDefs.RelationType] =
	BEGIN
	InternalError["Relation not implemented"];
	RETURN[dontcare];
	END;

-- determine whether an item should be shown
Visible: PUBLIC PROCEDURE [kind: IntStorageDefs.ObjectType, level: CARDINAL, parentVis: OutputDefs.VisibleType, left,right,bottom,top: LONG INTEGER] RETURNS [OutputDefs.VisibleType] =
	BEGIN
	InternalError["Visible not implemented"];
	RETURN[maybe];
	END;

-- returns the bounding box of the primitive interpreted in the current context
BBWire: PUBLIC PROCEDURE [layerName: CARDINAL, width: LONG CARDINAL, a: ParserTypeDefs.Path] RETURNS [left,right,bottom,top: LONG INTEGER] =
	BEGIN
	BBBoxDummy: PROC [layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
		BEGIN
		a,b,c,d: LONG INTEGER;
		[a,b,c,d] _ BBBox[layerName, length, width, center, xRotation, yRotation];
		left _ MAX[left,a];
		right _ MIN[right,b];
		bottom _ MAX[bottom,c];
		top _ MIN[top,d];
		END;
	left _ bottom _ FIRST[LONG INTEGER];
	right _ top _ LAST[LONG INTEGER];
	IF ~WireIsBox[layerName, width, a, BBBoxDummy] THEN {
		ParserErrorDefs.Report["Non-manhattan wire ignored",Advisory];
		left _ right _ bottom _ top _ 0;
		};
	END;

BBFlash: PUBLIC PROCEDURE [layerName: CARDINAL, diameter: LONG CARDINAL, center: ParserTypeDefs.Point] RETURNS [left,right,bottom,top: LONG INTEGER] =
	BEGIN
	[left,right,bottom,top] _ BBBox[layerName, diameter, diameter, center, 1, 0];
	END;

BBPolygon: PUBLIC PROCEDURE [layerName: CARDINAL, a: ParserTypeDefs.Path] RETURNS [left,right,bottom,top: LONG INTEGER] =
	BEGIN
	BBBoxDummy: PROC [layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] =
		BEGIN
		[left,right,bottom,top] _ BBBox[layerName, length, width, center, xRotation, yRotation];
		END;
	IF ~PolygonIsBox[layerName, a, BBBoxDummy] THEN ParserErrorDefs.Report["Non-rectangular Polygon ignored",Advisory];
	END;

BBBox: PUBLIC PROCEDURE [layerName: CARDINAL, length, width: LONG CARDINAL, center: ParserTypeDefs.Point, xRotation, yRotation: LONG INTEGER] RETURNS [left,right,bottom,top: LONG INTEGER] =
	BEGIN
	xSize,ySize: LONG CARDINAL;
	manhattan: BOOLEAN _ (xRotation=0 OR yRotation=0);
	IF manhattan THEN [xSize,ySize] _ ResolveRotation[length, width, xRotation, yRotation]
	ELSE BEGIN
		ParserErrorDefs.Report["Non-manhattan box ignored",Advisory];
		xSize _ ySize _ 0;
		END;
	left _ center.x - xSize/2;
	right _ center.x + xSize/2;
	bottom _ center.y - ySize/2;
	top _ center.y + ySize/2;
	END;

BBUserObject: PUBLIC PROCEDURE [layerName: CARDINAL, size: CARDINAL, data: POINTER TO UNSPECIFIED] RETURNS [left,right,bottom,top: LONG INTEGER] =
	BEGIN
	u: POINTER TO UserCmd _ data;
	SELECT u^.type FROM
		SymbolName =>	RETURN[0,0,0,0];
		NodeName =>	RETURN[u^.x,u^.x,u^.y,u^.y];
		ENDCASE => InternalError["Funny User Type"];
	RETURN[0,0,0,0];
	END;

--	Mainline code

IODefs.WriteLine[herald];
GetFileNames;
SetLambda[GetLambda[]];
UNTIL ParseCifFile[CifFileName] DO GetFileNames; ENDLOOP;
OpenChipFile[ChipFileName];
PutChipFile;
CloseChipFile;
IF NOT IntDefs.FinishInterpreter[] THEN InternalError["problem finishing Interpreter"];
NutsDictDefs.FreeDict;

END.