-- FILE:  CoForkDemo.mesa     Last Editor: Sturgis    July 9, 1985 11:55:27 am PDT

DIRECTORY
   CoFork USING[CoForkMe],
   BasicTime USING[GetClockPulses, GMT, Now, Period, Pulses, PulsesToMicroseconds],
   Commander USING[CommandProc, Register],
   Convert USING[RopeFromCard],
   IO USING[card, char, int, Put, PutF, rope, STREAM, time],
   Rope USING[Cat, Fetch, FromChar, Length, ROPE];

CoForkDemo: PROGRAM IMPORTS BasicTime, CoFork, Commander, Convert, IO, Rope =

BEGIN OPEN CoFork;


-- 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];

RopeTree: TYPE = POINTER TO RopeTreeNode;
RopeTreeNode: TYPE = RECORD[
      body: SELECT case: * FROM
         rope => [r: Rope.ROPE],
         binary => [l, r: RopeTree],
         ENDCASE
      ];

CharsFromRopeTree: PROCEDURE[tree: RopeTree, putChar: CharSink] RETURNS[moreWanted: BOOLEAN] =
   BEGIN
   WITH dt: tree SELECT FROM
      rope =>
         BEGIN
         FOR I: INT IN [0..Rope.Length[dt.r]) DO
             IF NOT putChar[Rope.Fetch[dt.r, I], FALSE] THEN RETURN[FALSE];
             ENDLOOP;
         RETURN[TRUE];
         END;
      binary => {IF CharsFromRopeTree[dt.l, putChar] THEN
                  RETURN[CharsFromRopeTree[dt.r, putChar]]
              ELSE RETURN[FALSE]};
      ENDCASE => ERROR;
   END;

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


-- tokens


Token: TYPE = RECORD
   [
   body: SELECT case: * FROM
      punct => [c: CHARACTER], 
      rope => [r: Rope.ROPE],
      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;
   ropeItem: Rope.ROPE _ NIL;
   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
         ropeItem _ NIL;
         WHILE NOT noChar AND NOT Punct[c] AND c # '  AND c # CR DO
            ropeItem _ Rope.Cat[ropeItem, Rope.FromChar[c]];
            [c, noChar] _ getChar[TRUE];
            ENDLOOP;
         IF NOT putToken[[rope[ropeItem]]] 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.STREAM] =
   BEGIN
   fakeInputRope: Rope.ROPE _ "this is a test.  We want to see what tokens are delivered, by Put[sink, @token]";
   ropeTreeNode: RopeTreeNode _ [rope[fakeInputRope]];

   getChar: CharSource;
   stopChars: CharStopper;

   getToken: TokenSource;
   stopTokens: TokenStopper;

   token: Token _ [noToken[]];

   [getChar, stopChars] _ MakeCharSource[@ropeTreeNode];
   [getToken, stopTokens] _ MakeTokenizer[getChar];

   token _ getToken[TRUE];

   DO
      WITH dt: token SELECT FROM
         punct => {c: CHARACTER_dt.c; out.PutF["punct: %g\n", IO.char[c]]; };
         rope => out.PutF["rope: %s\n", IO.rope[dt.r]];
         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.STREAM, r: Rope.ROPE] =
   BEGIN
   out.PutF["\n\n\n\n%g*N", IO.rope[r]];
   END;


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

MakeItemProducer: PROCEDURE[nToProduce: CARDINAL, out: IO.STREAM] 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.STREAM] =
   BEGIN
   getItem: ItemSource;
   stopItems: ItemStopper;
   item: CARDINAL; noItem: BOOLEAN;
   [getItem, stopItems] _ MakeItemProducer[nToProduce, out];
   out.PutF["\n\n\ntest of consumer requesting %g items, producer producing %g items\n\n", IO.card[nToRequest], IO.card[nToProduce]];
   FOR I: CARDINAL IN [0..nToRequest) DO
      [item, noItem] _ getItem[TRUE];
      IF noItem THEN out.Put[IO.rope["consumer sees Null item\n"]]
      ELSE out.PutF["consumer sees item: %d\N", IO.card[item]];
      ENDLOOP;
   stopItems[FALSE];
   END;


DemoItemProducer: PROCEDURE[out: IO.STREAM] =
   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


nominalTime: CARDINAL _ 10; -- can be set from command line

timeDataList: TimeDataHandle _ NIL;
timeDataTail: TimeDataHandle _ NIL;
TimeDataHandle: TYPE = REF TimeData;
TimeData: TYPE = RECORD
[
title: Rope.ROPE,
nActions: LONG CARDINAL,
nPulses: CARDINAL,
next: TimeDataHandle
];

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

