DIRECTORY
Alloc,
IntCodeDefs,
IntCodeStuff,
IntCodeUtils,
LiteralOps,
MimCode,
MimData,
MimP5,
MimP5U,
MimP5Install USING [],
MimZones,
MobDefs,
Pass4ToPass5,
RCMap,
RCMapEncode,
RefText,
Rope,
SymbolOps,
Symbols,
SymLiteralOps,
Target: TYPE MachineParms,
TargetConversions,
TypeStrings;

MimP5InstallImpl: PROGRAM
IMPORTS Alloc, IntCodeStuff, IntCodeUtils, LiteralOps, MimData, MimP5, MimP5U, MimZones, Pass4ToPass5, RCMapEncode, RefText, Rope, SymbolOps, SymLiteralOps, TargetConversions, TypeStrings
EXPORTS MimP5Install
= BEGIN

newStyle: BOOL ¬ FALSE;
smallStyle: BOOL ¬ FALSE;
canHandleAddr: BOOL ¬ FALSE;
canHandleFields: BOOL ¬ FALSE;

CodeList: TYPE = MimCode.CodeList;
LocationRep: TYPE = IntCodeDefs.LocationRep;
Node: TYPE = IntCodeDefs.Node;
NodeList: TYPE = IntCodeDefs.NodeList;
NodeRep: TYPE = IntCodeDefs.NodeRep;
OperRep: TYPE = IntCodeDefs.OperRep;
ROPE: TYPE = Rope.ROPE;
Type: TYPE = Symbols.Type;
nullType: Type = Symbols.nullType;
Var: TYPE = IntCodeDefs.Var;

bitsPerWord: NAT = Target.bitsPerWord;
bytesPerWord: NAT = Target.bitsPerWord/Target.bitsPerChar;

z: ZONE ¬ IntCodeUtils.zone;
runtimePrefix: ROPE ¬ "XR_";
lagNum: NAT = 12;
lagNames: REF LagNamesArray ¬ NIL;
LagNamesArray: TYPE = ARRAY [0..lagNum) OF ROPE;
lagOpers: REF LagOpersArray ¬ NIL;
LagOpersArray: TYPE = ARRAY [0..lagNum) OF Node;

assumeGlobalsInitZero: BOOL ¬ TRUE;

