-- FILE:  CoForkDemo.mesa     Last Editor: Sturgis    September 15, 1982 10:55 am

DIRECTORY
   CoFork USING[CoForkMe],
   Inline USING[LowHalf, HighHalf],
   IO,
   String USING[AppendChar, AppendDecimal, AppendLongDecimal, AppendString],
   Storage USING[Node, String],
   Time USING[Append, Current, Packed, Unpack],
   UserExec USING[CommandProc, GetExecHandle, RegisterCommand];

CoForkDemo: PROGRAM IMPORTS CoFork, Inline, IO, String, Storage, Time, UserExec =

BEGIN OPEN CoFork, Inline, IO, String, Storage, Time;


-- characters

CharSource: TYPE = POINTER TO PORT[moreWanted: BOOLEAN]
                           RETURNS[char: CHARACTER, noChar: BOOLEAN];
CharSink: TYPE = POINTER TO PORT[char: CHARACTER, noChar: BOOLEAN]
                           RETURNS[moreWanted: BOOLEAN];
CharStopper: TYPE = PROCEDURE[moreWanted: BOOLEAN];

StringTree: TYPE = POINTER TO StringTreeNode;
StringTreeNode: TYPE = RECORD[
      body: SELECT case: * FROM
         string => [s: STRING],
         binary => [l, r: StringTree],
         ENDCASE
      ];

CharsFromStringTree: PROCEDURE[tree: StringTree, putChar: CharSink] RETURNS[moreWanted: BOOLEAN] =
   BEGIN
   WITH dt: tree SELECT FROM
      string =>
         BEGIN
         FOR I: CARDINAL IN [0..dt.s.length) DO
             IF NOT putChar[dt.s[I], FALSE] THEN RETURN[FALSE];
             ENDLOOP;
         RETURN[TRUE];
         END;
      binary => {IF CharsFromStringTree[dt.l, putChar] THEN
                  RETURN[CharsFromStringTree[dt.r, putChar]]
              ELSE RETURN[FALSE]};
      ENDCASE => ERROR;
   END;

MakeCharSource: PROCEDURE[tree: StringTree] RETURNS[getChar: CharSource, stopChars: CharStopper] =
   BEGIN
   putChar: CharSink ← CoForkMe[];
   moreWanted: BOOLEAN;
   moreWanted ← putChar['a, TRUE]; -- define null item
   IF moreWanted THEN [] ← CharsFromStringTree[tree, putChar]; -- turn on producer
   END;


-- tokens


Token: TYPE = RECORD
   [
   body: SELECT case: * FROM
      punct => [c: CHARACTER], 
      string => [s: STRING],
      noToken => [],
      ENDCASE
   ];

TokenSource: TYPE = POINTER TO PORT[moreWanted: BOOLEAN] RETURNS[Token];
TokenSink: TYPE = POINTER TO PORT[Token] RETURNS[moreWanted: BOOLEAN]; 
TokenStopper: TYPE = PROCEDURE[moreWanted: BOOLEAN];


Punct: PROCEDURE[c: CHARACTER] RETURNS[isPunctuation: BOOLEAN] =
   {RETURN[c='. OR c=', OR c='[ OR c=']]};

