mkfasl.red 1.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  1. MODULE MKFASL --- Produce a fasl loading version of a given file;
  2. % Author: Martin L. Griss.
  3. % Modifications by: Anthony C. Hearn;
  4. fluid '(rfasl!* rsrc!* !*break !*lower !*quiet!_faslout !*usermode
  5. !*writingfaslfile);
  6. global '(!*echo);
  7. symbolic procedure mkfasl u;
  8. % produce a FASL file for the module u;
  9. if errorp errorset(list('mkfasl1,mkquote u),t,!*backtrace)
  10. then <<if !*writingfaslfile then eval '(faslend);
  11. errorprintf("***** Error during mkfasl of %w%n",u)>>;
  12. flag('(mkfasl),'opfn);
  13. flag('(mkfasl),'noval);
  14. symbolic procedure mkfasl1 u;
  15. begin scalar !*int,!*lower,!*usermode,!*quiet!_faslout,!*break,echo,
  16. ichan,oldichan;
  17. echo := !*echo;
  18. !*echo := nil;
  19. !*quiet!_faslout := t;
  20. terpri();
  21. prin2t bldmsg("*** Compiling %w ...",u);
  22. terpri();
  23. u := string!-downcase u;
  24. ichan := open(concat(u,".red"),'input);
  25. oldichan := rds ichan;
  26. faslout bldmsg("%w%w",rfasl!*,u);
  27. begin1();
  28. eval '(faslend);
  29. !*echo := echo;
  30. close ichan;
  31. rds oldichan
  32. end;
  33. endmodule;
  34. end;