-- File [Indigo]<CedarLib>WF>Rubicon>CWFImpl.mesa. -- Compatible Write Formatted implementation. -- This module leaves some unreleased storage (no finalization). -- Last edit Schmidt, 21-Aug-81 18:55:53 -- Last edit MBrown, January 9, 1981 2:11 PM -- Last edit BZM, September 7, 1981 2:36 PM. STRING => LONG STRING. -- Last edit BZM, 11-Nov-81 12:03:02. DESCRIPTOR => LONG DESCRIPTOR. -- Last edit BZM, 23-Feb-82 17:29:41. NIL string prints "", not "{NIL}". -- Last edit BZM, 15-Mar-82 21:24:33. Fix another damn NIL string bug. -- Last edit BZM, 2-May-82 21:19:43. Last uses of String => LongString. -- Mesa 7.0/ Pilot 6.0 -- implements the interface whose definitions module is "cwf.mesa" DIRECTORY Ascii USING [CR, BS, TAB, FF], CWF, Heap, Inline USING [DIVMOD, LowHalf], LongString USING[ AppendChar, AppendString, LowerCase, StringToDecimal], System USING [GreenwichMeanTime], Time USING [Append, Unpack]; CWFImpl: PROGRAM IMPORTS Heap, Inline, LongString, Time EXPORTS CWF = { GlobalData: TYPE = RECORD[ longProcArray, procArray, saveProcArray: ARRAY CHARACTER['a..'z] OF PROC[LONG POINTER,LONG STRING,PROC[CHARACTER]] ← ALL[NIL], GlobalWC: PROC[CHARACTER] ← WriteChar, GlobalString: LONG STRING ← NIL, swfstring: LONG STRING ← NIL ]; -- this is the only MDS variable data: LONG POINTER TO GlobalData ← NIL; WriteChar: PROC[c: CHARACTER] = { ERROR WFError["No WriteChar supplied"L] }; WFError: PUBLIC SIGNAL[err: LONG STRING] = CODE; WFNInternal: PROC [spat: LONG STRING, param: LONG DESCRIPTOR FOR ARRAY OF LONG POINTER, WC: PROC[CHARACTER]] = { form: STRING ← [10]; n,inx,pnum: CARDINAL; ch: CHARACTER; f: CARDINAL; p: PROC[LONG POINTER,LONG STRING,PROC[CHARACTER]]; longop: BOOLEAN; pnum ← 0; { IF spat # NIL THEN FOR inx IN [0 .. spat.length) DO SELECT spat[inx] FROM '% => { inx ← inx + 1; f ← 0; WHILE spat[inx] = '- OR spat[inx] = '. OR spat[inx] IN ['0 .. '9] AND f < form.maxlength DO form[f] ← spat[inx]; inx ← inx + 1; f ← f + 1; ENDLOOP; form.length ← f; longop ← FALSE; IF spat[inx] = 'l OR spat[inx] = 'L THEN { longop ← TRUE; inx ← inx + 1; }; -- spat[inx] is a control character, -- and form is the stuff between % and spat[inx] ch ← spat[inx]; IF ch IN ['A .. 'Z] THEN ch ← LongString.LowerCase[ch]; IF ch IN ['a .. 'z] THEN { p ← IF longop THEN data.longProcArray[ch] ELSE data.procArray[ch]; IF longop AND LOOPHOLE[p, UNSPECIFIED] = NIL THEN p ← data.procArray[ch]; IF LOOPHOLE[p, UNSPECIFIED] ~= NIL AND BASE[param] ~= NIL AND pnum < LENGTH[param] THEN p[param[pnum],form, WC] ELSE WC[ch]; }; IF ch = '% THEN WC['%] ELSE IF pnum >= LENGTH[param] THEN GOTO bad ELSE pnum ← pnum + 1; }; '* => { inx ← inx + 1; SELECT spat[inx] FROM 'N, 'R, 'n,'r => WC[Ascii.CR]; 'B,'b => WC[Ascii.BS]; 'T,'t => WC[Ascii.TAB]; 'F,'f => WC[Ascii.FF]; IN ['0..'9] => { --- octal constant, exactly 3 digits IF spat[inx+1] IN ['0 .. '9] AND spat[inx+2] IN ['0 .. '9] THEN { n ← (spat[inx] -'0) * 64 + (spat[inx+1] - '0) * 8 + (spat[inx+2] - '0); WC[LOOPHOLE[n]]; inx ← inx + 2; } ELSE WFError["Bad character to CWF"L]; }; ENDCASE => WC[spat[inx]]; }; ENDCASE => WC[spat[inx]]; ENDLOOP; IF pnum < LENGTH[param] THEN GOTO bad; EXITS bad => WFError["Wrong # of parameters to WF"L]; }; RETURN; }; SetCode: PUBLIC PROC[char: CHARACTER, p: PROC[LONG POINTER,LONG STRING, PROC[CHARACTER]]] = { IF char IN ['A .. 'Z] THEN char ← LongString.LowerCase[char]; IF char NOT IN ['a .. 'z] OR char = 'l THEN WFError["Invalid SetCode"L]; data.procArray[char] ← p; }; ResetCode: PUBLIC PROC[char: CHARACTER] = { IF char IN ['A .. 'Z] THEN char ← LongString.LowerCase[char]; IF char NOT IN ['a .. 'z] OR char = 'l THEN WFError["Invalid ResetCode"L]; data.procArray[char] ← data.saveProcArray[char]; }; WriteToString: PUBLIC PROC[s: LONG STRING] RETURNS[op: PROC[CHARACTER]] = { op ← data.GlobalWC; data.GlobalWC ← GoToString; data.GlobalString ← s; }; GoToString: PROC[ch: CHARACTER] = { LongString.AppendChar[data.GlobalString,ch]; }; SetWriteProcedure: PUBLIC PROC[p: PROC[CHARACTER]] RETURNS [op: PROC[CHARACTER]] = { op ← data.GlobalWC; data.GlobalWC ← p; data.GlobalString ← NIL; RETURN[op]; }; GetWriteProcedure: PUBLIC PROC RETURNS [PROC[CHARACTER]] = { RETURN[data.GlobalWC]; }; PrintUnsigned: PROC [data: CARDINAL, sto: STRING, base: CARDINAL] = { ms: STRING ← [20]; char: CHARACTER; digit: CARDINAL; IF data=0 OR base NOT IN [2..16] THEN LongString.AppendChar[ms, '0] ELSE DO [data, digit] ← Inline.DIVMOD[data, base]; char ← IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0; LongString.AppendChar[ms, char]; IF data=0 THEN EXIT; -- cannot run more than 20 repititions ENDLOOP; FOR digit DECREASING IN [0..ms.length) DO LongString.AppendChar[sto, ms[digit]]; ENDLOOP; }; PrintLongUnsigned: PROC[data:LONG CARDINAL,sto:STRING,base:CARDINAL]={ ms: STRING ← [34]; char: CHARACTER; digit: CARDINAL; IF data=0 OR base NOT IN [2..16] THEN LongString.AppendChar[ms, '0] ELSE DO digit ← Inline.LowHalf[data MOD base]; data ← data/base; char ← IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0; LongString.AppendChar[ms, char]; IF data=0 THEN EXIT; -- cannot run more than 34 repititions ENDLOOP; FOR digit DECREASING IN [0..ms.length) DO LongString.AppendChar[sto, ms[digit]]; ENDLOOP; }; PrintSigned: PROC[data: INTEGER,sto: STRING,base: CARDINAL] = { ndata: CARDINAL; sto.length ← 0; IF data < 0 THEN { LongString.AppendChar[sto, '-]; ndata ← -data; } ELSE ndata ← data; PrintUnsigned[ndata,sto,base]; }; PrintLongSigned: PROC[data: LONG INTEGER,sto: STRING,base: CARDINAL] ={ ndata: LONG CARDINAL; sto.length ← 0; IF data < 0 THEN { LongString.AppendChar[sto, '-]; ndata ← -data; } ELSE ndata ← data; PrintLongUnsigned[ndata,sto,base]; }; BRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; p: LONG POINTER TO CARDINAL ← data; PrintUnsigned[p↑,sto,8]; SRoutine[sto,form,wp]; }; CRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [2]; p: LONG POINTER TO CHARACTER ← data; sto[0] ← p↑; sto.length ← 1; SRoutine[sto,form,wp]; }; DRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; p: LONG POINTER TO INTEGER ← data; PrintSigned[p↑,sto,10]; SRoutine[sto,form,wp]; }; SRoutine: PROC[data: LONG POINTER,form: LONG STRING, wp: PROC[CHARACTER]] = { ladj: BOOLEAN ← FALSE; fill0: BOOLEAN ← FALSE; w: CARDINAL; k: INTEGER; s: LONG STRING ← data; j: CARDINAL; IF s = NIL THEN { -- [BZM on 23-Feb-82 17:27:08] NIL string should print nothing, not {NIL}: -- wp['{]; wp['N]; wp['I]; wp['L]; wp['}]; RETURN }; IF form.length > 0 THEN { IF form[0] = '0 THEN fill0 ← TRUE; IF form[0] = '- THEN { form[0] ← '0; ladj ← TRUE; }; w ← LongString.StringToDecimal[form]; } ELSE w ← s.length; -- w is field width, k is # chars to fill k ← s.length; k ← w - k; k ← MAX[0, k]; IF ~ladj THEN THROUGH [1..k] DO wp[IF fill0 THEN '0 ELSE ' ] ENDLOOP; FOR j IN [0 .. MIN[w,s.length]) DO wp[s[j]] ENDLOOP; IF ladj THEN THROUGH [1..k] DO wp[' ] ENDLOOP; }; URoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; p: LONG POINTER TO CARDINAL ← data; PrintUnsigned[p↑,sto,10]; SRoutine[sto,form,wp]; }; XRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; p: LONG POINTER TO CARDINAL ← data; PrintUnsigned[p↑,sto,16]; SRoutine[sto,form,wp]; }; LongBRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; ndata: LONG CARDINAL ← LOOPHOLE[data,LONG POINTER TO LONG CARDINAL]↑; PrintLongUnsigned[ndata, sto, 8]; SRoutine[sto,form,wp]; }; LongDRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; ndata: LONG INTEGER ← LOOPHOLE[data,LONG POINTER TO LONG INTEGER]↑; PrintLongSigned[ndata,sto,10]; SRoutine[sto,form,wp]; }; -- Interpret rp as a pointer to a long cardinal representing an interval -- in seconds and print it as hrs:min:sec. LongRRoutine: PROC [rp: LONG POINTER, f: LONG STRING, wp: PROC [CHARACTER]] = { et: LONG CARDINAL ← LOOPHOLE[rp,LONG POINTER TO LONG CARDINAL]↑; rear: STRING ← [20]; time: STRING ← [20]; hours1, minutes, seconds: LONG CARDINAL; seconds ← et MOD 60; et ← et/60; minutes ← et MOD 60; et ← et/60; hours1 ← et MOD 100; et ← et/100; IF et#0 THEN SWF1[time,"%ld"L,@et]; SWF3[rear,"%02ld:%02ld:%02ld"L, @hours1, @minutes, @seconds]; LongString.AppendString[time,rear]; SRoutine[time,f,wp]; }; -- Interpret rp as a pointer to a LONG CARDINAL as Time likes it and print it. LongTRoutine: PROC [rp: LONG POINTER, f: LONG STRING, wp: PROC [CHARACTER]] = { timeP: LONG POINTER TO System.GreenwichMeanTime ← LOOPHOLE[rp]; time: STRING ← [30]; Time.Append[time, Time.Unpack[timeP↑], TRUE]; -- TRUE=> print time zone (e.g. PDT) SRoutine[time,f,wp]; }; LongURoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; ndata: LONG CARDINAL ← LOOPHOLE[data,LONG POINTER TO LONG CARDINAL]↑; PrintLongUnsigned[ndata, sto, 10]; SRoutine[sto,form,wp]; }; LongXRoutine: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { sto: STRING ← [20]; ndata: LONG CARDINAL ← LOOPHOLE[data,LONG POINTER TO LONG CARDINAL]↑; PrintLongUnsigned[ndata, sto, 16]; SRoutine[sto,form,wp]; }; IRoutineError: PROC[data: LONG POINTER, form: LONG STRING, wp: PROC[CHARACTER]] = { SRoutine["Error - use %ld rather than %i*n"L,form,wp]; }; WF0: PUBLIC PROC [s: LONG STRING] = { WFNInternal[s,DESCRIPTOR[NIL,0],data.GlobalWC]; }; WF1: PUBLIC PROC [s: LONG STRING, a: LONG POINTER] = { nparam: ARRAY [0 .. 1) OF LONG POINTER; nparam[0] ← a; WFNInternal[s,DESCRIPTOR[nparam],data.GlobalWC]; }; WF2: PUBLIC PROC [s: LONG STRING, a,b: LONG POINTER] = { nparam: ARRAY [0 .. 2) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; WFNInternal[s,DESCRIPTOR[nparam],data.GlobalWC]; }; WF3: PUBLIC PROC [s: LONG STRING, a,b,c: LONG POINTER] = { nparam: ARRAY [0 .. 3) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; WFNInternal[s,DESCRIPTOR[nparam],data.GlobalWC]; }; WF, WF4: PUBLIC PROC [s: LONG STRING, a,b,c,d: LONG POINTER] = { nparam: ARRAY [0 .. 4) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d; WFNInternal[s,DESCRIPTOR[nparam],data.GlobalWC]; }; WFN: PUBLIC PROC[s: LONG STRING, array: LONG DESCRIPTOR FOR ARRAY OF LONG POINTER] = { WFNInternal[s,array,data.GlobalWC]; }; WFC: PUBLIC PROC [c: CHARACTER] = { data.GlobalWC[c]; }; WFCR: PUBLIC PROC = { data.GlobalWC[Ascii.CR]; }; SWFAppendChar: PROC[ch: CHARACTER] = { LongString.AppendChar[data.swfstring,ch]; }; SWF0: PUBLIC PROC [sto: LONG STRING, s: LONG STRING] = { sto.length ← 0; data.swfstring ← sto; WFNInternal[s,DESCRIPTOR[NIL,0],SWFAppendChar]; }; SWF1: PUBLIC PROC [sto: LONG STRING, s: LONG STRING, a: LONG POINTER] = { nparam: ARRAY [0 .. 1) OF LONG POINTER; sto.length ← 0; data.swfstring ← sto; nparam[0] ← a; WFNInternal[s,DESCRIPTOR[nparam],SWFAppendChar]; }; SWF2: PUBLIC PROC [sto: LONG STRING, s: LONG STRING, a,b: LONG POINTER] = { nparam: ARRAY [0 .. 2) OF LONG POINTER; sto.length ← 0; data.swfstring ← sto; nparam[0] ← a; nparam[1] ← b; WFNInternal[s,DESCRIPTOR[nparam],SWFAppendChar]; }; SWF3: PUBLIC PROC [sto: LONG STRING, s: LONG STRING, a,b,c: LONG POINTER] = { nparam: ARRAY [0 .. 3) OF LONG POINTER; sto.length ← 0; data.swfstring ← sto; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; WFNInternal[s,DESCRIPTOR[nparam],SWFAppendChar]; }; SWF, SWF4: PUBLIC PROC [sto: LONG STRING, s: LONG STRING, a,b,c,d: LONG POINTER] = { nparam: ARRAY [0 .. 4) OF LONG POINTER; sto.length ← 0; data.swfstring ← sto; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d; WFNInternal[s,DESCRIPTOR[nparam],SWFAppendChar]; }; SWFN: PUBLIC PROC[sto: LONG STRING, s: LONG STRING, array: LONG DESCRIPTOR FOR ARRAY OF LONG POINTER] = { sto.length ← 0; data.swfstring ← sto; WFNInternal[s,array,SWFAppendChar]; }; SWFC: PUBLIC PROC [sto: LONG STRING, ch: CHARACTER] = { LongString.AppendChar[sto,ch]; }; SWFCR: PUBLIC PROC[sto: LONG STRING] = { LongString.AppendChar[sto,Ascii.CR]; }; FWF0: PUBLIC PROC [proc: PROC[CHARACTER], s: LONG STRING] = { WFNInternal[s,DESCRIPTOR[NIL,0],proc]; }; FWF1: PUBLIC PROC [proc: PROC[CHARACTER], s: LONG STRING, a: LONG POINTER] = { nparam: ARRAY [0 .. 1) OF LONG POINTER; nparam[0] ← a; WFNInternal[s,DESCRIPTOR[nparam],proc]; }; FWF2: PUBLIC PROC [proc: PROC[CHARACTER], s: LONG STRING, a,b: LONG POINTER] = { nparam: ARRAY [0 .. 2) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; WFNInternal[s,DESCRIPTOR[nparam],proc]; }; FWF3: PUBLIC PROC [proc: PROC[CHARACTER], s: LONG STRING, a,b,c: LONG POINTER] = { nparam: ARRAY [0 .. 3) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; WFNInternal[s,DESCRIPTOR[nparam],proc]; }; FWF, FWF4: PUBLIC PROC [proc: PROC[CHARACTER], s: LONG STRING, a,b,c,d: LONG POINTER] = { nparam: ARRAY [0 .. 4) OF LONG POINTER; nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d; WFNInternal[s,DESCRIPTOR[nparam],proc]; }; FWFN: PUBLIC PROC[proc: PROC[CHARACTER], s: LONG STRING, array: LONG DESCRIPTOR FOR ARRAY OF LONG POINTER] = { WFNInternal[s,array,proc]; }; FWFC: PUBLIC PROC [proc: PROC[CHARACTER], ch: CHARACTER] = { proc[ch]; }; FWFCR: PUBLIC PROC[proc: PROC[CHARACTER]] = { proc[Ascii.CR]; }; Init: PROC = { -- INITIALIZATION CODE -- allocate space for the global data -- this memory is never freed!! data ← Heap.systemZone.NEW[GlobalData]; -- for 16 bit numbers SetCode['b,BRoutine]; data.saveProcArray['b] ← BRoutine; SetCode['c,CRoutine]; data.saveProcArray['c] ← CRoutine; SetCode['d,DRoutine]; data.saveProcArray['d] ← DRoutine; SetCode['i,IRoutineError]; data.saveProcArray['i] ← IRoutineError; SetCode['s,SRoutine]; data.saveProcArray['s] ← SRoutine; SetCode['u,URoutine]; data.saveProcArray['u] ← URoutine; SetCode['x,XRoutine]; data.saveProcArray['x] ← XRoutine; -- for LONGS data.longProcArray['b] ← LongBRoutine; data.longProcArray['d] ← LongDRoutine; data.longProcArray['r] ← LongRRoutine; data.longProcArray['t] ← LongTRoutine; data.longProcArray['u] ← LongURoutine; data.longProcArray['x] ← LongXRoutine; }; Init[]; }. MODULE HISTORY Created by Schmidt, July 1977 Changed by Schmidt, August 19, 1977 8:06 PM Reason: to delete wf5 - wf9, put in setwriteprocedure, and add a test for a NIL string Changed by Schmidt, August 19, 1977 8:23 PM Reason: deconvert from dboss Changed by Mitchell, June 13, 1978 9:48 PM Reason: Convert to Mesa 4.0 Chnaged by Schmidt, June 26, 1978 11:21 PM Reason: add %i, %l to handle 32-bit integers Changed by LStewart, June 19, 1979 11:04 AM Reason: Convert to Mesa 5.0 Changed by LStewart, July 10, 1979 5:10 PM Reason: Field width on long octal. Non-recursive number printer Changed by LStewart, September 12, 1979 12:13 PM Reason: add '. to Forms, add WriteProcedure as argument to code procs. Changed by Schmidt, April 21, 1980 12:10 AM Reason: change %i, %l to be %ld, %lb, etc. Add SWF, FWF. Changed by Schmidt, May 29, 1980 6:10 PM Reason: use procArray if longProcArray[] = NIL. Changed by Schmidt, August 4, 1980 11:33 PM Reason: convert to CWF, add default arguments. Changed by MBrown, September 6, 1980 3:31 PM Reason: Pilot version. All StreamDefs-related stuff removed. Changed by MBrown, January 9, 1981 2:16 PM Reason: Raise WFError, not ERROR, if called without setting WriteChar. Changed by Schmidt, 21-Aug-81 18:57:44 Reason: Make %lt print the time zone (e.g. PDT) Changed by BZM, September 7, 1981 2:43 PM Reason: Change all interface STRINGs to LONG, including the format string.