DIRECTORY
TreesDefs USING [TreeNode, FreeTree],
PrintingDefs USING [OutCode, PrintComments],
PrintDclsDefs USING [],
PrintExprDefs USING [MakeExpression],
String USING [EqualString],
Storage USING [AppendString, CopyString, FreeString, Free],
SymbolTableDefs USING [EnterSymbol, SymbolType];
PrintDclsImpl: PROGRAM IMPORTS PrintingDefs, PrintExprDefs, String,
Storage, TreesDefs, SymbolTableDefs
EXPORTS PrintDclsDefs = {
-- Global variable (saved from call to call)
structName: LONG STRING ← "StructA";
PrintFunctionHead: PUBLIC PROCEDURE [name: LONG STRING,
functionAttributes: LONG POINTER TO TreesDefs.TreeNode,
pointerTo: BOOLEAN, nameList: LONG POINTER TO TreesDefs.TreeNode,
argList: LONG POINTER TO TreesDefs.TreeNode] = {
dataType: LONG STRING;
symType: SymbolTableDefs.SymbolType;
dcl, itemHead, n: LONG POINTER TO TreesDefs.TreeNode;
PrintingDefs.OutCode[name, 0];
IF name # NIL THEN Storage.FreeString[name];
PrintingDefs.OutCode[": PROCEDURE ["L, 0];
FOR n ← nameList, n.right WHILE n # NIL DO
[dcl, itemHead] ← InDclList[n, argList];
IF itemHead = NIL THEN {
-- enter symbol with blockHeader=TRUE so that the symbol
-- will belong to the block about to be entered.
SymbolTableDefs.EnterSymbol[n.string,
long, long, "INT"L, 0, TRUE];
PrintingDefs.OutCode[n.string, 0];
PrintingDefs.OutCode[": INT"L, 0]; }
ELSE PrintOneDeclaration[dcl, 0, ""L, itemHead];
IF n.right # NIL THEN PrintingDefs.OutCode[", "L, 0];
ENDLOOP;
IF pointerTo THEN {
PrintingDefs.OutCode["] RETURNS [LONG POINTER TO "L, 0];
[symType, dataType] ← GetAttributes[functionAttributes, 0];
SymbolTableDefs.EnterSymbol[name, pointer, symType, dataType, 1];
PrintingDefs.OutCode[dataType, 0];
Storage.FreeString[dataType]; }
ELSE IF functionAttributes # NIL THEN {
PrintingDefs.OutCode["] RETURNS ["L, 0];
[symType, dataType] ← GetAttributes[functionAttributes, 0];
SymbolTableDefs.EnterSymbol[name, symType, symType, dataType, 0];
PrintingDefs.OutCode[dataType, 0];
Storage.FreeString[dataType]; };
PrintingDefs.OutCode["] =\n"L, 0];
TreesDefs.FreeTree[functionAttributes];
TreesDefs.FreeTree[argList];
TreesDefs.FreeTree[nameList]; };
InDclList: PROCEDURE [node, list: LONG POINTER TO TreesDefs.TreeNode]
RETURNS [dcl, item: LONG POINTER TO TreesDefs.TreeNode] = {
n, dclItemList, dcltor: LONG POINTER TO TreesDefs.TreeNode;
FOR n ← list, n.right WHILE n # NIL DO -- move along dclList
IF n.left = NIL THEN LOOP;
FOR dclItemList ← n.left.right, dclItemList.right
WHILE dclItemList # NIL DO
IF dclItemList.left = NIL THEN LOOP;
dcltor ← dclItemList.left.left;
IF String.EqualString[dcltor.string, node.string] THEN
RETURN [n.left, dclItemList.left];
ENDLOOP;
ENDLOOP;
RETURN [NIL, NIL]; };
PrintDeclarations: PUBLIC PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
indent: CARDINAL, separator: LONG STRING, terminateWithSeparator: BOOLEAN] = {
n: LONG POINTER TO TreesDefs.TreeNode;
FOR n ← node, n.right WHILE n # NIL DO
IF n.nodeType # dclList THEN {
PrintingDefs.OutCode["*** No dclList in PrintDeclarations ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
PrintOneDeclaration[n.left, indent,
IF n.right = NIL AND NOT terminateWithSeparator
THEN ""L ELSE separator,
NIL];
ENDLOOP; };
GetAttributes: PUBLIC PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
indent: CARDINAL]
RETURNS [symType: SymbolTableDefs.SymbolType, typeString: LONG STRING] = {
IF node = NIL THEN {
symType ← none;
typeString ← Storage.CopyString["*** NIL argument to GetAttributes ***"L];
RETURN; }
ELSE IF node.nodeType # attributes THEN {
symType ← none;
typeString ← Storage.CopyString["*** No attributes in GetAttributes ***"L];
RETURN; }
ELSE IF node.structure THEN {
symType ← structure;
IF node.right = NIL THEN typeString ← Storage.CopyString[node.string]
ELSE {
IF node.string = NIL THEN {
typeString ← Storage.CopyString[structName];
-- move to next generated structure name
structName.text[6] ← structName.text[6] + 1; }
ELSE typeString ← Storage.CopyString[node.string];
PrintingDefs.OutCode[typeString, indent];
PrintingDefs.OutCode[": TYPE = RECORD [\n"L, 0];
PrintDeclarations[node.right, indent + 1, ",\n"L, FALSE];
PrintingDefs.OutCode["];\n"L, indent]; }; }
ELSE IF node.union THEN {
symType ← union;
typeString ← Storage.CopyString["UNION"L] }
ELSE IF node.enumeration THEN {
symType ← enumeration;
typeString ← Storage.CopyString["ENUMERATION"L] }
ELSE IF node.long THEN {
symType ← long;
IF node.unsigned THEN typeString ← Storage.CopyString["LONG CARDINAL"L]
ELSE IF node.int THEN typeString ← Storage.CopyString["LONG INTEGER"L]
ELSE IF node.float OR node.double THEN typeString ← Storage.CopyString["LONG REAL"L]
ELSE typeString ← Storage.CopyString["INT"L]; }
ELSE IF node.unsigned THEN {
symType ← long;
typeString ← Storage.CopyString["LONG CARDINAL"L] }
ELSE IF node.char THEN {
symType ← short;
typeString ← Storage.CopyString["INTEGER"L] }
ELSE IF node.short THEN {
symType ← short;
typeString ← Storage.CopyString["INTEGER"L] }
ELSE IF node.float THEN {
symType ← real;
typeString ← Storage.CopyString["REAL"L] }
ELSE IF node.double THEN {
symType ← double;
typeString ← Storage.CopyString["LONG REAL"L] }
ELSE {
symType ← long;
typeString ← Storage.CopyString["INT"L]; };
IF node.class = extern THEN Storage.AppendString[@typeString, "--EXTERN--"L]
ELSE IF node.class = static THEN Storage.AppendString[@typeString, "--STATIC--"L]; };
PrintOneDeclaration: PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
indent: CARDINAL, separator: LONG STRING,
oneOnly: LONG POINTER TO TreesDefs.TreeNode] = {
temp: LONG STRING;
basicTypeString: LONG STRING;
symType: SymbolTableDefs.SymbolType;
baseSymType: SymbolTableDefs.SymbolType;
dclItem: LONG POINTER TO TreesDefs.TreeNode;
m: LONG POINTER TO TreesDefs.TreeNode;
dclItemHead: LONG POINTER TO TreesDefs.TreeNode;
topLevelArray: BOOLEAN;
nextLevelArray: BOOLEAN;
pointerCount: CARDINAL;
sawProcedure: BOOLEAN;
inBlockHeader: BOOLEAN;
IF node = NIL THEN RETURN;
-- check for a slipup
IF node.nodeType # declaration THEN {
PrintingDefs.OutCode["*** No declaration in PrintOneDeclaration ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
-- ignore class for now --
-- print any comments associated with this nodeType=declaration
IF node.string # NIL AND node.string.length > 0 THEN
PrintingDefs.PrintComments[node.string, indent];
-- get the basic type for this declaration --
[baseSymType, basicTypeString] ← GetAttributes[node.left, indent];
-- traverse the dclItemList --
FOR dclItem ← node.right, dclItem.right WHILE dclItem # NIL DO
-- error checking --
IF dclItem.nodeType # dclItemList THEN {
PrintingDefs.OutCode["*** No dclItemList in PrintOneDeclaration ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
-- go down the tree and more error checking --
dclItemHead ← dclItem.left;
IF dclItemHead.nodeType # itemHead THEN {
PrintingDefs.OutCode["*** No itemHead in PrintOneDeclaration ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
-- oneOnly # NIL => call from PrintFunctionHead and so only a
-- single thing is being declared and this is not it
IF oneOnly # NIL AND dclItemHead # oneOnly THEN LOOP;
-- Now see if the outer level type is ARRAY --
-- The outer level type is a the end of the declarator list --
topLevelArray ← dclItemHead.left # NIL
AND dclItemHead.left.right # NIL
AND dclItemHead.left.right.declaratorType = arrayOf;
nextLevelArray ← dclItemHead.left # NIL
AND dclItemHead.left.right # NIL
AND dclItemHead.left.right.right # NIL
AND dclItemHead.left.right.right.declaratorType = arrayOf;
-- Now we print out the declaration
-- First we write out the name of the variable and the ": "
PrintingDefs.OutCode[dclItemHead.left.string, indent];
PrintingDefs.OutCode[": "L, 0];
-- Change typedefs to Mesa TYPE declarations --
IF node.left = NIL THEN EXIT;
IF node.left.class = typedef THEN PrintingDefs.OutCode["TYPE = "L, 0];
-- Generate the "LONG POINTER TO" part of the type name and count how many indirections
pointerCount ← 0;
sawProcedure ← FALSE;
-- get to and loop through the declarator node chain --
FOR m ← dclItemHead.left.right, m.right WHILE m # NIL DO
IF m.nodeType # declarator THEN { -- error checking
PrintingDefs.OutCode["*** No declarator in PrintOneDeclaration ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
SELECT m.declaratorType FROM
pointerTo, arrayOf => {
pointerCount ← pointerCount + 1;
PrintingDefs.OutCode["LONG POINTER TO "L, 0]; };
functionOf => {
PrintingDefs.OutCode["PROCEDURE [] RETURNS ["L, 0];
sawProcedure ← TRUE; };
ENDCASE;
ENDLOOP;
-- Print out the basic type --
PrintingDefs.OutCode[basicTypeString, 0];
inBlockHeader ← oneOnly # NIL;
IF topLevelArray AND NOT inBlockHeader THEN {
symType ← IF nextLevelArray
THEN arrayArray
ELSE array; }
ELSE symType ← IF pointerCount > 0
THEN pointer
ELSE baseSymType;
SymbolTableDefs.EnterSymbol[dclItemHead.left.string,
symType, baseSymType, basicTypeString, pointerCount, inBlockHeader];
IF sawProcedure THEN PrintingDefs.OutCode["]"L, 0];
-- If there was an array declaration in the list we have to
-- now generate space for the array since we have changed its
-- type to pointer.
-- Note we don't do this for declaraions in procedure argument
-- lists (onlyOne # NIL) since no space needs to be generated
-- in these cases.
IF NOT inBlockHeader
AND (symType = array OR symType = arrayArray) THEN {
-- Set the array variable (whose type was changed to pointer)
-- to point to the first element in the array that allocates
-- the space for this variable's array.
PrintingDefs.OutCode[" = @"L, 0];
PrintingDefs.OutCode[dclItemHead.left.string, 0];
PrintingDefs.OutCode["Array[0]"L, 0];
PrintingDefs.OutCode[separator, 0]; -- includes CR
-- now append "Array" to the name and allocate the array itself
PrintingDefs.OutCode[dclItemHead.left.string, indent];
PrintingDefs.OutCode["Array: "L, 0];
-- Go through the declarators again, this time actually allocating
-- space for the arrays.
m ← dclItemHead.left.right;
PrintingDefs.OutCode["ARRAY [0.."L, 0];
temp ← IF m.left = NIL THEN Storage.CopyString["0"L]
ELSE PrintExprDefs.MakeExpression[m.left, FALSE];
PrintingDefs.OutCode[temp, 0];
Storage.FreeString[temp];
PrintingDefs.OutCode[") OF "L, 0];
FOR m ← dclItemHead.left.right.right, m.right WHILE m # NIL DO
IF m.nodeType # declarator THEN {
PrintingDefs.OutCode[
"*** No declarator in PrintOneDeclaration ***"L, 0];
PrintingDefs.OutCode[separator, 0];
RETURN; };
SELECT m.declaratorType FROM
pointerTo, arrayOf =>
PrintingDefs.OutCode["LONG POINTER TO "L, 0];
functionOf =>
PrintingDefs.OutCode["PROCEDURE [] RETURNS [] "L, 0];
ENDCASE;
ENDLOOP;
PrintingDefs.OutCode[basicTypeString, 0]; };
-- Now handle the double array case
IF NOT inBlockHeader AND symType = arrayArray THEN {
-- Note that these are not initialized correctly.
PrintingDefs.OutCode[" = ALL[@"L, 0];
PrintingDefs.OutCode[dclItemHead.left.string, 0];
PrintingDefs.OutCode["ArrayArray[i][0]]"L, 0];
PrintingDefs.OutCode[separator, 0]; -- includes CR
PrintingDefs.OutCode[dclItemHead.left.string, indent];
PrintingDefs.OutCode["ArrayArray: "L, 0];
FOR m ← dclItemHead.left.right, m.right WHILE m # NIL DO
SELECT m.declaratorType FROM
pointerTo =>
PrintingDefs.OutCode["LONG POINTER TO "L, 0];
arrayOf => {
PrintingDefs.OutCode["ARRAY [0.."L, 0];
temp ← IF m.left = NIL THEN Storage.CopyString["0"L]
ELSE PrintExprDefs.MakeExpression[m.left, FALSE];
PrintingDefs.OutCode[temp, 0];
Storage.FreeString[temp];
PrintingDefs.OutCode[") OF "L, 0]; };
functionOf =>
PrintingDefs.OutCode["PROCEDURE [] RETURNS [] "L, 0];
ENDCASE;
ENDLOOP;
PrintingDefs.OutCode[basicTypeString, 0]; };
-- now see if there is an initialization --
IF dclItemHead.right # NIL THEN { -- there is an initializer
SELECT dclItemHead.right.operationType FROM
eList => {
PrintingDefs.OutCode[" ← "L, 0];
PrintInitList[dclItemHead.right]; };
ENDCASE => {
PrintingDefs.OutCode[" ← "L, 0];
temp ← PrintExprDefs.MakeExpression[dclItemHead.right, FALSE];
PrintingDefs.OutCode[temp, 0];
Storage.FreeString[temp]; }; };
PrintingDefs.OutCode[separator, 0];
ENDLOOP;
Storage.FreeString[basicTypeString];
};
PrintInitList: PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode] = {
n: LONG POINTER TO TreesDefs.TreeNode;
temp: LONG STRING;
PrintingDefs.OutCode["["L, 0];
FOR n ← node, n.right WHILE n # NIL DO
IF n.left = NIL THEN LOOP;
SELECT n.left.operationType FROM
eList =>
PrintInitList[n.left];
ENDCASE => {
temp ← PrintExprDefs.MakeExpression[n.left, FALSE];
PrintingDefs.OutCode[temp, 0];
Storage.FreeString[temp]; };
IF n.right # NIL THEN PrintingDefs.OutCode[", "L, 0];
ENDLOOP;
PrintingDefs.OutCode["]"L, 0];
};
MergeAttributes: PUBLIC PROCEDURE [n1: LONG POINTER TO TreesDefs.TreeNode,
n2: LONG POINTER TO TreesDefs.TreeNode]
RETURNS [result: LONG POINTER TO TreesDefs.TreeNode] = {
IF n2.structure OR n2.union OR n2.enumeration THEN {
IF n2.class = noClass THEN n2.class ← n1.class;
result ← n2;
Storage.Free[n1]; }
ELSE IF n1.structure OR n1.union OR n1.enumeration THEN {
IF n1.class = noClass THEN n1.class ← n2.class;
result ← n1;
Storage.Free[n2]; }
ELSE {
n1.char ← n1.char OR n2.char;
n1.short ← n1.short OR n2.short;
n1.int ← n1.int OR n2.int;
n1.long ← n1.long OR n2.long;
n1.unsigned ← n1.unsigned OR n2.unsigned;
n1.float ← n1.float OR n2.float;
n1.double ← n1.double OR n2.double;
IF n1.class = noClass THEN n1.class ← n2.class;
result ← n1;
Storage.Free[n2]; };
};
}.