main7.red 2.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101
  1. % main7.red : Small READ-EVAL-PRINT Loop WITH IO
  2. % Needs IO, SUB2, SUB3, SUB4, SUB5, SUB6,SUB7
  3. IN "xxx-header.red"$
  4. in "pt:stubs3.red"$
  5. in "pt:stubs4.red"$
  6. in "pt:stubs5.red"$
  7. in "pt:stubs6.red"$
  8. in "pt:stubs7.red"$
  9. in "pt:psl-timer.sl"$
  10. on syslisp;
  11. Compiletime GLOBAL '(DEBUG IN!* OUT!* !$EOF!$ !*PVAL);
  12. Procedure FirstCall;
  13. Begin scalar x, Done, Hcount;
  14. INIT();
  15. InitHeap();
  16. InitEval();
  17. Prin2t '"MINI-PSL with File I/O";
  18. Prin2T '" Type (IOTEST) to test basic file I/O";
  19. Prin2T '" Future tests will be READ in this way";
  20. Prin2T '" !*RAISE and !*PVAL set T";
  21. LispVar(DEBUG) := 'NIL; % For nice I/O
  22. InitRead();
  23. LispVar(!*RAISE) := 'T; % Upcase Input IDs
  24. LispVar(!*PVAL) := 'T; % Print VALUEs
  25. LispVar(!$EOF!$) := MKID Char EOF; % Check for EOF
  26. Hcount :=0;
  27. Prin2t " .... Now we test INITCODE";
  28. InitCode();
  29. LISPVAR(IN!*):=0;
  30. LISPVAR(OUT!*):=1;
  31. Hcount :=0;
  32. ClearIo();
  33. While Not Done do
  34. <<Hcount:=Hcount+1;
  35. Prin2 Hcount; Prin2 '" lisp> ";
  36. x:=READ();
  37. if x EQ !$EOF!$ then
  38. <<Terpri();
  39. Prin2T " *** Top Level EOF *** ">>
  40. else if x eq 'QUIT then Done := 'T
  41. else <<Terpri();
  42. x:=EVAL x;
  43. if Lispvar(!*PVAL) then Print x>>;
  44. >>;
  45. Quit;
  46. End;
  47. %---- File Io tests ----
  48. Off syslisp;
  49. Procedure Iotest;
  50. Begin scalar InFile, OutFile,Ch,S,InString,OutString;
  51. Prin2T "---- Test of File IO";
  52. IN!*:=0;
  53. Out!*:=1;
  54. Prin2T " Test CLEARIO";
  55. A: Prin2T " Input String for Input File";
  56. Instring:=Read();
  57. Terpri();
  58. If not StringP Instring then goto A;
  59. B: Prin2T " Input String for OutPut File";
  60. OutString:=Read();
  61. Terpri();
  62. If not StringP Outstring then goto B;
  63. Infile:=Open(InString,'Input);
  64. prin2 " Input File Opened on ";
  65. Prin2 Infile;
  66. PRIN2T ", copy to TTY ";
  67. While Not ((ch:=IndependentReadChar(InFILE)) eq 26) do PutC Ch;
  68. Close Infile;
  69. Prin2T " File Closed, Input test done";
  70. Infile:=Open(InString,'Input);
  71. OutFile:=Open(OutString,'OutPut);
  72. prin2 " Input File on ";
  73. Prin2 Infile;
  74. PRIN2 ", copy to Output File on";
  75. Prin2T OutFile;
  76. While Not ((ch:=IndependentReadChar(InFILE)) eq 26)
  77. do IndependentWriteChar(outFile,Ch);
  78. Close Infile;
  79. Close OutFile;
  80. Prin2 "Both Files Closed, Inspect File:";
  81. Prin2T OutString;
  82. End;
  83. End;