MODULE SOxModuleSOCode;

IMPORT SOxCodeUtils, SOxCoder, Formatter, ImportList, SOxCodeGenError,
       Type, SOxCodeFiles, Wr, CodeForType, Atom, AtomList,
       AtomListFuncs, Text, Value, Fmt, StubCode;

REVEAL
  T = SOxCoder.T BRANDED OBJECT
        initializers:= "";
      OVERRIDES
        InitImports := initImports;
        Import      := import;
        Head        := head;
        Decls       := decls;
        Main        := main;
        Bottom      := bottom;
      END;

<* FATAL Wr.Failure*>

PROCEDURE PutLine (fmtWr: Formatter.T; text: TEXT) =
  BEGIN
    Formatter.PutText(fmtWr, text);
    Formatter.NewLine(fmtWr, freshLine := FALSE);
  END PutLine;

PROCEDURE EndLine (fmtWr: Formatter.T; text: TEXT) =
  BEGIN
    Formatter.PutText(fmtWr, text);
    Formatter.End(fmtWr);
    Formatter.NewLine(fmtWr, freshLine := FALSE);
  END EndLine;

VAR
  extraImports := ARRAY [1 .. 16] OF
                    Atom.T{
                    Atom.FromText("SharedObj"),
                    Atom.FromText("SharedObjRep"),
                    Atom.FromText("SharedObjStubLib"),
                    Atom.FromText("WeakRef"),
                    Atom.FromText("EventStubLib"),
                    Atom.FromText("EventProtocol"), Atom.FromText("Rd"),
                    Atom.FromText("Wr"), Atom.FromText("SharedObjError"),
                    Atom.FromText("ThreadF"), Atom.FromText("Thread"),
                    Atom.FromText("Event"),
                    Atom.FromText("Pickle2 AS Pickle"),
                    Atom.FromText("EmbProxiedObj"),
                    Atom.FromText("PickleStubs"),
                    Atom.FromText("ObjectSpace")

Atom.FromText(Time), Atom.FromText(Fmt), Atom.FromText(IO)

                    };
PROCEDURE initImports (<*UNUSED*> self    : T;
                                  basename: TEXT;
                                  imports : ImportList.T) =
  VAR
    imp := ARRAY [1 .. 1] OF
             Atom.T{Atom.FromText(SOxCodeUtils.FileName(
                                    basename, SOxCodeFiles.T.CB_I3))};
  BEGIN
    CodeForType.AugmentImportList(imports, extraImports);
    CodeForType.AugmentImportList(imports, imp);
  END initImports;

PROCEDURE import (<*UNUSED*> self    : T;
                             type    : Type.Object;
                             methods : ImportList.MethodList;
                             umethods: AtomList.T;
                             imports : ImportList.T           ) =
  BEGIN
    (* CodeForType.ImportLst(type, imports, methods, umethods); *)
    CodeForType.ImportSOLst(type, imports, methods, umethods);
  END import;

PROCEDURE head (self    : T;
                wr      : Formatter.T;
                fname   : TEXT;
                basename: TEXT;
                imports : ImportList.T ) =
  BEGIN
    WITH Put = Formatter.PutText,
         Tab = Formatter.Begin,
         Nl  = Formatter.NewLine  DO
      SOxCodeUtils.HeaderComment(wr, fname);
      self.basename := basename;
      self.fbasename :=
        SOxCodeUtils.FileName(basename, SOxCodeFiles.T.SO_M3);

      Put(wr, "MODULE " & self.fbasename & " EXPORTS ");
      Tab(wr, 0);
      PutLine(wr, SOxCodeUtils.FileName(basename,
                                        SOxCodeFiles.T.PKL_I3) & ", ");
      EndLine(wr, self.basename & ", " & SOxCodeUtils.FileName(
                                           basename, SOxCodeFiles.T.PRX_I3)
                    & ";");

      CodeForType.ProduceImports(wr, imports);

      Nl(wr, freshLine := FALSE);
      PutLine(wr, "CONST SharedObj_Protocol: EventProtocol.StubProtocol = 1;");

      PutLine(wr, "EXCEPTION DuplicateSpecial;");
      Nl(wr, freshLine := TRUE);
    END;
  END head;

PROCEDURE decls (           self    : T;
                            wr      : Formatter.T;
                            typeID  : Type.Qid;
                            stypeID : Type.Qid;
                 <*UNUSED*> implName: TEXT;
                            methods : ImportList.MethodList;
                            umethods: AtomList.T             ) =
  VAR
    typTxt               : TEXT;
    identfTxt, identfsTxt: TEXT;
    meth                 : Atom.T;
    firstMeth            : BOOLEAN;
  BEGIN
    WITH Put    = Formatter.PutText,
         Nl     = Formatter.NewLine,
         Tab    = Formatter.Begin,
         Br     = Formatter.Break,
         Grp    = Formatter.Group,
         EndTab = Formatter.End      DO
      typTxt := CodeForType.QidToText(typeID);
      identfTxt := CodeForType.QidToIdentf(typeID);
      identfsTxt := CodeForType.QidToIdentf(stypeID);

      Put(wr, "TYPE " & identfTxt & "_SOMethods = {");
      Tab(wr, 0);
      firstMeth := TRUE;
      FOR i := 0 TO LAST(methods^) DO
        meth := methods[i].name;
        IF AtomList.Member(umethods, meth) THEN
          IF firstMeth THEN
            firstMeth := FALSE
          ELSE
            Put(wr, ", ");
            Br(wr);
          END;
          Put(wr, Atom.ToText(meth));
        END;
      END;
      EndLine(wr, "};");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      Put(wr, "REVEAL");

      Nl(wr, freshLine := FALSE);
      PutLine(wr, identfTxt & " = " & identfsTxt & " BRANDED \"Shared"
                    & " " & self.basename & "." & identfTxt &
                    " v1.0\" OBJECT");

      Tab(wr, 2);
      PutLine(wr, "OVERRIDES");

      IF SOxCodeUtils.genProxyCode THEN
        PutLine(wr, "makeProxy := MakeProxy_" & identfTxt & ";");
      END;
      PutLine(wr, "applyUpdate := ApplyUpdate_" & identfTxt & ";");
      FOR i := 0 TO LAST(methods^) DO
        meth := methods[i].name;
        Nl(wr, freshLine := FALSE);
        Grp(wr);
        Put(wr, Atom.ToText(meth) & " := ");
        Put(wr, "Shared_" & Atom.ToText(meth) & "_" & identfTxt & ";");
        EndTab(wr);
      END;
      EndTab(wr);
      Nl(wr, freshLine := FALSE);
      PutLine(wr, "END;");

      EndTab(wr);
      Nl(wr, freshLine := FALSE);
    END;
  END decls;

