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     ! 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.