qhasm-fp

#!/bin/sh

awk -F: '
  {
    ++linenum
    line[linenum] = $0
  }
  function ST(i) {
    return "=float80#" 1 + i
  }
  function publicname(i) {
    sub(/=.*/,"",i)
    sub(/#.*/,"",i)
    return i
  }
  function dead(i,v,  j,z,zlen) {
    return !(i"<"v in livefloat80)
  }
  function doit(i,  newi,y,ylen,j,k,s,slen,v,w,stemp,z,source,target,numskipped) {
    for (;;) {
      # Have just assigned fpstacklen[i], the stack before insn i.
      slen = fpstacklen[i]
      for (j = 1;j <= slen;++j) s[j] = fpstack[i,j]
      # Now see what insn i does to s.   
      if (i > linenum) return
      ylen = split(line[i],y)

      if (y[1] == "leave") {
        return
      } else if (y[1] == "goto") {
        if (!(y[2] in label)) {
          print "error:unknown label"
          return
        } 
        newi = label[y[2]]  
        if (newi in fpstacklen) return

        # XXX: should prefer straight line, I think
        # XXX: should give user more control over stack order
        # XXX: should generate new stack in easier-swap order; also in maybegoto
        fpstacklen[newi] = 0
        for (j = 1;j <= slen;++j)
          if (!dead(newi,s[j])) {
            ++fpstacklen[newi]
            fpstack[newi,fpstacklen[newi]] = s[j]
          }
        i = newi
        continue
      } else if (y[1] == "maybegoto") {
        if (!(y[2] in label)) {
          print "error:unknown label"
          return
        }
        newi = label[y[2]]
        if (!(newi in fpstacklen)) {
          fpstacklen[newi] = 0
          for (j = 1;j <= slen;++j)
            if (!dead(newi,s[j])) {
              ++fpstacklen[newi]
              fpstack[newi,fpstacklen[newi]] = s[j]
            }
          doit(newi)
        }
      } else if (y[1] == "op") {

	split("",optype)
	for (k = 3;k <= ylen;++k)
	  if (match(y[k],/^fpstack\//)) {
	    split(y[k],z,/\//)
	    optype[z[2]] = 1
	  }

	if ("top" in optype) {
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      for (j = 1;j <= slen;++j)
		if (s[j] == z[2]) {
		  stemp = s[j]
		  s[j] = s[slen]
		  s[slen] = stemp
		  sub(/=.*/,ST(slen - j),y[k])
		  break
		}
	    }
	} else if ("pop" in optype) {
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      for (j = 1;j <= slen;++j)
		if (s[j] == z[2]) {
		  stemp = s[j]
		  s[j] = s[slen]
		  s[slen] = stemp
		  sub(/=.*/,ST(0),y[k])
		  --slen
		  break
		}
	    }
	} else if ("arith" in optype) {
	  target = ""
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^inplace>/)) {
	      split(y[k],z,/[<>]/)
	      if (match(z[2],/=float80#/))
	        target = z[2]
	    }
	  source = ""
	  numskipped = 0
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      if (match(z[2],/=float80#/))
	        if (z[2] != target) source = z[2]
		else if ((z[2] == target) && numskipped) source = z[2]
		else if (z[2] == target) ++numskipped
	    }
	  if (dead(i + 1,source) && s[slen] == target) {
	    ++ylen; y[ylen] = "modify/pop"
	    ++ylen; y[ylen] = "modify/reverse"
	    for (j = 1;j <= slen;++j)
	      if (s[j] == source) {
	        for (k = 3;k <= ylen;++k)
	          if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
		    split(y[k],z,/[<>]/)
		    if (z[2] == source) sub(/=.*/,ST(0),y[k])
		    if (z[2] == target) sub(/=.*/,ST(slen - j),y[k])
		  }
		s[j] = target
		--slen
		break
	      }
	  } else {
            if (s[slen] != source) {
              if ((s[slen] != target) || dead(i + 1,source)) {
                for (j = 1;j < slen;++j)
                  if (s[j] == source) {
                    fpexchange[i] = j
                    stemp = s[j]
                    s[j] = s[slen]
                    s[slen] = stemp
                    break
                  }
              }
            }
	    for (k = 3;k <= ylen;++k) {
	      if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
		split(y[k],z,/[<>]/)
		for (j = 1;j <= slen;++j) {
		  if (s[j] == z[2]) sub(/=.*/,ST(slen - j),y[k])
		}
	      }
	    }
	    if (s[slen] == source) {
	      ++ylen; y[ylen] = "modify/fromtop"
	    }
	    if (dead(i + 1,source)) {
	      --slen
	      ++ylen; y[ylen] = "modify/pop"
	    }
	  }
	} else if ("loadarith" in optype) {
	  target = ""
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^inplace>/)) {
	      split(y[k],z,/[<>]/)
	      if (match(z[2],/=float80#/))
	        target = z[2]
	    }
	  if (s[slen] != target) {
	    for (j = 1;j < slen;++j)
	      if (s[j] == target) {
		fpexchange[i] = j
		stemp = s[j]
		s[j] = s[slen]
		s[slen] = stemp
		break
	      }
	  }
	  for (j = 1;j <= slen;++j)
	    if (s[j] == target)
	      for (k = 3;k <= ylen;++k) {
	        if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
		  split(y[k],z,/[<>]/)
		  if (z[2] == target) sub(/=.*/,ST(slen - j),y[k])
	        }
	      }
	} else if ("load" in optype) {
	  target = ""
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^>/)) {
	      split(y[k],z,/[<>]/)
	      if (match(z[2],/=float80#/))
	        target = z[2]
	    }
	  ++slen
	  s[slen] = target
	  for (k = 3;k <= ylen;++k) {
	    if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      if (z[2] == target) sub(/=.*/,ST(0),y[k])
	    }
	  }
	} else if ("store" in optype) {
	  source = ""
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      if (match(z[2],/=float80#/))
	        source = z[2]
	    }
	  for (j = 1;j < slen;++j)
	    if (s[j] == source) {
	      fpexchange[i] = j
	      stemp = s[j]
	      s[j] = s[slen]
	      s[slen] = stemp
	      break
	    }
	  for (k = 3;k <= ylen;++k) {
	    if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      if (z[2] == source) sub(/=.*/,ST(0),y[k])
	    }
	  }
	  if (dead(i + 1,source)) {
	    --slen
	    ++ylen; y[ylen] = "modify/pop"
	  }
	} else {
	  for (k = 3;k <= ylen;++k)
	    if (match(y[k],/^inplace>/) || match(y[k],/^>/) || match(y[k],/^</)) {
	      split(y[k],z,/[<>]/)
	      for (j = 1;j <= slen;++j)
	        if (z[2] == s[j]) sub(/=.*/,ST(slen - j),y[k])
	    }
	}

        line[i] = ""
        for (j = 1;j <= ylen;++j) line[i] = line[i] y[j] ":"
      }

      newi = i + 1
      if (newi in fpstacklen) {
        fpfallthroughfix[i] = 1
        return
      }

      fpstacklen[newi] = 0
      for (j = 1;j <= slen;++j)
        if (dead(newi,s[j])) {
          fpfallthroughfix[i] = 1
        } else {
          ++fpstacklen[newi]
          fpstack[newi,fpstacklen[newi]] = s[j]
        }
      i = newi
    }
  }
  function reshuffle(i,newi,  j,k,s,slen,stemp,live,v,output) {
    slen = fpstacklen[i]
    for (j = 1;j <= slen;++j) s[j] = fpstack[i,j]

    split("",live)
    for (j = 1;j <= fpstacklen[newi];++j) live[fpstack[newi,j]] = 1
      
    j = 1
    for (;;) {
      # at this point s matches new stack in positions 1,2,...,j-1
      # j <= slen + 1 
      # j <= fpstacklen[newi] + 1
      if (j > slen) {
        if (j <= fpstacklen[newi]) print "error:stack growth, impossible"
        return
      }
      if (!(s[slen] in live)) {
v = publicname(s[slen])
print "op:internal stackpop "v":<"v ST(0)":asm/fstp %st(0):"
        --slen
        output = "comment:fpstackfrombottom:"
        for (j = 1;j <= slen;++j) {
          v = s[j]
          sub(/=.*/,"",v)
          output = output "<" v ":"
        }
        print output
        continue
      }
      # now s[1],s[2],...,s[j-1],s[slen] are all live
      if (j > fpstacklen[newi]) {
        print "error:live variable miscount, impossible"
        return
      }
      if (s[j] == fpstack[newi,j]) {
        ++j
        continue
      }
      for (k = j + 1;k <= slen;++k)
        if (s[k] == fpstack[newi,j])
          break
      if (k > slen) {
        print "error:live variable created, impossible"
        return
      }
      if (k != slen) {
v = publicname(s[k])
print "op:internal stacktop "v":<"v ST(slen - k)":vmap/r="v":asm/fxch <r:"
        stemp = s[k]
        s[k] = s[slen]
        s[slen] = stemp
      }
v = publicname(s[j])
print "op:internal stacktop "v":<"v ST(slen - j)":vmap/r="v":asm/fxch <r:"
      stemp = s[j]
      s[j] = s[slen]
      s[slen] = stemp

      output = "comment:fpstackfrombottom:"
      for (k = 1;k <= slen;++k) {
        v = s[k]
        sub(/=.*/,"",v)
        output = output "<" v ":"
      }
      print output

      ++j
    }
  }
  function samestack(i,newi,  j) {
    if (fpstacklen[i] != fpstacklen[newi]) return 0
    for (j = 1;j <= fpstacklen[i];++j)
      if (fpstack[i,j] != fpstack[newi,j]) return 0
    return 1
  }
  END {
    for (i = 1;i <= linenum;++i) {
      xlen = split(line[i],x)
      if (x[1] == "label") label[x[2]] = i
    }

    lastlv = ""
    for (i = 1;i <= linenum;++i) {
      xlen = split(line[i],x)
      if (x[1] == "op") if (x[2] == "livefloat80") lastlv = line[i]
      zlen = split(lastlv,z)
      for (j = 3;j <= zlen;++j)
	if (match(z[j],/^</)) {
          livefloat80[i z[j]] = 1
	}
    }

    for (i = 1;i <= linenum;++i) {
      xlen = split(line[i],x)
      if (x[1] == "enter") {
	if (i in fpstacklen) {
	  if (fpstacklen[i] != 0)
	    print "error:floating-point stack fall-through"
	} else {
	  fpstacklen[i] = 0
	  doit(i)
	}
      }
    }

    prevstacklen = 0

    for (i = 1;i <= linenum;++i) {
      xlen = split(line[i],x)
      while ((xlen > 1) && (x[xlen] == "")) --xlen

      if (i in fpstacklen) {
	if (i in fpexchange) {
	  v = publicname(fpstack[i,fpexchange[i]])
	  print "op:internal stacktop "v":<"v ST(fpstacklen[i] - fpexchange[i])":vmap/r="v":asm/fxch <r:"
	}
      }

      if (x[1] == "goto" || x[1] == "maybegoto") {
	if (samestack(i,label[x[2]])) {
	  print "comment:fp stack unchanged by jump"
	} else {
	  print "comment:automatically reorganizing fp stack for jump"
	  if (x[1] == "maybegoto") {
	    printf "maybegoto:fpcontinue."i":"x[3]",not:"
	    for (j = 4;j <= xlen;++j) printf "%s",x[j]
	    print ""
	    print "error:XXX have to do auto negated jump in qhasm-fpnew here"
	  }
	  reshuffle(i,label[x[2]])
	  if (x[1] == "maybegoto") {
	    print "goto:"x[2]":"
	    print "error:XXX have to do auto jump in qhasm-fpnew here"
	    print "label:fpcontinue."i":"
	    continue
	  }
	}
      }

      if (x[1] == "op" && x[2] == "livefloat80") {
        if (i in fpstacklen) {
	  if (prevstacklen > 0 || fpstacklen[i] > 0) {
	    output = "comment:fpstackfrombottom:"
	    for (j = 1;j <= fpstacklen[i];++j) {
	      v = fpstack[i,j]
	      sub(/=.*/,"",v)
	      output = output "<" v ":"
	    }
	    print output
	    prevstacklen = fpstacklen[i]
	  }
	}
      } else {
        for (j = 1;j < xlen;++j) printf "%s:",x[j]
        print x[xlen]
      }

      if (i in fpfallthroughfix) {
	if (samestack(i,i + 1)) {
	  print "comment:fp stack unchanged by fallthrough"
	} else {
	  print "comment:automatically reorganizing fp stack for fallthrough"
	  reshuffle(i,i + 1)
	}
      }
    }
  }
'