PilotBridgeImpl.mesa
Copyright (C) 1984, Xerox Corporation. All rights reserved.
Michael Plass, September 10, 1984 5:24:29 pm PDT
Pilot compatibility stuff
DIRECTORY Basics, Heap, IO, Inline, Space, Stream, System, VM, BasicTime, UnsafeStorage, Time, Rope, PupStream, RuntimeError, NameInfoDefs, GVNames;
PilotBridgeImpl: MONITOR
IMPORTS Basics, BasicTime, IO, UnsafeStorage, VM, PupStream, RuntimeError, GVNames, Rope
EXPORTS Heap, Inline, Space, Stream, System, Time, NameInfoDefs
~ BEGIN
Exported to Heap
systemZone: PUBLIC UNCOUNTED ZONE ~ UnsafeStorage.GetSystemUZone[];
Exported to Inline
bitsPerWord: NAT ~ Basics.bitsPerWord;
DBITSHIFT: PUBLIC PROCEDURE [value: LONG UNSPECIFIED, count: INTEGER] RETURNS [LONG UNSPECIFIED] ~ {
a: Inline.LongNumber.num ← LOOPHOLE[value];
IF count >= 0 THEN {
WHILE count >= bitsPerWord DO
a.highbits ← a.lowbits;
a.lowbits ← 0;
count ← count - bitsPerWord;
ENDLOOP;
a.highbits ← Basics.BITSHIFT[a.highbits, count] + Basics.BITSHIFT[a.lowbits, count-bitsPerWord];
a.lowbits ← Basics.BITSHIFT[a.lowbits, count];
}
ELSE {
WHILE count <= -bitsPerWord DO
a.lowbits ← a.highbits;
a.highbits ← 0;
count ← count + bitsPerWord;
ENDLOOP;
a.lowbits ← Basics.BITSHIFT[a.highbits, count+bitsPerWord] + Basics.BITSHIFT[a.lowbits, count];
a.highbits ← Basics.BITSHIFT[a.highbits, count];
};
RETURN [LOOPHOLE[a]]
};
Exported to Space
ScratchMap: PUBLIC PROCEDURE [count: VM.PageCount, usage: Space.Usage]
RETURNS [pointer: LONG POINTER] ~ {
interval: Space.Interval ← Allocate[count];
AddToScratchList[interval];
pointer ← interval.pointer;
};
Unmap: PUBLIC PROCEDURE [pointer: LONG POINTER, returnWait: Space.ReturnWait]
RETURNS [nil: LONG POINTER ← NIL] ~ {
interval: Space.Interval ← RemoveFromScratchList[pointer];
IF interval.pointer = NIL THEN Error[invalidParameters];
Deallocate[interval];
};
scratchList: LIST OF Space.Interval;
AddToScratchList: ENTRY PROC [interval: Space.Interval] ~ {
scratchList ← CONS[interval, scratchList];
};
RemoveFromScratchList: ENTRY PROC [pointer: LONG POINTER] RETURNS [Space.Interval] ~ {
prev: LIST OF Space.Interval ← NIL;
FOR p: LIST OF Space.Interval ← scratchList, p.rest UNTIL p=NIL DO
IF p.first.pointer = pointer THEN {
IF prev = NIL THEN scratchList ← p.rest ELSE prev.rest ← p.rest;
p.rest ← NIL;
RETURN [p.first];
};
prev ← p;
ENDLOOP;
RETURN [Space.nullInterval]
};
Activate, ActivateProc, Deactivate, DeactivateProc, ForceOut, Kill, SetAccess unimplemented for now
Allocate: PUBLIC PROCEDURE [count: VM.PageCount] RETURNS [interval: Space.Interval] ~ {
interval ← SpaceIntervalFromVMInterval[VM.Allocate[count]];
};
Deallocate: PUBLIC PROCEDURE [interval: Space.Interval] ~ {
VM.Free[VMIntervalFromSpaceInterval[interval]];
};
SpaceIntervalFromVMInterval: PROCEDURE [vmInterval: VM.Interval] RETURNS [interval: Space.Interval] ~ {
interval.pointer ← VM.AddressForPageNumber[vmInterval.page];
interval.count ← vmInterval.count;
};
VMIntervalFromSpaceInterval: PROCEDURE [interval: Space.Interval] RETURNS [vmInterval: VM.Interval] ~ {
vmInterval.page ← VM.PageNumberForAddress[interval.pointer];
vmInterval.count ← interval.count;
};
Error: PUBLIC ERROR [type: Space.ErrorType] ~ CODE;
Exported to Stream
Attention: PUBLIC SIGNAL [nextIndex: CARDINAL] ~ CODE;
EndOfStream: PUBLIC SIGNAL [nextIndex: CARDINAL] ~ CODE;
LongBlock: PUBLIC SIGNAL [nextIndex: CARDINAL] ~ CODE;
ShortBlock: PUBLIC ERROR ~ CODE;
SSTChange: PUBLIC SIGNAL [sst: Stream.SubSequenceType, nextIndex: CARDINAL] ~ CODE;
TimeOut: PUBLIC SIGNAL [nextIndex: CARDINAL] ~ CODE;
InvalidOperation: PUBLIC ERROR ~ CODE;
EndRecord: PUBLIC SIGNAL [nextIndex: CARDINAL] ~ CODE;
defaultObject: PUBLIC Stream.Object ← [
options: Stream.defaultInputOptions,
getByte: DefaultGetByte,
putByte: DefaultPutByte,
getWord: DefaultGetWord,
putWord: DefaultPutWord,
get: NIL,
put: NIL,
setSST: NIL,
sendAttention: NIL,
waitAttention: NIL,
delete: NIL,
getPosition: NIL,
setPosition: NIL,
sendNow: NIL,
clientData: NIL,
getSST: NIL,
getTimeout: NIL,
setTimeout: NIL
];
DefaultGetByte: PROCEDURE [sH: Stream.Handle] RETURNS [Stream.Byte] ~ {
bytes: PACKED ARRAY [0..4] OF Stream.Byte;
[] ← sH.get[sH, [@bytes, 0, 1], sH.options];
RETURN [bytes[0]];
};
DefaultGetWord: PROCEDURE [sH: Stream.Handle] RETURNS [Stream.Word] ~ {
words: PACKED ARRAY [0..2] OF WORD;
ptr: LONG POINTER ← @words;
[] ← sH.get[sH, [ptr, 0, Basics.bytesPerWord], sH.options];
RETURN [words[0]];
};
DefaultPutByte: PROCEDURE [sH: Stream.Handle, byte: Stream.Byte] ~ {
bytes: PACKED ARRAY [0..4] OF Stream.Byte;
bytes[0] ← byte;
sH.put[sH, [@bytes, 0, 1], FALSE];
};
DefaultPutWord: PROCEDURE [sH: Stream.Handle, word: Stream.Word] ~ {
words: PACKED ARRAY [0..2] OF WORD;
ptr: LONG POINTER ← @words;
words[0] ← word;
sH.put[sH, [ptr, 0, Basics.bytesPerWord], FALSE];
};
StreamPair: TYPE ~ REF StreamPairRep;
StreamPairRep: TYPE ~ RECORD [in, out: IO.STREAM];
IOGet: PROCEDURE [sH: Stream.Handle, block: Stream.Block, options: Stream.InputOptions] RETURNS [bytesTransferred: CARDINAL, why: Stream.CompletionCode, sst: Stream.SubSequenceType] ~ {
streamPair: StreamPair ← NARROW[sH.clientData];
ioStream: IO.STREAM ← streamPair.in;
why ← normal;
sst ← 0;
bytesTransferred ← ioStream.UnsafeGetBlock[[LOOPHOLE[block.blockPointer], block.startIndex, block.stopIndexPlusOne-block.startIndex] !
IO.Error => {
};
PupStream.TimeOut => TRUSTED {
IF options.signalTimeout THEN SIGNAL TimeOut[nextIndex];
RESUME;
};
];
IF bytesTransferred = 0 THEN {
gotMark: BOOL ← FALSE;
IF ioStream.GetInfo.class = $Pup THEN {
gotMark ← TRUE;
sst ← PupStream.ConsumeMark[ioStream ! RuntimeError.UNCAUGHT => {gotMark ← FALSE; CONTINUE}];
};
IF gotMark THEN {
IF options.signalSSTChange THEN SIGNAL SSTChange[sst, 0];
bytesTransferred ← 0;
why ← sstChange;
}
ELSE why ← endOfStream;
};
};
IOPut: PROCEDURE [sH: Stream.Handle, block: Stream.Block, endRecord: BOOLEAN] ~ {
streamPair: StreamPair ← NARROW[sH.clientData];
ioStream: IO.STREAM ← streamPair.out;
ioStream.UnsafePutBlock[[LOOPHOLE[block.blockPointer], block.startIndex, block.stopIndexPlusOne-block.startIndex] !
IO.Error => {
};
];
};
IOFlush: PROCEDURE [sH: Stream.Handle, endRecord: BOOLEAN] ~ {
streamPair: StreamPair ← NARROW[sH.clientData];
ioStream: IO.STREAM ← streamPair.out;
ioStream.Flush;
};
IOClose: PROCEDURE [sH: Stream.Handle] ~ {
streamPair: StreamPair ← NARROW[sH.clientData];
IF streamPair.in # NIL THEN streamPair.in.Close;
IF streamPair.out # NIL AND streamPair.out # streamPair.in THEN streamPair.out.Close;
};
FromIOStreams: PUBLIC PROC [in, out: IO.STREAM] RETURNS [stream: Stream.Handle] ~ {
stream ← NEW[Stream.Object ← defaultObject];
stream.clientData ← NEW[StreamPairRep ← [in, out]];
stream.get ← IOGet;
stream.put ← IOPut;
stream.sendNow ← IOFlush;
stream.delete ← IOClose;
};
Exported to System
GetClockPulses: PUBLIC PROC RETURNS [System.Pulses] ~ {
RETURN [[BasicTime.GetClockPulses[]]]
};
PulsesToMicroseconds: PUBLIC PROC[p: System.Pulses] RETURNS [System.Microseconds] ~ {
RETURN [BasicTime.PulsesToMicroseconds[p]]
};
MicrosecondsToPulses: PUBLIC PROC[m: System.Microseconds] RETURNS[System.Pulses] ~ {
RETURN [[BasicTime.MicrosecondsToPulses[m]]]
};
Overflow: PUBLIC ERROR ~ CODE;
switches: PUBLIC System.Switches ← System.defaultSwitches;
isUtilityPilot: PUBLIC BOOLEAN ← TRUE;
Exported to Time
Current: PUBLIC PROC RETURNS [time: Time.Packed] ~ {
RETURN [BasicTime.Now[]]
};
Unpack: PUBLIC PROC [time: Time.Packed] RETURNS [unpacked: Time.Unpacked] ~ {
RETURN [BasicTime.Unpack[time]]
};
Invalid: PUBLIC ERROR ~ CODE;
Pack: PUBLIC PROC [unpacked: Time.Unpacked] RETURNS [time: Time.Packed] ~ {
RETURN [BasicTime.Pack[unpacked]]
};
monthName: ARRAY BasicTime.MonthOfYear OF Rope.ROPE ~ ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "???"];
Append: PUBLIC PROC [s: LONG STRING, unpacked: Time.Unpacked, zone: BOOLEAN ← FALSE] ~ {
stream: IO.STREAM ← IO.TOS[];
text: REF TEXT ← NIL;
zoneChar: CHAR ← ' ;
IO.PutF[stream, "%2g-%g-%02g ", IO.int[unpacked.day], IO.rope[monthName[unpacked.month]], IO.int[unpacked.year MOD 100]];
IO.PutF[stream, "%2g:%02g:%02g", IO.int[unpacked.hour], IO.int[unpacked.minute], IO.int[unpacked.second]];
zoneChar ← SELECT unpacked.zone/60 FROM
0 => 'G,
5 => 'E,
6 => 'C,
7 => 'M,
8 => 'P,
ENDCASE => ' ;
IF zone AND zoneChar # ' THEN {
IO.PutChar[stream, ' ];
IO.PutChar[stream, zoneChar];
IO.PutChar[stream, IF unpacked.dst = yes THEN 'D ELSE 'S];
IO.PutChar[stream, 'T];
};
text ← IO.TextFromTOS[stream];
FOR i: NAT IN [0..text.length) DO
s[s.length] ← text[i];
s.length ← s.length + 1;
ENDLOOP;
};
AppendCurrent: PUBLIC PROC [s: LONG STRING, zone: BOOLEAN ← FALSE] ~ {
Append[s, Unpack[Current[]], zone]
};
Exported to NameInfoDefs
Authenticate: PUBLIC PROC[name: NameInfoDefs.RName, password: LONG STRING]
RETURNS[ NameInfoDefs.AuthenticateInfo ] ~ {
RETURN [GVNames.Authenticate[name: Rs[name], password: Rs[password]]]
};
Rs: PROC [string: LONG STRING] RETURNS [Rope.ROPE] ~ {
i: INTEGER ← -1;
fet: SAFE PROC RETURNS [CHAR] ~ TRUSTED {RETURN [string[i←i+1]]};
IF string = NIL THEN RETURN [NIL];
RETURN [Rope.FromProc[string.length, fet]];
};
IsInList: PUBLIC PROC[name: NameInfoDefs.RName, member: NameInfoDefs.RName,
level: NameInfoDefs.MembershipLevel, grade: NameInfoDefs.MembershipGrade, acl: NameInfoDefs.ListType]
RETURNS[NameInfoDefs.Membership] ~ {
RETURN [GVNames.IsInList[name: Rs[name], member: Rs[member],
level: level, grade: grade, acl: acl]]
};
END.