-- [iris]writeformatted>WFimpl.mesa -- last edit schmidt, May 29, 1980 6:06 PM -- Mesa 5.0 -- implements the interface whose definitions module is "wf.mesa" DIRECTORY InlineDefs: FROM "InlineDefs" USING [DIVMOD, LowHalf], IODefs: FROM "IODefs" USING [WriteChar], StreamDefs: FROM "StreamDefs", StringDefs: FROM "StringDefs" USING [AppendChar, AppendString, StringToDecimal], TimeDefs: FROM "TimeDefs", WF: FROM "WF" USING [Unbound]; WFImpl: PROGRAM IMPORTS InlineDefs, IODefs, StringDefs, TimeDefs EXPORTS WF = BEGIN longProcArray: ARRAY[1 .. 26] OF PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]]; procArray: ARRAY[1 .. 26] OF PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]]; saveProcArray: ARRAY[1 .. 26] OF PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]]; GlobalWC: PROCEDURE[CHARACTER]; GlobalString: STRING; swfstring: STRING; fwfstream: StreamDefs.StreamHandle; WFError: PUBLIC SIGNAL[STRING] = CODE; WFNInternal: PROCEDURE [s: STRING, param: DESCRIPTOR FOR ARRAY OF UNSPECIFIED, WC: PROCEDURE[CHARACTER]] = BEGIN form: STRING _ [10]; n,z,i,pnum: CARDINAL; ch: CHARACTER; f: CARDINAL; p: PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]]; longop: BOOLEAN; pnum _ 0; BEGIN FOR i IN [0 .. s.length) DO SELECT s[i] FROM '% => BEGIN i _ i + 1; f _ 0; WHILE s[i] = '- OR s[i] = '. OR s[i] IN ['0 .. '9] DO form[f] _ s[i]; i _ i+1; f_f+1; ENDLOOP; form.length _ f; longop _ FALSE; IF s[i] = 'l OR s[i] = 'L THEN BEGIN longop _ TRUE; i _ i + 1; END; -- s[i] is a control character, -- and form is the stuff between % and s[i] ch _ s[i]; IF ch IN ['A .. 'Z] THEN ch_ ch + 40B; IF ch IN ['a .. 'z] THEN BEGIN p _ IF longop THEN longProcArray[LOOPHOLE[ch,CARDINAL]-140B] ELSE procArray[LOOPHOLE[ch,CARDINAL]-140B]; IF longop AND LOOPHOLE[p, UNSPECIFIED] = WF.Unbound THEN p _ procArray[LOOPHOLE[ch,CARDINAL]-140B]; IF LOOPHOLE[p, UNSPECIFIED] ~= WF.Unbound THEN p[param[pnum],form, WC] ELSE WC[ch]; END; pnum _ pnum + 1; IF ch = '% THEN BEGIN WC['%]; pnum _ pnum - 1; END ELSE IF pnum > LENGTH[param] THEN GOTO bad; END; '* => BEGIN i _ i + 1; SELECT s[i] FROM 'N, 'R, 'n,'r => WC[15C]; 'B,'b => WC[10C]; 'T,'t => WC[11C]; 'F,'f => WC[14C]; IN ['0..'9] => BEGIN --- octal constant, exactly 3 digits IF s[i+1] IN ['0 .. '9] AND s[i+2] IN ['0 .. '9] THEN BEGIN z _ LOOPHOLE['0]; n _ (LOOPHOLE[s[i],CARDINAL]-z) * 64; n _ n + (LOOPHOLE[s[i+1],CARDINAL]-z) * 8; n _ n + LOOPHOLE[s[i+2],CARDINAL]-z; WC[LOOPHOLE[n]]; i _ i + 2; END ELSE SIGNAL WFError["Bad character to WF"]; END; ENDCASE => WC[s[i]]; END; ENDCASE => WC[s[i]]; ENDLOOP; IF pnum < LENGTH[param] THEN GOTO bad; EXITS bad => SIGNAL WFError["Wrong # of parameters to WF"]; END; RETURN; END; SetCode: PUBLIC PROCEDURE[char: CHARACTER, p: PROCEDURE[UNSPECIFIED,STRING, PROCEDURE[CHARACTER]]] = BEGIN IF char IN ['A .. 'Z] THEN char _ char + 40B; IF char ~IN ['a .. 'z] OR char = 'l THEN SIGNAL WFError["Invalid SetCode"]; procArray[LOOPHOLE[char,CARDINAL]-140B] _ p; END; ResetCode: PUBLIC PROCEDURE[char: CHARACTER] = BEGIN i: [1 .. 26]; IF char IN ['A .. 'Z] THEN char _ char + 40B; IF char ~IN ['a .. 'z] OR char = 'l THEN SIGNAL WFError["Invalid ResetCode"]; i _ LOOPHOLE[char,CARDINAL] - 140B; procArray[i] _ saveProcArray[i]; END; WriteToString: PUBLIC PROCEDURE[s: STRING] RETURNS[op: PROCEDURE[CHARACTER]] = BEGIN op _ GlobalWC; GlobalWC _ GoToString; GlobalString _ s; END; GoToString: PROCEDURE[ch: CHARACTER] = BEGIN StringDefs.AppendChar[GlobalString,ch]; END; SetWriteProcedure: PUBLIC PROCEDURE[p: PROCEDURE[CHARACTER]] RETURNS [op: PROCEDURE[CHARACTER]] = BEGIN op _ GlobalWC; GlobalWC _ p; RETURN[op]; END; GetWriteProcedure: PUBLIC PROCEDURE RETURNS [PROCEDURE[CHARACTER]] = BEGIN RETURN[GlobalWC]; END; PrintUnsigned: PROCEDURE [data: CARDINAL, sto: STRING, base: CARDINAL] = BEGIN ms: STRING _ [20]; char: CHARACTER; digit: CARDINAL; IF data=0 OR base NOT IN [2..16] THEN StringDefs.AppendChar[ms, '0] ELSE DO [data, digit] _ InlineDefs.DIVMOD[data, base]; char _ IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0; StringDefs.AppendChar[ms, char]; IF data=0 THEN EXIT; -- cannot run more than 20 repititions ENDLOOP; FOR digit DECREASING IN [0..ms.length) DO StringDefs.AppendChar[sto, ms[digit]]; ENDLOOP; END; PrintLongUnsigned: PROCEDURE[data:LONG CARDINAL,sto:STRING,base:CARDINAL]= BEGIN ms: STRING _ [34]; char: CHARACTER; digit: CARDINAL; IF data=0 OR base NOT IN [2..16] THEN StringDefs.AppendChar[ms, '0] ELSE DO digit _ InlineDefs.LowHalf[data MOD base]; data _ data/base; char _ IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0; StringDefs.AppendChar[ms, char]; IF data=0 THEN EXIT; -- cannot run more than 34 repititions ENDLOOP; FOR digit DECREASING IN [0..ms.length) DO StringDefs.AppendChar[sto, ms[digit]]; ENDLOOP; END; PrintSigned: PROCEDURE[data: INTEGER,sto: STRING,base: CARDINAL] = BEGIN ndata: CARDINAL; sto.length _ 0; IF data < 0 THEN BEGIN StringDefs.AppendChar[sto, '-]; ndata _ -data; END ELSE ndata _ data; PrintUnsigned[ndata,sto,base]; END; PrintLongSigned: PROCEDURE[data: LONG INTEGER,sto: STRING,base: CARDINAL] = BEGIN ndata: LONG CARDINAL; sto.length _ 0; IF data < 0 THEN BEGIN StringDefs.AppendChar[sto, '-]; ndata _ -data; END ELSE ndata _ data; PrintLongUnsigned[ndata,sto,base]; END; BRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; PrintUnsigned[data,sto,8]; SRoutine[sto,form,wp]; END; CRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; sto[0] _ LOOPHOLE[data,CHARACTER]; sto.length _ 1; SRoutine[sto,form,wp]; END; DRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; PrintSigned[data,sto,10]; SRoutine[sto,form,wp]; END; SRoutine: PROCEDURE[data: UNSPECIFIED,form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN ladj: BOOLEAN _ FALSE; fill0: BOOLEAN _ FALSE; w: CARDINAL; k: INTEGER; s: STRING _ data; j: CARDINAL; IF s = NIL THEN BEGIN wp['{]; wp['N]; wp['I]; wp['L]; wp['}]; RETURN END; IF form.length > 0 THEN BEGIN IF form[0] = '0 THEN fill0 _ TRUE; IF form[0] = '- THEN BEGIN form[0] _ '0; ladj _ TRUE; END; w _ StringDefs.StringToDecimal[form]; END ELSE w _ s.length; -- w is field width, k is # chars to fill k _ w - s.length; 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; END; URoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; PrintUnsigned[data,sto,10]; SRoutine[sto,form,wp]; END; XRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; PrintUnsigned[data,sto,16]; SRoutine[sto,form,wp]; END; LongBRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; ndata: LONG CARDINAL _ LOOPHOLE[data,POINTER TO LONG CARDINAL]^; PrintLongUnsigned[ndata, sto, 8]; SRoutine[sto,form,wp]; END; LongDRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; ndata: LONG INTEGER _ LOOPHOLE[data,POINTER TO LONG INTEGER]^; PrintLongSigned[ndata,sto,10]; SRoutine[sto,form,wp]; END; -- Interpret rp as a pointer to a long cardinal representing an interval -- in seconds and print it as hrs:min:sec. LongRRoutine: PROCEDURE [rp: UNSPECIFIED, f: STRING, wp: PROCEDURE [CHARACTER]] = BEGIN et: LONG CARDINAL _ LOOPHOLE[rp,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",@et]; SWF3[rear,"%02ld:%02ld:%02ld"L, @hours1, @minutes, @seconds]; StringDefs.AppendString[time,rear]; SRoutine[time,f,wp]; END; -- Interpret rp as a pointer to a TimeDefs.PackedTime and print it. LongTRoutine: PROCEDURE [rp: UNSPECIFIED, f: STRING, wp: PROCEDURE [CHARACTER]] = BEGIN OPEN TimeDefs; timeP: POINTER TO PackedTime _ rp; time: STRING _ [30]; AppendDayTime[time, UnpackDT[timeP^]]; SRoutine[time,f,wp]; END; LongURoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; ndata: LONG CARDINAL _ LOOPHOLE[data,POINTER TO LONG CARDINAL]^; PrintLongUnsigned[ndata, sto, 10]; SRoutine[sto,form,wp]; END; LongXRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN sto: STRING _ [20]; ndata: LONG CARDINAL _ LOOPHOLE[data,POINTER TO LONG CARDINAL]^; PrintLongUnsigned[ndata, sto, 16]; SRoutine[sto,form,wp]; END; IRoutineError: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN SRoutine["Error - use %ld rather than %i*n",form,wp]; END; WF0: PUBLIC PROCEDURE [s: STRING] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; WFNInternal[s,DESCRIPTOR[BASE[nparam],0],GlobalWC]; END; WF1: PUBLIC PROCEDURE [s: STRING, a: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; nparam[0] _ a; WFNInternal[s,DESCRIPTOR[BASE[nparam],1],GlobalWC]; END; WF2: PUBLIC PROCEDURE [s: STRING, a,b: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; nparam[0] _ a; nparam[1] _ b; WFNInternal[s,DESCRIPTOR[BASE[nparam],2],GlobalWC]; END; WF3: PUBLIC PROCEDURE [s: STRING, a,b,c: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; WFNInternal[s,DESCRIPTOR[BASE[nparam],3],GlobalWC]; END; WF4: PUBLIC PROCEDURE [s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; nparam[3] _ d; WFNInternal[s,DESCRIPTOR[BASE[nparam],4],GlobalWC]; END; WFN: PUBLIC PROCEDURE[s: STRING, array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] = BEGIN WFNInternal[s,array,GlobalWC]; END; WFC: PUBLIC PROCEDURE [c: CHARACTER] = BEGIN GlobalWC[c]; END; WFCR: PUBLIC PROCEDURE = BEGIN GlobalWC[15C]; END; SWFAppendChar: PROCEDURE[ch: CHARACTER] = BEGIN StringDefs.AppendChar[swfstring,ch]; END; SWF0: PUBLIC PROCEDURE [sto: STRING, s: STRING] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; sto.length _ 0; swfstring _ sto; WFNInternal[s,DESCRIPTOR[BASE[nparam],0],SWFAppendChar]; END; SWF1: PUBLIC PROCEDURE [sto: STRING, s: STRING, a: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; sto.length _ 0; swfstring _ sto; nparam[0] _ a; WFNInternal[s,DESCRIPTOR[BASE[nparam],1],SWFAppendChar]; END; SWF2: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; sto.length _ 0; swfstring _ sto; nparam[0] _ a; nparam[1] _ b; WFNInternal[s,DESCRIPTOR[BASE[nparam],2],SWFAppendChar]; END; SWF3: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b,c: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; sto.length _ 0; swfstring _ sto; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; WFNInternal[s,DESCRIPTOR[BASE[nparam],3],SWFAppendChar]; END; SWF4: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; sto.length _ 0; swfstring _ sto; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; nparam[3] _ d; WFNInternal[s,DESCRIPTOR[BASE[nparam],4],SWFAppendChar]; END; SWFN: PUBLIC PROCEDURE[sto: STRING, s: STRING, array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] = BEGIN sto.length _ 0; swfstring _ sto; WFNInternal[s,array,SWFAppendChar]; END; FWFPutStream: PROCEDURE[ch: CHARACTER] = BEGIN fwfstream.put[fwfstream,ch]; END; FWF0: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; fwfstream _ stream; WFNInternal[s,DESCRIPTOR[BASE[nparam],0],FWFPutStream]; END; FWF1: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; fwfstream _ stream; nparam[0] _ a; WFNInternal[s,DESCRIPTOR[BASE[nparam],1],FWFPutStream]; END; FWF2: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; fwfstream _ stream; nparam[0] _ a; nparam[1] _ b; WFNInternal[s,DESCRIPTOR[BASE[nparam],2],FWFPutStream]; END; FWF3: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b,c: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; fwfstream _ stream; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; WFNInternal[s,DESCRIPTOR[BASE[nparam],3],FWFPutStream]; END; FWF4: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN nparam: ARRAY [0 .. 4] OF UNSPECIFIED; fwfstream _ stream; nparam[0] _ a; nparam[1] _ b; nparam[2] _ c; nparam[3] _ d; WFNInternal[s,DESCRIPTOR[BASE[nparam],4],FWFPutStream]; END; FWFN: PUBLIC PROCEDURE[stream: StreamDefs.StreamHandle, s: STRING, array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] = BEGIN fwfstream _ stream; WFNInternal[s,array,FWFPutStream]; END; -- INITIALIZATION CODE BEGIN Temp: CARDINAL; FOR Temp IN [1 .. 26] DO saveProcArray[Temp] _ procArray[Temp] _ longProcArray[Temp] _ WF.Unbound; ENDLOOP; -- for 16 bit numbers SetCode['b,BRoutine]; saveProcArray[LOOPHOLE['b,CARDINAL]-140B] _ BRoutine; SetCode['c,CRoutine]; saveProcArray[LOOPHOLE['c,CARDINAL]-140B] _ CRoutine; SetCode['d,DRoutine]; saveProcArray[LOOPHOLE['d,CARDINAL]-140B] _ DRoutine; SetCode['i,IRoutineError]; saveProcArray[LOOPHOLE['i,CARDINAL]-140B] _ IRoutineError; SetCode['s,SRoutine]; saveProcArray[LOOPHOLE['s,CARDINAL]-140B] _ SRoutine; SetCode['u,URoutine]; saveProcArray[LOOPHOLE['u,CARDINAL]-140B] _ URoutine; SetCode['x,XRoutine]; saveProcArray[LOOPHOLE['x,CARDINAL]-140B] _ XRoutine; -- for LONGS longProcArray[LOOPHOLE['b,CARDINAL]-140B] _ LongBRoutine; longProcArray[LOOPHOLE['d,CARDINAL]-140B] _ LongDRoutine; longProcArray[LOOPHOLE['r,CARDINAL]-140B] _ LongRRoutine; longProcArray[LOOPHOLE['t,CARDINAL]-140B] _ LongTRoutine; longProcArray[LOOPHOLE['u,CARDINAL]-140B] _ LongURoutine; longProcArray[LOOPHOLE['x,CARDINAL]-140B] _ LongXRoutine; -- [] _ SetWriteProcedure[IODefs.WriteChar]; END; END. 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.