Tokens: PROCEDURE[getChar: CharSource, putToken: TokenSink] =
   BEGIN
   CR: CHARACTER = '\n;
   stringItem: STRING ← [100]; -- crude for now
   c: CHARACTER;
   noChar: BOOLEAN;
   [c, noChar] ← getChar[TRUE];
      DO
      WHILE NOT noChar AND (c = '  OR c = CR) DO
         [c, noChar]  ← getChar[TRUE] ENDLOOP;
      IF noChar THEN EXIT;
      IF Punct[c] THEN
         BEGIN
         IF NOT putToken[[punct[c]]] THEN EXIT;
         [c, noChar] ← getChar[TRUE];
         END
       ELSE
         BEGIN
         stringItem.length ← 0;
         WHILE NOT noChar AND NOT Punct[c] AND c # '  AND c # CR DO
            AppendChar[stringItem, c];
            [c, noChar] ← getChar[TRUE];
            ENDLOOP;
         IF NOT putToken[[string[stringItem]]] THEN EXIT; -- string in the token becomes invalid to consumer at next Get or Stop.
         END;
      ENDLOOP;
   END;

MakeTokenizer: PROCEDURE[chars: CharSource] RETURNS[getToken: TokenSource, stopTokens: TokenStopper] =
   BEGIN
   putToken: TokenSink ← CoForkMe[];
   IF putToken[[noToken[]]] THEN Tokens[chars, putToken];
   END;



-- use the tokens

DemoTokens: PROCEDURE[out: IO.Handle] =
   BEGIN
   fakeInputString: STRING ← "this is a test.  We want to see what tokens are delivered, by Put[sink, @token]";
   stringTreeNode: StringTreeNode ← [string[fakeInputString]];

   getChar: CharSource;
   stopChars: CharStopper;

   getToken: TokenSource;
   stopTokens: TokenStopper;

   token: Token;

   [getChar, stopChars] ← MakeCharSource[@stringTreeNode];
   [getToken, stopTokens] ← MakeTokenizer[getChar];

   token ← getToken[TRUE];

   DO
      WITH dt: token SELECT FROM
         punct => {c: CHARACTER←dt.c; out.PutF["punct: %g\n", char[c]]; };
         string => out.PutF["string: %s\n", string[dt.s]];
         noToken => EXIT;
         ENDCASE => ERROR;
      token ← getToken[TRUE];
      ENDLOOP;
   stopTokens[FALSE];
   stopChars[FALSE];
   END;

-- many cases test


ItemSource: TYPE = POINTER TO PORT[moreWanted: BOOLEAN]
                           RETURNS[item: CARDINAL, noItem: BOOLEAN];
ItemSink: TYPE = POINTER TO PORT[item: CARDINAL, noItem: BOOLEAN]
                           RETURNS[moreWanted: BOOLEAN];
ItemStopper: TYPE = PROCEDURE[moreWanted: BOOLEAN];


Note: PROCEDURE[out: IO.Handle, s: STRING] =
   BEGIN
   out.PutF["\n\n\n\n%s*N", string[s]];
   END;


ItemProducer: PROCEDURE[nToProduce: CARDINAL, putItem: ItemSink, out: IO.Handle] =
   BEGIN
   FOR I: CARDINAL IN [0..nToProduce) DO
      i: CARDINAL←I;
      out.PutF["producing %d\N", card[i]];
      out.Put[IF putItem[I, FALSE] THEN rope[" and producer sees that consumer wants more\N"] ELSE rope[" and producer sees that consumer wants no more\N"]];
      ENDLOOP;
   END;

MakeItemProducer: PROCEDURE[nToProduce: CARDINAL, out: IO.Handle] RETURNS[getItem: ItemSource, stopItems: ItemStopper] =
   BEGIN
   putItem: ItemSink ← CoForkMe[];
   IF putItem[0, TRUE] THEN [] ← ItemProducer[nToProduce, putItem, out];
   END;

OneDemoOfItemProducer: PROCEDURE[nToRequest, nToProduce: CARDINAL, out: IO.Handle] =
   BEGIN
   getItem: ItemSource;
   stopItems: ItemStopper;
   item: CARDINAL; noItem: BOOLEAN;
   [getItem, stopItems] ← MakeItemProducer[nToProduce, out];
   out.PutF["\n\n\ntest of consumer requesting %d items, producer producing %d items\n\n", card[nToRequest], card[nToProduce]];
   FOR I: CARDINAL IN [0..nToRequest) DO
      [item, noItem] ← getItem[TRUE];
      IF noItem THEN out.Put[rope["consumer sees Null item\n"]]
      ELSE out.PutF["consumer sees item: %d\N", card[item]];
      ENDLOOP;
   stopItems[FALSE];
   END;


DemoItemProducer: PROCEDURE[out: IO.Handle] =
   BEGIN

   Note[out, "test no items requested"];
   OneDemoOfItemProducer[nToRequest: 0, nToProduce: 1, out: out];

   Note[out, "test no items produced, no more requested"];
   OneDemoOfItemProducer[nToRequest: 1, nToProduce: 0, out: out];

   Note[out, "test no items produced, consumer is presistent"];
   OneDemoOfItemProducer[nToRequest: 2, nToProduce: 0, out: out];
   OneDemoOfItemProducer[nToRequest: 3, nToProduce: 0, out: out];

   Note[out, "test items produced, producer quites first, consumer quits politely"];
   OneDemoOfItemProducer[nToRequest: 2, nToProduce: 1, out: out];
   OneDemoOfItemProducer[nToRequest: 3, nToProduce: 2, out: out];
   OneDemoOfItemProducer[nToRequest: 6, nToProduce: 5, out: out];

   Note[out, "test items produced, producer quites first, consumer is presistent"];
   OneDemoOfItemProducer[nToRequest: 3, nToProduce: 1, out: out];
   OneDemoOfItemProducer[nToRequest: 4, nToProduce: 1, out: out];
   OneDemoOfItemProducer[nToRequest: 4, nToProduce: 2, out: out];
   OneDemoOfItemProducer[nToRequest: 5, nToProduce: 2, out: out];
   OneDemoOfItemProducer[nToRequest: 7, nToProduce: 5, out: out];
   OneDemoOfItemProducer[nToRequest: 8, nToProduce: 5, out: out];

   Note[out, "test items produced, consumer quits first, producer quits politely"];
   OneDemoOfItemProducer[nToRequest: 1, nToProduce: 1, out: out];
   OneDemoOfItemProducer[nToRequest: 2, nToProduce: 2, out: out];
   OneDemoOfItemProducer[nToRequest: 5, nToProduce: 5, out: out];

   Note[out, "test items produced, consumer quits first, producer persists"];
   OneDemoOfItemProducer[nToRequest: 1, nToProduce: 2, out: out];
   OneDemoOfItemProducer[nToRequest: 1, nToProduce: 3, out: out];
   OneDemoOfItemProducer[nToRequest: 2, nToProduce: 3, out: out];
   OneDemoOfItemProducer[nToRequest: 2, nToProduce: 4, out: out];
   OneDemoOfItemProducer[nToRequest: 5, nToProduce: 6, out: out];
   OneDemoOfItemProducer[nToRequest: 5, nToProduce: 7, out: out];

   END;


-- time support code
-- this code is adapted from TimeLocks retrieved from [Juniper]<Sturgis>d0Partition1 or some such (not from [Juniper]<Sturgis>newlocks, that had an earlier date.  The one retrieved had date August 19, 1980  4:10 PM

LongDecimalAsString: PROCEDURE[long: LONG CARDINAL, dummyString: STRING] RETURNS[STRING] = 
BEGIN
dummyString.length ← 0;
AppendLongDecimal[dummyString, long];
RETURN[dummyString];
END;


FullDayTimeAsString: PROCEDURE[s: STRING] RETURNS[STRING] =
BEGIN
s.length ← 0;
Append[s, Unpack[Current[]]];
RETURN[s];
END;


nominalTime: CARDINAL ← 10; -- can be set from command line
RTC: POINTER TO CARDINAL = LOOPHOLE[430B];

timeDataList: TimeDataHandle ← NIL;
timeDataTail: TimeDataHandle ← NIL;
TimeDataHandle: TYPE = POINTER TO TimeData;
TimeData: TYPE = RECORD
[
title: STRING,
nActions: LONG CARDINAL,
nTicks: CARDINAL,
next: TimeDataHandle
];

-- nTimes should be selected so that if Foo were done nTimes it would require about 10 seconds

TimeFoo: PROCEDURE[out: IO.Handle, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: STRING] =
BEGIN
newData: TimeDataHandle ← Node[SIZE[TimeData]];
newData.title ← String[title.length];
AppendString[newData.title, title];
--MyDisplayOff[];
[newData.nActions, newData.nTicks] ← TimeFoo1[out, nTimes, Foo, title];
--MyDisplayOn[];
newData.next ← NIL;
IF timeDataList = NIL THEN timeDataList ← newData
ELSE timeDataTail.next ← newData;
timeDataTail ← newData;
END;

PrintAccumulatedInfo: PROCEDURE[out: IO.Handle] =
BEGIN
td: TimeDataHandle;
dayTimeString: STRING ← [30];
out.PutF["\f\n %s\n\n", string[FullDayTimeAsString[dayTimeString]]];
FOR td ← timeDataList, td.next WHILE td # NIL
DO PrintTimeData[td, out] ENDLOOP;
END;

PrintTimeData: PROCEDURE[td: TimeDataHandle, out: IO.Handle] =
BEGIN
tempString: STRING ← [30];
nMicrosecondsPerAction: LONG CARDINAL ← (LONG[td.nTicks]*LONG[38994])/td.nActions; -- 38994 is obtained from Jim Mitchell's interpretation of hardware manual, 38.08 microseconds per fast clock tick, times 1024 (overflow of 10 bit field).
out.PutF["\n\n%s\t%s", string[td.title],
       string[LongDecimalAsString[nMicrosecondsPerAction, tempString]]];
END;

--DcbPtr: POINTER TO CARDINAL = LOOPHOLE[420B];
--savedDcb: CARDINAL;
--MyDisplayOff: PROCEDURE = -- -- note: using system supplied DisplayDefs.DisplayOff and DisplayOn resulted in no output to mesa.typescript, and loss of output recently sent to display.
-- BEGIN savedDcb ← DcbPtr↑; DcbPtr↑ ← 0 END;

-- MyDisplayOn: PROCEDURE =
-- BEGIN DcbPtr↑ ← savedDcb END;

TimeFoo1: PROCEDURE[out: IO.Handle, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: STRING] RETURNS[nActions: LONG CARDINAL, nTicks: CARDINAL] =
BEGIN
dayTimeString: STRING ← [30];
tempString: STRING ← [30];
nSeconds: CARDINAL;
nActionsString: STRING ← [30];
out.PutF["\n\n\n%s, starting at %s", string[title],
	string[FullDayTimeAsString[dayTimeString]]];
[nSeconds, nTicks, nActions] ← TimeFoo2[out, nTimes, Foo, title];
out.PutF["\n\n\tcompleted at %s", string[FullDayTimeAsString[dayTimeString]]];
out.PutF["\n\t\tnTicks: %d, nSeconds: %d, nActions: %s",
        card[nTicks], card[nSeconds],
        string[LongDecimalAsString[nActions, nActionsString]]];
END;

TimeFoo2: PROCEDURE[out: IO.Handle, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: STRING] RETURNS[nSeconds: CARDINAL, nTicks: CARDINAL, nActions: LONG CARDINAL] =
BEGIN
nRepititions: CARDINAL ← (nTimes*nominalTime+9)/10;
nDone: CARDINAL ← 0;
startTime: Packed;
stopTime: Packed;
startTicks: CARDINAL;
stopTicks: CARDINAL;
nActionsString: STRING ← [30];
longNSeconds: LONG CARDINAL;
Again: PROCEDURE RETURNS[BOOLEAN] =
BEGIN
nDone ← nDone + 1;
--IF spying THEN RandomDelay[];
RETURN[nDone <= nRepititions];
END;
startTime ← Current[];
startTicks ← RTC↑;
nActions ← LONG[Foo[Again]];
stopTicks ← RTC↑;
stopTime ← Current[];
longNSeconds ← stopTime - startTime;
nTicks ← stopTicks - startTicks;
nSeconds ← LowHalf[longNSeconds];
IF HighHalf[longNSeconds] # 0 THEN ERROR;
out.PutF["\n\t\tnActions: %s, nTicks: %d, nSeconds: %d",
    string[LongDecimalAsString[nActions, nActionsString]],
    card[nTicks], card[nSeconds]];
END;



-- some timing tests

CheapItemProducer: PROCEDURE[nToProduce: CARDINAL, putItem: ItemSink] =
   BEGIN
   FOR I: CARDINAL IN [0..nToProduce) DO
      [] ←  putItem[I, FALSE];
      ENDLOOP;
   END;

MakeCheapItemProducer: PROCEDURE[nToProduce: CARDINAL] RETURNS[getItem: ItemSource, stopItems: ItemStopper] =
   BEGIN
   putItem: ItemSink ← CoForkMe[];
   IF putItem[0, TRUE] THEN [] ← CheapItemProducer[nToProduce, putItem];
   END;

OneRunOfCheapItemProducer: PROCEDURE[nToRequest, nToProduce: CARDINAL] =
   BEGIN
   getItem: ItemSource;
   stopItems: ItemStopper;
   item: CARDINAL; noItem: BOOLEAN;
   [getItem, stopItems] ← MakeCheapItemProducer[nToProduce];
   FOR I: CARDINAL IN [0..nToRequest) DO
      [item, noItem] ← getItem[TRUE];
      ENDLOOP;
   stopItems[FALSE];
   END;

OneTimeOfCheapItemProducer: PROCEDURE[out: IO.Handle, nToRequest: CARDINAL, nToProduce: CARDINAL] =
   BEGIN
   title: STRING ← [100];
   RunIt: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActions: CARDINAL] = 
      BEGIN
      nActions ← 0;
      WHILE again[] DO
         OneRunOfCheapItemProducer[nToRequest, nToProduce];
         nActions ← nActions + 1;
         ENDLOOP;
      END;
   AppendString[title, "PortProducer: Request"];
   AppendDecimal[title, nToRequest];
   AppendString[title, "-Produce"];
   AppendDecimal[title, nToProduce];
   TimeFoo[out, 10000, RunIt, title];
   END;


-- comparison with procedures


SProducer: PROCEDURE[nToProduce: CARDINAL, for: PROCEDURE[CARDINAL] RETURNS[continue: BOOLEAN]] =
   BEGIN
   FOR I: CARDINAL IN [0..nToProduce) DO IF NOT for[I] THEN EXIT; ENDLOOP;
   END;

OneRunOfProcedureProducer: PROCEDURE[nToProduce: CARDINAL, nToRequest: CARDINAL] =
   BEGIN
   nSeen: CARDINAL ← 0;
   DummyFor: PROCEDURE[n: CARDINAL] RETURNS[continue: BOOLEAN] =
      {RETURN[(nSeen ← nSeen + 1) < nToRequest]}; 
   SProducer[nToProduce, DummyFor];
   END;

OneTimeOfProcedureProducer: PROCEDURE[out: IO.Handle, nToProduce: CARDINAL, nToRequest: CARDINAL] =
   BEGIN
   title: STRING ← [100];
   RunIt: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActions: CARDINAL] = 
      BEGIN
      nActions ← 0;
      WHILE again[] DO
         OneRunOfProcedureProducer[nToProduce, nToRequest];
         nActions ← nActions + 1;
         ENDLOOP;
      END;
   AppendString[title, "Procedure Producer: Request"];
   AppendDecimal[title, nToRequest];
   AppendString[title, "-Produce"];
   AppendDecimal[title, nToProduce];
   TimeFoo[out, 10000, RunIt, title];
   END;


