![[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] / 43BSD / ucb / lisp / liszt|
Return to cmacros.l CVS log | Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / liszt |
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.