<<>> <> <> <> <> 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 = { <<[item: RefLitItem, type: Symbols.Type, used: BOOL]>> 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 = { <<[mdi: Symbols.MDIndex, formal: Symbols.Name, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, sei: Symbols.ISEIndex, link: MobDefs.Link]>> 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 = { <<[mdi: Symbols.MDIndex, formal: Symbols.Name, irSei: Symbols.ISEIndex, irType: Symbols.CSEIndex, ts: TypeStrings.TypeString, sei: Symbols.ISEIndex, link: MobDefs.EXPLink]>> 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.