TimeFoo: PROCEDURE[out: IO.STREAM, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: Rope.ROPE] =
BEGIN
newData: TimeDataHandle _ NEW[TimeData];
newData.title _ title;
--MyDisplayOff[];
[newData.nActions, newData.nPulses] _ 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.STREAM] =
BEGIN
td: TimeDataHandle;
out.PutF["\f\n %g\n\n", IO.time[BasicTime.Now[]]];
FOR td _ timeDataList, td.next WHILE td # NIL
DO PrintTimeData[td, out] ENDLOOP;
END;

PrintTimeData: PROCEDURE[td: TimeDataHandle, out: IO.STREAM] =
BEGIN
nMicrosecondsPerAction: LONG CARDINAL _ BasicTime.PulsesToMicroseconds[td.nPulses];
out.PutF["\n\n%g\t%g", IO.rope[td.title],
       IO.card[nMicrosecondsPerAction]];
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.STREAM, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: Rope.ROPE] RETURNS[nActions: LONG CARDINAL, nPulses: CARDINAL] =
BEGIN
nSeconds: INT;
out.PutF["\n\n\n%g, starting at %g", IO.rope[title],
	IO.time[BasicTime.Now[]]];
[nSeconds, nPulses, nActions] _ TimeFoo2[out, nTimes, Foo, title];
out.PutF["\n\n\tcompleted at %g", IO.time[BasicTime.Now[]]];
out.PutF["\n\t\tnPulses: %g, nSeconds: %g, nActions: %g",
        IO.card[nPulses], IO.card[nSeconds],
        IO.card[nActions]];
END;

TimeFoo2: PROCEDURE[out: IO.STREAM, nTimes: CARDINAL, Foo: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActs: CARDINAL], title: Rope.ROPE] RETURNS[nSeconds: INT, nPulses: CARDINAL, nActions: LONG CARDINAL] =
BEGIN
nRepititions: CARDINAL _ (nTimes*nominalTime+9)/10;
nDone: CARDINAL _ 0;
startTime: BasicTime.GMT;
stopTime: BasicTime.GMT;
startPulses: BasicTime.Pulses;
stopPulses: BasicTime.Pulses;
deltaSeconds: INT;
deltaPulses: BasicTime.Pulses;
Again: PROCEDURE RETURNS[BOOLEAN] =
BEGIN
nDone _ nDone + 1;
--IF spying THEN RandomDelay[];
RETURN[nDone <= nRepititions];
END;
startTime _ BasicTime.Now[];
startPulses _ BasicTime.GetClockPulses[];
nActions _ LONG[Foo[Again]];
stopPulses _ BasicTime.GetClockPulses[];
stopTime _ BasicTime.Now[];
deltaSeconds _ BasicTime.Period[startTime, stopTime];
deltaPulses _ stopPulses - startPulses;
nSeconds _ deltaSeconds;
nPulses _ deltaPulses;
out.PutF["\n\t\tnActions: %g, deltaPulses: %g, deltaSeconds: %g",
    IO.card[nActions],
    IO.card[deltaPulses], IO.int[deltaSeconds]];
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.STREAM, nToRequest: CARDINAL, nToProduce: CARDINAL] =
   BEGIN
   title: Rope.ROPE _ NIL;
   RunIt: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActions: CARDINAL] = 
      BEGIN
      nActions _ 0;
      WHILE again[] DO
         OneRunOfCheapItemProducer[nToRequest, nToProduce];
         nActions _ nActions + 1;
         ENDLOOP;
      END;
   TimeFoo[out, 10000, RunIt, Rope.Cat[
   		"PortProducer: Request",
   		Convert.RopeFromCard[nToRequest],
   		"-Produce",
   		Convert.RopeFromCard[nToProduce]]];
   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.STREAM, nToProduce: CARDINAL, nToRequest: CARDINAL] =
   BEGIN
   RunIt: PROCEDURE[again: PROCEDURE RETURNS[BOOLEAN]] RETURNS[nActions: CARDINAL] = 
      BEGIN
      nActions _ 0;
      WHILE again[] DO
         OneRunOfProcedureProducer[nToProduce, nToRequest];
         nActions _ nActions + 1;
         ENDLOOP;
      END;
   TimeFoo[out, 10000, RunIt, Rope.Cat[
   		"Procedure Producer: Request",
   		Convert.RopeFromCard[nToRequest],
   		"-Produce",
   		Convert.RopeFromCard[nToProduce]]];
   END;


-- main code

DoOneDemo: Commander.CommandProc = TRUSTED
BEGIN
out: IO.STREAM _ cmd.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;

Commander.Register[key: "DemoCofork", proc: DoOneDemo, doc: "do one demo of CoFork"];


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
-- July 9, 1985 11:40:59 am PDT: Sturgis: Convert to Cedar 6.0 from some very early version of Cedar.  For example, had never heard of Rope, IO, or BasicTime.