projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| c1009b56 TL |
1 | ;---file: compmacs.l |
| 2 | ;----------- macros for the compiler ------------- | |
| 3 | ||
| 4 | ||
| 5 | (declare (special old-top-level compiler-name | |
| 6 | readtable original-readtable raw-readtable | |
| 7 | poport piport | |
| 8 | v-root v-ifile v-sfile | |
| 9 | vps-include vps-crap vp-sfile | |
| 10 | er-fatal ibase | |
| 11 | macros | |
| 12 | x-spec | |
| 13 | fl-asm fl-macl faslflag fl-inter | |
| 14 | k-macros k-lams k-nlams k-free internal-macros | |
| 15 | k-fnum k-current k-code k-ptrs k-ftype k-pid | |
| 16 | k-back k-regs | |
| 17 | twa-list | |
| 18 | s-inst | |
| 19 | x-con x-asg x-dont ; check on this | |
| 20 | x-reg x-leap x-opt | |
| 21 | x-emit | |
| 22 | w-vars w-labs w-ret w-save | |
| 23 | r-xv | |
| 24 | x-spfh x-spfn x-spfq x-spf | |
| 25 | w-bind | |
| 26 | w-name w-bv w-locs w-atmt cm-alv v-cnt | |
| 27 | $gccount$)) | |
| 28 | ||
| 29 | (def $pr$ (macro (x) `(patom ,(cadr x) vp-sfile))) | |
| 30 | ||
| 31 | (def put | |
| 32 | (macro (x) | |
| 33 | ((lambda (atm prp arg) | |
| 34 | `(progn (putprop ,atm ,arg ,prp) ,atm)) | |
| 35 | (cadr x) (caddr x) (cadddr x)))) | |
| 36 | ||
| 37 | ;--- comp-err | |
| 38 | ; comp-warn | |
| 39 | ; comp-note | |
| 40 | ; comp-gerr | |
| 41 | ; these are the compiler message producing macros. The form is | |
| 42 | ; (comp-xxxx val1 val2 val3 ... valn) , all values are printed according | |
| 43 | ; to this scheme. If vali is an atom, it is patomed, if vali is a | |
| 44 | ; list, it is evaluated and printed. If vali is N a newline is printed | |
| 45 | ; | |
| 46 | ; furthermore | |
| 47 | ; the name of the current function is printed first | |
| 48 | ; after comp-err prints the message, it does a throw to Comp-err . | |
| 49 | ; errors are preceeded by Error: | |
| 50 | ; warnings by %Warning: and | |
| 51 | ; notes by %Note: | |
| 52 | ; The message is sent to the message file | |
| 53 | ; | |
| 54 | (def comp-err | |
| 55 | (macro (l) | |
| 56 | `(progn ,@(comp-msg | |
| 57 | `( Error: (or k-current) ": " ,@(cdr l) N)) | |
| 58 | (throw nil Comp-error)))) | |
| 59 | ||
| 60 | (def comp-warn | |
| 61 | (macro (l) | |
| 62 | `(progn ,@(comp-msg | |
| 63 | `( %Warning: (or k-current) ": " ,@(cdr l) N))))) | |
| 64 | ||
| 65 | (def comp-note | |
| 66 | (macro (l) | |
| 67 | `(progn ,@(comp-msg | |
| 68 | `( %Note: ,@(cdr l) N))))) | |
| 69 | ||
| 70 | (def comp-gerr | |
| 71 | (macro (l) | |
| 72 | `(progn ,@(comp-msg | |
| 73 | `(?Error: ,@(cdr l) N)) | |
| 74 | (setq er-fatal (add1 er-fatal))))) | |
| 75 | ;--- comp-msg - port | |
| 76 | ; - lst | |
| 77 | ; prints the lst to the given port. The lst is printed in the manner | |
| 78 | ; described above, that is atoms are patomed, and lists are evaluated | |
| 79 | ; and printed, and N prints a newline. The output is always drained. | |
| 80 | ; | |
| 81 | (eval-when (compile eval) | |
| 82 | (def comp-msg | |
| 83 | (lambda (lis) | |
| 84 | (cond ((null lis) `((drain))) | |
| 85 | (t `(,(cond ((atom (car lis)) | |
| 86 | (cond ((eq (car lis) 'N) | |
| 87 | `(terpr)) | |
| 88 | (t `(patom ',(car lis))))) | |
| 89 | (t `(print ,(car lis)))) | |
| 90 | ,@(comp-msg (cdr lis)))))))) | |
| 91 |