Return to instr.l CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / liszt

Annotation of 43BSDTahoe/ucb/lisp/liszt/instr.l, revision 1.1

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.