-- main code

DoOneDemo: UserExec.CommandProc = TRUSTED
BEGIN
out: IO.Handle ← exec.out;

OneTimeOfCheapItemProducer[out, 1, 2];
OneTimeOfCheapItemProducer[out, 2, 3];
OneTimeOfCheapItemProducer[out, 3, 4];
OneTimeOfCheapItemProducer[out, 10, 11];

OneTimeOfCheapItemProducer[out, 1, 1];
OneTimeOfCheapItemProducer[out, 2, 2];
OneTimeOfCheapItemProducer[out, 3, 3];
OneTimeOfCheapItemProducer[out, 10, 10];

OneTimeOfCheapItemProducer[out, 1, 0];
OneTimeOfCheapItemProducer[out, 2, 1];
OneTimeOfCheapItemProducer[out, 3, 2];
OneTimeOfCheapItemProducer[out, 10, 9];



OneTimeOfProcedureProducer[out, 1, 2];
OneTimeOfProcedureProducer[out, 2, 3];
OneTimeOfProcedureProducer[out, 3, 4];
OneTimeOfProcedureProducer[out, 10, 11];

OneTimeOfProcedureProducer[out, 1, 1];
OneTimeOfProcedureProducer[out, 2, 2];
OneTimeOfProcedureProducer[out, 3, 3];
OneTimeOfProcedureProducer[out, 10, 10];