PROCEDURE main (           self    : T;
                           wr      : Formatter.T;
                           typeID  : Type.Qid;
                           type    : Type.Object;
                           stypeID : Type.Qid;
                <*UNUSED*> implName: TEXT;
                           methods : ImportList.MethodList;
                           umethods: AtomList.T             )
  RAISES {SOxCodeGenError.E} =
  VAR
    methTxt, typTxt      : TEXT;
    identfTxt, identfsTxt: TEXT;
    meth                 : Atom.T;
    exceptions           : AtomList.T := NIL;
    SOexports := AtomList.List2(Atom.FromText(self.basename),
                                Atom.FromText(SOxCodeUtils.FileName(
                                                  self.basename,
                                                  SOxCodeFiles.T.PRX_I3)));
  BEGIN
    WITH Put    = Formatter.PutText,
         Br     = Formatter.Break,
         Nl     = Formatter.NewLine,
         Tab    = Formatter.Begin,
         EndTab = Formatter.End      DO
      typTxt := CodeForType.QidToText(typeID);
      identfTxt := CodeForType.QidToIdentf(typeID);
      identfsTxt := CodeForType.QidToIdentf(stypeID);

      FOR i := 0 TO LAST(methods^) DO
        IF AtomList.Member(umethods, methods[i].name) THEN
          CodeForType.AugmentExceptionList(exceptions,
                                           methods[i].sig.raises, SOexports);
        END;
      END;

      IF SOxCodeUtils.genProxyCode THEN
        Tab(wr, 2);
        PutLine(wr, "PROCEDURE MakeProxy_" & identfTxt &
          " (self: " & identfTxt & ") =");
        Tab(wr, 2);
        PutLine(wr, "BEGIN");
        Tab(wr, 2);
        PutLine(wr, "IF MkProxy" & identfTxt & " # NIL THEN");
        EndLine(wr, "MkProxy" & identfTxt & "(self);");
        EndLine(wr, "END;");
        EndLine(wr, "END MakeProxy_" & identfTxt & ";");
      END;
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      Put(wr, "PROCEDURE ApplyUpdate_" & identfTxt & " (");
      Tab(wr, 0);
      Put(wr, "self: " & identfTxt & "; ");
      Br(wr);
      Put(wr, "ev: Event.T; ");
      Br(wr);
      Put(wr, "h: EventStubLib.Handle) ");
      EndTab(wr);
      Br(wr);
      Put(wr, "RAISES {");
      Tab(wr, 0);
      Put(wr, "SharedObj.Error, ");
      EVAL AtomListFuncs.DeleteD(exceptions, Atom.FromText("SharedObj.Error"));
      Br(wr);
      IF AtomListFuncs.DeleteD(exceptions,
                               Atom.FromText("SharedObj.Fatal")) # NIL THEN
        Put(wr, "SharedObj.Fatal, ");
        Br(wr);
      END;
      Put(wr, "Event.Error, ");
      Br(wr);
      Put(wr, "Rd.Failure, ");
      Br(wr);
      EndLine(wr, "Thread.Alerted} =");

      Tab(wr, 2);
      PutLine(wr, "BEGIN");

      Tab(wr, 2);
      PutLine(wr, "IF ev.prot # SharedObj_Protocol THEN");
      EndLine(wr, "EventStubLib.RaiseUnmarshalFailure();");
      PutLine(wr, "END;");
      Tab(wr, 2);
      PutLine(wr, "WITH meth = SharedObjStubLib.InInt32(h) DO");
      Tab(wr, 2);

      IF exceptions # NIL THEN
        PutLine(wr, "TRY");
        Tab(wr, 2);
      END;
      PutLine(wr, "TRY");
      PutLine(wr, "SharedObjStubLib.AcquireWriteLock(self);");
      PutLine(wr, "self.updating := ThreadF.MyId();");
      PutLine(wr, "CASE meth OF");

      FOR i := 0 TO LAST(methods^) DO
        meth := methods[i].name;
        methTxt := Atom.ToText(meth);
        IF AtomList.Member(umethods, meth) THEN
          Put(wr, "| ");
          Tab(wr, 0);
          Put(wr, "ORD(" & identfTxt & "_SOMethods." & methTxt & ") => ");
          Br(wr);
          EndLine(wr, "Stub_" & methTxt & "_" & identfTxt & "(self, h);");
        END;
      END;
      Tab(wr, 2);
      PutLine(wr, "ELSE");
      EndLine(wr, "EventStubLib.RaiseUnmarshalFailure();");
      EndLine(wr, "END;");
      Tab(wr, 2);
      PutLine(wr, "FINALLY");
      PutLine(wr, "self.updating := -1;");
      EndLine(wr, "SharedObjStubLib.ReleaseWriteLock(self);");
      EndLine(wr, "END;");
      IF exceptions # NIL THEN
        Tab(wr, 2);
        Put(wr, "EXCEPT ");
        Br(wr);
        WHILE exceptions # NIL DO
          Put(wr, Atom.ToText(exceptions.head));
          IF exceptions.tail # NIL THEN
            Put(wr, ", ");
          END;
          Br(wr);
          exceptions := exceptions.tail;
        END;
        Put(wr, "=> ");
        Br(wr);
        EndLine(wr, "(* ignore these exceptions quietly *)");
        EndLine(wr, "END;");
      END;
      EndLine(wr, "END;");
      EndLine(wr, "END ApplyUpdate_" & identfTxt & ";");

      Nl(wr, freshLine := FALSE);
      Surrogates(self, wr, type, identfTxt, identfsTxt, methods, umethods);
      Stubs(self, wr, type, identfTxt, identfsTxt, methods, umethods);
      Callbacks(self, wr, type, identfTxt, identfsTxt, methods, umethods);
      Picklers(self, wr, type, identfTxt, identfsTxt);
    END;
  END main;

