IPEncodingOutImpl.mesa
Written by J. Warnock, Mar 1982
Last edited by Andy Shore, February 14, 1983 3:57 pm
DIRECTORY
FileIO USING [Open, OpenFailed],
IPEncodingOut,
IPXeroxEncoding,
IO USING [Close, PutChar],
Inline USING [BITSHIFT],
Real USING [Fix],
Rope USING [ActionType, Fetch, Length, Map, MaxLen, ROPE],
Ieee USING [Ext, Unpack];
IPEncodingOutImpl: CEDAR PROGRAM
IMPORTS FileIO, Ieee, Inline, IO, IPEncodingOut, Real, Rope
EXPORTS IPEncodingOut
= BEGIN
OPEN IPEncodingOut, IPX: IPXeroxEncoding;
OpenOutputMaster: PUBLIC PROCEDURE[name: Rope.ROPE] RETURNS [h: Handle] = {
h ← Handle[FileIO.Open[name, overwrite !
FileIO.OpenFailed => CHECKED {ERROR Error[FileNotAvailable]}]];
h.WriteInterpressHeader[];
};
CloseMaster: PUBLIC PROCEDURE[h: Handle] = {
h.Close[];
};
AppendOp: PUBLIC PROCEDURE[h: Handle, op: IPX.EncodingValue] = {
val: CARDINALLOOPHOLE[op];
IF val <= 31 THEN h.AppendByte[128+val]
ELSE {
h.AppendByte[160+val/256];
h.AppendByte[val MOD 256];
};
};
AppendByte: PUBLIC PROCEDURE[h: Handle, val: CARDINAL] = {
h.PutChar[LOOPHOLE[val, CHAR]];
};
AppendSequenceDescriptor: PUBLIC PROCEDURE[h: Handle, type: IPX.SequenceType, length: NAT] = {
val: CARDINALLOOPHOLE[type];
IF length < 0 OR length > 16777215 THEN EncodingRangeError[];
IF length < 255 THEN {
h.AppendByte[192+val];
h.AppendByte[length]; }
ELSE {
h.AppendByte[224+val];
h.AppendInt[length, 3]; };
};
AppendString: PUBLIC PROCEDURE[h: Handle, length: NAT, proc: PROC RETURNS[c: [0..255]]] = {
i: NAT;
h.AppendSequenceDescriptor[sequenceString, length];
FOR i IN [0..length) DO
h.AppendByte[proc[]];
ENDLOOP;
};
AppendRope: PUBLIC PROCEDURE [h: Handle, rope: Rope.ROPE, start: INT ← 0, len: INT ← Rope.MaxLen] = {
length: INTMIN[len, rope.Length[]-start];
index: INT;
BlowIfEscape: PROCEDURE [c: CHAR] RETURNS [BOOL] = {RETURN [c = 377C];};
IF Rope.Map[rope, start, len, LOOPHOLE[BlowIfEscape, Rope.ActionType]] OR (length = 0) THEN
ERROR Error[RopeEncodingError]
ELSE {
h.AppendSequenceDescriptor[sequenceString, length];
FOR index IN [start..start+length) DO
h.AppendByte[LOOPHOLE[rope.Fetch[index], CARDINAL]];
ENDLOOP;
};
};
AppendReal: PUBLIC PROCEDURE[h: Handle, n: REAL] = {
f: INT;
i: INT;
ex: INTEGER;
e: Ieee.Ext ← Ieee.Unpack[n]; --UnPack returns frac and exp : n = frac*2^(exp-31) not signed.
-- adjust sign on mantissa and shift down to get 24 bits of mantissa.
f ← IF e.det.sign THEN -(e.frac.lc/256) ELSE e.frac.lc/256;
IF (e.exp >= 0) AND (e.exp <= 25) AND (n = (i←Real.Fix[n])) THEN
h.AppendInteger[i] -- number is vanilla integer
ELSE {
ex ← e.exp-23; --adjust exponent so that mantissa is integer.
IF ex < 0 THEN h.Append2Rational[f, ABS[ex]] -- must divide integer by power of 2.
ELSE h.AppendLongInteger[f, ex] -- must add extra bits to integer.
};
};
AppendInteger: PUBLIC PROCEDURE[h: Handle, i: INT] = {
bn: CARDINAL;
IF i IN [-4000..28767] THEN h.AppendInt[4000+i, 2]
ELSE {
bn ← BytesInInteger[i];
h.AppendSequenceDescriptor[sequenceInteger, bn];
h.AppendInt[i, bn];
};
};
AppendRational: PUBLIC PROCEDURE [h: Handle, i, j: INT] = {
c, bn, bd: CARDINAL;
bn ← BytesInInteger[i];
bd ← BytesInInteger[j];
c ← MAX[bn,bd];
h.AppendSequenceDescriptor[sequenceRational, 2*c];
h.AppendInt[i, c];
h.AppendInt[j, c];
};
Append2Rational: PUBLIC PROCEDURE [h: Handle, i: INT, e: INTEGER] = {
d, c, bn, bd: CARDINAL;
j: INT ← i;
d ← 0;
-- right shift off zeros and decrement byte count of denom.
IF j = 0 THEN {
h.AppendInteger[0];
RETURN;
};
UNTIL j MOD 256 # 0 DO j ← j/256; d ← d+1; ENDLOOP;
bn ← BytesInInteger[j];
bd ← e/8+1-d;
c ← MAX[bn,bd];
h.AppendSequenceDescriptor[sequenceRational, 2*c];
h.AppendInt[j, c];
h.Append2Int[e-8*d, c];
};
AppendLongInteger: PUBLIC PROCEDURE [h: Handle, f: INT, e: CARDINAL] = {
bn, bt: INTEGER;
i, j: INT;
i ← e MOD 8;
j ← f*LOOPHOLE[Inline.BITSHIFT[1,i], INTEGER];
bn ← BytesInInteger[j];
bt ← e/8;
h.AppendSequenceDescriptor[sequenceInteger, bn+bt];
h.AppendInt[j, bn];
THROUGH [0..bt) DO h.AppendByte[0]; ENDLOOP;
};
AppendInt: PUBLIC PROCEDURE [h: Handle, i: INT, c: CARDINAL] = {
a: PACKED ARRAY [0..3] OF [0..255];
bi: CARDINAL ← BytesInInteger[i];
IF bi > c THEN EncodingRangeError[];
THROUGH [0..c-bi) DO
IF i < 0 THEN h.AppendByte[255] ELSE h.AppendByte[0];--store leading 1's or 0's
ENDLOOP;
a ← LOOPHOLE[i];
IF bi > 3 THEN h.AppendByte[a[2]];
IF bi > 2 THEN h.AppendByte[a[3]];
IF bi > 1 THEN h.AppendByte[a[0]];
IF bi > 0 THEN h.AppendByte[a[1]];
};
Append2Int: PUBLIC PROCEDURE [h: Handle, e: CARDINAL, c: CARDINAL] = {
bi: CARDINAL ← e/8+1;
IF bi > c THEN EncodingRangeError[];
THROUGH [0..c-bi) DO h.AppendByte[0]; ENDLOOP; -- store leading 0's
h.AppendByte[Inline.BITSHIFT[1,e MOD 8]];
THROUGH [0..bi-1) DO h.AppendByte[0]; ENDLOOP; -- store trailing 0's
};
AppendIdentifier: PUBLIC PROCEDURE [h: Handle, id: Rope.ROPE, start: INT ← 0, len: INT ← Rope.MaxLen] = {
length: INTMIN[len, id.Length[]-start];
j: NAT;
h.AppendSequenceDescriptor[sequenceIdentifier, length];
FOR j IN [start..start+length) DO
h.AppendByte[LOOPHOLE[Rope.Fetch[id, j], CARDINAL]];
ENDLOOP;
};
BytesInInteger: PUBLIC PROCEDURE [n: INT] RETURNS [CARDINAL] = {
IF ABS[n] = 0 THEN RETURN[0];
IF ABS[n] > 37777777B AND LOOPHOLE[n, LONG CARDINAL] # 37740000000B THEN RETURN[4];
IF ABS[n] > 77777B AND LOOPHOLE[n, LONG CARDINAL] # 37777700000B THEN RETURN[3];
IF ABS[n] > 127 AND n # -128 THEN RETURN[2];
RETURN[1];
};
WriteInterpressHeader: PUBLIC PROCEDURE [h: Handle] = { --Interpress/Xerox/1.0 --
h.AppendByte[73]; -- I
h.AppendByte[110]; -- n
h.AppendByte[116]; -- t
h.AppendByte[101]; -- e
h.AppendByte[114]; -- r
h.AppendByte[112]; -- p
h.AppendByte[114]; -- r
h.AppendByte[101]; -- e
h.AppendByte[115]; -- s
h.AppendByte[115]; -- s
h.AppendByte[47]; -- /
h.AppendByte[88]; -- X
h.AppendByte[101]; -- e
h.AppendByte[114]; -- r
h.AppendByte[111]; -- o
h.AppendByte[120]; -- x
h.AppendByte[47]; -- /
h.AppendByte[50]; -- 2
h.AppendByte[46]; -- .
h.AppendByte[48]; -- 0
h.AppendByte[32]; -- 
};
EncodingRangeError: SIGNAL = CODE;
Error: PUBLIC ERROR [errorCode: ErrorCode] = CODE;
END.
Change Log
Created by Warnock; Mar 1982 as IPEncodingImpl
Changed by Shore; August 27, 1982 11:30 am
segmented Output routines and Cedarized
Changed by Shore; September 4, 1982 3:08 pm
modified to use Doug's latest IPXeroxEncoding
Changed by Shore; September 24, 1982 1:27 pm
made changes suggested by Sproull -- AppendRope now here, etc.
Changed by Shore; October 12, 1982 10:16 pm
updated for Cedar 3.4
Change by Shore; November 11, 1982 2:17 pm
change to Cedar.Style and added node styles
Changed by Shore; January 19, 1983 4:04 pm
changed to CEDAR, Interpress 2.0 and new node styles
Changed by Shore; January 30, 1983 1:11 pm
fixed bug in AppendRope with empty string