DIRECTORY Atom, ISNode, ISOut, ISScan, ISToken; ISOutImpl: CEDAR PROGRAM IMPORTS --Heap, Inline,-- Atom, ISNode --, Stream -- EXPORTS ISOut = BEGIN DataObject: TYPE = RECORD [ output: Stream.Handle _ NIL, mayNeedSeparatorBlank: BOOLEAN _ FALSE, nodeNest: CARDINAL _ 0]; DataHandle: TYPE = REF DataObject; PutTVObject: PROCEDURE [h: ISOut.Handle, tv: ISToken.TVHandle] = BEGIN data: DataHandle _ h.data; data.mayNeedSeparatorBlank _ FALSE; WITH tv SELECT FROM tvo: IntegerTVHandle => BEGIN IF tvo.value<0 THEN --<> -- {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 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, encoding: Publication100 ] ]; 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. ISOutImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. 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 Environment, Heap, Inline, Stream, XString, SHARES XString-- for fields-- 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. this ^^ here allows PutXXX, below, to override -- IF z=NIL THEN z _ zone; zone: z, Delete: PROCEDURE [h: ISOut.Handle] = BEGIN data: DataHandle = h.data; z: UNCOUNTED ZONE = data.zone; z.FREE[@h.data]; z.FREE[@h]; RETURN END; Κν˜codešœ™Kšœ Οmœ1™Kšž˜K˜šžœž˜˜ Kšž˜K˜"K˜Kšžœžœžœ˜@K˜Kšžœ˜—˜Kšž˜K˜Kšžœžœžœžœ#˜EKšžœ˜—K˜K˜K˜K˜K˜K˜ K˜K˜K˜Kšžœ˜"—Kšœžœ˜#Kšžœ˜——˜š‘ œž œžœ˜4Kšž˜K˜Kšžœžœ˜:K˜&Kšœžœ˜"Kšžœ˜——˜š‘œž œžœ˜1Kšž˜K˜Kšžœžœ˜:K˜&K˜Kšœžœ˜"Kšžœ˜——˜š‘œž œžœžœ˜BKšž˜K˜K˜Kš žœžœžœžœžœ˜KK˜Kšžœ˜——˜š‘œž œ*˜FKšž˜K˜K˜K˜K˜Kšžœ˜——˜š‘œž œ-˜@Kšž˜Kšžœ˜——˜š œ žœžœžœžœ˜.K˜K˜K˜K˜K˜K˜ K˜ K˜ K˜ ——˜Kš‘ œž œžœ!˜YK˜š‘œž œžœžœ˜DKšž˜K˜Kšœžœžœ ˜Kšœžœ˜Kšžœžœ˜:š žœžœž œžœžœ˜#Kšžœžœžœ˜5Kšž˜Kšžœ˜Kšžœ˜—š žœžœž œžœ ž˜'K˜@Kšœ žœ˜Kšžœ˜—K˜1Kšœžœ˜"Kšžœ˜——˜š ‘œžœž œ œžœ˜ZKšž˜Kšžœžœžœ ™Kšœžœžœ  œ˜E˜K˜K˜K˜—˜K˜#K˜%—˜K˜K˜!—˜K˜—˜K˜—˜K˜ K˜K˜ ——˜K™K˜šžœ˜K˜—š‘œž œ™%Kšž™K™Kšœž œžœ ™Kšœžœ ™Kšœžœ™ Kšž™Kšžœ™———˜š ‘œž œ0žœžœžœ˜TKšž˜K˜Kšœžœ#˜1K˜Kšœžœžœ$˜JKšžœ˜Kšžœ˜——˜šœ‘œž œ˜,Kšž˜K˜Kšœžœ˜Kšœžœžœ$˜OKšžœ˜šžœ˜K˜——š‘ œž œ(ž˜EK˜%Kšœ žœžœ˜Kšžœžœžœ ˜:šžœžœ˜K˜O—šžœžœžœž˜)K˜+Kš žœ žœžœ"žœžœžœ˜UKšžœ˜!Kšžœ˜—Kšžœ žœžœ ˜6šžœžœ˜K˜B—Kšžœ˜——˜š‘ œž œž œž˜?K˜1K˜/šžœ˜K˜——š‘ œž œž œ˜;K˜0——˜Kšžœ˜—K˜—…—#