33 |
structure P = CPS.P (* CPS primitive operators *) |
structure P = CPS.P (* CPS primitive operators *) |
34 |
structure LE = M.LabelExp (* Label Expression *) |
structure LE = M.LabelExp (* Label Expression *) |
35 |
structure R = CPSRegions (* Regions *) |
structure R = CPSRegions (* Regions *) |
36 |
|
structure PT = R.PT (* PointsTo *) |
37 |
structure CG = Control.CG (* Compiler Control *) |
structure CG = Control.CG (* Compiler Control *) |
38 |
structure MS = MachineSpec (* Machine Specification *) |
structure MS = MachineSpec (* Machine Specification *) |
39 |
structure D = MS.ObjDesc (* ML Object Descriptors *) |
structure D = MS.ObjDesc (* ML Object Descriptors *) |
47 |
|
|
48 |
structure MemAliasing = MemAliasing(Cells) (* Memory aliasing *) |
structure MemAliasing = MemAliasing(Cells) (* Memory aliasing *) |
49 |
|
|
|
structure MkRecord = MkRecord(C) (* How to build records *) |
|
|
|
|
50 |
fun error msg = MLRiscErrorMsg.error("MLRiscGen", msg) |
fun error msg = MLRiscErrorMsg.error("MLRiscGen", msg) |
51 |
|
|
52 |
(* |
(* |
345 |
(* |
(* |
346 |
* Points-to analysis projection. |
* Points-to analysis projection. |
347 |
*) |
*) |
348 |
fun pi(x as ref(R.PT.TOP _),_) = x |
fun pi(x as ref(PT.TOP _),_) = x |
349 |
| pi(x,i) = R.PT.pi(x,i) |
| pi(x,i) = PT.pi(x,i) |
350 |
|
|
351 |
val memDisambigFlag = !CG.memDisambiguate |
val memDisambigFlag = !CG.memDisambiguate |
|
(* val top = ref(R.PT.NAMED("mem",R.PT.newTop())) *) |
|
|
val top = R.memory |
|
352 |
|
|
353 |
fun getRegion(e,i) = |
fun getRegion e = |
354 |
|
if memDisambigFlag then |
355 |
|
(case e of |
356 |
|
CPS.VAR v => memDisambig v |
357 |
|
| _ => R.readonly |
358 |
|
) |
359 |
|
else R.memory |
360 |
|
|
361 |
|
fun getRegionPi(e,i) = |
362 |
if memDisambigFlag then |
if memDisambigFlag then |
363 |
(case e of |
(case e of |
364 |
CPS.VAR v => pi(memDisambig v,i) |
CPS.VAR v => pi(memDisambig v,i) |
365 |
| _ => R.readonly |
| _ => R.readonly |
366 |
) |
) |
367 |
else top |
else R.memory |
368 |
|
|
369 |
|
fun dataptrRegion v = getRegionPi(v, 0) |
370 |
|
|
371 |
|
(* fun arrayRegion(x as ref(PT.TOP _)) = x |
372 |
|
| arrayRegion x = PT.weakSubscript x *) |
373 |
|
(* For safety, let's assume it's the global memory right now *) |
374 |
|
fun arrayRegion _ = R.memory |
375 |
|
|
376 |
(* This keeps track of all the advanced offset on the hp |
(* This keeps track of all the advanced offset on the hp |
377 |
* since the beginning of the CPS function. |
* since the beginning of the CPS function. |
538 |
(*esac*) |
(*esac*) |
539 |
end |
end |
540 |
|
|
541 |
|
|
542 |
|
(* |
543 |
|
* Function to allocate an integer record |
544 |
|
* x <- [descriptor ... fields] |
545 |
|
*) |
546 |
|
fun ea(r, 0) = r |
547 |
|
| ea(r, n) = M.ADD(addrTy, r, M.LI n) |
548 |
|
fun indexEA(r, 0) = r |
549 |
|
| indexEA(r, n) = M.ADD(addrTy, r, M.LI(n*4)) |
550 |
|
|
551 |
|
fun allocRecord(markComp, mem, desc, fields, hp) = |
552 |
|
let fun getField(v, e, CPS.OFFp 0) = e |
553 |
|
| getField(v, e, CPS.OFFp n) = M.ADD(addrTy, e, M.LI(4*n)) |
554 |
|
| getField(v, e, p) = getPath(getRegion v, e, p) |
555 |
|
|
556 |
|
and getPath(mem, e, CPS.OFFp n) = indexEA(e, n) |
557 |
|
| getPath(mem, e, CPS.SELp(n, CPS.OFFp 0)) = |
558 |
|
markComp(M.LOAD(ity, indexEA(e, n), pi(mem, n))) |
559 |
|
| getPath(mem, e, CPS.SELp(n, p)) = |
560 |
|
let val mem = pi(mem, n) |
561 |
|
in getPath(mem, markPTR(M.LOAD(ity, indexEA(e, n), mem)), p) |
562 |
|
end |
563 |
|
|
564 |
|
fun storeFields([], hp, elem) = hp |
565 |
|
| storeFields((v, p)::fields, hp, elem) = |
566 |
|
(emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, M.LI hp), |
567 |
|
getField(v, regbind' v, p), pi(mem, elem))); |
568 |
|
storeFields(fields, hp+4, elem+1) |
569 |
|
) |
570 |
|
|
571 |
|
in emit(M.STORE(ity, ea(C.allocptr, hp), desc, pi(mem, ~1))); |
572 |
|
storeFields(fields, hp+4, 0); |
573 |
|
hp+4 |
574 |
|
end |
575 |
|
|
576 |
|
(* |
577 |
|
* Functions to allocate a floating point record |
578 |
|
* x <- [descriptor ... fields] |
579 |
|
*) |
580 |
|
fun allocFrecord(mem, desc, fields, hp) = |
581 |
|
let fun fea(r, 0) = r |
582 |
|
| fea(r, n) = M.ADD(addrTy, r, M.LI(n*8)) |
583 |
|
fun fgetField(v, CPS.OFFp 0) = fregbind v |
584 |
|
| fgetField(v, CPS.OFFp _) = error "allocFrecord.fgetField" |
585 |
|
| fgetField(v, p) = fgetPath(getRegion v, regbind' v, p) |
586 |
|
|
587 |
|
and fgetPath(mem, e, CPS.OFFp _) = error "allocFrecord.fgetPath" |
588 |
|
| fgetPath(mem, e, CPS.SELp(n, CPS.OFFp 0)) = |
589 |
|
markFLT(M.FLOAD(fty, fea(e, n), pi(mem, n))) |
590 |
|
| fgetPath(mem, e, CPS.SELp(n, p)) = |
591 |
|
let val mem = pi(mem, n) |
592 |
|
in fgetPath(mem, markPTR(M.LOAD(ity, indexEA(e, n), mem)),p) |
593 |
|
end |
594 |
|
|
595 |
|
fun fstoreFields([], hp, elem) = hp |
596 |
|
| fstoreFields((v, p)::fields, hp, elem) = |
597 |
|
(emit(M.FSTORE(fty, M.ADD(addrTy, C.allocptr, M.LI hp), |
598 |
|
fgetField(v, p), pi(mem, elem))); |
599 |
|
fstoreFields(fields, hp+8, elem+1) |
600 |
|
) |
601 |
|
in emit(M.STORE(ity, ea(C.allocptr, hp), desc, pi(mem, ~1))); |
602 |
|
fstoreFields(fields, hp+4, 0); |
603 |
|
hp+4 |
604 |
|
end |
605 |
|
|
606 |
|
(* Allocate a header pair for vector or array *) |
607 |
|
fun allocHeaderPair(hdrDesc, mem, dataPtr, len, hp) = |
608 |
|
(emit(M.STORE(ity, ea(C.allocptr, hp), M.LI hdrDesc,pi(mem,~1))); |
609 |
|
emit(M.STORE(ity, ea(C.allocptr, hp+4), |
610 |
|
M.REG(ity,dataPtr),pi(mem, 0))); |
611 |
|
emit(M.STORE(ity, ea(C.allocptr, hp+8), M.LI(len+len+1), |
612 |
|
pi(mem, 1))); |
613 |
|
hp+4 |
614 |
|
) |
615 |
|
|
616 |
(* |
(* |
617 |
* Int 31 tag optimizations. |
* Int 31 tag optimizations. |
618 |
* Note: if the tagging scheme changes then we'll have to redo these. |
* Note: if the tagging scheme changes then we'll have to redo these. |
698 |
orTag(rshiftOp(ity, regbind v, untagUnsigned(w))) |
orTag(rshiftOp(ity, regbind v, untagUnsigned(w))) |
699 |
|
|
700 |
fun getObjDescriptor(v) = |
fun getObjDescriptor(v) = |
701 |
M.LOAD(ity, M.SUB(pty, regbind v, M.LI(4)), getRegion(v, ~1)) |
M.LOAD(ity, M.SUB(pty, regbind v, M.LI(4)), getRegionPi(v, ~1)) |
702 |
|
|
703 |
fun getObjLength(v) = |
fun getObjLength(v) = |
704 |
M.SRL(ity, getObjDescriptor(v), M.LI(D.tagWidth -1)) |
M.SRL(ity, getObjDescriptor(v), M.LI(D.tagWidth -1)) |
1124 |
and mkRecord(vl, w, e, hp) = |
and mkRecord(vl, w, e, hp) = |
1125 |
let val len = length vl |
let val len = length vl |
1126 |
val desc = dtoi(D.makeDesc (len, D.tag_record)) |
val desc = dtoi(D.makeDesc (len, D.tag_record)) |
|
val contents = map (fn (v,p) => (regbind' v, p)) vl |
|
1127 |
in treeifyAlloc(w, |
in treeifyAlloc(w, |
1128 |
MkRecord.record |
allocRecord(markPTR, memDisambig w, M.LI desc, vl, hp), |
|
{desc=M.LI desc, fields=contents, |
|
|
mem=memDisambig w, hp=hp, emit=emit, |
|
|
markPTR=markPTR, markComp=markPTR}, |
|
1129 |
e, hp + 4 + len*4) |
e, hp + 4 + len*4) |
1130 |
end |
end |
1131 |
|
|
1133 |
and mkI32block(vl, w, e, hp) = |
and mkI32block(vl, w, e, hp) = |
1134 |
let val len = length vl |
let val len = length vl |
1135 |
val desc = dtoi(D.makeDesc (len, D.tag_raw32)) |
val desc = dtoi(D.makeDesc (len, D.tag_raw32)) |
|
val contents = map (fn (v,p) => (regbind' v, p)) vl |
|
1136 |
in treeifyAlloc(w, |
in treeifyAlloc(w, |
1137 |
MkRecord.record |
allocRecord(markI32, memDisambig w, M.LI desc, vl, hp), |
|
{desc=M.LI desc, fields=contents, |
|
|
mem=memDisambig w, hp=hp, emit=emit, |
|
|
markPTR=markPTR, markComp=markI32}, |
|
1138 |
e, hp + 4 + len*4) |
e, hp + 4 + len*4) |
1139 |
end |
end |
1140 |
|
|
1142 |
and mkFblock(vl, w, e, hp) = |
and mkFblock(vl, w, e, hp) = |
1143 |
let val len = List.length vl |
let val len = List.length vl |
1144 |
val desc = dtoi(D.makeDesc(len+len, D.tag_raw64)) |
val desc = dtoi(D.makeDesc(len+len, D.tag_raw64)) |
|
val vl' = |
|
|
map (fn (x, p as SELp _) => (M.GPR(regbind' x), p) |
|
|
| (x, p as OFFp 0) => (M.FPR(fregbind x), p) |
|
|
| _ => error "gen:RECORD:RK_FBLOCK") |
|
|
vl |
|
1145 |
(* At initialization the allocation pointer is aligned on |
(* At initialization the allocation pointer is aligned on |
1146 |
* an odd-word boundary, and the heap offset set to zero. If an |
* an odd-word boundary, and the heap offset set to zero. If an |
1147 |
* odd number of words have been allocated then the heap pointer |
* odd number of words have been allocated then the heap pointer |
1149 |
*) |
*) |
1150 |
val hp = |
val hp = |
1151 |
if Word.andb(Word.fromInt hp, 0w4) <> 0w0 then hp+4 else hp |
if Word.andb(Word.fromInt hp, 0w4) <> 0w0 then hp+4 else hp |
1152 |
in (* The components are floating points *) |
in (* The components are floating point *) |
1153 |
treeifyAlloc(w, |
treeifyAlloc(w, |
1154 |
MkRecord.frecord |
allocFrecord(memDisambig w, M.LI desc, vl, hp), |
|
{desc=M.LI desc, fields=vl', mem=memDisambig w, |
|
|
hp=hp, emit=emit, markPTR=markPTR, markComp=markFLT}, |
|
1155 |
e, hp + 4 + len * 8) |
e, hp + 4 + len * 8) |
1156 |
end |
end |
1157 |
|
|
1160 |
let val len = length vl |
let val len = length vl |
1161 |
val hdrDesc = dtoi(D.desc_polyvec) |
val hdrDesc = dtoi(D.desc_polyvec) |
1162 |
val dataDesc = dtoi(D.makeDesc(len, D.tag_vec_data)) |
val dataDesc = dtoi(D.makeDesc(len, D.tag_vec_data)) |
|
val contents = map (fn (v,p) => (regbind' v, p)) vl |
|
1163 |
val dataPtr = newReg PTR |
val dataPtr = newReg PTR |
1164 |
val hdrM = memDisambig w |
val mem = memDisambig w |
1165 |
val dataM = hdrM (* Allen *) |
val hp' = hp + 4 + len*4 |
1166 |
in (* The components are boxed *) |
in (* The components are boxed *) |
1167 |
MkRecord.record { |
(* Allocate the data *) |
1168 |
desc = M.LI(dataDesc), fields = contents, |
allocRecord(markPTR, mem, M.LI dataDesc, vl, hp); |
1169 |
mem = dataM, hp = hp, emit=emit, |
emit(M.MV(pty, dataPtr, ea(C.allocptr, hp+4))); |
1170 |
markPTR=markPTR, markComp=markPTR |
(* Now allocate the header pair *) |
|
}; |
|
|
emit(M.MV(pty, dataPtr, M.ADD(addrTy, C.allocptr, |
|
|
M.LI(hp+4)))); |
|
1171 |
treeifyAlloc(w, |
treeifyAlloc(w, |
1172 |
MkRecord.record { |
allocHeaderPair(hdrDesc, mem, dataPtr, len, hp+4+len*4), |
1173 |
desc = M.LI hdrDesc, |
e, hp'+12) |
|
fields = [ (M.REG(ity,dataPtr), offp0), |
|
|
(M.LI(len+len+1), offp0) |
|
|
], |
|
|
mem = hdrM, hp = hp + 4 + len*4, emit=emit, |
|
|
markPTR=markPTR, markComp=markPTR |
|
|
}, |
|
|
e, hp + 16 + len * 4) |
|
1174 |
end |
end |
1175 |
|
|
1176 |
(* |
(* |
1186 |
*) |
*) |
1187 |
and select(i, v, x, t, e, hp) = |
and select(i, v, x, t, e, hp) = |
1188 |
treeifyDef(x, |
treeifyDef(x, |
1189 |
M.LOAD(ity,scale4(regbind v,INT i),getRegion(v,i)), |
M.LOAD(ity,scale4(regbind v,INT i),getRegionPi(v,i)), |
1190 |
t, e, hp) |
t, e, hp) |
1191 |
|
|
1192 |
(* |
(* |
1395 |
defI31(x, orTag(getObjLength(v)), e, hp) |
defI31(x, orTag(getObjLength(v)), e, hp) |
1396 |
| gen(PURE(P.length, [v], x, t, e), hp) = select(1, v, x, t, e, hp) |
| gen(PURE(P.length, [v], x, t, e), hp) = select(1, v, x, t, e, hp) |
1397 |
| gen(PURE(P.subscriptv, [v, INT i], x, t, e), hp) = |
| gen(PURE(P.subscriptv, [v, INT i], x, t, e), hp) = |
1398 |
let val region = getRegion(v, 0) |
let (* get data pointer *) |
1399 |
(* get data pointer *) |
val mem = dataptrRegion v |
1400 |
val a = markPTR(M.LOAD(ity, regbind v, region)) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1401 |
val region' = region (* Allen *) |
val mem' = arrayRegion mem |
1402 |
in defBoxed(x, M.LOAD(ity, scale4(a, INT i), region'), e, hp) |
in defBoxed(x, M.LOAD(ity, scale4(a, INT i), mem'), e, hp) |
1403 |
end |
end |
1404 |
| gen(PURE(P.subscriptv, [v, w], x, _, e), hp) = |
| gen(PURE(P.subscriptv, [v, w], x, _, e), hp) = |
1405 |
let (* get data pointer *) |
let (* get data pointer *) |
1406 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1407 |
in defBoxed(x, M.LOAD(ity, scale4(a, w), R.readonly), e, hp) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1408 |
|
val mem' = arrayRegion mem |
1409 |
|
in defBoxed(x, M.LOAD(ity, scale4(a, w), mem'), e, hp) |
1410 |
end |
end |
1411 |
| gen(PURE(P.pure_numsubscript{kind=P.INT 8}, [v,i], x, _, e), hp) = |
| gen(PURE(P.pure_numsubscript{kind=P.INT 8}, [v,i], x, _, e), hp) = |
1412 |
let (* get data pointer *) |
let (* get data pointer *) |
1413 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1414 |
in defI31(x,tagUnsigned(M.LOAD(8,scale1(a, i), R.memory)), e, hp) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1415 |
|
val mem' = arrayRegion mem |
1416 |
|
in defI31(x,tagUnsigned(M.LOAD(8,scale1(a, i), mem')), e, hp) |
1417 |
end |
end |
1418 |
| gen(PURE(P.gettag, [v], x, _, e), hp) = |
| gen(PURE(P.gettag, [v], x, _, e), hp) = |
1419 |
defI31(x, tagUnsigned(M.ANDB(ity, |
defI31(x, tagUnsigned(M.ANDB(ity, |
1426 |
M.LI(dtoi D.desc_special)) |
M.LI(dtoi D.desc_special)) |
1427 |
in (* What gc types are the components? *) |
in (* What gc types are the components? *) |
1428 |
treeifyAlloc(x, |
treeifyAlloc(x, |
1429 |
MkRecord.record{desc=desc, fields=[(regbind' v, offp0)], |
allocRecord(markNothing, memDisambig x, |
1430 |
mem=memDisambig x, hp=hp, emit=emit, |
desc, [(v, offp0)], hp), |
|
markPTR=markPTR, markComp=markNothing}, |
|
1431 |
e, hp+8) |
e, hp+8) |
1432 |
end |
end |
1433 |
| gen(PURE(P.makeref, [v], x, _, e), hp) = |
| gen(PURE(P.makeref, [v], x, _, e), hp) = |
1459 |
| gen(PURE(P.recsubscript, [v, INT w], x, t, e), hp) = |
| gen(PURE(P.recsubscript, [v, INT w], x, t, e), hp) = |
1460 |
select(w,v,x,t,e,hp) |
select(w,v,x,t,e,hp) |
1461 |
| gen(PURE(P.recsubscript, [v, w], x, _, e), hp) = |
| gen(PURE(P.recsubscript, [v, w], x, _, e), hp) = |
1462 |
defI31(x, M.LOAD(ity, scale4(regbind v, w), R.readonly), e, hp) |
(* no indirection! *) |
1463 |
| gen(PURE(P.raw64subscript, [v, INT i], x, _, e), hp) = |
let val mem = arrayRegion(getRegion v) |
1464 |
fselect(i, v, x, e, hp) |
in defI31(x, M.LOAD(ity, scale4(regbind v, w), mem), e, hp) |
1465 |
|
end |
1466 |
| gen(PURE(P.raw64subscript, [v, i], x, _, e), hp) = |
| gen(PURE(P.raw64subscript, [v, i], x, _, e), hp) = |
1467 |
treeifyDefF64(x, M.FLOAD(fty,scale8(regbind v, i),R.readonly), |
let val mem = arrayRegion(getRegion v) |
1468 |
|
in treeifyDefF64(x, M.FLOAD(fty,scale8(regbind v, i), mem), |
1469 |
e, hp) |
e, hp) |
1470 |
|
end |
1471 |
| gen(PURE(P.newarray0, [_], x, t, e), hp) = |
| gen(PURE(P.newarray0, [_], x, t, e), hp) = |
1472 |
let val hdrDesc = dtoi(D.desc_polyarr) |
let val hdrDesc = dtoi(D.desc_polyarr) |
1473 |
val dataDesc = dtoi D.desc_ref |
val dataDesc = dtoi D.desc_ref |
1482 |
emit(M.MV(pty, dataPtr, M.ADD(addrTy,C.allocptr,M.LI(hp+4)))); |
emit(M.MV(pty, dataPtr, M.ADD(addrTy,C.allocptr,M.LI(hp+4)))); |
1483 |
(* gen code to allocate array header *) |
(* gen code to allocate array header *) |
1484 |
treeifyAlloc(x, |
treeifyAlloc(x, |
1485 |
MkRecord.record { |
allocHeaderPair(hdrDesc, hdrM, dataPtr, 0, hp+8), |
|
desc = M.LI hdrDesc, |
|
|
fields = [(M.REG(ity,dataPtr), offp0), (mlZero, offp0)], |
|
|
mem = hdrM, hp = hp + 8, emit=emit, |
|
|
markPTR=markPTR, markComp=markPTR (* boxed components *) |
|
|
}, |
|
1486 |
e, hp + 20) |
e, hp + 20) |
1487 |
end |
end |
1488 |
(*** ARITH ***) |
(*** ARITH ***) |
1565 |
end |
end |
1566 |
(*** LOOKER ***) |
(*** LOOKER ***) |
1567 |
| gen(LOOKER(P.!, [v], x, _, e), hp) = |
| gen(LOOKER(P.!, [v], x, _, e), hp) = |
1568 |
defBoxed (x, M.LOAD(ity, regbind v, R.memory), e, hp) |
let val mem = arrayRegion(getRegion v) |
1569 |
|
in defBoxed (x, M.LOAD(ity, regbind v, mem), e, hp) |
1570 |
|
end |
1571 |
| gen(LOOKER(P.subscript, [v,w], x, _, e), hp) = |
| gen(LOOKER(P.subscript, [v,w], x, _, e), hp) = |
1572 |
let (* get data pointer *) |
let (* get data pointer *) |
1573 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1574 |
in defBoxed (x, M.LOAD(ity, scale4(a, w), R.memory), e, hp) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1575 |
|
val mem' = arrayRegion mem |
1576 |
|
in defBoxed (x, M.LOAD(ity, scale4(a, w), mem'), e, hp) |
1577 |
end |
end |
1578 |
| gen(LOOKER(P.numsubscript{kind=P.INT 8},[v,i],x,_,e), hp) = |
| gen(LOOKER(P.numsubscript{kind=P.INT 8},[v,i],x,_,e), hp) = |
1579 |
let (* get data pointer *) |
let (* get data pointer *) |
1580 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1581 |
in defI31(x, tagUnsigned(M.LOAD(8,scale1(a, i),R.memory)), e, hp) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1582 |
|
val mem' = arrayRegion mem |
1583 |
|
in defI31(x, tagUnsigned(M.LOAD(8,scale1(a, i), mem')), e, hp) |
1584 |
end |
end |
1585 |
| gen(LOOKER(P.numsubscript{kind=P.FLOAT 64}, [v,i], x, _, e), hp)= |
| gen(LOOKER(P.numsubscript{kind=P.FLOAT 64}, [v,i], x, _, e), hp)= |
1586 |
let (* get data pointer *) |
let (* get data pointer *) |
1587 |
val a = markPTR(M.LOAD(ity,regbind v, R.readonly)) |
val mem = dataptrRegion v |
1588 |
in treeifyDefF64(x, M.FLOAD(fty,scale8(a, i),R.memory), e, hp) |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1589 |
|
val mem' = arrayRegion mem |
1590 |
|
in treeifyDefF64(x, M.FLOAD(fty,scale8(a, i), mem'), e, hp) |
1591 |
end |
end |
1592 |
| gen(LOOKER(P.gethdlr,[],x,_,e), hp) = defBoxed(x, C.exnptr, e, hp) |
| gen(LOOKER(P.gethdlr,[],x,_,e), hp) = defBoxed(x, C.exnptr, e, hp) |
1593 |
| gen(LOOKER(P.getvar, [], x, _, e), hp)= defBoxed(x, C.varptr, e, hp) |
| gen(LOOKER(P.getvar, [], x, _, e), hp)= defBoxed(x, C.varptr, e, hp) |
1601 |
(*** SETTER ***) |
(*** SETTER ***) |
1602 |
| gen(SETTER(P.assign, [a as VAR arr, v], e), hp) = |
| gen(SETTER(P.assign, [a as VAR arr, v], e), hp) = |
1603 |
let val ea = regbind a |
let val ea = regbind a |
1604 |
|
val mem = arrayRegion(getRegion a) |
1605 |
in recordStore(ea, hp); |
in recordStore(ea, hp); |
1606 |
emit(M.STORE(ity, ea, regbind v, memDisambig arr)); |
emit(M.STORE(ity, ea, regbind v, mem)); |
1607 |
gen(e, hp+8) |
gen(e, hp+8) |
1608 |
end |
end |
1609 |
| gen(SETTER(P.unboxedassign, [a, v], e), hp) = |
| gen(SETTER(P.unboxedassign, [a, v], e), hp) = |
1610 |
(emit(M.STORE(ity, regbind a, regbind v, R.memory)); |
let val mem = arrayRegion(getRegion a) |
1611 |
gen(e, hp)) |
in emit(M.STORE(ity, regbind a, regbind v, mem)); |
1612 |
|
gen(e, hp) |
1613 |
|
end |
1614 |
| gen(SETTER(P.update, [v,i,w], e), hp) = |
| gen(SETTER(P.update, [v,i,w], e), hp) = |
1615 |
let (* get data pointer *) |
let (* get data pointer *) |
1616 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1617 |
|
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1618 |
val tmpR = Cells.newReg() (* derived pointer! *) |
val tmpR = Cells.newReg() (* derived pointer! *) |
1619 |
val tmp = M.REG(ity, tmpR) |
val tmp = M.REG(ity, tmpR) |
1620 |
val ea = scale4(a, i) (* address of updated cell *) |
val ea = scale4(a, i) (* address of updated cell *) |
1621 |
|
val mem' = arrayRegion(mem) |
1622 |
in emit(M.MV(ity, tmpR, ea)); |
in emit(M.MV(ity, tmpR, ea)); |
1623 |
recordStore(tmp, hp); |
recordStore(tmp, hp); |
1624 |
emit(M.STORE(ity, tmp, regbind w, R.memory)); |
emit(M.STORE(ity, tmp, regbind w, mem')); |
1625 |
gen(e, hp+8) |
gen(e, hp+8) |
1626 |
end |
end |
1627 |
| gen(SETTER(P.boxedupdate, args, e), hp) = |
| gen(SETTER(P.boxedupdate, args, e), hp) = |
1628 |
gen(SETTER(P.update, args, e), hp) |
gen(SETTER(P.update, args, e), hp) |
1629 |
| gen(SETTER(P.unboxedupdate, [v, i, w], e), hp) = |
| gen(SETTER(P.unboxedupdate, [v, i, w], e), hp) = |
1630 |
let (* get data pointer *) |
let (* get data pointer *) |
1631 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1632 |
in emit(M.STORE(ity, scale4(a, i), regbind w, R.memory)); |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1633 |
|
val mem' = arrayRegion mem |
1634 |
|
in emit(M.STORE(ity, scale4(a, i), regbind w, mem')); |
1635 |
gen(e, hp) |
gen(e, hp) |
1636 |
end |
end |
1637 |
| gen(SETTER(P.numupdate{kind=P.INT 8}, [s,i,v], e), hp) = |
| gen(SETTER(P.numupdate{kind=P.INT 8}, [s,i,v], e), hp) = |
1638 |
let (* get data pointer *) |
let (* get data pointer *) |
1639 |
val a = markPTR(M.LOAD(ity, regbind s, R.readonly)) |
val mem = dataptrRegion v |
1640 |
|
val a = markPTR(M.LOAD(ity, regbind s, mem)) |
1641 |
val ea = scale1(a, i) |
val ea = scale1(a, i) |
1642 |
in emit(M.STORE(8,ea, untagUnsigned(v), R.memory)); |
val mem' = arrayRegion mem |
1643 |
|
in emit(M.STORE(8, ea, untagUnsigned(v), mem')); |
1644 |
gen(e, hp) |
gen(e, hp) |
1645 |
end |
end |
1646 |
| gen(SETTER(P.numupdate{kind=P.FLOAT 64},[v,i,w],e), hp) = |
| gen(SETTER(P.numupdate{kind=P.FLOAT 64},[v,i,w],e), hp) = |
1647 |
let (* get data pointer *) |
let (* get data pointer *) |
1648 |
val a = markPTR(M.LOAD(ity, regbind v, R.readonly)) |
val mem = dataptrRegion v |
1649 |
in emit(M.FSTORE(fty,scale8(a, i), fregbind w, R.memory)); |
val a = markPTR(M.LOAD(ity, regbind v, mem)) |
1650 |
|
val mem' = arrayRegion mem |
1651 |
|
in emit(M.FSTORE(fty,scale8(a, i), fregbind w, mem')); |
1652 |
gen(e, hp) |
gen(e, hp) |
1653 |
end |
end |
1654 |
| gen(SETTER(P.setspecial, [v, i], e), hp) = |
| gen(SETTER(P.setspecial, [v, i], e), hp) = |
1659 |
| _ => M.ORB(ity, M.SLL(ity, untagSigned(i), |
| _ => M.ORB(ity, M.SLL(ity, untagSigned(i), |
1660 |
M.LI D.tagWidth), |
M.LI D.tagWidth), |
1661 |
M.LI(dtoi D.desc_special)) |
M.LI(dtoi D.desc_special)) |
1662 |
in emit(M.STORE(ity, ea, i',R.memory)); |
val mem = getRegionPi(v, 0) |
1663 |
|
in emit(M.STORE(ity, ea, i', mem)); |
1664 |
gen(e, hp) |
gen(e, hp) |
1665 |
end |
end |
1666 |
| gen(SETTER(P.sethdlr,[x],e), hp) = |
| gen(SETTER(P.sethdlr,[x],e), hp) = |