Created by Susan Owicki Last modified on Mon Feb 28 17:01:36 PST 1994 by wobber modified on Mon May 17 14:59:49 PDT 1993 by mjordan modified on Thu Apr 22 10:32:22 PDT 1993 by owicki
MODULE; IMPORT Atom, CodeForType, FileWr, Fmt, Formatter, IntfStubCode, RefList, ModuleStubCode, OSError, Protocol, AtomRefTbl, StubUtils, Type, Wr; <* FATAL OSError.E, Wr.Failure *> VAR netobjName:= NEW(Type.Qid); PROCEDURE StubCode BrandsOK (t: Type.T; <*UNUSED*> existingSuper: Type.T := NIL): BOOLEAN = VAR OKSoFar := TRUE; BEGIN IF t = NIL THEN RETURN TRUE END; IF t.visited THEN RETURN t.brandsOK END; t.visited := TRUE; TYPECASE t OF | Type.Reference (ref) => IF ref.branded AND ref.brand = NIL THEN StubUtils.Message("Error: Branded type with no explicit brand -- " & CodeForType.ToText(ref)); OKSoFar := FALSE; END; TYPECASE ref OF | Type.Ref (r) => t.brandsOK := BrandsOK(r.target) AND OKSoFar | Type.Object (obj) => OKSoFar := BrandsOK(obj.super) AND OKSoFar; FOR i := 0 TO LAST(obj.fields^) DO OKSoFar := BrandsOK(obj.fields[i].type) AND OKSoFar; END; FOR i := 0 TO LAST(obj.methods^) DO OKSoFar := SigBrandsOK(obj.methods[i].sig) AND OKSoFar; END; t.brandsOK := OKSoFar | Type.Opaque (opq) => t.brandsOK := BrandsOK(opq.revealedSuperType) AND OKSoFar ELSE t.brandsOK := OKSoFar END; | Type.Array (arr) => t.brandsOK := BrandsOK(arr.element) AND OKSoFar | Type.Packed (p) => t.brandsOK := BrandsOK(p.base)AND OKSoFar | Type.Record (rec) => FOR i := 0 TO LAST(rec.fields^) DO OKSoFar := BrandsOK(rec.fields[i].type) AND OKSoFar; END; t.brandsOK := OKSoFar; | Type.Procedure (proc) => t.brandsOK := SigBrandsOK(proc.sig); ELSE t.brandsOK := TRUE END; RETURN t.brandsOK; END BrandsOK; PROCEDURESigBrandsOK (sig: Type.Signature): BOOLEAN = VAR OKSoFar := TRUE; BEGIN FOR i := 0 TO LAST(sig.formals^) DO OKSoFar := BrandsOK(sig.formals[i].type) AND OKSoFar END; RETURN BrandsOK(sig.result) AND OKSoFar; END SigBrandsOK; PROCEDUREGenStub (t: Type.Object; objName: Type.Qid; existingSuper: Type.T := NIL; existingSuperName: Type.Qid := NIL) = VAR methods: MethodList; intWr, modWr: Formatter.T; typeName := StubName(objName); fileName := StubUtils.FileName(typeName); superName: Atom.T; imports := NEW(AtomRefTbl.Default).init(); returnCodes: RefList.T; lastNewMethod: INTEGER; BEGIN IF existingSuper # NIL THEN superName := StubName(existingSuperName); END; TRY Initialize(t, intWr, modWr, typeName, fileName, methods, lastNewMethod, imports, existingSuper, superName); IntfStubCode.Header(t, intWr, typeName, objName, methods, lastNewMethod, imports); CodeForType.AddModuleImports(imports, methods, lastNewMethod); ModuleStubCode.Header(modWr, t, typeName, objName, methods, lastNewMethod, returnCodes, imports); Body(t, modWr, typeName, methods, lastNewMethod, returnCodes); CloseUp(intWr, modWr, fileName); EXCEPT StubUtils.Failure => Formatter.Close(intWr); Formatter.Close(modWr) END; END GenStub; PROCEDUREStubName (objName: Type.Qid): Atom.T = BEGIN RETURN Atom.FromText(Atom.ToText(objName.intf) & "_" & Atom.ToText(objName.item)); END StubName; PROCEDUREInitialize (t: Type.Object; VAR intWr, modWr: Formatter.T; typeName: Atom.T; fileName: TEXT; VAR methods: MethodList; VAR lastNewMethod: INTEGER; imports: AtomRefTbl.T; existingSuper: Type.T; superName: Atom.T )= BEGIN intWr := Formatter.New(FileWr.Open(fileName & ".i3")); modWr := Formatter.New(FileWr.Open(fileName & ".m3")); lastNewMethod := -1; BuildMethods(t, typeName, methods, lastNewMethod, existingSuper, superName, 0); CodeForType.ImportList(t, imports, methods, lastNewMethod, byName := FALSE); (* CodeForType.ImportRevelations(t, imports); *) CodeForType.AugmentImportList(imports, netObjImports); END Initialize; VAR netObjImports:= ARRAY {NetObj, StubLib, Rd, Thread, Wr} OF Atom.T {Atom.FromText("NetObj"), Atom.FromText("StubLib"), Atom.FromText("Rd"), Atom.FromText("Thread"), Atom.FromText("Wr")}; PROCEDUREBuildMethods (t: Type.Reference; typeName: Atom.T; VAR methods: MethodList; VAR lastNewMethod: INTEGER; existingSuper: Type.T; superName: Atom.T; n: INTEGER) = VAR debug: TEXT; BEGIN IF t.name # NIL AND t.name.intf = netobjName.intf AND t.name.item = netobjName.item THEN methods := NEW(MethodList, n); IF lastNewMethod < 0 THEN lastNewMethod := n-1; END; ELSE TYPECASE t OF | Type.Object (ot) => IF ot = existingSuper THEN lastNewMethod := n-1; END; BuildMethods(ot.super, typeName, methods, lastNewMethod, existingSuper, superName, n + NUMBER(ot.methods^)); FOR i := 0 TO LAST(ot.methods^) DO debug := Atom.ToText(ot.name.intf); methods[n].name := ot.methods[i].name; IF n <= lastNewMethod THEN methods[n].intf := typeName; ELSE methods[n].intf := superName; END; methods[n].sig := ot.methods[i].sig; INC(n); END; ELSE StubUtils.Die("StubCode.BuildMethods: non-object has methods"); END; END; END BuildMethods; PROCEDUREBody (t: Type.Object; modWr: Formatter.T; typeName: Atom.T; methods: MethodList; lastNewMethod: INTEGER; returnCodes: RefList.T) RAISES {StubUtils.Failure} = BEGIN ModuleStubCode.Surrogates(modWr, t, methods, lastNewMethod); ModuleStubCode.Dispatcher(modWr, t, typeName, methods, returnCodes); ModuleStubCode.OwnerStubs(modWr, t, methods, lastNewMethod); Formatter.PutText(modWr, "BEGIN"); Formatter.PutText(modWr, Wr.EOL); Formatter.PutText(modWr, " StubLib.Register(TYPECODE("); Formatter.PutText(modWr, CodeForType.ToText(t) & "), " & Fmt.Int(Protocol.version) & ", " & "TYPECODE(Surrogate_" & Atom.ToText(typeName)); Formatter.PutText(modWr, "), Invoke);"); Formatter.PutText(modWr, Wr.EOL); END Body; PROCEDURECloseUp (intWr, modWr: Formatter.T; fileName: TEXT) = BEGIN Formatter.PutText(intWr, "END " & fileName & "."); Formatter.PutText(modWr, "END " & fileName & "."); Formatter.NewLine(intWr); Formatter.NewLine(modWr); Formatter.Close(intWr); Formatter.Close(modWr); END CloseUp; PROCEDUREPragmasForStub (): REF ARRAY OF TEXT = BEGIN RETURN stubFormalPrags; END PragmasForStub; PROCEDURESigForStub (m: Type.Signature): Type.Signature = VAR sig:= Type.Signature{formals := stubFormals, result := NIL, raises := NIL}; useException: REF ARRAY OF BOOLEAN; c := 0; found: BOOLEAN; BEGIN IF m.raises = NIL THEN sig.raises := netObjExceptions; ELSE useException := NEW(REF ARRAY OF BOOLEAN, NUMBER(m.raises^)); FOR i := 0 TO LAST(m.raises^) DO useException[i] := FALSE; found := FALSE; FOR j := 0 TO LAST(netObjExceptions^) DO IF m.raises[i].qid.intf = netObjExceptions[j].qid.intf AND m.raises[i].qid.item = netObjExceptions[j].qid.item THEN found := TRUE END; END; IF NOT found THEN useException[i] := TRUE; INC(c); END; END; sig.raises := NEW(REF ARRAY OF Type.Exception, NUMBER(netObjExceptions^) + c); FOR i := 0 TO LAST(netObjExceptions^) DO sig.raises[i] := netObjExceptions[i] END; c := NUMBER(netObjExceptions^); FOR i := 0 TO LAST(m.raises^) DO IF useException[i] THEN sig.raises[c] := m.raises[i]; INC(c) END; END; END; RETURN sig; END SigForStub; VAR stubFormals: REF ARRAY OF Type.Formal; stubFormalPrags: REF ARRAY OF TEXT; netObjExceptions: REF ARRAY OF Type.Exception; BEGIN netobjName.intf := Atom.FromText("NetObj"); netobjName.item := Atom.FromText("T"); netObjExceptions := NEW (REF ARRAY OF Type.Exception, 4); FOR i := 0 TO LAST(netObjExceptions^) DO netObjExceptions[i] := NEW(Type.Exception); END; netObjExceptions[0].qid := NEW(Type.Qid, intf := Atom.FromText("NetObj"), item := Atom.FromText("Error")); (* The arg field for NetObj.Error is not filled in; this field isn't needed, since NetObj.Error is not marshalled or unmarshalled by stubs *) netObjExceptions[1].qid := NEW(Type.Qid, intf := Atom.FromText("Rd"), item := Atom.FromText("Failure")); netObjExceptions[2].qid := NEW(Type.Qid, intf := Atom.FromText("Wr"), item := Atom.FromText("Failure")); netObjExceptions[3].qid := NEW(Type.Qid, intf := Atom.FromText("Thread"), item := Atom.FromText("Alerted")); stubFormals := NEW(REF ARRAY OF Type.Formal, 2); stubFormalPrags := NEW(REF ARRAY OF TEXT, 2); stubFormals[0] := NEW(Type.Formal, mode := Type.Mode.Value, name := Atom.FromText("c"), default := NIL, type := NEW(Type.Object, name := NEW(Type.Qid, intf:= Atom.FromText("StubLib"), item := Atom.FromText("Conn")))); stubFormalPrags[0] := ""; stubFormals[1] := NEW(Type.Formal, mode := Type.Mode.Value, name := Atom.FromText("rep"), default := NIL, type := NEW(Type.Object, name := NEW(Type.Qid, intf:= Atom.FromText("StubLib"), item := Atom.FromText("DataRep")))); stubFormalPrags[1] := "<* NOWARN *> "; END StubCode.