[Indigo]<Cedar>IO>IOAmImpl.mesa!2

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

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;

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.

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

Printing Signals

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

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].

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

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.

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.

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