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