main1.red 918 B

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. % Simple 1 file test
  2. % This is program MAIN1.RED
  3. On SYSLISP;
  4. IN "XXX-HEADER.RED"$
  5. Procedure FirstCall;
  6. <<Init();
  7. PutC Char A;
  8. PutC Char B;
  9. Terpri();
  10. PutInt Ifact 10;
  11. Terpri();
  12. TestFact();
  13. Terpri();
  14. TestTak();
  15. Quit;>>;
  16. procedure terpri();
  17. PutC Char EOL;
  18. Procedure TestFact();
  19. << Timc();
  20. Terpri();
  21. ArithmeticTest 10000;
  22. Timc();>>;
  23. Procedure ArithmeticTest (N);
  24. begin scalar I;
  25. I:= 0;
  26. loop:
  27. if Igreaterp(I,N) then return NIL;
  28. Fact 9;
  29. I := iadd1 I;
  30. goto loop
  31. end;
  32. procedure TestTak();
  33. <<Timc();
  34. PutInt TopLevelTak (18,12,6);
  35. Terpri();
  36. Timc();>>;
  37. in "pt:tak.sl";
  38. syslsp procedure Fact (N);
  39. If ilessp(N,2) then 1 else LongTimes(N,Fact isub1 N);
  40. syslsp procedure Ifact u;
  41. Begin scalar m;
  42. m:=1;
  43. L1: if u eq 1 then return M;
  44. M:=LongTimes(U,M);
  45. u:=u-1;
  46. PutInt(u);
  47. Terpri();
  48. PutInt(M);
  49. Terpri();
  50. goto L1;
  51. end;
  52. end;