
DIRECTORY
Alloc,
CardTab,
ConvertUnsafe,
IO,
MimData,
MimosaType2CType USING [],
Rope,
SymbolOps,
Symbols,
Table;
MimosaType2CTypeImpl: PROGRAM
IMPORTS Alloc, CardTab, MimData, IO, Rope, SymbolOps
EXPORTS MimosaType2CType
~ BEGIN


ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
TypeTable: TYPE = CardTab.Ref;

Pair: TYPE = REF PairRep;
PairRep: TYPE = RECORD [
name: ROPE,
value: ROPE,
comment: ROPE];

bitsPerWord: NAT = 32;
bitsPerLong: NAT = 64;

NYI: PUBLIC SIGNAL = CODE;

CycleFound: PUBLIC ERROR = CODE;

EnterType: PUBLIC PROC [type: Symbols.Type, table: CardTab.Ref, out: STREAM м NIL]
RETURNS [Rope.ROPE] = {
seb: Symbols.Base = Alloc.Bounds[MimData.table, Symbols.seType].base;
ctxb: Symbols.Base = Alloc.Bounds[MimData.table, Symbols.ctxType].base;
inner: PROC [type: Symbols.Type] RETURNS [ROPE] = {
genName: PROC RETURNS [new: ROPE] = {
new м IO.PutFR1["type_%g", [cardinal[card]]];
[] м CardTab.Store[table, card, new];
};
indexRep: Table.IndexRep м LOOPHOLE[type];
card: CARD;
indexRep.tag м 0;
card м LOOPHOLE[indexRep];
WITH CardTab.Fetch[table, card].val SELECT FROM
rope: ROPE => RETURN [rope];
pair: Pair => RETURN [pair.name];
ENDCASE => {
ut: Symbols.CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];
sep: LONG POINTER TO Symbols.SERecord = @seb[type];
name: ROPE м NIL;
defn: ROPE м NIL;
comment: ROPE м NIL;
WITH se: sepн SELECT FROM
id => {
name м comment м RopeForName[se.hash];
defn м inner[ut];
SELECT type FROM
MimData.idINT, MimData.idCARD => RETURN [name];
MimData.idREAL, MimData.idDREAL => RETURN [name];
MimData.idBOOL, MimData.idNAT => defn м "int";
MimData.idCHAR => RETURN [name];
MimData.idANY => RETURN ["UNSPEC"];
ENDCASE => name м IO.PutFR1["type_%g", [rope[name]] ];
defn м IO.PutFR["%g %g", [rope[defn]], [rope[name]] ];
};
cons => {
ut: Symbols.CSEIndex = LOOPHOLE[type];
WITH cse: se SELECT FROM
basic =>
SELECT cse.code FROM
Symbols.codeANY => {
name м "UNSPEC";
defn м "int UNSPEC";
};
Symbols.codeCHAR => {
name м "CHAR";
defn м "char CHAR";	-- is this right?
};
ENDCASE => SIGNAL NYI;
signed =>
SELECT cse.length FROM
<= bitsPerWord => {
name м "INT";
defn м "int INT";
};
<= bitsPerLong => {
name м "DINT";
defn м "long int DINT";
};
ENDCASE => SIGNAL NYI;
unsigned =>
SELECT cse.length FROM
<= bitsPerWord => {
name м "CARD";
defn м "unsigned int CARD";
};
<= bitsPerLong => {
name м "DCARD";
defn м "long unsigned int DCARD";
};
ENDCASE => SIGNAL NYI;
real =>
SELECT cse.length FROM
bitsPerWord => {
name м "REAL";
defn м "float REAL";
};
bitsPerLong => {
name м "DREAL";
defn м "double DREAL";
};
ENDCASE => SIGNAL NYI;
enumerated => {
name м genName[];
defn м IO.PutFR1["unsigned int %g", [rope[name]] ];
comment м "class = enumerated";
};
record => {
name м genName[];
SELECT TRUE FROM
cse.machineDep, cse.packed => GO TO bailOut;
cse.hints.variant => GO TO bailOut;
ENDCASE => {
fieldCtx: Symbols.CTXIndex = cse.fieldCtx;
firstSei: Symbols.ISEIndex =
SymbolOps.FirstCtxSe[SymbolOps.own, fieldCtx];
ros: STREAM м IO.ROS[];
oldDepth: NAT м depth;
i: NAT м 0;
FOR eachSei: Symbols.ISEIndex
м firstSei, SymbolOps.NextSe[SymbolOps.own, eachSei]
WHILE eachSei # Symbols.ISENull DO
ese: Symbols.ISEPointer = @seb[eachSei];
eSei: Symbols.Type = ese.idType;
bits: CARD = SymbolOps.DecodeBitAddr[ese.idInfo];
IF bits MOD bitsPerWord # 0 THEN GO TO bailOut;
SELECT TRUE FROM
ese.constant => GO TO bailOut;
ese.linkSpace => GO TO bailOut;
ENDCASE => [] м inner[eSei];
ENDLOOP;
IO.PutRope[ros, "struct "];
IO.PutRope[ros, "{"];
depth м depth + depthIncr;
newLine[ros];
FOR eachSei: Symbols.ISEIndex
м firstSei, SymbolOps.NextSe[SymbolOps.own, eachSei]
WHILE eachSei # Symbols.ISENull DO
ese: Symbols.ISEPointer = @seb[eachSei];
typeSei: Symbols.Type = ese.idType;
eUnder: Symbols.CSEIndex =
SymbolOps.UnderType[SymbolOps.own, typeSei];
subDefn: ROPE м NIL;
subName: ROPE м RopeForName[ese.hash];
addr: CARD = SymbolOps.DecodeBitAddr[ese.idValue];
bits: CARD = SymbolOps.DecodeBitAddr[ese.idInfo];
IO.PutRope[ros, inner[typeSei]];
IO.PutRope[ros, " "];
IF subName = NIL
THEN {
IO.PutF1[ros, "_empty_%g", [integer[i]]];
i м i + 1;
}
ELSE IO.PutRope[ros, subName];
IF Rope.Equal[inner[eUnder], "CHAR"] THEN
IO.PutF1[ros, ": %g", [integer[bits]]];
IO.PutRope[ros, ";"];
newLine[ros];
ENDLOOP;
IO.PutRope[ros, "} "];
IO.PutRope[ros, name];
depth м oldDepth;
defn м IO.RopeFromROS[ros];
};
EXITS bailOut =>
defn м rawBitsDefn[name, cse.length];
};
ref => {
oldDepth: NAT м depth;
name м genName[];
defn м inner[cse.refType];
depth м oldDepth;
SELECT cse.length FROM
bitsPerWord =>
defn м IO.PutFR[
"%g *%g",
[rope[defn]],
[rope[name]] ];
ENDCASE => SIGNAL NYI;
};
array => {
bits: CARD м SymbolOps.BitsForType[SymbolOps.own, type];
len: CARD м SymbolOps.Cardinality[SymbolOps.own, cse.indexType];
name м genName[];
IF cse.packed
THEN
defn м rawBitsDefn[name, bits]
ELSE {
subName: ROPE м inner[cse.componentType];
defn м IO.PutFR["%g %g[%g]",
[rope[subName]], [rope[name]], [cardinal[len]] ];
};
};
arraydesc => {
name м genName[];
defn м rawBitsDefn[name, cse.length];
comment м "class = arraydesc";
};
transfer => {
name м genName[];
comment м "class = transfer";
IF cse.length # bitsPerWord
THEN defn м rawBitsDefn[name, cse.length]
ELSE 
SELECT cse.mode FROM
proc => {
comment м "class = proc";
defn м IO.PutFR[
"%g %g ()",
[rope[ inner[cse.typeOut] ]],
[rope[ name ]]
];
};
ENDCASE =>
defn м Rope.Concat["UNSPEC *", name];
};
definition => {
SIGNAL NYI;
};
union => {
SIGNAL NYI;
};
sequence => {
SIGNAL NYI;
};
relative => {
name м genName[];
defn м IO.PutFR1["unsigned int %g", [rope[name]] ];
comment м "class = relative";
};
subrange => {
name м genName[];
defn м IO.PutFR["%g %g", [rope[inner[cse.rangeType]]], [rope[name]] ];
comment м "class = subrange";
};
opaque => {
name м genName[];
defn м rawBitsDefn[name, cse.length];
comment м "class = opaque";
};
zone => {
name м genName[];
defn м Rope.Concat["UNSPEC *", name];
name м "class = zone";
};
ENDCASE => {
name м genName[];
defn м Rope.Concat["UNSPEC ", name];
};
};
ENDCASE;
SELECT TRUE FROM
defn # NIL => {
pair: Pair м NEW[PairRep м [
name: IF name # NIL
THEN name
ELSE (name м IO.PutFR1["type_%g", [cardinal[card]]]),
value: defn,
comment: comment]];
[] м CardTab.Store[table, card, pair];
IF out # NIL THEN {
IO.PutRope[out, "typedef "];
IO.PutRope[out, defn];
IO.PutRope[out, ";"];
newLine[out];
IF comment # NIL THEN {
IO.PutRope[out, "  /*"];
IO.PutRope[out, comment];
IO.PutRope[out, "*/"];
newLine[out];
};
};
};
name # NIL => 
[] м CardTab.Store[table, card, name];
ENDCASE => 
[] м CardTab.Store[table, card, name м "??"];
RETURN [name];
};
};
newLine: PROC [st: STREAM] = {
IO.PutRope[st, "\n"];
THROUGH [0..depth) DO
IO.PutChar[st, ' ];
ENDLOOP;
};
rawBitsDefn: PROC [name: ROPE, bits: CARD] RETURNS [ROPE] = {
words: CARD м (bits + bitsPerWord - 1) / bitsPerWord;
IF words < 2 THEN RETURN [Rope.Concat["UNSPEC ", name]];
RETURN [IO.PutFR["UNSPEC %g[%g]", [rope[name]], [cardinal[words]] ]];
};
depth: NAT м depthIncr;
IF out # NIL THEN newLine[out];
[] м inner[MimData.idANY];	-- to make sure that it has been defined
RETURN [inner[type]];
};
depthIncr: NAT м 2;