OneTimeOfProcedureProducer[out, 1, 0];
OneTimeOfProcedureProducer[out, 2, 1];
OneTimeOfProcedureProducer[out, 3, 2];
OneTimeOfProcedureProducer[out, 10, 9];



PrintAccumulatedInfo[out];




DemoTokens[out];
DemoItemProducer[out];
END;

UserExec.RegisterCommand[name: "DemoCofork", proc: DoOneDemo, briefDoc: "do one demo of CoFork"];
[] ← DoOneDemo[UserExec.GetExecHandle[]];


END.


--MODULE HISTORY

--Initial by: Sturgis,   July 23, 1981  1:59 PM, this code was edited from a version constructed this week called Tokenizer, in which the various experiments with CoFork were first conducted.  The edit log for that module can be found in CoForkImpl.Mesa
-- July 28, 1981  11:59 AM: add timing code from ForkDemo
-- August 4, 1981  4:25 PM: more timing code for procedure version of the producer
-- August 4, 1981  6:50 PM: increase repetitions to 10000
-- Cedar (Tajo, anyhow) version by Swinehart
-- 16-Oct-81 10:49:02, mnc
-- IOStream output, Swinehart, 30-Dec-81 15:03:10
-- no longer compiles, repair it so that it compiles, Sturgis: September 15, 1982 10:56 am