Return to cmacros.l CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / liszt

Annotation of 42BSD/ucb/lisp/liszt/cmacros.l, revision 1.1

1.1     ! root        1: ;----------- macros for the compiler -------------
        !             2: 
        !             3: (setq RCS-cmacros
        !             4:    "$Header: cmacros.l,v 1.12 83/08/24 17:15:44 layer Exp $")
        !             5: 
        !             6: (declare (macros t))                   ; compile and save macros
        !             7: 
        !             8: ; If we are making an interpreted version, then const.l hasn't been
        !             9: ; loaded yet...
        !            10: (eval-when (compile eval)
        !            11:    (or (get 'const 'loaded) (load '../const.l)))
        !            12: 
        !            13: ;--- comp-err
        !            14: ;    comp-warn
        !            15: ;    comp-note
        !            16: ;    comp-gerr
        !            17: ; these are the compiler message producing macros.  The form is
        !            18: ; (comp-xxxx val1 val2 val3 ... valn) , all values are printed according
        !            19: ;  to this scheme. If vali is an atom, it is patomed, if vali is a
        !            20: ;  list, it is evaluated and printed. If vali is N a newline is printed
        !            21: ; 
        !            22: ; furthermore
        !            23: ;    the name of the current function is printed first
        !            24: ;    after comp-err prints the message, it does a throw to Comp-err .
        !            25: ;    errors are preceeded by Error: 
        !            26: ;      warnings by %Warning: and
        !            27: ;      notes by %Note:
        !            28: ;     The message is sent to the message file
        !            29: ;
        !            30: (def comp-err
        !            31:    (macro (l)
        !            32:          `(progn (comp-msg "?Error: " v-ifile ": " g-fname ": "
        !            33:                            ,@(cdr l) )
        !            34:                  (setq er-fatal (1+ er-fatal))
        !            35:                  (throw nil Comp-error))))
        !            36: 
        !            37: (def comp-warn
        !            38:    (macro (l)
        !            39:          `(progn (cond (fl-warn
        !            40:                            (comp-msg "%Warning: " v-ifile ": "  g-fname ": "
        !            41:                                      ,@(cdr l)))))))
        !            42: 
        !            43: (def comp-note
        !            44:    (macro (l)
        !            45:          `(progn (cond (fl-verb
        !            46:                            (comp-msg "%Note: " v-ifile ": "  ,@(cdr l)))))))
        !            47: 
        !            48: (def comp-gerr
        !            49:    (macro (l)
        !            50:          `(progn (comp-msg
        !            51:                      "?Error: " v-ifile ": " g-fname ": ",@(cdr l))
        !            52:                  (setq er-fatal (1+ er-fatal)))))
        !            53: 
        !            54: ;--- comp-msg - port
        !            55: ;            - lst
        !            56: ;  prints the lst to the given port.  The lst is printed in the manner
        !            57: ; described above, that is atoms are patomed, and lists are evaluated
        !            58: ; and printed, and N prints a newline.   The output is always drained.
        !            59: ;
        !            60: (def comp-msg
        !            61:    (macro (lis)
        !            62:          (do ((xx (cdr lis) (cdr xx))
        !            63:               (res nil))
        !            64:              ((null xx)
        !            65:               `(progn ,@(nreverse (cons '(terpri) res))))
        !            66:              (setq res
        !            67:                    (cons (cond ((atom (car xx))
        !            68:                                 (cond ((eq (car xx) 'N) '(terpr))
        !            69:                                       ((stringp (car xx)) `(patom ,(car xx)))
        !            70:                                       (t `(niceprint ,(car xx)))))
        !            71:                                (t `(niceprint ,(car xx))))
        !            72:                          res)))))
        !            73: 
        !            74: (def niceprint
        !            75:    (macro (l)
        !            76:          `((lambda (float-format) (patom ,(cadr l))) "%.2f")))
        !            77: 
        !            78: ;--- standard push macro
        !            79: ; (Push stackname valuetoadd)
        !            80: 
        !            81: (defmacro Push (atm val)
        !            82:   `(setq ,atm (cons ,val ,atm)))
        !            83: 
        !            84: ;--- unpush macro - like pop except top value is thrown away
        !            85: (defmacro unpush (atm)
        !            86:   `(setq ,atm (cdr ,atm)))
        !            87: 
        !            88: ;--- and an increment macro
        !            89: (defmacro incr (atm)
        !            90:   `(setq ,atm (1+ ,atm)))
        !            91: 
        !            92: (defmacro decr (atm)
        !            93:   `(setq ,atm (1- ,atm)))
        !            94: 
        !            95: ;--- add a comment
        !            96: (defmacro makecomment (arg)
        !            97:   `(cond (fl-comments (setq g-comments (cons ,arg g-comments)))))
        !            98: 
        !            99: ;--- add a comment irregardless of the fl-comments flag
        !           100: (defmacro forcecomment (arg)
        !           101:   `(setq g-comments (cons ,arg g-comments)))
        !           102: 
        !           103: ;--- write to the .s file
        !           104: (defmacro sfilewrite (arg)
        !           105:   `(patom ,arg vp-sfile))
        !           106: 
        !           107: (defmacro sfilewriteln (arg)
        !           108:   `(msg (P vp-sfile) ,arg N))
        !           109: 
        !           110: ;--- Liszt-file  :: keep track of rcs info regarding part of Liszt
        !           111: ;  This is put at the beginning of a file which makes up the lisp compiler.
        !           112: ; The form used is   (Liszt-file name rcs-string)
        !           113: ; where name is the name of this file (without the .l) and rcs-string.
        !           114: ;
        !           115: (defmacro Liszt-file (name rcs-string)
        !           116:    `(cond ((not (boundp 'Liszt-file-names))
        !           117:           (setq Liszt-file-names (ncons ,rcs-string)))
        !           118:          (t (setq Liszt-file-names
        !           119:                   (append1 Liszt-file-names ,rcs-string)))))
        !           120: 
        !           121: (eval-when (compile eval load)
        !           122:    (defun immed-const (x)
        !           123:          (get_pname (concat #+for-vax "$" #+for-68k "#" x))))
        !           124: 
        !           125: ; Indicate that this file has been loaded, before
        !           126: (putprop 'cmacros t 'version)
        !           127: 
        !           128: ;-------- Instruction Macros
        !           129: 
        !           130: #+for-vax
        !           131: (defmacro e-add (src dst)
        !           132:    `(e-write3 'addl2 ,src ,dst))
        !           133: 
        !           134: #+for-vax
        !           135: (defmacro e-sub (src dst)
        !           136:    `(e-write3 'subl2 ,src ,dst))
        !           137: 
        !           138: #+for-vax
        !           139: (defmacro e-cmp (src dst)
        !           140:    `(e-write3 'cmpl ,src ,dst))
        !           141: 
        !           142: (defmacro e-tst (src)
        !           143:    `(e-write2 'tstl ,src))
        !           144: 
        !           145: (defmacro e-quick-call (what)
        !           146:    `(e-write2 #+for-vax "jsb" #+for-68k "jbsr" ,what))
        !           147: 
        !           148: ;--- e-add3 :: add from two sources and store in the dest
        !           149: ;--- e-sub3 :: subtract from two sources and store in the dest
        !           150: 
        !           151: ; WARNING:  if the destination is an autoincrement addressing mode, then
        !           152: ;      this will not work for the 68000, because multiple instructions
        !           153: ;      are generated:
        !           154: ;              (e-add3 a b "sp@+")
        !           155: ;      is
        !           156: ;              movl b,sp@+
        !           157: ;              addl a,sp@+     (or addql)
        !           158: #+for-vax
        !           159: (defmacro e-add3 (s1 s2 dest)
        !           160:    `(e-write4 'addl3 ,s1 ,s2 ,dest))
        !           161: 
        !           162: #+for-68k
        !           163: (defmacro e-add3 (s1 s2 dest)
        !           164:    `(progn
        !           165:        (e-write3 'movl ,s2 ,dest)
        !           166:        (e-add ,s1 ,dest)))
        !           167: 
        !           168: #+for-vax
        !           169: (defmacro e-sub3 (s1 s2 dest)
        !           170:    `(e-write4 'subl3 ,s1 ,s2 ,dest))
        !           171: 
        !           172: #+for-68k
        !           173: (defmacro e-sub3 (s1 s2 dest)
        !           174:    `(progn
        !           175:        (e-write3 'movl ,s2 ,dest)
        !           176:        (e-sub ,s1 ,dest)))
        !           177: 
        !           178: (defmacro d-cmp (arg1 arg2)
        !           179:   `(e-cmp (e-cvt ,arg1) (e-cvt ,arg2)))
        !           180: 
        !           181: (defmacro d-tst (arg)
        !           182:   `(e-tst (e-cvt ,arg)))
        !           183: 
        !           184: ;--- d-cmpnil :: compare an IADR to nil
        !           185: ;
        !           186: (defmacro d-cmpnil (iadr)
        !           187:    #+for-vax `(d-tst ,iadr)
        !           188:    #+for-68k `(d-cmp 'Nil ,iadr))
        !           189: 
        !           190: (defmacro e-cmpnil (eiadr)
        !           191:    #+for-vax `(break 'e-cmpnil)
        !           192:    #+for-68k `(e-cmp (e-cvt 'Nil) ,eiadr))
        !           193: 
        !           194: (defmacro e-call-qnewint ()
        !           195:    `(e-quick-call '_qnewint))
        !           196: 
        !           197: (defmacro C-push (src)
        !           198:    #+for-68k `(e-move ,src '#.Cstack)
        !           199:    #+for-vax `(e-write2 'pushl ,src))
        !           200: 
        !           201: (defmacro L-push (src)
        !           202:    `(e-move ,src '#.np-plus))
        !           203: 
        !           204: (defmacro C-pop (dst)
        !           205:    `(e-move '#.unCstack ,dst))
        !           206: 
        !           207: (defmacro L-pop (dst)
        !           208:    `(e-move '#.np-minus ,dst))

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