![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cmacros.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / liszt|
Return to cmacros.l CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / liszt |
1.1 root 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.