DIRECTORY AMBridge USING [IsRemote, ReadOnlyRefFromTV, SomeRefFromTV, TVForProc, TVForSignal, TVForPointerReferent], AMTypes USING [Domain, Error, IsNil, Referent, Size, TVType, TVToName, TypeClass, UnderType], Atom USING [MakeAtom], IO USING [CreateProcsStream, CreateRefStreamProcs, PutRope, PutTV, Signal, StreamProcs, RefPrintProc, ROPE, STREAM, TV, TVPrintProc, Type, UncheckedImplements], PrintTV USING [Intercept, Interceptor, Mother, PutClosure, PutProc], Rope USING [ROPE, IsEmpty], RTTypesBasic USING [EquivalentTypes, nullType], RuntimeInternal USING [SendMsgSignal] ; IOAMImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, Atom, IO, Rope, RuntimeInternal, PrintTV, RTTypesBasic EXPORTS IO = BEGIN OPEN IO; Implements: PUBLIC PROC [self: STREAM, operation, via: PROC ANY RETURNS ANY] = TRUSTED { opTV: TV = AMBridge.TVForProc[operation]; viaTV: TV = AMBridge.TVForProc[via]; IF ~RTTypesBasic.EquivalentTypes[AMTypes.TVType[opTV], AMTypes.TVType[viaTV]] THEN {IO.Signal[ProcedureHasWrongType, self]; RETURN}; UncheckedImplements[ self: self, operation: operation, via: via, procRef: AMBridge.SomeRefFromTV[viaTV], key: Atom.MakeAtom[AMTypes.TVToName[opTV]] ]; }; -- of Implements PutSignal: PUBLIC PROC [stream: IO.STREAM, signalTV, argsTV: TV _ NIL] = TRUSTED { ENABLE { UNWIND => NULL; RuntimeInternal.SendMsgSignal => NULL; -- this one has to be allowed to go through to higher catch phrase ANY => {stream.PutRope["SIGNAL.??"]; CONTINUE}; }; -- to bulletproof, in case something goes wrong in the catch phrase for ANY below, e.g. an AMTypes failure msg, signal: UNSPECIFIED; r: ROPE; PutSignal1: PROC = TRUSTED { OPEN AMTypes, IO; signalType: Type; argsType: Type; ptr: LONG POINTER; argsSize: NAT; signalTV _ AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]]; signalType _ TVType[signalTV]; argsType _ Domain[signalType]; argsSize _ IF argsType = RTTypesBasic.nullType THEN 0 ELSE AMTypes.Size[argsType]; IF argsSize > 1 THEN ptr _ LOOPHOLE[msg, POINTER] ELSE ptr _ @msg; IF argsSize # 0 THEN argsTV _ AMBridge.TVForPointerReferent[ptr, argsType] ELSE RETURN; }; -- of PutSignal1 IF signalTV = NIL THEN {[msg, signal] _ SIGNAL RuntimeInternal.SendMsgSignal[]; SELECT signal FROM -- some common signals which have to be handled specially because they come from compressed symbols. -1 => {stream.PutRope ["ERROR"]; RETURN}; ABORTED => {stream.PutRope["ABORTED"]; RETURN}; -- says andrew ENDCASE; r _ PrintTV.Mother[PutSignal1]; IF ~Rope.IsEmpty[r] THEN {stream.PutRope[r]; RETURN}; }; PutTV[stream: stream, tv: signalTV]; IF argsTV # NIL THEN PutTV[stream: stream, tv: argsTV]; }; -- PutThisSignal AttachRefPrintProc: PUBLIC PROC [refType: Type, refPrintProc: RefPrintProc] = { SELECT AMTypes.TypeClass[AMTypes.UnderType[refType]] FROM ref, list => PrintTV.Intercept[type: refType, proc: MyInterceptor, data: NEW[InterceptorRecord _ [refPrintProc: refPrintProc]]]; ENDCASE => IO.Signal[NotARefType, NIL]; }; -- of AttachRefPrintProc AttachTVPrintProc: PUBLIC PROC [type: Type, tvPrintProc: TVPrintProc, canHandleRemote: BOOL _ FALSE] = BEGIN PrintTV.Intercept[type: type, proc: MyInterceptor, data: NEW[InterceptorRecord _ [tvPrintProc: tvPrintProc]], canHandleRemote: canHandleRemote]; END; -- of AttachTVPrintProc InterceptorRecord: TYPE = RECORD[tvPrintProc: TVPrintProc _ NIL, refPrintProc: RefPrintProc _ NIL]; MyInterceptor: PrintTV.Interceptor -- [tv: TV, data: REF, put: PutClosure, depth: NAT, width: NAT] RETURNS [useOld: BOOL _ FALSE] -- = {stream: STREAM; record: REF InterceptorRecord _ NARROW[data]; WITH put.data SELECT FROM s: STREAM => stream _ s; ENDCASE => {IF putCache = NIL THEN -- first time -- putCache _ NEW[PutCacheRecord _ [ stream: CreateProcsStream[ streamProcs: CreateRefStreamProcs[putChar: PutCharClosure], streamData: putCache ], put: [NIL, NIL] ]]; putCache.put _ put; stream _ putCache.stream; }; IF record.tvPrintProc # NIL THEN { IF AMTypes.IsNil[tv ! AMTypes.Error => CONTINUE] THEN { stream.PutRope["NIL"]; RETURN; }; record.tvPrintProc[tv: tv, stream: stream]; } ELSE IF record.refPrintProc # NIL THEN TRUSTED -- UNCLEAN {referent: TV; ref: REF READONLY ANY _ NIL; IF AMBridge.IsRemote[tv] THEN RETURN[FALSE]; referent _ AMTypes.Referent[tv]; IF referent # NIL THEN ref _ AMBridge.ReadOnlyRefFromTV[referent]; IF ref = NIL THEN stream.PutRope["NIL"] ELSE record.refPrintProc[ref: ref, stream: stream]; } ELSE RETURN[TRUE]; }; PutCacheRecord: TYPE = RECORD [stream: STREAM, put: PrintTV.PutClosure]; putCache: REF PutCacheRecord _ NIL; PutCharClosure: PROC [self: STREAM, char: CHAR] = { putCache.put.proc[putCache.put.data, char]; }; END. change log 8-Mar-82 23:59:55 added subrange, pointer, long pointer to PrintType 12-Mar-82 13:45:45 changed Put to come up for air, i.e. check userabort. Fixed PrintType to check BBFault.AddressFault. 6-Apr-82 13:12:24 changed PrintType to check for and print READONLY for REF types. 16-Apr-82 17:40:07 changed PrintType to check for and print READONLY for REF types. 24-Apr-82 20:42:58 added everyBodyKnowsThese, LIST OF TypeNames, for which unaesthetic /unnecessary to print their underType, e.g. REAL, ROPE, INT, etc. June 29, 1982 11:54 am changed definition of PrintThisSignal to correspond to new way of handling signals in rttypes. August 3, 1982 1:17 pm eliminated calls to AMBridge.RefFromTV by calling PrintTV rather than PrintRefAny. August 26, 1982 10:25 am converted to use PrintTV rather than PrivateIO and hence TVStreamImpl October 14, 1982 1:08 pm moved printproc stuff in here so tvstreamimpl could be eliminated. ّThis module contains those portions of IO other than PrintTVIml and PrintTypeImpl which use the abstract machine interfaces. They are separated out in order that IO can be implemented via two configs, IOBasicPackage.bcd and RestOfIOPackage.bcd, the former of which is in the kernel edited by Teitelman March 8, 1983 3:00 pm Implementing new operations: Implements The following Allows individual streams to implement operations not provided with slots in streamProcs by storing an appropriate procedure on the streams alist. This procedure will be called with the same arguments as that supplied to the generic operation"s. For example, suppose a stream wants to implement the operation EraseChar. This would be accomplished by calling Implements on the corresponding handle with via a procedure of type PROC[self: handle, char: CHARACTER] (since EraseChar is of type PROC[self: handle, char: CHARACTER]), operation: IO.EraseChar. When EraseChar is called on this stream, it will search the streams otherStreamProcs for the key EraseChar, and if it finds such a key, call the procedure in proc giving it self, char as arguments. proc will be NARROWED to a procedure of the right type at runtime, to insure type safety, but to catch incorrect procedures earlier, i.e. when Implements is called, rather than when the operation is invoked, the check for whether proc is of the right type is also made at the time that Implements is called. Printing Signals interceptor stuff Used to define a procedure to be called for printing an object of the specified ref type. The procedure will be called with the corresponding ref and a stream. If the class of refType is not ref or list, raises IO.Signal[NotARefType]. More general print proc mechanism for use with any type. The procedure will be called with a tv for the corresponding object and a stream. Edited on March 8, 1983 3:00 pm, by Teitelman fixed so that if IsNil[tv], then rather than calling tvprintproc, simply print NIL. changes to: MyInterceptor, DIRECTORY, MyInterceptor ‌تU– "Cedar" styleکJ™™Jڑœ)™)ڑدk ک Jڑœ ‌œ\کjJڑœ‌œPک]Jڑœ‌œکJڑ ‌œ‌œ_‌œ‌œ‌œ*ک،Jڑœ‌œ7کDJڑœ‌œ‌œکJڑœ ‌œک/Jڑœ‌œک%JکJک—JکJڑذblœ‌œ‌کJکJڑ‌œ‌œ/کRJکJڑ‌œ‌œک JکJڑœ‌œ‌œ‌œکhead™'Jڑدc±™±Jکڑدn œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکYJک)Jک%ڑ‌œL‌œکSJڑœ‌œ%ک(Jڑ‌œک —ڑœکJڑœکJڑœکJڑœ ک Jڑœ'ک'Jڑœ*ک*Jڑœک—JڑœںکJک——™ڑ œ‌œ‌œ ‌œ‌œ‌œ‌œ‌ کSڑ‌œکJڑ‌œ‌œکJڑœ!‌œںBکjJڑ‌œ"‌œ‌ک/Jڑœںjکm—Jڑœ ‌œکJڑœ‌œکJکڑ œ‌œ‌ کJڑ‌œ ‌œکJکJکJڑœ‌œ‌œکJڑœ ‌œکJڑœ ‌œ ‌œ‌œ‌œ‌œکIJکJکJڑœ‌œ"‌œ‌œکRJڑ ‌œ‌œ‌œ‌œ‌œکDJڑ‌œ‌œ6کJJڑ‌œ‌œکJڑœںک—Jکڑ‌œ‌œ‌œکJڑœ‌œ!ک8ڑ‌œ‌œںfکyJڑœ!‌œک)Jڑ‌œ ‌œںک?Jڑ‌œک—JکJڑ‌œ‌œ‌œک5JکJک—Jک$Jڑ‌œ ‌œ‌œ#ک7Jڑœںک——™Jڑںë™ëڑ œ‌œ‌œ.‌کOڑ‌œ/‌ک9کJڑœ<‌œ4کs—Jڑ‌œ‌œ‌œک'—Jڑ‌œںک—کJڑں‹™‹—ڑ œ‌œ‌œ9‌œ‌œکfJڑ‌کJڑœ9‌œTکگJڑ‌œںک—JکJڑ œ‌œ‌œ‌œ‌œکcJکڑ œںaک„JکJڑœ ‌œکJڑœ‌œ‌œک-ڑ‌œ ‌œ‌کJڑœ‌œکڑ‌œک ڑœ‌œ‌œ‌œںœ‌œکJکJک;JکJک—Jڑœ‌œ‌œکJک—JکJکJک——ڑ‌œ‌œ‌œک"ڑ‌œ%‌œ‌œک7JڑœکJڑ‌œکJڑœک—Jڑœ+ک+Jک—ڑ‌œ‌œ‌œ‌ک&Jڑ‌œں کJڑœ‌œکJڑ œ‌œ‌œ‌œ‌œکڑ‌œ‌œ‌œ‌œک,Jک —Jڑ‌œ‌œ‌œ,کBJڑ‌œ‌œ‌œ‌œ/ک[Jک—Jڑ‌œ‌œ‌œکJکJک—Jڑ œ‌œ‌œ ‌œکHJڑ œ‌œ‌œک#Jکڑ œ‌œ‌œ‌œک3Jک+Jک——JکJڑ‌œکJکJکJک JکJکDJکJکwکJڑœ;‌œ‌œکR—Jڑœ<‌œ‌œکSJڑœ.‌œ‌œN‌œ‌œ‌œککJکuJکJکiJکJک^Jک[Jڑںک™-J™SJڑœدr'™3—J™J™—…—ذ$