PrintProcImpl.mesa
Paul Rovner, November 3, 1983 12:53 pm
MBrown, December 19, 1983 2:48 pm
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: BOOLTRUE;
classPrintProcsEnabled: BOOLTRUE;
refPrintProcsEnabled: BOOLTRUE;
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: REFNIL] = {
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;
splice it in
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: REFNIL] = {
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;
splice it in
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: REFNIL] = {
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;
splice it in
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;
proc # NIL => print proc provided
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;
proc # NIL => print proc provided
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;
proc # NIL => print proc provided
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] = {
provides a stateless enumerator for print procs
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] = {
provides a stateless enumerator for print procs
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] = {
provides a stateless enumerator for print procs
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 [stream: STREAM, refAny: REF READONLY ANY, depth: INT, width: INT, verbose: BOOL]
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];
};
};
START HERE
IOUtils.RegisterPrintRefAny[PrintRefAny];
END.