-- [iris]<mesalib>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.