showcase21.mod 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. MODULE Showcase21;
  2. // Tour of three features added this step:
  3. //
  4. // * result suffixes — components applied to a function-call result
  5. // (GetRec()^.field, GetArr()^[i]);
  6. // * PIM coroutines from SYSTEM — PROCESS / NEWPROCESS / TRANSFER,
  7. // two coroutines ping-pong five times and hand control back;
  8. // * ISO/gm2 standard library — RealStr (RealToFixed), LongMath
  9. // (sqrt/round), WholeStr (CardToStr) and DynamicStrings
  10. // (InitString/ConCat/CopyOut) build the output label.
  11. //
  12. // Writes "showcase21 total=42"; expected ExitCode: 42.
  13. IMPORT StrIO, WholeStr, RealStr, LongMath, DynamicStrings;
  14. FROM DynamicStrings IMPORT String;
  15. FROM SYSTEM IMPORT ADDRESS, PROCESS, NEWPROCESS, TRANSFER, ADR;
  16. TYPE
  17. Rec = RECORD a, b : INTEGER END;
  18. RecPtr = POINTER TO Rec;
  19. Arr = ARRAY [0..3] OF INTEGER;
  20. ArrPtr = POINTER TO Arr;
  21. VAR ExitCode : INTEGER;
  22. VAR r : RecPtr;
  23. VAR s : ArrPtr;
  24. VAR total : INTEGER;
  25. VAR x : REAL;
  26. VAR hits : CARDINAL;
  27. VAR ping, pong, exits : PROCESS;
  28. VAR ws1, ws2 : ARRAY [0..65535] OF CHAR;
  29. VAR num, label, out : ARRAY [0..63] OF CHAR;
  30. VAR ds : String;
  31. PROCEDURE GetRec () : RecPtr;
  32. BEGIN RETURN r END GetRec;
  33. PROCEDURE GetArr () : ArrPtr;
  34. BEGIN RETURN s END GetArr;
  35. PROCEDURE Ping;
  36. BEGIN
  37. LOOP
  38. TRANSFER(ping, pong)
  39. END
  40. END Ping;
  41. PROCEDURE Pong;
  42. BEGIN
  43. LOOP
  44. INC(hits);
  45. IF hits >= 5 THEN TRANSFER(pong, exits) END;
  46. TRANSFER(pong, ping)
  47. END
  48. END Pong;
  49. BEGIN
  50. ExitCode := 0;
  51. (* --- result suffixes --- *)
  52. NEW(r); NEW(s);
  53. r^.a := 40; r^.b := 2;
  54. s^[0] := 1; s^[1] := 2; s^[2] := 2; s^[3] := 4;
  55. IF GetRec()^.a + GetRec()^.b = 42 THEN
  56. ExitCode := ExitCode + 1
  57. ELSE ExitCode := 100 END;
  58. IF GetArr()^[1] + GetArr()^[2] = 4 THEN
  59. ExitCode := ExitCode + 2
  60. ELSE ExitCode := 100 END;
  61. total := 40;
  62. total := total + GetArr()^[1] + GetArr()^[2]; (* 44 *)
  63. total := total - GetRec()^.b; (* 42 *)
  64. (* --- ISO/gm2 library --- *)
  65. RealStr.RealToFixed(42.0, 0, num); (* "42" *)
  66. x := LongMath.sqrt(1764.0); (* 42.0 *)
  67. IF (num[0] = "4") AND (num[1] = "2") AND
  68. (LongMath.round(x) = 42) THEN
  69. ExitCode := ExitCode + 4
  70. ELSE ExitCode := 100 END;
  71. (* --- coroutines --- *)
  72. NEWPROCESS(Ping, ADR(ws1), 65536, ping);
  73. NEWPROCESS(Pong, ADR(ws2), 65536, pong);
  74. TRANSFER(exits, ping);
  75. IF hits = 5 THEN ExitCode := ExitCode + 8 ELSE ExitCode := 100 END;
  76. (* --- output line via DynamicStrings + WholeStr --- *)
  77. WholeStr.CardToStr(VAL(CARDINAL, total), num);
  78. ds := DynamicStrings.InitString("showcase21 total=");
  79. ds := DynamicStrings.ConCat(ds, DynamicStrings.InitString(num));
  80. DynamicStrings.CopyOut(out, ds);
  81. StrIO.WriteString(out);
  82. StrIO.WriteLn;
  83. IF ExitCode = 15 THEN ExitCode := 42 END
  84. END Showcase21.