home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / lisp / liszt / cmacros.l < prev    next >
Encoding:
Text File  |  1987-12-15  |  5.7 KB  |  227 lines
  1. ;----------- macros for the compiler -------------
  2.  
  3. (setq RCS-cmacros
  4.    "$Header: cmacros.l,v 1.14 87/12/15 16:55:07 sklower 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 #+(or for-vax for-tahoe) "$" #+for-68k "#" x))))
  125.  
  126. ; Indicate that this file has been loaded, before
  127. (putprop 'cmacros t 'version)
  128.  
  129. ;-------- Instruction Macros
  130.  
  131. #+(or for-vax for-tahoe)
  132. (defmacro e-add (src dst)
  133.    `(e-write3 'addl2 ,src ,dst))
  134.  
  135. #+(or for-vax for-tahoe)
  136. (defmacro e-sub (src dst)
  137.    `(e-write3 'subl2 ,src ,dst))
  138.  
  139. #+(or for-vax for-tahoe)
  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. #+for-vax
  147. (defmacro e-quick-call (what)
  148.    `(e-write2 "jsb" ,what))
  149.  
  150. #+for-tahoe
  151. (defmacro e-quick-call (what)
  152.    `(e-write3 "calls" "$4" ,what))
  153.  
  154. #+for-68k
  155. (defmacro e-quick-call (what)
  156.   `(e-write2 "jsbr" ,what))
  157.  
  158.  
  159. ;--- e-add3 :: add from two sources and store in the dest
  160. ;--- e-sub3 :: subtract from two sources and store in the dest
  161.  
  162. ; WARNING:  if the destination is an autoincrement addressing mode, then
  163. ;    this will not work for the 68000, because multiple instructions
  164. ;    are generated:
  165. ;        (e-add3 a b "sp@+")
  166. ;    is
  167. ;        movl b,sp@+
  168. ;        addl a,sp@+    (or addql)
  169. #+(or for-vax for-tahoe)
  170. (defmacro e-add3 (s1 s2 dest)
  171.    `(e-write4 'addl3 ,s1 ,s2 ,dest))
  172.  
  173. #+for-68k
  174. (defmacro e-add3 (s1 s2 dest)
  175.    `(progn
  176.        (e-write3 'movl ,s2 ,dest)
  177.        (e-add ,s1 ,dest)))
  178.  
  179. #+(or for-vax for-tahoe)
  180. (defmacro e-sub3 (s1 s2 dest)
  181.    `(e-write4 'subl3 ,s1 ,s2 ,dest))
  182.  
  183. #+for-68k
  184. (defmacro e-sub3 (s1 s2 dest)
  185.    `(progn
  186.        (e-write3 'movl ,s2 ,dest)
  187.        (e-sub ,s1 ,dest)))
  188.  
  189. (defmacro d-cmp (arg1 arg2)
  190.   `(e-cmp (e-cvt ,arg1) (e-cvt ,arg2)))
  191.  
  192. (defmacro d-tst (arg)
  193.   `(e-tst (e-cvt ,arg)))
  194.  
  195. ;--- d-cmpnil :: compare an IADR to nil
  196. ;
  197. (defmacro d-cmpnil (iadr)
  198.    #+(or for-vax for-tahoe) `(d-tst ,iadr)
  199.    #+for-68k `(d-cmp 'Nil ,iadr))
  200.  
  201. (defmacro e-cmpnil (eiadr)
  202.    #+(or for-vax for-tahoe) `(break 'e-cmpnil)
  203.    #+for-68k `(e-cmp (e-cvt 'Nil) ,eiadr))
  204.  
  205. (defmacro e-call-qnewint ()
  206.    `(e-quick-call '_qnewint))
  207.  
  208. (defmacro C-push (src)
  209.    #+for-68k `(e-move ,src '#.Cstack)
  210.    #+(or for-vax for-tahoe) `(e-write2 'pushl ,src))
  211.  
  212. (defmacro L-push (src)
  213.    `(e-move ,src '#.np-plus))
  214.  
  215. (defmacro C-pop (dst)
  216.    `(e-move '#.unCstack ,dst))
  217.  
  218. #+(or for-vax for-68k)
  219. (defmacro L-pop (dst)
  220.    `(e-move '#.np-minus ,dst))
  221.  
  222. #+for-tahoe
  223. (defmacro L-pop (dst)
  224.    `(progn (e-sub '($ 4) '#.np-reg)
  225.        (e-move '(0 #.np-reg) ,dst)))
  226.  
  227.