<> <> <> <> <> <> <> <> <> <> <> <> DIRECTORY Arpa USING [Address, nullAddress], Ascii USING [caseOffset, Digit, Lower], Atom USING [GetPName], AtomPrivate USING [UnsafeMakeAtom], Basics USING [LowHalf, UnsafeBlock], BasicTime USING [DayOfWeek, GetZoneAndDST, GMT, minutesPerHour, MonthOfYear, Unpack, Unpacked, UnpackZ, unspecifiedZone, Zone, ZoneAndDST], Convert USING [ErrorType, NetFormat, RealPrecision, TimePrecision], DReal, IO USING [card, char, DEL, Error, ErrorCode, GetIndex, GetTime, GetUnpackedTime, NUL, PutChar, PutFLR, PutFR, RIS, SP, STREAM], PreDebug USING [RegisterErrorExplainer], Real USING [DefaultSinglePrecision, Exception, ExceptionFlags, Extended, MaxSinglePrecision, NumberType, PairToReal, RealException, RealToPair], RefText USING [Append, AppendChar, AppendRope, AppendTextRope, ObtainScratch, ReleaseScratch, ReserveChars, TrustTextRopeAsText], Rope USING [ActionType, Concat, Equal, Fetch, FetchType, FromProc, FromRefText, Index, Length, Map, MapType, MaxLen, MoveType, ROPE, Substr, Text], RuntimeError USING [BoundsFault], XNS USING [Address, broadcastHost, broadcastNet, GetThisHost, Host, Net, Socket, unknownAddress, unknownNet, unknownSocket]; IOConvertImpl: CEDAR PROGRAM IMPORTS Ascii, Atom, AtomPrivate, Basics, BasicTime, DReal, IO, PreDebug, Real, Rope, RefText, RuntimeError, XNS EXPORTS Convert SHARES Rope = BEGIN OPEN Basics; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; NetFormat: TYPE = Convert.NetFormat; Base: TYPE = [2..36]; RealPrecision: TYPE = Convert.RealPrecision; DRealPrecision: TYPE = [0..DReal.MaxDoublePrecision]; TimePrecision: TYPE = Convert.TimePrecision; ErrorType: TYPE = Convert.ErrorType; -- { syntax, overflow, empty } Error: PUBLIC ERROR [reason: ErrorType, index: INT] = CODE; AtomFromErrorType: PUBLIC PROC [type: ErrorType] RETURNS [ATOM] ~ { SELECT type FROM syntax => RETURN[$syntax]; overflow => RETURN[$overflow]; empty => RETURN[$empty]; invalidBase => RETURN[$invalidBase]; unprintableAtom => RETURN[$unprintableAtom]; invalidNetFormat => RETURN[$invalidNetFormat]; ENDCASE => RETURN[NIL]; }; ErrorTypeFromAtom: PUBLIC PROC [atom: ATOM] RETURNS [ErrorType] ~ { SELECT atom FROM $syntax => RETURN[syntax]; $overflow => RETURN[overflow]; $empty => RETURN[empty]; $invalidBase => RETURN[invalidBase]; $unprintableAtom => RETURN[unprintableAtom]; $invalidNetFormat => RETURN[invalidNetFormat]; ENDCASE => RETURN[ErrorType.LAST]; }; <> CardFromDecimalLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL ¬ FALSE; num: CARD ¬ 0; decBase: CARD = 10D; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c ¬ r.Fetch[i]) FROM IN ['0..'9] => { IF num > CARD[(LCLAST-(decBase-1))]/decBase AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/decBase THEN ERROR Error[$overflow, i]; num ¬ num * decBase + CARD[c.ORD-'0.ORD]; digitSeen ¬ TRUE; }; 'D, 'd => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num ¬ ParseScaleFactor[decBase, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN EXIT; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; IF NOT digitSeen THEN ERROR Error[$empty, rLength-1]; RETURN [num]; }; LCLAST: CARD = LAST[CARD]; ParseScaleFactor: PROC [base: NAT, accum: CARD, r: ROPE, index: INT] RETURNS [CARD] = { bound: CARD = LCLAST/CARD[base]; decBase: CARD = 10D; scale: CARDINAL ¬ 0; c: CHAR; FOR i: INT IN [index+1..r.Length[]) DO IF (c ¬ r.Fetch[i]) IN ['0..'9] THEN { IF scale > CARD[(LCLAST-(decBase-1))]/decBase THEN ERROR Error[$overflow, i]; scale ¬ scale * 10 + CARD[c.ORD-'0.ORD]; } ELSE IF c IN [IO.NUL..IO.SP] THEN EXIT ELSE ERROR Error[$syntax, i]; ENDLOOP; UNTIL scale = 0 DO IF accum > bound THEN ERROR Error[$overflow, r.Length[]-1]; accum ¬ accum * base; scale ¬ scale - 1; ENDLOOP; RETURN [accum]; }; CardFromOctalLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL ¬ FALSE; num: CARD ¬ 0; FOR i: INT IN [start..rLength) DO c: CHAR; octalBase: CARD = 10B; SELECT (c ¬ r.Fetch[i]) FROM IN ['0..'7] => { IF num > CARD[(LCLAST-(octalBase-1))]/octalBase AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/octalBase THEN ERROR Error[$overflow, i]; num ¬ num * octalBase + CARD[c.ORD-'0.ORD]; digitSeen ¬ TRUE; }; 'B, 'b => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num ¬ ParseScaleFactor[octalBase, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN ERROR Error[$syntax, i]; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; ERROR Error[$empty, rLength-1]; }; CardFromHexLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL ¬ FALSE; num: CARD ¬ 0; hexBase: CARD ¬ 10H; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c ¬ Ascii.Lower[r.Fetch[i]]) FROM IN ['0..'9] => { IF num > CARD[(LCLAST-(hexBase-1))]/hexBase AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/hexBase THEN ERROR Error[$overflow, i]; num ¬ num * hexBase + CARD[c.ORD-'0.ORD]; digitSeen ¬ TRUE; }; IN ['a..'f] => { IF num > CARD[(LCLAST-(hexBase-1))]/hexBase AND num > (LCLAST-LOOPHOLE[c.ORD-(('a).ORD-10),CARDINAL])/hexBase THEN ERROR Error[$overflow, i]; num ¬ num * hexBase + CARD[c.ORD-(('a).ORD-10)]; digitSeen ¬ TRUE; }; 'h => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num ¬ ParseScaleFactor[hexBase, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN ERROR Error[$syntax, i]; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; ERROR Error[$empty, rLength-1]; }; CardFromWholeNumberLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CARD] = { rLength: INT = r.Length[]; radixChar: CHAR = FindRadix[r, start]; RETURN [(SELECT radixChar FROM 'd => CardFromDecimalLiteral, 'b => CardFromOctalLiteral, 'h => CardFromHexLiteral ENDCASE => ERROR)[r, start]] }; FindRadix: PROC [r: ROPE, start: INT] RETURNS [CHAR] ~ { rLength: INT = r.Length[]; radixChar: CHAR ¬ 'd; FOR i: INT IN [start .. rLength) DO c: CHAR; SELECT (c ¬ Ascii.Lower[r.Fetch[i]]) FROM 'b, 'd, 'h => radixChar ¬ c; ENDCASE; ENDLOOP; RETURN [radixChar] }; maxDINT: DCARD ~ 7FFFFFFFFFFFFFFFH; -- DINT.LAST DIntFromRope: PUBLIC PROC [r: ROPE] RETURNS [DINT] = { rLength: INT = r.Length[]; start: INT ¬ 0; neg: BOOL ¬ FALSE; mag: DCARD ¬ 0; WHILE start < rLength AND r.Fetch[start] IN['\000..' ] DO start ¬ start + 1 ENDLOOP; IF start >= rLength THEN ERROR Error[$syntax, start]; SELECT r.Fetch[start] FROM '- => {neg ¬ TRUE; start ¬ start+1}; '+ => {start ¬ start+1}; ENDCASE; mag ¬ DCardFromWholeNumberLiteral[r, start]; IF mag > maxDINT + ORD[neg] THEN Error[$overflow, rLength]; RETURN [IF neg THEN -mag ELSE mag]; }; DCardFromWholeNumberLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [DCARD] = { <> rLength: INT = r.Length[]; radixChar: CHAR = FindRadix[r, start]; radix: CARD = SELECT radixChar FROM 'b => 8, 'h => 16, ENDCASE => 10; value: DCARD ¬ 0; WHILE start < rLength AND r.Fetch[start] IN['\000..' ] DO start ¬ start + 1 ENDLOOP; IF start >= rLength THEN ERROR Error[$syntax, start]; FOR i: INT IN [start..rLength) DO c: CHAR = Ascii.Lower[r.Fetch[i]]; prev: DCARD ¬ value; digit: CARD ¬ 0; IF c = radixChar THEN { IF i+1 < rLength THEN { scale: CARD = CardFromWholeNumberLiteral[r, i+1]; value ¬ value * (radix**scale); IF value < prev THEN Error[$overflow, i]; }; EXIT; }; SELECT c FROM IN ['0..'9] => digit ¬ (c-'0); IN ['a..'f] => digit ¬ (c-'a+10); ENDCASE => Error[$syntax, i]; IF digit >= radix THEN Error[$syntax, i]; value ¬ (value * radix) + digit; IF value < prev THEN Error[$overflow, i]; ENDLOOP; RETURN [value] }; RealFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [REAL] ~ { <> state: {begin, int, dot, frac, estart, esign, exp, error} ¬ begin; index: INT ¬ start; -- index in rope of current char fr: INT ¬ 0; -- mantissa exp, adj: INTEGER ¬ 0; -- exponent and adjustment eNeg: BOOL ¬ FALSE; mDigits, eDigits: NAT ¬ 0; -- significant digits MDigit: PROC[c: CHAR] ~ { d: [0..10) ~ c-'0; IF state=frac THEN adj ¬ adj-1; IF mDigits=0 AND d=0 THEN NULL -- leading zero ELSE IF mDigits<9 THEN { fr ¬ fr*10+d; mDigits ¬ mDigits+1 } ELSE { adj ¬ adj+1; IF mDigits=9 AND d>5 THEN fr ¬ fr+1; }; -- round if 10th digit >5 }; EDigit: PROC[c: CHAR] ~ { d: [0..10) ~ c-'0; IF eDigits=0 AND d=0 THEN NULL -- leading zero ELSE IF eDigits<3 THEN { exp ¬ exp*10+d; eDigits ¬ eDigits+1 } ELSE ERROR Error[reason: $overflow, index: index]; }; action: Rope.ActionType ~ { SELECT state FROM begin => SELECT c FROM IN['\000..' ] => NULL; -- leading white space IN['0..'9] => { state ¬ int; MDigit[c] }; '. => state ¬ dot; ENDCASE => GOTO Fail; int => SELECT c FROM -- ?( + | - ) 0..9 | int 0..9 IN['0..'9] => MDigit[c]; '. => state ¬ frac; 'e, 'E => state ¬ estart; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; dot => SELECT c FROM -- ?( + | - ) . IN['0..'9] => { state ¬ frac; MDigit[c] }; ENDCASE => GOTO Fail; frac => SELECT c FROM -- int . | ?( + | - ) . 0..9 | frac 0..9 IN['0..'9] => MDigit[c]; 'e, 'E => state ¬ estart; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; estart => SELECT c FROM -- ( int | frac ) ( E | e ) IN['0..'9] => { state ¬ exp; EDigit[c] }; '+, '- => { eNeg ¬ (c='-); state ¬ esign }; ENDCASE => GOTO Fail; esign => SELECT c FROM -- ( int | frac ) ( E | e ) ( + | - ) IN['0..'9] => { state ¬ exp; EDigit[c] }; ENDCASE => GOTO Fail; exp => SELECT c FROM -- ( int | frac ) ( E | e ) ?( + | - ) 0..9 | exp 0..9 IN['0..'9] => EDigit[c]; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; ENDCASE => GOTO Fail; index ¬ index+1; EXITS Fail => { state ¬ error; RETURN[TRUE] }; }; [] ¬ Rope.Map[base: r, start: start, action: action]; SELECT state FROM int, frac, exp => NULL; -- ok begin => ERROR Error[reason: $empty, index: index]; ENDCASE => ERROR Error[reason: $syntax, index: index]; IF eNeg THEN exp ¬ -exp; RETURN[Real.PairToReal[fr: fr, exp10: exp+adj ! Real.RealException => RESUME]]; }; RopeFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [ROPE] = { new: ROPE; index: INT ¬ start + 1; end: INT ¬ r.Length[]-1; resultChars: INT ¬ 0; escaped: BOOL ¬ FALSE; getProc: PROC RETURNS [c: CHAR] = { IF index > end THEN RETURN ['\000]; c ¬ r.Fetch[index]; index ¬ index + 1; SELECT c FROM '\\ => { [c, index] ¬ ParseEscapeCode[r, index]; escaped ¬ TRUE }; '\" => { IF r.Fetch[index] # '\" THEN ERROR Error[$syntax, index]; index ¬ index + 1; escaped ¬ TRUE }; ENDCASE; resultChars ¬ resultChars + 1; }; IF r.Fetch[start] # '\" THEN ERROR Error[$syntax, start]; SELECT r.Fetch[end] FROM 'l, 'L => { end ¬ end - 2; IF r.Fetch[end+1] # '\" THEN ERROR Error[$syntax, end]; }; '\" => end ¬ end - 1; ENDCASE => ERROR Error[$syntax, end]; new ¬ Rope.FromProc[end - index + 1, getProc]; IF escaped THEN new ¬ new.Substr[0, resultChars]; RETURN [new]; }; CharFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CHAR] = { ENABLE RuntimeError.BoundsFault => ERROR Error[$syntax, start]; c: CHAR; SELECT (c ¬ r.Fetch[start]) FROM '\' => { -- preferred form: ' extendedChar IF (c ¬ r.Fetch[start ¬ start+1]) = '\\ THEN RETURN[ParseEscapeCode[r, start+1].c] ELSE RETURN[c]; }; IN ['0..'7] => { -- obsolete form: digit!...C num: INTEGER ¬ c.ORD-'0.ORD; DO SELECT (c ¬ r.Fetch[start ¬ start+1]) FROM IN ['0..'7] => { num ¬ num*10B + c.ORD-'0.ORD; IF num > 377B THEN ERROR Error[$overflow, start]; }; 'C, 'c => RETURN [VAL[num]]; ENDCASE => Error[$syntax, start]; ENDLOOP; }; ENDCASE => ERROR Error[$syntax, start]; }; ParseEscapeCode: PROC [r: ROPE, start: INT] RETURNS [c: CHAR, newIndex: INT] = { ENABLE RuntimeError.BoundsFault => ERROR Error[$syntax, start]; c ¬ r.Fetch[start]; SELECT Ascii.Lower[c] FROM 'n => c ¬ '\n; 'r => c ¬ '\r; 't => c ¬ '\t; 'b => c ¬ '\b; 'f => c ¬ '\f; 'l => c ¬ '\l; '\' => c ¬ '\'; '\" => c ¬ '\"; '\\ => c ¬ '\\; IN ['0..'3] => { num: INTEGER ¬ c.ORD-'0.ORD; FOR i: NAT IN [1..2] DO SELECT (c ¬ r.Fetch[start+i]) FROM IN ['0..'7] => num ¬ num*10B + c.ORD-'0.ORD; ENDCASE => ERROR Error[$syntax, start+i]; ENDLOOP; c ¬ VAL[num]; start ¬ start + 2; }; ENDCASE => ERROR Error[$syntax, start]; start ¬ start + 1; RETURN[c, start]; }; <<"Relaxed" parsing>> IntFromRope: PUBLIC PROC [r: ROPE, defaultBase: Base] RETURNS [INT] = { LastInt: CARD = INT.LAST; card: CARD; negative: BOOL; [card, negative] ¬ NumberFromRope[r, defaultBase, TRUE]; IF negative THEN { IF card <= LastInt+1 THEN RETURN[-card] } ELSE { IF card <= LastInt THEN RETURN[card] }; ERROR Error[$overflow, 0]; }; CardFromRope: PUBLIC PROC [r: ROPE, defaultBase: Base] RETURNS [CARD] = { RETURN[NumberFromRope[r, defaultBase, FALSE].card]; }; NumberFromRope: PROC [r: ROPE, defaultBase: Base, negativeOK: BOOL] RETURNS [card: CARD, negative: BOOL] = { <> rLength: INT = r.Length[]; start: INT ¬ 0; base: NAT = defaultBase; State: TYPE = { initial, signSeen, digitSeen }; state: State ¬ $initial; num: CARD ¬ 0; negative ¬ FALSE; FOR i: INT IN [start..rLength) DO { c: CHAR; SELECT (c ¬ Ascii.Lower[r.Fetch[i]]) FROM IN ['0..'9] => { cNum: CARDINAL = LOOPHOLE[(c.ORD-'0.ORD),CARDINAL]; IF cNum >= base THEN GOTO FindBase; IF (num > (LCLAST-9)/10 AND num > (LCLAST-cNum)/CARD[base]) THEN GOTO FindBase; num ¬ num * base + cNum; state ¬ $digitSeen; }; IN ['a..'z] => { cNum: CARDINAL = CARDINAL[c.ORD-('a.ORD-10)]; IF cNum >= base THEN GOTO FindBase; IF (num > CARD[(LCLAST-CARD[(Base.LAST-1)])]/CARD[Base.LAST] AND num > (LCLAST-cNum)/CARD[base]) THEN GOTO FindBase; num ¬ num * base + CARD[c.ORD-('a.ORD-10)]; state ¬ $digitSeen; }; '+, '- => IF state = $initial THEN { IF c = '- AND NOT negativeOK THEN GOTO Error; negative ¬ c = '-; start ¬ i+1; state ¬ $signSeen } ELSE GOTO Error; IN [IO.NUL..IO.SP] => IF state = $digitSeen THEN EXIT; ENDCASE => GOTO Error; EXITS FindBase => RETURN [CardFromWholeNumberLiteral[r, start], negative]; Error => ERROR Error[$syntax, i]; } ENDLOOP; SELECT state FROM initial, signSeen => ERROR Error[$empty, rLength]; ENDCASE => RETURN [num, negative]; }; RealFromRope: PUBLIC PROC [r: ROPE] RETURNS [REAL] = { rLength: INT = r.Length[]; start: INT ¬ 0; result: REAL; signSeen: BOOL ¬ FALSE; negative: BOOL ¬ FALSE; FOR i: INT IN [start..rLength) DO { c: CHAR; SELECT (c ¬ Ascii.Lower[r.Fetch[i]]) FROM IN ['0..'9], '. => { start ¬ i; EXIT }; '+, '- => IF NOT signSeen THEN { negative ¬ c = '-; start ¬ i+1; EXIT } ELSE GOTO Error; IN [IO.NUL..IO.SP] => NULL; ENDCASE => GOTO Error; EXITS Error => ERROR Error[$syntax, i]; } ENDLOOP; result ¬ RealFromLiteral[r, start]; RETURN [IF negative THEN -result ELSE result]; }; TimeFromRope: PUBLIC PROC [r: ROPE] RETURNS [BasicTime.GMT] = { RETURN [IO.GetTime[IO.RIS[r] ! IO.Error => SELECT ec FROM $SyntaxError => ERROR Error[$syntax, stream.GetIndex[]]; $Overflow => ERROR Error[$overflow, stream.GetIndex[]]; ENDCASE]]; }; UnpackedTimeFromRope: PUBLIC PROC [r: ROPE] RETURNS [BasicTime.Unpacked] = { RETURN [IO.GetUnpackedTime[IO.RIS[r] ! IO.Error => IF ec = $SyntaxError THEN ERROR Error[$syntax, stream.GetIndex[]]]]; }; BoolFromRope: PUBLIC PROC [r: ROPE] RETURNS [BOOL] = { IF MatchPrefix[r, "true"] THEN RETURN [TRUE]; IF MatchPrefix[r, "false"] THEN RETURN [FALSE]; IF MatchPrefix[r, "yes"] THEN RETURN [TRUE]; IF MatchPrefix[r, "no"] THEN RETURN [FALSE]; ERROR Error[$syntax, 0]; }; MatchPrefix: PROC [r: ROPE, pat: Rope.Text] RETURNS [BOOL] = { patLen: INT = pat.Length[]; fail: BOOL ¬ patLen = 0; index: INT ¬ 0; match: PROC [c: CHAR] RETURNS [quit: BOOL ¬ FALSE] = { IF index < patLen THEN { IF pat.Fetch[index] = Ascii.Lower[c] THEN index ¬ index+1 ELSE fail ¬ TRUE; RETURN [quit: fail] } ELSE IF c IN [IO.NUL..IO.SP] THEN RETURN [quit: TRUE]; }; [] ¬ r.Map[action: match]; RETURN [NOT fail]; }; AtomFromRope: PUBLIC PROC [r: ROPE] RETURNS [ATOM] = { rLength: INT = r.Length[]; result: ATOM; start: INT ¬ 0; IF start >= rLength THEN ERROR Error[$syntax, start]; IF r.Fetch[start] = '$ THEN start ¬ start+1; { scratch: REF TEXT = RefText.ObtainScratch[rLength-start]; len: NAT ¬ rLength-start; FOR i: NAT IN [0 .. len) DO scratch[i] ¬ r.Fetch[start+i]; ENDLOOP; scratch.length ¬ len; TRUSTED { result ¬ AtomPrivate.UnsafeMakeAtom[LOOPHOLE[scratch]] }; RefText.ReleaseScratch[scratch]; }; RETURN [result]; }; <> AppendInt: PUBLIC PROC [to: REF TEXT, from: INT, base: Base, showRadix: BOOL] RETURNS [REF TEXT] = { RETURN[AppendWholeNumber[to, LOOPHOLE[from.ABS], base, from<0, showRadix]]; }; AppendCard: PUBLIC PROC [to: REF TEXT, from: CARD, base: Base ¬ 10, showRadix: BOOL ¬ FALSE] RETURNS [REF TEXT] = { RETURN[AppendWholeNumber[to, from, base, FALSE, showRadix]]; }; AppendWholeNumber: PROC [ to: REF TEXT, from: CARD, base: NAT, negative: BOOL, showRadix: BOOL] RETURNS [REF TEXT] = { stack: ARRAY [0..31] OF CHAR; nChars: NAT ¬ 0; IF showRadix THEN { SELECT base FROM 10 => NULL; 8, 16 => { stack[0] ¬ IF base = 8 THEN 'B ELSE 'H; nChars ¬ 1 }; ENDCASE => ERROR Error[$invalidBase, 0]; } ELSE IF base NOT IN [2..36] THEN ERROR Error[$invalidBase, 0]; DO digit: NAT ¬ from MOD CARD[base]; stack[nChars] ¬ VAL[IF digit < 10 THEN '0.ORD + digit ELSE 'A.ORD + (digit-10)]; nChars ¬ nChars + 1; IF from < CARD[base] THEN EXIT; from ¬ from / CARD[base]; ENDLOOP; IF negative THEN { stack[nChars] ¬ '-; nChars ¬ nChars + 1; }; to ¬ RefText.ReserveChars[to, nChars]; { newLengthMinusOne: NAT = to.length + nChars - 1; FOR i: NAT DECREASING IN [0 .. nChars) DO to[newLengthMinusOne-i] ¬ stack[i]; ENDLOOP; to.length ¬ newLengthMinusOne + 1; }; RETURN[to]; }; AppendDCard: PUBLIC PROC [to: REF TEXT, from: DCARD, base: Base ¬ 10, showRadix: BOOL ¬ TRUE ] RETURNS [REF TEXT] ~ { IF from <= CARD.LAST THEN {RETURN [AppendCard[to, from, base, showRadix]]} ELSE { cbase: CARD ¬ base; digit: CARD ¬ from MOD cbase; to ¬ AppendDCard[to, from/cbase, base, FALSE]; RETURN [AppendCard[to, digit, base, showRadix]]; }; }; AppendReal: PUBLIC PROC [to: REF TEXT, from: REAL, precision: RealPrecision, useE: BOOL ¬ FALSE] RETURNS [REF TEXT] = TRUSTED { IF useE THEN RETURN [AppendE[to, from, precision]] ELSE RETURN [AppendG[to, from, precision]]; }; <> gconvert: UNSAFE PROC [value: DREAL, ndigit: INT, trailing: INT, buf: POINTER TO CHAR] ~ UNCHECKED MACHINE CODE { "+#define gconvert_help(v,n,t,b) (void)gconvert(*((double*) (&(v))),n,t,b)\n"; ".gconvert_help" }; fieldwidth: INT ¬ 7+precision; i: NAT ¬ to.length; hasDot: BOOL ¬ FALSE; to ¬ RefText.ReserveChars[to, fieldwidth+6]; gconvert[value: from, ndigit: precision, trailing: 0, buf: LOOPHOLE[to, POINTER TO CHAR]+SIZE[TEXT[0]]+to.length]; UNTIL to[i]=0C DO IF to[i] = '. THEN hasDot ¬ TRUE; i ¬ i + 1 ENDLOOP; to.length ¬ i; IF NOT hasDot THEN to ¬ RefText.Append[to, ".0"]; RETURN [to] };>> AppendDecimalDigits: PROC [to: REF TEXT, c: CARD, nDigits: [0..9]] RETURNS [REF TEXT] ~ { to ¬ RefText.ReserveChars[to, nDigits]; FOR j: NAT DECREASING IN [to.length..to.length+nDigits) DO to[j] ¬ '0 + (c MOD 10); c ¬ c / 10; ENDLOOP; to.length ¬ to.length+nDigits; RETURN [to] }; AppendDReal: PUBLIC PROC [to: REF TEXT, from: DREAL, precision: DRealPrecision, useE: BOOL ¬ FALSE] RETURNS [REF TEXT] ~ TRUSTED { <> type: Real.NumberType; d: DINT; exp10: INTEGER; precision ¬ MAX[precision, 1]; [type, d, exp10] ¬ DReal.RealToPair[from, precision]; SELECT type FROM zero => { to ¬ RefText.Append[to, "0.0"] }; infinity => { to ¬ RefText.AppendChar[to, IF from < 0.0 THEN '- ELSE '+]; to ¬ RefText.Append[to, "Inf"]; }; nan => { to ¬ RefText.Append[to, "NaN"]; }; ENDCASE => { IF d < 0 THEN { to ¬ RefText.AppendChar[to, '-]; d ¬ - d }; to ¬ RefText.Append[to, "0."]; IF precision > 9 THEN { to ¬ AppendDecimalDigits[to, d / 1d9, precision-9]; to ¬ AppendDecimalDigits[to, d MOD 1d9, 9]; } ELSE { to ¬ AppendDecimalDigits[to, d, precision]; }; to ¬ RefText.AppendChar[to, 'e]; to ¬ AppendInt[to, exp10 + precision, 10, FALSE]; }; RETURN [to] }; AppendTime: PUBLIC PROC [to: REF TEXT, from: BasicTime.GMT, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [REF TEXT] = { RETURN[AppendUnpackedTime[ to, BasicTime.Unpack[from], start, end, includeDayOfWeek, useAMPM, includeZone]]; }; AppendUnpackedTime: PUBLIC PROC [to: REF TEXT, from: BasicTime.Unpacked, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [REF TEXT] = { ok: PACKED ARRAY TimePrecision OF BOOL ¬ ALL[FALSE]; FOR p: TimePrecision IN TimePrecision[start..end] DO ok[p] ¬ TRUE ENDLOOP; IF includeDayOfWeek THEN { to ¬ RefText.AppendTextRope[to, Day[from.weekday]]; IF ok # ALL[FALSE] THEN to ¬ RefText.AppendTextRope[to, ", "] }; IF ok[months] THEN { to ¬ RefText.AppendTextRope[to, Month[from.month]]; IF ok[days] OR ok[years] OR ok[hours] THEN to ¬ RefText.AppendChar[to, ' ] }; IF ok[days] THEN { to ¬ AppendCard[to, from.day, 10, FALSE]; IF ok[years] OR ok[hours] THEN to ¬ RefText.AppendTextRope[to, ", "] }; IF ok[years] THEN { to ¬ AppendCard[to, from.year, 10, FALSE]; IF ok[hours] THEN to ¬ RefText.AppendChar[to, ' ] }; IF ok[hours] THEN { to ¬ AppendCard[ to, IF useAMPM AND from.hour>12 THEN from.hour - 12 ELSE from.hour, 10, FALSE]; IF ok[minutes] THEN { to ¬ RefText.AppendChar[to, ':]; to ¬ Append2[to, from.minute]; IF ok[seconds] THEN { to ¬ RefText.AppendChar[to, ':]; to ¬ Append2[to, from.second]; }; }; IF useAMPM THEN { to ¬ RefText.AppendTextRope[to, IF from.hour >= 12 THEN " pm" ELSE " am"]; }; IF includeZone THEN { to ¬ RefText.AppendChar[to, ' ]; to ¬ AppendZone[to, from.zone, (from.dst=yes)]; }; }; RETURN[to]; }; AppendTimeRFC822: PUBLIC PROC [to: REF TEXT, from: BasicTime.GMT, includeSeconds: BOOL ¬ TRUE, includeDayOfWeek: BOOL ¬ FALSE, useUT: BOOL ¬ FALSE] RETURNS [REF TEXT] = { utz: BasicTime.ZoneAndDST ~ [zone: 0, beginDST: 366, endDST: 0]; z: BasicTime.ZoneAndDST ~ IF useUT THEN utz ELSE BasicTime.GetZoneAndDST[]; RETURN [AppendUnpackedTimeRFC822[to: to, from: BasicTime.UnpackZ[from, z], includeSeconds: includeSeconds, includeDayOfWeek: includeDayOfWeek]]; }; AppendUnpackedTimeRFC822: PROC [to: REF TEXT, from: BasicTime.Unpacked, includeSeconds: BOOL ¬ TRUE, includeDayOfWeek: BOOL ¬ FALSE] RETURNS [REF TEXT] = { IF includeDayOfWeek THEN { to ¬ RefText.AppendTextRope[to: to, from: Day[from.weekday], len: 3]; to ¬ RefText.AppendTextRope[to, ", "]; }; to ¬ Append2[to, from.day]; to ¬ RefText.AppendChar[to, ' ]; to ¬ RefText.AppendTextRope[to: to, from: Month[from.month], len: 3]; to ¬ RefText.AppendChar[to, ' ]; to ¬ Append2[to, from.year MOD 100]; to ¬ RefText.AppendChar[to, ' ]; to ¬ Append2[to, from.hour]; to ¬ RefText.AppendChar[to, ':]; to ¬ Append2[to, from.minute]; IF includeSeconds THEN { to ¬ RefText.AppendChar[to, ':]; to ¬ Append2[to, from.second]; }; to ¬ RefText.AppendChar[to, ' ]; to ¬ AppendZone[to, from.zone, (from.dst=yes), TRUE]; RETURN[to]; }; MonthArray: TYPE ~ ARRAY BasicTime.MonthOfYear[January .. December] OF Rope.Text; Month: REF MonthArray ~ NEW [MonthArray ¬ ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]]; DayArray: TYPE ~ ARRAY BasicTime.DayOfWeek[Monday .. Sunday] OF Rope.Text; Day: REF DayArray ~ NEW [DayArray ¬ ["Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"]]; Append2: PROC [to: REF TEXT, from: [0..100)] RETURNS [REF TEXT] ~ { to ¬ RefText.AppendChar[to, '0+(from/10)]; to ¬ RefText.AppendChar[to, '0+(from MOD 10)]; RETURN [to]; }; AppendZone: PROC [to: REF TEXT, zone: BasicTime.Zone, dst: BOOL, useUT: BOOL ¬ FALSE] RETURNS [REF TEXT] ~ { zoneRope: ROPE ¬ NIL; metZone: BasicTime.Zone = -1*BasicTime.minutesPerHour; jstZone: BasicTime.Zone = -9*BasicTime.minutesPerHour; nZ: BasicTime.Zone ¬ zone; SELECT zone FROM jstZone => zoneRope ¬ "JST"; metZone => zoneRope ¬ "MET"; 0 => zoneRope ¬ IF useUT THEN "UT" ELSE IF dst THEN "BST" ELSE "GMT"; NAT[5*BasicTime.minutesPerHour] => zoneRope ¬ IF dst THEN "EDT" ELSE "EST"; NAT[6*BasicTime.minutesPerHour] => zoneRope ¬ IF dst THEN "CDT" ELSE "CST"; NAT[7*BasicTime.minutesPerHour] => zoneRope ¬ IF dst THEN "MDT" ELSE "MST"; NAT[8*BasicTime.minutesPerHour] => zoneRope ¬ IF dst THEN "PDT" ELSE "PST"; ENDCASE; IF ( dst AND ( zone >= -720+BasicTime.minutesPerHour ) ) THEN nZ ¬ zone - BasicTime.minutesPerHour; IF zoneRope = NIL THEN zoneRope ¬ IO.PutFR["%g%02d%02d", IO.char[IF zone < 0 THEN '- ELSE '+], IO.card[zone.ABS/BasicTime.minutesPerHour], IO.card[zone.ABS MOD BasicTime.minutesPerHour] ]; to ¬ RefText.AppendRope[to, zoneRope]; RETURN [to]; }; AppendBool: PUBLIC PROC [to: REF TEXT, from: BOOL] RETURNS [REF TEXT] = { RETURN [RefText.AppendTextRope[to, RopeFromBool[from]]]; }; AppendAtom: PUBLIC PROC [to: REF TEXT, from: ATOM, quote: BOOL] RETURNS [REF TEXT] = { pName: Rope.Text = IF from = NIL THEN "" ELSE Atom.GetPName[from]; IF quote THEN { CheckID[pName]; to ¬ RefText.AppendChar[to, '$]; }; RETURN [RefText.AppendTextRope[to, pName]]; }; CheckID: PUBLIC PROC [id: Rope.Text] = { FOR i: INT IN [0..id.Length[]) DO SELECT id.Fetch[i] FROM IN ['0..'9] => IF i = 0 THEN ERROR Error[$unprintableAtom, 0]; IN ['A..'Z], IN ['a..'z] => NULL; ENDCASE => ERROR Error[$unprintableAtom, 0]; ENDLOOP; }; AppendRope: PUBLIC PROC [to: REF TEXT, from: ROPE, quote: BOOL ¬ TRUE] RETURNS [REF TEXT] = { IF quote THEN to ¬ RefText.AppendChar[to, '\"]; FOR i: INT IN [0 .. from.Length[]) DO to ¬ AppendChar[to, Rope.Fetch[from, i], FALSE]; ENDLOOP; IF quote THEN to ¬ RefText.AppendChar[to, '\"]; RETURN [to]; }; AppendChar: PUBLIC PROC [to: REF TEXT, from: CHAR, quote: BOOL ¬ TRUE] RETURNS [REF TEXT] = { IF quote THEN to ¬ RefText.AppendChar[to, '\']; RETURN [ IF from IN [IO.SP .. IO.DEL) AND from # '\\ AND from # '\" AND from # '\' THEN RefText.AppendChar[to, from] ELSE AppendExtendedChar[to, from] ]; }; AppendExtendedChar: PROC [to: REF TEXT, c: CHAR] RETURNS [REF TEXT] = { IF c IN [IO.SP .. IO.DEL) THEN { IF c = '\\ OR c = '\" OR c = '\' THEN to ¬ RefText.AppendChar[to, '\\]; to ¬ RefText.AppendChar[to, c]; } ELSE { to ¬ RefText.AppendChar[to, '\\]; SELECT c FROM '\n => to ¬ RefText.AppendChar[to, 'n]; '\t => to ¬ RefText.AppendChar[to, 't]; '\b => to ¬ RefText.AppendChar[to, 'b]; '\f => to ¬ RefText.AppendChar[to, 'f]; '\l => to ¬ RefText.AppendChar[to, 'l]; ENDCASE => { to ¬ RefText.AppendChar[to, VAL['0.ORD + (c.ORD / 64)]]; to ¬ RefText.AppendChar[to, VAL['0.ORD + (c.ORD MOD 64 / 8)]]; to ¬ RefText.AppendChar[to, VAL['0.ORD + (c.ORD MOD 8)]] } ; }; RETURN [to]; }; RopeFromInt: PUBLIC PROC [from: INT, base: Base, showRadix: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendInt[scratch, from, base, showRadix]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromCard: PUBLIC PROC [from: CARD, base: Base, showRadix: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendCard[scratch, from, base, showRadix]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromReal: PUBLIC PROC [from: REAL, precision: RealPrecision, useE: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendReal[scratch, from, precision, useE]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromDReal: PUBLIC PROC [from: DREAL, precision: DRealPrecision, useE: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendDReal[scratch, from, precision, useE]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromTime: PUBLIC PROC [from: BasicTime.GMT, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendUnpackedTime[scratch, BasicTime.Unpack[from], start, end, includeDayOfWeek, useAMPM, includeZone]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromUnpackedTime: PUBLIC PROC [from: BasicTime.Unpacked, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendUnpackedTime[scratch, from, start, end, includeDayOfWeek, useAMPM, includeZone]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromTimeRFC822: PUBLIC PROC [from: BasicTime.GMT, includeSeconds: BOOL ¬ TRUE, includeDayOfWeek: BOOL ¬ FALSE, useUT: BOOL ¬ FALSE] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendTimeRFC822[to: scratch, from: from, includeSeconds: includeSeconds, includeDayOfWeek: includeDayOfWeek, useUT: useUT]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromBool: PUBLIC PROC [from: BOOL] RETURNS [Rope.Text] = { RETURN [IF from THEN "TRUE" ELSE "FALSE"]; }; RopeFromAtom: PUBLIC PROC [from: ATOM, quote: BOOL] RETURNS [ROPE] = { pName: Rope.Text = IF from = NIL THEN "" ELSE Atom.GetPName[from]; IF NOT quote THEN RETURN [pName]; CheckID[pName]; RETURN [Rope.Concat["$", pName]]; }; RopeFromRope: PUBLIC PROC [from: ROPE, quote: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[from.Length[]+10]; result: Rope.Text = Rope.FromRefText[AppendRope[scratch, from, quote]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromChar: PUBLIC PROC [from: CHAR, quote: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[5]; result: Rope.Text = Rope.FromRefText[AppendChar[scratch, from, quote]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; <> <<>> bufferSize: NAT = Real.MaxSinglePrecision*2 + 8; FtoRope: PUBLIC PROC [r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT ¬ RefText.ObtainScratch[bufferSize]; rope ¬ Rope.FromRefText[AppendF[scratch, r, afterDot]]; RefText.ReleaseScratch[scratch]; }; AppendF: PUBLIC PROC [buffer: REF TEXT, r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; places: INTEGER ¬ afterDot; [nType, fract, exp10] ¬ Real.RealToPair[r, Real.MaxSinglePrecision]; SELECT nType FROM normal => { fudge: REAL ¬ Real.PairToReal[5, -places-1]; abs: REAL ¬ ABS[r]; IF abs < fudge THEN { <> buffer ¬ RefText.AppendChar[buffer, '0]; GO TO restZero}; IF fract < 0 THEN { buffer ¬ RefText.AppendChar[buffer, '-]; fract ¬ -fract; }; { <> temp: REF TEXT ¬ RefText.ObtainScratch[afterDot+Real.MaxSinglePrecision+4]; tpos: NAT ¬ 0; card: CARD ¬ fract; error: {up, none, down} ¬ none; <> DO SELECT places+exp10 FROM < 0 => { <> thisDigit: [0..10) ¬ LowHalf[card MOD 10]; card ¬ card/10; exp10 ¬ exp10 + 1; SELECT thisDigit FROM = 0 => {}; > 5 => {card ¬ card + 1; error ¬ up}; = 5 => IF error = up THEN error ¬ down ELSE {card ¬ card + 1; error ¬ up}; ENDCASE => error ¬ down; }; > 0 => { <> temp[tpos] ¬ '0; tpos ¬ tpos + 1; places ¬ places - 1; IF places = 0 THEN {temp[tpos] ¬ '.; tpos ¬ tpos + 1}; }; ENDCASE => EXIT; ENDLOOP; <> DO temp[tpos] ¬ '0 + LowHalf[card MOD 10]; tpos ¬ tpos + 1; card ¬ card / 10; exp10 ¬ exp10 + 1; places ¬ places - 1; IF places = 0 THEN {temp[tpos] ¬ '.; tpos ¬ tpos + 1}; IF card = 0 AND exp10 > 0 THEN EXIT; ENDLOOP; <> WHILE tpos > 0 DO buffer ¬ RefText.AppendChar[buffer, temp[tpos ¬ tpos - 1]]; ENDLOOP; RefText.ReleaseScratch[temp]; }; }; zero => { buffer ¬ RefText.AppendChar[buffer, '0]; GO TO restZero; }; infinity => buffer ¬ RefText.AppendRope[buffer, IF fract < 0 THEN "-Inf" ELSE "+Inf"]; nan => { buffer ¬ RefText.AppendChar[buffer, '*]; buffer ¬ RefText.AppendChar[buffer, '.]; buffer ¬ AppendChars[buffer, afterDot, '*]; }; ENDCASE => ERROR; RETURN [buffer]; EXITS restZero => { IF afterDot > 0 THEN { buffer ¬ RefText.AppendChar[buffer, '.]; buffer ¬ AppendChars[buffer, afterDot, '0]}; RETURN [buffer]; }; }; EtoRope: PUBLIC PROC [r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT ¬ RefText.ObtainScratch[bufferSize]; rope ¬ Rope.FromRefText[AppendE[scratch, r, afterDot]]; RefText.ReleaseScratch[scratch]; }; AppendE: PUBLIC PROC [buffer: REF TEXT, r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; IF precision < 1 THEN precision ¬ 1; [nType, fract, exp10] ¬ Real.RealToPair[r, precision]; SELECT nType FROM normal => { abs: REAL ¬ ABS[r]; lag: CARD ¬ 1; card: CARD ¬ ABS[fract]; pos: NAT ¬ 0; IF r < 0.0 THEN buffer ¬ RefText.AppendChar[buffer, '-]; pos ¬ buffer.length; buffer ¬ RefText.AppendChar[buffer, '.]; buffer ¬ AppendWholeNumber[buffer, card, 10, FALSE, FALSE]; buffer[pos] ¬ buffer[pos+1]; buffer[pos+1] ¬ '.; buffer ¬ RefText.AppendChar[buffer, 'e]; exp10 ¬ exp10 + precision - 1; buffer ¬ RefText.AppendChar[buffer, IF exp10 < 0 THEN '- ELSE '+]; buffer ¬ AppendWholeNumber[buffer, ABS[exp10], 10, FALSE, FALSE]; }; ENDCASE => buffer ¬ AppendF[buffer, r, 1]; RETURN [buffer]; }; GtoRope: PUBLIC PROC [r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT ¬ RefText.ObtainScratch[bufferSize]; rope ¬ Rope.FromRefText[AppendG[scratch, r, precision]]; RefText.ReleaseScratch[scratch]; }; AppendG: PUBLIC PROC [buffer: REF TEXT, r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; IF precision < 1 THEN precision ¬ 1; [nType, fract, exp10] ¬ Real.RealToPair[r, precision]; SELECT nType FROM normal => { places: NAT ¬ precision; IF fract < 0 THEN { buffer ¬ RefText.AppendChar[buffer, '-]; fract ¬ ABS[fract]; r ¬ ABS[r]; }; IF exp10 > 0 THEN { <> buffer ¬ AppendE[buffer, r, precision]; GO TO done}; <> WHILE LowHalf[fract MOD 10] = 0 DO places ¬ places - 1; exp10 ¬ exp10 + 1; fract ¬ fract / 10; ENDLOOP; IF exp10 >= 0 THEN { <> buffer ¬ AppendF[buffer, r, 1]; GO TO done}; IF -exp10 <= precision THEN { <> buffer ¬ AppendF[buffer, r, -exp10]; GO TO done}; <> buffer ¬ AppendE[buffer, r, MAX[places, 2]]; EXITS done => {}; }; ENDCASE => buffer ¬ AppendF[buffer, r, 1]; RETURN [buffer]; }; PutChars: PROC [st: STREAM, chars: NAT, char: CHAR] = { THROUGH [0..chars) DO IO.PutChar[st, char]; ENDLOOP; }; AppendChars: PROC [text: REF TEXT, chars: NAT, char: CHAR] RETURNS [REF TEXT] = { THROUGH [0..chars) DO text ¬ RefText.AppendChar[text, char]; ENDLOOP; RETURN [text]; }; <> XNSFieldType: TYPE = { default, broadcast, octal, decimal, hex, notANumber }; <decimal->hex) but cannot cause it to decrease. See GetXNSFieldType[...].>> XNSAddressFromRope: PUBLIC PROC [r: ROPE] RETURNS [XNS.Address] ~ { nameLen: INT ~ Rope.Length[r]; answer: XNS.Address ¬ XNS.unknownAddress; netPart, hostPart, socketPart: ROPE ¬ NIL; netType, hostType, socketType: XNSFieldType ¬ default; <> BEGIN firstDot, secondDot: INT; firstDot ¬ Rope.Index[s1~r, s2~"."]; IF firstDot = nameLen THEN firstDot ¬ Rope.Index[s1~r, s2~"#"]; IF firstDot = nameLen THEN { <> hostPart ¬ r; hostType ¬ GetXNSFieldType[hostPart]; GOTO DoneSplit }; secondDot ¬ Rope.Index[s1~r, pos1~firstDot+1, s2~"."]; IF secondDot = nameLen THEN secondDot ¬ Rope.Index[s1~r, pos1~firstDot+1, s2~"#"]; IF secondDot = nameLen THEN { <> part1: ROPE ~ Rope.Substr[base~r, len~firstDot]; part2: ROPE ~ Rope.Substr[base~r, start~firstDot+1]; type1: XNSFieldType ~ GetXNSFieldType[part1]; type2: XNSFieldType ~ GetXNSFieldType[part2]; SELECT TRUE FROM (type1 = notANumber) AND (type2 # notANumber) => { hostPart ¬ part1; hostType ¬ type1; socketPart ¬ part2; socketType ¬ type2 }; (type1 # notANumber) AND (type2 = notANumber) => { netPart ¬ part1; netType ¬ type1; hostPart ¬ part2; hostType ¬ type2 }; ENDCASE => ERROR Error[reason~syntax, index~0]; GOTO DoneSplit }; { <> netPart ¬ Rope.Substr[base~r, len~firstDot]; netType ¬ GetXNSFieldType[netPart]; hostPart ¬ Rope.Substr[base~r, start~firstDot+1, len~secondDot-firstDot-1]; hostType ¬ GetXNSFieldType[hostPart]; socketPart ¬ Rope.Substr[base~r, start~secondDot+1]; socketType ¬ GetXNSFieldType[socketPart]; GOTO DoneSplit }; EXITS DoneSplit => NULL; END; SELECT hostType FROM default => ERROR Error[reason~syntax, index~0]; broadcast => answer.host ¬ XNS.broadcastHost; octal, decimal, hex => answer.host ¬ CvtXNSHost[hostPart, hostType]; notANumber => { IF Rope.Equal[hostPart, "ME"] THEN answer.host ¬ XNS.GetThisHost[] ELSE ERROR Error[reason~syntax, index~0]; }; ENDCASE => ERROR; SELECT netType FROM default => answer.net ¬ DefaultXNSNet[]; broadcast => answer.net ¬ XNS.broadcastNet; octal, decimal, hex => answer.net ¬ CvtXNSNet[netPart, netType]; notANumber => ERROR Error[reason~syntax, index~0]; ENDCASE => ERROR; SELECT socketType FROM default => answer.socket ¬ XNS.unknownSocket; broadcast => ERROR Error[reason~syntax, index~0]; octal, decimal, hex => answer.socket ¬ CvtXNSSocket[socketPart, socketType]; notANumber => ERROR Error[reason~syntax, index~0]; ENDCASE => ERROR; RETURN [answer]; }; XNSNetFromRope: PUBLIC PROC [r: ROPE] RETURNS [XNS.Net] ~ { type: XNSFieldType ~ GetXNSFieldType[r]; SELECT type FROM default => RETURN [DefaultXNSNet[]]; broadcast => RETURN [XNS.broadcastNet]; octal, decimal, hex => RETURN [CvtXNSNet[r, type]]; notANumber => ERROR Error[syntax, 0]; ENDCASE => ERROR; }; XNSHostFromRope: PUBLIC PROC [r: ROPE] RETURNS [XNS.Host] ~ { type: XNSFieldType ~ GetXNSFieldType[r]; SELECT type FROM default => RETURN [XNS.GetThisHost[]]; broadcast => RETURN [XNS.broadcastHost]; octal, decimal, hex => RETURN [CvtXNSHost[r, type]]; notANumber => { IF Rope.Equal[r, "ME"] THEN RETURN [XNS.GetThisHost[]]; ERROR Error[syntax, 0] }; ENDCASE => ERROR; }; XNSSocketFromRope: PUBLIC PROC [r: ROPE] RETURNS [XNS.Socket] ~ { type: XNSFieldType ~ GetXNSFieldType[r]; SELECT type FROM default => RETURN [XNS.unknownSocket]; broadcast => ERROR Error[syntax, 0]; octal, decimal, hex => RETURN [CvtXNSSocket[r, type]]; notANumber => ERROR Error[syntax, 0]; ENDCASE => ERROR; }; <<>> DefaultXNSNet: PROC RETURNS [default: XNS.Net ¬ XNS.unknownNet] ~ { <> <> ERROR Error[empty, 0]; -- Not yet implemented - waiting on CommDriver.GetNetworkChain }; bnSize: NAT ~ 6; BigNum: TYPE ~ ARRAY[0..bnSize) OF CARDINAL; <> CvtXNSHost: PROC [rope: ROPE, type: XNSFieldType] RETURNS [XNS.Host] ~ { n: BigNum ~ CvtXNS[rope, type]; RETURN [ [a~n[0], b~n[1], c~n[2], d~n[3], e~n[4], f~n[5]] ] }; CvtXNSNet: PROC [rope: ROPE, type: XNSFieldType] RETURNS [XNS.Net] ~ { n: BigNum ~ CvtXNS[rope, type]; RETURN [ [hi~[hi~n[2], lo~n[3]], lo~[hi~n[4], lo~n[5]]] ] }; CvtXNSSocket: PROC [rope: ROPE, type: XNSFieldType] RETURNS [XNS.Socket] ~ { n: BigNum ~ CvtXNS[rope, type]; RETURN [ [hi~n[4], lo~n[5]] ] }; CvtXNS: PROC [rope: ROPE, type: XNSFieldType] RETURNS [BigNum] ~ { n: BigNum ¬ ALL [0]; base: CARDINAL; len: CARDINAL; c: CHAR; MulAdd: PROC [increment: CARDINAL] ~ { FOR i: CARDINAL DECREASING IN [0..bnSize) DO temp: CARDINAL ¬ n[i] * base + increment; n[i] ¬ temp MOD 100H; increment ¬ temp / 100H; ENDLOOP; }; base ¬ SELECT type FROM octal => 8, decimal => 10, ENDCASE => 16; IF (len ¬ Rope.Length[rope]) = 0 THEN ERROR; c ¬ Rope.Fetch[rope, len-1]; SELECT TRUE FROM (type = octal) AND ((c = 'B) OR (c = 'b)) => len ¬ len - 1; (type = hex) AND ((c = 'H) OR (c = 'h)) => len ¬ len - 1; ENDCASE => NULL; FOR i: CARDINAL IN [0..len) DO SELECT (c ¬ Rope.Fetch[rope,i]) FROM IN ['0..'9] => MulAdd[c - '0]; IN ['A..'F] => MulAdd[(c - 'A) + 10]; IN ['a..'f] => MulAdd[(c - 'a) + 10]; ENDCASE => NULL; ENDLOOP; RETURN [n]; }; GetXNSFieldType: PROC [rope: ROPE] RETURNS [type: XNSFieldType] ~ { limit: CARDINAL; IF (limit ¬ Rope.Length[rope]) = 0 THEN RETURN [default]; limit ¬ limit - 1; IF Rope.Equal[rope, "*"] THEN RETURN [broadcast]; type ¬ (SELECT Rope.Fetch[rope, 0] FROM IN ['0 .. '7] => octal, IN ['8 .. '9] => decimal, ENDCASE => notANumber); FOR i: CARDINAL IN [1 .. limit) WHILE type < notANumber DO SELECT Rope.Fetch[rope, i] FROM IN ['0 .. '7] => type ¬ MAX[type, octal]; IN ['8 .. '9] => type ¬ MAX[type, decimal]; IN ['A .. 'F], IN ['a .. 'f] => type ¬ MAX[type, hex]; '- => type ¬ (IF type <= decimal THEN decimal ELSE notANumber); ENDCASE => type ¬ notANumber; ENDLOOP; IF limit > 0 THEN SELECT Rope.Fetch[rope, limit] FROM IN ['0 .. '9], 'D, 'd => type ¬ MAX[type, decimal]; 'B, 'b => type ¬ MAX[type, octal]; IN ['A .. 'F], IN ['a .. 'f], 'H, 'h => type ¬ MAX[type, hex]; ENDCASE => type ¬ notANumber; }; <<>> RopeFromXNSAddress: PUBLIC PROC [address: XNS.Address, format: NetFormat] RETURNS [rope: ROPE] ~ { scratch: REF TEXT ¬ RefText.ObtainScratch[40]; rope ¬ Rope.FromRefText[scratch ¬ AppendXNSAddress[scratch, address, format]]; RefText.ReleaseScratch[scratch]; }; RopeFromXNSNet: PUBLIC PROC [net: XNS.Net, format: NetFormat] RETURNS [rope: ROPE] ~ { scratch: REF TEXT ¬ RefText.ObtainScratch[20]; rope ¬ Rope.FromRefText[scratch ¬ AppendXNSNet[scratch, net, format]]; RefText.ReleaseScratch[scratch]; }; RopeFromXNSHost: PUBLIC PROC [host: XNS.Host, format: NetFormat] RETURNS [rope: ROPE] ~ { scratch: REF TEXT ¬ RefText.ObtainScratch[20]; rope ¬ Rope.FromRefText[scratch ¬ AppendXNSHost[scratch, host, format]]; RefText.ReleaseScratch[scratch]; }; RopeFromXNSSocket: PUBLIC PROC [socket: XNS.Socket, format: NetFormat] RETURNS [rope: ROPE] ~ { scratch: REF TEXT ¬ RefText.ObtainScratch[20]; rope ¬ Rope.FromRefText[scratch ¬ AppendXNSSocket[scratch, socket, format]]; RefText.ReleaseScratch[scratch]; }; AppendXNSAddress: PUBLIC PROC [to: REF TEXT, address: XNS.Address, format: NetFormat] RETURNS [REF TEXT] ~ { <> <> IF address.net = XNS.broadcastNet THEN to ¬ RefText.AppendChar[to, '* ] ELSE to ¬ FmtXNS[to, [0, 0, address.net.hi.hi, address.net.hi.lo, address.net.lo.hi, address.net.lo.lo], format]; to ¬ RefText.AppendChar[to, '. ]; IF address.host = XNS.broadcastHost THEN to ¬ RefText.AppendChar[to, '* ] ELSE to ¬ FmtXNS[to, [address.host.a, address.host.b, address.host.c, address.host.d, address.host.e, address.host.f], format]; to ¬ RefText.AppendChar[to, '. ]; IF address.socket # XNS.unknownSocket THEN to ¬ FmtXNS[to, [0, 0, 0, 0, address.socket.hi, address.socket.lo], format]; RETURN [to] }; AppendXNSNet: PUBLIC PROC [to: REF TEXT, net: XNS.Net, format: NetFormat] RETURNS [REF TEXT] ~ { IF net = XNS.broadcastNet THEN to ¬ RefText.AppendChar[to, '* ] ELSE to ¬ FmtXNS[to, [0, 0, net.hi.hi, net.hi.lo, net.lo.hi, net.lo.lo], format]; RETURN [to] }; AppendXNSHost: PUBLIC PROC [to: REF TEXT, host: XNS.Host, format: NetFormat] RETURNS [REF TEXT] ~ { IF host = XNS.broadcastHost THEN to ¬ RefText.AppendChar[to, '* ] ELSE to ¬ FmtXNS[to, [host.a, host.b, host.c, host.d, host.e, host.f], format]; RETURN [to] }; AppendXNSSocket: PUBLIC PROC [to: REF TEXT, socket: XNS.Socket, format: NetFormat] RETURNS [REF TEXT] ~ { to ¬ FmtXNS[to, [0, 0, 0, 0, socket.hi, socket.lo], format]; RETURN [to] }; maxDigits: NAT ~ 24; repChar: ARRAY [0 .. 16) OF CHAR ~ ['0, '1, '2, '3, '4, '5, '6, '7, '8, '9, 'A, 'B, 'C, 'D, 'E, 'F]; FmtXNS: PROC [to: REF TEXT, n: BigNum, type: NetFormat] RETURNS [REF TEXT] ~ { text: REF TEXT; base, rem: CARDINAL ¬ 0; i: NAT; isZero: BOOL; DivRem: PROC ~ { <<[n, rem, isZero] _ [n/base, n MOD base, (n/base = 0)]>> temp, carry: CARDINAL; rem ¬ 0; isZero ¬ TRUE; FOR j: CARDINAL IN [0 .. bnSize) DO temp ¬ n[j] + rem*0100H; IF (n[j] ¬ temp / base) # 0 THEN isZero ¬ FALSE; rem ¬ temp MOD base; ENDLOOP; <> carry ¬ 0; FOR j: NAT DECREASING IN [0 .. bnSize) DO temp ¬ n[j] + carry; n[j] ¬ temp MOD 0100H; carry ¬ temp / 0100H; ENDLOOP; }; text ¬ RefText.ObtainScratch[maxDigits]; text.length ¬ text.maxLength; i ¬ text.length; SELECT type FROM productSoftware => { untilDash: NAT ¬ 3; nDashes: NAT ¬ 0; base ¬ 10; isZero ¬ FALSE; WHILE (NOT isZero) OR (nDashes = 0) DO <<[n, rem, isZero] _ [n/base, n MOD base, (n/base = 0)]>> DivRem[]; IF untilDash = 0 THEN { text[i ¬ i - 1] ¬ '-; untilDash ¬ 3; nDashes ¬ nDashes + 1 }; text[i ¬ i - 1] ¬ repChar[rem]; untilDash ¬ untilDash - 1; ENDLOOP; }; octal => { base ¬ 8; text[i ¬ i - 1] ¬ 'B; isZero ¬ FALSE; WHILE NOT isZero DO <<[n, rem, isZero] _ [n/base, n MOD base, (n/base = 0)]>> DivRem[]; text[i ¬ i - 1] ¬ repChar[rem]; ENDLOOP; }; hex => { base ¬ 16; text[i ¬ i - 1] ¬ 'H; isZero ¬ FALSE; WHILE (NOT isZero) OR (rem >= 10) DO <<[n, rem, isZero] _ [n/base, n MOD base, (n/base = 0)]>> DivRem[]; text[i ¬ i - 1] ¬ repChar[rem]; ENDLOOP; }; ENDCASE => ERROR; WHILE i < text.length DO to ¬ RefText.AppendChar[to, text[i]]; i ¬ i + 1; ENDLOOP; RefText.ReleaseScratch[text]; RETURN [to] }; <> ArpaAddressFromRope: PUBLIC PROC [r: ROPE] RETURNS [address: Arpa.Address] ~ { i: INT ¬ 0; len: INT; AToI: PROC [] RETURNS [BYTE] ~ { n: CARDINAL ¬ 0; c: CHAR; IF i < len THEN { c ¬ Rope.Fetch[r, i]; i ¬ i + 1 } ELSE { c ¬ 'X }; IF NOT Ascii.Digit[c] THEN ERROR Error[syntax, i]; DO <> n ¬ n * 10 + (c - '0); IF n >= 256 THEN ERROR Error[syntax, i]; IF i >= len THEN RETURN[n]; c ¬ Rope.Fetch[r, i]; IF NOT Ascii.Digit[c] THEN RETURN [n]; i ¬ i + 1; ENDLOOP; }; SkipDot: PROC ~ { IF (i >= len) OR (Rope.Fetch[r, i] # '.) THEN ERROR Error[syntax, i]; i ¬ i + 1; }; len ¬ Rope.Length[r]; IF len <= 0 THEN RETURN [Arpa.nullAddress]; IF (len >= 2) AND (Rope.Fetch[r,0] = '[) AND (Rope.Fetch[r, len-1] = ']) THEN { len ¬ len - 2; r ¬ Rope.Substr[r, 1, len] }; address.a ¬ AToI[]; SkipDot[]; address.b ¬ AToI[]; SkipDot[]; address.c ¬ AToI[]; SkipDot[]; address.d ¬ AToI[]; IF i < len THEN ERROR Error[syntax, i]; }; RopeFromArpaAddress: PUBLIC PROC [a: Arpa.Address] RETURNS [rope: ROPE] ~ { RETURN[IO.PutFLR["[%g.%g.%g.%g]", LIST[[cardinal[a.a]], [cardinal[a.b]], [cardinal[a.c]], [cardinal[a.d]]]] ]; }; AppendArpaAddress: PUBLIC PROC [to: REF TEXT, address: Arpa.Address] RETURNS [REF TEXT] ~ { base: Base = 10; to ¬ AppendWholeNumber[to, address.a, base, FALSE, FALSE]; to ¬ AppendChar[to, '.]; to ¬ AppendWholeNumber[to, address.b, base, FALSE, FALSE]; to ¬ AppendChar[to, '.]; to ¬ AppendWholeNumber[to, address.c, base, FALSE, FALSE]; to ¬ AppendChar[to, '.]; RETURN[AppendWholeNumber[to, address.d, base, FALSE, FALSE]]; }; PreDebug.RegisterErrorExplainer[Error, NIL, "Convert.Error"]; END.