home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / lisp / liszt / instr.l < prev    next >
Encoding:
Text File  |  1987-12-15  |  4.6 KB  |  157 lines

  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)))
  157.