Return to cmacros.l CVS log

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

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

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