![[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] / 42BSD / ucb / lisp / liszt|
Return to instr.l CVS log | Up to [CSRG BSD Unix] / 42BSD / 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.6 83/08/28 17:15:18 layer Exp $")
4:
5: ;;; ---- i n s t r emulate machine instructions
6: ;;;
7: ;;; -[Mon Aug 15 15:19:54 1983 by layer]-
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 (eq '$ (car src))
24: (and (>& (cadr src) 0) (<& (cadr src) 9)))
25: then (e-write3 'addql src dst)
26: else (e-write3 'addl src dst)))
27:
28: ;--- e-sub :: emit an add intruction (check for quick add: (immed 1 - 8))
29: ;
30: #+for-68k
31: (defun e-sub (src dst)
32: (if (and (dtpr src)
33: (eq '$ (car src))
34: (zerop (cadr src)))
35: thenret
36: elseif (and (dtpr src)
37: (numberp (cadr src))
38: (and (>& (cadr src) 0) (<& (cadr src) 9)))
39: then (e-write3 'subql src dst)
40: else (e-write3 'subl src dst)))
41:
42: ; NOTE: The cmp routines emis instructions to test the condition codes
43: ; by arg1 - arg2 (ie, arg1 is subtracted from arg2). On the
44: ; 68000 the args must be reversed.
45:
46: ;--- e-cmp :: compare two EIADR values
47: ;
48: ; NOTE: for 68000, this does "cmpl dst,src"
49: ;
50: #+for-68k
51: (defun e-cmp (src dst)
52: (if (and (symbolp src)
53: (memq src '(d0 d7 a0 a1 a2 d3 d1 d2 a3 a4 a5 sp d6 a6 d4 d5)))
54: then ; the form is "cmp <ea>,Rx"
55: (e-write3 'cmpl dst src)
56: elseif (and (dtpr dst)
57: (or (memq (car dst) '($ \#))
58: (and (eq '* (car dst))
59: (eq '\# (cadr dst)))))
60: then ; the form is "cmp #const,<ea>"
61: (e-write3 'cmpl dst src)
62: elseif (and (dtpr src)
63: (dtpr dst)
64: (eq '+ (car src))
65: (eq '+ (car dst)))
66: then ; the form is "cmp an@+,am@+"
67: (e-write3 'cmpml dst src)
68: else ; addressing modes are too complicated to
69: ; do in 1 instruction...
70: (d-regused 'd6)
71: (e-write3 'movl src 'd6)
72: (e-write3 'cmpl dst 'd6)))
73:
74: ;--- e-move :: move value from one place to anther
75: ; this corresponds to d-move except the args are EIADRS
76: ;
77: (defun e-move (from to)
78: (if (and (dtpr from)
79: (eq '$ (car from))
80: (eq 0 (cadr from)))
81: then (e-write2 'clrl to)
82: else (e-write3 'movl from to)))
83:
84: ;--- d-move :: emit instructions to move value from one place to another
85: ;
86: (defun d-move (from to)
87: (makecomment `(from ,(e-uncvt from) to ,(e-uncvt to)))
88: #+for-vax
89: (cond ((eq 'Nil from) (e-write2 'clrl (e-cvt to)))
90: (t (e-move (e-cvt from) (e-cvt to))))
91: #+for-68k
92: (let ((froma (e-cvt from))
93: (toa (e-cvt to)))
94: (if (and (dtpr froma)
95: (eq '$ (car froma))
96: (and (>& (cadr froma) -1) (<& (cadr froma) 65))
97: (atom toa)
98: (eq 'd (nthchar toa 1)))
99: then ;it's a mov #immed,Dn, where 0 <= immed <= 64
100: ; i.e., it's a quick move
101: (e-write3 'moveq froma toa)
102: else (cond ((eq 'Nil froma) (e-write3 'movl '#.nil-reg toa))
103: (t (e-write3 'movl froma toa))))))
104:
105: ;--- d-movespec :: move from loc to loc where the first addr given is
106: ; an EIADR
107: ; - from : EIADR
108: ; - to : IADR
109: ;
110: (defun d-movespec (from to)
111: (makecomment `(fromspec ,from to ,(e-uncvt to)))
112: (e-move from (e-cvt to)))
113:
114: ;--- d-ashl :: emit shift code (don't know what direction to shift)
115: #+for-68k
116: (defun d-ashl (count src dst)
117: (let ((genlab1 (d-genlab))
118: (genlab2 (d-genlab)))
119: (e-write3 'movl src dst)
120: (e-write2 'tstl count)
121: (e-write2 'bmi genlab1)
122: (e-write3 'asll count dst)
123: (e-write2 'bra genlab2)
124: (e-label genlab1)
125: (e-write3 'asrl count dst)
126: (e-writel genlab2)))
127:
128: ;--- d-asrl :: emit shift right code
129: #+for-68k
130: (defun d-asrl (count src dst)
131: (e-write3 'movl src dst)
132: (if (and (numberp count) (greaterp count 8))
133: then (e-write3 'moveq (concat "#" count) 'd0)
134: (e-write3 'asrl 'd0 dst)
135: else (e-write3 'asrl (concat "#" count) dst)))
136:
137: ;--- d-asll :: emit shift left code
138: #+for-68k
139: (defun d-asll (count src dst)
140: (e-write3 'movl src dst)
141: (if (and (numberp count) (greaterp count 8))
142: then (e-write3 'moveq `($ ,count) 'd0)
143: (e-write3 'asll 'd0 dst)
144: 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.