DIRECTORY AMTypes USING [TV, Type, nullType, Class], AMBridge USING [TVForReadOnlyReferent], IOUtils USING [RegisterPrintRefAny, PrintRefAnyProc], PrintTV USING [TVPrintProc, RefPrintProc, Print], SafeStorage USING [GetCanonicalType, GetReferentType] ; PrintProcImpl: CEDAR MONITOR -- protects printproc registries IMPORTS AMBridge, IOUtils, SafeStorage, PrintTV EXPORTS PrintTV = BEGIN OPEN AMTypes, PrintTV, SafeStorage; tvPrintProcsEnabled: BOOL _ TRUE; classPrintProcsEnabled: BOOL _ TRUE; refPrintProcsEnabled: BOOL _ TRUE; tvPrintProcList: TVPrintProcList _ NIL; TVPrintProcList: TYPE = LIST OF TVPrintProcListRecord; TVPrintProcListRecord: TYPE = RECORD [type: Type, proc: TVPrintProc, data: REF]; classPrintProcList: ClassPrintProcList _ NIL; ClassPrintProcList: TYPE = LIST OF ClassPrintProcListRecord; ClassPrintProcListRecord: TYPE = RECORD [class: Class, proc: TVPrintProc, data: REF]; refPrintProcList: RefPrintProcList _ NIL; RefPrintProcList: TYPE = LIST OF RefPrintProcListRecord; RefPrintProcListRecord: TYPE = RECORD [type: Type, proc: RefPrintProc, data: REF]; RegisterTVPrintProc: PUBLIC ENTRY PROC [type: Type, proc: TVPrintProc, data: REF _ NIL] = { ENABLE UNWIND => NULL; prev, new: TVPrintProcList _ NIL; type _ GetCanonicalType[type]; FOR x: TVPrintProcList _ tvPrintProcList, x.rest UNTIL x = NIL DO IF LOOPHOLE[x.first.type, CARDINAL] = LOOPHOLE[type, CARDINAL] THEN { IF proc = NIL THEN { -- splice it out IF prev = NIL THEN tvPrintProcList _ x.rest ELSE prev.rest _ x.rest; } ELSE {--change bindings--x.first.proc _ proc; x.first.data _ data}; RETURN; } ELSE IF LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[type, CARDINAL] THEN EXIT; prev _ x; ENDLOOP; new _ LIST[[type: type, proc: proc, data: data]]; IF prev = NIL THEN { new.rest _ tvPrintProcList; tvPrintProcList _ new} ELSE { new.rest _ prev.rest; prev.rest _ new}; }; RegisterClassPrintProc: PUBLIC ENTRY PROC [class: Class, proc: TVPrintProc, data: REF _ NIL] = { ENABLE UNWIND => NULL; prev, new: ClassPrintProcList _ NIL; FOR x: ClassPrintProcList _ classPrintProcList, x.rest UNTIL x = NIL DO IF x.first.class = class THEN { IF proc = NIL THEN { -- splice it out IF prev = NIL THEN classPrintProcList _ x.rest ELSE prev.rest _ x.rest; } ELSE {--change bindings--x.first.proc _ proc; x.first.data _ data}; RETURN; } ELSE IF LOOPHOLE[x.first.class, CARDINAL] > LOOPHOLE[class, CARDINAL] THEN EXIT; prev _ x; ENDLOOP; new _ LIST[[class: class, proc: proc, data: data]]; IF prev = NIL THEN { new.rest _ classPrintProcList; classPrintProcList _ new} ELSE { new.rest _ prev.rest; prev.rest _ new}; }; RegisterRefPrintProc: PUBLIC ENTRY PROC [referentType: Type, proc: RefPrintProc, data: REF _ NIL] = { ENABLE UNWIND => NULL; prev, new: RefPrintProcList _ NIL; type: Type _ GetCanonicalType[referentType]; FOR x: RefPrintProcList _ refPrintProcList, x.rest UNTIL x = NIL DO IF LOOPHOLE[x.first.type, CARDINAL] = LOOPHOLE[type, CARDINAL] THEN { IF proc = NIL THEN { -- splice it out IF prev = NIL THEN refPrintProcList _ x.rest ELSE prev.rest _ x.rest; } ELSE {--change bindings--x.first.proc _ proc; x.first.data _ data}; RETURN; } ELSE IF LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[type, CARDINAL] THEN EXIT; prev _ x; ENDLOOP; new _ LIST[[type: type, proc: proc, data: data]]; IF prev = NIL THEN { new.rest _ refPrintProcList; refPrintProcList _ new} ELSE { new.rest _ prev.rest; prev.rest _ new}; }; DisableTVPrintProcs: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ tvPrintProcsEnabled; tvPrintProcsEnabled _ FALSE; }; DisableClassPrintProcs: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ classPrintProcsEnabled; classPrintProcsEnabled _ FALSE; }; DisableRefPrintProc: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ refPrintProcsEnabled; refPrintProcsEnabled _ FALSE; }; EnableTVPrintProcs: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ classPrintProcsEnabled; classPrintProcsEnabled _ TRUE; }; EnableClassPrintProcs: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ tvPrintProcsEnabled; tvPrintProcsEnabled _ TRUE; }; EnableRefPrintProc: PUBLIC ENTRY PROC RETURNS [wasEnabled: BOOL] = { ENABLE UNWIND => NULL; wasEnabled _ refPrintProcsEnabled; refPrintProcsEnabled _ TRUE; }; GetTVPrintProc: PUBLIC ENTRY PROC [type: Type] RETURNS [proc: TVPrintProc, data: REF] = { ENABLE UNWIND => NULL; x: TVPrintProcList; IF NOT tvPrintProcsEnabled THEN RETURN [NIL, NIL]; type _ GetCanonicalType[type]; FOR x _ tvPrintProcList, x.rest UNTIL x = NIL DO IF x.first.type = type THEN RETURN [x.first.proc, x.first.data]; IF LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[type, CARDINAL] THEN EXIT; ENDLOOP; RETURN [NIL, NIL]; }; GetClassPrintProc: PUBLIC ENTRY PROC [class: Class] RETURNS [proc: TVPrintProc, data: REF] = { ENABLE UNWIND => NULL; x: ClassPrintProcList; IF NOT classPrintProcsEnabled THEN RETURN [NIL, NIL]; FOR x _ classPrintProcList, x.rest UNTIL x = NIL DO IF x.first.class = class THEN RETURN [x.first.proc, x.first.data]; IF LOOPHOLE[x.first.class, CARDINAL] > LOOPHOLE[class, CARDINAL] THEN EXIT; ENDLOOP; RETURN [NIL, NIL]; }; GetRefPrintProc: PUBLIC ENTRY PROC [type: Type] RETURNS [proc: RefPrintProc, data: REF] = { ENABLE UNWIND => NULL; x: RefPrintProcList; IF NOT refPrintProcsEnabled THEN RETURN [NIL, NIL]; type _ GetCanonicalType[type]; FOR x _ refPrintProcList, x.rest UNTIL x = NIL DO IF x.first.type = type THEN RETURN [x.first.proc, x.first.data]; IF LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[type, CARDINAL] THEN EXIT; ENDLOOP; RETURN [NIL, NIL]; }; NextTVPrintProc: PUBLIC ENTRY PROC [after: Type _ nullType] RETURNS [type: Type, proc: TVPrintProc, data: REF] = { ENABLE UNWIND => NULL; FOR x: TVPrintProcList _ tvPrintProcList, x.rest UNTIL x = NIL DO IF after = nullType OR LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[after, CARDINAL] THEN RETURN [x.first.type, x.first.proc, x.first.data]; ENDLOOP; RETURN [after, NIL, NIL]; }; NextClassPrintProc: PUBLIC ENTRY PROC [after: Class _ nil] RETURNS [class: Class, proc: TVPrintProc, data: REF] = { ENABLE UNWIND => NULL; FOR x: ClassPrintProcList _ classPrintProcList, x.rest UNTIL x = NIL DO IF after = nil OR LOOPHOLE[x.first.class, CARDINAL] > LOOPHOLE[after, CARDINAL] THEN RETURN [x.first.class, x.first.proc, x.first.data]; ENDLOOP; RETURN [after, NIL, NIL]; }; NextRefPrintProc: PUBLIC ENTRY PROC [after: Type _ nullType] RETURNS [type: Type, proc: RefPrintProc, data: REF] = { ENABLE UNWIND => NULL; FOR x: RefPrintProcList _ refPrintProcList, x.rest UNTIL x = NIL DO IF after = nullType OR LOOPHOLE[x.first.type, CARDINAL] > LOOPHOLE[after, CARDINAL] THEN RETURN [x.first.type, x.first.proc, x.first.data]; ENDLOOP; RETURN [after, NIL, NIL]; }; PrintRefAny: IOUtils.PrintRefAnyProc = { proc: RefPrintProc; data: REF; TRUSTED{ [proc: proc, data: data] _ GetRefPrintProc[GetReferentType[LOOPHOLE[refAny, REF]]]; }; IF proc = NIL OR proc[refAny, data, stream, depth, width, verbose].useOld THEN { tv: AMTypes.TV; TRUSTED { tv _ AMBridge.TVForReadOnlyReferent[ref: refAny] }; PrintTV.Print[tv: tv, put: stream, depth: depth, width: width, verbose: verbose]; }; }; IOUtils.RegisterPrintRefAny[PrintRefAny]; END. δPrintProcImpl.mesa Paul Rovner, November 3, 1983 12:53 pm MBrown, December 19, 1983 2:48 pm splice it in splice it in splice it in proc # NIL => print proc provided proc # NIL => print proc provided proc # NIL => print proc provided provides a stateless enumerator for print procs provides a stateless enumerator for print procs provides a stateless enumerator for print procs PROC [stream: STREAM, refAny: REF READONLY ANY, depth: INT, width: INT, verbose: BOOL] START HERE Κ X– "Cedar" style˜J˜šΟc™Jš œ™&Jšœ™!—J˜šΟk ˜ Jšœžœžœ˜*Jšœ žœ˜'Jšœžœ(˜5Jšœžœ$˜1Jšœ žœ$˜5˜J˜——šΠbl œžœžœ ˜>Jšžœ(˜/Jšžœ˜J˜Jšœžœžœ˜+J˜Jšœžœžœ˜!Jšœžœžœ˜$šœžœžœ˜"J˜—šœ#žœ˜'JšΟbœžœžœžœ˜6Jš œžœžœ'žœ˜P—J˜šœ)žœ˜-Jš œžœžœžœ˜šžœ˜šžœž˜ šžœ˜Jšžœžœžœžœ˜DJšœ˜—Jšžœœ*˜C—Jšžœ˜Jšœ˜——š žœžœžœžœžœžœ˜CJšžœžœ˜ —Jšœ ˜ Jšžœ˜—Jšœ ™ Jšœžœ'˜1šžœž˜ šžœ˜Jšœ˜Jšœ˜—šžœ˜Jšœ˜Jšœ˜——J˜J˜—š‘œžœžœž˜)Jšœ(žœžœ˜6Jšžœžœžœ˜Jšœ žœ˜$šžœ4žœžœž˜Gšžœ˜šžœ˜šžœž˜ šžœ˜Jšžœžœžœžœ˜GJšœ˜—Jšžœœ*˜C—Jšžœ˜Jšœ˜——š žœžœžœžœžœžœ˜EJšžœžœ˜ —Jšœ ˜ Jšžœ˜—Jšœ ™ Jšœžœ)˜3šžœž˜ šžœ˜Jšœ˜Jšœ˜—šžœ˜Jšœ˜Jšœ˜——J˜J˜—š‘œžœžœž˜'Jšœ/žœžœ˜=Jšžœžœžœ˜Jšœžœ˜"Jšœ,˜,šžœ0žœžœž˜Cš žœžœžœžœžœ˜>šžœ˜šžœž˜ šžœ˜Jšžœžœžœžœ˜EJšœ˜—Jšžœœ*˜C—Jšžœ˜Jšœ˜——š žœžœžœžœžœžœ˜CJšžœžœ˜ —Jšœ ˜ Jšžœ˜—Jšœ ™ Jšœžœ'˜1šžœž˜ šžœ˜Jšœ˜Jšœ˜—šžœ˜Jšœ˜Jšœ˜——J˜J˜—procš ‘œžœžœžœžœžœ˜EJšžœžœžœ˜Kšœ!˜!Kšœžœ˜Kšœ˜—š ‘œžœžœžœžœžœ˜HJšžœžœžœ˜Kšœ$˜$Kšœžœ˜Kšœ˜—š ‘œžœžœžœžœžœ˜EJšžœžœžœ˜Kšœ"˜"Kšœžœ˜Kšœ˜—K˜š ‘œžœžœžœžœžœ˜DJšžœžœžœ˜Kšœ$˜$Kšœžœ˜Kšœ˜—š ‘œžœžœžœžœžœ˜GJšžœžœžœ˜Kšœ!˜!Kšœžœ˜Kšœ˜—š ‘œžœžœžœžœžœ˜DJšžœžœžœ˜Kšœ"˜"Kšœžœ˜Kšœ˜—K˜š‘œžœžœžœ ˜.Jšžœžœ˜*Jšžœžœžœ˜Jš!™!Jšœ˜Jš žœžœžœžœžœžœ˜2Jšœ˜šžœžœžœž˜0Jšžœžœžœ˜@Jšžœžœžœžœžœžœžœ˜IJšžœ˜—Jšžœžœžœ˜J˜J˜—š‘œžœžœžœ˜3Jšžœžœ˜*Jšžœžœžœ˜Jš!™!Jšœ˜Jš žœžœžœžœžœžœ˜5šžœ žœžœž˜3Jšžœžœžœ˜BJšžœžœžœžœžœžœžœ˜KJšžœ˜—Jšžœžœžœ˜J˜J˜—š‘œžœžœžœ ˜/Jšžœžœ˜+Jšžœžœžœ˜Jš!™!Jšœ˜Jš žœžœžœžœžœžœ˜3Jšœ˜šžœžœžœž˜1Jšžœžœžœ˜@Jšžœžœžœžœžœžœžœ˜IJšžœ˜—Jšžœžœžœ˜J˜J˜—š‘œžœžœžœ˜;Jšžœ'žœ˜6Jš/™/Jšžœžœžœ˜šžœ.žœžœž˜Aš žœžœžœžœžœžœ˜SJšžœžœ,˜7—Jšžœ˜—Jšžœ žœžœ˜J˜J˜—š‘œžœžœžœ˜:Jšžœ)žœ˜8Jš/™/Jšžœžœžœ˜šžœ4žœžœž˜Gš žœ žœžœžœžœžœ˜OJšžœžœ-˜8—Jšžœ˜—Jšžœ žœžœ˜J˜J˜—š‘œžœžœžœ˜