Created by Susan Owicki Last modified on Fri Feb 11 14:16:02 PST 1994 by wobber modified on Wed Jun 9 12:12:32 PDT 1993 by owicki modified on Mon May 17 14:59:50 PDT 1993 by mjordan
MODULE; IMPORT Atom, CodeForType, Fmt, Formatter, RefList, Protocol, AtomRefTbl, StubCode, StubUtils, Text, Type, Value, Wr; IMPORT TextRefTbl AS TextSet; <* FATAL Wr.Failure *> CONST PerfComment = " (* Performance Monitoring *)"; PROCEDURE ModuleStubCode Header (modWr: Formatter.T; <* UNUSED *>t: Type.Object; typeName: Atom.T; objName: Type.Qid; methods: StubCode.MethodList; lastNewMethod: INTEGER; VAR returnCodes: RefList.T; importList: AtomRefTbl.T) = BEGIN Formatter.PutText(modWr, "MODULE " & StubUtils.FileName(typeName) & " EXPORTS " & Atom.ToText(objName.intf) & ", " & StubUtils.FileName(typeName) & ";" & Wr.EOL & Wr.EOL); CodeForType.ProduceImports(modWr, objName, importList); CodeForType.ImportSuperStubs(modWr, methods, lastNewMethod, typeName); IF StubUtils.perfMon THEN Formatter.PutText(modWr, "IMPORT NetObjPerf, PerfUtil;" & PerfComment); Formatter.NewLine(modWr, freshLine := FALSE); END; Formatter.PutText(modWr, "CONST Protocol: StubLib.StubProtocol = " & Fmt.Int(Protocol.version) & ";" & Wr.EOL & Wr.EOL); Formatter.PutText(modWr, "TYPE "); Formatter.Begin(modWr, 1); Formatter.NewLine(modWr, freshLine := FALSE); EnumerateMethods(modWr, methods); Formatter.NewLine(modWr, freshLine := FALSE); EnumerateReturnCodes(modWr, methods, lastNewMethod, returnCodes); Formatter.End(modWr); Formatter.NewLine(modWr); END Header; PROCEDUREEnumerateMethods (modWr: Formatter.T; methods: StubCode.MethodList) = BEGIN Formatter.Begin(modWr, 2); Formatter.PutText(modWr, "Methods = {"); FOR i := LAST(methods^) TO 0 BY -1 DO IF i < LAST(methods^) THEN Formatter.PutText(modWr, ", "); END; Formatter.Break(modWr, type := Formatter.BreakType.NonOptimal); Formatter.PutText(modWr, Atom.ToText(methods[i].name)); END; Formatter.PutText(modWr, "};"); Formatter.End(modWr); END EnumerateMethods; PROCEDUREEnumerateReturnCodes (modWr: Formatter.T; methods: StubCode.MethodList; lastNewMethod: INTEGER; VAR returnList: RefList.T) = VAR returnCodes := NEW(TextSet.Default).init(8); ename: TEXT; BEGIN Formatter.Begin(modWr, 2); Formatter.PutText(modWr, "ReturnCodes = {OK"); FOR i := 0 TO lastNewMethod DO IF methods[i].sig.raises # NIL THEN FOR j := 0 TO LAST(methods[i].sig.raises^) DO ename := QidToText(methods[i].sig.raises[j].qid, "_"); IF NOT returnCodes.put(ename, NIL) AND NOT Text.Equal(ename, "Thread_Alerted") AND NOT Text.Equal(ename, "NetObj_Error") THEN returnList := RefList.Cons(methods[i].sig.raises[j], returnList); Formatter.PutText(modWr, ", "); Formatter.Break(modWr, type := Formatter.BreakType.NonOptimal); Formatter.PutText(modWr, ename); END; END; END; END; Formatter.PutText(modWr, "};" & Wr.EOL); Formatter.End(modWr); END EnumerateReturnCodes; PROCEDUREQidToText (qid: Type.Qid; sep: TEXT): TEXT = BEGIN RETURN Atom.ToText(qid.intf) & sep & Atom.ToText(qid.item); END QidToText; PROCEDURESurrogates (modWr: Formatter.T; t: Type.Object; methods: StubCode.MethodList; lastNewMethod: INTEGER) RAISES {StubUtils.Failure} = VAR procedureName, eName, text: TEXT; BEGIN Formatter.Begin(modWr, 2); FOR i := 0 TO lastNewMethod DO procedureName := "Surrogate_" & Atom.ToText(methods[i].name); Formatter.NewLine(modWr, freshLine := FALSE); CodeForType.ProcHeader(modWr, t, procedureName, methods[i].sig, suffix := "_arg"); PutLine(modWr, " = "); Formatter.Begin(modWr, 2); Formatter.NewLine(modWr, freshLine := FALSE); Formatter.Begin(modWr, 4); PutLine(modWr, "VAR reuse := FALSE;"); PutLine(modWr, "rep: StubLib.DataRep;"); PutLine(modWr, "c: StubLib.Conn;"); PutLine(modWr, "dataPresent: BOOLEAN; <* NOWARN *>");
PutLine(modWr, stubProt: StubLib.StubProtocol;);
IF methods[i].sig.result # NIL THEN
PutLine(modWr, "res: " &
CodeForType.ToText(methods[i].sig.result) & ";");
END;
IF StubUtils.perfMon THEN
PutLine(modWr, "wridx, rdidx: INTEGER;" & PerfComment);
END;
Formatter.End(modWr);
Formatter.NewLine(modWr, freshLine := FALSE);
Formatter.Begin(modWr, 2);
PutLine(modWr, "BEGIN");
Formatter.Begin(modWr, 2);
PutLine(modWr, "TRY");
IF StubUtils.perfMon THEN
PutLine(modWr, "IF NetObjPerf.enabled THEN" & PerfComment);
PutLine(modWr, " NetObjPerf.StartCall(PerfUtil.ThreadId(), " &
Fmt.Int(NUMBER(methods[i].sig.formals^)) & ");");
PutLine(modWr, "END;");
END;
PutLine(modWr, "c := StubLib.StartCall(self, Protocol);");
Formatter.Begin(modWr, 2);
PutLine(modWr, "TRY");
PutLine(modWr, "StubLib.OutInt32(c, ORD(Methods." &
Atom.ToText(methods[i].name) & "));");
IF StubUtils.perfMon THEN
PutLine(modWr, "wridx := Wr.Index(c.wr);" & PerfComment);
END;
FOR j := 0 TO LAST(methods[i].sig.formals^) DO
WITH f = methods[i].sig.formals[j] DO
MarshalTypedVal(modWr, Atom.ToText(f.name) & "_arg",
f.type, Direction.Out, calling := TRUE,
maySuppress := TRUE);
END;
END;
IF StubUtils.perfMon THEN
PutLine(modWr, "wridx := Wr.Index(c.wr) - wridx;" & PerfComment);
END;
PutLine(modWr, "rep := StubLib.AwaitResult(c);");
PutLine(modWr, "CASE StubLib.InInt32(c, rep) OF");
Formatter.Begin(modWr, 2);
PutLine(modWr, "| ORD(ReturnCodes.OK) => ");
IF StubUtils.perfMon THEN
PutLine(modWr, "rdidx := Rd.Index(c.rd);" & PerfComment);
END;
FOR j := 0 TO LAST(methods[i].sig.formals^) DO
WITH f = methods[i].sig.formals[j] DO
IF f.mode = Type.Mode.Var THEN
MarshalTypedVal(modWr, Atom.ToText(f.name) & "_arg",
f.type, Direction.In, calling := FALSE);
END;
END;
END;
IF methods[i].sig.result # NIL THEN
MarshalTypedVal(modWr, "res", methods[i].sig.result, Direction.In,
calling := FALSE);
END;
Formatter.End(modWr);
PutLine(modWr, "reuse := TRUE;");
IF methods[i].sig.raises = NIL THEN
StubUtils.Message("Network object method cannot have RAISES ANY.");
RAISE StubUtils.Failure;
END;
(* A network object method can't have a RAISES ANY clause *)
FOR j := 0 TO LAST(methods[i].sig.raises^) DO
WITH excp = methods[i].sig.raises[j] DO
eName := QidToText(excp.qid, "_");
IF NOT Text.Equal(eName, "Thread_Alerted") AND
NOT Text.Equal(eName, "NetObj_Error") THEN
PutLine(modWr, "| ORD(ReturnCodes." &
eName & ") => ");
IF StubUtils.perfMon THEN
PutLine(modWr, " rdidx := Rd.Index(c.rd);" & PerfComment);
END;
IF excp.arg # NIL THEN
Formatter.Begin(modWr, 2);
PutLine(modWr, " VAR arg: " & CodeForType.ToText(excp.arg)
& ";");
Formatter.Begin(modWr, 2);
PutLine(modWr, "BEGIN");
MarshalTypedVal(modWr, "arg", excp.arg, Direction.In,
calling := FALSE);
text := "(arg)";
ELSE
text := "";
END;
PutLine(modWr, "reuse := TRUE;");
PutLine(modWr, "RAISE " & QidToText(excp.qid, ".") & text & ";");
IF excp.arg # NIL THEN
Formatter.End(modWr);
Formatter.NewLine(modWr);
Formatter.End(modWr);
PutLine(modWr, "END;");
END;
END;
END;
END;
PutLine(modWr, "ELSE");
IF StubUtils.perfMon THEN
PutLine(modWr, " rdidx := Rd.Index(c.rd);" & PerfComment);
END;
PutLine(modWr, " StubLib.RaiseUnmarshalFailure();");
Formatter.PutText(modWr, "END");
Formatter.End(modWr);
Formatter.NewLine(modWr, freshLine := FALSE);
PutLine(modWr, "FINALLY");
IF StubUtils.perfMon THEN
PutLine(modWr, " rdidx := Rd.Index(c.rd) - rdidx;" & PerfComment);
END;
PutLine(modWr, " StubLib.EndCall(c, reuse);");
IF StubUtils.perfMon THEN
PutLine(modWr, " IF NetObjPerf.enabled THEN" & PerfComment);
PutLine(modWr, " NetObjPerf.EndCall(PerfUtil.ThreadId(), " &
"wridx, rdidx);");
PutLine(modWr, " END;");
END;
PutLine(modWr, "END;");
Formatter.End(modWr);
Formatter.NewLine(modWr);
PutLine(modWr, "EXCEPT");
PutLine(modWr,
"| Rd.Failure(ec) => StubLib.RaiseCommFailure(ec);");
PutLine(modWr,
"| Wr.Failure(ec) => StubLib.RaiseCommFailure(ec);");
Formatter.PutText(modWr, "END;");
IF methods[i].sig.result # NIL THEN
Formatter.NewLine(modWr, freshLine := FALSE);
Formatter.PutText(modWr, "RETURN res;");
END;
Formatter.End(modWr);
Formatter.NewLine(modWr, freshLine := FALSE);
Formatter.PutText(modWr, "END " & procedureName & ";");
Formatter.End(modWr);
Formatter.NewLine(modWr, freshLine := FALSE);
END;
Formatter.End(modWr);
END Surrogates;
PROCEDURE Dispatcher (modWr: Formatter.T;
t: Type.Object;
typeName: Atom.T;
methods: StubCode.MethodList;
returnCodes: RefList.T) RAISES {StubUtils.Failure} =
VAR e: Type.Exception;
ename: TEXT;
l: RefList.T;
BEGIN
Formatter.PutText(modWr, Wr.EOL & "PROCEDURE Invoke(");
Formatter.PutText(modWr, Wr.EOL & " c: StubLib.Conn;");
Formatter.PutText(modWr, Wr.EOL & " obj: NetObj.T;");
Formatter.PutText(modWr, Wr.EOL & " rep: StubLib.DataRep;");
Formatter.PutText(modWr, Wr.EOL & " stubProt: StubLib.StubProtocol)");
Formatter.PutText(modWr, Wr.EOL & " RAISES {NetObj.Error, Rd.Failure,");
Formatter.PutText(modWr, Wr.EOL & " Wr.Failure, Thread.Alerted} =");
Formatter.PutText(modWr, Wr.EOL & " VAR t := NARROW(obj, " &
CodeForType.ToText(t) & ");");
Formatter.PutText(modWr, Wr.EOL & " BEGIN");
Formatter.PutText(modWr, Wr.EOL & " IF stubProt # Protocol" &
" THEN StubLib.RaiseUnmarshalFailure() END;");
Formatter.PutText(modWr, Wr.EOL & " TRY");
Formatter.Begin(modWr, -1);
Formatter.PutText(modWr, Wr.EOL & " CASE StubLib.InInt32(c, rep) OF");
FOR i := FIRST(methods^) TO LAST(methods^) DO
Formatter.NewLine(modWr, freshLine := FALSE);
Formatter.PutText(modWr,"| ORD(Methods." & Atom.ToText(methods[i].name) &
") => ");
IF methods[i].intf # typeName THEN
Formatter.PutText(modWr, Atom.ToText(methods[i].intf) & ".");
END;
Formatter.PutText(modWr, "Stub_" &
Atom.ToText(methods[i].name) & "(t, c, rep);");
END;
Formatter.End(modWr);
Formatter.PutText(modWr, Wr.EOL & " ELSE");
Formatter.PutText(modWr, Wr.EOL & " StubLib.RaiseUnmarshalFailure();");
Formatter.PutText(modWr, Wr.EOL & " END;");
Formatter.PutText(modWr, Wr.EOL & " EXCEPT");
l := returnCodes;
IF l = NIL THEN
PutLine(modWr, "");
END;
WHILE l # NIL DO
e := NARROW(l.head, Type.Exception);
l := l.tail;
ename := QidToText(e.qid, "_");
Formatter.PutText(modWr, Wr.EOL & " | " & QidToText(e.qid, ".") );
IF e.arg # NIL THEN
Formatter.PutText(modWr, "(arg)");
END;
Formatter.PutText(modWr, " => ");
Formatter.PutText(modWr, Wr.EOL & " StubLib.StartResult(c);");
Formatter.PutText(modWr,
Wr.EOL & " StubLib.OutInt32(c, ORD(ReturnCodes."
& ename & "));");
IF e.arg # NIL THEN
Formatter.PutText(modWr, Wr.EOL & " ");
MarshalTypedVal(modWr, "arg", e.arg, Direction.Out, calling := FALSE);
ELSE
PutLine(modWr, "");
END
END;
Formatter.PutText(modWr, " END;");
Formatter.PutText(modWr, Wr.EOL & " END Invoke;" & Wr.EOL & Wr.EOL);
END Dispatcher;
PROCEDURE OwnerStubs (modWr: Formatter.T;
t: Type.Object;
methods: StubCode.MethodList;
lastNewMethod: INTEGER) RAISES {StubUtils.Failure} =
VAR varType: Type.T;
BEGIN
FOR i := 0 TO lastNewMethod DO
CodeForType.ProcHeader(modWr, t,
"Stub_" & Atom.ToText(methods[i].name),
StubCode.SigForStub(methods[i].sig),
StubCode.PragmasForStub());
Formatter.PutText(modWr, "=" & Wr.EOL);
WITH sig = methods[i].sig DO
IF NUMBER(sig.formals^) > 0 OR sig.result # NIL THEN
Formatter.Begin(modWr, 6);
Formatter.PutText(modWr, " VAR ");
FOR j := 0 TO LAST(sig.formals^) DO
WITH f = sig.formals[j] DO
TYPECASE f.type OF
| Type.OpenArray (oa) => varType := oa.refArray
ELSE varType := f.type;
END;
PutLine(modWr, Atom.ToText(f.name) & "_arg: " &
CodeForType.ToText(varType) & ";");
END;
END;
IF sig.result # NIL THEN
PutLine(modWr, "res: " & CodeForType.ToText(sig.result) & ";");
END;
PutLine(modWr, "dataPresent: BOOLEAN <* NOWARN *>;");
Formatter.End(modWr);
END;
Formatter.NewLine(modWr);
Formatter.Begin(modWr, 4);
PutLine(modWr, " BEGIN");
FOR j := 0 TO LAST(sig.formals^) DO
WITH f = sig.formals[j] DO
MarshalTypedVal(modWr, Atom.ToText(f.name) & "_arg",
f.type, Direction.In, calling := TRUE, maySuppress := TRUE);
END;
END;
IF sig.result # NIL THEN
Formatter.PutText(modWr, "res := ");
END;
Formatter.PutText(modWr, "self." &
Atom.ToText(methods[i].name) &"(");
FOR j := 0 TO LAST(methods[i].sig.formals^) DO
IF j > 0 THEN
Formatter.PutText(modWr, ", ");
END;
Formatter.PutText(modWr,
Atom.ToText(methods[i].sig.formals[j].name) & "_arg");
TYPECASE methods[i].sig.formals[j].type OF
| Type.OpenArray =>
Formatter.PutText(modWr, "^");
ELSE
END;
END;
PutLine(modWr, ");");
PutLine(modWr, "StubLib.StartResult(c);");
PutLine(modWr,
"StubLib.OutInt32(c, ORD(ReturnCodes.OK));");
FOR j := 0 TO LAST(sig.formals^) DO
WITH f = sig.formals[j] DO
IF f.mode = Type.Mode.Var THEN
MarshalTypedVal(modWr, Atom.ToText(f.name) & "_arg",
f.type, Direction.Out, calling := FALSE);
END;
END;
END;
IF sig.result # NIL THEN
MarshalTypedVal(modWr, "res", sig.result, Direction.Out,
calling := FALSE);
END;
Formatter.End(modWr); Formatter.NewLine(modWr);
Formatter.PutText(modWr, " END " & "Stub_" &
Atom.ToText(methods[i].name) & ";" & Wr.EOL & Wr.EOL);
END;
END;
END OwnerStubs;
TYPE Direction = {In, Out};
PROCEDURE MarshalTypedVal (fmtWr: Formatter.T;
varName: TEXT;
t: Type.T;
d: Direction;
calling: BOOLEAN;
indexDepth := 0;
maySuppress := FALSE) RAISES {StubUtils.Failure} =
BEGIN
TYPECASE t OF
| Type.Char (ch) =>
Enumeration(fmtWr, varName, ch, d, 0,
ORD(LAST(CHAR)));
| Type.WideChar (wch) =>
Enumeration(fmtWr, varName, wch, d, 0, ORD(LAST(WIDECHAR)));
| Type.UserDefined (ud) =>
Enumeration(fmtWr, varName, t, d, 0, LAST(ud.elts^));
| Type.Subrange (sub) =>
IF t = Type.integer THEN
StubLibCall(fmtWr, "Integer", varName, d);
ELSIF t = Type.longint THEN
StubLibCall(fmtWr, "Longint", varName, d);
ELSE
SubRange(fmtWr, varName, t, d, sub.min, sub.max);
END;
| Type.Real =>
StubLibCall(fmtWr, "Real", varName, d);
| Type.LongReal =>
StubLibCall(fmtWr, "Longreal", varName, d);
| Type.Extended =>
StubLibCall(fmtWr, "Extended", varName, d);
| Type.Reference (r) =>
IF Type.MayBeRefAny(r) OR NOT Type.NamedType(r) THEN
StubLibCall(fmtWr, "Ref", varName, d, ", -1");
ELSE
StubLibCall(fmtWr, "Ref", varName, d,
", TYPECODE(" & CodeForType.ToText(r) & ")");
END;
| Type.Array (a) =>
IF a.index = NIL THEN
MarshalOpenArray(fmtWr, varName, t, d, calling, indexDepth,
maySuppress);
ELSE
BeginOutOnly(fmtWr, t, d, maySuppress);
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "FOR i" & Fmt.Int(indexDepth) & " := FIRST(" &
CodeForType.ToText(a.index) &
") TO LAST(" & CodeForType.ToText(a.index) &
") DO");
MarshalTypedVal(fmtWr, varName & "[i" & Fmt.Int(indexDepth) &
"]", a.element, d, calling, indexDepth+1);
Formatter.End(fmtWr);
PutLine(fmtWr, "END;");
EndOutOnly(fmtWr, maySuppress);
END;
| Type.Packed (p) =>
BeginOutOnly(fmtWr, t, d, maySuppress);
MarshalTypedVal(fmtWr, varName, p.base, d, calling, indexDepth);
EndOutOnly(fmtWr, maySuppress);
| Type.Record (rec) =>
BeginOutOnly(fmtWr, t, d, maySuppress);
FOR i := 0 TO LAST(rec.fields^) DO
MarshalTypedVal(fmtWr,
varName & "." & Atom.ToText(rec.fields[i].name),
rec.fields[i].type, d, calling, indexDepth);
END;
EndOutOnly(fmtWr, maySuppress);
| Type.Set (s) =>
BeginOutOnly(fmtWr, t, d, maySuppress);
IF d = Direction.In THEN
PutLine(fmtWr, varName & ":=" & CodeForType.ToText(s) & "{};");
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "FOR i" & Fmt.Int(indexDepth) & " := FIRST("
& CodeForType.ToText(s.range) &
") TO LAST(" & CodeForType.ToText(s.range) &
") DO");
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "IF StubLib.InBoolean(c) THEN");
PutLine(fmtWr, varName & " := " & varName & " + " &
CodeForType.ToText(s) & "{i" & Fmt.Int(indexDepth) & "};");
Formatter.End(fmtWr);
PutLine(fmtWr, "END")
ELSE
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "FOR i" & Fmt.Int(indexDepth) & " := FIRST(" &
CodeForType.ToText(s.range) &
") TO LAST(" & CodeForType.ToText(s.range) &
") DO");
PutLine(fmtWr, "StubLib.OutBoolean(c, i" & Fmt.Int(indexDepth) &
" IN " & varName & ");");
END;
Formatter.End(fmtWr);
PutLine(fmtWr, "END;");
EndOutOnly(fmtWr, maySuppress);
| Type.Procedure =>
StubUtils.Message("Can't have a procedure as argument or result " &
"of a network object method.");
RAISE StubUtils.Failure;
ELSE StubUtils.Die("ModuleStubCode.MarshalTypedVal: attempt to marshal unsupported type");
END;
END MarshalTypedVal;
PROCEDURE SubRange (fmtWr: Formatter.T;
varName: TEXT;
t: Type.Subrange;
d: Direction;
min, max: Value.T) =
BEGIN
IF t = Type.longint OR t.base = Type.longint THEN
WITH min = NARROW(min, Value.Longint).val,
max = NARROW(max, Value.Longint).val DO
StubLibCall(fmtWr, "Longint", varName, d,
", " & Fmt.LongInt(min) & ", " & Fmt.LongInt(max));
END;
ELSIF t = Type.integer OR t.base = Type.integer THEN
WITH min = NARROW(min, Value.Integer).val,
max = NARROW(max, Value.Integer).val DO
StubLibCall(fmtWr, "Integer", varName, d,
", " & Fmt.Int(min) & ", " & Fmt.Int(max));
END;
ELSE
TYPECASE t.base OF
| Type.Enumeration =>
WITH min = NARROW(min, Value.Integer).val,
max = NARROW(max, Value.Integer).val DO
Enumeration(fmtWr, varName, t.base, d, min, max);
END;
| Type.Subrange => SubRange(fmtWr, varName, t.base, d, min, max);
ELSE StubUtils.Die("ModuleStubCode.SubRange: unsupported subrange type");
END;
END;
END SubRange;
PROCEDURE Enumeration (fmtWr: Formatter.T;
varName: TEXT;
t: Type.Enumeration;
d: Direction;
min, max: INTEGER) =
BEGIN
IF d = Direction.In THEN
PutLine(fmtWr, varName & " := VAL(StubLib.InInteger(c, rep, "
& Fmt.Int(min) & "," & Fmt.Int(max) & "), "
& CodeForType.ToText(t) &");");
ELSE
PutLine(fmtWr, "StubLib.OutInteger(c, ORD(" & varName &"));");
END;
END Enumeration;
PROCEDURE PutLine (fmtWr: Formatter.T; text: TEXT) =
BEGIN
Formatter.PutText(fmtWr, text);
Formatter.NewLine(fmtWr, freshLine := FALSE);
END PutLine;
PROCEDURE StubLibCall (fmtWr: Formatter.T;
proc: TEXT;
varName: TEXT;
d: Direction;
extra := "") =
BEGIN
IF d = Direction.In THEN
PutLine(fmtWr, varName & " := StubLib.In" & proc & "(c, rep"
& extra & ");");
ELSE
PutLine(fmtWr, "StubLib.Out" & proc & "(c, " & varName & ");");
END;
END StubLibCall;
PROCEDURE StubLibCallNoRep (fmtWr: Formatter.T;
proc: TEXT;
varName: TEXT;
d: Direction;
extra := "") =
BEGIN
IF d = Direction.In THEN
PutLine(fmtWr, varName & " := StubLib.In" & proc & "(c"
& extra & ");");
ELSE
PutLine(fmtWr, "StubLib.Out" & proc & "(c, " & varName & ");");
END;
END StubLibCallNoRep;
PROCEDURE BeginOutOnly (fmtWr: Formatter.T;
<*UNUSED*> t: Type.T;
d: Direction;
maySuppress: BOOLEAN) =
VAR dataPresent:= TRUE; (* Could check for size *)
(* When recognizing pragma, dataPresent determined by
methods[i].formals[j].outOnly *)
BEGIN
IF maySuppress THEN
IF d = Direction.Out THEN
PutLine(fmtWr, "dataPresent := " & Fmt.Bool(dataPresent) &";" );
END;
StubLibCallNoRep(fmtWr, "Boolean", "dataPresent", d);
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "IF dataPresent THEN ");
END;
END BeginOutOnly;
PROCEDURE EndOutOnly (fmtWr: Formatter.T; maySuppress: BOOLEAN) =
BEGIN
IF maySuppress THEN
PutLine(fmtWr, "END;");
Formatter.End(fmtWr);
END;
END EndOutOnly;
PROCEDURE MarshalOpenArray (fmtWr: Formatter.T;
varName: TEXT;
a: Type.OpenArray;
d: Direction;
calling: BOOLEAN;
indexDepth: INTEGER;
maySuppress: BOOLEAN) RAISES {StubUtils.Failure} =
VAR nDimensions:= a.openDimensions;
aName, baseName, boundList: Text.T;
component: Type.T;
BEGIN
IF calling THEN (* Must marshal/unmarshal array bounds *)
IF d = Direction.Out THEN
StubLibCall(fmtWr, "Integer", "NUMBER(" & varName & ")",d);
aName := varName & "[0";
FOR i := 2 TO nDimensions DO
StubLibCall(fmtWr, "Integer", "NUMBER(" & aName & "])",d);
aName := aName & ", 0";
END;
baseName := varName;
ELSE
Formatter.PutText(fmtWr, "WITH n1 = StubLib.InInteger(c, rep)");
boundList := "n1";
FOR i := 2 TO nDimensions DO
PutLine(fmtWr, ",");
Formatter.PutText(fmtWr, " n" & Fmt.Int(i) &
" = StubLib.InInteger(c, rep)");
boundList := boundList & ", n" & Fmt.Int(i);
END;
PutLine(fmtWr, " DO");
PutLine(fmtWr, " " & varName & " := NEW(" &
CodeForType.ToText(a.refArray) & ", " & boundList & ");");
PutLine(fmtWr, "END;");
baseName := varName & "^";
END;
ELSE
IF d = Direction.Out THEN
baseName := varName & "^";
ELSE
baseName := varName;
END;
END;
(* Suppress actual data for <*OUTPUT*> params on call *)
BeginOutOnly(fmtWr, a, d, maySuppress);
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "FOR n1 := 0 TO LAST(" & baseName & ") DO" );
aName := varName & "[n1";
component := a.element;
FOR i := 2 TO nDimensions DO
Formatter.Begin(fmtWr, 2);
PutLine(fmtWr, "FOR n" & Fmt.Int(i) & " := 0 TO LAST(" & aName
& "]) DO");
aName := aName & ", n" & Fmt.Int(i);
component := NARROW(component, Type.OpenArray).element;
END;
MarshalTypedVal(fmtWr, aName & "]", component, d, calling, indexDepth);
FOR i := 1 TO nDimensions DO
Formatter.End(fmtWr);
PutLine(fmtWr, "END;"); (* End FOR Loop *)
END;
EndOutOnly(fmtWr, maySuppress);
END MarshalOpenArray;
BEGIN
END ModuleStubCode.