Return to compmacs.l CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / liszt

Annotation of 3BSD/cmd/liszt/compmacs.l, revision 1.1.1.1

1.1       root        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: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.