PROCEDURE bottom (self: T; wr: Formatter.T; <*UNUSED*> fname: TEXT) =
  BEGIN
    WITH Put    = Formatter.PutText,
         Nl = Formatter.NewLine DO
      Nl(wr, freshLine := FALSE);
      PutLine(wr, "BEGIN");
      Put(wr, self.initializers);
      PutLine(wr, "END " & self.fbasename & ".");
    END;
  END bottom;

TYPE Direction = {In, Out};

PROCEDURE PrintStubArgs (wr : Formatter.T;
                         sig: Type.Signature;
                         dir: Direction       ) =
  BEGIN
    FOR j := 0 TO LAST(sig.formals^) DO
      Formatter.PutText(wr, ", ");
      Formatter.Break(wr);
      Formatter.PutText(wr, Atom.ToText(sig.formals[j].name) & "_arg");
      IF dir = Direction.In THEN
        TYPECASE sig.formals[j].type OF
        | Type.OpenArray => Formatter.PutText(wr, "^");
        ELSE
        END;
      END;
    END;
  END PrintStubArgs;

PROCEDURE Surrogates (self: T;
                      wr      : Formatter.T;
                      t       : Type.Object;
                      identfTxt, identfsTxt: TEXT;
                      methods : ImportList.MethodList;
                      umethods: AtomList.T           )
  RAISES {SOxCodeGenError.E} =
  VAR
    procedureName: TEXT;
    uMeth                     : BOOLEAN;
    methTxt      : TEXT;
    meth                 : Atom.T;
    SOexports := AtomList.List2(Atom.FromText(self.basename),
                                Atom.FromText(SOxCodeUtils.FileName(
                                                  self.basename,
                                                  SOxCodeFiles.T.PRX_I3)));
  BEGIN
    WITH Put    = Formatter.PutText,
         Nl     = Formatter.NewLine,
         Tab    = Formatter.Begin,
         EndTab = Formatter.End      DO
      FOR i := 0 TO LAST(methods^) DO
        meth := methods[i].name;
        methTxt := Atom.ToText(meth);

        uMeth := AtomList.Member(umethods, meth);
        procedureName := "Shared_" & Atom.ToText(methods[i].name) &
                             "_" & identfTxt;

        Tab(wr, 2);
        CodeForType.ProcHeader(wr, t, procedureName, methods[i].sig,
                               suffix := "_arg", exports := SOexports);
        PutLine(wr, " = ");

        IF uMeth THEN
          Tab(wr, 4);
          PutLine(wr, "VAR out: SharedObjStubLib.Handle;");
          PutLine(wr, "id := ThreadF.MyId();");
          EndLine(wr, "dataPresent: BOOLEAN; <* NOWARN *>");
          (* PutLine(wr, "stubProt: StubLib.StubProtocol;"); *)

IF methods[i].sig.result # NIL THEN PutLine(wr, res: & CodeForType.ToText(methods[i].sig.result) & ;); END;

IF StubUtils.perfMon THEN PutLine(wr, wridx, rdidx: INTEGER; & PerfComment); END;

END;
        Tab(wr, 2);
        PutLine(wr, "BEGIN");
        IF Text.Equal("init", Atom.ToText(methods[i].name)) THEN
          PutLine(
            wr, "(**************************************************)");
          PutLine(
            wr, "(* This get's done once. After that, it's a noop. *)");
          PutLine(
            wr, "(**************************************************)");
          PutLine(wr, "self := NARROW(SharedObj.Init(self), " &
                                   identfTxt & ");");
          PutLine(wr, "self.makeProxy();");
          PutLine(
            wr, "(**************************************************)");
        END;
        PutLine(wr, "IF NOT self.ok THEN "
                      & "SharedObjError.RaiseDeadObject() END;");
        IF uMeth THEN
          Tab(wr, 2);
          PutLine(wr, "TRY");
          PutLine(wr, "SharedObjStubLib.AcquireReadLock(self);");
          Tab(wr, 2);
          PutLine(wr, "IF self.updating = id THEN ");
          PutLine(wr, "(* do a simple, non-update call to the method *)");
          IF methods[i].sig.result # NIL THEN
            Put(wr, "RETURN ");
          END;
          Put(wr, identfsTxt & "." & Atom.ToText(methods[i].name) & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, methods[i].sig, Direction.Out);
          EndTab(wr);
          IF methods[i].sig.result # NIL THEN
            EndLine(wr, ");");
          ELSE
            PutLine(wr, ");");
            EndLine(wr, "RETURN;");
          END;
          EndLine(wr, "END;");
          Tab(wr, 2);
          PutLine(wr, "FINALLY");
          EndLine(wr, "SharedObjStubLib.ReleaseReadLock(self);");
          PutLine(wr, "END;");
          (* "SharedObjError.RaiseRecursiveUpdate(); END;"); *)

          Tab(wr, 2);
          PutLine(wr, "TRY");

IF StubUtils.perfMon THEN PutLine(wr, IF NetObjPerf.enabled THEN & PerfComment); PutLine(wr, NetObjPerf.StartCall(PerfUtil.ThreadId(), & Fmt.Int(NUMBER(methods[i].sig.formals^)) & );); PutLine(wr, END;); END;

          PutLine(wr, "out := SharedObjStubLib.StartCall(self);");
          Tab(wr, 2);
          PutLine(wr, "IF SharedObjStubLib.MarshalArgs(out) THEN");
          PutLine(wr, "SharedObjStubLib.OutInt32(out, ORD(" &
            identfTxt & "_SOMethods." & Atom.ToText(methods[i].name) & "));");

