DIRECTORY AMTypes USING [TV, Type, nullType, Class], AMBridge USING [TVForReadOnlyReferent, TVForROPE, TVForATOM], IO USING [PutChar], IOUtils USING [RegisterPrintRefAny, PrintRefAnyProc], PrintTV USING [TVPrintProc, RefPrintProc, Print], Rope USING [ROPE], SafeStorage USING [GetCanonicalType, GetReferentType]; PrintProcImpl: CEDAR MONITOR -- protects printproc registries IMPORTS AMBridge, IO, 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; ra: REF ANY; TRUSTED { ra _ LOOPHOLE[refAny]; WITH ra SELECT FROM rope: Rope.ROPE => tv _ AMBridge.TVForROPE[rope]; atom: ATOM => tv _ AMBridge.TVForATOM[atom]; ENDCASE => { IF ra # NIL THEN stream.PutChar['^]; tv _ AMBridge.TVForReadOnlyReferent[ref: refAny]}}; PrintTV.Print[tv: tv, put: stream, depth: depth, width: width, verbose: verbose]; }; }; IOUtils.RegisterPrintRefAny[PrintRefAny]; END. ŒPrintProcImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Paul Rovner, November 3, 1983 12:53 pm MBrown, January 13, 1984 2:49 pm Russ Atkinson (RRA) February 12, 1985 2:10:23 pm PST 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] so ROPE and ATOM arms will work (around compiler bug?) START HERE Κ Έ– "Cedar" style˜codešΟc™Kšœ Οmœ1™KšŸœ Ÿœ˜3KšŸœ˜KšœŸœŸœ˜+K˜KšœŸœŸœ˜!KšœŸœŸœ˜$šœŸœŸœ˜"K˜—šœ#Ÿœ˜'KšΟbœŸœŸœŸœ˜6Kš‘œŸœŸœ'Ÿœ˜P—K˜šœ)Ÿœ˜-Kš‘œŸœŸœŸœ˜šŸœ˜šŸœŸ˜ šŸœ˜KšŸœŸœŸœŸœ˜DKšœ˜—KšŸœœ*˜C—KšŸœ˜Kšœ˜——š ŸœŸœŸœŸœŸœŸœ˜CKšŸœŸœ˜ —Kšœ ˜ KšŸœ˜—Kšœ ™ KšœŸœ'˜1šŸœŸ˜ šŸœ˜Kšœ˜Kšœ˜—šŸœ˜Kšœ˜Kšœ˜——K˜K˜—š ’œŸœŸœŸœ)ŸœŸœ˜`KšŸœŸœŸœ˜Kšœ Ÿœ˜$šŸœ4ŸœŸœŸ˜GšŸœ˜šŸœ˜šŸœŸ˜ šŸœ˜KšŸœŸœŸœŸœ˜GKšœ˜—KšŸœœ*˜C—KšŸœ˜Kšœ˜——š ŸœŸœŸœŸœŸœŸœ˜EKšŸœŸœ˜ —Kšœ ˜ KšŸœ˜—Kšœ ™ KšœŸœ)˜3šŸœŸ˜ šŸœ˜Kšœ˜Kšœ˜—šŸœ˜Kšœ˜Kšœ˜——K˜K˜—š ’œŸœŸœŸœ0ŸœŸœ˜eKšŸœŸœŸœ˜KšœŸœ˜"Kšœ,˜,šŸœ0ŸœŸœŸ˜Cš ŸœŸœŸœŸœŸœ˜>šŸœ˜šŸœŸ˜ šŸœ˜KšŸœŸœŸœŸœ˜EKšœ˜—KšŸœœ*˜C—KšŸœ˜Kšœ˜——š ŸœŸœŸœŸœŸœŸœ˜CKšŸœŸœ˜ —Kšœ ˜ KšŸœ˜—Kšœ ™ KšœŸœ'˜1šŸœŸ˜ šŸœ˜Kšœ˜Kšœ˜—šŸœ˜Kšœ˜Kšœ˜——K˜K˜—š ’œŸœŸœŸœŸœŸœ˜EKšŸœŸœŸœ˜Kšœ!˜!KšœŸœ˜Kšœ˜—š ’œŸœŸœŸœŸœŸœ˜HKšŸœŸœŸœ˜Kšœ$˜$KšœŸœ˜Kšœ˜—š ’œŸœŸœŸœŸœŸœ˜EKšŸœŸœŸœ˜Kšœ"˜"KšœŸœ˜Kšœ˜—K˜š ’œŸœŸœŸœŸœŸœ˜DKšŸœŸœŸœ˜Kšœ$˜$KšœŸœ˜Kšœ˜—š ’œŸœŸœŸœŸœŸœ˜GKšŸœŸœŸœ˜Kšœ!˜!KšœŸœ˜Kšœ˜—š ’œŸœŸœŸœŸœŸœ˜DKšŸœŸœŸœ˜Kšœ"˜"KšœŸœ˜Kšœ˜—K˜š ’œŸœŸœŸœŸœŸœ˜YKšŸœŸœŸœ˜Kš!™!Kšœ˜Kš ŸœŸœŸœŸœŸœŸœ˜2Kšœ˜šŸœŸœŸœŸ˜0KšŸœŸœŸœ˜@KšŸœŸœŸœŸœŸœŸœŸœ˜IKšŸœ˜—KšŸœŸœŸœ˜K˜K˜—š ’œŸœŸœŸœŸœŸœ˜^KšŸœŸœŸœ˜Kš!™!Kšœ˜Kš ŸœŸœŸœŸœŸœŸœ˜5šŸœ ŸœŸœŸ˜3KšŸœŸœŸœ˜BKšŸœŸœŸœŸœŸœŸœŸœ˜KKšŸœ˜—KšŸœŸœŸœ˜K˜K˜—š ’œŸœŸœŸœŸœŸœ˜[KšŸœŸœŸœ˜Kš!™!Kšœ˜Kš ŸœŸœŸœŸœŸœŸœ˜3Kšœ˜šŸœŸœŸœŸ˜1KšŸœŸœŸœ˜@KšŸœŸœŸœŸœŸœŸœŸœ˜IKšŸœ˜—KšŸœŸœŸœ˜K˜K˜—š ’œŸœŸœŸœŸœ'Ÿœ˜rKš/™/KšŸœŸœŸœ˜šŸœ.ŸœŸœŸ˜Aš ŸœŸœŸœŸœŸœŸœ˜SKšŸœŸœ,˜7—KšŸœ˜—KšŸœ ŸœŸœ˜K˜K˜—š ’œŸœŸœŸœŸœ)Ÿœ˜sKš/™/KšŸœŸœŸœ˜šŸœ4ŸœŸœŸ˜Gš Ÿœ ŸœŸœŸœŸœŸœ˜OKšŸœŸœ-˜8—KšŸœ˜—KšŸœ ŸœŸœ˜K˜K˜—š ’œŸœŸœŸœŸœ(Ÿœ˜tKš/™/KšŸœŸœŸœ˜šŸœ0ŸœŸœŸ˜Cš ŸœŸœŸœŸœŸœŸœ˜SKšŸœŸœ,˜7—KšŸœ˜—KšŸœ ŸœŸœ˜K˜K˜—š‘ œ˜(KšŸœ Ÿœ ŸœŸ œ Ÿœ Ÿœ Ÿœ™VKšœ˜KšœŸœ˜ šŸœ˜ Kšœ;Ÿœ Ÿœ˜SKšœ˜—šŸœŸœŸœ:Ÿœ˜PKšœ Ÿœ˜KšœŸœŸœ˜ šŸœ˜ šœŸœ ˜K™6—šŸœŸœŸ˜Kšœ Ÿœ"˜1KšœŸœ"˜,šŸœ˜ KšŸœŸœŸœ˜$Kšœ3˜3———KšœQ˜QKšœ˜—Kšœ˜—K™K™Kšœ ™ K˜Kšœ)˜)K˜KšŸœ˜——…—ˆ,Μ