[Cyan]<Imaging>ISScanner>ISOutImpl.mesa!1

ISOutImpl.mesa

edit by Ayers 23-May-85 18:49:29

based on the ideas in 'Press' etc by Johnsson --

Rick Beach, August 1, 1985 2:13:27 pm PDT

MKaplan, August 13, 1985 1:17:35 pm PDT

DIRECTORY

Environment,

Heap,

Inline,

Stream,

XString,

Atom,

ISNode,

ISOut,

ISScan,

ISToken;

ISOutImpl: CEDAR PROGRAM

IMPORTS --Heap, Inline,-- Atom, ISNode --, Stream --

EXPORTS ISOut

SHARES XString-- for fields--

= BEGIN

DataObject: TYPE = RECORD [

output: Stream.Handle ← NIL,

mayNeedSeparatorBlank: BOOLEAN ← FALSE,

nodeNest: CARDINAL ← 0];

DataHandle: TYPE = REF DataObject;

PutTVObject is here becasuse it is generally useful for outputting things like right hand sides. It needs careful though to avoid call-loops. In particular, only outside clients should call this: ISNode.Externalize should not.

PutTVObject: PROCEDURE [h: ISOut.Handle, tv: ISToken.TVHandle] =

BEGIN

data: DataHandle ← h.data;

data.mayNeedSeparatorBlank ← FALSE;

this ^^ here allows PutXXX, below, to override --

WITH tv SELECT FROM

tvo: IntegerTVHandle =>

BEGIN

IF tvo.value<0 THEN --<<How should we fixc this kludge??>> --

{PutLongCardinal [h, 0]; PutOperator [h, minus]; PutLongCardinal [h, -tvo.value]}

ELSE PutLongCardinal [h, tvo.value];

END;

tvo: AtomTVHandle => PutISAtom [h, tvo.value];

tvo: StringTVHandle =>

BEGIN

list: ISToken.TVHandle ← tvo.list;