IF StubUtils.perfMon THEN PutLine(wr, 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(wr, Atom.ToText(f.name) & "_arg",
                              "SharedObjStubLib", f.type, Direction.Out,
                              calling := TRUE, maySuppress := TRUE);
            END;
          END;

IF StubUtils.perfMon THEN PutLine(wr, wridx := Wr.Index(c.wr) - wridx; & PerfComment); END;

          EndTab(wr);
          PutLine(wr, "END;");
          PutLine(wr, "SharedObjStubLib.SequenceCall(out, SharedObj_Protocol);");
          Tab(wr, 2);
          PutLine(wr, "TRY");
          PutLine(wr, "SharedObjStubLib.AcquireWriteLock(self);");
          PutLine(wr, "self.updating := id;");
          Put(wr, "Callback_pre_" & Atom.ToText(methods[i].name) &
            "_" & identfTxt & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, methods[i].sig, Direction.Out);
          EndTab(wr);
          PutLine(wr, ");");
          IF methods[i].sig.result # NIL THEN
            Tab(wr, 2);
            Put(wr, "WITH res = ");
          END;
          Put(wr, identfsTxt & "." & Atom.ToText(methods[i].name) & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, methods[i].sig, Direction.Out);
          EndTab(wr);
          IF methods[i].sig.result # NIL THEN
            PutLine(wr, ") DO");
          ELSE
            PutLine(wr, ");");
          END;
          Put(wr, "Callback_post_" & Atom.ToText(methods[i].name) &
            "_" & identfTxt & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, methods[i].sig, Direction.Out);
          EndTab(wr);
          IF methods[i].sig.result # NIL THEN
            PutLine(wr, ");");
            EndLine(wr, "RETURN res;");
            EndLine(wr, "END;");
          ELSE
            EndLine(wr, ");");
          END;
          Tab(wr, 2);
          PutLine(wr, "FINALLY");
          PutLine(wr, "self.updating := -1;");
          PutLine(wr, "SharedObjStubLib.ReleaseWriteLock(self);");
          EndLine(wr, "SharedObjStubLib.EndCall(out);");
          EndLine(wr, "END;");
          PutLine(wr, "EXCEPT");
          Put(wr, "| Wr.Failure (ec) => SharedObjError.RaiseCommFailure(ec)");
          IF methods[i].sig.result # NIL THEN
            PutLine(wr, "; <*ASSERT FALSE*>");
          ELSE
            PutLine(wr, ";");
          END;
          Put(wr, "| Thread.Alerted => SharedObjError.RaiseAlerted()");
          IF methods[i].sig.result # NIL THEN
            PutLine(wr, "; <*ASSERT FALSE*>");
          ELSE
            PutLine(wr, ";");
          END;
          EndLine(wr, "END;");

IF StubUtils.perfMon THEN PutLine(wr, rdidx := Rd.Index(c.rd); & PerfComment); END;

ELSE
          Tab(wr, 2);
          PutLine(wr, "TRY");
          PutLine(wr, "SharedObjStubLib.AcquireReadLock(self);");
          IF methods[i].sig.result # NIL THEN
            Put(wr, "RETURN ");
          END;
          Put(wr, identfsTxt & "." & Atom.ToText(methods[i].name) & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, methods[i].sig, Direction.Out);
          EndTab(wr);
          EndLine(wr, ");");
          Tab(wr, 2);
          PutLine(wr, "FINALLY");
          EndLine(wr, "SharedObjStubLib.ReleaseReadLock(self);");
          EndLine(wr, "END;");
        END;
        EndLine(wr, "END " & procedureName & ";");
        Nl(wr, freshLine := FALSE);
      END;
    END;
  END Surrogates;

PROCEDURE Stubs (self: T;
                 wr      : Formatter.T;
                 t: Type.Object;
                 identfTxt, identfsTxt: TEXT;
                 methods : ImportList.MethodList;
                 umethods: AtomList.T           )
  RAISES {SOxCodeGenError.E} =
  VAR
    varType: Type.T;
    SOexports := AtomList.List2(Atom.FromText(self.basename),
                                Atom.FromText(SOxCodeUtils.FileName(
                                                  self.basename,
                                                  SOxCodeFiles.T.PRX_I3)));
  BEGIN
    FOR i := 0 TO LAST(methods^) DO
      WITH Put    = Formatter.PutText,
         Nl     = Formatter.NewLine,
         Tab    = Formatter.Begin,
         EndTab = Formatter.End,

Br = Formatter.Break,

         sig    = methods[i].sig,
         stubSig = StubCode.SigForStub(sig),
         meth = methods[i].name,
         methTxt = Atom.ToText(meth),
         procedureName = "Stub_" & methTxt & "_" & identfTxt
       DO
        IF AtomList.Member(umethods, meth) THEN
          Tab(wr, 2);
          CodeForType.ProcHeader(wr, t, procedureName, stubSig,
                                 StubCode.PragmasForStub(),
                                 exports := SOexports);
          PutLine(wr, " = ");
          IF NUMBER(sig.formals^) > 0 THEN
            Tab(wr, 6);
            Put(wr, "  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;
                WITH txt = Atom.ToText(f.name)& "_arg: " &
                     CodeForType.ToText(varType, exports := SOexports) & ";" DO
                  PutLine(wr, txt);
                END;
              END;
            END;
            EndLine(wr, "dataPresent: BOOLEAN <* NOWARN *>;");
          END;
          Tab(wr, 2);
          PutLine(wr, "BEGIN");

          FOR j := 0 TO LAST(sig.formals^) DO
            WITH f = sig.formals[j] DO
              MarshalTypedVal(wr, Atom.ToText(f.name) & "_arg",
                              "SharedObjStubLib", f.type, Direction.In,
                              calling := TRUE, maySuppress := TRUE);
            END;
          END;

          Put(wr, "Callback_pre_" & methTxt & "_" & identfTxt & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, sig, Direction.In);
          EndTab(wr);
          PutLine(wr, ");");
          IF sig.result # NIL THEN
            Put(wr, "EVAL ");
          END;
          Put(wr, identfsTxt & "." & methTxt & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, sig, Direction.In);
          EndTab(wr);
          PutLine(wr, ");");

          Put(wr, "Callback_post_" & methTxt &  "_" & identfTxt & "(");
          Tab(wr, 0);
          Put(wr, "self");
          PrintStubArgs(wr, sig, Direction.In);
          EndTab(wr);
          EndLine(wr, ");");
          EndLine(wr, "END " & procedureName & ";");
          Nl(wr, freshLine := FALSE);
        END;
      END;
    END;
  END Stubs;

VAR cbName := ARRAY [0..1] OF Text.T{ "pre", "post" };

PROCEDURE Callbacks (self: T;
                     wr      : Formatter.T;
                     <*UNUSED*>t: Type.Object;
                     identfTxt: TEXT;
                     <*UNUSED*>identfsTxt: TEXT;
                     methods : ImportList.MethodList;
                     umethods: AtomList.T           ) =
  VAR
    SOexports := AtomList.List2(Atom.FromText(self.basename),
                                Atom.FromText(SOxCodeUtils.FileName(
                                                  self.basename,
                                                  SOxCodeFiles.T.PRX_I3)));
    procedureName: TEXT;
  BEGIN
    FOR i := 0 TO LAST(methods^) DO
      WITH Put    = Formatter.PutText,
         Nl     = Formatter.NewLine,
         EndTab = Formatter.End,
         Tab    = Formatter.Begin,
         sig = methods[i].sig,
         meth = methods[i].name,
         methTxt = Atom.ToText(meth)
       DO
        IF AtomList.Member(umethods, meth) THEN
          FOR j := FIRST(cbName) TO LAST(cbName) DO
            procedureName := "Callback_" & cbName[j] & "_" & methTxt &
                                 "_" & identfTxt;

            Tab(wr, 2);
            Put(wr, "PROCEDURE " & procedureName & "(");
            Tab(wr,0);
            Put(wr, "self: " & identfTxt);
            CodeForType.PrintSig(wr, sig, NIL, suffix := "_arg",
                                exports := SOexports);
            EndLine(wr, ") =");

CodeForType.ProcHeader(wr, t, procedureName, sig, suffix := _arg, exports := SOexports);

            PutLine(wr, "VAR cbs := self.callbacks;");
            Tab(wr, 2);
            PutLine(wr, "BEGIN");
            Tab(wr, 2);
            PutLine(wr, "WHILE cbs # NIL DO");
            Tab(wr, 2);
            PutLine(wr, "IF cbs.head.ready THEN");
            Tab(wr, 2);
            PutLine(wr, "WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO");
            Tab(wr, 2);
            PutLine(wr, "IF ref # NIL THEN");
            Tab(wr, 2);
            PutLine(wr, "WITH cb = NARROW(ref, " &
              SOxCodeUtils.FileName(self.basename,
                                    SOxCodeFiles.T.CB_I3) & "." &
                                    identfTxt & ") DO");
            Tab(wr, 2);
            Put(wr, "IF NOT cb." & cbName[j] & "_" & methTxt & "(");
            Tab(wr, 0);
            Put(wr, "self");
            PrintStubArgs(wr, sig, Direction.Out);
            EndTab(wr);
            PutLine(wr, ") THEN");
            EndLine(wr, "cb." & cbName[j] & "_anyChange(self);");
            EndLine(wr, "END;");
            EndLine(wr, "END;");
            EndLine(wr, "END;");
            EndLine(wr, "END;");
            PutLine(wr, "END;");
            EndLine(wr, "cbs := cbs.tail;");
            EndLine(wr, "END;");
            EndLine(wr, "END " & procedureName & ";");
            Nl(wr, freshLine := FALSE);
          END;
        END;
      END;
    END;
  END Callbacks;

PROCEDURE Picklers (self: T;
                 wr      : Formatter.T;
                 t: Type.Object;
                 identfTxt, identfsTxt: TEXT) RAISES {SOxCodeGenError.E} =
  VAR
    procedureName: Text.T;
  BEGIN
    WITH Put    = Formatter.PutText,
         Nl     = Formatter.NewLine,
         EndTab = Formatter.End,
         Br     = Formatter.Break,
         Tab    = Formatter.Begin,
         nodata = (NUMBER(t.fields^) = 0) DO

      PutLine(wr, "(* The pickling routine for this shared object." &
        " We will register a");
      PutLine(wr, "   pickler for " & self.basename & "." &
        identfsTxt & ", and then handle both " & identfsTxt & " and " &
        identfTxt & ".");
      PutLine(wr, "   Pickling subtypes of " & identfTxt & " is illegal. *)");

      Tab(wr, 2);
      PutLine(wr, "REVEAL");
      Put(wr, identfTxt & "Special = ");
      Tab(wr, 0);
      PutLine(wr, "SharedObj.Special BRANDED \"" & self.basename & "." &
        identfTxt & "Special\" OBJECT");
      Tab(wr, 2);
      PutLine(wr, "OVERRIDES");
      PutLine(wr, "write := DefaultSpWrite_" & identfTxt & ";");
      EndLine(wr, "read := DefaultSpRead_" & identfTxt & ";");
      EndLine(wr, "END;");
      EndLine(wr, "");

      Tab(wr, 2);
      PutLine(wr, "TYPE");
      Put(wr, identfTxt & "_Special = ");
      Tab(wr, 0);
      Tab(wr, 2);
      PutLine(wr, "Pickle.Special OBJECT");
      PutLine(wr, "mu: MUTEX;");
      PutLine(wr, "sp: " & identfTxt & "Special;");
      EndLine(wr, "registered: BOOLEAN := FALSE;");

      Tab(wr, 2);
      PutLine(wr, "OVERRIDES");
      PutLine(wr, "write := Write_" & identfTxt & ";");
      EndLine(wr, "read := Read_" & identfTxt & ";");
      EndLine(wr, "END;");
      EndLine(wr, "");

      Tab(wr, 2);
      procedureName := "DefaultSpWrite_" & identfTxt;
      Put(wr, "PROCEDURE " & procedureName & " (");
      Tab(wr, 0);
      Put(wr, "<*UNUSED*>self: " & identfTxt & "Special; ");
      Br(wr);
      IF nodata THEN
        Put(wr, "<*UNUSED*>");
      END;
      Put(wr, "shobj: SharedObj.T; ");
      Br(wr);
      IF nodata THEN
        Put(wr, "<*UNUSED*>");
      END;
      PutLine(wr, "out: Pickle.Writer)");
      EndTab(wr);
      IF nodata THEN
        PutLine(wr, " =");
      ELSE
        PutLine(wr, "RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} =");
      END;
      Tab(wr, 2);
      IF NOT nodata THEN
        PutLine(wr, "VAR");
        EndLine(wr, "obj := NARROW(shobj, " & identfsTxt & ");");
        Tab(wr, 2);
      END;
      PutLine(wr, "BEGIN");
      FOR j := 0 TO LAST(t.fields^) DO
        WITH f = t.fields[j] DO
          MarshalTypedVal(wr, "obj." & Atom.ToText(f.name),
                          "PickleStubs", f.type, Direction.Out,
                          calling := TRUE, maySuppress := TRUE);
        END;
      END;
      EndTab(wr);
      Nl(wr, freshLine := FALSE);
      EndLine(wr, "END " & procedureName & ";");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      procedureName := "Write_" & identfTxt;
      Put(wr, "PROCEDURE " & procedureName & " (");
      Tab(wr, 0);
      Put(wr, "<*UNUSED*>ts: " & identfTxt & "_Special; ");
      Br(wr);
      Put(wr, "ref: REFANY; ");
      Br(wr);
      PutLine(wr, "out: Pickle.Writer)");
      EndTab(wr);
      PutLine(wr, "RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} =");
      Tab(wr, 2);
      PutLine(wr, "VAR");
      PutLine(wr, "obj: " & identfsTxt & ";");
      PutLine(wr, "sp: " & identfTxt & "Special;");
      EndLine(wr, "tc := TYPECODE(ref);");
      Tab(wr, 2);
      PutLine(wr, "BEGIN");

PutLine(wr, IO.Put(\Pickle.Special for & self.basename & . & identfsTxt & \\n\););

Tab(wr, 2);
      PutLine(wr, "IF tc # TYPECODE(" & identfsTxt &
        ") AND tc # TYPECODE(" & identfTxt & ") THEN");
      EndLine(wr, "RAISE Pickle.Error(\"Can't pickle subtypes of " &
        self.basename & "." & identfTxt & "\");");
      PutLine(wr, "END;");
      PutLine(wr, "obj := NARROW(ref, " & identfsTxt & ");");
      PutLine(wr, "out.writeType(tc);");

PutLine(wr, IO.Put(\Pickle.Special.wr for & self.basename & . & identfsTxt & : writing shared obj\\n\););

      PutLine(wr, "SharedObjStubLib.StartWritePickle(obj, out);");
      Tab(wr,2);
      PutLine(wr, "LOCK sp" & identfTxt & ".mu DO");
      EndLine(wr, "sp := sp" & identfTxt & ".sp;");
      PutLine(wr, "END;");
      PutLine(wr, "sp.write(obj, out);");

      EndLine(wr, "SharedObjStubLib.EndWritePickle(obj, out);");

EndLine(wr, IO.Put(\Pickle.Special.wr for & self.basename & . & identfsTxt & : wrote shared obj\\n\););

      EndLine(wr, "END " & procedureName & ";");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      procedureName := "DefaultSpRead_" & identfTxt;
      Put(wr, "PROCEDURE " & procedureName & " (");
      Tab(wr, 0);
      Put(wr, "<*UNUSED*>self: " & identfTxt & "Special; ");
      Br(wr);
      IF nodata THEN
        Put(wr, "<*UNUSED*>");
      END;
      Put(wr, "shobj: SharedObj.T; ");
      Br(wr);
      IF nodata THEN
        Put(wr, "<*UNUSED*>");
      END;
      Put(wr, "in: Pickle.Reader) ");
      Br(wr);
      EndTab(wr);
      IF nodata THEN
        PutLine(wr, " =");
      ELSE
        Put(wr, "RAISES {");
        Br(wr);
        Tab(wr, 0);
        Put(wr, "Pickle.Error, ");
        Br(wr);
        Put(wr, "Rd.EndOfFile, ");
        Br(wr);
        Put(wr, "Rd.Failure, ");
        Br(wr);
        EndLine(wr, "Thread.Alerted} =");
      END;
      Tab(wr, 2);
      IF NOT nodata THEN
        PutLine(wr, "VAR");
        EndLine(wr, "obj := NARROW(shobj, " & identfsTxt & ");");
        Tab(wr, 2);
      END;
      PutLine(wr, "BEGIN");
      FOR j := 0 TO LAST(t.fields^) DO
        WITH f = t.fields[j] DO
          MarshalTypedVal(wr, "obj." & Atom.ToText(f.name),
                          "PickleStubs", f.type, Direction.In,
                          calling := TRUE, maySuppress := TRUE);
        END;
      END;
      EndTab(wr);
      Nl(wr, freshLine := FALSE);
      EndLine(wr, "END " & procedureName & ";");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      procedureName := "Read_" & identfTxt;
      Put(wr, "PROCEDURE " & procedureName & " (");
      Tab(wr, 0);
      Put(wr, "<*UNUSED*>ts: " & identfTxt & "_Special; in: Pickle.Reader; ");
      Br(wr);
      Put(wr, "id: Pickle.RefID):");
      Br(wr);
      EndTab(wr);
      Put(wr, "REFANY RAISES {");
      Br(wr);
      Tab(wr, 0);
      Put(wr, "Pickle.Error, ");
      Br(wr);
      Put(wr, "Rd.EndOfFile, ");
      Br(wr);
      Put(wr, "Rd.Failure, ");
      Br(wr);
      EndLine(wr, "Thread.Alerted} =");
      Tab(wr, 2);
      PutLine(wr, "VAR");
      PutLine(wr, "space: ObjectSpace.T;");
      PutLine(wr, "obj: " & identfsTxt & ";");
      PutLine(wr, "sp: " & identfTxt & "Special;");
      PutLine(wr, "proxy: EmbProxiedObj.Proxy;");
      EndLine(wr, "tc := in.readType();");
      Tab(wr, 2);
      PutLine(wr, "BEGIN");
      Tab(wr, 2);
      PutLine(wr, "IF tc = TYPECODE(" & identfTxt & ") THEN");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : shared obj\\n\););

      EndLine(wr, "obj := NEW(" & identfTxt & ");");
      Tab(wr, 2);
      PutLine(wr, "ELSIF tc = TYPECODE(" & identfsTxt & ") THEN");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : non-shared obj\\n\););

      EndLine(wr, "obj := NEW(" & identfsTxt & ");");
      Tab(wr, 2);
      PutLine(wr, "ELSE");
      EndLine(wr, "RAISE Pickle.Error(\"Can't unpickle subtypes of " &
        self.basename & "." & identfTxt & "\");");
      PutLine(wr, "END;");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : reading space\\n\););

