home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / lisp / liszt / fixnum.l < prev    next >
Encoding:
Text File  |  1988-04-26  |  17.6 KB  |  544 lines
  1. (include-if (null (get 'chead 'version)) "../chead.l")
  2. (Liszt-file fixnum
  3.    "$Header: /usr/src/local/franz/liszt/RCS/fixnum.l,v 1.16 88/04/26 11:50:18 sklower Exp $")
  4.  
  5. ;;; ----    f i x n u m        fixnum compilation
  6. ;;;
  7. ;;;                -[Fri Aug 26 14:07:53 1983 by layer]-
  8.  
  9. ;  There are a few functions in lisp which are only permitted to take
  10. ; fixnum operands and produce fixnum results.  The compiler recognizes
  11. ; these functions and open codes them.
  12. ;
  13.  
  14. ;--- d-fixnumexp :: compute a fixnum from an expression
  15. ;    x - a lisp expression which must return a fixnum
  16. ;
  17. ; This is an almost equivalent to d-exp, except that
  18. ; 1] it will do clever things if the expression can be open coded in a 
  19. ;    fixnum way.
  20. ; 2] the result must be a fixnum, and is left in r5 unboxed.
  21. ;
  22. (defun d-fixnumexp (x)
  23.   (d-fixnumcode (d-fixexpand x)))
  24.  
  25.  
  26. ;--- c-fixnumop :: compute a fixnum result
  27. ;  This is the extry point into this code from d-exp.  The form to evaluate
  28. ; is in v-form.  The only way we could get here is if the car of v-form
  29. ; is a function which we've stated is a fixnum returning function. 
  30. ;
  31. (defun c-fixnumop nil
  32.   (d-fixnumexp v-form)
  33.   (d-fixnumbox))
  34.  
  35. ;--- d-fixnumbox :: rebox a fixnum in r5
  36. ;
  37. #+(or for-vax for-tahoe)
  38. (defun d-fixnumbox ()
  39.    (let (x)
  40.     (e-write3 'moval (concat "*$5120[" '#.fixnum-reg "]") 'r0)
  41.     (e-sub3 '($ 1024) '#.fixnum-reg 'r1)
  42.     (e-write2 'blssu (setq x (d-genlab)))
  43.     (e-call-qnewint)
  44.     (e-writel x)
  45.     (d-clearreg)))
  46.  
  47. #+for-68k
  48. (defun d-fixnumbox ()
  49.    (let (x)
  50.     (d-regused '#.fixnum-reg)
  51.     (e-move '#.fixnum-reg 'd0)
  52.     (e-write3 'asll '($ 2) 'd0)
  53.     ; add onto the base of the fixnums
  54.     (e-add (e-cvt '(fixnum 0)) 'd0)
  55.     (e-move '#.fixnum-reg 'd1) 
  56.     (e-sub '($ 1024) 'd1)
  57.     (e-write2 'jcs (setq x (d-genlab)))    ;branch carry set
  58.     (e-call-qnewint)
  59.     (e-writel x)
  60.     (d-clearreg)))
  61.  
  62. ;--- d-fixexpand  :: pass over a fixnum expression doing local optimizations
  63. ; 
  64. ; This code gets the first look at the operands of a fixnum expression.
  65. ; It handles the strange cases, like (+) or (/ 3), and it also insures
  66. ; that constants are folded (or collapsed as we call it here).
  67. ; 
  68. ; things to watch out for:
  69. ; (+ x y z) we can fold x,y,z , likewise in the case of *
  70. ; (- x y z) we can only fold y and z since they are negated but x is not,
  71. ;        likewise for /
  72. (defun d-fixexpand (x)
  73.   (prog nil
  74.     (setq x (d-macroexpand x))
  75.     loop
  76.     (if (and (dtpr x) (symbolp (car x)) (get (car x) 'fixop))
  77.         then (if (memq (car x) '(+ *))
  78.              then  (setq x (cons (car x)
  79.                      (d-collapse (cdr x) (car x))))
  80.              else  (setq x
  81.                  (cons (car x)
  82.                        (cons (cadr x)
  83.                          (d-collapse (cddr x) (car x))))))
  84.              (if (null (cdr x))
  85.              then  ; (- or +) => 0 (* or /) => 1
  86.                  (setq x
  87.                    (cdr (assq (car x)
  88.                       '((+ . 0) (- . 0)
  89.                         (* . 1) (/ . 1)))))
  90.                  (go loop)
  91.           elseif (null (cddr x)) then
  92.                    ; (+ n) => n, (- n) => (- 0 n), (* n) => n,
  93.                ; (/ n) => (/ 1 n)
  94.               (setq x
  95.                 (if (memq (car x) '(* +))
  96.                     then (cadr x)
  97.                  elseif (eq (car x) '-)
  98.                     then `(- 0 ,(cadr x))
  99.                  elseif (eq (car x) '/)
  100.                     then `(/ 1 ,(cadr x))
  101.                     else (comp-err
  102.                          "Internal fixexpand error ")))
  103.               (go loop)))
  104.     (return x)))
  105.  
  106. ;--- d-toplevmacroexpand :: expand top level form if macro
  107. ; a singe level of macro expansion is done.  this is a nice general
  108. ; routine and should be used by d-exp.
  109. ;**** out of date **** will be removed soon
  110. (defun d-toplevmacroexpand (x)
  111.   (let ((fnbnd (and (dtpr x) (symbolp (car x)) (getd (car x)))))
  112.        (if (and fnbnd (or (and (bcdp fnbnd) (eq (getdisc fnbnd) 'macro))
  113.               (and (dtpr fnbnd) (eq (car fnbnd) 'macro))))
  114.        then (d-toplevmacroexpand (apply fnbnd x))
  115.        else x)))
  116.  
  117.  
  118. ;--- d-collapse :: collapse (fold) constants
  119. ; 
  120. ; this is used to reduce the number of operations. since we know that
  121. ; fixnum operations are commutative.
  122. ;
  123. (defun d-collapse (form op)
  124.   (let (const res conlist)
  125.        ; generate list of constants (conlist) and non constants (res)
  126.        (do ((xx form (cdr xx)))
  127.        ((null xx))
  128.        (if (numberp (car xx))
  129.            then (if (fixp (car xx))
  130.             then (setq conlist (cons (car xx) conlist))
  131.             else (comp-err "Illegal operand in fixnum op " 
  132.                        (car xx)))
  133.            else (setq res (cons (car xx) res))))
  134.  
  135.        ; if no constants found thats ok, but if we found some,
  136.        ; then collapse and return the form with the collapsed constant
  137.        ; at the end.
  138.  
  139.        (if (null conlist)
  140.        then form     ; no change
  141.        else (setq res (nreverse 
  142.          (cons (apply (cond ((or (eq op '/) (eq op '*)) 'times)
  143.                     (t 'plus)) 
  144.                   (cons (cond ((or (eq op '/) (eq op '*)) 1)
  145.                       (t 0))
  146.                     conlist))
  147.                res))))))
  148.  
  149.  
  150. ;---- d-fixnumcode :: emit code for prescanned fixnum expression
  151. ;    expr -  a expression which should return an unboxed fixnum value 
  152. ;        in r5.
  153. ;  This function checks if the expression is indeed a guaranteed fixnum 
  154. ; arithmetic expression, and if so , generates code for the operation.
  155. ; If the expression is not a fixnum operation, then a normal evaluation
  156. ; of the cdr of the expression is done, which will grab the fixnum value
  157. ; and put it in r5.
  158. ;
  159. #+(or for-vax for-tahoe)
  160. (defun d-fixnumcode (expr)
  161.   (let ((operator (and (dtpr expr) 
  162.                (symbolp (car expr)) 
  163.                (get (car expr) 'fixop)))
  164.     (g-ret nil)
  165.     tmp)
  166.        ; the existance of a fixop property on a function says that it is a
  167.        ; special fixnum only operation.
  168.        (if (null operator) 
  169.        then (let ((g-loc '#.fixnum-reg) g-cc) ; non fixnum op, do normal
  170.              (d-exp `(cdr ,expr)))    ; eval to get unboxed number
  171.        else (do ((xx (cdr expr) (cdr xx))    ; fixnum op, scan all args
  172.              (lop) (rop) (res) (opnd))
  173.             ((null xx))
  174.             (setq opnd (car xx))
  175.             (if (fixp opnd) 
  176.             then (setq rop `(immed ,opnd))
  177.                 elseif (and (symbolp opnd) 
  178.                  (setq rop (d-simple `(cdr ,opnd))))
  179.                 thenret
  180.             else (if (and lop (not (eq lop '#.unCstack)))
  181.                  then (C-push (e-cvt lop))
  182.                  (setq lop '#.unCstack))
  183.                  (d-fixnumcode (d-fixexpand opnd))
  184.                  (setq rop 'r5))
  185.             (if (null lop) 
  186.             then (if (cdr xx) 
  187.                  then (setq lop rop)
  188.                  else (e-move (e-cvt rop) 'r5))
  189.             else (if (cdr xx) 
  190.                  then (setq res '#.Cstack)
  191.                  else (setq res 'r5))
  192.                  (if (setq tmp (d-shiftcheck operator rop))
  193.                  then (e-write4 #+for-vax 'ashl 
  194.                         #+for-tahoe 'shal
  195.                         (e-cvt (list 'immed tmp))
  196.                         (e-cvt lop)
  197.                         (e-cvt res))
  198.                  else (e-write4 operator (e-cvt rop) 
  199.                         (e-cvt lop) 
  200.                         (e-cvt res)))
  201.                  (if (cdr xx) 
  202.                  then (setq lop '#.unCstack)
  203.                  else (setq lop "r5")))))))
  204.  
  205. #+for-68k
  206. (defun d-fixnumcode (expr)
  207.    (let ((operator (and (dtpr expr)
  208.             (symbolp (car expr))
  209.             (get (car expr) 'fixop)))
  210.      (g-ret nil)
  211.      tmp)
  212.        ; the existance of a fixop property on a function says that it is a
  213.        ; special fixnum only operation.
  214.        (makecomment `(d-fixnumcode ,expr))
  215.        (if (null operator) 
  216.        then (let ((g-loc '#.fixnum-reg) g-cc) ; non fixnum op, do normal
  217.             (d-exp `(cdr ,expr)))      ; eval to get unboxed number
  218.         (d-regused '#.fixnum-reg)
  219.        else (do ((xx (cdr expr) (cdr xx))      ; fixnum op, scan all args
  220.              (lop) (rop) (res) (opnd))
  221.             ((null xx))
  222.             (setq opnd (car xx))
  223.             (if (fixp opnd) 
  224.             then (setq rop `(immed ,opnd))
  225.              elseif (and (symbolp opnd)
  226.                  (setq rop (d-simple `(cdr ,opnd))))
  227.             thenret
  228.             else (if (and lop (not (eq lop '#.unCstack)))
  229.                  then (C-push (e-cvt lop))
  230.                       (setq lop '#.unCstack))
  231.                  (d-fixnumcode (d-fixexpand opnd))
  232.                  (setq rop '#.fixnum-reg))
  233.             (if (null lop) 
  234.             then (if (cdr xx) 
  235.                  then (setq lop rop)
  236.                  else (e-move
  237.                         (e-cvt rop)
  238.                         '#.fixnum-reg))
  239.             else (if (cdr xx) 
  240.                  then (setq res '#.Cstack)
  241.                  else (setq res '#.fixnum-reg))
  242.                  (if (setq tmp (d-shiftcheck operator rop))
  243.                  then (d-asll tmp (e-cvt lop) (e-cvt res))
  244.                  else (e-move (e-cvt lop) 'd0)
  245.                       (e-write3 operator (e-cvt rop) 'd0)
  246.                       (e-move 'd0 (e-cvt res)))
  247.                  (if (cdr xx) 
  248.                  then (setq lop '#.unCstack)
  249.                  else (setq lop '#.fixnum-reg)))))
  250.        (makecomment '(d-fixnumcode done))))
  251.  
  252. ;--- d-shiftcheck    :: check if we can shift instead of multiply
  253. ; return t if the operator is a multiply and the operand is an
  254. ; immediate whose value is a power of two.
  255. (defun d-shiftcheck (operator operand)
  256.    (and (eq operator #+(or for-vax for-tahoe) 'lmul
  257.                  #+for-68k 'mull3)
  258.     (dtpr operand)
  259.     (eq (car operand) 'immed)
  260.     (cdr (assoc (cadr operand) arithequiv))))
  261.  
  262. ; this table is incomplete 
  263. ;
  264. (setq arithequiv '((1 . 0) (2 . 1) (4 . 2) (8 . 3) (16 . 4) (32 . 5)
  265.            (64 . 6) (128 . 7) (256 . 8) (512 . 9) (1024 . 10)
  266.            (2048 . 11) (4096 . 12) (8192 . 13) (16384 . 14)
  267.            (32768 . 15) (65536 . 16) (131072 . 17)))
  268.  
  269.  
  270. ;--- cc-oneplus  :: compile 1+ form            = cc-oneplus =
  271. ;  1+ increments a fixnum only. We generate code to check if the number
  272. ; to be incremented is a small fixnum less than or equal to 1022.  This
  273. ; check is done by checking the address of the fixnum's box.  If the
  274. ; number is in that range, we just increment the box pointer by 4.
  275. ; otherwise we call we call _qoneplus which does the add and calls
  276. ; _qnewint
  277. ;
  278. #+(or for-vax for-tahoe)
  279. (defun cc-oneplus nil
  280.   (if (null g-loc)
  281.       then (if (car g-cc) then (e-goto (car g-cc)))
  282.       else (let ((argloc (d-simple (cadr v-form)))
  283.          (lab1 (d-genlab))
  284.          (lab2 (d-genlab)))
  285.         (if (null argloc) 
  286.             then (let ((g-loc 'r0) g-cc g-ret)
  287.                   (d-exp (cadr v-form)))
  288.              (setq argloc 'reg))
  289.         (e-cmp (e-cvt argloc) '($ #.(+ 5120 (* 4 1022))))
  290.         (e-write2 'jleq lab1)
  291.         (if (not (eq argloc 'r0)) then (d-move argloc 'reg))
  292.         (e-quick-call '_qoneplus)
  293.         (if (and g-loc (not (eq g-loc 'reg)))
  294.             then (d-move 'reg g-loc))
  295.         (if (car g-cc)
  296.             then (e-goto (car g-cc))
  297.             else (e-goto lab2))
  298.         (e-label lab1)
  299.         (e-add3 '($ 4) (e-cvt argloc) (e-cvt g-loc))
  300.         (if (car g-cc) then (e-goto (car g-cc)))
  301.         (e-label lab2))))
  302.  
  303. #+for-68k
  304. (defun cc-oneplus nil
  305.    (if (null g-loc)
  306.        then (if (car g-cc) then (e-goto (car g-cc)))
  307.        else (let ((argloc (d-simple (cadr v-form)))
  308.           (lab1 (d-genlab))
  309.           (lab2 (d-genlab)))
  310.         (if (null argloc) 
  311.             then (let ((g-loc 'areg) g-cc g-ret)
  312.                  (d-exp (cadr v-form)))
  313.              (setq argloc 'areg))
  314.         ; ($ (+ Fixzero (* 4 1022))
  315.         (d-cmp argloc '(fixnum 1022))
  316.         (e-write2 'jle lab1)
  317.         (if (not (eq argloc 'areg)) then (d-move argloc 'areg))
  318.         (e-quick-call '_qoneplus)
  319.         (if (and g-loc (not (eq g-loc 'reg)))
  320.             then (d-move 'reg g-loc))
  321.         (if (car g-cc)
  322.             then (e-goto (car g-cc))
  323.             else (e-goto lab2))
  324.         (e-label lab1)
  325.         (if (not (eq argloc 'reg))
  326.             then (d-move argloc 'reg))
  327.         (e-write3 'addql "#4" 'd0)
  328.         (if (and g-loc (not (eq g-loc 'reg)))
  329.             then (d-move 'reg g-loc))
  330.         (if (car g-cc) then (e-goto (car g-cc)))
  331.         (e-label lab2))))
  332.             
  333.  
  334.  
  335. ;--- cc-oneminus :: compile the 1- form
  336. ; just like 1+ we check to see if we are decrementing an small fixnum.
  337. ; and if we are we just decrement the pointer to the fixnum and save
  338. ; a call to qinewint.  The valid range of fixnums we can decrement are
  339. ; 1023 to -1023.  This requires two range checks (as opposed to one for 1+).
  340. ;
  341. #+(or for-vax for-tahoe)
  342. (defun cc-oneminus nil
  343.   (if (null g-loc)
  344.       then (if (car g-cc) then (e-goto (car g-cc)))
  345.       else (let ((argloc (d-simple (cadr v-form)))
  346.          (lab1 (d-genlab))
  347.          (lab2 (d-genlab))
  348.          (lab3 (d-genlab)))
  349.         (if (null argloc) 
  350.             then (let ((g-loc 'r0) g-cc)
  351.                   (d-exp (cadr v-form)))
  352.                  (setq argloc 'reg))
  353.         (e-cmp (e-cvt argloc) '($ #.(- 5120 (* 4 1024))))
  354.         (e-write2 'jleq lab1)    ; not within range
  355.         (e-cmp (e-cvt argloc) '($ #.(+ 5120 (* 4 1023))))
  356.         (e-write2 'jleq lab2)    ; within range
  357.         ; not within range, must do it the hard way.
  358.         (e-label lab1)
  359.         (if (not (eq argloc 'r0)) then (d-move argloc 'reg))
  360.         (e-quick-call '_qoneminus)
  361.         (if (and g-loc (not (eq g-loc 'reg)))
  362.             then (d-move 'reg g-loc))
  363.         (if (car g-cc)
  364.             then (e-goto (car g-cc))
  365.             else (e-goto lab3))
  366.         (e-label lab2)
  367.         ; we are within range, just decrement the pointer by the
  368.         ; size of a word (4 bytes).
  369.         (e-sub3 '($ 4) (e-cvt argloc) (e-cvt g-loc))
  370.         (if (car g-cc) then (e-goto (car g-cc)))
  371.         (e-label lab3))))
  372.  
  373. #+for-68k
  374. (defun cc-oneminus nil
  375.   (if (null g-loc)
  376.       then (if (car g-cc) then (e-goto (car g-cc)))
  377.       else (let ((argloc (d-simple (cadr v-form)))
  378.          (lab1 (d-genlab))
  379.          (lab2 (d-genlab))
  380.          (lab3 (d-genlab)))
  381.         (if (null argloc) 
  382.             then (let ((g-loc 'areg) g-cc)
  383.                   (d-exp (cadr v-form)))
  384.                  (setq argloc 'areg))
  385.         ; ($ (- Fixzero (* 4 1024)))
  386.         (d-cmp argloc '(fixnum -1024))
  387.         (e-write2 'jle lab1)    ; not within range
  388.         (d-cmp argloc '(fixnum 1023))
  389.         (e-write2 'jle lab2)    ; within range
  390.         ; not within range, must do it the hard way.
  391.         (e-label lab1)
  392.         (if (not (eq argloc 'areg)) then (d-move argloc 'areg))
  393.         (e-quick-call '_qoneminus)
  394.         (if (and g-loc (not (eq g-loc 'reg)))
  395.             then (d-move 'reg g-loc))
  396.         (if (car g-cc)
  397.             then (e-goto (car g-cc))
  398.             else (e-goto lab3))
  399.         (e-label lab2)
  400.         ; we are within range, just decrement the pointer by the
  401.         ; size of a word (4 bytes).
  402.         (if (not (eq argloc 'reg))
  403.             then (d-move argloc 'reg))
  404.         (e-sub '($ 4) 'd0)
  405.         (if (and g-loc (not (eq g-loc 'reg)))
  406.             then (d-move 'reg g-loc))
  407.         (if (car g-cc) then (e-goto (car g-cc)))
  408.         (e-label lab3))))
  409.  
  410. ;--- cm-<  :: compile a < expression
  411. ; 
  412. ; the operands to this form can either be fixnum or flonums but they
  413. ; must be of the same type.
  414. ;
  415. ; We can compile the form just like an eq form since all we want is
  416. ; a compare and a jump.  The comparisons are inverted since that is
  417. ; the way eq expects it.
  418.  
  419. (defun cm-< nil
  420.    (if (not (= 2 (length (cdr v-form))))
  421.       then (comp-err "incorrect number of arguments to < " v-form))
  422.    ; only can do fixnum stuff if we know that one of the args is
  423.    ; a fixnum.
  424.    ;
  425.    (if (or (fixp (cadr v-form)) (fixp (caddr v-form)))
  426.       then `(<& ,(cadr v-form) ,(caddr v-form))
  427.       else `(lessp ,(cadr v-form) ,(caddr v-form))))
  428.  
  429. ;--- c-<& :: fixnum <
  430. ;
  431. ; We can compile the form just like an eq form since all we want is
  432. ; a compare and a jump.  The comparisons are inverted since that is
  433. ; the way eq expects it.
  434.  
  435. (defun cc-<& nil
  436.    (let ((g-trueop  #+(or for-vax for-tahoe) 'jgeq #+for-68k 'jpl)
  437.      (g-falseop #+(or for-vax for-tahoe) 'jlss #+for-68k 'jmi)
  438.      (v-form `(eq (cdr ,(cadr v-form)) (cdr ,(caddr v-form)))))
  439.       (cc-eq)))
  440.  
  441. ;--- cm->  :: compile a > expression
  442. ;
  443. ; the operands to this form can either be fixnum or flonums but they
  444. ; must be of the same type.  
  445. ; We can compile the form just like an eq form since all we want is
  446. ; a compare and a jump.  The comparisons are inverted since that is
  447. ; the way eq expects it.
  448. (defun cm-> nil
  449.    (if (not (= 2 (length (cdr v-form))))
  450.       then (comp-err "incorrect number of arguments to > " v-form))
  451.    ; only can do fixnum stuff if we know that one of the args is
  452.    ; a fixnum.
  453.    ;
  454.    (if (or (fixp (cadr v-form)) (fixp (caddr v-form)))
  455.       then `(>& ,(cadr v-form) ,(caddr v-form))
  456.       else `(greaterp ,(cadr v-form) ,(caddr v-form))))
  457.  
  458. ;--- cc->& :: compile a fixnum > function
  459. ;
  460. ; We can compile the form just like an eq form since all we want is
  461. ; a compare and a jump.  The comparisons are inverted since that is
  462. ; the way eq expects it.
  463. (defun cc->& nil
  464.    (let ((g-trueop  #+(or for-vax for-tahoe) 'jleq #+for-68k 'jle)
  465.      (g-falseop #+(or for-vax for-tahoe) 'jgtr #+for-68k 'jgt)
  466.      (v-form `(eq (cdr ,(cadr v-form)) (cdr ,(caddr v-form)))))
  467.       (cc-eq)))
  468.  
  469. ;--- cm-=  : compile an = expression
  470. ;  The = function is a strange one.  It can compare two fixnums or two
  471. ; flonums which is fine on a pdp-10 where they are the same size, but
  472. ; is a real pain on a vax where they are different sizes.
  473. ; We thus can see if one of the arguments is a fixnum and assume that
  474. ; the other one is and then  call =&, the fixnum equal code.
  475. ;
  476. (defun cm-= nil
  477.    (if (not (= 2 (length (cdr v-form))))
  478.       then (comp-err "incorrect number of arguments to = : " v-form))
  479.    (if (or (fixp (cadr v-form)) (fixp (caddr v-form)))
  480.       then `(=& ,(cadr v-form) ,(caddr v-form))
  481.       else `(equal ,(cadr v-form) ,(caddr v-form))))
  482.  
  483. ;--- cm-=&
  484. ;
  485. ; if the number is within the small fixnum range, we can just
  486. ; do pointer comparisons.
  487. ;
  488. (defun cm-=& nil
  489.    (if (or (and (fixp (cadr v-form))
  490.         (< (cadr v-form) 1024)
  491.         (> (cadr v-form) -1025))
  492.        (and (fixp (caddr v-form))
  493.         (< (caddr v-form) 1024)
  494.         (> (caddr v-form) -1025)))
  495.       then `(eq ,(cadr v-form) ,(caddr v-form))
  496.       else `(eq (cdr ,(cadr v-form)) (cdr ,(caddr v-form)))))
  497.  
  498. ; this should be converted
  499. #+(or for-vax for-tahoe)
  500. (defun c-\\ nil
  501.    (d-fixop 'ediv  'remainder))
  502.  
  503. #+(or for-vax for-tahoe)
  504. (defun d-fixop (opcode lispopcode)
  505.    (prog (op1 op2 rop1 rop2 simpleop1)
  506.        (if (not (eq 3 (length v-form))) ; only handle two ops for now
  507.        then (d-callbig lispopcode (cdr v-form) nil)
  508.        else (setq op1 (cadr v-form)
  509.               op2 (caddr v-form))
  510.         (if (fixp op1)
  511.             then (setq rop1 `($ ,op1)  ; simple int
  512.                    simpleop1 t)        
  513.             else (if (setq rop1 (d-simple `(cdr ,op1)))
  514.                  then (setq rop1 (e-cvt rop1))
  515.                  else (let ((g-loc 'reg) g-cc g-ret)
  516.                       (d-exp op1))
  517.                   (setq rop1 '(0 r0))))
  518.         (if (fixp op2)
  519.             then (setq rop2 `($ ,op2))
  520.             else (if (setq rop2 (d-simple `(cdr ,op2)))
  521.                  then (setq rop2 (e-cvt rop2))
  522.                  else (C-push rop1)
  523.                   (setq rop1 '#.unCstack)
  524.                   (let ((g-loc 'reg)
  525.                     g-cc g-ret)
  526.                       (d-exp op2))
  527.                   (setq rop2 '(0 r0))))
  528.         (if (eq opcode 'ediv)
  529.             then (if (not simpleop1)
  530.                  then #+for-vax (progn (e-move rop1 'r2) ;need quad
  531.                         (e-write4 'ashq '$-32 'r1 'r1))
  532.                       #+for-tahoe (let ((x (d-genlab)))
  533.                         (e-write2 'clrl 'r2)
  534.                         (e-move rop1 'r3)
  535.                         (e-write2 'jgeq x)
  536.                         (e-write3 'mnegl '($ 1) 'r2)
  537.                         (e-writel x))
  538.                   (setq rop1 #+for-vax 'r1 #+for-tahoe 'r2))
  539.                                   ; word div.
  540.              (e-write5 'ediv rop2 rop1 'r0 'r5)
  541.             else (e-write4 opcode rop2 rop1 'r5))
  542.         (d-fixnumbox)
  543.         (d-clearreg))))
  544.