OutputByte [data, '"];

WHILE list#NIL DO

PutTVObject [h, list];

list ← list.next;

IF list#NIL AND data.mayNeedSeparatorBlank THEN OutputByte [data, ' ];

data.mayNeedSeparatorBlank ← FALSE;

ENDLOOP;

OutputByte [data, '"];

END;

tvo: DollarTVHandle => PutTag [h, tvo.value];

tvo: CharactersTVHandle => PutXStringLiteral [h, @tvo.value];

tvo: PlusTVHandle => PutOperator [h, plus];

tvo: MinusTVHandle => PutOperator [h, minus];

tvo: TimesTVHandle => PutOperator [h, times];

tvo: DivideTVHandle => PutOperator [h, divide];

tvo: GetsTVHandle => PutOperator [h, gets];

tvo: LeftCurlyTVHandle => PutOperator [h, leftCurly];

tvo: RightCurlyTVHandle => PutOperator [h, rightCurly];

tvo: PushTVHandle => PutOperator [h, push];

tvo: PopTVHandle => PutOperator [h, pop];

tvo: NodeTVHandle => ISNode.Externalize [tvo.isnode, h];

tvo: NullTVHandle => NULL;

ENDCASE => ERROR; -- we should handle all possibilities above --

END;

PutOperator: PROCEDURE [h: ISOut.Handle, op: ISOut.Operator] =

BEGIN

data: DataHandle ← h.data;

SELECT op FROM

leftCurly =>

BEGIN

data.nodeNest ← data.nodeNest + 1;

OutputByte [data, 15C];

THROUGH [0..2*data.nodeNest) DO OutputByte [data, ' ]; ENDLOOP;

OutputByte [data, '{];

END;

rightCurly =>

BEGIN

OutputByte [data, '}];

IF data.nodeNest=0 THEN ERROR ELSE data.nodeNest ← data.nodeNest - 1;

END;

gets => OutputByte [data, '=];

open => OutputByte [data, '|];

plus => OutputByte [data, '+];

minus => OutputByte [data, '-];

times => OutputByte [data, '*];

divide => OutputByte [data, '/];

push => OutputByte [data, '[];

pop => OutputByte [data, ']];

dot => OutputByte [data, '.];

ENDCASE => OutputByte [data, '@];

data.mayNeedSeparatorBlank ← FALSE;

END;

PutISAtom: PROCEDURE [h: ISOut.Handle, atom: ATOM] =

BEGIN

data: DataHandle ← h.data;

IF data.mayNeedSeparatorBlank THEN OutputByte [data, 40B];

OutputXString [data, GetPName [atom]];

data.mayNeedSeparatorBlank ← TRUE;

END;

PutTag: PROCEDURE [h: ISOut.Handle, atom: ATOM] =

BEGIN

data: DataHandle ← h.data;

IF data.mayNeedSeparatorBlank THEN OutputByte [data, 40B];

OutputXString [data, GetPName [atom]];

OutputByte [data, '$];

data.mayNeedSeparatorBlank ← TRUE;

END;

PutStringLiteral: PROCEDURE [h: ISOut.Handle, text: LONG STRING] =

BEGIN

data: DataHandle ← h.data;

OutputByte [data, '<];

FOR k: CARDINAL IN [0..text.length) DO OutputByte [data, text[k]]; ENDLOOP;

OutputByte [data, '>];

END;

PutXStringLiteral: PROCEDURE [h: ISOut.Handle, text: XString.Reader] =

BEGIN

data: DataHandle ← h.data;

OutputByte [data, '<];

OutputXString [data, text];

OutputByte [data, '>];

END;

PutBlock: PROCEDURE [h: ISOut.Handle, text: Environment.Block] =

BEGIN

END;

powersOfTen: ARRAY [1..9] OF LONG CARDINAL ← [

10,

100,

1000,

10000,

100000,

1000000,

10000000,

100000000,

1000000000 ];

PutCardinal: PROCEDURE [h: ISOut.Handle, value: CARDINAL] = {PutLongCardinal [h, value]};

PutLongCardinal: PROCEDURE [h: ISOut.Handle, value: LONG CARDINAL] =

BEGIN

data: DataHandle ← h.data;

mod: LONG CARDINAL ← value;

digits: CARDINAL;

IF data.mayNeedSeparatorBlank THEN OutputByte [data, 40B];

FOR k: NAT DECREASING IN [1..9] DO

IF value>=powersOfTen[k] THEN {digits ← k + 1; EXIT};

REPEAT

FINISHED => digits ← 1;

ENDLOOP;

FOR k: NAT DECREASING IN [1..digits) DO

OutputByte [data, Inline.LowHalf[mod/powersOfTen[k]] + ('0-0C)];

mod ← mod MOD powersOfTen[k];

ENDLOOP;

OutputByte [data, Inline.LowHalf[mod] + ('0-0C)];

data.mayNeedSeparatorBlank ← TRUE;

END;

CreatePublication100: PUBLIC PROCEDURE --[z: UNCOUNTED ZONE]-- RETURNS [h: ISOut.Handle] =

BEGIN

IF z=NIL THEN z ← zone;

h ← NEW [ ISOut.Interface ← [data: NEW [DataObject --← [zone: z]-- ],

PutOperator: PutOperator,

PutISAtom: PutISAtom,

PutTag: PutTag,

PutStringLiteral: PutStringLiteral,

PutXStringLiteral: PutXStringLiteral,

PutCardinal: PutCardinal,

PutLongCardinal: PutLongCardinal,

PutTVObject: PutTVObject,

Delete: Delete,

Start: Start,

Finish: Finish,

Abort: Abort,

zone: z,

encoding: Publication100 ] ];

END;

Delete: PROCEDURE [h: ISOut.Handle] =

BEGIN

data: DataHandle = h.data;

z: UNCOUNTED ZONE = data.zone;

z.FREE[@h.data];

z.FREE[@h];

RETURN

END;

Start: PROCEDURE [h: ISOut.Handle, output: Stream.Handle, name: LONG STRING ← NIL] =

BEGIN

data: DataHandle = h.data;

prefix: STRING = "INTERSCRIPT/INTERCHANGE/1.0 "L;

data.output ← output;

Stream.PutBlock[output, [LOOPHOLE[LONG[@prefix.text]], 0, prefix.length]];

RETURN;

END;

Finish, Abort: PROCEDURE [h: ISOut.Handle] =

BEGIN

data: DataHandle = h.data;

suffix: STRING = " ENDSCRIPT"L;

Stream.PutBlock[data.output, [LOOPHOLE[LONG[@suffix.text]], 0, suffix.length]];

RETURN;

END;

OutputXString: PROCEDURE[data: DataHandle, s: XString.Reader] = BEGIN

context: XString.Context ← s.context;

newPrefix: BOOLEAN ← FALSE;

IF context.suffixSize#1 THEN ERROR; -- no stringlet16's --

IF context.prefix#0 THEN

{Stream.PutByte[data.output,377B]; Stream.PutByte[data.output,context.prefix]};

FOR j: CARDINAL IN [s.offset..s.limit) DO

Stream.PutByte [ data.output, s.bytes[j] ];

IF newPrefix THEN {IF (context.prefix←s.bytes[j])=377B THEN ERROR; newPrefix ← FALSE}

ELSE newPrefix ← s.bytes[j]=377B;

ENDLOOP;

IF newPrefix THEN ERROR; -- string ended with a 377 --

IF context.prefix#0 THEN

{Stream.PutByte[data.output,377B]; Stream.PutByte[data.output,0]};

END;

OutputWord: PROCEDURE[data: DataHandle, w: UNSPECIFIED] = BEGIN

Stream.PutByte[data.output, Inline.HighByte[w]];

Stream.PutByte[data.output, Inline.LowByte[w]];

END;

OutputByte: PROCEDURE[data: DataHandle, w: UNSPECIFIED] = {

Stream.PutByte[data.output, Inline.LowByte[w]]};

END.