PutLine(wr, "space := in.read();");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : reading shared obj\\n\););

      PutLine(wr, "SharedObjStubLib.StartReadPickle(obj, in, space);");

      Tab(wr,2);
      PutLine(wr, "LOCK sp" & identfTxt & ".mu DO");
      EndLine(wr, "sp := sp" & identfTxt & ".sp;");
      PutLine(wr, "END;");
      PutLine(wr, "sp.read(obj, in);");

      Tab(wr, 2);
      PutLine(wr, "IF tc = TYPECODE(" & identfTxt & ") THEN");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : setup shared obj\\n\););

      PutLine(wr, "obj := SharedObjStubLib.SetupNewCopy(obj, in, id, space);");
      PutLine(wr, "proxy := PickleStubs.InRef(in);");
      Tab(wr, 2);
      PutLine(wr, "IF obj.proxy = NIL THEN");
      EndLine(wr, "obj.proxy := proxy;");
      PutLine(wr, "END;");
      EndLine(wr, "obj.makeProxy();");
      Tab(wr, 2);
      PutLine(wr, "ELSE");
      PutLine(wr, "obj.proxy := NIL;");
      EndLine(wr, "obj.proxy := PickleStubs.InRef(in);");
      PutLine(wr, "END;");

PutLine(wr, IO.Put(\Pickle.Special.rd for & self.basename & . & identfsTxt & : done\\n\););

