![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instr.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / liszt|
Return to instr.l CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / liszt |
1.1 root 1: (include-if (null (get 'chead 'version)) "../chead.l")
2: (Liszt-file instr
3: "$Header: instr.l,v 1.9 87/12/15 17:03:01 sklower Exp $")
4:
5: ;;; ---- i n s t r emulate machine instructions
6: ;;;
7: ;;; -[Thu Jan 5 18:40:50 1984 by jkf]-
8:
9:
10: ; The routines in this file emulate instructions, usually VAX-11
11: ; ones. Routines names with the prefix "e-" take EIADR's, and
12: ; those with "d-" take IADR's as arguments.
13: ; Some of the simple routines are accually macros, and can be found in
14: ; ../cmacros.l
15:
16:
17: ;--- d-add :: emit an add intruction
18: ; 68000 has a quick add for $1 - $8
19: ;
20: ; (the one for the vax is a macro in cmacros.l)
21: #+for-68k
22: (defun e-add (src dst)
23: (if (and (dtpr src)
24: (eq '$ (car src))
25: (and (>& (cadr src) 0) (<& (cadr src) 9)))
26: then (e-write3 'addql src dst)
27: else (e-write3 'addl src dst)))
28:
29: ;--- e-sub :: emit an add intruction (check for quick add: (immed 1 - 8))
30: ;
31: #+for-68k
32: (defun e-sub (src dst)
33: (if (and (dtpr src)
34: (eq '$ (car src))
35: (zerop (cadr src)))
36: thenret
37: elseif (and (dtpr src)
38: (numberp (cadr src))
39: (and (>& (cadr src) 0) (<& (cadr src) 9)))
40: then (e-write3 'subql src dst)
41: else (e-write3 'subl src dst)))
42:
43: ; NOTE: The cmp routines emis instructions to test the condition codes
44: ; by arg1 - arg2 (ie, arg1 is subtracted from arg2). On the
45: ; 68000 the args must be reversed.
46:
47: ;--- e-cmp :: compare two EIADR values
48: ;
49: ; NOTE: for 68000, this does "cmpl dst,src"
50: ;
51: #+for-68k
52: (defun e-cmp (src dst)
53: (if (and (symbolp src)
54: (memq src '(d0 d7 a0 a1 a2 d3 d1 d2 a3 a4 a5 sp d6 a6 d4 d5)))
55: then ; the form is "cmp <ea>,Rx"
56: (e-write3 'cmpl dst src)
57: elseif (and (dtpr dst)
58: (or (memq (car dst) '($ \#))
59: (and (eq '* (car dst))
60: (eq '\# (cadr dst)))))
61: then ; the form is "cmp #const,<ea>"
62: (if (and (dtpr src)
63: (or (memq (car src) '($ \#))
64: (and (eq '* (car src))
65: (eq '\# (cadr src)))))
66: then ; we have "cmp #n,#m"
67: ; and we can't do it in one cmp
68: (d-regused 'd6)
69: (e-write3 'movl src 'd6)
70: (e-write3 'cmpl dst 'd6)
71: else ; we have "cmp #n,<ea>"
72: (e-write3 'cmpl dst src))
73: elseif (and (dtpr src)
74: (dtpr dst)
75: (eq '+ (car src))
76: (eq '+ (car dst)))
77: then ; the form is "cmp An@+,Am@+"
78: (e-write3 'cmpml dst src)
79: else ; addressing modes are too complicated to
80: ; do in 1 instruction...
81: (d-regused 'd6)
82: (e-write3 'movl src 'd6)
83: (e-write3 'cmpl dst 'd6)))
84:
85: ;--- e-move :: move value from one place to anther
86: ; this corresponds to d-move except the args are EIADRS
87: ;
88: (defun e-move (from to)
89: (if (and (dtpr from)
90: (eq '$ (car from))
91: (eq 0 (cadr from)))
92: then (e-write2 'clrl to)
93: else (e-write3 'movl from to)))
94:
95: ;--- d-move :: emit instructions to move value from one place to another
96: ;
97: (defun d-move (from to)
98: (makecomment `(from ,(e-uncvt from) to ,(e-uncvt to)))
99: #+(or for-vax for-tahoe)
100: (cond ((eq 'Nil from) (e-move '($ 0) (e-cvt to)))
101: (t (e-move (e-cvt from) (e-cvt to))))
102:
103: #+for-68k
104: (let ((froma (e-cvt from))
105: (toa (e-cvt to)))
106: (if (and (dtpr froma)
107: (eq '$ (car froma))
108: (and (>& (cadr froma) -1) (<& (cadr froma) 65))
109: (atom toa)
110: (eq 'd (nthchar toa 1)))
111: then ;it's a mov #immed,Dn, where 0 <= immed <= 64
112: ; i.e., it's a quick move
113: (e-write3 'moveq froma toa)
114: else (cond ((eq 'Nil froma) (e-write3 'movl '#.nil-reg toa))
115: (t (e-write3 'movl froma toa))))))
116:
117: ;--- d-movespec :: move from loc to loc where the first addr given is
118: ; an EIADR
119: ; - from : EIADR
120: ; - to : IADR
121: ;
122: (defun d-movespec (from to)
123: (makecomment `(fromspec ,from to ,(e-uncvt to)))
124: (e-move from (e-cvt to)))
125:
126: ;--- d-ashl :: emit shift code (don't know what direction to shift)
127: #+for-68k
128: (defun d-ashl (count src dst)
129: (let ((genlab1 (d-genlab))
130: (genlab2 (d-genlab)))
131: (e-write3 'movl src dst)
132: (e-write2 'tstl count)
133: (e-write2 'bmi genlab1)
134: (e-write3 'asll count dst)
135: (e-write2 'bra genlab2)
136: (e-label genlab1)
137: (e-write3 'asrl count dst)
138: (e-writel genlab2)))
139:
140: ;--- d-asrl :: emit shift right code
141: #+for-68k
142: (defun d-asrl (count src dst)
143: (e-write3 'movl src dst)
144: (if (and (numberp count) (greaterp count 8))
145: then (e-write3 'moveq (concat "#" count) 'd0)
146: (e-write3 'asrl 'd0 dst)
147: else (e-write3 'asrl (concat "#" count) dst)))
148:
149: ;--- d-asll :: emit shift left code
150: #+for-68k
151: (defun d-asll (count src dst)
152: (e-write3 'movl src dst)
153: (if (and (numberp count) (greaterp count 8))
154: then (e-write3 'moveq `($ ,count) 'd0)
155: (e-write3 'asll 'd0 dst)
156: else (e-write3 'asll `($ ,count) dst)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.