Return to m68ascode.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / m68

Annotation of researchv10no/cmd/sml/src/m68/m68ascode.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: structure M68Assem = struct val outfile = ref std_out end
        !             3: 
        !             4: structure M68AsCode : M68CODER = struct
        !             5: 
        !             6: open System.Tags M68Assem 
        !             7: 
        !             8: (* DEBUG
        !             9: fun diag (s : string) f x =
        !            10:        f x handle e =>
        !            11:                (print "?exception "; print (System.exn_name e);
        !            12:                 print " in m68ascode."; print s; print "\n";
        !            13:                 raise e)
        !            14: *)
        !            15: 
        !            16: val offset = ref 0
        !            17: 
        !            18: type Label = string
        !            19: 
        !            20: local val i = ref 0 in
        !            21: fun newlabel () = (i := !i + 1; "L" ^ makestring (!i))
        !            22: end
        !            23: 
        !            24: fun itoa (i:int) = if i < 0 then "-" ^ makestring (~i)
        !            25:                   else makestring i
        !            26: 
        !            27: datatype Register = DataReg of int
        !            28:                  | AddrReg of int
        !            29:                  | FloatReg of int
        !            30:                  | PC
        !            31: 
        !            32: datatype Size = Byte | Word | Long
        !            33: 
        !            34: datatype EA = Direct of Register
        !            35:            | PostInc of Register
        !            36:            | PreDec of Register
        !            37:            | Displace of Register * int
        !            38:            | Index of Register * int * Register * Size
        !            39:            | Immedlab of Label
        !            40:            | Immed of int
        !            41:            | Abs of int
        !            42:            | Address of Label
        !            43: 
        !            44: val d0 = DataReg 0
        !            45: and d1 = DataReg 1
        !            46: and d2 = DataReg 2
        !            47: and d3 = DataReg 3
        !            48: and d4 = DataReg 4
        !            49: and d5 = DataReg 5
        !            50: and d6 = DataReg 6
        !            51: and d7 = DataReg 7
        !            52: and a0 = AddrReg 0
        !            53: and a1 = AddrReg 1
        !            54: and a2 = AddrReg 2
        !            55: and a3 = AddrReg 3
        !            56: and a4 = AddrReg 4
        !            57: and a5 = AddrReg 5
        !            58: and a6 = AddrReg 6
        !            59: and sp = AddrReg 7
        !            60: and fp0 = FloatReg 0
        !            61: and fp1 = FloatReg 1
        !            62: and fp2 = FloatReg 2
        !            63: and fp3 = FloatReg 3
        !            64: and fp4 = FloatReg 4
        !            65: and fp5 = FloatReg 5
        !            66: and fp6 = FloatReg 6
        !            67: and fp7 = FloatReg 7
        !            68: 
        !            69: fun emit s = output (!outfile) s
        !            70: 
        !            71: fun emitreg (DataReg 0) = emit "d0"
        !            72:   | emitreg (DataReg 1) = emit "d1"
        !            73:   | emitreg (DataReg 2) = emit "d2"
        !            74:   | emitreg (DataReg 3) = emit "d3"
        !            75:   | emitreg (DataReg 4) = emit "d4"
        !            76:   | emitreg (DataReg 5) = emit "d5"
        !            77:   | emitreg (DataReg 6) = emit "d6"
        !            78:   | emitreg (DataReg 7) = emit "d7"
        !            79:   | emitreg (AddrReg 0) = emit "a0"
        !            80:   | emitreg (AddrReg 1) = emit "a1"
        !            81:   | emitreg (AddrReg 2) = emit "a2"
        !            82:   | emitreg (AddrReg 3) = emit "a3"
        !            83:   | emitreg (AddrReg 4) = emit "a4"
        !            84:   | emitreg (AddrReg 5) = emit "a5"
        !            85:   | emitreg (AddrReg 6) = emit "a6"
        !            86:   | emitreg (AddrReg 7) = emit "sp"
        !            87:   | emitreg (FloatReg 0) = emit "fp0"
        !            88:   | emitreg (FloatReg 1) = emit "fp1"
        !            89:   | emitreg (FloatReg 2) = emit "fp2"
        !            90:   | emitreg (FloatReg 3) = emit "fp3"
        !            91:   | emitreg (FloatReg 4) = emit "fp4"
        !            92:   | emitreg (FloatReg 5) = emit "fp5"
        !            93:   | emitreg (FloatReg 6) = emit "fp6"
        !            94:   | emitreg (FloatReg 7) = emit "fp7"
        !            95:   | emitreg PC = emit "pc"
        !            96: 
        !            97: (* DEBUG val emitreg = diag "emitreg" emitreg *)
        !            98: 
        !            99: fun sizeint i =
        !           100:        if i < 128 andalso i > ~129 then Byte
        !           101:        else if i < 32768 andalso i > ~32769 then Word
        !           102:        else Long
        !           103: 
        !           104: (* DEBUG val sizeint = diag "sizeint" sizeint *)
        !           105: 
        !           106: fun emitarg (Immed i) = (emit "#"; emit (itoa i))
        !           107:   | emitarg (Abs i) = emit (itoa i)
        !           108:   | emitarg (Direct r) = emitreg r
        !           109:   | emitarg (Displace (ra as AddrReg _,0)) = (emitreg ra; emit "@")
        !           110:   | emitarg (PostInc ra) = (emitreg ra; emit "@+")
        !           111:   | emitarg (PreDec ra) = (emitreg ra; emit "@-")
        !           112:   | emitarg (Displace (r as DataReg _, i)) = 
        !           113:            (emit"@("; emit(itoa i); emit ","; emitreg r; emit ":L:1)")
        !           114:   | emitarg (Displace (r as AddrReg _,i)) =
        !           115:        (emitreg r;
        !           116:         emit "@(";
        !           117:         emit (itoa i);
        !           118:         emit ")")
        !           119:   | emitarg (Index (ra,disp,r,s)) =
        !           120:        (emitreg ra;
        !           121:         emit "@(";
        !           122:         emit (itoa disp);
        !           123:         emit ",";
        !           124:         emitreg r;
        !           125:         emit ":L:";
        !           126:         emit (case s of Byte => "1" | Word => "2" | Long => "4");    
        !           127:         emit ")")
        !           128:   | emitarg (Address lab) = emit lab
        !           129: 
        !           130: (* DEBUG val emitarg = diag "emitarg" emitarg *)
        !           131: 
        !           132: fun emit2arg (a,b) = (emitarg a; emit ","; emitarg b; emit "\n")
        !           133: 
        !           134: (* DEBUG val emit2arg = diag "emit2arg" emit2arg *)
        !           135: 
        !           136: fun emit1arg (a) = (emitarg a; emit "\n")
        !           137: 
        !           138: fun align () = emit ".align 2\n"
        !           139: 
        !           140: (* DEBUG val align = diag "align" align *)
        !           141: 
        !           142: local val p = makestring power_tags
        !           143:       val t = makestring tag_backptr
        !           144: in
        !           145: fun mark () = let val lab = newlabel()
        !           146:              in  emit lab;
        !           147:                  emit ": .long ((";
        !           148:                  emit lab;
        !           149:                  emit "-base)/4+1)*";   (* STRING dependency *)
        !           150:                  emit p;
        !           151:                  emit "+";
        !           152:                  emit t;
        !           153:                  emit "\n"
        !           154:              end
        !           155: end
        !           156: 
        !           157: (* DEBUG val mark = diag "mark" mark *)
        !           158: 
        !           159: fun define lab = (emit lab; emit ":\n")
        !           160: (* DEBUG val define = diag "define" define *)
        !           161: fun oct i = let val m = Integer.makestring
        !           162:            in  m(i div 64)^m((i div 8)mod 8)^m(i mod 8) end
        !           163: (* DEBUG val oct = diag "oct" oct *)
        !           164: fun c_char "\n" = "\\n"
        !           165:   | c_char "\t" = "\\t"
        !           166:   | c_char "\\" = "\\\\"
        !           167:   | c_char "\"" = "\\\""
        !           168:   | c_char c = if ord c < 32 then "\\"^oct(ord c) else c
        !           169: fun a_str s = implode(map c_char (explode s))
        !           170: fun emitstring s = (emit ".ascii \""; emit(a_str s); emit "\"\n")
        !           171: fun realconst s = (emit ".double 0r"; emit s; emit "\n")
        !           172: fun emitlong (i : int) = (emit ".long "; emit(makestring i); emit "\n")
        !           173: 
        !           174: fun emitlab (offset,l2) = 
        !           175:        (emit "5: .long "; emit l2; emit "-5b";
        !           176:         if offset < 0 then (emit "-"; emit (makestring (~offset)))
        !           177:                       else (emit "+"; emit (makestring offset));
        !           178:         emit "\n")
        !           179: 
        !           180: exception Illegal
        !           181: 
        !           182: fun rts () = emit "rts\n"
        !           183: 
        !           184: fun exg (arg as (Direct(AddrReg a),Direct(AddrReg b))) =
        !           185:        if a = b then ()
        !           186:        else (emit "exg "; emit2arg arg)
        !           187:   | exg (arg as (Direct(DataReg a),Direct(DataReg b))) =
        !           188:        if a = b then ()
        !           189:        else (emit "exg "; emit2arg arg)
        !           190:   | exg (arg as (Direct(AddrReg b),Direct(DataReg a))) =
        !           191:        (emit "exg "; emit2arg arg)
        !           192:   | exg (arg as (Direct(DataReg a),Direct(AddrReg b))) =
        !           193:        (emit "exg "; emit2arg arg)
        !           194: 
        !           195: fun pea (Direct _) = raise Illegal
        !           196:   | pea (PreDec _) = raise Illegal
        !           197:   | pea (PostInc _) = raise Illegal
        !           198:   | pea (Immed _) = raise Illegal
        !           199:   | pea (arg as (Address lab)) =
        !           200:        (emit "pea "; emit1arg arg)
        !           201:   | pea (arg) =
        !           202:        (emit "pea "; emit1arg arg)
        !           203: 
        !           204: fun movl (_,Immed _) = raise Illegal
        !           205:   (* labels not implemented *)
        !           206:   (* MOVEQ/MOVE *)
        !           207:   | movl (src as (Immed i),dest as (Direct(DataReg d))) =
        !           208:        (case sizeint i of
        !           209:            Byte => (emit "moveq "; emit2arg (src,dest))
        !           210:          | _ => (emit "movl "; emit2arg (src,dest)))
        !           211:   (* MOVEA *)
        !           212:   | movl (src,dest as (Direct(AddrReg a))) =
        !           213:        (emit "movl "; emit2arg (src,dest))
        !           214:   (* general MOVE *)
        !           215:   | movl (src,dest) =
        !           216:        (emit "movl "; emit2arg (src,dest))
        !           217: 
        !           218: fun addl (_,Immed _) = raise Illegal
        !           219:   (* ADDQ/ADDA *)
        !           220:   | addl (src as (Immed i),dest as (Direct(AddrReg a))) =
        !           221:        if i <= 8 andalso i >= 1 then
        !           222:                (emit "addql "; emit2arg(src,dest))
        !           223:        else    (emit "addl "; emit2arg(src,dest))
        !           224:   | addl (src,dest as (Direct(AddrReg a))) =
        !           225:        (emit "addl "; emit2arg (src,dest))
        !           226:   (* ADDQ/ADDI *)
        !           227:   | addl (src as (Immed i),dest) =
        !           228:        if i <= 8 andalso i >= 1 then
        !           229:                (emit "addql "; emit2arg (src,dest))
        !           230:        else    (emit "addl "; emit2arg (src,dest))
        !           231:   (* general ADD *)
        !           232:   | addl (src,dest as (Direct(DataReg d))) = 
        !           233:        (emit "addl "; emit2arg (src,dest))
        !           234:   | addl (src as (Direct(DataReg d)),dest) =
        !           235:        (emit "addl "; emit2arg (src,dest))
        !           236: 
        !           237: fun lea (Direct _,_) = raise Illegal
        !           238:   | lea (PreDec _,_) = raise Illegal
        !           239:   | lea (PostInc _,_) = raise Illegal
        !           240:   | lea (Immed _,_) = raise Illegal
        !           241:   | lea (src as Address _,dest as Direct(AddrReg _)) =
        !           242:        (emit "lea "; emit2arg (src,dest))
        !           243:   | lea (src,dest as (Direct(AddrReg a))) =
        !           244:        (emit "lea "; emit2arg (src,dest))
        !           245:   | lea (Displace(a, i), dest as (Direct(DataReg _))) =    (* fake lea to data register *)
        !           246:        (movl(Direct(a), dest); addl(Immed(i), dest))
        !           247:   | lea _ = raise Illegal
        !           248: 
        !           249: (* DEBUG val lea = diag "lea" lea *)
        !           250: 
        !           251: fun subl (_,Immed _) = raise Illegal
        !           252:   (* SUBQ/SUBA *)
        !           253:   | subl (src  as (Immed i),dest as (Direct(AddrReg a))) =
        !           254:        if i <= 8 andalso i >= 1 then
        !           255:                (emit "subql "; emit2arg(src,dest))
        !           256:        else    (emit "subl "; emit2arg(src,dest))
        !           257:   (* SUBA *)
        !           258:   | subl (src,dest as (Direct(AddrReg a))) =
        !           259:        (emit "subl "; emit2arg(src,dest))
        !           260:   (* SUBQ/SUBI *)
        !           261:   | subl (src as (Immed i),dest) =
        !           262:        if i <= 8 andalso i >= 1 then
        !           263:                (emit "subql "; emit2arg(src,dest))
        !           264:        else    (emit "subl "; emit2arg(src,dest))
        !           265:   (* general SUB *)
        !           266:   | subl (src,dest as (Direct(DataReg d))) = 
        !           267:        (emit "subl "; emit2arg(src,dest))
        !           268:   | subl (src as (Direct(DataReg d)),dest) = 
        !           269:        (emit "subl "; emit2arg(src,dest))
        !           270: 
        !           271: fun eorl (_, Direct(AddrReg _)) = raise Illegal
        !           272:   | eorl args = (emit "eorl "; emit2arg args)
        !           273: 
        !           274: fun orl (_, Direct(AddrReg _)) = raise Illegal
        !           275:   | orl args = (emit "orl "; emit2arg args)
        !           276: 
        !           277: fun andl (_, Direct(AddrReg _)) = raise Illegal
        !           278:   | andl args = (emit "andl "; emit2arg args)
        !           279: 
        !           280: fun divl args = (emit "divl "; emit2arg args)
        !           281: fun mull args = (emit "mull "; emit2arg args)
        !           282: fun asll (Immed 1, arg) = (emit "asll "; emit1arg arg)
        !           283:   | asll args = (emit "asll "; emit2arg args)
        !           284: fun asrl (Immed 1, arg) = (emit "asrl "; emit1arg arg)
        !           285:   | asrl args = (emit "asrl "; emit2arg args)
        !           286: fun movb (Immed 0, arg) = (emit "clrb "; emit1arg arg)
        !           287:   | movb args = (emit "movb "; emit2arg args)
        !           288: 
        !           289: fun cmpl (src, dest as (Immed i)) =
        !           290:        (print "?bad cmpl\n"; emit "| BAD cmpl "; emit2arg(src, dest))
        !           291:   (* CMP *)
        !           292:   | cmpl (src,dest as (Direct(DataReg d))) =
        !           293:        (emit "cmpl "; emit2arg (src,dest))
        !           294:   (* CMPA *)
        !           295:   | cmpl (src,dest as (Direct(AddrReg a))) =
        !           296:        (emit "cmpl "; emit2arg (src,dest))
        !           297:   (* CMPI *)
        !           298:   | cmpl (src as (Immed i),dest) =
        !           299:        (emit "cmpl "; emit2arg (src,dest))
        !           300:   (* CMPM *)
        !           301:   | cmpl (src as (PostInc(AddrReg y)),dest as (PostInc(AddrReg x))) =
        !           302:        (emit "cmpm "; emit2arg (src,dest))
        !           303: 
        !           304: fun btst (_,Direct(AddrReg _)) = raise Illegal
        !           305:   | btst (_,Immed _) = raise Illegal
        !           306:   | btst (src as (Direct(DataReg d)),dest) =
        !           307:        (emit "btst "; emit2arg (src,dest))
        !           308:   | btst (src as (Immed i),dest) =
        !           309:        (emit "btst "; emit2arg (src,dest))
        !           310: 
        !           311: 
        !           312: fun jne (arg as (Address lab)) = (emit "jne "; emit1arg arg)
        !           313: fun jeq (arg as (Address lab)) = (emit "jeq "; emit1arg arg)
        !           314: fun jgt (arg as (Address lab)) = (emit "jgt "; emit1arg arg)
        !           315: fun jge (arg as (Address lab)) = (emit "jge "; emit1arg arg)
        !           316: fun jlt (arg as (Address lab)) = (emit "jlt "; emit1arg arg)
        !           317: fun jle (arg as (Address lab)) = (emit "jle "; emit1arg arg)
        !           318: 
        !           319: fun jra (arg as (Address lab)) =
        !           320:        (emit "jra "; emit1arg arg)
        !           321:   | jra (arg as (Displace(AddrReg a,i))) =
        !           322:        (emit "jra "; emit1arg arg)
        !           323:   | jra (arg as Index _) =
        !           324:        (emit "jra "; emit1arg arg)
        !           325: 
        !           326: fun jbsr (arg as (Address lab)) =
        !           327:        (emit "jbsr "; emit1arg arg)
        !           328:   | jbsr (arg as (Displace(AddrReg _,_))) =
        !           329:        (emit "jbsr "; emit1arg arg)
        !           330: 
        !           331: (* 68881 float operations *)
        !           332: (* Some src/dest combinations are illegal, but not caught here. *)
        !           333: fun fjne (arg as (Address lab)) = (emit "fjne "; emit1arg arg)
        !           334: fun fjeq (arg as (Address lab)) = (emit "fjeq "; emit1arg arg)
        !           335: fun fjgt (arg as (Address lab)) = (emit "fjgt "; emit1arg arg)
        !           336: fun fjge (arg as (Address lab)) = (emit "fjge "; emit1arg arg)
        !           337: fun fjlt (arg as (Address lab)) = (emit "fjlt "; emit1arg arg)
        !           338: fun fjle (arg as (Address lab)) = (emit "fjle "; emit1arg arg)
        !           339: 
        !           340: fun fcmpd (arg as (src,dest)) = (emit "fcmpd "; emit2arg arg)
        !           341: fun faddd (arg as (src,dest)) = (emit "faddd "; emit2arg arg)
        !           342: fun fsubd (arg as (src,dest)) = (emit "fsubd "; emit2arg arg)
        !           343: fun fmuld (arg as (src,dest)) = (emit "fmuld "; emit2arg arg)
        !           344: fun fdivd (arg as (src,dest)) = (emit "fdivd "; emit2arg arg)
        !           345: fun fnegd (arg as (src,dest)) = (emit "fnegd "; emit2arg arg)
        !           346: fun fmoved (arg as (src,dest as Direct(FloatReg f))) =
        !           347:        (emit "fmoved "; emit2arg arg)
        !           348:   | fmoved (arg as (src as Direct(FloatReg f),dest)) =
        !           349:        (emit "fmoved "; emit2arg arg)
        !           350: 
        !           351: fun trapv() = emit "trapv\n"
        !           352: fun trapmi() = emit "trapmi\n"
        !           353: 
        !           354: fun exg args = (emit "exg "; emit2arg args)
        !           355: 
        !           356: fun push ea = movl(ea,PreDec sp)
        !           357: 
        !           358: fun pop ea = movl(PostInc sp,ea)
        !           359: 
        !           360: val pusha = pea
        !           361: 
        !           362: val comment = emit
        !           363: 
        !           364: end (* structure AsCode *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.