EndLine(wr, "RETURN obj;");
      EndLine(wr, "END " & procedureName & ";");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      procedureName := "RegisterSpecial_" & identfTxt;
      Put(wr, "PROCEDURE " & procedureName & " (");
      PutLine(wr, "sp: " & identfTxt & "Special) =");
      PutLine(wr, "<* FATAL DuplicateSpecial *>");
      Tab(wr, 2);
      PutLine(wr, "BEGIN");
      PutLine(wr, "(* we will need to NEW it here if RegisterSpecial_" &
        identfTxt);
      PutLine(wr, "   is called from " & self.basename & " *)");
      Tab(wr, 2);
      PutLine(wr, "IF sp" & identfTxt & " = NIL THEN");
      Put(wr, "sp" & identfTxt & " := NEW(");
      Tab(wr, 0);
      Put(wr, identfTxt & "_Special, ");
      Br(wr);
      Put(wr, "sc := TYPECODE(" & identfsTxt & "), ");
      Br(wr);
      Put(wr, "mu := NEW(MUTEX)");
      EndTab(wr);
      EndLine(wr, ");");
      PutLine(wr, "END;");

      Tab(wr, 2);
      PutLine(wr, "LOCK sp" & identfTxt & ".mu DO");
      Tab(wr, 2);
      PutLine(wr, "IF sp" & identfTxt & ".registered THEN");
      EndLine(wr, "RAISE DuplicateSpecial;");
      PutLine(wr, "END;");
      PutLine(wr, "sp" & identfTxt & ".registered := TRUE;");
      EndLine(wr, "sp" & identfTxt & ".sp := sp;");
      EndLine(wr, "END;");
      EndLine(wr, "END " & procedureName & ";");
      Nl(wr, freshLine := FALSE);

      Tab(wr, 2);
      PutLine(wr, "VAR");
      EndLine(wr, "sp" & identfTxt & ": " & identfTxt & "_Special := NIL;");

      (* Add to the initializers *)
      self.initializers := self.initializers &
         "  IF sp" & identfTxt & " = NIL THEN\n    sp" & identfTxt &
         " := NEW(" & identfTxt & "_Special,\n       sc := TYPECODE(" &
         identfsTxt & "),\n      mu := NEW(MUTEX),\n" &
         "      sp := NEW(" & identfTxt &
         "Special));\n  END;\n  Pickle.RegisterSpecial(sp" & identfTxt & ");\n";
    END;
  END Picklers;

