-- 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.