![[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] / 43BSD / ucb / lisp / liszt|
Return to instr.l CVS log | Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / liszt |
1.1 root 1: (include-if (null (get 'chead 'version)) "../chead.l")
2: (Liszt-file instr
3: "$Header: instr.l,v 1.7 84/01/05 18:40:55 jkf 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: #+for-vax
100: (cond ((eq 'Nil from) (e-write2 'clrl (e-cvt to)))
101: (t (e-move (e-cvt from) (e-cvt to))))
102: #+for-68k
103: (let ((froma (e-cvt from))
104: (toa (e-cvt to)))
105: (if (and (dtpr froma)
106: (eq '$ (car froma))
107: (and (>& (cadr froma) -1) (<& (cadr froma) 65))
108: (atom toa)
109: (eq 'd (nthchar toa 1)))
110: then ;it's a mov #immed,Dn, where 0 <= immed <= 64
111: ; i.e., it's a quick move
112: (e-write3 'moveq froma toa)
113: else (cond ((eq 'Nil froma) (e-write3 'movl '#.nil-reg toa))
114: (t (e-write3 'movl froma toa))))))
115:
116: ;--- d-movespec :: move from loc to loc where the first addr given is
117: ; an EIADR
118: ; - from : EIADR
119: ; - to : IADR
120: ;
121: (defun d-movespec (from to)
122: (makecomment `(fromspec ,from to ,(e-uncvt to)))
123: (e-move from (e-cvt to)))
124:
125: ;--- d-ashl :: emit shift code (don't know what direction to shift)
126: #+for-68k
127: (defun d-ashl (count src dst)
128: (let ((genlab1 (d-genlab))
129: (genlab2 (d-genlab)))
130: (e-write3 'movl src dst)
131: (e-write2 'tstl count)
132: (e-write2 'bmi genlab1)
133: (e-write3 'asll count dst)
134: (e-write2 'bra genlab2)
135: (e-label genlab1)
136: (e-write3 'asrl count dst)
137: (e-writel genlab2)))
138:
139: ;--- d-asrl :: emit shift right code
140: #+for-68k
141: (defun d-asrl (count src dst)
142: (e-write3 'movl src dst)
143: (if (and (numberp count) (greaterp count 8))
144: then (e-write3 'moveq (concat "#" count) 'd0)
145: (e-write3 'asrl 'd0 dst)
146: else (e-write3 'asrl (concat "#" count) dst)))
147:
148: ;--- d-asll :: emit shift left code
149: #+for-68k
150: (defun d-asll (count src dst)
151: (e-write3 'movl src dst)
152: (if (and (numberp count) (greaterp count 8))
153: then (e-write3 'moveq `($ ,count) 'd0)
154: (e-write3 'asll 'd0 dst)
155: 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.