PROCEDURE MarshalTypedVal (fmtWr      : Formatter.T;
                           varName    : TEXT;
                           libName    : TEXT;
                           t          : Type.T;
                           d          : Direction;
                           calling    : BOOLEAN;
                           indexDepth                 := 0;
                           maySuppress                := FALSE)
  RAISES {SOxCodeGenError.E} =
  BEGIN
    TYPECASE t OF
    | Type.Char (ch) =>
        Enumeration(fmtWr, varName, libName, ch, d, 0, ORD(LAST(CHAR)));
    | Type.UserDefined (ud) =>
        Enumeration(fmtWr, varName, libName, t, d, 0, LAST(ud.elts^));
    | Type.Subrange (sub) =>
        IF t = Type.integer THEN
          StubLibCall(fmtWr, "Integer", varName, libName, d);
        ELSIF t = Type.longint THEN
          StubLibCall(fmtWr, "Longint", varName, libName, d);
        ELSE
          SubRange(fmtWr, varName, libName, t, d, sub.min, sub.max);
        END;
    | Type.Real => StubLibCall(fmtWr, "Real", varName, libName, d);
    | Type.LongReal => StubLibCall(fmtWr, "Longreal", varName, libName, d);
    | Type.Extended => StubLibCall(fmtWr, "Extended", varName, libName, d);
    | Type.Reference (r) =>
        IF Type.MayBeRefAny(r) OR NOT Type.NamedType(r) THEN
          StubLibCall(fmtWr, "Ref", varName, libName, d, ", -1");
        ELSE
          StubLibCall(fmtWr, "Ref", varName, libName, d,
                      ", TYPECODE(" & CodeForType.ToText(r) & ")");
        END;
    | Type.Array (a) =>
        IF a.index = NIL THEN
          MarshalOpenArray(fmtWr, varName, libName, t, d, calling,
                           indexDepth, maySuppress);
        ELSE
          BeginOutOnly(fmtWr, libName, 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) & "]", libName,
            a.element, d, calling, indexDepth + 1);
          EndLine(fmtWr, "END;");
          EndOutOnly(fmtWr, maySuppress);
        END;
    | Type.Packed (p) =>
        BeginOutOnly(fmtWr, libName, t, d, maySuppress);
        MarshalTypedVal(
          fmtWr, varName, libName, p.base, d, calling, indexDepth);
        EndOutOnly(fmtWr, maySuppress);
    | Type.Record (rec) =>
        BeginOutOnly(fmtWr, libName, t, d, maySuppress);
        FOR i := 0 TO LAST(rec.fields^) DO
          MarshalTypedVal(
            fmtWr, varName & "." & Atom.ToText(rec.fields[i].name),
            libName, rec.fields[i].type, d, calling, indexDepth);
        END;
        EndOutOnly(fmtWr, maySuppress);
    | Type.Set (s) =>
        BeginOutOnly(fmtWr, libName, 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 " & libName & ".InBoolean(in) THEN");
          PutLine(fmtWr, varName & " := " & varName & " + "
                           & CodeForType.ToText(s) & "{i"
                           & Fmt.Int(indexDepth) & "};");
          EndLine(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, libName & ".OutBoolean(out, i" & Fmt.Int(indexDepth)
                           & " IN " & varName & ");");
        END;
        EndLine(fmtWr, "END;");
        EndOutOnly(fmtWr, maySuppress);
    | Type.Procedure =>
        RAISE SOxCodeGenError.E("Can't have a procedure as argument or result "
                                & "of a network object method.");
    ELSE
      RAISE SOxCodeGenError.E("Run time error -- shouldn't occur");
    END;
  END MarshalTypedVal;

PROCEDURE SubRange (fmtWr   : Formatter.T;
                    varName : TEXT;
                    libName : TEXT;
                    t       : Type.Subrange;
                    d       : Direction;
                    min, max: Value.T) RAISES {SOxCodeGenError.E}=
  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, libName, 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, libName, 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, libName, t.base, d, min, max);
        END;
      | Type.Subrange =>
        SubRange(fmtWr, varName, libName, t.base, d, min, max);
      ELSE
        RAISE SOxCodeGenError.E("Run time error -- shouldn't occur");
      END;
    END;
  END SubRange;

