[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>MimosaType2CTypeImpl.mesa

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?

DIRECTORY

Alloc,

CardTab,

ConvertUnsafe,

IO,

MimData,

MimosaType2CType USING [],

Rope,

SymbolOps,

Symbols,

Table;

MimosaType2CTypeImpl: PROGRAM

IMPORTS Alloc, CardTab, MimData, IO, Rope, SymbolOps

EXPORTS MimosaType2CType

~ BEGIN

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.

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 => {

UNSPECIFIED

name ¬ "UNSPEC";

defn ¬ "int UNSPEC";

};

Symbols.codeCHAR => {

CHAR

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;

We can't dictate that C put things in the right place

cse.hints.variant => GO TO bailOut;

We can't hack variant records yet

ENDCASE => {

fieldCtx: Symbols.CTXIndex = cse.fieldCtx;

firstSei: Symbols.ISEIndex =
SymbolOps.FirstCtxSe[SymbolOps.own, fieldCtx];

ros: STREAM ¬ IO.ROS[];

oldDepth: NAT ¬ depth;

i: NAT ¬ 0;

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.

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;

We can't ensure that C will understand

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];

At this point we should have a valid record field for declarations

IO.PutRope[ros, inner[typeSei]];

IO.PutRope[ros, " "];

IF subName = NIL

THEN {

No name, so invent one unique to this structure

IO.PutF1[ros, "𡤎mpty←%g", [integer[i]]];

i ¬ i + 1;

}

ELSE IO.PutRope[ros, subName];

IF Rope.Equal[inner[eUnder], "CHAR"] THEN

Force this to be the right width

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

We can't hack packed arrays

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 => {

Is this sufficient?

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.