LookupType: PUBLIC PROC [type: Symbols.Type, table: CardTab.Ref] RETURNS [Rope.ROPE] = {
indexRep: Table.IndexRep м LOOPHOLE[type];
card: CARD;
indexRep.tag м 0;
card м LOOPHOLE[indexRep];
WITH CardTab.Fetch[table, card].val SELECT FROM
rope: ROPE => RETURN [rope];
pair: Pair => RETURN [pair.name];
ENDCASE => RETURN [NIL];
};

RopeForName: PUBLIC PROC [name: Symbols.Name] RETURNS [ROPE] = {
IF name = Symbols.nullName
THEN RETURN [NIL]
ELSE {
ss: ConvertUnsafe.SubString = SymbolOps.SubStringForName[SymbolOps.own, name];
ros: STREAM = IO.ROS[];
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
IO.PutChar[ros, ss.base[i]];
ENDLOOP;
RETURN [IO.RopeFromROS[ros]];
};
};

END.
   V  
MimosaType2CTypeImpl.mesa
Copyright ╙ 1987, 1991 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) December 3, 1987 2:29:18 pm PST
Issue List
1.  The layout of structures is not certain to be compatible with Cedar/Mesa conventions.  In such a case, we avoid the record declaration and use the fallback.  It would be better to do something more clever.  For now, we can only convert records that are completely composed of word quantities.
2.  The use of the C type char can lead to use of bytes instead of words.  This can make the record to structure conversion a little weird.  This has implications to earlier phases of the compiler: should ARRAY T OF CHAR be packed or not?  It depends on whether there is any access benefit to leaving it unpacked (no benefit for unpacking on Sun Sparc, small benefit for AMD 29000, moderate benefit for Dragon).
3.  What about BOOL?  It currently translates into int, but should it be char?