PROCEDURE Enumeration (fmtWr   : Formatter.T;
                       varName : TEXT;
                       libName : TEXT;
                       t       : Type.Enumeration;
                       d       : Direction;
                       min, max: INTEGER           ) =
  BEGIN
    IF d = Direction.In THEN
      PutLine(fmtWr, varName & " := VAL(" & libName & ".InInteger(in, "
                       & Fmt.Int(min) & "," & Fmt.Int(max) & "), "
                       & CodeForType.ToText(t) & ");");
    ELSE
      PutLine(fmtWr, libName & ".OutInteger(out, ORD(" & varName & "));");
    END;
  END Enumeration;

PROCEDURE StubLibCall (fmtWr  : Formatter.T;
                       proc   : TEXT;
                       varName: TEXT;
                       libName: TEXT;
                       d      : Direction;
                       extra                  := "") =
  BEGIN
    IF d = Direction.In THEN
      PutLine(fmtWr, varName & " := " & libName & ".In" & proc & "(in"
                       & extra & ");");
    ELSE
      PutLine(fmtWr, libName & ".Out" & proc & "(out, " & varName & ");");
    END;
  END StubLibCall;

PROCEDURE StubLibCallNoRep (fmtWr  : Formatter.T;
                            proc   : TEXT;
                            varName: TEXT;
                            libName: TEXT;
                            d      : Direction;
                            extra                  := "") =
  BEGIN
    IF d = Direction.In THEN
      PutLine(fmtWr, varName & " := " & libName & ".In" & proc & "(in"
                       & extra & ");");
    ELSE
      PutLine(fmtWr, libName & ".Out" & proc & "(out, " & varName & ");");
    END;
  END StubLibCallNoRep;

PROCEDURE BeginOutOnly (           fmtWr      : Formatter.T;
                                   libName    : TEXT;
                        <*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", libName, 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;
                            libName    : TEXT;
                            a          : Type.OpenArray;
                            d          : Direction;
                            calling    : BOOLEAN;
                            indexDepth : INTEGER;
                            maySuppress: BOOLEAN         )
  RAISES {SOxCodeGenError.E} =
  VAR
    nDimensions                        := a.openDimensions;
    aName, baseName, boundList: Text.T;
    component                 : Type.T;
  BEGIN
    WITH Put    = Formatter.PutText,
         Tab    = Formatter.Begin,
         EndTab = Formatter.End      DO
      IF calling THEN            (* Must marshal/unmarshal array bounds *)
        IF d = Direction.Out THEN
          StubLibCall(
            fmtWr, "Integer", "NUMBER(" & varName & ")", libName, d);
          aName := varName & "[0";
          FOR i := 2 TO nDimensions DO
            StubLibCall(
              fmtWr, "Integer", "NUMBER(" & aName & "])", libName, d);
            aName := aName & ", 0";
          END;
          baseName := varName;
        ELSE
          Put(fmtWr, "WITH n1 = " & libName & ".InInteger(in)");
          boundList := "n1";
          FOR i := 2 TO nDimensions DO
            PutLine(fmtWr, ",");
            Put(fmtWr, "    n" & Fmt.Int(i) & " = " & libName
                         & ".InInteger(in)");
            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, libName, a, d, maySuppress);

      Tab(fmtWr, 2);
      PutLine(fmtWr, "FOR n1 := 0 TO LAST(" & baseName & ") DO");
      aName := varName & "[n1";
      component := a.element;
      FOR i := 2 TO nDimensions DO
        Tab(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 & "]", libName, component, d, calling, indexDepth);
      FOR i := 1 TO nDimensions DO
        EndTab(fmtWr);
        PutLine(fmtWr, "END;");  (* End FOR Loop *)
      END;
      EndOutOnly(fmtWr, maySuppress);
    END;
  END MarshalOpenArray;

BEGIN
END SOxModuleSOCode.