GenInstallationProc: PUBLIC PROC
[name: ROPE, gfType: Symbols.Type, module: IntCodeDefs.ModuleNode] = {
cl: CodeList ¬ MimP5U.NewCodeList[];
typeCache: TypeCache ¬ z.NEW[TypeCacheRep ¬ []];
eachType: SymLiteralOps.TypesVisitor = {
IF used THEN {
dest: Node ¬ MimP5.Exp[SymLiteralOps.TypeRef[type]];
destVar: Var ¬ NARROW[dest];
IF lastType = Symbols.nullType
OR NOT SymbolOps.EqTypes[SymbolOps.own, type, lastType]
THEN {
dest: Node ¬ MimP5.Exp[SymLiteralOps.TypeRef[type]];
destVar: Var ¬ NARROW[dest];
MimP5U.MoreCode[cl, MimP5U.Assign[
lhs: destVar,
rhs: EmitType[type, typeCache]]];
}
ELSE {
src: Node ¬ MimP5.Exp[SymLiteralOps.TypeRef[lastType]];
srcVar: Var ¬ NARROW[src];
MimP5U.MoreCode[cl, MimP5U.Assign[
lhs: destVar,
rhs: srcVar]];
};
lastType ¬ type;
};
};
eachRefLit: SymLiteralOps.RefLitsVisitor = {
IF used THEN {
dest: Node;
ss: SymbolOps.SubString;
WITH item SELECT FROM
atom => {
ss ¬ SymbolOps.SubStringForName[SymbolOps.own, pName];
dest ¬ MimP5.Exp[SymLiteralOps.AtomRef[pName]];
};
text => {
str: LONG STRING ¬ LiteralOps.StringValue[value];
ss ¬ [str, 0, str.length];
dest ¬ MimP5.Exp[SymLiteralOps.TextRef[value]];
};
ENDCASE => ERROR;
MimP5U.MoreCode[cl, MimP5U.ApplyOp[
MimP5U.CedarOpNode[simpleAssignInit],
MimP5U.MakeNodeList2[
MimP5U.Address[dest],
InstallCall[name: "GetRefLiteral",
n1: MimP5.Exp[SymLiteralOps.TypeRef[type]],
n2: EmitString[ss, mesa, writer],
bits: Target.bitsPerRef]]]];
};
};
offset, length: CARD;
uz: UNCOUNTED ZONE ¬ MimZones.tempUZ;
writer: TargetConversions.Writer ¬ TargetConversions.NewWriter[];
buffer: REF TEXT ¬ RefText.New[50];
zero: Node ¬ MimP5U.MakeConstInt[0];
base: RCMap.Base = MimP5U.GetRCMapBase[];
typesVar: Var ¬ NIL;
label: IntCodeDefs.Label ¬ MimP5U.AllocLabel[];
lastType: Type ¬ Symbols.nullType;

CountArgs: PROC [seb: Symbols.Base, cse: Symbols.CSEIndex] RETURNS [INT] = TRUSTED {
count: INT ¬ 0;
IF cse # Symbols.CSENull THEN
WITH se: seb[cse] SELECT FROM
record => count ¬ SymbolOps.CtxEntries[SymbolOps.own, se.fieldCtx];
ENDCASE => ERROR;
RETURN [count];
};

HandleImportsExports: PROC [parent: IntCodeDefs.Label] = {
importsVisitor: Pass4ToPass5.ImportsVisitor = {
seb: Symbols.Base = Alloc.Bounds[MimData.table, Symbols.seType].base;
IF lastMdi # mdi THEN {
irPtr ¬ NIL;
WITH se: seb[irType] SELECT FROM
definition => {
slots ¬ se.slots;
irPtr ¬ MimP5.VarForInterface[link.modIndex];
IF irLocal = NIL THEN
irLocal ¬ NewLocalTemp[cl, parent, Target.bitsPerRef];
IF (newStyle OR MimData.switches['k]) AND formal # seb[irSei].hash
THEN {
MimP5U.MoreCode[cl, MimP5U.Assign[
irLocal,
InstallCall[name: "ImportInterfaceX",
n1: EmitName[formal, c, writer],
n2: EmitName[seb[irSei].hash, c, writer],
n3: EmitType[irType, typeCache],
n4: MimP5U.MakeConstInt[slots],
bits: Target.bitsPerRef]]];
}
ELSE {
MimP5U.MoreCode[cl, MimP5U.Assign[
irLocal,
InstallCall[name: "ImportInterface",
n1: EmitName[formal, c, writer],
n2: EmitType[irType, typeCache],
n3: MimP5U.MakeConstInt[slots],
bits: Target.bitsPerRef]]];
};
MimP5U.MoreCode[cl, MimP5U.Assign[irPtr, irLocal]];
};
ref => {
ut: Type = MimP5.Clarify[se.refType];
linkVar: Var ¬ MimP5.VarForLink[link, Target.bitsPerRef];
IF (newStyle OR MimData.switches['k]) AND formal # seb[irSei].hash
THEN {
MimP5U.MoreCode[cl, 
InstallCall[name: "ImportProgramX",
n1: EmitName[formal, c, writer],
n2: EmitName[seb[irSei].hash, c, writer],
n3: EmitType[ut, typeCache],
n4: MimP5U.Address[linkVar],
bits: Target.bitsPerRef]];
}
ELSE {
MimP5U.MoreCode[cl, 
InstallCall[name: "ImportProgram",
n1: EmitName[formal, c, writer],
n2: EmitType[ut, typeCache],
n3: MimP5U.Address[linkVar],
bits: Target.bitsPerRef]];
};
};
ENDCASE;
lastMdi ¬ mdi;
};
IF ~seb[sei].constant THEN {
ut: Symbols.CSEIndex = MimP5.Clarify[seb[sei].idType];
linkVar: Var ¬ MimP5.VarForLink[link, MimP5U.BitsForType[ut]];
SELECT link.tag FROM
proc => {
ut: Symbols.CSEIndex = MimP5.Clarify[seb[sei].idType];
WITH se: seb[ut] SELECT FROM
transfer => IF se.mode = proc THEN {
unitsOut: CARD = SymbolOps.AUsForType[SymbolOps.own, se.typeOut];
unitsIn: CARD = SymbolOps.AUsForType[SymbolOps.own, se.typeIn];
index: CARD ¬ link.offset;
nargs: CARD = CountArgs[seb, se.typeIn];
IF index >= slots THEN ERROR;
IF (smallStyle OR MimData.switches['k])
AND unitsOut < 256 AND unitsIn < 256
AND index < 256 AND nargs < 256
THEN {
encoded: CARD = unitsOut*(256*LONG[256]*256)
+ unitsIn*(256*LONG[256])
+ index*256
+ nargs;
MimP5U.MoreCode[cl, InstallCall[
name: "ImportProcS",
n1: irLocal,
n2: MimP5U.MakeConstCard[encoded]
]];
}
ELSE
MimP5U.MoreCode[cl, InstallCall[
name: "ImportProc",
n1: irLocal,
n2: MimP5U.MakeConstInt[index],
n3: MimP5U.MakeConstInt[unitsOut],
n4: MimP5U.MakeConstInt[unitsIn],
n5: MimP5U.MakeConstInt[nargs]
]];
};
ENDCASE;
};
ENDCASE;
};
};
exportsVisitor: Pass4ToPass5.ExportsVisitor = {
seb: Symbols.Base = Alloc.Bounds[MimData.table, Symbols.seType].base;
index: CARD = link.to;
indexExp: Node = MimP5U.MakeConstCard[index];
IF lastMdi # mdi THEN {
irPtr ¬ NIL;
WITH t: seb[irType] SELECT FROM
definition => {
slots ¬ t.slots;
irPtr ¬ MimP5.VarForInterface[link.from.modIndex];
IF irLocal = NIL THEN
irLocal ¬ NewLocalTemp[cl, parent, Target.bitsPerRef];
IF (newStyle OR MimData.switches['k]) AND formal # seb[irSei].hash
THEN {
MimP5U.MoreCode[cl, MimP5U.Assign[
irLocal,
InstallCall[name: "ExportInterfaceX",
n1: EmitName[formal, c, writer],
n2: EmitName[seb[irSei].hash, c, writer],
n3: EmitType[irType, typeCache],
n4: MimP5U.MakeConstInt[slots],
bits: Target.bitsPerRef]]];
}
ELSE {
MimP5U.MoreCode[cl, MimP5U.Assign[
irLocal,
InstallCall[name: "ExportInterface",
n1: EmitName[formal, c, writer],
n2: EmitType[irType, typeCache],
n3: MimP5U.MakeConstInt[slots],
bits: Target.bitsPerRef]]];
};
MimP5U.MoreCode[cl, MimP5U.Assign[irPtr, irLocal]];
};
ENDCASE;
lastMdi ¬ mdi;
};
SELECT link.from.tag FROM
var => {
expr: Node ¬ MimP5U.Address[MimP5.Exp[[symbol[sei]]]];
IF index >= slots THEN ERROR;
MimP5U.MoreCode[cl, 
InstallCall[name: "ExportVar",
n1: irLocal,
n2: indexExp,
n3: expr]];
};
proc => {
ut: Symbols.CSEIndex = MimP5.Clarify[seb[sei].idType];
expr: Node ¬ MimP5.Exp[[symbol[sei]]];
IF index >= slots THEN ERROR;
WITH se: seb[ut] SELECT FROM
transfer =>
SELECT se.mode FROM
signal, error => {
WITH expr SELECT FROM
apply: IntCodeDefs.ApplyNode =>
WITH apply.proc SELECT FROM
oper: IntCodeDefs.OperNode =>
WITH oper.oper SELECT FROM
mesa: IntCodeDefs.MesaOper =>
IF mesa.mesa = addr THEN
WITH apply.args.first SELECT FROM
var: Var => {
MimP5U.MoreCode[cl, InstallCall[
name: "ExportVar",
n1: irLocal,
n2: indexExp,
n3: expr
]];
RETURN;
};
ENDCASE;
ENDCASE;
ENDCASE;
ENDCASE;
ERROR;
};
proc => {
unitsOut: CARD = SymbolOps.AUsForType[SymbolOps.own, se.typeOut];
unitsIn: CARD = SymbolOps.AUsForType[SymbolOps.own, se.typeIn];
nargs: CARD = CountArgs[seb, se.typeIn];
name: Node _ EmitName[seb[sei].hash, c, writer];
IF (smallStyle OR MimData.switches['k])
AND unitsOut < 256 AND unitsIn < 256
AND index < 256 AND nargs < 256
THEN {
encoded: CARD = unitsOut*(256*LONG[256]*256)
+ unitsIn*(256*LONG[256])
+ index*256
+ nargs;
MimP5U.MoreCode[cl, InstallCall[
name: "ExportProcS",
n1: irLocal,
n2: expr,
n3: MimP5U.MakeConstCard[encoded],
n4: name
]]
}
ELSE
MimP5U.MoreCode[cl, InstallCall[
name: "ExportProc",
n1: irLocal,
n2: indexExp,
n3: expr,
n4: MimP5U.MakeConstInt[unitsOut],
n5: MimP5U.MakeConstInt[unitsIn],
n6: MimP5U.MakeConstInt[nargs],
n7: name
]];
RETURN;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
};
type => {
name: Node ¬ EmitName[seb[sei].hash, c, writer];
absType: Node ¬ EmitGetTypeIndex[ts, zero, writer];
concType: Node ¬ EmitType[MimP5.Clarify[sei], typeCache];
MimP5U.MoreCode[cl, 
InstallCall[name: "ExportType",
n1: name,
n2: absType,
n3: concType]];
};
other => {
expr: Node ¬ MimP5.Exp[[symbol[sei]]];
SELECT SymbolOps.XferMode[SymbolOps.own, seb[sei].idType] FROM
program => {};
ENDCASE => ERROR;
MimP5U.MoreCode[cl, 
InstallCall[name: "ExportVar",
n1: irLocal,
n2: indexExp,
n3: expr]];
};
ENDCASE => ERROR;
};
lastMdi: Symbols.MDIndex ¬ Symbols.MDNull;
irPtr: Var ¬ NIL;
irLocal: Var ¬ NIL;
slots: NAT ¬ 0;
Pass4ToPass5.VisitImports[importsVisitor];
lastMdi ¬ Symbols.MDNull;
Pass4ToPass5.VisitExports[exportsVisitor];
};

lagNames ¬ z.NEW[LagNamesArray ¬ ALL[NIL]];
lagOpers ¬ z.NEW[LagOpersArray ¬ ALL[NIL]];

FOR each: NodeList ¬ module.procs, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
labNode: IntCodeDefs.LabelNode =>
WITH labNode.label.node SELECT FROM
lambda: IntCodeDefs.LambdaNode => IF lambda.parent = NIL THEN {
bti: Symbols.CBTIndex ¬ LOOPHOLE[labNode.label.id];
body: Node ¬ MimP5.ProcDescForBti[bti: bti, body: TRUE];
MimP5U.MoreCode[cl, MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[body, 0, bitsPerWord],
rhs: MimP5.ProcLabelForBti[bti: bti, direct: FALSE]]];
IF NOT assumeGlobalsInitZero THEN
MimP5U.MoreCode[cl, MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[body, bitsPerWord, bitsPerWord],
rhs: zero]];
};
ENDCASE;
ENDCASE;
ENDLOOP;

typeCache.writer ¬ writer;

[offset, length] ¬ SymLiteralOps.DescribeTypes[];
SymLiteralOps.EnumerateTypes[eachType];

SymLiteralOps.EnumerateRefLits[eachRefLit];

MimP5U.MoreCode[cl,
InstallCall[name: "DeclareGlobalFrame",
n1: EmitRope[name, c, writer],
n2: MimP5U.MesaOpNode[op: globalFrame, bits: Target.bitsPerLongPtr],
n3: EmitType[gfType, typeCache],
n4: MimP5.ProcDescForBti[Symbols.RootBti]]];

HandleImportsExports[label];

{
body: NodeList ¬ MimP5U.ExtractList[cl];
ConstantRhs: PROC [node: Node, addrOK: BOOL] RETURNS [BOOL] = {
WITH node SELECT FROM
const: REF NodeRep.const => RETURN [TRUE];
var: Var => WITH var.location SELECT FROM
comp: REF LocationRep.composite => {
FOR each: NodeList ¬ comp.parts, each.rest WHILE each # NIL DO
IF NOT ConstantRhs[each.first, addrOK] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
field: REF LocationRep.field =>
IF canHandleFields THEN
WITH field.base SELECT FROM
const: REF NodeRep.const => RETURN [TRUE];
ENDCASE;
dummy: REF LocationRep.dummy => RETURN [TRUE];
ENDCASE;
apply: REF NodeRep.apply =>
IF apply.handler = NIL THEN
WITH apply.proc SELECT FROM
oper: REF NodeRep.oper => WITH oper.oper SELECT FROM
mesa: REF OperRep.mesa =>
SELECT mesa.mesa FROM
addr => 
IF addrOK THEN
RETURN [IsGlobalLoc[apply.args.first]
OR ConstantRhs[apply.args.first, FALSE]];
all => RETURN [ConstantRhs[apply.args.first, FALSE]
AND ConstantRhs[apply.args.rest.first, FALSE]];
ENDCASE;
ENDCASE;
ENDCASE;
opNode: REF NodeRep.oper => WITH opNode.oper SELECT FROM
code: REF OperRep.code => RETURN [TRUE];
ENDCASE;
ENDCASE;
RETURN [FALSE];
};
IsGlobalLoc: PROC [node: Node] RETURNS [BOOL] = {
DO
WITH node SELECT FROM
var: Var => WITH var.location SELECT FROM
gv: REF LocationRep.globalVar => RETURN [TRUE];
field: REF LocationRep.field => {node ¬ field.base; LOOP}; 
ENDCASE;
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};
GlobalDisjoint: PROC [gVar: Node] RETURNS [BOOL] = {
id: INT ¬ 0;
gStart: INT ¬ 0;
gLen: INT ¬ gVar.bits;
DO
WITH gVar SELECT FROM
var: Var => WITH var.location SELECT FROM
gv: REF LocationRep.globalVar => {id ¬ var.id; EXIT};
field: REF LocationRep.field => {
gStart ¬ gStart + field.start;
gVar ¬ field.base;
LOOP;
}; 
ENDCASE;
ENDCASE;
ERROR;
ENDLOOP;
FOR each: NodeList ¬ keptList, each.rest WHILE each # NIL DO
eVar: Node ¬ each.first;
eStart: INT ¬ 0;
eLen: INT ¬ eVar.bits;
DO
WITH eVar SELECT FROM
var: Var => WITH var.location SELECT FROM
gv: REF LocationRep.globalVar => {
IF id # var.id THEN RETURN [TRUE];
IF (eStart+eLen) <= gStart THEN RETURN [TRUE];
IF (gStart+gLen) <= eStart THEN RETURN [TRUE];
RETURN [FALSE];
};
field: REF LocationRep.field => {
eStart ¬ eStart + field.start;
eVar ¬ field.base;
LOOP;
}; 
ENDCASE;
ENDCASE;
ERROR;
ENDLOOP;
ENDLOOP;
RETURN [TRUE];
};
DoList: PROC [list: NodeList] RETURNS [BOOL] = {
FOR each: NodeList ¬ list, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
comment: REF NodeRep.comment => LOOP;
source: REF NodeRep.source =>
IF DoList[source.nodes] THEN LOOP;
block: REF NodeRep.block =>
IF DoList[block.nodes] THEN LOOP;
assn: REF NodeRep.assign =>
IF IsGlobalLoc[assn.lhs] AND IntCodeUtils.SideEffectFree[assn.rhs, FALSE] THEN {
IF ConstantRhs[assn.rhs, canHandleAddr]
AND GlobalDisjoint[assn.lhs]
AND assn.rhs.bits = bitsPerWord THEN {
new: NodeList ¬ IntCodeUtils.NodeListCons[assn, NIL];
IF tail = NIL THEN head ¬ new ELSE tail.rest ¬ new;
tail ¬ new;
each.first ¬ movedComment;
};
keptList ¬ IntCodeUtils.NodeListCons[assn.lhs, keptList];
LOOP;
};
ENDCASE;
RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
movedComment: Node = IntCodeStuff.GenComment["moved to installation proc"];
head: NodeList ¬ NIL;
tail: NodeList ¬ NIL;
keptList: NodeList ¬ NIL;
WITH module.procs.first SELECT FROM
initLab: IntCodeDefs.LabelNode =>
WITH initLab.label.node SELECT FROM
initLambda: IntCodeDefs.LambdaNode => {
[] ¬ DoList[initLambda.body];
IF tail # NIL THEN {tail.rest ¬ body; body ¬ head};
};
ENDCASE => ERROR;
ENDCASE => ERROR;
label.node ¬ z.NEW[NodeRep.lambda ¬ [details: lambda[
parent: NIL,
descBody: NIL,
kind: install,
bitsOut: 0,
formalArgs: NIL,
body: body]]];
};

module.procs ¬ MimP5U.MakeNodeList[
z.NEW[NodeRep.label ¬ [0, label[label]]],
module.procs];

z.FREE[@lagNames];
z.FREE[@lagOpers];
};

NewLocalTemp: PROC [cl: CodeList, parent: IntCodeDefs.Label, bits: INT ¬ Target.bitsPerRef]
RETURNS [Var] = {
v: Var ¬ MimP5U.MakeTemp[cl, bits].var;
WITH v.location SELECT FROM
local: IntCodeDefs.LocalVarLocation => local.parent ¬ parent;
ENDCASE => ERROR;
RETURN [v];
};

TypeCache: TYPE = REF TypeCacheRep;
TypeCacheRep: TYPE = RECORD [
writer: TargetConversions.Writer ¬ NIL,
lastType: Type ¬ nullType,
typeVar: Var ¬ NIL,
probes: INT ¬ 0,
misses: INT ¬ 0
];

EmitType: PROC [type: Type, typeCache: TypeCache] RETURNS [Node] = {
zero: Node ¬ MimP5U.MakeConstInt[0];
node: Node ¬ zero;
IF type # nullType THEN {
typeVar: Var = typeCache.typeVar;
typeCache.probes ¬ typeCache.probes + 1;
IF typeVar # NIL AND typeCache.lastType = type THEN
RETURN [typeVar];
typeCache.misses ¬ typeCache.misses + 1;
{
uz: UNCOUNTED ZONE ¬ MimZones.tempUZ;
ts: TypeStrings.TypeString ¬ TypeStrings.Create[SymbolOps.own, type, uz];
rcMap: RCMap.Index ¬ MimP5U.RCMapForType[type];
IF rcMap # RCMap.nullIndex THEN {
buffer: REF TEXT ¬ RefText.ObtainScratch[50];
base: RCMap.Base = MimP5U.GetRCMapBase[];
buffer ¬ RCMapEncode.MapToDesc[base, rcMap, buffer];
node ¬ EmitRope[LOOPHOLE[buffer], mesa, typeCache.writer];
RefText.ReleaseScratch[buffer];
};
node ¬ EmitGetTypeIndex[ts, node, typeCache.writer];
uz.FREE[@ts];
};
typeCache.lastType ¬ type;
IF typeVar # NIL THEN
node ¬ IntCodeStuff.GenAssign[typeVar, node, typeVar.bits];
};
RETURN [node];
};

EmitGetTypeIndex: PROC
[ts: TypeStrings.TypeString, rcmap: Node, writer: TargetConversions.Writer]
RETURNS [Node] = {
IF smallStyle OR MimData.switches['k] THEN
WITH rcmap SELECT FROM
wc: REF NodeRep.const.word => IF wc.word = IntCodeDefs.zerosWord THEN
RETURN [InstallCall[name: "GetTypeIndexS",
n1: EmitString[[ts, 0, ts.length], mesa, writer],
bits: Target.bitsPerWord]];
ENDCASE;
RETURN [InstallCall[name: "GetTypeIndex",
n1: EmitString[[ts, 0, ts.length], mesa, writer],
n2: MimP5U.MakeConstInt[0],	-- RRA: eventually need a better description
n3: rcmap,	-- no RC map possible for abstract type
bits: Target.bitsPerWord]];
};

Kind: TYPE = {mesa, c};

EmitName: PROC
[name: Symbols.Name, kind: Kind ¬ mesa, writer: TargetConversions.Writer ¬ NIL]
RETURNS [Node] = {
ss: SymbolOps.SubString ¬ SymbolOps.SubStringForName[SymbolOps.own, name];
RETURN [EmitString[ss, kind, writer]];
};

EmitString: PROC
[ss: SymbolOps.SubString, kind: Kind ¬ mesa, writer: TargetConversions.Writer ¬ NIL]
RETURNS [Node] = {
len: CARDINAL ¬ ss.length;
max: CARDINAL ¬ len;
align: NAT ¬ IF kind = mesa THEN Target.bitsPerWord ELSE Target.bitsPerAU;
IF writer = NIL
THEN writer ¬ TargetConversions.NewWriter[]
ELSE TargetConversions.ResetWriter[writer];
SELECT kind FROM
mesa => {
max ¬ max + (bytesPerWord - max MOD bytesPerWord);
TargetConversions.PutCard[writer, len, Target.bitsPerStringBound];
TargetConversions.PutCard[writer, max, Target.bitsPerStringBound];
};
ENDCASE;
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
TargetConversions.PutChar[writer, ss.base[i]];
ENDLOOP;
TargetConversions.PutCard[writer, 0, Target.bitsPerChar];
THROUGH (len..max) DO
TargetConversions.PutCard[writer, 0, Target.bitsPerChar];
ENDLOOP;
RETURN [MimP5U.Address[z.NEW [NodeRep.const.bytes ¬ [0, const[bytes[
align, TargetConversions.WriterContents[writer]]]]]]];
};

EmitRope: PROC
[rope: ROPE, kind: Kind ¬ mesa, writer: TargetConversions.Writer ¬ NIL]
RETURNS [Node] = {
len: NAT ¬ Rope.Length[rope];
max: CARDINAL ¬ len;
align: NAT ¬ IF kind = mesa THEN Target.bitsPerWord ELSE Target.bitsPerAU;
IF writer = NIL
THEN writer ¬ TargetConversions.NewWriter[]
ELSE TargetConversions.ResetWriter[writer];
SELECT kind FROM
mesa => {
max ¬ max + (bytesPerWord - max MOD bytesPerWord);
TargetConversions.PutCard[writer, len, Target.bitsPerStringBound];
TargetConversions.PutCard[writer, len, Target.bitsPerStringBound];
};
ENDCASE;
FOR i: NAT IN [0..len) DO
TargetConversions.PutChar[writer, Rope.Fetch[rope, i]];
ENDLOOP;
TargetConversions.PutCard[writer, 0, Target.bitsPerChar];
THROUGH (len..max) DO
TargetConversions.PutCard[writer, 0, Target.bitsPerChar];
ENDLOOP;
RETURN [MimP5U.Address[z.NEW [NodeRep.const.bytes ¬ [0, const[bytes[
align, TargetConversions.WriterContents[writer]]]]]]];
};

InstallCall: PROC
[name: ROPE, n1, n2, n3, n4, n5, n6, n7: Node ¬ NIL, bits: INT ¬ 0] RETURNS [Node] = {
oper: Node ¬ NIL;
nl: NodeList ¬ IF n7 = NIL THEN NIL ELSE MimP5U.MakeNodeList[n7];
IF nl # NIL OR n6 # NIL THEN nl ¬ MimP5U.MakeNodeList[n6, nl];
IF nl # NIL OR n5 # NIL THEN nl ¬ MimP5U.MakeNodeList[n5, nl];
IF nl # NIL OR n4 # NIL THEN nl ¬ MimP5U.MakeNodeList[n4, nl];
IF nl # NIL OR n3 # NIL THEN nl ¬ MimP5U.MakeNodeList[n3, nl];
IF nl # NIL OR n2 # NIL THEN nl ¬ MimP5U.MakeNodeList[n2, nl];
IF nl # NIL OR n1 # NIL THEN nl ¬ MimP5U.MakeNodeList[n1, nl];
IF name = NIL THEN ERROR;
FOR i: [0..lagNum) IN [0..lagNum) DO
n: ROPE ¬ lagNames[i];
IF n = name THEN {oper ¬ lagOpers[i]; EXIT};
IF n = NIL OR i = lagNum-1 THEN {
victim: [0..lagNum) ¬ IF n = NIL THEN i ELSE 0;
oper ¬ z.NEW[NodeRep.machineCode ¬
[bits: 0, details: machineCode[Rope.Concat[runtimePrefix, name]]]];
lagNames[victim] ¬ name;
lagOpers[victim] ¬ oper;
EXIT;
};
ENDLOOP;
RETURN [MimP5U.ApplyOp[oper, nl, bits]];
};

END.


κ
MimP5InstallImpl.mesa
Copyright Σ 1987, 1988, 1989, 1990, 1991, 1993 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) June 1, 1991 1:03 pm PDT
Foote, May 19, 1993 9:32 am PDT
Set this TRUE when we have loader support!
RRA: May 21, 1989 2:28:32 pm PDT
Set this TRUE when we have loader support!
Set this TRUE when we have C2C support!
RRA: September 7, 1989 6:46:33 pm PDT
Set this TRUE when we have C2C support!
RRA: September 7, 1989 8:24:58 pm PDT
note: the '_ is actually a '_ with postfix prop: "Modern" family XCPrintFonts
For each type we emit the initialization using the type string and RC map
[item: RefLitItem, type: Symbols.Type, used: BOOL]
Note: perform an initializing counted assignment to the slot in the global frame.
[mdi: Symbols.MDIndex, formal: Symbols.Name, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, sei: Symbols.ISEIndex, link: MobDefs.Link]
This is an imported module
ImportProc[irPtr, index, unitsOut, unitsIn, argCount]
Special case where all constant arguments are < 256 and can be encoded in a single word.  Encoding is the same for ImportProcS and ExportProcS.
[mdi: Symbols.MDIndex, formal: Symbols.Name, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, ts: TypeStrings.TypeString, sei: Symbols.ISEIndex, link: MobDefs.EXPLink]
ExportVar[irPtr, index, addr]
The error or signal value should have been the address of a variable!
ExportProc[irPtr, index, proc, unitsOut, unitsIn, argCount]
Special case where all constant arguments are < 256 and can be encoded in a single word.  Encoding is the same for ExportProcS and ImportProcS.
The ppcr incremental loader can't lookup symbols by value, so to give the runtime a chance to maintain a load state we include the name of the exported procedure in the ExportProc call.  There's staging trickery here to keep from hurting XSoft.  We rely on the fact that none of the currently interesting C compilers complain about a mismatch in the number of arguments to a C procedure.  Then we use a macro in InstallationSupport.h to split uses of ExportProcS into ExportProcS and ExportProcSWithName in code generated by this new code.
ExportType[name, absType, concType]
ExportVar[irPtr, index, val]  {for programs}
First we need to initialize the descriptor bodies for all of the top-level procedures
Now initialize the procedure
typeCache.typeVar _ NewLocalTemp[cl, label];
Emit code to initialize all of the type variables
Emit code to initialize all of the REF literals (should not cause more types)
Now emit the code to declare the global frame
Now emit the code to handle the imports & exports
Create the installation procedure (no descriptor body needed!)
Move the assignment from the initialization procedure to the installation procedure.
Insert the installation procedure into the module
A Mesa string (starts with two copies of the length)
Make all strings zero-terminated
Pad to word boundary (for mesa strings)
A Mesa string (starts with two copies of the length)
Make all strings zero-terminated
Pad to word boundary (for mesa strings)
Κ–
(cedarcode) style•NewlineDelimiter

™
head™Icodešœ
Οe
œO™ZL™,L™L˜š
Οk	˜	Lš
œ˜Lš
œ˜Lš
œ
˜
Lš
œ
˜
Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lšœ
žœ˜Lš
œ	˜	Lš
œ˜Lš
œ
˜
Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ
˜
Lš
œ˜Lš
œ˜Lšœžœ˜Lš
œ˜Lš
œ˜L˜——šΟnœž˜Lšžœ΄
˜»
Lšžœ
˜Lšœž˜L˜šœ
žœžœ
˜™*L™ ——šœžœžœ
˜L™*—šœžœžœ
˜™'L™%——šœžœžœ
˜™'L™%——L˜Lšœ
žœ˜"Lšœ
žœ˜,Lšœžœ˜Lšœ
žœ˜&Lšœ	žœ˜$Lšœ	žœ˜$Lšžœžœžœ
˜šœžœ˜L˜"—Lšœžœ˜L˜Lšœ
žœ˜&Lšœžœ)˜:L˜Lšœžœ˜•	CharProps+

Postfix"Modern" family XCPrintFontsšœžœ	˜L–+

Postfix"Modern" family XCPrintFontsAš
œM™M—Lšœžœ˜šœ
žœžœ
˜"Lš	œžœžœ
žœ
žœ
˜0—šœ
žœžœ
˜"Lšœžœžœ
žœ˜0—L˜Lšœžœžœ
˜#L˜—šŸœžœ
žœžœ;˜gLš
œ$˜$Lšœžœ˜0š
œ(˜(šžœžœ˜Lš
œ4˜4Lšœžœ˜šžœžœ
žœ1˜Všžœ˜LšœCžœ™ILš
œ4˜4Lšœžœ˜š
œ"˜"Lš
œ
˜
Lš
œ!˜!—L˜
—šžœ˜Lš
œ7˜7Lšœžœ˜š
œ"˜"Lš
œ
˜
Lš
œ˜—L˜——Lš
œ˜L˜—L˜—š
œ,˜,Lšœ-žœ
™2šžœžœ˜Lš
œ˜Lš
œ˜šžœžœ
ž˜˜	Lš
œ6˜6Lš
œ/˜/L˜—˜	Lšœžœ
žœ!˜1L˜Lš
œ/˜/L˜—Lšžœžœ
˜—Lš
œQ™Qš
œ#˜#Lš
œ%˜%š
œ˜Lš
œ˜š
œ"˜"Lš
œ+˜+Lš
œ!˜!Lš
œ˜———L˜—L˜—Lšœžœ
˜Lšœž	œ
žœ˜%Lš
œA˜ALšœžœ
žœ˜#Lš
œ$˜$Lš
œ)˜)Lšœžœ
˜Lš
œ/˜/Lš
œ"˜"L˜š
Ÿ	œžœ,žœžœžœ˜TLšœžœ˜šžœž˜šžœžœ
ž˜Lš
œC˜CLšžœžœ
˜——Lšžœ	˜L˜—L˜šŸœžœ ˜:•StartOfExpansion›
 -- [mdi: Symbols.MDIndex, formal: Symbols.ISEIndex, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, sei: Symbols.ISEIndex, offset: Pass4ToPass5.CARD16]š
œ/˜/Lš
œŠ
™Š
Lš
œE˜Ešžœžœ˜Lšœžœ
˜šžœžœ
ž˜ ˜Lš
œ˜Lš
œ-˜-šžœžœ
ž˜Lš
œ6˜6—šžœžœžœ˜Bšžœ˜š
œ"˜"Lš
œ˜š
œ%˜%Lš
œ ˜ Lš
œ)˜)Lš
œ ˜ Lš
œ˜Lš
œ˜——L˜
—šžœ˜š
œ"˜"Lš
œ˜š
œ$˜$Lš
œ ˜ Lš
œ ˜ Lš
œ˜Lš
œ˜——L˜——Lš
œ3˜3L˜—˜L™Lš
œ%˜%Lš
œ9˜9šžœžœžœ˜Bšžœ˜š
œ˜š
œ#˜#Lš
œ ˜ Lš
œ)˜)Lš
œ˜Lš
œ˜Lš
œ˜——L˜
—šžœ˜š
œ˜š
œ"˜"Lš
œ ˜ Lš
œ˜Lš
œ˜Lš
œ˜——L˜——L˜—Lšžœ
˜—L˜L˜—šžœžœ˜Lš
œ6˜6Lš
œ>˜>šžœ
ž˜š
œ	˜	Lš
œ6˜6šžœ
žœ
ž˜šœžœžœ˜$Lš
œ5™5Lšœ
žœ3˜ALšœ	žœ2˜?Lšœžœ˜Lšœžœ˜(Lšžœžœ
žœ
˜šžœ
žœžœžœžœ
žœ˜lšžœ˜Lš
œ
™
Lšœ	žœžœžœ˜[L˜hL˜
—š
ž˜Lš
œΙ
˜Ι
——L˜—Lšžœ
˜—L˜—Lšžœ
˜—L˜—L˜—–±
 -- [mdi: Symbols.MDIndex, formal: Symbols.ISEIndex, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, ts: TypeStrings.TypeString, sei: Symbols.ISEIndex, link: MobDefs.EXPLink]š
œ/˜/Lš
Πck©
™©
Lš
œE˜ELšœžœ˜Lš
œ-˜-šžœžœ˜Lšœžœ
˜šžœžœ
ž˜˜Lš
œ˜Lš
œ2˜2šžœžœ
ž˜Lš
œ6˜6—šžœžœžœ˜Bšžœ˜š
œ"˜"Lš
œ˜š
œ%˜%Lš
œ ˜ Lš
œ)˜)Lš
œ ˜ Lš
œ˜Lš
œ˜——L˜
—šžœ˜š
œ"˜"Lš
œ˜š
œ$˜$Lš
œ ˜ Lš
œ ˜ Lš
œ˜Lš
œ˜——L˜——Lš
œ3˜3L˜—Lšžœ
˜—Lš
œ˜L˜—šžœž˜š
œ˜Lš
œ™Lš
œ6˜6Lšžœžœ
žœ
˜š
œ˜š
œ˜Lš
œ˜Lš
œ
˜
Lš
œ˜——Lš
œ˜—š
œ	˜	Lš
œ6˜6Lš
œ&˜&Lšžœžœ
žœ
˜šžœ
žœ
ž˜š
œ˜šžœ	ž˜˜šžœžœ
ž˜š
œ˜šžœžœ
ž˜š
œ˜šžœžœ
ž˜š
œ˜šžœž˜šžœžœ
ž˜!š
œ
˜
Lš
œ[˜[Lšžœ
˜L˜—Lšžœ
˜———Lšžœ
˜——Lšžœ
˜——Lšžœ
˜—šžœ
˜L™E—L˜—š
œ	˜	Lš
œ;™;Lšœ
žœ3˜ALšœ	žœ2˜?Lšœžœ˜(L˜0šžœ
žœžœžœžœ
žœ˜lšžœ˜Lš
œ
™
Lšœ	žœžœžœ˜[L™›L˜{L˜
—š
ž˜L˜Λ
——Lšžœ
˜L˜—Lšžœžœ
˜——Lšžœžœ
˜—Lš
œ˜—š
œ	˜	Lš
œ#™#Lš
œ0˜0Lš
œ3˜3Lš
œ9˜9š
œ˜š
œ˜Lš
œ	˜	Lš
œ˜Lš
œ˜——Lš
œ˜—˜
Lš
œ,™,Lš
œ&˜&šžœ4ž˜>L˜Lšžœžœ
˜—š
œ˜š
œ˜Lš
œ˜Lš
œ
˜
Lš
œ˜——L˜—Lšžœžœ
˜—L˜—Lš
œ*˜*Lšœ
žœ
˜Lšœžœ
˜Lšœžœ˜Lš
œ*˜*Lš
œ˜Lš
œ*˜*L˜L˜—Lšœ
žœžœ
žœ˜+Lšœ
žœžœ
žœ˜+L˜L™Ušžœ*žœžœ
ž˜@šžœžœ
ž˜˜!šžœžœ
ž˜#šœ"žœžœ
žœ˜?L™Lšœžœ˜3Lšœ2žœ˜8š
œ"˜"Lš
œ/˜/Lšœ-žœ˜6—šžœ
žœž˜!š
œ"˜"Lš
œ9˜9Lš
œ˜——L˜—Lšžœ
˜——Lšžœ
˜—Lšžœ
˜L˜—Lš
œ,™,š
œ˜L˜—Lš
œ1˜1š
œ'˜'L™1—L˜š
œ+˜+L™M—L˜L™-š
œ˜š
œ'˜'Lš
œ˜Lš
œD˜DLš
œ ˜ Lš
œ,˜,——L˜L™1Lš
œ˜L˜˜
L™>Lš
œ(˜(š
Ÿœžœžœžœžœ˜?šžœžœ
ž˜Lšœžœžœžœ˜*šœžœžœ
ž˜)šœžœ˜$šžœ(žœžœ
ž˜>Lš
žœ
žœ!žœ
žœžœ˜;Lšžœ
˜—Lšžœžœ˜L˜—šœžœ˜šžœž˜šžœžœ
ž˜Lšœžœžœžœ˜*Lšžœ
˜———Lšœžœžœžœ˜.Lšžœ
˜—šœžœ˜šžœžœ
ž˜šžœžœ
ž˜šœžœžœžœ
ž˜4šœžœ˜šžœž˜š
œ˜šžœž˜Lšžœ žœžœ˜O——Lš	œžœ žœžœ$žœ˜cLšžœ
˜——Lšžœ
˜—Lšžœ
˜———šœžœžœ
žœ
ž˜8Lšœžœžœžœ˜(Lšžœ
˜—Lšžœ
˜—Lšžœžœ˜L˜—šŸœžœžœžœ˜1š
ž˜šžœžœ
ž˜šœžœžœ
ž˜)Lšœžœžœžœ˜/Lšœžœ*žœ˜;Lšžœ
˜—Lšžœ
˜—Lšžœžœ˜Lšžœ
˜—L˜—šŸœžœžœžœ˜4Lšœžœ˜Lšœžœ˜Lšœžœ
˜š
ž˜šžœžœ
ž˜šœžœžœ
ž˜)Lšœžœ(žœ˜5šœžœ˜!Lš
œ˜Lš
œ˜Lšžœ
˜Lš
œ˜—Lšžœ
˜—Lšžœ
˜—Lšžœ
˜Lšžœ
˜—šžœ&žœžœ
ž˜<Lš
œ˜Lšœžœ˜Lšœžœ
˜š
ž˜šžœžœ
ž˜šœžœžœ
ž˜)šœžœ˜"Lšžœ
žœ
žœžœ˜"Lšžœžœ
žœžœ˜.Lšžœžœ
žœžœ˜.Lšžœžœ˜L˜—šœžœ˜!Lš
œ˜Lš
œ˜Lšžœ
˜Lš
œ˜—Lšžœ
˜—Lšžœ
˜—Lšžœ
˜Lšžœ
˜—Lšžœ
˜—Lšžœžœ˜L˜—šŸœžœžœžœ˜0šžœ"žœžœ
ž˜8šžœžœ
ž˜Lšœ	žœžœ
˜%šœžœ˜Lšžœžœ
žœ
˜"—šœžœ˜Lšžœžœ
žœ
˜!—šœžœ˜šžœžœ'žœžœ˜Pšžœ&žœžœžœ˜kL™TLšœ0žœ˜5Lšžœžœ
žœžœ˜3Lš
œ˜Lš
œ˜L˜—Lš
œ9˜9Lšžœ
˜L˜——Lšžœ
˜—Lšžœžœ˜Lšžœ
˜—Lšžœžœ˜L˜—Lš
œK˜KLšœžœ
˜Lšœžœ
˜Lšœžœ
˜šžœžœ
ž˜#˜!šžœžœ
ž˜#š
œ'˜'Lš
œ˜Lšžœžœ
žœ!˜3L˜—Lšžœžœ
˜——Lšžœžœ
˜—Lš	œžœ,žœžœ)žœ˜Œ
L˜—L˜L™1š
œ#˜#Lšœžœ$˜)Lš
œ˜—L˜Lšœžœ˜Lšœžœ˜L˜L˜—šŸœžœ1žœžœ
˜mLš
œ'˜'šžœžœ
ž˜Lš
œ=˜=Lšžœžœ
˜—Lšžœ˜L˜L˜—Lšœžœžœ˜#šœžœžœ˜Lšœ#žœ
˜'Lš
œ˜Lšœžœ
˜Lšœžœ˜Lšœžœ˜L˜L˜—šŸœžœ$žœ˜DLš
œ$˜$Lš
œ˜šžœžœ˜Lš
œ!˜!Lš
œ(˜(šžœžœ
žœž˜3Lšžœ˜—Lš
œ(˜(˜
Lšœž	œ
žœ˜%Lš
œI˜ILš
œ/˜/šžœžœ˜!Lšœžœ
žœ˜-Lš
œ)˜)Lš
œ4˜4Lšœžœ"˜:Lš
œ˜L˜—Lš
œ4˜4Lšœžœ˜
L˜—Lš
œ˜šžœžœ
ž˜Lš
œ;˜;—L˜—Lšžœ˜L˜L˜—šŸœžœMžœ˜ušžœžœž˜*šžœžœ
ž˜šœžœžœ!ž˜Ešžœ$˜*Lš
œ1˜1Lš
œ˜——Lšžœ
˜——šžœ#˜)š
œ1˜1LšœΟc,˜HLšœ‘'˜2Lš
œ˜——L˜L˜—Lšœžœ
˜L˜šŸœžœKžœžœ˜qLš
œJ˜JLšžœ ˜&L˜L˜—šŸ
œžœPžœžœ˜xLšœžœ
˜Lšœžœ˜Lš	œžœžœ
žœžœ˜Jšžœ
ž˜Lšžœ'˜+Lšžœ'˜+—šžœž˜˜	L™4Lšœ žœ˜2Lš
œB˜BLš
œB˜BL˜—Lšžœ
˜—šžœžœ
žœ"ž˜6Lš
œ.˜.Lšžœ
˜—š
œ9˜9L™ —L™'šžœž˜Lš
œ9˜9Lšžœ
˜—Lšžœžœ_˜{L˜L˜—š
Ÿœžœžœ8žœžœ˜iLšœžœ˜Lšœžœ˜Lš	œžœžœ
žœžœ˜Jšžœ
ž˜Lšžœ'˜+Lšžœ'˜+—šžœž˜˜	L™4Lšœ žœ˜2Lš
œB˜BLš
œB˜BL˜—Lšžœ
˜—šžœžœ
žœ
ž˜Lš
œ7˜7Lšžœ
˜—š
œ9˜9L™ —L™'šžœž˜Lš
œ9˜9Lšžœ
˜—Lšžœžœ_˜{L˜L˜—šŸœžœžœ%žœžœžœ˜hLšœ
žœ
˜Lšœžœžœ
žœ
žœ
žœ˜ALš
žœžœ
žœžœ
žœ"˜>Lš
žœžœ
žœžœ
žœ"˜>Lš
žœžœ
žœžœ
žœ"˜>Lš
žœžœ
žœžœ
žœ"˜>Lš
žœžœ
žœžœ
žœ"˜>Lš
žœžœ
žœžœ
žœ"˜>Lšžœžœ
žœ
žœ
˜šžœžœ
ž˜$Lšœžœ˜Lšžœ
žœžœ˜,šžœžœ
žœžœ˜!Lš	œžœžœ
žœžœ˜/Lšœ	žœZ˜fLš
œ˜Lš
œ˜Lšžœ
˜L˜—Lšžœ
˜—Lšžœ"˜(L˜—L˜Lšžœ
˜L˜L˜—…—LΪtΛ