Problem with cyclic types: type declarations are processed in linear order EXCEPT for certain cases of struct and union types.  We can detect cyclic types, but can't avoid them right now.
UNSPECIFIED
CHAR
We can't dictate that C put things in the right place
We can't hack variant records yet
During the first pass we ensure that all of the component types make sense to generate code for.  If anything is to weird, then we bail out.
We can't ensure that C will understand
At this point we should have a valid record field for declarations
No name, so invent one unique to this structure
Force this to be the right width
We can't hack packed arrays
Is this sufficient?
 Э╩╖  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЩKЪЬ
╧eЬ7ЩBKЩ3ЧШ Щ
IindentЩиLЪ	Ь╧zЬп╧kЬЯЬЯЬ┐ЩЫLЪЬЯЬ ЮЬЮЬЩNLЩ ЧЪЯ	Ш	KЪЬШKЪЬШKЪЬШKЪЯЬШKЪЬШKЪЬЯЬШKЪЬШKЪЬ
Ш
KЪЬШKЪЬШЧЧheadЪ╧nЬЯШKЪЯЬЯЬШ4KЪЯЬШKЪЬЯШKШ KЩ╗KШ KЪЯЬЯЬЯЬШKЪЯЬЯЬЯЬЯЬШKЪЬЯЬШKШ KЪЬЯЬЯЬ	ШЪЬ	ЯЬЯЬШKЪЬЯЬШKЪЬЯЬШKЪЬ	ЯЬШKШ ЧKЪЬЯЬШKЪЬЯЬШKШ ЧЪЯЬЯЬЯЬШKШ ЧЪа
ЬЯЬЯЬШ KШ ЧЪа	ЬЯЬ/ЯЬЯЬЯЬЯЬШjKЪЬEШEKЪЬGШGЪЬЯЬЯЬЯЬШ3ЪЬ	ЯЬЯЬЯЬШ%KЪЬЯЬ%Ш-KЪЬ%Ш%KШЧKЪЬЯЬШ*KЪЬЯЬШKЪЬШKЪЬЯЬШЪЯЬ ЯЬЯШ/KЪЬЯЬЯЬШKЪЬЯЬШ!ЪЯЬШKЪЬ@Ш@KЪЬЯЬЯЬЯЬШ3KЪЬЯЬЯЬШKЪЬЯЬЯЬШKЪЬ	ЯЬЯЬШЪЯЬ
ЯЬЯШШKЪЬ&Ш&KЪЬШЪЯЬЯШKЪЬ!ЯЬШ/KЪЬ#ЯЬШ1KЪЬ.Ш.KЪЬЯЬШ KЪЬЯЬШ#KЪЯЬЯЬ"Ш6ЧKЪЬЯЬ-Ш6KШЧШ	KЪЬЯЬШ&ЪЯЬ	ЯЬЯШЪЬШЪЯЬ
ЯШЪЬШKЪЯЩKЪЬШKЪЬШKЪЬШЧЪЬШKЪЯЩKЪЬШKЪЬ╧cШ%KЪЬШЧKЪЯЬЯЬЯЬШЧЧЪЬ	Ш	ЪЯЬЯШШKШKШKШЧЪЬШKЪЬШKЪЬШKШЧKЪЯЬЯЬЯЬШЧЧЪЬШЪЯЬЯШЪЬШKШKЪЬШKШЧЪЬШKШKЪЬ!Ш!KШЧKЪЯЬЯЬЯЬШЧЧЪЬШЪЯЬЯШЪЬШKЪЬШKЪЬШKШЧЪЬШKЪЬШKЪЬШKШЧKЪЯЬЯЬЯЬШЧЧЪЬШKЪЬШKЪЬЯЬ*Ш3KЪЬШKЪЬШЧЪЬШKЪЬШЪЯЬЯЬЯШЪЬЯЬЯЬ	Ш,KЩ5ЧЪЬЯЬЯЬ	Ш#KЩ!ЧЪЯЬШKШ*KЪЬKШKKЪЬЯЬЯЬЯЬШKЪЬ
ЯЬ	ШKЪЬЯЬШKЩМЪЯЬPЯЬЯШuKЪЬ(Ш(KЪЬ Ш KЪЬЯЬ'Ш1Ъ
ЯЬЯЬЯЬЯЬЯЬ	Ш/KЩ&ЧЪЯЬЯЬЯШKЪЬЯЬЯЬ	ШKЪЬЯЬЯЬ	ШKЪЯЬШЧKЪЯЬШЧKЪЯЬШKЪЯЬШKШKШЪЯЬPЯЬЯШuKЪЬ(Ш(KЪЬ#Ш#KЪЬGШGKЪЬ	ЯЬЯЬШKЪЬ	ЯЬШ&KЪЬЯЬ(Ш2KЪЬЯЬ'Ш1KЩBKЪЯЬШ KЪЯЬШЪЯЬЯШЪЯЬШKЩ/KЪЯЬ'Ш)KШ
KШЧKЪЯЬЯЬШЧЪЯЬ#ЯШ)KЩ KЪЯЬ%Ш'ЧKЪЯЬШKШKЪЯЬШЧKЪЯЬШKЪЯЬШKЪЬШKЪЬЯЬШKШЧЧЪЯЬШKЪЬ%Ш%ЧKЪЬШЧЪЬШKЪЬ
ЯЬ	ШKЪЬШKЪЬШKЪЬШЪЯЬЯШЪЬШЪЬЯЬШKШ	KЪЬШKЪЬШЧЧKЪЯЬЯЬЯЬШЧKЪЬШЧЪЬ
Ш
KЪЬЯЬ.Ш8KЪЬЯЬ7Ш@KЪЬШЪЯЬШЪЯШKЩKЪЬШЧЪЯЬШKЪЬ	ЯЬШ)KЪЬЯЬEШNKШЧЧKЪЬШЧЪЬШKЪЬШKЪЬ%Ш%KЪЬШKЪЬШЧЪЬШKЪЬШKЪЬШЪЯЬШKЪЯЬ%Ш)ЪЯЬШЪЯЬ
ЯШЪЬ	Ш	KЪЬШЪЬЯЬШKШKЪЬШKЪЬШKЪЬШЧKШЧЪЯЬШ
KЪЬ%Ш%ЧЧЧЧKЪЬШЧЪЬШKЪЯЬЯЬШKЪЬШЧЪЬ
Ш
KЪЯЬЯЬШKЪЬШЧЪЬШKЪЯЬЯЬШKЪЬШЧЪЬШKЪЬШKЪЬЯЬ*Ш3KЪЬШKЪЬШЧЪЬШKЩKЪЬШKЪЬЯЬ=ШFKЪЬШKЪЬШЧЪЬШKЪЬШKЪЬ%Ш%KЪЬШKЪЬШЧЪЬ	Ш	KЪЬШKЪЬ%Ш%KЪЬШKЪЬШЧЪЯЬШKЪЬШKЪЬ$Ш$KШЧЧKШЧKЪЯЬШЧЪЯЬЯЬЯШЪЬЯЬШЪЬЯЬШKЪ	ЬЯЬЯЬЯЬ	ЯЬ&ШSKЪЬШKШЧKЪЬ&Ш&ЪЯЬЯЬЯЬШKЪЯЬШKЪЯЬШKЪЯЬШKЪЬШЪЯЬЯЬЯЬШKЪЯЬШKЪЯЬШKЪЯЬШKЪЬШKШЧKШЧKШЧЪЬЯЬШKЪЬ&Ш&ЧЪЯЬШKЪЬ-Ш-ЧЧKЪЯЬШKШЧЧKШЧЪЬ	ЯЬЯЬШKЪЯЬШЪЯЬЯШKЪЯЬШKЪЯЬШЧKШЧЪЬЯЬЯЬЯЬЯЬЯЬШ=KЪЬЯЬ*Ш5KЪЯЬЯЬЯЬ Ш8KЪЯЬЯЬ;ШEKШЧKЪЬЯЬШKЪЯЬЯЬЯЬШKЪЬб(ШCKЪЯЬШKШKЪЬЯЬШKШ ЧЪа
ЬЯЬ*ЯЬЯЬШXKЪЬЯЬШ*KЪЬЯЬШKЪЬШKЪЬЯЬШЪЯЬ ЯЬЯШ/KЪЬЯЬЯЬШKЪЬЯЬШ!KЪЯЬЯЬЯЬШЧKШKШ ЧЪаЬЯЬЯЬЯЬШ@ЪЯЬШKЪЯЬЯЬЯЬШЪЯЬШKЪЬNШNKЪЬЯЬЯЬЯЬШЪЯЬЯЬЯЬ"ЯШ6KЪЯЬШKЪЯЬШЧKЪЯЬЯЬШKШЧЧKШKШ ЧKЪЯЬШЧ ЕЧ    b  1o  