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