From 7acfca905d76140f4cc0b09c9a12de237de364cd Mon Sep 17 00:00:00 2001 From: Nick Barnes Date: Wed, 31 Oct 2001 14:40:56 +0000 Subject: Branch imports for masters. Copied from Perforce Change: 23678 ServerID: perforce.ravenbrook.com --- mps/code/abq.c | 312 ++++++ mps/code/abq.h | 59 ++ mps/code/abqtest.c | 177 ++++ mps/code/action.c | 12 + mps/code/amcss.c | 227 ++++ mps/code/amcsshe.c | 323 ++++++ mps/code/amcssth.c | 298 ++++++ mps/code/amsss.c | 174 +++ mps/code/apss.c | 162 +++ mps/code/arena.c | 649 ++++++++++++ mps/code/arenacl.c | 475 +++++++++ mps/code/arenacv.c | 422 ++++++++ mps/code/arenavm.c | 1547 +++++++++++++++++++++++++++ mps/code/arenavmx.c | 32 + mps/code/assert.c | 71 ++ mps/code/awlut.c | 323 ++++++ mps/code/awlutth.c | 332 ++++++ mps/code/boot.c | 125 +++ mps/code/boot.h | 34 + mps/code/bt.c | 1001 ++++++++++++++++++ mps/code/btcv.c | 568 ++++++++++ mps/code/bttest.c | 385 +++++++ mps/code/buffer.c | 1526 ++++++++++++++++++++++++++ mps/code/cbs.c | 1661 +++++++++++++++++++++++++++++ mps/code/cbs.h | 114 ++ mps/code/cbstest.c | 657 ++++++++++++ mps/code/chain.h | 91 ++ mps/code/check.h | 279 +++++ mps/code/comm.gmk | 553 ++++++++++ mps/code/commpost.nmk | 265 +++++ mps/code/commpre.nmk | 197 ++++ mps/code/config.h | 310 ++++++ mps/code/cx.gmk | 30 + mps/code/dbgpool.c | 494 +++++++++ mps/code/dbgpool.h | 57 + mps/code/dc.gmk | 27 + mps/code/dumper.c | 146 +++ mps/code/eg.gmk | 34 + mps/code/event.c | 231 ++++ mps/code/event.h | 115 ++ mps/code/eventcnv.c | 618 +++++++++++ mps/code/eventcom.h | 150 +++ mps/code/eventdef.h | 170 +++ mps/code/eventgen.h | 1008 ++++++++++++++++++ mps/code/eventgen.pl | 178 ++++ mps/code/eventpro.c | 433 ++++++++ mps/code/eventpro.h | 41 + mps/code/eventrep.c | 736 +++++++++++++ mps/code/eventrep.h | 24 + mps/code/finalcv.c | 180 ++++ mps/code/fmtdy.c | 829 +++++++++++++++ mps/code/fmtdy.h | 44 + mps/code/fmtdytst.c | 140 +++ mps/code/fmthe.c | 609 +++++++++++ mps/code/fmthe.h | 38 + mps/code/format.c | 154 +++ mps/code/gathconf.bat | 32 + mps/code/gc.gmk | 30 + mps/code/global.c | 789 ++++++++++++++ mps/code/gp.gmk | 32 + mps/code/hqbuild/data/cv_alpha.txt | 1 + mps/code/hqbuild/data/cv_x86.txt | 3 + mps/code/hqbuild/tools/hqbuild | 20 + mps/code/hqbuild/tools/hqbuild.bat | 12 + mps/code/i6cc.gmk | 31 + mps/code/iam4cc.gmk | 21 + mps/code/ic.gmk | 21 + mps/code/idlench.awk | 69 ++ mps/code/lc.gmk | 24 + mps/code/ld.c | 210 ++++ mps/code/lii3eg.gmk | 21 + mps/code/lii4gc.gmk | 28 + mps/code/lippgc.gmk | 21 + mps/code/lo.h | 44 + mps/code/lock.h | 225 ++++ mps/code/lockan.c | 122 +++ mps/code/lockcov.c | 50 + mps/code/lockli.c | 258 +++++ mps/code/lockutw3.c | 93 ++ mps/code/lockw3.c | 156 +++ mps/code/locus.c | 481 +++++++++ mps/code/locv.c | 136 +++ mps/code/message.c | 396 +++++++ mps/code/messtest.c | 269 +++++ mps/code/meter.c | 104 ++ mps/code/meter.h | 57 + mps/code/misc.h | 190 ++++ mps/code/mpm.c | 525 +++++++++ mps/code/mpm.h | 988 +++++++++++++++++ mps/code/mpmss.c | 153 +++ mps/code/mpmst.h | 692 ++++++++++++ mps/code/mpmtypes.h | 439 ++++++++ mps/code/mps.h | 623 +++++++++++ mps/code/mpsacl.h | 16 + mps/code/mpsavm.h | 17 + mps/code/mpscamc.h | 19 + mps/code/mpscams.h | 14 + mps/code/mpscawl.h | 14 + mps/code/mpsclo.h | 15 + mps/code/mpscmv.h | 17 + mps/code/mpscmv2.h | 35 + mps/code/mpscmvff.h | 17 + mps/code/mpscsnc.h | 14 + mps/code/mpsi.c | 1844 ++++++++++++++++++++++++++++++++ mps/code/mpsicv.c | 430 ++++++++ mps/code/mpsio.h | 25 + mps/code/mpsioan.c | 87 ++ mps/code/mpsiw3.c | 32 + mps/code/mpslib.h | 48 + mps/code/mpsliban.c | 121 +++ mps/code/mpstd.h | 299 ++++++ mps/code/mpsw3.h | 39 + mps/code/mpswin.h | 31 + mps/code/mv2test.c | 324 ++++++ mps/code/o1alcc.gmk | 21 + mps/code/o1algc.gmk | 20 + mps/code/ossu.h | 92 ++ mps/code/osxc.h | 27 + mps/code/pool.c | 576 ++++++++++ mps/code/poolabs.c | 627 +++++++++++ mps/code/poolamc.c | 2058 ++++++++++++++++++++++++++++++++++++ mps/code/poolams.c | 1457 +++++++++++++++++++++++++ mps/code/poolams.h | 207 ++++ mps/code/poolawl.c | 1248 ++++++++++++++++++++++ mps/code/poollo.c | 801 ++++++++++++++ mps/code/poolmfs.c | 303 ++++++ mps/code/poolmfs.h | 51 + mps/code/poolmrg.c | 847 +++++++++++++++ mps/code/poolmrg.h | 19 + mps/code/poolmv.c | 866 +++++++++++++++ mps/code/poolmv.h | 56 + mps/code/poolmv2.c | 1148 ++++++++++++++++++++ mps/code/poolmv2.h | 18 + mps/code/poolmvff.c | 682 ++++++++++++ mps/code/pooln.c | 296 ++++++ mps/code/pooln.h | 40 + mps/code/poolncv.c | 49 + mps/code/poolsnc.c | 697 ++++++++++++ mps/code/prmcan.c | 37 + mps/code/prmci3.h | 23 + mps/code/prmci3li.c | 86 ++ mps/code/prmci3w3.c | 78 ++ mps/code/prmcli.h | 26 + mps/code/prmcw3.h | 23 + mps/code/proddw.bat | 40 + mps/code/protan.c | 78 ++ mps/code/proti3.c | 240 +++++ mps/code/protli.c | 90 ++ mps/code/protlii3.c | 151 +++ mps/code/proto1.c | 199 ++++ mps/code/protocol.c | 125 +++ mps/code/protocol.h | 184 ++++ mps/code/protso.c | 198 ++++ mps/code/protsu.c | 235 ++++ mps/code/protw3.c | 137 +++ mps/code/pthrdext.c | 363 +++++++ mps/code/pthrdext.h | 68 ++ mps/code/qs.c | 519 +++++++++ mps/code/ref.c | 81 ++ mps/code/replay.c | 180 ++++ mps/code/reserv.c | 407 +++++++ mps/code/ring.c | 122 +++ mps/code/ring.h | 108 ++ mps/code/root.c | 669 ++++++++++++ mps/code/s7ppac/Makefile | 207 ++++ mps/code/s7ppmw.sit | Bin 0 -> 6474 bytes mps/code/sac.c | 365 +++++++ mps/code/sac.h | 80 ++ mps/code/sacss.c | 180 ++++ mps/code/sc.gmk | 20 + mps/code/seg.c | 1653 +++++++++++++++++++++++++++++ mps/code/segsmss.c | 860 +++++++++++++++ mps/code/shield.c | 305 ++++++ mps/code/sos8cx.gmk | 18 + mps/code/sos8gc.gmk | 16 + mps/code/sos8gp.gmk | 17 + mps/code/sos9sc.gmk | 17 + mps/code/span.c | 25 + mps/code/spi3.asm | 27 + mps/code/splay.c | 1019 ++++++++++++++++++ mps/code/splay.h | 84 ++ mps/code/ss.h | 36 + mps/code/ssan.c | 22 + mps/code/sslii3.c | 58 + mps/code/sso1al.s | 42 + mps/code/sssos8.s | 43 + mps/code/sssus8.s | 43 + mps/code/ssw3i3.c | 45 + mps/code/sus8gc.gmk | 16 + mps/code/sus8lc.gmk | 14 + mps/code/table.c | 279 +++++ mps/code/table.h | 26 + mps/code/teletest.c | 221 ++++ mps/code/testlib.c | 110 ++ mps/code/testlib.h | 153 +++ mps/code/th.h | 73 ++ mps/code/than.c | 144 +++ mps/code/thlii4.c | 303 ++++++ mps/code/thw3i3.c | 330 ++++++ mps/code/trace.c | 1666 +++++++++++++++++++++++++++++ mps/code/tract.c | 615 +++++++++++ mps/code/tract.h | 281 +++++ mps/code/version.c | 58 + mps/code/vman.c | 204 ++++ mps/code/vmi5.c | 275 +++++ mps/code/vmli.c | 292 +++++ mps/code/vmo1.c | 297 ++++++ mps/code/vmso.c | 306 ++++++ mps/code/vmsu.c | 313 ++++++ mps/code/vmw3.c | 274 +++++ mps/code/vmxc.c | 257 +++++ mps/code/w3almv.nmk | 292 +++++ mps/code/w3i3mv.nmk | 307 ++++++ mps/code/w3ppmv.nmk | 291 +++++ mps/code/walk.c | 363 +++++++ mps/code/xcppgc.gmk | 29 + 216 files changed, 60315 insertions(+) create mode 100644 mps/code/abq.c create mode 100644 mps/code/abq.h create mode 100644 mps/code/abqtest.c create mode 100644 mps/code/action.c create mode 100644 mps/code/amcss.c create mode 100644 mps/code/amcsshe.c create mode 100644 mps/code/amcssth.c create mode 100644 mps/code/amsss.c create mode 100644 mps/code/apss.c create mode 100644 mps/code/arena.c create mode 100644 mps/code/arenacl.c create mode 100644 mps/code/arenacv.c create mode 100644 mps/code/arenavm.c create mode 100644 mps/code/arenavmx.c create mode 100644 mps/code/assert.c create mode 100644 mps/code/awlut.c create mode 100644 mps/code/awlutth.c create mode 100644 mps/code/boot.c create mode 100644 mps/code/boot.h create mode 100644 mps/code/bt.c create mode 100644 mps/code/btcv.c create mode 100644 mps/code/bttest.c create mode 100644 mps/code/buffer.c create mode 100644 mps/code/cbs.c create mode 100644 mps/code/cbs.h create mode 100644 mps/code/cbstest.c create mode 100644 mps/code/chain.h create mode 100644 mps/code/check.h create mode 100644 mps/code/comm.gmk create mode 100644 mps/code/commpost.nmk create mode 100644 mps/code/commpre.nmk create mode 100644 mps/code/config.h create mode 100644 mps/code/cx.gmk create mode 100644 mps/code/dbgpool.c create mode 100644 mps/code/dbgpool.h create mode 100644 mps/code/dc.gmk create mode 100644 mps/code/dumper.c create mode 100644 mps/code/eg.gmk create mode 100644 mps/code/event.c create mode 100644 mps/code/event.h create mode 100644 mps/code/eventcnv.c create mode 100644 mps/code/eventcom.h create mode 100644 mps/code/eventdef.h create mode 100644 mps/code/eventgen.h create mode 100644 mps/code/eventgen.pl create mode 100644 mps/code/eventpro.c create mode 100644 mps/code/eventpro.h create mode 100644 mps/code/eventrep.c create mode 100644 mps/code/eventrep.h create mode 100644 mps/code/finalcv.c create mode 100644 mps/code/fmtdy.c create mode 100644 mps/code/fmtdy.h create mode 100644 mps/code/fmtdytst.c create mode 100644 mps/code/fmthe.c create mode 100644 mps/code/fmthe.h create mode 100644 mps/code/format.c create mode 100644 mps/code/gathconf.bat create mode 100644 mps/code/gc.gmk create mode 100644 mps/code/global.c create mode 100644 mps/code/gp.gmk create mode 100644 mps/code/hqbuild/data/cv_alpha.txt create mode 100644 mps/code/hqbuild/data/cv_x86.txt create mode 100644 mps/code/hqbuild/tools/hqbuild create mode 100644 mps/code/hqbuild/tools/hqbuild.bat create mode 100644 mps/code/i6cc.gmk create mode 100644 mps/code/iam4cc.gmk create mode 100644 mps/code/ic.gmk create mode 100644 mps/code/idlench.awk create mode 100644 mps/code/lc.gmk create mode 100644 mps/code/ld.c create mode 100644 mps/code/lii3eg.gmk create mode 100644 mps/code/lii4gc.gmk create mode 100644 mps/code/lippgc.gmk create mode 100644 mps/code/lo.h create mode 100644 mps/code/lock.h create mode 100644 mps/code/lockan.c create mode 100644 mps/code/lockcov.c create mode 100644 mps/code/lockli.c create mode 100644 mps/code/lockutw3.c create mode 100644 mps/code/lockw3.c create mode 100644 mps/code/locus.c create mode 100644 mps/code/locv.c create mode 100644 mps/code/message.c create mode 100644 mps/code/messtest.c create mode 100644 mps/code/meter.c create mode 100644 mps/code/meter.h create mode 100644 mps/code/misc.h create mode 100644 mps/code/mpm.c create mode 100644 mps/code/mpm.h create mode 100644 mps/code/mpmss.c create mode 100644 mps/code/mpmst.h create mode 100644 mps/code/mpmtypes.h create mode 100644 mps/code/mps.h create mode 100644 mps/code/mpsacl.h create mode 100644 mps/code/mpsavm.h create mode 100644 mps/code/mpscamc.h create mode 100644 mps/code/mpscams.h create mode 100644 mps/code/mpscawl.h create mode 100644 mps/code/mpsclo.h create mode 100644 mps/code/mpscmv.h create mode 100644 mps/code/mpscmv2.h create mode 100644 mps/code/mpscmvff.h create mode 100644 mps/code/mpscsnc.h create mode 100644 mps/code/mpsi.c create mode 100644 mps/code/mpsicv.c create mode 100644 mps/code/mpsio.h create mode 100644 mps/code/mpsioan.c create mode 100644 mps/code/mpsiw3.c create mode 100644 mps/code/mpslib.h create mode 100644 mps/code/mpsliban.c create mode 100644 mps/code/mpstd.h create mode 100644 mps/code/mpsw3.h create mode 100644 mps/code/mpswin.h create mode 100644 mps/code/mv2test.c create mode 100644 mps/code/o1alcc.gmk create mode 100644 mps/code/o1algc.gmk create mode 100644 mps/code/ossu.h create mode 100644 mps/code/osxc.h create mode 100644 mps/code/pool.c create mode 100644 mps/code/poolabs.c create mode 100644 mps/code/poolamc.c create mode 100644 mps/code/poolams.c create mode 100644 mps/code/poolams.h create mode 100644 mps/code/poolawl.c create mode 100644 mps/code/poollo.c create mode 100644 mps/code/poolmfs.c create mode 100644 mps/code/poolmfs.h create mode 100644 mps/code/poolmrg.c create mode 100644 mps/code/poolmrg.h create mode 100644 mps/code/poolmv.c create mode 100644 mps/code/poolmv.h create mode 100644 mps/code/poolmv2.c create mode 100644 mps/code/poolmv2.h create mode 100644 mps/code/poolmvff.c create mode 100644 mps/code/pooln.c create mode 100644 mps/code/pooln.h create mode 100644 mps/code/poolncv.c create mode 100644 mps/code/poolsnc.c create mode 100644 mps/code/prmcan.c create mode 100644 mps/code/prmci3.h create mode 100644 mps/code/prmci3li.c create mode 100644 mps/code/prmci3w3.c create mode 100644 mps/code/prmcli.h create mode 100644 mps/code/prmcw3.h create mode 100644 mps/code/proddw.bat create mode 100644 mps/code/protan.c create mode 100644 mps/code/proti3.c create mode 100644 mps/code/protli.c create mode 100644 mps/code/protlii3.c create mode 100644 mps/code/proto1.c create mode 100644 mps/code/protocol.c create mode 100644 mps/code/protocol.h create mode 100644 mps/code/protso.c create mode 100644 mps/code/protsu.c create mode 100644 mps/code/protw3.c create mode 100644 mps/code/pthrdext.c create mode 100644 mps/code/pthrdext.h create mode 100644 mps/code/qs.c create mode 100644 mps/code/ref.c create mode 100644 mps/code/replay.c create mode 100644 mps/code/reserv.c create mode 100644 mps/code/ring.c create mode 100644 mps/code/ring.h create mode 100644 mps/code/root.c create mode 100644 mps/code/s7ppac/Makefile create mode 100644 mps/code/s7ppmw.sit create mode 100644 mps/code/sac.c create mode 100644 mps/code/sac.h create mode 100644 mps/code/sacss.c create mode 100644 mps/code/sc.gmk create mode 100644 mps/code/seg.c create mode 100644 mps/code/segsmss.c create mode 100644 mps/code/shield.c create mode 100644 mps/code/sos8cx.gmk create mode 100644 mps/code/sos8gc.gmk create mode 100644 mps/code/sos8gp.gmk create mode 100644 mps/code/sos9sc.gmk create mode 100644 mps/code/span.c create mode 100644 mps/code/spi3.asm create mode 100644 mps/code/splay.c create mode 100644 mps/code/splay.h create mode 100644 mps/code/ss.h create mode 100644 mps/code/ssan.c create mode 100644 mps/code/sslii3.c create mode 100644 mps/code/sso1al.s create mode 100644 mps/code/sssos8.s create mode 100644 mps/code/sssus8.s create mode 100644 mps/code/ssw3i3.c create mode 100644 mps/code/sus8gc.gmk create mode 100644 mps/code/sus8lc.gmk create mode 100644 mps/code/table.c create mode 100644 mps/code/table.h create mode 100644 mps/code/teletest.c create mode 100644 mps/code/testlib.c create mode 100644 mps/code/testlib.h create mode 100644 mps/code/th.h create mode 100644 mps/code/than.c create mode 100644 mps/code/thlii4.c create mode 100644 mps/code/thw3i3.c create mode 100644 mps/code/trace.c create mode 100644 mps/code/tract.c create mode 100644 mps/code/tract.h create mode 100644 mps/code/version.c create mode 100644 mps/code/vman.c create mode 100644 mps/code/vmi5.c create mode 100644 mps/code/vmli.c create mode 100644 mps/code/vmo1.c create mode 100644 mps/code/vmso.c create mode 100644 mps/code/vmsu.c create mode 100644 mps/code/vmw3.c create mode 100644 mps/code/vmxc.c create mode 100644 mps/code/w3almv.nmk create mode 100644 mps/code/w3i3mv.nmk create mode 100644 mps/code/w3ppmv.nmk create mode 100644 mps/code/walk.c create mode 100644 mps/code/xcppgc.gmk (limited to 'mps/code') diff --git a/mps/code/abq.c b/mps/code/abq.c new file mode 100644 index 00000000000..4e082213472 --- /dev/null +++ b/mps/code/abq.c @@ -0,0 +1,312 @@ +/* impl.c.abq: AVAILABLE BLOCK QUEUE + * + * $HopeName: MMsrc!abq.c(trunk.4) $ + * Copyright (C) 1999. Harlequin Limited. All rights reserved. + * + * .readership: Any MPS developer + * + * .purpose: A FIFO queue substrate for impl.c.poolmv2 + * + * .design: See design.mps.poolmv2 + */ + +#include "meter.h" +#include "abq.h" +#include "cbs.h" +#include "mpm.h" + +SRCID(abq, "$HopeName: MMsrc!abq.c(trunk.4) $"); + + +/* Private prototypes */ + +static Size ABQQueueSize(Count elements); +static Index ABQNextIndex(ABQ abq, Index index); + + +/* Methods */ + +/* ABQInit -- Initialize an ABQ + * + * items is the number of items the queue can hold + */ +Res ABQInit(Arena arena, ABQ abq, void *owner, Count items) +{ + Count elements; + void *p; + Res res; + + AVERT(Arena, arena); + AVER(abq != NULL); + AVER(items > 0); + + elements = items + 1; + + res = ControlAlloc(&p, arena, ABQQueueSize(elements), + /* withReservoirPermit */ FALSE); + if (res != ResOK) + return res; + + abq->elements = elements; + abq->in = 0; + abq->out = 0; + abq->queue = (CBSBlock *)p; + + METER_INIT(abq->push, "push", owner); + METER_INIT(abq->pop, "pop", owner); + METER_INIT(abq->peek, "peek", owner); + METER_INIT(abq->delete, "delete", owner); + + abq->sig = ABQSig; + + AVERT(ABQ, abq); + return ResOK; +} + + +/* ABQCheck -- validate an ABQ */ +Bool ABQCheck(ABQ abq) +{ + Index index; + + CHECKS(ABQ, abq); + CHECKL(abq->elements > 0); + CHECKL(abq->in < abq->elements); + CHECKL(abq->out < abq->elements); + CHECKL(abq->queue != NULL); + /* Is this really a local check? */ + for (index = abq->out; index != abq->in; ) { + CHECKL(CBSBlockCheck(abq->queue[index])); + if (++index == abq->elements) + index = 0; + } + + return TRUE; +} + + +/* ABQFinish -- finish an ABQ */ +void ABQFinish(Arena arena, ABQ abq) +{ + AVERT(Arena, arena); + AVERT(ABQ, abq); + + METER_EMIT(&abq->push); + METER_EMIT(&abq->pop); + METER_EMIT(&abq->peek); + METER_EMIT(&abq->delete); + ControlFree(arena, abq->queue, ABQQueueSize(abq->elements)); + + abq->elements = 0; + abq->queue = NULL; + + abq->sig = SigInvalid; +} + + +/* ABQPush -- push a block onto the tail of the ABQ */ +Res ABQPush(ABQ abq, CBSBlock block) +{ + AVERT(ABQ, abq); + AVERT(CBSBlock, block); + + METER_ACC(abq->push, ABQDepth(abq)); + + if (ABQIsFull(abq)) + return ResFAIL; + + abq->queue[abq->in] = block; + abq->in = ABQNextIndex(abq, abq->in); + + AVERT(ABQ, abq); + return ResOK; +} + + +/* ABQPop -- pop a block from the head of the ABQ */ +Res ABQPop(ABQ abq, CBSBlock *blockReturn) +{ + AVER(blockReturn != NULL); + AVERT(ABQ, abq); + + METER_ACC(abq->pop, ABQDepth(abq)); + + if (ABQIsEmpty(abq)) + return ResFAIL; + + *blockReturn = abq->queue[abq->out]; + AVERT(CBSBlock, *blockReturn); + + abq->out = ABQNextIndex(abq, abq->out); + + AVERT(ABQ, abq); + return ResOK; +} + + +/* ABQPeek -- peek at the head of the ABQ */ +Res ABQPeek(ABQ abq, CBSBlock *blockReturn) +{ + AVER(blockReturn != NULL); + AVERT(ABQ, abq); + + METER_ACC(abq->peek, ABQDepth(abq)); + + if (ABQIsEmpty(abq)) + return ResFAIL; + + *blockReturn = abq->queue[abq->out]; + AVERT(CBSBlock, *blockReturn); + + /* Identical to pop, but don't increment out */ + + AVERT(ABQ, abq); + return ResOK; +} + + +/* ABQDelete -- delete a block from the ABQ */ +Res ABQDelete(ABQ abq, CBSBlock block) +{ + Index index, next, elements, in; + CBSBlock *queue; + + AVERT(ABQ, abq); + AVERT(CBSBlock, block); + + METER_ACC(abq->delete, ABQDepth(abq)); + + index = abq->out; + in = abq->in; + elements = abq->elements; + queue = abq->queue; + + while (index != in) { + if (queue[index] == block) { + goto found; + } + index = ABQNextIndex(abq, index); + } + + return ResFAIL; + +found: + /* index points to the node to be removed */ + next = ABQNextIndex(abq, index); + while (next != in) { + queue[index] = queue[next]; + index = next; + next = ABQNextIndex(abq, index); + } + abq->in = index; + AVERT(ABQ, abq); + return ResOK; +} + + +/* ABQDescribe -- Describe an ABQ */ +Res ABQDescribe(ABQ abq, mps_lib_FILE *stream) +{ + Res res; + Index index; + + AVERT(ABQ, abq); + + AVER(stream != NULL); + + res = WriteF(stream, + "ABQ $P\n{\n", (WriteFP)abq, + " elements: $U \n", (WriteFU)abq->elements, + " in: $U \n", (WriteFU)abq->in, + " out: $U \n", (WriteFU)abq->out, + " queue: \n", + NULL); + if(res != ResOK) + return res; + + for (index = abq->out; index != abq->in; ) { + res = CBSBlockDescribe(abq->queue[index], stream); + if(res != ResOK) + return res; + if (++index == abq->elements) + index = 0; + } + + res = WriteF(stream, "\n", NULL); + if(res != ResOK) + return res; + + res = METER_WRITE(abq->push, stream); + if(res != ResOK) + return res; + res = METER_WRITE(abq->pop, stream); + if(res != ResOK) + return res; + res = METER_WRITE(abq->peek, stream); + if(res != ResOK) + return res; + res = METER_WRITE(abq->delete, stream); + if(res != ResOK) + return res; + + res = WriteF(stream, "}\n", NULL); + if(res != ResOK) + return res; + + return ResOK; +} + + +/* ABQIsEmpty -- Is an ABQ empty? */ +Bool ABQIsEmpty(ABQ abq) +{ + AVERT(ABQ, abq); + + return abq->out == abq->in; +} + + +/* ABQIsFull -- Is an ABQ full? */ +Bool ABQIsFull(ABQ abq) +{ + AVERT(ABQ, abq); + + return ABQNextIndex(abq, abq->in) == abq->out; +} + + +/* ABQDepth -- return the number of items in an ABQ */ +Count ABQDepth(ABQ abq) +{ + Index out, in; + + AVERT(ABQ, abq); + out = abq->out; + in = abq->in; + + if (in >= out) + return in - out; + else + return in + abq->elements - out; +} + + +/* ABQQueueSize -- calculate the storage required for the vector to + store elements items */ +static Size ABQQueueSize(Count elements) +{ + /* strange but true: the sizeof expression calculates the size of a + single queue element */ + return (Size)(sizeof(((ABQ)NULL)->queue[0]) * elements); +} + + +/* ABQNextIndex -- calculate the next index into the queue vector from + the current one */ +static Index ABQNextIndex(ABQ abq, Index index) +{ + Index next = index + 1; + if (next == abq->elements) + next = 0; + return next; +} diff --git a/mps/code/abq.h b/mps/code/abq.h new file mode 100644 index 00000000000..00fa5f69c7a --- /dev/null +++ b/mps/code/abq.h @@ -0,0 +1,59 @@ +/* impl.h.abq: ABQ INTERFACE + * + * $HopeName: MMsrc!abq.h(trunk.3) $ + * Copyright (C) 1998 Harlequin Group plc. All rights reserved. + * + * .purpose: A FIFO queue substrate for impl.c.poolmv2 + * + * .source: design.mps.poolmv2 + */ + +#ifndef abq_h +#define abq_h + +#include "meter.h" +#include "cbs.h" +#include "mpm.h" + + +/* Signatures */ + +#define ABQSig ((Sig)0x519AB099) /* SIGnature ABQ */ + + +/* Prototypes */ + +typedef struct ABQStruct *ABQ; +extern Res ABQInit(Arena arena, ABQ abq, void *owner, Count items); +extern Bool ABQCheck(ABQ abq); +extern void ABQFinish(Arena arena, ABQ abq); +extern Res ABQPush(ABQ abq, CBSBlock block); +extern Res ABQPop(ABQ abq, CBSBlock *blockReturn); +extern Res ABQPeek(ABQ abq, CBSBlock *blockReturn); +extern Res ABQDelete(ABQ abq, CBSBlock block); +extern Res ABQDescribe(ABQ abq, mps_lib_FILE *stream); +extern Bool ABQIsEmpty(ABQ abq); +extern Bool ABQIsFull(ABQ abq); +extern Count ABQDepth(ABQ abq); + + +/* Types */ + +typedef struct ABQStruct +{ + Count elements; + Index in; + Index out; + CBSBlock *queue; + + /* Meter queue depth at each operation */ + METER_DECL(push); + METER_DECL(pop); + METER_DECL(peek); + METER_DECL(delete); + + Sig sig; +} ABQStruct; + +#endif /* abq_h */ + diff --git a/mps/code/abqtest.c b/mps/code/abqtest.c new file mode 100644 index 00000000000..85efaa76bf6 --- /dev/null +++ b/mps/code/abqtest.c @@ -0,0 +1,177 @@ +/* impl.c.abqtest: AVAILABLE BLOCK QUEUE TEST + * + * $HopeName: MMsrc!abqtest.c(trunk.5) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#include "abq.h" +#include "cbs.h" +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "testlib.h" +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include +#include + + +SRCID(abqtest, "$HopeName: MMsrc!abqtest.c(trunk.5) $"); + + +static ABQStruct abq; /* the ABQ which we will use */ +static Size abqSize; /* the size of the current ABQ */ + +#define ABQ_SIZE 10 +#define TEST_ITER 10000 + + +static unsigned long abqRnd(unsigned long n) +{ + return rnd()%n; +} + + +static int pushee = 1; +static int popee = 1; +static int deleted = 0; + + +typedef struct TestStruct *Test; + +typedef struct TestStruct +{ + Test next; + int id; + CBSBlockStruct cbsBlockStruct; +} TestStruct; + + +static CBSBlock TestCBSBlock(Test t) +{ + return &t->cbsBlockStruct; +} + +static Test CBSBlockTest(CBSBlock c) +{ + return PARENT(TestStruct, cbsBlockStruct, c); +} + + +static Test testBlocks = NULL; + + +static CBSBlock CreateCBSBlock(int no) +{ + Test b = malloc(sizeof(TestStruct)); + cdie(b != NULL, "malloc"); + + b->next = testBlocks; + b->id = no; + b->cbsBlockStruct.base = 0; + b->cbsBlockStruct.limit = 0; + + testBlocks = b; + + return TestCBSBlock(b); +} + + +static void DestroyCBSBlock(CBSBlock c) +{ + Test b = CBSBlockTest(c); + + if (b == testBlocks) + testBlocks = b->next; + else { + Test prev; + + for (prev = testBlocks; prev != 0; prev = prev->next) + if (prev->next == b) { + prev->next = b->next; + break; + } + } + + free(b); +} + + +static void step(void) +{ + Res res; + CBSBlock a; + + switch (abqRnd(9)) { + case 0: case 1: case 2: case 3: + push: + res = ABQPush(&abq, CreateCBSBlock(pushee)); + if (res != ResOK) { + goto pop; + } + pushee++; + break; + case 5: case 6: case 7: case 8: + pop: + res = ABQPop(&abq, &a); + if (res != ResOK){ + goto push; + } + if (popee == deleted) { + popee++; + deleted = 0; + } + cdie(CBSBlockTest(a)->id == popee, "pop"); + popee++; + DestroyCBSBlock(a); + break; + default: + if (!deleted & (pushee > popee)) { + Test b; + + deleted = abqRnd (pushee - popee) + popee; + for (b = testBlocks; b != NULL; b = b->next) + if (b->id == deleted) + break; + cdie(b != NULL, "found to delete"); + res = ABQDelete(&abq, TestCBSBlock(b)); + cdie(res == ResOK, "ABQDelete"); + } + } +} + + +#define testArenaSIZE (((size_t)4)<<20) + +extern int main(int argc, char *argv[]) +{ + Res res; + mps_arena_t arena; + int i; + + randomize(argc, argv); + + abqSize = 0; + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + + res = ABQInit((Arena)arena, &abq, NULL, ABQ_SIZE); + if (res == ResOK) { + abqSize = ABQ_SIZE; + } else { + printf("ABQCreate returned %d\n",res); + return 1; + } + + for (i = 0; i < TEST_ITER; i++) { + step(); + } + + printf("All tests passed.\n"); + return 0; +} diff --git a/mps/code/action.c b/mps/code/action.c new file mode 100644 index 00000000000..f7f8d79a7d6 --- /dev/null +++ b/mps/code/action.c @@ -0,0 +1,12 @@ +/* impl.c.action: STRATEGIC ACTION + * + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * $HopeName: MMsrc!action.c(trunk.6) $ + */ + +#include "mpm.h" + +SRCID(action, "$HopeName: MMsrc!action.c(trunk.6) $"); + + +/* All contents obsolete. */ diff --git a/mps/code/amcss.c b/mps/code/amcss.c new file mode 100644 index 00000000000..29ab71d2a5a --- /dev/null +++ b/mps/code/amcss.c @@ -0,0 +1,227 @@ +/* impl.c.amcss: POOL CLASS AMC STRESS TEST + * + * $HopeName: MMsrc!amcss.c(trunk.36) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + */ + +#include "fmtdy.h" +#include "testlib.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include + + +/* These values have been tuned to cause one top-generation collection. */ +#define testArenaSIZE ((size_t)1000*1024) +#define avLEN 3 +#define exactRootsCOUNT 200 +#define ambigRootsCOUNT 50 +#define genCOUNT 2 +#define collectionsCOUNT 37 +#define rampSIZE 9 +#define initTestFREQ 6000 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) + +static mps_pool_t pool; +static mps_ap_t ap; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; + + +static mps_addr_t make(void) +{ + size_t length = rnd() % (2*avLEN); + size_t size = (length+2) * sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size); + if(res) + die(res, "MPS_RESERVE_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if(res) + die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + return p; +} + + +static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pol, + void *p, size_t s) +{ + testlib_unused(object); testlib_unused(fmt); testlib_unused(pol); + testlib_unused(s); + (*(unsigned long *)p)++; +} + + +/* test -- the body of the test */ + +static void *test(void *arg, size_t s) +{ + mps_arena_t arena; + mps_fmt_t format; + mps_chain_t chain; + mps_root_t exactRoot, ambigRoot; + unsigned long objs; size_t i; + mps_word_t collections, rampSwitch; + mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp(); + int ramping; + mps_ap_t busy_ap; + mps_addr_t busy_init; + + arena = (mps_arena_t)arg; + (void)s; /* unused */ + + die(dylan_fmt(&format, arena), "fmt_create"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + + die(mps_pool_create(&pool, arena, mps_class_amc(), format, chain), + "pool_create(amc)"); + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2"); + + for(i = 0; i < exactRootsCOUNT; ++i) + exactRoots[i] = objNULL; + for(i = 0; i < ambigRootsCOUNT; ++i) + ambigRoots[i] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); + + /* create an ap, and leave it busy */ + die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + + collections = 0; + rampSwitch = rampSIZE; + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + objs = 0; + while(collections < collectionsCOUNT) { + unsigned long c; + size_t r; + + c = mps_collections(arena); + + if(collections != c) { + collections = c; + printf("\nCollection %lu, %lu objects.\n", + c, objs); + for(r = 0; r < exactRootsCOUNT; ++r) + cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]), + "all roots check"); + if(collections == collectionsCOUNT / 2) { + unsigned long object_count = 0; + mps_arena_park(arena); + mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0); + mps_arena_release(arena); + printf("stepped on %lu objects.\n", object_count); + } + if(collections == rampSwitch) { + rampSwitch += rampSIZE; + if(ramping) { + mps_ap_alloc_pattern_end(ap, ramp); + mps_ap_alloc_pattern_end(busy_ap, ramp); + /* kill half of the roots */ + for(i = 0; i < exactRootsCOUNT; i += 2) { + if(exactRoots[i] != objNULL) { + cdie(dylan_check(exactRoots[i]), "ramp kill check"); + exactRoots[i] = objNULL; + } + } + /* Every other time, switch back immediately. */ + if(collections & 1) ramping = 0; + } + if(!ramping) { + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + } + } + } + + r = (size_t)rnd(); + if(r & 1) { + i = (r >> 1) % exactRootsCOUNT; + if(exactRoots[i] != objNULL) + cdie(dylan_check(exactRoots[i]), "dying root check"); + exactRoots[i] = make(); + if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL) + dylan_write(exactRoots[(exactRootsCOUNT-1) - i], + exactRoots, exactRootsCOUNT); + } else { + i = (r >> 1) % ambigRootsCOUNT; + ambigRoots[(ambigRootsCOUNT-1) - i] = make(); + /* Create random interior pointers */ + ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1); + } + + if(r % initTestFREQ == 0) + *(int*)busy_init = -1; /* check that the buffer is still there */ + + if(objs % 1024 == 0) { + putchar('.'); + fflush(stdout); + } + + ++objs; + } + + (void)mps_commit(busy_ap, busy_init, 64); + mps_ap_destroy(busy_ap); + mps_ap_destroy(ap); + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_pool_destroy(pool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE), + "arena_create"); + die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/amcsshe.c b/mps/code/amcsshe.c new file mode 100644 index 00000000000..778ce7c1710 --- /dev/null +++ b/mps/code/amcsshe.c @@ -0,0 +1,323 @@ +/* impl.c.amcsshe: POOL CLASS AMC STRESS TEST WITH HEADER + * + * $HopeName: MMsrc!amcsshe.c(trunk.4) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + */ + +#include "fmthe.h" +#include "testlib.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include + + +/* These values have been tuned to cause one top-generation collection. */ +#define testArenaSIZE ((size_t)1000*1024) +#define avLEN 3 +#define exactRootsCOUNT 200 +#define ambigRootsCOUNT 50 +#define bogusRootsCOUNT 4096 +#define collectionsCOUNT 37 +#define rampSIZE 9 +#define initTestFREQ 6000 +#define genCOUNT 2 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) + + +static mps_pool_t pool; +static mps_ap_t ap; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; +static mps_addr_t bogusRoots[bogusRootsCOUNT]; + + + +static mps_word_t *ww = NULL; +static mps_word_t *tvw; + + +static mps_word_t dylan_make_WV(mps_word_t version, mps_word_t vb, + mps_word_t es, mps_word_t vf) +{ + /* VERSION- ... VB------ reserved ES---VF- */ + return((version << (MPS_WORD_WIDTH - 8)) | + (vb << 16) | + (es << 3) | + vf); +} + + +static mps_res_t init(mps_addr_t addr, size_t size, + mps_addr_t *refs, size_t nr_refs) +{ + + /* Make sure the size is aligned. */ + if ((size & (ALIGN-1)) != 0) return MPS_RES_PARAM; + + if (ww == NULL) { + ww = malloc(sizeof(mps_word_t) * (BASIC_WRAPPER_SIZE + 1)); + if (ww == NULL) return MPS_RES_MEMORY; + tvw = malloc(sizeof(mps_word_t) * BASIC_WRAPPER_SIZE); + if (tvw == NULL) { + free(ww); + return MPS_RES_MEMORY; + } + + /* Build a wrapper wrapper. */ + ww[WW] = (mps_word_t)ww; + ww[WC] = (mps_word_t)ww; /* dummy class */ + ww[WM] = (1 << 2) | 1; /* dummy subtype_mask */ + ww[WF] = ((WS - 1) << 2) | 2; + ww[WV] = dylan_make_WV(2, 0, 0, 0); + ww[WS] = (1 << 2) | 1; + ww[WP] = 1; + + /* Build a wrapper for traceable vectors. */ + tvw[WW] = (mps_word_t)ww; + tvw[WC] = (mps_word_t)ww; /* dummy class */ + tvw[WM] = (1 << 2) | 1; /* dummy subtype_mask */ + tvw[WF] = 0; /* no fixed part */ + tvw[WV] = dylan_make_WV(2, 0, 0, 2); /* traceable variable part */ + tvw[WS] = 1; /* no patterns */ + } + + /* If there is enough room, make a vector, otherwise just */ + /* make a padding object. */ + + if (size >= sizeof(mps_word_t) * 2) { + mps_word_t *p = (mps_word_t *)addr; + mps_word_t i, t = (size / sizeof(mps_word_t)) - 2; + + p[0] = (mps_word_t)tvw; /* install vector wrapper */ + p[1] = (t << 2) | 1; /* tag the vector length */ + for(i = 0; i < t; ++i) { + mps_word_t r = rnd(); + + if (r & 1) + p[2+i] = ((r & ~(mps_word_t)3) | 1); /* random int */ + else + p[2+i] = (mps_word_t)refs[(r >> 1) % nr_refs]; /* random ptr */ + } + } else { + die(MPS_RES_FAIL, "small object"); + } + + return MPS_RES_OK; +} + + +static void dylan_write(mps_addr_t addr, mps_addr_t *refs, size_t nr_refs) +{ + mps_word_t *p = (mps_word_t *)addr; + mps_word_t t = p[1] >> 2; + + /* If the object is a vector, update a random entry. */ + if (p[0] == (mps_word_t)tvw && t > 0) { + mps_word_t r = rnd(); + size_t i = 2 + (rnd() % t); + + if (r & 1) + p[i] = ((r & ~(mps_word_t)3) | 1); /* random int */ + else + p[i] = (mps_word_t)refs[(r >> 1) % nr_refs]; /* random ptr */ + } +} + + +static mps_addr_t make(void) +{ + size_t length = rnd() % (2*avLEN); + size_t size = (length+2) * sizeof(mps_word_t); + mps_addr_t p, userP; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size + headerSIZE); + if (res) + die(res, "MPS_RESERVE_BLOCK"); + userP = (mps_addr_t)((char*)p + headerSIZE); + res = init(userP, size, exactRoots, exactRootsCOUNT); + if (res) + die(res, "dylan_init"); + ((int*)p)[0] = realTYPE; + ((int*)p)[1] = 0xED0ED; + } while(!mps_commit(ap, p, size + headerSIZE)); + + return userP; +} + + +/* test -- the body of the test */ + +static void *test(void *arg, size_t s) +{ + mps_arena_t arena; + mps_fmt_t format; + mps_chain_t chain; + mps_root_t exactRoot, ambigRoot, bogusRoot; + unsigned long objs; size_t i; + mps_word_t collections, rampSwitch; + mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp(); + int ramping; + mps_ap_t busy_ap; + mps_addr_t busy_init; + + arena = (mps_arena_t)arg; + (void)s; /* unused */ + + die(EnsureHeaderFormat(&format, arena), "fmt_create"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + + die(mps_pool_create(&pool, arena, mps_class_amc(), format, chain), + "pool_create(amc)"); + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2"); + + for(i = 0; i < exactRootsCOUNT; ++i) + exactRoots[i] = objNULL; + for(i = 0; i < ambigRootsCOUNT; ++i) + ambigRoots[i] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); + die(mps_root_create_table(&bogusRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &bogusRoots[0], bogusRootsCOUNT), + "root_create_table(bogus)"); + + /* create an ap, and leave it busy */ + die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + + collections = 0; + rampSwitch = rampSIZE; + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + objs = 0; + while(collections < collectionsCOUNT) { + unsigned long c; + size_t r; + + c = mps_collections(arena); + + if (collections != c) { + collections = c; + printf("\nCollection %lu, %lu objects.\n", c, objs); + for(r = 0; r < exactRootsCOUNT; ++r) { + if (exactRoots[r] != objNULL) + die(HeaderFormatCheck(exactRoots[r]), "wrapper check"); + } + if (collections == rampSwitch) { + rampSwitch += rampSIZE; + if (ramping) { + mps_ap_alloc_pattern_end(ap, ramp); + mps_ap_alloc_pattern_end(busy_ap, ramp); + /* kill half of the roots */ + for(i = 0; i < exactRootsCOUNT; i += 2) { + if (exactRoots[i] != objNULL) { + die(HeaderFormatCheck(exactRoots[i]), "ramp kill check"); + exactRoots[i] = objNULL; + } + } + /* Every other time, switch back immediately. */ + if (collections & 1) ramping = 0; + } + if (!ramping) { + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + } + } + /* fill bogusRoots with variations of a real pointer */ + r = rnd() % exactRootsCOUNT; + if (exactRoots[i] != objNULL) { + char *p = (char*)exactRoots[i]; + + for(i = 0; i < bogusRootsCOUNT; ++i, ++p) + bogusRoots[i] = (mps_addr_t)p; + } + } + + r = (size_t)rnd(); + if (r & 1) { + i = (r >> 1) % exactRootsCOUNT; + if (exactRoots[i] != objNULL) + die(HeaderFormatCheck(exactRoots[i]), "wrapper check"); + exactRoots[i] = make(); + if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL) + dylan_write(exactRoots[(exactRootsCOUNT-1) - i], + exactRoots, exactRootsCOUNT); + } else { + i = (r >> 1) % ambigRootsCOUNT; + ambigRoots[(ambigRootsCOUNT-1) - i] = make(); + /* Create random interior pointers */ + ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1); + } + + if (r % initTestFREQ == 0) + *(int*)busy_init = -1; /* check that the buffer is still there */ + + if (objs % 1024 == 0) { + putchar('.'); + fflush(stdout); + } + + ++objs; + } + + (void)mps_commit(busy_ap, busy_init, 64); + mps_ap_destroy(busy_ap); + mps_ap_destroy(ap); + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_root_destroy(bogusRoot); + mps_pool_destroy(pool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), 3*testArenaSIZE), + "arena_create\n"); + die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c new file mode 100644 index 00000000000..4d54f6f69cd --- /dev/null +++ b/mps/code/amcssth.c @@ -0,0 +1,298 @@ +/* impl.c.amcssth: POOL CLASS AMC STRESS TEST WITH TWO THREADS + * + * $HopeName: MMsrc!amcssth.c(trunk.3) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .posix: This is Posix only. + */ + +#define _POSIX_C_SOURCE 199309L + +#include "fmtdy.h" +#include "testlib.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include +#include +#include + + +/* These values have been tuned to cause one top-generation collection. */ +#define testArenaSIZE ((size_t)1000*1024) +#define avLEN 3 +#define exactRootsCOUNT 200 +#define ambigRootsCOUNT 50 +#define genCOUNT 2 +#define collectionsCOUNT 37 +#define rampSIZE 9 +#define initTestFREQ 6000 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) + + +static mps_pool_t pool; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; + +mps_arena_t arena; +mps_fmt_t format; +mps_chain_t chain; +mps_root_t exactRoot, ambigRoot; +unsigned long objs = 0; + + +static mps_addr_t make(mps_ap_t ap) +{ + size_t length = rnd() % (2*avLEN); + size_t size = (length+2) * sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size); + if (res) + die(res, "MPS_RESERVE_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if (res) + die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + return p; +} + + +static void test_stepper(mps_addr_t object, void *p, size_t s) +{ + (*(unsigned long *)p)++; + testlib_unused(s); + testlib_unused(object); +} + + +/* init -- initialize pool and roots */ + +static void init(void) +{ + size_t i; + + die(dylan_fmt(&format, arena), "fmt_create"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + + die(mps_pool_create(&pool, arena, mps_class_amc(), format, chain), + "pool_create(amc)"); + + for(i = 0; i < exactRootsCOUNT; ++i) + exactRoots[i] = objNULL; + for(i = 0; i < ambigRootsCOUNT; ++i) + ambigRoots[i] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); +} + + +/* finish -- finish pool and roots */ + +static void finish(void) +{ + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_pool_destroy(pool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); +} + + +/* churn -- create an object and install into roots */ + +static void churn(mps_ap_t ap) +{ + size_t i; + size_t r; + + ++objs; + r = (size_t)rnd(); + if (r & 1) { + i = (r >> 1) % exactRootsCOUNT; + if (exactRoots[i] != objNULL) + cdie(dylan_check(exactRoots[i]), "dying root check"); + exactRoots[i] = make(ap); + if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL) + dylan_write(exactRoots[(exactRootsCOUNT-1) - i], + exactRoots, exactRootsCOUNT); + } else { + i = (r >> 1) % ambigRootsCOUNT; + ambigRoots[(ambigRootsCOUNT-1) - i] = make(ap); + /* Create random interior pointers */ + ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1); + } +} + + +/* test -- the body of the test */ + +static void *test(void *arg, size_t s) +{ + size_t i; + mps_word_t collections, rampSwitch; + mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp(); + int ramping; + mps_ap_t ap, busy_ap; + mps_addr_t busy_init; + + arena = (mps_arena_t)arg; + (void)s; /* unused */ + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2"); + + /* create an ap, and leave it busy */ + die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + + collections = 0; + rampSwitch = rampSIZE; + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + while(collections < collectionsCOUNT) { + unsigned long c; + size_t r; + + c = mps_collections(arena); + + if (collections != c) { + collections = c; + printf("\nCollection %lu, %lu objects.\n", + c, objs); + for(r = 0; r < exactRootsCOUNT; ++r) + cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]), + "all roots check"); + if (collections == collectionsCOUNT / 2) { + unsigned long object_count = 0; + mps_arena_park(arena); + mps_amc_apply(pool, test_stepper, &object_count, 0); + mps_arena_release(arena); + printf("mps_amc_apply stepped on %lu objects.\n", object_count); + } + if (collections == rampSwitch) { + rampSwitch += rampSIZE; + if (ramping) { + mps_ap_alloc_pattern_end(ap, ramp); + mps_ap_alloc_pattern_end(busy_ap, ramp); + /* kill half of the roots */ + for(i = 0; i < exactRootsCOUNT; i += 2) { + if (exactRoots[i] != objNULL) { + cdie(dylan_check(exactRoots[i]), "ramp kill check"); + exactRoots[i] = objNULL; + } + } + /* Every other time, switch back immediately. */ + if (collections & 1) ramping = 0; + } + if (!ramping) { + mps_ap_alloc_pattern_begin(ap, ramp); + mps_ap_alloc_pattern_begin(busy_ap, ramp); + ramping = 1; + } + } + } + + churn(ap); + + if (r % initTestFREQ == 0) + *(int*)busy_init = -1; /* check that the buffer is still there */ + + if (objs % 1024 == 0) { + putchar('.'); + fflush(stdout); + } + } + + (void)mps_commit(busy_ap, busy_init, 64); + mps_ap_destroy(busy_ap); + mps_ap_destroy(ap); + + return NULL; +} + + +static void *fooey2(void *arg, size_t s) +{ + mps_ap_t ap; + + (void)arg; (void)s; /* unused */ + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate(fooey)"); + while(mps_collections(arena) < collectionsCOUNT) { + churn(ap); + } + mps_ap_destroy(ap); + return NULL; +} + + +static void *fooey(void* childIsFinishedReturn) +{ + void *r; + mps_thr_t thread; + mps_thr_t thread2; + + /* register the thread twice, just to make sure it works */ + die(mps_thread_reg(&thread, (mps_arena_t)arena), "thread_reg"); + die(mps_thread_reg(&thread2, (mps_arena_t)arena), "thread2_reg"); + mps_tramp(&r, fooey2, NULL, 0); + mps_thread_dereg(thread); + mps_thread_dereg(thread2); + *(int *)childIsFinishedReturn = 1; + return r; +} + + +int main(int argc, char **argv) +{ + mps_thr_t thread; + pthread_t pthread1; + void *r; + int childIsFinished = 0; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create"); + init(); + die(mps_thread_reg(&thread, arena), "thread_reg"); + pthread_create(&pthread1, NULL, fooey, (void *)&childIsFinished); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + + while (!childIsFinished) { + struct timespec req = {1, 0}; + (void)nanosleep(&req, NULL); + } + + finish(); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/amsss.c b/mps/code/amsss.c new file mode 100644 index 00000000000..9a3f6ff7072 --- /dev/null +++ b/mps/code/amsss.c @@ -0,0 +1,174 @@ +/* impl.c.amsss: POOL CLASS AMS STRESS TEST + * + * $HopeName: MMsrc!amsss.c(trunk.11) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .design: Adapted from amcss.c, but not counting collections, just + * total size of objects allocated (because epoch doesn't increment + * when AMS is collected). + */ + +#include "fmtdy.h" +#include "testlib.h" +#include "mpscams.h" +#include "mpsavm.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include +#include +#include + + +#define exactRootsCOUNT 50 +#define ambigRootsCOUNT 100 +/* This is enough for three GCs. */ +#define totalSizeMAX 800 * (size_t)1024 +#define totalSizeSTEP 200 * (size_t)1024 +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) +#define testArenaSIZE ((size_t)16<<20) +#define initTestFREQ 6000 +static mps_gen_param_s testChain[1] = { { 160, 0.90 } }; + + +static mps_pool_t pool; +static mps_ap_t ap; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; +static size_t totalSize = 0; + + +static mps_addr_t make(void) +{ + size_t length = rnd() % 20, size = (length+2) * sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size); + if(res) + die(res, "MPS_RESERVE_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if(res) + die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + totalSize += size; + return p; +} + + +static void *test(void *arg, size_t s) +{ + mps_arena_t arena; + mps_fmt_t format; + mps_chain_t chain; + mps_root_t exactRoot, ambigRoot; + size_t lastStep = 0, i, r; + unsigned long objs; + mps_ap_t busy_ap; + mps_addr_t busy_init; + + arena = (mps_arena_t)arg; + (void)s; /* unused */ + + die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create"); + die(mps_chain_create(&chain, arena, 1, testChain), "chain_create"); + die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain), + "pool_create(ams)"); + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2"); + + for(i = 0; i < exactRootsCOUNT; ++i) + exactRoots[i] = objNULL; + for(i = 0; i < ambigRootsCOUNT; ++i) + ambigRoots[i] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); + + /* create an ap, and leave it busy */ + die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + + objs = 0; + while(totalSize < totalSizeMAX) { + if(totalSize > lastStep + totalSizeSTEP) { + lastStep = totalSize; + printf("\nSize %lu bytes, %lu objects.\n", + (unsigned long)totalSize, objs); + fflush(stdout); + for(i = 0; i < exactRootsCOUNT; ++i) + cdie(exactRoots[i] == objNULL || dylan_check(exactRoots[i]), + "all roots check"); + } + + r = (size_t)rnd(); + if(r & 1) { + i = (r >> 1) % exactRootsCOUNT; + if(exactRoots[i] != objNULL) + cdie(dylan_check(exactRoots[i]), "dying root check"); + exactRoots[i] = make(); + if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL) + dylan_write(exactRoots[(exactRootsCOUNT-1) - i], + exactRoots, exactRootsCOUNT); + } else { + i = (r >> 1) % ambigRootsCOUNT; + ambigRoots[(ambigRootsCOUNT-1) - i] = make(); + /* Create random interior pointers */ + ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1); + } + + if(rnd() % initTestFREQ == 0) + *(int*)busy_init = -1; /* check that the buffer is still there */ + + ++objs; + if (objs % 256 == 0) { + printf("."); + fflush(stdout); + } + } + + (void)mps_commit(busy_ap, busy_init, 64); + mps_ap_destroy(busy_ap); + mps_ap_destroy(ap); + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_pool_destroy(pool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/apss.c b/mps/code/apss.c new file mode 100644 index 00000000000..44c5c3503d4 --- /dev/null +++ b/mps/code/apss.c @@ -0,0 +1,162 @@ +/* impl.c.apss: AP MANUAL ALLOC STRESS TEST + * + * $HopeName$ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + */ + + +#include "mpscmv.h" +#include "mpscmvff.h" +#include "mpslib.h" +#include "mpsavm.h" + +#include "testlib.h" + +#include +#include + + +#define testArenaSIZE ((((size_t)3)<<24) - 4) +#define testSetSIZE 200 +#define testLOOPS 10 + + +static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) +{ + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, *p, ap, size); + if(res != MPS_RES_OK) + return res; + } while(!mps_commit(ap, *p, size)); + + return MPS_RES_OK; +} + + +static mps_res_t stress(mps_class_t class, mps_arena_t arena, + size_t (*size)(int i), ...) +{ + mps_res_t res = MPS_RES_OK; + mps_pool_t pool; + mps_ap_t ap; + va_list arg; + int i, k; + int *ps[testSetSIZE]; + size_t ss[testSetSIZE]; + + va_start(arg, size); + res = mps_pool_create_v(&pool, arena, class, arg); + va_end(arg); + if (res != MPS_RES_OK) + return res; + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + + /* allocate a load of objects */ + for (i=0; i= sizeof(ps[i])) + *ps[i] = 1; /* Write something, so it gets swap. */ + } + + mps_pool_check_fenceposts(pool); + + for (k=0; k (b)) ? (a) : (b)) + +#define alignUp(w, a) (((w) + (a) - 1) & ~((size_t)(a) - 1)) + +static size_t randomSize8(int i) +{ + size_t maxSize = 2 * 160 * 0x2000; + /* Reduce by a factor of 2 every 10 cycles. Total allocation about 40 MB. */ + return alignUp(rnd() % max((maxSize >> (i / 10)), 2) + 1, 8); +} + + +static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 }; + +static void testInArena(mps_arena_t arena) +{ + mps_res_t res; + + printf("MVFF\n\n"); + res = stress(mps_class_mvff(), arena, randomSize8, + (size_t)65536, (size_t)32, (size_t)4, TRUE, TRUE, TRUE); + if (res == MPS_RES_COMMIT_LIMIT) return; + die(res, "stress MVFF"); + printf("MV debug\n\n"); + res = stress(mps_class_mv_debug(), arena, randomSize8, + &debugOptions, (size_t)65536, (size_t)32, (size_t)65536); + if (res == MPS_RES_COMMIT_LIMIT) return; + die(res, "stress MV debug"); + printf("MV\n\n"); + res = stress(mps_class_mv(), arena, randomSize8, + (size_t)65536, (size_t)32, (size_t)65536); + if (res == MPS_RES_COMMIT_LIMIT) return; + die(res, "stress MV"); +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE), + "mps_arena_create"); + mps_arena_commit_limit_set(arena, testArenaSIZE); + testInArena(arena); + mps_arena_destroy(arena); + + die(mps_arena_create(&arena, mps_arena_class_vmnz(), 2*testArenaSIZE), + "mps_arena_create"); + testInArena(arena); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/arena.c b/mps/code/arena.c new file mode 100644 index 00000000000..c0bb7888524 --- /dev/null +++ b/mps/code/arena.c @@ -0,0 +1,649 @@ +/* impl.c.arena: ARENA ALLOCATION FEATURES + * + * $HopeName: MMsrc!arena.c(trunk.79) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .sources: design.mps.arena is the main design document. */ + +#include "tract.h" +#include "poolmv.h" +#include "mpm.h" + +SRCID(arena, "$HopeName: MMsrc!arena.c(trunk.79) $"); + + +/* ArenaControlPool -- get the control pool */ + +#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct) + + +/* ArenaTrivDescribe -- produce trivial description of an arena */ + +static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream) +{ + if (!CHECKT(Arena, arena)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + return WriteF(stream, + " No class-specific description available.\n", NULL); +} + + +/* AbstractArenaClass -- The abstact arena class definition + * + * .null: Most abstract class methods are set to NULL. See + * design.mps.arena.class.abstract.null. */ + +typedef ArenaClassStruct AbstractArenaClassStruct; + +DEFINE_CLASS(AbstractArenaClass, class) +{ + INHERIT_CLASS(&class->protocol, ProtocolClass); + class->name = "ABSARENA"; + class->size = 0; + class->offset = 0; + class->init = NULL; + class->finish = NULL; + class->reserved = NULL; + class->spareCommitExceeded = ArenaNoSpareCommitExceeded; + class->extend = ArenaNoExtend; + class->alloc = NULL; + class->free = NULL; + class->chunkInit = NULL; + class->chunkFinish = NULL; + class->describe = ArenaTrivDescribe; + class->sig = ArenaClassSig; +} + + +/* ArenaClassCheck -- check the consistency of an arena class */ + +Bool ArenaClassCheck(ArenaClass class) +{ + CHECKL(ProtocolClassCheck(&class->protocol)); + CHECKL(class->name != NULL); /* Should be <=6 char C identifier */ + CHECKL(class->size >= sizeof(ArenaStruct)); + /* Offset of generic Pool within class-specific instance cannot be */ + /* greater than the size of the class-specific portion of the */ + /* instance. */ + CHECKL(class->offset <= (size_t)(class->size - sizeof(ArenaStruct))); + CHECKL(FUNCHECK(class->init)); + CHECKL(FUNCHECK(class->finish)); + CHECKL(FUNCHECK(class->reserved)); + CHECKL(FUNCHECK(class->spareCommitExceeded)); + CHECKL(FUNCHECK(class->extend)); + CHECKL(FUNCHECK(class->alloc)); + CHECKL(FUNCHECK(class->free)); + CHECKL(FUNCHECK(class->chunkInit)); + CHECKL(FUNCHECK(class->chunkFinish)); + CHECKL(FUNCHECK(class->describe)); + CHECKS(ArenaClass, class); + return TRUE; +} + + +/* ArenaCheck -- check the arena */ + +Bool ArenaCheck(Arena arena) +{ + CHECKS(Arena, arena); + CHECKD(Globals, ArenaGlobals(arena)); + CHECKD(ArenaClass, arena->class); + + CHECKL(BoolCheck(arena->poolReady)); + if (arena->poolReady) { /* design.mps.arena.pool.ready */ + CHECKD(MV, &arena->controlPoolStruct); + CHECKD(Reservoir, &arena->reservoirStruct); + } + /* Can't check that limit>=size because we may call ArenaCheck */ + /* while the size is being adjusted. */ + + CHECKL(arena->committed <= arena->commitLimit); + CHECKL(arena->spareCommitted <= arena->committed); + CHECKL(arena->spareCommitted <= arena->spareCommitLimit); + + CHECKL(ShiftCheck(arena->zoneShift)); + CHECKL(AlignCheck(arena->alignment)); + /* Tract allocation must be platform-aligned. */ + CHECKL(arena->alignment >= MPS_PF_ALIGN); + /* Stripes can't be smaller than pages. */ + CHECKL(((Size)1 << arena->zoneShift) >= arena->alignment); + + if (arena->lastTract == NULL) { + CHECKL(arena->lastTractBase == (Addr)0); + } else { + CHECKL(TractBase(arena->lastTract) == arena->lastTractBase); + } + + if (arena->primary != NULL) { + CHECKD(Chunk, arena->primary); + } + CHECKL(RingCheck(&arena->chunkRing)); + /* nothing to check for chunkSerial */ + CHECKD(ChunkCacheEntry, &arena->chunkCache); + + CHECKL(LocusCheck(arena)); + + return TRUE; +} + + +/* ArenaInit -- initialize the generic part of the arena + * + * .init.caller: Unlike PoolInit, this is called by the class init + * methods, not the generic Create. This is because the class is + * responsible for allocating the descriptor. */ + +Res ArenaInit(Arena arena, ArenaClass class) +{ + Res res; + + /* We do not check the arena argument, because it's _supposed_ to */ + /* point to an uninitialized block of memory. */ + AVERT(ArenaClass, class); + + arena->class = class; + + arena->committed = (Size)0; + /* commitLimit may be overridden by init (but probably not */ + /* as there's not much point) */ + arena->commitLimit = (Size)-1; + arena->spareCommitted = (Size)0; + arena->spareCommitLimit = ARENA_INIT_SPARE_COMMIT_LIMIT; + /* alignment is usually overridden by init */ + arena->alignment = 1 << ARENA_ZONESHIFT; + /* zoneShift is usually overridden by init */ + arena->zoneShift = ARENA_ZONESHIFT; + arena->poolReady = FALSE; /* design.mps.arena.pool.ready */ + arena->lastTract = NULL; + arena->lastTractBase = NULL; + + arena->primary = NULL; + RingInit(&arena->chunkRing); + arena->chunkSerial = (Serial)0; + ChunkCacheEntryInit(&arena->chunkCache); + + LocusInit(arena); + + res = GlobalsInit(ArenaGlobals(arena)); + if (res != ResOK) + goto failGlobalsInit; + + arena->sig = ArenaSig; + + /* initialize the reservoir, design.mps.reservoir */ + res = ReservoirInit(&arena->reservoirStruct, arena); + if (res != ResOK) + goto failReservoirInit; + + AVERT(Arena, arena); + return ResOK; + +failReservoirInit: + GlobalsFinish(ArenaGlobals(arena)); +failGlobalsInit: + return res; +} + + +/* ArenaCreateV -- create the arena and call initializers */ + +Res ArenaCreateV(Arena *arenaReturn, ArenaClass class, va_list args) +{ + Arena arena; + Res res; + + AVER(arenaReturn != NULL); + AVERT(ArenaClass, class); + + /* Do initialization. This will call ArenaInit (see .init.caller). */ + res = (*class->init)(&arena, class, args); + if (res != ResOK) + goto failInit; + + arena->alignment = ChunkPageSize(arena->primary); + if (arena->alignment > ((Size)1 << arena->zoneShift)) { + res = ResMEMORY; /* size was too small */ + goto failStripeSize; + } + + /* load cache */ + ChunkEncache(arena, arena->primary); + + res = ControlInit(arena); + if (res != ResOK) + goto failControlInit; + + res = GlobalsCompleteCreate(ArenaGlobals(arena)); + if (res != ResOK) + goto failGlobalsCompleteCreate; + + AVERT(Arena, arena); + *arenaReturn = arena; + return ResOK; + +failGlobalsCompleteCreate: + ControlFinish(arena); +failControlInit: +failStripeSize: + (*class->finish)(arena); +failInit: + return res; +} + + +/* ArenaFinish -- finish the generic part of the arena + * + * .finish.caller: Unlike PoolFinish, this is called by the class finish + * methods, not the generic Destroy. This is because the class is + * responsible for deallocating the descriptor. */ + +void ArenaFinish(Arena arena) +{ + ReservoirFinish(ArenaReservoir(arena)); + arena->sig = SigInvalid; + GlobalsFinish(ArenaGlobals(arena)); + LocusFinish(arena); + RingFinish(&arena->chunkRing); +} + + +/* ArenaDestroy -- destroy the arena */ + +void ArenaDestroy(Arena arena) +{ + AVERT(Arena, arena); + + GlobalsPrepareToDestroy(ArenaGlobals(arena)); + + /* Empty the reservoir - see impl.c.reserv.reservoir.finish */ + ReservoirSetLimit(ArenaReservoir(arena), 0); + + arena->poolReady = FALSE; + ControlFinish(arena); + + /* Call class-specific finishing. This will call ArenaFinish. */ + (*arena->class->finish)(arena); + + EventFinish(); +} + + +/* ControlInit -- initialize the control pool */ + +Res ControlInit(Arena arena) +{ + Res res; + + AVERT(Arena, arena); + res = PoolInit(&arena->controlPoolStruct.poolStruct, + arena, PoolClassMV(), + ARENA_CONTROL_EXTENDBY, ARENA_CONTROL_AVGSIZE, + ARENA_CONTROL_MAXSIZE); + if (res != ResOK) + return res; + arena->poolReady = TRUE; /* design.mps.arena.pool.ready */ + return ResOK; +} + + +/* ControlFinish -- finish the control pool */ + +void ControlFinish(Arena arena) +{ + AVERT(Arena, arena); + arena->poolReady = FALSE; + PoolFinish(&arena->controlPoolStruct.poolStruct); +} + + +/* ArenaDescribe -- describe the arena */ + +Res ArenaDescribe(Arena arena, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(Arena, arena)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, "Arena $P {\n", (WriteFP)arena, + " class $P (\"$S\")\n", + (WriteFP)arena->class, arena->class->name, + NULL); + if (res != ResOK) return res; + + if (arena->poolReady) { + res = WriteF(stream, + " controlPool $P\n", (WriteFP)&arena->controlPoolStruct, + NULL); + if (res != ResOK) return res; + } + + res = WriteF(stream, + " commitLimit $W\n", (WriteFW)arena->commitLimit, + " spareCommitted $W\n", (WriteFW)arena->spareCommitted, + " spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit, + " zoneShift $U\n", (WriteFU)arena->zoneShift, + " alignment $W\n", (WriteFW)arena->alignment, + NULL); + if (res != ResOK) return res; + + res = (*arena->class->describe)(arena, stream); + if (res != ResOK) return res; + + res = GlobalsDescribe(ArenaGlobals(arena), stream); + if (res != ResOK) return res; + + res = WriteF(stream, + "} Arena $P ($U)\n", (WriteFP)arena, + (WriteFU)arena->serial, + NULL); + return res; +} + + +/* ArenaDescribeTracts -- describe all the tracts in the arena */ + +Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream) +{ + Res res; + Tract tract; + Bool b; + Addr oldLimit, base, limit; + Size size; + + if (!CHECKT(Arena, arena)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + b = TractFirst(&tract, arena); + oldLimit = TractBase(tract); + while (b) { + base = TractBase(tract); + limit = TractLimit(tract); + size = ArenaAlign(arena); + + if (TractBase(tract) > oldLimit) { + res = WriteF(stream, + "[$P, $P) $W $U ---\n", + (WriteFP)oldLimit, (WriteFP)base, + (WriteFW)AddrOffset(oldLimit, base), + (WriteFU)AddrOffset(oldLimit, base), + NULL); + if (res != ResOK) return res; + } + + res = WriteF(stream, + "[$P, $P) $W $U $P ($S)\n", + (WriteFP)base, (WriteFP)limit, + (WriteFW)size, (WriteFW)size, + (WriteFP)TractPool(tract), + (WriteFS)(TractPool(tract)->class->name), + NULL); + if (res != ResOK) return res; + b = TractNext(&tract, arena, TractBase(tract)); + oldLimit = limit; + } + return ResOK; +} + + +/* ControlAlloc -- allocate a small block directly from the control pool + * + * .arena.control-pool: Actually the block will be allocated from the + * control pool, which is an MV pool embedded in the arena itself. + * + * .controlalloc.addr: In implementations where Addr is not compatible + * with void* (design.mps.type.addr.use), ControlAlloc must take care of + * allocating so that the block can be addressed with a void*. */ + +Res ControlAlloc(void **baseReturn, Arena arena, size_t size, + Bool withReservoirPermit) +{ + Addr base; + Res res; + + AVERT(Arena, arena); + AVER(baseReturn != NULL); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + AVER(arena->poolReady); + + res = PoolAlloc(&base, ArenaControlPool(arena), (Size)size, + withReservoirPermit); + if (res != ResOK) + return res; + + *baseReturn = (void *)base; /* see .controlalloc.addr */ + return ResOK; +} + + +/* ControlFree -- free a block allocated using ControlAlloc */ + +void ControlFree(Arena arena, void* base, size_t size) +{ + AVERT(Arena, arena); + AVER(base != NULL); + AVER(size > 0); + AVER(arena->poolReady); + + PoolFree(ArenaControlPool(arena), (Addr)base, (Size)size); +} + + +/* ArenaAlloc -- allocate some tracts from the arena */ + +Res ArenaAlloc(Addr *baseReturn, SegPref pref, Size size, Pool pool, + Bool withReservoirPermit) +{ + Res res; + Arena arena; + Addr base; + Tract baseTract; + Reservoir reservoir; + + AVER(baseReturn != NULL); + AVERT(SegPref, pref); + AVER(size > (Size)0); + AVERT(Pool, pool); + AVER(BoolCheck(withReservoirPermit)); + + arena = PoolArena(pool); + AVERT(Arena, arena); + AVER(SizeIsAligned(size, arena->alignment)); + reservoir = ArenaReservoir(arena); + AVERT(Reservoir, reservoir); + + res = ReservoirEnsureFull(reservoir); + if (res != ResOK) { + AVER(ResIsAllocFailure(res)); + if (!withReservoirPermit) + return res; + } + + res = (*arena->class->alloc)(&base, &baseTract, pref, size, pool); + if (res == ResOK) { + goto goodAlloc; + } else if (withReservoirPermit) { + AVER(ResIsAllocFailure(res)); + res = ReservoirWithdraw(&base, &baseTract, reservoir, size, pool); + if (res == ResOK) + goto goodAlloc; + } + EVENT_PWP(ArenaAllocFail, arena, size, pool); + return res; + +goodAlloc: + /* cache the tract - design.mps.arena.tract.cache */ + arena->lastTract = baseTract; + arena->lastTractBase = base; + + EVENT_PPAWP(ArenaAlloc, arena, baseTract, base, size, pool); + *baseReturn = base; + return ResOK; +} + + +/* ArenaFree -- free some tracts to the arena */ + +void ArenaFree(Addr base, Size size, Pool pool) +{ + Arena arena; + Addr limit; + Reservoir reservoir; + Res res; + + AVERT(Pool, pool); + AVER(base != NULL); + AVER(size > (Size)0); + arena = PoolArena(pool); + AVERT(Arena, arena); + reservoir = ArenaReservoir(arena); + AVERT(Reservoir, reservoir); + AVER(AddrIsAligned(base, arena->alignment)); + AVER(SizeIsAligned(size, arena->alignment)); + + /* uncache the tract if in range - design.mps.arena.tract.uncache */ + limit = AddrAdd(base, size); + if ((arena->lastTractBase >= base) && (arena->lastTractBase < limit)) { + arena->lastTract = NULL; + arena->lastTractBase = (Addr)0; + } + + res = ReservoirEnsureFull(reservoir); + if (res == ResOK) { + (*arena->class->free)(base, size, pool); + } else { + AVER(ResIsAllocFailure(res)); + ReservoirDeposit(reservoir, base, size); + } + + EVENT_PAW(ArenaFree, arena, base, size); + return; +} + + +Size ArenaReserved(Arena arena) +{ + AVERT(Arena, arena); + return (*arena->class->reserved)(arena); +} + +Size ArenaCommitted(Arena arena) +{ + AVERT(Arena, arena); + return arena->committed; +} + +Size ArenaSpareCommitted(Arena arena) +{ + AVERT(Arena, arena); + return arena->spareCommitted; +} + +Size ArenaSpareCommitLimit(Arena arena) +{ + AVERT(Arena, arena); + return arena->spareCommitLimit; +} + +void ArenaSetSpareCommitLimit(Arena arena, Size limit) +{ + AVERT(Arena, arena); + /* Can't check limit, as all possible values are allowed. */ + + arena->spareCommitLimit = limit; + if (arena->spareCommitLimit < arena->spareCommitted) { + arena->class->spareCommitExceeded(arena); + } + + EVENT_PW(SpareCommitLimitSet, arena, limit); + return; +} + +/* Used by arenas which don't use spare committed memory */ +void ArenaNoSpareCommitExceeded(Arena arena) +{ + AVERT(Arena, arena); + return; +} + + +Size ArenaCommitLimit(Arena arena) +{ + AVERT(Arena, arena); + return arena->commitLimit; +} + +Res ArenaSetCommitLimit(Arena arena, Size limit) +{ + Size committed; + Res res; + + AVERT(Arena, arena); + AVER(ArenaCommitted(arena) <= arena->commitLimit); + + committed = ArenaCommitted(arena); + if (limit < committed) { + /* Attempt to set the limit below current committed */ + if (limit >= committed - arena->spareCommitted) { + /* could set the limit by flushing any spare committed memory */ + arena->class->spareCommitExceeded(arena); + AVER(limit >= ArenaCommitted(arena)); + arena->commitLimit = limit; + res = ResOK; + } else { + res = ResFAIL; + } + } else { + arena->commitLimit = limit; + res = ResOK; + } + EVENT_PWU(CommitLimitSet, arena, limit, (res == ResOK)); + return res; +} + + +/* ArenaAvail -- return available memory in the arena */ + +Size ArenaAvail(Arena arena) +{ + Size sSwap; + + sSwap = ArenaReserved(arena); + if (sSwap > arena->commitLimit) sSwap = arena->commitLimit; + /* @@@@ sSwap should take actual paging file size into account */ + return sSwap - arena->committed + arena->spareCommitted; +} + + +/* ArenaExtend -- Add a new chunk in the arena */ + +Res ArenaExtend(Arena arena, Addr base, Size size) +{ + Res res; + + AVERT(Arena, arena); + AVER(base != (Addr)0); + AVER(size > 0); + + res = (*arena->class->extend)(arena, base, size); + if (res != ResOK) + return res; + + EVENT_PAW(ArenaExtend, arena, base, size); + return ResOK; +} + + +/* ArenaNoExtend -- fail to extend the arena by a chunk */ + +Res ArenaNoExtend(Arena arena, Addr base, Size size) +{ + AVERT(Arena, arena); + AVER(base != (Addr)0); + AVER(size > (Size)0); + + NOTREACHED; + return ResUNIMPL; +} diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c new file mode 100644 index 00000000000..aa5d82e08cf --- /dev/null +++ b/mps/code/arenacl.c @@ -0,0 +1,475 @@ +/* impl.c.arenacl: ARENA CLASS USING CLIENT MEMORY + * + * $HopeName: MMsrc!arenacl.c(trunk.23) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.arena.client. + * + * .improve.remember: One possible performance improvement is to + * remember (a conservative approximation to) the indices of the first + * and last free pages in each chunk, and start searching from these + * in ChunkAlloc. See request.epcore.170534. + */ + +#include "boot.h" +#include "tract.h" +#include "mpm.h" +#include "mpsacl.h" + +SRCID(arenacl, "$HopeName: MMsrc!arenacl.c(trunk.23) $"); + + +/* ClientArenaStruct -- Client Arena Structure */ + +#define ClientArenaSig ((Sig)0x519A6EC7) /* SIGnature AREna CLient */ + +typedef struct ClientArenaStruct { + ArenaStruct arenaStruct; /* generic arena structure */ + Sig sig; /* design.mps.sig */ +} ClientArenaStruct; +typedef struct ClientArenaStruct *ClientArena; + +#define Arena2ClientArena(arena) PARENT(ClientArenaStruct, arenaStruct, arena) +#define ClientArena2Arena(clArena) (&(clArena)->arenaStruct) + + +/* CLChunk -- chunk structure */ + +typedef struct ClientChunkStruct *ClientChunk; + +#define ClientChunkSig ((Sig)0x519A6C2C) /* SIGnature ARena CLient Chunk */ + +typedef struct ClientChunkStruct { + ChunkStruct chunkStruct; /* generic chunk */ + Size freePages; /* number of free pages in chunk */ + Addr pageBase; /* base of first managed page in chunk */ + Sig sig; /* design.mps.sig */ +} ClientChunkStruct; + +#define ClientChunk2Chunk(clchunk) (&(clchunk)->chunkStruct) +#define Chunk2ClientChunk(chunk) PARENT(ClientChunkStruct, chunkStruct, chunk) + + +/* ClientChunkClientArena -- get the client arena from a client chunk */ + +#define ClientChunkClientArena(clchunk) \ + Arena2ClientArena(ChunkArena(ClientChunk2Chunk(clchunk))) + + +/* ClientChunkCheck -- check the consistency of a client chunk */ + +static Bool ClientChunkCheck(ClientChunk clChunk) +{ + Chunk chunk; + + CHECKS(ClientChunk, clChunk); + chunk = ClientChunk2Chunk(clChunk); + CHECKL(ChunkCheck(chunk)); + CHECKL(clChunk->freePages <= chunk->pages); + /* check they don't overlap (knowing the order) */ + CHECKL((Addr)(chunk + 1) < (Addr)chunk->allocTable); + return TRUE; +} + + +/* ClientArenaCheck -- check the consistency of a client arena */ + +static Bool ClientArenaCheck(ClientArena clientArena) +{ + CHECKS(ClientArena, clientArena); + CHECKD(Arena, ClientArena2Arena(clientArena)); + return TRUE; +} + + +/* clientChunkCreate -- create a ClientChunk */ + +static Res clientChunkCreate(Chunk *chunkReturn, Addr base, Addr limit, + ClientArena clientArena) +{ + ClientChunk clChunk; + Chunk chunk; + Addr alignedBase; + BootBlockStruct bootStruct; + BootBlock boot = &bootStruct; + Res res; + void *p; + + AVER(chunkReturn != NULL); + AVER(base != (Addr)0); + /* @@@@ Should refuse on small chunks, instead of AVERring. */ + AVER(limit != (Addr)0); + AVER(limit > base); + + /* Initialize boot block. */ + /* Chunk has to be page-aligned, and the boot allocs must be within it. */ + alignedBase = AddrAlignUp(base, ARENA_CLIENT_PAGE_SIZE); + AVER(alignedBase < limit); + res = BootBlockInit(boot, (void *)alignedBase, (void *)limit); + if (res != ResOK) + goto failBootInit; + + /* Allocate the chunk. */ + /* See design.mps.arena.@@@@ */ + res = BootAlloc(&p, boot, sizeof(ClientChunkStruct), MPS_PF_ALIGN); + if (res != ResOK) + goto failChunkAlloc; + clChunk = p; chunk = ClientChunk2Chunk(clChunk); + + res = ChunkInit(chunk, ClientArena2Arena(clientArena), + alignedBase, AddrAlignDown(limit, ARENA_CLIENT_PAGE_SIZE), + ARENA_CLIENT_PAGE_SIZE, boot); + if (res != ResOK) + goto failChunkInit; + + ClientArena2Arena(clientArena)->committed += + AddrOffset(base, PageIndexBase(chunk, chunk->allocBase)); + BootBlockFinish(boot); + + clChunk->sig = ClientChunkSig; + AVERT(ClientChunk, clChunk); + *chunkReturn = chunk; + return ResOK; + +failChunkInit: +failChunkAlloc: +failBootInit: + return res; +} + + +/* ClientChunkInit -- initialize a ClientChunk */ + +static Res ClientChunkInit(Chunk chunk, BootBlock boot) +{ + ClientChunk clChunk; + + /* chunk is supposed to be uninitialized, so don't check it. */ + clChunk = Chunk2ClientChunk(chunk); + AVERT(BootBlock, boot); + UNUSED(boot); + + clChunk->freePages = chunk->pages; /* too large @@@@ */ + + return ResOK; +} + + +/* clientChunkDestroy -- destroy a ClientChunk */ + +static void clientChunkDestroy(Chunk chunk) +{ + ClientChunk clChunk; + + clChunk = Chunk2ClientChunk(chunk); + AVERT(ClientChunk, clChunk); + + clChunk->sig = SigInvalid; + ChunkFinish(chunk); +} + + +/* ClientChunkFinish -- finish a ClientChunk */ + +static void ClientChunkFinish(Chunk chunk) +{ + /* Can't check chunk as it's not valid anymore. */ + UNUSED(chunk); NOOP; +} + + +/* ClientArenaInit -- create and initialize the client arena + * + * .init.memory: Creates the arena structure in the chuck given, and + * makes the first chunk from the memory left over. + * .arena.init: Once the arena has been allocated, we call ArenaInit + * to do the generic part of init. + */ +static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, + va_list args) +{ + Arena arena; + ClientArena clientArena; + Size size; + Size clArenaSize; /* aligned size of ClientArenaStruct */ + Addr base, limit, chunkBase; + Res res; + Chunk chunk; + + size = va_arg(args, Size); + base = va_arg(args, Addr); + AVER(arenaReturn != NULL); + AVER((ArenaClass)mps_arena_class_cl() == class); + AVER(base != (Addr)0); + + clArenaSize = SizeAlignUp(sizeof(ClientArenaStruct), MPS_PF_ALIGN); + if (size < clArenaSize) + return ResMEMORY; + + limit = AddrAdd(base, size); + + /* allocate the arena */ + base = AddrAlignUp(base, MPS_PF_ALIGN); + clientArena = (ClientArena)base; + chunkBase = AddrAlignUp(AddrAdd(base, clArenaSize), MPS_PF_ALIGN); + if (chunkBase > limit) + return ResMEMORY; + + arena = ClientArena2Arena(clientArena); + /* impl.c.arena.init.caller */ + res = ArenaInit(arena, class); + if (res != ResOK) + return res; + + /* have to have a valid arena before calling ChunkCreate */ + clientArena->sig = ClientArenaSig; + + res = clientChunkCreate(&chunk, chunkBase, limit, clientArena); + if (res != ResOK) + goto failChunkCreate; + arena->primary = chunk; + + /* Set the zone shift to divide the initial chunk into the same */ + /* number of zones as will fit into a reference set (the number of */ + /* bits in a word). Note that some zones are discontiguous in the */ + /* arena if the size is not a power of 2. */ + arena->zoneShift = SizeFloorLog2(size >> MPS_WORD_SHIFT); + + EVENT_PWA(ArenaCreateCL, arena, size, base); + AVERT(ClientArena, clientArena); + *arenaReturn = arena; + return ResOK; + +failChunkCreate: + ArenaFinish(arena); + return res; +} + + +/* ClientArenaFinish -- finish the arena */ + +static void ClientArenaFinish(Arena arena) +{ + ClientArena clientArena; + Ring node, next; + + clientArena = Arena2ClientArena(arena); + AVERT(ClientArena, clientArena); + + /* destroy all chunks */ + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + clientChunkDestroy(chunk); + } + + clientArena->sig = SigInvalid; + + ArenaFinish(arena); /* impl.c.arena.finish.caller */ +} + + +/* ClientArenaExtend -- extend the arena */ + +static Res ClientArenaExtend(Arena arena, Addr base, Size size) +{ + ClientArena clientArena; + Chunk chunk; + Res res; + Addr limit; + + AVERT(Arena, arena); + AVER(base != (Addr)0); + AVER(size > 0); + limit = AddrAdd(base, size); + + clientArena = Arena2ClientArena(arena); + res = clientChunkCreate(&chunk, base, limit, clientArena); + return res; +} + + +/* ClientArenaReserved -- return the amount of reserved address space */ + +static Size ClientArenaReserved(Arena arena) +{ + Size size; + Ring node, nextNode; + + AVERT(Arena, arena); + + size = 0; + /* .req.extend.slow */ + RING_FOR(node, &arena->chunkRing, nextNode) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + AVERT(Chunk, chunk); + size += AddrOffset(chunk->base, chunk->limit); + } + + return size; +} + + +/* chunkAlloc -- allocate some tracts in a chunk */ + +static Res chunkAlloc(Addr *baseReturn, Tract *baseTractReturn, + SegPref pref, Size pages, Pool pool, Chunk chunk) +{ + Index baseIndex, limitIndex, index; + Bool b; + Arena arena; + ClientChunk clChunk; + + AVER(baseReturn != NULL); + AVER(baseTractReturn != NULL); + clChunk = Chunk2ClientChunk(chunk); + + if (pages > clChunk->freePages) + return ResRESOURCE; + + arena = chunk->arena; + + if (pref->high) + b = BTFindShortResRangeHigh(&baseIndex, &limitIndex, chunk->allocTable, + chunk->allocBase, chunk->pages, pages); + else + b = BTFindShortResRange(&baseIndex, &limitIndex, chunk->allocTable, + chunk->allocBase, chunk->pages, pages); + + if (!b) + return ResRESOURCE; + + /* Check commit limit. Note that if there are multiple reasons */ + /* for failing the allocation we attempt to return other result codes */ + /* in preference to ResCOMMIT_LIMIT. See design.mps.arena.commit-limit */ + if (ArenaCommitted(arena) + pages * ChunkPageSize(chunk) + > arena->commitLimit) { + return ResCOMMIT_LIMIT; + } + + /* Initialize the generic tract structures. */ + AVER(limitIndex > baseIndex); + for(index = baseIndex; index < limitIndex; ++index) { + PageAlloc(chunk, index, pool); + } + + clChunk->freePages -= pages; + + *baseReturn = PageIndexBase(chunk, baseIndex); + *baseTractReturn = PageTract(&chunk->pageTable[baseIndex]); + + return ResOK; +} + + +/* ClientAlloc -- allocate a region from the arena */ + +static Res ClientAlloc(Addr *baseReturn, Tract *baseTractReturn, + SegPref pref, Size size, Pool pool) +{ + Arena arena; + Res res; + Ring node, nextNode; + Size pages; + + AVER(baseReturn != NULL); + AVER(baseTractReturn != NULL); + AVERT(SegPref, pref); + AVER(size > 0); + AVERT(Pool, pool); + + arena = PoolArena(pool); + AVERT(Arena, arena); + /* All chunks have same pageSize. */ + AVER(SizeIsAligned(size, ChunkPageSize(arena->primary))); + /* NULL is used as a discriminator (see */ + /* design.mps.arenavm.table.disc), therefore the real pool */ + /* must be non-NULL. */ + AVER(pool != NULL); + + pages = ChunkSizeToPages(arena->primary, size); + + /* .req.extend.slow */ + RING_FOR(node, &arena->chunkRing, nextNode) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + res = chunkAlloc(baseReturn, baseTractReturn, pref, pages, pool, chunk); + if (res == ResOK || res == ResCOMMIT_LIMIT) { + return res; + } + } + return ResRESOURCE; +} + + +/* ClientFree - free a region in the arena */ + +static void ClientFree(Addr base, Size size, Pool pool) +{ + Arena arena; + Chunk chunk; + Size pages; + ClientArena clientArena; + Index pi, baseIndex, limitIndex; + Bool foundChunk; + ClientChunk clChunk; + + AVER(base != NULL); + AVER(size > (Size)0); + AVERT(Pool, pool); + arena = PoolArena(pool); + AVERT(Arena, arena); + clientArena = Arena2ClientArena(arena); + AVERT(ClientArena, clientArena); + AVER(SizeIsAligned(size, ChunkPageSize(arena->primary))); + AVER(AddrIsAligned(base, ChunkPageSize(arena->primary))); + + foundChunk = ChunkOfAddr(&chunk, arena, base); + AVER(foundChunk); + clChunk = Chunk2ClientChunk(chunk); + AVERT(ClientChunk, clChunk); + + pages = ChunkSizeToPages(chunk, size); + baseIndex = INDEX_OF_ADDR(chunk, base); + limitIndex = baseIndex + pages; + AVER(baseIndex < limitIndex); + AVER(limitIndex <= chunk->pages); + + for(pi = baseIndex; pi < limitIndex; pi++) { + Page page = &chunk->pageTable[pi]; + Tract tract = PageTract(page); + + AVER(TractPool(tract) == pool); + TractFinish(tract); + } + + AVER(BTIsSetRange(chunk->allocTable, baseIndex, limitIndex)); + BTResRange(chunk->allocTable, baseIndex, limitIndex); + + clChunk->freePages += pages; +} + + +/* ClientArenaClass -- The Client arena class definition */ + +DEFINE_ARENA_CLASS(ClientArenaClass, this) +{ + INHERIT_CLASS(this, AbstractArenaClass); + this->name = "CL"; + this->size = sizeof(ClientArenaStruct); + this->offset = offsetof(ClientArenaStruct, arenaStruct); + this->init = ClientArenaInit; + this->finish = ClientArenaFinish; + this->reserved = ClientArenaReserved; + this->extend = ClientArenaExtend; + this->alloc = ClientAlloc; + this->free = ClientFree; + this->chunkInit = ClientChunkInit; + this->chunkFinish = ClientChunkFinish; +} + + +/* mps_arena_class_cl -- return the arena class CL */ + +mps_arena_class_t mps_arena_class_cl(void) +{ + return (mps_arena_class_t)EnsureClientArenaClass(); +} diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c new file mode 100644 index 00000000000..bda889eb858 --- /dev/null +++ b/mps/code/arenacv.c @@ -0,0 +1,422 @@ +/* impl.c.arenacv: ARENA COVERAGE TEST + * + * $HopeName: MMsrc!arenacv.c(trunk.14) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .coverage: At the moment, we're only trying to cover the new code + * (partial mapping of the page table and vm overflow). + * + * .note.tract-size: If the page size is divisible by sizeof(TractStruct), many + * test cases end up being essentially identical -- there just aren't that + * many different cases then. + * + * .improve.gap-below: Could test different-sized gaps below the tract + * being allocated; this requires using two adjacent zones. + */ + +#include + +#include "mpm.h" +#include "poolmv.h" +#include "testlib.h" +#include "mpsavm.h" +#include "mpsacl.h" + + +#define tractsSIZE 500 + + +/* testAllocAndIterate -- Test arena allocation and iteration + * + * .tract-seg: Test allocation and iteration, using both low-level + * tracts and higher-level segments. To do this, contrive a set of + * allocation and iteration functions which are interchangeable. + */ + +/* Type definitions for the interchangability interface */ + + +/* AllocInfo -- interchangeable info about allocated regions */ + +typedef struct AllocInfoStruct *AllocInfo; + +typedef struct AllocInfoStruct { + union { + struct { + Addr base; + Size size; + Pool pool; + } tractData; + struct { + Seg seg; + } segData; + } the; +} AllocInfoStruct; + +typedef Res (*AllocFun)(AllocInfoStruct *aiReturn, SegPref pref, + Size size, Pool pool); + +typedef void (*FreeFun)(AllocInfo ai); + +typedef Bool (*FirstFun)(AllocInfoStruct *aiReturn, Arena arena); + +typedef Bool (*NextFun)(AllocInfoStruct *nextReturn, AllocInfo ai, + Arena arena); + +typedef Count (*UnitsFun)(Count pages); + +typedef void (*TestFun)(AllocInfo ai, Arena arena); + +typedef void (*CopyFun)(AllocInfoStruct *toReturn, AllocInfo from); + + +/* AllocatorClass -- encapsulates an allocation mechanism */ + +typedef struct AllocatorClassStruct *AllocatorClass; + +typedef struct AllocatorClassStruct { + AllocFun alloc; /* allocation method */ + FreeFun free; /* deallocation method */ + FirstFun first; /* find first block for iteration */ + NextFun next; /* find next block for iteration */ + UnitsFun units; /* number of iteration objects for pages */ + TestFun test; /* consistency check a region */ + CopyFun copy; /* copy an AllocationInfo object */ +} AllocatorClassStruct; + + +/* Implementation of the tract-based interchangability interface */ + +static Res allocAsTract(AllocInfoStruct *aiReturn, SegPref pref, + Size size, Pool pool) +{ + Res res; + Addr base; + res = ArenaAlloc(&base, pref, size, pool, FALSE); + if (res == ResOK) { + aiReturn->the.tractData.base = base; + aiReturn->the.tractData.size = size; + aiReturn->the.tractData.pool = pool; + } + return res; +} + +static void freeAsTract(AllocInfo ai) +{ + ArenaFree(ai->the.tractData.base, + ai->the.tractData.size, + ai->the.tractData.pool); +} + +static Bool firstAsTract(AllocInfoStruct *aiReturn, Arena arena) +{ + Bool res; + Tract tract; + res = TractFirst(&tract, arena); + if (res) { + aiReturn->the.tractData.base = TractBase(tract); + aiReturn->the.tractData.size = ArenaAlign(arena);; + aiReturn->the.tractData.pool = TractPool(tract); + } + return res; +} + +static Bool nextAsTract(AllocInfoStruct *nextReturn, AllocInfo ai, + Arena arena) +{ + Bool res; + Tract tract; + res = TractNext(&tract, arena, ai->the.tractData.base); + if (res) { + nextReturn->the.tractData.base = TractBase(tract); + nextReturn->the.tractData.size = ArenaAlign(arena);; + nextReturn->the.tractData.pool = TractPool(tract); + } + return res; +} + +static Count unitsAsTract(Count pages) +{ + return pages; /* one tract for each page */ +} + + +static void testAsTract(AllocInfo ai, Arena arena) +{ + /* Test TractOfAddr */ + Tract tract; + Addr base; + Bool found; + + found = TractOfAddr(&tract, arena, ai->the.tractData.base); + cdie(found, "TractOfAddr"); + base = TractBase(tract); + cdie(base == ai->the.tractData.base, "base"); + +} + +static void copyAsTract(AllocInfoStruct *toReturn, AllocInfo from) +{ + toReturn->the.tractData.base = from->the.tractData.base; + toReturn->the.tractData.size = from->the.tractData.size; + toReturn->the.tractData.pool = from->the.tractData.pool; +} + +static AllocatorClassStruct allocatorTractStruct = { + allocAsTract, + freeAsTract, + firstAsTract, + nextAsTract, + unitsAsTract, + testAsTract, + copyAsTract +}; + + +/* Implementation of the segment-based interchangability interface */ + +static Res allocAsSeg(AllocInfoStruct *aiReturn, SegPref pref, + Size size, Pool pool) +{ + Res res; + Seg seg; + res = SegAlloc(&seg, SegClassGet(), pref, size, pool, FALSE); + if (res == ResOK) { + aiReturn->the.segData.seg = seg; + } + return res; +} + +static void freeAsSeg(AllocInfo ai) +{ + SegFree(ai->the.segData.seg); +} + +static Bool firstAsSeg(AllocInfoStruct *aiReturn, Arena arena) +{ + Bool res; + Seg seg; + res = SegFirst(&seg, arena); + if (res) { + aiReturn->the.segData.seg = seg; + } + return res; +} + +static Bool nextAsSeg(AllocInfoStruct *nextReturn, AllocInfo ai, + Arena arena) +{ + Bool res; + Seg seg; + res = SegNext(&seg, arena, SegBase(ai->the.segData.seg)); + if (res) { + nextReturn->the.segData.seg = seg; + } + return res; +} + +static Count unitsAsSeg(Count pages) +{ + if (0 == pages) + return 0; /* can't have a zero length seg */ + else + return 1; /* one seg no matter how many pages */ +} + +static void testAsSeg(AllocInfo ai, Arena arena) +{ + /* Test size functions */ + Seg seg = ai->the.segData.seg; + Addr base, limit; + Size size; + + UNUSED(arena); + base = SegBase(seg); + limit = SegLimit(seg); + size = SegSize(seg); + cdie(size == AddrOffset(base, limit), "size"); +} + +static void copyAsSeg(AllocInfoStruct *toReturn, AllocInfo from) +{ + toReturn->the.segData.seg = from->the.segData.seg; +} + +static AllocatorClassStruct allocatorSegStruct = { + allocAsSeg, + freeAsSeg, + firstAsSeg, + nextAsSeg, + unitsAsSeg, + testAsSeg, + copyAsSeg +}; + + +/* The main function can use either tracts or segs */ + +static void testAllocAndIterate(Arena arena, Pool pool, + Size pageSize, Count numPerPage, + AllocatorClass allocator) +{ + AllocInfoStruct offsetRegion, gapRegion, newRegion, topRegion; + SegPrefStruct pref = *SegPrefDefault(); + Count offset, gap, new; + ZoneSet zone = (ZoneSet)2; + int i; + + /* Testing the behaviour with various sizes of gaps in the page table. */ + + /* Assume the allocation strategy is first-fit. The idea of the tests is */ + /* to allocate a region of memory, then deallocate a gap in the middle, */ + /* then allocate a new region that fits in the gap with various amounts */ + /* left over. Like this: */ + /* |-offsetRegion-||----gapRegion----||-topRegion-| */ + /* |-offsetRegion-||-newRegion-| |-topRegion-| */ + /* This is done with three different sizes of offsetRegion, in two */ + /* different zones to ensure that all page boundary cases are tested. */ + for(i = 0; i < 2; ++i) { /* zone loop */ + for(offset = 0; offset <= 2*numPerPage; offset += numPerPage) { + if(offset != 0) + die(allocator->alloc(&offsetRegion, &pref, offset * pageSize, pool), + "offsetRegion"); + for(gap = numPerPage+1; gap <= 3 * (numPerPage+1); + gap += (numPerPage+1)) { + die(allocator->alloc(&gapRegion, &pref, gap * pageSize, pool), + "gapRegion"); + die(allocator->alloc(&topRegion, &pref, pageSize, pool), + "topRegion"); + allocator->free(&gapRegion); + for(new = 1; new <= gap; new += numPerPage) { + AllocInfoStruct thisRegion, nextRegion; + Count regionNum, expected; + Res enoughRegions; + + die(allocator->alloc(&newRegion, &pref, new * pageSize, pool), + "newRegion"); + + /* Test iterators */ + cdie(allocator->first(&thisRegion, arena), "first"); + regionNum = 1; + while (allocator->next(&nextRegion, &thisRegion, arena)) { + regionNum++; + allocator->copy(&thisRegion, &nextRegion); + } + + /* Should be able to iterate over at least offset, new, top */ + expected = + allocator->units(offset) + + allocator->units(new) + + allocator->units(1); + + if (regionNum >= expected) + enoughRegions = ResOK; + else + enoughRegions = ResFAIL; + + die(enoughRegions, "Not enough regions"); + + allocator->free(&newRegion); + } + + allocator->free(&topRegion); + } + if(offset != 0) { + allocator->test(&offsetRegion, arena); + allocator->free(&offsetRegion); + } + } + SegPrefExpress(&pref, SegPrefZoneSet, &zone); + } + +} + + +static void testPageTable(ArenaClass class, ...) +{ + Arena arena; Pool pool; + Size pageSize; + Count tractsPerPage; + va_list args; + + va_start(args, class); + die(ArenaCreateV(&arena, class, args), "ArenaCreate"); + va_end(args); + + die(PoolCreate(&pool, arena, PoolClassMV(), + (Size)65536, (Size)32, (Size)65536), + "PoolCreate"); + + pageSize = ArenaAlign(arena); + tractsPerPage = pageSize / sizeof(TractStruct); + printf("%ld tracts per page in the page table.\n", (long)tractsPerPage); + + /* test tract allocation and iteration */ + testAllocAndIterate(arena, pool, pageSize, tractsPerPage, + &allocatorTractStruct); + + /* test segment allocation and iteration */ + testAllocAndIterate(arena, pool, pageSize, tractsPerPage, + &allocatorSegStruct); + + PoolDestroy(pool); + ArenaDestroy(arena); +} + + +static Res makeArena(Arena *arenaOut, ArenaClass class, ...) +{ + va_list args; + Res res; + + va_start(args, class); + res = ArenaCreateV(arenaOut, class, args); + va_end(args); + return res; +} + + +/* testSize -- test arena size overflow + * + * Just try allocating larger arenas, doubling the size each time, until + * it fails, then check the error code. + */ + +static void testSize(Size size) +{ + ArenaClass class = (ArenaClass)mps_arena_class_vm(); + Arena arena; + Res res; + + do { + res = makeArena(&arena, class, size); + if (res == ResOK) + ArenaDestroy(arena); + else + die((res == ResRESOURCE) ? ResOK : res, "right error code"); + size *= 2; + } while (size == 0); +} + + +#define TEST_ARENA_SIZE ((Size)16<<22) + + +int main(void) +{ + void *block; + + testPageTable((ArenaClass)mps_arena_class_vm(), TEST_ARENA_SIZE); + testPageTable((ArenaClass)mps_arena_class_vmnz(), TEST_ARENA_SIZE); + + block = malloc(TEST_ARENA_SIZE); + cdie(block != NULL, "malloc"); + testPageTable((ArenaClass)mps_arena_class_cl(), TEST_ARENA_SIZE, + (Addr)block); + + testSize(TEST_ARENA_SIZE); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "Conclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c new file mode 100644 index 00000000000..494afd48338 --- /dev/null +++ b/mps/code/arenavm.c @@ -0,0 +1,1547 @@ +/* impl.c.arenavm: VIRTUAL MEMORY ARENA CLASS + * + * $HopeName: MMsrc!arenavm.c(trunk.73) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * + * DESIGN + * + * .design: See design.mps.arena.vm, and design.mps.arena.coop-vm + * + * .vm.addr-is-star: In this file, Addr is compatible with C + * pointers, and Count with size_t (Index), because all refer to the + * virtual address space. + * + * + * IMPROVEMENTS + * + * .improve.table.zone-zero: It would be better to make sure that the + * page tables are in zone zero, since that zone is least useful for + * GC. (But it would change how pagesFindFreeInZones avoids allocating + * over the tables, see .alloc.skip.) + */ + +#include "boot.h" +#include "tract.h" +#include "mpm.h" +#include "mpsavm.h" + +SRCID(arenavm, "$HopeName: MMsrc!arenavm.c(trunk.73) $"); + + +/* @@@@ Arbitrary calculation for the maximum number of distinct */ +/* object sets for generations. Should be in config.h. */ +/* .gencount.const: Must be a constant suitable for use as an */ +/* array size. */ +#define VMArenaGenCount ((Count)(MPS_WORD_WIDTH/2)) + +/* VMChunk -- chunks for VM arenas */ + +typedef struct VMChunkStruct *VMChunk; + +#define VMChunkSig ((Sig)0x519A6B3C) /* SIGnature ARena VM Chunk */ + +typedef struct VMChunkStruct { + ChunkStruct chunkStruct; /* generic chunk */ + VM vm; /* virtual memory handle */ + Addr overheadMappedLimit; /* limit of pages mapped for overhead */ + BT pageTableMapped; /* indicates mapped state of page table */ + BT noSparePages; /* 1 bit per page of pageTable */ + Sig sig; /* design.mps.sig */ +} VMChunkStruct; + +#define VMChunk2Chunk(vmchunk) (&(vmchunk)->chunkStruct) +#define Chunk2VMChunk(chunk) PARENT(VMChunkStruct, chunkStruct, chunk) + + +/* VMChunkVMArena -- get the VM arena from a VM chunk */ + +#define VMChunkVMArena(vmchunk) \ + Arena2VMArena(ChunkArena(VMChunk2Chunk(vmchunk))) + + +/* VMArena + * + * See design.mps.arena.coop-vm.struct.vmarena for description. + */ + +typedef struct VMArenaStruct *VMArena; + +#define VMArenaSig ((Sig)0x519A6EB3) /* SIGnature AREna VM */ + +typedef struct VMArenaStruct { /* VM arena structure */ + ArenaStruct arenaStruct; + VM vm; /* VM where the arena itself is stored */ + Size spareSize; /* total size of spare pages */ + ZoneSet blacklist; /* zones to use last */ + ZoneSet genZoneSet[VMArenaGenCount]; /* .gencount.const */ + ZoneSet freeSet; /* unassigned zones */ + Size extendBy; + Sig sig; /* design.mps.sig */ +} VMArenaStruct; + +#define Arena2VMArena(arena) PARENT(VMArenaStruct, arenaStruct, arena) +#define VMArena2Arena(vmarena) (&(vmarena)->arenaStruct) + + +/* Forward declarations */ + +static void sparePagesPurge(VMArena vmArena); +static ArenaClass VMArenaClassGet(void); +static ArenaClass VMNZArenaClassGet(void); + + +/* VMChunkCheck -- check the consistency of a VM chunk */ + +static Bool VMChunkCheck(VMChunk vmchunk) +{ + Chunk chunk; + + CHECKS(VMChunk, vmchunk); + chunk = VMChunk2Chunk(vmchunk); + CHECKL(ChunkCheck(chunk)); + CHECKL(VMCheck(vmchunk->vm)); + CHECKL(VMAlign(vmchunk->vm) == ChunkPageSize(chunk)); + CHECKL(vmchunk->overheadMappedLimit <= (Addr)chunk->pageTable); + /* check pageTableMapped table */ + CHECKL(vmchunk->pageTableMapped != NULL); + CHECKL((Addr)vmchunk->pageTableMapped >= chunk->base); + CHECKL(AddrAdd((Addr)vmchunk->pageTableMapped, BTSize(chunk->pageTablePages)) + <= vmchunk->overheadMappedLimit); + /* check noSparePages table */ + CHECKL(vmchunk->noSparePages != NULL); + CHECKL((Addr)vmchunk->noSparePages >= chunk->base); + CHECKL(AddrAdd((Addr)vmchunk->noSparePages, BTSize(chunk->pageTablePages)) + <= vmchunk->overheadMappedLimit); + /* .improve.check-table: Could check the consistency of the tables. */ + return TRUE; +} + + +/* addrOfPageDesc -- address of the page descriptor (as an Addr) */ + +#define addrOfPageDesc(chunk, index) \ + ((Addr)&(chunk)->pageTable[index]) + + +/* PageTablePageIndex + * + * Maps from a page base address for a page occupied by the page table + * to the index of that page in the range of pages occupied by the + * page table. So that + * PageTablePageIndex(chunk, (Addr)chunk->pageTable) == 0 + * and + * PageTablePageIndex(chunk, + * AddrAlignUp(addrOfPageDesc(chunk->pages), pageSize) + * == chunk->pageTablePages + */ +#define PageTablePageIndex(chunk, pageAddr) \ + ChunkSizeToPages(chunk, AddrOffset((Addr)(chunk)->pageTable, pageAddr)) + + +/* TablePageIndexBase + * + * Takes a page table page index (i.e., the index of a page occupied + * by the page table, where the page occupied by chunk->pageTable is + * index 0) and returns the base address of that page. + * (Reverse of mapping defined by PageTablePageIndex.) + */ +#define TablePageIndexBase(chunk, index) \ + AddrAdd((Addr)(chunk)->pageTable, ChunkPagesToSize(chunk, index)) + + +/* pageIsSpare -- is page spare (free and mapped)? */ + +#define pageIsSpare(page) \ + ((page)->the.rest.pool == NULL && (page)->the.rest.type == PageTypeSpare) + + +/* VMArenaCheck -- check the consistency of an arena structure */ + +static Bool VMArenaCheck(VMArena vmArena) +{ + Index gen; + ZoneSet allocSet; + Arena arena; + VMChunk primary; + + CHECKS(VMArena, vmArena); + arena = VMArena2Arena(vmArena); + CHECKD(Arena, arena); + /* spare pages are committed, so must be less spare than committed. */ + CHECKL(vmArena->spareSize <= arena->committed); + CHECKL(vmArena->blacklist != ZoneSetUNIV); + + allocSet = ZoneSetEMPTY; + for(gen = (Index)0; gen < VMArenaGenCount; ++gen) { + allocSet = ZoneSetUnion(allocSet, vmArena->genZoneSet[gen]); + } + CHECKL(ZoneSetInter(allocSet, vmArena->freeSet) == ZoneSetEMPTY); + CHECKL(vmArena->extendBy > 0); + + if (arena->primary != NULL) { + primary = Chunk2VMChunk(arena->primary); + CHECKD(VMChunk, primary); + /* We could iterate over all chunks accumulating an accurate */ + /* count of committed, but we don't have all day. */ + CHECKL(VMMapped(primary->vm) <= arena->committed); + } + return TRUE; +} + + +/* VM indirect functions + * + * These functions should be used to map and unmap within the arena. + * They are responsible for maintaining vmArena->committed, and for + * checking that the commit limit does not get exceeded. + */ +static Res vmArenaMap(VMArena vmArena, VM vm, Addr base, Addr limit) +{ + Arena arena; + Size size; + Res res; + + /* no checking as function is local to module */ + + arena = VMArena2Arena(vmArena); + size = AddrOffset(base, limit); + /* committed can't overflow (since we can't commit more memory than */ + /* address space), but we're paranoid. */ + AVER(arena->committed < arena->committed + size); + /* check against commit limit */ + if (arena->commitLimit < arena->committed + size) + return ResCOMMIT_LIMIT; + + res = VMMap(vm, base, limit); + if (res != ResOK) + return res; + arena->committed += size; + return ResOK; +} + + +static void vmArenaUnmap(VMArena vmArena, VM vm, Addr base, Addr limit) +{ + Arena arena; + Size size; + + /* no checking as function is local to module */ + + arena = VMArena2Arena(vmArena); + size = AddrOffset(base, limit); + AVER(size <= arena->committed); + + VMUnmap(vm, base, limit); + arena->committed -= size; + return; +} + + +/* VMChunkCreate -- create a chunk + * + * chunkReturn, return parameter for the created chunk. + * vmArena, the parent VMArena. + * size, approximate amount of virtual address that the chunk should reserve. + */ +static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size) +{ + Res res; + Addr base, limit, chunkStructLimit; + Align pageSize; + VM vm; + BootBlockStruct bootStruct; + BootBlock boot = &bootStruct; + VMChunk vmChunk; + void *p; + + AVER(chunkReturn != NULL); + AVERT(VMArena, vmArena); + AVER(size > 0); + + res = VMCreate(&vm, size); + if (res != ResOK) + goto failVMCreate; + + pageSize = VMAlign(vm); + /* The VM will have aligned the userSize; pick up the actual size. */ + base = VMBase(vm); + limit = VMLimit(vm); + + res = BootBlockInit(boot, (void *)base, (void *)limit); + if (res != ResOK) + goto failBootInit; + + /* Allocate and map the descriptor. */ + /* See design.mps.arena.@@@@ */ + res = BootAlloc(&p, boot, sizeof(VMChunkStruct), MPS_PF_ALIGN); + if (res != ResOK) + goto failChunkAlloc; + vmChunk = p; + /* Calculate the limit of the page where the chunkStruct resides. */ + chunkStructLimit = AddrAlignUp((Addr)(vmChunk + 1), pageSize); + res = vmArenaMap(vmArena, vm, base, chunkStructLimit); + if (res != ResOK) + goto failChunkMap; + vmChunk->overheadMappedLimit = chunkStructLimit; + + vmChunk->vm = vm; + res = ChunkInit(VMChunk2Chunk(vmChunk), VMArena2Arena(vmArena), + base, limit, pageSize, boot); + if (res != ResOK) + goto failChunkInit; + + BootBlockFinish(boot); + + vmChunk->sig = VMChunkSig; + AVERT(VMChunk, vmChunk); + *chunkReturn = VMChunk2Chunk(vmChunk); + return ResOK; + +failChunkInit: + /* No need to unmap, as we're destroying the VM. */ +failChunkMap: +failChunkAlloc: +failBootInit: + VMDestroy(vm); +failVMCreate: + return res; +} + + +/* VMChunkInit -- initialize a VMChunk */ + +static Res VMChunkInit(Chunk chunk, BootBlock boot) +{ + size_t btSize; + VMChunk vmChunk; + Addr overheadLimit; + void *p; + Res res; + + /* chunk is supposed to be uninitialized, so don't check it. */ + vmChunk = Chunk2VMChunk(chunk); + AVERT(BootBlock, boot); + + btSize = (size_t)BTSize(chunk->pageTablePages); + res = BootAlloc(&p, boot, btSize, MPS_PF_ALIGN); + if (res != ResOK) + goto failPageTableMapped; + vmChunk->pageTableMapped = p; + res = BootAlloc(&p, boot, btSize, MPS_PF_ALIGN); + if (res != ResOK) + goto failnoSparePages; + vmChunk->noSparePages = p; + + /* Actually commit all the tables. design.mps.arena.vm.@@@@ */ + overheadLimit = AddrAdd(chunk->base, (Size)BootAllocated(boot)); + if (vmChunk->overheadMappedLimit < overheadLimit) { + overheadLimit = AddrAlignUp(overheadLimit, ChunkPageSize(chunk)); + res = vmArenaMap(VMChunkVMArena(vmChunk), vmChunk->vm, + vmChunk->overheadMappedLimit, overheadLimit); + if (res != ResOK) + goto failTableMap; + vmChunk->overheadMappedLimit = overheadLimit; + } + + BTResRange(vmChunk->pageTableMapped, 0, chunk->pageTablePages); + BTSetRange(vmChunk->noSparePages, 0, chunk->pageTablePages); + return ResOK; + + /* .no-clean: No clean-ups needed for boot, as we will discard the chunk. */ +failTableMap: +failnoSparePages: +failPageTableMapped: + return res; +} + + +/* vmChunkDestroy -- destroy a VMChunk */ + +static void vmChunkDestroy(Chunk chunk) +{ + VM vm; + VMChunk vmChunk; + + AVERT(Chunk, chunk); + vmChunk = Chunk2VMChunk(chunk); + AVERT(VMChunk, vmChunk); + AVER(BTIsSetRange(vmChunk->noSparePages, 0, chunk->pageTablePages)); + AVER(BTIsResRange(vmChunk->pageTableMapped, 0, chunk->pageTablePages)); + + vmChunk->sig = SigInvalid; + vm = vmChunk->vm; + ChunkFinish(chunk); + VMDestroy(vm); +} + + +/* VMChunkFinish -- finish a VMChunk */ + +static void VMChunkFinish(Chunk chunk) +{ + VMChunk vmChunk = Chunk2VMChunk(chunk); + + vmArenaUnmap(VMChunkVMArena(vmChunk), vmChunk->vm, + VMBase(vmChunk->vm), vmChunk->overheadMappedLimit); + /* No point in finishing the other fields, since they are unmapped. */ +} + + +/* VMArenaInit -- create and initialize the VM arena + * + * .arena.init: Once the arena has been allocated, we call ArenaInit + * to do the generic part of init. + */ +static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, va_list args) +{ + Size userSize; /* size requested by user */ + Size chunkSize; /* size actually created */ + Size vmArenaSize; /* aligned size of VMArenaStruct */ + Res res; + VMArena vmArena; + Arena arena; + Index gen; + VM arenaVM; + Chunk chunk; + + userSize = va_arg(args, Size); + AVER(arenaReturn != NULL); + AVER(class == VMArenaClassGet() || class == VMNZArenaClassGet()); + AVER(userSize > 0); + + /* Create a VM to hold the arena and map it. */ + vmArenaSize = SizeAlignUp(sizeof(VMArenaStruct), MPS_PF_ALIGN); + res = VMCreate(&arenaVM, vmArenaSize); + if (res != ResOK) + goto failVMCreate; + res = VMMap(arenaVM, VMBase(arenaVM), VMLimit(arenaVM)); + if (res != ResOK) + goto failVMMap; + vmArena = (VMArena)VMBase(arenaVM); + + arena = VMArena2Arena(vmArena); + /* impl.c.arena.init.caller */ + res = ArenaInit(arena, class); + if (res != ResOK) + goto failArenaInit; + arena->committed = VMMapped(arenaVM); + + vmArena->vm = arenaVM; + vmArena->spareSize = 0; + + /* .blacklist: We blacklist the zones corresponding to small integers. */ + vmArena->blacklist = + ZoneSetAdd(arena, ZoneSetAdd(arena, ZoneSetEMPTY, (Addr)1), (Addr)-1); + + for(gen = (Index)0; gen < VMArenaGenCount; gen++) { + vmArena->genZoneSet[gen] = ZoneSetEMPTY; + } + vmArena->freeSet = ZoneSetUNIV; /* includes blacklist */ + /* design.mps.arena.coop-vm.struct.vmarena.extendby.init */ + vmArena->extendBy = userSize; + + /* have to have a valid arena before calling ChunkCreate */ + vmArena->sig = VMArenaSig; + res = VMChunkCreate(&chunk, vmArena, userSize); + if (res != ResOK) + goto failChunkCreate; + arena->primary = chunk; + + /* .zoneshift: Set the zone shift to divide the chunk into the same */ + /* number of stripes as will fit into a reference set (the number of */ + /* bits in a word). Fail if the chunk is so small stripes are smaller */ + /* than pages. Note that some zones are discontiguous in the chunk if */ + /* the size is not a power of 2. See design.mps.arena.class.fields. */ + chunkSize = AddrOffset(chunk->base, chunk->limit); + arena->zoneShift = SizeFloorLog2(chunkSize >> MPS_WORD_SHIFT); + + AVERT(VMArena, vmArena); + if ((ArenaClass)mps_arena_class_vm() == class) + EVENT_PWW(ArenaCreateVM, arena, userSize, chunkSize); + else + EVENT_PWW(ArenaCreateVMNZ, arena, userSize, chunkSize); + *arenaReturn = arena; + return ResOK; + +failChunkCreate: + ArenaFinish(arena); +failArenaInit: + VMUnmap(arenaVM, VMBase(arenaVM), VMLimit(arenaVM)); +failVMMap: + VMDestroy(arenaVM); +failVMCreate: + return res; +} + + +/* VMArenaFinish -- finish the arena */ + +static void VMArenaFinish(Arena arena) +{ + VMArena vmArena; + Ring node, next; + VM arenaVM; + + vmArena = Arena2VMArena(arena); + AVERT(VMArena, vmArena); + arenaVM = vmArena->vm; + + sparePagesPurge(vmArena); + /* destroy all chunks */ + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + vmChunkDestroy(chunk); + } + AVER(arena->committed == VMMapped(arenaVM)); + + vmArena->sig = SigInvalid; + + ArenaFinish(arena); /* impl.c.global.finish.caller */ + + VMUnmap(arenaVM, VMBase(arenaVM), VMLimit(arenaVM)); + VMDestroy(arenaVM); + EVENT_P(ArenaDestroy, vmArena); +} + + +/* VMArenaReserved -- return the amount of reserved address space + * + * Add up the reserved space from all the chunks. + */ +static Size VMArenaReserved(Arena arena) +{ + Size reserved; + Ring node, next; + + reserved = 0; + RING_FOR(node, &arena->chunkRing, next) { + VMChunk vmChunk = Chunk2VMChunk(RING_ELT(Chunk, chunkRing, node)); + reserved += VMReserved(vmChunk->vm); + } + return reserved; +} + + +/* VMArenaSpareCommitExceeded -- handle excess spare pages */ + +static void VMArenaSpareCommitExceeded(Arena arena) +{ + VMArena vmArena; + + vmArena = Arena2VMArena(arena); + AVERT(VMArena, vmArena); + + sparePagesPurge(vmArena); + return; +} + + +/* Page Table Partial Mapping + * + * Some helper functions + */ + + +/* tablePageBaseIndex -- index of the first page descriptor falling + * (at least partially) on this table page + * + * .repr.table-page: Table pages are passed as the page's base address. + * + * .division: We calculate it by dividing the offset from the beginning + * of the page table by the size of a table element. This relies on + * .vm.addr-is-star. + */ +#define tablePageBaseIndex(chunk, tablePage) \ + (AddrOffset((Addr)(chunk)->pageTable, (tablePage)) \ + / sizeof(PageStruct)) + + +/* tablePageWholeBaseIndex + * + * Index of the first page descriptor wholly on this table page. + * Table page specified by address (not index). + */ +#define tablePageWholeBaseIndex(chunk, tablePage) \ + (AddrOffset((Addr)(chunk)->pageTable, \ + AddrAdd((tablePage), sizeof(PageStruct)-1)) \ + / sizeof(PageStruct)) + + +/* tablePageLimitIndex -- index of the first page descriptor falling + * (wholly) on the next table page + * + * Similar to tablePageBaseIndex, see .repr.table-page and .division. + */ +#define tablePageLimitIndex(chunk, tablePage) \ + ((AddrOffset((Addr)(chunk)->pageTable, (tablePage)) \ + + ChunkPageSize(chunk) - 1) \ + / sizeof(PageStruct) \ + + 1) + +/* tablePageWholeLimitIndex + * + * Index of the first page descriptor falling partially on the next + * table page. + */ +#define tablePageWholeLimitIndex(chunk, tablePage) \ + ((AddrOffset((Addr)(chunk)->pageTable, (tablePage)) \ + + ChunkPageSize(chunk)) \ + / sizeof(PageStruct)) + + +/* tablePageInUse -- Check whether a given page of the page table is in use + * + * Returns TRUE if and only if the table page given is in use, i.e., if + * any of the page descriptors falling on it (even partially) are being + * used. Relies on .repr.table-page and .vm.addr-is-star. + * + * .improve.limits: We don't need to check the parts we're (de)allocating. + */ +static Bool tablePageInUse(Chunk chunk, Addr tablePage) +{ + Index limitIndex; + + /* Check it's in the page table. */ + AVER((Addr)&chunk->pageTable[0] <= tablePage); + AVER(tablePage < addrOfPageDesc(chunk, chunk->pages)); + + if (tablePage == AddrPageBase(chunk, addrOfPageDesc(chunk, chunk->pages))) { + limitIndex = chunk->pages; + } else { + limitIndex = tablePageLimitIndex(chunk, tablePage); + } + AVER(limitIndex <= chunk->pages); + + return !BTIsResRange(chunk->allocTable, + tablePageBaseIndex(chunk, tablePage), limitIndex); +} + + +/* tablePagesUsed + * + * Takes a range of pages identified by [pageBase, pageLimit), and + * returns the pages occupied by the page table which store the + * PageStruct descriptors for those pages. + */ +static void tablePagesUsed(Index *tableBaseReturn, Index *tableLimitReturn, + Chunk chunk, Index pageBase, Index pageLimit) +{ + *tableBaseReturn = + PageTablePageIndex(chunk, + AddrPageBase(chunk, addrOfPageDesc(chunk, pageBase))); + *tableLimitReturn = + PageTablePageIndex(chunk, + AddrAlignUp(addrOfPageDesc(chunk, pageLimit), + ChunkPageSize(chunk))); + return; +} + + +/* tablePagesEnsureMapped -- ensure needed part of page table is mapped + * + * Pages from baseIndex to limitIndex are about to be allocated. + * Ensure that the relevant pages occupied by the page table are mapped. + */ +static Res tablePagesEnsureMapped(VMChunk vmChunk, + Index baseIndex, Index limitIndex) +{ + /* tableBaseIndex, tableLimitIndex, tableCursorIndex, */ + /* unmappedBase, unmappedLimit are all indexes of pages occupied */ + /* by the page table. */ + Index tableBaseIndex, tableLimitIndex; + Index tableCursorIndex; + Index unmappedBaseIndex, unmappedLimitIndex; + Index i; + Chunk chunk; + Res res; + + chunk = VMChunk2Chunk(vmChunk); + + tablePagesUsed(&tableBaseIndex, &tableLimitIndex, + chunk, baseIndex, limitIndex); + + tableCursorIndex = tableBaseIndex; + + while(BTFindLongResRange(&unmappedBaseIndex, &unmappedLimitIndex, + vmChunk->pageTableMapped, + tableCursorIndex, tableLimitIndex, + 1)) { + Addr unmappedBase = TablePageIndexBase(chunk, unmappedBaseIndex); + Addr unmappedLimit = TablePageIndexBase(chunk, unmappedLimitIndex); + /* There might be a page descriptor overlapping the beginning */ + /* of the range of table pages we are about to map. */ + /* We need to work out whether we should touch it. */ + if (unmappedBaseIndex == tableBaseIndex + && unmappedBaseIndex > 0 + && !BTGet(vmChunk->pageTableMapped, unmappedBaseIndex - 1)) { + /* Start with first descriptor wholly on page */ + baseIndex = tablePageWholeBaseIndex(chunk, unmappedBase); + } else { + /* start with first descriptor partially on page */ + baseIndex = tablePageBaseIndex(chunk, unmappedBase); + } + /* Similarly for the potentially overlapping page descriptor */ + /* at the end. */ + if (unmappedLimitIndex == tableLimitIndex + && unmappedLimitIndex < chunk->pageTablePages + && !BTGet(vmChunk->pageTableMapped, unmappedLimitIndex)) { + /* Finish with last descriptor wholly on page */ + limitIndex = tablePageBaseIndex(chunk, unmappedLimit); + } else if (unmappedLimitIndex == chunk->pageTablePages) { + /* Finish with last descriptor in chunk */ + limitIndex = chunk->pages; + } else { + /* Finish with last descriptor partially on page */ + limitIndex = tablePageWholeBaseIndex(chunk, unmappedLimit); + } + res = vmArenaMap(VMChunkVMArena(vmChunk), + vmChunk->vm, unmappedBase, unmappedLimit); + if (res != ResOK) + return res; + BTSetRange(vmChunk->pageTableMapped, unmappedBaseIndex, unmappedLimitIndex); + for(i = baseIndex; i < limitIndex; ++i) { + PageInit(chunk, i); + } + tableCursorIndex = unmappedLimitIndex; + if (tableCursorIndex == tableLimitIndex) + break; + } + + return ResOK; +} + + +/* tablePagesUnmapUnused + * + * Of the pages occupied by the page table from tablePageBase to + * tablePageLimit find those which are wholly unused and unmap them. + */ +static void tablePagesUnmapUnused(VMChunk vmChunk, + Addr tablePageBase, Addr tablePageLimit) +{ + Chunk chunk; + Addr cursor; + Size pageSize; + + chunk = VMChunk2Chunk(vmChunk); + pageSize = ChunkPageSize(chunk); + AVER(AddrIsAligned(tablePageBase, pageSize)); + AVER(AddrIsAligned(tablePageLimit, pageSize)); + + /* for loop indexes over base addresses of pages occupied by page table */ + for(cursor = tablePageBase; + cursor < tablePageLimit; + cursor = AddrAdd(cursor, pageSize)) { + if (!tablePageInUse(chunk, cursor)) { + vmArenaUnmap(VMChunkVMArena(vmChunk), vmChunk->vm, + cursor, AddrAdd(cursor, pageSize)); + AVER(BTGet(vmChunk->noSparePages, PageTablePageIndex(chunk, cursor))); + AVER(BTGet(vmChunk->pageTableMapped, PageTablePageIndex(chunk, cursor))); + BTRes(vmChunk->pageTableMapped, PageTablePageIndex(chunk, cursor)); + } + } + AVER(cursor == tablePageLimit); + + return; +} + + +/* pagesFindFreeInArea -- find a range of free pages in a given address range + * + * Search for a free run of pages in the free table, between the given + * base and limit. + * + * The downwards arg governs whether we use BTFindShortResRange (if + * downwards is FALSE) or BTFindShortResRangeHigh (if downwards is + * TRUE). This _roughly_ corresponds to allocating pages from top down + * (when downwards is TRUE), at least within an interval. It is used + * for implementing SegPrefHigh. + */ +static Bool pagesFindFreeInArea(Index *baseReturn, Chunk chunk, Size size, + Addr base, Addr limit, Bool downwards) +{ + Word pages; /* number of pages equiv. to size */ + Index basePage, limitPage; /* Index equiv. to base and limit */ + Index start, end; /* base and limit of free run */ + + AVER(AddrIsAligned(base, ChunkPageSize(chunk))); + AVER(AddrIsAligned(limit, ChunkPageSize(chunk))); + AVER(chunk->base <= base); + AVER(base < limit); + AVER(limit <= chunk->limit); + AVER(size <= AddrOffset(base, limit)); + AVER(size > (Size)0); + AVER(SizeIsAligned(size, ChunkPageSize(chunk))); + + basePage = INDEX_OF_ADDR(chunk, base); + limitPage = INDEX_OF_ADDR(chunk, limit); + pages = ChunkSizeToPages(chunk, size); + + if (downwards) { + if (!BTFindShortResRangeHigh(&start, &end, chunk->allocTable, + basePage, limitPage, pages)) + return FALSE; + } else { + if(!BTFindShortResRange(&start, &end, chunk->allocTable, + basePage, limitPage, pages)) + return FALSE; + } + + *baseReturn = start; + return TRUE; +} + + +/* pagesFindFreeInZones -- find a range of free pages with a ZoneSet + * + * This function finds the intersection of ZoneSet and the set of free + * pages and tries to find a free run of pages in the resulting set of + * areas. + * + * In other words, it finds space for a page whose ZoneSet (see + * ZoneSetOfPage) will be a subset of the specified ZoneSet. + * + * For meaning of downwards arg see pagesFindFreeInArea. + * .improve.findfree.downwards: This should be improved so that it + * allocates pages from top down globally, as opposed to (currently) + * just within an interval. + */ +static Bool pagesFindFreeInZones(Index *baseReturn, VMChunk *chunkReturn, + VMArena vmArena, Size size, ZoneSet zones, + Bool downwards) +{ + Arena arena; + Addr chunkBase, base, limit; + Size zoneSize; + Ring node, next; + + arena = VMArena2Arena(vmArena); + zoneSize = (Size)1 << arena->zoneShift; + + /* Should we check chunk cache first? */ + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + AVERT(Chunk, chunk); + + /* .alloc.skip: The first address available for arena allocation, */ + /* is just after the arena tables. */ + chunkBase = PageIndexBase(chunk, chunk->allocBase); + + base = chunkBase; + while(base < chunk->limit) { + if (ZoneSetIsMember(arena, zones, base)) { + /* Search for a run of zone stripes which are in the ZoneSet */ + /* and the arena. Adding the zoneSize might wrap round (to */ + /* zero, because limit is aligned to zoneSize, which is a */ + /* power of two). */ + limit = base; + do { + /* advance limit to next higher zone stripe boundary */ + limit = AddrAlignUp(AddrAdd(limit, 1), zoneSize); + + AVER(limit > base || limit == (Addr)0); + + if (limit >= chunk->limit || limit < base) { + limit = chunk->limit; + break; + } + + AVER(base < limit && limit < chunk->limit); + } while(ZoneSetIsMember(arena, zones, limit)); + + /* If the ZoneSet was universal, then the area found ought to */ + /* be the whole chunk. */ + AVER(zones != ZoneSetUNIV + || (base == chunkBase && limit == chunk->limit)); + + /* Try to allocate a page in the area. */ + if (AddrOffset(base, limit) >= size + && pagesFindFreeInArea(baseReturn, chunk, size, base, limit, + downwards)) { + *chunkReturn = Chunk2VMChunk(chunk); + return TRUE; + } + + base = limit; + } else { + /* Adding the zoneSize might wrap round (to zero, because */ + /* base is aligned to zoneSize, which is a power of two). */ + base = AddrAlignUp(AddrAdd(base, 1), zoneSize); + AVER(base > chunkBase || base == (Addr)0); + if (base >= chunk->limit || base < chunkBase) { + base = chunk->limit; + break; + } + } + } + + AVER(base == chunk->limit); + } + + return FALSE; +} + + +/* vmGenOfSegPref -- return generation specified by a segment preference */ + +static Serial vmGenOfSegPref(VMArena vmArena, SegPref pref) +{ + Serial gen; + + AVER(pref->isGen); + UNUSED(vmArena); + + gen = pref->gen; + if (gen >= VMArenaGenCount) { + gen = VMArenaGenCount - 1; + } + return gen; +} + + +/* pagesFindFreeWithSegPref -- find a range of free pages with given preferences + * + * Note this does not create or allocate any pages. + * + * basereturn: return parameter for the index in the + * chunk's page table of the base of the free area found. + * chunkreturn: return parameter for the chunk in which + * the free space has been found. + * pref: the SegPref object to be used when considering + * which zones to try. + * size: Size to find space for. + * barge: TRUE iff stealing space in zones used + * by other SegPrefs should be considered (if it's FALSE then only + * zones already used by this segpref or free zones will be used). + */ +static Bool pagesFindFreeWithSegPref(Index *baseReturn, VMChunk *chunkReturn, + VMArena vmArena, SegPref pref, Size size, + Bool barge) +{ + ZoneSet preferred; + + if (pref->isGen) { + Serial gen = vmGenOfSegPref(vmArena, pref); + preferred = vmArena->genZoneSet[gen]; + } else { + preferred = pref->zones; + } + + /* @@@@ Some of these tests might be duplicates. If we're about */ + /* to run out of virtual address space, then slow allocation is */ + /* probably the least of our worries. */ + + /* .alloc.improve.map: Define a function that takes a list */ + /* (say 4 long) of ZoneSets and tries pagesFindFreeInZones on */ + /* each one in turn. Extra ZoneSet args that weren't needed */ + /* could be ZoneSetEMPTY */ + + if (pref->isCollected) { /* GC'd memory */ + /* We look for space in the following places (in order) */ + /* - Zones already allocated to me (preferred) but are not */ + /* blacklisted; */ + /* - Zones that are either allocated to me, or are unallocated */ + /* but not blacklisted; */ + /* - Any non-blacklisted zone; */ + /* - Any zone; */ + /* Note that each is a superset of the previous, unless */ + /* blacklisted zones have been allocated (or the default */ + /* is used). */ + if (pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetDiff(preferred, vmArena->blacklist), + pref->high) + || pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetUnion(preferred, + ZoneSetDiff(vmArena->freeSet, + vmArena->blacklist)), + pref->high)) { + return TRUE; /* found */ + } + if (!barge) + /* do not barge into other zones, give up now */ + return FALSE; + if (pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetDiff(ZoneSetUNIV, vmArena->blacklist), + pref->high) + || pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetUNIV, pref->high)) { + return TRUE; /* found */ + } + } else { /* non-GC'd memory */ + /* We look for space in the following places (in order) */ + /* - Zones preferred (preferred) and blacklisted; */ + /* - Zones preferred; */ + /* - Zones preferred or blacklisted zone; */ + /* - Any zone. */ + /* Note that each is a superset of the previous, unless */ + /* blacklisted zones have been allocated. */ + if (pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetInter(preferred, vmArena->blacklist), + pref->high) + || pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + preferred, pref->high) + || pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetUnion(preferred, vmArena->blacklist), + pref->high) + || pagesFindFreeInZones(baseReturn, chunkReturn, vmArena, size, + ZoneSetUNIV, pref->high)) { + return TRUE; + } + } + return FALSE; +} + + +/* vmArenaExtend -- Extend the arena by making a new chunk + * + * The size arg specifies how much we wish to allocate after the extension. + */ +static Res vmArenaExtend(VMArena vmArena, Size size) +{ + Chunk newChunk; + Size chunkSize; + Res res; + + /* .improve.debug: @@@@ chunkSize (calculated below) won't */ + /* be big enough if the tables of the new chunk are */ + /* more than vmArena->extendBy (because there will be fewer than */ + /* size bytes free in the new chunk). Fix this. */ + chunkSize = vmArena->extendBy + size; + res = VMChunkCreate(&newChunk, vmArena, chunkSize); + /* .improve.chunk-create.fail: If we fail we could try again */ + /* (with a smaller size, say). We don't do this. */ + return res; +} + + +/* VM*AllocPolicy -- allocation policy methods */ + + +/* Used in abstracting allocation policy between VM and VMNZ */ +typedef Res (*VMAllocPolicyMethod)(Index *, VMChunk *, VMArena, SegPref, Size); + +static Res VMAllocPolicy(Index *baseIndexReturn, VMChunk *chunkReturn, + VMArena vmArena, SegPref pref, Size size) +{ + if (!pagesFindFreeWithSegPref(baseIndexReturn, chunkReturn, + vmArena, pref, size, FALSE)) { + /* try and extend, but don't worry if we can't */ + (void)vmArenaExtend(vmArena, size); + + /* We may or may not have a new chunk at this point */ + /* we proceed to try the allocation again anyway. */ + /* We specify barging, but if we have got a new chunk */ + /* then hopefully we won't need to barge. */ + if (!pagesFindFreeWithSegPref(baseIndexReturn, chunkReturn, + vmArena, pref, size, TRUE)) { + /* .improve.alloc-fail: This could be because the request was */ + /* too large, or perhaps the arena is fragmented. We could */ + /* return a more meaningful code. */ + return ResRESOURCE; + } + } + return ResOK; +} + +static Res VMNZAllocPolicy(Index *baseIndexReturn, VMChunk *chunkReturn, + VMArena vmArena, SegPref pref, Size size) +{ + if (pagesFindFreeInZones(baseIndexReturn, chunkReturn, vmArena, size, + ZoneSetUNIV, pref->high)) { + return ResOK; + } + return ResRESOURCE; +} + + +/* pageIsMapped -- checks whether a free page is mapped or not. */ + +static Bool pageIsMapped(VMChunk vmChunk, Index pi) +{ + Index pageTableBaseIndex; + Index pageTableLimitIndex; + int pageType; + Chunk chunk = VMChunk2Chunk(vmChunk); + + /* Note that unless the pi'th PageStruct crosses a page boundary */ + /* Base and Limit will differ by exactly 1. */ + /* They will differ by at most 2 assuming that */ + /* sizeof(PageStruct) <= ChunkPageSize(chunk) (!) */ + tablePagesUsed(&pageTableBaseIndex, &pageTableLimitIndex, chunk, pi, pi+1); + /* using unsigned arithmetic overflow to use just one comparison */ + AVER(pageTableLimitIndex - pageTableBaseIndex - 1 < 2); + + /* We can examine the PageStruct descriptor iff both table pages */ + /* are mapped. */ + if (BTGet(vmChunk->pageTableMapped, pageTableBaseIndex) + && BTGet(vmChunk->pageTableMapped, pageTableLimitIndex - 1)) { + pageType = PageType(&chunk->pageTable[pi]); + if (pageType == PageTypeSpare) + return TRUE; + AVER(pageType == PageTypeFree); + } + return FALSE; +} + + +/* sparePageRelease -- releases a spare page + * + * Either to allocate it or to purge it. + * Temporarily leaves it in an inconsistent state. + */ +static void sparePageRelease(VMChunk vmChunk, Index pi) +{ + Chunk chunk = VMChunk2Chunk(vmChunk); + Arena arena = ChunkArena(chunk); + + AVER(PageType(&chunk->pageTable[pi]) == PageTypeSpare); + AVER(arena->spareCommitted >= ChunkPageSize(chunk)); + arena->spareCommitted -= ChunkPageSize(chunk); + return; +} + + +/* pagesMarkAllocated -- Mark the pages allocated */ + +static Res pagesMarkAllocated(VMArena vmArena, VMChunk vmChunk, + Index baseIndex, Count pages, Pool pool) +{ + Index i; + Index limitIndex; + Index mappedBase, mappedLimit; + Index unmappedBase, unmappedLimit; + Chunk chunk = VMChunk2Chunk(vmChunk); + Res res; + + /* Ensure that the page descriptors we need are on mapped pages. */ + limitIndex = baseIndex + pages; + res = tablePagesEnsureMapped(vmChunk, baseIndex, limitIndex); + if (res != ResOK) + goto failTableMap; + + mappedBase = baseIndex; + mappedLimit = mappedBase; + + do { + while(pageIsMapped(vmChunk, mappedLimit)) { + ++mappedLimit; + if (mappedLimit >= limitIndex) + break; + } + AVER(mappedLimit <= limitIndex); + /* NB for loop will loop 0 times iff first page is not mapped */ + for(i = mappedBase; i < mappedLimit; ++i) { + sparePageRelease(vmChunk, i); + PageAlloc(chunk, i, pool); + } + if (mappedLimit >= limitIndex) + break; + unmappedBase = mappedLimit; + unmappedLimit = unmappedBase; + while(!pageIsMapped(vmChunk, unmappedLimit)) { + ++unmappedLimit; + if (unmappedLimit >= limitIndex) + break; + } + AVER(unmappedLimit <= limitIndex); + res = vmArenaMap(vmArena, vmChunk->vm, + PageIndexBase(chunk, unmappedBase), + PageIndexBase(chunk, unmappedLimit)); + if (res != ResOK) + goto failPagesMap; + for(i = unmappedBase; i < unmappedLimit; ++i) { + PageAlloc(chunk, i, pool); + } + mappedBase = unmappedLimit; + mappedLimit = mappedBase; + } while(mappedLimit < limitIndex); + AVER(mappedLimit == limitIndex); + + return ResOK; + +failPagesMap: + /* region from baseIndex to mappedLimit needs unmapping */ + if (baseIndex < mappedLimit) { + vmArenaUnmap(vmArena, vmChunk->vm, + PageIndexBase(chunk, baseIndex), + PageIndexBase(chunk, mappedLimit)); + /* mark pages as free */ + for(i = baseIndex; i < mappedLimit; ++i) { + TractFinish(PageTract(&chunk->pageTable[i])); + PageFree(chunk, i); + } + } + { + Index pageTableBaseIndex, pageTableLimitIndex; + /* find which pages of page table were affected */ + tablePagesUsed(&pageTableBaseIndex, &pageTableLimitIndex, + chunk, baseIndex, limitIndex); + /* Resetting the noSparePages bits is lazy, it means that */ + /* we don't have to bother trying to unmap unused portions */ + /* of the pageTable. */ + BTResRange(vmChunk->noSparePages, pageTableBaseIndex, pageTableLimitIndex); + } +failTableMap: + return res; +} + + +/* vmAllocComm -- allocate a region from the arena + * + * Common code used by mps_arena_class_vm and + * mps_arena_class_vmnz. + */ +static Res vmAllocComm(Addr *baseReturn, Tract *baseTractReturn, + VMAllocPolicyMethod policy, + SegPref pref, Size size, Pool pool) +{ + Addr base, limit; + Tract baseTract; + Arena arena; + Count pages; + Index baseIndex; + ZoneSet zones; + Res res; + VMArena vmArena; + VMChunk vmChunk; + Chunk chunk; + + AVER(baseReturn != NULL); + AVER(baseTractReturn != NULL); + AVER(FunCheck((Fun)policy)); + AVERT(SegPref, pref); + AVER(size > (Size)0); + AVERT(Pool, pool); + + arena = PoolArena(pool); + vmArena = Arena2VMArena(arena); + AVERT(VMArena, vmArena); + /* All chunks have same pageSize. */ + AVER(SizeIsAligned(size, ChunkPageSize(arena->primary))); + + /* NULL is used as a discriminator */ + /* (see design.mps.arena.vm.table.disc) therefore the real pool */ + /* must be non-NULL. */ + AVER(pool != NULL); + + /* Early check on commit limit. */ + if (arena->spareCommitted < size) { + Size necessaryCommitIncrease = size - arena->spareCommitted; + if (arena->committed + necessaryCommitIncrease > arena->commitLimit + || arena->committed + necessaryCommitIncrease < arena->committed) { + return ResCOMMIT_LIMIT; + } + } + + res = (*policy)(&baseIndex, &vmChunk, vmArena, pref, size); + if (res != ResOK) + return res; + + /* chunk (and baseIndex) should be initialised by policy */ + AVERT(VMChunk, vmChunk); + chunk = VMChunk2Chunk(vmChunk); + + /* Compute number of pages to be allocated. */ + pages = ChunkSizeToPages(chunk, size); + + res = pagesMarkAllocated(vmArena, vmChunk, baseIndex, pages, pool); + if (res != ResOK) { + if (arena->spareCommitted > 0) { + sparePagesPurge(vmArena); + res = pagesMarkAllocated(vmArena, vmChunk, baseIndex, pages, pool); + if (res != ResOK) + goto failPagesMap; + /* win! */ + } else { + goto failPagesMap; + } + } + + base = PageIndexBase(chunk, baseIndex); + baseTract = PageTract(&chunk->pageTable[baseIndex]); + limit = AddrAdd(base, size); + zones = ZoneSetOfRange(arena, base, limit); + + if (pref->isGen) { + Serial gen = vmGenOfSegPref(vmArena, pref); + vmArena->genZoneSet[gen] = ZoneSetUnion(vmArena->genZoneSet[gen], zones); + } + + vmArena->freeSet = ZoneSetDiff(vmArena->freeSet, zones); + + *baseReturn = base; + *baseTractReturn = baseTract; + return ResOK; + +failPagesMap: + return res; +} + + +static Res VMAlloc(Addr *baseReturn, Tract *baseTractReturn, + SegPref pref, Size size, Pool pool) +{ + /* All checks performed in common vmAllocComm */ + return vmAllocComm(baseReturn, baseTractReturn, + VMAllocPolicy, pref, size, pool); +} + +static Res VMNZAlloc(Addr *baseReturn, Tract *baseTractReturn, + SegPref pref, Size size, Pool pool) +{ + /* All checks performed in common vmAllocComm */ + return vmAllocComm(baseReturn, baseTractReturn, + VMNZAllocPolicy, pref, size, pool); +} + + +/* spareRangesMap -- map a function over spare ranges + * + * The function f is called on the ranges of spare pages which are + * within the range of pages from base to limit. PageStruct descriptors + * from base to limit should be mapped in the page table before calling + * this function. + */ +typedef void (*spareRangesFn)(VMChunk, Index, Index, void *); + +static void spareRangesMap(VMChunk vmChunk, Index base, Index limit, + spareRangesFn f, void *p) +{ + Index spareBase, spareLimit; + Chunk chunk = VMChunk2Chunk(vmChunk); + + AVER(base < limit); + + spareBase = base; + do { + while(!pageIsSpare(&chunk->pageTable[spareBase])) { + ++spareBase; + if (spareBase >= limit) + goto done; + } + spareLimit = spareBase; + while(pageIsSpare(&chunk->pageTable[spareLimit])) { + ++spareLimit; + if (spareLimit >= limit) + break; + } + f(vmChunk, spareBase, spareLimit, p); + spareBase = spareLimit; + } while(spareBase < limit); +done: + AVER(spareBase == limit); + + return; +} + + +/* vmArenaUnmapSpareRange + * + * Takes a range of spare pages and unmaps them, turning them into free pages. + */ +static void vmArenaUnmapSpareRange(VMChunk vmChunk, + Index rangeBase, Index rangeLimit, void *p) +{ + Index i; + Chunk chunk = VMChunk2Chunk(vmChunk); + + UNUSED(p); + for(i = rangeBase; i < rangeLimit; ++i) { + sparePageRelease(vmChunk, i); + PageInit(chunk, i); + } + vmArenaUnmap(VMChunkVMArena(vmChunk), vmChunk->vm, + PageIndexBase(chunk, rangeBase), + PageIndexBase(chunk, rangeLimit)); + + return; +} + + +/* sparePagesPurge -- all spare pages are found and purged (unmapped) + * + * This is currently the only way the spare pages are reduced. + * + * It uses the noSparePages bits to determine which areas of the + * pageTable to examine. + */ +static void sparePagesPurge(VMArena vmArena) +{ + Ring node, next; + Arena arena = VMArena2Arena(vmArena); + + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + VMChunk vmChunk = Chunk2VMChunk(chunk); + Index spareBaseIndex, spareLimitIndex; + Index tablePageCursor = 0; + + while(BTFindLongResRange(&spareBaseIndex, &spareLimitIndex, + vmChunk->noSparePages, + tablePageCursor, chunk->pageTablePages, + 1)) { + Addr spareTableBase, spareTableLimit; + Index pageBase, pageLimit; + Index tablePage; + + spareTableBase = TablePageIndexBase(chunk, spareBaseIndex); + spareTableLimit = TablePageIndexBase(chunk, spareLimitIndex); + /* Determine whether to use initial overlapping PageStruct. */ + if (spareBaseIndex > 0 + && !BTGet(vmChunk->pageTableMapped, spareBaseIndex - 1)) { + pageBase = tablePageWholeBaseIndex(chunk, spareTableBase); + } else { + pageBase = tablePageBaseIndex(chunk, spareTableBase); + } + for(tablePage = spareBaseIndex; tablePage < spareLimitIndex; + ++tablePage) { + /* Determine whether to use final overlapping PageStruct. */ + if (tablePage == spareLimitIndex - 1 + && spareLimitIndex < chunk->pageTablePages + && !BTGet(vmChunk->pageTableMapped, spareLimitIndex)) { + pageLimit = + tablePageWholeLimitIndex(chunk, + TablePageIndexBase(chunk, tablePage)); + } else if (tablePage == chunk->pageTablePages - 1) { + pageLimit = chunk->pages; + } else { + pageLimit = + tablePageLimitIndex(chunk, TablePageIndexBase(chunk, tablePage)); + } + if (pageBase < pageLimit) { + spareRangesMap(vmChunk, pageBase, pageLimit, + vmArenaUnmapSpareRange, NULL); + } else { + /* Only happens for last page occupied by the page table */ + /* and only then when that last page has just the tail end */ + /* part of the last page descriptor and nothing more. */ + AVER(pageBase == pageLimit); + AVER(tablePage == chunk->pageTablePages - 1); + } + BTSet(vmChunk->noSparePages, tablePage); + pageBase = pageLimit; + } + tablePagesUnmapUnused(vmChunk, spareTableBase, spareTableLimit); + tablePageCursor = spareLimitIndex; + if (tablePageCursor >= chunk->pageTablePages) { + AVER(tablePageCursor == chunk->pageTablePages); + break; + } + } + + } + + AVER(arena->spareCommitted == 0); + return; +} + + +/* VMFree -- free a region in the arena */ + +static void VMFree(Addr base, Size size, Pool pool) +{ + Arena arena; + VMArena vmArena; + VMChunk vmChunk; + Chunk chunk; + Count pages; + Index pi, piBase, piLimit; + Index pageTableBase; + Index pageTableLimit; + Bool foundChunk; + + AVER(base != NULL); + AVER(size > (Size)0); + AVERT(Pool, pool); + arena = PoolArena(pool); + AVERT(Arena, arena); + vmArena = Arena2VMArena(arena); + AVERT(VMArena, vmArena); + + /* All chunks have same pageSize. */ + AVER(SizeIsAligned(size, ChunkPageSize(arena->primary))); + AVER(AddrIsAligned(base, ChunkPageSize(arena->primary))); + + foundChunk = ChunkOfAddr(&chunk, arena, base); + AVER(foundChunk); + vmChunk = Chunk2VMChunk(chunk); + + /* Calculate the number of pages in the region */ + pages = ChunkSizeToPages(chunk, size); + piBase = INDEX_OF_ADDR(chunk, base); + piLimit = piBase + pages; + AVER(piBase < piLimit); + AVER(piLimit <= chunk->pages); + + /* loop from pageBase to pageLimit-1 inclusive */ + /* Finish each Tract found, then convert them to spare pages. */ + for(pi = piBase; pi < piLimit; ++pi) { + Page page = &chunk->pageTable[pi]; + Tract tract = PageTract(page); + AVER(TractPool(tract) == pool); + + TractFinish(tract); + PagePool(page) = NULL; + PageType(page) = PageTypeSpare; + } + arena->spareCommitted += ChunkPagesToSize(chunk, piLimit - piBase); + BTResRange(chunk->allocTable, piBase, piLimit); + + tablePagesUsed(&pageTableBase, &pageTableLimit, chunk, piBase, piLimit); + BTResRange(vmChunk->noSparePages, pageTableBase, pageTableLimit); + + if (arena->spareCommitted > arena->spareCommitLimit) { + sparePagesPurge(vmArena); + } + /* @@@@ Chunks are never freed. */ + + return; +} + + +/* VMArenaClass -- The VM arena class definition */ + +DEFINE_ARENA_CLASS(VMArenaClass, this) +{ + INHERIT_CLASS(this, AbstractArenaClass); + this->name = "VM"; + this->size = sizeof(VMArenaStruct); + this->offset = offsetof(VMArenaStruct, arenaStruct); + this->init = VMArenaInit; + this->finish = VMArenaFinish; + this->reserved = VMArenaReserved; + this->spareCommitExceeded = VMArenaSpareCommitExceeded; + this->alloc = VMAlloc; + this->free = VMFree; + this->chunkInit = VMChunkInit; + this->chunkFinish = VMChunkFinish; +} + + +/* VMNZArenaClass -- The VMNZ arena class definition + * + * VMNZ is just VMArena with a different allocation policy. + */ +DEFINE_ARENA_CLASS(VMNZArenaClass, this) +{ + INHERIT_CLASS(this, VMArenaClass); + this->name = "VMNZ"; + this->alloc = VMNZAlloc; +} + + +/* mps_arena_class_vm -- return the arena class VM */ + +mps_arena_class_t mps_arena_class_vm(void) +{ + return (mps_arena_class_t)VMArenaClassGet(); +} + + +/* mps_arena_class_vmnz -- return the arena class VMNZ */ + +mps_arena_class_t mps_arena_class_vmnz(void) +{ + return (mps_arena_class_t)VMNZArenaClassGet(); +} diff --git a/mps/code/arenavmx.c b/mps/code/arenavmx.c new file mode 100644 index 00000000000..5a77e29850c --- /dev/null +++ b/mps/code/arenavmx.c @@ -0,0 +1,32 @@ +/* impl.c.arenavmx: STUBS FOR ARENAVM + * + * $HopeName: MMsrc!arenavmx.c(trunk.3) $ + * Copyright (C) 1999 Harlequin Group plc. All rights reserved. + * + * .purpose: This file is not properly part of the MPS. It is a + * convenience file for EP-Core who do _not_ wish to get a link error, + * when they link to a VM arena function on a platform where it isn't + * supported (see req.epcore.link.no-error). + * + * .stub: This file provides stub functions for the VM arena class + * functions. Calling any of them causes a run-time assertion. + */ + + +#include "mpm.h" +#include "mpsavm.h" + +SRCID(arenavmx, "$HopeName: MMsrc!arenavmx.c(trunk.3) $"); + + +mps_arena_class_t mps_arena_class_vm(void) +{ + NOTREACHED; + return (mps_arena_class_t)NULL; +} + +mps_arena_class_t mps_arena_class_vmnz(void) +{ + NOTREACHED; + return (mps_arena_class_t)NULL; +} diff --git a/mps/code/assert.c b/mps/code/assert.c new file mode 100644 index 00000000000..206112e5d30 --- /dev/null +++ b/mps/code/assert.c @@ -0,0 +1,71 @@ +/* impl.c.assert: ASSERTION IMPLEMENTATION + * + * $HopeName$ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * This source provides the AssertFail function which is + * invoked by the assertion macros (see impl.h.assert). + * It also provides for user-installed assertion failure handlers. + */ + +#include "check.h" +#include "mpm.h" + +SRCID(assert, "$HopeName: MMsrc!assert.c(trunk.11) $"); + + +/* CheckLevel -- Control check level + * + * This controls the behaviour of Check methods unless MPS_HOT_RED + * is defined, when it is effectively stuck at "CheckNONE". + */ + +unsigned CheckLevel = CheckSHALLOW; + + +static void AssertLib(const char *cond, const char *id, + const char *file, unsigned line) +{ + WriteF(mps_lib_stderr, + "\n" + "MPS ASSERTION FAILURE\n" + "\n" + "Id: $S\n", id, + "File: $S\n", file, + "Line: $U\n", (WriteFU)line, + "Condition: $S\n", cond, + "\n", + NULL); + + mps_lib_abort(); +} + + +static AssertHandler handler = &AssertLib; + + +AssertHandler AssertDefault(void) +{ + return &AssertLib; +} + + +AssertHandler AssertInstall(AssertHandler new) +{ + AssertHandler prev = handler; + handler = new; + return prev; +} + + +/* AssertFail -- fail an assertion + * + * This function is called when an ASSERT macro fails a test. It + * calls the installed assertion handler, if it is not NULL. If + * handler returns the progam continues. + */ +void AssertFail1(const char *s) +{ + if (handler != NULL) + (*handler)(s, "", "", 0); +} diff --git a/mps/code/awlut.c b/mps/code/awlut.c new file mode 100644 index 00000000000..58827e9d6cc --- /dev/null +++ b/mps/code/awlut.c @@ -0,0 +1,323 @@ +/* impl.c.awlut: POOL CLASS AWL UNIT TEST + * + * $HopeName: MMsrc!awlut.c(trunk.17) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: see design.mps.poolawl.test.* + */ + +#include "mpscawl.h" +#include "mpsclo.h" +#include "mpsavm.h" +#include "fmtdy.h" +#include "testlib.h" +#include "mps.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include + + +#define testArenaSIZE ((size_t)64<<20) +#define TABLE_SLOTS 49 +#define ITERATIONS 5000 +#define CHATTER 100 + + +static mps_word_t bogus_class; + +#define UNINIT 0x041412ED + +#define DYLAN_ALIGN 4 /* depends on value defined in fmtdy.c */ + + +/* size_tAlignUp -- align w up to alignment a */ + +#define size_tAlignUp(w, a) (((w) + (a) - 1) & ~((size_t)(a) - 1)) + + +static mps_word_t wrapper_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* Extra word */ + 4uL<<2|2, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8), /* V */ + 1uL<<2|1, /* VL */ + 1 /* patterns */ +}; + + +static mps_word_t string_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* extra word */ + 0, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8)|3uL<<3|4, /* V */ + 1 /* VL */ +}; + +static mps_word_t table_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* extra word */ + 1uL<<2|1, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8)|2, /* V */ + 1 /* VL */ +}; + + +static void initialise_wrapper(mps_word_t *wrapper) +{ + wrapper[0] = (mps_word_t)&wrapper_wrapper; + wrapper[1] = (mps_word_t)&bogus_class; +} + + +/* alloc_string - create a dylan string object + * + * create a dylan string object (byte vector) whose contents + * are the string s (including the terminating NUL) + * .assume.dylan-obj + */ + +static mps_word_t *alloc_string(char *s, mps_ap_t ap) +{ + size_t l; + size_t objsize; + void *p; + mps_word_t *object; + + l = strlen(s)+1; + /* number of words * sizeof word */ + objsize = (2 + (l+sizeof(mps_word_t)-1)/sizeof(mps_word_t)) + * sizeof(mps_word_t); + objsize = size_tAlignUp(objsize, DYLAN_ALIGN); + do { + size_t i; + char *s2; + + die(mps_reserve(&p, ap, objsize), "Reserve Leaf\n"); + object = p; + object[0] = (mps_word_t)string_wrapper; + object[1] = l << 2 | 1; + s2 = (char *)&object[2]; + for(i = 0; i < l; ++i) { + s2[i] = s[i]; + } + } while(!mps_commit(ap, p, objsize)); + return object; +} + + +/* alloc_table -- create a table with n variable slots + * + * .assume.dylan-obj + */ + +static mps_word_t *alloc_table(unsigned long n, mps_ap_t ap) +{ + size_t objsize; + void *p; + mps_word_t *object; + + objsize = (3 + n) * sizeof(mps_word_t); + objsize = size_tAlignUp(objsize, MPS_PF_ALIGN); + do { + unsigned long i; + + die(mps_reserve(&p, ap, objsize), "Reserve Table\n"); + object = p; + object[0] = (mps_word_t)table_wrapper; + object[1] = 0; + object[2] = n << 2 | 1; + for(i = 0; i < n; ++i) { + object[3+i] = 0; + } + } while(!mps_commit(ap, p, objsize)); + return object; +} + + +/* gets the nth slot from a table + * .assume.dylan-obj + */ +static mps_word_t *table_slot(mps_word_t *table, unsigned long n) +{ + return (mps_word_t *)table[3+n]; +} + + +/* sets the nth slot in a table + * .assume.dylan-obj + */ +static void set_table_slot(mps_word_t *table, + unsigned long n, mps_word_t *p) +{ + cdie(table[0] == (mps_word_t)table_wrapper, "set_table_slot"); + table[3+n] = (mps_word_t)p; +} + + +/* links two tables together via their link slot + * (1st fixed part slot) + */ +static void table_link(mps_word_t *t1, mps_word_t *t2) +{ + cdie(t1[0] == (mps_word_t)table_wrapper, "table_link 1"); + cdie(t2[0] == (mps_word_t)table_wrapper, "table_link 2"); + t1[1] = (mps_word_t)t2; + t2[1] = (mps_word_t)t1; +} + + +static void test(mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap, + mps_ap_t bogusap) +{ + mps_word_t *weaktable; + mps_word_t *exacttable; + mps_word_t *preserve[TABLE_SLOTS]; /* preserves objects in the weak */ + /* table by referring to them */ + unsigned long i, j; + void *p; + + exacttable = alloc_table(TABLE_SLOTS, exactap); + weaktable = alloc_table(TABLE_SLOTS, weakap); + table_link(exacttable, weaktable); + + /* Leave bogusap between reserve and commit for the duration */ + die(mps_reserve(&p, bogusap, 64), "Reserve bogus"); + + for(i = 0; i < TABLE_SLOTS; ++i) { + mps_word_t *string; + if (rnd() % 2 == 0) { + string = alloc_string("iamalive", leafap); + preserve[i] = string; + } else { + string = alloc_string("iamdead", leafap); + preserve[i] = 0; + } + set_table_slot(weaktable, i, string); + string = alloc_string("iamexact", leafap); + set_table_slot(exacttable, i, string); + } + + for(j = 0; j < ITERATIONS; ++j) { + for(i = 0; i < TABLE_SLOTS; ++i) { + mps_word_t *string; + + string = alloc_string("spong", leafap); + } + } + + for(i = 0; i < TABLE_SLOTS; ++i) { + if (preserve[i] == 0) { + if (table_slot(weaktable, i)) { + error("Strongly unreachable weak table entry found, slot %lu.\n", i); + } else { + if (table_slot(exacttable, i) != 0) { + error("Weak table entry deleted, but corresponding " + "exact table entry not deleted, slot %lu.\n", i); + } + } + } + } + + (void)mps_commit(bogusap, p, 64); +} + + +/* setup -- set up pools for the test + * + * v serves two purposes: + * - a pseudo stack base for the stack root. + * - pointer to a guff structure, which packages some values needed + * (arena and thr mostly) + */ + +struct guff_s { + mps_arena_t arena; + mps_thr_t thr; +}; + +static void *setup(void *v, size_t s) +{ + struct guff_s *guff; + mps_arena_t arena; + mps_pool_t leafpool; + mps_pool_t tablepool; + mps_fmt_t dylanfmt; + mps_fmt_t dylanweakfmt; + mps_ap_t leafap, exactap, weakap, bogusap; + mps_root_t stack; + mps_thr_t thr; + + guff = (struct guff_s *)v; + (void)s; + arena = guff->arena; + thr = guff->thr; + + die(mps_root_create_reg(&stack, arena, MPS_RANK_AMBIG, 0, thr, + mps_stack_scan_ambig, v, 0), + "Root Create\n"); + die(mps_fmt_create_A(&dylanfmt, arena, dylan_fmt_A()), + "Format Create\n"); + die(mps_fmt_create_A(&dylanweakfmt, arena, dylan_fmt_A_weak()), + "Format Create (weak)\n"); + die(mps_pool_create(&leafpool, arena, mps_class_lo(), dylanfmt), + "Leaf Pool Create\n"); + die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt), + "Table Pool Create\n"); + die(mps_ap_create(&leafap, leafpool, MPS_RANK_EXACT), + "Leaf AP Create\n"); + die(mps_ap_create(&exactap, tablepool, MPS_RANK_EXACT), + "Exact AP Create\n"); + die(mps_ap_create(&weakap, tablepool, MPS_RANK_WEAK), + "Weak AP Create\n"); + die(mps_ap_create(&bogusap, tablepool, MPS_RANK_EXACT), + "Bogus AP Create\n"); + + test(leafap, exactap, weakap, bogusap); + + mps_ap_destroy(bogusap); + mps_ap_destroy(weakap); + mps_ap_destroy(exactap); + mps_ap_destroy(leafap); + mps_pool_destroy(tablepool); + mps_pool_destroy(leafpool); + mps_fmt_destroy(dylanweakfmt); + mps_fmt_destroy(dylanfmt); + mps_root_destroy(stack); + + return NULL; +} + + +int main(int argc, char **argv) +{ + struct guff_s guff; + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + initialise_wrapper(wrapper_wrapper); + initialise_wrapper(string_wrapper); + initialise_wrapper(table_wrapper); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create\n"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + guff.arena = arena; + guff.thr = thread; + mps_tramp(&r, setup, &guff, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/awlutth.c b/mps/code/awlutth.c new file mode 100644 index 00000000000..cecdc77bfbc --- /dev/null +++ b/mps/code/awlutth.c @@ -0,0 +1,332 @@ +/* impl.c.awlutth: THREADING UNIT TEST USING POOL CLASS AWL + * + * $HopeName: MMsrc!awlutth.c(trunk.1) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: see design.mps.poolawl.test.* + */ + +#include "mpscawl.h" +#include "mpsclo.h" +#include "mpsavm.h" +#include "fmtdy.h" +#include "testlib.h" +#include "mps.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include +#ifdef MPS_OS_LI +#include +#endif + + +#define testArenaSIZE ((size_t)64<<20) +#define TABLE_SLOTS 50 +#define ITERATIONS 5000 +#define CHATTER 100 +/* The number that a half of all numbers generated from rnd are less + * than. Hence, probability a-half, or P a-half */ +/* see impl.h.testlib */ +#define P_A_HALF (1024uL*1024uL*1024uL - 1) /* 2^30 - 1 */ + + +static mps_word_t bogus_class; + +#define UNINIT 0x041412ED + +#define DYLAN_ALIGN 4 /* depends on value defined in fmtdy.c */ + + +static mps_word_t wrapper_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* Extra word */ + 4uL<<2|2, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8), /* V */ + 1uL<<2|1, /* VL */ + 1 /* patterns */ +}; + + +static mps_word_t string_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* extra word */ + 0, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8)|3uL<<3|4, /* V */ + 1 /* VL */ +}; + +static mps_word_t table_wrapper[] = { + UNINIT, /* wrapper */ + UNINIT, /* class */ + 0, /* extra word */ + 1uL<<2|1, /* F */ + 2uL<<(MPS_WORD_WIDTH - 8)|2, /* V */ + 1 /* VL */ +}; + + +static void initialise_wrapper(mps_word_t *wrapper) +{ + wrapper[0] = (mps_word_t)&wrapper_wrapper; + wrapper[1] = (mps_word_t)&bogus_class; +} + + +/* create a dylan string object (byte vector) whose contents + * are the string s (including the terminating NUL) + * .assume.dylan-obj */ +static mps_word_t *alloc_string(char *s, mps_ap_t ap) +{ + size_t l; + size_t objsize; + void *p; + mps_word_t *object; + + l = strlen(s)+1; + /* number of words * sizeof word */ + objsize = (2 + (l+sizeof(mps_word_t)-1)/sizeof(mps_word_t)) * + sizeof(mps_word_t); + objsize = (objsize + DYLAN_ALIGN-1)/DYLAN_ALIGN*DYLAN_ALIGN; + do { + size_t i; + char *s2; + + die(mps_reserve(&p, ap, objsize), "Reserve Leaf\n"); + object = p; + object[0] = (mps_word_t)string_wrapper; + object[1] = l << 2 | 1; + s2 = (char *)&object[2]; + for(i = 0; i < l; ++i) { + s2[i] = s[i]; + } + } while(!mps_commit(ap, p, objsize)); + return object; +} + + +/* alloc_table -- create a table with n variable slots + * + * .assume.dylan-obj + */ +static mps_word_t *alloc_table(unsigned long n, mps_ap_t ap) +{ + size_t objsize; + void *p; + mps_word_t *object; + objsize = (4 + n) * sizeof(mps_word_t); + objsize = (objsize + MPS_PF_ALIGN-1)/MPS_PF_ALIGN*MPS_PF_ALIGN; + do { + unsigned long i; + + die(mps_reserve(&p, ap, objsize), "Reserve Table\n"); + object = p; + object[0] = (mps_word_t)table_wrapper; + object[1] = 0; + object[2] = n << 2 | 1; + for(i = 0; i < n; ++i) { + object[3+i] = 0; + } + } while(!mps_commit(ap, p, objsize)); + return object; +} + + +/* gets the nth slot from a table + * .assume.dylan-obj + */ +static mps_word_t *table_slot(mps_word_t *table, unsigned long n) +{ + return (mps_word_t *)table[3+n]; +} + +/* sets the nth slot in a table + * .assume.dylan-obj + */ +static void set_table_slot(mps_word_t *table, + unsigned long n, mps_word_t *p) +{ + cdie(table[0] == (mps_word_t)table_wrapper, "set_table_slot"); + table[3+n] = (mps_word_t)p; +} + +/* links two tables together via their link slot + * (1st fixed part slot) + */ +static void table_link(mps_word_t *t1, mps_word_t *t2) +{ + cdie(t1[0] == (mps_word_t)table_wrapper, "table_link 1"); + cdie(t2[0] == (mps_word_t)table_wrapper, "table_link 2"); + t1[1] = (mps_word_t)t2; + t2[1] = (mps_word_t)t1; +} + + +static void test(mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap, + mps_ap_t bogusap) +{ + mps_word_t *weaktable; + mps_word_t *exacttable; + mps_word_t *preserve[TABLE_SLOTS]; /* preserves objects in the weak */ + /* table by referring to them */ + unsigned long i, j; + void *p; + + exacttable = alloc_table(TABLE_SLOTS, exactap); + weaktable = alloc_table(TABLE_SLOTS, weakap); + table_link(exacttable, weaktable); + + /* Leave bogusap between reserve and commit for the duration */ + die(mps_reserve(&p, bogusap, 64), "Reserve bogus"); + + for(i = 0; i < TABLE_SLOTS; ++i) { + mps_word_t *string; + if(rnd() < P_A_HALF) { + string = alloc_string("iamalive", leafap); + preserve[i] = string; + } else { + string = alloc_string("iamdead", leafap); + preserve[i] = 0; + } + set_table_slot(weaktable, i, string); + string = alloc_string("iamexact", leafap); + set_table_slot(exacttable, i, string); + } + + for(j = 0; j < ITERATIONS; ++j) { + for(i = 0; i < TABLE_SLOTS; ++i) { + mps_word_t *string; + + string = alloc_string("spong", leafap); + } + } + + for(i = 0; i < TABLE_SLOTS; ++i) { + if(preserve[i] == 0) { + if(table_slot(weaktable, i)) { + fprintf(stdout, + "Strongly unreachable weak table entry found, " + "slot %lu.\n", + i); + } else { + if(table_slot(exacttable, i) != 0) { + fprintf(stdout, + "Weak table entry deleted, but corresponding " + "exact table entry not deleted, slot %lu.\n", + i); + } + } + } + } + + (void)mps_commit(bogusap, p, 64); + puts("A okay\n"); +} + + +struct guff_s { + mps_arena_t arena; + mps_thr_t thr; +}; + +/* v serves two purposes: + * A pseudo stack base for the stack root. + * Pointer to a guff structure, which packages some values needed + * (arena and thr mostly) */ +static void *setup(void *v, size_t s) +{ + struct guff_s *guff; + mps_arena_t arena; + mps_pool_t leafpool; + mps_pool_t tablepool; + mps_fmt_t dylanfmt; + mps_fmt_t dylanweakfmt; + mps_ap_t leafap, exactap, weakap, bogusap; + mps_root_t stack; + mps_thr_t thr; + + guff = (struct guff_s *)v; + (void)s; + arena = guff->arena; + thr = guff->thr; + + die(mps_root_create_reg(&stack, arena, MPS_RANK_AMBIG, 0, thr, + mps_stack_scan_ambig, v, 0), + "Root Create\n"); + die(mps_fmt_create_A(&dylanfmt, arena, dylan_fmt_A()), + "Format Create\n"); + die(mps_fmt_create_A(&dylanweakfmt, arena, dylan_fmt_A_weak()), + "Format Create (weak)\n"); + die(mps_pool_create(&leafpool, arena, mps_class_lo(), dylanfmt), + "Leaf Pool Create\n"); + die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt), + "Table Pool Create\n"); + die(mps_ap_create(&leafap, leafpool, MPS_RANK_EXACT), + "Leaf AP Create\n"); + die(mps_ap_create(&exactap, tablepool, MPS_RANK_EXACT), + "Exact AP Create\n"); + die(mps_ap_create(&weakap, tablepool, MPS_RANK_WEAK), + "Weak AP Create\n"); + die(mps_ap_create(&bogusap, tablepool, MPS_RANK_EXACT), + "Bogus AP Create\n"); + + test(leafap, exactap, weakap, bogusap); + + mps_ap_destroy(bogusap); + mps_ap_destroy(weakap); + mps_ap_destroy(exactap); + mps_ap_destroy(leafap); + mps_pool_destroy(tablepool); + mps_pool_destroy(leafpool); + mps_fmt_destroy(dylanweakfmt); + mps_fmt_destroy(dylanfmt); + mps_root_destroy(stack); + + return NULL; +} + + +static void *setup_thr(void *v) +{ + struct guff_s guff; + mps_arena_t arena = (mps_arena_t)v; + mps_thr_t thread; + void *r; + + die(mps_thread_reg(&thread, arena), "thread_reg"); + guff.arena = arena; + guff.thr = thread; + mps_tramp(&r, setup, &guff, 0); + mps_thread_dereg(thread); + + return r; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + pthread_t pthread1; + + randomize(argc, argv); + + initialise_wrapper(wrapper_wrapper); + initialise_wrapper(string_wrapper); + initialise_wrapper(table_wrapper); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create\n"); + pthread_create(&pthread1, NULL, setup_thr, (void *)arena); + setup_thr(arena); + pthread_join(pthread1, NULL); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/boot.c b/mps/code/boot.c new file mode 100644 index 00000000000..7888c8e381e --- /dev/null +++ b/mps/code/boot.c @@ -0,0 +1,125 @@ +/* impl.c.boot: BOOTSTRAP ALLOCATOR + * + * $HopeName: MMsrc!boot.c(MMdevel_pekka_locus.2) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .overview: A structure and protocols for allocating memory from a + * given block. Very simple, it basically just increments a pointer. + * + * .boot.c: The Bootstrap Allocator is used to allocate C structures + * for use in the implementation, not client objects. Therefore, + * we use "C types" (void *, size_t) not "client types" (Addr, Size). + */ + +#include "boot.h" +#include "mpm.h" + +SRCID(boot, "$HopeName: MMsrc!boot.c(MMdevel_pekka_locus.2) $"); + + +#define BootBlockSig ((Sig)0x519B002B) /* SIGnature BOOT Block */ + + +/* BootBlockCheck -- check a BootBlock structure */ + +Bool BootBlockCheck(BootBlock boot) +{ + CHECKS(BootBlock, boot); + CHECKL(boot->base != NULL); + CHECKL(boot->alloc != NULL); + CHECKL(boot->limit != NULL); + CHECKL(boot->base <= boot->alloc); + CHECKL(boot->alloc <= boot->limit); + CHECKL(boot->alloc < boot->limit); + + return TRUE; +} + + +/* BootBlockInit -- initialize a BootBlock + * + * boot: a pointer to the structure to be initialized + * (must have been allocated by the caller, probably on the stack). + * base: a pointer to the base of the memory to be allocated from + * from (the memory need not be committed) + * limit: a pointer to the limit of the memory to be allocated from + */ + +Res BootBlockInit(BootBlockStruct *boot, void *base, void *limit) +{ + /* Can't check boot as we are supposed to be initializing it */ + AVER(boot != NULL); + AVER(base != NULL); + AVER(limit != NULL); + AVER(base < limit); + + boot->base = base; + boot->alloc = base; + boot->limit = limit; + boot->sig = BootBlockSig; + + AVERT(BootBlock, boot); + return ResOK; +} + + +/* BootBlockFinish -- finish a BootBlock structure */ + +void BootBlockFinish(BootBlock boot) +{ + AVERT(BootBlock, boot); + + boot->base = boot->alloc = boot->limit = NULL; + boot->sig = SigInvalid; +} + + +/* BootAllocated + * + * Returns the total amount allocated using this descriptor + */ +size_t BootAllocated(BootBlock boot) +{ + AVERT(BootBlock, boot); + + return PointerOffset(boot->base, boot->alloc); +} + + +/* BootAlloc -- allocate from BootBlock structure + * + * preturn: The returned pointer, see .boot.c. + * boot: must have been initialized with BootBlockInit(). + * size: size of requested object, see .boot.c. + * align: required alignment of object, see .boot.c. + */ + +Res BootAlloc(void **pReturn, BootBlock boot, size_t size, size_t align) +{ + void *blockBase, *blockLimit; /* base, limit of candidate block */ + + AVER(pReturn != NULL); + AVERT(BootBlock, boot); + AVER(size > 0); + AVER(AlignCheck((Align)align)); + + /* Align alloc pointer up and bounds check. */ + blockBase = PointerAlignUp(boot->alloc, align); + if(boot->limit <= blockBase || blockBase < boot->alloc) { + return ResMEMORY; + } + blockLimit = PointerAdd(blockBase, size); + /* Following checks that the ordering constraint holds: */ + /* boot->alloc <= blockBase < blockLimit <= boot->limit */ + /* (if it doesn't hold then something overallocated/wrapped round) */ + if(blockBase < boot->alloc || + blockLimit <= blockBase || + boot->limit < blockLimit) { + return ResMEMORY; + } + + /* Fits! So allocate it */ + boot->alloc = blockLimit; + *pReturn = blockBase; + return ResOK; +} diff --git a/mps/code/boot.h b/mps/code/boot.h new file mode 100644 index 00000000000..04b1c80d0f0 --- /dev/null +++ b/mps/code/boot.h @@ -0,0 +1,34 @@ +/* impl.h.boot: BOOTSTRAP ALLOCATOR INTERFACE + * + * $HopeName: MMsrc!boot.h(MMdevel_pekka_locus.2) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .overview: A protocol for allocating memory from a given block. + */ + +#ifndef boot_h +#define boot_h + +#include "mpmtypes.h" + + +/* BootBlockStruct -- descriptor of the block to allocate from */ + +typedef struct BootBlockStruct +{ + Sig sig; + void *base; + void *alloc; + void *limit; +} BootBlockStruct; + + +extern Res BootBlockInit(BootBlockStruct *boot, void *base, void *limit); +extern void BootBlockFinish(BootBlock boot); +extern Res BootAlloc(void **pReturn, BootBlock boot, size_t size, + size_t align); +extern size_t BootAllocated(BootBlock boot); +extern Bool BootBlockCheck(BootBlock boot); + + +#endif /* boot_h */ diff --git a/mps/code/bt.c b/mps/code/bt.c new file mode 100644 index 00000000000..e1fd8bfb6c6 --- /dev/null +++ b/mps/code/bt.c @@ -0,0 +1,1001 @@ +/* impl.c.bt: BIT TABLES + * + * $HopeName: MMsrc!bt.c(trunk.24) $ + * Copyright (C) 1999. Harlequin Limited. All rights reserved. + * + * READERSHIP + * + * .readership: Any MPS developer + * + * DESIGN + * + * .design: see design.mps.bt + */ + +#include "mpm.h" + + +SRCID(bt, "$HopeName: MMsrc!bt.c(trunk.24) $"); + + +/* BTIndexAlignUp, BTIndexAlignDown -- Align bit-table indices + * + * Align bit-table indices up and down to word boundaries + */ + +#define BTIndexAlignUp(index) (IndexAlignUp((index), MPS_WORD_WIDTH)) +#define BTIndexAlignDown(index) (IndexAlignDown((index), MPS_WORD_WIDTH)) + + +/* BTMask -- generate sub-word masks + * + * Create a mask with only specified bits set + */ + +/* Return a word mask of bits set only from base and above */ +#define BTMaskLow(base) (~(Word)0 << (base)) + +/* Return a word mask of bits set only below limit */ +#define BTMaskHigh(limit) (~(Word)0 >> (MPS_WORD_WIDTH - (limit))) + +/* Return a word mask of bits set only in requested range */ +#define BTMask(base,limit) (BTMaskHigh((limit)) & BTMaskLow((base))) + + +/* BTWordIndex, BTBitIndex -- Decode BT indexes + * + * Return word and bit indexes from index + */ + +#define BTWordIndex(index) ((index) >> MPS_WORD_SHIFT) +#define BTBitIndex(index) ((index) & (MPS_WORD_WIDTH - 1)) + + +/* BTIsSmallRange -- test range size + * + * Predicate to determine whether a range is sufficiently small + * that it's not worth trying to separate words and odd bits. + * The choice of what counts as "sufficiently small" is made + * for efficiency reasons. Empirical evidence indicates that + * a good choice is ranges of size 6 or less. + */ + +#define BTIsSmallRange(base,limit) ((base) + 6 >= (limit)) + + +/* ACT_ON_RANGE -- macro to act on a base-limit range + * + * Three actions should be provided: + * - single_action(btIndex) - operates on a single bit + * - bits_action(wordIndex, base, limit) -- operates on part-words + * - word_action(wordIndex) -- Operates on full words in range + * WORD_ACTIONs should not use break or continue. + * + * If the range is small enough it will be processed a single + * bit at a time. Larger ranges are processed as words where + * possible, and part-words for boundary bits. + */ + +#define ACT_ON_RANGE(base,limit,single_action, \ + bits_action,word_action) \ + BEGIN \ + if (BTIsSmallRange((base), (limit))) { \ + /* Small ranges are processed most efficiently bit-by-bit */ \ + Index actBit; \ + for (actBit = (base); actBit < (limit); ++actBit) { \ + single_action(actBit); \ + } \ + } else { \ + Index actInnerBase = BTIndexAlignUp((base)); \ + if (actInnerBase > (limit)) { /* no inner range */ \ + AVER((base) < (limit)); /* caught by small range case */ \ + bits_action(BTWordIndex((base)), \ + BTBitIndex((base)), \ + BTBitIndex((limit))); \ + } else { \ + Index actInnerLimit = BTIndexAlignDown((limit)); \ + Index actWordIndex, actWordBase, actWordLimit; \ +\ + actWordBase = BTWordIndex(actInnerBase); \ + actWordLimit = BTWordIndex(actInnerLimit); \ +\ + if ((base) < actInnerBase) { \ + bits_action(actWordBase-1, \ + BTBitIndex((base)), \ + MPS_WORD_WIDTH); \ + } \ +\ + for (actWordIndex = actWordBase; actWordIndex < actWordLimit; \ + ++actWordIndex) { \ + word_action(actWordIndex); \ + } \ +\ + if ((limit) > actInnerLimit) { \ + bits_action(actWordLimit, 0, BTBitIndex((limit))); \ + } \ + } \ + } \ + END + + +/* ACT_ON_RANGE_HIGH -- macro to act on a base-limit range + * + * in reverse order. Usage as for ACT_ON_RANGE + */ + +#define ACT_ON_RANGE_HIGH(base,limit,single_action, \ + bits_action,word_action) \ + BEGIN \ + if (BTIsSmallRange((base), (limit))) { \ + /* Small ranges are processed most efficiently bit-by-bit */ \ + Index actBit; \ + for (actBit = (limit); actBit > (base); --actBit) { \ + single_action(actBit - 1); \ + } \ + } else { \ + Index actInnerBase = BTIndexAlignUp((base)); \ + if (actInnerBase > (limit)) { /* no inner range */ \ + AVER((base) < (limit)); /* caught by small range case */ \ + bits_action(BTWordIndex((base)), \ + BTBitIndex((base)), \ + BTBitIndex((limit))); \ + } else { \ + Index actInnerLimit = BTIndexAlignDown((limit)); \ + Index actWordIndex, actWordBase, actWordLimit; \ +\ + actWordBase = BTWordIndex(actInnerBase); \ + actWordLimit = BTWordIndex(actInnerLimit); \ +\ + if ((limit) > actInnerLimit) { \ + bits_action(actWordLimit, 0, BTBitIndex((limit))); \ + } \ +\ + for (actWordIndex = actWordLimit; actWordIndex > actWordBase; \ + --actWordIndex) { \ + word_action(actWordIndex-1); \ + } \ +\ + if ((base) < actInnerBase) { \ + bits_action(actWordBase-1, \ + BTBitIndex((base)), \ + MPS_WORD_WIDTH); \ + } \ + } \ + } \ + END + + + +/* BTCreate -- allocate a BT from the control pool + * + * See design.mps.bt.if.create + */ + +Res BTCreate(BT *btReturn, Arena arena, Count length) +{ + Res res; + BT bt; + void *p; + + AVER(btReturn != NULL); + AVERT(Arena, arena); + AVER(length > 0); + + res = ControlAlloc(&p, arena, BTSize(length), + /* withReservoirPermit */ FALSE); + if (res != ResOK) + return res; + bt = (BT)p; + + *btReturn = bt; + return ResOK; +} + + +/* BTDestroy -- free a BT to the control pool. + * + * See design.mps.bt.if.destroy + */ + +void BTDestroy(BT bt, Arena arena, Count length) +{ + AVER(bt != NULL); + AVERT(Arena, arena); + AVER(length > 0); + + ControlFree(arena, bt, BTSize(length)); +} + + +/* BTCheck -- check the validity of a bit table + * + * There's not much that can be checked at present. This is + * discussed in review.impl.c.bt.4. + */ + +static Bool BTCheck(BT bt) +{ + AVER(bt != NULL); + AVER(AddrIsAligned((Addr)bt, sizeof(Word))); + return TRUE; +} + + +/* BTSize -- return the size of a BT + * + * See design.mps.bt.fun.size + */ + +size_t (BTSize)(unsigned long n) +{ + /* check that the expression used in rounding up doesn't overflow */ + AVER(n+MPS_WORD_WIDTH-1 > n); + + return BTSize(n); +} + + +/* BTGet -- get a bit from a BT + * + * See design.mps.bt.fun.get + */ + +Bool (BTGet)(BT t, Index i) +{ + AVER(BTCheck(t)); + /* Can't check i */ + + /* see macro in impl.h.mpm */ + return BTGet(t, i); +} + + +/* BTSet -- set a bit in a BT + * + * See design.mps.bt.fun.set + */ + +void (BTSet)(BT t, Index i) +{ + AVER(BTCheck(t)); + /* Can't check i */ + + /* see macro in impl.h.mpm */ + BTSet(t, i); +} + + +/* BTRes -- reset a bit in a BT + * + * design.mps.bt.fun.res + */ + +void (BTRes)(BT t, Index i) +{ + AVER(BTCheck(t)); + /* Can't check i */ + + /* see macro in impl.h.mpm */ + BTRes(t, i); +} + + +/* BTSetRange -- set a range of bits in a BT + * + * design.mps.bt.fun.set-range + */ + +void BTSetRange(BT t, Index base, Index limit) +{ + AVER(BTCheck(t)); + AVER(base < limit); + +#define SINGLE_SET_RANGE(i) \ + BTSet(t, (i)) +#define BITS_SET_RANGE(i,base,limit) \ + t[(i)] |= BTMask((base),(limit)) +#define WORD_SET_RANGE(i) \ + t[(i)] = ~(Word)(0) + + ACT_ON_RANGE(base, limit, SINGLE_SET_RANGE, + BITS_SET_RANGE, WORD_SET_RANGE); +} + + +/* BTIsResRange -- test whether a range of bits is all reset + * + * See design.mps.bt.fun.is-reset-range. + */ + +Bool BTIsResRange(BT bt, Index base, Index limit) +{ + AVER(BTCheck(bt)); + AVER(base < limit); + /* Can't check range of base or limit */ + +#define SINGLE_IS_RES_RANGE(i) \ + if (BTGet(bt, (i))) return FALSE +#define BITS_IS_RES_RANGE(i,base,limit) \ + if ((bt[(i)] & BTMask((base),(limit))) != (Word)0) return FALSE +#define WORD_IS_RES_RANGE(i) \ + if (bt[(i)] != (Word)0) return FALSE + + ACT_ON_RANGE(base, limit, SINGLE_IS_RES_RANGE, + BITS_IS_RES_RANGE, WORD_IS_RES_RANGE); + return TRUE; +} + + +/* BTIsSetRange -- test whether a range of bits is all set + * + * See design.mps.bt.fun.is-set-range. + */ + +Bool BTIsSetRange(BT bt, Index base, Index limit) +{ + AVER(BTCheck(bt)); + AVER(base < limit); + /* Can't check range of base or limit */ + +#define SINGLE_IS_SET_RANGE(i) \ + if (!BTGet(bt, (i))) return FALSE +#define BITS_IS_SET_RANGE(i,base,limit) \ + BEGIN \ + Word bactMask = BTMask((base),(limit)); \ + if ((bt[(i)] & bactMask) != bactMask) \ + return FALSE; \ + END +#define WORD_IS_SET_RANGE(i) \ + if (bt[(i)] != ~(Word)0) return FALSE + + ACT_ON_RANGE(base, limit, SINGLE_IS_SET_RANGE, + BITS_IS_SET_RANGE, WORD_IS_SET_RANGE); + return TRUE; +} + + +/* BTResRange -- reset a range of bits in a BT + * + * design.mps.bt.fun.res-range + */ + +void BTResRange(BT t, Index base, Index limit) +{ + AVER(BTCheck(t)); + AVER(base < limit); + +#define SINGLE_RES_RANGE(i) \ + BTRes(t, (i)) +#define BITS_RES_RANGE(i,base,limit) \ + t[(i)] &= ~(BTMask((base),(limit))) +#define WORD_RES_RANGE(i) t[(i)] = (Word)(0) + + ACT_ON_RANGE(base, limit, SINGLE_RES_RANGE, + BITS_RES_RANGE, WORD_RES_RANGE); +} + + +/* BTFindSet -- find the lowest set bit in a range in a bit table. + * + * Sets foundReturn to false if the range is entirely reset; + * in this case indexReturn is unset. Sets foundReturn to true + * otherwise. + * + * Implemented as a macro for efficiency reasons. + * The macro internally uses the label btFindSetLabel. + * If the macro must be used more than once within a function + * this label must be redefined to avoid a nameclash. E.g. + * #define btFindSetLabel uniqueLabel + * BTFindSet(...) + * #undef btFindSetLabel + */ + +#define BTFindSet(foundReturn,indexReturn,bt,base,limit)\ + BEGIN \ + Bool *bfsFoundReturn = (foundReturn); \ + Index *bfsIndexReturn = (indexReturn); \ + BT bfsBt = (bt); \ + ACT_ON_RANGE((base), (limit), SINGLE_FIND_SET, \ + BITS_FIND_SET, WORD_FIND_SET); \ + *bfsFoundReturn = FALSE; \ +btFindSetLabel:; \ + END + +#define SINGLE_FIND_SET(i) \ + if (BTGet(bfsBt, (i))) { \ + *bfsIndexReturn = (i); \ + *bfsFoundReturn = TRUE; \ + goto btFindSetLabel; \ + } +#define BITS_FIND_SET(wi,base,limit) \ + BEGIN \ + Index bactWi = (wi); \ + ACTION_FIND_SET(bactWi, bfsBt[bactWi], (base), (limit)); \ + END +#define WORD_FIND_SET(wi) \ + BEGIN \ + Index wactWi = (wi); \ + ACTION_FIND_SET(wactWi, bfsBt[wactWi], 0, MPS_WORD_WIDTH); \ + END +#define ACTION_FIND_SET(wi,word,base,limit) \ + ACTION_FIND_SET_BIT((wi),(word),(base),(limit),btFindSetLabel) + + +/* ACTION_FIND_SET_BIT -- Find first set bit in a range + * + * Helper macro to find the low bit in a range of a word. + * Works by first shifting the base of the range to the low + * bits of the word. Then loops performing a binary chop + * over the data looking to see if a bit is set in the lower + * half. If not, it must be in the upper half which is then + * shifted down. The loop completes after using a chop unit + * of a single single bit. + */ + +#define ACTION_FIND_SET_BIT(wi,word,base,limit,label) \ + BEGIN \ + /* no need to mask the low bits which are shifted */ \ + Index actionIndex = (base); \ + Word actionWord = ((word) & BTMaskHigh((limit))) >> actionIndex; \ + Count actionMaskWidth = (MPS_WORD_WIDTH >> 1); \ + Word actionMask = ~(Word)0 >> (MPS_WORD_WIDTH-actionMaskWidth); \ + if (actionWord != (Word)0) { \ + while (actionMaskWidth != (Count)0) { \ + if ((actionWord & actionMask) == (Word)0) { \ + actionIndex += actionMaskWidth; \ + actionWord >>= actionMaskWidth; \ + } \ + actionMaskWidth >>= 1; \ + actionMask >>= actionMaskWidth; \ + } \ + *bfsIndexReturn = ((wi) << MPS_WORD_SHIFT) | actionIndex; \ + *bfsFoundReturn = TRUE; \ + goto label; \ + } \ + END + + +/* BTFindRes -- find the lowest reset bit in a range in a bit table. + * + * Usage as for BTFindSet + * + * Internally uses the label btFindResLabel + * which must be redefined to avoid a nameclash if the macro is + * used twice in a function scope. + */ + +#define BTFindRes(foundReturn,indexReturn,bt,base,limit)\ + BEGIN \ + Bool *bfsFoundReturn = (foundReturn); \ + Index *bfsIndexReturn = (indexReturn); \ + BT bfsBt = (bt); \ + ACT_ON_RANGE((base), (limit), SINGLE_FIND_RES, \ + BITS_FIND_RES, WORD_FIND_RES); \ + *bfsFoundReturn = FALSE; \ +btFindResLabel:; \ + END + +#define SINGLE_FIND_RES(i) \ + if (!BTGet(bfsBt, (i))) { \ + *bfsIndexReturn = (i); \ + *bfsFoundReturn = TRUE; \ + goto btFindResLabel; \ + } +#define BITS_FIND_RES(wi,base,limit) \ + BEGIN \ + Index bactWi = (wi); \ + ACTION_FIND_RES(bactWi,bfsBt[bactWi], (base), (limit)); \ + END +#define WORD_FIND_RES(wi) \ + BEGIN \ + Index wactWi = (wi); \ + ACTION_FIND_RES(wactWi, bfsBt[wactWi], 0, MPS_WORD_WIDTH); \ + END +#define ACTION_FIND_RES(wi,word,base,limit) \ + ACTION_FIND_SET_BIT((wi),~(word),(base),(limit),btFindResLabel) + + +/* BTFindSetHigh -- find the highest set bit in a range in a bit table. + * + * Usage as for BTFindSet + * + * Internally uses the label btFindSetHighLabel + * which must be redefined to avoid a nameclash if the macro is + * used twice in a function scope. + */ + +#define BTFindSetHigh(foundReturn,indexReturn,bt,base,limit)\ + BEGIN \ + Bool *bfsFoundReturn = (foundReturn); \ + Index *bfsIndexReturn = (indexReturn); \ + BT bfsBt = (bt); \ + ACT_ON_RANGE_HIGH((base), (limit), SINGLE_FIND_SET_HIGH, \ + BITS_FIND_SET_HIGH, WORD_FIND_SET_HIGH); \ + *bfsFoundReturn = FALSE; \ +btFindSetHighLabel:; \ + END + +#define SINGLE_FIND_SET_HIGH(i) \ + if (BTGet(bfsBt, (i))) { \ + *bfsIndexReturn = (i); \ + *bfsFoundReturn = TRUE; \ + goto btFindSetHighLabel; \ + } +#define BITS_FIND_SET_HIGH(wi,base,limit) \ + BEGIN \ + Index bactWi = (wi); \ + ACTION_FIND_SET_HIGH(bactWi, bfsBt[bactWi], (base), (limit)); \ + END +#define WORD_FIND_SET_HIGH(wi) \ + BEGIN \ + Index wactWi = (wi); \ + ACTION_FIND_SET_HIGH(wactWi, (bfsBt[wactWi]), 0, MPS_WORD_WIDTH); \ + END +#define ACTION_FIND_SET_HIGH(wi,word,base,limit) \ + ACTION_FIND_SET_BIT_HIGH((wi),(word),(base),(limit),btFindSetHighLabel) + + +/* ACTION_FIND_SET_BIT_HIGH -- Find highest set bit in a range + * + * Helper macro to find the high bit in a range of a word. + * Essentially a mirror image of ACTION_FIND_SET + */ + +#define ACTION_FIND_SET_BIT_HIGH(wi,word,base,limit,label) \ + BEGIN \ + /* no need to mask the high bits which are shifted */ \ + Index actionShift = MPS_WORD_WIDTH - (limit); \ + Index actionIndex = MPS_WORD_WIDTH - 1 - actionShift; \ + Word actionWord = ((word) & BTMaskLow((base))) << actionShift; \ + Count actionMaskWidth = (MPS_WORD_WIDTH >> 1); \ + Word actionMask = ~(Word)0 << (MPS_WORD_WIDTH-actionMaskWidth); \ + if (actionWord != (Word)0) { \ + while (actionMaskWidth != (Count)0) { \ + if ((actionWord & actionMask) == (Word)0) { \ + actionIndex -= actionMaskWidth; \ + actionWord <<= actionMaskWidth; \ + } \ + actionMaskWidth >>= 1; \ + actionMask <<= actionMaskWidth; \ + } \ + *bfsIndexReturn = ((wi) << MPS_WORD_SHIFT) | actionIndex; \ + *bfsFoundReturn = TRUE; \ + goto label; \ + } \ + END + + +/* BTFindResHigh -- find the highest reset bit in a range + * + * Usage as for BTFindSet + * + * Internally uses the label btFindSetHighLabel + * which must be redefined to avoid a nameclash if the macro is + * used twice in a function scope. + */ + +#define BTFindResHigh(foundReturn,indexReturn,bt,base,limit)\ + BEGIN \ + Bool *bfsFoundReturn = (foundReturn); \ + Index *bfsIndexReturn = (indexReturn); \ + BT bfsBt = (bt); \ + ACT_ON_RANGE_HIGH((base), (limit), SINGLE_FIND_RES_HIGH, \ + BITS_FIND_RES_HIGH, WORD_FIND_RES_HIGH); \ + *bfsFoundReturn = FALSE; \ +btFindResHighLabel:; \ + END + +#define SINGLE_FIND_RES_HIGH(i) \ + if (!BTGet(bfsBt, (i))) { \ + *bfsIndexReturn = (i); \ + *bfsFoundReturn = TRUE; \ + goto btFindResHighLabel; \ + } +#define BITS_FIND_RES_HIGH(wi,base,limit) \ + BEGIN \ + Index bactWi = (wi); \ + ACTION_FIND_RES_HIGH(bactWi, bfsBt[bactWi], (base), (limit)); \ + END +#define WORD_FIND_RES_HIGH(wi) \ + BEGIN \ + Index wactWi = (wi); \ + ACTION_FIND_RES_HIGH(wactWi, (bfsBt[wactWi]), 0, MPS_WORD_WIDTH); \ + END +#define ACTION_FIND_RES_HIGH(wi,word,base,limit) \ + ACTION_FIND_SET_BIT_HIGH((wi),~(word),(base),(limit),btFindResHighLabel) + + +/* BTFindResRange -- find a reset range of bits in a bit table + * + * Starts searching at the low end of the search range. + * + * See design.mps.bt.fun.find-res-range. + */ + +static Bool BTFindResRange(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long minLength, unsigned long maxLength) +{ + Bool foundRes; /* true if a reset bit is found */ + Index resBase; /* base of a candidate reset range */ + Index unseenBase; /* base of testing so far */ + Index minLimit; /* limit of minimal acceptable range */ + Index resLimit; /* limit of search for a candidate range */ + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(BT, bt); + AVER(searchBase < searchLimit); + AVER(minLength > 0); + AVER(minLength <= maxLength); + AVER(maxLength <= searchLimit - searchBase); + + foundRes = FALSE; /* don't know first reset bit */ + minLimit = 0; /* avoid spurious compiler warning */ + resBase = searchBase; /* haven't seen anything yet */ + unseenBase = searchBase; /* haven't seen anything yet */ + resLimit = searchLimit - minLength + 1; + + while (resBase < resLimit) { + Index setIndex; /* index of last set bit found */ + Bool foundSet = FALSE; /* true if a set bit is found */ + + /* Find the first reset bit if it's not already known */ + if (!foundRes) { + BTFindRes(&foundRes, &resBase, bt, unseenBase, resLimit); + if (!foundRes) { + /* failure */ + return FALSE; + } + unseenBase = resBase + 1; + minLimit = resBase + minLength; + } + + /* Look to see if there is any set bit in the minimum range */ + BTFindSetHigh(&foundSet, &setIndex, bt, unseenBase, minLimit); + if (!foundSet) { + /* Found minimum range. Extend it. */ + Index setBase; /* base of search for set bit */ + Index setLimit; /* limit search for set bit */ + foundSet = FALSE; + setBase = minLimit; + setLimit = resBase + maxLength; + if (setLimit > searchLimit) + setLimit = searchLimit; + if (setLimit > setBase) + BTFindSet(&foundSet, &setIndex, bt, setBase, setLimit); + if (!foundSet) + setIndex = setLimit; + + AVER(setIndex - resBase >= minLength); + AVER(setIndex - resBase <= maxLength); + *baseReturn = resBase; + *limitReturn = setIndex; + return TRUE; + + } else { + /* Range was too small. Try again */ + unseenBase = minLimit; + resBase = setIndex + 1; + if (resBase != minLimit) { + /* Already found the start of next candidate range */ + minLimit = resBase + minLength; + } else { + foundRes = FALSE; + } + } + } + + /* failure */ + return FALSE; +} + + +/* BTFindResRangeHigh -- find a reset range of bits in a bit table + * + * Starts searching at the high end of the search range. + * + * See design.mps.bt.fun.find-res-range. + */ + +static Bool BTFindResRangeHigh(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long minLength, + unsigned long maxLength) +{ + Bool foundRes; /* true if a reset bit is found */ + Index resLimit; /* limit of a candidate reset range */ + Index resIndex; /* index of highest reset bit found */ + Index unseenLimit; /* limit of testing so far */ + Index minBase; /* base of minimal acceptable range */ + Index resBase; /* base of search for a candidate range */ + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(BT, bt); + AVER(searchBase < searchLimit); + AVER(minLength > 0); + AVER(minLength <= maxLength); + AVER(maxLength <= searchLimit - searchBase); + + foundRes = FALSE; /* don't know first reset bit */ + minBase = 0; /* avoid spurious compiler warning */ + resLimit = searchLimit; /* haven't seen anything yet */ + unseenLimit = searchLimit; /* haven't seen anything yet */ + resBase = searchBase + minLength -1; + + while (resLimit > resBase) { + Index setIndex; /* index of first set bit found */ + Bool foundSet = FALSE; /* true if a set bit is found */ + + /* Find the first reset bit if it's not already known */ + if (!foundRes) { + /* Look for the limit of a range */ + BTFindResHigh(&foundRes, &resIndex, bt, resBase, unseenLimit); + if (!foundRes) { + /* failure */ + return FALSE; + } + resLimit = resIndex + 1; + unseenLimit = resIndex; + minBase = resLimit - minLength; + } + + /* Look to see if there is any set bit in the minimum range */ + BTFindSet(&foundSet, &setIndex, bt, minBase, unseenLimit); + if (!foundSet) { + /* Found minimum range. Extend it. */ + Index setBase; /* base of search for set bit */ + Index setLimit; /* limit search for set bit */ + Index baseIndex; /* base of reset range found */ + foundSet = FALSE; + setLimit = minBase; + if ((searchBase + maxLength) > resLimit) + setBase = searchBase; + else + setBase = resLimit - maxLength; + if (setLimit > setBase) + BTFindSetHigh(&foundSet, &setIndex, bt, setBase, setLimit); + if (foundSet) + baseIndex = setIndex+1; + else + baseIndex = setBase; + + AVER(resLimit - baseIndex >= minLength); + AVER(resLimit - baseIndex <= maxLength); + *baseReturn = baseIndex; + *limitReturn = resLimit; + return TRUE; + + } else { + /* Range was too small. Try again */ + unseenLimit = minBase; + resLimit = setIndex; + if (resLimit != minBase) { + /* Already found the start of next candidate range */ + minBase = resLimit - minLength; + } else { + foundRes = FALSE; + } + } + } + + /* failure */ + return FALSE; +} + + +/* BTFindLongResRange -- find long range of reset bits in a bit table + * + * See design.mps.bt.fun.find-long-res-range. + */ + +Bool BTFindLongResRange(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long length) +{ + /* All parameters are checked by BTFindResRange. */ + return BTFindResRange(baseReturn, limitReturn, + bt, + searchBase, searchLimit, + length, searchLimit - searchBase); +} + + +/* BTFindLongResRangeHigh -- find long range of reset bits in a bit table + * + * See design.mps.bt.fun.find-long-res-range-high. + */ + +Bool BTFindLongResRangeHigh(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long length) +{ + /* All parameters are checked by BTFindResRangeHigh. */ + return BTFindResRangeHigh(baseReturn, limitReturn, + bt, + searchBase, searchLimit, + length, searchLimit - searchBase); +} + + +/* BTFindShortResRange -- find short range of reset bits in a bit table + * + * See design.mps.bt.fun.find-short-res-range. + */ + +Bool BTFindShortResRange(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long length) +{ + /* All parameters are checked by BTFindResRange. */ + return BTFindResRange(baseReturn, limitReturn, + bt, + searchBase, searchLimit, + length, length); +} + +/* BTFindShortResRangeHigh -- find short range of reset bits in a bit table + * + * Starts looking from the top of the search range. + * + * See design.mps.bt.fun.find-short-res-range-high. + */ + +Bool BTFindShortResRangeHigh(Index *baseReturn, Index *limitReturn, + BT bt, + Index searchBase, Index searchLimit, + unsigned long length) +{ + /* All parameters are checked by BTFindResRangeHigh. */ + return BTFindResRangeHigh(baseReturn, limitReturn, + bt, + searchBase, searchLimit, + length, length); +} + + +/* BTRangesSame -- check that a range of bits in two BTs are the same. + * + * See design.mps.bt.if.ranges-same + */ + +Bool BTRangesSame(BT comparand, BT comparator, Index base, Index limit) +{ + AVER(BTCheck(comparand)); + AVER(BTCheck(comparator)); + AVER(base < limit); + +#define SINGLE_RANGES_SAME(i) \ + if (BTGet(comparand, (i)) != BTGet(comparator, (i))) \ + return FALSE +#define BITS_RANGES_SAME(i,base,limit) \ + BEGIN \ + Index bactI = (i); \ + Word bactMask = BTMask((base),(limit)); \ + if ((comparand[bactI] & (bactMask)) != \ + (comparator[bactI] & (bactMask))) \ + return FALSE; \ + END +#define WORD_RANGES_SAME(i) \ + BEGIN \ + Index wactI = (i); \ + if ((comparand[wactI]) != (comparator[wactI])) \ + return FALSE; \ + END + + ACT_ON_RANGE(base, limit, SINGLE_RANGES_SAME, + BITS_RANGES_SAME, WORD_RANGES_SAME); + return TRUE; +} + + +/* BTCopyInvertRange -- copy a range of bits from one BT to another, + * inverting them as you go. + * + * See design.mps.bt.if.copy-invert-range + */ + +void BTCopyInvertRange(BT fromBT, BT toBT, Index base, Index limit) +{ + AVER(BTCheck(fromBT)); + AVER(BTCheck(toBT)); + AVER(fromBT != toBT); + AVER(base < limit); + +#define SINGLE_COPY_INVERT_RANGE(i) \ + if (BTGet(fromBT, (i))) \ + BTRes(toBT, (i)); \ + else \ + BTSet(toBT, (i)) +#define BITS_COPY_INVERT_RANGE(i,base,limit) \ + BEGIN \ + Index bactI = (i); \ + Word bactMask = BTMask((base),(limit)); \ + toBT[bactI] = \ + (toBT[bactI] & ~bactMask) | (~fromBT[bactI] & bactMask); \ + END +#define WORD_COPY_INVERT_RANGE(i) \ + BEGIN \ + Index wactI = (i); \ + toBT[wactI] = ~fromBT[wactI]; \ + END + + ACT_ON_RANGE(base, limit, SINGLE_COPY_INVERT_RANGE, + BITS_COPY_INVERT_RANGE, WORD_COPY_INVERT_RANGE); +} + + +/* BTCopyRange -- copy a range of bits from one BT to another + * + * See design.mps.bt.if.copy-range + */ + +void BTCopyRange(BT fromBT, BT toBT, Index base, Index limit) +{ + AVER(BTCheck(fromBT)); + AVER(BTCheck(toBT)); + AVER(fromBT != toBT); + AVER(base < limit); + +#define SINGLE_COPY_RANGE(i) \ + if (BTGet(fromBT, (i))) \ + BTSet(toBT, (i)); \ + else \ + BTRes(toBT, (i)) +#define BITS_COPY_RANGE(i,base,limit) \ + BEGIN \ + Index bactI = (i); \ + Word bactMask = BTMask((base),(limit)); \ + toBT[bactI] = \ + (toBT[bactI] & ~bactMask) | (fromBT[bactI] & bactMask); \ + END +#define WORD_COPY_RANGE(i) \ + BEGIN \ + Index wactI = (i); \ + toBT[wactI] = fromBT[wactI]; \ + END + + ACT_ON_RANGE(base, limit, SINGLE_COPY_RANGE, + BITS_COPY_RANGE, WORD_COPY_RANGE); +} + + +/* BTCopyOffsetRange -- copy a range of bits from one BT to an + * offset range in another BT + * + * .slow: Can't always use ACT_ON_RANGE because word alignment + * may differ for each range. We could try to be smart about + * detecting similar alignment - but we don't. + * + * See design.mps.bt.if.copy-offset-range + */ + +void BTCopyOffsetRange(BT fromBT, BT toBT, + Index fromBase, Index fromLimit, + Index toBase, Index toLimit) +{ + Index fromBit, toBit; + + AVER(BTCheck(fromBT)); + AVER(BTCheck(toBT)); + AVER(fromBT != toBT); + AVER(fromBase < fromLimit); + AVER(toBase < toLimit); + AVER((fromLimit - fromBase) == (toLimit - toBase)); + + for (fromBit = fromBase, toBit = toBase; + fromBit < fromLimit; + ++fromBit, ++toBit) { + if (BTGet(fromBT, fromBit)) + BTSet(toBT, toBit); + else + BTRes(toBT, toBit); + } +} + diff --git a/mps/code/btcv.c b/mps/code/btcv.c new file mode 100644 index 00000000000..b82b383d891 --- /dev/null +++ b/mps/code/btcv.c @@ -0,0 +1,568 @@ +/* impl.c.btss: BIT TABLE COVERAGE TEST + * + * $HopeName: MMsrc!btcv.c(trunk.4) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .readership: MPS developers + * + * .coverage: Direct coverage of BTFind*ResRange*, BTRangesSame, + * BTISResRange, BTIsSetRange, BTCopyRange, BTCopyOffsetRange. + * Reasonable coverage of BTCopyInvertRange, BTResRange, + * BTSetRange, BTRes, BTSet, BTCreate, BTDestroy. + */ + + +#include "mpm.h" +#include "mpsavm.h" +#include "mps.h" +#include "testlib.h" + +#include + +SRCID(btcv, "$HopeName: MMsrc!btcv.c(trunk.4) $"); + + +/* bt*Symmetric -- Symmetric operations on bit tables + * + * The operations take 2 bit tables, btlo & bthi. + * They perform the equivalent BT* operation on btlo, and + * a reflected operation on the bits of bthi from the opposite + * direction. + */ + +#define btReflectIndex(btSize, i) (btSize - (i) - 1) +#define btReflectLimit(btSize, i) (btSize - (i)) + + +static void btSetSymmetric(BT btlo, BT bthi, Count btSize, Index i) +{ + BTSet(btlo, i); + BTSet(bthi, btReflectIndex(btSize, i)); +} + +static void btResSymmetric(BT btlo, BT bthi, Count btSize, Index i) +{ + BTRes(btlo, i); + BTRes(bthi, btReflectIndex(btSize, i)); +} + +static void btSetRangeSymmetric(BT btlo, BT bthi, Count btSize, + Index base, Index limit) +{ + BTSetRange(btlo, base, limit); + BTSetRange(bthi, btReflectLimit(btSize, limit), btReflectLimit(btSize, base)); +} + +static void btResRangeSymmetric(BT btlo, BT bthi, Count btSize, + Index base, Index limit) +{ + BTResRange(btlo, base, limit); + BTResRange(bthi, btReflectLimit(btSize, limit), btReflectLimit(btSize, base)); +} + + +typedef Bool (*BTFinderFn)(Index *, Index *, BT, Index, Index, unsigned long); + + +/* btTestSingleRange -- Test expectations for calls to BTFind*ResRange* + * + */ + +static void btTestSingleRange(BTFinderFn finder, BT bt, + Index base, Index limit, + unsigned long length, + Bool expect, + Index expectBase, Index expectLimit) +{ + Bool found; + Index foundBase, foundLimit; + + found = finder(&foundBase, &foundLimit, bt, base, limit, length); + cdie(found == expect, "FindResRange result"); + if (expect) { + cdie(foundBase == expectBase, "FindResRange base"); + cdie(foundLimit == expectLimit, "FindResRange limit"); + } +} + + +/* btTestResRange -- Test expectations for calls to BTFindShortResRange + * + * Symmetrically call BTFindShortResRange / BTFindShortResRangeHigh + * and test the expected results + */ + +static void btTestResRange(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length, + Bool expect, + Index expectBase, Index expectLimit) +{ + btTestSingleRange(BTFindShortResRange, btlo, + base, limit, + length, expect, + expectBase, expectLimit); + + btTestSingleRange(BTFindShortResRangeHigh, bthi, + btReflectLimit(btSize, limit), + btReflectLimit(btSize, base), + length, expect, + btReflectLimit(btSize, expectLimit), + btReflectLimit(btSize, expectBase)); +} + + +/* btTestLongResRange -- Test expectations for calls to BTFindLongResRange + * + * Symmetrically call BTFindLongResRange / BTFindLongResRangeHigh + * and test the expected results + */ + +static void btTestLongResRange(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length, + Bool expect, + Index expectBase, Index expectLimit) +{ + btTestSingleRange(BTFindLongResRange, btlo, + base, limit, + length, expect, + expectBase, expectLimit); + + btTestSingleRange(BTFindLongResRangeHigh, bthi, + btReflectLimit(btSize, limit), + btReflectLimit(btSize, base), + length, expect, + btReflectLimit(btSize, expectLimit), + btReflectLimit(btSize, expectBase)); +} + + +/* btAllResTest -- tests with only a reset range + * + * Test finding reset ranges in an all-reset table. + */ + +static void btAllResTest(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length) +{ + btResRangeSymmetric(btlo, bthi, btSize, 0, btSize); + btTestResRange(btlo, bthi, btSize, base, limit, length, + TRUE, base, base + length); + btTestLongResRange(btlo, bthi, btSize, base, limit, length, + TRUE, base, limit); +} + + +/* btNoResTest -- tests with no reset ranges + * + * Test finding reset ranges in an all-set search area of a table. + * Reset the area outside the search to ensure it doesn't get found + * by mistake. + */ + +static void btNoResTest(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length) +{ + btResRangeSymmetric(btlo, bthi, btSize, 0, btSize); + btSetRangeSymmetric(btlo, bthi, btSize, base, limit); + btTestResRange(btlo, bthi, btSize, base, limit, length, + FALSE, 0, 0); + btTestLongResRange(btlo, bthi, btSize, base, limit, length, + FALSE, 0, 0); +} + + +/* btResAndFindTest -- Test finding ranges of given size + * + * Resets the range between resBase & resLimit, and then attempts + * to find it by searching in the range between base & limit. + * Expect to find the range if it's long enough, + */ + +static void btResAndFindTest(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + Index resBase, Index resLimit, + unsigned long length) +{ + btResRangeSymmetric(btlo, bthi, btSize, resBase, resLimit); + if ((resLimit - resBase) < length) { + btTestResRange(btlo, bthi, btSize, base, limit, length, + FALSE, 0, 0); + btTestLongResRange(btlo, bthi, btSize, base, limit, length, + FALSE, 0, 0); + } else { + btTestResRange(btlo, bthi, btSize, base, limit, length, + TRUE, resBase, resBase + length); + btTestLongResRange(btlo, bthi, btSize, base, limit, length, + TRUE, resBase, resLimit); + } +} + + + +/* btSingleResTest -- tests with a single reset range + * + * Test finding single ranges of various sizes + */ + +static void btSingleResTest(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length) +{ + unsigned long resLen; + /* choose varying range lengths from too short to longer than needed */ + for (resLen = length - 1; resLen <= length + 1; resLen++) { + if ((resLen > 0) && (resLen < (limit - base -2))) { + /* place the ranges both near the beginning & near the end */ + /* of the search space */ + Index resBase, resLimit; + for (resBase = base; resBase <= base +2; resBase++) { + btResRangeSymmetric(btlo, bthi, btSize, 0, btSize); + btSetRangeSymmetric(btlo, bthi, btSize, base, limit); + btResAndFindTest(btlo, bthi, btSize, base, limit, + resBase, resBase + resLen, length); + } + for (resLimit = limit; resLimit >= limit -2; resLimit--) { + btResRangeSymmetric(btlo, bthi, btSize, 0, btSize); + btSetRangeSymmetric(btlo, bthi, btSize, base, limit); + btResAndFindTest(btlo, bthi, btSize, base, limit, + resLimit - resLen, resLimit, length); + } + } + } +} + + + +/* btDoubleResTest -- Test finding double ranges of various sizes + * + * Set up 2 ranges with various relative positions. The first + * range is always too small. + */ + + +/* Constants describing the type of arrangement of the 2 ranges */ +enum { + ArrangeGAP1 = 0, + ArrangeGAP2 = 1, + ArrangeSPREAD = 2, + ArrangeMAX +}; + +typedef unsigned Arrangement; + +/* Choose a limit for reset range 1 */ +static Index btArrangeRes1(Arrangement arrange, + Index base, Index res2Base, + unsigned long length) +{ + switch (arrange) { + + case ArrangeGAP1: { + /* Gap between ranges is of length 1 */ + return res2Base - 1; + } + + case ArrangeGAP2: { + /* Gap between ranges is of length 2 */ + return res2Base - 2; + } + + case ArrangeSPREAD: { + /* range 1 starts as far before range 2 as possible */ + return base + length; + } + + default: + NOTREACHED; + return 0; /* keep the compiler happy */ + } +} + +/* Constants describing the type of pattern for the first range */ +enum { + PatternLEN1 = 0, + PatternSETMID = 1, + PatternJUSTSMALL = 2, + PatternMAX +}; + +typedef unsigned Pattern; + +/* Choose a limit for reset range 1 */ +static void btResetFirstRange(BT btlo, BT bthi, Count btSize, + Index res1Limit, + unsigned long length, + Pattern pattern) +{ + switch (pattern) { + + case PatternLEN1: { + /* First range is a single reset bit */ + btResSymmetric(btlo, bthi, btSize, res1Limit-1); + return; + } + + case PatternSETMID: { + /* Actually make 2 ranges here by setting a bit in the middle */ + Index mid = res1Limit - length + (length / 2); + btResRangeSymmetric(btlo, bthi, btSize, res1Limit-length, res1Limit); + btSetSymmetric(btlo, bthi, btSize, mid); + return; + } + + case PatternJUSTSMALL: { + /* Range of (length - 1) */ + btResRangeSymmetric(btlo, bthi, btSize, + 1 + res1Limit - length, res1Limit); + return; + } + + default: + NOTREACHED; + } +} + + +static void btDoubleResTest(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length) +{ + unsigned long res2Len; + + if (length < 2) + return; /* no possibility of making the first range too small */ + + /* choose varying range lengths for second res range */ + for (res2Len = length - 1; res2Len <= length + 1; res2Len++) { + if ((res2Len > 0) && (res2Len < (limit - base -2))) { + Index res2Limit; + /* place the second ranges near the end of the search space */ + for (res2Limit = limit; res2Limit >= limit-8; res2Limit--) { + Index res2Base = res2Limit - res2Len; + Arrangement arrange; + /* Pick one of a number of possible arrangements of the ranges */ + for (arrange = ArrangeGAP1; arrange < ArrangeMAX; arrange++) { + Index res1Limit = btArrangeRes1(arrange, base, res2Base, length); + Pattern pat; + /* Pick one of a number of pattern types for range 1 */ + for (pat = PatternLEN1; pat < PatternMAX; pat++) { + btResRangeSymmetric(btlo, bthi, btSize, 0, btSize); + btSetRangeSymmetric(btlo, bthi, btSize, base, limit); + btResetFirstRange(btlo, bthi, btSize, res1Limit, length, pat); + /* Set up range 2 and expect to find it when searching */ + btResAndFindTest(btlo, bthi, btSize, base, limit, + res2Base, res2Limit, length); + } + } + } + } + } +} + + +/* btFindRangeTests -- Test BTFind*ResRange* + * + * Run a variety of FindResRange tests with different table patterns. + */ + +static void btFindRangeTests(BT btlo, BT bthi, Count btSize, + Index base, Index limit, + unsigned long length) +{ + btAllResTest(btlo, bthi, btSize, base, limit, length); + btNoResTest(btlo, bthi, btSize, base, limit, length); + btSingleResTest(btlo, bthi, btSize, base, limit, length); + btDoubleResTest(btlo, bthi, btSize, base, limit, length); +} + + + +/* btIsRangeTests -- Test BTIsResRange & BTIsSetRange + * + * Test ranges which are all reset or set apart from single + * bits near to the base and limit (both inside and outside + * the range). + * + * Test BTRangesSame by using the same bit patterns and comparing + * with an appropriate all-set or all-reset table. + * + * These tests also test BTCopyInvertRange + */ + +static void btIsRangeTests(BT bt1, BT bt2, Count btSize, + Index base, Index limit) +{ + Index minBase, maxLimit, b, l; + + if (base > 0) { + minBase = base - 1; + } else { + minBase = 0; + } + + if (limit < btSize) { + maxLimit = limit + 1; + } else { + maxLimit = btSize; + } + + for (b = minBase; b <= base+1; b++) { + for (l = maxLimit; l >= limit-1; l--) { + /* test a table which is all reset apart from a set bit */ + /* near each of the base and limit of the range in question */ + Bool outside; /* true if set bits are both outside test range */ + + outside = (b < base) && (l > limit); + BTResRange(bt1, 0, btSize); + BTSet(bt1, b); + BTSet(bt1, l - 1); + + /* invert the table for the inverse test */ + BTCopyInvertRange(bt1, bt2, 0, btSize); + + /* Check it with BTIsResRange, and the inverse with BTIsSetRange */ + cdie(BTIsResRange(bt1, base, limit) == outside, "BTISResRange"); + cdie(BTIsSetRange(bt2, base, limit) == outside, "BTISSetRange"); + + /* Check the same range with BTRangesSame on an empty table */ + BTResRange(bt2, 0, btSize); + cdie(BTRangesSame(bt1, bt2, base, limit) == outside, "BTRangeSame"); + + /* Check the inverse with BTRangesSame on a full table */ + BTCopyInvertRange(bt1, bt2, 0, btSize); + BTSetRange(bt1, 0, btSize); + cdie(BTRangesSame(bt1, bt2, base, limit) == outside, "BTRangeSame"); + } + } +} + + +/* btCopyTests -- Test BTCopyRange & BTCopyOffsetRange + * + * Test copying ranges which are all reset or set apart from + * single bits near to the base and limit (both inside and outside + * the range). + * + */ + +static void btCopyTests(BT bt1, BT bt2, Count btSize, + Index base, Index limit) +{ + Index minBase, maxLimit, b, l; + + if (base > 0) { + minBase = base - 1; + } else { + minBase = 0; + } + + if (limit < btSize) { + maxLimit = limit + 1; + } else { + maxLimit = btSize; + } + + for (b = minBase; b <= base+1; b++) { + for (l = maxLimit; l >= limit-1; l--) { + /* initialize a table which is all reset apart from a set bit */ + /* near each of the base and limit of the range in question */ + Bool outside; /* true if set bits are both outside test range */ + + outside = (b < base) && (l > limit); + BTResRange(bt1, 0, btSize); + BTSet(bt1, b); + BTSet(bt1, l - 1); + + /* check copying the region to the bottom of the other table */ + BTCopyOffsetRange(bt1, bt2, base, limit, 0, limit - base); + cdie(BTIsResRange(bt2, 0, limit - base) == outside, "BTIsResRange"); + + /* check copying the region to the top of the other table */ + BTCopyOffsetRange(bt1, bt2, + base, limit, btSize + base - limit, btSize); + cdie(BTIsResRange(bt2, btSize + base - limit, btSize) == outside, + "BTIsResRange"); + + /* check copying the region to the same place in the other table */ + BTCopyOffsetRange(bt1, bt2, base, limit, base, limit); + cdie(BTIsResRange(bt2, base, limit) == outside, "BTIsResRange"); + + /* copy the range and check its the same */ + BTCopyRange(bt1, bt2, base, limit); + cdie(BTRangesSame(bt1, bt2, base, limit), "BTRangeSame"); + + /* invert the table, then copy it and check it again */ + BTCopyInvertRange(bt2, bt1, 0, btSize); + BTCopyRange(bt1, bt2, base, limit); + cdie(BTRangesSame(bt1, bt2, base, limit), "BTRangeSame"); + } + } +} + + + +/* btTests -- Do all the tests + */ + +static void btTests(BT btlo, BT bthi, Count btSize) +{ + Index base, limit; + + /* Perform lots of tests over different subranges */ + for (base = 0; base < MPS_WORD_WIDTH; base++) { + for (limit = btSize; limit > (btSize-MPS_WORD_WIDTH); limit--) { + /* Perform Is*Range tests over those subranges */ + btIsRangeTests(btlo, bthi, btSize, base, limit); + + /* Perform Copy*Range tests over those subranges */ + btCopyTests(btlo, bthi, btSize, base, limit); + + /* Perform FindResRange tests with different lengths */ + btFindRangeTests(btlo, bthi, btSize, base, limit, 1); + btFindRangeTests(btlo, bthi, btSize, base, limit, 2); + btFindRangeTests(btlo, bthi, btSize, base, limit, MPS_WORD_WIDTH - 1); + btFindRangeTests(btlo, bthi, btSize, base, limit, MPS_WORD_WIDTH); + btFindRangeTests(btlo, bthi, btSize, base, limit, MPS_WORD_WIDTH + 1); + btFindRangeTests(btlo, bthi, btSize, base, limit, limit - base -1); + btFindRangeTests(btlo, bthi, btSize, base, limit, limit - base); + } + } +} + + +/* Start the world */ + +#define testArenaSIZE (((size_t)64)<<20) + +int main(int argc, char *argv[]) +{ + mps_arena_t mpsArena; + Arena arena; /* the ANSI arena which we use to allocate the BT */ + BT btlo, bthi; + Count btSize; + + /* tests need 4 whole words plus a few extra bits */ + btSize = MPS_WORD_WIDTH * 4 + 10; + + testlib_unused(argc); + testlib_unused(argv); + + die(mps_arena_create(&mpsArena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + arena = (Arena)mpsArena; /* avoid pun */ + + die((mps_res_t)BTCreate(&btlo, arena, btSize), + "failed to create low bit table"); + + die((mps_res_t)BTCreate(&bthi, arena, btSize), + "failed to create high bit table"); + + btTests(btlo, bthi, btSize); + + printf("\nNo problems detected.\n"); + return 0; +} diff --git a/mps/code/bttest.c b/mps/code/bttest.c new file mode 100644 index 00000000000..26c19b716d4 --- /dev/null +++ b/mps/code/bttest.c @@ -0,0 +1,385 @@ +/* impl.c.bttest: BIT TABLE TEST + * + * $HopeName: MMsrc!bttest.c(trunk.4) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + + +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "testlib.h" + +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + + +SRCID(bttest, "$HopeName: MMsrc!bttest.c(trunk.4) $"); + + +static BT bt; /* the BT which we will use */ +static Size btSize; /* the size of the current BT */ +static Arena arena; /* the arena which we use to allocate the BT */ + + +#define MAX_ARGS 3 + + +static Word args[MAX_ARGS]; +static Count argCount; + + +static Bool argInRange(Index arg) +{ + if (bt == NULL) { + printf("no BT\n"); + return FALSE; + } + if (args[arg] >= btSize) { + printf("out of range\n"); + return FALSE; + } + return TRUE; +} + + +static Bool checkDefaultRange(Index arg) +{ + if (bt == NULL) { + printf("no BT\n"); + return FALSE; + } + if (argCount == arg+1) { + printf("range half-specified\n"); + return FALSE; + } + if (argCount == arg) { /* use default range */ + args[arg] = 0; + args[arg+1] = btSize; + return TRUE; + } + if (args[arg] >= args[arg+1]) { + printf("range ill-formed\n"); + return FALSE; + } + if (args[arg+1] > btSize) { + printf("range too high\n"); + return FALSE; + } + return TRUE; /* explicit valid range */ +} + + +static void quit(void) +{ + exit(0); +} + + +static void destroy(void) +{ + if (bt != NULL) { + BTDestroy(bt, arena, btSize); + bt = NULL; + } else { + printf("No BT to destroy\n"); + } +} + +static void create(void) +{ + Res res; + if (args[0] < 1) { + printf("can't create a BT of size 0\n"); + return; + } + if (bt != NULL) + destroy(); + res = BTCreate(&bt, arena, args[0]); + if (res == ResOK) { + btSize = args[0]; + BTResRange(bt, 0, btSize); + } else { + printf("BTCreate returned %d\n",res); + } +} + + +static void set(void) +{ + if (argInRange(0)) + (BTSet)(bt, args[0]); +} + + +static void reset(void) +{ + if (argInRange(0)) + (BTRes)(bt, args[0]); +} + + +static void get(void) +{ + if (argInRange(0)) { + Bool b = (BTGet)(bt, args[0]); + printf(b ? "TRUE\n" : "FALSE\n"); + } +} + + +static void setRange(void) +{ + if (checkDefaultRange(0)) + BTSetRange(bt, args[0], args[1]); +} + + +static void resetRange(void) +{ + if (checkDefaultRange(0)) + BTResRange(bt, args[0], args[1]); +} + + +static void isSetRange(void) +{ + if (checkDefaultRange(0)) { + Bool b = BTIsSetRange(bt, args[0], args[1]); + printf(b ? "TRUE\n" : "FALSE\n"); + } +} + + +static void isResRange(void) +{ + if (checkDefaultRange(0)) { + Bool b = BTIsResRange(bt, args[0], args[1]); + printf(b ? "TRUE\n" : "FALSE\n"); + } +} + + +static void findShortResRange(void) +{ + if (checkDefaultRange(1)) { + if (args[0] > (args[2] - args[1])) { + printf("can't fit length in range\n"); + } else { + Index base, limit; + Bool b = BTFindShortResRange(&base, &limit, bt, + args[1], args[2], args[0]); + if (b) + printf("%lu - %lu\n",base, limit); + else + printf("FALSE\n"); + } + } +} + + +static void findShortResRangeHigh(void) +{ + if (checkDefaultRange(1)) { + if (args[0] > (args[2] - args[1])) { + printf("can't fit length in range\n"); + } else { + Index base, limit; + Bool b = BTFindShortResRangeHigh(&base, &limit, bt, + args[1], args[2], args[0]); + if (b) + printf("%lu - %lu\n",base, limit); + else + printf("FALSE\n"); + } + } +} + +static void findLongResRange(void) +{ + if (checkDefaultRange(1)) { + if (args[0] > (args[2] - args[1])) { + printf("can't fit length in range\n"); + } else { + Index base, limit; + Bool b = BTFindLongResRange(&base, &limit, bt, + args[1], args[2], args[0]); + if (b) + printf("%lu - %lu\n",base, limit); + else + printf("FALSE\n"); + } + } +} + + +static void help(void) +{ + printf("c create a BT of size 's'\n" + "d destroy the current BT\n" + "s set the bit index 'i'\n" + "r reset the bit index 'i'\n" + "g get the bit index 'i'\n" + "sr [ ] set the specified range\n" + "rr [ ] reset the specified range\n" + "is [ ] is the specified range set?\n" + "ir [ ] is the specified range reset?\n" + "f [ ] find a reset range of length 'l'.\n" + "fh [ ] find a reset range length 'l', working downwards\n" + "fl [ ] find a reset range of length at least 'l'\n" + "q quit\n" + "? print this message\n" + "\n" + "No way of testing BTSize, BTRangesSame, or BTCopyInvertRange.\n"); +} + + +static struct commandShapeStruct { + char *name; + Count min_args; + Count max_args; + void (*fun)(void); +} commandShapes[] = { + {"c", 1, 1, create}, + {"d", 0, 0, destroy}, + {"s", 1, 1, set}, + {"r", 1, 1, reset}, + {"g", 1, 1, get}, + {"sr", 0, 2, setRange}, + {"rr", 0, 2, resetRange}, + {"is", 0, 2, isSetRange}, + {"ir", 0, 2, isResRange}, + {"f", 1, 3, findShortResRange}, + {"fh", 1, 3, findShortResRangeHigh}, + {"fl", 1, 3, findLongResRange}, + {"?", 0, 0, help}, + {"q", 0, 0, quit}, + { NULL, 0, 0, NULL} +}; + + +typedef struct commandShapeStruct *commandShape; + + +static void obeyCommand(char *command) +{ + commandShape shape = commandShapes; + while(shape->name != NULL) { + char *csp = shape->name; + char *p = command; + while (*csp == *p) { + csp++; + p++; + } + if ((*csp == 0) && ((*p == '\n') || (*p == ' '))) { /* complete match */ + argCount = 0; + while ((*p == ' ') && (argCount < shape->max_args)) { + /* get an argument */ + char *newP; + long l; + l = strtol(p, &newP, 0); + if(l < 0) { /* negative integer */ + printf("negative integer arguments are invalid\n"); + return; + } + args[argCount] = l; + if (newP == p) { /* strtoul failed */ + printf("couldn't parse an integer argument\n"); + return; + } + p = newP; + ++ argCount; + } + if (argCount < shape->min_args) { + printf("insufficient arguments to command\n"); + } else if (*p != '\n') { + printf("too many arguments to command\n"); + } else { /* do the command */ + shape->fun(); + } + return; + } else { + ++ shape; /* try next command */ + } + } + printf("command not understood\n"); + help(); +} + + +#ifdef MPS_BUILD_MV +/* disable "conversion from int to char" */ +#pragma warning(disable: 4244) +#endif + +static void showBT(void) { + Index i; + char c; + if (bt == NULL) + return; + i = 0; + while((i < btSize) && (i < 50)) { + if (i % 10 == 0) + c = (char)((i / 10) % 10) + '0'; + else + c = ' '; + putchar(c); + ++ i; + } + putchar('\n'); + i = 0; + while((i < btSize) && (i < 50)) { + c = (char)(i % 10) +'0'; + putchar(c); + ++ i; + } + putchar('\n'); + i = 0; + while(i < btSize) { + if (BTGet(bt,i)) + c = 'O'; + else + c = '.'; + putchar(c); + ++ i; + if (i % 50 == 0) + putchar('\n'); + } + putchar('\n'); +} + +#ifdef MPS_BUILD_MV +/* disable "conversion from int to char" */ +#pragma warning(default: 4244) +#endif + + +#define testArenaSIZE (((size_t)64)<<20) + +extern int main(int argc, char *argv[]) +{ + bt = NULL; + btSize = 0; + + testlib_unused(argc); testlib_unused(argv); + + die(mps_arena_create((mps_arena_t*)&arena, mps_arena_class_vm(), + testArenaSIZE), + "mps_arena_create"); + while(1) { + char input[100]; + printf("bt test> "); + fflush(stdout); + if (fgets(input, 100, stdin)) { + obeyCommand(input); + showBT(); + } else { + return 0; + } + } +} diff --git a/mps/code/buffer.c b/mps/code/buffer.c new file mode 100644 index 00000000000..22b4cda9485 --- /dev/null +++ b/mps/code/buffer.c @@ -0,0 +1,1526 @@ +/* impl.c.buffer: ALLOCATION BUFFER IMPLEMENTATION + * + * $HopeName: MMsrc!buffer.c(trunk.63) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: This is (part of) the implementation of allocation buffers. + * Several macros which also form part of the implementation are in + * impl.h.mps. Several macros forming part of impl.h.mps should be + * consistent with the macros and functions in this module. + * + * DESIGN + * + * .design: See design.mps.buffer. + * + * .ap.async: The mutator is allowed to change certain AP fields + * asynchronously. Functions that can be called on buffers not + * synchronized with the mutator must take care when reading these + * fields. Such functions are marked with this tag. + * + * TRANSGRESSIONS + * + * .trans.mod: There are several instances where pool structures are + * directly accessed by this module because impl.c.pool does not provide + * an adequate (or adequately documented) interface. They bear this + * tag. */ + +#include "mpm.h" + +SRCID(buffer, "$HopeName: MMsrc!buffer.c(trunk.63) $"); + + +/* forward declarations */ +static void BufferFrameNotifyPopPending(Buffer buffer); + + +/* BufferCheck -- check consistency of a buffer + * + * See .ap.async. */ + +Bool BufferCheck(Buffer buffer) +{ + CHECKS(Buffer, buffer); + CHECKL(buffer->serial < buffer->pool->bufferSerial); /* .trans.mod */ + CHECKU(Arena, buffer->arena); + CHECKU(Pool, buffer->pool); + CHECKL(buffer->arena == buffer->pool->arena); + CHECKL(RingCheck(&buffer->poolRing)); /* design.mps.check.type.no-sig */ + CHECKL(BoolCheck(buffer->isMutator)); + CHECKL(buffer->fillSize >= 0.0); + CHECKL(buffer->emptySize >= 0.0); + CHECKL(buffer->emptySize <= buffer->fillSize); + CHECKL(buffer->alignment == buffer->pool->alignment); + CHECKL(AlignCheck(buffer->alignment)); + CHECKL(BoolCheck(buffer->apStruct.enabled)); + + if (buffer->apStruct.enabled) { + /* no useful check for frameptr - mutator may be updating it */ + CHECKL(BoolCheck(buffer->apStruct.lwPopPending)); + } else { + CHECKL(buffer->apStruct.lwPopPending == FALSE); + CHECKL(buffer->apStruct.frameptr == NULL); + } + + /* If any of the buffer's fields indicate that it is reset, make */ + /* sure it is really reset. Otherwise, check various properties */ + /* of the non-reset fields. */ + if (buffer->mode & BufferModeTRANSITION) { + /* nothing to check */ + } else if ((buffer->mode & BufferModeATTACHED) == 0 + || buffer->base == (Addr)0 + || buffer->apStruct.init == (Addr)0 + || buffer->apStruct.alloc == (Addr)0 + || buffer->poolLimit == (Addr)0) { + CHECKL((buffer->mode & BufferModeATTACHED) == 0); + CHECKL(buffer->base == (Addr)0); + CHECKL(buffer->initAtFlip == (Addr)0); + CHECKL(buffer->apStruct.init == (Addr)0); + CHECKL(buffer->apStruct.alloc == (Addr)0); + CHECKL(buffer->apStruct.limit == (Addr)0); + /* Nothing reliable to check for lightweight frame state */ + CHECKL(buffer->poolLimit == (Addr)0); + } else { + Addr aplimit; + + /* The buffer is attached to a region of memory. */ + /* Check consistency. */ + CHECKL(buffer->mode & BufferModeATTACHED); + + /* These fields should obey the ordering */ + /* base <= init <= alloc <= poolLimit */ + CHECKL(buffer->base <= buffer->apStruct.init); + CHECKL(buffer->apStruct.init <= buffer->apStruct.alloc); + CHECKL(buffer->apStruct.alloc <= buffer->poolLimit); + + /* Check that the fields are aligned to the buffer alignment. */ + CHECKL(AddrIsAligned(buffer->base, buffer->alignment)); + CHECKL(AddrIsAligned(buffer->initAtFlip, buffer->alignment)); + CHECKL(AddrIsAligned(buffer->apStruct.init, buffer->alignment)); + CHECKL(AddrIsAligned(buffer->apStruct.alloc, buffer->alignment)); + CHECKL(AddrIsAligned(buffer->apStruct.limit, buffer->alignment)); + CHECKL(AddrIsAligned(buffer->poolLimit, buffer->alignment)); + + /* .lwcheck: If LW frames are enabled, the buffer may become */ + /* trapped asynchronously. It can't become untrapped */ + /* asynchronously, though. See design.mps.alloc-frame.lw-frame.pop. */ + /* Read a snapshot value of the limit field. Use this to determine */ + /* if we are trapped, and to permit more useful checking when not */ + /* yet trapped. */ + aplimit = buffer->apStruct.limit; + + /* If the buffer isn't trapped then "limit" should be the limit */ + /* set by the owning pool. Otherwise, "init" is either at the */ + /* same place it was at flip (.commit.before) or has been set */ + /* to "alloc" (.commit.after). Also, when the buffer is */ + /* flipped, initAtFlip should hold the init at flip, which is */ + /* between the base and current init. Otherwise, initAtFlip */ + /* is kept at zero to avoid misuse (see */ + /* request.dylan.170429.sol.zero). */ + + if ((buffer->apStruct.enabled && aplimit == (Addr)0) /* see .lwcheck */ + || (!buffer->apStruct.enabled && BufferIsTrapped(buffer))) { + /* .check.use-trapped: This checking function uses BufferIsTrapped, */ + /* So BufferIsTrapped can't do checking as that would cause an */ + /* infinite loop. */ + CHECKL(aplimit == (Addr)0); + if (buffer->mode & BufferModeFLIPPED) { + CHECKL(buffer->apStruct.init == buffer->initAtFlip + || buffer->apStruct.init == buffer->apStruct.alloc); + CHECKL(buffer->base <= buffer->initAtFlip); + CHECKL(buffer->initAtFlip <= buffer->apStruct.init); + } + /* Nothing special to check in the logged mode. */ + } else { + CHECKL(aplimit == buffer->poolLimit); /* see .lwcheck */ + CHECKL(buffer->initAtFlip == (Addr)0); + } + } + + return TRUE; +} + + +/* BufferDescribe -- write out description of buffer + * + * See impl.h.mpmst for structure definitions. */ + +Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(Buffer, buffer)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "Buffer $P ($U) {\n", + (WriteFP)buffer, (WriteFU)buffer->serial, + " class $P (\"$S\")\n", + (WriteFP)buffer->class, buffer->class->name, + " Arena $P\n", (WriteFP)buffer->arena, + " Pool $P\n", (WriteFP)buffer->pool, + buffer->isMutator ? + " Mutator Buffer\n" : " Internal Buffer\n", + " Mode $B\n", (WriteFB)(buffer->mode), + " fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024), + " emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024), + " alignment $W\n", (WriteFW)buffer->alignment, + " base $A\n", buffer->base, + " initAtFlip $A\n", buffer->initAtFlip, + " init $A\n", buffer->apStruct.init, + " alloc $A\n", buffer->apStruct.alloc, + " limit $A\n", buffer->apStruct.limit, + " poolLimit $A\n", buffer->poolLimit, + NULL); + if (res != ResOK) return res; + + res = buffer->class->describe(buffer, stream); + if (res != ResOK) return res; + + res = WriteF(stream, "} Buffer $P ($U)\n", + (WriteFP)buffer, (WriteFU)buffer->serial, + NULL); + return res; +} + + +/* BufferInitV -- initialize an allocation buffer */ + +static Res BufferInitV(Buffer buffer, BufferClass class, + Pool pool, Bool isMutator, va_list args) +{ + Arena arena; + Res res; + + AVER(buffer != NULL); + AVERT(BufferClass, class); + AVERT(Pool, pool); + /* The PoolClass should support buffer protocols */ + AVER((pool->class->attr & AttrBUF)); /* .trans.mod */ + + arena = PoolArena(pool); + /* Initialize the buffer. See impl.h.mpmst for a definition of */ + /* the structure. sig and serial comes later .init.sig-serial */ + buffer->arena = arena; + buffer->class = class; + buffer->pool = pool; + RingInit(&buffer->poolRing); + buffer->isMutator = isMutator; + if (ArenaGlobals(arena)->bufferLogging) { + buffer->mode = BufferModeLOGGED; + } else { + buffer->mode = 0; + } + buffer->fillSize = 0.0; + buffer->emptySize = 0.0; + buffer->alignment = pool->alignment; /* .trans.mod */ + buffer->base = (Addr)0; + buffer->initAtFlip = (Addr)0; + buffer->apStruct.init = (Addr)0; + buffer->apStruct.alloc = (Addr)0; + buffer->apStruct.limit = (Addr)0; + buffer->apStruct.frameptr = NULL; + buffer->apStruct.enabled = FALSE; + buffer->apStruct.lwPopPending = FALSE; + buffer->poolLimit = (Addr)0; + buffer->rampCount = 0; + + /* .init.sig-serial: Now the vanilla stuff is initialized, */ + /* sign the buffer and give it a serial number. It can */ + /* then be safely checked in subclass methods. */ + buffer->sig = BufferSig; + buffer->serial = pool->bufferSerial; /* .trans.mod */ + ++pool->bufferSerial; + AVERT(Buffer, buffer); + + /* Dispatch to the buffer class method to perform any */ + /* class-specific initialization of the buffer. */ + res = (*class->init)(buffer, pool, args); + if (res != ResOK) + goto failInit; + + /* Attach the initialized buffer to the pool. */ + RingAppend(&pool->bufferRing, &buffer->poolRing); + + return ResOK; + +failInit: + RingFinish(&buffer->poolRing); + buffer->sig = SigInvalid; + return res; +} + + +/* BufferCreate -- create an allocation buffer + * + * See design.mps.buffer.method.create. */ + +Res BufferCreate(Buffer *bufferReturn, BufferClass class, + Pool pool, Bool isMutator, ...) +{ + Res res; + va_list args; + + va_start(args, isMutator); + res = BufferCreateV(bufferReturn, class, pool, isMutator, args); + va_end(args); + return res; +} + + +/* BufferCreateV -- create an allocation buffer, with varargs + * + * See design.mps.buffer.method.create. */ + +Res BufferCreateV(Buffer *bufferReturn, BufferClass class, + Pool pool, Bool isMutator, va_list args) +{ + Res res; + Buffer buffer; + Arena arena; + void *p; + + AVER(bufferReturn != NULL); + AVERT(BufferClass, class); + AVERT(Pool, pool); + + arena = PoolArena(pool); + + /* Allocate memory for the buffer descriptor structure. */ + res = ControlAlloc(&p, arena, class->size, + /* withReservoirPermit */ FALSE); + if (res != ResOK) + goto failAlloc; + buffer = p; + + /* Initialize the buffer descriptor structure. */ + res = BufferInitV(buffer, class, pool, isMutator, args); + if (res != ResOK) + goto failInit; + + *bufferReturn = buffer; + return ResOK; + +failInit: + ControlFree(arena, buffer, class->size); +failAlloc: + return res; +} + + +/* BufferDetach -- detach a buffer from a region */ + +void BufferDetach(Buffer buffer, Pool pool) +{ + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + + if (!BufferIsReset(buffer)) { + Addr init, limit; + Size spare; + + buffer->mode |= BufferModeTRANSITION; + init = buffer->apStruct.init; + limit = buffer->poolLimit; + /* Ask the owning pool to do whatever it needs to before the */ + /* buffer is detached (e.g. copy buffer state into pool state). */ + (*pool->class->bufferEmpty)(pool, buffer, init, limit); + /* Use of lightweight frames must have been disabled by now */ + AVER(BufferFrameState(buffer) == BufferFrameDISABLED); + + /* run any class-specific detachment method */ + buffer->class->detach(buffer); + + spare = AddrOffset(init, limit); + buffer->emptySize += spare; + if (buffer->isMutator) { + buffer->pool->emptyMutatorSize += spare; + ArenaGlobals(buffer->arena)->emptyMutatorSize += spare; + ArenaGlobals(buffer->arena)->allocMutatorSize += + AddrOffset(buffer->base, init); + } else { + buffer->pool->emptyInternalSize += spare; + ArenaGlobals(buffer->arena)->emptyInternalSize += spare; + } + + /* Reset the buffer. */ + buffer->base = (Addr)0; + buffer->initAtFlip = (Addr)0; + buffer->apStruct.init = (Addr)0; + buffer->apStruct.alloc = (Addr)0; + buffer->apStruct.limit = (Addr)0; + buffer->poolLimit = (Addr)0; + buffer->mode &= + ~(BufferModeATTACHED|BufferModeFLIPPED|BufferModeTRANSITION); + BufferFrameSetState(buffer, BufferFrameDISABLED); + + EVENT_PW(BufferEmpty, buffer, spare); + } +} + + +/* BufferDestroy -- destroy an allocation buffer + * + * See design.mps.buffer.method.destroy. */ + +void BufferDestroy(Buffer buffer) +{ + Arena arena; + BufferClass class; + + AVERT(Buffer, buffer); + arena = buffer->arena; + class = buffer->class; + AVERT(BufferClass, class); + BufferFinish(buffer); + ControlFree(arena, buffer, class->size); +} + + +/* BufferFinish -- finish an allocation buffer */ + +void BufferFinish(Buffer buffer) +{ + Pool pool; + + AVERT(Buffer, buffer); + + pool = BufferPool(buffer); + + /* The PoolClass should support buffer protocols */ + AVER((pool->class->attr & AttrBUF)); /* .trans.mod */ + AVER(BufferIsReady(buffer)); + + /* design.mps.alloc-frame.lw-frame.sync.trip */ + if (BufferIsTrappedByMutator(buffer)) { + BufferFrameNotifyPopPending(buffer); + } + + BufferDetach(buffer, pool); + + /* Dispatch to the buffer class method to perform any */ + /* class-specific finishing of the buffer. */ + (*buffer->class->finish)(buffer); + + /* Detach the buffer from its owning pool and unsig it. */ + RingRemove(&buffer->poolRing); + buffer->sig = SigInvalid; + + /* Finish off the generic buffer fields. */ + RingFinish(&buffer->poolRing); + + EVENT_P(BufferFinish, buffer); +} + + +/* BufferIsReset -- test whether a buffer is in the "reset" state + * + * A buffer is "reset" when it is not attached. In this state all of + * the pointers into the region are zero. This condition is checked by + * BufferCheck. */ + +Bool BufferIsReset(Buffer buffer) +{ + AVERT(Buffer, buffer); + + return !(buffer->mode & BufferModeATTACHED); +} + + +/* BufferIsReady -- test whether a buffer is ready for reserve + * + * BufferIsReady returns TRUE if and only if the buffer is not between a + * reserve and commit. The result is only reliable if the client is not + * currently using the buffer, since it may update the alloc and init + * pointers asynchronously. */ + +Bool BufferIsReady(Buffer buffer) +{ + AVERT(Buffer, buffer); + + return buffer->apStruct.init == buffer->apStruct.alloc; +} + + +/* BufferIsMutator -- test whether buffer belongs to mutator + * + * Returns TRUE iff mutator was created for the mutator. */ + +Bool BufferIsMutator(Buffer buffer) +{ + AVERT(Buffer, buffer); + + return buffer->isMutator; +} + + +/* BufferSetUnflipped + * + * Unflip a buffer if it was flipped. */ + +static void BufferSetUnflipped(Buffer buffer) +{ + AVERT(Buffer, buffer); + AVER(buffer->mode & BufferModeFLIPPED); + buffer->mode &= ~BufferModeFLIPPED; + /* restore apStruct.limit if appropriate */ + if (!BufferIsTrapped(buffer)) { + buffer->apStruct.limit = buffer->poolLimit; + } + buffer->initAtFlip = (Addr)0; +} + + +/* BufferFrameState + * + * Returns the frame state of a buffer. See + * design.mps.alloc-frame.lw-frame.states. */ + +FrameState BufferFrameState(Buffer buffer) +{ + AVERT(Buffer, buffer); + if (buffer->apStruct.enabled) { + if (buffer->apStruct.lwPopPending) { + return BufferFramePOP_PENDING; + } else { + AVER(buffer->apStruct.frameptr == NULL); + return BufferFrameVALID; + } + } else { + AVER(buffer->apStruct.frameptr == NULL); + AVER(buffer->apStruct.lwPopPending == FALSE); + return BufferFrameDISABLED; + } +} + + +/* BufferFrameSetState + * + * Sets the frame state of a buffer. Only the mutator may set the + * PopPending state. See design.mps.alloc-frame.lw-frame.states. */ + +void BufferFrameSetState(Buffer buffer, FrameState state) +{ + AVERT(Buffer, buffer); + AVER(state == BufferFrameVALID || state == BufferFrameDISABLED); + buffer->apStruct.frameptr = NULL; + buffer->apStruct.lwPopPending = FALSE; + buffer->apStruct.enabled = (state == BufferFrameVALID); +} + + +/* BufferSetAllocAddr + * + * Sets the init & alloc pointers of a buffer. */ + +void BufferSetAllocAddr(Buffer buffer, Addr addr) +{ + AVERT(Buffer, buffer); + /* Can't check Addr */ + AVER(BufferIsReady(buffer)); + AVER(buffer->base <= addr); + AVER(buffer->poolLimit >= addr); + + buffer->apStruct.init = addr; + buffer->apStruct.alloc = addr; +} + + +/* BufferFrameNotifyPopPending + * + * Notifies the pool when a lightweight frame pop operation has been + * deferred and needs to be processed. See + * design.mps.alloc-frame.lw-frame.sync.trip. */ + +static void BufferFrameNotifyPopPending(Buffer buffer) +{ + AllocFrame frame; + Pool pool; + AVER(BufferIsTrappedByMutator(buffer)); + AVER(BufferFrameState(buffer) == BufferFramePOP_PENDING); + frame = (AllocFrame)buffer->apStruct.frameptr; + /* Unset PopPending state & notify the pool */ + BufferFrameSetState(buffer, BufferFrameVALID); + /* If the frame is no longer trapped, undo the trap by resetting */ + /* the AP limit pointer */ + if (!BufferIsTrapped(buffer)) { + buffer->apStruct.limit = buffer->poolLimit; + } + pool = BufferPool(buffer); + (*pool->class->framePopPending)(pool, buffer, frame); +} + + + +/* BufferFramePush + * + * See design.mps.alloc-frame. */ + +Res BufferFramePush(AllocFrame *frameReturn, Buffer buffer) +{ + Pool pool; + AVERT(Buffer, buffer); + AVER(frameReturn != NULL); + + + /* Process any flip or PopPending */ + if (!BufferIsReset(buffer) && buffer->apStruct.limit == (Addr)0) { + /* .fill.unflip: If the buffer is flipped then we unflip the buffer. */ + if (buffer->mode & BufferModeFLIPPED) { + BufferSetUnflipped(buffer); + } + + /* check for PopPending */ + if (BufferIsTrappedByMutator(buffer)) { + BufferFrameNotifyPopPending(buffer); + } + } + pool = BufferPool(buffer); + return (*pool->class->framePush)(frameReturn, pool, buffer); +} + + +/* BufferFramePop + * + * See design.mps.alloc-frame. */ + +Res BufferFramePop(Buffer buffer, AllocFrame frame) +{ + Pool pool; + AVERT(Buffer, buffer); + /* frame is of an abstract type & can't be checked */ + pool = BufferPool(buffer); + return (*pool->class->framePop)(pool, buffer, frame); + +} + + + +/* BufferReserve -- reserve memory from an allocation buffer + * + * .reserve: Keep in sync with impl.h.mps.reserve. */ + +Res BufferReserve(Addr *pReturn, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Addr next; + + AVER(pReturn != NULL); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buffer)->alignment)); + AVER(BufferIsReady(buffer)); + AVER(BoolCheck(withReservoirPermit)); + + /* Is there enough room in the unallocated portion of the buffer to */ + /* satisfy the request? If so, just increase the alloc marker and */ + /* return a pointer to the area below it. */ + next = AddrAdd(buffer->apStruct.alloc, size); + if (next > buffer->apStruct.alloc && next <= buffer->apStruct.limit) { + buffer->apStruct.alloc = next; + *pReturn = buffer->apStruct.init; + return ResOK; + } + + /* If the buffer can't accommodate the request, call "fill". */ + return BufferFill(pReturn, buffer, size, withReservoirPermit); +} + + +/* BufferAttach -- attach a region to a buffer + * + * BufferAttach is entered because of a BufferFill, or because of a Pop + * operation on a lightweight frame. */ + +void BufferAttach(Buffer buffer, Addr base, Addr limit, + Addr init, Size size) +{ + Size filled; + + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + AVER(AddrAdd(base, size) <= limit); + AVER(base <= init); + AVER(init <= limit); + + /* Set up the buffer to point at the supplied region */ + buffer->mode |= BufferModeATTACHED; + buffer->base = base; + buffer->apStruct.init = init; + buffer->apStruct.alloc = AddrAdd(init, size); + /* only set limit if not logged */ + if ((buffer->mode & BufferModeLOGGED) == 0) { + buffer->apStruct.limit = limit; + } else { + AVER(buffer->apStruct.limit == (Addr)0); + } + AVER(buffer->initAtFlip == (Addr)0); + buffer->poolLimit = limit; + + filled = AddrOffset(init, limit); + buffer->fillSize += filled; + if (buffer->isMutator) { + if (base != init) { /* see design.mps.buffer.count.alloc.how */ + Size prealloc = AddrOffset(base, init); + ArenaGlobals(buffer->arena)->allocMutatorSize -= prealloc; + } + buffer->pool->fillMutatorSize += filled; + ArenaGlobals(buffer->arena)->fillMutatorSize += filled; + } else { + buffer->pool->fillInternalSize += filled; + ArenaGlobals(buffer->arena)->fillInternalSize += filled; + } + + /* run any class-specific attachment method */ + buffer->class->attach(buffer, base, limit, init, size); + + AVERT(Buffer, buffer); + EVENT_PWAW(BufferFill, buffer, size, base, filled); +} + + +/* BufferFill -- refill an empty buffer + * + * BufferFill is entered by the "reserve" operation on a buffer if there + * isn't enough room between "alloc" and "limit" to satisfy an + * allocation request. This might be because the buffer has been + * trapped and "limit" has been set to zero. */ + +Res BufferFill(Addr *pReturn, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Res res; + Pool pool; + Addr base, limit, next; + + AVER(pReturn != NULL); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buffer)->alignment)); + AVER(BufferIsReady(buffer)); + + pool = BufferPool(buffer); + + /* If we're here because the buffer was trapped, then we attempt */ + /* the allocation here. */ + if (!BufferIsReset(buffer) && buffer->apStruct.limit == (Addr)0) { + /* .fill.unflip: If the buffer is flipped then we unflip the buffer. */ + if (buffer->mode & BufferModeFLIPPED) { + BufferSetUnflipped(buffer); + } + + /* design.mps.alloc-frame.lw-frame.sync.trip */ + if (BufferIsTrappedByMutator(buffer)) { + BufferFrameNotifyPopPending(buffer); + } + + /* .fill.logged: If the buffer is logged then we leave it logged. */ + next = AddrAdd(buffer->apStruct.alloc, size); + if (next > buffer->apStruct.alloc && + next <= buffer->poolLimit) { + buffer->apStruct.alloc = next; + if (buffer->mode & BufferModeLOGGED) { + EVENT_PAW(BufferReserve, buffer, buffer->apStruct.init, size); + } + *pReturn = buffer->apStruct.init; + return ResOK; + } + } + + /* There really isn't enough room for the allocation now. */ + AVER(AddrAdd(buffer->apStruct.alloc, size) > buffer->poolLimit + || AddrAdd(buffer->apStruct.alloc, size) < buffer->apStruct.alloc); + + BufferDetach(buffer, pool); + + /* Ask the pool for some memory. */ + res = (*pool->class->bufferFill)(&base, &limit, + pool, buffer, size, + withReservoirPermit); + if (res != ResOK) + return res; + + /* Set up the buffer to point at the memory given by the pool */ + /* and do the allocation that was requested by the client. */ + BufferAttach(buffer, base, limit, base, size); + + if (buffer->mode & BufferModeLOGGED) { + EVENT_PAW(BufferReserve, buffer, buffer->apStruct.init, size); + } + + *pReturn = base; + return res; +} + + + +/* BufferCommit -- commit memory previously reserved + * + * .commit: Keep in sync with impl.h.mps.commit. */ + +Bool BufferCommit(Buffer buffer, Addr p, Size size) +{ + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buffer)->alignment)); + AVER(!BufferIsReady(buffer)); + + /* See design.mps.collection.flip. */ + /* .commit.before: If a flip occurs before this point, when the */ + /* pool reads "initAtFlip" it will point below the object, so it */ + /* will be trashed and the commit must fail when trip is called. */ + AVER(p == buffer->apStruct.init); + AVER(AddrAdd(buffer->apStruct.init, size) == buffer->apStruct.alloc); + + /* .commit.update: Atomically update the init pointer to declare */ + /* that the object is initialized (though it may be invalid if a */ + /* flip occurred). */ + buffer->apStruct.init = buffer->apStruct.alloc; + + /* .improve.memory-barrier: Memory barrier here on the DEC Alpha */ + /* (and other relaxed memory order architectures). */ + /* .commit.after: If a flip occurs at this point, the pool will */ + /* see "initAtFlip" above the object, which is valid, so it will */ + /* be collected. The commit must succeed when trip is called. */ + /* The pointer "p" will have been fixed up. (@@@@ Will it?) */ + /* .commit.trip: Trip the buffer if a flip has occurred. */ + if (buffer->apStruct.limit == 0) + return BufferTrip(buffer, p, size); + + /* No flip occurred, so succeed. */ + + return TRUE; +} + + +/* BufferTrip -- act on a trapped buffer + * + * Called from BufferCommit (and its equivalents) when invoked on a + * trapped buffer (indicated by limit == 0). This function can decide + * whether to succeed or fail the commit. */ + +Bool BufferTrip(Buffer buffer, Addr p, Size size) +{ + Pool pool; + + AVERT(Buffer, buffer); + AVER(p != 0); + AVER(size > 0); + AVER(SizeIsAligned(size, buffer->alignment)); + + /* The limit field should be zero, because that's how trip gets */ + /* called. See .commit.trip. */ + AVER(buffer->apStruct.limit == 0); + /* Of course we should be trapped. */ + AVER(BufferIsTrapped(buffer)); + /* But the mutator shouldn't have caused the trap */ + AVER(!BufferIsTrappedByMutator(buffer)); + + /* The init and alloc fields should be equal at this point, because */ + /* the step .commit.update has happened. */ + AVER(buffer->apStruct.init == buffer->apStruct.alloc); + + /* The p parameter points at the base address of the allocated */ + /* block, the end of which should now coincide with the init and */ + /* alloc fields. */ + /* Note that we don't _really_ care about p too much. We don't */ + /* do anything else with it apart from these checks. (in particular */ + /* it seems like the algorithms could be modified to cope with the */ + /* case of the object having been copied between Commit updating i */ + /* and testing limit) */ + AVER(AddrAdd(p, size) == buffer->apStruct.init); + + pool = BufferPool(buffer); + + AVER(PoolHasAddr(pool, p)); + + /* .trip.unflip: If the flip occurred before commit set "init" */ + /* to "alloc" (see .commit.before) then the object is invalid */ + /* (won't've been scanned) so undo the allocation and fail commit. */ + /* Otherwise (see .commit.after) the object is valid (will've been */ + /* scanned) so commit can simply succeed. */ + if ((buffer->mode & BufferModeFLIPPED) + && buffer->apStruct.init != buffer->initAtFlip) { + /* Reset just enough state for Reserve/Fill to work. */ + /* The buffer is left trapped and we leave the untrapping */ + /* for the next reserve (which goes out of line to Fill */ + /* (.fill.unflip) because the buffer is still trapped) */ + buffer->apStruct.init = p; + buffer->apStruct.alloc = p; + return FALSE; + } + + /* Emit event including class if loggged */ + if (buffer->mode & BufferModeLOGGED) { + Bool b; + Format format; + Addr clientClass; + + b = PoolFormat(&format, buffer->pool); + if (b) { + clientClass = format->class(p); + } else { + clientClass = (Addr)0; + } + EVENT_PAWA(BufferCommit, buffer, p, size, clientClass); + /* Of course, it's not _really_ unused unless you're not */ + /* using telemetry. This is a HACK @@@@. It should be */ + /* removed when telemetry is fixed to use its arguments. */ + UNUSED(clientClass); + } + return TRUE; +} + + +/* BufferFlip -- trap buffer at GC flip time + * + * .flip: Tells the buffer that a flip has occurred. If the buffer is + * between reserve and commit, and has a rank (i.e. references), and has + * the two-phase protocol, then the object being initialized is + * invalidated by failing the next commit. The buffer code handles this + * automatically (ie the pool implementation is not involved). If the + * buffer is reset there is no effect, since there is no object to + * invalidate. If the buffer is already flipped there is no effect, + * since the object is already invalid by a previous trace. The buffer + * becomes unflipped at the next reserve or commit operation (actually + * reserve because commit is lazy). This is handled by BufferFill + * (.fill.unflip) or BufferTrip (.trip.unflip). */ + +void BufferFlip(Buffer buffer) +{ + AVERT(Buffer, buffer); + + if (BufferRankSet(buffer) != RankSetEMPTY + && (buffer->mode & BufferModeFLIPPED) == 0 + && !BufferIsReset(buffer)) { + AVER(buffer->initAtFlip == (Addr)0); + buffer->initAtFlip = buffer->apStruct.init; + /* Memory Barrier here? @@@@ */ + buffer->apStruct.limit = (Addr)0; + buffer->mode |= BufferModeFLIPPED; + } +} + + +/* BufferScanLimit -- return limit of data to which to scan + * + * Returns the highest address to which it is safe to scan objects in + * the buffer. When the buffer is not flipped, this is the "init" of + * the AP. When the buffer is flipped, it is the value that "init" had + * at flip time. [Could make BufferScanLimit return the AP "alloc" when + * using ambiguous scanning.] See .ap.async. */ + +Addr BufferScanLimit(Buffer buffer) +{ + if (buffer->mode & BufferModeFLIPPED) { + return buffer->initAtFlip; + } else { + return buffer->apStruct.init; + } +} + + +Seg BufferSeg(Buffer buffer) +{ + AVERT(Buffer, buffer); + return buffer->class->seg(buffer); +} + + +RankSet BufferRankSet(Buffer buffer) +{ + AVERT(Buffer, buffer); + return buffer->class->rankSet(buffer); +} + +void BufferSetRankSet(Buffer buffer, RankSet rankset) +{ + AVERT(Buffer, buffer); + AVERT(RankSet, rankset); + buffer->class->setRankSet(buffer, rankset); +} + + +/* BufferReassignSeg -- adjust the seg of an attached buffer + * + * Used for segment splitting and merging. */ + +void BufferReassignSeg(Buffer buffer, Seg seg) +{ + AVERT(Buffer, buffer); + AVERT(Seg, seg); + AVER(!BufferIsReset(buffer)); + AVER(BufferBase(buffer) >= SegBase(seg)); + AVER(BufferLimit(buffer) <= SegLimit(seg)); + AVER(BufferPool(buffer) == SegPool(seg)); + buffer->class->reassignSeg(buffer, seg); +} + + +/* BufferIsTrapped + * + * Indicates whether the buffer is trapped - either by MPS or the + * mutator. See .ap.async. */ + +Bool BufferIsTrapped(Buffer buffer) +{ + /* Can't check buffer, see .check.use-trapped */ + return BufferIsTrappedByMutator(buffer) + || ((buffer->mode & (BufferModeFLIPPED|BufferModeLOGGED)) != 0); +} + + +/* BufferIsTrappedByMutator + * + * Indicates whether the mutator trapped the buffer. See + * design.mps.alloc-frame.lw-frame.sync.trip and .ap.async. */ + +Bool BufferIsTrappedByMutator(Buffer buffer) +{ + AVER(!buffer->apStruct.lwPopPending || buffer->apStruct.enabled); + /* Can't check buffer, see .check.use-trapped */ + return buffer->apStruct.lwPopPending; +} + + +/* Alloc pattern functions + * + * Just represent the two patterns by two different pointers to dummies. */ + +AllocPatternStruct AllocPatternRampStruct = {'\0'}; + +AllocPattern AllocPatternRamp(void) +{ + return &AllocPatternRampStruct; +} + +AllocPatternStruct AllocPatternRampCollectAllStruct = {'\0'}; + +AllocPattern AllocPatternRampCollectAll(void) +{ + return &AllocPatternRampCollectAllStruct; +} + +static Bool AllocPatternCheck(AllocPattern pattern) +{ + CHECKL(pattern == &AllocPatternRampCollectAllStruct + || pattern == &AllocPatternRampStruct); + UNUSED(pattern); /* impl.c.mpm.check.unused */ + return TRUE; +} + + +/* BufferRampBegin -- note an entry into a ramp pattern + * + * .ramp.hack: We count the number of times the ap has begun ramp mode + * (and not ended), so we can do reset by ending all the current ramps. */ + +void BufferRampBegin(Buffer buffer, AllocPattern pattern) +{ + Pool pool; + + AVERT(Buffer, buffer); + AVERT(AllocPattern, pattern); + + ++buffer->rampCount; + AVER(buffer->rampCount > 0); + + pool = BufferPool(buffer); + AVERT(Pool, pool); + (*pool->class->rampBegin)(pool, buffer, + pattern == &AllocPatternRampCollectAllStruct); +} + + +/* BufferRampEnd -- note an exit from a ramp pattern */ + +Res BufferRampEnd(Buffer buffer) +{ + Pool pool; + + AVERT(Buffer, buffer); + + if (buffer->rampCount == 0) + return ResFAIL; + --buffer->rampCount; + + pool = BufferPool(buffer); + AVERT(Pool, pool); + (*pool->class->rampEnd)(pool, buffer); + return ResOK; +} + + +/* BufferRampReset -- exit from ramp mode */ + +void BufferRampReset(Buffer buffer) +{ + Pool pool; + + AVERT(Buffer, buffer); + + if (buffer->rampCount == 0) + return; + + pool = BufferPool(buffer); + AVERT(Pool, pool); + do + (*pool->class->rampEnd)(pool, buffer); + while(--buffer->rampCount > 0); +} + + + +/* BufferClass -- support for the basic Buffer class */ + + +/* bufferTrivInit -- basic buffer init method */ + +static Res bufferTrivInit (Buffer buffer, Pool pool, va_list args) +{ + /* initialization happens in BufferInitV so checks are safe */ + AVERT(Buffer, buffer); + AVERT(Pool, pool); + UNUSED(args); + EVENT_PPU(BufferInit, buffer, pool, buffer->isMutator); + return ResOK; +} + + +/* bufferTrivFinish -- basic buffer finish method */ + +static void bufferTrivFinish (Buffer buffer) +{ + /* No special finish for simple buffers */ + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + NOOP; +} + + +/* bufferTrivAttach -- basic buffer attach method */ + +static void bufferTrivAttach(Buffer buffer, Addr base, Addr limit, + Addr init, Size size) +{ + /* No special attach method for simple buffers */ + AVERT(Buffer, buffer); + /* Other parameters are consistency checked in BufferAttach */ + UNUSED(base); + UNUSED(limit); + UNUSED(init); + UNUSED(size); + NOOP; +} + + +/* bufferTrivDetach -- basic buffer detach method */ + +static void bufferTrivDetach(Buffer buffer) +{ + /* No special detach method for simple buffers */ + AVERT(Buffer, buffer); + NOOP; +} + + +/* bufferNoSeg -- basic buffer BufferSeg accessor method + * + * .noseg: basic buffers don't support segments, so this method should + * not be called. */ + +static Seg bufferNoSeg (Buffer buffer) +{ + AVERT(Buffer, buffer); + NOTREACHED; /* .noseg */ + return NULL; +} + + + +/* bufferTrivRankSet -- basic BufferRankSet accessor method */ + +static RankSet bufferTrivRankSet (Buffer buffer) +{ + AVERT(Buffer, buffer); + /* vanilla buffers can only have empty rank set */ + return RankSetEMPTY; +} + + +/* bufferNoSetRankSet -- basic BufferSetRankSet setter method + * + * .norank: basic buffers don't support ranksets, so this method should + * not be called. */ + +static void bufferNoSetRankSet (Buffer buffer, RankSet rankset) +{ + AVERT(Buffer, buffer); + AVERT(RankSet, rankset); + NOTREACHED; /* .norank */ +} + + +/* bufferNoReassignSeg -- basic BufferReassignSeg method + * + * .noseg: basic buffers don't support attachment to sements, so this + * method should not be called. */ + +static void bufferNoReassignSeg (Buffer buffer, Seg seg) +{ + AVERT(Buffer, buffer); + AVERT(Seg, seg); + NOTREACHED; /* .noseg */ +} + + +/* bufferTrivDescribe -- basic Buffer describe method */ + +static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream) +{ + if (!CHECKT(Buffer, buffer)) return ResFAIL; + if (stream == NULL) return ResFAIL; + /* dispatching function does it all */ + return ResOK; +} + + +/* BufferClassCheck -- check the consistency of a BufferClass */ + +Bool BufferClassCheck(BufferClass class) +{ + CHECKL(ProtocolClassCheck(&class->protocol)); + CHECKL(class->name != NULL); /* Should be <=6 char C identifier */ + CHECKL(class->size >= sizeof(BufferStruct)); + CHECKL(FUNCHECK(class->init)); + CHECKL(FUNCHECK(class->finish)); + CHECKL(FUNCHECK(class->attach)); + CHECKL(FUNCHECK(class->detach)); + CHECKL(FUNCHECK(class->seg)); + CHECKL(FUNCHECK(class->rankSet)); + CHECKL(FUNCHECK(class->setRankSet)); + CHECKL(FUNCHECK(class->reassignSeg)); + CHECKL(FUNCHECK(class->describe)); + CHECKS(BufferClass, class); + return TRUE; +} + + +/* BufferClass -- the vanilla buffer class definition + * + * See design.mps.buffer.class.hierarchy.buffer. */ + +DEFINE_CLASS(BufferClass, class) +{ + INHERIT_CLASS(&class->protocol, ProtocolClass); + class->name = "BUFFER"; + class->size = sizeof(BufferStruct); + class->init = bufferTrivInit; + class->finish = bufferTrivFinish; + class->attach = bufferTrivAttach; + class->detach = bufferTrivDetach; + class->describe = bufferTrivDescribe; + class->seg = bufferNoSeg; + class->rankSet = bufferTrivRankSet; + class->setRankSet = bufferNoSetRankSet; + class->reassignSeg = bufferNoReassignSeg; + class->sig = BufferClassSig; +} + + + +/* SegBufClass -- support for the SegBuf subclass */ + + +/* BufferSegBuf -- convert generic Buffer to a SegBuf */ + +#define BufferSegBuf(buffer) ((SegBuf)(buffer)) + + +/* SegBufCheck -- check consistency of a SegBuf */ + +Bool SegBufCheck(SegBuf segbuf) +{ + Buffer buffer; + + CHECKS(SegBuf, segbuf); + buffer = &segbuf->bufferStruct; + CHECKL(BufferCheck(buffer)); + CHECKL(RankSetCheck(segbuf->rankSet)); + + if (buffer->mode & BufferModeTRANSITION) { + /* nothing to check */ + } else if ((buffer->mode & BufferModeATTACHED) == 0) { + CHECKL(segbuf->seg == NULL); + } else { + /* The buffer is attached to a segment. */ + CHECKL(segbuf->seg != NULL); + CHECKL(SegCheck(segbuf->seg)); + /* To avoid recursive checking, leave it to SegCheck to make */ + /* sure the buffer and segment fields tally. */ + + if (buffer->mode & BufferModeFLIPPED) { + /* Only buffers that allocate pointers get flipped. */ + CHECKL(segbuf->rankSet != RankSetEMPTY); + } + } + + return TRUE; +} + + +/* segBufInit -- SegBuf init method */ + +static Res segBufInit (Buffer buffer, Pool pool, va_list args) +{ + BufferClass super; + SegBuf segbuf; + Res res; + + AVERT(Buffer, buffer); + AVERT(Pool, pool); + segbuf = BufferSegBuf(buffer); + + /* Initialize the superclass fields first via next-method call */ + super = BUFFER_SUPERCLASS(SegBufClass); + res = super->init(buffer, pool, args); + if (res != ResOK) + return res; + + segbuf->seg = NULL; + segbuf->sig = SegBufSig; + segbuf->rankSet = RankSetEMPTY; + + AVERT(SegBuf, segbuf); + EVENT_PPU(BufferInitSeg, buffer, pool, buffer->isMutator); + return ResOK; +} + + +/* segBufFinish -- SegBuf finish method */ + +static void segBufFinish (Buffer buffer) +{ + BufferClass super; + SegBuf segbuf; + + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + segbuf = BufferSegBuf(buffer); + AVERT(SegBuf, segbuf); + + segbuf->sig = SigInvalid; + + /* finish the superclass fields last */ + super = BUFFER_SUPERCLASS(SegBufClass); + super->finish(buffer); +} + + +/* segBufAttach -- SegBuf attach method */ + +static void segBufAttach(Buffer buffer, Addr base, Addr limit, + Addr init, Size size) +{ + SegBuf segbuf; + Seg seg; + Arena arena; + Bool found; + + AVERT(Buffer, buffer); + /* Other parameters are consistency checked in BufferAttach */ + UNUSED(init); + UNUSED(size); + + segbuf = BufferSegBuf(buffer); + arena = BufferArena(buffer); + found = SegOfAddr(&seg, arena, base); + AVER(found); + AVER(segbuf->seg == NULL); + AVER(SegBuffer(seg) == NULL); + AVER(SegBase(seg) <= base); + AVER(limit <= SegLimit(seg)); + + /* attach the buffer to the segment */ + SegSetBuffer(seg, buffer); + segbuf->seg = seg; + + AVERT(SegBuf, segbuf); +} + + +/* segBufDetach -- SegBuf detach method */ + +static void segBufDetach(Buffer buffer) +{ + SegBuf segbuf; + Seg seg; + + AVERT(Buffer, buffer); + segbuf = BufferSegBuf(buffer); + AVERT(SegBuf, segbuf); + + seg = segbuf->seg; + AVER(seg != NULL); + SegSetBuffer(seg, NULL); + segbuf->seg = NULL; +} + + +/* segBufSeg -- BufferSeg accessor method for SegBuf instances */ + +static Seg segBufSeg (Buffer buffer) +{ + SegBuf segbuf; + + AVERT(Buffer, buffer); + segbuf = BufferSegBuf(buffer); + AVERT(SegBuf, segbuf); + return segbuf->seg; +} + + +/* segBufRankSet -- BufferRankSet accessor for SegBuf instances */ + +static RankSet segBufRankSet (Buffer buffer) +{ + SegBuf segbuf; + + AVERT(Buffer, buffer); + segbuf = BufferSegBuf(buffer); + AVERT(SegBuf, segbuf); + return segbuf->rankSet; +} + + +/* segBufSetRankSet -- BufferSetRankSet setter method for SegBuf */ + +static void segBufSetRankSet (Buffer buffer, RankSet rankset) +{ + SegBuf segbuf; + + AVERT(Buffer, buffer); + AVERT(RankSet, rankset); + segbuf = BufferSegBuf(buffer); + AVERT(SegBuf, segbuf); + segbuf->rankSet = rankset; +} + + +/* segBufReassignSeg -- BufferReassignSeg method for SegBuf + * + * Used to support segment merging and splitting. + * + * .invseg: On entry the buffer is attached to an invalid segment, which + * can't be checked. The method is called to make the attachment valid. */ + +static void segBufReassignSeg (Buffer buffer, Seg seg) +{ + SegBuf segbuf; + + AVERT(Buffer, buffer); + AVERT(Seg, seg); + segbuf = BufferSegBuf(buffer); + /* Can't check segbuf on entry. See .invseg */ + AVER(NULL != segbuf->seg); + AVER(seg != segbuf->seg); + segbuf->seg = seg; + AVERT(SegBuf, segbuf); +} + + +/* segBufDescribe -- describe method for SegBuf */ + +static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream) +{ + SegBuf segbuf; + BufferClass super; + Res res; + + if (!CHECKT(Buffer, buffer)) return ResFAIL; + if (stream == NULL) return ResFAIL; + segbuf = BufferSegBuf(buffer); + if (!CHECKT(SegBuf, segbuf)) return ResFAIL; + + /* Describe the superclass fields first via next-method call */ + super = BUFFER_SUPERCLASS(SegBufClass); + res = super->describe(buffer, stream); + if (res != ResOK) return res; + + res = WriteF(stream, + " Seg $P\n", (WriteFP)segbuf->seg, + " rankSet $U\n", (WriteFU)segbuf->rankSet, + NULL); + + return res; +} + + +/* SegBufClass -- SegBuf class definition + * + * Supports an association with a single segment when attached. See + * design.mps.buffer.class.hierarchy.segbuf. */ + +typedef BufferClassStruct SegBufClassStruct; + +DEFINE_CLASS(SegBufClass, class) +{ + INHERIT_CLASS(class, BufferClass); + class->name = "SEGBUF"; + class->size = sizeof(SegBufStruct); + class->init = segBufInit; + class->finish = segBufFinish; + class->attach = segBufAttach; + class->detach = segBufDetach; + class->describe = segBufDescribe; + class->seg = segBufSeg; + class->rankSet = segBufRankSet; + class->setRankSet = segBufSetRankSet; + class->reassignSeg = segBufReassignSeg; +} + + +/* RankBufClass -- support for the RankBufClass subclass */ + + +/* rankBufInit -- RankBufClass init method */ + +static Res rankBufInit (Buffer buffer, Pool pool, va_list args) +{ + /* Assumes pun compatibility between Rank and mps_rank_t */ + /* Which is checked by mpsi_check in impl.c.mpsi */ + Rank rank = va_arg(args, Rank); + BufferClass super; + Res res; + + AVERT(Buffer, buffer); + AVERT(Pool, pool); + AVER(RankCheck(rank)); + + /* Initialize the superclass fields first via next-method call */ + super = BUFFER_SUPERCLASS(RankBufClass); + res = super->init(buffer, pool, args); + if (res != ResOK) + return res; + + BufferSetRankSet(buffer, RankSetSingle(rank)); + + /* There's nothing to check that the superclass doesn't, so no AVERT. */ + EVENT_PPUU(BufferInitRank, buffer, pool, buffer->isMutator, rank); + return ResOK; +} + + +/* RankBufClass -- RankBufClass class definition + * + * A subclass of SegBufClass, sharing structure for instances. + * + * Supports initialization to a rank supplied at creation time. */ + +typedef BufferClassStruct RankBufClassStruct; + +DEFINE_CLASS(RankBufClass, class) +{ + INHERIT_CLASS(class, SegBufClass); + class->name = "RANKBUF"; + class->init = rankBufInit; +} diff --git a/mps/code/cbs.c b/mps/code/cbs.c new file mode 100644 index 00000000000..7b4e2e06ad4 --- /dev/null +++ b/mps/code/cbs.c @@ -0,0 +1,1661 @@ +/* impl.c.cbs: COALESCING BLOCK STRUCTURE IMPLEMENTATION + * + * $HopeName: MMsrc!cbs.c(trunk.20) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .intro: This is a portable implementation of coalescing block + * structures. + * + * .purpose: CBSs are used to manage potentially unbounded + * collections of memory blocks. + * + * .sources: design.mps.cbs. + */ + +#include "cbs.h" +#include "splay.h" +#include "meter.h" +#include "poolmfs.h" +#include "mpm.h" + + +SRCID(cbs, "$HopeName: MMsrc!cbs.c(trunk.20) $"); + + +/* See design.mps.cbs.align */ +#define cbsMinimumAlignment ((Align)sizeof(void *)) + +#define cbsOfSplayTree(tree) PARENT(CBSStruct, splayTree, (tree)) +#define cbsBlockOfSplayNode(node) PARENT(CBSBlockStruct, splayNode, (node)) +#define splayTreeOfCBS(tree) (&((cbs)->splayTree)) +#define splayNodeOfCBSBlock(block) (&((block)->splayNode)) +#define keyOfCBSBlock(block) ((void *)&((block)->base)) + + +/* CBSEmergencyBlock* -- Getters and setters for emergency blocks + * + * See design.mps.cbs.impl.low-mem.inline.block. + */ + +#define CBSEmergencyBlockBase(block) ((Addr)(block)) +#define CBSEmergencyBlockLimit(block) ((Addr)((block)[1])) +#define CBSEmergencyBlockSize(block) \ + (AddrOffset(CBSEmergencyBlockBase(block), CBSEmergencyBlockLimit(block))) +#define CBSEmergencyBlockNext(block) ((CBSEmergencyBlock)((block)[0])) + +#define CBSEmergencyBlockSetNext(block, next) \ + BEGIN (block)[0] = (void *)(next); END +#define CBSEmergencyBlockSetLimit(block, limit) \ + BEGIN (block)[1] = (void *)(limit); END + + +/* CBSEmergencyGrain* -- Getters and setters for emergency grains + * + * See design.mps.cbs.impl.low-mem.inline.grain. + */ + +#define CBSEmergencyGrainBase(grain) ((Addr)(grain)) +#define CBSEmergencyGrainLimit(cbs, grain) \ + AddrAdd(CBSEmergencyGrainBase(grain), CBSEmergencyGrainSize(cbs)) +#define CBSEmergencyGrainSize(cbs) ((cbs)->alignment) +#define CBSEmergencyGrainNext(grain) ((CBSEmergencyGrain)((grain)[0])) + +#define CBSEmergencyGrainSetNext(grain, next) \ + BEGIN (grain)[0] = (void *)(next); END + + +static CBSEmergencyBlock CBSEmergencyBlockInit(Addr base, Addr limit) +{ + CBSEmergencyBlock block = (CBSEmergencyBlock)base; + CBSEmergencyBlockSetNext(block, NULL); + CBSEmergencyBlockSetLimit(block, limit); + return block; +} + +static CBSEmergencyGrain CBSEmergencyGrainInit(CBS cbs, Addr base, Addr limit) +{ + CBSEmergencyGrain grain = (CBSEmergencyGrain)base; + AVER(AddrOffset(base, limit) == CBSEmergencyGrainSize(cbs)); + CBSEmergencyGrainSetNext(grain, NULL); + return grain; +} + + +/* CBSEnter, CBSLeave -- Avoid re-entrance + * + * .enter-leave: The callbacks are restricted in what they may call. + * These functions enforce this. + * + * .enter-leave.simple: Simple queries may be called from callbacks. + */ + +static void CBSEnter(CBS cbs) +{ + /* Don't need to check as always called from interface function. */ + AVER(!cbs->inCBS); + cbs->inCBS = TRUE; + return; +} + +static void CBSLeave(CBS cbs) +{ + /* Don't need to check as always called from interface function. */ + AVER(cbs->inCBS); + cbs->inCBS = FALSE; + return; +} + + +/* CBSCheck -- Check CBS */ + +Bool CBSCheck(CBS cbs) +{ + /* See .enter-leave.simple. */ + CHECKS(CBS, cbs); + CHECKL(cbs != NULL); + CHECKL(SplayTreeCheck(splayTreeOfCBS(cbs))); + /* nothing to check about splayTreeSize */ + CHECKD(Pool, cbs->blockPool); + CHECKL(BoolCheck(cbs->mayUseInline)); + CHECKL(BoolCheck(cbs->fastFind)); + CHECKL(BoolCheck(cbs->inCBS)); + CHECKL(cbs->new == NULL || FUNCHECK(cbs->new)); + CHECKL(cbs->delete == NULL || FUNCHECK(cbs->delete)); + CHECKL(cbs->grow == NULL || FUNCHECK(cbs->grow)); + CHECKL(cbs->shrink == NULL || FUNCHECK(cbs->shrink)); + CHECKL(cbs->mayUseInline || cbs->emergencyBlockList == NULL); + CHECKL(cbs->mayUseInline || cbs->emergencyGrainList == NULL); + /* See design.mps.cbs.align */ + CHECKL(!cbs->mayUseInline || + AlignIsAligned(cbs->alignment, cbsMinimumAlignment)); + /* can't check emergencyBlockList or emergencyGrainList more */ + /* Checking eblSize and eglSize is too laborious without a List ADT */ + /* No MeterCheck */ + + return TRUE; +} + + +/* CBSBlockCheck -- See design.mps.cbs.function.cbs.block.check */ + +Bool CBSBlockCheck(CBSBlock block) +{ + /* See .enter-leave.simple. */ + UNUSED(block); /* Required because there is no signature */ + CHECKL(block != NULL); + CHECKL(SplayNodeCheck(splayNodeOfCBSBlock(block))); + + /* If the block is in the middle of being deleted, */ + /* the pointers will be equal. */ + CHECKL(CBSBlockBase(block) <= CBSBlockLimit(block)); + /* Can't check maxSize because it may be invalid at the time */ + return TRUE; +} + + +/* CBSBlockSize -- see design.mps.cbs.function.cbs.block.size */ + +Size (CBSBlockSize)(CBSBlock block) +{ + /* See .enter-leave.simple. */ + return CBSBlockSize(block); +} + + +/* cbsSplayCompare -- Compare key to [base,limit) + * + * See design.mps.splay.type.splay.compare.method + */ + +static Compare cbsSplayCompare(void *key, SplayNode node) +{ + Addr base1, base2, limit2; + CBSBlock cbsBlock; + + /* NULL key compares less than everything. */ + if (key == NULL) + return CompareLESS; + + AVER(node != NULL); + + base1 = *(Addr *)key; + cbsBlock = cbsBlockOfSplayNode(node); + base2 = cbsBlock->base; + limit2 = cbsBlock->limit; + + if (base1 < base2) + return CompareLESS; + else if (base1 >= limit2) + return CompareGREATER; + else + return CompareEQUAL; +} + + +/* cbsTestNode, cbsTestTree -- test for nodes larger than the S parameter */ + +static Bool cbsTestNode(SplayTree tree, SplayNode node, + void *closureP, unsigned long closureS) +{ + Size size; + CBSBlock block; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + AVER(closureP == NULL); + AVER(closureS > 0); + AVER(cbsOfSplayTree(tree)->fastFind); + + size = (Size)closureS; + block = cbsBlockOfSplayNode(node); + + return CBSBlockSize(block) >= size; +} + +static Bool cbsTestTree(SplayTree tree, SplayNode node, + void *closureP, unsigned long closureS) +{ + Size size; + CBSBlock block; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + AVER(closureP == NULL); + AVER(closureS > 0); + AVER(cbsOfSplayTree(tree)->fastFind); + + size = (Size)closureS; + block = cbsBlockOfSplayNode(node); + + return block->maxSize >= size; +} + + +/* cbsUpdateNode -- update size info after restructuring */ + +static void cbsUpdateNode(SplayTree tree, SplayNode node, + SplayNode leftChild, SplayNode rightChild) +{ + Size maxSize; + CBSBlock block; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + if (leftChild != NULL) + AVERT(SplayNode, leftChild); + if (rightChild != NULL) + AVERT(SplayNode, rightChild); + AVER(cbsOfSplayTree(tree)->fastFind); + + block = cbsBlockOfSplayNode(node); + maxSize = CBSBlockSize(block); + + if (leftChild != NULL) { + Size size = cbsBlockOfSplayNode(leftChild)->maxSize; + if (size > maxSize) + maxSize = size; + } + + if (rightChild != NULL) { + Size size = cbsBlockOfSplayNode(rightChild)->maxSize; + if (size > maxSize) + maxSize = size; + } + + block->maxSize = maxSize; +} + + +/* CBSInit -- Initialise a CBS structure + * + * See design.mps.cbs.function.cbs.init. + */ + +Res CBSInit(Arena arena, CBS cbs, void *owner, + CBSChangeSizeMethod new, CBSChangeSizeMethod delete, + CBSChangeSizeMethod grow, CBSChangeSizeMethod shrink, + Size minSize, Align alignment, + Bool mayUseInline, Bool fastFind) +{ + Res res; + + AVERT(Arena, arena); + AVER(new == NULL || FUNCHECK(new)); + AVER(delete == NULL || FUNCHECK(delete)); + AVER(BoolCheck(mayUseInline)); + if (mayUseInline) { + /* See design.mps.cbs.align */ + if (!AlignIsAligned(alignment, cbsMinimumAlignment)) + return ResPARAM; + } + + SplayTreeInit(splayTreeOfCBS(cbs), &cbsSplayCompare, + fastFind ? &cbsUpdateNode : NULL); + res = PoolCreate(&(cbs->blockPool), arena, PoolClassMFS(), + sizeof(CBSBlockStruct) * 64, sizeof(CBSBlockStruct)); + if (res != ResOK) + return res; + cbs->splayTreeSize = 0; + + cbs->new = new; + cbs->delete = delete; + cbs->grow = grow; + cbs->shrink = shrink; + cbs->minSize = minSize; + cbs->mayUseInline = mayUseInline; + cbs->fastFind = fastFind; + cbs->alignment = alignment; + cbs->inCBS = TRUE; + cbs->emergencyBlockList = NULL; + cbs->eblSize = 0; + cbs->emergencyGrainList = NULL; + cbs->eglSize = 0; + + METER_INIT(cbs->splaySearch, "size of splay tree", (void *)cbs); + METER_INIT(cbs->eblSearch, "size of emergencyBlockList", (void *)cbs); + METER_INIT(cbs->eglSearch, "size of emergencyGrainList", (void *)cbs); + + cbs->sig = CBSSig; + + AVERT(CBS, cbs); + EVENT_PP(CBSInit, cbs, owner); + UNUSED(owner); /* @@@@ hack: unused in non-event varieties */ + CBSLeave(cbs); + return ResOK; +} + + +/* CBSFinish -- Finish a CBS structure + * + * See design.mps.cbs.function.cbs.finish. + */ + +void CBSFinish(CBS cbs) +{ + AVERT(CBS, cbs); + CBSEnter(cbs); + + METER_EMIT(&cbs->splaySearch); + METER_EMIT(&cbs->eblSearch); + METER_EMIT(&cbs->eglSearch); + + cbs->sig = SigInvalid; + + SplayTreeFinish(splayTreeOfCBS(cbs)); + PoolDestroy(cbs->blockPool); + cbs->emergencyBlockList = NULL; + cbs->emergencyGrainList = NULL; +} + + +/* Node change operators + * + * These four functions are called whenever blocks are created, + * destroyed, grow, or shrink. They report to the client, and + * perform the necessary memory management. They are responsible + * for the client interaction logic. + */ + +static void cbsBlockDelete(CBS cbs, CBSBlock block) +{ + Res res; + Size oldSize; + + AVERT(CBS, cbs); + AVERT(CBSBlock, block); + + oldSize = CBSBlockSize(block); + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + res = SplayTreeDelete(splayTreeOfCBS(cbs), splayNodeOfCBSBlock(block), + keyOfCBSBlock(block)); + AVER(res == ResOK); /* Must be possible to delete node */ + STATISTIC(--cbs->splayTreeSize); + + /* make invalid */ + block->limit = block->base; + + if (cbs->delete != NULL && oldSize >= cbs->minSize) + (*(cbs->delete))(cbs, block, oldSize, (Size)0); + + PoolFree(cbs->blockPool, (Addr)block, sizeof(CBSBlockStruct)); + + return; +} + +static void cbsBlockShrink(CBS cbs, CBSBlock block, Size oldSize) +{ + Size newSize; + + AVERT(CBS, cbs); + AVERT(CBSBlock, block); + + newSize = CBSBlockSize(block); + AVER(oldSize > newSize); + + if (cbs->fastFind) { + SplayNodeRefresh(splayTreeOfCBS(cbs), splayNodeOfCBSBlock(block), + keyOfCBSBlock(block)); + AVER(CBSBlockSize(block) <= block->maxSize); + } + + if (cbs->delete != NULL && oldSize >= cbs->minSize && newSize < cbs->minSize) + (*(cbs->delete))(cbs, block, oldSize, newSize); + else if (cbs->shrink != NULL && newSize >= cbs->minSize) + (*(cbs->shrink))(cbs, block, oldSize, newSize); +} + +static void cbsBlockGrow(CBS cbs, CBSBlock block, Size oldSize) +{ + Size newSize; + + AVERT(CBS, cbs); + AVERT(CBSBlock, block); + + newSize = CBSBlockSize(block); + AVER(oldSize < newSize); + + if (cbs->fastFind) { + SplayNodeRefresh(splayTreeOfCBS(cbs), splayNodeOfCBSBlock(block), + keyOfCBSBlock(block)); + AVER(CBSBlockSize(block) <= block->maxSize); + } + + if (cbs->new != NULL && oldSize < cbs->minSize && newSize >= cbs->minSize) + (*(cbs->new))(cbs, block, oldSize, newSize); + else if (cbs->grow != NULL && oldSize >= cbs->minSize) + (*(cbs->grow))(cbs, block, oldSize, newSize); +} + +static Res cbsBlockNew(CBS cbs, Addr base, Addr limit) +{ + CBSBlock block; + Res res; + Addr p; + Size newSize; + + AVERT(CBS, cbs); + + res = PoolAlloc(&p, cbs->blockPool, sizeof(CBSBlockStruct), + /* withReservoirPermit */ FALSE); + if (res != ResOK) + goto failPoolAlloc; + block = (CBSBlock)p; + + SplayNodeInit(splayNodeOfCBSBlock(block)); + block->base = base; + block->limit = limit; + newSize = CBSBlockSize(block); + block->maxSize = newSize; + + AVERT(CBSBlock, block); + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + res = SplayTreeInsert(splayTreeOfCBS(cbs), splayNodeOfCBSBlock(block), + keyOfCBSBlock(block)); + AVER(res == ResOK); + STATISTIC(++cbs->splayTreeSize); + + if (cbs->new != NULL && newSize >= cbs->minSize) + (*(cbs->new))(cbs, block, (Size)0, newSize); + + return ResOK; + +failPoolAlloc: + AVER(res != ResOK); + return res; +} + + +/* cbsInsertIntoTree -- Insert a range into the splay tree */ + +static Res cbsInsertIntoTree(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Addr base, Addr limit) +{ + Res res; + Addr newBase, newLimit; + SplayNode leftSplay, rightSplay; + CBSBlock leftCBS, rightCBS; + Bool leftMerge, rightMerge; + Size oldSize; + + AVERT(CBS, cbs); + AVER(base != (Addr)0); + AVER(base < limit); + AVER(AddrIsAligned(base, cbs->alignment)); + AVER(AddrIsAligned(limit, cbs->alignment)); + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + res = SplayTreeNeighbours(&leftSplay, &rightSplay, + splayTreeOfCBS(cbs), (void *)&base); + if (res != ResOK) + goto fail; + + if (leftSplay == NULL) { + leftCBS = NULL; + leftMerge = FALSE; + } else { + leftCBS = cbsBlockOfSplayNode(leftSplay); + AVER(leftCBS->limit <= base); /* by cbsSplayCompare */ + leftMerge = leftCBS->limit == base; + } + + if (rightSplay == NULL) { + rightCBS = NULL; + rightMerge = FALSE; + } else { + rightCBS = cbsBlockOfSplayNode(rightSplay); + if (rightCBS != NULL && limit > rightCBS->base) { + res = ResFAIL; + goto fail; + } + rightMerge = rightCBS->base == limit; + } + + newBase = leftMerge ? CBSBlockBase(leftCBS) : base; + newLimit = rightMerge ? CBSBlockLimit(rightCBS) : limit; + + if (leftMerge) { + if (rightMerge) { + Size oldLeftSize = CBSBlockSize(leftCBS); + Size oldRightSize = CBSBlockSize(rightCBS); + + /* must block larger neighbour and destroy smaller neighbour; */ + /* see design.mps.cbs.function.cbs.insert.callback */ + if (oldLeftSize >= oldRightSize) { + Addr rightLimit = rightCBS->limit; + cbsBlockDelete(cbs, rightCBS); + leftCBS->limit = rightLimit; + cbsBlockGrow(cbs, leftCBS, oldLeftSize); + } else { /* left block is smaller */ + Addr leftBase = leftCBS->base; + cbsBlockDelete(cbs, leftCBS); + rightCBS->base = leftBase; + cbsBlockGrow(cbs, rightCBS, oldRightSize); + } + } else { /* leftMerge, !rightMerge */ + oldSize = CBSBlockSize(leftCBS); + leftCBS->limit = limit; + cbsBlockGrow(cbs, leftCBS, oldSize); + } + } else { /* !leftMerge */ + if (rightMerge) { + oldSize = CBSBlockSize(rightCBS); + rightCBS->base = base; + cbsBlockGrow(cbs, rightCBS, oldSize); + } else { /* !leftMerge, !rightMerge */ + res = cbsBlockNew(cbs, base, limit); + if (res != ResOK) + goto fail; + } + } + + AVER(newBase <= base); + AVER(newLimit >= limit); + *baseReturn = newBase; + *limitReturn = newLimit; + + return ResOK; + +fail: + AVER(res != ResOK); + return res; +} + + +/* cbsCoalesceWithEmergencyLists -- coalesce received range with EBL and EGL + * + * Attempts to extend the range about to be freed by adding ranges from + * the emergency lists. May remove blocks from the emergency list. + */ + +static Res cbsCoalesceWithEmergencyLists(Addr *baseIO, Addr *limitIO, CBS cbs) +{ + Addr base, limit; + Count nCoalescences = 0; + + AVER(baseIO != NULL); + AVER(limitIO != NULL); + AVERT(CBS, cbs); + AVER(cbs->mayUseInline); + + base = *baseIO; + limit = *limitIO; + AVER(base < limit); + + if (cbs->emergencyBlockList != NULL) { + CBSEmergencyBlock prev, block, next; + Addr blockBase, blockLimit; + + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(block = cbs->emergencyBlockList, prev = NULL; + block != NULL && CBSEmergencyBlockBase(block) <= limit; + block = CBSEmergencyBlockNext(block)) { + + blockBase = CBSEmergencyBlockBase(block); + blockLimit = CBSEmergencyBlockLimit(block); + AVER(blockBase < blockLimit); + + if (prev != NULL) + AVER(CBSEmergencyBlockLimit(prev) < blockBase); + + if (blockLimit == base) { + base = blockBase; + next = CBSEmergencyBlockNext(block); + if (prev == NULL) + cbs->emergencyBlockList = next; + else + CBSEmergencyBlockSetNext(prev, next); + ++nCoalescences; + STATISTIC(--cbs->eblSize); + AVER(cbs->emergencyBlockList != NULL || cbs->eblSize == 0); + } else if (blockBase == limit) { + limit = blockLimit; + next = CBSEmergencyBlockNext(block); + if (prev == NULL) + cbs->emergencyBlockList = next; + else + CBSEmergencyBlockSetNext(prev, next); + ++nCoalescences; + STATISTIC(--cbs->eblSize); + AVER(cbs->emergencyBlockList != NULL || cbs->eblSize == 0); + /* For loop will stop at next test */ + } else if (blockLimit > base) { + return ResFAIL; /* range intersects block */ + } else { + prev = block; /* Only move prev if we didn't delete */ + } + } + /* block's next is still valid, even if it's been coalesced */ + } + + if (cbs->emergencyGrainList != NULL) { + CBSEmergencyGrain prev, grain, next; + Addr grainBase, grainLimit; + + METER_ACC(cbs->eglSearch, cbs->eglSize); + for(grain = cbs->emergencyGrainList, prev = NULL; + grain != NULL && CBSEmergencyGrainBase(grain) <= limit && + nCoalescences < 2; + grain = CBSEmergencyGrainNext(grain)) { + grainBase = CBSEmergencyGrainBase(grain); + grainLimit = CBSEmergencyGrainLimit(cbs, grain); + AVER(grainBase < grainLimit); + + if (prev != NULL) + AVER(CBSEmergencyGrainLimit(cbs, prev) < grainBase); + + if (grainLimit == base) { + base = grainBase; + next = CBSEmergencyGrainNext(grain); + if (prev == NULL) + cbs->emergencyGrainList = next; + else + CBSEmergencyGrainSetNext(prev, next); + ++nCoalescences; + STATISTIC(--cbs->eglSize); + AVER(cbs->emergencyGrainList != NULL || cbs->eglSize == 0); + } else if (grainBase == limit) { + limit = grainLimit; + next = CBSEmergencyGrainNext(grain); + if (prev == NULL) + cbs->emergencyGrainList = next; + else + CBSEmergencyGrainSetNext(prev, next); + ++nCoalescences; + STATISTIC(--cbs->eglSize); + AVER(cbs->emergencyGrainList != NULL || cbs->eglSize == 0); + break; + } else if (grainLimit > base) { + return ResFAIL; /* range intersects grain */ + } else { + prev = grain; + } + } + /* grain's next is still valid, even if it's been coalesced */ + } + + /* Because the lists are known to have isolated ranges, there can */ + /* be no more than 2 coalescences. */ + AVER(nCoalescences <= 2); + + *baseIO = base; + *limitIO = limit; + return ResOK; +} + + +/* cbsAddToEmergencyLists -- Adds range to emergency lists + * + * The range must be unadjacent to any items on the emergency lists. + */ + +static Res cbsAddToEmergencyLists(CBS cbs, Addr base, Addr limit) +{ + Res res = ResOK; + Size size; + + AVERT(CBS, cbs); + AVER(base < limit); + AVER(cbs->mayUseInline); + + size = AddrOffset(base, limit); + /* Use the block list if possible. See design.mps.cbs.align. */ + if (size > cbsMinimumAlignment) { + CBSEmergencyBlock prev, block, new; + new = CBSEmergencyBlockInit(base, limit); + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(prev = NULL, block = cbs->emergencyBlockList; + block != NULL && CBSEmergencyBlockBase(block) < base; + prev = block, block = CBSEmergencyBlockNext(block)) { + if (prev != NULL) + AVER(CBSEmergencyBlockLimit(prev) < CBSEmergencyBlockBase(block)); + AVER(CBSEmergencyBlockBase(block) < CBSEmergencyBlockLimit(block)); + } + + if (prev != NULL && block != NULL) + AVER(CBSEmergencyBlockLimit(prev) < CBSEmergencyBlockBase(block)); + + /* check ordering: prev ... new ... block */ + if (prev != NULL && CBSEmergencyBlockLimit(prev) >= base) + return ResFAIL; /* range intersects with existing block */ + + if (block != NULL && limit >= CBSEmergencyBlockBase(block)) + return ResFAIL; /* range intersects with existing block */ + + if (prev == NULL) + cbs->emergencyBlockList = new; + else + CBSEmergencyBlockSetNext(prev, new); + CBSEmergencyBlockSetNext(new, block); /* may be NULL */ + STATISTIC(++cbs->eblSize); + } else if (size == CBSEmergencyGrainSize(cbs)) { + CBSEmergencyGrain prev, grain, new; + new = CBSEmergencyGrainInit(cbs, base, limit); + METER_ACC(cbs->eglSearch, cbs->eglSize); + for(prev = NULL, grain = cbs->emergencyGrainList; + grain != NULL && CBSEmergencyGrainBase(grain) < base; + prev = grain, grain = CBSEmergencyGrainNext(grain)) { + if (prev != NULL) + AVER(CBSEmergencyGrainLimit(cbs, prev) < + CBSEmergencyGrainBase(grain)); + } + + if (prev != NULL && grain != NULL) + AVER(CBSEmergencyGrainLimit(cbs, prev) < CBSEmergencyGrainBase(grain)); + + /* check ordering: prev ... new ... grain */ + if (prev != NULL && CBSEmergencyGrainLimit(cbs, prev) >= base) + return ResFAIL; /* range intersects with existing grain */ + + if (grain != NULL && limit >= CBSEmergencyGrainBase(grain)) + return ResFAIL; /* range intersects with existing grain */ + + if (prev == NULL) + cbs->emergencyGrainList = new; + else + CBSEmergencyGrainSetNext(prev, new); + CBSEmergencyGrainSetNext(new, grain); /* may be NULL */ + STATISTIC(++cbs->eglSize); + } else { + NOTREACHED; + res = ResFAIL; /* in case AVERs are compiled out */ + } + + return res; +} + + +/* cbsFlushEmergencyLists -- Attempt to move ranges to CBS proper */ + +static void cbsFlushEmergencyLists(CBS cbs) +{ + Res res = ResOK; + Addr base, limit; + + AVERT(CBS, cbs); + AVER(cbs->mayUseInline); + + if (cbs->emergencyBlockList != NULL) { + CBSEmergencyBlock block; + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(block = cbs->emergencyBlockList; + block != NULL; + block = CBSEmergencyBlockNext(block)) { + AVER(CBSEmergencyBlockBase(block) < CBSEmergencyBlockLimit(block)); + res = cbsInsertIntoTree(&base, &limit, + cbs, CBSEmergencyBlockBase(block), + CBSEmergencyBlockLimit(block)); + if (res == ResOK) { + AVER(cbs->emergencyBlockList == block); + /* Emergency block is isolated in CBS */ + AVER(base == CBSEmergencyBlockBase(block)); + AVER(limit == CBSEmergencyBlockLimit(block)); + + cbs->emergencyBlockList = CBSEmergencyBlockNext(block); + STATISTIC(--cbs->eblSize); + AVER(cbs->emergencyBlockList != NULL || cbs->eblSize == 0); + } else { + AVER(ResIsAllocFailure(res)); + goto done; + } + } + } + + if (cbs->emergencyGrainList != NULL) { + CBSEmergencyGrain grain; + METER_ACC(cbs->eglSearch, cbs->eglSize); + for(grain = cbs->emergencyGrainList; + grain != NULL; + grain = CBSEmergencyGrainNext(grain)) { + res = cbsInsertIntoTree(&base, &limit, + cbs, CBSEmergencyGrainBase(grain), + CBSEmergencyGrainLimit(cbs, grain)); + if (res == ResOK) { + AVER(cbs->emergencyGrainList == grain); + /* Emergency grain is isolated in CBS */ + AVER(base == CBSEmergencyGrainBase(grain)); + AVER(limit == CBSEmergencyGrainLimit(cbs, grain)); + + cbs->emergencyGrainList = CBSEmergencyGrainNext(grain); + STATISTIC(--cbs->eglSize); + AVER(cbs->emergencyGrainList != NULL || cbs->eglSize == 0); + } else { + AVER(ResIsAllocFailure(res)); + goto done; + } + } + } + + done: + return; +} + + +/* CBSInsert -- Insert a range into the CBS + * + * See design.mps.cbs.functions.cbs.insert. + */ + +Res CBSInsertReturningRange(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Addr base, Addr limit) +{ + Addr newBase, newLimit; + Res res; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(base != (Addr)0); + AVER(base < limit); + AVER(AddrIsAligned(base, cbs->alignment)); + AVER(AddrIsAligned(limit, cbs->alignment)); + + if (cbs->mayUseInline) { + newBase = base; + newLimit = limit; + + res = cbsCoalesceWithEmergencyLists(&newBase, &newLimit, cbs); + if (res != ResOK) { + AVER(res == ResFAIL); + goto done; + } + + res = cbsInsertIntoTree(&newBase, &newLimit, cbs, newBase, newLimit); + /* newBase and newLimit only changed if res == ResOK */ + + if (ResIsAllocFailure(res)) { + res = cbsAddToEmergencyLists(cbs, newBase, newLimit); + if (res != ResOK) { + AVER(res == ResFAIL); + goto done; + } + } else { + /* Attempt to clear emergency lists */ + cbsFlushEmergencyLists(cbs); + } + } else { + res = cbsInsertIntoTree(&newBase, &newLimit, cbs, base, limit); + } + + done: + if (res == ResOK) { + AVER(newBase <= base); + AVER(limit <= newLimit); + *baseReturn = newBase; + *limitReturn = newLimit; + } + + CBSLeave(cbs); + return res; +} + +Res CBSInsert(CBS cbs, Addr base, Addr limit) +{ + Res res; + Addr newBase, newLimit; + + /* all parameters checked by CBSInsertReturningRange */ + /* CBSEnter/Leave done by CBSInsertReturningRange */ + + res = CBSInsertReturningRange(&newBase, &newLimit, + cbs, base, limit); + + return res; +} + + +/* cbsDeleteFrom* -- delete blocks from different parts of the CBS */ + +static Res cbsDeleteFromTree(CBS cbs, Addr base, Addr limit) +{ + Res res; + CBSBlock cbsBlock; + SplayNode splayNode; + Size oldSize; + + /* parameters already checked */ + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + res = SplayTreeSearch(&splayNode, splayTreeOfCBS(cbs), (void *)&base); + if (res != ResOK) + goto failSplayTreeSearch; + cbsBlock = cbsBlockOfSplayNode(splayNode); + + if (limit > cbsBlock->limit) { + res = ResFAIL; + goto failLimitCheck; + } + + if (base == cbsBlock->base) { + if (limit == cbsBlock->limit) { /* entire block */ + cbsBlockDelete(cbs, cbsBlock); + } else { /* remaining fragment at right */ + AVER(limit < cbsBlock->limit); + oldSize = CBSBlockSize(cbsBlock); + cbsBlock->base = limit; + cbsBlockShrink(cbs, cbsBlock, oldSize); + } + } else { + AVER(base > cbsBlock->base); + if (limit == cbsBlock->limit) { /* remaining fragment at left */ + oldSize = CBSBlockSize(cbsBlock); + cbsBlock->limit = base; + cbsBlockShrink(cbs, cbsBlock, oldSize); + } else { /* two remaining fragments */ + Size leftNewSize = AddrOffset(cbsBlock->base, base); + Size rightNewSize = AddrOffset(limit, cbsBlock->limit); + /* must shrink larger fragment and create smaller; */ + /* see design.mps.cbs.function.cbs.delete.callback */ + if (leftNewSize >= rightNewSize) { + Addr oldLimit = cbsBlock->limit; + AVER(limit < cbsBlock->limit); + oldSize = CBSBlockSize(cbsBlock); + cbsBlock->limit = base; + cbsBlockShrink(cbs, cbsBlock, oldSize); + res = cbsBlockNew(cbs, limit, oldLimit); + if (res != ResOK) { + AVER(ResIsAllocFailure(res)); + if (cbs->mayUseInline) { + res = cbsAddToEmergencyLists(cbs, limit, oldLimit); + AVER(res == ResOK); + } else { + goto failNew; + } + } + } else { /* right fragment is larger */ + Addr oldBase = cbsBlock->base; + AVER(base > cbsBlock->base); + oldSize = CBSBlockSize(cbsBlock); + cbsBlock->base = limit; + cbsBlockShrink(cbs, cbsBlock, oldSize); + res = cbsBlockNew(cbs, oldBase, base); + if (res != ResOK) { + AVER(ResIsAllocFailure(res)); + if (cbs->mayUseInline) { + res = cbsAddToEmergencyLists(cbs, oldBase, base); + AVER(res == ResOK); + } else { + goto failNew; + } + } + } + } + } + + return ResOK; + +failNew: +failLimitCheck: +failSplayTreeSearch: + AVER(res != ResOK); + return res; +} + + +static Res cbsDeleteFromEmergencyBlockList(CBS cbs, Addr base, Addr limit) +{ + Res res; + Addr blockBase, blockLimit; + CBSEmergencyBlock prev, block; + + /* parameters already checked in caller */ + AVER(cbs->mayUseInline); + + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(prev = NULL, block = cbs->emergencyBlockList; + block != NULL && CBSEmergencyBlockLimit(block) < limit; + prev = block, block = CBSEmergencyBlockNext(block)) { + AVER(CBSEmergencyBlockBase(block) < CBSEmergencyBlockLimit(block)); + if (CBSEmergencyBlockBase(block) >= base) + return ResFAIL; + if (prev != NULL) + AVER(CBSEmergencyBlockLimit(prev) < CBSEmergencyBlockBase(block)); + } + + if (block != NULL) { + blockBase = CBSEmergencyBlockBase(block); + blockLimit = CBSEmergencyBlockLimit(block); + AVER(blockBase < blockLimit); + AVER(blockLimit >= limit); + + if (blockBase <= base && limit <= blockLimit) { + /* remove from list */ + if (prev == NULL) + cbs->emergencyBlockList = CBSEmergencyBlockNext(block); + else + CBSEmergencyBlockSetNext(prev, CBSEmergencyBlockNext(block)); + STATISTIC(--cbs->eblSize); + AVER(cbs->emergencyBlockList != NULL || cbs->eblSize == 0); + if (blockBase < base) { + res = cbsAddToEmergencyLists(cbs, blockBase, base); + if (res != ResOK) + return res; + } + if (limit < blockLimit) { + res = cbsAddToEmergencyLists(cbs, limit, blockLimit); + if (res != ResOK) + return res; + } + return ResOK; + } else { + return ResFAIL; /* partly in list */ + } + } + return ResFAIL; /* not in list at all */ +} + + +static Res cbsDeleteFromEmergencyGrainList(CBS cbs, Addr base, Addr limit) +{ + Addr grainBase, grainLimit; + CBSEmergencyGrain prev, grain; + + /* parameters already checked in caller */ + AVER(cbs->mayUseInline); + if (AddrOffset(base, limit) != CBSEmergencyGrainSize(cbs)) + return ResFAIL; + + METER_ACC(cbs->eglSearch, cbs->eglSize); + for(prev = NULL, grain = cbs->emergencyGrainList; + grain != NULL && CBSEmergencyGrainLimit(cbs, grain) < limit; + prev = grain, grain = CBSEmergencyGrainNext(grain)) { + if (prev != NULL) + AVER(CBSEmergencyGrainLimit(cbs, prev) < CBSEmergencyGrainBase(grain)); + } + + if (grain != NULL) { + grainBase = CBSEmergencyGrainBase(grain); + grainLimit = CBSEmergencyGrainLimit(cbs, grain); + AVER(grainLimit >= limit); + + if (grainBase <= base && limit <= grainLimit) { + AVER(grainBase == base); + AVER(grainLimit == limit); + /* remove from list */ + if (prev == NULL) + cbs->emergencyGrainList = CBSEmergencyGrainNext(grain); + else + CBSEmergencyGrainSetNext(prev, CBSEmergencyGrainNext(grain)); + STATISTIC(--cbs->eglSize); + AVER(cbs->emergencyGrainList != NULL || cbs->eglSize == 0); + return ResOK; + } else { + return ResFAIL; /* range is partly in list */ + } + } + return ResFAIL; /* range is not in list at all */ +} + + +/* CBSDelete -- Remove a range from a CBS + * + * See design.mps.cbs.function.cbs.delete. + */ + +Res CBSDelete(CBS cbs, Addr base, Addr limit) +{ + Res res; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(base != NULL); + AVER(limit > base); + AVER(AddrIsAligned(base, cbs->alignment)); + AVER(AddrIsAligned(limit, cbs->alignment)); + + res = cbsDeleteFromTree(cbs, base, limit); + + /* We rely on the consistency of the three free structures. */ + /* These checks don't distinguish "partially in" from "not in". */ + if (cbs->mayUseInline) { + AVER(res == ResOK || res == ResFAIL); + if (res == ResFAIL) { /* wasn't in tree */ + res = cbsDeleteFromEmergencyBlockList(cbs, base, limit); + if (res == ResFAIL) { /* wasn't in block list */ + res = cbsDeleteFromEmergencyGrainList(cbs, base, limit); + } + } + /* always worth trying, wherever we found the deleted block */ + if (res == ResOK) + cbsFlushEmergencyLists(cbs); + } + + CBSLeave(cbs); + return res; +} + + +Res CBSBlockDescribe(CBSBlock block, mps_lib_FILE *stream) +{ + Res res; + + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "[$P,$P) {$U}", + (WriteFP)block->base, + (WriteFP)block->limit, + (WriteFU)block->maxSize, + NULL); + return res; +} + +static Res CBSSplayNodeDescribe(SplayNode splayNode, mps_lib_FILE *stream) +{ + Res res; + + if (splayNode == NULL) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = CBSBlockDescribe(cbsBlockOfSplayNode(splayNode), stream); + return res; +} + + +/* CBSIterate -- Iterate all blocks in CBS + * + * This is not necessarily efficient. + * See design.mps.cbs.function.cbs.iterate. + */ + +/* Internal version without enter/leave checking. */ +static void cbsIterateInternal(CBS cbs, CBSIterateMethod iterate, void *closureP) +{ + SplayNode splayNode; + SplayTree splayTree; + CBSBlock cbsBlock; + + AVERT(CBS, cbs); + AVER(FUNCHECK(iterate)); + + splayTree = splayTreeOfCBS(cbs); + /* .splay-iterate.slow: We assume that splay tree iteration does */ + /* searches and meter it. */ + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + splayNode = SplayTreeFirst(splayTree, NULL); + while(splayNode != NULL) { + cbsBlock = cbsBlockOfSplayNode(splayNode); + if (!(*iterate)(cbs, cbsBlock, closureP)) { + break; + } + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + splayNode = SplayTreeNext(splayTree, splayNode, keyOfCBSBlock(cbsBlock)); + } + return; +} + +void CBSIterate(CBS cbs, CBSIterateMethod iterate, void *closureP) +{ + AVERT(CBS, cbs); + AVER(FUNCHECK(iterate)); + CBSEnter(cbs); + + cbsIterateInternal(cbs, iterate, closureP); + + CBSLeave(cbs); + return; +} + + +/* CBSIterateLarge -- Iterate only large blocks + * + * This function iterates only blocks that are larger than or equal + * to the minimum size. + */ + +typedef struct CBSIterateLargeClosureStruct { + void *p; + CBSIterateMethod f; +} CBSIterateLargeClosureStruct, *CBSIterateLargeClosure; + +static Bool cbsIterateLargeAction(CBS cbs, CBSBlock block, void *p) +{ + Bool b = TRUE; + CBSIterateLargeClosure closure; + + closure = (CBSIterateLargeClosure)p; + AVER(closure != NULL); + + if (CBSBlockSize(block) >= cbs->minSize) + b = (closure->f)(cbs, block, closure->p); + + return b; +} + + +void CBSIterateLarge(CBS cbs, CBSIterateMethod iterate, void *closureP) +{ + CBSIterateLargeClosureStruct closure; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(FUNCHECK(iterate)); + + closure.p = closureP; + closure.f = iterate; + cbsIterateInternal(cbs, &cbsIterateLargeAction, (void *)&closure); + + CBSLeave(cbs); + return; +} + + +/* CBSSetMinSize -- Set minimum interesting size for cbs + * + * This function may invoke the shrink and grow methods as + * appropriate. See design.mps.cbs.function.cbs.set.min-size. + */ + +typedef struct { + Size old; + Size new; +} CBSSetMinSizeClosureStruct, *CBSSetMinSizeClosure; + +static Bool cbsSetMinSizeGrow(CBS cbs, CBSBlock block, void *p) +{ + CBSSetMinSizeClosure closure; + Size size; + + closure = (CBSSetMinSizeClosure)p; + AVER(closure->old > closure->new); + size = CBSBlockSize(block); + if (size < closure->old && size >= closure->new) + (*cbs->new)(cbs, block, size, size); + + return TRUE; +} + +static Bool cbsSetMinSizeShrink(CBS cbs, CBSBlock block, void *p) +{ + CBSSetMinSizeClosure closure; + Size size; + + closure = (CBSSetMinSizeClosure)p; + AVER(closure->old < closure->new); + size = CBSBlockSize(block); + if (size >= closure->old && size < closure->new) + (*cbs->delete)(cbs, block, size, size); + + return TRUE; +} + +void CBSSetMinSize(CBS cbs, Size minSize) +{ + CBSSetMinSizeClosureStruct closure; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + closure.old = cbs->minSize; + closure.new = minSize; + + if (minSize < cbs->minSize) + cbsIterateInternal(cbs, &cbsSetMinSizeGrow, (void *)&closure); + else if (minSize > cbs->minSize) + cbsIterateInternal(cbs, &cbsSetMinSizeShrink, (void *)&closure); + + cbs->minSize = minSize; + + CBSLeave(cbs); +} + + +/* CBSFindDeleteCheck -- check method for a CBSFindDelete value */ + +static Bool CBSFindDeleteCheck(CBSFindDelete findDelete) +{ + CHECKL(findDelete == CBSFindDeleteNONE || findDelete == CBSFindDeleteLOW + || findDelete == CBSFindDeleteHIGH + || findDelete == CBSFindDeleteENTIRE); + UNUSED(findDelete); /* impl.c.mpm.check.unused */ + + return TRUE; +} + + +/* cbsFindDeleteRange -- delete approriate range of block found */ + +typedef Res (*cbsDeleteMethod)(CBS cbs, Addr base, Addr limit); + +static void cbsFindDeleteRange(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Addr base, Addr limit, Size size, + cbsDeleteMethod delete, + CBSFindDelete findDelete) +{ + Bool callDelete = TRUE; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(CBS, cbs); + AVER(base < limit); + AVER(size > 0); + AVER(AddrOffset(base, limit) >= size); + AVER(FUNCHECK(delete)); + AVERT(CBSFindDelete, findDelete); + + switch(findDelete) { + + case CBSFindDeleteNONE: { + callDelete = FALSE; + } break; + + case CBSFindDeleteLOW: { + limit = AddrAdd(base, size); + } break; + + case CBSFindDeleteHIGH: { + base = AddrSub(limit, size); + } break; + + case CBSFindDeleteENTIRE: { + /* do nothing */ + } break; + + default: { + NOTREACHED; + } break; + } + + if (callDelete) { + Res res; + res = (*delete)(cbs, base, limit); + AVER(res == ResOK); + } + + *baseReturn = base; + *limitReturn = limit; +} + + +/* CBSFindFirst -- find the first block of at least the given size */ + +Bool CBSFindFirst(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Size size, CBSFindDelete findDelete) +{ + Bool found; + Addr base = (Addr)0, limit = (Addr)0; /* only defined when found is TRUE */ + cbsDeleteMethod deleteMethod = NULL; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVER(size > 0); + AVER(sizeof(unsigned long) >= sizeof(Size)); + AVER(SizeIsAligned(size, cbs->alignment)); + AVER(cbs->fastFind); + AVERT(CBSFindDelete, findDelete); + + cbsFlushEmergencyLists(cbs); /* might do some good */ + + { + SplayNode node; + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + found = SplayFindFirst(&node, splayTreeOfCBS(cbs), &cbsTestNode, + &cbsTestTree, NULL, (unsigned long)size); + + if (found) { + CBSBlock block; + + block = cbsBlockOfSplayNode(node); + AVER(CBSBlockSize(block) >= size); + base = CBSBlockBase(block); + limit = CBSBlockLimit(block); + deleteMethod = &cbsDeleteFromTree; + } + } + + if (cbs->emergencyBlockList != NULL) { + CBSEmergencyBlock block; + + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(block = cbs->emergencyBlockList; + block != NULL && + (!found || CBSEmergencyBlockBase(block) < base); + block = CBSEmergencyBlockNext(block)) { + if (CBSEmergencyBlockSize(block) >= size) { + found = TRUE; + base = CBSEmergencyBlockBase(block); + limit = CBSEmergencyBlockLimit(block); + deleteMethod = &cbsDeleteFromEmergencyBlockList; + /* @@@@ Could remove in place more efficiently. */ + break; + } + } + } + + if (cbs->emergencyGrainList != NULL && + size <= CBSEmergencyGrainSize(cbs)) { + /* Take first grain */ + CBSEmergencyGrain grain = cbs->emergencyGrainList; + + if (!found || CBSEmergencyGrainBase(grain) < base) { + found = TRUE; + base = CBSEmergencyGrainBase(grain); + limit = CBSEmergencyGrainLimit(cbs, grain); + deleteMethod = &cbsDeleteFromEmergencyGrainList; + } + } + + if (found) { + AVER(AddrOffset(base, limit) >= size); + cbsFindDeleteRange(baseReturn, limitReturn, cbs, base, limit, size, + deleteMethod, findDelete); + } + + CBSLeave(cbs); + return found; +} + + +/* CBSFindLast -- find the last block of at least the given size */ + +Bool CBSFindLast(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Size size, CBSFindDelete findDelete) +{ + Bool found; + Addr base = (Addr)0, limit = (Addr)0; /* only defined in found is TRUE */ + cbsDeleteMethod deleteMethod = NULL; + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVER(size > 0); + AVER(sizeof(unsigned long) >= sizeof(Size)); + AVER(SizeIsAligned(size, cbs->alignment)); + AVER(cbs->fastFind); + AVERT(CBSFindDelete, findDelete); + + cbsFlushEmergencyLists(cbs); /* might do some good */ + + { + SplayNode node; + + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + found = SplayFindLast(&node, splayTreeOfCBS(cbs), &cbsTestNode, + &cbsTestTree, NULL, (unsigned long)size); + if (found) { + CBSBlock block; + + block = cbsBlockOfSplayNode(node); + AVER(CBSBlockSize(block) >= size); + base = CBSBlockBase(block); + limit = CBSBlockLimit(block); + deleteMethod = &cbsDeleteFromTree; + } + } + + if (cbs->emergencyBlockList != NULL) { + CBSEmergencyBlock block; + + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(block = cbs->emergencyBlockList; + block != NULL; + block = CBSEmergencyBlockNext(block)) { + if (CBSEmergencyBlockSize(block) >= size && + (!found || CBSEmergencyBlockBase(block) > base)) { + found = TRUE; + base = CBSEmergencyBlockBase(block); + limit = CBSEmergencyBlockLimit(block); + deleteMethod = &cbsDeleteFromEmergencyBlockList; + /* @@@@ Could remove in place more efficiently. */ + } + } + } + + if (cbs->emergencyGrainList != NULL && + size <= CBSEmergencyGrainSize(cbs)) { + CBSEmergencyGrain grain; + + /* Find last grain */ + METER_ACC(cbs->eglSearch, cbs->eglSize); + for(grain = cbs->emergencyGrainList; + CBSEmergencyGrainNext(grain) != NULL; + grain = CBSEmergencyGrainNext(grain)) + NOOP; + + if (!found || CBSEmergencyGrainBase(grain) > base) { + found = TRUE; + base = CBSEmergencyGrainBase(grain); + limit = CBSEmergencyGrainLimit(cbs, grain); + deleteMethod = &cbsDeleteFromEmergencyGrainList; + /* @@@@ Could remove in place more efficiently */ + } + } + + if (found) { + AVER(AddrOffset(base, limit) >= size); + cbsFindDeleteRange(baseReturn, limitReturn, cbs, base, limit, size, + deleteMethod, findDelete); + } + + CBSLeave(cbs); + return found; +} + + +/* CBSFindLargest -- find the largest block in the CBS */ + +Bool CBSFindLargest(Addr *baseReturn, Addr *limitReturn, + CBS cbs, CBSFindDelete findDelete) +{ + Bool found = FALSE; + Addr base = (Addr)0, limit = (Addr)0; /* only defined when found is TRUE */ + cbsDeleteMethod deleteMethod = NULL; + Size size = 0; /* suppress bogus warning from MSVC */ + + AVERT(CBS, cbs); + CBSEnter(cbs); + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVER(sizeof(unsigned long) >= sizeof(Size)); + AVER(cbs->fastFind); + AVERT(CBSFindDelete, findDelete); + + cbsFlushEmergencyLists(cbs); /* might do some good */ + + { + SplayNode root; + Bool notEmpty; + + notEmpty = SplayRoot(&root, splayTreeOfCBS(cbs)); + if (notEmpty) { + CBSBlock block; + SplayNode node; + + size = cbsBlockOfSplayNode(root)->maxSize; + METER_ACC(cbs->splaySearch, cbs->splayTreeSize); + found = SplayFindFirst(&node, splayTreeOfCBS(cbs), &cbsTestNode, + &cbsTestTree, NULL, (unsigned long)size); + AVER(found); /* maxSize is exact, so we will find it. */ + block = cbsBlockOfSplayNode(node); + AVER(CBSBlockSize(block) >= size); + base = CBSBlockBase(block); + limit = CBSBlockLimit(block); + deleteMethod = &cbsDeleteFromTree; + } + } + + if (cbs->emergencyBlockList != NULL) { + CBSEmergencyBlock block; + + /* Scan the whole list -- could maintain a maxSize to avoid it. */ + METER_ACC(cbs->eblSearch, cbs->eblSize); + for(block = cbs->emergencyBlockList; + block != NULL; + block = CBSEmergencyBlockNext(block)) { + if (CBSEmergencyBlockSize(block) >= size) { + /* .pref: >= so that it prefers the emerg. list to the tree */ + found = TRUE; + size = CBSEmergencyBlockSize(block); + base = CBSEmergencyBlockBase(block); + limit = CBSEmergencyBlockLimit(block); + deleteMethod = &cbsDeleteFromEmergencyBlockList; + /* @@@@ Could remove in place more efficiently. */ + } + } + } + + /* If something was found, it will be larger than an emerg. grain. */ + if (!found && cbs->emergencyGrainList != NULL) { + /* Take first grain */ + CBSEmergencyGrain grain = cbs->emergencyGrainList; + + found = TRUE; + size = CBSEmergencyGrainSize(cbs); + base = CBSEmergencyGrainBase(grain); + limit = CBSEmergencyGrainLimit(cbs, grain); + deleteMethod = &cbsDeleteFromEmergencyGrainList; + } + + if (found) { + cbsFindDeleteRange(baseReturn, limitReturn, cbs, base, limit, size, + deleteMethod, findDelete); + } + + CBSLeave(cbs); + return found; +} + + +/* CBSDescribe -- describe a CBS + * + * See design.mps.cbs.function.cbs.describe. + */ + +Res CBSDescribe(CBS cbs, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(CBS, cbs)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "CBS $P {\n", (WriteFP)cbs, + " blockPool: $P\n", (WriteFP)cbs->blockPool, + " new: $F ", (WriteFF)cbs->new, + " delete: $F \n", (WriteFF)cbs->delete, + NULL); + if (res != ResOK) return res; + + res = SplayTreeDescribe(splayTreeOfCBS(cbs), stream, &CBSSplayNodeDescribe); + if (res != ResOK) return res; + + res = METER_WRITE(cbs->splaySearch, stream); + if (res != ResOK) return res; + res = METER_WRITE(cbs->eblSearch, stream); + if (res != ResOK) return res; + res = METER_WRITE(cbs->eglSearch, stream); + if (res != ResOK) return res; + + res = WriteF(stream, "}\n", NULL); + return res; +} diff --git a/mps/code/cbs.h b/mps/code/cbs.h new file mode 100644 index 00000000000..951bad89287 --- /dev/null +++ b/mps/code/cbs.h @@ -0,0 +1,114 @@ +/* impl.h.cbs: CBS -- Coalescing Block Structure + * + * $HopeName: MMsrc!cbs.h(trunk.3) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .source: design.mps.cbs. + */ + +#ifndef cbs_h +#define cbs_h + +#include "meter.h" +#include "splay.h" +#include "mpmtypes.h" + + +typedef struct CBSStruct *CBS; +typedef struct CBSBlockStruct *CBSBlock; +typedef void (*CBSChangeSizeMethod)(CBS cbs, CBSBlock block, + Size oldSize, Size newSize); +typedef Bool (*CBSIterateMethod)(CBS cbs, CBSBlock block, void *closureP); + + +/* See design.mps.cbs.impl.low-mem.inline.block */ +typedef void **CBSEmergencyBlock; /* next, limit */ + +/* See design.mps.cbs.impl.low-mem.inline.block */ +typedef void **CBSEmergencyGrain; /* next */ + + +#define CBSSig ((Sig)0x519CB599) /* SIGnature CBS */ + +typedef struct CBSStruct { + SplayTreeStruct splayTree; + Count splayTreeSize; + Pool blockPool; + CBSChangeSizeMethod new; + CBSChangeSizeMethod delete; + CBSChangeSizeMethod grow; + CBSChangeSizeMethod shrink; + Size minSize; + Align alignment; + Bool mayUseInline; + Bool fastFind; + Bool inCBS; /* prevent reentrance */ + CBSEmergencyBlock emergencyBlockList; + Count eblSize; + CBSEmergencyGrain emergencyGrainList; + Count eglSize; + /* meters for sizes of search structures at each op */ + METER_DECL(splaySearch); + METER_DECL(eblSearch); + METER_DECL(eglSearch); + Sig sig; /* sig at end because embeded */ +} CBSStruct; + +typedef struct CBSBlockStruct { + SplayNodeStruct splayNode; + Addr base; + Addr limit; + Size maxSize; /* accurate maximum block size of sub-tree */ +} CBSBlockStruct; + + +extern Bool CBSCheck(CBS cbs); +extern Bool CBSBlockCheck(CBSBlock block); + +extern Res CBSInit(Arena arena, CBS cbs, void *owner, + CBSChangeSizeMethod new, + CBSChangeSizeMethod delete, + CBSChangeSizeMethod grow, + CBSChangeSizeMethod shrink, + Size minSize, + Align alignment, + Bool mayUseInline, + Bool fastFind); +extern void CBSFinish(CBS cbs); + +extern Res CBSInsert(CBS cbs, Addr base, Addr limit); +extern Res CBSInsertReturningRange(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Addr base, Addr limit); +extern Res CBSDelete(CBS cbs, Addr base, Addr limit); +extern void CBSIterate(CBS cbs, CBSIterateMethod iterate, void *closureP); +extern void CBSIterateLarge(CBS cbs, CBSIterateMethod iterate, void *closureP); +extern void CBSSetMinSize(CBS cbs, Size minSize); + +extern Res CBSDescribe(CBS cbs, mps_lib_FILE *stream); +extern Res CBSBlockDescribe(CBSBlock block, mps_lib_FILE *stream); + +/* CBSBlockBase -- See design.mps.cbs.function.cbs.block.base */ +#define CBSBlockBase(block) ((block)->base) +/* CBSBlockLimit -- See design.mps.cbs.function.cbs.block.limit */ +#define CBSBlockLimit(block) ((block)->limit) +#define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit) +extern Size (CBSBlockSize)(CBSBlock block); + +typedef unsigned CBSFindDelete; +enum { + CBSFindDeleteNONE = 1,/* don't delete after finding */ + CBSFindDeleteLOW, /* delete precise size from low end */ + CBSFindDeleteHIGH, /* delete precise size from high end */ + CBSFindDeleteENTIRE /* delete entire range */ +}; + +extern Bool CBSFindFirst(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Size size, CBSFindDelete findDelete); +extern Bool CBSFindLast(Addr *baseReturn, Addr *limitReturn, + CBS cbs, Size size, CBSFindDelete findDelete); + +extern Bool CBSFindLargest(Addr *baseReturn, Addr *limitReturn, + CBS cbs, CBSFindDelete findDelete); + + +#endif /* cbs_h */ diff --git a/mps/code/cbstest.c b/mps/code/cbstest.c new file mode 100644 index 00000000000..20ca4a0f08c --- /dev/null +++ b/mps/code/cbstest.c @@ -0,0 +1,657 @@ +/* impl.c.cbstest: COALESCING BLOCK STRUCTURE TEST + * + * $HopeName: MMsrc!cbstest.c(trunk.10) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + */ + +#include "cbs.h" +#include "mpm.h" +#include "mpsavm.h" +#include "mps.h" +#include "testlib.h" + +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + +SRCID(cbstest, "$HopeName: MMsrc!cbstest.c(trunk.10) $"); + + +#define ArraySize ((Size)123456) +#define NOperations ((Size)125000) +#define MinSize ((Size)120) /* Arbitrary size */ +#define Alignment ((Align)sizeof(void *)) + + +static Count NAllocateTried, NAllocateSucceeded, NDeallocateTried, + NDeallocateSucceeded, NNewBlocks, NDeleteBlocks, NGrowBlocks, + NShrinkBlocks; + + +/* Used to predict which callbacks will be called, and with which values. */ +/* At most one callback of each type will be called. */ +typedef struct CallbackPredictionStruct { + Bool shouldBeCalled; + Size oldSize; + Addr base; + Addr limit; +} CallbackPredictionStruct, *CallbackPrediction; + +static CallbackPredictionStruct CallbackNew; +static CallbackPredictionStruct CallbackDelete; +static CallbackPredictionStruct CallbackGrow; +static CallbackPredictionStruct CallbackShrink; + + +typedef struct CheckCBSClosureStruct { + BT allocTable; + Addr base; + Addr limit; + Addr oldLimit; +} CheckCBSClosureStruct, *CheckCBSClosure; + + +static Addr (addrOfIndex)(Addr block, Index i) +{ + return AddrAdd(block, (i * Alignment)); +} + + +static Index (indexOfAddr)(Addr block, Addr a) +{ + return (Index)(AddrOffset(block, a) / Alignment); +} + + +/* This function encapsulates the common tests for the callbacks. */ + +static void testCallback(CBS cbs, CBSBlock cbsBlock, + Size oldSize, Size newSize, + CallbackPrediction prediction) +{ + Insist(CBSCheck(cbs)); + Insist(CBSBlockCheck(cbsBlock)); + Insist(prediction->shouldBeCalled); + Insist(oldSize == prediction->oldSize); + + if (newSize == 0) { + Insist(prediction->base == 0); + Insist(prediction->limit == 0); + } else { + Insist(CBSBlockSize(cbsBlock) == newSize); + Insist(newSize == AddrOffset(prediction->base, prediction->limit)); + Insist(CBSBlockBase(cbsBlock) == prediction->base); + Insist(CBSBlockLimit(cbsBlock) == prediction->limit); + } + + prediction->shouldBeCalled = FALSE; +} + + +static void cbsNewCallback(CBS cbs, CBSBlock cbsBlock, + Size oldSize, Size newSize) +{ + testCallback(cbs, cbsBlock, oldSize, newSize, &CallbackNew); + Insist(oldSize < cbs->minSize); + Insist(newSize >= cbs->minSize); + + NNewBlocks++; +} + + +static void cbsDeleteCallback(CBS cbs, CBSBlock cbsBlock, + Size oldSize, Size newSize) +{ + testCallback(cbs, cbsBlock, oldSize, newSize, &CallbackDelete); + Insist(oldSize >= cbs->minSize); + Insist(newSize < cbs->minSize); + + NDeleteBlocks++; +} + + +static void cbsGrowCallback(CBS cbs, CBSBlock cbsBlock, + Size oldSize, Size newSize) +{ + testCallback(cbs, cbsBlock, oldSize, newSize, &CallbackGrow); + Insist(oldSize >= cbs->minSize); + Insist(newSize >= cbs->minSize); + Insist(oldSize < newSize); + + NGrowBlocks++; +} + + +static void cbsShrinkCallback(CBS cbs, CBSBlock cbsBlock, + Size oldSize, Size newSize) +{ + testCallback(cbs, cbsBlock, oldSize, newSize, &CallbackShrink); + Insist(oldSize >= cbs->minSize); + Insist(newSize >= cbs->minSize); + Insist(oldSize > newSize); + + NShrinkBlocks++; +} + + +static Bool checkCBSAction(CBS cbs, CBSBlock cbsBlock, void *p) +{ + Addr base, limit; + CheckCBSClosure closure = (CheckCBSClosure)p; + + /* Don't need to check cbs every time */ + UNUSED(cbs); + Insist(closure != NULL); + + base = CBSBlockBase(cbsBlock); + limit = CBSBlockLimit(cbsBlock); + + if (base > closure->oldLimit) { + Insist(BTIsSetRange(closure->allocTable, + indexOfAddr(closure->base, closure->oldLimit), + indexOfAddr(closure->base, base))); + } else { /* must be at start of table */ + Insist(base == closure->oldLimit); + Insist(closure->oldLimit == closure->base); + } + + Insist(BTIsResRange(closure->allocTable, + indexOfAddr(closure->base, base), + indexOfAddr(closure->base, limit))); + + + closure->oldLimit = limit; + + return TRUE; +} + + +static void checkCBS(CBS cbs, BT allocTable, Addr dummyBlock) +{ + CheckCBSClosureStruct closure; + + closure.allocTable = allocTable; + closure.base = dummyBlock; + closure.limit = addrOfIndex(closure.base, ArraySize); + closure.oldLimit = closure.base; + + CBSIterate(cbs, checkCBSAction, (void *)&closure); + + if (closure.oldLimit == closure.base) + Insist(BTIsSetRange(allocTable, 0, + indexOfAddr(dummyBlock, closure.limit))); + else if (closure.limit > closure.oldLimit) + Insist(BTIsSetRange(allocTable, + indexOfAddr(dummyBlock, closure.oldLimit), + indexOfAddr(dummyBlock, closure.limit))); + else + Insist(closure.oldLimit == closure.limit); +} + + +static Word cbsRnd(Word limit) +{ + /* Not very uniform, but never mind. */ + return (Word)rnd() % limit; +} + + +/* nextEdge -- Finds the next transition in the bit table + * + * Returns the index greater than such that the + * range [, ) has the same value in the bit table, + * and has a different value or does not exist. + */ + +static Index nextEdge(BT bt, Size size, Index base) +{ + Index end; + Bool baseValue; + + Insist(bt != NULL); + Insist(base < size); + + baseValue = BTGet(bt, base); + + for(end = base + 1; end < size && BTGet(bt, end) == baseValue; end++) + NOOP; + + return end; +} + + +/* lastEdge -- Finds the previous transition in the bit table + * + * Returns the index less than such that the range + * [, ] has the same value in the bit table, + * and -1 has a different value or does not exist. + */ + +static Index lastEdge(BT bt, Size size, Index base) +{ + Index end; + Bool baseValue; + + Insist(bt != NULL); + Insist(base < size); + + baseValue = BTGet(bt, base); + + for(end = base; end > (Index)0 && BTGet(bt, end - 1) == baseValue; end--) + NOOP; + + return end; +} + + +/* randomRange -- picks random range within table + * + * The function first picks a uniformly distributed within the table. + * + * It then scans forward a binary exponentially distributed + * number of "edges" in the table (that is, transitions between set and + * reset) to get . Note that there is a 50% chance that will + * be the next edge, a 25% chance it will be the edge after, etc., until + * the end of the table. + * + * Finally it picks a uniformly distributed in the range + * [base+1, limit]. + * + * Hence there is a somewhat better than 50% chance that the range will be + * all either set or reset. + */ + +static void randomRange(Addr *baseReturn, Addr *limitReturn, + BT allocTable, Addr block) +{ + Index base; /* the start of our range */ + Index end; /* an edge (i.e. different from its predecessor) */ + /* after base */ + Index limit; /* a randomly chosen value in (base, limit]. */ + + base = cbsRnd(ArraySize); + + do { + end = nextEdge(allocTable, ArraySize, base); + } while(end < ArraySize && cbsRnd(2) == 0); /* p=0.5 exponential */ + + Insist(end > base); + + limit = base + 1 + cbsRnd(end - base); + + *baseReturn = addrOfIndex(block, base); + *limitReturn = addrOfIndex(block, limit); +} + + +/* Set callback expectations */ + +static void clearExpectations(void) +{ + CallbackNew.shouldBeCalled = FALSE; + CallbackDelete.shouldBeCalled = FALSE; + CallbackGrow.shouldBeCalled = FALSE; + CallbackShrink.shouldBeCalled = FALSE; +} + +static void expectCallback(CallbackPrediction prediction, + Size oldSize, Addr base, Addr limit) +{ + Insist(prediction->shouldBeCalled == FALSE); + Insist(base == (Addr)0 || limit > base); + Insist(oldSize != (Size)0 || base != (Addr)0); + Insist(base != (Addr)0 || limit == (Addr)0); + + prediction->shouldBeCalled = TRUE; + prediction->oldSize = oldSize; + prediction->base = base; + prediction->limit = limit; +} + + +static void checkExpectations(void) +{ + Insist(!CallbackNew.shouldBeCalled); + Insist(!CallbackDelete.shouldBeCalled); + Insist(!CallbackGrow.shouldBeCalled); + Insist(!CallbackShrink.shouldBeCalled); +} + + +static void allocate(CBS cbs, Addr block, BT allocTable, + Addr base, Addr limit) +{ + Res res; + Index ib, il; /* Indexed for base and limit */ + Bool isFree; + + ib = indexOfAddr(block, base); + il = indexOfAddr(block, limit); + + isFree = BTIsResRange(allocTable, ib, il); + + /* + printf("allocate: [%p, %p) -- %s\n", + base, limit, isFree ? "succeed" : "fail"); + */ + + NAllocateTried++; + + if (isFree) { + Addr outerBase, outerLimit; /* interval containing [ib, il) */ + Size left, right, total; /* Sizes of block and two fragments */ + + outerBase = + addrOfIndex(block, lastEdge(allocTable, ArraySize, ib)); + outerLimit = + addrOfIndex(block, nextEdge(allocTable, ArraySize, il - 1)); + + left = AddrOffset(outerBase, base); + right = AddrOffset(limit, outerLimit); + total = AddrOffset(outerBase, outerLimit); + + /* based on detailed knowledge of CBS behaviour */ + checkExpectations(); + if (total >= MinSize && left < MinSize && right < MinSize) { + if (left == (Size)0 && right == (Size)0) { + expectCallback(&CallbackDelete, total, (Addr)0, (Addr)0); + } else if (left >= right) { + expectCallback(&CallbackDelete, total, outerBase, base); + } else { + expectCallback(&CallbackDelete, total, limit, outerLimit); + } + } else if (left >= MinSize && right >= MinSize) { + if (left >= right) { + expectCallback(&CallbackShrink, total, outerBase, base); + expectCallback(&CallbackNew, (Size)0, limit, outerLimit); + } else { + expectCallback(&CallbackNew, (Size)0, outerBase, base); + expectCallback(&CallbackShrink, total, limit, outerLimit); + } + } else if (total >= MinSize) { + if (left >= right) { + Insist(left >= MinSize); + Insist(right < MinSize); + expectCallback(&CallbackShrink, total, outerBase, base); + } else { + Insist(left < MinSize); + Insist(right >= MinSize); + expectCallback(&CallbackShrink, total, limit, outerLimit); + } + } + } + + res = CBSDelete(cbs, base, limit); + + if (!isFree) { + die_expect((mps_res_t)res, MPS_RES_FAIL, + "Succeeded in deleting allocated block"); + } else { /* isFree */ + die_expect((mps_res_t)res, MPS_RES_OK, + "failed to delete free block"); + NAllocateSucceeded++; + BTSetRange(allocTable, ib, il); + checkExpectations(); + } +} + + +static void deallocate(CBS cbs, Addr block, BT allocTable, + Addr base, Addr limit) +{ + Res res; + Index ib, il; + Bool isAllocated; + Addr outerBase = base, outerLimit = limit; /* interval containing [ib, il) */ + Addr freeBase, freeLimit; /* interval returned by CBS */ + + ib = indexOfAddr(block, base); + il = indexOfAddr(block, limit); + + isAllocated = BTIsSetRange(allocTable, ib, il); + + /* + printf("deallocate: [%p, %p) -- %s\n", + base, limit, isAllocated ? "succeed" : "fail"); + */ + + NDeallocateTried++; + + if (isAllocated) { + Size left, right, total; /* Sizes of block and two fragments */ + + /* Find the free blocks adjacent to the allocated block */ + if (ib > 0 && !BTGet(allocTable, ib - 1)) { + outerBase = + addrOfIndex(block, lastEdge(allocTable, ArraySize, ib - 1)); + } else { + outerBase = base; + } + + if (il < ArraySize && !BTGet(allocTable, il)) { + outerLimit = + addrOfIndex(block, nextEdge(allocTable, ArraySize, il)); + } else { + outerLimit = limit; + } + + left = AddrOffset(outerBase, base); + right = AddrOffset(limit, outerLimit); + total = AddrOffset(outerBase, outerLimit); + + /* based on detailed knowledge of CBS behaviour */ + checkExpectations(); + if (total >= MinSize && left < MinSize && right < MinSize) { + if (left >= right) + expectCallback(&CallbackNew, left, outerBase, outerLimit); + else + expectCallback(&CallbackNew, right, outerBase, outerLimit); + } else if (left >= MinSize && right >= MinSize) { + if (left >= right) { + expectCallback(&CallbackDelete, right, (Addr)0, (Addr)0); + expectCallback(&CallbackGrow, left, outerBase, outerLimit); + } else { + expectCallback(&CallbackDelete, left, (Addr)0, (Addr)0); + expectCallback(&CallbackGrow, right, outerBase, outerLimit); + } + } else if (total >= MinSize) { + if (left >= right) { + Insist(left >= MinSize); + Insist(right < MinSize); + expectCallback(&CallbackGrow, left, outerBase, outerLimit); + } else { + Insist(left < MinSize); + Insist(right >= MinSize); + expectCallback(&CallbackGrow, right, outerBase, outerLimit); + } + } + } + + res = CBSInsertReturningRange(&freeBase, &freeLimit, cbs, base, limit); + + if (!isAllocated) { + die_expect((mps_res_t)res, MPS_RES_FAIL, + "succeeded in inserting non-allocated block"); + } else { /* isAllocated */ + die_expect((mps_res_t)res, MPS_RES_OK, + "failed to insert allocated block"); + + NDeallocateSucceeded++; + BTResRange(allocTable, ib, il); + checkExpectations(); + Insist(freeBase == outerBase); + Insist(freeLimit == outerLimit); + } +} + + +static void find(CBS cbs, void *block, BT alloc, Size size, Bool high, + CBSFindDelete findDelete) +{ + Bool expected, found; + Index expectedBase, expectedLimit; + Addr foundBase, foundLimit, remainderBase, remainderLimit; + Size oldSize, newSize; + + checkExpectations(); + + expected = (high ? BTFindLongResRangeHigh : BTFindLongResRange) + (&expectedBase, &expectedLimit, alloc, + (Index)0, (Index)ArraySize, (unsigned long)size); + + if (expected) { + oldSize = (expectedLimit - expectedBase) * Alignment; + remainderBase = addrOfIndex(block, expectedBase); + remainderLimit = addrOfIndex(block, expectedLimit); + + switch(findDelete) { + case CBSFindDeleteNONE: { + /* do nothing */ + } break; + case CBSFindDeleteENTIRE: { + remainderBase = remainderLimit; + } break; + case CBSFindDeleteLOW: { + expectedLimit = expectedBase + size; + remainderBase = addrOfIndex(block, expectedLimit); + } break; + case CBSFindDeleteHIGH: { + expectedBase = expectedLimit - size; + remainderLimit = addrOfIndex(block, expectedBase); + } break; + } + + if (findDelete != CBSFindDeleteNONE) { + newSize = AddrOffset(remainderBase, remainderLimit); + + if (oldSize >= MinSize) { + if (newSize == 0) + expectCallback(&CallbackDelete, oldSize, (Addr)0, (Addr)0); + else if (newSize < MinSize) + expectCallback(&CallbackDelete, oldSize, + remainderBase, remainderLimit); + else + expectCallback(&CallbackShrink, oldSize, + remainderBase, remainderLimit); + } + } + } + + found = (high ? CBSFindLast : CBSFindFirst) + (&foundBase, &foundLimit, cbs, size * Alignment, findDelete); + + Insist(found == expected); + + if (found) { + Insist(expectedBase == indexOfAddr(block, foundBase)); + Insist(expectedLimit == indexOfAddr(block, foundLimit)); + checkExpectations(); + + if (findDelete != CBSFindDeleteNONE) + BTSetRange(alloc, expectedBase, expectedLimit); + } + + return; +} + + +#define testArenaSIZE (((size_t)4)<<20) + +extern int main(int argc, char *argv[]) +{ + int i; + Addr base, limit; + mps_arena_t mpsArena; + Arena arena; /* the ANSI arena which we use to allocate the BT */ + CBSStruct cbsStruct; + CBS cbs; + void *p; + Addr dummyBlock; + BT allocTable; + Size size; + Bool high; + CBSFindDelete findDelete = CBSFindDeleteNONE; + + randomize(argc, argv); + + NAllocateTried = NAllocateSucceeded = NDeallocateTried = + NDeallocateSucceeded = NNewBlocks = NDeleteBlocks = + NGrowBlocks = NShrinkBlocks = 0; + + clearExpectations(); + + die(mps_arena_create(&mpsArena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + arena = (Arena)mpsArena; /* avoid pun */ + + die((mps_res_t)BTCreate(&allocTable, arena, ArraySize), + "failed to create alloc table"); + + die((mps_res_t)CBSInit(arena, &cbsStruct, NULL, &cbsNewCallback, + &cbsDeleteCallback, &cbsGrowCallback, + &cbsShrinkCallback, MinSize, + Alignment, TRUE, TRUE), + "failed to initialise CBS"); + cbs = &cbsStruct; + + BTSetRange(allocTable, 0, ArraySize); /* Initially all allocated */ + + /* We're not going to use this block, but I feel unhappy just */ + /* inventing addresses. */ + die((mps_res_t)ControlAlloc(&p, arena, ArraySize * Alignment, + /* withReservoirPermit */ FALSE), + "failed to allocate block"); + dummyBlock = (Addr)p; /* avoid pun */ + + printf("Allocated block [%p, %p)\n", dummyBlock, + (char *)dummyBlock + ArraySize); + + checkCBS(cbs, allocTable, dummyBlock); + for(i = 0; i < NOperations; i++) { + switch(cbsRnd(3)) { + case 0: { + randomRange(&base, &limit, allocTable, dummyBlock); + allocate(cbs, dummyBlock, allocTable, base, limit); + } break; + case 1: { + randomRange(&base, &limit, allocTable, dummyBlock); + deallocate(cbs, dummyBlock, allocTable, base, limit); + } break; + case 2: { + size = cbsRnd(ArraySize / 10) + 1; + high = cbsRnd(2) ? TRUE : FALSE; + switch(cbsRnd(6)) { + case 0: + case 1: + case 2: findDelete = CBSFindDeleteNONE; break; + case 3: findDelete = CBSFindDeleteLOW; break; + case 4: findDelete = CBSFindDeleteHIGH; break; + case 5: findDelete = CBSFindDeleteENTIRE; break; + } + find(cbs, dummyBlock, allocTable, size, high, findDelete); + } break; + } + if (i % 5000 == 0) + checkCBS(cbs, allocTable, dummyBlock); + } + + checkExpectations(); + + /* CBSDescribe prints a very long line. */ + /* CBSDescribe(cbs, mps_lib_get_stdout()); */ + + printf("\nNumber of allocations attempted: %ld\n", NAllocateTried); + printf("Number of allocations succeeded: %ld\n", NAllocateSucceeded); + printf("Number of deallocations attempted: %ld\n", NDeallocateTried); + printf("Number of deallocations succeeded: %ld\n", NDeallocateSucceeded); + printf("Number of new large blocks: %ld\n", NNewBlocks); + printf("Number of deleted large blocks: %ld\n", NDeleteBlocks); + printf("Number of grown large blocks: %ld\n", NGrowBlocks); + printf("Number of shrunk large blocks: %ld\n", NShrinkBlocks); + printf("\nNo problems detected.\n"); + return 0; +} diff --git a/mps/code/chain.h b/mps/code/chain.h new file mode 100644 index 00000000000..ed1d2077b1a --- /dev/null +++ b/mps/code/chain.h @@ -0,0 +1,91 @@ +/* impl.h.chain: GENERATION CHAINS + * + * $HopeName: MMsrc!chain.h(trunk.1) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + */ + +#ifndef chain_h +#define chain_h + +#include "mpmtypes.h" +#include "ring.h" + + +/* GenParamStruct -- structure for specifying generation parameters */ +/* .gen-param: This structure must match impl.h.mps.gen-param. */ + +typedef struct GenParamStruct { + Size capacity; /* capacity in kB */ + double mortality; +} GenParamStruct; + + +/* GenDesc -- descriptor of a generation in a chain */ + +typedef struct GenDescStruct *GenDesc; + +#define GenDescSig ((Sig)0x5199E4DE) /* SIGnature GEN DEsc */ + +typedef struct GenDescStruct { + Sig sig; + ZoneSet zones; /* zoneset for this generation */ + Size capacity; /* capacity in kB */ + double mortality; + double proflow; /* predicted proportion of survivors promoted */ + RingStruct locusRing; /* this generation in all the pools using the chain */ +} GenDescStruct; + + +/* PoolGen -- descriptor of a generation in a pool */ + +typedef struct PoolGenStruct *PoolGen; + +#define PoolGenSig ((Sig)0x519B009E) /* SIGnature POOl GEn */ + +typedef struct PoolGenStruct { + Sig sig; + Serial nr; /* generation number */ + Pool pool; /* pool this belongs to */ + Chain chain; /* chain this belongs to */ + RingStruct genRing; /* this generation in all the pools using this chain */ + Size totalSize; /* total size of segs in gen in this pool */ + Size newSize; /* size allocated since last GC */ +} PoolGenStruct; + + +/* Chain -- a generation chain */ + +#define ChainSig ((Sig)0x519C8A14) /* SIGnature CHAIN */ + +typedef struct ChainStruct { + Sig sig; + Arena arena; + RingStruct chainRing; /* list of chains in the arena */ + TraceSet activeTraces; /* set of traces collecting this chain */ + size_t genCount; /* number of generations */ + GenDescStruct *gens; /* the array of generations */ +} ChainStruct; + + +extern Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount, + GenParamStruct *params); +extern void ChainDestroy(Chain chain); +extern Bool ChainCheck(Chain chain); + +extern double ChainDeferral(Chain chain); +extern Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace); +extern Res ChainCondemnAll(Chain chain, Trace trace); +extern void ChainStartGC(Chain chain, Trace trace); +extern void ChainEndGC(Chain chain, Trace trace); +extern size_t ChainGens(Chain chain); + + +extern Bool PoolGenCheck(PoolGen gen); +extern Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool); +extern void PoolGenFinish(PoolGen gen); +extern void PoolGenFlip(PoolGen gen); +#define PoolGenNr(gen) ((gen)->nr) +extern void PoolGenUpdateZones(PoolGen gen, Seg seg); + + +#endif /* chain_h */ diff --git a/mps/code/check.h b/mps/code/check.h new file mode 100644 index 00000000000..0b789816a36 --- /dev/null +++ b/mps/code/check.h @@ -0,0 +1,279 @@ +/* impl.h.check: ASSERTION INTERFACE + * + * $HopeName: MMsrc!check.h(trunk.17) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .aver: This header defines a family of AVER and NOTREACHED macros. + * These macros should be used to instrument and annotate code with + * invariants, and so provide both interface and internal consistency + * checks. + * + * .comment: Non-obvious AVER statements should always be accompanied by + * a comment. + * + * .disable: When assertions are disabled, AVER expands to something + * which evaluates the condition but discards the result. Compilers + * will throw the code away, but check its syntax. + * + * .trans.level-check: CheckLevel itself is not checked anywhere. + */ + +#ifndef check_h +#define check_h + +#include "config.h" +#include "misc.h" +#include "mpslib.h" + + +/* CheckLevel -- Control check method behaviour; see impl.c.assert */ + +extern unsigned CheckLevel; + +enum { + CheckNONE = 0, + CheckSHALLOW = 1, + CheckDEEP = 2 +}; + + +/* AVER, AVERT -- MPM assertions + * + * AVER and AVERT are used to assert conditions within the MPM. + * In white-hot varieties, all assertions compile away to nothing. + */ + +#if defined(MPS_HOT_WHITE) + +#define AVER(cond) DISCARD(cond) +#define AVERT(type, val) DISCARD(type ## Check(val)) +#define AVER_CRITICAL(cond) DISCARD(cond) +#define AVERT_CRITICAL(type, val) DISCARD(type ## Check(val)) + +#elif defined(MPS_HOT_RED) + +#define AVER(cond) ASSERT(cond, #cond) +#define AVERT(type, val) ASSERT(type ## Check(val), \ + "TypeCheck " #type ": " #val) +#define AVER_CRITICAL(cond) DISCARD(cond) +#define AVERT_CRITICAL(type, val) DISCARD(type ## Check(val)) + +#elif defined(MPS_COOL) + +#define AVER(cond) ASSERT(cond, #cond) +#define AVERT(type, val) ASSERT(type ## Check(val), \ + "TypeCheck " #type ": " #val) +#define AVER_CRITICAL(cond) ASSERT(cond, #cond) +#define AVERT_CRITICAL(type, val) ASSERT(type ## Check(val), \ + "TypeCheck " #type ": " #val) + +#else + +#error "No heat defined." + +#endif + + +/* AssertHandler -- the assert handler */ + +typedef void (*AssertHandler)(const char *cond, const char *id, + const char *file, unsigned line); +extern AssertHandler AssertInstall(AssertHandler handler); +extern AssertHandler AssertDefault(void); + + +/* internals for actually asserting */ + +extern void AssertFail1(const char *s); + +#define ASSERT(cond, condstring) \ + BEGIN \ + if(cond) NOOP; else \ + AssertFail1(condstring "\n" __FILE__ "\n" STR(__LINE__)); \ + END + + +/* NOTREACHED -- control should never reach this statement */ + +#if defined(MPS_HOT_WHITE) + +#define NOTREACHED NOOP + +#else + +#define NOTREACHED \ + BEGIN \ + AssertFail1("unreachable statement" "\n" __FILE__ "\n" STR(__LINE__)); \ + END + +#endif + + +/* CHECKT -- check type simply + * + * Must be thread safe. See design.mps.interface.c.thread-safety + * and design.mps.interface.c.check.space. + */ + +#define CHECKT(type, val) ((val) != NULL && (val)->sig == type ## Sig) + + +#if defined(MPS_HOT_WHITE) + + +#define CHECKS(type, val) DISCARD(CHECKT(type, val)) +#define CHECKL(cond) DISCARD(cond) +#define CHECKD(type, val) DISCARD(CHECKT(type, val)) +#define CHECKD_NOSIG(type, val) DISCARD((val) != NULL) +#define CHECKU(type, val) DISCARD(CHECKT(type, val)) +#define CHECKU_NOSIG(type, val) DISCARD((val) != NULL) + + +#elif defined(MPS_HOT_RED) + + +#define CHECKS(type, val) ASSERT(CHECKT(type, val), \ + "SigCheck " #type ": " #val) + +#define CHECKL(cond) DISCARD(cond) +#define CHECKD(type, val) DISCARD(CHECKT(type, val)) +#define CHECKD_NOSIG(type, val) DISCARD((val) != NULL) +#define CHECKU(type, val) DISCARD(CHECKT(type, val)) +#define CHECKU_NOSIG(type, val) DISCARD((val) != NULL) + + +#elif defined(MPS_COOL) + + +/* CHECKS -- Check Signature */ + +#define CHECKS(type, val) ASSERT(CHECKT(type, val), \ + "SigCheck " #type ": " #val) + +/* CHECKL -- Check Local Invariant + * + * Could make this an expression using ?: + */ + +#define CHECKL(cond) \ + BEGIN \ + switch(CheckLevel) { \ + case CheckNONE: \ + NOOP; \ + break; \ + case CheckSHALLOW: \ + case CheckDEEP: \ + ASSERT(cond, #cond); \ + break; \ + } \ + END + + +/* CHECKD -- Check Down */ + +#define CHECKD(type, val) \ + BEGIN \ + switch(CheckLevel) { \ + case CheckNONE: \ + NOOP; \ + break; \ + case CheckSHALLOW: \ + ASSERT(CHECKT(type, val), \ + "SigCheck " #type ": " #val); \ + break; \ + case CheckDEEP: \ + ASSERT(type ## Check(val), \ + "TypeCheck " #type ": " #val); \ + break; \ + } \ + END + + +/* CHECKD_NOSIG -- Check Down for a type with no signature */ + +#define CHECKD_NOSIG(type, val) \ + BEGIN \ + switch(CheckLevel) { \ + case CheckNONE: \ + NOOP; \ + break; \ + case CheckSHALLOW: \ + ASSERT((val) != NULL, \ + "NullCheck " #type ": " #val); \ + break; \ + case CheckDEEP: \ + ASSERT(type ## Check(val), \ + "TypeCheck " #type ": " #val); \ + break; \ + } \ + END + + +/* CHECKU -- Check Up */ + +#define CHECKU(type, val) \ + BEGIN \ + switch(CheckLevel) { \ + case CheckNONE: \ + NOOP; \ + break; \ + case CheckSHALLOW: \ + case CheckDEEP: \ + ASSERT(CHECKT(type, val), \ + "SigCheck " #type ": " #val); \ + break; \ + } \ + END + + +/* CHECKU_NOSIG -- Check Up for a type with no signature */ + +#define CHECKU_NOSIG(type, val) \ + BEGIN \ + switch(CheckLevel) { \ + case CheckNONE: \ + NOOP; \ + break; \ + case CheckSHALLOW: \ + case CheckDEEP: \ + ASSERT((val) != NULL, \ + "NullCheck " #type ": " #val); \ + break; \ + } \ + END + + +#else + +#error "No heat defined." + +#endif + + +/* CHECKLVALUE &c -- type compatibility checking + * + * .check.macros: The CHECK* macros use some C trickery to attempt to + * verify that certain types and fields are equivalent. They do not + * do a complete job. This trickery is justified by the security gained + * in knowing that impl.h.mps matches the MPM. See also + * mail.richard.1996-08-07.09-49. [This paragraph is intended to + * satisfy rule.impl.trick.] + */ + +#define CHECKLVALUE(lv1, lv2) \ + ((void)sizeof((lv1) = (lv2)), (void)sizeof((lv2) = (lv1)), TRUE) + +#define CHECKTYPE(t1, t2) \ + (sizeof(t1) == sizeof(t2) && \ + CHECKLVALUE(*((t1 *)0), *((t2 *)0))) + +#define CHECKFIELDAPPROX(s1, f1, s2, f2) \ + (sizeof(((s1 *)0)->f1) == sizeof(((s2 *)0)->f2) && \ + offsetof(s1, f1) == offsetof(s2, f2)) + +#define CHECKFIELD(s1, f1, s2, f2) \ + (CHECKFIELDAPPROX(s1, f1, s2, f2) && \ + CHECKLVALUE(((s1 *)0)->f1, ((s2 *)0)->f2)) + + +#endif /* check_h */ diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk new file mode 100644 index 00000000000..4699cd2756e --- /dev/null +++ b/mps/code/comm.gmk @@ -0,0 +1,553 @@ +# impl.gmk.comm: COMMON GNUMAKEFILE FRAGMENT +# +# $HopeName: MMsrc!comm.gmk(trunk.70) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# DESCRIPTION +# +# This makefile fragment is included in more specific makefiles for +# platforms which use GNU make. +# +# PARAMETERS +# +# Assumes the following variables and definitions: +# CFLAGSCOMPILER a list of flags for all compilations +# CFLAGSDEBUG a list of flags for compilations with maximum debug +# information, and any optimization possible +# CFLAGSOPT a list of flags for compilations with maximum +# optimization, and any debug info possible +# CFLAGSOPTNODEBUG a list of flags for compilations with maximum +# optimization, and absolutely no debug info +# CC the command for the C compiler +# LINKFLAGS a list of flags passed to the linker +# ARFLAGSPFM platform-specific flags for ar +# RANLIB the command to index a library (default: none needed) +# gendep optionally defined to be a command sequence for +# generating the dependency file (.d) from a C file (.c); +# it is used in a rule of the form: +# $(PFM)/$(VARIETY)/%.d: %.c +# PFM platform code, e.g. "sus8gc" +# LIBS extra libraries to include in tests (usually "-lm") +# NOISY if defined and non-empty, causes commands to be emitted +# MPMPF platform-dependent C sources for the "mpm" part +# MPMS assembler sources for the "mpm" part (.s files) +# MPMPS pre-processor assembler sources for the "mpm" part (.S files) +# SWPF platform-dependent C sources for the "sw" part +# +# %%PART: Add a new parameter above for the files included in the part. +# +# EDITING +# +# To add new targets, varieties, and parts: +# Search for the string "%%TARGET", "%%VARIETY", or "%%PART" in this +# makefile and follow the instructions. If you're adding a part, you'll +# have to change the makefiles for all the platforms which use this +# makefile to define the source list for that part, and the GNUmakefile +# to include a recursive call to the name of that part. +# +# CHECK PARAMETERS +# +# GNU make doesn't really have an "error" directive, but these lines +# will cause it to exit with an error. +# [These only test to see whether the symbol is defined. We could be +# more thorough and test the syntax and content. -- richard 1995-09-07] + +ifndef CC +error "comm.gmk: CC not defined" +endif +ifndef CFLAGSCOMPILER +error "comm.gmk: CFLAGSCOMPILER not defined" +endif +ifndef CFLAGSDEBUG +error "comm.gmk: CFLAGSDEBUG not defined" +endif +ifndef CFLAGSOPT +error "comm.gmk: CFLAGSOPT not defined" +endif +ifndef CFLAGSOPTNODEBUG +error "comm.gmk: CFLAGSOPTNODEBUG not defined" +endif + +# +# %%PART: Add checks for the parameter with the sources for the new +# part. + +ifndef PFM +error "comm.gmk: PFM not defined" +endif +ifndef MPMPF +error "comm.gmk: MPMPF not defined" +endif + + +# DECLARATIONS + +ifdef NOISY +ECHO = : +else +.SILENT: +ECHO = echo +endif + +.PHONY: phony + + +# C FLAGS + +# Some flags depend on the target. Alas. +ifdef TARGET +ifeq ($(TARGET),mmsw.a) +CFLAGSTARGET = -DCONFIG_PROD_EPCORE +else +ifeq ($(TARGET),epvmss) +CFLAGSTARGET = -DCONFIG_PROD_EPCORE +else +ifeq ($(TARGET),replaysw) +CFLAGSTARGET = -DCONFIG_PROD_EPCORE +else +ifeq ($(TARGET),epdss) +CFLAGSTARGET = -DCONFIG_PROD_EPCORE +else +ifeq ($(TARGET),mmdw.a) +CFLAGSTARGET = -DCONFIG_PROD_DYLAN +else +ifeq ($(TARGET),replay) +CFLAGSTARGET = -DCONFIG_PROD_DYLAN +else +CFLAGSTARGET = -DCONFIG_PROD_MPS +endif +endif +endif +endif +endif +endif +endif + +# These flags are included in all compilations. +CFLAGSCOMMON = $(PFMDEFS) $(CFLAGSTARGET) $(CFLAGSCOMPILER) + +# %%VARIETY: Define a macro containing the set of flags for the new +# variety. + +# These flags are added to compilations for the indicated variety. +CFWE = -DCONFIG_VAR_WE -DNDEBUG $(CFLAGSOPTNODEBUG) +CFWI = -DCONFIG_VAR_WI -DNDEBUG $(CFLAGSOPT) +CFHE = -DCONFIG_VAR_HE -DNDEBUG $(CFLAGSOPTNODEBUG) +CFHI = -DCONFIG_VAR_HI -DNDEBUG $(CFLAGSOPT) +CFII = -DCONFIG_VAR_II -DNDEBUG $(CFLAGSOPT) +CFCE = -DCONFIG_VAR_CE $(CFLAGSOPTNODEBUG) +CFCI = -DCONFIG_VAR_CI $(CFLAGSDEBUG) +CFTI = -DCONFIG_VAR_TI $(CFLAGSDEBUG) + +# Bind CFLAGS to the appropriate set of flags for the variety. +# %%VARIETY: Add a test for the variety and set CFLAGS here. +ifeq ($(VARIETY),we) +CFLAGS=$(CFLAGSCOMMON) $(CFWE) +else +ifeq ($(VARIETY),wi) +CFLAGS=$(CFLAGSCOMMON) $(CFWI) +else +ifeq ($(VARIETY),he) +CFLAGS=$(CFLAGSCOMMON) $(CFHE) +else +ifeq ($(VARIETY),hi) +CFLAGS=$(CFLAGSCOMMON) $(CFHI) +else +ifeq ($(VARIETY),ii) +CFLAGS=$(CFLAGSCOMMON) $(CFII) +else +ifeq ($(VARIETY),ce) +CFLAGS=$(CFLAGSCOMMON) $(CFCE) +else +ifeq ($(VARIETY),ci) +CFLAGS=$(CFLAGSCOMMON) $(CFCI) +else +ifeq ($(VARIETY),ti) +CFLAGS=$(CFLAGSCOMMON) $(CFTI) +else +endif +endif +endif +endif +endif +endif +endif +endif + + +ARFLAGS=rc$(ARFLAGSPFM) + + +# == Common definitions == +# %%PART: Add your part here, unless it's platform-specific +# These values are defined here because they have no variation between +# platforms. + +AMC = poolamc.c +AMS = poolams.c +AWL = poolawl.c +LO = poollo.c +SNC = poolsnc.c +POOLN = pooln.c +MVFF = poolmvff.c +TESTLIB = testlib.c +FMTDY = fmtdy.c +FMTDYTST = fmtdy.c fmtdytst.c +FMTPS = fmtpstst.c +PLINTH = mpsliban.c mpsioan.c +EVENTPROC = eventcnv.c eventpro.c table.c +MPMCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \ + tract.c walk.c reserv.c protocol.c pool.c poolabs.c \ + trace.c root.c seg.c format.c buffer.c ref.c bt.c ring.c \ + shield.c ld.c event.c action.c sac.c message.c assert.c \ + poolmrg.c poolmfs.c poolmv.c dbgpool.c \ + boot.c meter.c splay.c cbs.c version.c +MPM = $(MPMCOMMON) $(MPMPF) +SWCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \ + tract.c walk.c reserv.c protocol.c pool.c poolabs.c \ + trace.c root.c seg.c format.c buffer.c ref.c bt.c ring.c \ + shield.c ld.c event.c action.c sac.c message.c assert.c \ + poolmrg.c poolmfs.c poolmv.c dbgpool.c \ + poolepdl.c poolepvm.c poolams.c poolmvff.c \ + boot.c meter.c splay.c cbs.c version.c mpsioan.c +SW = $(SWCOMMON) $(SWPF) + + +# These map the source file lists onto object files and dependency files +# in the platform/variety directory. +# +# %%PART: Add a new macro which expands to the files included in the +# part. + +ifdef VARIETY +MPMOBJ = $(MPM:%.c=$(PFM)/$(VARIETY)/%.o) \ + $(MPMS:%.s=$(PFM)/$(VARIETY)/%.o) +MPMDEP = $(MPM:%.c=$(PFM)/$(VARIETY)/%.d) +AMCOBJ = $(AMC:%.c=$(PFM)/$(VARIETY)/%.o) +AMCDEP = $(AMC:%.c=$(PFM)/$(VARIETY)/%.d) +AMSOBJ = $(AMS:%.c=$(PFM)/$(VARIETY)/%.o) +AMSDEP = $(AMS:%.c=$(PFM)/$(VARIETY)/%.d) +AWLOBJ = $(AWL:%.c=$(PFM)/$(VARIETY)/%.o) +AWLDEP = $(AWL:%.c=$(PFM)/$(VARIETY)/%.d) +LOOBJ = $(LO:%.c=$(PFM)/$(VARIETY)/%.o) +LODEP = $(LO:%.c=$(PFM)/$(VARIETY)/%.d) +SNCOBJ = $(SNC:%.c=$(PFM)/$(VARIETY)/%.o) +SNCDEP = $(SNC:%.c=$(PFM)/$(VARIETY)/%.d) +POOLNOBJ = $(POOLN:%.c=$(PFM)/$(VARIETY)/%.o) +POOLNDEP = $(POOLN:%.c=$(PFM)/$(VARIETY)/%.d) +MVFFOBJ = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.o) +MVFFDEP = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.d) +SWOBJ = $(SW:%.c=$(PFM)/$(VARIETY)/%.o) + +# The following hack for SWDEP only creates those dependencies when +# a SW target is being built. +ifdef TARGET +ifeq ($(TARGET),mmsw.a) +SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d) +else +ifeq ($(TARGET),epvmss) +SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d) +else +ifeq ($(TARGET),depend) +SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d) +else +SWDEP = +endif +endif +endif +endif + +TESTLIBOBJ = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.o) +TESTLIBDEP = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.d) +FMTDYOBJ = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.o) +FMTDYDEP = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.d) +FMTDYTSTOBJ = $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.o) +FMTDYTSTDEP = $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.d) +FMTPSOBJ = $(FMTPS:%.c=$(PFM)/$(VARIETY)/%.o) +FMTPSDEP = $(FMTPS:%.c=$(PFM)/$(VARIETY)/%.d) +PLINTHOBJ = $(PLINTH:%.c=$(PFM)/$(VARIETY)/%.o) +PLINTHDEP = $(PLINTH:%.c=$(PFM)/$(VARIETY)/%.d) +EVENTPROCOBJ = $(EVENTPROC:%.c=$(PFM)/$(VARIETY)/%.o) +EVENTPROCDEP = $(EVENTPROC:%.c=$(PFM)/$(VARIETY)/%.d) +endif + + +# == Pseudo-targets == + +# %%TARGET: Add the target to the all dependencies, if it uses the +# CONFIG_PROD_MPS configuration, to swall if CONFIG_PROD_EPCORE + +all: mpmss sacss amcss amcsshe amsss segsmss awlut \ + mpsicv lockcov poolncv locv qs apss \ + finalcv arenacv bttest teletest \ + abqtest cbstest btcv mv2test messtest \ + eventcnv mps.a + +swall: mmsw.a epvmss replaysw epdss + +# Runs the automatic tests that are built with CONFIG_PROD_MPS +# These tests are run overnight (see design.buildsys.overnight). +# bttest & teletest cannot be run unattended +# mv2test cannot be run because MV2 is broken +testrun: mpmss apss sacss amcss amcsshe amsss segsmss awlut mpsicv lockcov \ + poolncv locv qs finalcv arenacv abqtest cbstest btcv messtest + $(^:%=date && $(PFM)/$(VARIETY)/% &&) true + +# Runs the automatic tests that are built with CONFIG_PROD_EPCORE +testrunep: epvmss epdss + $(^:%=date && $(PFM)/$(VARIETY)/% &&) true + + +# These convenience targets allow one to type "make foo" to build target +# foo in selected varieties (or none, for the latter rule). +# +# %%TARGET: Add a pseudo-target for the new target here. + +mpmss sacss amcss amcssth amcsshe amsss segsmss awlut awlutth \ + mpsicv lockcov poolncv locv qs apss \ + finalcv arenacv bttest teletest epvmss epdss \ + abqtest cbstest btcv mv2test \ + messtest \ + eventcnv replay replaysw \ + mps.a mmsw.a mpsplan.a mmdw.a: phony +ifdef VARIETY + $(MAKE) -f $(PFM).gmk TARGET=$@ variety +else + $(MAKE) -f $(PFM).gmk TARGET=$@ target +endif + + +# "clean" removes the directory containing the build results for the +# platform. + +clean: phony + $(ECHO) "$(PFM): $@" + rm -rf "$(PFM)" + +# "target" builds some varieties of the target named in the TARGET macro. +# %%VARIETY: Optionally, add a recursive make call for the new variety, +# if it should be built by default. + +ifdef TARGET +ifndef VARIETY +target: phony + $(MAKE) -f $(PFM).gmk VARIETY=hi variety + $(MAKE) -f $(PFM).gmk VARIETY=ci variety + $(MAKE) -f $(PFM).gmk VARIETY=ti variety +endif +endif + + +# "variety" builds the target named in the TARGET macro using the +# variety named in the VARIETY macro. + +ifdef VARIETY +ifdef TARGET +variety: $(PFM)/$(VARIETY)/$(TARGET) +endif +endif + + +# GENUINE TARGETS +# +# Each line defines an executable or library target to be built and the +# object files it is built from. These lines add dependencies to the +# generic rules below, and should not include commands to execute. +# +# %%TARGET: Add the dependencies for the new target here. + +ifdef VARIETY + +$(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/locv: $(PFM)/$(VARIETY)/locv.o \ + $(MPMOBJ) $(LOOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/mpmss: $(PFM)/$(VARIETY)/mpmss.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/apss: $(PFM)/$(VARIETY)/apss.o \ + $(MPMOBJ) $(MVFFOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/sacss: $(PFM)/$(VARIETY)/sacss.o \ + $(MPMOBJ) $(MVFFOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/bttest: $(PFM)/$(VARIETY)/bttest.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/teletest: $(PFM)/$(VARIETY)/teletest.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/lockcov: $(PFM)/$(VARIETY)/lockcov.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/mpsicv: $(PFM)/$(VARIETY)/mpsicv.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/amcss: $(PFM)/$(VARIETY)/amcss.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/amcssth: $(PFM)/$(VARIETY)/amcssth.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/amcsshe: $(PFM)/$(VARIETY)/amcsshe.o \ + $(PFM)/$(VARIETY)/fmthe.o $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/amsss: $(PFM)/$(VARIETY)/amsss.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMSOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/segsmss: $(PFM)/$(VARIETY)/segsmss.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMSOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/epvmss: $(PFM)/$(VARIETY)/epvmss.o \ + $(FMTPSOBJ) $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ) + +$(PFM)/$(VARIETY)/epdss: $(PFM)/$(VARIETY)/epdss.o \ + $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ) + +$(PFM)/$(VARIETY)/awlut: $(PFM)/$(VARIETY)/awlut.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(LOOBJ) $(AWLOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/awlutth: $(PFM)/$(VARIETY)/awlutth.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(LOOBJ) $(AWLOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/poolncv: $(PFM)/$(VARIETY)/poolncv.o \ + $(MPMOBJ) $(TESTLIBOBJ) $(POOLNOBJ) + +$(PFM)/$(VARIETY)/qs: $(PFM)/$(VARIETY)/qs.o \ + $(AMCOBJ) $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/arenacv: $(PFM)/$(VARIETY)/arenacv.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/abqtest: $(PFM)/$(VARIETY)/abqtest.o \ + $(PFM)/$(VARIETY)/abq.o $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/cbstest: $(PFM)/$(VARIETY)/cbstest.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/btcv: $(PFM)/$(VARIETY)/btcv.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/mv2test: $(PFM)/$(VARIETY)/mv2test.o \ + $(PFM)/$(VARIETY)/poolmv2.o $(PFM)/$(VARIETY)/abq.o \ + $(MPMOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/messtest: $(PFM)/$(VARIETY)/messtest.o \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)/$(VARIETY)/eventcnv: $(PFM)/$(VARIETY)/eventcnv.o \ + $(PFM)/$(VARIETY)/eventpro.o $(PFM)/$(VARIETY)/table.o + +$(PFM)/$(VARIETY)/replay: $(PFM)/$(VARIETY)/replay.o \ + $(PFM)/$(VARIETY)/eventrep.o \ + $(PFM)/$(VARIETY)/eventpro.o $(PFM)/$(VARIETY)/table.o \ + $(MPMOBJ) $(AWLOBJ) $(AMSOBJ) $(POOLNOBJ) $(AMCOBJ) $(SNCOBJ) $(MVFFOBJ) + +$(PFM)/$(VARIETY)/replaysw: $(PFM)/$(VARIETY)/replay.o \ + $(PFM)/$(VARIETY)/eventrep.o \ + $(PFM)/$(VARIETY)/eventpro.o $(PFM)/$(VARIETY)/table.o \ + $(FMTPSOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mpsliban.o $(SWOBJ) + +$(PFM)/$(VARIETY)/mps.a: $(MPMOBJ) $(AMCOBJ) $(SNCOBJ) $(MVFFOBJ) + +$(PFM)/$(VARIETY)/mmdw.a: $(MPMOBJ) $(AMCOBJ) $(LOOBJ) $(SNCOBJ) \ + $(FMTDYOBJ) $(AWLOBJ) + +$(PFM)/$(VARIETY)/mpsplan.a: $(PLINTHOBJ) + +$(PFM)/$(VARIETY)/mmsw.a: \ + $(SWOBJ) + +endif + + +# GENERIC RULES +# +# These generate build output in the / directory. +# Note that we can't used "mkdir -p" to create this directory because +# it's broken (w.r.t. the man page) under OSF/1. + +# Object files + +define run-cc +$(ECHO) "$(PFM): $@" +test -d $(PFM) || mkdir $(PFM) +test -d $(PFM)/$(VARIETY) || mkdir $(PFM)/$(VARIETY) +$(CC) $(CFLAGS) -c -o $@ $< +endef + +# .force: FORCE is a dependent that can be used to force targets to be +# built. +.PHONY: FORCE +# A rule with no dependents and no commands always causes update. +# (See GNUMake doc, make.info, Node: Force Targets) +# (ignore the bit about using FORCE as being the same as using .PHONY +# it's not, and we make use of that, see .special.version below) +FORCE: + +# .special.version: version.o has a special rule so that it is always +# built. This rule has no commands, this has the effect of adding the +# dependents to those specified by other rules (in this case the implicit +# .o:.c rule below, .rule.c-to-o). The extra dependent added is the +# FORCE dependent (defined above, .force) which causes the target to be +# always built. +ifdef VARIETY +$(PFM)/$(VARIETY)/version.o: FORCE +endif + +# .rule.c-to-o: +$(PFM)/$(VARIETY)/%.o: %.c + $(run-cc) + +$(PFM)/$(VARIETY)/%.o: %.s + $(run-cc) + +$(PFM)/$(VARIETY)/%.o: %.S + $(run-cc) + +# Dependencies +# +# These are included into _this_ makefile (see below). GNU make does the +# right thing as long as it knows how to make the dependency files before +# including them. + +ifdef gendep + +$(PFM)/$(VARIETY)/%.d: %.c + $(ECHO) "$(PFM): $@" + test -d $(PFM) || mkdir $(PFM) + test -d $(PFM)/$(VARIETY) || mkdir $(PFM)/$(VARIETY) + $(gendep) + +ifdef VARIETY +ifdef TARGET +# %%PART: Add the dependency file macro for the new part here. +include $(MPMDEP) $(AMSDEP) $(AMCDEP) $(LODEP) $(SWDEP) \ + $(AWLDEP) $(POOLNDEP) $(TESTLIBDEP) $(FMTDYDEP) $(FMTPSDEP) \ + $(PLINTHDEP) $(EVENTPROCDEP) +endif +endif + +endif + +# Library + +ifndef RANLIB +RANLIB = : +endif + +$(PFM)/$(VARIETY)/%.a: + $(ECHO) "$(PFM): $@" + rm -f $@ + $(AR) $(ARFLAGS) $@ $^ + $(RANLIB) $@ + +# Executable + +$(PFM)/$(VARIETY)/%: + $(ECHO) "$(PFM): $@" + $(CC) $(LINKFLAGS) -o $@ $^ $(LIBS) + +# End of makefile. diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk new file mode 100644 index 00000000000..8f42d5a5101 --- /dev/null +++ b/mps/code/commpost.nmk @@ -0,0 +1,265 @@ +# impl.nmk.commpost: SECOND COMMON FRAGMENT FOR PLATFORMS USING MV AND NMAKE +# +# $HopeName: MMsrc!commpost.nmk(trunk.44) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# DESCRIPTION +# +# Second common makefile fragment for w3*mv.nmk. See commpre.nmk + + +# PSEUDO-TARGETS + +# "all" builds all the varieties of all targets +# %%TARGET: Add the target to the all dependencies, if it uses the +# CONFIG_PROD_MPS configuration, to swall if CONFIG_PROD_EPCORE + +all: mpmss.exe amcss.exe amsss.exe segsmss.exe awlut.exe \ + mpsicv.exe lockutw3.exe lockcov.exe poolncv.exe locv.exe qs.exe apss.exe \ + finalcv.exe arenacv.exe bttest.exe teletest.exe protcv.exe \ + abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe \ + locbwcss.exe locusss.exe \ + eventcnv.exe + +swall: mmsw.lib epvmss.exe replaysw.exe + + +# Convenience targets + +# %%TARGET: Add a pseudo-target for the new target here, first rule for +# variety-dependent targets, and second for variety-independent ones. + +mpmss.exe amcss.exe amcsshe.exe amsss.exe segsmss.exe awlut.exe dwstress.exe \ + mpsicv.exe lockutw3.exe lockcov.exe poolncv.exe locv.exe qs.exe apss.exe \ + finalcv.exe arenacv.exe bttest.exe teletest.exe protcv.exe epvmss.exe \ + abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe \ + locbwcss.exe locusss.exe \ + replay.exe replaysw.exe eventcnv.exe \ + mmdw.lib mmsw.lib mps_conf.lib mpsplan.lib: +!IFDEF VARIETY + $(MAKE) /nologo /f $(PFM).nmk TARGET=$@ variety +!ELSE + $(MAKE) /nologo /f $(PFM).nmk TARGET=$@ target +!ENDIF + +# "clean" removes the directory containing the build results. +# Depends on there being no file called "clean". +# Since we can't know whether we have rmdir, try with deltree as well. + +clean: + $(ECHO) $(PFM): $@ + -echo y | rmdir/s $(PFM) + -deltree /Y $(PFM) + +# target target +# %%VARIETY: Optionally, add a recursive make call for the new variety, +# if it should be built by default. +# Only the varieties needed for development and internal customers are made. +# Depends on there being no file called "target". + +!IFDEF TARGET +!IFNDEF VARIETY +target: + $(MAKE) /nologo /f $(PFM).nmk VARIETY=hi variety + $(MAKE) /nologo /f $(PFM).nmk VARIETY=ci variety + $(MAKE) /nologo /f $(PFM).nmk VARIETY=ti variety +!ENDIF +!ENDIF + +# variety +# Depends on there being no file called "variety". + +!IFDEF VARIETY +!IFDEF TARGET +variety: $(PFM)\$(VARIETY)\$(TARGET) +!ENDIF +!ENDIF + +mpsicv.cov: + $(MAKE) /nologo /f $(PFM).nmk TARGET=$@ VARIETY=cv variety + +# FORCE +# Used to force a target to be built. +# Depends on there being no file called "FORCE". +FORCE: + + +# GENUINE TARGETS +# +# Each line defines an executable or library target to be built and the object +# files it is build from. For an executable these lines add dependencies to +# the generic rules below, and should not include commands to execute. +# For a library this is not possible and the target should include commands +# to build it. +# %%TARGET: Add your new target here + + +!IFDEF VARIETY + +# .special.version: version.obj has a special rule so that it is always +# built. This rule has no commands, meaning that the commands from +# other rules (the implicit .c -> .obj rule in particular) will be used. +# (Actually, there's a MS bug that causes this to randomly fail to build.) +$(PFM)\$(VARIETY)\version.obj: FORCE + +$(PFM)\$(VARIETY)\finalcv.exe: $(PFM)\$(VARIETY)\finalcv.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(DWOBJ) $(DWTESTOBJ) \ + $(MRGOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\locv.exe: $(PFM)\$(VARIETY)\locv.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) $(LOOBJ) + +$(PFM)\$(VARIETY)\mpmss.exe: $(PFM)\$(VARIETY)\mpmss.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\apss.exe: $(PFM)\$(VARIETY)\apss.obj \ + $(PFM)\$(VARIETY)\poolmvff.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\bttest.exe: $(PFM)\$(VARIETY)\bttest.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\teletest.exe: $(PFM)\$(VARIETY)\teletest.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\lockcov.exe: $(PFM)\$(VARIETY)\lockcov.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\lockutw3.exe: $(PFM)\$(VARIETY)\lockutw3.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\protcv.exe: $(PFM)\$(VARIETY)\protcv.obj \ + $(MPMOBJ) $(PLINTHOBJ) + +$(PFM)\$(VARIETY)\mpsicv.exe: $(PFM)\$(VARIETY)\mpsicv.obj \ + $(MPMOBJ) $(AMCOBJ) $(PLINTHOBJ) $(DWOBJ) $(DWTESTOBJ) \ + $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\amcss.exe: $(PFM)\$(VARIETY)\amcss.obj \ + $(MPMOBJ) $(AMCOBJ) $(PLINTHOBJ) $(DWOBJ) $(DWTESTOBJ) \ + $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\amcsshe.exe: $(PFM)\$(VARIETY)\amcsshe.obj \ + $(CONFIGURAOBJ) $(AMCOBJ) $(PLINTHOBJ) $(PFM)\$(VARIETY)\fmthe.obj \ + $(TESTLIBOBJ) $(DONGLELIB) + +$(PFM)\$(VARIETY)\amsss.exe: $(PFM)\$(VARIETY)\amsss.obj \ + $(MPMOBJ) $(AMSOBJ) $(PLINTHOBJ) $(DWOBJ) $(DWTESTOBJ) \ + $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\segsmss.exe: $(PFM)\$(VARIETY)\segsmss.obj \ + $(MPMOBJ) $(AMSOBJ) $(PLINTHOBJ) $(DWOBJ) $(DWTESTOBJ) \ + $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\locbwcss.exe: $(PFM)\$(VARIETY)\locbwcss.obj \ + $(PFM)\$(VARIETY)\poolmvff.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\dwstress.exe: $(PFM)\$(VARIETY)\dwstress.obj \ + $(DWOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) + +$(PFM)\$(VARIETY)\epvmss.exe: $(PFM)\$(VARIETY)\epvmss.obj \ + $(PFM)\$(VARIETY)\fmtpstst.obj \ + $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ) $(EVENTOBJ) + +$(PFM)\$(VARIETY)\awlut.exe: $(PFM)\$(VARIETY)\awlut.obj \ + $(PFM)\$(VARIETY)\fmtdy.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) $(LOOBJ) $(AWLOBJ) + +$(PFM)\$(VARIETY)\poolncv.exe: $(PFM)\$(VARIETY)\poolncv.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) $(POOLNOBJ) + +$(PFM)\$(VARIETY)\qs.exe: $(PFM)\$(VARIETY)\qs.obj \ + $(AMCOBJ) $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\arenacv.exe: $(PFM)\$(VARIETY)\arenacv.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\abqtest.exe: $(PFM)\$(VARIETY)\abqtest.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\cbstest.exe: $(PFM)\$(VARIETY)\cbstest.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\btcv.exe: $(PFM)\$(VARIETY)\btcv.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\mv2test.exe: $(PFM)\$(VARIETY)\mv2test.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\eventcnv.exe: $(PFM)\$(VARIETY)\eventcnv.obj \ + $(PFM)\$(VARIETY)\eventpro.obj $(PFM)\$(VARIETY)\table.obj + +$(PFM)\$(VARIETY)\replay.exe: $(PFM)\$(VARIETY)\replay.obj \ + $(PFM)\$(VARIETY)\eventrep.obj \ + $(PFM)\$(VARIETY)\eventpro.obj $(PFM)\$(VARIETY)\table.obj \ + $(MPMOBJ) $(AWLOBJ) $(AMSOBJ) $(POOLNOBJ) $(AMCOBJ) $(SNCOBJ) \ + $(PFM)\$(VARIETY)\poolmvff.obj $(PFM)\$(VARIETY)\mpsliban.obj + +# Have to rename the object file, because the names must match, or +# the template rule for .exe.obj won't be used. +$(PFM)\$(VARIETY)\replaysw.obj: $(PFM)\$(VARIETY)\replay.obj + $(ECHO) $@ + copy $** $@ >nul: + +$(PFM)\$(VARIETY)\replaysw.exe: $(PFM)\$(VARIETY)\replaysw.obj \ + $(PFM)\$(VARIETY)\eventrep.obj \ + $(PFM)\$(VARIETY)\eventpro.obj $(PFM)\$(VARIETY)\table.obj \ + $(PFM)\$(VARIETY)\fmtpstst.obj $(TESTLIBOBJ) \ + $(PFM)\$(VARIETY)\mpsliban.obj $(SWOBJ) + +$(PFM)\$(VARIETY)\messtest.exe: $(PFM)\$(VARIETY)\messtest.obj \ + $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) + +$(PFM)\$(VARIETY)\mmsw.lib: $(SWOBJ) + $(ECHO) $@ + $(LIBMAN) $(LIBFLAGS) /OUT:$@ $** + +$(PFM)\$(VARIETY)\mmdw.lib: $(MPMOBJ) $(AMCOBJ) $(DWOBJ) \ + $(AWLOBJ) $(LOOBJ) $(SNCOBJ) + $(ECHO) $@ + $(LIBMAN) $(LIBFLAGS) /OUT:$@ $** + +$(PFM)\$(VARIETY)\mps_conf.lib: $(CONFIGURAOBJ) $(AMCOBJ) $(LOOBJ) $(SNCOBJ) \ + $(MVFFOBJ) $(AMSOBJ) + $(ECHO) $@ + $(LIBMAN) $(LIBFLAGS) /OUT:$@ $(DONGLELIB) $** + +$(PFM)\$(VARIETY)\mpsplan.lib: $(PLINTHOBJ) + $(ECHO) $@ + $(LIBMAN) $(LIBFLAGS) /OUT:$@ $** + +!ENDIF + + +# GENERIC RULES + +# Object files + +{}.c{$(PFM)\$(VARIETY)}.obj: + $(ECHO) $@ + @if not exist $(PFM) mkdir $(PFM) + @if not exist $(PFM)\$(VARIETY) mkdir $(PFM)\$(VARIETY) + cl /c $(CFLAGS) /Fd$(PFM)\$(VARIETY)\ /Fo$@ $< + +{}.asm{$(PFM)\$(VARIETY)}.obj: + $(ECHO) $@ + @if not exist $(PFM) mkdir $(PFM) + @if not exist $(PFM)\$(VARIETY) mkdir $(PFM)\$(VARIETY) + ml /nologo /c /coff /Fo$@ $< + +# Coverage files +#{$(PFM)\$(VARIETY)}.exe{$(PFM)\$(VARIETY)}.cov: +# $(ECHO) $@ +# cd $(PFM)\$(VARIETY) +# prep /nologo /lv $( $(@F) + + +# Executables + +{$(PFM)\$(VARIETY)}.obj{$(PFM)\$(VARIETY)}.exe: + $(ECHO) $@ + $(LINKER) $(LINKFLAGS) /OUT:$@ $(**) diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk new file mode 100644 index 00000000000..9bff42463eb --- /dev/null +++ b/mps/code/commpre.nmk @@ -0,0 +1,197 @@ +# impl.nmk.commpre: FIRST COMMON FRAGMENT FOR PLATFORMS USING MV AND NMAKE +# +# $HopeName: MMsrc!commpre.nmk(trunk.19) $ +# Copyright (C) 2001 Harlequin Limited. All rights reserved. +# +# DESCRIPTION +# +# .description: This makefile fragment is included in more specific +# makefiles for platforms which use the "mv" builder. This is +# the first of two common makefile fragements (the other is commpost.nmk). +# Alas, due to shortcomings in nmake, it is not possible to use only one +# common fragment. +# +# %%PART: Add a new parameter for the files included in the part +# Parameters: +# PFM platform code, e.g. "nti3mv" +# PFMDEFS /D options to define platforms preprocessor symbols +# to the compiler. Eg "/DOS_NT /DARCH_386 /DBUILD_MVC" +# MPM list of sources which make up the "mpm" part for this +# platform. Each source is stripped of its .c extension +# and surrounded in angle brackets (<>) +# PLINTH as above for the "plinth" part +# AMC as above for the "amc" part +# AMS as above for the "ams" part +# LO as above for the "lo" part +# MRG as above for the "mrg" part +# SW as above for the "sw" part +# TESTLIB as above for the "testlib" part +# NOISY if defined, causes command to be emitted +# +# +# EDITING +# +# To add new targets. varieties, and parts: +# Search for the string "%%TARGET", "%%VARIETY", or "%%PART" in this makefile +# and follow the instructions. If you're adding a part, you'll have to change +# the makefile for all the platforms which use this makefile to define the +# source list for that part. +# + +# CHECK PARAMETERS +# +# +# %%PART: Add checks for the parameter with the sources for the new part. + +!IFNDEF PFM +!ERROR commpre.nmk: PFM not defined +!ENDIF +!IFNDEF PFMDEFS +!ERROR commpre.nmk: PFMDEFS not defined +!ENDIF +!IFNDEF MPM +!ERROR commpre.nmk: MPM not defined +!ENDIF +!IFNDEF PLINTH +!ERROR commpre.nmk: PLINTH not defined +!ENDIF +!IFNDEF LO +!ERROR commpre.nmk: LO not defined +!ENDIF +!IFNDEF AMC +!ERROR commpre.nmk: AMC not defined +!ENDIF +!IFNDEF AMS +!ERROR commpre.nmk: AMS not defined +!ENDIF +!IFNDEF SW +!ERROR commpre.nmk: SW not defined +!ENDIF +!IFNDEF TESTLIB +!ERROR commpre.nmk: TESTLIB not defined +!ENDIF + + +# DECLARATIONS + + +!IFDEF NOISY +ECHO = rem +!ELSE +.SILENT: +ECHO = echo +!ENDIF + + +# C FLAGS + +# /MD means compile for multi-threaded environment with separate C library DLL. +# /MT means compile for multi-threaded environment. +# /ML means compile for single-threaded environment. +# A 'd' at the end means compile for debugging. + +!ifdef TARGET +!if "$(TARGET)" == "mmsw.lib" || "$(TARGET)" == "epvmss.exe" || "$(TARGET)" == "replaysw.exe" +CFLAGSTARGETPRE = /DCONFIG_PROD_EPCORE +CFLAGSTARGETPOST = +CRTFLAGSW = /MD +CRTFLAGSH = /MDd +CRTFLAGSC = /MDd +LINKFLAGSWHITE = msvcrt.lib +LINKFLAGSHOT = msvcrtd.lib +LINKFLAGSCOOL = msvcrtd.lib + +!elseif "$(TARGET)" == "mmdw.lib" +# /Oy- is actually 86-specific, but Dylan is only built for that platform +CFLAGSTARGETPRE = /DCONFIG_PROD_DYLAN +CFLAGSTARGETPOST = /Oy- +CRTFLAGSW = /MT +CRTFLAGSH = /MT +CRTFLAGSC = /MT +LINKFLAGSWHITE = libcmt.lib +LINKFLAGSHOT = libcmt.lib +LINKFLAGSCOOL = libcmt.lib + +!elseif "$(TARGET)" == "mps_conf.lib" || "$(TARGET)" == "amcsshe.exe" +CFLAGSTARGETPRE = /DCONFIG_PROD_CONFIGURA +CFLAGSTARGETPOST = +CRTFLAGSW = /ML +CRTFLAGSH = /ML +CRTFLAGSC = /MLd +LINKFLAGSWHITE = libc.lib +LINKFLAGSHOT = libc.lib +LINKFLAGSCOOL = libcd.lib + +!else +CFLAGSTARGETPRE = /DCONFIG_PROD_MPS +CFLAGSTARGETPOST = +CRTFLAGSW = /MT +CRTFLAGSH = /MT +CRTFLAGSC = /MTd +LINKFLAGSWHITE = libcmt.lib +LINKFLAGSHOT = libcmt.lib +LINKFLAGSCOOL = libcmtd.lib +!endif +!endif + +CFLAGSCOMMONPRE = /nologo /W4 /WX $(PFMDEFS) $(CFLAGSTARGETPRE) +CFLAGSCOMMONPOST = $(CFLAGSTARGETPOST) + +# Flags for use in the variety combinations +CFLAGSHOT = /Ox /DNDEBUG +CFLAGSCOOL = /Od /GZ +CFLAGSINTERNAL = /Zi +CFLAGSEXTERNAL = + +# The combinations of variety +# %%VARIETY: Define a macro containing the set of flags for the new variety. +CFWE = /DCONFIG_VAR_WE $(CRTFLAGSW) $(CFLAGSHOT) $(CFLAGSEXTERNAL) +CFWI = /DCONFIG_VAR_WI $(CRTFLAGSW) $(CFLAGSHOT) $(CFLAGSINTERNAL) +CFHE = /DCONFIG_VAR_HE $(CRTFLAGSH) $(CFLAGSHOT) $(CFLAGSEXTERNAL) +CFHI = /DCONFIG_VAR_HI $(CRTFLAGSH) $(CFLAGSHOT) $(CFLAGSINTERNAL) +CFCE = /DCONFIG_VAR_CE $(CRTFLAGSC) $(CFLAGSCOOL) $(CFLAGSEXTERNAL) +CFCI = /DCONFIG_VAR_CI $(CRTFLAGSC) $(CFLAGSCOOL) $(CFLAGSINTERNAL) +CFTI = /DCONFIG_VAR_TI $(CRTFLAGSC) $(CFLAGSCOOL) $(CFLAGSINTERNAL) + +# Microsoft documentation is not very clear on the point of using both +# optimization and debug information + +# LINKER FLAGS +# %%VARIETY: define a macro containing the flags for the new variety +LINKER = link +LINKFLAGSCOMMON = /nologo +LINKFLAGSINTERNAL = /DEBUG:full +LINKFLAGSEXTERNAL = /RELEASE + +LFWE = $(LINKFLAGSWHITE) $(LINKFLAGSEXTERNAL) +LFWI = $(LINKFLAGSWHITE) $(LINKFLAGSINTERNAL) +LFHE = $(LINKFLAGSHOT) $(LINKFLAGSEXTERNAL) +LFHI = $(LINKFLAGSHOT) $(LINKFLAGSINTERNAL) +LFCE = $(LINKFLAGSCOOL) $(LINKFLAGSEXTERNAL) +LFCI = $(LINKFLAGSCOOL) $(LINKFLAGSINTERNAL) +LFTI = $(LINKFLAGSCOOL) $(LINKFLAGSINTERNAL) + +#LFCV = /PROFILE /DEBUG:full /DEBUGTYPE:cv + +# Library manager +# %%VARIETY: define a macro containing the flags for the new variety +LIBMAN = lib # can't call this LIB - it screws the environment +LIBFLAGSCOMMON = /nologo +LIBFLAGSWE = +LIBFLAGSWI = +LIBFLAGSHE = +LIBFLAGSHI = +LIBFLAGSCE = +LIBFLAGSCI = +LIBFLAGSTI = +#LIBFLAGSCV = + +# Browser database manager [not used at present] +#BSC = bscmake +#BSCFLAGS = /nologo /n + + +# == Common definitions == +# %%PART: Add your part here, unless it's platform-specific +# [It is not possible use a macro, like $(PFM), in a substitution, +# hence all parts end up being platform-specific.] diff --git a/mps/code/config.h b/mps/code/config.h new file mode 100644 index 00000000000..300f84d8a24 --- /dev/null +++ b/mps/code/config.h @@ -0,0 +1,310 @@ +/* impl.h.config: MPS CONFIGURATION + * + * $HopeName: MMsrc!config.h(trunk.46) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * PURPOSE + * + * This module translates from high-level symbols defined by the + * external build system (gnumake, nmake, etc.) into specific sets + * of features used by MPS modules. For example, the build system + * will defined one of the CONFIG_VAR_* symbols to indicate which + * variety it is building, this file translates that into a certain + * level of checking, and a certain level of telemetry. + * + * DESIGN + * + * See design.mps.config. + */ + +#ifndef config_h +#define config_h + + +/* Variety Configuration + * + * Convert CONFIG_VAR_* defined on compiler command line into + * internal configuration parameters. See design.mps.config.var + * and design.mps.variety.macro. Note that MPS_HOT is subclassed + * into MPS_HOT_RED and MPS_HOT_WHITE; this distinction should + * be rarely used. + */ + +#if defined(CONFIG_VAR_HI) /* Hot, Internal; variety.hi */ +#define MPS_VARIETY_STRING "hi" +#define MPS_HOT +#define MPS_HOT_RED +#define EVENT_NONE +#elif defined(CONFIG_VAR_CI) /* Cool, Internal; variety.ci */ +#define MPS_VARIETY_STRING "ci" +#define MPS_COOL +#define EVENT_NONE +#elif defined(CONFIG_VAR_TI) /* Telemetry, Internal; variety.ti */ +#define MPS_VARIETY_STRING "ti" +#define MPS_COOL +#define EVENT +#elif defined(CONFIG_VAR_HE) /* Hot, External; variety.he */ +#define MPS_VARIETY_STRING "he" +#define MPS_HOT +#define MPS_HOT_RED +#define EVENT_NONE +#elif defined(CONFIG_VAR_CE) /* Cool, External; variety.ce */ +#define MPS_VARIETY_STRING "ce" +#define MPS_COOL +#define EVENT_NONE +#elif defined(CONFIG_VAR_WI) /* White hot, Internal; variety.wi */ +#define MPS_VARIETY_STRING "wi" +#define MPS_HOT +#define MPS_HOT_WHITE +#define EVENT_NONE +#elif defined(CONFIG_VAR_WE) /* White hot, External; variety.we */ +#define MPS_VARIETY_STRING "we" +#define MPS_HOT +#define MPS_HOT_WHITE +#define EVENT_NONE +#elif defined(CONFIG_VAR_II) /* Ice, Internal; variety.ii */ +#define MPS_VARIETY_STRING "ii" +#define MPS_HOT +#define MPS_HOT_RED +#define EVENT +#else +#error "No target variety configured." +#endif + + +#if defined(EVENT) +#define DIAGNOSTICS +#elif defined(EVENT_NONE) +#define DIAGNOSTICS_NONE +#else +#error "Events not configured." +#endif + + +/* Platform Configuration */ + +#include "mpstd.h" + +/* Suppress Visual C warnings at warning level 4, */ +/* see mail.richard.1997-09-25.13-26. */ +/* Essentially the same settings are done in testlib.h. */ + +#ifdef MPS_BUILD_MV + +/* "unreferenced inline function has been removed" (windows.h) */ +#pragma warning(disable: 4514) + +/* "constant conditional" (MPS_END) */ +#pragma warning(disable: 4127) + +/* "unreachable code" (ASSERT, if cond is constantly true). */ +#pragma warning(disable: 4702) + +/* MSVC 2.0 generates a warning when using NOCHECK or UNUSED */ +#ifdef _MSC_VER +#if _MSC_VER < 1000 +#pragma warning(disable: 4705) +#endif +#else /* _MSC_VER */ +#error "Expected _MSC_VER to be defined for builder.mv" +#endif /* _MSC_VER */ + +/* MSVC 10.00 on PowerPC generates erroneous warnings about */ +/* uninitialized local variables, if you take their address. */ +#ifdef MPS_ARCH_PP +#pragma warning(disable: 4701) +#endif /* MPS_ARCH_PP */ + + +/* In white-hot versions, absolutely no checking is done. This leads to + * many spurious warnings because parameters are suddenly unused, etc. + * We aren't interested in these. + */ + +#if defined(MPS_HOT_WHITE) + +/* "unreferenced formal parameter" */ +#pragma warning(disable: 4100) + +/* "unreferenced local function has been removed" */ +#pragma warning(disable: 4505) + +#endif /* MPS_HOT_WHITE */ + +#endif /* MPS_BUILD_MV */ + + +/* EPVMDefaultSubsequentSegSIZE is a default for the alignment of + * subsequent segments (non-initial at each save level) in EPVM. See + * design.mps.poolepvm.arch.segment.size. + */ + +#define EPVMDefaultSubsequentSegSIZE (64ul * 1024) + + +/* Arena Configuration -- see impl.c.arena + * + * .client.seg-size: ARENA_CLIENT_PAGE_SIZE is the size in bytes of a + * "page" (i.e., segment granule) in the client arena. It's set at 8192 + * with no particular justification. + */ + +#define ARENA_CONTROL_EXTENDBY ((Size)4096) +#define ARENA_CONTROL_AVGSIZE ((Size)32) +#define ARENA_CONTROL_MAXSIZE ((Size)65536) + +#define ArenaPollALLOCTIME (65536.0) + +#define ARENA_ZONESHIFT ((Shift)20) + +#define ARENA_CLIENT_PAGE_SIZE ((Size)8192) + +#define ArenaDefaultZONESET (ZoneSetUNIV << (MPS_WORD_WIDTH / 2)) +/* @@@@ knows the implementation of ZoneSets */ + +/* .segpref.default: For EPcore, non-DL segments should be placed high */ +/* to reduce fragmentation of DL pools (see request.epcore.170193). */ +#define SegPrefDEFAULT { \ + SegPrefSig, /* sig */ \ + TRUE, /* high */ \ + ArenaDefaultZONESET, /* zoneSet */ \ + FALSE, /* isCollected */ \ + FALSE, /* isGen */ \ + (Serial)0, /* gen */ \ +} + +#define LDHistoryLENGTH ((Size)4) + + +/* Stack configuration */ + +/* Currently StackProbe has a useful implementation only on + * Intel platforms and only when using Microsoft build tools (builder.mv) + */ +#if defined(MPS_ARCH_I3) && defined(MPS_BUILD_MV) +#define StackProbeDEPTH ((Size)500) +#else +#define StackProbeDEPTH ((Size)0) +#endif /* MPS_ARCH_I3 */ + + +/* Shield Configuration -- see impl.c.shield */ + +#define ShieldCacheSIZE ((size_t)16) +#define ShieldDepthWIDTH (4) + + +/* VM Configuration -- see impl.c.vm* */ + +#define VMANPageALIGNMENT ((Align)4096) +#define VMJunkBYTE ((unsigned char)0xA9) + + +/* Tracer Configuration -- see impl.c.trace */ + +#define TraceLIMIT ((size_t)1) +/* I count 4 function calls to scan, 10 to copy. */ +#define TraceCopyScanRATIO (1.5) + + + +/* Events + * + * EventBufferSIZE is the number of words in the global event buffer. + */ + +#define EventBufferSIZE ((size_t)4096) +#define EventStringLengthMAX ((size_t)255) /* Not including NUL */ + + +/* Assert Buffer */ + +#define ASSERT_BUFFER_SIZE ((Size)512) + + +/* memory operator configuration + * + * We need efficient operators similar to memcpy, memset, and memcmp. + * In general, we cannot use the C library mem functions directly as + * that would not be freestanding. However, on some platforms we can do + * this, because they are inlined by the compiler and so do not actually + * create a dependence on an external library. + */ + +#if defined(MPS_PF_W3I3MV) && defined(MPS_HOT) +/* MSVC on Intel inlines mem* when optimizing */ +#define mps_lib_memset memset +#define mps_lib_memcpy memcpy +#define mps_lib_memcmp memcmp +/* get prototypes for ANSI mem* */ +#include +#endif + + +/* Product Configuration + * + * Convert CONFIG_PROD_* defined on compiler command line into + * internal configuration parameters. See design.mps.config.prod. + */ + +#if defined(CONFIG_PROD_EPCORE) +#define MPS_PROD_STRING "epcore" +#define MPS_PROD_EPCORE +#define ARENA_INIT_SPARE_COMMIT_LIMIT ((Size)0) +/* .nosync.why: ScriptWorks is single-threaded when using the MM. */ +#define THREAD_SINGLE +#define PROTECTION_NONE +#define DONGLE_NONE + +#elif defined(CONFIG_PROD_DYLAN) +#define MPS_PROD_STRING "dylan" +#define MPS_PROD_DYLAN +/* .prod.arena-size: ARENA_SIZE is currently set larger for the + * MM/Dylan product as an interim solution. + * See request.dylan.170170.sol.patch and change.dylan.buffalo.170170. + */ +#define ARENA_SIZE ((Size)1<<30) +#define ARENA_INIT_SPARE_COMMIT_LIMIT ((Size)10uL*1024uL*1024uL) +#define THREAD_MULTI +#define PROTECTION +#define DONGLE_NONE + +#elif defined(CONFIG_PROD_CONFIGURA) +#define MPS_PROD_STRING "configura" +#define MPS_PROD_CONFIGURA +#define ARENA_INIT_SPARE_COMMIT_LIMIT ((Size)10uL*1024uL*1024uL) +#define THREAD_SINGLE +#define PROTECTION +#define DONGLE +/* global dongles have customerID 0 */ +#define DONGLE_CUSTOMER_ID ((int)1) + +#elif defined(CONFIG_PROD_MPS) +#define MPS_PROD_STRING "mps" +#define MPS_PROD_MPS +#define ARENA_INIT_SPARE_COMMIT_LIMIT ((Size)10uL*1024uL*1024uL) +#define THREAD_MULTI +#define PROTECTION +#define DONGLE_NONE + +#else +#error "No target product configured." +#endif + + +/* Dongle configuration */ + +#if defined(DONGLE) + +#define DONGLE_TEST_FREQUENCY ((unsigned int)4000) + +#elif defined(DONGLE_NONE) + +/* nothing to do */ + +#else +#error "No dongle configured." +#endif + + +#endif /* config_h */ diff --git a/mps/code/cx.gmk b/mps/code/cx.gmk new file mode 100644 index 00000000000..42ded6ab2ac --- /dev/null +++ b/mps/code/cx.gmk @@ -0,0 +1,30 @@ +# impl.gmk.sc: GNUMAKEFILE FRAGMENT FOR CXREF +# +# $HopeName: MMsrc!cx.gmk(trunk.3) $ +# +# This file is included by platform makefiles that generate a c +# cross-reference using the cxref tool. +# +# This file was created using the cxref tool supplied with the +# Sun Pro C compilation system on a Solaris 2.x system (lizard) +# (see pkginfo SPROcc). +# +# The options may be different for other vendors' cxref, then again +# it may be the same. + + +# We need a symbol for a non-empty definition with empty value +ifdef MPS_EMPTY +error "cx.gmk: MPS_EMPTY defined" +endif + +CC = cxref +# 3rd field width (arguments to -W option) must be one more than the +# maximum allowed identifer length, see +# guide.impl.c.naming.ident.length +CFLAGSCOMPILER = -d -R -W40,10,41,20 +CFLAGSDEBUG = $(MPS_EMPTY) +CFLAGSOPT = $(MPS_EMPTY) +CFLAGSOPTNODEBUG = $(MPS_EMPTY) + +include comm.gmk diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c new file mode 100644 index 00000000000..5d1b463a255 --- /dev/null +++ b/mps/code/dbgpool.c @@ -0,0 +1,494 @@ +/* impl.c.dbgpool: POOL DEBUG MIXIN + * + * $HopeName: MMsrc!dbgpool.c(trunk.13) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .source: design.mps.object-debug + */ + +#include "dbgpool.h" +#include "poolmfs.h" +#include "splay.h" +#include "mpslib.h" +#include "mpm.h" +#include "mps.h" +#include + +SRCID(dbgpool, "$HopeName$"); + + +/* tagStruct -- tags for storing info about allocated objects */ + +typedef struct tagStruct { + /* We don't want to pay the expense of a sig in every tag */ + Addr addr; + Size size; + SplayNodeStruct splayNode; + char userdata[1 /* actually variable length */]; +} tagStruct; + +#define SplayNode2Tag(node) PARENT(tagStruct, splayNode, (node)) + +typedef tagStruct *Tag; + + +/* tag init methods: copying the user-supplied data into the tag */ + +#define TagInitMethodCheck(f) \ + ((f) != NULL) /* that's the best we can do */ + +static void TagTrivInit(void* tag, va_list args) +{ + UNUSED(tag); UNUSED(args); +} + + +/* TagComp -- splay comparison function for address ordering of tags */ + +static Compare TagComp(void *key, SplayNode node) +{ + Addr addr1, addr2; + + addr1 = *(Addr *)key; + addr2 = SplayNode2Tag(node)->addr; + if (addr1 < addr2) + return CompareLESS; + else if (addr1 > addr2) { + /* Check key is not inside the object of this tag */ + AVER_CRITICAL(AddrAdd(addr2, SplayNode2Tag(node)->size) <= addr1); + return CompareGREATER; + } else + return CompareEQUAL; +} + + +/* PoolDebugMixinCheck -- check a PoolDebugMixin */ + +Bool PoolDebugMixinCheck(PoolDebugMixin debug) +{ + /* Nothing to check about fenceTemplate */ + /* Nothing to check about fenceSize */ + CHECKL(TagInitMethodCheck(debug->tagInit)); + /* Nothing to check about tagSize */ + CHECKD(Pool, debug->tagPool); + CHECKL(CHECKTYPE(Addr, void*)); /* tagPool relies on this */ + /* Nothing to check about missingTags */ + CHECKL(SplayTreeCheck(&debug->index)); + UNUSED(debug); /* see impl.c.mpm.check.unused */ + return TRUE; +} + + +/* DebugPoolDebugMixin -- gets the debug mixin, if any */ + +#define DebugPoolDebugMixin(pool) (((pool)->class->debugMixin)(pool)) + + +/* PoolNoDebugMixin -- debug mixin methods for pools with no mixin */ + +PoolDebugMixin PoolNoDebugMixin(Pool pool) +{ + AVERT(Pool, pool); + return NULL; +} + + +/* PoolDebugOptionsCheck -- check a PoolDebugOptions */ + +static Bool PoolDebugOptionsCheck(PoolDebugOptions opt) +{ + CHECKL(opt != NULL); + if (opt->fenceSize != 0) { + CHECKL(opt->fenceTemplate != NULL); + /* Nothing to check about fenceSize */ + } + return TRUE; +} + + +/* DebugPoolInit -- init method for a debug pool + * + * Someday, this could be split into fence and tag init methods. + */ + +static Res DebugPoolInit(Pool pool, va_list args) +{ + Res res; + PoolDebugOptions options; + PoolDebugMixin debug; + TagInitMethod tagInit; + Size tagSize; + + AVERT(Pool, pool); + options = va_arg(args, PoolDebugOptions); + AVERT(PoolDebugOptions, options); + /* @@@@ Tag parameters should be taken from options, but tags have */ + /* not been published yet. */ + tagInit = NULL; tagSize = 0; + + res = SuperclassOfPool(pool)->init(pool, args); + if (res != ResOK) + return res; + + debug = DebugPoolDebugMixin(pool); + AVER(debug != NULL); + + /* fencepost init */ + /* @@@@ This parses a user argument, options, so it should really */ + /* go through the MPS interface. The template needs to be copied */ + /* into Addr memory, to avoid breaking design.mps.type.addr.use. */ + debug->fenceSize = options->fenceSize; + if (debug->fenceSize != 0) { + if (debug->fenceSize % PoolAlignment(pool) != 0) { + res = ResPARAM; + goto alignFail; + } + /* Fenceposting turns on tagging */ + if (tagInit == NULL) { + tagSize = 0; + tagInit = TagTrivInit; + } + debug->fenceTemplate = options->fenceTemplate; + } + + /* tag init */ + debug->tagInit = tagInit; + if (debug->tagInit != NULL) { + debug->tagSize = tagSize + sizeof(tagStruct) - 1; + /* This pool has to be like the arena control pool: the blocks */ + /* allocated must be accessible using void*. */ + res = PoolCreate(&debug->tagPool, PoolArena(pool), PoolClassMFS(), + debug->tagSize, debug->tagSize); + if (res != ResOK) + goto tagFail; + debug->missingTags = 0; + SplayTreeInit(&debug->index, TagComp, NULL); + } + + debug->sig = PoolDebugMixinSig; + AVERT(PoolDebugMixin, debug); + return ResOK; + +tagFail: +alignFail: + SuperclassOfPool(pool)->finish(pool); + return res; +} + + +/* DebugPoolFinish -- finish method for a debug pool */ + +static void DebugPoolFinish(Pool pool) +{ + PoolDebugMixin debug; + + AVERT(Pool, pool); + + debug = DebugPoolDebugMixin(pool); + AVER(debug != NULL); + AVERT(PoolDebugMixin, debug); + if (debug->tagInit != NULL) { + SplayTreeFinish(&debug->index); + PoolDestroy(debug->tagPool); + } + SuperclassOfPool(pool)->finish(pool); +} + + +/* FenceAlloc -- allocation wrapper for fenceposts + * + * Allocates an object, adding fenceposts on both sides. Layout: + * + * |----------|-------------------------------------|------|----------| + * start fp client object slop end fp + * + * slop is the extra allocation from rounding up the client request to + * the pool's alignment. The fenceposting code does this, so there's a + * better chance of the end fencepost being flush with the next object + * (can't be guaranteed, since the underlying pool could have allocated + * an even larger block). The alignment slop is filled from the + * fencepost template as well (as much as fits, .fence.size guarantees + * the template is larger). + */ + +static Res FenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool, + Size size, Bool withReservoir) +{ + Res res; + Addr new, clientNew; + Size alignedSize; + + AVER(aReturn != NULL); + AVERT(PoolDebugMixin, debug); + AVERT(Pool, pool); + AVER(size > 0); + AVERT(Bool, withReservoir); + + alignedSize = SizeAlignUp(size, PoolAlignment(pool)); + res = SuperclassOfPool(pool)->alloc(&new, pool, + alignedSize + 2*debug->fenceSize, + withReservoir); + if (res != ResOK) + return res; + clientNew = AddrAdd(new, debug->fenceSize); + /* @@@@ shields? */ + /* start fencepost */ + AddrCopy(new, debug->fenceTemplate, debug->fenceSize); + /* alignment slop */ + AddrCopy(AddrAdd(clientNew, size), + debug->fenceTemplate, alignedSize - size); + /* end fencepost */ + AddrCopy(AddrAdd(clientNew, alignedSize), + debug->fenceTemplate, debug->fenceSize); + + *aReturn = clientNew; + return res; +} + + +/* FenceCheck -- check fences of an object */ + +static Bool FenceCheck(PoolDebugMixin debug, Pool pool, + Addr obj, Size size) +{ + Size alignedSize; + + AVERT_CRITICAL(PoolDebugMixin, debug); + AVERT_CRITICAL(Pool, pool); + /* Can't check obj */ + + alignedSize = SizeAlignUp(size, PoolAlignment(pool)); + /* Compare this to the memcpy's in FenceAlloc */ + return (AddrComp(AddrSub(obj, debug->fenceSize), debug->fenceTemplate, + debug->fenceSize) == 0 + && AddrComp(AddrAdd(obj, size), debug->fenceTemplate, + alignedSize - size) == 0 + && AddrComp(AddrAdd(obj, alignedSize), debug->fenceTemplate, + debug->fenceSize) == 0); +} + + +/* FenceFree -- freeing wrapper for fenceposts */ + +static void FenceFree(PoolDebugMixin debug, + Pool pool, Addr old, Size size) +{ + Size alignedSize; + + AVERT(PoolDebugMixin, debug); + AVERT(Pool, pool); + /* Can't check old */ + AVER(size > 0); + + ASSERT(FenceCheck(debug, pool, old, size), "fencepost check on free"); + + alignedSize = SizeAlignUp(size, PoolAlignment(pool)); + SuperclassOfPool(pool)->free(pool, AddrSub(old, debug->fenceSize), + alignedSize + 2*debug->fenceSize); +} + + +/* TagAlloc -- allocation wrapper for tagged pools */ + +static Res TagAlloc(PoolDebugMixin debug, + Pool pool, Addr new, Size size, Bool withReservoir) +{ + Tag tag; + Res res; + + AVERT(PoolDebugMixin, debug); + AVERT(Pool, pool); + AVER(size > 0); + + res = PoolAlloc((Addr*)&tag, debug->tagPool, debug->tagSize, FALSE); + if (res != ResOK) { + if (withReservoir) { /* design.mps.object-debug.out-of-space */ + debug->missingTags++; + return ResOK; + } else { + return res; + } + } + tag->addr = new; tag->size = size; + SplayNodeInit(&tag->splayNode); + /* In the future, we might call debug->tagInit here. */ + res = SplayTreeInsert(&debug->index, &tag->splayNode, (void *)&new); + AVER(res == ResOK); + return ResOK; +} + + +/* TagFree -- deallocation wrapper for tagged pools */ + +static void TagFree(PoolDebugMixin debug, Pool pool, Addr old, Size size) +{ + SplayNode node; + Tag tag; + Res res; + + AVERT(PoolDebugMixin, debug); + AVERT(Pool, pool); + AVER(size > 0); + + res = SplayTreeSearch(&node, &debug->index, (void *)&old); + if (res != ResOK) { + AVER(debug->missingTags > 0); + debug->missingTags--; + return; + } + tag = SplayNode2Tag(node); + AVER(tag->size == size); + res = SplayTreeDelete(&debug->index, node, (void *)&old); + AVER(res == ResOK); + SplayNodeFinish(node); + PoolFree(debug->tagPool, (Addr)tag, debug->tagSize); +} + + +/* DebugPoolAlloc -- alloc method for a debug pool + * + * Eventually, tag init args will need to be handled somewhere here. + */ + +static Res DebugPoolAlloc(Addr *aReturn, + Pool pool, Size size, Bool withReservoir) +{ + Res res; + Addr new; + PoolDebugMixin debug; + + AVER(aReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVERT(Bool, withReservoir); + + debug = DebugPoolDebugMixin(pool); + AVER(debug != NULL); + AVERT(PoolDebugMixin, debug); + res = FenceAlloc(&new, debug, pool, size, withReservoir); + if (res != ResOK) + return res; + /* Allocate object first, so it fits even when the tag doesn't. */ + res = TagAlloc(debug, pool, new, size, withReservoir); + if (res != ResOK) + goto tagFail; + + *aReturn = new; + return res; + +tagFail: + FenceFree(debug, pool, new, size); + return res; +} + + +/* DebugPoolFree -- free method for a debug pool */ + +static void DebugPoolFree(Pool pool, Addr old, Size size) +{ + PoolDebugMixin debug; + + AVERT(Pool, pool); + /* Can't check old */ + AVER(size > 0); + + debug = DebugPoolDebugMixin(pool); + AVER(debug != NULL); + AVERT(PoolDebugMixin, debug); + FenceFree(debug, pool, old, size); + /* Free the object first, to get fences checked before tag. */ + TagFree(debug, pool, old, size); +} + + +/* TagWalk -- walk all object in the pool using tags */ + +typedef void (*ObjectsStepMethod)(Addr addr, Size size, Format fmt, + Pool pool, void *tagData, void *p); + +#define ObjectsStepMethodCheck(f) \ + ((f) != NULL) /* that's the best we can do */ + +static void TagWalk(Pool pool, ObjectsStepMethod step, void *p) +{ + SplayNode node; + PoolDebugMixin debug; + Addr dummy = NULL; /* Breaks design.mps.type.addr.use, but it's */ + /* only temporary until SplayTreeFirst is fixed. */ + + AVERT(Pool, pool); + AVERT(ObjectsStepMethod, step); + /* Can't check p */ + + debug = DebugPoolDebugMixin(pool); + AVER(debug != NULL); + AVERT(PoolDebugMixin, debug); + + node = SplayTreeFirst(&debug->index, (void *)&dummy); + while (node != NULL) { + Tag tag = SplayNode2Tag(node); + + step(tag->addr, tag->size, NULL, pool, &tag->userdata, p); + node = SplayTreeNext(&debug->index, node, (void *)&tag->addr); + } +} + + +/* FenceCheckingStep -- step function for DebugPoolCheckFences */ + +static void FenceCheckingStep(Addr addr, Size size, Format fmt, + Pool pool, void *tagData, void *p) +{ + /* no need to check arguments checked in the caller */ + UNUSED(fmt); UNUSED(tagData); + ASSERT(FenceCheck((PoolDebugMixin)p, pool, addr, size), + "fencepost check requested by client"); +} + + +/* DebugPoolCheckFences -- check all the fenceposts in the pool */ + +static void DebugPoolCheckFences(Pool pool) +{ + PoolDebugMixin debug; + + AVERT(Pool, pool); + debug = DebugPoolDebugMixin(pool); + if (debug == NULL) + return; + AVERT(PoolDebugMixin, debug); + + TagWalk(pool, FenceCheckingStep, (void *)debug); +} + + +/* PoolClassMixInDebug -- mix in the debug support for class init */ + +void PoolClassMixInDebug(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->init = DebugPoolInit; + class->finish = DebugPoolFinish; + class->alloc = DebugPoolAlloc; + class->free = DebugPoolFree; +} + + +/* mps_pool_check_fenceposts -- check all the fenceposts in the pool */ + +void mps_pool_check_fenceposts(mps_pool_t mps_pool) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + + /* CHECKT not AVERT, see design.mps.interface.c.check.space */ + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + AVERT(Pool, pool); + DebugPoolCheckFences(pool); + + ArenaLeave(arena); +} diff --git a/mps/code/dbgpool.h b/mps/code/dbgpool.h new file mode 100644 index 00000000000..b3bfb1c488d --- /dev/null +++ b/mps/code/dbgpool.h @@ -0,0 +1,57 @@ +/* impl.h.dbgpool: POOL DEBUG MIXIN + * + * $HopeName: MMsrc!dbgpool.h(trunk.3) $ + * Copyright (C) 1998 Harlequin Group plc. All rights reserved. + */ + +#ifndef dbgpool_h +#define dbgpool_h + +#include "splay.h" +#include "mpmtypes.h" +#include + + +/* tag init methods: copying the user-supplied data into the tag */ + +typedef void (*TagInitMethod)(void* tag, va_list args); + + +/* PoolDebugOptions -- option structure for debug pool init + * + * This must be kept in sync with impl.h.mps.mps_pool_debug_option_s. + */ + +typedef struct PoolDebugOptionsStruct { + void* fenceTemplate; + Size fenceSize; + /* TagInitMethod tagInit; */ + /* Size tagSize; */ +} PoolDebugOptionsStruct; + +typedef PoolDebugOptionsStruct *PoolDebugOptions; + + +/* PoolDebugMixinStruct -- internal structure for debug mixins */ + +#define PoolDebugMixinSig ((Sig)0x519B0DB9) /* SIGnature POol DeBuG */ + +typedef struct PoolDebugMixinStruct { + Sig sig; + Addr fenceTemplate; + Size fenceSize; + TagInitMethod tagInit; + Size tagSize; + Pool tagPool; + Count missingTags; + SplayTreeStruct index; +} PoolDebugMixinStruct; + + +extern Bool PoolDebugMixinCheck(PoolDebugMixin dbg); + + +extern void PoolClassMixInDebug(PoolClass class); + + +#endif /* dbgpool_h */ diff --git a/mps/code/dc.gmk b/mps/code/dc.gmk new file mode 100644 index 00000000000..426f6d1b191 --- /dev/null +++ b/mps/code/dc.gmk @@ -0,0 +1,27 @@ +# impl.gmk.dc: GNUMAKEFILE FRAGMENT FOR DIGITAL C COMPILER (DEC UNIX/OSF) +# +# $HopeName: MMsrc!dc.gmk(trunk.2) $ +# Copyright(C) 1997, 1998 Harlequin Group, all rights reserved +# +# See design.buildsys.unix +# +# This file is included by platform makefiles that use the Digital C +# compiler. +# +# Options are derived from man cc on schiele +# +# There is a potentially useful option -check +# Unfortunately it produces warnings about non casting printf to void +# and bogus warnings about non-void functions not having a return statement +# as the last statement. We would need to cleam our code in order to use +# the option. + +CC = cc +CFLAGSCOMPILER = -std1 -w2 -warnprotos -portable -readonly_strings +CFLAGSDEBUG = -g2 +CFLAGSOPT = -O2 -g3 +CFLAGSOPTNODEBUG = -O2 + +# -M for a dependency file + +include comm.gmk diff --git a/mps/code/dumper.c b/mps/code/dumper.c new file mode 100644 index 00000000000..72b283c6108 --- /dev/null +++ b/mps/code/dumper.c @@ -0,0 +1,146 @@ +/* impl.c.dumper: Simple Event Dumper + * + * $HopeName: MMsrc!dumper.c(trunk.4) $ + * Copyright (C) 1997 Harlequin Group plc. All rights reserved. + * + * .readership: MM developers. + * + * .purpose: This is a simple tool to dump events as text. + * + * .trans: As a tool, it's allowed to depend on the ANSI C library. + */ + +#include +#include +#include +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif + +typedef unsigned long Word; +typedef struct AddrStruct *Addr; + +#include "eventcom.h" + + +#define RELATION(type, code, always, kind, format) \ + case Event ## type: \ + readEvent(#type, #format, header[0], header[1], header[2]); \ + break; + + +#define AVER(test) \ + if(test) do {} while(0); else error("AVER: " #test) + + +static char *prog; +static FILE *progin; + + +static void error (const char *format, ...) { + va_list args; + fprintf(stderr, "%s: Error: ", prog); + va_start(args, format); + vfprintf(stderr, format, args); + fputc('\n', stderr); + va_end(args); + exit(EXIT_FAILURE); + assert(0); +} + + +#define PROCESS(ch, type, _length, printfFormat, cast) \ + case ch: { \ + type v; \ + size_t n = fread(&v, (_length), 1, progin); \ + if(n < 1) \ + error("Can't read data for format code >%c<", ch); \ + printf(printfFormat " ", (cast)v); \ + length -= (_length) / sizeof(Word); \ + } break; + + +static void readEvent(char *type, char *format, Word code, Word length, + Word cpuTime) { + AVER(type != NULL); + AVER(format != NULL); + + printf("%-20s ", type); + + for(; *format != '\0'; format++) { + switch(*format) { + PROCESS('A', Addr, sizeof(Addr), "0x%08lX", unsigned long) + PROCESS('P', void *, sizeof(void *), "0x%08lX", unsigned long) + PROCESS('U', unsigned, sizeof(unsigned),"%u", unsigned) + PROCESS('W', Word, sizeof(Word),"%lu", Word) + PROCESS('D', double, sizeof(double), "%f", double) + case 'S': { + size_t n; + char *v; + AVER(length > 0); + v = malloc(length * sizeof(Word)); + if(v == NULL) + error("Can't allocate string space %u", (unsigned)length); + n = fread((void *)v, sizeof(Word), length, progin); + if(n < 1) + error("Can't read data for string"); + printf("%s ", v); + length = 0; + } break; + case '0': break; + default: + error("Unknown format >%c<", *format); + break; + } + } + putc('\n', stdout); + + AVER(length == 0); +} + + +int main(int argc, char *argv[]) { + Word header[3]; + size_t arg = 1; + + prog = (argc >= 1 ? argv[0] : "unknown"); + + /* parse options here [there aren't any] */ + + do { + if(argc <= 1) { + progin = stdin; + } else { + char *filename = argv[arg]; + assert(filename != NULL); + progin = fopen(filename, "rb"); + /* fopen returns NULL in error (ISO C 7.9.5.3) */ + if(progin == NULL) { + error("Failed to open \"%s\".\n", filename); + } + ++arg; + } + while(!feof(progin)) { + size_t n; + n = fread(header, sizeof(Word), 3, progin); + if(n < 3) { + if(feof(progin)) + continue; + error("Can't read from input"); + } + + switch(header[0]) { +#include "eventdef.h" + default: + error("Unknown event code %08lX", header[0]); + } + } + } while(arg < argc); + + return(0); +} + + diff --git a/mps/code/eg.gmk b/mps/code/eg.gmk new file mode 100644 index 00000000000..23d64ee8fc8 --- /dev/null +++ b/mps/code/eg.gmk @@ -0,0 +1,34 @@ +# impl.gmk.eg: GNUMAKEFILE FRAGMENT FOR EGCS +# +# $HopeName$ +# Copyright (C) 1996, 1997, 1998 Harlequin Group, all rights reserved +# +# This file is included by platform makefiles that use the EGCS +# compiler. It defines the compiler specific variables that the +# common makefile fragment (impl.gmk.comm) requires. +# +# It was made by copying gc.gmk on 1998-03-23 + + +CC = egcs +CFLAGSCOMPILER = \ + -ansi -pedantic -Wall -Werror -Wpointer-arith \ + -Wstrict-prototypes -Wmissing-prototypes \ + -Winline -Waggregate-return -Wnested-externs \ + -Wcast-qual -Wshadow +CFLAGSDEBUG = -g -ggdb3 +CFLAGSOPT = -O -g -ggdb3 +CFLAGSOPTNODEBUG = -O -g0 + +# gcc -MM generates a dependency line of the form: +# thing.o : thing.c ... +# The sed line converts this into: +# //thing.o //thing.d : thing.c ... +# @@ This sequence is vulnerable to interrupts (for some reason) + +define gendep + $(SHELL) -ec "gcc -c $(CFLAGS) -MM $< | \ + sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@" +endef + +include comm.gmk diff --git a/mps/code/event.c b/mps/code/event.c new file mode 100644 index 00000000000..e5527c3f8f1 --- /dev/null +++ b/mps/code/event.c @@ -0,0 +1,231 @@ +/* impl.c.event: EVENT LOGGING + * + * $HopeName: MMsrc!event.c(trunk.13) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .sources: mps.design.event + * + * TRANSGRESSIONS (rule.impl.trans) + * + * .trans.ref: The reference counting used to destroy the mps_io object + * isn't right. + * + * .trans.log: The log file will be re-created if the lifetimes of + * arenas don't overlap, but shared if they do. mps_io_create cannot + * be called twice, but EventInit avoids this anyway. + * + * .trans.ifdef: This file should logically be split into two, event.c + * (which contains NOOP definitions, for general use) and eventdl.c, which + * is specific to the logging variety and actually does logging (maybe). + * Unfortunately, the build system doesn't really cope, and so this file + * consists of two versions which are conditional on the EVENT symbol. + */ + +#include "mpm.h" +#include "event.h" +#include "mpsio.h" + +SRCID(event, "$HopeName: MMsrc!event.c(trunk.13) $"); + + +#ifdef EVENT /* .trans.ifdef */ + + +static Bool eventInited = FALSE; +static mps_io_t eventIO; +static char eventBuffer[EventBufferSIZE]; +static Count eventUserCount; +static Serial EventInternSerial; + +EventUnion EventMould; /* Used by macros in impl.h.event */ +char *EventNext, *EventLimit; /* Used by macros in impl.h.event */ +Word EventKindControl; /* Bit set used to control output. */ + + +/* EventFlush -- flush event buffer to the event stream */ + +Res EventFlush(void) +{ + Res res; + + AVER(eventInited); + + res = (Res)mps_io_write(eventIO, (void *)eventBuffer, + EventNext - eventBuffer); + EventNext = eventBuffer; + if (res != ResOK) return res; + + return ResOK; +} + + +/* EventSync -- synchronize the event stream with the buffers */ + +Res EventSync(void) +{ + Res resEv, resIO; + + resEv = EventFlush(); + resIO = mps_io_flush(eventIO); + return (resEv != ResOK) ? resEv : resIO; +} + + +/* EventInit -- start using the event system, initialize if necessary */ + +Res EventInit(void) +{ + Res res; + + /* Only if this is the first call. */ + if(!eventInited) { /* See .trans.log */ + AVER(EventNext == 0); + AVER(EventLimit == 0); + res = (Res)mps_io_create(&eventIO); + if(res != ResOK) return res; + EventNext = eventBuffer; + EventLimit = &eventBuffer[EventBufferSIZE]; + eventUserCount = (Count)1; + eventInited = TRUE; + EventKindControl = (Word)mps_lib_telemetry_control(); + EventInternSerial = (Serial)1; /* 0 is reserved */ + (void)EventInternString(MPSVersion()); /* emit version */ + } else { + ++eventUserCount; + } + + return ResOK; +} + + +/* EventFinish -- stop using the event system */ + +void EventFinish(void) +{ + AVER(eventInited); + AVER(eventUserCount > 0); + + (void)EventSync(); + + --eventUserCount; +} + + +/* EventControl -- Change or read control word + * + * Resets the bits specified in resetMask, and flips those in + * flipMask. Returns old value. + * + * Operations can be implemented as follows: + * Set(M) EventControl(M,M) + * Reset(M) EventControl(M,0) + * Flip(M) EventControl(0,M) + * Read() EventControl(0,0) + */ + +Word EventControl(Word resetMask, Word flipMask) +{ + Word oldValue = EventKindControl; + + /* EventKindControl = (EventKindControl & ~resetMask) ^ flipMask */ + EventKindControl = + BS_SYM_DIFF(BS_DIFF(EventKindControl, resetMask), flipMask); + + return oldValue; +} + + +/* EventInternString -- emit an Intern event on the (null-term) string given */ + +Word EventInternString(const char *label) +{ + Word id; + + AVER(label != NULL); + + id = (Word)EventInternSerial; + ++EventInternSerial; + EVENT_WS(Intern, id, StringLength(label), label); + return id; +} + + +/* EventInternGenString -- emit an Intern event on the string given */ + +Word EventInternGenString(size_t len, const char *label) +{ + Word id; + + AVER(label != NULL); + + id = (Word)EventInternSerial; + ++EventInternSerial; + EVENT_WS(Intern, id, len, label); + return id; +} + + +/* EventLabelAddr -- emit event to label address with the given id */ + +void EventLabelAddr(Addr addr, Word id) +{ + AVER((Serial)id < EventInternSerial); + + EVENT_AW(Label, addr, id); +} + + +#else /* EVENT, not */ + + +Res (EventSync)(void) +{ + return(ResOK); +} + + +Res (EventInit)(void) +{ + return(ResOK); +} + + +void (EventFinish)(void) +{ + NOOP; +} + + +Word (EventControl)(Word resetMask, Word flipMask) +{ + UNUSED(resetMask); + UNUSED(flipMask); + + return (Word)0; +} + + +Word (EventInternString)(const char *label) +{ + UNUSED(label); + + return (Word)0; +} + + +Word (EventInternGenString)(size_t len, const char *label) +{ + UNUSED(len); UNUSED(label); + + return (Word)0; +} + + +void (EventLabelAddr)(Addr addr, Word id) +{ + UNUSED(addr); + UNUSED(id); +} + + +#endif /* EVENT */ diff --git a/mps/code/event.h b/mps/code/event.h new file mode 100644 index 00000000000..21ed2db9a96 --- /dev/null +++ b/mps/code/event.h @@ -0,0 +1,115 @@ +/* impl.h.event -- Event Logging Interface + * + * Copyright (C) 1997. Harlequin Group plc. All rights reserved. + * $HopeName: MMsrc!event.h(trunk.14) $ + * + * READERSHIP + * + * .readership: MPS developers. + * + * DESIGN + * + * .design: design.mps.telemetry. + */ + +#ifndef event_h +#define event_h + +#include "eventcom.h" +#include "mpm.h" + + +extern Res EventSync(void); +extern Res EventInit(void); +extern void EventFinish(void); +extern Word EventControl(Word, Word); +extern Word EventInternString(const char *); +extern Word EventInternGenString(size_t, const char *); +extern void EventLabelAddr(Addr, Word); + + +#ifdef EVENT + + +extern Res EventFlush(void); + + +/* Event Kinds --- see design.mps.telemetry + * + * All events are classified as being of one event type. + * They are small enough to be able to be used as shifts within a word. + */ + +#define EventKindArena ((EventKind)0) /* Per space or arena */ +#define EventKindPool ((EventKind)1) /* Per pool */ +#define EventKindTrace ((EventKind)2) /* Per trace or scan */ +#define EventKindSeg ((EventKind)3) /* Per seg */ +#define EventKindRef ((EventKind)4) /* Per ref or fix */ +#define EventKindObject ((EventKind)5) /* Per alloc or object */ +#define EventKindUser ((EventKind)6) /* User-invoked */ + +#define EventKindNumber ((Count)7) /* Number of event kinds */ + + +/* Event type definitions + * + * Define various constants for each event type to describe them. + */ + +/* Note that enum values can be up to fifteen bits long portably. */ +#define RELATION(type, code, always, kind, format) \ + enum { \ + Event##type##High = ((code >> 8) & 0xFF), \ + Event##type##Low = (code & 0xFF), \ + Event##type##Always = always, \ + Event##type##Kind = EventKind##kind, \ + Event##type##Format = EventFormat##format \ + }; + +#include "eventdef.h" + +#undef RELATION + + +/* Event writing support */ + +extern EventUnion EventMould; +extern char *EventNext, *EventLimit; +extern Word EventKindControl; + +#define EVENT_BEGIN(type) \ + BEGIN \ + if(BS_IS_MEMBER(EventKindControl, ((Index)Event##type##Kind))) { \ + size_t _length; + +#define EVENT_END(type, format, length) \ + AVER(EventFormat##format == Event##type##Format); \ + /* @@@@ As an interim measure, send the old event codes */ \ + EventMould.any.code = Event##type; \ + EventMould.any.clock = mps_clock(); \ + AVER(EventNext <= EventLimit); \ + _length = size_tAlignUp(length, sizeof(Word)); \ + if(_length > (size_t)(EventLimit - EventNext)) \ + EventFlush(); /* @@@@ should pass length */ \ + AVER(_length <= (size_t)(EventLimit - EventNext)); \ + mps_lib_memcpy(EventNext, &EventMould, _length); \ + EventNext += _length; \ + } \ + END + + +#else /* EVENT not */ + + +#define EventInit() NOOP +#define EventFinish() NOOP +#define EventControl(r, f) (UNUSED(r), UNUSED(f), (Word)0) +#define EventInternString(s) (UNUSED(s), (Word)0) +#define EventInternGenString(l, s) (UNUSED(l), UNUSED(s), (Word)0) +#define EventLabelAddr(a, i) BEGIN UNUSED(a); UNUSED(i); END + + +#endif /* EVENT */ + + +#endif /* event_h */ diff --git a/mps/code/eventcnv.c b/mps/code/eventcnv.c new file mode 100644 index 00000000000..5d13c00de63 --- /dev/null +++ b/mps/code/eventcnv.c @@ -0,0 +1,618 @@ +/* impl.c.eventcnv: Simple event log converter + * Copyright (C) 1999 Harlequin Group plc. All rights reserved. + * + * $HopeName: MMsrc!eventcnv.c(trunk.3) $ + */ + +#include "config.h" +/* override variety setting for EVENT */ +#define EVENT + +#include "eventcom.h" +#include "eventpro.h" +#include "mpmtypes.h" + +#include /* for size_t */ +#include /* for printf */ +#include /* for va_list */ +#include /* for EXIT_FAILURE */ +#include /* for assert */ +#include /* for strcmp */ +#include /* for sqrt */ +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif + + +typedef unsigned int uint; +typedef unsigned long ulong; + + +static Word eventTime; /* current event time */ + + +/* event counters */ + +typedef unsigned long eventCountArray[EventCodeMAX+1]; +static unsigned long bucketEventCount[EventCodeMAX+1]; +static unsigned long totalEventCount[EventCodeMAX+1]; + + +static char *prog; /* program name */ + + +/* command-line arguments */ + +static Bool verbose = FALSE; +/* style: '\0' for human-readable, 'L' for Lisp, 'C' for CDF. */ +static char style = '\0'; +static Bool reportEvents = FALSE; +static Bool eventEnabled[EventCodeMAX+1]; +static Bool partialLog = FALSE; +static Word bucketSize = 0; + + +/* error -- error signalling */ + +static void error(const char *format, ...) +{ + va_list args; + + fflush(stdout); /* sync */ + fprintf(stderr, "%s: @%lu ", prog, (ulong)eventTime); + va_start(args, format); + vfprintf(stderr, format, args); + fprintf(stderr, "\n"); + va_end(args); + exit(EXIT_FAILURE); +} + + +/* usage -- usage message */ + +static void usage(void) +{ + fprintf(stderr, + "Usage: %s [-f logfile] [-p] [-v] [-e events] [-b size]" + " [-S[LC]] [-?]\nSee guide.mps.telemetry for instructions.", + prog); +} + + +/* usageError -- explain usage and error */ + +static void usageError(void) +{ + usage(); + error("Bad usage"); +} + + +/* parseEventSpec -- parses an event spec + * + * The spec is of the form: [(+|-)]... + * The first name can be 'all'. + */ + +static void parseEventSpec(const char *arg) +{ + size_t arglen; + EventCode i; + const char *end; + char name[EventNameMAX+1]; + Bool enabled = TRUE; + + end = arg + strlen(arg); + for(i = 0; i <= EventCodeMAX; ++i) + eventEnabled[i] = FALSE; + do { + arglen = strcspn(arg, "+-"); + strncpy(name, arg, arglen); name[arglen] = '\0'; + if (strcmp(name, "all") == 0) { + for(i = 0; i <= EventCodeMAX; ++i) + eventEnabled[i] = EventCodeIsValid(i); + } else + eventEnabled[EventName2Code(name)] = enabled; + enabled = (arg[arglen] == '+'); arg += arglen + 1; + } while (arg < end); +} + + +/* parseArgs -- parse command line arguments, return log file name */ + +static char *parseArgs(int argc, char *argv[]) +{ + char *name = "mpsio.log"; + int i = 1; + + if (argc >= 1) + prog = argv[0]; + else + prog = "unknown"; + + while (i < argc) { /* consider argument i */ + if (argv[i][0] == '-') { /* it's an option argument */ + switch (argv[i][1]) { + case 'f': /* file name */ + ++ i; + if (i == argc) + usageError(); + else + name = argv[i]; + break; + case 'p': /* partial log */ + partialLog = TRUE; + break; + case 'v': /* verbosity */ + verbose = TRUE; + break; + case 'e': { /* event statistics */ + reportEvents = TRUE; + ++ i; + if (i == argc) + usageError(); + else + parseEventSpec(argv[i]); + } break; + case 'b': { /* bucket size */ + ++ i; + if (i == argc) + usageError(); + else { + int n; + + n = sscanf(argv[i], "%lu", &bucketSize); + if (n != 1) usageError(); + } + } break; + case 'S': /* style */ + style = argv[i][2]; /* '\0' for human-readable, 'L' for Lisp, */ + break; /* 'C' for CDF. */ + case '?': case 'h': /* help */ + usage(); + break; + default: + usageError(); + } + } /* if option */ + ++ i; + } + return name; +} + + +/* processEvent -- process event */ + +static void processEvent(EventProc proc, Event event, Word etime) +{ + Res res; + + res = EventRecord(proc, event, etime); + if (res != ResOK) + error("Can't record event: error %d.", res); + switch(event->any.code) { + default: + break; + } +} + + +/* Printing routines */ + + +/* printStr -- print an EventString */ + +static void printStr(EventString str, Bool quotes) +{ + size_t i, len; + + if (quotes) putchar('"'); + len = str->len; + for (i = 0; i < len; ++ i) { + char c = str->str[i]; + if (quotes && (c == '"' || c == '\\')) putchar('\\'); + putchar(c); + } + if (quotes) putchar('"'); +} + + +/* printAddr -- print an Addr or its label */ + +static void printAddr(EventProc proc, Addr addr) +{ + Word label; + + label = AddrLabel(proc, addr); + if (label != 0 && addr != 0) { + /* We assume labelling zero is meant to record a point in time */ + EventString sym = LabelText(proc, label); + if (sym != NULL) { + putchar(' '); + printStr(sym, (style == 'C')); + } else { + printf((style == '\0') ? " sym%05lX" : " \"sym %lX\"", + (ulong)label); + } + } else + printf((style != 'C') ? " %08lX" : " %lu", (ulong)addr); +} + + +/* reportEventResults -- report event counts from a count array */ + +static void reportEventResults(eventCountArray eventCounts) +{ + EventCode i; + unsigned long total = 0; + + for(i = 0; i <= EventCodeMAX; ++i) { + total += eventCounts[i]; + if (eventEnabled[i]) + switch (style) { + case '\0': + printf(" %5lu", eventCounts[i]); + break; + case 'L': + printf(" %lX", eventCounts[i]); + break; + case 'C': + printf(", %lu", eventCounts[i]); + break; + } + } + switch (style) { + case '\0': + printf(" %5lu\n", total); + break; + case 'L': + printf(" %lX)\n", total); + break; + case 'C': + printf(", %lu\n", total); + break; + } +} + + +/* reportBucketResults -- report results of the current bucket */ + +static void reportBucketResults(Word bucketLimit) +{ + switch (style) { + case '\0': + printf("%8lu:", (ulong)bucketLimit); + break; + case 'L': + printf("(%lX", (ulong)bucketLimit); + break; + case 'C': + printf("%lu", (ulong)bucketLimit); + break; + } + if (reportEvents) { + reportEventResults(bucketEventCount); + } +} + + +/* clearBucket -- clear bucket */ + +static void clearBucket(void) +{ + EventCode i; + + for(i = 0; i <= EventCodeMAX; ++i) + bucketEventCount[i] = 0; +} + + +/* readLog -- read and parse log + * + * This is the heart of eventcnv: It reads an event log using EventRead. + * It updates the counters. If verbose is true, it looks up the format, + * parses the arguments, and prints a representation of the event. Each + * argument is printed using printArg (see RELATION, below), except for + * some event types that are handled specially. + */ + +static void printArg(EventProc proc, + void *arg, char argType, char *styleConv) +{ + switch (argType) { + case 'A': { + if (style != 'L') { + if (style == 'C') putchar(','); + printAddr(proc, *(Addr *)arg); + } else + printf(styleConv, (ulong)*(Addr *)arg); + } break; + case 'P': { + printf(styleConv, (ulong)*(void **)arg); + } break; + case 'U': { + printf(styleConv, (ulong)*(unsigned *)arg); + } break; + case 'W': { + printf(styleConv, (ulong)*(Word *)arg); + } break; + case 'D': { + switch (style) { + case '\0': + printf(" %#8.3g", *(double *)arg); break; + case 'C': + printf(", %.10G", *(double *)arg); break; + case 'L': + printf(" %#.10G", *(double *)arg); break; + } + } break; + case 'S': { + if (style == 'C') putchar(','); + putchar(' '); + printStr((EventStringStruct *)arg, (style == 'C' || style == 'L')); + } break; + default: error("Can't print format >%c<", argType); + } +} + + +#define RELATION(name, code, always, kind, format) \ + case code: { \ + printArg(proc, EVENT_##format##_FIELD_PTR(event, i), \ + eventFormat[i], styleConv); \ + } break; + + +static void readLog(EventProc proc) +{ + EventCode c; + Word bucketLimit = bucketSize; + char *styleConv = NULL; /* suppress uninit warning */ + + /* Print event count header. */ + if (reportEvents) { + if (style == '\0') { + printf(" bucket:"); + for(c = 0; c <= EventCodeMAX; ++c) + if (eventEnabled[c]) + printf(" %04X", (unsigned)c); + printf(" all\n"); + } + } + + /* Init event counts. */ + for(c = 0; c <= EventCodeMAX; ++c) + totalEventCount[c] = 0; + clearBucket(); + + /* Init style. */ + switch (style) { + case '\0': + styleConv = " %8lX"; break; + case 'C': + styleConv = ", %lu"; break; + case 'L': + styleConv = " %lX"; break; + default: + error("Unknown style code '%c'", style); + } + + while (TRUE) { /* loop for each event */ + char *eventFormat; + int argCount, i; + Event event; + EventCode code; + Res res; + + /* Read and parse event. */ + res = EventRead(&event, proc); + if (res == ResFAIL) break; /* eof */ + if (res != ResOK) error("Truncated log"); + eventTime = event->any.clock; + code = EventGetCode(event); + + /* Output bucket, if necessary, and update counters */ + if (bucketSize != 0 && eventTime >= bucketLimit) { + reportBucketResults(bucketLimit-1); + clearBucket(); + do { + bucketLimit += bucketSize; + } while (eventTime >= bucketLimit); + } + if (reportEvents) { + ++bucketEventCount[code]; + ++totalEventCount[code]; + } + + /* Output event. */ + if (verbose) { + eventFormat = EventCode2Format(code); + argCount = strlen(eventFormat); + if (eventFormat[0] == '0') argCount = 0; + + if (style == 'L') putchar('('); + + switch (style) { + case '\0': case 'L': { + printf("%-19s", EventCode2Name(code)); + } break; + case 'C': + printf("%u", (unsigned)code); + break; + } + + switch (style) { + case '\0': + printf(" %8lu", (ulong)eventTime); break; + case 'C': + printf(", %lu", (ulong)eventTime); break; + case 'L': + printf(" %lX", (ulong)eventTime); break; + } + + switch (event->any.code) { + case EventLabel: { + switch (style) { + case '\0': case 'C': { + EventString sym = LabelText(proc, event->aw.w1); + printf((style == '\0') ? " %08lX " : ", %lu, ", + (ulong)event->aw.a0); + if (sym != NULL) { + printStr(sym, (style == 'C')); + } else { + printf((style == '\0') ? "sym %05lX" : "sym %lX\"", + (ulong)event->aw.w1); + } + } break; + case 'L': { + printf(" %lX %lX", (ulong)event->aw.a0, (ulong)event->aw.w1); + } break; + } + } break; + case EventMeterValues: { + switch (style) { + case '\0': { + if (event->pddwww.w3 == 0) { + printf(" %08lX 0 N/A N/A N/A N/A", + (ulong)event->pddwww.p0); + } else { + double mean = event->pddwww.d1 / (double)event->pddwww.w3; + /* .stddev: stddev = sqrt(meanSquared - mean^2), but see */ + /* impl.c.meter.limitation.variance. */ + double stddev = sqrt(fabs(event->pddwww.d2 + - (mean * mean))); + printf(" %08lX %8u %8u %8u %#8.3g %#8.3g", + (ulong)event->pddwww.p0, (uint)event->pddwww.w3, + (uint)event->pddwww.w4, (uint)event->pddwww.w5, + mean, stddev); + } + printAddr(proc, (Addr)event->pddwww.p0); + } break; + case 'C': { + putchar(','); + printAddr(proc, (Addr)event->pddwww.p0); + printf(", %.10G, %.10G, %u, %u, %u", + event->pddwww.d1, event->pddwww.d2, + (uint)event->pddwww.w3, (uint)event->pddwww.w4, + (uint)event->pddwww.w5); + } break; + case 'L': { + printf(" %lX %#.10G %#.10G %X %X %X", (ulong)event->pddwww.p0, + event->pddwww.d1, event->pddwww.d2, + (uint)event->pddwww.w3, (uint)event->pddwww.w4, + (uint)event->pddwww.w5); + } break; + } + } break; + case EventPoolInit: { /* pool, arena, class */ + printf(styleConv, (ulong)event->ppp.p0); + printf(styleConv, (ulong)event->ppp.p1); + /* class is a Pointer, but we label them, so call printAddr */ + if (style != 'L') { + if (style == 'C') putchar(','); + printAddr(proc, (Addr)event->ppp.p2); + } else + printf(styleConv, (ulong)event->ppp.p2); + } break; + default: + for (i = 0; i < argCount; ++i) { + switch(code) { +#include "eventdef.h" +#undef RELATION + } + } + } + + if (style == 'L') putchar(')'); + putchar('\n'); + fflush(stdout); + } + processEvent(proc, event, eventTime); + EventDestroy(proc, event); + } /* while(!feof(input)) */ + + /* report last bucket (partial) */ + if (bucketSize != 0) { + reportBucketResults(eventTime); + } + if (reportEvents) { + /* report totals */ + switch (style) { + case '\0': { + printf("\n run:"); + } break; + case 'L': { + printf("(t"); + } break; + case 'C': { + printf("%lu", eventTime+1); + } break; + } + reportEventResults(totalEventCount); + + /* explain event codes */ + if (style == '\0') { + printf("\n"); + for(c = 0; c <= EventCodeMAX; ++c) + if (eventEnabled[c]) + printf(" %04X %s\n", (unsigned)c, EventCode2Name(c)); + if (bucketSize == 0) + printf("\nevent clock stopped at %lu\n", (ulong)eventTime); + } + } +} + + +/* logReader -- reader function for a file log */ + +static FILE *input; + +static Res logReader(void *file, void *p, size_t len) +{ + size_t n; + + n = fread(p, 1, len, (FILE *)file); + return (n < len) ? (feof((FILE *)file) ? ResFAIL : ResIO) : ResOK; +} + + +/* CHECKCONV -- check t2 can be cast to t1 without loss */ + +#define CHECKCONV(t1, t2) \ + (sizeof(t1) >= sizeof(t2)) + + +/* main */ + +int main(int argc, char *argv[]) +{ + char *filename; + EventProc proc; + Res res; + + assert(CHECKCONV(ulong, Word)); + assert(CHECKCONV(ulong, Addr)); + assert(CHECKCONV(ulong, void *)); + assert(CHECKCONV(unsigned, EventCode)); + assert(CHECKCONV(Addr, void *)); /* for labelled pointers */ + + filename = parseArgs(argc, argv); + + if (strcmp(filename, "-") == 0) + input = stdin; + else { + input = fopen(filename, "rb"); + if (input == NULL) + error("unable to open \"%s\"\n", filename); + } + + res = EventProcCreate(&proc, partialLog, logReader, (void *)input); + if (res != ResOK) + error("Can't init EventProc module: error %d.", res); + + readLog(proc); + + EventProcDestroy(proc); + return EXIT_SUCCESS; +} diff --git a/mps/code/eventcom.h b/mps/code/eventcom.h new file mode 100644 index 00000000000..044473c1041 --- /dev/null +++ b/mps/code/eventcom.h @@ -0,0 +1,150 @@ +/* impl.h.eventcom -- Event Logging Common Definitions + * + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * $HopeName: MMsrc!eventcom.h(trunk.20) $ + * + * .sources: mps.design.telemetry + */ + +#ifndef eventcom_h +#define eventcom_h + +/* #include "eventgen.h" later in the file */ +#include "mpmtypes.h" /* for Word */ + + +/* Types for event fields */ + + +typedef Word EventType; +typedef size_t EventCode; +typedef Index EventKind; + +typedef Byte EventStringLen; + +typedef struct { + EventStringLen len; + char str[EventStringLengthMAX]; +} EventStringStruct; + +typedef EventStringStruct *EventString; + + +#define EventNameMAX ((size_t)19) +#define EventCodeMAX ((EventCode)0x0069) + + +/* eventgen.h is just the automatically generated part of this file */ +#include "eventgen.h" + + +#ifdef EVENT + +typedef EventUnion *Event; + +#endif + + +/* Event types -- see design.mps.telemetry + * + * These names are intended to be mnemonic. They are derived from + * selected letters as indicated, using the transliteration in + * guide.hex.trans. + * + * These definitions will be unnecessary when the event codes are + * changed to 16-bit. See impl.h.eventdef. + */ + /* EVent ... */ +#define EventEventTime ((EventType)0xEF213E99) /* TIME */ +#define EventPoolInit ((EventType)0xEFB07141) /* POoL INIt */ +#define EventPoolFinish ((EventType)0xEFB07F14) /* POoL FINish */ +#define EventPoolAlloc ((EventType)0xEFB07A77) /* POoL ALLoc */ +#define EventPoolFree ((EventType)0xEFB07F6E) /* POoL FREe */ +#define EventArenaCreateVM ((EventType)0xEFA64CF3) /* AReNa Create VM */ +#define EventArenaCreateVMNZ ((EventType)0xEFA64CF2) /* AReNa Create VmnZ */ +#define EventArenaCreateCL ((EventType)0xEFA64CC7) /* AReNa Create CL */ +#define EventArenaDestroy ((EventType)0xEFA64DE5) /* AReNa DEStroy */ +#define EventArenaAlloc ((EventType)0xEFA64A77) /* AReNa ALLoc */ +#define EventArenaFree ((EventType)0xEFA64F6E) /* AReNa FREe */ +#define EventSegAlloc ((EventType)0xEF5E9A77) /* SEG ALLoc */ +#define EventSegFree ((EventType)0xEF5E9F6E) /* SEG FREe */ +#define EventSegMerge ((EventType)0xEF5E93E6) /* SEG MERge */ +#define EventSegSplit ((EventType)0xEF5E95B7) /* SEG SPLit */ +#define EventAMCGenCreate ((EventType)0xEFA3C94C) /* AMC GeN Create */ +#define EventAMCGenDestroy ((EventType)0xEFA3C94D) /* AMC GeN Destroy */ +#define EventAMCInit ((EventType)0xEFA3C141) /* AMC INIt */ +#define EventAMCFinish ((EventType)0xEFA3CF14) /* AMC FINish */ +#define EventAMCTraceBegin ((EventType)0xEFA3C26B) /* AMC TRace Begin */ +#define EventAMCScanBegin ((EventType)0xEFA3C5CB) /* AMC SCan Begin */ +#define EventAMCScanEnd ((EventType)0xEFA3C5CE) /* AMC SCan End */ +#define EventAMCFix ((EventType)0xEFA3CF18) /* AMC FIX */ +#define EventAMCFixInPlace ((EventType)0xEFA3CF8A) /* AMC FiX Ambig */ +#define EventAMCFixForward ((EventType)0xEFA3CF8F) /* AMC FiX Forward */ +#define EventAMCReclaim ((EventType)0xEFA3C6EC) /* AMC REClaim */ +#define EventTraceStart ((EventType)0xEF26AC52) /* TRACe STart */ +#define EventTraceCreate ((EventType)0xEF26ACC6) /* TRACe CReate */ +#define EventTraceDestroy ((EventType)0xEF26ACDE) /* TRACe DEstroy */ +#define EventSegSetGrey ((EventType)0xEF59596A) /* SeG Set GRAy */ +#define EventTraceFlipBegin ((EventType)0xEF26AF7B) /* TRAce FLip Begin */ +#define EventTraceFlipEnd ((EventType)0xEF26AF7E) /* TRAce FLip End */ +#define EventTraceReclaim ((EventType)0xEF26A6EC) /* TRAce REClaim */ +#define EventTraceScanSeg ((EventType)0xEF26A559) /* TRAce ScanSeG */ +#define EventTraceScanSingleRef \ + ((EventType)0xEF26A556) /* TRAce ScanSingleRef */ +#define EventTraceAccess ((EventType)0xEF26AACC) /* TRAce ACCess */ +#define EventTracePoll ((EventType)0xEF26AB01) /* TRAce POLl */ +#define EventTraceStep ((EventType)0xEF26A52B) /* TRAce STeP */ +#define EventTraceFix ((EventType)0xEF26AF18) /* TRAce FIX */ +#define EventTraceFixSeg ((EventType)0xEF26AF85) /* TRAce FiX Seg */ +#define EventTraceFixWhite ((EventType)0xEF26AF83) /* TRAce FiX White */ +#define EventTraceScanArea ((EventType)0xEF26A5CA) /* TRAce SCan Area */ +#define EventTraceScanAreaTagged ((EventType)0xEF26A5C2) /* TRAce SCan area Tagged */ +#define EventVMCreate ((EventType)0xEFF3C6EA) /* VM CREAte */ +#define EventVMDestroy ((EventType)0xEFF3DE52) /* VM DESTroy */ +#define EventVMMap ((EventType)0xEFF33AB9) /* VM MAP */ +#define EventVMUnmap ((EventType)0xEFF3043B) /* VM UNMaP */ +#define EventIntern ((EventType)0xEF142E64) /* INTERN */ +#define EventArenaExtend ((EventType)0xEFA64E82) /* AReNa EXTend */ +#define EventArenaRetract ((EventType)0xEFA646E2) /* AReNa RETract */ +#define EventRootScan ((EventType)0xEF625CA4) /* RooT SCAN */ +#define EventLabel ((EventType)0xEF7ABE79) /* LABEL */ +#define EventTraceSegGreyen ((EventType)0xEF26A599) /* TRAce SeG Greyen */ +#define EventBufferReserve ((EventType)0xEFB0FF6E) /* BUFFer REserve */ +#define EventBufferCommit ((EventType)0xEFB0FFC0) /* BUFFer COmmit */ +#define EventBufferInit ((EventType)0xEFB0FF14) /* BUFFer INit */ +#define EventBufferInitSeg ((EventType)0xEFB0F15E) /* BUFFer Init SEg */ +#define EventBufferInitRank ((EventType)0xEFB0F16A) /* BUFFer Init RAnk */ +#define EventBufferInitEPVM ((EventType)0xEFB0F1EF) /* BUFfer Init EpVm */ +#define EventBufferFinish ((EventType)0xEFB0FFF1) /* BUFFer FInish */ +#define EventBufferFill ((EventType)0xEFB0FFF7) /* BUFFer FilL */ +#define EventBufferEmpty ((EventType)0xEFB0FFE3) /* BUFFer EMpty */ +#define EventArenaAllocFail ((EventType)0xEFA64A7F) /* AReNa ALloc Fail */ +#define EventSegAllocFail ((EventType)0xEF5E9A7F) /* SEG ALloc Fail */ +#define EventMeterInit ((EventType)0xEF3E2141) /* METer INIt */ +#define EventMeterValues ((EventType)0xEF3E2FA7) /* METer VALues */ +#define EventCBSInit ((EventType)0xEFCB5141) /* CBS INIt */ +#define EventTraceStatCondemn ((EventType)0xEF26A5C0) /* TRAce Stat COndemn */ +#define EventTraceStatScan ((EventType)0xEF26A55C) /* TRAce Stat SCan */ +#define EventTraceStatFix ((EventType)0xEF26A5F8) /* TRAce Stat FiX */ +#define EventTraceStatReclaim ((EventType)0xEF26A56E) /* TRAce Stat REclaim */ +#define EventArenaWriteFaults ((EventType)0xEFA6436F) /* AReNa WRite Faults */ +#define EventPoolInitMV ((EventType)0xEFB0713F) /* POoL Init MV */ +#define EventPoolInitMVFF ((EventType)0xEFB071FF) /* POoL Init mvFF */ +#define EventPoolInitMFS ((EventType)0xEFB07135) /* POoL Init MfS */ +#define EventPoolInitEPVM ((EventType)0xEFB071EF) /* POoL Init EpVm */ +#define EventPoolInitEPDL ((EventType)0xEFB071E7) /* POoL Init EpdL */ +#define EventPoolInitAMS ((EventType)0xEFB071A5) /* POoL Init AmS */ +#define EventPoolInitAMC ((EventType)0xEFB071AC) /* POoL Init AmC */ +#define EventPoolInitAMCZ ((EventType)0xEFB071A2) /* POoL Init AmcZ */ +#define EventPoolInitAWL ((EventType)0xEFB071A3) /* POoL Init AWl */ +#define EventPoolInitLO ((EventType)0xEFB07170) /* POoL Init LO */ +#define EventPoolInitSNC ((EventType)0xEFB07154) /* POoL Init SNc */ +#define EventPoolInitMVT ((EventType)0xEFB07132) /* POoL Init MvT */ +#define EventPoolPush ((EventType)0xEFB07B58) /* POoL PuSH */ +#define EventPoolPop ((EventType)0xEFB07B0B) /* POoL POP */ +#define EventReservoirLimitSet ((EventType)0xEF6E5713) /* REServoir LIMit set */ +#define EventCommitLimitSet ((EventType)0xEFC03713) /* COMmit LIMit set */ +#define EventSpareCommitLimitSet ((EventType)0xEF5BC713) /* SPare Commit LIMit set */ + + +#endif /* eventcom_h */ diff --git a/mps/code/eventdef.h b/mps/code/eventdef.h new file mode 100644 index 00000000000..cd181a15274 --- /dev/null +++ b/mps/code/eventdef.h @@ -0,0 +1,170 @@ +/* impl.h.eventdef -- Event Logging Definitions + * + * $HopeName: MMsrc!eventdef.h(trunk.24) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .source: design.mps.telemetry + * + * .desc: This file declares relationships that define the various + * event types. It is intended to be used with clever definitions + * of the RELATION macro. + * + * TRANSGRESSIONS + * + * .trans.nocppguard: This file has no #ifdef guard around the entire file. + * This is so that the file can be included multiple times. This is + * useful because each inclusion can use a different definition of + * RELATION. However this may be slightly shot by having the version + * defined here. + * + * .kind.abuse: A few events have a kind which is not obvious from the + * type of the objects that the event relates to. They are given the + * kind that that have on the grounds of expected use. The kinds are + * used in controlling the overall volume of telemetry and these events are + * given kinds so that they are grouped under the same control as events + * you are likely to want to see them with. (So for example, lots of + * scanner events have the same kind, Seg, because if you are interested + * in one then you're probably interested in them all and it's a similar + * amount of data). + */ + +/* No #ifndef eventdef_h, see .trans.nocppguard. */ + + +/* EVENT_VERSION_* -- three part version number + * + * Increment the minor version when adding new events, + * the median version when changing an existing event, + * and the major version when changing the format of the event file. + */ + +#define EVENT_VERSION_MAJOR ((unsigned)0) +#define EVENT_VERSION_MEDIAN ((unsigned)0) +#define EVENT_VERSION_MINOR ((unsigned)0) + + +/* Relations -- Generic definitions of events + * + * These specify: + * - Type: The name of the event type, without the leading "Event"; + * - Code: The unique 16-bit code associated with this event type, + * not currently used (see impl.h.eventcom); + * - Always: Whether this event type should appear in optimised + * varieties, not currently used; + * - Kind: Category into which this event falls, without the + * leading "EventKind"; + * - Format: Character sequence indicating the format of the event + * parameters, similar to writef (Pointer, Addr, Word, Unsigned, + * String, Double). + */ + +RELATION(AMCGenCreate , 0x0001, TRUE, Pool, PP) +RELATION(AMCGenDestroy , 0x0002, TRUE, Pool, P) +RELATION(AMCInit , 0x0003, TRUE, Pool, PP) +RELATION(AMCFinish , 0x0004, TRUE, Pool, P) +RELATION(ArenaCreateVM , 0x0005, TRUE, Arena, PWW) +RELATION(ArenaCreateVMNZ , 0x0006, TRUE, Arena, PWW) +RELATION(ArenaWriteFaults , 0x0007, TRUE, Trace, PW) +RELATION(MeterInit , 0x0008, TRUE, Pool, PP) +RELATION(MeterValues , 0x0009, TRUE, Pool, PDDWWW) +RELATION(AMCScanBegin , 0x000a, TRUE, Seg, PPP) +RELATION(AMCScanEnd , 0x000b, TRUE, Seg, PPP) +RELATION(AMCFix , 0x000c, TRUE, Ref, 0) +RELATION(AMCFixInPlace , 0x000d, TRUE, Ref, 0) +RELATION(AMCFixForward , 0x000e, TRUE, Ref, A) +RELATION(AMCReclaim , 0x000f, TRUE, Seg, PPP) +#if 0 /* Not in use */ +RELATION(AMCTraceEnd , 0x0010, TRUE, Trace, PPP) +#endif +RELATION(ArenaCreateCL , 0x0011, TRUE, Arena, PWA) +RELATION(ArenaDestroy , 0x0012, TRUE, Arena, P) +RELATION(SegAlloc , 0x0013, TRUE, Seg, PPAWP) +RELATION(SegFree , 0x0014, TRUE, Seg, PP) +RELATION(PoolInit , 0x0015, TRUE, Pool, PPP) +RELATION(PoolFinish , 0x0016, TRUE, Pool, P) +RELATION(PoolAlloc , 0x0017, TRUE, Object, PAW) +RELATION(PoolFree , 0x0018, TRUE, Object, PAW) +RELATION(CBSInit , 0x0019, TRUE, Pool, PP) +RELATION(Intern , 0x001a, TRUE, User, WS) +RELATION(Label , 0x001b, TRUE, User, AW) +RELATION(TraceStart , 0x001c, TRUE, Trace, PPP) +#if 0 /* Not in use */ +RELATION(TraceCreate , 0x001d, TRUE, Trace, PPPU) +#endif +RELATION(TraceDestroy , 0x001e, TRUE, Trace, P) +RELATION(SegSetGrey , 0x001f, TRUE, Seg, PPU) +RELATION(TraceFlipBegin , 0x0020, TRUE, Trace, PP) +RELATION(TraceFlipEnd , 0x0021, TRUE, Trace, PP) +RELATION(TraceReclaim , 0x0022, TRUE, Seg, P) +#if 0 /* not in use */ +RELATION(TraceScan , 0x0023, TRUE, Seg, UUPPP) +#endif +RELATION(TraceAccess , 0x0024, TRUE, Seg, PPU) +/* TracePoll's kind isn't really Trace, but then it isn't Seg either */ +RELATION(TracePoll , 0x0025, TRUE, Trace, PP) +RELATION(TraceFix , 0x0026, TRUE, Ref, PPAU) +RELATION(TraceFixSeg , 0x0027, TRUE, Ref, P) +RELATION(TraceFixWhite , 0x0028, TRUE, Ref, 0) +/* TraceScanArea{Tagged} abuses kind, see .kind.abuse */ +RELATION(TraceScanArea , 0x0029, TRUE, Seg, PPP) +RELATION(TraceScanAreaTagged , 0x002a, TRUE, Seg, PPP) +RELATION(VMCreate , 0x002b, TRUE, Arena, PAA) +RELATION(VMDestroy , 0x002c, TRUE, Arena, P) +RELATION(VMMap , 0x002d, TRUE, Seg, PAA) +RELATION(VMUnmap , 0x002e, TRUE, Seg, PAA) +RELATION(ArenaExtend , 0x002f, TRUE, Arena, PAW) +RELATION(ArenaRetract , 0x0030, TRUE, Arena, PAW) +RELATION(TraceSegGreyen , 0x0031, TRUE, Seg, PPU) +/* RootScanned abuses kind, see .kind.abuse */ +RELATION(RootScan , 0x0032, TRUE, Seg, PWW) +/* TraceStep abuses kind, see .kind.abuse */ +RELATION(TraceStep , 0x0033, TRUE, Seg, PP) +RELATION(BufferReserve , 0x0034, TRUE, Object, PAW) +RELATION(BufferCommit , 0x0035, TRUE, Object, PAWA) +/* BufferInit/Finish abuse kind, see .kind.abuse */ +RELATION(BufferInit , 0x0036, TRUE, Pool, PPU) +RELATION(BufferFinish , 0x0037, TRUE, Pool, P) +#if 0 /* not in use */ +RELATION(MVTFinish , 0x0038, TRUE, Pool, P) +#endif +RELATION(BufferFill , 0x0039, TRUE, Seg, PWAW) +RELATION(BufferEmpty , 0x003A, TRUE, Seg, PW) +RELATION(SegAllocFail , 0x003B, TRUE, Seg, PWP) +RELATION(TraceScanSeg , 0x003C, TRUE, Seg, UUPP) +/* TraceScanSingleRef abuses kind, see .kind.abuse */ +RELATION(TraceScanSingleRef , 0x003D, TRUE, Seg, UUPA) +RELATION(TraceStatCondemn , 0x003E, TRUE, Trace, PWWWWDD) +RELATION(TraceStatScan , 0x003F, TRUE, Trace, PWWWWWWWWWWWW) +RELATION(TraceStatFix , 0x0040, TRUE, Trace, PWWWWWWWWW) +RELATION(TraceStatReclaim , 0x0041, TRUE, Trace, PWW) + +RELATION(PoolInitMVFF , 0x0042, TRUE, Pool, PPWWWUUU) +RELATION(PoolInitMV , 0x0043, TRUE, Pool, PPWWW) +RELATION(PoolInitMFS , 0x0044, TRUE, Pool, PPWW) +RELATION(PoolInitEPVM , 0x0045, TRUE, Pool, PPPUU) +RELATION(PoolInitEPDL , 0x0046, TRUE, Pool, PPUWWW) +RELATION(PoolInitAMS , 0x0047, TRUE, Pool, PPP) +RELATION(PoolInitAMC , 0x0048, TRUE, Pool, PP) +RELATION(PoolInitAMCZ , 0x0049, TRUE, Pool, PP) +RELATION(PoolInitAWL , 0x004A, TRUE, Pool, PP) +RELATION(PoolInitLO , 0x004B, TRUE, Pool, PP) +RELATION(PoolInitSNC , 0x004C, TRUE, Pool, PP) +RELATION(PoolInitMVT , 0x004D, TRUE, Pool, PWWWWW) + +RELATION(BufferInitEPVM , 0x0050, TRUE, Pool, PPU) +RELATION(BufferInitSeg , 0x0051, TRUE, Pool, PPU) +RELATION(BufferInitRank , 0x0052, TRUE, Pool, PPUU) + +/* PoolPush/Pop go under Object, because they're user ops. */ +RELATION(PoolPush , 0x0060, TRUE, Object, P) +RELATION(PoolPop , 0x0061, TRUE, Object, PU) +RELATION(ReservoirLimitSet , 0x0062, TRUE, Arena, PW) +RELATION(CommitLimitSet , 0x0063, TRUE, Arena, PWU) +RELATION(SpareCommitLimitSet , 0x0064, TRUE, Arena, PW) +RELATION(ArenaAlloc , 0x0065, TRUE, Arena, PPAWP) +RELATION(ArenaFree , 0x0066, TRUE, Arena, PAW) +RELATION(ArenaAllocFail , 0x0067, TRUE, Arena, PWP) +RELATION(SegMerge , 0x0068, TRUE, Seg, PPP) +RELATION(SegSplit , 0x0069, TRUE, Seg, PPPA) + +/* Remember to update EventNameMAX and EventCodeMAX in eventcom.h! */ diff --git a/mps/code/eventgen.h b/mps/code/eventgen.h new file mode 100644 index 00000000000..d6c39d41683 --- /dev/null +++ b/mps/code/eventgen.h @@ -0,0 +1,1008 @@ +/* impl.h.eventgen -- Automatic event header + * + * $HopeName$ + * + * DO NOT EDIT THIS FILE! + * This file was generated by MMsrc!eventgen.pl(trunk.11) $ + */ + +#ifdef EVENT + +typedef struct { + Word code; + Word clock; +} Event0Struct; + +#define EVENT_0_FIELD_PTR(event, i) \ + (NULL) + +typedef struct { + Word code; + Word clock; + Addr a0; +} EventAStruct; + +#define EVENT_A_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->a.a0) \ + : NULL) + +typedef struct { + Word code; + Word clock; + Addr a0; + Word w1; +} EventAWStruct; + +#define EVENT_AW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->aw.a0) \ + : ((i) == 1) ? (void *)&((event)->aw.w1) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; +} EventPStruct; + +#define EVENT_P_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->p.p0) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Addr a1; + Addr a2; +} EventPAAStruct; + +#define EVENT_PAA_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->paa.p0) \ + : ((i) == 1) ? (void *)&((event)->paa.a1) \ + : ((i) == 2) ? (void *)&((event)->paa.a2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Addr a1; + Word w2; +} EventPAWStruct; + +#define EVENT_PAW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->paw.p0) \ + : ((i) == 1) ? (void *)&((event)->paw.a1) \ + : ((i) == 2) ? (void *)&((event)->paw.w2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Addr a1; + Word w2; + Addr a3; +} EventPAWAStruct; + +#define EVENT_PAWA_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pawa.p0) \ + : ((i) == 1) ? (void *)&((event)->pawa.a1) \ + : ((i) == 2) ? (void *)&((event)->pawa.w2) \ + : ((i) == 3) ? (void *)&((event)->pawa.a3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + double d1; + double d2; + Word w3; + Word w4; + Word w5; +} EventPDDWWWStruct; + +#define EVENT_PDDWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pddwww.p0) \ + : ((i) == 1) ? (void *)&((event)->pddwww.d1) \ + : ((i) == 2) ? (void *)&((event)->pddwww.d2) \ + : ((i) == 3) ? (void *)&((event)->pddwww.w3) \ + : ((i) == 4) ? (void *)&((event)->pddwww.w4) \ + : ((i) == 5) ? (void *)&((event)->pddwww.w5) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; +} EventPPStruct; + +#define EVENT_PP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pp.p0) \ + : ((i) == 1) ? (void *)&((event)->pp.p1) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + Addr a2; + unsigned u3; +} EventPPAUStruct; + +#define EVENT_PPAU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppau.p0) \ + : ((i) == 1) ? (void *)&((event)->ppau.p1) \ + : ((i) == 2) ? (void *)&((event)->ppau.a2) \ + : ((i) == 3) ? (void *)&((event)->ppau.u3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + Addr a2; + Word w3; + void * p4; +} EventPPAWPStruct; + +#define EVENT_PPAWP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppawp.p0) \ + : ((i) == 1) ? (void *)&((event)->ppawp.p1) \ + : ((i) == 2) ? (void *)&((event)->ppawp.a2) \ + : ((i) == 3) ? (void *)&((event)->ppawp.w3) \ + : ((i) == 4) ? (void *)&((event)->ppawp.p4) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + void * p2; +} EventPPPStruct; + +#define EVENT_PPP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppp.p0) \ + : ((i) == 1) ? (void *)&((event)->ppp.p1) \ + : ((i) == 2) ? (void *)&((event)->ppp.p2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + void * p2; + Addr a3; +} EventPPPAStruct; + +#define EVENT_PPPA_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pppa.p0) \ + : ((i) == 1) ? (void *)&((event)->pppa.p1) \ + : ((i) == 2) ? (void *)&((event)->pppa.p2) \ + : ((i) == 3) ? (void *)&((event)->pppa.a3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + void * p2; + unsigned u3; +} EventPPPUStruct; + +#define EVENT_PPPU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pppu.p0) \ + : ((i) == 1) ? (void *)&((event)->pppu.p1) \ + : ((i) == 2) ? (void *)&((event)->pppu.p2) \ + : ((i) == 3) ? (void *)&((event)->pppu.u3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + void * p2; + unsigned u3; + unsigned u4; +} EventPPPUUStruct; + +#define EVENT_PPPUU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pppuu.p0) \ + : ((i) == 1) ? (void *)&((event)->pppuu.p1) \ + : ((i) == 2) ? (void *)&((event)->pppuu.p2) \ + : ((i) == 3) ? (void *)&((event)->pppuu.u3) \ + : ((i) == 4) ? (void *)&((event)->pppuu.u4) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + unsigned u2; +} EventPPUStruct; + +#define EVENT_PPU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppu.p0) \ + : ((i) == 1) ? (void *)&((event)->ppu.p1) \ + : ((i) == 2) ? (void *)&((event)->ppu.u2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + unsigned u2; + unsigned u3; +} EventPPUUStruct; + +#define EVENT_PPUU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppuu.p0) \ + : ((i) == 1) ? (void *)&((event)->ppuu.p1) \ + : ((i) == 2) ? (void *)&((event)->ppuu.u2) \ + : ((i) == 3) ? (void *)&((event)->ppuu.u3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + unsigned u2; + Word w3; + Word w4; + Word w5; +} EventPPUWWWStruct; + +#define EVENT_PPUWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppuwww.p0) \ + : ((i) == 1) ? (void *)&((event)->ppuwww.p1) \ + : ((i) == 2) ? (void *)&((event)->ppuwww.u2) \ + : ((i) == 3) ? (void *)&((event)->ppuwww.w3) \ + : ((i) == 4) ? (void *)&((event)->ppuwww.w4) \ + : ((i) == 5) ? (void *)&((event)->ppuwww.w5) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + Word w2; + Word w3; +} EventPPWWStruct; + +#define EVENT_PPWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppww.p0) \ + : ((i) == 1) ? (void *)&((event)->ppww.p1) \ + : ((i) == 2) ? (void *)&((event)->ppww.w2) \ + : ((i) == 3) ? (void *)&((event)->ppww.w3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + Word w2; + Word w3; + Word w4; +} EventPPWWWStruct; + +#define EVENT_PPWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppwww.p0) \ + : ((i) == 1) ? (void *)&((event)->ppwww.p1) \ + : ((i) == 2) ? (void *)&((event)->ppwww.w2) \ + : ((i) == 3) ? (void *)&((event)->ppwww.w3) \ + : ((i) == 4) ? (void *)&((event)->ppwww.w4) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + void * p1; + Word w2; + Word w3; + Word w4; + unsigned u5; + unsigned u6; + unsigned u7; +} EventPPWWWUUUStruct; + +#define EVENT_PPWWWUUU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ppwwwuuu.p0) \ + : ((i) == 1) ? (void *)&((event)->ppwwwuuu.p1) \ + : ((i) == 2) ? (void *)&((event)->ppwwwuuu.w2) \ + : ((i) == 3) ? (void *)&((event)->ppwwwuuu.w3) \ + : ((i) == 4) ? (void *)&((event)->ppwwwuuu.w4) \ + : ((i) == 5) ? (void *)&((event)->ppwwwuuu.u5) \ + : ((i) == 6) ? (void *)&((event)->ppwwwuuu.u6) \ + : ((i) == 7) ? (void *)&((event)->ppwwwuuu.u7) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + unsigned u1; +} EventPUStruct; + +#define EVENT_PU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pu.p0) \ + : ((i) == 1) ? (void *)&((event)->pu.u1) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; +} EventPWStruct; + +#define EVENT_PW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pw.p0) \ + : ((i) == 1) ? (void *)&((event)->pw.w1) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Addr a2; +} EventPWAStruct; + +#define EVENT_PWA_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwa.p0) \ + : ((i) == 1) ? (void *)&((event)->pwa.w1) \ + : ((i) == 2) ? (void *)&((event)->pwa.a2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Addr a2; + Word w3; +} EventPWAWStruct; + +#define EVENT_PWAW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwaw.p0) \ + : ((i) == 1) ? (void *)&((event)->pwaw.w1) \ + : ((i) == 2) ? (void *)&((event)->pwaw.a2) \ + : ((i) == 3) ? (void *)&((event)->pwaw.w3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + void * p2; +} EventPWPStruct; + +#define EVENT_PWP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwp.p0) \ + : ((i) == 1) ? (void *)&((event)->pwp.w1) \ + : ((i) == 2) ? (void *)&((event)->pwp.p2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + unsigned u2; +} EventPWUStruct; + +#define EVENT_PWU_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwu.p0) \ + : ((i) == 1) ? (void *)&((event)->pwu.w1) \ + : ((i) == 2) ? (void *)&((event)->pwu.u2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Word w2; +} EventPWWStruct; + +#define EVENT_PWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pww.p0) \ + : ((i) == 1) ? (void *)&((event)->pww.w1) \ + : ((i) == 2) ? (void *)&((event)->pww.w2) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Word w2; + Word w3; + Word w4; + double d5; + double d6; +} EventPWWWWDDStruct; + +#define EVENT_PWWWWDD_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwwwwdd.p0) \ + : ((i) == 1) ? (void *)&((event)->pwwwwdd.w1) \ + : ((i) == 2) ? (void *)&((event)->pwwwwdd.w2) \ + : ((i) == 3) ? (void *)&((event)->pwwwwdd.w3) \ + : ((i) == 4) ? (void *)&((event)->pwwwwdd.w4) \ + : ((i) == 5) ? (void *)&((event)->pwwwwdd.d5) \ + : ((i) == 6) ? (void *)&((event)->pwwwwdd.d6) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; +} EventPWWWWWStruct; + +#define EVENT_PWWWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwwwww.p0) \ + : ((i) == 1) ? (void *)&((event)->pwwwww.w1) \ + : ((i) == 2) ? (void *)&((event)->pwwwww.w2) \ + : ((i) == 3) ? (void *)&((event)->pwwwww.w3) \ + : ((i) == 4) ? (void *)&((event)->pwwwww.w4) \ + : ((i) == 5) ? (void *)&((event)->pwwwww.w5) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; + Word w6; + Word w7; + Word w8; + Word w9; +} EventPWWWWWWWWWStruct; + +#define EVENT_PWWWWWWWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwwwwwwwww.p0) \ + : ((i) == 1) ? (void *)&((event)->pwwwwwwwww.w1) \ + : ((i) == 2) ? (void *)&((event)->pwwwwwwwww.w2) \ + : ((i) == 3) ? (void *)&((event)->pwwwwwwwww.w3) \ + : ((i) == 4) ? (void *)&((event)->pwwwwwwwww.w4) \ + : ((i) == 5) ? (void *)&((event)->pwwwwwwwww.w5) \ + : ((i) == 6) ? (void *)&((event)->pwwwwwwwww.w6) \ + : ((i) == 7) ? (void *)&((event)->pwwwwwwwww.w7) \ + : ((i) == 8) ? (void *)&((event)->pwwwwwwwww.w8) \ + : ((i) == 9) ? (void *)&((event)->pwwwwwwwww.w9) \ + : NULL) + +typedef struct { + Word code; + Word clock; + void * p0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; + Word w6; + Word w7; + Word w8; + Word w9; + Word w10; + Word w11; + Word w12; +} EventPWWWWWWWWWWWWStruct; + +#define EVENT_PWWWWWWWWWWWW_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->pwwwwwwwwwwww.p0) \ + : ((i) == 1) ? (void *)&((event)->pwwwwwwwwwwww.w1) \ + : ((i) == 2) ? (void *)&((event)->pwwwwwwwwwwww.w2) \ + : ((i) == 3) ? (void *)&((event)->pwwwwwwwwwwww.w3) \ + : ((i) == 4) ? (void *)&((event)->pwwwwwwwwwwww.w4) \ + : ((i) == 5) ? (void *)&((event)->pwwwwwwwwwwww.w5) \ + : ((i) == 6) ? (void *)&((event)->pwwwwwwwwwwww.w6) \ + : ((i) == 7) ? (void *)&((event)->pwwwwwwwwwwww.w7) \ + : ((i) == 8) ? (void *)&((event)->pwwwwwwwwwwww.w8) \ + : ((i) == 9) ? (void *)&((event)->pwwwwwwwwwwww.w9) \ + : ((i) == 10) ? (void *)&((event)->pwwwwwwwwwwww.w10) \ + : ((i) == 11) ? (void *)&((event)->pwwwwwwwwwwww.w11) \ + : ((i) == 12) ? (void *)&((event)->pwwwwwwwwwwww.w12) \ + : NULL) + +typedef struct { + Word code; + Word clock; + unsigned u0; + unsigned u1; + void * p2; + Addr a3; +} EventUUPAStruct; + +#define EVENT_UUPA_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->uupa.u0) \ + : ((i) == 1) ? (void *)&((event)->uupa.u1) \ + : ((i) == 2) ? (void *)&((event)->uupa.p2) \ + : ((i) == 3) ? (void *)&((event)->uupa.a3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + unsigned u0; + unsigned u1; + void * p2; + void * p3; +} EventUUPPStruct; + +#define EVENT_UUPP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->uupp.u0) \ + : ((i) == 1) ? (void *)&((event)->uupp.u1) \ + : ((i) == 2) ? (void *)&((event)->uupp.p2) \ + : ((i) == 3) ? (void *)&((event)->uupp.p3) \ + : NULL) + +typedef struct { + Word code; + Word clock; + unsigned u0; + unsigned u1; + void * p2; + void * p3; + void * p4; +} EventUUPPPStruct; + +#define EVENT_UUPPP_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->uuppp.u0) \ + : ((i) == 1) ? (void *)&((event)->uuppp.u1) \ + : ((i) == 2) ? (void *)&((event)->uuppp.p2) \ + : ((i) == 3) ? (void *)&((event)->uuppp.p3) \ + : ((i) == 4) ? (void *)&((event)->uuppp.p4) \ + : NULL) + +typedef struct { + Word code; + Word clock; + Word w0; + EventStringStruct s1; +} EventWSStruct; + +#define EVENT_WS_FIELD_PTR(event, i) \ + (((i) == 0) ? (void *)&((event)->ws.w0) \ + : ((i) == 1) ? (void *)&((event)->ws.s1) \ + : NULL) + + +typedef union { + Event0Struct any; + EventAStruct a; + EventAWStruct aw; + EventPStruct p; + EventPAAStruct paa; + EventPAWStruct paw; + EventPAWAStruct pawa; + EventPDDWWWStruct pddwww; + EventPPStruct pp; + EventPPAUStruct ppau; + EventPPAWPStruct ppawp; + EventPPPStruct ppp; + EventPPPAStruct pppa; + EventPPPUStruct pppu; + EventPPPUUStruct pppuu; + EventPPUStruct ppu; + EventPPUUStruct ppuu; + EventPPUWWWStruct ppuwww; + EventPPWWStruct ppww; + EventPPWWWStruct ppwww; + EventPPWWWUUUStruct ppwwwuuu; + EventPUStruct pu; + EventPWStruct pw; + EventPWAStruct pwa; + EventPWAWStruct pwaw; + EventPWPStruct pwp; + EventPWUStruct pwu; + EventPWWStruct pww; + EventPWWWWDDStruct pwwwwdd; + EventPWWWWWStruct pwwwww; + EventPWWWWWWWWWStruct pwwwwwwwww; + EventPWWWWWWWWWWWWStruct pwwwwwwwwwwww; + EventUUPAStruct uupa; + EventUUPPStruct uupp; + EventUUPPPStruct uuppp; + EventWSStruct ws; +} EventUnion; + + +#define EVENT_0(type) \ + EVENT_BEGIN(type) \ + EVENT_END(type, 0, sizeof(Event0Struct)) + +#define EVENT_A(type, _a0) \ + EVENT_BEGIN(type) \ + EventMould.a.a0 = (_a0); \ + EVENT_END(type, A, sizeof(EventAStruct)) + +#define EVENT_AW(type, _a0, _w1) \ + EVENT_BEGIN(type) \ + EventMould.aw.a0 = (_a0); \ + EventMould.aw.w1 = (_w1); \ + EVENT_END(type, AW, sizeof(EventAWStruct)) + +#define EVENT_P(type, _p0) \ + EVENT_BEGIN(type) \ + EventMould.p.p0 = (_p0); \ + EVENT_END(type, P, sizeof(EventPStruct)) + +#define EVENT_PAA(type, _p0, _a1, _a2) \ + EVENT_BEGIN(type) \ + EventMould.paa.p0 = (_p0); \ + EventMould.paa.a1 = (_a1); \ + EventMould.paa.a2 = (_a2); \ + EVENT_END(type, PAA, sizeof(EventPAAStruct)) + +#define EVENT_PAW(type, _p0, _a1, _w2) \ + EVENT_BEGIN(type) \ + EventMould.paw.p0 = (_p0); \ + EventMould.paw.a1 = (_a1); \ + EventMould.paw.w2 = (_w2); \ + EVENT_END(type, PAW, sizeof(EventPAWStruct)) + +#define EVENT_PAWA(type, _p0, _a1, _w2, _a3) \ + EVENT_BEGIN(type) \ + EventMould.pawa.p0 = (_p0); \ + EventMould.pawa.a1 = (_a1); \ + EventMould.pawa.w2 = (_w2); \ + EventMould.pawa.a3 = (_a3); \ + EVENT_END(type, PAWA, sizeof(EventPAWAStruct)) + +#define EVENT_PDDWWW(type, _p0, _d1, _d2, _w3, _w4, _w5) \ + EVENT_BEGIN(type) \ + EventMould.pddwww.p0 = (_p0); \ + EventMould.pddwww.d1 = (_d1); \ + EventMould.pddwww.d2 = (_d2); \ + EventMould.pddwww.w3 = (_w3); \ + EventMould.pddwww.w4 = (_w4); \ + EventMould.pddwww.w5 = (_w5); \ + EVENT_END(type, PDDWWW, sizeof(EventPDDWWWStruct)) + +#define EVENT_PP(type, _p0, _p1) \ + EVENT_BEGIN(type) \ + EventMould.pp.p0 = (_p0); \ + EventMould.pp.p1 = (_p1); \ + EVENT_END(type, PP, sizeof(EventPPStruct)) + +#define EVENT_PPAU(type, _p0, _p1, _a2, _u3) \ + EVENT_BEGIN(type) \ + EventMould.ppau.p0 = (_p0); \ + EventMould.ppau.p1 = (_p1); \ + EventMould.ppau.a2 = (_a2); \ + EventMould.ppau.u3 = (_u3); \ + EVENT_END(type, PPAU, sizeof(EventPPAUStruct)) + +#define EVENT_PPAWP(type, _p0, _p1, _a2, _w3, _p4) \ + EVENT_BEGIN(type) \ + EventMould.ppawp.p0 = (_p0); \ + EventMould.ppawp.p1 = (_p1); \ + EventMould.ppawp.a2 = (_a2); \ + EventMould.ppawp.w3 = (_w3); \ + EventMould.ppawp.p4 = (_p4); \ + EVENT_END(type, PPAWP, sizeof(EventPPAWPStruct)) + +#define EVENT_PPP(type, _p0, _p1, _p2) \ + EVENT_BEGIN(type) \ + EventMould.ppp.p0 = (_p0); \ + EventMould.ppp.p1 = (_p1); \ + EventMould.ppp.p2 = (_p2); \ + EVENT_END(type, PPP, sizeof(EventPPPStruct)) + +#define EVENT_PPPA(type, _p0, _p1, _p2, _a3) \ + EVENT_BEGIN(type) \ + EventMould.pppa.p0 = (_p0); \ + EventMould.pppa.p1 = (_p1); \ + EventMould.pppa.p2 = (_p2); \ + EventMould.pppa.a3 = (_a3); \ + EVENT_END(type, PPPA, sizeof(EventPPPAStruct)) + +#define EVENT_PPPU(type, _p0, _p1, _p2, _u3) \ + EVENT_BEGIN(type) \ + EventMould.pppu.p0 = (_p0); \ + EventMould.pppu.p1 = (_p1); \ + EventMould.pppu.p2 = (_p2); \ + EventMould.pppu.u3 = (_u3); \ + EVENT_END(type, PPPU, sizeof(EventPPPUStruct)) + +#define EVENT_PPPUU(type, _p0, _p1, _p2, _u3, _u4) \ + EVENT_BEGIN(type) \ + EventMould.pppuu.p0 = (_p0); \ + EventMould.pppuu.p1 = (_p1); \ + EventMould.pppuu.p2 = (_p2); \ + EventMould.pppuu.u3 = (_u3); \ + EventMould.pppuu.u4 = (_u4); \ + EVENT_END(type, PPPUU, sizeof(EventPPPUUStruct)) + +#define EVENT_PPU(type, _p0, _p1, _u2) \ + EVENT_BEGIN(type) \ + EventMould.ppu.p0 = (_p0); \ + EventMould.ppu.p1 = (_p1); \ + EventMould.ppu.u2 = (_u2); \ + EVENT_END(type, PPU, sizeof(EventPPUStruct)) + +#define EVENT_PPUU(type, _p0, _p1, _u2, _u3) \ + EVENT_BEGIN(type) \ + EventMould.ppuu.p0 = (_p0); \ + EventMould.ppuu.p1 = (_p1); \ + EventMould.ppuu.u2 = (_u2); \ + EventMould.ppuu.u3 = (_u3); \ + EVENT_END(type, PPUU, sizeof(EventPPUUStruct)) + +#define EVENT_PPUWWW(type, _p0, _p1, _u2, _w3, _w4, _w5) \ + EVENT_BEGIN(type) \ + EventMould.ppuwww.p0 = (_p0); \ + EventMould.ppuwww.p1 = (_p1); \ + EventMould.ppuwww.u2 = (_u2); \ + EventMould.ppuwww.w3 = (_w3); \ + EventMould.ppuwww.w4 = (_w4); \ + EventMould.ppuwww.w5 = (_w5); \ + EVENT_END(type, PPUWWW, sizeof(EventPPUWWWStruct)) + +#define EVENT_PPWW(type, _p0, _p1, _w2, _w3) \ + EVENT_BEGIN(type) \ + EventMould.ppww.p0 = (_p0); \ + EventMould.ppww.p1 = (_p1); \ + EventMould.ppww.w2 = (_w2); \ + EventMould.ppww.w3 = (_w3); \ + EVENT_END(type, PPWW, sizeof(EventPPWWStruct)) + +#define EVENT_PPWWW(type, _p0, _p1, _w2, _w3, _w4) \ + EVENT_BEGIN(type) \ + EventMould.ppwww.p0 = (_p0); \ + EventMould.ppwww.p1 = (_p1); \ + EventMould.ppwww.w2 = (_w2); \ + EventMould.ppwww.w3 = (_w3); \ + EventMould.ppwww.w4 = (_w4); \ + EVENT_END(type, PPWWW, sizeof(EventPPWWWStruct)) + +#define EVENT_PPWWWUUU(type, _p0, _p1, _w2, _w3, _w4, _u5, _u6, _u7) \ + EVENT_BEGIN(type) \ + EventMould.ppwwwuuu.p0 = (_p0); \ + EventMould.ppwwwuuu.p1 = (_p1); \ + EventMould.ppwwwuuu.w2 = (_w2); \ + EventMould.ppwwwuuu.w3 = (_w3); \ + EventMould.ppwwwuuu.w4 = (_w4); \ + EventMould.ppwwwuuu.u5 = (_u5); \ + EventMould.ppwwwuuu.u6 = (_u6); \ + EventMould.ppwwwuuu.u7 = (_u7); \ + EVENT_END(type, PPWWWUUU, sizeof(EventPPWWWUUUStruct)) + +#define EVENT_PU(type, _p0, _u1) \ + EVENT_BEGIN(type) \ + EventMould.pu.p0 = (_p0); \ + EventMould.pu.u1 = (_u1); \ + EVENT_END(type, PU, sizeof(EventPUStruct)) + +#define EVENT_PW(type, _p0, _w1) \ + EVENT_BEGIN(type) \ + EventMould.pw.p0 = (_p0); \ + EventMould.pw.w1 = (_w1); \ + EVENT_END(type, PW, sizeof(EventPWStruct)) + +#define EVENT_PWA(type, _p0, _w1, _a2) \ + EVENT_BEGIN(type) \ + EventMould.pwa.p0 = (_p0); \ + EventMould.pwa.w1 = (_w1); \ + EventMould.pwa.a2 = (_a2); \ + EVENT_END(type, PWA, sizeof(EventPWAStruct)) + +#define EVENT_PWAW(type, _p0, _w1, _a2, _w3) \ + EVENT_BEGIN(type) \ + EventMould.pwaw.p0 = (_p0); \ + EventMould.pwaw.w1 = (_w1); \ + EventMould.pwaw.a2 = (_a2); \ + EventMould.pwaw.w3 = (_w3); \ + EVENT_END(type, PWAW, sizeof(EventPWAWStruct)) + +#define EVENT_PWP(type, _p0, _w1, _p2) \ + EVENT_BEGIN(type) \ + EventMould.pwp.p0 = (_p0); \ + EventMould.pwp.w1 = (_w1); \ + EventMould.pwp.p2 = (_p2); \ + EVENT_END(type, PWP, sizeof(EventPWPStruct)) + +#define EVENT_PWU(type, _p0, _w1, _u2) \ + EVENT_BEGIN(type) \ + EventMould.pwu.p0 = (_p0); \ + EventMould.pwu.w1 = (_w1); \ + EventMould.pwu.u2 = (_u2); \ + EVENT_END(type, PWU, sizeof(EventPWUStruct)) + +#define EVENT_PWW(type, _p0, _w1, _w2) \ + EVENT_BEGIN(type) \ + EventMould.pww.p0 = (_p0); \ + EventMould.pww.w1 = (_w1); \ + EventMould.pww.w2 = (_w2); \ + EVENT_END(type, PWW, sizeof(EventPWWStruct)) + +#define EVENT_PWWWWDD(type, _p0, _w1, _w2, _w3, _w4, _d5, _d6) \ + EVENT_BEGIN(type) \ + EventMould.pwwwwdd.p0 = (_p0); \ + EventMould.pwwwwdd.w1 = (_w1); \ + EventMould.pwwwwdd.w2 = (_w2); \ + EventMould.pwwwwdd.w3 = (_w3); \ + EventMould.pwwwwdd.w4 = (_w4); \ + EventMould.pwwwwdd.d5 = (_d5); \ + EventMould.pwwwwdd.d6 = (_d6); \ + EVENT_END(type, PWWWWDD, sizeof(EventPWWWWDDStruct)) + +#define EVENT_PWWWWW(type, _p0, _w1, _w2, _w3, _w4, _w5) \ + EVENT_BEGIN(type) \ + EventMould.pwwwww.p0 = (_p0); \ + EventMould.pwwwww.w1 = (_w1); \ + EventMould.pwwwww.w2 = (_w2); \ + EventMould.pwwwww.w3 = (_w3); \ + EventMould.pwwwww.w4 = (_w4); \ + EventMould.pwwwww.w5 = (_w5); \ + EVENT_END(type, PWWWWW, sizeof(EventPWWWWWStruct)) + +#define EVENT_PWWWWWWWWW(type, _p0, _w1, _w2, _w3, _w4, _w5, _w6, _w7, _w8, _w9) \ + EVENT_BEGIN(type) \ + EventMould.pwwwwwwwww.p0 = (_p0); \ + EventMould.pwwwwwwwww.w1 = (_w1); \ + EventMould.pwwwwwwwww.w2 = (_w2); \ + EventMould.pwwwwwwwww.w3 = (_w3); \ + EventMould.pwwwwwwwww.w4 = (_w4); \ + EventMould.pwwwwwwwww.w5 = (_w5); \ + EventMould.pwwwwwwwww.w6 = (_w6); \ + EventMould.pwwwwwwwww.w7 = (_w7); \ + EventMould.pwwwwwwwww.w8 = (_w8); \ + EventMould.pwwwwwwwww.w9 = (_w9); \ + EVENT_END(type, PWWWWWWWWW, sizeof(EventPWWWWWWWWWStruct)) + +#define EVENT_PWWWWWWWWWWWW(type, _p0, _w1, _w2, _w3, _w4, _w5, _w6, _w7, _w8, _w9, _w10, _w11, _w12) \ + EVENT_BEGIN(type) \ + EventMould.pwwwwwwwwwwww.p0 = (_p0); \ + EventMould.pwwwwwwwwwwww.w1 = (_w1); \ + EventMould.pwwwwwwwwwwww.w2 = (_w2); \ + EventMould.pwwwwwwwwwwww.w3 = (_w3); \ + EventMould.pwwwwwwwwwwww.w4 = (_w4); \ + EventMould.pwwwwwwwwwwww.w5 = (_w5); \ + EventMould.pwwwwwwwwwwww.w6 = (_w6); \ + EventMould.pwwwwwwwwwwww.w7 = (_w7); \ + EventMould.pwwwwwwwwwwww.w8 = (_w8); \ + EventMould.pwwwwwwwwwwww.w9 = (_w9); \ + EventMould.pwwwwwwwwwwww.w10 = (_w10); \ + EventMould.pwwwwwwwwwwww.w11 = (_w11); \ + EventMould.pwwwwwwwwwwww.w12 = (_w12); \ + EVENT_END(type, PWWWWWWWWWWWW, sizeof(EventPWWWWWWWWWWWWStruct)) + +#define EVENT_UUPA(type, _u0, _u1, _p2, _a3) \ + EVENT_BEGIN(type) \ + EventMould.uupa.u0 = (_u0); \ + EventMould.uupa.u1 = (_u1); \ + EventMould.uupa.p2 = (_p2); \ + EventMould.uupa.a3 = (_a3); \ + EVENT_END(type, UUPA, sizeof(EventUUPAStruct)) + +#define EVENT_UUPP(type, _u0, _u1, _p2, _p3) \ + EVENT_BEGIN(type) \ + EventMould.uupp.u0 = (_u0); \ + EventMould.uupp.u1 = (_u1); \ + EventMould.uupp.p2 = (_p2); \ + EventMould.uupp.p3 = (_p3); \ + EVENT_END(type, UUPP, sizeof(EventUUPPStruct)) + +#define EVENT_UUPPP(type, _u0, _u1, _p2, _p3, _p4) \ + EVENT_BEGIN(type) \ + EventMould.uuppp.u0 = (_u0); \ + EventMould.uuppp.u1 = (_u1); \ + EventMould.uuppp.p2 = (_p2); \ + EventMould.uuppp.p3 = (_p3); \ + EventMould.uuppp.p4 = (_p4); \ + EVENT_END(type, UUPPP, sizeof(EventUUPPPStruct)) + +#define EVENT_WS(type, _w0, _l1, _s1) \ + EVENT_BEGIN(type) \ + size_t _string_len; \ + EventMould.ws.w0 = (_w0); \ + _string_len = (_l1); \ + AVER(_string_len < EventStringLengthMAX); \ + EventMould.ws.s1.len = (EventStringLen)_string_len; \ + mps_lib_memcpy(EventMould.ws.s1.str, _s1, _string_len); \ + EVENT_END(type, WS, offsetof(EventWSStruct, s1.str) + _string_len) + +#define EventFormat0 0 +#define EventFormatA 1 +#define EventFormatAW 2 +#define EventFormatP 3 +#define EventFormatPAA 4 +#define EventFormatPAW 5 +#define EventFormatPAWA 6 +#define EventFormatPDDWWW 7 +#define EventFormatPP 8 +#define EventFormatPPAU 9 +#define EventFormatPPAWP 10 +#define EventFormatPPP 11 +#define EventFormatPPPA 12 +#define EventFormatPPPU 13 +#define EventFormatPPPUU 14 +#define EventFormatPPU 15 +#define EventFormatPPUU 16 +#define EventFormatPPUWWW 17 +#define EventFormatPPWW 18 +#define EventFormatPPWWW 19 +#define EventFormatPPWWWUUU 20 +#define EventFormatPU 21 +#define EventFormatPW 22 +#define EventFormatPWA 23 +#define EventFormatPWAW 24 +#define EventFormatPWP 25 +#define EventFormatPWU 26 +#define EventFormatPWW 27 +#define EventFormatPWWWWDD 28 +#define EventFormatPWWWWW 29 +#define EventFormatPWWWWWWWWW 30 +#define EventFormatPWWWWWWWWWWWW 31 +#define EventFormatUUPA 32 +#define EventFormatUUPP 33 +#define EventFormatUUPPP 34 +#define EventFormatWS 35 + +#else /* EVENT not */ + +#define EVENT_0(type) NOOP +#define EVENT_A(type, p0) NOOP +#define EVENT_AW(type, p0, p1) NOOP +#define EVENT_P(type, p0) NOOP +#define EVENT_PAA(type, p0, p1, p2) NOOP +#define EVENT_PAW(type, p0, p1, p2) NOOP +#define EVENT_PAWA(type, p0, p1, p2, p3) NOOP +#define EVENT_PDDWWW(type, p0, p1, p2, p3, p4, p5) NOOP +#define EVENT_PP(type, p0, p1) NOOP +#define EVENT_PPAU(type, p0, p1, p2, p3) NOOP +#define EVENT_PPAWP(type, p0, p1, p2, p3, p4) NOOP +#define EVENT_PPP(type, p0, p1, p2) NOOP +#define EVENT_PPPA(type, p0, p1, p2, p3) NOOP +#define EVENT_PPPU(type, p0, p1, p2, p3) NOOP +#define EVENT_PPPUU(type, p0, p1, p2, p3, p4) NOOP +#define EVENT_PPU(type, p0, p1, p2) NOOP +#define EVENT_PPUU(type, p0, p1, p2, p3) NOOP +#define EVENT_PPUWWW(type, p0, p1, p2, p3, p4, p5) NOOP +#define EVENT_PPWW(type, p0, p1, p2, p3) NOOP +#define EVENT_PPWWW(type, p0, p1, p2, p3, p4) NOOP +#define EVENT_PPWWWUUU(type, p0, p1, p2, p3, p4, p5, p6, p7) NOOP +#define EVENT_PU(type, p0, p1) NOOP +#define EVENT_PW(type, p0, p1) NOOP +#define EVENT_PWA(type, p0, p1, p2) NOOP +#define EVENT_PWAW(type, p0, p1, p2, p3) NOOP +#define EVENT_PWP(type, p0, p1, p2) NOOP +#define EVENT_PWU(type, p0, p1, p2) NOOP +#define EVENT_PWW(type, p0, p1, p2) NOOP +#define EVENT_PWWWWDD(type, p0, p1, p2, p3, p4, p5, p6) NOOP +#define EVENT_PWWWWW(type, p0, p1, p2, p3, p4, p5) NOOP +#define EVENT_PWWWWWWWWW(type, p0, p1, p2, p3, p4, p5, p6, p7, p8, p9) NOOP +#define EVENT_PWWWWWWWWWWWW(type, p0, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12) NOOP +#define EVENT_UUPA(type, p0, p1, p2, p3) NOOP +#define EVENT_UUPP(type, p0, p1, p2, p3) NOOP +#define EVENT_UUPPP(type, p0, p1, p2, p3, p4) NOOP +#define EVENT_WS(type, p0, p1, l1) NOOP + +#endif /* EVENT */ diff --git a/mps/code/eventgen.pl b/mps/code/eventgen.pl new file mode 100644 index 00000000000..d7ccd267981 --- /dev/null +++ b/mps/code/eventgen.pl @@ -0,0 +1,178 @@ +#!/usr/local/bin/perl -w +# impl.pl.eventgen: GENERATOR FOR impl.h.eventgen +# +# $HopeName: MMsrc!eventgen.pl(trunk.12) $ +# Copyright (C) 1999 Harlequin Limited. All rights reserved. +# +# .how: Invoke this script in the src directory. It works by scanning +# eventdef.h and then creating a file eventgen.h that includes the +# necessary types and macros. +# +# You will need to have eventgen.h claimed, and you should +# remember to check it in afterwards. + +$HopeName = '$HopeName: MMsrc!eventgen.pl(trunk.12) $'; + +%Formats = (); + +%Types = ( + "D", "double", + "S", "EventStringStruct", + "U", "unsigned", + "W", "Word", + "A", "Addr", + "P", "void *", + ); + + +#### Discover formats + + +open(C, ") { + if(/RELATION\([^,]*,[^,]*,[^,]*,[^,]*, ([A-Z]+)\)/) { + $Formats{$1} = 1 if(!defined($Formats{$1})); + } +} +close(C); + + +#### Generate eventgen.h + + +open(H, ">eventgen.h") || die "Can't open eventgen.h for output"; + +print H "/* impl.h.eventgen -- Automatic event header + * + * \$HopeName\$ + * + * DO NOT EDIT THIS FILE! + * This file was generated by", substr($HopeName, 10), " + */\n\n"; + + +print H "#ifdef EVENT\n\n"; + + +#### Generate structure definitions and accessors + + +foreach $format ("", sort(keys(%Formats))) { + $fmt = ($format eq "") ? "0" : $format; + print H "typedef struct {\n"; + print H " Word code;\n Word clock;\n"; + for($i = 0; $i < length($format); $i++) { + $c = substr($format, $i, 1); + if($c eq "S") { + die "String must be at end of format" if($i+1 != length($format)); + } + if(!defined($Types{$c})) { + die "Can't find type for format code >$c<."; + } else { + print H " ", $Types{$c}, " \l$c$i;\n"; + } + } + print H "} Event${fmt}Struct;\n\n"; + + print H "#define EVENT_${fmt}_FIELD_PTR(event, i) \\\n ("; + for($i = 0; $i < length($format); $i++) { + $c = substr($format, $i, 1); + print H "((i) == $i) ? (void *)&((event)->\L$fmt.$c\E$i) \\\n : "; + } + print H "NULL)\n\n"; +} + + +#### Generate union type + + +print H "\ntypedef union {\n Event0Struct any;\n"; + +foreach $format (sort(keys(%Formats))) { + print H " Event${format}Struct \L$format;\n"; +} +print H "} EventUnion;\n\n\n"; + + +#### Generate writer macros + + +foreach $format ("", sort(keys(%Formats))) { + $fmt = ($format eq "") ? "0" : $format; + + print H "#define EVENT_$fmt(type"; + for($i = 0; $i < length($format); $i++) { + $c = substr($format, $i, 1); + if($c eq "S") { + print H ", _l$i, _s$i"; + } else { + print H ", _\l$c$i"; + } + } + print H ") \\\n"; + + print H " EVENT_BEGIN(type) \\\n"; + + if(($i = index($format, "S")) != -1) { + print H " size_t _string_len; \\\n"; + } + + for($i = 0; $i < length($format); $i++) { + $c = substr($format, $i, 1); + if($c eq "S") { + print H " _string_len = (_l$i); \\\n"; + print H " AVER(_string_len < EventStringLengthMAX); \\\n"; + print H " EventMould.\L$fmt.s$i.len = " + . "(EventStringLen)_string_len; \\\n"; + print H " mps_lib_memcpy(EventMould.\L$fmt.s$i.str, " + . "_s$i, _string_len); \\\n"; + } else { + print H " EventMould.\L$fmt.$c$i = (_$c$i); \\\n"; + } + } + + if(($i = index($format, "S")) != -1) { + print H " EVENT_END(type, $fmt, " + . "offsetof(Event${fmt}Struct, s$i.str) " + . "+ _string_len)\n\n"; + } else { + print H " EVENT_END(type, $fmt, " + . "sizeof(Event${fmt}Struct))\n\n"; + } +} + + +#### Generate format codes + + +$C = 0; +foreach $format ("0", sort(keys(%Formats))) { + print H "#define EventFormat$format $C\n"; + $C++; +} + + +#### Generate dummies for non-event varieties + + +print H "\n#else /* EVENT not */\n\n"; + + +print H "#define EVENT_0(type) NOOP\n"; + +foreach $format (sort(keys(%Formats))) { + print H "#define EVENT_$format(type"; + for($i = 0; $i < length($format); $i++) { + print H ", p$i"; + } + if(($i = index($format, "S")) != -1) { + print H ", l$i"; + } + print H ") NOOP\n"; +} + + +print H "\n#endif /* EVENT */\n"; + + +close(H); diff --git a/mps/code/eventpro.c b/mps/code/eventpro.c new file mode 100644 index 00000000000..9cb8700fe8d --- /dev/null +++ b/mps/code/eventpro.c @@ -0,0 +1,433 @@ +/* impl.c.eventpro: Event processing routines + * Copyright (C) 1999 Harlequin Group plc. All rights reserved. + * + * $HopeName: MMsrc!eventpro.c(trunk.3) $ + */ + +#include "config.h" +/* override variety setting for EVENT */ +#define EVENT + +#include "table.h" + +#include "eventcom.h" +#include "eventpro.h" +#include "misc.h" +#include "mpmtypes.h" + +#include /* assert */ +#include /* size_t */ +#include /* strcmp */ + + +struct EventProcStruct { + Bool partialLog; /* Is this a partial log? */ + EventProcReader reader; /* reader fn */ + void *readerP; /* closure pointer for reader fn */ + Table internTable; /* dictionary of intern ids to symbols */ + Table labelTable; /* dictionary of addrs to intern ids */ + void *cachedEvent; +}; + + +/* error -- error signalling + * + * Should integrate with client exceptions, but that'll do for now. + */ + +#define error(fmt, arg) assert(((void)fmt, FALSE)); + + +/* PointerAdd -- add offset to pointer + * + * Copy of the def in mpm.h which we can't include + */ + +#define PointerAdd(p, s) ((void *)((char *)(p) + (s))) + + +/* sizeAlignUp -- align size_t values up */ + +#define sizeAlignUp(w, a) (((w) + (a) - 1) & ~((size_t)(a) - 1)) + + +/* EventSizeAlign -- Calculate actual size of event in the output + * + * Calculates the actual size of an event in the output, given the size + * of the structure. This has to agree with the writing (EVENT_END). + */ + +#define EventSizeAlign(size) sizeAlignUp(size, sizeof(Word)) + + + +/* Event types */ + + +/* eventTypes -- an array containing info about the event types */ + +typedef struct { + EventType type; + char *name; + size_t code; + size_t length; + char *format; +} eventRecord; + +static eventRecord eventTypes[] = { + {0, "(unused)", 0, 0, "0"}, +#define RELATION(name, code, always, kind, format) \ + {Event##name, #name, code, \ + EventSizeAlign(sizeof(Event##format##Struct)), #format}, +#include "eventdef.h" +#undef RELATION +}; + +#define eventTypeCount (sizeof(eventTypes) / sizeof(eventRecord)) + + +/* eventType2Index -- find index in eventTypes for the given type */ + +static size_t eventType2Index(EventType type) +{ + size_t i; + + for(i = 0; i < eventTypeCount; ++i) + if (eventTypes[i].type == type) + return i; + error("Unknown event type %08lX", type); + return 0; +} + + +/* eventcode2Index -- find index in eventTypes for the given code */ + +static size_t eventCode2Index(EventCode code, Bool errorp) +{ + size_t i; + + for(i = 0; i < eventTypeCount; ++i) + if (eventTypes[i].code == code) + return i; + if (errorp) + error("Unknown event code %08lX", code); + return 0; +} + + +/* EventName2Code -- find event code for the given event name */ + +EventCode EventName2Code(char *name) +{ + size_t i; + + for(i = 0; i < eventTypeCount; ++i) + if (strcmp(eventTypes[i].name, name) == 0) { + assert(eventTypes[i].code <= EventCodeMAX); + return eventTypes[i].code; + } + error("Unknown event name %s", name); + return 0; +} + + +/* EventCode2Name -- find event name for the given event code */ + +char *EventCode2Name(EventCode code) +{ + return eventTypes[eventCode2Index(code, TRUE)].name; +} + + +/* EventCode2Format -- find format for the given event code */ + +char *EventCode2Format(EventCode code) +{ + return eventTypes[eventCode2Index(code, TRUE)].format; +} + + +/* EventGetCode -- get event code of the given event */ + +EventCode EventGetCode(Event event) +{ + size_t i = eventType2Index(event->any.code); + assert(eventTypes[i].code <= EventCodeMAX); + return eventTypes[i].code; +} + + +Bool EventCodeIsValid(EventCode code) +{ + return (eventCode2Index(code, FALSE) != 0); +} + + +/* EventStrings */ + + +/* EventStringEmpty -- an empty event string */ + +EventStringStruct EventStringEmpty = {0, ""}; + + +/* eventStringCopy -- copy an event string */ + +static Res eventStringCopy(EventString *str_o, EventString str) +{ + EventString newStr; + + newStr = (EventString)malloc(offsetof(EventStringStruct, str) + + str->len); + if (newStr == NULL) return ResMEMORY; + newStr->len = str->len; + memcpy(&(newStr->str), &(str->str), str->len); + *str_o = newStr; + return ResOK; +} + + +static void eventStringDestroy(EventString str) +{ + free(str); +} + + +/* Labels */ + + +/* Symbol -- representation of an interned string */ + +typedef struct symbolStruct { + Word id; + EventString name; +} symbolStruct; +typedef struct symbolStruct *Symbol; + + +/* Label -- representation of a labelled address */ + +typedef struct labelStruct { + Word id; + Word time; + Addr addr; +} labelStruct; +typedef struct labelStruct *Label; + + +/* AddrLabel -- return intern id for given addr (or 0 if none) */ + +Word AddrLabel(EventProc proc, Addr addr) +{ + void *entry; + + if (TableLookup(&entry, proc->labelTable, (Word)addr)) + return ((Label)entry)->id; + else + return (Word)0; +} + + +/* LabelText -- return text for given intern id (or NULL if none) */ + +EventString LabelText(EventProc proc, Word id) +{ + void *entry; + + if (TableLookup(&entry, proc->internTable, id)) + return ((Symbol)entry)->name; + else + return NULL; +} + + +/* Processing */ + + +/* EventRead -- read one event from the file and allocate descriptor */ + +#define internStrOffset (offsetof(EventWSStruct, s1.str)) + +Res EventRead(Event *eventReturn, EventProc proc) +{ + size_t index, length; + Res res; + EventType type; + Event event; + void *restOfEvent; + + res = proc->reader(proc->readerP, &type, sizeof(EventType)); + if (res != ResOK) return res; + + index = eventType2Index(type); + length = eventTypes[index].length; + if (proc->cachedEvent != NULL) { + event = proc->cachedEvent; + proc->cachedEvent = NULL; + } else { + /* This is too long for most events, but never mind. */ + event = (Event)malloc(sizeof(EventUnion)); + if (event == NULL) return ResMEMORY; + } + + event->any.code = type; + restOfEvent = PointerAdd(event, sizeof(EventType)); + if (type == EventIntern) { /* the only string event */ + /* read enough to get the length */ + res = proc->reader(proc->readerP, restOfEvent, + internStrOffset - sizeof(EventType)); + if (res != ResOK) return res; + /* read the rest */ + res = proc->reader(proc->readerP, &(event->ws.s1.str), + /* Length must agree with EVENT_WS. */ + EventSizeAlign(internStrOffset + event->ws.s1.len) + - internStrOffset); + if (res != ResOK) return res; + } else { + res = proc->reader(proc->readerP, restOfEvent, + length - sizeof(EventType)); + if (res != ResOK) return res; + } + *eventReturn = event; + return ResOK; +} + + +/* EventRecord -- record event in databases + * + * Currently only labels are tracked, but perhaps there will be other + * stuff in the future. + */ + +Res EventRecord(EventProc proc, Event event, Word etime) +{ + Res res; + + switch(event->any.code) { + case EventIntern: { /* id, label */ + Symbol sym = malloc(sizeof(symbolStruct)); + + if (sym == NULL) return ResMEMORY; + sym->id = event->ws.w0; + res = eventStringCopy(&(sym->name), &(event->ws.s1)); + if (res != ResOK) { + free(sym); + return res; + } + res = TableDefine(proc->internTable, sym->id, sym); + } break; + case EventLabel: { /* addr, id */ + Label label = malloc(sizeof(labelStruct)); + void *entry; + + if (label == NULL) return ResMEMORY; + label->id = event->aw.w1; + if (!proc->partialLog) { + assert(TableLookup(&entry, proc->internTable, label->id)); + } + label->time = etime; + label->addr = event->aw.a0; + if (TableLookup(&entry, proc->labelTable, (Word)label->addr)) + res = TableRedefine(proc->labelTable, (Word)label->addr, label); + else + res = TableDefine(proc->labelTable, (Word)label->addr, label); + } break; + default: + res = ResOK; + break; + } + return res; +} + + +/* EventDestroy -- destroy an event */ + +void EventDestroy(EventProc proc, Event event) +{ + if (proc->cachedEvent == NULL) + proc->cachedEvent = event; + else + free(event); +} + + +/* initialization and finishing */ + + +/* Checking macros, copied from check.h */ + +#define CHECKLVALUE(lv1, lv2) \ + ((void)sizeof((lv1) = (lv2)), (void)sizeof((lv2) = (lv1)), TRUE) + +#define CHECKTYPE(t1, t2) \ + (sizeof(t1) == sizeof(t2) && \ + CHECKLVALUE(*((t1 *)0), *((t2 *)0))) + +#define CHECKFIELDAPPROX(s1, f1, s2, f2) \ + (sizeof(((s1 *)0)->f1) == sizeof(((s2 *)0)->f2) && \ + offsetof(s1, f1) == offsetof(s2, f2)) + +#define CHECKFIELD(s1, f1, s2, f2) \ + (CHECKFIELDAPPROX(s1, f1, s2, f2) && \ + CHECKLVALUE(((s1 *)0)->f1, ((s2 *)0)->f2)) + + +/* EventProcCreate -- initialize the module */ + +Res EventProcCreate(EventProc *procReturn, Bool partial, + EventProcReader reader, void *readerP) +{ + Res res; + EventProc proc = malloc(sizeof(struct EventProcStruct)); + + if (proc == NULL) return ResMEMORY; + + /* check event struct access */ + assert(CHECKFIELD(EventUnion, any.code, EventWSStruct, code)); + assert(CHECKFIELD(EventUnion, any.clock, EventWSStruct, clock)); + /* check use of labelTable */ + assert(sizeof(Word) >= sizeof(Addr)); + + proc->partialLog = partial; + proc->reader = reader; proc->readerP = readerP; + res = TableCreate(&proc->internTable, (size_t)1<<4); + if (res != ResOK) goto failIntern; + res = TableCreate(&proc->labelTable, (size_t)1<<7); + if (res != ResOK) goto failLabel; + proc->cachedEvent = NULL; + *procReturn = proc; + return ResOK; + +failLabel: + TableDestroy(proc->internTable); +failIntern: + free(proc); + return res; +} + + +/* EventProcDestroy -- finish the module */ + +static void deallocItem(Word key, void *value) +{ + UNUSED(key); + free(value); +} + +static void deallocSym(Word key, void *value) +{ + UNUSED(key); + eventStringDestroy(((Symbol)value)->name); + free(value); +} + +void EventProcDestroy(EventProc proc) +{ + TableMap(proc->labelTable, deallocItem); + TableMap(proc->internTable, deallocSym); + TableDestroy(proc->labelTable); + TableDestroy(proc->internTable); + if (proc->cachedEvent != NULL) + free(proc->cachedEvent); + free(proc); +} diff --git a/mps/code/eventpro.h b/mps/code/eventpro.h new file mode 100644 index 00000000000..993b673fd7c --- /dev/null +++ b/mps/code/eventpro.h @@ -0,0 +1,41 @@ +/* impl.h.eventpro: Interface for event processing routines + * Copyright (C) 1999 Harlequin Group plc. All rights reserved. + * + * $HopeName: MMsrc!eventpro.h(trunk.3) $ + */ + +#ifndef eventpro_h +#define eventpro_h + +#include "config.h" +/* override variety setting for EVENT */ +#define EVENT + +#include "eventcom.h" +#include "mpmtypes.h" + + +typedef struct EventProcStruct *EventProc; +typedef Res (*EventProcReader)(void *, void *, size_t); + + +extern EventCode EventName2Code(char *name); +extern char *EventCode2Name(EventCode code); +extern EventCode EventGetCode(Event event); +extern char *EventCode2Format(EventCode code); +extern Bool EventCodeIsValid(EventCode code); + +extern Word AddrLabel(EventProc proc, Addr addr); +extern EventString LabelText(EventProc proc, Word label); + +extern Res EventRead(Event *eventReturn, EventProc proc); +extern void EventDestroy(EventProc proc, Event event); + +extern Res EventRecord(EventProc proc, Event event, Word etime); + +extern Res EventProcCreate(EventProc *procReturn, Bool partial, + EventProcReader reader, void *readerP); +extern void EventProcDestroy(EventProc proc); + + +#endif /* eventpro_h */ diff --git a/mps/code/eventrep.c b/mps/code/eventrep.c new file mode 100644 index 00000000000..0d2738e5f45 --- /dev/null +++ b/mps/code/eventrep.c @@ -0,0 +1,736 @@ +/* impl.c.eventrep: Allocation replayer routines + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * $HopeName: MMsrc!eventrep.c(trunk.2) $ + */ + +#include "config.h" +/* override variety setting for EVENT */ +#define EVENT + +#include "eventcom.h" +#include "eventrep.h" +#include "eventpro.h" +#include "mpmtypes.h" + +#include "mps.h" +#include "mpsavm.h" +#include "mpsacl.h" +#include "mpscmv.h" +#include "mpscmvff.h" +#include "mpscepvm.h" +#include "fmtpstst.h" +#include "mpscepdl.h" + +#include "table.h" + +#include /* for size_t */ +#include /* for va_list */ +#include /* for EXIT_FAILURE */ +#include /* for printf */ +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif + + +typedef unsigned long ulong; + + +/* Globals */ + +static ulong totalEvents; /* count of events */ +static ulong discardedEvents; /* count of ignored events */ +static ulong unknownEvents; /* count of unknown events */ + +static Bool partialLog; +static Word eventTime; + +/* Dictionaries for translating from log to replay values */ +static Table arenaTable; /* dictionary of arenas */ +static Table poolTable; /* dictionary of poolReps */ +static Table apTable; /* dictionary of apReps */ + + +/* poolSupport -- describes pool support for explicit deallocation */ + +enum {supportTruncate = 1, supportFree, supportNothing}; +typedef int poolSupport; + + +/* objectTable -- object address mapping structure + * + * .obj-mapping.truncate: Pools that support truncate need to keep track + * of object end points as well. .obj-mapping.partial-free: Arbitrary + * partial free is not supported. + */ + +typedef struct objectTableStruct { + Table startTable; + Table endTable; +} objectTableStruct; +typedef struct objectTableStruct *objectTable; + + +/* poolRep -- pool tracking structure + * + * .pool.object-addr: Pools that support explicit free (or truncate) + * need to maintain a mapping from the addresses in the log to those in + * the replay. + * + * .bufclass: In order to create APs with the correct arguments, the + * replayer has to pick the right BufferInit event to use, as there's + * one for each superclass. The pool determines the buffer class, so + * we store its subclass level in the pool representation. + */ + +typedef struct poolRepStruct { + mps_pool_t pool; /* the replay pool */ + objectTable objects; + int bufferClassLevel; /* subclass level of the buffer class */ +} poolRepStruct; +typedef struct poolRepStruct *poolRep; + + +/* apRep -- ap tracking structure */ + +typedef struct apRepStruct { + mps_ap_t ap; /* the replay ap */ + objectTable objects; /* object mapping for the pool of this ap */ +} apRepStruct; +typedef struct apRepStruct *apRep; + + +/* PointerAdd -- add offset to pointer */ + +#define PointerAdd(p, s) ((void *)((char *)(p) + (s))) +#define PointerSub(p, s) ((void *)((char *)(p) - (s))) + + +/* error -- error signalling */ + +static void error(const char *format, ...) +{ + va_list args; + + fflush(stdout); /* sync */ + fprintf(stderr, "Failed @%lu ", (ulong)eventTime); + va_start(args, format); + vfprintf(stderr, format, args); + fprintf(stderr, "\n"); + va_end(args); + exit(EXIT_FAILURE); +} + + +/* verify, verifyMPS -- check return values + * + * We don't use assert for this, because we want it in release as well. + */ + +#define verifyMPS(res) \ + MPS_BEGIN if ((res) != MPS_RES_OK) error("line %d MPS", __LINE__); MPS_END + +#define verify(cond) \ + MPS_BEGIN if (!(cond)) error("line %d " #cond, __LINE__); MPS_END + + +#ifdef MPS_PROD_EPCORE + + +/* ensurePSFormat -- return the PS format, creating it, if necessary */ + +static mps_fmt_t psFormat = NULL; + +static void ensurePSFormat(mps_fmt_t *fmtOut, mps_arena_t arena) +{ + mps_res_t eres; + + if (psFormat == NULL) { + eres = mps_fmt_create_A(&psFormat, arena, ps_fmt_A()); + verifyMPS(eres); + } + *fmtOut = psFormat; +} + + +/* finishPSFormat -- finish the PS format, if necessary */ + +static void finishPSFormat(void) +{ + if (psFormat != NULL) + mps_fmt_destroy(psFormat); +} + + +#endif + + +/* objectTableCreate -- create an objectTable */ + +static objectTable objectTableCreate(poolSupport support) +{ + if (support != supportNothing) { + Res ires; + objectTable table; + + table = malloc(sizeof(objectTableStruct)); + verify(table != NULL); + ires = TableCreate(&table->startTable, (size_t)1<<12); + verify(ires == ResOK); + if (support == supportTruncate) { + ires = TableCreate(&table->endTable, (size_t)1<<12); + verify(ires == ResOK); + } else { + table->endTable = NULL; + } + return table; + } else { + return NULL; + } +} + + +/* objectTableDestroy -- destroy an objectTable */ + +static void objectTableDestroy(objectTable table) +{ + if (table != NULL) { + TableDestroy(table->startTable); + if (table->endTable != NULL) + TableDestroy(table->endTable); + free(table); + } +} + + +/* objDefine -- add a new mapping to an objectTable */ + +static void objDefine(objectTable table, + void *logObj, void *obj, size_t size) +{ + if (table != NULL) { + Res ires; + + ires = TableDefine(table->startTable, (Word)logObj, obj); + verify(ires == ResOK); + if (table->endTable != NULL) { + ires = TableDefine(table->endTable, + (Word)PointerAdd(logObj, size), + PointerAdd(obj, size)); + verify(ires == ResOK); + } + } +} + + +/* objRemove -- look up and remove a mapping in an objectTable */ + +static void objRemove(void **objReturn, objectTable table, + void *logObj, size_t size) +{ + Bool found; + Res ires; + void *obj; + void *end; + void *logEnd; + + found = TableLookup(&obj, table->startTable, (Word)logObj); + if (found) { + ires = TableRemove(table->startTable, (Word)logObj); + verify(ires == ResOK); + if (table->endTable != NULL) { + ires = TableRemove(table->endTable, + (Word)PointerAdd(logObj, size)); + verify(ires == ResOK); + } + *objReturn = obj; + return; + } + /* Must be a truncation. */ + verify(table->endTable != NULL); + logEnd = PointerAdd(logObj, size); + found = TableLookup(&end, table->endTable, (Word)logEnd); + verify(found); + obj = PointerSub(end, size); + /* Remove the old end and insert the new one. */ + ires = TableRemove(table->endTable, (Word)logEnd); + verify(ires == ResOK); + ires = TableDefine(table->endTable, (Word)logObj, obj); + verify(ires == ResOK); + *objReturn = obj; + return; +} + + +/* poolRecreate -- create and record a pool */ + +static void poolRecreate(void *logPool, void *logArena, mps_class_t class, + poolSupport support, int bufferClassLevel, ...) +{ + va_list args; + mps_pool_t pool; + mps_res_t eres; + poolRep rep; + Res ires; + void *entry; + Bool found; + + found = TableLookup(&entry, arenaTable, (Word)logArena); + verify(found); + va_start(args, bufferClassLevel); + eres = mps_pool_create_v(&pool, (mps_arena_t)entry, class, args); + verifyMPS(eres); + va_end(args); + rep = malloc(sizeof(poolRepStruct)); + verify(rep != NULL); + rep->pool = pool; + rep->objects = objectTableCreate(support); + rep->bufferClassLevel = bufferClassLevel; + ires = TableDefine(poolTable, (Word)logPool, (void *)rep); + verify(ires == ResOK); +} + + +/* poolRedestroy -- destroy and derecord a pool */ + +static void poolRedestroy(void *logPool) +{ + Res ires; + void *entry; + Bool found; + poolRep rep; + + found = TableLookup(&entry, poolTable, (Word)logPool); + verify(found); + rep = (poolRep)entry; + mps_pool_destroy(rep->pool); + ires = TableRemove(poolTable, (Word)logPool); + verify(ires == ResOK); + objectTableDestroy(rep->objects); + free(rep); +} + + +/* apRecreate -- create and record an ap */ + +static void apRecreate(void *logAp, void *logPool, ...) +{ + va_list args; + mps_ap_t ap; + poolRep pRep; + apRep aRep; + mps_res_t eres; + Res ires; + void *entry; + Bool found; + + found = TableLookup(&entry, poolTable, (Word)logPool); + verify(found); + pRep = (poolRep)entry; + va_start(args, logPool); + eres = mps_ap_create_v(&ap, pRep->pool, args); + verifyMPS(eres); + va_end(args); + aRep = malloc(sizeof(apRepStruct)); + verify(aRep != NULL); + aRep->ap = ap; + aRep->objects = pRep->objects; + ires = TableDefine(apTable, (Word)logAp, (void *)aRep); + verify(ires == ResOK); +} + + +/* apRedestroy -- destroy and derecord an ap */ + +static void apRedestroy(void *logAp) +{ + Res ires; + void *entry; + Bool found; + apRep rep; + + found = TableLookup(&entry, apTable, (Word)logAp); + verify(found); + rep = (apRep)entry; + mps_ap_destroy(rep->ap); + ires = TableRemove(apTable, (Word)logAp); + verify(ires == ResOK); + free(rep); +} + + +/* EventReplay -- replay event */ + +static arenaJustCreated = FALSE; + +void EventReplay(Event event, Word etime) +{ + mps_res_t eres; + Res ires; + Bool found; + void *entry; + + ++totalEvents; + eventTime = etime; + switch(event->any.code) { + case EventArenaCreateVM: { /* arena, userSize, chunkSize */ + mps_arena_t arena; + + eres = mps_arena_create(&arena, mps_arena_class_vm(), + event->pww.w1); + verifyMPS(eres); + ires = TableDefine(arenaTable, (Word)event->pww.p0, (void *)arena); + verify(ires == ResOK); + arenaJustCreated = TRUE; + } break; + case EventArenaCreateVMNZ: { /* arena, userSize, chunkSize */ + mps_arena_t arena; + + eres = mps_arena_create(&arena, mps_arena_class_vmnz(), + event->pww.w1); + verifyMPS(eres); + ires = TableDefine(arenaTable, (Word)event->pww.p0, (void *)arena); + verify(ires == ResOK); + arenaJustCreated = TRUE; + } break; + case EventArenaCreateCL: { /* arena, size, base */ + mps_arena_t arena; + void *base; + + base = malloc((size_t)event->pwa.w1); + verify(base != NULL); + eres = mps_arena_create(&arena, mps_arena_class_cl(), + (Size)event->pwa.w1, base); + verifyMPS(eres); + ires = TableDefine(arenaTable, (Word)event->pw.p0, (void *)arena); + verify(ires == ResOK); + arenaJustCreated = TRUE; + } break; + case EventArenaDestroy: { /* arena */ + found = TableLookup(&entry, arenaTable, (Word)event->p.p0); + verify(found); +#ifdef MPS_PROD_EPCORE + /* @@@@ assuming there's only one arena at a time */ + finishPSFormat(); +#endif + mps_arena_destroy((mps_arena_t)entry); + ires = TableRemove(arenaTable, (Word)event->pw.p0); + verify(ires == ResOK); + } break; + case EventPoolInitMVFF: { + /* pool, arena, extendBy, avgSize, align, slotHigh, arenaHigh, firstFit */ + poolRecreate(event->ppwwwuuu.p0, event->ppwwwuuu.p1, + mps_class_mvff(), supportFree, 0, + (size_t)event->ppwwwuuu.w2, + (size_t)event->ppwwwuuu.w3, + (size_t)event->ppwwwuuu.w4, + (mps_bool_t)event->ppwwwuuu.u5, + (mps_bool_t)event->ppwwwuuu.u6, + (mps_bool_t)event->ppwwwuuu.u7); + } break; + case EventPoolInitMV: { /* pool, arena, extendBy, avgSize, maxSize */ + /* .pool.control: The control pool will get created just after */ + /* its arena; ignore it. */ + if (!arenaJustCreated) { + poolRecreate(event->ppwww.p0, event->ppwww.p1, + mps_class_mv(), supportFree, 0, (size_t)event->ppwww.w2, + (size_t)event->ppwww.w3, (size_t)event->ppwww.w4); + } else { + arenaJustCreated = FALSE; + } + } break; + case EventPoolInitMFS: { /* pool, arena, extendBy, unitSize */ + /* internal only */ + ++discardedEvents; + } break; + case EventPoolInit: { /* pool, arena, class */ + /* all internal only */ + ++discardedEvents; + } break; +#ifdef MPS_PROD_EPCORE + case EventPoolInitEPVM: { + /* pool, arena, format, maxSaveLevel, saveLevel */ + mps_arena_t arena; + mps_fmt_t format; + + found = TableLookup(&entry, arenaTable, (Word)event->pppuu.p1); + verify(found); + arena = (mps_arena_t)entry; + ensurePSFormat(&format, arena); /* We know what the format is. */ + poolRecreate(event->pppuu.p0, event->pppuu.p1, + mps_class_epvm(), supportNothing, 2, format, + (mps_epvm_save_level_t)event->pppuu.u3, + (mps_epvm_save_level_t)event->pppuu.u4); + } break; + case EventPoolInitEPDL: { + /* pool, arena, isEPDL, extendBy, avgSize, align */ + poolRecreate(event->ppuwww.p0, event->ppuwww.p1, + event->ppuwww.u2 ? mps_class_epdl() : mps_class_epdr(), + event->ppuwww.u2 ? supportTruncate : supportFree, 0, + (size_t)event->ppuwww.w3, (size_t)event->ppuwww.w4, + (size_t)event->ppuwww.w5); + } break; +#endif + case EventPoolFinish: { /* pool */ + found = TableLookup(&entry, poolTable, (Word)event->p.p0); + if (found) { + poolRedestroy(event->p.p0); + } else { + ++discardedEvents; + } + } break; + case EventBufferInit: { /* buffer, pool, isMutator */ + if ((Bool)event->ppu.u2) { + found = TableLookup(&entry, poolTable, (Word)event->ppu.p1); + if (found) { + poolRep rep = (poolRep)entry; + + if(rep->bufferClassLevel == 0) { /* see .bufclass */ + apRecreate(event->ppu.p0, event->ppu.p1); + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } break; + case EventBufferInitSeg: { /* buffer, pool, isMutator */ + if ((Bool)event->ppu.u2) { + found = TableLookup(&entry, poolTable, (Word)event->ppu.p1); + if (found) { + poolRep rep = (poolRep)entry; + + if(rep->bufferClassLevel == 1) { /* see .bufclass */ + apRecreate(event->ppu.p0, event->ppu.p1); + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } break; + case EventBufferInitRank: { /* buffer, pool, isMutator, rank */ + if ((Bool)event->ppuu.u2) { + found = TableLookup(&entry, poolTable, (Word)event->ppuu.p1); + if (found) { + poolRep rep = (poolRep)entry; + + if(rep->bufferClassLevel == 2) { /* see .bufclass */ + apRecreate(event->ppuu.p0, event->ppuu.p1, event->ppuu.u3); + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } break; +#ifdef MPS_PROD_EPCORE + case EventBufferInitEPVM: { /* buffer, pool, isObj */ + found = TableLookup(&entry, poolTable, (Word)event->ppu.p1); + if (found) { + poolRep rep = (poolRep)entry; + + if(rep->bufferClassLevel == 2) { /* see .bufclass */ + apRecreate(event->ppu.p0, event->ppu.p1, (mps_bool_t)event->ppu.u2); + } else { + ++discardedEvents; + } + } else { + ++discardedEvents; + } + } break; +#endif + case EventBufferFinish: { /* buffer */ + found = TableLookup(&entry, apTable, (Word)event->p.p0); + if (found) { + apRedestroy(event->p.p0); + } else { + ++discardedEvents; + } + } break; + case EventBufferReserve: { /* buffer, init, size */ + found = TableLookup(&entry, apTable, (Word)event->paw.p0); + if (found) { + apRep rep = (apRep)entry; + mps_addr_t p; + + eres = mps_reserve(&p, rep->ap, (size_t)event->paw.w2); + verifyMPS(eres); + } else { + ++discardedEvents; + } + } break; + case EventBufferCommit: { /* buffer, p, size, clientClass */ + found = TableLookup(&entry, apTable, (Word)event->pawa.p0); + if (found) { + apRep rep = (apRep)entry; + mps_addr_t obj = rep->ap->init; + mps_bool_t committed; + size_t size = (size_t)event->pawa.w2; + + committed = mps_commit(rep->ap, obj, size); + verifyMPS(committed ? MPS_RES_OK : MPS_RES_FAIL); + objDefine(rep->objects, event->pawa.a1, obj, size); + } else { + ++discardedEvents; + } + } break; + case EventPoolAlloc: { /* pool, obj, size */ + found = TableLookup(&entry, poolTable, (Word)event->paw.p0); + if (found) { + poolRep rep = (poolRep)entry; + void *obj; + size_t size = (size_t)event->paw.w2; + + eres = mps_alloc(&obj, rep->pool, size); + verifyMPS(eres); + objDefine(rep->objects, event->paw.a1, obj, size); + } else { + ++discardedEvents; + } + } break; + case EventPoolFree: { /* pool, obj, size */ + found = TableLookup(&entry, poolTable, (Word)event->paw.p0); + if (found) { + poolRep rep = (poolRep)entry; + void *obj; + size_t size = (size_t)event->paw.w2; + + objRemove(&obj, rep->objects, event->paw.a1, size); + mps_free(rep->pool, obj, size); + } else { + ++discardedEvents; + } + } break; +#ifdef MPS_PROD_EPCORE + case EventPoolPush: { /* pool */ + found = TableLookup(&entry, poolTable, (Word)event->p.p0); + if (found) { + poolRep rep = (poolRep)entry; + + /* It must be EPVM. */ + mps_epvm_save(rep->pool); + } + } break; + case EventPoolPop: { /* pool, level */ + found = TableLookup(&entry, poolTable, (Word)event->pu.p0); + if (found) { + poolRep rep = (poolRep)entry; + + /* It must be EPVM. */ + mps_epvm_restore(rep->pool, (mps_epvm_save_level_t)event->pu.u1); + } + } break; +#endif + case EventCommitLimitSet: { /* arena, limit, succeeded */ + found = TableLookup(&entry, arenaTable, (Word)event->pwu.p0); + verify(found); + eres = mps_arena_commit_limit_set((mps_arena_t)entry, + (size_t)event->pwu.w1); + verifyMPS(((Bool)event->pwu.u2 == (eres == MPS_RES_OK)) + ? MPS_RES_OK : MPS_RES_FAIL); + } break; + case EventSpareCommitLimitSet: { /* arena, limit */ + found = TableLookup(&entry, arenaTable, (Word)event->pw.p0); + verify(found); + (void)mps_arena_spare_commit_limit_set((mps_arena_t)entry, + (size_t)event->pw.w1); + } break; + case EventReservoirLimitSet: { /* arena, limit */ + found = TableLookup(&entry, arenaTable, (Word)event->pw.p0); + verify(found); + mps_reservoir_limit_set((mps_arena_t)entry, (size_t)event->pw.w1); + } break; + case EventVMMap: case EventVMUnmap: + case EventVMCreate: case EventVMDestroy: + case EventArenaWriteFaults: + case EventArenaAlloc: case EventArenaAllocFail: case EventArenaFree: + case EventSegAlloc: case EventSegAllocFail: case EventSegFree: + case EventSegMerge: case EventSegSplit: + case EventBufferFill: case EventBufferEmpty: + case EventCBSInit: case EventMeterInit: case EventMeterValues: + case EventIntern: case EventLabel: { + ++discardedEvents; + } break; + default: { + ++unknownEvents; + if (unknownEvents < 12) /* don't output too much */ + printf("Unknown event @%ld: %s.\n", etime, + EventCode2Name(EventGetCode(event))); + } break; + } +} + + +/* Checking macros, copied from check.h */ + +#define CHECKLVALUE(lv1, lv2) \ + ((void)sizeof((lv1) = (lv2)), (void)sizeof((lv2) = (lv1)), TRUE) + +#define CHECKTYPE(t1, t2) \ + (sizeof(t1) == sizeof(t2) && \ + CHECKLVALUE(*((t1 *)0), *((t2 *)0))) + + +/* CHECKCONV -- check t2 can be cast to t1 without loss */ + +#define CHECKCONV(t1, t2) \ + (sizeof(t1) >= sizeof(t2)) + + +/* EventRepInit -- initialize the module */ + +Res EventRepInit(Bool partial) +{ + Res res; + + /* Check using pointers as keys in the tables. */ + verify(CHECKCONV(Word, void *)); + /* Check storage of MPS opaque handles in the tables. */ + verify(CHECKTYPE(mps_arena_t, void *)); + verify(CHECKTYPE(mps_ap_t, void *)); + /* .event-conv: Conversion of event fields into the types required */ + /* by the MPS functions is justified by the reverse conversion */ + /* being acceptable (which is upto the event log generator). */ + + partialLog = partial; + totalEvents = 0; discardedEvents = 0; unknownEvents = 0; + + res = TableCreate(&arenaTable, (size_t)1); + if (res != ResOK) goto failArena; + res = TableCreate(&poolTable, (size_t)1<<4); + if (res != ResOK) goto failPool; + res = TableCreate(&apTable, (size_t)1<<6); + if (res != ResOK) goto failAp; + + return ResOK; + +failAp: + TableDestroy(poolTable); +failPool: + TableDestroy(arenaTable); +failArena: + return res; +} + + +/* EventRepFinish -- finish the module */ + +void EventRepFinish(void) +{ + /* @@@@ add listing of remaining objects? */ + /* No point in cleaning up the tables, since we're quitting. */ + printf("Replayed %lu and discarded %lu events (%lu unknown).\n", + totalEvents - discardedEvents - unknownEvents, + discardedEvents + unknownEvents, unknownEvents); +} diff --git a/mps/code/eventrep.h b/mps/code/eventrep.h new file mode 100644 index 00000000000..33787b5a16f --- /dev/null +++ b/mps/code/eventrep.h @@ -0,0 +1,24 @@ +/* impl.h.eventrep: Allocation replayer interface + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * $HopeName: MMsrc!eventrep.h(MMdevel_alloc_replay.1) $ + */ + +#ifndef eventrep_h +#define eventrep_h + +#include "config.h" +/* override variety setting for EVENT */ +#define EVENT + +#include "eventcom.h" +#include "mpmtypes.h" + + +extern Res EventRepInit(Bool partial); +extern void EventRepFinish(void); + +extern void EventReplay(Event event, Word etime); + + +#endif /* eventrep_h */ diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c new file mode 100644 index 00000000000..55df9d93beb --- /dev/null +++ b/mps/code/finalcv.c @@ -0,0 +1,180 @@ +/* impl.c.finalcv: FINALIZATION COVERAGE TEST + * + * $HopeName: MMsrc!finalcv.c(trunk.12) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * See design.mps.poolmrg.test. + * + * DEPENDENCIES + * + * This test uses the dylan object format, but the reliance on this + * particular format is not great and could be removed. + * + * NOTES + * + * This code was created by first copying impl.c.weakcv + */ + +#include "testlib.h" +#include "mps.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "fmtdy.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include + + +#define testArenaSIZE ((size_t)16<<20) +#define rootCOUNT 20 +#define churnFACTOR 30 +#define slotSIZE (3*sizeof(mps_word_t)) +#define genCOUNT 2 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +/* tags an integer according to dylan format */ +static mps_word_t dylan_int(mps_word_t x) +{ + return (x << 2)|1; +} + + +/* converts a dylan format int to an int (untags) */ +static mps_word_t dylan_int_int(mps_word_t x) +{ + return x >> 2; +} + + +static void *root[rootCOUNT]; + + +static void churn(mps_ap_t ap) +{ + int i; + mps_addr_t p; + mps_res_t e; + + for(i = 0; i < churnFACTOR; ++i) { + do { + MPS_RESERVE_BLOCK(e, p, ap, 4096); + die(e, "MPS_RESERVE_BLOCK"); + die(dylan_init(p, 4096, root, 1), "dylan_init"); + } while(!mps_commit(ap, p, 4096)); + } + p = NULL; +} + + +static void *test(void *arg, size_t s) +{ + int i; /* index */ + mps_ap_t ap; + mps_fmt_t fmt; + mps_chain_t chain; + mps_pool_t amc; + mps_res_t e; + mps_root_t mps_root[2]; + mps_arena_t arena; + void *p = NULL; + mps_message_t message; + + arena = (mps_arena_t)arg; + (void)s; + + die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + die(mps_pool_create(&amc, arena, mps_class_amc(), fmt, chain), + "pool_create amc\n"); + die(mps_root_create_table(&mps_root[0], arena, MPS_RANK_EXACT, (mps_rm_t)0, + root, (size_t)rootCOUNT), + "root_create\n"); + die(mps_root_create_table(&mps_root[1], arena, MPS_RANK_EXACT, (mps_rm_t)0, + &p, (size_t)1), + "root_create\n"); + die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n"); + + /* design.mps.poolmrg.test.promise.ut.alloc */ + for(i = 0; i < rootCOUNT; ++i) { + do { + MPS_RESERVE_BLOCK(e, p, ap, slotSIZE); + die(e, "MPS_RES_OK"); + die(dylan_init(p, slotSIZE, root, 1), "dylan_init"); + } while(!mps_commit(ap, p, slotSIZE)); + ((mps_word_t *)p)[2] = dylan_int(i); + die(mps_finalize(arena, &p), "finalize\n"); + root[i] = p; + } + p = NULL; + + /* design.mps.poolmrg.test.promise.ut.drop */ + for(i = 0; i < rootCOUNT; ++i) { + if (rnd() % 2 == 0) + root[i] = NULL; + } + + mps_message_type_enable(arena, mps_message_type_finalization()); + + /* design.mps.poolmrg.test.promise.ut.churn */ + while(mps_collections(arena) < 3) { + churn(ap); + while(mps_message_poll(arena)) { + mps_word_t *obj; + mps_word_t objind; + mps_addr_t objaddr; + + /* design.mps.poolmrg.test.promise.ut.message */ + cdie(mps_message_get(&message, arena, mps_message_type_finalization()), + "get"); + mps_message_finalization_ref(&objaddr, arena, message); + obj = objaddr; + objind = dylan_int_int(obj[2]); + printf("Finalizing: object %lu at %p\n", objind, objaddr); + /* design.mps.poolmrg.test.promise.ut.final.check */ + cdie(root[objind] == NULL, "died"); + root[objind] = objaddr; + mps_message_discard(arena, message); + } + } + + /* @@@@ design.mps.poolmrg.test.promise.ut.nofinal.check missing */ + + mps_ap_destroy(ap); + mps_root_destroy(mps_root[1]); + mps_root_destroy(mps_root[0]); + mps_pool_destroy(amc); + mps_chain_destroy(chain); + mps_fmt_destroy(fmt); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create\n"); + die(mps_thread_reg(&thread, arena), "thread_reg\n"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/fmtdy.c b/mps/code/fmtdy.c new file mode 100644 index 00000000000..da45dbc11e5 --- /dev/null +++ b/mps/code/fmtdy.c @@ -0,0 +1,829 @@ +/* impl.c.fmtdy: DYLAN OBJECT FORMAT IMPLEMENTATION + * + * $HopeName: MMsrc!fmtdy.c(trunk.19) $ + * Copyright (C) 1996,1997 Harlequin Group, all rights reserved. + * + * .readership: MPS developers, Dylan developers + * + * .layouts: + * + * All objects, B: + * + * B W pointer to wrapper + * B+1 object body + * + * Forwarded (or padding) one-word objects, B: + * + * B N | 0b01 new address | 1 + * + * Forwarded (or padding) multi-word objects, B: + * + * B N | 0b10 new address | 2 + * B+1 L limit of object (addr of end + 1) + * + * Wrappers, W: + * + * W WW pointer to wrapper wrapper + * W+1 class DylanWorks class pointer (traceable) + * W+2 subtype_mask DylanWorks subtype_mask (untraceable) + * W+3 (FL << 2) | FF fixed part length and format + * W+4 (VS << 3) | VF variable part format and element size + * W+5 (WT << 2) | 1 tagged pattern vector length + * W+6 pattern 0 patterns for fixed part fields + * W+6+WT-1 pattern WT-1 + * + * The wrapper wrapper, WW: + * + * WW WW WW is it's own wrapper + * WW+1 class DylanWorks class of wrappers + * WW+2 subtype_mask DylanWorks subtype_mask for WW + * WW+3 (4 << 2) | 2 wrappers have four patterned fields + * WW+4 (0 << 3) | 0 wrappers have a non-traceable vector + * WW+5 (1 << 2) | 1 one pattern word follows + * WW+6 0b001 only field 0 is traceable + * + * .improve.abstract.access: There are severe common subexpression + * problems. In particular, code for accessing subfields in the + * fh and vh words is repeated. It should be abstracted into + * macros (or functions). This is particularly bad for the vh + * word which has 4 subfields (version, vb, es, vf). + */ + + +#include "fmtdy.h" +#include "mps.h" +#include +#include +#include + +#ifdef MPS_PF_SUS8LC +/* .hack.stderr: builder.lc (LCC) uses Sun's header files. Sun's + * assert.h is broken, as it assumes it can use stderr. We have to + * fix it by supplying stderr. + */ +#include +#endif + + +#define notreached() assert(0) +#define unused(param) ((void)param) + +#ifdef MPS_BUILD_MV + +/* MSVC 2.0 generates a warning for unused(). */ +#ifdef _MSC_VER +#if _MSC_VER < 1000 +#pragma warning(disable: 4705) +#endif +#else /* _MSC_VER */ +#error "Expected _MSC_VER to be defined for builder.mv" +#endif /* _MSC_VER */ + +/* MPS_END causes "constant conditional" warnings. */ +#pragma warning(disable: 4127) + +/* windows.h causes warnings about "unreferenced inline function */ +/* has been removed". */ +#pragma warning(disable: 4514) + +#endif /* MPS_BUILD_MV */ + + +#define ALIGN sizeof(mps_word_t) + +#ifdef FMTDY_COUNTING +#define FMTDY_COUNT(x) x +#define FMTDY_FL_LIMIT 16 +static unsigned long dylan_vff_counts[4*8]; +static unsigned long dylan_fl_counts[FMTDY_FL_LIMIT]; +static unsigned long dylan_fl_oversize_count; +static unsigned long dylan_fw_counts[2]; +#else +#define FMTDY_COUNT(x) +#endif /* FMTDY_COUNTING */ + + +#ifndef NDEBUG + +int dylan_wrapper_check(mps_word_t *w) +{ + mps_word_t *ww; + mps_word_t vh; + mps_word_t version; + mps_word_t reserved; + mps_word_t class; + mps_word_t fh, fl, ff; + mps_word_t vb, es, vf; + mps_word_t vt, t; + + assert(w != NULL); + assert(((mps_word_t)w & 3) == 0); + + /* The first word of the wrapper is a pointer to a wrapper wrapper, */ + /* which always has the same contents. Check it. */ + + /* .improve.unique.wrapper: When this becomes part of the Dylan + * run-time, it would be possible to know the address of a unique + * wrapper wrapper and check that instead. */ + + assert(w[WW] != 0); + assert((w[WW] & 3) == 0); /* wrapper wrapper is aligned */ + ww = (mps_word_t *)w[WW]; + assert(ww[WW] == w[WW]); /* wrapper wrapper is own wrapper */ + assert(ww[WC] != 0); /* wrapper class exists */ + assert((ww[WC] & 3) == 0); /* wrapper class is aligned */ + assert(ww[WF] == (((WS - 1) << 2) | 2)); /* fields with patterns */ + assert((ww[WV] & 0x00ffffff) == 0);/* non-traceable vector */ + /* Code in this file only works for version 2 */ + assert(((ww[WV] >> (MPS_WORD_WIDTH - 8)) & 0xff) == 2); + assert(ww[WS] == ((1 << 2) | 1)); /* one pattern word in wrapper wrapper */ + /* The first field is traceable, the second field can be traced, */ + /* but doesn't need to be. */ + assert((ww[WP] == 1) || (ww[WP] == 3)); + + /* Unpack the wrapper. */ + + class = w[WC]; /* class */ + fh = w[WF]; /* fixed part header word */ + fl = fh >> 2; /* fixed part length */ + ff = fh & 3; /* fixed part format code */ + vh = w[WV]; /* variable part header */ + version = (vh >> (MPS_WORD_WIDTH - 8)) & 0xff; + assert(version == 2); /* Code in this file only works for version 2 */ + reserved = (vh >> 8) & 0xff; + assert(reserved == 0); + vb = (vh >> 16) & 0xff; + es = (vh & 0xff) >> 3;/* element size */ + vf = vh & 7; /* variable part format code */ + vt = w[WS]; /* vector total word (Dylan-tagged) */ + t = vt >> 2; /* vector total length */ + + /* The second word is the class of the wrapped object. */ + /* It would be good to check which pool this is in. */ + + assert(class != 0); /* class exists */ + assert((class & 3) == 0); /* class is aligned */ + + /* The third word contains the fixed part format and length. */ + /* The only illegal format is 3. Anything else is possible, although */ + /* we could do some bound checking on the length if we knew more about */ + /* the surroundings of the object. */ + + /* Fixed part format 3 is reserved. */ + assert(ff != 3); + + /* Zero length fixed part is only legal in format 0. */ + /* Current Dylan run-time does not honour this so I remove it for now */ + /* We probably want this check as then we can scan without having to */ + /* check for 0 fixed length fields as a special case */ + /* assert(ff == 0 || fl != 0); */ + + /* The fourth word contains the variable part format and element */ + /* size. This assumes that DylanWorks is only going to use byte */ + /* vectors in the non-word case. */ + + /* Variable part format 6 is reserved. */ + assert(vf != 6); + + /* There should be no shift in word vector formats. */ + assert((vf & 6) == 4 || es == 0); + + /* The fifth word is the number of patterns in the pattern */ + /* vector. This can be calculated from the fixed part length. */ + /* The word is also tagged like a DylanWorks integer. */ + + assert((vt & 3) == 1); + + /* The pattern vector in the wrapper should be of non-zero length */ + /* only if there is a patterned fixed part. */ + assert(ff == 2 || t == 0); + + /* The number of patterns is (fixed fields+31)/32. */ + assert(ff != 2 || t == ((fl + MPS_WORD_WIDTH - 1) >> MPS_WORD_SHIFT)); + + /* The patterns are random bits, so we can't check them. However, */ + /* the left-over bits in the last pattern should be zero. */ + + assert(ff != 2 || (w[WS+t] >> ((fh>>2) & (MPS_WORD_WIDTH-1))) == 0); + + return 1; +} + +#endif /* NDEBUG */ + + +/* Scan a contiguous array of references in [base, limit). */ +/* This code has been hand-optimised and examined using Metrowerks */ +/* Codewarrior on a 68K and also Microsoft Visual C on a 486. The */ +/* variables in the loop allocate nicely into registers. Alter with */ +/* care. */ + +static mps_res_t dylan_scan_contig(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit) +{ + mps_res_t res; + mps_addr_t *p; /* reference cursor */ + mps_addr_t r; /* reference to be fixed */ + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + loop: if(p >= limit) goto out; + r = *p++; + if(((mps_word_t)r&3) != 0) /* pointers tagged with 0 */ + goto loop; /* not a pointer */ + if(!MPS_FIX1(mps_ss, r)) goto loop; + res = MPS_FIX2(mps_ss, p-1); + if(res == MPS_RES_OK) goto loop; + return res; + out: assert(p == limit); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + +/* Scan weakly a contiguous array of references in [base, limit). */ +/* Only required to scan vectors for Dylan Weak Tables. */ +/* Depends on the vector length field being scannable (ie a tagged */ +/* integer). */ +/* When a reference that has been fixed to NULL is detected the */ +/* corresponding reference in the associated table (pointed to be the */ +/* assoc variable) will be deleted. */ + +static mps_res_t +dylan_scan_contig_weak(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit, + mps_addr_t *objectBase, mps_addr_t *assoc) +{ + mps_addr_t *p; + mps_res_t res; + mps_addr_t r; + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + goto skip_inc; + loop: + ++p; + skip_inc: + if(p >= limit) + goto out; + r = *p; + if(((mps_word_t)r & 3) != 0) /* non-pointer */ + goto loop; + if(!MPS_FIX1(mps_ss, r)) + goto loop; + res = MPS_FIX2(mps_ss, p); + if(res == MPS_RES_OK) { + if(*p == 0 && r != 0) { + if(assoc != NULL) { + assoc[p-objectBase] = 0; /* delete corresponding entry */ + } + } + goto loop; + } + return res; + out: + assert(p == limit); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + + +/* Scan an array of words in [base, limit) using the patterns at pats */ +/* to determine which words can be fixed. */ +/* This code has been hand-optimised and examined using Metrowerks */ +/* Codewarrior on a 68K and also Microsoft Visual C on a 486. The */ +/* variables in the loop allocate nicely into registers. Alter with */ +/* care. */ + +static mps_res_t dylan_scan_pat(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit, + mps_word_t *pats, mps_word_t nr_pats) +{ + mps_res_t res; + mps_word_t *pc = pats;/* pattern cursor */ + mps_word_t pat; /* pattern register */ + mps_addr_t *p; /* reference cursor */ + mps_addr_t *pp; /* inner loop cursor */ + int b; /* bit */ + mps_addr_t r; /* reference to be fixed */ + + unused(nr_pats); + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + goto in; + pat: p += MPS_WORD_WIDTH; + if(p >= limit) goto out; + in: pp = p; + pat = *pc++; + loop: if(pat == 0) goto pat; + ++pp; + b = (int)(pat & 1); + pat >>= 1; + if(b == 0) goto loop; + r = *(pp-1); + if(((mps_word_t)r&3) != 0) /* pointers tagged with 0 */ + goto loop; /* not a pointer */ + if(!MPS_FIX1(mps_ss, r)) goto loop; + res = MPS_FIX2(mps_ss, pp-1); + if(res == MPS_RES_OK) goto loop; + return res; + out: assert(p < limit + MPS_WORD_WIDTH); + assert(pc == pats + nr_pats); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + +#define NONWORD_LENGTH(_vt, _es) \ + ((_es) < MPS_WORD_SHIFT ? \ + ((_vt) + (1 << (MPS_WORD_SHIFT - (_es))) - 1) >> \ + (MPS_WORD_SHIFT - (_es)) : \ + (_vt) << ((_es) - MPS_WORD_SHIFT)) + +static mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io) +{ + mps_addr_t *p; /* cursor in object */ + mps_addr_t *q; /* cursor limit for loops */ + mps_word_t h; /* header word */ + mps_word_t *w; /* pointer to wrapper */ + mps_word_t fh; /* fixed part header word */ + mps_word_t fl; /* fixed part length, in words */ + mps_word_t vh; /* variable part header */ + mps_word_t vf; /* variable part format */ + mps_word_t vl; /* variable part actual length */ + unsigned vb; /* vector bias */ + unsigned es; /* variable part element size (log2 of bits) */ + mps_word_t vt; /* total vector length */ + mps_res_t res; + + assert(object_io != NULL); + + p = (mps_addr_t *)*object_io; + assert(p != NULL); + + h = (mps_word_t)p[0]; /* load the header word */ + + /* If the object is forwarded, simply skip it. */ + if(h & 3) { + mps_addr_t l; + + if((h & 3) == 1) { + /* single-word */ + l = (mps_addr_t)(p + 1); + FMTDY_COUNT(++dylan_fw_counts[0]); + } else { /* multi-word */ + assert((h & 3) == 2); + l = (mps_addr_t)p[1]; + FMTDY_COUNT(++dylan_fw_counts[1]); + } + + *object_io = l; + return MPS_RES_OK; + } + + mps_fix(mps_ss, p); /* fix the wrapper */ + w = (mps_word_t *)p[0]; /* wrapper is header word */ + assert(dylan_wrapper_check(w)); + + ++p; /* skip header */ + + /* Fixed Part */ + + fh = w[WF]; + fl = fh >> 2; /* get the fixed part length */ + + /* It might be worth inlining common cases here, for example, */ + /* pairs. This can be done by examining fh as a whole. */ + + FMTDY_COUNT(fl < FMTDY_FL_LIMIT ? ++dylan_fl_counts[fl] : + ++dylan_fl_oversize_count); + if(fl > 0) { + q = p + fl; /* set q to end of fixed part */ + switch(fh & 3) { /* switch on the fixed format */ + case 0: /* all non-traceable fields */ + p = q; + break; + + case 1: /* all traceable fields */ + res = dylan_scan_contig(mps_ss, p, q); + if(res) return res; + break; + + case 2: /* patterns */ + res = dylan_scan_pat(mps_ss, p, q, &w[WP], w[WS]>>2); + if(res) return res; + break; + + default: + notreached(); + break; + } + p = q; + } + + /* Variable Part */ + vh = w[WV]; + vf = vh & 7; /* get variable part format */ + FMTDY_COUNT(++dylan_vff_counts[(vf << 2)|(fh&3)]); + if(vf != 7) + { + vt = *(mps_word_t *)p; /* total vector length */ + assert((vt & 3) == 1); /* check Dylan integer tag */ + vt >>= 2; /* untag it */ + ++p; + + switch(vf) + { + case 0: /* non-stretchy non-traceable */ + p += vt; + break; + + case 1: /* stretchy non-traceable */ + notreached(); /* Not used by DylanWorks yet */ + p += vt + 1; + break; + + case 2: /* non-stretchy traceable */ + q = p + vt; + res = dylan_scan_contig(mps_ss, p, q); + if(res) return res; + p = q; + break; + + case 3: /* stretchy traceable */ + notreached(); /* DW doesn't create them yet */ + vl = *(mps_word_t *)p; /* vector length */ + assert((vl & 3) == 1); /* check Dylan integer tag */ + vl >>= 2; /* untag it */ + ++p; + res = dylan_scan_contig(mps_ss, p, p + vl); + if(res) return res; + p += vt; /* skip to end of whole vector */ + break; + + case 4: /* non-word */ + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es); + break; + + case 5: /* stretchy non-word */ + notreached(); /* DW doesn't create them yet */ + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es) + 1; + break; + + default: + notreached(); + break; + } + } + + *object_io = (mps_addr_t)p; + return MPS_RES_OK; +} + +static mps_res_t dylan_scan(mps_ss_t mps_ss, + mps_addr_t base, mps_addr_t limit) +{ + mps_res_t res; + + while(base < limit) { + res = dylan_scan1(mps_ss, &base); + if(res) return res; + } + + assert(base == limit); + + return MPS_RES_OK; +} + +/* dylan_class -- return pointer indicating class of object + * + * Return wrapper pointer, except for broken hearts or padding + */ + +static mps_addr_t dylan_class(mps_addr_t obj) +{ + mps_word_t first_word = ((mps_word_t *)obj)[0]; + + if((first_word & 3) != 0) /* broken heart or padding */ + return NULL; + else + return (mps_addr_t)first_word; +} + +static mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io) +{ + mps_addr_t *assoc; + mps_addr_t *base; + mps_addr_t *p, q; + mps_res_t res; + mps_word_t *w; + mps_word_t fword, ff, fl; + mps_word_t h; + mps_word_t vword, vf, vl; + + assert(object_io != NULL); + base = (mps_addr_t *)*object_io; + assert(base != NULL); + p = base; + + h = (mps_word_t)p[0]; + /* object should not be forwarded (as there is no forwarding method) */ + assert((h & 3) == 0); + + mps_fix(mps_ss, p); + + /* w points to wrapper */ + w = (mps_word_t *)p[0]; + + assert(dylan_wrapper_check(w)); + + ++p; /* skip header */ + + fword = w[WF]; + fl = fword >> 2; + /* weak vectors should have at least one fixed field */ + /* (for assoc field) */ + assert(fl >= 1); + + ff = fword & 3; + + /* weak vectors should have traceable fixed format */ + assert(ff == 1); + + assoc = (mps_addr_t *)p[0]; + + vword = w[WV]; + vf = vword & 7; + vl = (mps_word_t)p[fl] >> 2; + + /* weak vectors should be non-stretchy traceable */ + assert(vf == 2); + + /* q is end of the object. There are fl fixed fields, vl variable */ + /* fields and another slot that contains the vector length */ + q = p + fl + vl + 1; + + res = dylan_scan_contig_weak(mps_ss, p, q, base, assoc); + if(res != MPS_RES_OK) { + return res; + } + + *object_io = q; + return MPS_RES_OK; +} + + +static mps_res_t dylan_scan_weak(mps_ss_t mps_ss, + mps_addr_t base, mps_addr_t limit) +{ + mps_res_t res; + + while(base < limit) { + res = dylan_scan1_weak(mps_ss, &base); + if(res) return res; + } + + assert(base == limit); + + return MPS_RES_OK; +} + +static mps_addr_t dylan_skip(mps_addr_t object) +{ + mps_addr_t *p; /* cursor in object */ + mps_word_t *w; /* wrapper cursor */ + mps_word_t h; /* header word */ + mps_word_t vh; /* variable part header */ + mps_word_t vf; /* variable part format */ + mps_word_t vt; /* total vector length */ + unsigned vb; /* vector bias */ + unsigned es; /* variable part element size (log2 of bits) */ + + p = (mps_addr_t *)object; + assert(p != NULL); + + h = (mps_word_t)p[0]; /* load the header word */ + + /* If the object is forwarded, simply skip it. */ + if(h & 3) { + mps_addr_t l; + + if((h & 3) == 1) /* single-word */ + l = (mps_addr_t)(p + 1); + else { /* multi-word */ + assert((h & 3) == 2); + l = (mps_addr_t)p[1]; + } + + return l; + } + + w = (mps_word_t *)h; /* load the fixed wrapper */ + assert(dylan_wrapper_check(w)); + ++p; + + p += w[WF] >> 2; /* skip fixed part fields */ + + vh = w[WV]; + vf = vh & 7; /* get variable part format */ + if(vf != 7) + { + vt = *(mps_word_t *)p; + assert((vt & 3) == 1); /* check Dylan integer tag */ + vt = vt >> 2; /* total length */ + ++p; + + p += vf & 1; /* stretchy vectors have an extra word */ + + if((vf & 6) == 4) /* non-word */ + { + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es); + } + else + p += vt; + } + + return (mps_addr_t)p; +} + +static void dylan_copy(mps_addr_t old, mps_addr_t new) +{ + size_t length = (char *)dylan_skip(old) - (char *)old; + assert(dylan_wrapper_check(*(mps_word_t **)old)); + /* .improve.memcpy: Can do better here as we know that new and old + * will be aligned (to MPS_PF_ALIGN) */ + memcpy(new, old, length); +} + +static void dylan_no_copy(mps_addr_t old, mps_addr_t new) +{ + unused(old); unused(new); + notreached(); +} + +static mps_addr_t dylan_isfwd(mps_addr_t object) +{ + mps_word_t h, tag; + + h = *(mps_word_t *)object; + tag = h & 3; + if(tag != 0) + return (mps_addr_t)(h - tag); + else + return NULL; +} + +static mps_addr_t dylan_no_isfwd(mps_addr_t object) +{ + unused(object); + notreached(); + return 0; +} + +static void dylan_fwd(mps_addr_t old, mps_addr_t new) +{ + mps_word_t *p; + mps_addr_t limit; + + assert(dylan_isfwd(old) == NULL); + assert(((mps_word_t)new & 3) == 0); + + p = (mps_word_t *)old; + limit = dylan_skip(old); + if(limit == &p[1]) /* single-word object? */ + p[0] = (mps_word_t)new | 1; + else { + p[0] = (mps_word_t)new | 2; + p[1] = (mps_word_t)limit; + } +} + +static void dylan_no_fwd(mps_addr_t old, mps_addr_t new) +{ + unused(old); unused(new); + notreached(); +} + +void dylan_pad(mps_addr_t addr, size_t size) +{ + mps_word_t *p; + + p = (mps_word_t *)addr; + if(size == sizeof(mps_word_t)) /* single-word object? */ + p[0] = 1; + else { + p[0] = 2; + p[1] = (mps_word_t)((char *)addr + size); + } +} + +static void dylan_no_pad(mps_addr_t addr, size_t size) +{ + unused(addr); unused(size); + notreached(); +} + +static struct mps_fmt_A_s dylan_fmt_A_s = +{ + ALIGN, + dylan_scan, + dylan_skip, + dylan_copy, + dylan_fwd, + dylan_isfwd, + dylan_pad +}; + +static struct mps_fmt_A_s dylan_fmt_A_weak_s = +{ + ALIGN, + dylan_scan_weak, + dylan_skip, + dylan_no_copy, + dylan_no_fwd, + dylan_no_isfwd, + dylan_no_pad +}; + +mps_fmt_A_s *dylan_fmt_A(void) +{ + return &dylan_fmt_A_s; +} + +mps_fmt_A_s *dylan_fmt_A_weak(void) +{ + return &dylan_fmt_A_weak_s; +} + + +static struct mps_fmt_B_s dylan_fmt_B_s = +{ + ALIGN, + dylan_scan, + dylan_skip, + dylan_copy, + dylan_fwd, + dylan_isfwd, + dylan_pad, + dylan_class +}; + +static struct mps_fmt_B_s dylan_fmt_B_weak_s = +{ + ALIGN, + dylan_scan_weak, + dylan_skip, + dylan_no_copy, + dylan_no_fwd, + dylan_no_isfwd, + dylan_no_pad, + dylan_class +}; + +mps_fmt_B_s *dylan_fmt_B(void) +{ + return &dylan_fmt_B_s; +} + +mps_fmt_B_s *dylan_fmt_B_weak(void) +{ + return &dylan_fmt_B_weak_s; +} + + +/* Now we have format variety-independent version that pick the right + * format variety and create it. + */ + +mps_res_t dylan_fmt(mps_fmt_t *mps_fmt_o, mps_arena_t arena) +{ + return mps_fmt_create_B(mps_fmt_o, arena, dylan_fmt_B()); +} + +mps_res_t dylan_fmt_weak(mps_fmt_t *mps_fmt_o, mps_arena_t arena) +{ + return mps_fmt_create_B(mps_fmt_o, arena, dylan_fmt_B_weak()); +} + + +mps_bool_t dylan_check(mps_addr_t addr) +{ + assert(addr != 0); + assert(((mps_word_t)addr & (ALIGN-1)) == 0); + assert(dylan_wrapper_check((mps_word_t *)((mps_word_t *)addr)[0])); + /* .assert.unused: Asserts throw away their conditions */ + /* in hot varieties, so UNUSED is needed. */ + unused(addr); + return 1; +} diff --git a/mps/code/fmtdy.h b/mps/code/fmtdy.h new file mode 100644 index 00000000000..10d26cbb5ef --- /dev/null +++ b/mps/code/fmtdy.h @@ -0,0 +1,44 @@ +/* impl.h.fmtdy: DYLAN OBJECT FORMAT + * + * $HopeName: MMsrc!fmtdy.h(trunk.6) $ + * Copyright (C) 1997 Harlequin Group, all rights reserved + */ + +#ifndef fmtdy_h +#define fmtdy_h + +#include "mps.h" + +/* Format */ +extern mps_fmt_A_s *dylan_fmt_A(void); +extern mps_fmt_A_s *dylan_fmt_A_weak(void); +extern mps_fmt_B_s *dylan_fmt_B(void); +extern mps_fmt_B_s *dylan_fmt_B_weak(void); +extern mps_res_t dylan_fmt(mps_fmt_t *, mps_arena_t); +extern mps_res_t dylan_fmt_weak(mps_fmt_t *, mps_arena_t); + + +/* Used only for debugging / testing */ +extern mps_res_t dylan_init(mps_addr_t addr, size_t size, + mps_addr_t *refs, size_t nr_refs); +extern void dylan_write(mps_addr_t addr, + mps_addr_t *refs, size_t nr_refs); +extern mps_addr_t dylan_read(mps_addr_t addr); +extern mps_bool_t dylan_check(mps_addr_t addr); +extern void dylan_pad(mps_addr_t addr, size_t size); +extern int dylan_wrapper_check(mps_word_t *w); + +/* Constants describing wrappers. Used only for debugging / testing */ +#define WW 0 /* offset of Wrapper-Wrapper */ +#define WC 1 /* offset of Class pointer*/ +#define WM 2 /* offset of subtype Mask */ +#define WF 3 /* offset of Fixed part descriptor */ +#define WV 4 /* offset of Vector part descriptor */ +#define WS 5 /* offset of Size field for pattern vector */ +#define WP 6 /* offset of Pattern 0, if present */ + +#define BASIC_WRAPPER_SIZE (WS + 1) /* size of wrapper with no patterns */ + +#define ALIGN sizeof(mps_word_t) /* alignment for Dylan format */ + +#endif /* fmtdy_h */ diff --git a/mps/code/fmtdytst.c b/mps/code/fmtdytst.c new file mode 100644 index 00000000000..c39ee3ce8b3 --- /dev/null +++ b/mps/code/fmtdytst.c @@ -0,0 +1,140 @@ +/* impl.c.fmtdytst: DYLAN FORMAT TEST CODE + * + * $HopeName: MMsrc!fmtdytst.c(trunk.5) $ + * Copyright (C) 1998 Harlequin Group. All rights reserved. + * + * .readership: MPS developers, Dylan developers. + */ + +#include "fmtdy.h" +#include "mps.h" +#include "testlib.h" +#include +#include +#include + + +#ifdef MPS_BUILD_MV +/* windows.h causes warnings about "unreferenced inline function */ +/* has been removed". */ +#pragma warning(disable: 4514) +#endif /* MPS_BUILD_MV */ + +#ifdef MPS_PF_SUS8LC +/* .hack.malloc: builder.lc (LCC) uses Sun's header files. Sun's + * stdlib.h is broken, as it has an incorrect declaration of malloc. + * We fix that here in a very hacky way. + */ +#define malloc(x) (void *)malloc(x) +#endif /* MPS_PF_SUS8LC */ + + +static mps_word_t *ww = NULL; +static mps_word_t *tvw; + + +static mps_word_t dylan_make_WV(mps_word_t version, mps_word_t vb, + mps_word_t es, mps_word_t vf) +{ + assert((version & ((1 << 8) - 1)) == version); + assert((vb & ((1 << 8) - 1)) == vb); + assert((es & ((1 << 5) - 1)) == es); + assert((vf & ((1 << 3) - 1)) == vf); + + /* VERSION- ... VB------ reserved ES---VF- */ + return((version << (MPS_WORD_WIDTH - 8)) | + (vb << 16) | + (es << 3) | + vf); +} + + +mps_res_t dylan_init(mps_addr_t addr, size_t size, + mps_addr_t *refs, size_t nr_refs) +{ + + /* Make sure the size is aligned. */ + assert((size & (ALIGN-1)) == 0); + + if(ww == NULL) { + ww = malloc(sizeof(mps_word_t) * (BASIC_WRAPPER_SIZE + 1)); + if(ww == NULL) return MPS_RES_MEMORY; + tvw = malloc(sizeof(mps_word_t) * BASIC_WRAPPER_SIZE); + if(tvw == NULL) { + free(ww); + return MPS_RES_MEMORY; + } + + /* Build a wrapper wrapper. */ + ww[WW] = (mps_word_t)ww; + ww[WC] = (mps_word_t)ww; /* dummy class */ + ww[WM] = (1 << 2) | 1; /* dummy subtype_mask */ + ww[WF] = ((WS - 1) << 2) | 2; + ww[WV] = dylan_make_WV(2, 0, 0, 0); + ww[WS] = (1 << 2) | 1; + ww[WP] = 1; + + /* Build a wrapper for traceable vectors. */ + tvw[WW] = (mps_word_t)ww; + tvw[WC] = (mps_word_t)ww; /* dummy class */ + tvw[WM] = (1 << 2) | 1; /* dummy subtype_mask */ + tvw[WF] = 0; /* no fixed part */ + tvw[WV] = dylan_make_WV(2, 0, 0, 2); /* traceable variable part */ + tvw[WS] = 1; /* no patterns */ + } + + /* If there is enough room, make a vector, otherwise just */ + /* make a padding object. */ + + if(size >= sizeof(mps_word_t) * 2) { + mps_word_t *p = (mps_word_t *)addr; + mps_word_t i, t = (size / sizeof(mps_word_t)) - 2; + + p[0] = (mps_word_t)tvw; /* install vector wrapper */ + p[1] = (t << 2) | 1; /* tag the vector length */ + for(i = 0; i < t; ++i) { + mps_word_t r = rnd(); + + if(r & 1) + p[2+i] = ((r & ~(mps_word_t)3) | 1); /* random int */ + else + p[2+i] = (mps_word_t)refs[(r >> 1) % nr_refs]; /* random ptr */ + } + } else + dylan_pad(addr, size); + + return MPS_RES_OK; +} + + +void dylan_write(mps_addr_t addr, mps_addr_t *refs, size_t nr_refs) +{ + mps_word_t *p = (mps_word_t *)addr; + mps_word_t t = p[1] >> 2; + + /* If the object is a vector, update a random entry. */ + if(p[0] == (mps_word_t)tvw && t > 0) { + mps_word_t r = rnd(); + size_t i = 2 + (rnd() % t); + + if(r & 1) + p[i] = ((r & ~(mps_word_t)3) | 1); /* random int */ + else + p[i] = (mps_word_t)refs[(r >> 1) % nr_refs]; /* random ptr */ + } +} + + +mps_addr_t dylan_read(mps_addr_t addr) +{ + mps_word_t *p = (mps_word_t *)addr; + + /* If the object is a vector, return a random entry. */ + if(p[0] == (mps_word_t)tvw) { + mps_word_t t = p[1] >> 2; + if(t > 0) + return (mps_addr_t)p[2 + (rnd() % t)]; + } + + return addr; +} diff --git a/mps/code/fmthe.c b/mps/code/fmthe.c new file mode 100644 index 00000000000..148c37d5c10 --- /dev/null +++ b/mps/code/fmthe.c @@ -0,0 +1,609 @@ +/* impl.c.fmthe: DYLAN-LIKE OBJECT FORMAT WITH HEADERS + * + * $HopeName: MMsrc!fmthe.c(trunk.1) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .source: This was derived from impl.c.fmtdy -- it's probably a good idea to + * keep them in sync and share improvements. + * + * .layouts: + * + * All objects, B: + * + * B W pointer to wrapper + * B+1 object body + * + * Forwarded (or padding) one-word objects, B: + * + * B N | 0b01 new address | 1 + * + * Forwarded (or padding) multi-word objects, B: + * + * B N | 0b10 new address | 2 + * B+1 L limit of object (addr of end + 1) + * + * Wrappers, W: + * + * W WW pointer to wrapper wrapper + * W+1 class DylanWorks class pointer (traceable) + * W+2 subtype_mask DylanWorks subtype_mask (untraceable) + * W+3 (FL << 2) | FF fixed part length and format + * W+4 (VS << 3) | VF variable part format and element size + * W+5 (WT << 2) | 1 tagged pattern vector length + * W+6 pattern 0 patterns for fixed part fields + * W+6+WT-1 pattern WT-1 + * + * The wrapper wrapper, WW: + * + * WW WW WW is it's own wrapper + * WW+1 class DylanWorks class of wrappers + * WW+2 subtype_mask DylanWorks subtype_mask for WW + * WW+3 (4 << 2) | 2 wrappers have four patterned fields + * WW+4 (0 << 3) | 0 wrappers have a non-traceable vector + * WW+5 (1 << 2) | 1 one pattern word follows + * WW+6 0b001 only field 0 is traceable + */ + + +#include "fmthe.h" +#include "mps.h" + +#include +#include + +#include "mpstd.h" +#ifdef MPS_PF_SUS8LC +/* .hack.stderr: builder.lc (LCC) uses Sun's header files. Sun's + * assert.h is broken, as it assumes it can use stderr. We have to + * fix it by supplying stderr. + */ +#include +/* Better include ossu.h as well, in case we use other stuff from stdio.h. */ +#include "ossu.h" +#endif + +#include "testlib.h" + + +#define assert(cond) Insist(cond) +#define notreached() assert(0) +#define unused(param) ((void)(param)) + + +#ifdef FMTDY_COUNTING +#define FMTDY_COUNT(x) x +#define FMTDY_FL_LIMIT 16 +static unsigned long dylan_vff_counts[4*8]; +static unsigned long dylan_fl_counts[FMTDY_FL_LIMIT]; +static unsigned long dylan_fl_oversize_count; +static unsigned long dylan_fw_counts[2]; +#else +#define FMTDY_COUNT(x) +#endif /* FMTDY_COUNTING */ + + +static int dylan_wrapper_check(mps_word_t *w) +{ + mps_word_t *ww; + mps_word_t vh; + mps_word_t version; + mps_word_t reserved; + mps_word_t class; + mps_word_t fh, fl, ff; + mps_word_t vb, es, vf; + mps_word_t vt, t; + + assert(w != NULL); + assert(((mps_word_t)w & 3) == 0); + + /* The first word of the wrapper is a pointer to a wrapper wrapper, */ + /* which always has the same contents. Check it. */ + + /* .improve.unique.wrapper: When this becomes part of the Dylan + * run-time, it would be possible to know the address of a unique + * wrapper wrapper and check that instead. */ + + assert(w[WW] != 0); + assert((w[WW] & 3) == 0); /* wrapper wrapper is aligned */ + ww = (mps_word_t *)w[WW]; + assert(ww[WW] == w[WW]); /* wrapper wrapper is own wrapper */ + assert(ww[WC] != 0); /* wrapper class exists */ + assert((ww[WC] & 3) == 0); /* wrapper class is aligned */ + assert(ww[WF] == (((WS - 1) << 2) | 2)); /* fields with patterns */ + assert((ww[WV] & 0x00ffffff) == 0);/* non-traceable vector */ + /* Code in this file only works for version 2 */ + assert(((ww[WV] >> (MPS_WORD_WIDTH - 8)) & 0xff) == 2); + assert(ww[WS] == ((1 << 2) | 1)); /* one pattern word in wrapper wrapper */ + /* The first field is traceable, the second field can be traced, */ + /* but doesn't need to be. */ + assert((ww[WP] == 1) || (ww[WP] == 3)); + + /* Unpack the wrapper. */ + + class = w[WC]; /* class */ + fh = w[WF]; /* fixed part header word */ + fl = fh >> 2; /* fixed part length */ + ff = fh & 3; /* fixed part format code */ + vh = w[WV]; /* variable part header */ + version = (vh >> (MPS_WORD_WIDTH - 8)) & 0xff; + assert(version == 2); /* Code in this file only works for version 2 */ + reserved = (vh >> 8) & 0xff; + assert(reserved == 0); + vb = (vh >> 16) & 0xff; + es = (vh & 0xff) >> 3;/* element size */ + vf = vh & 7; /* variable part format code */ + vt = w[WS]; /* vector total word (Dylan-tagged) */ + t = vt >> 2; /* vector total length */ + + /* The second word is the class of the wrapped object. */ + /* It would be good to check which pool this is in. */ + + assert(class != 0); /* class exists */ + assert((class & 3) == 0); /* class is aligned */ + + /* The third word contains the fixed part format and length. */ + /* The only illegal format is 3. Anything else is possible, although */ + /* we could do some bound checking on the length if we knew more about */ + /* the surroundings of the object. */ + + /* Fixed part format 3 is reserved. */ + assert(ff != 3); + + /* Zero length fixed part is only legal in format 0. */ + /* Current Dylan run-time does not honour this so I remove it for now */ + /* We probably want this check as then we can scan without having to */ + /* check for 0 fixed length fields as a special case */ + /* assert(ff == 0 || fl != 0); */ + + /* The fourth word contains the variable part format and element */ + /* size. This assumes that DylanWorks is only going to use byte */ + /* vectors in the non-word case. */ + + /* Variable part format 6 is reserved. */ + assert(vf != 6); + + /* There should be no shift in word vector formats. */ + assert((vf & 6) == 4 || es == 0); + + /* The fifth word is the number of patterns in the pattern */ + /* vector. This can be calculated from the fixed part length. */ + /* The word is also tagged like a DylanWorks integer. */ + + assert((vt & 3) == 1); + + /* The pattern vector in the wrapper should be of non-zero length */ + /* only if there is a patterned fixed part. */ + assert(ff == 2 || t == 0); + + /* The number of patterns is (fixed fields+31)/32. */ + assert(ff != 2 || t == ((fl + MPS_WORD_WIDTH - 1) >> MPS_WORD_SHIFT)); + + /* The patterns are random bits, so we can't check them. However, */ + /* the left-over bits in the last pattern should be zero. */ + + assert(ff != 2 || (w[WS+t] >> ((fh>>2) & (MPS_WORD_WIDTH-1))) == 0); + + return 1; +} + + +/* Scan a contiguous array of references in [base, limit). */ +/* This code has been hand-optimised and examined using Metrowerks */ +/* Codewarrior on a 68K and also Microsoft Visual C on a 486. The */ +/* variables in the loop allocate nicely into registers. Alter with */ +/* care. */ + +static mps_res_t dylan_scan_contig(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit) +{ + mps_res_t res; + mps_addr_t *p; /* reference cursor */ + mps_addr_t r; /* reference to be fixed */ + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + loop: if(p >= limit) goto out; + r = *p++; + if(((mps_word_t)r&3) != 0) /* pointers tagged with 0 */ + goto loop; /* not a pointer */ + if(!MPS_FIX1(mps_ss, r)) goto loop; + res = MPS_FIX2(mps_ss, p-1); + if(res == MPS_RES_OK) goto loop; + return res; + out: assert(p == limit); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + + +/* dylan_scan_pat -- scan according to pattern + * + * Scan an array of words in [base, limit) using the patterns at pats + * to determine which words can be fixed. + */ + +static mps_res_t dylan_scan_pat(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit, + mps_word_t *pats, mps_word_t nr_pats) +{ + mps_res_t res; + mps_word_t *pc = pats;/* pattern cursor */ + mps_word_t pat; /* pattern register */ + mps_addr_t *p; /* reference cursor */ + mps_addr_t *pp; /* inner loop cursor */ + int b; /* bit */ + mps_addr_t r; /* reference to be fixed */ + + unused(nr_pats); + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + goto in; + pat: p += MPS_WORD_WIDTH; + if(p >= limit) goto out; + in: pp = p; + pat = *pc++; + loop: if(pat == 0) goto pat; + ++pp; + b = (int)(pat & 1); + pat >>= 1; + if(b == 0) goto loop; + r = *(pp-1); + if(((mps_word_t)r&3) != 0) /* pointers tagged with 0 */ + goto loop; /* not a pointer */ + if(!MPS_FIX1(mps_ss, r)) goto loop; + res = MPS_FIX2(mps_ss, pp-1); + if(res == MPS_RES_OK) goto loop; + return res; + out: assert(p < limit + MPS_WORD_WIDTH); + assert(pc == pats + nr_pats); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + + +#define AddHeader(p) ((mps_addr_t)((char*)(p) + headerSIZE)) + + +#define NONWORD_LENGTH(_vt, _es) \ + ((_es) < MPS_WORD_SHIFT ? \ + ((_vt) + (1 << (MPS_WORD_SHIFT - (_es))) - 1) >> \ + (MPS_WORD_SHIFT - (_es)) : \ + (_vt) << ((_es) - MPS_WORD_SHIFT)) + +static mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io) +{ + mps_addr_t *p; /* cursor in object */ + mps_addr_t *q; /* cursor limit for loops */ + mps_word_t h; /* header word */ + mps_word_t *w; /* pointer to wrapper */ + mps_word_t fh; /* fixed part header word */ + mps_word_t fl; /* fixed part length, in words */ + mps_word_t vh; /* variable part header */ + mps_word_t vf; /* variable part format */ + mps_word_t vl; /* variable part actual length */ + unsigned vb; /* vector bias */ + unsigned es; /* variable part element size (log2 of bits) */ + mps_word_t vt; /* total vector length */ + mps_res_t res; + int* header; + + assert(object_io != NULL); + + p = (mps_addr_t *)*object_io; + assert(p != NULL); + + header = (int*)((char*)p - headerSIZE); + if (*header != realTYPE) { + switch (*header) { + case pad1TYPE: *object_io = (mps_addr_t)((char*)p + 4); break; + case pad2TYPE: *object_io = (mps_addr_t)((char*)p + 8); break; + default: notreached(); break; + } + return MPS_RES_OK; + } + + h = (mps_word_t)p[0]; /* load the header word */ + + /* If the object is forwarded, simply skip it. */ + if(h & 3) { + mps_addr_t l; + + if((h & 3) == 1) { + /* single-word */ + l = AddHeader(p + 1); + FMTDY_COUNT(++dylan_fw_counts[0]); + } else { /* multi-word */ + assert((h & 3) == 2); + l = (mps_addr_t)p[1]; + FMTDY_COUNT(++dylan_fw_counts[1]); + } + + *object_io = l; + return MPS_RES_OK; + } + + mps_fix(mps_ss, p); /* fix the wrapper */ + w = (mps_word_t *)p[0]; /* wrapper is header word */ + assert(dylan_wrapper_check(w)); + + ++p; /* skip header */ + + /* Fixed Part */ + + fh = w[WF]; + fl = fh >> 2; /* get the fixed part length */ + + /* It might be worth inlining common cases here, for example, */ + /* pairs. This can be done by examining fh as a whole. */ + + FMTDY_COUNT(fl < FMTDY_FL_LIMIT ? ++dylan_fl_counts[fl] : + ++dylan_fl_oversize_count); + if(fl > 0) { + q = p + fl; /* set q to end of fixed part */ + switch(fh & 3) { /* switch on the fixed format */ + case 0: /* all non-traceable fields */ + p = q; + break; + + case 1: /* all traceable fields */ + res = dylan_scan_contig(mps_ss, p, q); + if(res) return res; + break; + + case 2: /* patterns */ + res = dylan_scan_pat(mps_ss, p, q, &w[WP], w[WS]>>2); + if(res) return res; + break; + + default: + notreached(); + break; + } + p = q; + } + + /* Variable Part */ + vh = w[WV]; + vf = vh & 7; /* get variable part format */ + FMTDY_COUNT(++dylan_vff_counts[(vf << 2)|(fh&3)]); + if(vf != 7) + { + vt = *(mps_word_t *)p; /* total vector length */ + assert((vt & 3) == 1); /* check Dylan integer tag */ + vt >>= 2; /* untag it */ + ++p; + + switch(vf) + { + case 0: /* non-stretchy non-traceable */ + p += vt; + break; + + case 1: /* stretchy non-traceable */ + notreached(); /* Not used by DylanWorks yet */ + p += vt + 1; + break; + + case 2: /* non-stretchy traceable */ + q = p + vt; + res = dylan_scan_contig(mps_ss, p, q); + if(res) return res; + p = q; + break; + + case 3: /* stretchy traceable */ + notreached(); /* DW doesn't create them yet */ + vl = *(mps_word_t *)p; /* vector length */ + assert((vl & 3) == 1); /* check Dylan integer tag */ + vl >>= 2; /* untag it */ + ++p; + res = dylan_scan_contig(mps_ss, p, p + vl); + if(res) return res; + p += vt; /* skip to end of whole vector */ + break; + + case 4: /* non-word */ + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es); + break; + + case 5: /* stretchy non-word */ + notreached(); /* DW doesn't create them yet */ + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es) + 1; + break; + + default: + notreached(); + break; + } + } + + *object_io = AddHeader(p); + return MPS_RES_OK; +} + + +static mps_res_t dylan_scan(mps_ss_t mps_ss, + mps_addr_t base, mps_addr_t limit) +{ + mps_res_t res; + mps_addr_t p = base; + + while(p < limit) { + res = dylan_scan1(mps_ss, &p); + if(res) return res; + } + + assert(p <= AddHeader(limit)); + + return MPS_RES_OK; +} + + +static mps_addr_t dylan_skip(mps_addr_t object) +{ + mps_addr_t *p; /* cursor in object */ + mps_word_t *w; /* wrapper cursor */ + mps_word_t h; /* header word */ + mps_word_t vh; /* variable part header */ + mps_word_t vf; /* variable part format */ + mps_word_t vt; /* total vector length */ + unsigned vb; /* vector bias */ + unsigned es; /* variable part element size (log2 of bits) */ + int* header; + + p = (mps_addr_t *)object; + assert(p != NULL); + + header = (int*)((char*)object - headerSIZE); + if (*header != realTYPE) { + switch (*header) { + case pad1TYPE: return (mps_addr_t)((char*)object + 4); break; + case pad2TYPE: return (mps_addr_t)((char*)object + 8); break; + default: assert(0 == 1); break; + } + } + + h = (mps_word_t)p[0]; /* load the header word */ + + /* If the object is forwarded, simply skip it. */ + if(h & 3) { + if((h & 3) == 1) /* single-word */ + return AddHeader(p + 1); + else { /* multi-word */ + assert((h & 3) == 2); + return (mps_addr_t)p[1]; + } + } + + w = (mps_word_t *)h; /* load the fixed wrapper */ + assert(dylan_wrapper_check(w)); + ++p; + + p += w[WF] >> 2; /* skip fixed part fields */ + + vh = w[WV]; + vf = vh & 7; /* get variable part format */ + if(vf != 7) + { + vt = *(mps_word_t *)p; + assert((vt & 3) == 1); /* check Dylan integer tag */ + vt = vt >> 2; /* total length */ + ++p; + + p += vf & 1; /* stretchy vectors have an extra word */ + + if((vf & 6) == 4) /* non-word */ + { + es = (vh & 0xff) >> 3; + vb = (vh >> 16) & 0xff; + vt += vb; + p += NONWORD_LENGTH(vt, es); + } + else + p += vt; + } + + return AddHeader(p); +} + + +static mps_addr_t dylan_isfwd(mps_addr_t object) +{ + mps_word_t h, tag; + int *header; + + header = (int*)((char*)object - headerSIZE); + if (*header != realTYPE) { + return NULL; + } + + h = *(mps_word_t *)object; + tag = h & 3; + if(tag != 0) + return (mps_addr_t)(h - tag); + else + return NULL; +} + + +static void dylan_fwd(mps_addr_t old, mps_addr_t new) +{ + mps_word_t *p; + mps_addr_t limit; + + assert(dylan_isfwd(old) == NULL); + assert(((mps_word_t)new & 3) == 0); + + p = (mps_word_t *)old; + limit = dylan_skip(old); + if(limit == &p[1]) /* single-word object? */ + p[0] = (mps_word_t)new | 1; + else { + p[0] = (mps_word_t)new | 2; + p[1] = (mps_word_t)limit; + } +} + + +static void dylan_pad(mps_addr_t addr, size_t fullSize) +{ + mps_word_t *p; + size_t size; + + p = (mps_word_t *)AddHeader(addr); + size = fullSize - headerSIZE; + if (fullSize <= headerSIZE) { + *(int*)addr = (fullSize == 4) ? pad1TYPE : pad2TYPE; + } else { + *(int*)addr = realTYPE; + if(size == sizeof(mps_word_t)) /* single-word object? */ + p[0] = 1; + else { + p[0] = 2; + p[1] = (mps_word_t)AddHeader((char *)addr + fullSize); + } + } +} + + +/* HeaderFormat -- format descriptor for this format */ + +static struct mps_fmt_auto_header_s HeaderFormat = +{ + ALIGN, + dylan_scan, + dylan_skip, + dylan_fwd, + dylan_isfwd, + dylan_pad, + (size_t)headerSIZE +}; + + +/* EnsureHeaderFormat -- create a format object for this format */ + +mps_res_t EnsureHeaderFormat(mps_fmt_t *mps_fmt_o, mps_arena_t arena) +{ + return mps_fmt_create_auto_header(mps_fmt_o, arena, &HeaderFormat); +} + + +/* HeaderFormatCheck -- check an object in this format */ + +mps_res_t HeaderFormatCheck(mps_addr_t addr) +{ + if (addr != 0 && ((mps_word_t)addr & (ALIGN-1)) == 0 + && dylan_wrapper_check((mps_word_t *)((mps_word_t *)addr)[0])) + return MPS_RES_OK; + else + return MPS_RES_FAIL; +} diff --git a/mps/code/fmthe.h b/mps/code/fmthe.h new file mode 100644 index 00000000000..58bbe03f7b8 --- /dev/null +++ b/mps/code/fmthe.h @@ -0,0 +1,38 @@ +/* impl.h.fmthe: DYLAN-LIKE OBJECT FORMAT WITH HEADERS + * + * $HopeName$ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + */ + +#ifndef fmthe_h +#define fmthe_h + +#include "mps.h" + + +/* Format */ +extern mps_res_t EnsureHeaderFormat(mps_fmt_t *, mps_arena_t); +extern mps_res_t HeaderFormatCheck(mps_addr_t addr); + + +/* Constants describing wrappers. Used only for debugging / testing */ +#define WW 0 /* offset of Wrapper-Wrapper */ +#define WC 1 /* offset of Class pointer*/ +#define WM 2 /* offset of subtype Mask */ +#define WF 3 /* offset of Fixed part descriptor */ +#define WV 4 /* offset of Vector part descriptor */ +#define WS 5 /* offset of Size field for pattern vector */ +#define WP 6 /* offset of Pattern 0, if present */ + +#define BASIC_WRAPPER_SIZE (WS + 1) /* size of wrapper with no patterns */ + +#define ALIGN sizeof(mps_word_t) /* alignment for Dylan format */ + + +#define headerSIZE (8) +#define realTYPE 0 +#define pad1TYPE 1 +#define pad2TYPE 2 + + +#endif /* fmthe_h */ diff --git a/mps/code/format.c b/mps/code/format.c new file mode 100644 index 00000000000..c5403e15c5e --- /dev/null +++ b/mps/code/format.c @@ -0,0 +1,154 @@ +/* impl.c.format: OBJECT FORMATS + * + * $HopeName: MMsrc!format.c(trunk.20) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * See protocol.mps.format. + */ + +#include "mpm.h" + +SRCID(format, "$HopeName: MMsrc!format.c(trunk.20) $"); + + +/* FormatCheck -- check a format */ + +Bool FormatCheck(Format format) +{ + CHECKS(Format, format); + CHECKU(Arena, format->arena); + CHECKL(format->serial < format->arena->formatSerial); + CHECKL(format->variety == FormatVarietyA + || format->variety == FormatVarietyB + || format->variety == FormatVarietyAutoHeader); + CHECKL(RingCheck(&format->arenaRing)); + CHECKL(AlignCheck(format->alignment)); + /* @@@@ alignment should be less than maximum allowed */ + CHECKL(FUNCHECK(format->scan)); + CHECKL(FUNCHECK(format->skip)); + CHECKL(FUNCHECK(format->move)); + CHECKL(FUNCHECK(format->isMoved)); + /* Ignore unused copy field. */ + CHECKL(FUNCHECK(format->pad)); + CHECKL(FUNCHECK(format->class)); + + return TRUE; +} + + +static Addr FormatDefaultClass(Addr object) +{ + AVER(object != NULL); + + return ((Addr *)object)[0]; +} + + +/* FormatCreate -- create a format */ + +Res FormatCreate(Format *formatReturn, Arena arena, + Align alignment, + FormatVariety variety, + FormatScanMethod scan, + FormatSkipMethod skip, + FormatMoveMethod move, + FormatIsMovedMethod isMoved, + FormatCopyMethod copy, + FormatPadMethod pad, + FormatClassMethod class, + Size headerSize) +{ + Format format; + Res res; + void *p; + + AVER(formatReturn != NULL); + + res = ControlAlloc(&p, arena, sizeof(FormatStruct), + /* withReservoirPermit */ FALSE); + if(res != ResOK) + return res; + format = (Format)p; /* avoid pun */ + + format->arena = arena; + RingInit(&format->arenaRing); + format->alignment = alignment; + format->variety = variety; + format->scan = scan; + format->skip = skip; + format->move = move; + format->isMoved = isMoved; + format->copy = copy; + format->pad = pad; + if(class == NULL) { + format->class = &FormatDefaultClass; + } else { + AVER(variety == FormatVarietyB); + format->class = class; + } + if(headerSize != 0) { + AVER(variety == FormatVarietyAutoHeader); + format->headerSize = headerSize; + } else { + format->headerSize = 0; + } + + format->sig = FormatSig; + format->serial = arena->formatSerial; + ++arena->formatSerial; + + AVERT(Format, format); + + RingAppend(&arena->formatRing, &format->arenaRing); + + *formatReturn = format; + return ResOK; +} + + +void FormatDestroy(Format format) +{ + AVERT(Format, format); + + RingRemove(&format->arenaRing); + + format->sig = SigInvalid; + + RingFinish(&format->arenaRing); + + ControlFree(format->arena, format, sizeof(FormatStruct)); +} + + +/* Must be thread safe. See design.mps.interface.c.thread-safety. */ +Arena FormatArena(Format format) +{ + /* Can't AVER format as that would not be thread-safe */ + /* AVERT(Format, format); */ + return format->arena; +} + + +Res FormatDescribe(Format format, mps_lib_FILE *stream) +{ + Res res; + + res = WriteF(stream, + "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial, + " arena $P ($U)\n", + (WriteFP)format->arena, (WriteFU)format->arena->serial, + " alignment $W\n", (WriteFW)format->alignment, + " scan $F\n", (WriteFF)format->scan, + " skip $F\n", (WriteFF)format->skip, + " move $F\n", (WriteFF)format->move, + " isMoved $F\n", (WriteFF)format->isMoved, + " copy $F\n", (WriteFF)format->copy, + " pad $F\n", (WriteFF)format->pad, + "} Format $P ($U)\n", (WriteFP)format, (WriteFU)format->serial, + NULL); + if(res != ResOK) return res; + + return ResOK; +} diff --git a/mps/code/gathconf.bat b/mps/code/gathconf.bat new file mode 100644 index 00000000000..3f544dbdd19 --- /dev/null +++ b/mps/code/gathconf.bat @@ -0,0 +1,32 @@ +@rem impl.bat.gathconf: GATHERING A RELEASE FOR CONFIGURA +@rem +@rem $HopeName: MMsrc!gathconf.bat(trunk.1) $ +@rem Copyright (C) 2000 Harlequin Limited. All rights reserved. + +mkdir release +mkdir release\include +mkdir release\lib +mkdir release\lib\w3i3 +mkdir release\lib\w3i3\release +mkdir release\lib\w3i3\debug +mkdir release\src +copy mps.h release\include +copy mpsavm.h release\include +copy mpsacl.h release\include +copy mpscamc.h release\include +copy mpscams.h release\include +copy mpsclo.h release\include +copy mpscmv.h release\include +copy mpscmvff.h release\include +copy mpscsnc.h release\include +copy mpsio.h release\include +copy mpslib.h release\include +copy mpstd.h release\include +copy mpsw3.h release\include +copy mpswin.h release\include +copy w3i3mv\we\mps_conf.lib release\lib\w3i3\release +copy w3i3mv\ce\mps_conf.lib release\lib\w3i3\debug +copy w3i3mv\we\mpsplan.lib release\lib\w3i3\release +copy w3i3mv\ce\mpsplan.lib release\lib\w3i3\debug +copy mpsliban.c release\src +copy mpsioan.c release\src diff --git a/mps/code/gc.gmk b/mps/code/gc.gmk new file mode 100644 index 00000000000..a28c127b778 --- /dev/null +++ b/mps/code/gc.gmk @@ -0,0 +1,30 @@ +# impl.gmk.gc: GNUMAKEFILE FRAGMENT FOR GNU CC +# +# $HopeName: MMsrc!gc.gmk(trunk.25) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This file is included by platform makefiles that use the GNU CC +# compiler. It defines the compiler-specific variables that the +# common makefile fragment (impl.gmk.comm) requires. + +CC = gcc +CFLAGSCOMPILER := \ + -ansi -pedantic -Wall -Werror -Wpointer-arith \ + -Wstrict-prototypes -Wmissing-prototypes \ + -Winline -Waggregate-return -Wnested-externs \ + -Wcast-qual -Wshadow +CFLAGSDEBUG = -g -ggdb3 +CFLAGSOPT = -O -g -ggdb3 +CFLAGSOPTNODEBUG = -O -g0 + +# gcc -MM generates a dependency line of the form: +# thing.o : thing.c ... +# The sed line converts this into: +# //thing.o //thing.d : thing.c ... +# If interrupted, this is liable to leave a zero-length file behind. + +define gendep + $(SHELL) -ec "$(CC) $(CFLAGS) -MM $< | \ + sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@" + [ -s $@ ] || rm -f $@ +endef diff --git a/mps/code/global.c b/mps/code/global.c new file mode 100644 index 00000000000..88dd8299a07 --- /dev/null +++ b/mps/code/global.c @@ -0,0 +1,789 @@ +/* impl.c.global: ARENA-GLOBAL INTERFACES + * + * $HopeName: MMsrc!global.c(trunk.12) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .sources: See design.mps.arena. design.mps.thread-safety is relevant + * to the functions ArenaEnter and ArenaLeave in this file. + * + * + * TRANSGRESSIONS + * + * .static: Static data is used in ArenaAccess (in order to find the + * appropriate arena) and GlobalsInit. It's checked in GlobalsCheck. + * See design.mps.arena.static. + * + * .non-mod: The Globals structure has many fields which properly belong + * to other modules (see impl.h.mpmst); GlobalsInit contains code which + * breaks the usual module abstractions. Such instances are documented + * with a tag to the relevant module implementation. Most of the + * functions should be in some other module, they just ended up here by + * confusion over naming. */ + +#include "dongle.h" +#include "poolmrg.h" +#include "mps.h" /* finalization */ +#include "poolmv.h" +#include "mpm.h" + + +SRCID(global, "$HopeName: MMsrc!global.c(trunk.12) $"); + + +/* All static data objects are declared here. See .static */ + +/* design.mps.arena.static.ring.init */ +static Bool arenaRingInit = FALSE; +static RingStruct arenaRing; /* design.mps.arena.static.ring */ + + +/* ArenaControlPool -- get the control pool */ + +#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct) + + +/* arenaClaimRingLock, arenaReleaseRingLock -- lock/release the arena ring + * + * See design.mps.arena.static.ring.lock. */ + +static void arenaClaimRingLock(void) +{ + LockClaimGlobal(); /* claim the global lock to protect arenaRing */ +} + +static void arenaReleaseRingLock(void) +{ + LockReleaseGlobal(); /* release the global lock protecting arenaRing */ +} + + +/* arenaAnnounce -- add a new arena into the global ring of arenas + * + * On entry, the arena must not be locked (there should be no need, + * because other threads can't know about it). On exit, it will be. */ + +static void arenaAnnounce(Arena arena) +{ + Globals arenaGlobals; + + /* arena checked in ArenaEnter */ + + arenaClaimRingLock(); + ArenaEnter(arena); + arenaGlobals = ArenaGlobals(arena); + AVERT(Globals, arenaGlobals); + RingAppend(&arenaRing, &arenaGlobals->globalRing); + arenaReleaseRingLock(); +} + + +/* arenaDenounce -- remove an arena from the global ring of arenas + * + * After this, no other thread can access the arena through ArenaAccess. + * On entry, the arena should be locked. On exit, it will still be, but + * the lock has been released and reacquired in the meantime, so callers + * should not assume anything about the state of the arena. */ + +static void arenaDenounce(Arena arena) +{ + Globals arenaGlobals; + + AVERT(Arena, arena); + + /* Temporarily give up the arena lock to avoid deadlock, */ + /* see design.mps.thread-safety.deadlock. */ + ArenaLeave(arena); + + /* Detach the arena from the global list. */ + arenaClaimRingLock(); + ArenaEnter(arena); + arenaGlobals = ArenaGlobals(arena); + AVERT(Globals, arenaGlobals); + RingRemove(&arenaGlobals->globalRing); + arenaReleaseRingLock(); +} + + +/* GlobalsCheck -- check the arena globals */ + +Bool GlobalsCheck(Globals arenaGlobals) +{ + Arena arena; + TraceId ti; + Trace trace; + Index i; + Size depth; + RefSet rs; + Rank rank; + + CHECKS(Globals, arenaGlobals); + arena = GlobalsArena(arenaGlobals); + CHECKL(RingCheck(&arenaGlobals->globalRing)); + + CHECKL(MPSVersion() == arenaGlobals->mpsVersionString); + + if (arenaGlobals->lock != NULL) + CHECKD_NOSIG(Lock, arenaGlobals->lock); + + /* no check possible on pollThreshold */ + CHECKL(BoolCheck(arenaGlobals->insidePoll)); + CHECKL(BoolCheck(arenaGlobals->clamped)); + CHECKL(arenaGlobals->fillMutatorSize >= 0.0); + CHECKL(arenaGlobals->emptyMutatorSize >= 0.0); + CHECKL(arenaGlobals->allocMutatorSize >= 0.0); + CHECKL(arenaGlobals->fillMutatorSize - arenaGlobals->emptyMutatorSize + >= arenaGlobals->allocMutatorSize); + CHECKL(arenaGlobals->fillInternalSize >= 0.0); + CHECKL(arenaGlobals->emptyInternalSize >= 0.0); + + CHECKL(BoolCheck(arenaGlobals->bufferLogging)); + CHECKL(RingCheck(&arenaGlobals->poolRing)); + CHECKL(RingCheck(&arenaGlobals->rootRing)); + CHECKL(RingCheck(&arena->formatRing)); + CHECKL(RingCheck(&arena->messageRing)); + /* Don't check enabledMessageTypes */ + CHECKL(BoolCheck(arena->isFinalPool)); + if (arena->isFinalPool) { + CHECKD(Pool, arena->finalPool); + } else { + CHECKL(arena->finalPool == NULL); + } + + CHECKL(RingCheck(&arena->threadRing)); + + CHECKL(BoolCheck(arena->insideShield)); + CHECKL(arena->shCacheLimit <= ShieldCacheSIZE); + CHECKL(arena->shCacheI < arena->shCacheLimit); + CHECKL(BoolCheck(arena->suspended)); + + depth = 0; + for (i = 0; i < arena->shCacheLimit; ++i) { + Seg seg = arena->shCache[i]; + if (seg != NULL) { + CHECKD(Seg, seg); + depth += SegDepth(seg); + } + } + CHECKL(depth <= arena->shDepth); + + CHECKL(TraceSetCheck(arena->busyTraces)); + CHECKL(TraceSetCheck(arena->flippedTraces)); + CHECKL(TraceSetSuper(arena->busyTraces, arena->flippedTraces)); + + TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena) + /* design.mps.arena.trace */ + if (TraceSetIsMember(arena->busyTraces, trace)) { + CHECKD(Trace, trace); + } else { + /* design.mps.arena.trace.invalid */ + CHECKL(trace->sig == SigInvalid); + } + TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena); + for(rank = 0; rank < RankLIMIT; ++rank) + CHECKL(RingCheck(&arena->greyRing[rank])); + CHECKL(RingCheck(&arena->chainRing)); + + /* can't write a check for arena->epoch */ + + /* check that each history entry is a subset of the next oldest */ + rs = RefSetEMPTY; + /* note this loop starts from 1; there is no history age 0 */ + for (i=1; i <= LDHistoryLENGTH; ++ i) { + /* check history age 'i'; 'j' is the history index. */ + Index j = (arena->epoch + LDHistoryLENGTH - i) % LDHistoryLENGTH; + CHECKL(RefSetSub(rs, arena->history[j])); + rs = arena->history[j]; + } + /* the oldest history entry must be a subset of the prehistory */ + CHECKL(RefSetSub(rs, arena->prehistory)); + + /* we also check the statics now. design.mps.arena.static.check */ + CHECKL(BoolCheck(arenaRingInit)); + CHECKL(RingCheck(&arenaRing)); + + return TRUE; +} + + +/* GlobalsInit -- initialize the globals of the arena */ + +Res GlobalsInit(Globals arenaGlobals) +{ + Arena arena; + Index i; + Rank rank; + + /* This is one of the first things that happens, */ + /* so check static consistency here. */ + AVER(MPMCheck()); + + if (!DongleTestFull()) + return ResFAIL; + + arenaClaimRingLock(); + /* Ensure static things are initialized. */ + if (!arenaRingInit) { + /* there isn't an arena ring yet */ + /* design.mps.arena.static.init */ + arenaRingInit = TRUE; + RingInit(&arenaRing); + ProtSetup(); + } + EventInit(); + arenaReleaseRingLock(); + + arena = GlobalsArena(arenaGlobals); + + RingInit(&arenaGlobals->globalRing); + + arenaGlobals->lock = NULL; + + arenaGlobals->pollThreshold = 0.0; + arenaGlobals->insidePoll = FALSE; + arenaGlobals->clamped = FALSE; + arenaGlobals->fillMutatorSize = 0.0; + arenaGlobals->emptyMutatorSize = 0.0; + arenaGlobals->allocMutatorSize = 0.0; + arenaGlobals->fillInternalSize = 0.0; + arenaGlobals->emptyInternalSize = 0.0; + + arenaGlobals->mpsVersionString = MPSVersion(); + arenaGlobals->bufferLogging = FALSE; + RingInit(&arenaGlobals->poolRing); + arenaGlobals->poolSerial = (Serial)0; + RingInit(&arenaGlobals->rootRing); + arenaGlobals->rootSerial = (Serial)0; + + RingInit(&arena->threadRing); + arena->threadSerial = (Serial)0; + RingInit(&arena->formatRing); + arena->formatSerial = (Serial)0; + RingInit(&arena->messageRing); + arena->enabledMessageTypes = NULL; + arena->isFinalPool = FALSE; + arena->finalPool = NULL; + arena->busyTraces = TraceSetEMPTY; /* impl.c.trace */ + arena->flippedTraces = TraceSetEMPTY; /* impl.c.trace */ + arena->insideShield = FALSE; /* impl.c.shield */ + arena->shCacheI = (Size)0; + arena->shCacheLimit = (Size)1; + arena->shDepth = (Size)0; + arena->suspended = FALSE; + for(i = 0; i < ShieldCacheSIZE; i++) + arena->shCache[i] = NULL; + + for (i=0; i < TraceLIMIT; i++) { + /* design.mps.arena.trace.invalid */ + arena->trace[i].sig = SigInvalid; + } + for(rank = 0; rank < RankLIMIT; ++rank) + RingInit(&arena->greyRing[rank]); + STATISTIC(arena->writeBarrierHitCount = 0); + RingInit(&arena->chainRing); + + arena->epoch = (Epoch)0; /* impl.c.ld */ + arena->prehistory = RefSetEMPTY; + for(i = 0; i < LDHistoryLENGTH; ++i) + arena->history[i] = RefSetEMPTY; + + arenaGlobals->sig = GlobalsSig; + AVERT(Globals, arenaGlobals); + return ResOK; +} + + +/* GlobalsCompleteCreate -- complete creating the globals of the arena + * + * This is like the final initializations in a Create method, except + * there's no separate GlobalsCreate. */ + +Res GlobalsCompleteCreate(Globals arenaGlobals) +{ + Arena arena; + Res res; + void *p; + + AVERT(Globals, arenaGlobals); + arena = GlobalsArena(arenaGlobals); + + /* initialize the message stuff, design.mps.message */ + { + void *v; + + res = ControlAlloc(&v, arena, BTSize(MessageTypeLIMIT), FALSE); + if (res != ResOK) + return res; + arena->enabledMessageTypes = v; + BTResRange(arena->enabledMessageTypes, 0, MessageTypeLIMIT); + } + + res = ControlAlloc(&p, arena, LockSize(), FALSE); + if (res != ResOK) + return res; + arenaGlobals->lock = (Lock)p; + LockInit(arenaGlobals->lock); + + arenaAnnounce(arena); + + return ResOK; + + /* @@@@ error path */ +} + + +/* GlobalsFinish -- finish the globals of the arena */ + +void GlobalsFinish(Globals arenaGlobals) +{ + Arena arena; + Rank rank; + + AVERT(Globals, arenaGlobals); + arena = GlobalsArena(arenaGlobals); + + STATISTIC_STAT(EVENT_PW(ArenaWriteFaults, arena, + arena->writeBarrierHitCount)); + + arenaGlobals->sig = SigInvalid; + + RingFinish(&arena->formatRing); + RingFinish(&arena->messageRing); + RingFinish(&arena->threadRing); + for(rank = 0; rank < RankLIMIT; ++rank) + RingFinish(&arena->greyRing[rank]); + RingFinish(&arenaGlobals->rootRing); + RingFinish(&arenaGlobals->poolRing); + RingFinish(&arenaGlobals->globalRing); +} + + +/* GlobalsPrepareToDestroy -- prepare to destroy the globals of the arena + * + * This is like the final initializations in a Destroy method, except + * there's no separate GlobalsDestroy. */ + +void GlobalsPrepareToDestroy(Globals arenaGlobals) +{ + Arena arena; + + AVERT(Globals, arenaGlobals); + + arena = GlobalsArena(arenaGlobals); + arenaDenounce(arena); + + LockReleaseMPM(arenaGlobals->lock); + /* Theoretically, another thread could grab the lock here, but it's */ + /* not worth worrying about, since an attempt after the lock has been */ + /* destroyed would lead to a crash just the same. */ + LockFinish(arenaGlobals->lock); + + /* .message.queue.empty: Empty the queue of messages before */ + /* proceeding to finish the arena. It is important that this */ + /* is done before destroying the finalization pool as otherwise */ + /* the message queue would have dangling pointers to messages */ + /* whose memory has been unmapped. */ + MessageEmpty(arena); + + /* throw away the BT used by messages */ + if (arena->enabledMessageTypes != NULL) { + ControlFree(arena, (void *)arena->enabledMessageTypes, + BTSize(MessageTypeLIMIT)); + arena->enabledMessageTypes = NULL; + } + + /* destroy the final pool (see design.mps.finalize) */ + if (arena->isFinalPool) { + /* All this subtlety is because PoolDestroy will call */ + /* ArenaCheck several times. The invariant on finalPool */ + /* and isFinalPool should hold before, after, and during */ + /* the PoolDestroy call */ + Pool pool = arena->finalPool; + + arena->isFinalPool = FALSE; + arena->finalPool = NULL; + PoolDestroy(pool); + } +} + + +/* ArenaEnter -- enter the state where you can look at the arena */ + +#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE) +void (ArenaEnter)(Arena arena) +{ + /* Don't need to lock, just check. */ + AVERT(Arena, arena); +} +#else +void ArenaEnter(Arena arena) +{ + AVER(CHECKT(Arena, arena)); + + StackProbe(StackProbeDEPTH); + LockClaim(ArenaGlobals(arena)->lock); + AVERT(Arena, arena); /* can't AVER it until we've got the lock */ + ShieldEnter(arena); +} +#endif + + +/* ArenaLeave -- leave the state where you can look at MPM data structures */ + +#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE) +void (ArenaLeave)(Arena arena) +{ + /* Don't need to lock, just check. */ + AVERT(Arena, arena); +} +#else +void ArenaLeave(Arena arena) +{ + AVERT(Arena, arena); + ShieldLeave(arena); + ProtSync(arena); /* design.mps.prot.if.sync */ + LockReleaseMPM(ArenaGlobals(arena)->lock); +} +#endif + + +/* mps_exception_info -- pointer to exception info + * + * This is a hack to make exception info easier to find in a release + * version. The format is platform-specific. We won't necessarily + * publish this. */ + +MutatorFaultContext mps_exception_info = NULL; + + +/* ArenaAccess -- deal with an access fault + * + * This is called when a protected address is accessed. The mode + * corresponds to which mode flags need to be cleared in order for the + * access to continue. */ + +Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context) +{ + Seg seg; + Ring node, nextNode; + Res res; + + arenaClaimRingLock(); /* design.mps.arena.lock.ring */ + mps_exception_info = context; + AVER(RingCheck(&arenaRing)); + + RING_FOR(node, &arenaRing, nextNode) { + Globals arenaGlobals = RING_ELT(Globals, globalRing, node); + Arena arena = GlobalsArena(arenaGlobals); + Root root; + + ArenaEnter(arena); /* design.mps.arena.lock.arena */ + /* @@@@ The code below assumes that Roots and Segs are disjoint. */ + /* It will fall over (in TraceSegAccess probably) if there is a */ + /* protected root on a segment. */ + /* It is possible to overcome this restriction. */ + if (SegOfAddr(&seg, arena, addr)) { + mps_exception_info = NULL; + arenaReleaseRingLock(); + /* An access in a different thread may have already caused the + * protection to be cleared. This avoids calling TraceAccess on + * protection that has already been cleared on a separate thread. */ + mode &= SegPM(seg); + if (mode != AccessSetEMPTY) { + res = PoolAccess(SegPool(seg), seg, addr, mode, context); + AVER(res == ResOK); /* Mutator can't continue unless this succeeds */ + } + ArenaLeave(arena); + return TRUE; + } else if (RootOfAddr(&root, arena, addr)) { + mps_exception_info = NULL; + arenaReleaseRingLock(); + mode &= RootPM(root); + if (mode != AccessSetEMPTY) + RootAccess(root, mode); + ArenaLeave(arena); + return TRUE; + } + + ArenaLeave(arena); + } + + mps_exception_info = NULL; + arenaReleaseRingLock(); + return FALSE; +} + + +/* ArenaPoll -- trigger periodic actions + * + * Poll all background activities to see if they need to do anything. + * ArenaPoll does nothing if the amount of committed memory is less than + * the arena poll threshold. This means that actions are taken as the + * memory demands increase. + * + * @@@@ This is where time is "stolen" from the mutator in addition + * to doing what it asks and servicing accesses. This is where the + * amount of time should be controlled, perhaps by passing time + * limits to the various other activities. + * + * @@@@ Perhaps this should be based on a process table rather than a + * series of manual steps for looking around. This might be worthwhile + * if we introduce background activities other than tracing. */ + +#ifdef MPS_PROD_EPCORE +void (ArenaPoll)(Globals globals) +{ + /* Don't poll, just check. */ + AVERT(Globals, globals); +} +#else +void ArenaPoll(Globals globals) +{ + double size; + + AVERT(Globals, globals); + + if (!DONGLE_TEST_QUICK()) { + /* Cripple it by deleting the control pool. */ + GlobalsArena(globals)->poolReady = FALSE; /* suppress check */ + PoolFinish(ArenaControlPool(GlobalsArena(globals))); + return; + } + if (globals->clamped) + return; + size = globals->fillMutatorSize; + if (globals->insidePoll || size < globals->pollThreshold) + return; + + globals->insidePoll = TRUE; + + TracePoll(globals); + + size = globals->fillMutatorSize; + globals->pollThreshold = size + ArenaPollALLOCTIME; + AVER(globals->pollThreshold > size); /* enough precision? */ + + globals->insidePoll = FALSE; +} +#endif + + +/* ArenaFinalize -- registers an object for finalization + * + * See design.mps.finalize. */ + +Res ArenaFinalize(Arena arena, Ref obj) +{ + Res res; + + AVERT(Arena, arena); + /* Could consider checking that Ref is valid. */ + + if (!arena->isFinalPool) { + Pool pool; + + res = PoolCreate(&pool, arena, PoolClassMRG()); + if (res != ResOK) + return res; + arena->finalPool = pool; + arena->isFinalPool = TRUE; + } + AVER(arena->isFinalPool); + + res = MRGRegister(arena->finalPool, (Ref)obj); + return res; +} + + +/* Peek / Poke */ + +Ref ArenaPeek(Arena arena, Addr addr) +{ + Seg seg; + Bool b; + + AVERT(Arena, arena); + + b = SegOfAddr(&seg, arena, addr); + if (b) { + return ArenaPeekSeg(arena, seg, addr); + } else { + Ref ref; + ref = *(Ref *)addr; + return ref; + } +} + +Ref ArenaPeekSeg(Arena arena, Seg seg, Addr addr) +{ + Ref ref; + + AVERT(Arena, arena); + AVERT(Seg, seg); + + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + /* Consider checking addr's alignment using seg->pool->alignment */ + + ShieldExpose(arena, seg); + ref = *(Ref *)addr; + ShieldCover(arena, seg); + return ref; +} + +void ArenaPoke(Arena arena, Addr addr, Ref ref) +{ + Seg seg; + Bool b; + + AVERT(Arena, arena); + /* Can't check addr as it is arbitrary */ + /* Can't check ref as it is arbitrary */ + + b = SegOfAddr(&seg, arena, addr); + if (b) { + ArenaPokeSeg(arena, seg, addr, ref); + } else { + *(Ref *)addr = ref; + } +} + +void ArenaPokeSeg(Arena arena, Seg seg, Addr addr, Ref ref) +{ + RefSet summary; + + AVERT(Arena, arena); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + /* Consider checking addr's alignment using seg->pool->alignment */ + /* ref is arbitrary and can't be checked */ + + ShieldExpose(arena, seg); + *(Ref *)addr = ref; + summary = SegSummary(seg); + summary = RefSetAdd(arena, summary, (Addr)ref); + SegSetSummary(seg, summary); + ShieldCover(arena, seg); +} + + +/* ArenaRead -- read a single reference, possibly through a barrier + * + * This forms part of a software barrier. It provides fine-grain access + * to single references in segments. */ + +Ref ArenaRead(Arena arena, Addr addr) +{ + Bool b; + Seg seg; + + AVERT(Arena, arena); + + b = SegOfAddr(&seg, arena, addr); + AVER(b == TRUE); + + /* .read.flipped: We AVER that the reference that we are reading */ + /* refers to an object for which all the traces that the object is */ + /* white for are also flipped. This is because we don't have any */ + /* write-barrier (in the sense of write-barrier collectors) */ + /* mechanism in place for reading (strictly speaking, writing */ + /* it somewhere after having read it) references that are white. */ + AVER(TraceSetSub(SegWhite(seg), arena->flippedTraces)); + + /* .read.conservative: @@@@ Should scan at rank phase-of-trace, */ + /* not RankEXACT which is conservative. See also */ + /* impl.c.trace.scan.conservative for a similar nasty. */ + TraceScanSingleRef(arena->flippedTraces, RankEXACT, arena, + seg, (Ref *)addr); + /* get the possibly fixed reference */ + return ArenaPeekSeg(arena, seg, addr); +} + + +/* GlobalsDescribe -- describe the arena globals */ + +Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream) +{ + Res res; + Arena arena; + Ring node, nextNode; + Index i; + + if (!CHECKT(Globals, arenaGlobals)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + arena = GlobalsArena(arenaGlobals); + res = WriteF(stream, + " mpsVersion $S\n", arenaGlobals->mpsVersionString, + " lock $P\n", (WriteFP)arenaGlobals->lock, + " pollThreshold $U kB\n", + (WriteFU)(arenaGlobals->pollThreshold / 1024), + arenaGlobals->insidePoll ? "inside poll\n" : "outside poll\n", + arenaGlobals->clamped ? "clamped\n" : "released\n", + " fillMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->fillMutatorSize / 1024), + " emptyMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->emptyMutatorSize / 1024), + " allocMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->allocMutatorSize / 1024), + " fillInternalSize $U kB\n", + (WriteFU)(arenaGlobals->fillInternalSize / 1024), + " emptyInternalSize $U kB\n", + (WriteFU)(arenaGlobals->emptyInternalSize / 1024), + " poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial, + " rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial, + " formatSerial $U\n", (WriteFU)arena->formatSerial, + " threadSerial $U\n", (WriteFU)arena->threadSerial, + arena->insideShield ? "inside shield\n" : "outside shield\n", + " busyTraces $B\n", (WriteFB)arena->busyTraces, + " flippedTraces $B\n", (WriteFB)arena->flippedTraces, + /* @@@@ no TraceDescribe function */ + " epoch $U\n", (WriteFU)arena->epoch, + NULL); + if (res != ResOK) return res; + + for(i=0; i < LDHistoryLENGTH; ++ i) { + res = WriteF(stream, + " history[$U] = $B\n", i, arena->history[i], + NULL); + if (res != ResOK) return res; + } + + res = WriteF(stream, + " [note: indices are raw, not rotated]\n" + " prehistory = $B\n", (WriteFB)arena->prehistory, + NULL); + if (res != ResOK) return res; + + res = WriteF(stream, + " suspended $S\n", arena->suspended ? "YES" : "NO", + " shDepth $U\n", arena->shDepth, + " shCacheI $U\n", arena->shCacheI, + /* @@@@ should SegDescribe the cached segs? */ + NULL); + if (res != ResOK) return res; + + res = RootsDescribe(arenaGlobals, stream); + if (res != ResOK) return res; + + RING_FOR(node, &arenaGlobals->poolRing, nextNode) { + Pool pool = RING_ELT(Pool, arenaRing, node); + res = PoolDescribe(pool, stream); + if (res != ResOK) return res; + } + + RING_FOR(node, &arena->formatRing, nextNode) { + Format format = RING_ELT(Format, arenaRing, node); + res = FormatDescribe(format, stream); + if (res != ResOK) return res; + } + + RING_FOR(node, &arena->threadRing, nextNode) { + Thread thread = ThreadRingThread(node); + res = ThreadDescribe(thread, stream); + if (res != ResOK) return res; + } + + /* @@@@ What about grey rings? */ + return res; +} diff --git a/mps/code/gp.gmk b/mps/code/gp.gmk new file mode 100644 index 00000000000..aa3a3062e13 --- /dev/null +++ b/mps/code/gp.gmk @@ -0,0 +1,32 @@ +# impl.gmk.gp: GNUMAKEFILE FRAGMENT FOR GNU CC/GPROF +# +# $HopeName$ +# Copyright (C) 1998 Harlequin Group plc, all rights reserved +# +# This file is included by platform makefiles that use the GNU CC +# compiler with gprof. It defines the compiler specific variables +# that the common makefile fragment (impl.gmk.comm) requires. + + +CC = gcc +CFLAGSCOMPILER = \ + -ansi -pedantic -Wall -Werror -Wpointer-arith \ + -Wstrict-prototypes -Wmissing-prototypes \ + -Winline -Waggregate-return -Wnested-externs \ + -Wcast-qual -Wshadow -pg +CFLAGSDEBUG = -g -ggdb3 +CFLAGSOPT = -O -g -ggdb3 +CFLAGSOPTNODEBUG = -O -g0 + +# gcc -MM generates a dependency line of the form: +# thing.o : thing.c ... +# The sed line converts this into: +# //thing.o //thing.d : thing.c ... +# @@ This sequence is vulnerable to interrupts (for some reason) + +define gendep + $(SHELL) -ec "gcc -c $(CFLAGS) -MM $< | \ + sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@" +endef + +include comm.gmk diff --git a/mps/code/hqbuild/data/cv_alpha.txt b/mps/code/hqbuild/data/cv_alpha.txt new file mode 100644 index 00000000000..cb5d08aa6c5 --- /dev/null +++ b/mps/code/hqbuild/data/cv_alpha.txt @@ -0,0 +1 @@ +MSVCNT 5_0 diff --git a/mps/code/hqbuild/data/cv_x86.txt b/mps/code/hqbuild/data/cv_x86.txt new file mode 100644 index 00000000000..1feeab52711 --- /dev/null +++ b/mps/code/hqbuild/data/cv_x86.txt @@ -0,0 +1,3 @@ +MSVCNT 5_0 +MSTOOLS Aug96US9 +MSMASM 6.11 diff --git a/mps/code/hqbuild/tools/hqbuild b/mps/code/hqbuild/tools/hqbuild new file mode 100644 index 00000000000..cd6d69787fe --- /dev/null +++ b/mps/code/hqbuild/tools/hqbuild @@ -0,0 +1,20 @@ +#!/bin/sh +# impl.sh.hqbuild +# +# $HopeName: MMsrc!tools:swbuild(trunk.1) $ +# Copyright (C) 1996 Harlequin Group, all rights reserved +# +# Build script for SWIG autobuild system. +# The SWIG autobuild system expects to execute this file passing it +# an argument. +# +# We specify that the argument will be the platform code to make life +# easy for us + +case $# in + 1) ;; + *) echo 1>&2 'Wrong number of arguments to hqbuild. +Exactly one argument expected'; exit 1;; +esac + +gnumake -r -f "$1.gmk" diff --git a/mps/code/hqbuild/tools/hqbuild.bat b/mps/code/hqbuild/tools/hqbuild.bat new file mode 100644 index 00000000000..6badae142d9 --- /dev/null +++ b/mps/code/hqbuild/tools/hqbuild.bat @@ -0,0 +1,12 @@ +@REM impl.bat.hqbuild: setup for SWIG autobuild system +@REM $HopeName: MMsrc!hqbuild:tools:hqbuild.bat(trunk.5) $ +@REM Copyright (C) 1996-1998 Harlequin Group plc. All rights reserved. +@REM Called by SWIG autobuild system +@ +@REM we expect whatcom to have set MSVCNT and possibly MSMASM and MSTOOLS +IF NOT %MSMASM%X == X SET PATH=%MSMASM%\bin;%PATH% +SET PATH=%MSVCNT%\..\sharedide\bin\ide;%MSVCNT%\..\sharedide\bin;%MSVCNT%\bin;%PATH% +SET INCLUDE=%MSVCNT%\include;%MSVCNT%\mfc\include;%INCLUDE% +SET LIB=%MSVCNT%\lib;%MSVCNT%\mfc\lib;%LIB% +@REM First argument is expected to be platform code, rest we pass on +nmake /f %1.nmk %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/mps/code/i6cc.gmk b/mps/code/i6cc.gmk new file mode 100644 index 00000000000..6101975b4a9 --- /dev/null +++ b/mps/code/i6cc.gmk @@ -0,0 +1,31 @@ +# impl.gmk.ic: GNUMAKEFILE FRAGMENT FOR IRIX 6 CC (N32 or N64 ABI) +# +# $HopeName$ +# Copyright (C) 1997, 1998 Harlequin Group plc. All rights reserved. +# +# This file is included by platform makefiles that use the IRIX 6 CC +# compiler. It defines the compiler specific variables that the +# common makefile fragment (impl.gmk.comm) requires. + + +CC = cc + + +# suppress error(1174): function "foo" was declared but never referenced +# because it happens with vfork in included from vmi5.c +# suppress error(1196): function declared implicitly +# because it happens with __vfork in included from vmi5.c +# suppress remark(1209): 'controlling expression is constant' +# because it occurs in 'while(0)' and statically determined checks +# suppress remark(1552): 'variable "foo" was set but never used' +# (e.g. variables only used in asserts) +# can't use -pedantic because Irix header files have #ident + +CFLAGSCOMPILER = -ansi -fullwarn -w2 -diag_error 1000-9999 \ + -diag_suppress 1174,1196,1209,1552 +CFLAGSDEBUG = -g +CFLAGSOPT = -O -g3 +CFLAGSOPTNODEBUG = -O + + +include comm.gmk diff --git a/mps/code/iam4cc.gmk b/mps/code/iam4cc.gmk new file mode 100644 index 00000000000..51c6de546d4 --- /dev/null +++ b/mps/code/iam4cc.gmk @@ -0,0 +1,21 @@ +# impl.gmk.iam4cc: BUILD FOR IRIX 6 N32/MIPS IV/CC PLATFORM +# +# $HopeName: MMsrc!iam4cc.gmk(trunk.9) $ +# Copyright (C) 1998 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.iam4cc. + +PFM = iam4cc +PFMDEFS = -n32 + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmi5.c \ + protan.c prmcan.c ssan.c span.c +SWPF = than.c vmi5.c protsw.c prmcan.c ssan.c + +LIBS = -lm + +LINKFLAGS = -n32 +ARFLAGSPFM = s + +AR=/bin/ar +include i6cc.gmk diff --git a/mps/code/ic.gmk b/mps/code/ic.gmk new file mode 100644 index 00000000000..b376e017561 --- /dev/null +++ b/mps/code/ic.gmk @@ -0,0 +1,21 @@ +# impl.gmk.ic: GNUMAKEFILE FRAGMENT FOR IRIX CC (IRIX 4 OR 5) +# +# $HopeName: MMsrc!ic.gmk(trunk.3) $ +# Copyright (C) 1996, 1998 Harlequin Group, all rights reserved +# +# This file is included by platform makefiles that use the IRIX CC +# compiler. It defines the compiler specific variables that the +# common makefile fragment (impl.gmk.comm) requires. + +# We need a symbol for a non-empty definition with empty value +ifdef MPS_EMPTY +error "ic.gmk: MPS_EMPTY defined" +endif + +CC = cc +CFLAGSCOMPILER = $(MPS_EMPTY) +CFLAGSDEBUG = -g +CFLAGSOPT = -O -g +CFLAGSOPTNODEBUG = -O + +include comm.gmk diff --git a/mps/code/idlench.awk b/mps/code/idlench.awk new file mode 100644 index 00000000000..cafeaaedb8f --- /dev/null +++ b/mps/code/idlench.awk @@ -0,0 +1,69 @@ +#!/bin/nawk -f +# impl.awk.idlench: IDENTIFIER LENGTH CHECK +# $HopeName$ +# Copyright (C) 1998. Harlequin Group plc. All rights reserved. +# +# READERSHIP +# +# .readership: Anyone prepared to read awk programs. +# +# SOURCE +# +# .language: This program is written in awk as specified in the Single +# UNIX Specification from the X/Open Group (aka XPG4 UNIX, aka UNIX98). +# See http://www.opengroup.org/onlinepubs/7908799/xcu/awk.html for +# their man page. +# +# DESIGN +# +# .design: See design.buildsys.idlench +# +# PURPOSE +# +# This program processes the output of cxref to find long +# identifiers. +# +# It outputs a list of functions that are used (ie those named appearing +# in the 3rd column: FUNCTION) whose names completely fill the column. +# +# A typical invocation might be: +# +# ./idlench.awk sos8cx/ci/*.o +# +# Not all awks are UNIX98 compliant; you need to find one that is. +# By default (if invoked as above) this script runs using /bin/nawk +# which on Solaris is a complant awk, but this isn't guaranteed for +# other systems. +# +# So the invocation might be something like: +# +# awk -f idlench.awk sos8cx/ci/*.o +# +# if there are problems with finding the right awk + +# check for good awk +NR == 1 { + if(FNR!=1) { + print "error: bad version of awk, try nawk or /usr/xpg4/bin/awk ?" + exit 1 + } +} +# skip 1st line +FNR == 1 {next} +# 2nd line contains column titles from which we determine widths +FNR == 2 { + lastfunpos=index($0, "LINE")-2 + firstfunpos=index($0, "FUNCTION") + if(lastfunpos<=0 || firstfunpos > lastfunpos) { + print "error: malformed line 2 of file " FILENAME; exit 1} + funlength = lastfunpos - firstfunpos + 1 + next +} +# for the rest of file, simply check last char in FUNCTION field +substr($0, lastfunpos, 1) != " " { + fun = substr($0, firstfunpos, funlength) + if(!dup[fun]) { + print fun + dup[fun] = 1 + } +} diff --git a/mps/code/lc.gmk b/mps/code/lc.gmk new file mode 100644 index 00000000000..8741a825fcd --- /dev/null +++ b/mps/code/lc.gmk @@ -0,0 +1,24 @@ +# impl.gmk.lc: GNUMAKEFILE FRAGMENT FOR LCC +# +# $HopeName: MMsrc!lc.gmk(trunk.3) $ +# Copyright (C) 1996,1997, 1998 Harlequin Group, all rights reserved +# +# This file is included by platform makefiles that use the LCC +# compiler. It defines the compiler specific variables that the +# common makefile fragment (impl.gmk.comm) requires. +# +# .optimize.noflags: lcc does some minimal amount of optimization all +# the time and ignores the -O flag. Hence the empty *OPT* macros. + +# We need a symbol for a non-empty definition with empty value +ifdef MPS_EMPTY +error "lc.gmk: MPS_EMPTY defined" +endif + +CC = lcc +CFLAGSCOMPILER = -I/usr/include +CFLAGSDEBUG = -g +CFLAGSOPT = $(MPS_EMPTY) +CFLAGSOPTNODEBUG = $(MPS_EMPTY) + +include comm.gmk diff --git a/mps/code/ld.c b/mps/code/ld.c new file mode 100644 index 00000000000..518786f4b21 --- /dev/null +++ b/mps/code/ld.c @@ -0,0 +1,210 @@ +/* impl.c.ld: LOCATION DEPENDENCY IMPLEMENTATION + * + * $HopeName: MMsrc!ld.c(trunk.8) $ + * Copyright (C) 1996 Harlequin Limited. All rights reserved. + * + * .def: A location dependency records the fact that the bit-patterns + * of some references will be used directly (most likely for + * hashing), and provides a protocol for finding out whether that + * dependency has become stale because a reference has been changed (by + * a moving memory manager). + * + * .rationale: The client may build hash-tables using pointer hashing. + * The collector may change the values of the pointers transparently, + * by fixing them and moving the objects. The hash function will no + * longer return the same value, and the object can't be found in + * the expected bucket. When the client can't find an object in a + * hashtable it must check to see if any of the references in the table + * have moved, and rehash if they have. Location dependency provides + * a reasonably accurate way of determining whether this has happened. + * + * .impl: A location dependency consists of an epoch (monotonically + * increasing notion of time) and a reference set. The epoch records + * when the location dependency started, and the reference set + * accumulates an approximation to the set of references which are + * depended on. The client can check to see if any of these + * references have moved since the epoch. + * + * .history: The current epoch, and a history of object movement + * are recorded in the arena. Each slot in the history contains a + * summary of all the movement since an earlier epoch (maintained by + * LDAge). To see if a dependency has become stale all that + * is needed is to see whether its reference set intersects with the + * movement since its epoch. + * + * .mod: LDHistoryLENGTH is used as a modulus to calculate the offset + * of an epoch in the history, so it's best if this is a power of two. + * (impl.h.mpmconf) + * + * .epoch-size: The epoch should probably be a longer integer to avoid + * the possibility of overflow. + * (32 bits only gives 50 days at 1ms frequency) + * + * .ld.access: Accesses (reads and writes) to the ld structure must be + * "wrapped" with an ShieldExpose/Cover pair if and only if the access + * is taking place inside the arena. Currently this is only the case for + * LDReset. + */ + +#include "mpm.h" + +SRCID(ld, "$HopeName: MMsrc!ld.c(trunk.8) $"); + + +/* LDReset -- reset a dependency to empty + * + * .reset.sync: This does not need to be synchronized with LDAge + * because if the epoch advances after it is read the dependency + * will simply include movement for more time than necessary. + */ +void LDReset(LD ld, Arena arena) +{ + Bool b; + Seg seg; + + AVER(ld != NULL); + AVERT(Arena, arena); + + b = SegOfAddr(&seg, arena, (Addr)ld); + if (b) + ShieldExpose(arena, seg); /* .ld.access */ + ld->epoch = arena->epoch; + ld->rs = RefSetEMPTY; + if (b) + ShieldCover(arena, seg); +} + + +/* LDAdd -- add a reference to a dependency + * + * .add.lock-free: This function is thread safe with respect to the + * (rest of the) mps. It is unnecessary to claim locks before calling + * this function. + * + * .add.user-serial: + * However, this function is _not_ thread safe with respect to itself. + * Users should ensure that calls to LDAdd operating on the same LD are + * serialized. + * + * .add.sync: Add must take place _before_ the location of the reference + * is depended on. If the reference changes between adding and + * depending it will show up as moved because the movement will have + * occured since the epoch recorded in the dependency. If the location + * were used first only the new location of the reference would end up + * in the set. + */ +void LDAdd(LD ld, Arena arena, Addr addr) +{ + AVER(ld->epoch <= arena->epoch); + /* AVERT(Arena, arena) -- see .add.lock-free */ + + ld->rs = RefSetAdd(arena, ld->rs, addr); +} + + +/* LDIsStale -- check whether a dependency is stale + * + * .stale.thread-safe: This function is thread safe. It will return a + * correct (but possibly conservative) answer regardless of the number + * of calls to LDAge anywhere during the function. Update with care. + * + * .stale.current: If the dependency's epoch is the current epoch, + * nothing can have moved since it was initialized. + * + * .stale.recent: If the dependency is recent, see if it intersects + * with everything which has moved since it was initialized. + * + * .stale.recent.conservative: The refset from the history table is + * loaded before we check whether ld->epoch is "recent" with respect to + * the current epoch. This means that we may (conservatively) decide + * to use the prehistory instead. + * + * .stale.old: Otherwise, if the dependency is older than the length + * of the history, check it against all movement that has ever occured. + */ +Bool LDIsStale(LD ld, Arena arena, Addr addr) +{ + RefSet rs; + + UNUSED(addr); + + AVER(ld->epoch <= arena->epoch); + /* AVERT(Arena, arena) -- .stale.thread-safe */ + + if (arena->epoch == ld->epoch) /* .stale.current */ + return FALSE; + + /* Load the history refset, _then_ check to see if it's recent. + * This may in fact load an okay refset, which we decide to throw + * away and use the pre-history instead. */ + rs = arena->history[ld->epoch % LDHistoryLENGTH]; + /* .stale.recent */ + /* .stale.recent.conservative */ + if (arena->epoch - ld->epoch > LDHistoryLENGTH) { + rs = arena->prehistory; /* .stale.old */ + } + + return RefSetInter(ld->rs, rs) != RefSetEMPTY; +} + + +/* LDAge -- age the arena by adding a moved set + * + * This stores the fact that a set of references has changed in + * the history in the arena structure, and increments the epoch. + * + * This is only called during a 'flip', because it must be atomic + * w.r.t. the mutator (and therefore w.r.t. LdIsStale). This is + * because it updates the notion of the 'current' and 'oldest' history + * entries. + */ +void LDAge(Arena arena, RefSet rs) +{ + Size i; + + AVERT(Arena, arena); + AVER(rs != RefSetEMPTY); + + /* Replace the entry for epoch - LDHistoryLENGTH by an empty */ + /* set which will become the set which has moved since the */ + /* current epoch. */ + arena->history[arena->epoch % LDHistoryLENGTH] = RefSetEMPTY; + + /* Record the fact that the moved set has moved, by adding it */ + /* to all the sets in the history, including the set for the */ + /* current epoch. */ + for(i = 0; i < LDHistoryLENGTH; ++i) + arena->history[i] = RefSetUnion(arena->history[i], rs); + + /* This is the union of all movement since time zero. */ + arena->prehistory = RefSetUnion(arena->prehistory, rs); + + /* Advance the epoch by one. */ + ++arena->epoch; + AVER(arena->epoch != 0); /* .epoch-size */ +} + + +/* LDMerge -- merge two location dependencies + * + * .merge.lock-free: This function is thread-safe with respect to the + * (rest of the) MPS. It is unnecessary to claim locks before calling + * this function. + */ +void LDMerge(LD ld, Arena arena, LD from) +{ + /* AVERT(Arena, arena); -- .merge.lock-free */ + AVER(ld != NULL); + AVER(ld->epoch <= arena->epoch); + AVER(from != NULL); + AVER(from->epoch <= arena->epoch); + + /* If a reference has been added since epoch e1 then I've */ + /* certainly added since epoch e0 where e0 < e1. Therefore */ + /* the epoch of the merged ld is the minimum. */ + if (from->epoch < ld->epoch) + ld->epoch = from->epoch; + + /* The set of references added is the union of the two. */ + ld->rs = RefSetUnion(ld->rs, from->rs); +} diff --git a/mps/code/lii3eg.gmk b/mps/code/lii3eg.gmk new file mode 100644 index 00000000000..44143e262f1 --- /dev/null +++ b/mps/code/lii3eg.gmk @@ -0,0 +1,21 @@ +# impl.gmk.lii3eg: BUILD FOR LINUX/INTEL/EGCS PLATFORM +# +# $HopeName: MMsrc!lii3eg.gmk(trunk.3) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.lii3eg. + +PFM = lii3eg + +THREADSRC = lockli.c thlii3.c pthrdext.c +THREADLIB = -lpthread + +PFMDEFS = -D_REENTRANT + +MPMPF = mpsliban.c mpsioan.c ${THREADSRC} vmli.c \ + protli.c protlii3.c proti3.c prmci3li.c sslii3.c span.c +SWPF = than.c vmli.c protsw.c prmcan.c ssan.c + +LIBS = -lm ${THREADLIB} + +include eg.gmk diff --git a/mps/code/lii4gc.gmk b/mps/code/lii4gc.gmk new file mode 100644 index 00000000000..2523ddc7f78 --- /dev/null +++ b/mps/code/lii4gc.gmk @@ -0,0 +1,28 @@ +# impl.gmk.lii4gc: BUILD FOR LINUX/INTEL/GCC PLATFORM +# +# $HopeName: MMsrc!lii4gc.gmk(trunk.5) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = lii4gc + +THREADSRC = lockli.c thlii4.c pthrdext.c +THREADLIB = -lpthread + +PFMDEFS = -D_REENTRANT + +MPMPF = mpsliban.c mpsioan.c ${THREADSRC} vmli.c \ + protli.c protlii3.c proti3.c prmci3li.c sslii3.c span.c +SWPF = than.c vmli.c protsw.c prmcan.c ssan.c + +LIBS = -lm ${THREADLIB} + +include gc.gmk + +CC = cc + +# Suppress some warnings (SuSE). +# .void: -Wpointer-arith cannot be used because the string.h header does +# arithmetic on void*. +CFLAGSCOMPILER := $(subst -Wpointer-arith,,$(CFLAGSCOMPILER)) + +include comm.gmk diff --git a/mps/code/lippgc.gmk b/mps/code/lippgc.gmk new file mode 100644 index 00000000000..565e11ea0c0 --- /dev/null +++ b/mps/code/lippgc.gmk @@ -0,0 +1,21 @@ +# impl.gmk.lippgc: BUILD FOR LINUX/POWER(32)/GCC PLATFORM +# +# $HopeName: MMsrc!lippgc.gmk(trunk.5) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.lippgc. + +PFM = lippgc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmli.c \ + protan.c prmcan.c ssan.c span.c + +LIBS = -lm + +include gc.gmk + +CC = cc + +# If any adjustment to compiler options is needed, it should be done here. + +include comm.gmk diff --git a/mps/code/lo.h b/mps/code/lo.h new file mode 100644 index 00000000000..3d61fe9e23a --- /dev/null +++ b/mps/code/lo.h @@ -0,0 +1,44 @@ +/* impl.h.lo + * + * LEAF OBJECT POOL CLASS + * + * $HopeName: MMsrc!lo.h(MMdevel_restr2.2) $ + * + * Copyright (C) 1996 Harlequin Group, all rights reserved + * + * The Leaf Object PoolClass is an automatically managed (ie garbage + * collected) pool for managing "leaf" objects. Leaf objects are + * objects that have no references or no references that need tracing + * (ie the objects they refer too are non-moving and are manually + * managed). + * + * This Class has the following features: + * + * Approximately 6% (asymptotically) space overhead on managed objects. + * + * Automatically reclaims memory used by objects no longer reachable + * from the roots. + * + * Non-moving. References to objects in this pool will never change + * due to "fixing". + * + * Buffers will always "commit". When allocating using a buffer, + * commit will never fail. + * + * The following caveat applies: + * + * Space and time performance will degrade when fragmentation + * increases. + * + */ + +#ifndef lo_h +#define lo_h + +#include "mpm.h" + +typedef struct LOStruct *LO; + +extern PoolClass PoolClassLO(void); + +#endif /* lo_h */ diff --git a/mps/code/lock.h b/mps/code/lock.h new file mode 100644 index 00000000000..5fb97ef238b --- /dev/null +++ b/mps/code/lock.h @@ -0,0 +1,225 @@ +/* impl.h.lock: RECURSIVE LOCKS + * + * $HopeName: MMsrc!lock.h(trunk.5) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .description: [@@@@ Should be combined with design.mps.lock] + * This defines the type Lock, which supports simple recursive + * locking. Locking ensures that only a single thread may be running + * with a lock held. By claiming a lock in some code, this ensures + * that only one thread can be running in that code at a time. This + * in turn can be used to protect different threads from trying to + * read or update data structures which are in a transitional state. + * + * At most one thread may own a lock at a time. A lock is initialised + * without an owner. A lock should not have an owner when it is + * finished. Claiming the lock will wait until the lock is not owned + * by another thread and then cause the current thread to become the + * owner. Releasing the the lock will relinquish ownership if the + * number of releases matches the number of claims. + * + * To use a lock a structure of type LockStruct must be allocated. + * This is defined in impl.h.lockst. Sources which allocate such a + * structure will need to include "lockst.h". A lock of type Lock is + * a pointer to such an allocated structure. + * + * A lock must be Inited before use and should be Finished after use, + * using LockInit and LockFinish. + * + * LockClaimRecursive & LockReleaseRecursive are for claiming and + * releasing the lock. These may be used recursively. + * + * There is a limit on the number of recursive claims which + * depends on the implementation. See issue.lock-claim-limit. + * + * LockClaim and LockReleaseMPM are the same as the Recursive versions, + * except that LockClaim may only be used by a thread that doesn't + * already own the lock, and LockReleaseMPM may only be used to release + * a lock with one claim. LockClaim and LockReleaseMPM if used, must + * be used symmetrically in pairs. + * + * There are two intended uses. Here is an example: + * #include "lock.h" + * #include "lockst.h" + * static LockStruct lockStruct; + * binaryUse() + * { ;; lock not owned by this thread. + * LockClaim(&lockStruct); + * ;; lock owned by this thread. + * ;; Cannot call binaryUse() at this point. + * ;; only one thread at a time may be at this point. + * LockReleaseMPM(&lockStruct); + * ;; lock not owned by this thread. + * } + * + * recursiveUse() + * { ;; lock may already be owned by this thread. + * LockClaimRecursive(&lockStruct); + * ;; lock held by this thread. + * ;; only one thread at a time may be at this point. + * LockReleaseRecursive(&lockStruct); + * ;; lock owned by this thread if it was before. + * } + * LockInit(&lockStruct) must be called before calling binaryUse() + * or recursiveUse(). + * LockFinish(&lockStruct) should be called when lock is no longer + * needed. + * recursiveUse() may be called by both functions. + * binaryUse() may only be called where lock is known not to be + * already owned by this thread. In particular, it may not be + * called by recursiveUse(). + * + * LockClaimGlobalRecursive & LockReleaseGlobalRecursive are + * similar to LockClaimRecursive & LockReleaseRecursive + * except that they lock an implicit global lock. This may be + * used for locking access to data structures which are global, + * such as class objects. + */ + +#ifndef lock_h +#define lock_h + +#include "mpm.h" + + +#define LockSig ((Sig)0x51970CC9) /* SIGnature LOCK */ + + +#if defined(THREAD_MULTI) + + +/* LockSize -- Return the size of a LockStruct + * + * Supports allocation of locks. + */ + +extern size_t LockSize(void); + + +/* LockInit/Finish + * + * lock points to the allocated lock structure. A lock has no + * owner after initialisation. + */ + +extern void LockInit(Lock lock); +extern void LockFinish(Lock lock); + + +/* LockClaimRecursive + * + * This is called to increase the number of claims on the lock. + * LockClaimRecursive will wait until the lock is not owned by another + * thread and return with the lock owned. + * This can be called recursively. + */ + +extern void LockClaimRecursive(Lock lock); + + +/* LockReleaseRecursive + * + * This is called to reduce the number of claims on the lock. + * If the number of claims drops to zero, ownership is relinquished. + * This must not be called without possession of the lock. + */ + +extern void LockReleaseRecursive(Lock lock); + + +/* LockClaim + * + * This may only be used when the lock is not already owned by + * the calling thread. + * When used it behaves like LockClaimRecursive, but must be + * matched by a call to LockReleaseMPM. + */ + +extern void LockClaim(Lock lock); + + +/* LockReleaseMPM + * + * This must only be used to release a Lock symmetrically + * with LockClaim. It therefore should only be called with + * a single claim. + */ + +extern void LockReleaseMPM(Lock lock); + + +/* LockCheck -- Validation */ + +extern Bool LockCheck(Lock lock); + + +/* == Global locks == */ + + +/* LockClaimGlobalRecursive + * + * This is called to increase the number of claims on the recursive + * global lock. LockClaimRecursive will wait until the lock is not + * owned by another thread and return with the lock owned. + * This can be called recursively. + */ + +extern void LockClaimGlobalRecursive(void); + + +/* LockReleaseGlobalRecursive + * + * This is called to reduce the number of claims on the recursive + * global lock. If the number of claims drops to zero, ownership + * is relinquished. This must not be called without possession of + * the lock. + */ + +extern void LockReleaseGlobalRecursive(void); + + +/* LockClaimGlobal + * + * This is called to claim the binary global lock, and may only be + * used if that lock is not already owned by the calling thread. + * It must be matched by a call to LockReleaseGlobal. + */ + +extern void LockClaimGlobal(void); + + +/* LockReleaseGlobal + * + * This must only be used to release the binary global lock + * symmetrically with LockClaimGlobal. + * It therefore should only be called with a single claim. + */ + +extern void LockReleaseGlobal(void); + + +#elif defined(THREAD_SINGLE) + + +#define LockSize() MPS_PF_ALIGN +#define LockInit(lock) UNUSED(lock) +#define LockFinish(lock) UNUSED(lock) +#define LockClaimRecursive(lock) UNUSED(lock) +#define LockReleaseRecursive(lock) UNUSED(lock) +#define LockClaim(lock) UNUSED(lock) +#define LockReleaseMPM(lock) UNUSED(lock) +#define LockCheck(lock) ((void)lock, TRUE) +#define LockClaimGlobalRecursive() +#define LockReleaseGlobalRecursive() +#define LockClaimGlobal() +#define LockReleaseGlobal() + + +#else + +#error "No threading defined." + +#endif + + +#endif /* lock_h */ diff --git a/mps/code/lockan.c b/mps/code/lockan.c new file mode 100644 index 00000000000..358b0ffc5ec --- /dev/null +++ b/mps/code/lockan.c @@ -0,0 +1,122 @@ +/* impl.c.lockan: ANSI RECURSIVE LOCKS + * + * $HopeName: MMsrc!lockan.c(trunk.9) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .purpose: This is a trivial implementation of recursive locks + * that assumes we are not running in a multi-threaded environment. + * This provides stubs for the locking code where locking is not + * applicable. The stubs provide some amount of checking. + * + * .limit: The limit on the number of recursive claims is ULONG_MAX. + */ + +#include "lock.h" +#include "mpmtypes.h" + +SRCID(lockan, "$HopeName: MMsrc!lockan.c(trunk.9) $"); + + +typedef struct LockStruct { /* ANSI fake lock structure */ + Sig sig; /* design.mps.sig */ + unsigned long claims; /* # claims held by owner */ +} LockStruct; + + +size_t (LockSize)(void) +{ + return sizeof(LockStruct); +} + +Bool (LockCheck)(Lock lock) +{ + CHECKS(Lock, lock); + return TRUE; +} + + +void (LockInit)(Lock lock) +{ + AVER(lock != NULL); + lock->claims = 0; + lock->sig = LockSig; + AVERT(Lock, lock); +} + +void (LockFinish)(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims == 0); + lock->sig = SigInvalid; +} + + +void (LockClaim)(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims == 0); + lock->claims = 1; +} + +void (LockReleaseMPM)(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims == 1); + lock->claims = 0; +} + +void (LockClaimRecursive)(Lock lock) +{ + AVERT(Lock, lock); + ++lock->claims; + AVER(lock->claims>0); +} + +void (LockReleaseRecursive)(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims > 0); + --lock->claims; +} + + +/* Global locking is performed by normal locks. + * A separate lock structure is used for recursive and + * non-recursive locks so that each may be differently ordered + * with respect to client-allocated locks. + */ + +static LockStruct globalLockStruct = { + LockSig, + 0 +}; + +static LockStruct globalRecursiveLockStruct = { + LockSig, + 0 +}; + +static Lock globalLock = &globalLockStruct; + +static Lock globalRecLock = &globalRecursiveLockStruct; + + +void (LockClaimGlobalRecursive)(void) +{ + LockClaimRecursive(globalRecLock); +} + +void (LockReleaseGlobalRecursive)(void) +{ + LockReleaseRecursive(globalRecLock); +} + +void (LockClaimGlobal)(void) +{ + LockClaim(globalLock); +} + +void (LockReleaseGlobal)(void) +{ + LockReleaseMPM(globalLock); +} diff --git a/mps/code/lockcov.c b/mps/code/lockcov.c new file mode 100644 index 00000000000..1c3f64ae509 --- /dev/null +++ b/mps/code/lockcov.c @@ -0,0 +1,50 @@ +/* impl.c.lockcov: LOCK COVERAGE TEST + * + * $HopeName: MMsrc!lockcov.c(trunk.4) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "testlib.h" +#include /* for malloc & free */ + + +int main(void) +{ + Lock a = malloc(LockSize()); + Lock b = malloc(LockSize()); + + Insist(a != NULL); + Insist(b != NULL); + + LockInit(a); + LockInit(b); + LockClaimGlobal(); + LockClaim(a); + LockClaimRecursive(b); + LockClaimGlobalRecursive(); + LockReleaseGlobal(); + LockClaimGlobal(); + LockReleaseMPM(a); + LockClaimGlobalRecursive(); + LockReleaseGlobal(); + LockClaimRecursive(b); + LockFinish(a); + LockReleaseRecursive(b); + LockReleaseRecursive(b); + LockFinish(b); + LockInit(a); + LockClaim(a); + LockClaimRecursive(a); + LockReleaseGlobalRecursive(); + LockReleaseRecursive(a); + LockReleaseMPM(a); + LockFinish(a); + LockReleaseGlobalRecursive(); + free(a); + free(b); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/lockli.c b/mps/code/lockli.c new file mode 100644 index 00000000000..97e242d1d6a --- /dev/null +++ b/mps/code/lockli.c @@ -0,0 +1,258 @@ +/* impl.c.lockli: RECURSIVE LOCKS FOR POSIX SYSTEMS + * + * $HopeName$ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .linux: This implementation currently just supports LinuxThreads + * (platform MPS_OS_LI), Single Unix i/f. + * + * .posix: In fact, the implementation should be reusable for most POSIX + * implementations, but may need some customization for each. + * + * .design: These locks are implemented using mutexes. + * + * .recursive: Mutexes support both non-recursive and recursive locking, but + * only at initialization time. This doesn't match the API of MPS Lock module, + * which chooses at locking time, so all locks are made (non-recursive) + * errorchecking. Recursive locks are implemented by checking the error + * code. + * + * .claims: During use the claims field is updated to remember the number of + * claims acquired on a lock. This field must only be modified + * while we hold the mutex. + */ + +#define _XOPEN_SOURCE 500 +#include +#include +#include + +#include "mpmtypes.h" +#include "lock.h" +#include "config.h" + + +#ifndef MPS_OS_LI +#error "lockli.c is specific to LinuxThreads but MPS_OS_LI not defined" +#endif + +SRCID(lockli, "$HopeName$"); + + +/* LockAttrSetRecursive -- Set mutexattr to permit recursive locking + * + * There's a standard way to do this - but early LinuxThreads doesn't + * quite follow the standard. Some other implementations might not + * either. + */ + +#ifdef OLD_LINUXTHREADS + +#define LockAttrSetRecursive(attrptr) \ + pthread_mutexattr_setkind_np(attrptr, PTHREAD_MUTEX_ERRORCHECK_NP) + +#else + +#define LockAttrSetRecursive(attrptr) \ + pthread_mutexattr_settype(attrptr, PTHREAD_MUTEX_ERRORCHECK) + +#endif + + +/* LockStruct -- the MPS lock structure + * + * .lock.posix: Posix lock structure; uses a mutex. + */ + +typedef struct LockStruct { + Sig sig; /* design.mps.sig */ + unsigned long claims; /* # claims held by owner */ + pthread_mutex_t mut; /* the mutex itself */ +} LockStruct; + + +/* LockSize -- size of a LockStruct */ + +size_t LockSize(void) +{ + return sizeof(LockStruct); +} + + +/* LockCheck -- check a lock */ + +Bool LockCheck(Lock lock) +{ + CHECKS(Lock, lock); + /* While claims can't be very large, I don't dare to put a limit on it. */ + /* There's no way to test the mutex, or check if it's held by somebody. */ + return TRUE; +} + + +/* LockInit -- initialize a lock */ + +void LockInit(Lock lock) +{ + pthread_mutexattr_t attr; + int res; + + AVER(lock != NULL); + lock->claims = 0; + res = pthread_mutexattr_init(&attr); + AVER(res == 0); + res = LockAttrSetRecursive(&attr); + AVER(res == 0); + res = pthread_mutex_init(&lock->mut, &attr); + AVER(res == 0); + res = pthread_mutexattr_destroy(&attr); + AVER(res == 0); + lock->sig = LockSig; + AVERT(Lock, lock); +} + + +/* LockFinish -- finish a lock */ + +void LockFinish(Lock lock) +{ + int res; + + AVERT(Lock, lock); + /* Lock should not be finished while held */ + AVER(lock->claims == 0); + res = pthread_mutex_destroy(&lock->mut); + AVER(res == 0); + lock->sig = SigInvalid; +} + + +/* LockClaim -- claim a lock (non-recursive) */ + +void LockClaim(Lock lock) +{ + int res; + + AVERT(Lock, lock); + + res = pthread_mutex_lock(&lock->mut); + /* pthread_mutex_lock will error if we own the lock already. */ + AVER(res == 0); + + /* This should be the first claim. Now we own the mutex */ + /* it is ok to check this. */ + AVER(lock->claims == 0); + lock->claims = 1; +} + + +/* LockReleaseMPM -- release a lock (non-recursive) */ + +void LockReleaseMPM(Lock lock) +{ + int res; + + AVERT(Lock, lock); + AVER(lock->claims == 1); /* The lock should only be held once */ + lock->claims = 0; /* Must set this before releasing the lock */ + res = pthread_mutex_unlock(&lock->mut); + /* pthread_mutex_unlock will error if we didn't own the lock. */ + AVER(res == 0); +} + + +/* LockClaimRecursive -- claim a lock (recursive) */ + +void LockClaimRecursive(Lock lock) +{ + int res; + + AVERT(Lock, lock); + + res = pthread_mutex_lock(&lock->mut); + /* pthread_mutex_lock will return: */ + /* 0 if we have just claimed the lock */ + /* EDEADLK if we own the lock already. */ + AVER((res == 0 && lock->claims == 0) || + (res == EDEADLK && lock->claims > 0)); + + ++lock->claims; + AVER(lock->claims > 0); +} + + +/* LockReleaseRecursive -- release a lock (recursive) */ + +void LockReleaseRecursive(Lock lock) +{ + int res; + + AVERT(Lock, lock); + AVER(lock->claims > 0); + --lock->claims; + if (lock->claims == 0) { + res = pthread_mutex_unlock(&lock->mut); + /* pthread_mutex_unlock will error if we didn't own the lock. */ + AVER(res == 0); + } +} + + +/* Global locks + * + * .global: The two "global" locks are statically allocated normal locks. + */ + +static LockStruct globalLockStruct; +static LockStruct globalRecLockStruct; +static Lock globalLock = &globalLockStruct; +static Lock globalRecLock = &globalRecLockStruct; +static pthread_once_t isGlobalLockInit = PTHREAD_ONCE_INIT; + +static void globalLockInit(void) +{ + LockInit(globalLock); + LockInit(globalRecLock); +} + + +/* LockClaimGlobalRecursive -- claim the global recursive lock */ + +void LockClaimGlobalRecursive(void) +{ + int res; + + /* Ensure the global lock has been initialized */ + res = pthread_once(&isGlobalLockInit, globalLockInit); + AVER(res == 0); + LockClaimRecursive(globalRecLock); +} + + +/* LockReleaseGlobalRecursive -- release the global recursive lock */ + +void LockReleaseGlobalRecursive(void) +{ + LockReleaseRecursive(globalRecLock); +} + + +/* LockClaimGlobal -- claim the global non-recursive lock */ + +void LockClaimGlobal(void) +{ + int res; + + /* Ensure the global lock has been initialized */ + res = pthread_once(&isGlobalLockInit, globalLockInit); + AVER(res == 0); + LockClaim(globalLock); +} + + +/* LockReleaseGlobal -- release the global non-recursive lock */ + +void LockReleaseGlobal(void) +{ + LockReleaseMPM(globalLock); +} diff --git a/mps/code/lockutw3.c b/mps/code/lockutw3.c new file mode 100644 index 00000000000..b1b56a443ca --- /dev/null +++ b/mps/code/lockutw3.c @@ -0,0 +1,93 @@ +/* impl.c.lockutw3: LOCK UTILIZATION TEST + * + * $HopeName$ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "testlib.h" + +#include "mpswin.h" + + +#ifndef MPS_OS_W3 +#error "Relies on Win32 threads" +#endif + + +#define nTHREADS 4 + +static Lock lock; +unsigned long shared, tmp; + + +void incR(unsigned long i) +{ + LockClaimRecursive(lock); + if (i < 100) { + while(i--) { + tmp = shared; + shared = tmp + 1; + } + } else { + incR(i >> 1); + incR(i+1 >> 1); + } + LockReleaseRecursive(lock); +} + + +void inc(unsigned long i) +{ + incR(i+1>>1); + i >>= 1; + while (i) { + LockClaim(lock); + if (i > 10000) { + incR(5000); + i -= 5000; + } + tmp = shared; + shared = tmp+1; + i--; + LockReleaseMPM(lock); + } +} + + +#define COUNT 100000l +DWORD WINAPI thread0(void *p) +{ + (void)p; + inc(COUNT); + return 0; +} + + +int main(void) +{ + DWORD id; + HANDLE t[10]; + unsigned i; + + lock = malloc(LockSize()); + Insist(lock != NULL); + + LockInit(lock); + + shared = 0; + + for(i = 0; i < nTHREADS; i++) + t[i] = CreateThread(NULL, 0, thread0, NULL, 0, &id); + + for(i = 0; i < nTHREADS; i++) + WaitForSingleObject(t[i], INFINITE); + + Insist(shared == nTHREADS*COUNT); + + LockFinish(lock); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/lockw3.c b/mps/code/lockw3.c new file mode 100644 index 00000000000..cf22084ef58 --- /dev/null +++ b/mps/code/lockw3.c @@ -0,0 +1,156 @@ +/* impl.c.lockw3: RECURSIVE LOCKS IN WIN32 + * + * $HopeName: MMsrc!lockw3.c(trunk.11) $ + * Copyright (C) 1995, 1997, 1998 Harlequin Group plc. All rights reserved. + * + * .design: These are implemented using critical sections. + * See the section titled "Synchronization functions" in the Groups + * chapter of the Microsoft Win32 API Programmer's Reference. + * The "Synchronization" section of the Overview is also relevant. + * + * Critical sections support recursive locking, so the implementation + * could be trivial. This implementation counts the claims to provide + * extra checking. + * + * The limit on the number of recursive claims is the max of + * ULONG_MAX and the limit imposed by critical sections, which + * is believed to be about UCHAR_MAX. + * + * During use the claims field is updated to remember the number of + * claims acquired on a lock. This field must only be modified + * while we are inside the critical section. + */ + +#include "mpm.h" + +#ifndef MPS_OS_W3 +#error "lockw3.c is specific to Win32 but MPS_OS_W3 not defined" +#endif + +#include "mpswin.h" + +SRCID(lockw3, "$HopeName: MMsrc!lockw3.c(trunk.11) $"); + + +/* .lock.win32: Win32 lock structure; uses CRITICAL_SECTION */ +typedef struct LockStruct { + Sig sig; /* design.mps.sig */ + unsigned long claims; /* # claims held by the owning thread */ + CRITICAL_SECTION cs; /* Win32's recursive lock thing */ +} LockStruct; + + +size_t LockSize(void) +{ + return sizeof(LockStruct); +} + +Bool LockCheck(Lock lock) +{ + CHECKS(Lock, lock); + return TRUE; +} + +void LockInit(Lock lock) +{ + AVER(lock != NULL); + lock->claims = 0; + InitializeCriticalSection(&lock->cs); + lock->sig = LockSig; + AVERT(Lock, lock); +} + +void LockFinish(Lock lock) +{ + AVERT(Lock, lock); + /* Lock should not be finished while held */ + AVER(lock->claims == 0); + DeleteCriticalSection(&lock->cs); + lock->sig = SigInvalid; +} + +void LockClaim(Lock lock) +{ + AVERT(Lock, lock); + EnterCriticalSection(&lock->cs); + /* This should be the first claim. Now we are inside the + * critical section it is ok to check this. */ + AVER(lock->claims == 0); + lock->claims = 1; +} + +void LockReleaseMPM(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims == 1); /* The lock should only be held once */ + lock->claims = 0; /* Must set this before leaving CS */ + LeaveCriticalSection(&lock->cs); +} + +void LockClaimRecursive(Lock lock) +{ + AVERT(Lock, lock); + EnterCriticalSection(&lock->cs); + ++lock->claims; + AVER(lock->claims > 0); +} + +void LockReleaseRecursive(Lock lock) +{ + AVERT(Lock, lock); + AVER(lock->claims > 0); + --lock->claims; + LeaveCriticalSection(&lock->cs); +} + + + +/* Global locking is performed by normal locks. + * A separate lock structure is used for recursive and + * non-recursive locks so that each may be differently ordered + * with respect to client-allocated locks. + */ + +static LockStruct globalLockStruct; +static LockStruct globalRecLockStruct; +static Lock globalLock = &globalLockStruct; +static Lock globalRecLock = &globalRecLockStruct; +static Bool globalLockInit = FALSE; /* TRUE iff initialized */ + + +static void lockEnsureGlobalLock(void) +{ + /* Ensure both global locks have been initialized. */ + /* There is a race condition initializing them. */ + if (!globalLockInit) { + LockInit(globalLock); + LockInit(globalRecLock); + globalLockInit = TRUE; + } +} + +void LockClaimGlobalRecursive(void) +{ + lockEnsureGlobalLock(); + AVER(globalLockInit); + LockClaimRecursive(globalRecLock); +} + +void LockReleaseGlobalRecursive(void) +{ + AVER(globalLockInit); + LockReleaseRecursive(globalRecLock); +} + +void LockClaimGlobal(void) +{ + lockEnsureGlobalLock(); + AVER(globalLockInit); + LockClaim(globalLock); +} + +void LockReleaseGlobal(void) +{ + AVER(globalLockInit); + LockReleaseMPM(globalLock); +} diff --git a/mps/code/locus.c b/mps/code/locus.c new file mode 100644 index 00000000000..6e1714884b7 --- /dev/null +++ b/mps/code/locus.c @@ -0,0 +1,481 @@ +/* impl.c.locus: LOCUS MANAGER + * + * $HopeName: MMsrc!locus.c(trunk.4) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * See design.mps.arena.vm and design.mps.locus for basic locus stuff. + * See design.mps.trace for chains. + */ + +#include "chain.h" +#include "ring.h" +#include "mpm.h" +#include "mpstd.h" +#include /* for DBL_MAX */ + + +SRCID(locus, "$HopeName: MMsrc!locus.c(trunk.4) $"); + + +/* SegPrefCheck -- check the consistency of a segment preference */ + +Bool SegPrefCheck(SegPref pref) +{ + CHECKS(SegPref, pref); + CHECKL(BoolCheck(pref->high)); + /* zones can't be checked because it's arbitrary. */ + CHECKL(BoolCheck(pref->isGen)); + CHECKL(BoolCheck(pref->isCollected)); + /* gen is an arbitrary serial */ + return TRUE; +} + + +/* SegPrefDefault -- return a segment preference representing the defaults */ + +static SegPrefStruct segPrefDefault = SegPrefDEFAULT; + +SegPref SegPrefDefault(void) +{ + return &segPrefDefault; +} + + +/* SegPrefExpress -- express a segment preference */ + +Res SegPrefExpress(SegPref pref, SegPrefKind kind, void *p) +{ + AVERT(SegPref, pref); + AVER(pref != &segPrefDefault); + + switch(kind) { + case SegPrefHigh: + AVER(p == NULL); + pref->high = TRUE; + break; + + case SegPrefLow: + AVER(p == NULL); + pref->high = FALSE; + break; + + case SegPrefZoneSet: + AVER(p != NULL); + pref->zones = *(ZoneSet *)p; + break; + + case SegPrefCollected: + AVER(p == NULL); + pref->isCollected = TRUE; + break; + + case SegPrefGen: + AVER(p != NULL); + pref->isGen = TRUE; + pref->gen = *(Serial *)p; + break; + + default: + /* Unknown kinds are ignored for binary compatibility. */ + /* See design.mps.pref. */ + break; + } + + return ResOK; +} + + +#if 1 + +/* GenDescCheck -- check a GenDesc */ + +static Bool GenDescCheck(GenDesc gen) +{ + CHECKS(GenDesc, gen); + /* nothing to check for zones */ + /* nothing to check for capacity */ + CHECKL(gen->mortality >= 0.0); + CHECKL(gen->mortality <= 1.0); + CHECKL(gen->proflow >= 0.0); + CHECKL(gen->proflow <= 1.0); + CHECKL(RingCheck(&gen->locusRing)); + return TRUE; +} + + +/* GenDescNewSize -- return effective size of generation */ + +static Size GenDescNewSize(GenDesc gen) +{ + Size size = 0; + Ring node, nextNode; + + RING_FOR(node, &gen->locusRing, nextNode) { + PoolGen pgen = RING_ELT(PoolGen, genRing, node); + AVERT(PoolGen, pgen); + size += pgen->newSize; + } + return size; +} + + +/* GenDescTotalSize -- return total size of generation */ + +static Size GenDescTotalSize(GenDesc gen) +{ + Size size = 0; + Ring node, nextNode; + + RING_FOR(node, &gen->locusRing, nextNode) { + PoolGen pgen = RING_ELT(PoolGen, genRing, node); + AVERT(PoolGen, pgen); + size += pgen->totalSize; + } + return size; +} + + +/* ChainCreate -- create a generation chain */ + +Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount, + GenParamStruct *params) +{ + size_t i; + Chain chain; + GenDescStruct *gens; + Res res; + void *p; + + AVER(chainReturn != NULL); + AVERT(Arena, arena); + AVER(genCount > 0); + AVER(params != NULL); + for (i = 0; i < genCount; ++i) { + AVER(params[i].capacity > 0); + AVER(params[i].mortality > 0.0); + AVER(params[i].mortality < 1.0); + } + + res = ControlAlloc(&p, arena, genCount * sizeof(GenDescStruct), FALSE); + if (res != ResOK) return res; + gens = (GenDescStruct *)p; + + for (i = 0; i < genCount; ++i) { + gens[i].zones = ZoneSetEMPTY; + gens[i].capacity = params[i].capacity; + gens[i].mortality = params[i].mortality; + gens[i].proflow = 1.0; /* @@@@ temporary */ + RingInit(&gens[i].locusRing); + gens[i].sig = GenDescSig; + } + + res = ControlAlloc(&p, arena, sizeof(ChainStruct), FALSE); + if (res != ResOK) + goto failChainAlloc; + chain = (Chain)p; + + chain->arena = arena; + RingInit(&chain->chainRing); + chain->activeTraces = TraceSetEMPTY; + chain->genCount = genCount; + chain->gens = gens; + chain->sig = ChainSig; + + RingAppend(&arena->chainRing, &chain->chainRing); + AVERT(Chain, chain); + *chainReturn = chain; + return ResOK; + +failChainAlloc: + ControlFree(arena, gens, genCount * sizeof(GenDescStruct)); + return res; +} + + +/* ChainCheck -- check a chain */ + +Bool ChainCheck(Chain chain) +{ + size_t i; + + CHECKS(Chain, chain); + CHECKU(Arena, chain->arena); + CHECKL(RingCheck(&chain->chainRing)); + CHECKL(TraceSetCheck(chain->activeTraces)); + CHECKL(chain->genCount > 0); + for (i = 0; i < chain->genCount; ++i) { + CHECKD(GenDesc, &chain->gens[i]); + } + return TRUE; +} + + +/* ChainDestroy -- destroy a chain */ + +void ChainDestroy(Chain chain) +{ + Arena arena; + size_t genCount; + size_t i; + + AVERT(Chain, chain); + + arena = chain->arena; genCount = chain->genCount; + RingRemove(&chain->chainRing); + chain->sig = SigInvalid; + for (i = 0; i < genCount; ++i) { + RingFinish(&chain->gens[i].locusRing); + chain->gens[i].sig = SigInvalid; + } + RingFinish(&chain->chainRing); + ControlFree(arena, chain->gens, genCount * sizeof(GenDescStruct)); + ControlFree(arena, chain, sizeof(ChainStruct)); +} + + +/* ChainGens -- return the number of generation in chain */ + +size_t ChainGens(Chain chain) +{ + AVERT(Chain, chain); + return chain->genCount; +} + + +/* ChainDeferral -- time until next ephemeral GC for this chain */ + +double ChainDeferral(Chain chain) +{ + AVERT(Chain, chain); + + if (chain->activeTraces != TraceSetEMPTY) + return DBL_MAX; + else + return chain->gens[0].capacity * 1024.0 + - (double)GenDescNewSize(&chain->gens[0]); +} + + +/* ChainCondemnAuto -- condemn approriate parts of this chain + * + * This is only called if ChainDeferral returned a value sufficiently + * high that the tracer decided to start the collection. (Usually + * more than zero, but sometimes less; see mps.design.trace.) + */ +Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace) +{ + Res res; + Serial topCondemnedGenSerial, currGenSerial; + GenDesc gen; + ZoneSet condemnedSet = ZoneSetEMPTY; + Size condemnedSize = 0, survivorSize = 0, genNewSize, genTotalSize; + + AVERT(Chain, chain); + AVERT(Trace, trace); + + /* Find lowest gen within its capacity, set topCondemnedGenSerial to the */ + /* preceeding one. */ + currGenSerial = 0; gen = &chain->gens[0]; + AVERT(GenDesc, gen); + genNewSize = GenDescNewSize(gen); + do { /* At this point, we've decided to collect currGenSerial. */ + topCondemnedGenSerial = currGenSerial; + condemnedSet = ZoneSetUnion(condemnedSet, gen->zones); + genTotalSize = GenDescTotalSize(gen); + condemnedSize += genTotalSize; + survivorSize += (Size)(genNewSize * (1.0 - gen->mortality)) + /* predict survivors will survive again */ + + (genTotalSize - genNewSize); + + if (++currGenSerial >= chain->genCount) + break; /* reached the top */ + gen = &chain->gens[currGenSerial]; + AVERT(GenDesc, gen); + genNewSize = GenDescNewSize(gen); + } while (genNewSize >= gen->capacity * (Size)1024); + + /* Condemn everything in these zones. */ + if (condemnedSet != ZoneSetEMPTY) { + res = TraceCondemnZones(trace, condemnedSet); + if (res != ResOK) + return res; + } + + *mortalityReturn = 1.0 - (double)survivorSize / condemnedSize; + return ResOK; +} + + +/* ChainCondemnAll -- condemn everything in the chain */ + +Res ChainCondemnAll(Chain chain, Trace trace) +{ + Ring node, nextNode; + Bool haveWhiteSegs = FALSE; + Res res; + + /* Condemn every segment in every pool using this chain. */ + /* Finds the pools by iterating over the PoolGens in gen 0. */ + RING_FOR(node, &chain->gens[0].locusRing, nextNode) { + PoolGen nursery = RING_ELT(PoolGen, genRing, node); + Pool pool = nursery->pool; + Ring segNode, nextSegNode; + + AVERT(Pool, pool); + AVER((pool->class->attr & AttrGC) != 0); + RING_FOR(segNode, PoolSegRing(pool), nextSegNode) { + Seg seg = SegOfPoolRing(segNode); + + res = TraceAddWhite(trace, seg); + if (res != ResOK) + goto failBegin; + haveWhiteSegs = TRUE; + } + } + + return ResOK; + +failBegin: + AVER(!haveWhiteSegs); /* Would leave white sets inconsistent. */ + return res; +} + + +/* ChainStartGC -- called to notify start of GC for this chain */ + +void ChainStartGC(Chain chain, Trace trace) +{ + AVERT(Chain, chain); + AVERT(Trace, trace); + + chain->activeTraces = TraceSetAdd(chain->activeTraces, trace); +} + + +/* ChainEndGC -- called to notify end of GC for this chain */ + +void ChainEndGC(Chain chain, Trace trace) +{ + AVERT(Chain, chain); + AVERT(Trace, trace); + + chain->activeTraces = TraceSetDel(chain->activeTraces, trace); +} + + +/* PoolGenInit -- initialize a PoolGen */ + +Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool) +{ + /* Can't check gen, because it's not been initialized. */ + AVERT(Chain, chain); + AVER(nr <= chain->genCount); + AVERT(Pool, pool); + + gen->nr = nr; + gen->pool = pool; + gen->chain = chain; + RingInit(&gen->genRing); + gen->totalSize = (Size)0; + gen->newSize = (Size)0; + gen->sig = PoolGenSig; + + if (nr != chain->genCount) + RingAppend(&chain->gens[nr].locusRing, &gen->genRing); + else + /* Dynamic generation is linked to the arena, not the chain. */ + RingAppend(&chain->arena->topGen.locusRing, &gen->genRing); + AVERT(PoolGen, gen); + return ResOK; +} + + +/* PoolGenFinish -- finish a PoolGen */ + +void PoolGenFinish(PoolGen gen) +{ + AVERT(PoolGen, gen); + + gen->sig = SigInvalid; + RingRemove(&gen->genRing); +} + + +/* PoolGenCheck -- check a PoolGen */ + +Bool PoolGenCheck(PoolGen gen) +{ + CHECKS(PoolGen, gen); + /* nothing to check about serial */ + CHECKU(Pool, gen->pool); + CHECKU(Chain, gen->chain); + CHECKL(RingCheck(&gen->genRing)); + CHECKL(gen->newSize <= gen->totalSize); + return TRUE; +} + + +/* PoolGenUpdateZones -- update the zone of the generation + * + * This is a temporary i/f: eventually the locus manager will update + * these directly. + */ +void PoolGenUpdateZones(PoolGen gen, Seg seg) +{ + Chain chain; + + AVERT(PoolGen, gen); + AVERT(Seg, seg); + + chain = gen->chain; + AVERT(Chain, chain); + if (gen->nr != chain->genCount) + chain->gens[gen->nr].zones = + ZoneSetUnion(chain->gens[gen->nr].zones, ZoneSetOfSeg(chain->arena, seg)); + /* No need to keep track of dynamic gen zoneset. */ +} + + +/* LocusInit -- initialize the locus module */ + +void LocusInit(Arena arena) +{ + GenDesc gen = &arena->topGen; + + /* Can't check arena, because it's not been inited. */ + + gen->zones = ZoneSetEMPTY; + gen->capacity = 0; /* unused */ + gen->mortality = TraceTopGenMortality; /* @@@@ unused ATM */ + gen->proflow = 0.0; + RingInit(&gen->locusRing); + gen->sig = GenDescSig; +} + + +/* LocusFinish -- finish the locus module */ + +void LocusFinish(Arena arena) +{ + GenDesc gen = &arena->topGen; + + /* Can't check arena, because it's being finished. */ + + gen->sig = SigInvalid; + RingFinish(&gen->locusRing); +} + + +/* LocusCheck -- check the locus module */ + +Bool LocusCheck(Arena arena) +{ + /* Can't check arena, because this is part of ArenaCheck. */ + GenDescCheck(&arena->topGen); + return TRUE; +} + + +#endif diff --git a/mps/code/locv.c b/mps/code/locv.c new file mode 100644 index 00000000000..b63b163ff03 --- /dev/null +++ b/mps/code/locv.c @@ -0,0 +1,136 @@ +/* impl.c.locv: LEAF OBJECT POOL CLASS COVERAGE TEST + * + * $HopeName: MMsrc!locv.c(trunk.15) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * This is (not much of) a coverage test for the Leaf Object + * pool (PoolClassLO). + */ + +#include "testlib.h" +#include "mps.h" +#include "mpsclo.h" +#include "mpsavm.h" + + +#define testArenaSIZE ((size_t)16<<20) + +static mps_res_t scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit); +static mps_addr_t skip(mps_addr_t object); +static void move(mps_addr_t object, mps_addr_t to); +static mps_addr_t isMoved(mps_addr_t object); +static void copy(mps_addr_t old, mps_addr_t new); +static void pad(mps_addr_t base, size_t size); + +static mps_fmt_A_s locv_fmt = + { + (mps_align_t)4, + scan, + skip, + copy, + move, + isMoved, + pad + }; + +static mps_addr_t roots[4]; + + +int main(void) +{ + mps_arena_t arena; + mps_pool_t pool; + mps_fmt_t format; + mps_ap_t ap; + mps_addr_t p; + mps_root_t root; + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + die(mps_root_create_table(&root, arena, MPS_RANK_EXACT, + (mps_rm_t)0, + roots, (sizeof(roots)/sizeof(*roots))), + "RootCreate"); + + die(mps_fmt_create_A(&format, arena, &locv_fmt), "FormatCreate"); + + die(mps_pool_create(&pool, arena, mps_class_lo(), format), "LOCreate"); + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "APCreate"); + + die(mps_reserve(&p, ap, (size_t)4), "mps_reserve 4"); + *(mps_word_t *)p = 4; + cdie(mps_commit(ap, p, (size_t)4), "commit 4"); + die(mps_reserve(&roots[1], ap, (size_t)8), "mps_reserve 8"); + p = roots[1]; + *(mps_word_t *)p = 8; + cdie(mps_commit(ap, p, (size_t)8), "commit 8"); + die(mps_reserve(&p, ap, (size_t)4096), "mps_reserve 4096"); + *(mps_word_t *)p = 4096; + cdie(mps_commit(ap, p, (size_t)4096), "commit 4096"); + die(mps_reserve(&p, ap, (size_t)4), "mps_reserve last"); + *(mps_word_t *)p = 4; + cdie(mps_commit(ap, p, (size_t)4), "commit last"); + + mps_ap_destroy(ap); + mps_pool_destroy(pool); + mps_fmt_destroy(format); + mps_root_destroy(root); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} + + +static mps_res_t scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit) +{ + testlib_unused(ss); + testlib_unused(base); + testlib_unused(limit); + die(MPS_RES_FAIL, "Error in Test, scan called unexpectedly"); + return MPS_RES_FAIL; +} + + +static mps_addr_t skip(mps_addr_t object) +{ + size_t bytes; + + bytes = (size_t)(*(mps_word_t *)object); + + return (mps_addr_t)((char *)object + bytes); +} + + +static void move(mps_addr_t object, mps_addr_t to) +{ + testlib_unused(object); + testlib_unused(to); + cdie(0, "move"); +} + + +static mps_addr_t isMoved(mps_addr_t object) +{ + testlib_unused(object); + cdie(0, "isMoved"); + return (mps_addr_t)NULL; +} + + +static void copy(mps_addr_t old, mps_addr_t new) +{ + testlib_unused(old); + testlib_unused(new); + cdie(0, "copy"); +} + + +static void pad(mps_addr_t base, size_t size) +{ + testlib_unused(base); + testlib_unused(size); + cdie(0, "pad"); +} diff --git a/mps/code/message.c b/mps/code/message.c new file mode 100644 index 00000000000..f29af31d258 --- /dev/null +++ b/mps/code/message.c @@ -0,0 +1,396 @@ +/* impl.c.message: MPS/CLIENT MESSAGES + * + * $HopeName: MMsrc!message.c(trunk.10) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: See design.mps.message (it really exists). + * + * PURPOSE + * + * .purpose: Provide the generic part of the MPS / Client message + * interface. Messages are instances of Message Classes; much of the + * "real work" goes on in the modules that provide the actual messages. + */ + +#include "mpm.h" + +SRCID(message, "$HopeName: MMsrc!message.c(trunk.10) $"); + + +/* Maps from a Ring pointer to the message */ +#define MessageNodeMessage(node) \ + PARENT(MessageStruct, queueRing, node) + + +/* forward declarations */ +static Bool MessageTypeEnabled(Arena arena, MessageType type); +static void MessageDelete(Message message); + + +/* MessageOnQueue -- is the message on the queue? + * + * Message is on queue if and only if its ring is not a singleton. + */ + +static Bool MessageOnQueue(Message message) +{ + AVERT(Message, message); + + return !RingIsSingle(&message->queueRing); +} + + +/* Checking Functions */ + + +Bool MessageTypeCheck(MessageType type) +{ + CHECKL(type < MessageTypeLIMIT); + UNUSED(type); /* impl.c.mpm.check.unused */ + + return TRUE; +} + + +Bool MessageCheck(Message message) +{ + CHECKS(Message, message); + CHECKU(Arena, message->arena); + CHECKL(MessageTypeCheck(message->type)); + CHECKU(MessageClass, message->class); + CHECKL(RingCheck(&message->queueRing)); + + return TRUE; +} + + +Bool MessageClassCheck(MessageClass class) +{ + CHECKS(MessageClass, class); + CHECKL(class->name != NULL); + CHECKL(FUNCHECK(class->delete)); + CHECKL(FUNCHECK(class->finalizationRef)); + CHECKL(class->endSig == MessageClassSig); + + return TRUE; +} + + +/* Internal Functions */ + + +/* returns the arena associated with a message */ +Arena MessageArena(Message message) +{ + AVERT(Message, message); + + return message->arena; +} + + +/* return the class of a message */ +MessageClass MessageGetClass(Message message) +{ + AVERT(Message, message); + + return message->class; +} + + +/* Initialises a message */ +void MessageInit(Arena arena, Message message, MessageClass class, + MessageType type) +{ + AVERT(Arena, arena); + AVER(message != NULL); + AVERT(MessageClass, class); + AVERT(MessageType, type); + + message->arena = arena; + message->class = class; + RingInit(&message->queueRing); + message->type = type; + message->sig = MessageSig; + + AVERT(Message, message); +} + + +/* Finishes a message */ +void MessageFinish(Message message) +{ + AVERT(Message, message); + AVER(RingIsSingle(&message->queueRing)); + + message->sig = SigInvalid; + RingFinish(&message->queueRing); +} + + +/* Posts a message to the arena's queue of pending messages */ +void MessagePost(Arena arena, Message message) +{ + AVERT(Arena, arena); + AVERT(Message, message); + + /* queueRing field must be a singleton, see */ + /* design.mps.message.fun.post.singleton */ + AVER(!MessageOnQueue(message)); + if(MessageTypeEnabled(arena, message->type)) { + RingAppend(&arena->messageRing, &message->queueRing); + } else { + /* discard message immediately if client hasn't enabled that type */ + MessageDiscard(arena, message); + } +} + + +/* returns the Message at the head of the queue */ +static Message MessageHead(Arena arena) +{ + AVERT(Arena, arena); + AVER(!RingIsSingle(&arena->messageRing)); + + return MessageNodeMessage(RingNext(&arena->messageRing)); +} + + +/* returns the type of a message */ +MessageType MessageGetType(Message message) +{ + AVERT(Message, message); + + return message->type; +} + + +/* External Functions + * + * These are actually the internal implementations of functions + * exposed through the external interface */ + + +/* Determines whether the queue has any messages on it */ +Bool MessagePoll(Arena arena) +{ + AVERT(Arena, arena); + + if(RingIsSingle(&arena->messageRing)) { + return FALSE; + } else { + return TRUE; + } +} + + +/* Determines the type of a message at the head of the queue */ +Bool MessageQueueType(MessageType *typeReturn, Arena arena) +{ + Message message; + MessageType type; + + AVER(typeReturn != NULL); + AVERT(Arena, arena); + + if(!MessagePoll(arena)) { + return FALSE; + } + message = MessageHead(arena); + type = MessageGetType(message); + *typeReturn = type; + + return TRUE; +} + + +/* Discards a message + * (called from external interface) */ +void MessageDiscard(Arena arena, Message message) +{ + AVERT(Arena, arena); + AVERT(Message, message); + + AVER(!MessageOnQueue(message)); + + MessageDelete(message); +} + + +/* Deletes the message at the head of the queue. + * Internal function. */ +static void MessageDeleteHead(Arena arena) +{ + Message message; + + AVERT(Arena, arena); + AVER(!RingIsSingle(&arena->messageRing)); + + message = MessageHead(arena); + AVERT(Message, message); + RingRemove(&message->queueRing); + MessageDelete(message); +} + +/* Empties the queue by discarding all messages */ +void MessageEmpty(Arena arena) +{ + AVERT(Arena, arena); + + while(!RingIsSingle(&arena->messageRing)) { + MessageDeleteHead(arena); + } +} + +Bool MessageGet(Message *messageReturn, Arena arena, MessageType type) +{ + Ring node, next; + + AVER(messageReturn != NULL); + AVERT(Arena, arena); + AVER(MessageTypeCheck(type)); + + RING_FOR(node, &arena->messageRing, next) { + Message message = RING_ELT(Message, queueRing, node); + if(MessageGetType(message) == type) { + RingRemove(&message->queueRing); + *messageReturn = message; + return TRUE; + } + } + return FALSE; +} + + +static Bool MessageTypeEnabled(Arena arena, MessageType type) +{ + AVERT(Arena, arena); + AVER(MessageTypeCheck(type)); + + return BTGet(arena->enabledMessageTypes, type); +} + + +void MessageTypeEnable(Arena arena, MessageType type) +{ + AVERT(Arena, arena); + AVER(MessageTypeCheck(type)); + + BTSet(arena->enabledMessageTypes, type); +} + + +void MessageTypeDisable(Arena arena, MessageType type) +{ + Message message; + + AVERT(Arena, arena); + AVER(MessageTypeCheck(type)); + + /* Flush existing messages of this type */ + while(MessageGet(&message, arena, type)) { + MessageDelete(message); + } + + BTRes(arena->enabledMessageTypes, type); +} + + + +/* Dispatch Methods */ + + +/* generic message delete dispatch */ +static void MessageDelete(Message message) +{ + AVERT(Message, message); + + (*message->class->delete)(message); +} + + +/* type specific dispatch methods */ + +void MessageFinalizationRef(Ref *refReturn, Arena arena, + Message message) +{ + AVER(refReturn != NULL); + AVERT(Arena, arena); + AVERT(Message, message); + + AVER(message->type == MessageTypeFINALIZATION); + + (*message->class->finalizationRef)(refReturn, arena, message); + + return; +} + + +Size MessageGCLiveSize(Message message) +{ + AVERT(Message, message); + AVER(message->type == MessageTypeGC); + + return (*message->class->gcLiveSize)(message); +} + +Size MessageGCCondemnedSize(Message message) +{ + AVERT(Message, message); + AVER(message->type == MessageTypeGC); + + return (*message->class->gcCondemnedSize)(message); +} + +Size MessageGCNotCondemnedSize(Message message) +{ + AVERT(Message, message); + AVER(message->type == MessageTypeGC); + + return (*message->class->gcNotCondemnedSize)(message); +} + + +/* type-specific stub methods */ + + +void MessageNoFinalizationRef(Ref *refReturn, Arena arena, + Message message) +{ + AVER(refReturn != NULL); + AVERT(Arena, arena); + AVERT(Message, message); + + NOTREACHED; +} + +Size MessageNoGCLiveSize(Message message) +{ + AVERT(Message, message); + UNUSED(message); + + NOTREACHED; + + return (Size)0; +} + +Size MessageNoGCCondemnedSize(Message message) +{ + AVERT(Message, message); + UNUSED(message); + + NOTREACHED; + + return (Size)0; +} + +Size MessageNoGCNotCondemnedSize(Message message) +{ + AVERT(Message, message); + UNUSED(message); + + NOTREACHED; + + return (Size)0; +} diff --git a/mps/code/messtest.c b/mps/code/messtest.c new file mode 100644 index 00000000000..d5ab23ea8e5 --- /dev/null +++ b/mps/code/messtest.c @@ -0,0 +1,269 @@ +/* impl.c.messtest: MESSAGE TEST + * + * $HopeName: MMsrc!messtest.c(trunk.2) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "mpsavm.h" +#include "mps.h" +#include "testlib.h" + +#include +#include + +SRCID(messtest, "$HopeName: MMsrc!messtest.c(trunk.2) $"); + + +/* Basic infrastructure for creating dummy messages */ + +static void dfMessageDelete(Message message) +{ + Arena arena; + arena = MessageArena(message); + ControlFree(arena, (void *)message, sizeof(MessageStruct)); +} + + +/* DFMessageClassStruct -- dummy finalization message class */ + +static MessageClassStruct DFMessageClassStruct = { + MessageClassSig, /* sig */ + "DummyFinal", /* name */ + dfMessageDelete, /* Delete */ + MessageNoFinalizationRef, /* FinalizationRef */ + MessageNoGCLiveSize, /* GCLiveSize */ + MessageNoGCCondemnedSize, /* GCCondemnedSize */ + MessageNoGCNotCondemnedSize, /* GCNoteCondemnedSize */ + MessageClassSig /* design.mps.message.class.sig.double */ +}; + + +/* DGCMessageClassStruct -- dummy GC message class */ + +static MessageClassStruct DGCMessageClassStruct = { + MessageClassSig, /* sig */ + "DummyGC", /* name */ + dfMessageDelete, /* Delete */ + MessageNoFinalizationRef, /* FinalizationRef */ + MessageNoGCLiveSize, /* GCLiveSize */ + MessageNoGCCondemnedSize, /* GCCondemnedSize */ + MessageNoGCNotCondemnedSize, /* GCNoteCondemnedSize */ + MessageClassSig /* design.mps.message.class.sig.double */ +}; + + +static void checkNoMessages(Arena arena) +{ + cdie(!MessagePoll(arena), "Queue not empty"); +} + + +static void topMessageType(MessageType *typeReturn, Arena arena) +{ + cdie(MessageQueueType(typeReturn, arena), "Queue empty"); +} + + +/* postDummyMessage -- post a dummy finalization message */ + +static void postDummyMessage(Arena arena, MessageClass class, + MessageType type) +{ + void *p; + Message message; + + die((mps_res_t)ControlAlloc(&p, arena, sizeof(MessageStruct), FALSE), + "AllocMessage"); + message = (Message)p; + MessageInit(arena, message, class, type); + MessagePost(arena, message); + return; +} + + +/* postFinalizationMessage -- post dummy finalization message */ + +static void postFinalizationMessage(Arena arena) +{ + postDummyMessage(arena, &DFMessageClassStruct, MessageTypeFINALIZATION); +} + +/* postGCMessage -- post dummy GC message */ + +static void postGCMessage(Arena arena) +{ + postDummyMessage(arena, &DGCMessageClassStruct, MessageTypeGC); +} + + +/* postInterleavedMessages -- post a couple of each message type */ + +static void postInterleavedMessages(Arena arena) +{ + postFinalizationMessage(arena); + postGCMessage(arena); + postFinalizationMessage(arena); + postGCMessage(arena); +} + + +/* eatMessageOfType -- get a message of a specified type + * + * There must be at least 1 message of that type on the queue. + */ + +static void eatMessageOfType(Arena arena, MessageType type) +{ + Message message; + cdie(MessageGet(&message, arena, type), "No message"); + MessageDiscard(arena, message); +} + + +/* eatHiddenMessage -- get a message which isn't at top of queue + * + * Assumes there is at least 1 message of each of Finalization + * and GC types. + */ + +static void eatHiddenMessage(Arena arena) +{ + MessageType type, eatType; + + topMessageType(&type, arena); + if (type != MessageTypeGC) { + eatType = MessageTypeGC; + } else { + eatType = MessageTypeFINALIZATION; + } + eatMessageOfType(arena, eatType); +} + + +/* eatTopMessageOfType -- get a message which is at top of queue + * + * The message must be of the specified type. + * Assumes there is at least 1 message on the queue. + */ + +static void eatTopMessageOfType(Arena arena, MessageType type) +{ + MessageType topType; + + topMessageType(&topType, arena); + cdie((topType == type), "Unexpected type"); + eatMessageOfType(arena, type); +} + + +/* eatTopMessage -- get a message which is at top of queue + * + * Assumes there is at least 1 message on the queue. + */ + +static void eatTopMessage(Arena arena) +{ + MessageType type; + + topMessageType(&type, arena); + eatMessageOfType(arena, type); +} + + + +/* testInterleaving -- test interleaving messages of different types + * + * See request.dylan.160204 + * must be able to retrieve a message even if a message of + * another type is at the head of the queue. + */ + +static void testInterleaving(Arena arena) +{ + MessageEmpty(arena); + + /* enable both types of message */ + MessageTypeEnable(arena, MessageTypeGC); + MessageTypeEnable(arena, MessageTypeFINALIZATION); + + /* post a couple of interleaved messages of each type */ + postInterleavedMessages(arena); + + /* check that we can pull out 2 messages not at the head */ + eatHiddenMessage(arena); + eatHiddenMessage(arena); + + /* check that we can pull out 2 messages which are at the head */ + eatTopMessage(arena); + eatTopMessage(arena); +} + + +/* testDisabling -- test message types can be disabled + * + * See request.dylan.160204 + */ + +static void testDisabling(Arena arena) +{ + MessageEmpty(arena); + + /* enable both types of message */ + MessageTypeEnable(arena, MessageTypeGC); + MessageTypeEnable(arena, MessageTypeFINALIZATION); + + /* post a couple of interleaved messages of each type */ + postInterleavedMessages(arena); + + /* Disable one of the types */ + MessageTypeDisable(arena, MessageTypeFINALIZATION); + + /* check that we can pull out 2 messages of the other type */ + eatTopMessageOfType(arena, MessageTypeGC); + eatTopMessageOfType(arena, MessageTypeGC); + + /* check that the queue is empty */ + checkNoMessages(arena); + + /* Post a disabled message */ + postFinalizationMessage(arena); + + /* check that the queue is still empty */ + checkNoMessages(arena); +} + + +/* testGetEmpty -- test we don't AVER when getting a non-existent message */ + +static void testGetEmpty(Arena arena) +{ + Message message; + + MessageEmpty(arena); + checkNoMessages(arena); + cdie(!MessageGet(&message, arena, MessageTypeGC), "Got non-existent message"); +} + + +#define testArenaSIZE (((size_t)64)<<20) + +extern int main(int argc, char *argv[]) +{ + mps_arena_t mpsArena; + Arena arena; + + testlib_unused(argc); + testlib_unused(argv); + + die(mps_arena_create(&mpsArena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + arena = (Arena)mpsArena; + + testGetEmpty(arena); + testInterleaving(arena); + testDisabling(arena); + + printf("\nNo problems detected.\n"); + return 0; +} diff --git a/mps/code/meter.c b/mps/code/meter.c new file mode 100644 index 00000000000..fc3b36d7bbd --- /dev/null +++ b/mps/code/meter.c @@ -0,0 +1,104 @@ +/* impl.c.meter: METERS + * + * $HopeName: MMsrc!meter.c(trunk.9) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * TRANSGRESSIONS + * + * .trans.label: We label meters with EventLabelAddr, but of course that's + * meant for labelling Addr's. We get away with it as long as the type + * Meter is compatible with Addr. + */ + +#include "meter.h" +#include "mpm.h" + +SRCID(meter, "$HopeName$"); + + +/* MeterInit -- initialize a meter */ + +void MeterInit(Meter meter, char *name, void *owner) +{ + Word sym; + + meter->name = name; + meter->count = 0; + meter->total = 0.0; + meter->meanSquared = 0.0; + meter->max = 0; + meter->min = (Size)-1; + + sym = EventInternString(name); + EventLabelAddr((Addr)meter, sym); /* see .trans.label */ + EVENT_PP(MeterInit, meter, owner); + UNUSED(owner); /* @@@@ hack */ +} + + +/* MeterAccumulate -- accumulate another data point in the meter */ + +void MeterAccumulate(Meter meter, Size amount) +{ + Count count = meter->count + 1; + double total = meter->total; + double meanSquared = meter->meanSquared; + double dcount = (double)count; + + /* .limitation.variance: This computation accumulates a running + * mean^2, minimizing overflow, but sacrificing numerical stablity + * for small variances. For more accuracy, the data set should be + * emitted using a telemetry stream and analyzed off-line. + .stddev: stddev = sqrt(meanSquared - mean^2). + */ + meter->count = count; + meter->total = total + amount; + meter->meanSquared = + meanSquared / dcount * (dcount - 1.0) + + amount / dcount * amount; + if (amount > meter->max) + meter->max = amount; + if (amount < meter->min) + meter->min = amount; +} + + +/* MeterWrite -- describe method for meters */ + +Res MeterWrite(Meter meter, mps_lib_FILE *stream) +{ + Res res = ResOK; + + res = WriteF(stream, + "meter $S {", meter->name, + "count: $U", meter->count, + NULL); + if (res != ResOK) + return res; + if (meter->count > 0) { + double mean = meter->total / (double)meter->count; + + res = WriteF(stream, + ", total: $D", meter->total, + ", max: $U", meter->max, + ", min: $U", meter->min, + ", mean: $D", mean, + ", mean^2: $D", meter->meanSquared, + NULL); + if (res != ResOK) + return res; + } + res = WriteF(stream, "}\n", NULL); + + return res; +} + + +/* MeterEmit -- emit an evnet with the current data from the meter */ + +void MeterEmit(Meter meter) +{ + EVENT_PDDWWW(MeterValues, meter, meter->total, meter->meanSquared, + meter->count, meter->max, meter->min); + UNUSED(meter); /* @@@@ hack */ +} diff --git a/mps/code/meter.h b/mps/code/meter.h new file mode 100644 index 00000000000..02ad6811f4f --- /dev/null +++ b/mps/code/meter.h @@ -0,0 +1,57 @@ +/* impl.h.meter: METER INTERFACE + * + * $HopeName: MMsrc!meter.h(trunk.5) $ + * Copyright (C) 1998, 1999 Harlequin Group plc. All rights reserved. + * + * .sources: mps.design.metrics. + * + * .purpose: Defines an interface for creating "meters" that accumulate + * the number, total and mean^2 of a set of data points. These + * accumulators can be used to report on the number, total, average, and + * variance of the data set. + */ + +#ifndef meter_h +#define meter_h + +#include "mpmtypes.h" +#include "config.h" +#include "misc.h" +#include "mpslib.h" + + +typedef struct MeterStruct *Meter; + +typedef struct MeterStruct +{ + char *name; + Count count; + double total; + double meanSquared; + Size min; + Size max; +} MeterStruct; + + +extern void MeterInit(Meter meter, char* name, void *owner); +extern void MeterAccumulate(Meter meter, Size amount); +extern Res MeterWrite(Meter meter, mps_lib_FILE *stream); +extern void MeterEmit(Meter meter); + +#define METER_DECL(meter) STATISTIC_DECL(struct MeterStruct meter) +#define METER_INIT(meter, init, owner) \ + BEGIN STATISTIC(MeterInit(&(meter), init, owner)); UNUSED(owner); END +/* Hack: owner is typically only used for MeterInit */ +#define METER_ACC(meter, delta) \ + STATISTIC(MeterAccumulate(&(meter), delta)) +#if defined(DIAGNOSTICS) +#define METER_WRITE(meter, stream) MeterWrite(&(meter), stream) +#elif defined(DIAGNOSTICS_NONE) +#define METER_WRITE(meter, stream) (ResOK) +#else +#error "Diagnostics not configured." +#endif +#define METER_EMIT(meter) STATISTIC(MeterEmit(meter)) + + +#endif /* meter_h */ diff --git a/mps/code/misc.h b/mps/code/misc.h new file mode 100644 index 00000000000..333f2214389 --- /dev/null +++ b/mps/code/misc.h @@ -0,0 +1,190 @@ +/* impl.h.misc: MISCELLANEOUS DEFINITIONS + * + * $HopeName: MMsrc!misc.h(trunk.26) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * Small general things which are useful for C but aren't part of the + * memory manager itself. The only reason that this file exists is + * that these things are too small and trivial to be put in their own + * headers. If they ever become non-trivial they should be moved out. + */ + +#ifndef misc_h +#define misc_h + +#include + + +typedef int Bool; /* design.mps.type.bool */ +enum { + FALSE = 0, + TRUE = 1 +}; + + +/* offsetof -- offset of field within structure + * + * .hack.offsetof: On platform.sus8lc the offsetof macro is not defined + * (because LCC does not bother fixing up SunOS's broken header files). + * We define it here using normal C constructs. This hack is only + * required on platform.sus8lc and no other platforms. See + * change.mps.tracer2.170226 + */ + +#ifdef MPS_PF_SUS8LC +#ifdef offsetof +#error "offsetof was unexpectedly already defined on platform SUS8LC" +#else +#define offsetof(type, field) ((size_t)(((char *)&((type *)0)->field) \ + - (char *)0)) +#endif /* offsetof */ +#endif /* MPS_PF_SUS8LC */ + + +/* SrcId -- source identification + * + * Every C source file should start with a SRCID declaration to + * create a local static source identification structure. This + * is used by other macros (particularly assertions) and can be + * used to reverse engineer binary deliverables. + */ + +typedef const struct SrcIdStruct *SrcId; +typedef const struct SrcIdStruct { + const char *file; + const char *hopename; + const char *build_date; + const char *build_time; +} SrcIdStruct; + +#define SRCID(id, hopename) \ + static SrcIdStruct FileSrcIdStruct = \ + {__FILE__, (hopename), __DATE__, __TIME__}; \ + SrcId id ## SrcId = &FileSrcIdStruct + + +/* BEGIN and END -- statement brackets + * + * BEGIN and END can be used to bracket multi-statement blocks which + * will be followed by a semicolon, such as multi-statement macros. + * BEGIN and END should be used to bracket ALL multi-statement macros. + * The block, with its semicolon, still counts as a single statement. + * This ensures that such macros can be used in all statement contexts, + * including in the first branch of an if() statement which has an else + * clause. + */ + +#define BEGIN do { +#define END } while(0) + + + +/* RVALUE -- for method-style macros + * + * RVALUE is used to enclose the expansion of a macro that must not be + * used as an lvalue, e.g. a getter method. + */ + +#define RVALUE(expr) ((void)0, (expr)) + +/* NOOP -- null statement + * + * Do not be tempted to use NULL, or just semicolon as the null + * statement. These items are dangerously ambigous and could cause + * subtle bugs if misplaced. NOOP is a macro which is guaranteed to + * cause an error if it is not used in a statement context. + */ + +#define NOOP do {} while(0) + + +/* STR -- expands into a string of the expansion of the argument + * + * E.g., if we have: + * #define a b + * STR(a) will expand into "b". + */ + +#define STR_(x) #x +#define STR(x) STR_(x) + + +/* DISCARD -- discards an expression, but checks syntax + * + * The argument is an expression; the expansion followed by a semicolon + * is syntactically a statement (to avoid it being used in computation). + * + * .discard: DISCARD uses sizeof so that the expression is not evaluated + * and yet the compiler will check that it is a valid expression. The + * conditional is compared with zero so it can designate a bitfield object. + */ + +#define DISCARD(expr) \ + BEGIN \ + (void)sizeof((expr)!=0); \ + END + + +/* DISCARD_STAT -- discards a statement, but checks syntax + * + * The argument is a statement; the expansion followed by a semicolon + * is syntactically a statement. + */ + +#define DISCARD_STAT(stat) \ + BEGIN \ + if (0) stat; \ + END + + +/* UNUSED -- declare parameter unused + * + * This macro supresses warnings about unused parameters. It should be + * applied to the parameter at the beginning of the body of the + * procedure. + * + * The cast to void appears to work for GCC, MSVC, and CodeWarrior. + * It's a shame there's no way to ensure that the parameter won't be + * used. We could scramble it, but that's undesirable in release + * versions. + */ + +#define UNUSED(param) ((void)param) + + +/* PARENT -- parent structure + * + * Given a pointer to a field of a structure this returns a pointer to + * the main structure. PARENT(foo_t, x, foo->x) == foo. + * + * This macro is thread-safe. design.mps.misc.parent.thread-safe + */ + +#define PARENT(type, field, p) \ + ((type *)((char *)(p) - offsetof(type, field))) + + +/* Bit Sets -- sets of integers in [0,N-1]. + * + * Can be used on any unsigned integral type, ty. These definitions + * are _syntactic_, hence macroid, hence upper case + * (guide.c.naming.macro.special). + */ + +#define BS_EMPTY(ty) ((ty)0) +#define BS_COMP(s) (~(s)) +#define BS_UNIV(ty) BS_COMP(BS_EMPTY(ty)) +#define BS_SINGLE(ty, i) ((ty)1 << (i)) +#define BS_IS_MEMBER(s, i) (((s) >> (i)) & 1) +#define BS_UNION(s1, s2) ((s1) | (s2)) +#define BS_ADD(ty, s, i) BS_UNION((s), BS_SINGLE(ty, (i))) +#define BS_INTER(s1, s2) ((s1) & (s2)) +#define BS_DIFF(s1, s2) BS_INTER((s1), BS_COMP(s2)) +#define BS_DEL(ty, s, i) BS_DIFF((s), BS_SINGLE(ty, (i))) +#define BS_SUPER(s1, s2) (BS_INTER((s1), (s2)) == (s2)) +#define BS_SUB(s1, s2) BS_SUPER((s2), (s1)) +#define BS_IS_SINGLE(s) (((s) & ((s)-1)) == 0) +#define BS_SYM_DIFF(s1, s2) ((s1) ^ (s2)) + + +#endif /* misc_h */ diff --git a/mps/code/mpm.c b/mps/code/mpm.c new file mode 100644 index 00000000000..8f60f074882 --- /dev/null +++ b/mps/code/mpm.c @@ -0,0 +1,525 @@ +/* impl.c.mpm: GENERAL MPM SUPPORT + * + * $HopeName: MMsrc!mpm.c(trunk.34) $ + * Copyright (C) 1996 Harlequin Limited. All rights reserved. + * + * .purpose: Miscellaneous support for the implementation of the MPM + * and pool classes. + * + * .sources: design.mps.writef */ + +#include "mpm.h" +#include +/* Get some floating constants for WriteDouble */ +#include +#include + + +SRCID(mpm, "$HopeName: MMsrc!mpm.c(trunk.34) $"); + + +/* MPMCheck -- test MPM assumptions */ + +Bool MPMCheck(void) +{ + CHECKL(sizeof(Word) * CHAR_BIT == MPS_WORD_WIDTH); + CHECKL(1uL << MPS_WORD_SHIFT == MPS_WORD_WIDTH); + CHECKL(AlignCheck(MPS_PF_ALIGN)); + /* Check that trace ids will fit in the TraceId type. */ + CHECKL(TraceLIMIT <= UINT_MAX); + /* Check that there are enough bits in */ + /* a TraceSet to store all possible trace ids. */ + CHECKL(sizeof(TraceSet) * CHAR_BIT >= TraceLIMIT); + + CHECKL((SizeAlignUp(0, 2048) == 0)); + CHECKL(!SizeIsAligned(64, (unsigned) -1)); + CHECKL(SizeIsAligned(0, 32)); + CHECKL((SizeAlignUp(1024, 16) == 1024)); + /* .prime: 31051 is prime */ + CHECKL(SizeIsAligned(SizeAlignUp(31051, 256), 256)); + CHECKL(SizeIsAligned(SizeAlignUp(31051, 512), 512)); + CHECKL(!SizeIsAligned(31051, 1024)); + CHECKL(!SizeIsP2(0)); + CHECKL(SizeIsP2(128)); + CHECKL(SizeLog2(1L) == 0); + CHECKL(SizeLog2(256L) == 8); + CHECKL(SizeLog2(65536L) == 16); + CHECKL(SizeLog2(131072L) == 17); + + /* .check.writef: We check that various types will fit in a Word; */ + /* See .writef.check. Don't need to check WriteFS or WriteFF as they */ + /* should not be cast to Word. */ + CHECKL(sizeof(WriteFA) <= sizeof(Word)); + CHECKL(sizeof(WriteFP) <= sizeof(Word)); + CHECKL(sizeof(WriteFW) <= sizeof(Word)); /* Should be trivial*/ + CHECKL(sizeof(WriteFU) <= sizeof(Word)); + CHECKL(sizeof(WriteFB) <= sizeof(Word)); + CHECKL(sizeof(WriteFC) <= sizeof(Word)); + /* .check.write.double: See .write.double.check */ + { + int e, DBL_EXP_DIG = 1; + for (e = DBL_MAX_10_EXP; e > 0; e /= 10) + DBL_EXP_DIG++; + CHECKL(DBL_EXP_DIG < DBL_DIG); + CHECKL(-(DBL_MIN_10_EXP) <= DBL_MAX_10_EXP); + } + + return TRUE; +} + + +/* FunCheck -- check that a function pointer is valid */ + +Bool FunCheck(Fun f) +{ + CHECKL(f != NULL); + /* Could assert various platform-specific things here. */ + UNUSED(f); /* see .check.unused */ + return TRUE; +} + + +/* ShiftCheck -- check that a shift is valid */ + +Bool ShiftCheck(Shift shift) +{ + CHECKL(shift < MPS_WORD_WIDTH); /* standard.ansic 6.3.7 */ + UNUSED(shift); /* see .check.unused */ + return TRUE; +} + + +/* AttrCheck -- check that a set of pool attributes are valid */ + +Bool AttrCheck(Attr attr) +{ + CHECKL((attr & ~AttrMASK) == 0); + /* Could check for legal combinations of attributes. */ + UNUSED(attr); /* see .check.unused */ + return TRUE; +} + + +/* AlignCheck -- check that an alignment is valid */ + +Bool AlignCheck(Align align) +{ + CHECKL(align > 0 && (align & (align - 1)) == 0); + /* .check.unused: Check methods for signatureless types don't use */ + /* their argument in hot varieties, so UNUSED is needed. */ + UNUSED(align); + return TRUE; +} + + +/* WordIsAligned -- test whether a word is aligned */ + +Bool (WordIsAligned)(Word word, Align align) +{ + AVER(AlignCheck(align)); + return WordIsAligned(word, align); +} + + +/* WordAlignUp -- round a word up to the nearest aligned value */ + +Word (WordAlignUp)(Word word, Align align) +{ + AVER(AlignCheck(align)); + return WordAlignUp(word, align); +} + +/* WordRoundUp -- round word up to round. + * + * .wordroundup.arg.word: The word arg is quantity to be rounded. + * .wordroundup.arg.round: The modulus argument is not necessarily an + * alignment (i.e., not a power of two). + * + * .wordroundup.result: Let m be congruent to 0 mod r (m == 0(r)), and + * let m be the least m >= w. If w+r-1 (!) is representable in Word + * then result is m. Otherwise result is 0. Wittily. (NB. Result may + * be 0 even if m is representable.) */ + +Word (WordRoundUp)(Word word, Size modulus) +{ + AVER(modulus > 0); + return WordRoundUp(word, modulus); +} + + +/* WordAlignUp -- round a word down to the nearest aligned value */ + +Word (WordAlignDown)(Word word, Align alignment) +{ + AVER(AlignCheck(alignment)); + return WordAlignDown(word, alignment); +} + + +/* SizeIsP2 -- test whether a size is a power of two */ + +Bool SizeIsP2(Size size) +{ + return size > 0 && (size & (size - 1)) == 0; +} + + +/* Logarithms */ + +Shift SizeFloorLog2(Size size) +{ + Shift l = 0; + + AVER(size != 0); + while(size > 1) { + ++l; + size >>= 1; + } + return l; +} + +Shift SizeLog2(Size size) +{ + AVER(SizeIsP2(size)); + return SizeFloorLog2(size); +} + + +/* AddrAlignDown -- round a word down to the nearest aligned value */ + +Addr (AddrAlignDown)(Addr addr, Align alignment) +{ + AVER(AlignCheck(alignment)); + return AddrAlignDown(addr, alignment); +} + + +/* ResIsAllocFailure + * + * Test whether a result code is in the set of allocation failure codes. */ + +Bool ResIsAllocFailure(Res res) +{ + return (res == ResMEMORY || res == ResRESOURCE || res == ResCOMMIT_LIMIT); +} + + +/* WriteWord -- output a textual representation of a word to a stream + * + * Output as an unsigned value in the given base (2-16), padded to the + * given width. */ + +static Res WriteWord(mps_lib_FILE *stream, Word w, unsigned base, + unsigned width) +{ + static const char digit[16] = "0123456789ABCDEF"; + static const char pad = '0'; /* padding character */ + char buf[MPS_WORD_WIDTH + 1]; /* enough for binary, */ + /* plus one for terminator */ + unsigned i; + int r; + + AVER(stream != NULL); + AVER(2 <= base && base <= 16); + AVER(width <= MPS_WORD_WIDTH); + + /* Add digits to the buffer starting at the right-hand end, so that */ + /* the buffer forms a string representing the number. A do...while */ + /* loop is used to ensure that at least one digit (zero) is written */ + /* when the number is zero. */ + i = MPS_WORD_WIDTH; + buf[i] = '\0'; + do { + --i; + buf[i] = digit[w % base]; + w /= base; + } while(w > 0); + + /* If the number is not as wide as the requested field, pad out the */ + /* buffer with zeros. */ + while(i > MPS_WORD_WIDTH - width) { + --i; + buf[i] = pad; + } + + r = mps_lib_fputs(&buf[i], stream); + if (r == mps_lib_EOF) + return ResIO; + + return ResOK; +} + + +/* WriteDouble -- write a double float to a stream + * + * Cf.: Guy L. Steele, Jr. and Jon L. White, "How to print + * floating-point numbers accurately", ACM SIGPLAN Notices, Vol. 25, + * No. 6 (Jun. 1990), Pages 112-126 + * + * .write.double.limitation: Only the "simple" printer is implemented + * here. + * + * .write.double.check: There being no DBL_EXP_DIG, we assume that it is + * less than DBL_DIG. */ + +static Res WriteDouble(mps_lib_FILE *stream, double d) +{ + double F = d; + int E = 0, i, x = 0; + /* Largest exponent that will print in %f style. Larger will use %e */ + /* style. DBL_DIG is chosen for use of doubles as extra-large integers. */ + int expmax = DBL_DIG; + /* Smallest exponent that will print in %f style. Smaller will use */ + /* %e style. -4 is chosen because it is the %g default. */ + int expmin = -4; + /* Epsilon defines how many digits will be printed. Using DBL_EPSILON */ + /* prints all the significant digits. To print fewer digits, set */ + /* epsilon to 10 ^ - N, where N is the desired number of digits. */ + double epsilon = DBL_EPSILON / 2; + char digits[] = "0123456789"; + /* sign, DBL_DIG, '0.', 'e', '+/-', log10(DBL_MAX_10_EXP), */ + /* terminator. See .write.double.check. */ + char buf[1+DBL_DIG+2+1+1+DBL_DIG+1]; + int j = 0; + + if (F == 0.0) { + if (mps_lib_fputs("0", stream) == mps_lib_EOF) + return ResIO; + return ResOK; + } + + if (F < 0) { + buf[j] = '-'; + j++; + F = - F; + } + + /* This scaling operation could introduce rounding errors. */ + for ( ; F >= 1.0 ; F /= 10.0) { + E++; + if (E > DBL_MAX_10_EXP) { + if (mps_lib_fputs("Infinity", stream) == mps_lib_EOF) + return ResIO; + return ResOK; + } + } + for ( ; F < 0.1; F *= 10) + E--; + + /* See if %e notation is required */ + if (E > expmax || E <= expmin) { + x = E - 1; + E = 1; + } + + /* Insert leading 0's */ + if (E <= 0) { + buf[j] = '0'; + j++; + } + if (E < 0) { + buf[j] = '.'; + j++; + } + for (i = -E; i > 0; i--) { + buf[j] = '0'; + j++; + } + + /* Convert the fraction to base 10, inserting a decimal according to */ + /* the exponent. This is Steele and White's FP3 algorithm. */ + do { + int U; + + if (E == 0) { + buf[j] = '.'; + j++; + } + F *= 10.0; + U = (int)F; + F = F - U; + epsilon *= 10.0; + E--; + if (F < epsilon || F > 1.0 - epsilon) { + if (F < 0.5) + buf[j] = digits[U]; + else + buf[j] = digits[U + 1]; + j++; + break; + } + buf[j] = digits[U]; + j++; + } while (1); + + /* Insert trailing 0's */ + for (i = E; i > 0; i--) { + buf[j] = '0'; + j++; + } + + /* If %e notation is selected, append the exponent indicator and sign. */ + if (x != 0) { + buf[j] = 'e'; + j++; + if (x < 0) { + buf[j] = '-'; + j++; + x = - x; + } + else { + buf[j] = '+'; + j++; + } + + /* Format the exponent to at least two digits. */ + for (i = 100; i <= x; ) + i *= 10; + i /= 10; + do { + buf[j] = digits[x / i]; + j++; + x %= i; + i /= 10; + } while (i > 0); + } + buf[j] = '\0'; /* arnold */ + + if (mps_lib_fputs(buf, stream) == mps_lib_EOF) + return ResIO; + return ResOK; +} + + +/* WriteF -- write formatted output + * + * .writef.des: See design.mps.writef, also design.mps.lib + * + * .writef.p: There is an assumption that void * fits in Word in + * the case of $P, and unsigned long for $U and $B. This is checked in + * MPMCheck. + * + * .writef.div: Although MPS_WORD_WIDTH/4 appears three times, there + * are effectively three separate decisions to format at this width. + * + * .writef.check: See .check.writef. */ + +Res WriteF(mps_lib_FILE *stream, ...) +{ + const char *format; + int r; + size_t i; + Res res; + va_list args; + + AVER(stream != NULL); + + va_start(args, stream); + + for(;;) { + format = va_arg(args, const char *); + if (format == NULL) + break; + + while(*format != '\0') { + if (*format != '$') { + r = mps_lib_fputc(*format, stream); /* Could be more efficient */ + if (r == mps_lib_EOF) return ResIO; + } else { + ++format; + AVER(*format != '\0'); + + switch(*format) { + case 'A': { /* address */ + WriteFA addr = va_arg(args, WriteFA); + res = WriteWord(stream, (Word)addr, 16, + (sizeof(WriteFA) * CHAR_BIT + 3) / 4); + if (res != ResOK) return res; + } break; + + case 'P': { /* pointer, see .writef.p */ + WriteFP p = va_arg(args, WriteFP); + res = WriteWord(stream, (Word)p, 16, + (sizeof(WriteFP) * CHAR_BIT + 3)/ 4); + if (res != ResOK) return res; + } break; + + case 'F': { /* function */ + WriteFF f = va_arg(args, WriteFF); + Byte *b = (Byte *)&f; + for(i=0; i < sizeof(WriteFF); i++) { + res = WriteWord(stream, (Word)(b[i]), 16, + (CHAR_BIT + 3) / 4); + if (res != ResOK) return res; + } + } break; + + case 'S': { /* string */ + WriteFS s = va_arg(args, WriteFS); + r = mps_lib_fputs((const char *)s, stream); + if (r == mps_lib_EOF) return ResIO; + } break; + + case 'C': { /* character */ + WriteFC c = va_arg(args, WriteFC); /* promoted */ + r = mps_lib_fputc((int)c, stream); + if (r == mps_lib_EOF) return ResIO; + } break; + + case 'W': { /* word */ + WriteFW w = va_arg(args, WriteFW); + res = WriteWord(stream, (Word)w, 16, + (sizeof(WriteFW) * CHAR_BIT + 3) / 4); + if (res != ResOK) return res; + } break; + + case 'U': { /* decimal, see .writef.p */ + WriteFU u = va_arg(args, WriteFU); + res = WriteWord(stream, (Word)u, 10, 0); + if (res != ResOK) return res; + } break; + + case 'B': { /* binary, see .writef.p */ + WriteFB b = va_arg(args, WriteFB); + res = WriteWord(stream, (Word)b, 2, sizeof(WriteFB) * CHAR_BIT); + if (res != ResOK) return res; + } break; + + case '$': { /* dollar char */ + r = mps_lib_fputc('$', stream); + if (r == mps_lib_EOF) return ResIO; + } break; + + case 'D': { /* double */ + WriteFD d = va_arg(args, WriteFD); + res = WriteDouble(stream, d); + if (res != ResOK) return res; + } break; + + default: + NOTREACHED; + } + } + + ++format; + } + } + + va_end(args); + + return ResOK; +} + + +/* StringLength -- Slow substitute for strlen */ + +size_t StringLength(const char *s) +{ + size_t i; + + AVER(s != NULL); + + for(i = 0; s[i] != '\0'; i++) + NOOP; + return(i); +} diff --git a/mps/code/mpm.h b/mps/code/mpm.h new file mode 100644 index 00000000000..0572b1a5a20 --- /dev/null +++ b/mps/code/mpm.h @@ -0,0 +1,988 @@ +/* impl.h.mpm: MEMORY POOL MANAGER DEFINITIONS + * + * $HopeName: MMsrc!mpm.h(trunk.147) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .trans.bufferinit: The Buffer data structure has an Init field and + * an Init method, there's a name clash. We resolve this by calling the + * accessor BufferGetInit. */ + +#ifndef mpm_h +#define mpm_h + +#include "config.h" +#include "misc.h" +#include "check.h" + +#include "event.h" +#include "lock.h" +#include "th.h" +#include "ss.h" +#include "mpslib.h" +#include "ring.h" +#include "tract.h" /* only for certain Seg macros */ +#include "mpmtypes.h" +#include "mpmst.h" + + +/* MPMCheck -- check MPM assumptions */ + +extern Bool MPMCheck(void); + + +/* Miscellaneous Checks -- see impl.c.mpm */ + +/* design.mps.type.bool.check */ +#define BoolCheck(b) ((unsigned)(b) <= 1) + +extern Bool FunCheck(Fun f); +#define FUNCHECK(f) (FunCheck((Fun)f)) + +extern Bool ShiftCheck(Shift shift); +extern Bool AttrCheck(Attr attr); +extern Bool RootVarCheck(RootVar rootVar); + + +/* Address/Size Interface -- see impl.c.mpm */ + +extern Bool AlignCheck(Align align); + +extern Bool (WordIsAligned)(Word word, Align align); +#define WordIsAligned(w, a) (((w) & ((a) - 1)) == 0) + +extern Word (WordAlignUp)(Word word, Align align); +#define WordAlignUp(w, a) (((w) + (a) - 1) & ~((Word)(a) - 1)) + +/* Rounds w up to a multiple of r, see impl.c.mpm for exact behaviour */ +extern Word (WordRoundUp)(Word word, Size round); +#define WordRoundUp(w, r) (((w)+(r)-1) - ((w)+(r)-1)%(r)) + +extern Word (WordAlignDown)(Word word, Align align); +#define WordAlignDown(w, a) ((w) & ~((Word)(a) - 1)) + +#define size_tAlignUp(s, a) ((size_t)WordAlignUp((Word)(s), a)) + +#define PointerAdd(p, s) ((void *)((char *)(p) + (s))) +#define PointerSub(p, s) ((void *)((char *)(p) - (s))) + +#define PointerOffset(base, limit) \ + ((size_t)((char *)(limit) - (char *)(base))) + +#define PointerAlignUp(p, s) \ + ((void *)WordAlignUp((Word)(p), (Align)(s))) + +#define AddrAdd(p, s) ((Addr)PointerAdd((void *)(p), s)) +#define AddrSub(p, s) ((Addr)PointerSub((void *)(p), s)) + +#define AddrOffset(b, l) \ + ((Size)(PointerOffset((void *)(b), (void *)(l)))) + +extern Addr (AddrAlignDown)(Addr addr, Align align); +#define AddrAlignDown(p, a) ((Addr)WordAlignDown((Word)(p), a)) + +#define AlignWord(s) ((Word)(s)) + +#define AddrIsAligned(p, a) WordIsAligned((Word)(p), a) +#define AddrAlignUp(p, a) ((Addr)WordAlignUp((Word)(p), a)) + +#define SizeIsAligned(s, a) WordIsAligned((Word)(s), a) +#define SizeAlignUp(s, a) ((Size)WordAlignUp((Word)(s), a)) +#define SizeAlignDown(s, a) ((Size)WordAlignDown((Word)(s), a)) +/* r not required to be a power of 2 */ +#define SizeRoundUp(s, r) ((Size)WordRoundUp((Word)(s), (Size)(r))) + +#define IndexIsAligned(s, a) WordIsAligned((Word)(s), a) +#define IndexAlignUp(s, a) ((Index)WordAlignUp((Word)(s), a)) +#define IndexAlignDown(s, a) ((Index)WordAlignDown((Word)(s), a)) + +#define AlignIsAligned(a1, a2) WordIsAligned((Word)(a1), a2) + + +extern Addr (AddrSet)(Addr target, Byte value, Size size); +/* This is one of the places that implements Addr, so it's allowed to */ +/* convert to void *, see design.mps.type.addr.ops.mem. */ +#define AddrSet(target, value, size) \ + mps_lib_memset(target, (int)(value), size) + +extern Addr (AddrCopy)(Addr target, Addr source, Size size); +#define AddrCopy(target, source, size) \ + mps_lib_memcpy(target, source, size) + +extern int (AddrComp)(Addr a, Addr b, Size size); +#define AddrComp(a, b, size) \ + mps_lib_memcmp(a, b, size) + + +/* ADDR_PTR -- turns an Addr into a pointer to the given type */ + +#define ADDR_PTR(type, addr) ((type *)(addr)) + + +/* Result codes */ + +extern Bool ResIsAllocFailure(Res res); + + +/* Logs and Powers + * + * SizeIsP2 returns TRUE if and only if size is a non-negative integer + * power of 2, and FALSE otherwise. + * + * SizeLog2 returns the logarithm in base 2 of size. size must be a + * power of 2. + * + * SizeFloorLog2 returns the floor of the logarithm in base 2 of size. + * size can be any positive non-zero value. */ + +extern Bool SizeIsP2(Size size); +extern Shift SizeLog2(Size size); +extern Shift SizeFloorLog2(Size size); + + +/* Formatted Output -- see design.mps.writef, impl.c.mpm */ + +extern Res WriteF(mps_lib_FILE *stream, ...); + + +/* Miscellaneous support -- see impl.c.mpm */ + +extern size_t StringLength(const char *s); + + +/* Version Determination + * + * See design.mps.version-library. */ + +extern char *MPSVersion(void); + + +/* Bit Table Interface -- see design.mps.bt.if.* for doc */ + +/* design.mps.bt.if.size */ +extern size_t (BTSize)(unsigned long length); +#define BTSize(n) (((n) + MPS_WORD_WIDTH-1) / MPS_WORD_WIDTH * sizeof(Word)) + + +/* design.mps.bt.if.get */ +extern Bool (BTGet)(BT bt, Index index); +#define BTGet(a, i) \ + ((Bool)(((a)[((i) >> MPS_WORD_SHIFT)] \ + >> ((i) & ~((Word)-1 << MPS_WORD_SHIFT))) \ + & (Word)1)) + +/* design.mps.bt.if.set */ +extern void (BTSet)(BT bt, Index index); +#define BTSet(a, i) \ + BEGIN \ + (a)[((i)>>MPS_WORD_SHIFT)] |= (Word)1<<((i)&~((Word)-1<>MPS_WORD_SHIFT)] &= \ + ~((Word)1 << ((i) & ~((Word)-1<arena) +#define PoolAlignment(pool) ((pool)->alignment) +#define PoolSegRing(pool) (&(pool)->segRing) + +extern Bool PoolFormat(Format *formatReturn, Pool pool); + +extern double PoolMutatorAllocSize(Pool pool); + +extern Bool PoolOfAddr(Pool *poolReturn, Arena arena, Addr addr); +extern Bool PoolHasAddr(Pool pool, Addr addr); + +extern Res PoolCreate(Pool *poolReturn, Arena arena, PoolClass class, ...); +extern Res PoolCreateV(Pool *poolReturn, Arena arena, PoolClass class, + va_list arg); +extern void PoolDestroy(Pool pool); +extern BufferClass PoolDefaultBufferClass(Pool pool); +extern Res PoolAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit); +extern void PoolFree(Pool pool, Addr old, Size size); +extern Res PoolTraceBegin(Pool pool, Trace trace); +extern Res PoolAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context); +extern Res PoolWhiten(Pool pool, Trace trace, Seg seg); +extern void PoolGrey(Pool pool, Trace trace, Seg seg); +extern void PoolBlacken(Pool pool, TraceSet traceSet, Seg seg); +extern Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg); +extern Res (PoolFix)(Pool pool, ScanState ss, Seg seg, Addr *refIO); +#define PoolFix(pool, ss, seg, refIO) \ + ((*(pool)->fix)(pool, ss, seg, refIO)) +extern void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO); +extern void PoolReclaim(Pool pool, Trace trace, Seg seg); +extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, + void *v, unsigned long s); +extern Res PoolTrivInit(Pool pool, va_list arg); +extern void PoolTrivFinish(Pool pool); +extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit); +extern Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit); +extern void PoolNoFree(Pool pool, Addr old, Size size); +extern void PoolTrivFree(Pool pool, Addr old, Size size); +extern Res PoolNoBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit); +extern Res PoolTrivBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit); +extern void PoolNoBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit); +extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit); +extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream); +extern Res PoolNoTraceBegin(Pool pool, Trace trace); +extern Res PoolTrivTraceBegin(Pool pool, Trace trace); +extern Res PoolNoAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context); +extern Res PoolSegAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context); +extern Res PoolSingleAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context); +extern Res PoolNoWhiten(Pool pool, Trace trace, Seg seg); +extern Res PoolTrivWhiten(Pool pool, Trace trace, Seg seg); +extern void PoolNoGrey(Pool pool, Trace trace, Seg seg); +extern void PoolTrivGrey(Pool pool, Trace trace, Seg seg); +extern void PoolNoBlacken(Pool pool, TraceSet traceSet, Seg seg); +extern void PoolTrivBlacken(Pool pool, TraceSet traceSet, Seg seg); +extern Res PoolNoScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg); +extern Res PoolNoFix(Pool pool, ScanState ss, Seg seg, Ref *refIO); +extern void PoolNoReclaim(Pool pool, Trace trace, Seg seg); +extern void PoolNoRampBegin(Pool pool, Buffer buf, Bool collectAll); +extern void PoolTrivRampBegin(Pool pool, Buffer buf, Bool collectAll); +extern void PoolNoRampEnd(Pool pool, Buffer buf); +extern void PoolTrivRampEnd(Pool pool, Buffer buf); +extern Res PoolNoFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf); +extern Res PoolTrivFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf); +extern Res PoolNoFramePop(Pool pool, Buffer buf, AllocFrame frame); +extern Res PoolTrivFramePop(Pool pool, Buffer buf, AllocFrame frame); +extern void PoolNoFramePopPending(Pool pool, Buffer buf, AllocFrame frame); +extern void PoolNoWalk(Pool pool, Seg seg, FormattedObjectsStepMethod step, + void *p, unsigned long s); +extern PoolDebugMixin PoolNoDebugMixin(Pool pool); +extern BufferClass PoolNoBufferClass(void); + +#define ClassOfPool(pool) ((pool)->class) +#define SuperclassOfPool(pool) \ + ((PoolClass)ProtocolClassSuperclassPoly((pool)->class)) + + +/* Abstract Pool Classes Interface -- see impl.c.poolabs */ +extern void PoolClassMixInAllocFree(PoolClass class); +extern void PoolClassMixInBuffer(PoolClass class); +extern void PoolClassMixInScan(PoolClass class); +extern void PoolClassMixInFormat(PoolClass class); +extern void PoolClassMixInCollect(PoolClass class); +extern AbstractPoolClass AbstractPoolClassGet(void); +extern AbstractAllocFreePoolClass AbstractAllocFreePoolClassGet(void); +extern AbstractBufferPoolClass AbstractBufferPoolClassGet(void); +extern AbstractBufferPoolClass AbstractSegBufPoolClassGet(void); +extern AbstractScanPoolClass AbstractScanPoolClassGet(void); +extern AbstractCollectPoolClass AbstractCollectPoolClassGet(void); + +/* DEFINE_POOL_CLASS + * + * Convenience macro -- see design.mps.protocol.int.define-special. */ + +#define DEFINE_POOL_CLASS(className, var) \ + DEFINE_ALIAS_CLASS(className, PoolClass, var) + +#define POOL_SUPERCLASS(className) \ + ((PoolClass)SUPERCLASS(className)) + + +/* Message Interface -- see design.mps.message */ + +extern Bool MessageCheck(Message message); +extern Bool MessageClassCheck(MessageClass class); +extern Bool MessageTypeCheck(MessageType type); +extern MessageClass MessageGetClass(Message message); +extern Arena MessageArena(Message message); +extern void MessageInit(Arena arena, Message message, + MessageClass class, MessageType type); +extern void MessageFinish(Message message); +extern void MessagePost(Arena arena, Message message); +extern Bool MessagePoll(Arena arena); +extern MessageType MessageGetType(Message message); +extern void MessageDiscard(Arena arena, Message message); +extern void MessageEmpty(Arena arena); +extern Bool MessageGet(Message *messageReturn, Arena arena, + MessageType type); +extern Bool MessageQueueType(MessageType *typeReturn, Arena arena); +extern void MessageTypeEnable(Arena arena, MessageType type); +extern void MessageTypeDisable(Arena arena, MessageType type); + +/* Message methods */ + +/* Method dispatchers */ +extern void MessageFinalizationRef(Ref *refReturn, + Arena arena, Message message); +extern Size MessageGCLiveSize(Message message); +extern Size MessageGCCondemnedSize(Message message); +extern Size MessageGCNotCondemnedSize(Message message); + +/* Convenience methods */ +extern void MessageNoFinalizationRef(Ref *refReturn, + Arena arena, Message message); +extern Size MessageNoGCLiveSize(Message message); +extern Size MessageNoGCCondemnedSize(Message message); +extern Size MessageNoGCNotCondemnedSize(Message message); + + +/* Trace Interface -- see impl.c.trace */ + +#define TraceSetSingle(trace) BS_SINGLE(TraceSet, (trace)->ti) +#define TraceSetIsSingle(ts) BS_IS_SINGLE(ts) +#define TraceSetIsMember(ts, trace) BS_IS_MEMBER(ts, (trace)->ti) +#define TraceSetAdd(ts, trace) BS_ADD(TraceSet, ts, (trace)->ti) +#define TraceSetDel(ts, trace) BS_DEL(TraceSet, ts, (trace)->ti) +#define TraceSetUnion(ts1, ts2) BS_UNION(ts1, ts2) +#define TraceSetInter(ts1, ts2) BS_INTER(ts1, ts2) +#define TraceSetDiff(ts1, ts2) BS_DIFF(ts1, ts2) +#define TraceSetSuper(ts1, ts2) BS_SUPER(ts1, ts2) +#define TraceSetSub(ts1, ts2) BS_SUB(ts1, ts2) +#define TraceSetComp(ts) BS_COMP(ts) + +#define TRACE_SET_ITER(ti, trace, ts, arena) \ + for(ti = 0, trace = ArenaTrace(arena, ti); ti < TraceLIMIT; \ + ++ti, trace = ArenaTrace(arena, ti)) BEGIN \ + if (TraceSetIsMember(ts, trace)) { + +#define TRACE_SET_ITER_END(ti, trace, ts, arena) } END + + +extern void ScanStateInit(ScanState ss, TraceSet ts, Arena arena, + Rank rank, ZoneSet white); +extern void ScanStateFinish(ScanState ss); +extern Bool ScanStateCheck(ScanState ss); +extern void ScanStateSetSummary(ScanState ss, RefSet summary); +extern RefSet ScanStateSummary(ScanState ss); + +extern Bool TraceIdCheck(TraceId id); +extern Bool TraceSetCheck(TraceSet ts); +extern Bool TraceCheck(Trace trace); +extern Res TraceCreate(Trace *traceReturn, Arena arena); +extern void TraceDestroy(Trace trace); + +extern Res TraceAddWhite(Trace trace, Seg seg); +extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet); +extern void TraceStart(Trace trace, double mortality, double finishingTime); +extern void TracePoll(Globals globals); + +extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode); +extern Res TraceFix(ScanState ss, Ref *refIO); +extern Res TraceFixEmergency(ScanState ss, Ref *refIO); + + +/* Collection control parameters */ + +extern double TraceTopGenMortality; +extern double TraceWorkFactor; + + +/* Equivalent to impl.h.mps MPS_SCAN_BEGIN */ + +#define TRACE_SCAN_BEGIN(ss) \ + BEGIN \ + Shift SCANzoneShift = (ss)->zoneShift; \ + ZoneSet SCANwhite = (ss)->white; \ + RefSet SCANsummary = (ss)->unfixedSummary; \ + Word SCANt; \ + { + +/* Equivalent to impl.h.mps MPS_FIX1 */ + +#define TRACE_FIX1(ss, ref) \ + (SCANt = (Word)1 << ((Word)(ref) >> SCANzoneShift & (MPS_WORD_WIDTH-1)), \ + SCANsummary |= SCANt, \ + SCANwhite & SCANt) + +/* Equivalent to impl.h.mps MPS_FIX2 */ + +#define TRACE_FIX2(ss, refIO) \ + ((*(ss)->fix)(ss, refIO)) + +/* Equivalent to impl.h.mps MPS_FIX */ + +#define TRACE_FIX(ss, refIO) \ + (TRACE_FIX1(ss, *(refIO)) ? TRACE_FIX2(ss, refIO) : ResOK) + +/* Equivalent to impl.h.mps MPS_SCAN_END */ + +#define TRACE_SCAN_END(ss) \ + } \ + (ss)->unfixedSummary = SCANsummary; \ + END + +extern Res TraceScanArea(ScanState ss, Addr *base, Addr *limit); +extern Res TraceScanAreaTagged(ScanState ss, Addr *base, Addr *limit); +extern Res TraceScanAreaMasked(ScanState ss, + Addr *base, Addr *limit, Word mask); +extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena, + Seg seg, Ref *refIO); + + +/* Arena Interface -- see impl.c.arena */ + +/* DEFINE_ARENA_CLASS + * + * Convenience macro -- see design.mps.protocol.int.define-special. */ + +#define DEFINE_ARENA_CLASS(className, var) \ + DEFINE_ALIAS_CLASS(className, ArenaClass, var) + +#define ARENA_SUPERCLASS(className) \ + ((ArenaClass)SUPERCLASS(className)) + +extern AbstractArenaClass AbstractArenaClassGet(void); +extern Bool ArenaClassCheck(ArenaClass class); + +extern Bool ArenaCheck(Arena arena); +extern Res ArenaCreateV(Arena *arenaReturn, ArenaClass class, va_list args); +extern void ArenaDestroy(Arena arena); +extern Res ArenaInit(Arena arena, ArenaClass class); +extern void ArenaFinish(Arena arena); +extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream); +extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream); +extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context); + +extern Bool GlobalsCheck(Globals arena); +extern Res GlobalsInit(Globals arena); +extern void GlobalsFinish(Globals arena); +extern Res GlobalsCompleteCreate(Globals arenaGlobals); +extern void GlobalsPrepareToDestroy(Globals arenaGlobals); +extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream); + +#define ArenaGlobals(arena) (&(arena)->globals) +#define GlobalsArena(glob) PARENT(ArenaStruct, globals, glob) + +#define ArenaRootRing(arena) (&(arena)->rootRing) +#define ArenaTraceRing(arena) (&(arena)->traceRing) +#define ArenaThreadRing(arena) (&(arena)->threadRing) +#define ArenaEpoch(arena) ((arena)->epoch) /* .epoch.ts */ +#define ArenaTrace(arena, ti) (&(arena)->trace[ti]) +#define ArenaZoneShift(arena) ((arena)->zoneShift) +#define ArenaAlign(arena) ((arena)->alignment) +#define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank]) + + +extern void (ArenaEnter)(Arena arena); +extern void (ArenaLeave)(Arena arena); + +#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE) +#define ArenaEnter(arena) UNUSED(arena) +#define ArenaLeave(arena) UNUSED(arena) +#endif + + +extern void (ArenaPoll)(Globals globals); +#ifdef MPS_PROD_EPCORE +#define ArenaPoll(globals) UNUSED(globals) +#endif +/* .nogc.why: ScriptWorks doesn't use MM-provided incremental GC, so */ +/* doesn't need to poll when allocating. */ + + +extern void ArenaClamp(Globals globals); +extern void ArenaRelease(Globals globals); +extern void ArenaPark(Globals globals); +extern Res ArenaCollect(Globals globals); + +extern Res ControlInit(Arena arena); +extern void ControlFinish(Arena arena); +extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size, + Bool withReservoirPermit); +extern void ControlFree(Arena arena, void *base, size_t size); + + +/* Peek/Poke + * + * These are provided so that modules in the MPS can make occasional + * access to client data. They perform the appropriate shield and + * summary manipulations that are necessary. + * + * Note that Peek and Poke can be called with address that may or + * may not be in arena managed memory. */ + +/* Peek reads a value */ +extern Ref ArenaPeek(Arena arena, Addr addr); +/* Same, but addr must be in seg */ +extern Ref ArenaPeekSeg(Arena arena, Seg seg, Addr addr); +/* Poke stores a value */ +extern void ArenaPoke(Arena arena, Addr addr, Ref ref); +/* Same, but addr must be in seg */ +extern void ArenaPokeSeg(Arena arena, Seg seg, Addr addr, Ref ref); + + +/* Read/Write + * + * These simulate mutator reads and writes to locations. + * They are effectively a software barrier, and maintain the tricolor + * invariant (hence performing any scanning or color manipulation + * necessary). + * + * Only Read provided right now. */ + +Ref ArenaRead(Arena arena, Addr addr); + + +extern Size ArenaReserved(Arena arena); +extern Size ArenaCommitted(Arena arena); +extern Size ArenaSpareCommitted(Arena arena); + +extern Size ArenaCommitLimit(Arena arena); +extern Res ArenaSetCommitLimit(Arena arena, Size limit); +extern Size ArenaSpareCommitLimit(Arena arena); +extern void ArenaSetSpareCommitLimit(Arena arena, Size limit); +extern void ArenaNoSpareCommitExceeded(Arena arena); + +extern double ArenaMutatorAllocSize(Arena arena); +extern Size ArenaAvail(Arena arena); + +extern Res ArenaExtend(Arena, Addr base, Size size); + +extern Res ArenaFinalize(Arena arena, Ref obj); + +extern Bool ArenaIsReservedAddr(Arena arena, Addr addr); + +#define ArenaReservoir(arena) (&(arena)->reservoirStruct) + +extern Bool ReservoirCheck(Reservoir reservoir); +extern Res ReservoirInit(Reservoir reservoir, Arena arena); +extern void ReservoirFinish (Reservoir reservoir); +extern Size ReservoirLimit(Reservoir reservoir); +extern void ReservoirSetLimit(Reservoir reservoir, Size size); +extern Size ReservoirAvailable(Reservoir reservoir); +extern Res ReservoirEnsureFull(Reservoir reservoir); +extern void ReservoirDeposit(Reservoir reservoir, Addr base, Size size); +extern Res ReservoirWithdraw(Addr *baseReturn, Tract *baseTractReturn, + Reservoir reservoir, Size size, Pool pool); + +extern Res ArenaAlloc(Addr *baseReturn, SegPref pref, + Size size, Pool pool, Bool withReservoirPermit); +extern void ArenaFree(Addr base, Size size, Pool pool); + +extern Res ArenaNoExtend(Arena arena, Addr base, Size size); + + +/* Locus interface */ + +extern Bool SegPrefCheck(SegPref pref); +extern SegPref SegPrefDefault(void); +extern Res SegPrefExpress(SegPref pref, SegPrefKind kind, void *p); + +extern void LocusInit(Arena arena); +extern void LocusFinish(Arena arena); +extern Bool LocusCheck(Arena arena); + + +/* Segment interface */ + +extern Res SegAlloc(Seg *segReturn, SegClass class, SegPref pref, + Size size, Pool pool, Bool withReservoirPermit, ...); +extern void SegFree(Seg seg); +extern Bool SegOfAddr(Seg *segReturn, Arena arena, Addr addr); +extern Bool SegFirst(Seg *segReturn, Arena arena); +extern Bool SegNext(Seg *segReturn, Arena arena, Addr addr); +extern void SegSetWhite(Seg seg, TraceSet white); +extern void SegSetGrey(Seg seg, TraceSet grey); +extern void SegSetRankSet(Seg seg, RankSet rankSet); +extern void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary); +extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi, + Bool withReservoirPermit, ...); +extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at, + Bool withReservoirPermit, ...); +extern Res SegDescribe(Seg seg, mps_lib_FILE *stream); +extern void SegSetSummary(Seg seg, RefSet summary); +extern Buffer SegBuffer(Seg seg); +extern void SegSetBuffer(Seg seg, Buffer buffer); +extern Bool SegCheck(Seg seg); +extern Bool GCSegCheck(GCSeg gcseg); +extern Bool SegClassCheck(SegClass class); +extern SegClass SegClassGet(void); +extern SegClass GCSegClassGet(void); +extern void SegClassMixInNoSplitMerge(SegClass class); + + +/* DEFINE_SEG_CLASS -- define a segment class */ + +#define DEFINE_SEG_CLASS(className, var) \ + DEFINE_ALIAS_CLASS(className, SegClass, var) + + +#define SEG_SUPERCLASS(className) \ + ((SegClass)SUPERCLASS(className)) + +extern Size SegSize(Seg seg); +extern Addr (SegBase)(Seg seg); +extern Addr (SegLimit)(Seg seg); +#define SegBase(seg) (TractBase((seg)->firstTract)) +#define SegLimit(seg) ((seg)->limit) +#define SegPool(seg) (TractPool((seg)->firstTract)) +/* .bitfield.promote: The bit field accesses need to be cast to the */ +/* right type, otherwise they'll be promoted to signed int, see */ +/* standard.ansic.6.2.1.1. */ +#define SegRankSet(seg) ((RankSet)(seg)->rankSet) +#define SegPM(seg) ((AccessSet)(seg)->pm) +#define SegSM(seg) ((AccessSet)(seg)->sm) +#define SegDepth(seg) ((unsigned)(seg)->depth) +#define SegGrey(seg) ((TraceSet)(seg)->grey) +#define SegWhite(seg) ((TraceSet)(seg)->white) +#define SegNailed(seg) ((TraceSet)(seg)->nailed) +#define SegOfPoolRing(node) (RING_ELT(Seg, poolRing, (node))) +#define SegOfGreyRing(node) (&(RING_ELT(GCSeg, greyRing, (node)) \ + ->segStruct)) + +#define SegSummary(seg) (((GCSeg)(seg))->summary) + +#define SegSetPM(seg, mode) ((void)((seg)->pm = (mode))) +#define SegSetSM(seg, mode) ((void)((seg)->sm = (mode))) +#define SegSetDepth(seg, d) ((void)((seg)->depth = (d))) +#define SegSetNailed(seg, ts) ((void)((seg)->nailed = (ts))) + + +/* Buffer Interface -- see impl.c.buffer */ + +extern Res BufferCreate(Buffer *bufferReturn, BufferClass class, + Pool pool, Bool isMutator, ...); +extern Res BufferCreateV(Buffer *bufferReturn, BufferClass class, + Pool pool, Bool isMutator, va_list args); +extern void BufferDestroy(Buffer buffer); +extern Bool BufferCheck(Buffer buffer); +extern Bool SegBufCheck(SegBuf segbuf); +extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream); +extern Res BufferReserve(Addr *pReturn, Buffer buffer, Size size, + Bool withReservoirPermit); +/* macro equivalent for BufferReserve, keep in sync with impl.c.buffer */ +#define BUFFER_RESERVE(pReturn, buffer, size, withReservoirPermit) \ + (AddrAdd(BufferAlloc(buffer), size) > BufferAlloc(buffer) && \ + AddrAdd(BufferAlloc(buffer), size) <= BufferAP(buffer)->limit ? \ + (*(pReturn) = BufferAlloc(buffer), \ + BufferAP(buffer)->alloc = AddrAdd(BufferAlloc(buffer), size), \ + ResOK) : \ + BufferFill(pReturn, buffer, size, withReservoirPermit)) + +extern Res BufferFill(Addr *pReturn, Buffer buffer, Size size, + Bool withReservoirPermit); + +extern Bool BufferCommit(Buffer buffer, Addr p, Size size); +/* macro equivalent for BufferCommit, keep in sync with impl.c.buffer */ +#define BUFFER_COMMIT(buffer, p, size) \ + (BufferAP(buffer)->init = BufferAlloc(buffer), \ + BufferAP(buffer)->limit != 0 || BufferTrip(buffer, p, size)) + +extern Bool BufferTrip(Buffer buffer, Addr p, Size size); +extern void BufferFinish(Buffer buffer); +extern Bool BufferIsReset(Buffer buffer); +extern Bool BufferIsReady(Buffer buffer); +extern Bool BufferIsMutator(Buffer buffer); +extern void BufferSetAllocAddr(Buffer buffer, Addr addr); +extern void BufferAttach(Buffer buffer, + Addr base, Addr limit, Addr init, Size size); +extern void BufferDetach(Buffer buffer, Pool pool); +extern void BufferFlip(Buffer buffer); + +extern AP (BufferAP)(Buffer buffer); +#define BufferAP(buffer) (&(buffer)->apStruct) +extern Buffer BufferOfAP(AP ap); +#define BufferOfAP(ap) PARENT(BufferStruct, apStruct, ap) + +#define BufferArena(buffer) ((buffer)->arena) +#define BufferPool(buffer) ((buffer)->pool) + +extern Seg BufferSeg(Buffer buffer); + +extern RankSet BufferRankSet(Buffer buffer); +extern void BufferSetRankSet(Buffer buffer, RankSet rankset); + +#define BufferBase(buffer) ((buffer)->base) +#define BufferGetInit(buffer) /* see .trans.bufferinit */ \ + (BufferAP(buffer)->init) +#define BufferAlloc(buffer) (BufferAP(buffer)->alloc) +#define BufferLimit(buffer) ((buffer)->poolLimit) +extern Addr BufferScanLimit(Buffer buffer); + +extern void BufferReassignSeg(Buffer buffer, Seg seg); + +extern Bool BufferIsTrapped(Buffer buffer); +extern Bool BufferIsTrappedByMutator(Buffer buffer); + +extern void BufferRampBegin(Buffer buffer, AllocPattern pattern); +extern Res BufferRampEnd(Buffer buffer); +extern void BufferRampReset(Buffer buffer); + +extern Res BufferFramePush(AllocFrame *frameReturn, Buffer buffer); +extern Res BufferFramePop(Buffer buffer, AllocFrame frame); +extern FrameState BufferFrameState(Buffer buffer); +extern void BufferFrameSetState(Buffer buffer, FrameState state); + + +/* DEFINE_BUFFER_CLASS -- define a buffer class */ + +#define DEFINE_BUFFER_CLASS(className, var) \ + DEFINE_ALIAS_CLASS(className, BufferClass, var) + +#define BUFFER_SUPERCLASS(className) \ + ((BufferClass)SUPERCLASS(className)) + +extern Bool BufferClassCheck(BufferClass class); +extern BufferClass BufferClassGet(void); +extern BufferClass SegBufClassGet(void); +extern BufferClass RankBufClassGet(void); + +extern AllocPattern AllocPatternRamp(void); +extern AllocPattern AllocPatternRampCollectAll(void); + + +/* Format Interface -- see impl.c.format */ + +extern Bool FormatCheck(Format format); +extern Res FormatCreate(Format *formatReturn, Arena arena, + Align alignment, + FormatVariety variety, + FormatScanMethod scan, + FormatSkipMethod skip, + FormatMoveMethod move, + FormatIsMovedMethod isMoved, + FormatCopyMethod copy, + FormatPadMethod pad, + FormatClassMethod class, + Size headerSize); +extern void FormatDestroy(Format format); +extern Arena FormatArena(Format format); +extern Res FormatDescribe(Format format, mps_lib_FILE *stream); + + +/* Reference Interface -- see impl.c.ref */ + +extern Bool RankCheck(Rank rank); +extern Bool RankSetCheck(RankSet rankSet); + +#define RankSetIsMember(rs, r) BS_IS_MEMBER((rs), (r)) +#define RankSetSingle(r) BS_SINGLE(RankSet, (r)) +#define RankSetIsSingle(r) BS_IS_SINGLE(r) +#define RankSetUnion(rs1, rs2) BS_UNION((rs1), (rs2)) +#define RankSetDel(rs, r) BS_DEL(RankSet, (rs), (r)) + +#define AddrZone(arena, addr) \ + (((Word)(addr) >> (arena)->zoneShift) & (MPS_WORD_WIDTH - 1)) + +#define RefSetUnion(rs1, rs2) BS_UNION((rs1), (rs2)) +#define RefSetInter(rs1, rs2) BS_INTER((rs1), (rs2)) +#define RefSetDiff(rs1, rs2) BS_DIFF((rs1), (rs2)) +#define RefSetAdd(arena, rs, addr) \ + BS_ADD(RefSet, rs, AddrZone(arena, addr)) +#define RefSetIsMember(arena, rs, addr) \ + BS_IS_MEMBER(rs, AddrZone(arena, addr)) +#define RefSetSuper(rs1, rs2) BS_SUPER((rs1), (rs2)) +#define RefSetSub(rs1, rs2) BS_SUB((rs1), (rs2)) + + +/* Zone sets -- see design.mps.refset */ + +#define ZoneSetUnion(zs1, zs2) BS_UNION(zs1, zs2) +#define ZoneSetInter(zs1, zs2) BS_INTER(zs1, zs2) +#define ZoneSetDiff(zs1, zs2) BS_DIFF(zs1, zs2) +#define ZoneSetAdd(arena, zs, addr) \ + BS_ADD(ZoneSet, zs, AddrZone(arena, addr)) +#define ZoneSetIsMember(arena, zs, addr) \ + BS_IS_MEMBER(zs, AddrZone(arena, addr)) +#define ZoneSetSub(zs1, zs2) BS_SUB(zs1, zs2) +#define ZoneSetSuper(zs1, zs2) BS_SUPER(zs1, zs2) +#define ZoneSetComp(zs) BS_COMP(zs) + +extern ZoneSet ZoneSetOfRange(Arena arena, Addr base, Addr limit); +extern ZoneSet ZoneSetOfSeg(Arena arena, Seg seg); + + +/* Shield Interface -- see impl.c.shield */ + +extern void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode); +extern void (ShieldLower)(Arena arena, Seg seg, AccessSet mode); +extern void (ShieldEnter)(Arena arena); +extern void (ShieldLeave)(Arena arena); +extern void (ShieldExpose)(Arena arena, Seg seg); +extern void (ShieldCover)(Arena arena, Seg seg); +extern void (ShieldSuspend)(Arena arena); +extern void (ShieldResume)(Arena arena); +extern void (ShieldFlush)(Arena arena); + +#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE) +#define ShieldRaise(arena, seg, mode) \ + BEGIN UNUSED(arena); UNUSED(seg); UNUSED(mode); END +#define ShieldLower(arena, seg, mode) \ + BEGIN UNUSED(arena); UNUSED(seg); UNUSED(mode); END +#define ShieldEnter(arena) BEGIN UNUSED(arena); END +#define ShieldLeave(arena) BEGIN UNUSED(arena); END +#define ShieldExpose(arena, seg) \ + BEGIN UNUSED(arena); UNUSED(seg); END +#define ShieldCover(arena, seg) \ + BEGIN UNUSED(arena); UNUSED(seg); END +#define ShieldSuspend(arena) BEGIN UNUSED(arena); END +#define ShieldResume(arena) BEGIN UNUSED(arena); END +#define ShieldFlush(arena) BEGIN UNUSED(arena); END +#endif + + +/* Protection Interface + * + * See design.mps.prot for the design of the generic interface including + * the contracts for these functions. + * + * This interface has several different implementations, typically one + * per platform, see impl.c.prot* for the various implementations, and + * design.mps.prot* for the corresponding designs. */ + +extern void ProtSetup(void); + +extern void ProtSet(Addr base, Addr limit, AccessSet mode); +extern void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s); +extern void ProtSync(Arena arena); +extern Bool ProtCanStepInstruction(MutatorFaultContext context); +extern Res ProtStepInstruction(MutatorFaultContext context); + + +/* Location Dependency -- see impl.c.ld */ + +extern void LDReset(LD ld, Arena arena); +extern void LDAdd(LD ld, Arena arena, Addr addr); +extern Bool LDIsStale(LD ld, Arena arena, Addr addr); +extern void LDAge(Arena arena, RefSet moved); +extern void LDMerge(LD ld, Arena arena, LD from); + + +/* Root Interface -- see impl.c.root */ + +extern Res RootCreateTable(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + Addr *base, Addr *limit); +extern Res RootCreateTableMasked(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + Addr *base, Addr *limit, + Word mask); +extern Res RootCreateReg(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + RootScanRegMethod scan, + void *p, size_t s); +extern Res RootCreateFmt(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + FormatScanMethod scan, + Addr base, Addr limit); +extern Res RootCreateFun(Root *rootReturn, Arena arena, + Rank rank, RootScanMethod scan, + void *p, size_t s); +extern void RootDestroy(Root root); +extern Bool RootModeCheck(RootMode mode); +extern Bool RootCheck(Root root); +extern Res RootDescribe(Root root, mps_lib_FILE *stream); +extern Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream); +extern Rank RootRank(Root root); +extern AccessSet RootPM(Root root); +extern RefSet RootSummary(Root root); +extern void RootGrey(Root root, Trace trace); +extern Res RootScan(ScanState ss, Root root); +extern Arena RootArena(Root root); +extern Bool RootOfAddr(Root *root, Arena arena, Addr addr); +extern void RootAccess(Root root, AccessSet mode); +typedef Res (*RootIterateFn)(Root root, void *p); +extern Res RootsIterate(Globals arena, RootIterateFn f, void *p); + + +/* VM Interface -- see impl.c.vm* */ + +extern Align VMAlign(VM vm); +extern Bool VMCheck(VM vm); +extern Res VMCreate(VM *VMReturn, Size size); +extern void VMDestroy(VM vm); +extern Addr VMBase(VM vm); +extern Addr VMLimit(VM vm); +extern Res VMMap(VM vm, Addr base, Addr limit); +extern void VMUnmap(VM vm, Addr base, Addr limit); +extern Size VMReserved(VM vm); +extern Size VMMapped(VM vm); + + +/* Stack Probe */ + +extern void StackProbe(Size depth); + + +/* STATISTIC -- gather diagnostics (in some varieties) + * + * The argument of STATISTIC is an expression; the expansion followed by + * a semicolon is syntactically a statement. + * + * The argument of STATISTIC_STAT is a statement; the expansion followed by + * a semicolon is syntactically a statement. + * + * STATISTIC_WRITE is inserted in WriteF arguments to output the values + * of diagnostic fields. + * + * .statistic.whitehot: The implementation of STATISTIC for + * non-statistical varieties passes the parameter to DISCARD to ensure + * the parameter is syntactically an expression. The parameter is + * passed as part of a comma-expression so that its type is not + * important. This permits an expression of type void. */ + +#if defined(DIAGNOSTICS) + +#define STATISTIC(gather) BEGIN (gather); END +#define STATISTIC_STAT(gather) BEGIN gather; END +#define STATISTIC_WRITE(format, arg) (format), (arg), + +#elif defined(DIAGNOSTICS_NONE) + +#define STATISTIC(gather) DISCARD(((gather), 0)) +#define STATISTIC_STAT(gather) DISCARD_STAT(gather) +#define STATISTIC_WRITE(format, arg) + +#else + +#error "No diagnostics configured." + +#endif + + +#endif /* mpm_h */ diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c new file mode 100644 index 00000000000..638d30de920 --- /dev/null +++ b/mps/code/mpmss.c @@ -0,0 +1,153 @@ +/* impl.c.mpmss: MPM STRESS TEST + * + * $HopeName: MMsrc!mpmss.c(trunk.23) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#include "mpscmv.h" +#include "mpslib.h" +#include "mpsavm.h" +#include "testlib.h" +#include "mps.h" +#include +#include + + +/* @@@@ Hack due to missing mpscmfs.h */ +extern mps_class_t PoolClassMFS(void); + + +#define testArenaSIZE ((((size_t)64)<<20) - 4) +#define smallArenaSIZE ((((size_t)1)<<20) - 4) +#define testSetSIZE 200 +#define testLOOPS 10 + + +static mps_res_t stress(mps_class_t class, mps_arena_t arena, + size_t (*size)(int i), ...) +{ + mps_res_t res; + mps_pool_t pool; + va_list arg; + int i, k; + int *ps[testSetSIZE]; + size_t ss[testSetSIZE]; + + va_start(arg, size); + res = mps_pool_create_v(&pool, arena, class, arg); + va_end(arg); + if (res != MPS_RES_OK) + return res; + + /* allocate a load of objects */ + for (i=0; i= sizeof(ps[i])) + *ps[i] = 1; /* Write something, so it gets swap. */ + } + + mps_pool_check_fenceposts(pool); + + for (k=0; k (b)) ? (a) : (b)) + + +static size_t randomSize(int i) +{ + /* Make the range large enough to span three pages in the segment table: */ + /* 160 segments/page, page size max 0x2000. */ + size_t maxSize = 2 * 160 * 0x2000; + /* Reduce by a factor of 2 every 10 cycles. Total allocation about 40 MB. */ + return rnd() % max((maxSize >> (i / 10)), 2) + 1; +} + + +static size_t fixedSizeSize = 0; + +static size_t fixedSize(int i) +{ + testlib_unused(i); + return fixedSizeSize; +} + + +static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 }; + +static int testInArena(mps_arena_t arena) +{ + printf("MV debug\n"); + die(stress(mps_class_mv_debug(), arena, randomSize, + &debugOptions, (size_t)65536, (size_t)32, (size_t)65536), + "stress MV debug"); + + printf("MFS\n"); + fixedSizeSize = 13; + die(stress(PoolClassMFS(), + arena, fixedSize, (size_t)100000, fixedSizeSize), + "stress MFS"); + + printf("MV\n"); + die(stress(mps_class_mv(), arena, randomSize, + (size_t)65536, (size_t)32, (size_t)65536), + "stress MV"); + + return 0; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + testInArena(arena); + mps_arena_destroy(arena); + + die(mps_arena_create(&arena, mps_arena_class_vm(), smallArenaSIZE), + "mps_arena_create"); + testInArena(arena); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h new file mode 100644 index 00000000000..2ca29ec5dbb --- /dev/null +++ b/mps/code/mpmst.h @@ -0,0 +1,692 @@ +/* impl.h.mpmst: MEMORY POOL MANAGER DATA STRUCTURES + * + * $HopeName: MMsrc!mpmst.h(trunk.98) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: This header file crosses module boundaries. The relevant + * design a module's structures should be found in that module's design + * document. + * + * .structure: Most structures have already been declared as incomplete + * types in impl.h.mpmtypes. Most of the structures are the underlying + * aggregate types for an abstract data type. See + * guide.impl.c.naming.type.adt-aggregate.relate. + * + * .rationale.sig: Object signatures (PoolSig, etc.) are defined here, + * along with the structures, so that any code which can see a structure + * can also check its signature before using any of its fields. See + * design.mps.sig.test.uniq to check that signatures are unique. */ + +#ifndef mpmst_h +#define mpmst_h + +#include "config.h" +#include "mpmtypes.h" + +#include "protocol.h" +#include "ring.h" +#include "chain.h" + + +/* PoolClassStruct -- pool class structure + * + * See design.mps.pool. + * + * .class: The pool class structure is defined by each pool class + * implementation in order to provide an interface between the MPM + * and the class (see design.mps.class-interface) via generic + * functions (see impl.c.pool). A class XXX defines a function + * PoolClassXXX() returning a PoolClass pointing to a PoolClassStruct + * of methods which implement the memory management policy. + * + * .class.end-sig: The class structure has a signature at the end. This + * causes the compiler to complain if the class structure is extended + * without modifying static initializers. */ + +#define PoolClassSig ((Sig)0x519C7A55) /* SIGnature pool CLASS */ + +typedef struct PoolClassStruct { + ProtocolClassStruct protocol; + const char *name; /* class name string */ + size_t size; /* size of outer structure */ + size_t offset; /* offset of generic struct in outer struct */ + Attr attr; /* attributes */ + PoolInitMethod init; /* initialize the pool descriptor */ + PoolFinishMethod finish; /* finish the pool descriptor */ + PoolAllocMethod alloc; /* allocate memory from pool */ + PoolFreeMethod free; /* free memory to pool */ + PoolBufferFillMethod bufferFill; /* out-of-line reserve */ + PoolBufferEmptyMethod bufferEmpty; /* out-of-line commit */ + PoolAccessMethod access; /* handles read/write accesses */ + PoolWhitenMethod whiten; /* whiten objects in a segment */ + PoolGreyMethod grey; /* grey non-white objects */ + PoolBlackenMethod blacken; /* blacken grey objects without scanning */ + PoolScanMethod scan; /* find references during tracing */ + PoolFixMethod fix; /* referent reachable during tracing */ + PoolFixEmergencyMethod fixEmergency; /* as fix, no failure allowed */ + PoolReclaimMethod reclaim; /* reclaim dead objects after tracing */ + PoolRampBeginMethod rampBegin;/* begin a ramp pattern */ + PoolRampEndMethod rampEnd; /* end a ramp pattern */ + PoolFramePushMethod framePush; /* push an allocation frame */ + PoolFramePopMethod framePop; /* pop an allocation frame */ + PoolFramePopPendingMethod framePopPending; /* notify pending pop */ + PoolWalkMethod walk; /* walk over a segment */ + PoolBufferClassMethod bufferClass; /* default BufferClass of pool */ + PoolDescribeMethod describe; /* describe the contents of the pool */ + PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */ + Bool labelled; /* whether it has been EventLabelled */ + Sig sig; /* .class.end-sig */ +} PoolClassStruct; + + +/* PoolStruct -- generic structure + * + * .pool: A generic structure is created when a pool is created and + * holds the generic part of the pool's state. Each pool class defines + * a "subclass" of the pool structure (the "outer structure") which + * contains PoolStruct as a a field. The outer structure holds the + * class-specific part of the pool's state. See impl.c.pool, + * design.mps.pool. */ + +#define PoolSig ((Sig)0x519B0019) /* SIGnature POOL */ + +typedef struct PoolStruct { /* generic structure */ + Sig sig; /* design.mps.sig */ + Serial serial; /* from arena->poolSerial */ + PoolClass class; /* pool class structure */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* link in list of pools in arena */ + RingStruct bufferRing; /* allocation buffers are attached to pool */ + Serial bufferSerial; /* serial of next buffer */ + RingStruct segRing; /* segs are attached to pool */ + Align alignment; /* alignment for units */ + Format format; /* format only if class->attr&AttrFMT */ + PoolFixMethod fix; /* fix method */ + double fillMutatorSize; /* bytes filled, mutator buffers */ + double emptyMutatorSize; /* bytes emptied, mutator buffers */ + double fillInternalSize; /* bytes filled, internal buffers */ + double emptyInternalSize; /* bytes emptied, internal buffers */ +} PoolStruct; + + +/* MFSStruct -- MFS (Manual Fixed Small) pool outer structure + * + * .mfs: See impl.c.poolmfs, design.mps.poolmfs. + * + * The MFS outer structure is declared here because it is inlined + * in the control pool structure which is inlined in the arena. Normally, + * pool outer structures are declared with the pools. + * + * The signature is placed at the end, see + * design.mps.pool.outer-structure.sig. */ + +#define MFSSig ((Sig)0x5193F599) /* SIGnature MFS */ + +typedef struct MFSStruct { /* MFS outer structure */ + PoolStruct poolStruct; /* generic structure */ + Size unroundedUnitSize; /* the unit size requested */ + Size extendBy; /* arena alloc size rounded using unitSize */ + Size unitSize; /* rounded for management purposes */ + Word unitsPerExtent; /* number of units per arena alloc */ + struct MFSHeaderStruct *freeList; /* head of the free list */ + Tract tractList; /* the first tract */ + Sig sig; /* design.mps.sig */ +} MFSStruct; + + +/* MVStruct -- MV (Manual Variable) pool outer structure + * + * .mv: See impl.c.poolmv, design.mps.poolmv. + * + * The MV pool outer structure is declared here because it is the + * control pool structure which is inlined in the arena. Normally, + * pool outer structures are declared with the pools. */ + +#define MVSig ((Sig)0x5193B999) /* SIGnature MV */ + +typedef struct MVStruct { /* MV pool outer structure */ + PoolStruct poolStruct; /* generic structure */ + MFSStruct blockPoolStruct; /* for managing block descriptors */ + MFSStruct spanPoolStruct; /* for managing span descriptors */ + Size extendBy; /* segment size to extend pool by */ + Size avgSize; /* client estimate of allocation size */ + Size maxSize; /* client estimate of maximum size */ + Size space; /* total free space in pool */ + Size lost; /* design.mps.poolmv.lost */ + RingStruct spans; /* span chain */ + Sig sig; /* design.mps.sig */ +} MVStruct; + + +/* ReservoirStruct -- Reservoir structure + * + * .reservoir: See impl.c.reserv, design.mps.reservoir. + * + * The Reservoir structure is declared here because it is in-lined in + * the arena for storing segments for the low-memory reservoir. It is + * implemented as a pool - but doesn't follow the normal pool naming + * conventions because it's not intended for general use and the use of + * a pool is an incidental detail. */ + +#define ReservoirSig ((Sig)0x5196e599) /* SIGnature REServoir */ + +typedef struct ReservoirStruct { /* Reservoir structure */ + PoolStruct poolStruct; /* generic pool structure */ + Tract reserve; /* linked list of reserve tracts */ + Size reservoirLimit; /* desired reservoir size */ + Size reservoirSize; /* actual reservoir size */ + Sig sig; /* design.mps.sig */ +} ReservoirStruct; + + +/* MessageClassStruct -- Message Class structure + * + * See design.mps.message.class.struct (and design.mps.message.message, + * and design.mps.message.class). */ + +#define MessageClassSig ((Sig)0x519359c1) /* SIGnature MeSsaGe CLass */ + +typedef struct MessageClassStruct { + Sig sig; /* design.mps.sig */ + const char *name; /* Human readable Class name */ + + /* generic methods */ + MessageDeleteMethod delete; /* terminates a message */ + + /* methods specific to MessageTypeFinalization */ + MessageFinalizationRefMethod finalizationRef; + + /* methods specific to MessageTypeGC */ + MessageGCLiveSizeMethod gcLiveSize; + MessageGCCondemnedSizeMethod gcCondemnedSize; + MessageGCNotCondemnedSizeMethod gcNotCondemnedSize; + + Sig endSig; /* design.mps.message.class.sig.double */ +} MessageClassStruct; + +#define MessageSig ((Sig)0x5193e559) /* SIG MESSaGe */ + +/* MessageStruct -- Message structure + * + * See design.mps.message.message.struct. */ + +typedef struct MessageStruct { + Sig sig; /* design.mps.sig */ + Arena arena; /* owning arena */ + MessageType type; /* Message Type */ + MessageClass class; /* Message Class Structure */ + RingStruct queueRing; /* Message queue ring */ +} MessageStruct; + + +/* SegClassStruct -- segment class structure + * + * See design.mps.seg & design.mps.protocol. + * + * .seg.class: The segment class structure is defined by each segment + * class implementation in order to provide a generic interface to + * segments. */ + +#define SegClassSig ((Sig)0x5195E9C7) /* SIGnature SEG CLass */ + +typedef struct SegClassStruct { + ProtocolClassStruct protocol; + const char *name; /* class name string */ + size_t size; /* size of outer structure */ + SegInitMethod init; /* initialize the segment */ + SegFinishMethod finish; /* finish the segment */ + SegSetSummaryMethod setSummary; /* set the segment summary */ + SegBufferMethod buffer; /* get the segment buffer */ + SegSetBufferMethod setBuffer; /* set the segment buffer */ + SegSetGreyMethod setGrey; /* change greyness of segment */ + SegSetWhiteMethod setWhite; /* change whiteness of segment */ + SegSetRankSetMethod setRankSet; /* change rank set of segment */ + SegSetRankSummaryMethod setRankSummary; /* change rank set & summary */ + SegDescribeMethod describe; /* describe the contents of the seg */ + SegMergeMethod merge; /* merge two adjacent segments */ + SegSplitMethod split; /* split a segment into two */ + Sig sig; /* .class.end-sig */ +} SegClassStruct; + + +/* SegStruct -- segment structure + * + * .seg: Segments are the basic units of protection and tracer activity + * for allocated memory. See design.mps.seg. */ + +#define SegSig ((Sig)0x5195E999) /* SIGnature SEG */ + +typedef struct SegStruct { /* segment structure */ + Sig sig; /* impl.h.misc.sig */ + SegClass class; /* segment class structure */ + Tract firstTract; /* first tract of segment */ + RingStruct poolRing; /* link in list of segs in pool */ + Addr limit; /* limit of segment */ + unsigned depth : ShieldDepthWIDTH; /* see impl.c.shield.def.depth */ + AccessSet pm : AccessSetWIDTH; /* protection mode, impl.c.shield */ + AccessSet sm : AccessSetWIDTH; /* shield mode, impl.c.shield */ + TraceSet grey : TraceLIMIT; /* traces for which seg is grey */ + TraceSet white : TraceLIMIT; /* traces for which seg is white */ + TraceSet nailed : TraceLIMIT; /* traces for which seg has nailed objects */ + RankSet rankSet : RankLIMIT; /* ranks of references in this seg */ +} SegStruct; + + +/* GCSegStruct -- GCable segment structure + * + * .seggc: GCSeg is a subclass of Seg with support for buffered + * allocation and GC. See design.mps.seg. */ + +#define GCSegSig ((Sig)0x5199C5E9) /* SIGnature GC SEG */ + +typedef struct GCSegStruct { /* GC segment structure */ + SegStruct segStruct; /* superclass fields must come first */ + RingStruct greyRing; /* link in list of grey segs */ + RefSet summary; /* summary of references out of seg */ + Buffer buffer; /* non-NULL if seg is buffered */ + Sig sig; /* design.mps.sig */ +} GCSegStruct; + + +/* SegPrefStruct -- segment preference structure + * + * .seg-pref: arena memory users (pool class code) need a way of + * expressing preferences about the segments they allocate. + * + * .seg-pref.misleading: The name is historical and misleading. SegPref + * objects need have nothing to do with segments. @@@@ */ + +#define SegPrefSig ((Sig)0x5195E9B6) /* SIGnature SEG PRef */ + +typedef struct SegPrefStruct { /* segment placement preferences */ + Sig sig; /* impl.h.misc.sig */ + Bool high; /* high or low */ + ZoneSet zones; /* preferred zones */ + Bool isCollected; /* whether segment will be collected */ + Bool isGen; /* whether gen is set */ + Serial gen; /* associated geneation */ +} SegPrefStruct; + + +/* BufferClassStruct -- buffer class structure + * + * See design.mps.buffer & design.mps.protocol. + * + * .buffer.class: The buffer class structure is defined by each buffer + * class implementation in order to provide a generic interface to + * buffers. */ + +#define BufferClassSig ((Sig)0x519B0FC7) /* SIGnature BUFfer CLass */ + +typedef struct BufferClassStruct { + ProtocolClassStruct protocol; + const char *name; /* class name string */ + size_t size; /* size of outer structure */ + BufferInitMethod init; /* initialize the buffer */ + BufferFinishMethod finish; /* finish the buffer */ + BufferAttachMethod attach; /* attach the buffer */ + BufferDetachMethod detach; /* detach the buffer */ + BufferDescribeMethod describe;/* describe the contents of the buffer */ + BufferSegMethod seg; /* seg of buffer */ + BufferRankSetMethod rankSet; /* rank set of buffer */ + BufferSetRankSetMethod setRankSet; /* change rank set of buffer */ + BufferReassignSegMethod reassignSeg; /* change seg of attached buffer */ + Sig sig; /* .class.end-sig */ +} BufferClassStruct; + + + + +/* APStruct -- allocation point structure + * + * AP are part of the design of buffers see design.mps.buffer. + * + * The allocation point is exported to the client code so that it can + * do in-line buffered allocation. + * + * .ap: This structure must match impl.h.mps.ap. See also + * impl.c.mpsi.check.ap. */ + +typedef struct APStruct { + Addr init; /* limit of initialized area */ + Addr alloc; /* limit of allocated area */ + Addr limit; /* limit of allocation buffer */ + Addr frameptr; /* lightweight frame pointer */ + Bool enabled; /* lightweight frame status */ + Bool lwPopPending; /* lightweight pop pending? */ +} APStruct; + + +/* BufferStruct -- allocation buffer structure + * + * See impl.c.buffer, design.mps.buffer. + * + * The buffer contains an AP which may be exported to the client. */ + +#define BufferSig ((Sig)0x519B0FFE) /* SIGnature BUFFEr */ + +typedef struct BufferStruct { + Sig sig; /* design.mps.sig */ + BufferClass class; /* buffer class structure */ + Serial serial; /* from pool->bufferSerial */ + Arena arena; /* owning arena */ + Pool pool; /* owning pool */ + RingStruct poolRing; /* buffers are attached to pools */ + Bool isMutator; /* TRUE iff buffer used by mutator */ + BufferMode mode; /* Attached/Logged/Flipped/etc */ + double fillSize; /* bytes filled in this buffer */ + double emptySize; /* bytes emptied from this buffer */ + Addr base; /* base address of allocation buffer */ + Addr initAtFlip; /* limit of initialized data at flip */ + APStruct apStruct; /* the allocation point */ + Addr poolLimit; /* the pool's idea of the limit */ + Align alignment; /* allocation alignment */ + unsigned rampCount; /* see impl.c.buffer.ramp.hack */ +} BufferStruct; + + +/* SegBufStruct -- Buffer structure associated with segments + * + * .segbuf: SegBuf is a subclass of Buffer with support for attachment + * to segments. */ + +#define SegBufSig ((Sig)0x51959B0F) /* SIGnature SeG BUFfer */ + +typedef struct SegBufStruct { + BufferStruct bufferStruct; /* superclass fields must come first */ + RankSet rankSet; /* ranks of references being created */ + Seg seg; /* segment being buffered */ + Sig sig; /* design.mps.sig */ +} SegBufStruct; + + +/* FormatStruct -- object format structure + * + * See design.mps.format-interface, impl.c.format. + * + * .single: In future, when more variants are added, FormatStruct should + * really be replaced by a collection of format classes. */ + +#define FormatSig ((Sig)0x519F63A2) /* Signature FoRMAT */ + +typedef struct FormatStruct { + Sig sig; + Serial serial; /* from arena->formatSerial */ + FormatVariety variety; /* format variety (e.g. A) */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* formats are attached to the arena */ + Align alignment; /* alignment of formatted objects */ + FormatScanMethod scan; + FormatSkipMethod skip; + FormatMoveMethod move; + FormatIsMovedMethod isMoved; + FormatCopyMethod copy; + FormatPadMethod pad; + FormatClassMethod class; /* pointer indicating class */ + Size headerSize; /* size of header */ +} FormatStruct; + + +/* LDStruct -- location dependency structure + * + * See design.mps.ld, and impl.c.ld. + * + * A version of this structure is exported to the client. .ld.struct: + * This must be kept in sync with impl.h.mps.ld. See also + * impl.c.mpsi.check.ld. */ + +typedef struct LDStruct { + Epoch epoch; /* epoch when ld was last reset / init'ed */ + RefSet rs; /* RefSet of Add'ed references */ +} LDStruct; + + +/* ScanState + * + * .ss: See impl.c.trace. + * + * .ss: The first four fields of the trace structure must match the + * external scan state structure (mps_ss_s) thus: + * ss->fix mps_ss->fix + * ss->zoneShift mps_ss->w0 + * ss->white mps_ss->w1 + * ss->unfixedSummary mps_ss->w2 + * See impl.h.mps.ss and impl.c.mpsi.check.ss. This is why the Sig + * field is in the middle of this structure. .ss.zone: The zoneShift + * field is therefore declared as Word rather than Shift. */ + +#define ScanStateSig ((Sig)0x5195CA45) /* SIGnature SCAN State */ + +typedef struct ScanStateStruct { + TraceFixMethod fix; /* fix function */ + Word zoneShift; /* copy of arena->zoneShift. See .ss.zone */ + ZoneSet white; /* white set, for inline fix test */ + RefSet unfixedSummary; /* accumulated summary of scanned references */ + Sig sig; /* design.mps.sig */ + Arena arena; /* owning arena */ + TraceSet traces; /* traces to scan for */ + Rank rank; /* reference rank of scanning */ + Bool wasMarked; /* design.mps.fix.protocol.was-ready */ + RefSet fixedSummary; /* accumulated summary of fixed references */ + STATISTIC_DECL(Count fixRefCount); /* refs which pass zone check */ + STATISTIC_DECL(Count segRefCount); /* refs which refer to segs */ + STATISTIC_DECL(Count whiteSegRefCount); /* refs which refer to white segs */ + STATISTIC_DECL(Count nailCount); /* segments nailed by ambig refs */ + STATISTIC_DECL(Count snapCount); /* refs snapped to forwarded objs */ + STATISTIC_DECL(Count forwardedCount); /* objects preserved by moving */ + Size forwardedSize; /* bytes preserved by moving */ + STATISTIC_DECL(Count preservedInPlaceCount); /* objects preserved in place */ + Size preservedInPlaceSize; /* bytes preserved in place */ + STATISTIC_DECL(Size copiedSize); /* bytes copied */ + STATISTIC_DECL(Size scannedSize); /* bytes scanned */ +} ScanStateStruct; + + +/* TraceStruct -- tracer state structure */ + +#define TraceSig ((Sig)0x51924ACE) /* SIGnature TRACE */ + +typedef struct TraceStruct { + Sig sig; /* design.mps.sig */ + TraceId ti; /* index into TraceSets */ + Arena arena; /* owning arena */ + ZoneSet white; /* zones in the white set */ + ZoneSet mayMove; /* zones containing possibly moving objs */ + TraceState state; /* current state of trace */ + Bool emergency; /* ran out of memory during trace */ + Chain chain; /* chain being incrementally collected */ + Size condemned; /* condemned bytes */ + Size notCondemned; /* collectable but not condemned */ + Size foundation; /* initial grey set size */ + Size rate; /* segs to scan per increment */ + STATISTIC_DECL(Count greySegCount); /* number of grey segs */ + STATISTIC_DECL(Count greySegMax); /* max number of grey segs */ + STATISTIC_DECL(Count rootScanCount); /* number of roots scanned */ + STATISTIC_DECL(Count rootScanSize); /* total size of scanned roots */ + STATISTIC_DECL(Size rootCopiedSize); /* bytes copied by scanning roots */ + STATISTIC_DECL(Count segScanCount); /* number of segs scanned */ + Count segScanSize; /* total size of scanned segments */ + STATISTIC_DECL(Size segCopiedSize); /* bytes copied by scanning segments */ + STATISTIC_DECL(Count singleScanCount); /* number of single refs scanned */ + STATISTIC_DECL(Count singleScanSize); /* total size of single refs scanned */ + STATISTIC_DECL(Size singleCopiedSize); /* bytes copied by scanning single refs */ + STATISTIC_DECL(Count fixRefCount); /* refs which pass zone check */ + STATISTIC_DECL(Count segRefCount); /* refs which refer to segs */ + STATISTIC_DECL(Count whiteSegRefCount); /* refs which refer to white segs */ + STATISTIC_DECL(Count nailCount); /* segments nailed by ambig refs */ + STATISTIC_DECL(Count snapCount); /* refs snapped to forwarded objs */ + STATISTIC_DECL(Count readBarrierHitCount); /* read barrier faults */ + STATISTIC_DECL(Count pointlessScanCount); /* pointless seg scans */ + STATISTIC_DECL(Count forwardedCount); /* objects preserved by moving */ + Size forwardedSize; /* bytes preserved by moving */ + STATISTIC_DECL(Count preservedInPlaceCount); /* objects preserved in place */ + Size preservedInPlaceSize; /* bytes preserved in place */ + STATISTIC_DECL(Count reclaimCount); /* segments reclaimed */ + STATISTIC_DECL(Count reclaimSize); /* bytes reclaimed */ +} TraceStruct; + + +/* ChunkCacheEntryStruct -- cache entry in the chunk cache */ + +#define ChunkCacheEntrySig ((Sig)0x519C80CE) /* SIGnature CHUnk Cache Entry */ + +typedef struct ChunkCacheEntryStruct { + Sig sig; + Chunk chunk; + Addr base; + Addr limit; + Page pageTableBase; + Page pageTableLimit; +} ChunkCacheEntryStruct; + + +/* ArenaClassStruct -- generic arena class interface */ + +#define ArenaClassSig ((Sig)0x519A6C1A) /* SIGnature ARena CLAss */ + +typedef struct ArenaClassStruct { + ProtocolClassStruct protocol; + char *name; /* class name string */ + size_t size; /* size of outer structure */ + size_t offset; /* offset of generic struct in outer struct */ + ArenaInitMethod init; + ArenaFinishMethod finish; + ArenaReservedMethod reserved; + ArenaSpareCommitExceededMethod spareCommitExceeded; + ArenaExtendMethod extend; + ArenaAllocMethod alloc; + ArenaFreeMethod free; + ArenaChunkInitMethod chunkInit; + ArenaChunkFinishMethod chunkFinish; + ArenaDescribeMethod describe; + Sig sig; +} ArenaClassStruct; + + +/* GlobalsStruct -- the global state associated with an arena + * + * .space: The arena structure holds the entire state of the MPS, and as + * such contains a lot of fields which are considered "global". These + * fields belong to different modules. The module which owns each group + * of fields is commented. */ + +#define GlobalsSig ((Sig)0x519970BA) /* SIGnature GLOBAls */ + +typedef struct GlobalsStruct { + Sig sig; + + /* general fields (impl.c.global) */ + RingStruct globalRing; /* node in global ring of arenas */ + Lock lock; /* arena's lock */ + + /* polling fields (impl.c.global) */ + double pollThreshold; /* design.mps.arena.poll */ + Bool insidePoll; + Bool clamped; /* prevent background activity */ + double fillMutatorSize; /* total bytes filled, mutator buffers */ + double emptyMutatorSize; /* total bytes emptied, mutator buffers */ + double allocMutatorSize; /* fill-empty, only asymptotically accurate */ + double fillInternalSize; /* total bytes filled, internal buffers */ + double emptyInternalSize; /* total bytes emptied, internal buffers */ + + /* version field (impl.c.version) */ + const char *mpsVersionString; /* MPSVersion() */ + + /* buffer fields (impl.c.buffer) */ + Bool bufferLogging; /* design.mps.buffer.logging.control */ + + /* pool fields (impl.c.pool) */ + RingStruct poolRing; /* ring of pools in arena */ + Serial poolSerial; /* serial of next created pool */ + + /* root fields (impl.c.root) */ + RingStruct rootRing; /* ring of roots attached to arena */ + Serial rootSerial; /* serial of next root */ +} GlobalsStruct; + + +/* ArenaStruct -- generic arena + * + * See impl.c.arena. */ + +#define ArenaSig ((Sig)0x519A6E4A) /* SIGnature ARENA */ + +typedef struct ArenaStruct { + GlobalsStruct globals; /* must be first, see design.mps.arena.globals */ + Serial serial; + + ArenaClass class; /* arena class structure */ + + Bool poolReady; /* design.mps.arena.pool.ready */ + MVStruct controlPoolStruct; /* design.mps.arena.pool */ + + ReservoirStruct reservoirStruct; /* design.mps.reservoir */ + + Size committed; /* amount of committed RAM */ + Size commitLimit; /* client-configurable commit limit */ + + Size spareCommitted; /* Amount of memory in hysteresis fund */ + Size spareCommitLimit; /* Limit on spareCommitted */ + + Shift zoneShift; /* see also impl.c.ref */ + Align alignment; /* minimum alignment of tracts */ + + Tract lastTract; /* most recently allocated tract */ + Addr lastTractBase; /* base address of lastTract */ + + Chunk primary; /* the primary chunk */ + RingStruct chunkRing; /* all the chunks */ + Serial chunkSerial; /* next chunk number */ + ChunkCacheEntryStruct chunkCache; /* just one entry */ + + /* locus fields (impl.c.locus) */ + GenDescStruct topGen; /* generation descriptor for dynamic gen */ + + /* format fields (impl.c.format) */ + RingStruct formatRing; /* ring of formats attached to arena */ + Serial formatSerial; /* serial of next format */ + + /* message fields (design.mps.message, impl.c.message) */ + RingStruct messageRing; /* ring of pending messages */ + BT enabledMessageTypes; /* map of which types are enabled */ + + /* finalization fields (design.mps.finalize), impl.c.poolmrg */ + Bool isFinalPool; /* indicator for finalPool */ + Pool finalPool; /* either NULL or an MRG pool */ + + /* thread fields (impl.c.thread) */ + RingStruct threadRing; /* ring of attached threads */ + Serial threadSerial; /* serial of next thread */ + + /* shield fields (impl.c.shield) */ + Bool insideShield; /* TRUE if and only if inside shield */ + Seg shCache[ShieldCacheSIZE]; /* Cache of unsynced segs */ + Size shCacheI; /* index into cache */ + Size shCacheLimit; /* High water mark for cache usage */ + Size shDepth; /* sum of depths of all segs */ + Bool suspended; /* TRUE iff mutator suspended */ + + /* trace fields (impl.c.trace) */ + TraceSet busyTraces; /* set of running traces */ + TraceSet flippedTraces; /* set of running and flipped traces */ + TraceStruct trace[TraceLIMIT]; /* trace structures. See + design.mps.trace.intance.limit */ + RingStruct greyRing[RankLIMIT]; /* ring of grey segments at each rank */ + STATISTIC_DECL(Count writeBarrierHitCount); /* write barrier hits */ + RingStruct chainRing; /* ring of chains */ + + /* location dependency fields (impl.c.ld) */ + Epoch epoch; /* design.mps.arena.ld.epoch */ + RefSet prehistory; /* design.mps.arena.ld.prehistory */ + RefSet history[LDHistoryLENGTH]; /* design.mps.arena.ld.history */ + + Sig sig; +} ArenaStruct; + + +typedef struct AllocPatternStruct { + char dummy; +} AllocPatternStruct; + + +#endif /* mpmst_h */ diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h new file mode 100644 index 00000000000..abf12d6b7b0 --- /dev/null +++ b/mps/code/mpmtypes.h @@ -0,0 +1,439 @@ +/* impl.h.mpmtypes: MEMORY POOL MANAGER TYPES + * + * $HopeName: MMsrc!mpmtypes.h(trunk.89) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: design.mps.type + * + * .rationale: Types and type constants are almost all defined + * in this header, in advance of any declarations of prototypes + * or structures. This avoids difficulties in defining recursive + * data structures. + */ + +#ifndef mpmtypes_h +#define mpmtypes_h + +#include "config.h" /* this must come first: it defines target options */ +#include "misc.h" /* miscellaneous non-specific bits and bobs */ +#include "mpslib.h" + +#include +#include + + +/* TYPES */ + +typedef unsigned long Sig; /* design.mps.sig */ +typedef int Res; /* design.mps.type.res */ + +typedef void (*Fun)(void); /* design.mps.type.fun */ +typedef MPS_T_WORD Word; /* design.mps.type.word */ +typedef unsigned char Byte; /* design.mps.type.byte */ +typedef struct AddrStruct *Addr; /* design.mps.type.addr */ +typedef Word Size; /* design.mps.type.size */ +typedef Word Count; /* design.mps.type.count */ +typedef Word Index; /* design.mps.type.index */ +typedef Word Align; /* design.mps.type.align */ +typedef unsigned Shift; /* design.mps.type.shift */ +typedef unsigned Serial; /* design.mps.type.serial */ +typedef Addr Ref; /* design.mps.type.ref */ +typedef void *Pointer; /* design.mps.type.pointer */ + +typedef Word RefSet; /* design.mps.refset */ +typedef Word ZoneSet; /* design.mps.refset */ +typedef unsigned Rank; +typedef unsigned RankSet; +typedef unsigned RootMode; +typedef Size Epoch; /* design.mps.ld */ +typedef unsigned TraceId; /* design.mps.trace */ +typedef unsigned TraceSet; /* design.mps.trace */ +typedef unsigned TraceState; /* design.mps.trace */ +typedef unsigned AccessSet; /* design.mps.type.access-set */ +typedef unsigned Attr; /* design.mps.type.attr */ +typedef unsigned FormatVariety; +typedef int RootVar; /* design.mps.type.rootvar */ + +typedef Word *BT; /* design.mps.bt */ +typedef struct BootBlockStruct *BootBlock; /* impl.c.boot */ +typedef struct BufferStruct *Buffer; /* design.mps.buffer */ +typedef struct SegBufStruct *SegBuf; /* design.mps.buffer */ +typedef struct BufferClassStruct *BufferClass; /* design.mps.buffer */ +typedef BufferClass SegBufClass; /* design.mps.buffer */ +typedef BufferClass RankBufClass; /* design.mps.buffer */ +typedef unsigned BufferMode; /* design.mps.buffer */ +typedef unsigned FrameState; /* design.mps.alloc-frame */ +typedef struct APStruct *AP; /* design.mps.buffer */ +typedef struct FormatStruct *Format; /* design.mps.format */ +typedef struct LDStruct *LD; /* design.mps.ld */ +typedef struct LockStruct *Lock; /* impl.c.lock* */ +typedef struct PoolStruct *Pool; /* design.mps.pool */ +typedef struct PoolClassStruct *PoolClass; /* impl.c.poolclas */ +typedef PoolClass AbstractPoolClass; /* impl.c.poolabs */ +typedef PoolClass AbstractAllocFreePoolClass; /* impl.c.poolabs */ +typedef PoolClass AbstractBufferPoolClass; /* impl.c.poolabs */ +typedef PoolClass AbstractSegBufPoolClass; /* impl.c.poolabs */ +typedef PoolClass AbstractScanPoolClass; /* impl.c.poolabs */ +typedef PoolClass AbstractCollectPoolClass; /* impl.c.poolabs */ +typedef struct TraceStruct *Trace; /* design.mps.trace */ +typedef struct ScanStateStruct *ScanState; /* design.mps.trace */ +typedef struct ChainStruct *Chain; /* design.mps.trace */ +typedef struct TractStruct *Tract; /* design.mps.arena */ +typedef struct ChunkStruct *Chunk; /* impl.c.tract */ +typedef struct ChunkCacheEntryStruct *ChunkCacheEntry; /* impl.c.tract */ +typedef struct PageStruct *Page; /* impl.c.tract */ +typedef struct SegStruct *Seg; /* impl.c.seg */ +typedef struct GCSegStruct *GCSeg; /* impl.c.seg */ +typedef struct SegClassStruct *SegClass; /* impl.c.seg */ +typedef SegClass GCSegClass; /* impl.c.seg */ +typedef struct SegPrefStruct *SegPref; /* design.mps.pref, impl.c.locus */ +typedef int SegPrefKind; /* design.mps.pref, impl.c.locus */ +typedef struct ArenaClassStruct *ArenaClass; /* design.mps.arena */ +typedef ArenaClass AbstractArenaClass; /* impl.c.arena */ +typedef struct ArenaStruct *Arena; /* design.mps.arena */ +typedef struct GlobalsStruct *Globals; /* design.mps.arena */ +typedef struct VMStruct *VM; /* impl.c.vm* */ +typedef struct RootStruct *Root; /* impl.c.root */ +typedef struct ThreadStruct *Thread; /* impl.c.th* */ +typedef struct MutatorFaultContextStruct + *MutatorFaultContext; /* design.mps.prot */ +typedef struct PoolDebugMixinStruct *PoolDebugMixin; +typedef struct AllocPatternStruct *AllocPattern; +typedef struct AllocFrameStruct *AllocFrame; /* design.mps.alloc-frame */ +typedef struct ReservoirStruct *Reservoir; /* design.mps.reservoir */ + + +/* Arena*Method -- see impl.h.mpmst.ArenaClassStruct */ + +typedef Res (*ArenaInitMethod)(Arena *arenaReturn, + ArenaClass class, va_list args); +typedef void (*ArenaFinishMethod)(Arena arena); +typedef Size (*ArenaReservedMethod)(Arena arena); +typedef void (*ArenaSpareCommitExceededMethod)(Arena arena); +typedef Res (*ArenaExtendMethod)(Arena arena, Addr base, Size size); +typedef Res (*ArenaAllocMethod)(Addr *baseReturn, Tract *baseTractReturn, + SegPref pref, Size size, Pool pool); +typedef void (*ArenaFreeMethod)(Addr base, Size size, Pool pool); +typedef Res (*ArenaChunkInitMethod)(Chunk chunk, BootBlock boot); +typedef void (*ArenaChunkFinishMethod)(Chunk chunk); +typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream); + + +/* Messages + * + * See design.mps.message + */ + +typedef unsigned MessageType; +typedef struct MessageStruct *Message; +typedef struct MessageClassStruct *MessageClass; + + +/* TraceFixMethod */ + +typedef Res (*TraceFixMethod)(ScanState ss, Ref *refIO); + + +/* Heap Walker */ + +/* This type is used by the PoolClass method Walk */ +typedef void (*FormattedObjectsStepMethod)(Addr, Format, Pool, + void *, Size); + +/* Seg*Method -- see design.mps.seg */ + +typedef Res (*SegInitMethod)(Seg seg, Pool pool, Addr base, Size size, + Bool withReservoirPermit, va_list args); +typedef void (*SegFinishMethod)(Seg seg); +typedef void (*SegSetGreyMethod)(Seg seg, TraceSet grey); +typedef void (*SegSetWhiteMethod)(Seg seg, TraceSet white); +typedef void (*SegSetRankSetMethod)(Seg seg, RankSet rankSet); +typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet, + RefSet summary); +typedef void (*SegSetSummaryMethod)(Seg seg, RefSet summary); +typedef Buffer (*SegBufferMethod)(Seg seg); +typedef void (*SegSetBufferMethod)(Seg seg, Buffer buffer); +typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream); +typedef Res (*SegMergeMethod)(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args); +typedef Res (*SegSplitMethod)(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args); + +/* Buffer*Method -- see design.mps.buffer */ + +typedef Res (*BufferInitMethod)(Buffer buffer, Pool pool, va_list args); +typedef void (*BufferFinishMethod)(Buffer buffer); +typedef void (*BufferAttachMethod)(Buffer buffer, Addr base, Addr limit, + Addr init, Size size); +typedef void (*BufferDetachMethod)(Buffer buffer); +typedef Seg (*BufferSegMethod)(Buffer buffer); +typedef RankSet (*BufferRankSetMethod)(Buffer buffer); +typedef void (*BufferSetRankSetMethod)(Buffer buffer, RankSet rankSet); +typedef void (*BufferReassignSegMethod)(Buffer buffer, Seg seg); +typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream); + + +/* Pool*Method -- see design.mps.class-interface */ + +/* Order of types corresponds to PoolClassStruct in impl.h.mpmst */ + +typedef Res (*PoolInitMethod)(Pool pool, va_list args); +typedef void (*PoolFinishMethod)(Pool pool); +typedef Res (*PoolAllocMethod)(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit); +typedef void (*PoolFreeMethod)(Pool pool, Addr old, Size size); +typedef Res (*PoolBufferFillMethod)(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit); +typedef void (*PoolBufferEmptyMethod)(Pool pool, Buffer buffer, + Addr init, Addr limit); +typedef Res (*PoolTraceBeginMethod)(Pool pool, Trace trace); +typedef Res (*PoolAccessMethod)(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context); +typedef Res (*PoolWhitenMethod)(Pool pool, Trace trace, Seg seg); +typedef void (*PoolGreyMethod)(Pool pool, Trace trace, Seg seg); +typedef void (*PoolBlackenMethod)(Pool pool, TraceSet traceSet, Seg seg); +typedef Res (*PoolScanMethod)(Bool *totalReturn, ScanState ss, + Pool pool, Seg seg); +typedef Res (*PoolFixMethod)(Pool pool, ScanState ss, Seg seg, + Ref *refIO); +typedef Res (*PoolFixEmergencyMethod)(Pool pool, ScanState ss, + Seg seg, Ref *refIO); +typedef void (*PoolReclaimMethod)(Pool pool, Trace trace, Seg seg); +typedef void (*PoolRampBeginMethod)(Pool pool, Buffer buf, Bool collectAll); +typedef void (*PoolRampEndMethod)(Pool pool, Buffer buf); +typedef Res (*PoolFramePushMethod)(AllocFrame *frameReturn, + Pool pool, Buffer buf); +typedef Res (*PoolFramePopMethod)(Pool pool, Buffer buf, + AllocFrame frame); +typedef void (*PoolFramePopPendingMethod)(Pool pool, Buffer buf, + AllocFrame frame); +typedef void (*PoolWalkMethod)(Pool pool, Seg seg, + FormattedObjectsStepMethod f, + void *p, unsigned long s); +typedef BufferClass (*PoolBufferClassMethod)(void); +typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream); +typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool); + + +/* Message*Method -- design.mps.message */ + +typedef void (*MessageDeleteMethod)(Message message); +typedef void (*MessageFinalizationRefMethod) + (Ref *refReturn, Arena arena, Message message); +typedef Size (*MessageGCLiveSizeMethod)(Message message); +typedef Size (*MessageGCCondemnedSizeMethod)(Message message); +typedef Size (*MessageGCNotCondemnedSizeMethod)(Message message); + + +/* Message Types -- design.mps.message and elsewhere */ + +typedef struct MessageFinalizationStruct *MessageFinalization; + + +/* Format*Method -- see design.mps.format-interface */ +/* .fmt-methods: These methods must match those defined in the */ +/* MPS C Interface. (See impl.h.mps.fmt-methods.) */ + +typedef Res (*FormatScanMethod)(ScanState ss, Addr base, Addr limit); +typedef Addr (*FormatSkipMethod)(Addr object); +typedef void (*FormatMoveMethod)(Addr object, Addr to); +typedef Addr (*FormatIsMovedMethod)(Addr object); +typedef void (*FormatCopyMethod)(Addr object, Addr to); +typedef void (*FormatPadMethod)(Addr base, Size size); +typedef Addr (*FormatClassMethod)(Addr object); + + +/* Root*Method -- see design.mps.root-interface */ +/* .root-methods: These methods must match those defined in the */ +/* MPS C Interface. (See impl.h.mps.root-methods.) */ + +typedef Res (*RootScanMethod)(ScanState ss, void *p, size_t s); +typedef Res (*RootScanRegMethod)(ScanState ss, Thread thread, void *p, size_t s); + + +/* CONSTANTS */ + + +/* design.mps.sig SIGnature IS BAD */ +#define SigInvalid ((Sig)0x51915BAD) + +#define SizeMAX ((Size)-1) +#define AccessSetEMPTY ((AccessSet)0) /* design.mps.type.access-set */ +#define AccessREAD ((AccessSet)(1<<0)) +#define AccessWRITE ((AccessSet)(1<<1)) +#define AccessSetWIDTH (2) +#define RefSetEMPTY BS_EMPTY(RefSet) +#define RefSetUNIV BS_UNIV(RefSet) +#define ZoneSetEMPTY BS_EMPTY(ZoneSet) +#define ZoneSetUNIV BS_UNIV(ZoneSet) +#define TraceSetEMPTY BS_EMPTY(TraceSet) +#define TraceSetUNIV ((TraceSet)((1u << TraceLIMIT) - 1)) +#define RankSetEMPTY BS_EMPTY(RankSet) +#define RankSetUNIV ((RankSet)((1u << RankLIMIT) - 1)) +#define AttrFMT ((Attr)(1<<0)) /* design.mps.type.attr */ +#define AttrSCAN ((Attr)(1<<1)) +#define AttrPM_NO_READ ((Attr)(1<<2)) +#define AttrPM_NO_WRITE ((Attr)(1<<3)) +#define AttrALLOC ((Attr)(1<<4)) +#define AttrFREE ((Attr)(1<<5)) +#define AttrBUF ((Attr)(1<<6)) +#define AttrBUF_RESERVE ((Attr)(1<<7)) +#define AttrBUF_ALLOC ((Attr)(1<<8)) +#define AttrGC ((Attr)(1<<9)) +#define AttrINCR_RB ((Attr)(1<<10)) +#define AttrINCR_WB ((Attr)(1<<11)) +#define AttrMOVINGGC ((Attr)(1<<12)) +#define AttrMASK (AttrFMT | AttrSCAN | AttrPM_NO_READ | \ + AttrPM_NO_WRITE | AttrALLOC | AttrFREE | \ + AttrBUF | AttrBUF_RESERVE | AttrBUF_ALLOC | \ + AttrGC | AttrINCR_RB | AttrINCR_WB | AttrMOVINGGC) + + +/* Format varieties */ +enum { + FormatVarietyA = 1, + FormatVarietyB, + FormatVarietyAutoHeader, + FormatVarietyLIMIT +}; + + +/* Segment preferences */ +enum { + SegPrefHigh = 1, + SegPrefLow, + SegPrefZoneSet, + SegPrefGen, + SegPrefCollected, + SegPrefLIMIT +}; + + +/* Buffer modes */ +#define BufferModeATTACHED ((BufferMode)(1<<0)) +#define BufferModeFLIPPED ((BufferMode)(1<<1)) +#define BufferModeLOGGED ((BufferMode)(1<<2)) +#define BufferModeTRANSITION ((BufferMode)(1<<3)) + + +/* Buffer frame states. See design.mps.alloc-frame.lw-frame.states */ +enum { + BufferFrameVALID = 1, + BufferFramePOP_PENDING, + BufferFrameDISABLED +}; + + +/* Rank constants -- see design.mps.type.rank */ +/* These definitions must match impl.h.mps.rank. */ +/* This is checked by impl.c.mpsi.check. */ + +enum { + RankAMBIG = 0, + RankEXACT = 1, + RankFINAL = 2, + RankWEAK = 3, + RankLIMIT +}; + + +/* Root Modes -- not implemented */ +/* .rm: Synchronize with impl.h.mps.rm. */ +/* This comment exists as a placeholder for when root modes are */ +/* implemented. */ + +#define RootModeCONSTANT ((RootMode)1<<0) +#define RootModePROTECTABLE ((RootMode)1<<1) +#define RootModePROTECTABLE_INNER ((RootMode)1<<2) + + +/* Root Variants -- see design.mps.type.rootvar + * + * .rootvar: Synchonize with impl.c.root.rootvarcheck + */ + +enum { + RootFUN, + RootTABLE, + RootTABLE_MASKED, + RootREG, + RootFMT, + RootLIMIT +}; + + +/* .result-codes: Result Codes -- see design.mps.type.res */ +/* These definitions must match impl.h.mps.result-codes. */ +/* This is checked by impl.c.mpsi.check.rc. */ +/* Changing this list entails changing the list in */ +/* impl.h.mps.result-codes and the check in impl.c.mpsi.check.rc */ + +enum { + ResOK = 0, + ResFAIL, + ResRESOURCE, + ResMEMORY, + ResLIMIT, + ResUNIMPL, + ResIO, + ResCOMMIT_LIMIT, + ResPARAM +}; + + +/* TraceStates -- see design.mps.trace */ + +enum { + TraceINIT = 1, + TraceUNFLIPPED, + TraceFLIPPED, + TraceRECLAIM, + TraceFINISHED +}; + + +/* MessageTypes -- see design.mps.message */ +/* .message.types: Keep in sync with impl.h.mps.message.types */ + +enum { + MessageTypeFINALIZATION, + MessageTypeGC, + MessageTypeLIMIT +}; + + +/* Types for WriteF formats */ +/* These should be used with calls to WriteF. */ +/* These must be unpromotable types. */ + +typedef Addr WriteFA; +typedef Pointer WriteFP; +typedef const char *WriteFS; +typedef Word WriteFW; +typedef unsigned long WriteFU; +typedef unsigned long WriteFB; +typedef void *(*WriteFF)(void); +typedef int WriteFC; /* Promoted */ +typedef double WriteFD; + + +/* STATISTIC_DECL -- declare a field to accumulate statistics in + * + * The argument is a field declaration (a struct-declaration minus the + * semicolon) for a single field (no commas). Currently, we always + * leave them in, see design.mps.metrics. + */ + +#if defined(DIAGNOSTICS) +#define STATISTIC_DECL(field) field +#elif defined(DIAGNOSTICS_NONE) +#define STATISTIC_DECL(field) field +#else +#error "No diagnostics configured." +#endif + + +#endif /* mpmtypes_h */ diff --git a/mps/code/mps.h b/mps/code/mps.h new file mode 100644 index 00000000000..7339319d815 --- /dev/null +++ b/mps/code/mps.h @@ -0,0 +1,623 @@ +/* impl.h.mps: HARLEQUIN MEMORY POOL SYSTEM C INTERFACE + * + * $HopeName: MMsrc!mps.h(trunk.63) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .readership: customers, MPS developers. + * .sources: design.mps.interface.c. + */ + +#ifndef mps_h +#define mps_h + +#include "mpstd.h" /* detect platform */ +#include +#include +#include + + +/* Abstract Types */ + +typedef struct mps_arena_s *mps_arena_t; /* arena */ +typedef mps_arena_t mps_space_t; /* space, for backward comp. */ +typedef struct mps_arena_class_s *mps_arena_class_t; /* arena class */ +typedef struct mps_pool_s *mps_pool_t; /* pool */ +typedef struct mps_chain_s *mps_chain_t; /* chain */ +typedef struct mps_fmt_s *mps_fmt_t; /* object format */ +typedef struct mps_root_s *mps_root_t; /* root */ +typedef struct mps_class_s *mps_class_t; /* pool class */ +typedef struct mps_thr_s *mps_thr_t; /* thread registration */ +typedef struct mps_ap_s *mps_ap_t; /* allocation point */ +typedef struct mps_ld_s *mps_ld_t; /* location dependency */ +typedef struct mps_ss_s *mps_ss_t; /* scan state */ +typedef struct mps_message_s + *mps_message_t; /* message */ +typedef struct mps_alloc_pattern_s + *mps_alloc_pattern_t; /* allocation patterns */ +typedef struct mps_frame_s + *mps_frame_t; /* allocation frames */ + +/* Concrete Types */ + +typedef MPS_T_WORD mps_word_t; /* machine word (target dep.) */ +typedef int mps_bool_t; /* boolean (int) */ +typedef int mps_res_t; /* result code (int) */ +typedef unsigned mps_shift_t; /* shift amount (unsigned int) */ +typedef void *mps_addr_t; /* managed address (void *) */ +typedef size_t mps_align_t; /* alignment (size_t) */ +typedef unsigned mps_rm_t; /* root mode (unsigned) */ +typedef unsigned mps_rank_t; /* ranks (unsigned) */ +typedef unsigned mps_message_type_t; /* message type (unsigned) */ + +/* Result Codes */ +/* .result-codes: Keep in sync with impl.h.mpmtypes.result-codes */ +/* and the check in impl.c.mpsi.check.rc */ + +enum { + MPS_RES_OK = 0, /* success (always zero) */ + MPS_RES_FAIL, /* unspecified failure */ + MPS_RES_RESOURCE, /* unable to obtain resources */ + MPS_RES_MEMORY, /* unable to obtain memory */ + MPS_RES_LIMIT, /* limitation reached */ + MPS_RES_UNIMPL, /* unimplemented facility */ + MPS_RES_IO, /* system I/O error */ + MPS_RES_COMMIT_LIMIT, /* arena commit limit exceeded */ + MPS_RES_PARAM /* illegal user parameter value */ +}; + +/* .message.types: Keep in sync with impl.h.mpmtypes.message.types */ +/* Not meant to be used by clients, they should use the macros below. */ +enum { + MPS_MESSAGE_TYPE_FINALIZATION, + MPS_MESSAGE_TYPE_GC +}; + +/* Message Types + * This is what clients should use. */ +#define mps_message_type_finalization() MPS_MESSAGE_TYPE_FINALIZATION +#define mps_message_type_gc() MPS_MESSAGE_TYPE_GC + + +/* Reference Ranks + * + * See protocol.mps.reference. */ + +extern mps_rank_t mps_rank_ambig(void); +extern mps_rank_t mps_rank_exact(void); +extern mps_rank_t mps_rank_weak(void); + +/* These upper case symbolic forms are obsolescent. */ +/* Provided for source compatibility only. */ +#define MPS_RANK_AMBIG mps_rank_ambig() +#define MPS_RANK_EXACT mps_rank_exact() +#define MPS_RANK_WEAK mps_rank_weak() + +/* Root Modes */ +/* .rm: Keep in sync with impl.h.mpmtypes.rm */ + +#define MPS_RM_CONST (((mps_rm_t)1<<0)) +#define MPS_RM_PROT (((mps_rm_t)1<<1)) + + +/* Allocation Point */ +/* .ap: Keep in sync with impl.h.mpmst.ap. */ + +typedef struct mps_ap_s { /* allocation point descriptor */ + mps_addr_t init; /* limit of initialized memory */ + mps_addr_t alloc; /* limit of allocated memory */ + mps_addr_t limit; /* limit of available memory */ + mps_addr_t frameptr; /* lightweight frame pointer */ + mps_bool_t enabled; /* lightweight frame status */ + mps_bool_t lwpoppending; /* lightweight pop pending? */ +} mps_ap_s; + + +/* Segregated-fit Allocation Caches */ +/* .sac: Keep in sync with impl.h.sac. */ + +typedef struct mps_sac_s *mps_sac_t; + +#define MPS_SAC_CLASS_LIMIT ((size_t)8) + +typedef struct mps_sac_freelist_block_s { + size_t mps_size; + size_t mps_count; + size_t mps_count_max; + mps_addr_t mps_blocks; +} mps_sac_freelist_block_s; + +typedef struct mps_sac_s { + size_t mps_middle; + mps_bool_t mps_trapped; + mps_sac_freelist_block_s mps_freelists[2 * MPS_SAC_CLASS_LIMIT]; +} mps_sac_s; + +/* .sacc: Keep in sync with impl.h.sac. */ +typedef struct mps_sac_classes_s { + size_t mps_block_size; + size_t mps_cached_count; + unsigned mps_frequency; +} mps_sac_classes_s; + + +/* Location Dependency */ +/* .ld: Keep in sync with impl.h.mpmst.ld.struct. */ + +typedef struct mps_ld_s { /* location dependency descriptor */ + mps_word_t w0, w1; +} mps_ld_s; + + +/* Format and Root Method Types */ +/* .fmt-methods: Keep in sync with impl.h.mpmtypes.fmt-methods */ +/* .root-methods: Keep in sync with impl.h.mpmtypes.root-methods */ + +typedef mps_res_t (*mps_root_scan_t)(mps_ss_t, void *, size_t); +typedef mps_res_t (*mps_fmt_scan_t)(mps_ss_t, mps_addr_t, mps_addr_t); +typedef mps_res_t (*mps_reg_scan_t)(mps_ss_t, mps_thr_t, + void *, size_t); +typedef mps_addr_t (*mps_fmt_skip_t)(mps_addr_t); +typedef void (*mps_fmt_copy_t)(mps_addr_t, mps_addr_t); +typedef void (*mps_fmt_fwd_t)(mps_addr_t, mps_addr_t); +typedef mps_addr_t (*mps_fmt_isfwd_t)(mps_addr_t); +typedef void (*mps_fmt_pad_t)(mps_addr_t, size_t); +typedef mps_addr_t (*mps_fmt_class_t)(mps_addr_t); + + +/* Scan State */ +/* .ss: See also impl.c.mpsi.check.ss and impl.h.mpmst.ss. */ + +typedef struct mps_ss_s { + mps_res_t (*fix)(mps_ss_t, mps_addr_t *); + mps_word_t w0, w1, w2; +} mps_ss_s; + + +/* Format Variants */ + +typedef struct mps_fmt_A_s { + mps_align_t align; + mps_fmt_scan_t scan; + mps_fmt_skip_t skip; + mps_fmt_copy_t copy; + mps_fmt_fwd_t fwd; + mps_fmt_isfwd_t isfwd; + mps_fmt_pad_t pad; +} mps_fmt_A_s; +typedef struct mps_fmt_A_s *mps_fmt_A_t; /* deprecated */ + +typedef struct mps_fmt_B_s { + mps_align_t align; + mps_fmt_scan_t scan; + mps_fmt_skip_t skip; + mps_fmt_copy_t copy; + mps_fmt_fwd_t fwd; + mps_fmt_isfwd_t isfwd; + mps_fmt_pad_t pad; + mps_fmt_class_t mps_class; +} mps_fmt_B_s; +typedef struct mps_fmt_B_s *mps_fmt_B_t; /* deprecated */ + + +typedef struct mps_fmt_auto_header_s { + mps_align_t align; + mps_fmt_scan_t scan; + mps_fmt_skip_t skip; + mps_fmt_fwd_t fwd; + mps_fmt_isfwd_t isfwd; + mps_fmt_pad_t pad; + size_t mps_headerSize; +} mps_fmt_auto_header_s; + + +/* Internal Definitions */ + +#define MPS_BEGIN do { +#define MPS_END } while(0) +/* MPS_END might cause compiler warnings about constant conditionals. + * This could be avoided with some loss of efficiency by replacing 0 + * with a variable always guaranteed to be 0. In Visual C, the + * warning can be turned off using: + * #pragma warning(disable: 4127) + */ + + +/* Assertion Handling */ + +typedef void (*mps_assert_t)(const char *, const char *, const char *, + unsigned); + +extern mps_assert_t mps_assert_install(mps_assert_t); +extern mps_assert_t mps_assert_default(void); + + +/* arenas */ + +extern void mps_arena_clamp(mps_arena_t); +extern void mps_arena_release(mps_arena_t); +extern void mps_arena_park(mps_arena_t); +extern mps_res_t mps_arena_collect(mps_arena_t); +extern void mps_space_clamp(mps_space_t); +extern void mps_space_release(mps_space_t); +extern void mps_space_park(mps_space_t); +extern mps_res_t mps_space_collect(mps_space_t); + +extern mps_res_t mps_arena_create(mps_arena_t *, mps_arena_class_t, ...); +extern mps_res_t mps_arena_create_v(mps_arena_t *, mps_arena_class_t, va_list); +extern void mps_arena_destroy(mps_arena_t); + +/* these two for backward compatibility */ +extern mps_res_t mps_space_create(mps_space_t *); +extern void mps_space_destroy(mps_space_t); + +extern size_t mps_arena_reserved(mps_arena_t); +extern size_t mps_arena_committed(mps_arena_t); +extern size_t mps_arena_spare_committed(mps_arena_t); + +extern size_t mps_arena_commit_limit(mps_arena_t); +extern mps_res_t mps_arena_commit_limit_set(mps_arena_t, size_t); +extern void mps_arena_spare_commit_limit_set(mps_arena_t, size_t); +extern size_t mps_arena_spare_commit_limit(mps_arena_t); + +extern size_t mps_space_reserved(mps_space_t); +extern size_t mps_space_committed(mps_space_t); + +/* Client memory arenas */ +extern mps_res_t mps_arena_extend(mps_arena_t, mps_addr_t, size_t); +extern mps_res_t mps_arena_retract(mps_arena_t, mps_addr_t, size_t); + + +/* Object Formats */ + +extern mps_res_t mps_fmt_create_A(mps_fmt_t *, mps_arena_t, + mps_fmt_A_s *); +extern mps_res_t mps_fmt_create_B(mps_fmt_t *, mps_arena_t, + mps_fmt_B_s *); +extern mps_res_t mps_fmt_create_auto_header(mps_fmt_t *, mps_arena_t, + mps_fmt_auto_header_s *); +extern void mps_fmt_destroy(mps_fmt_t); + + +/* Pools */ + +extern mps_res_t mps_pool_create(mps_pool_t *, mps_arena_t, + mps_class_t, ...); +extern mps_res_t mps_pool_create_v(mps_pool_t *, mps_arena_t, + mps_class_t, va_list); +extern void mps_pool_destroy(mps_pool_t); + +/* .gen-param: This structure must match impl.h.chain.gen-param. */ +typedef struct mps_gen_param_s { + size_t mps_capacity; + double mps_mortality; +} mps_gen_param_s; + +extern mps_res_t mps_chain_create(mps_chain_t *, mps_arena_t, + size_t, mps_gen_param_s *); +extern void mps_chain_destroy(mps_chain_t); + +extern mps_res_t mps_alloc(mps_addr_t *, mps_pool_t, size_t, ...); +extern mps_res_t mps_alloc_v(mps_addr_t *, mps_pool_t, size_t, va_list); +extern void mps_free(mps_pool_t, mps_addr_t, size_t); + + +/* Allocation Points */ + +extern mps_res_t mps_ap_create(mps_ap_t *, mps_pool_t, ...); +extern mps_res_t mps_ap_create_v(mps_ap_t *, mps_pool_t, va_list); +extern void mps_ap_destroy(mps_ap_t); + +extern mps_res_t (mps_reserve)(mps_addr_t *, mps_ap_t, size_t); +extern mps_bool_t (mps_commit)(mps_ap_t, mps_addr_t, size_t); + +extern mps_res_t mps_ap_fill(mps_addr_t *, mps_ap_t, size_t); +extern mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *, + mps_ap_t, + size_t); + +extern mps_res_t (mps_ap_frame_push)(mps_frame_t *, mps_ap_t); +extern mps_res_t (mps_ap_frame_pop)(mps_ap_t, mps_frame_t); + +extern mps_bool_t mps_ap_trip(mps_ap_t, mps_addr_t, size_t); + +extern mps_alloc_pattern_t mps_alloc_pattern_ramp(void); +extern mps_alloc_pattern_t mps_alloc_pattern_ramp_collect_all(void); +extern mps_res_t mps_ap_alloc_pattern_begin(mps_ap_t, mps_alloc_pattern_t); +extern mps_res_t mps_ap_alloc_pattern_end(mps_ap_t, mps_alloc_pattern_t); +extern mps_res_t mps_ap_alloc_pattern_reset(mps_ap_t); + + +/* Segregated-fit Allocation Caches */ + +extern mps_res_t mps_sac_create(mps_sac_t *, mps_pool_t, size_t, + mps_sac_classes_s *); +extern void mps_sac_destroy(mps_sac_t); +extern mps_res_t mps_sac_alloc(mps_addr_t *, mps_sac_t, size_t, mps_bool_t); +extern void mps_sac_free(mps_sac_t, mps_addr_t, size_t); +extern void mps_sac_flush(mps_sac_t); + +/* Direct access to mps_sac_fill and mps_sac_empty is not supported. */ +extern mps_res_t mps_sac_fill(mps_addr_t *, mps_sac_t, size_t, mps_bool_t); +extern void mps_sac_empty(mps_sac_t, mps_addr_t, size_t); + +#define MPS_SAC_ALLOC_FAST(res_o, p_o, sac, size, has_reservoir_permit) \ + MPS_BEGIN \ + size_t _mps_i, _mps_s; \ + \ + _mps_s = (size); \ + if (_mps_s > (sac)->mps_middle) { \ + _mps_i = 0; \ + while (_mps_s > (sac)->mps_freelists[_mps_i].mps_size) \ + _mps_i += 2; \ + } else { \ + _mps_i = 1; \ + while (_mps_s <= (sac)->mps_freelists[_mps_i].mps_size) \ + _mps_i += 2; \ + } \ + if ((sac)->mps_freelists[_mps_i].mps_count != 0) { \ + (p_o) = (sac)->mps_freelists[_mps_i].mps_blocks; \ + (sac)->mps_freelists[_mps_i].mps_blocks = *(mps_addr_t *)(p_o); \ + --(sac)->mps_freelists[_mps_i].mps_count; \ + (res_o) = MPS_RES_OK; \ + } else \ + (res_o) = mps_sac_fill(&(p_o), sac, _mps_s, \ + has_reservoir_permit); \ + MPS_END + +#define MPS_SAC_FREE_FAST(sac, p, size) \ + MPS_BEGIN \ + size_t _mps_i, _mps_s; \ + \ + _mps_s = (size); \ + if (_mps_s > (sac)->mps_middle) { \ + _mps_i = 0; \ + while (_mps_s > (sac)->mps_freelists[_mps_i].mps_size) \ + _mps_i += 2; \ + } else { \ + _mps_i = 1; \ + while (_mps_s <= (sac)->mps_freelists[_mps_i].mps_size) \ + _mps_i += 2; \ + } \ + if ((sac)->mps_freelists[_mps_i].mps_count \ + < (sac)->mps_freelists[_mps_i].mps_count_max) { \ + *(mps_addr_t *)(p) = (sac)->mps_freelists[_mps_i].mps_blocks; \ + (sac)->mps_freelists[_mps_i].mps_blocks = (p); \ + ++(sac)->mps_freelists[_mps_i].mps_count; \ + } else \ + mps_sac_empty(sac, p, _mps_s); \ + MPS_END + +/* backward compatibility */ +#define MPS_SAC_ALLOC(res_o, p_o, sac, size, has_reservoir_permit) \ + MPS_SAC_ALLOC_FAST(res_o, p_o, sac, size, has_reservoir_permit) +#define MPS_SAC_FREE(sac, p, size) MPS_SAC_FREE_FAST(sac, p, size) + + +/* Low memory reservoir */ + +extern void mps_reservoir_limit_set(mps_arena_t, size_t); +extern size_t mps_reservoir_limit(mps_arena_t); +extern size_t mps_reservoir_available(mps_arena_t); +extern mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *, + mps_ap_t, + size_t); + + +/* Reserve Macros */ +/* .reserve: Keep in sync with impl.c.buffer.reserve. */ + +#define mps_reserve(_p_o, _mps_ap, _size) \ + ((char *)(_mps_ap)->alloc + (_size) > (char *)(_mps_ap)->alloc && \ + (char *)(_mps_ap)->alloc + (_size) <= (char *)(_mps_ap)->limit ? \ + ((_mps_ap)->alloc = \ + (mps_addr_t)((char *)(_mps_ap)->alloc + (_size)), \ + *(_p_o) = (_mps_ap)->init, \ + MPS_RES_OK) : \ + mps_ap_fill(_p_o, _mps_ap, _size)) + + +#define MPS_RESERVE_BLOCK(_res_v, _p_v, _mps_ap, _size) \ + MPS_BEGIN \ + char *_alloc = (char *)(_mps_ap)->alloc; \ + char *_next = _alloc + (_size); \ + if(_next > _alloc && _next <= (char *)(_mps_ap)->limit) { \ + (_mps_ap)->alloc = (mps_addr_t)_next; \ + (_p_v) = (_mps_ap)->init; \ + (_res_v) = MPS_RES_OK; \ + } else \ + (_res_v) = mps_ap_fill(&(_p_v), _mps_ap, _size); \ + MPS_END + + +#define MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(_res_v, _p_v, _mps_ap, _size) \ + MPS_BEGIN \ + char *_alloc = (char *)(_mps_ap)->alloc; \ + char *_next = _alloc + (_size); \ + if(_next > _alloc && _next <= (char *)(_mps_ap)->limit) { \ + (_mps_ap)->alloc = (mps_addr_t)_next; \ + (_p_v) = (_mps_ap)->init; \ + (_res_v) = MPS_RES_OK; \ + } else \ + (_res_v) = mps_ap_fill_with_reservoir_permit(&(_p_v), _mps_ap, _size); \ + MPS_END + + +/* Commit Macros */ +/* .commit: Keep in sync with impl.c.buffer.commit. */ + +#define mps_commit(_mps_ap, _p, _size) \ + ((_mps_ap)->init = (_mps_ap)->alloc, \ + (_mps_ap)->limit != 0 || mps_ap_trip(_mps_ap, _p, _size)) + + +/* Root Creation and Destruction */ + +extern mps_res_t mps_root_create(mps_root_t *, mps_arena_t, mps_rank_t, + mps_rm_t, mps_root_scan_t, + void *, size_t); +extern mps_res_t mps_root_create_table(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, + mps_addr_t *, size_t); +extern mps_res_t mps_root_create_table_masked(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, + mps_addr_t *, size_t, + mps_word_t); +extern mps_res_t mps_root_create_fmt(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, + mps_fmt_scan_t, mps_addr_t, + mps_addr_t); +extern mps_res_t mps_root_create_reg(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, mps_thr_t, + mps_reg_scan_t, void *, size_t); +extern void mps_root_destroy(mps_root_t); + +extern mps_res_t mps_stack_scan_ambig(mps_ss_t, mps_thr_t, + void *, size_t); + + +/* Protection Trampoline and Thread Registration */ + +typedef void *(*mps_tramp_t)(void *, size_t); + +extern void (mps_tramp)(void **, mps_tramp_t, void *, size_t); + +#ifndef mps_tramp /* If a platform-specific version hasn't been defined */ + +#define mps_tramp(r_o, f, p, s) \ + MPS_BEGIN \ + void **_r_o = (r_o); \ + mps_tramp_t _f = (f); \ + void *_p = (p); \ + size_t _s = (s); \ + *_r_o = (*_f)(_p, _s); \ + MPS_END + +#endif + +extern mps_res_t mps_thread_reg(mps_thr_t *, mps_arena_t); +extern void mps_thread_dereg(mps_thr_t); + + +/* Location Dependency */ + +extern void mps_ld_reset(mps_ld_t, mps_arena_t); +extern void mps_ld_add(mps_ld_t, mps_arena_t, mps_addr_t); +extern void mps_ld_merge(mps_ld_t, mps_arena_t, mps_ld_t); +extern mps_bool_t mps_ld_isstale(mps_ld_t, mps_arena_t, mps_addr_t); + +extern mps_word_t mps_collections(mps_arena_t); + + +/* Messages */ + +extern mps_bool_t mps_message_poll(mps_arena_t); +extern void mps_message_type_enable(mps_arena_t, mps_message_type_t); +extern void mps_message_type_disable(mps_arena_t, mps_message_type_t); +extern mps_bool_t mps_message_get(mps_message_t *, + mps_arena_t, mps_message_type_t); +extern void mps_message_discard(mps_arena_t, mps_message_t); +extern mps_bool_t mps_message_queue_type(mps_message_type_t *, mps_arena_t); +extern mps_message_type_t mps_message_type(mps_arena_t, mps_message_t); + +/* Message Type Specific Methods */ + +/* MPS_MESSAGE_TYPE_FINALIZATION */ + +extern void mps_message_finalization_ref(mps_addr_t *, + mps_arena_t, mps_message_t); + +/* MPS_MESSAGE_TYPE_GC */ + +extern size_t mps_message_gc_live_size(mps_arena_t, mps_message_t); + +extern size_t mps_message_gc_condemned_size(mps_arena_t, mps_message_t); + +extern size_t mps_message_gc_not_condemned_size(mps_arena_t, + mps_message_t); + + +/* Finalization */ + +extern mps_res_t mps_finalize(mps_arena_t, mps_addr_t *); +extern void mps_definalize(mps_arena_t, mps_addr_t *); + + +/* Telemetry */ + +extern mps_word_t mps_telemetry_control(mps_word_t, mps_word_t); +extern mps_word_t mps_telemetry_intern(const char *); +extern void mps_telemetry_label(mps_addr_t, mps_word_t); +extern void mps_telemetry_flush(void); + + +/* Heap Walking */ + +typedef void (*mps_formatted_objects_stepper_t)(mps_addr_t, mps_fmt_t, + mps_pool_t, + void *, size_t); +extern void mps_arena_formatted_objects_walk(mps_arena_t, + mps_formatted_objects_stepper_t, + void *, size_t); + + +/* Root Walking */ + +typedef void (*mps_roots_stepper_t)(mps_addr_t *, + mps_root_t, + void *, size_t); +extern void mps_arena_roots_walk(mps_arena_t, + mps_roots_stepper_t, + void *, size_t); + + +/* Fenceposting */ + + +typedef struct mps_pool_debug_option_s { + void* fence_template; + size_t fence_size; +} mps_pool_debug_option_s; + +extern void mps_pool_check_fenceposts(mps_pool_t); + + +/* Scanner Support */ + +extern mps_res_t mps_fix(mps_ss_t, mps_addr_t *); + +#define MPS_SCAN_BEGIN(ss) \ + MPS_BEGIN \ + mps_ss_t _ss = (ss); \ + mps_word_t _mps_w0 = (_ss)->w0; \ + mps_word_t _mps_w1 = (_ss)->w1; \ + mps_word_t _mps_w2 = (_ss)->w2; \ + mps_word_t _mps_wt; \ + { + +#define MPS_FIX1(ss, ref) \ + (_mps_wt = 1uL<<((mps_word_t)(ref)>>_mps_w0&(MPS_WORD_WIDTH-1)), \ + _mps_w2 |= _mps_wt, \ + _mps_w1 & _mps_wt) + +#define MPS_FIX2(ss, ref_io) \ + ((*(ss)->fix)(ss, ref_io)) + +#define MPS_FIX12(ss, ref_io) \ + (MPS_FIX1(ss, *(ref_io)) ? \ + MPS_FIX2(ss, ref_io) : MPS_RES_OK) + +/* MPS_FIX is deprecated */ +#define MPS_FIX(ss, ref_io) MPS_FIX12(ss, ref_io) + +#define MPS_FIX_CALL(ss, call) \ + MPS_BEGIN \ + (call); _mps_w2 |= (ss)->w2; \ + MPS_END + +#define MPS_SCAN_END(ss) \ + } \ + (ss)->w2 = _mps_w2; \ + MPS_END + + +#endif /* mps_h */ diff --git a/mps/code/mpsacl.h b/mps/code/mpsacl.h new file mode 100644 index 00000000000..e881b3e97c7 --- /dev/null +++ b/mps/code/mpsacl.h @@ -0,0 +1,16 @@ +/* impl.h.mpsacl: MEMORY POOL SYSTEM ARENA CLASS "CL" + * + * $HopeName: MMsrc!mpsacl.h(trunk.2) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#ifndef mpsacl_h +#define mpsacl_h + +#include "mps.h" + + +extern mps_arena_class_t mps_arena_class_cl(void); + + +#endif /* mpsacl_h */ diff --git a/mps/code/mpsavm.h b/mps/code/mpsavm.h new file mode 100644 index 00000000000..e37329206a9 --- /dev/null +++ b/mps/code/mpsavm.h @@ -0,0 +1,17 @@ +/* impl.h.mpsavm: MEMORY POOL SYSTEM ARENA CLASS "VM" + * + * $HopeName: MMsrc!mpsavm.h(trunk.3) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#ifndef mpsavm_h +#define mpsavm_h + +#include "mps.h" + + +extern mps_arena_class_t mps_arena_class_vm(void); +extern mps_arena_class_t mps_arena_class_vmnz(void); + + +#endif /* mpsavm_h */ diff --git a/mps/code/mpscamc.h b/mps/code/mpscamc.h new file mode 100644 index 00000000000..8e49b0df1e4 --- /dev/null +++ b/mps/code/mpscamc.h @@ -0,0 +1,19 @@ +/* impl.h.mpscamc: MEMORY POOL SYSTEM CLASS "AMC" + * + * $HopeName: MMsrc!mpscamc.h(trunk.4) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscamc_h +#define mpscamc_h + +#include "mps.h" + +extern mps_class_t mps_class_amc(void); +extern mps_class_t mps_class_amcz(void); + +extern void mps_amc_apply(mps_pool_t, + void (*)(mps_addr_t, void *, size_t), + void *, size_t); + +#endif /* mpscamc_h */ diff --git a/mps/code/mpscams.h b/mps/code/mpscams.h new file mode 100644 index 00000000000..9e629858bd8 --- /dev/null +++ b/mps/code/mpscams.h @@ -0,0 +1,14 @@ +/* impl.h.mpscams: MEMORY POOL SYSTEM CLASS "AMS" + * + * $HopeName: MMsrc!mpscams.h(trunk.2) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscams_h +#define mpscams_h + +#include "mps.h" + +extern mps_class_t mps_class_ams(void); + +#endif /* mpscams_h */ diff --git a/mps/code/mpscawl.h b/mps/code/mpscawl.h new file mode 100644 index 00000000000..5b6b928dde0 --- /dev/null +++ b/mps/code/mpscawl.h @@ -0,0 +1,14 @@ +/* impl.h.mpscaawl: MEMORY POOL SYSTEM CLASS "AWL" + * + * $HopeName: MMsrc!mpscawl.h(trunk.1) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscawl_h +#define mpscawl_h + +#include "mps.h" + +extern mps_class_t mps_class_awl(void); + +#endif /* mpscawl_h */ diff --git a/mps/code/mpsclo.h b/mps/code/mpsclo.h new file mode 100644 index 00000000000..047e3e0b02c --- /dev/null +++ b/mps/code/mpsclo.h @@ -0,0 +1,15 @@ +/* impl.h.mpsclo: MEMORY POOL SYSTEM CLASS "LO" + * + * $HopeName: MMsrc!mpsclo.h(trunk.1) $ + * + * Copyright (C) 1996 Harlequin Limited. All rights reserved. + */ + +#ifndef mpsclo_h +#define mpsclo_h + +#include "mps.h" + +extern mps_class_t mps_class_lo(void); + +#endif /* mpsclo_h */ diff --git a/mps/code/mpscmv.h b/mps/code/mpscmv.h new file mode 100644 index 00000000000..60c533dccd0 --- /dev/null +++ b/mps/code/mpscmv.h @@ -0,0 +1,17 @@ +/* impl.h.mpscmv: MEMORY POOL SYSTEM CLASS "MV" + * + * $HopeName: MMsrc!mpscmv.h(trunk.3) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscmv_h +#define mpscmv_h + +#include "mps.h" + +extern size_t mps_mv_free_size(mps_pool_t mps_pool); +extern size_t mps_mv_size(mps_pool_t mps_pool); +extern mps_class_t mps_class_mv(void); +extern mps_class_t mps_class_mv_debug(void); + +#endif /* mpscmv_h */ diff --git a/mps/code/mpscmv2.h b/mps/code/mpscmv2.h new file mode 100644 index 00000000000..25d05d0b89e --- /dev/null +++ b/mps/code/mpscmv2.h @@ -0,0 +1,35 @@ +/* impl.h.mpscmv2: MEMORY POOL SYSTEM CLASS "MVT" + * + * $HopeName: MMsrc!mpscmv2.h(trunk.2) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscmv2_h +#define mpscmv2_h + +#include "mps.h" + +/* The mvt pool class has five extra parameters to mps_pool_create: + * mps_res_t mps_pool_create(mps_pool_t * pool, mps_arena_t arena, + * mps_class_t mvt_class, + * size_t minimum_size, + * size_t mean_size, + * size_t maximum_size, + * mps_count_t reserve_depth + * mps_count_t fragmentation_limit); + * minimum_, mean_, and maximum_size are the mimimum, mean, and + * maximum (typical) size of objects expected to be allocated in the + * pool. reserve_depth is a measure of the expected hysteresis of the + * object population. fragmentation_limit is a percentage (between 0 + * and 100): if the free space managed by the pool exceeds the + * specified percentage, the pool will resort to a "first fit" + * allocation policy. + */ +extern mps_class_t mps_class_mvt(void); + +/* The mvt pool class supports two extensions to the pool protocol: + size and free_size. */ +extern size_t mps_mvt_free_size(mps_pool_t mps_pool); +extern size_t mps_mvt_size(mps_pool_t mps_pool); + +#endif /* mpscmv2_h */ diff --git a/mps/code/mpscmvff.h b/mps/code/mpscmvff.h new file mode 100644 index 00000000000..ebd1b833076 --- /dev/null +++ b/mps/code/mpscmvff.h @@ -0,0 +1,17 @@ +/* impl.h.mpscmvff: MEMORY POOL SYSTEM CLASS "MVFF" + * + * $HopeName: MMsrc!mpscmvff.h(trunk.3) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscmvff_h +#define mpscmvff_h + +#include "mps.h" + +extern size_t mps_mvff_free_size(mps_pool_t mps_pool); +extern size_t mps_mvff_size(mps_pool_t mps_pool); +extern mps_class_t mps_class_mvff(void); +extern mps_class_t mps_class_mvff_debug(void); + +#endif /* mpscmvff_h */ diff --git a/mps/code/mpscsnc.h b/mps/code/mpscsnc.h new file mode 100644 index 00000000000..75fbf06e7d7 --- /dev/null +++ b/mps/code/mpscsnc.h @@ -0,0 +1,14 @@ +/* impl.h.mpscsnc: MEMORY POOL SYSTEM CLASS "SNC" + * + * $HopeName: MMsrc!mpscsnc.h(trunk.1) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#ifndef mpscsnc_h +#define mpscsnc_h + +#include "mps.h" + +extern mps_class_t mps_class_snc(void); + +#endif /* mpscsnc_h */ diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c new file mode 100644 index 00000000000..c72bf7549b1 --- /dev/null +++ b/mps/code/mpsi.c @@ -0,0 +1,1844 @@ +/* impl.c.mpsi: MEMORY POOL SYSTEM C INTERFACE LAYER + * + * $HopeName: MMsrc!mpsi.c(trunk.78) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .purpose: This code bridges between the MPS interface to C, + * impl.h.mps, and the internal MPM interfaces, as defined by + * impl.h.mpm. .purpose.check: It performs checking of the C client's + * usage of the MPS Interface. .purpose.thread: It excludes multiple + * threads from the MPM by locking the Arena (see .thread-safety). + * + * .design: design.mps.interface.c + * + * + * NOTES + * + * .note.break-out: Take care not to return when "inside" the Arena + * (between ArenaEnter and ArenaLeave) as this will leave the Arena in + * an unsuitable state for re-entry. + * + * + * TRANSGRESSIONS (rule.impl.trans) + * + * .check.protocol: (rule.impl.req) More could be done in this code to + * check that protocols are obeyed by the client. It probably doesn't + * meet checking requirements. + * + * .varargs: (rule.universal.complete) The varargs passed to + * mps_alloc(_v) are ignored at the moment. None of the pool + * implementations use them. + * + * .poll: (rule.universal.complete) Various allocation methods call + * ArenaPoll to allow the MPM to "steal" CPU time and get on with + * background tasks such as incremental GC. + * + * .root-mode: (rule.universal.complete) The root "mode", which + * specifies things like the protectability of roots, is ignored at + * present. This is because the MPM doesn't ever try to protect them. + * In future, it will. + * + * .reg-scan: (rule.universal.complete) At present, we only support + * register scanning using our own ambiguous register and stack scanning + * method, mps_stack_scan_ambig. This may never change, but the way the + * interface is designed allows for the possibility of change. + * + * .naming: (rule.impl.guide) The exported identifiers do not follow the + * normal MPS naming conventions. See design.mps.interface.c.naming. */ + +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" /* only for mps_space_create */ +#include "sac.h" +#include "chain.h" + +SRCID(mpsi, "$HopeName: MMsrc!mpsi.c(trunk.78) $"); + + +/* mpsi_check -- check consistency of interface mappings + * + * .check.purpose: The mpsi_check function attempts to check whether + * the defintions in impl.h.mpsi match the equivalent definition in + * the MPM. It is checking the assumptions made in the other functions + * in this implementation. + * + * .check.empty: Note that mpsi_check compiles away to almost nothing. + * + * .check.enum.cast: enum comparisons have to be cast to avoid a warning + * from the SunPro C compiler. See builder.sc.warn.enum. */ + +static Bool mpsi_check(void) +{ + /* .check.rc: Check that external and internal result codes match. */ + /* See impl.h.mps.result-codes and impl.h.mpmtypes.result-codes. */ + /* Also see .check.enum.cast. */ + CHECKL(CHECKTYPE(mps_res_t, Res)); + CHECKL((int)MPS_RES_OK == (int)ResOK); + CHECKL((int)MPS_RES_FAIL == (int)ResFAIL); + CHECKL((int)MPS_RES_RESOURCE == (int)ResRESOURCE); + CHECKL((int)MPS_RES_MEMORY == (int)ResMEMORY); + CHECKL((int)MPS_RES_LIMIT == (int)ResLIMIT); + CHECKL((int)MPS_RES_UNIMPL == (int)ResUNIMPL); + CHECKL((int)MPS_RES_IO == (int)ResIO); + CHECKL((int)MPS_RES_COMMIT_LIMIT == (int)ResCOMMIT_LIMIT); + + /* Check that external and internal rank numbers match. */ + /* See impl.h.mps.ranks and impl.h.mpmtypes.ranks. */ + /* Also see .check.enum.cast. */ + CHECKL(CHECKTYPE(mps_rank_t, Rank)); + CHECKL((int)MPS_RANK_AMBIG == (int)RankAMBIG); + CHECKL((int)MPS_RANK_EXACT == (int)RankEXACT); + CHECKL((int)MPS_RANK_WEAK == (int)RankWEAK); + + /* The external idea of a word width and the internal one */ + /* had better match. See design.mps.interface.c.cons. */ + CHECKL(sizeof(mps_word_t) == sizeof(void *)); + CHECKL(CHECKTYPE(mps_word_t, Word)); + + /* The external idea of an address and the internal one */ + /* had better match. */ + CHECKL(CHECKTYPE(mps_addr_t, Addr)); + + /* The external idea of size and the internal one had */ + /* better match. See design.mps.interface.c.cons.size */ + /* and design.mps.interface.c.pun.size. */ + CHECKL(CHECKTYPE(size_t, Size)); + + /* Check ap_s/APStruct compatibility by hand */ + /* .check.ap: See impl.h.mps.ap and impl.h.buffer.ap. */ + CHECKL(sizeof(mps_ap_s) == sizeof(APStruct)); + CHECKL(CHECKFIELD(mps_ap_s, init, APStruct, init)); + CHECKL(CHECKFIELD(mps_ap_s, alloc, APStruct, alloc)); + CHECKL(CHECKFIELD(mps_ap_s, limit, APStruct, limit)); + + /* Check sac_s/ExternalSACStruct compatibility by hand */ + /* See impl.h.mps.sac and impl.h.sac.sac. */ + CHECKL(sizeof(mps_sac_s) == sizeof(ExternalSACStruct)); + CHECKL(CHECKFIELD(mps_sac_s, mps_middle, ExternalSACStruct, middle)); + CHECKL(CHECKFIELD(mps_sac_s, mps_trapped, + ExternalSACStruct, trapped)); + CHECKL(CHECKFIELDAPPROX(mps_sac_s, mps_freelists, + ExternalSACStruct, freelists)); + CHECKL(sizeof(mps_sac_freelist_block_s) + == sizeof(SACFreeListBlockStruct)); + CHECKL(CHECKFIELD(mps_sac_freelist_block_s, mps_size, + SACFreeListBlockStruct, size)); + CHECKL(CHECKFIELD(mps_sac_freelist_block_s, mps_count, + SACFreeListBlockStruct, count)); + CHECKL(CHECKFIELD(mps_sac_freelist_block_s, mps_count_max, + SACFreeListBlockStruct, countMax)); + CHECKL(CHECKFIELD(mps_sac_freelist_block_s, mps_blocks, + SACFreeListBlockStruct, blocks)); + + /* Check sac_classes_s/SACClassesStruct compatibility by hand */ + /* See impl.h.mps.sacc and impl.h.sac.sacc. */ + CHECKL(sizeof(mps_sac_classes_s) == sizeof(SACClassesStruct)); + CHECKL(CHECKFIELD(mps_sac_classes_s, mps_block_size, + SACClassesStruct, blockSize)); + CHECKL(CHECKFIELD(mps_sac_classes_s, mps_cached_count, + SACClassesStruct, cachedCount)); + CHECKL(CHECKFIELD(mps_sac_classes_s, mps_frequency, + SACClassesStruct, frequency)); + + /* Check ss_s/ScanStateStruct compatibility by hand */ + /* .check.ss: See impl.h.mps.ss and impl.h.mpmst.ss. */ + /* Note that the size of the mps_ss_s and ScanStateStruct */ + /* are not equal. See impl.h.mpmst.ss. CHECKFIELDAPPROX */ + /* is used on the fix field because its type is punned and */ + /* therefore isn't exactly checkable. See */ + /* design.mps.interface.c.pun.addr. */ + CHECKL(CHECKFIELDAPPROX(mps_ss_s, fix, ScanStateStruct, fix)); + CHECKL(CHECKFIELD(mps_ss_s, w0, ScanStateStruct, zoneShift)); + CHECKL(CHECKFIELD(mps_ss_s, w1, ScanStateStruct, white)); + CHECKL(CHECKFIELD(mps_ss_s, w2, ScanStateStruct, unfixedSummary)); + + /* Check ld_s/LDStruct compatibility by hand */ + /* .check.ld: See also impl.h.mpmst.ld.struct and impl.h.mps.ld */ + CHECKL(sizeof(mps_ld_s) == sizeof(LDStruct)); + CHECKL(CHECKFIELD(mps_ld_s, w0, LDStruct, epoch)); + CHECKL(CHECKFIELD(mps_ld_s, w1, LDStruct, rs)); + + return TRUE; +} + + +/* Ranks + * + * Here a rank returning function is defined for all client visible + * ranks. + * + * .rank.final.not: RankFINAL does not have a corresponding function as + * it is only used internally. */ + +mps_rank_t mps_rank_ambig(void) +{ + return RankAMBIG; +} + +mps_rank_t mps_rank_exact(void) +{ + return RankEXACT; +} + +mps_rank_t mps_rank_weak(void) +{ + return RankWEAK; +} + + +mps_assert_t mps_assert_install(mps_assert_t handler) +{ + AVER(handler != NULL); + return AssertInstall(handler); +} + +mps_assert_t mps_assert_default(void) +{ + return AssertDefault(); +} + + +mps_res_t mps_arena_extend(mps_arena_t mps_arena, + mps_addr_t base, size_t size) +{ + Arena arena = (Arena)mps_arena; + Res res; + + ArenaEnter(arena); + AVER(size > 0); + res = ArenaExtend(arena, (Addr)base, (Size)size); + ArenaLeave(arena); + + return (mps_res_t)res; +} + +size_t mps_arena_reserved(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + size = ArenaReserved(arena); + ArenaLeave(arena); + + return (size_t)size; +} + +/* for backward compatibility */ +size_t mps_space_reserved(mps_space_t mps_space) +{ + return mps_arena_reserved(mps_space); +} + +size_t mps_arena_committed(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + size = ArenaCommitted(arena); + ArenaLeave(arena); + + return (size_t)size; +} + +/* for backward compatibility */ +size_t mps_space_committed(mps_space_t mps_space) +{ + return mps_arena_committed(mps_space); +} + +size_t mps_arena_spare_committed(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + size = ArenaSpareCommitted(arena); + ArenaLeave(arena); + + return (size_t)size; +} + +size_t mps_arena_commit_limit(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + size = ArenaCommitLimit(arena); + ArenaLeave(arena); + + return size; +} + +mps_res_t mps_arena_commit_limit_set(mps_arena_t mps_arena, size_t limit) +{ + Res res; + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + res = ArenaSetCommitLimit(arena, limit); + ArenaLeave(arena); + + return res; +} + +void mps_arena_spare_commit_limit_set(mps_arena_t mps_arena, size_t limit) +{ + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + ArenaSetSpareCommitLimit(arena, limit); + ArenaLeave(arena); + + return; +} + +size_t mps_arena_spare_commit_limit(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + size_t limit; + + ArenaEnter(arena); + limit = ArenaSpareCommitLimit(arena); + ArenaLeave(arena); + + return limit; +} + +void mps_arena_clamp(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + ArenaEnter(arena); + ArenaClamp(ArenaGlobals(arena)); + ArenaLeave(arena); +} + +/* for backward compatibility */ +void mps_space_clamp(mps_space_t mps_space) +{ + mps_arena_clamp(mps_space); +} + + +void mps_arena_release(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + ArenaEnter(arena); + ArenaRelease(ArenaGlobals(arena)); + ArenaLeave(arena); +} + +/* for backward compatibility */ +void mps_space_release(mps_space_t mps_space) +{ + mps_arena_release(mps_space); +} + + +void mps_arena_park(mps_space_t mps_space) +{ + Arena arena = (Arena)mps_space; + ArenaEnter(arena); + ArenaPark(ArenaGlobals(arena)); + ArenaLeave(arena); +} + +/* for backward compatibility */ +void mps_space_park(mps_space_t mps_space) +{ + mps_arena_park(mps_space); +} + + +mps_res_t mps_arena_collect(mps_space_t mps_space) +{ + Res res; + Arena arena = (Arena)mps_space; + ArenaEnter(arena); + res = ArenaCollect(ArenaGlobals(arena)); + ArenaLeave(arena); + return res; +} + +/* for backward compatibility */ +mps_res_t mps_space_collect(mps_space_t mps_space) +{ + return mps_arena_collect(mps_space); +} + + +/* mps_arena_create -- create an arena object */ + +mps_res_t mps_arena_create(mps_arena_t *mps_arena_o, + mps_arena_class_t mps_arena_class, ...) +{ + mps_res_t res; + va_list args; + + va_start(args, mps_arena_class); + res = mps_arena_create_v(mps_arena_o, mps_arena_class, args); + va_end(args); + return res; +} + + +/* mps_arena_create_v -- create an arena object */ + +mps_res_t mps_arena_create_v(mps_arena_t *mps_arena_o, + mps_arena_class_t mps_arena_class, va_list args) +{ + Arena arena; + Res res; + + /* This is the first real call that the client will have to make, */ + /* so check static consistency here. */ + AVER(mpsi_check()); + + AVER(mps_arena_o != NULL); + + res = ArenaCreateV(&arena, (ArenaClass)mps_arena_class, args); + if (res != ResOK) + return res; + + ArenaLeave(arena); + *mps_arena_o = (mps_arena_t)arena; + return MPS_RES_OK; +} + +#ifdef MPS_PROD_DYLAN +mps_res_t mps_space_create(mps_space_t *mps_space_o) +{ + return mps_arena_create(mps_space_o, mps_arena_class_vm(), ARENA_SIZE); +} +#endif + + +/* mps_arena_destroy -- destroy an arena object */ + +void mps_arena_destroy(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + ArenaDestroy(arena); +} + +#ifdef MPS_PROD_DYLAN +void mps_space_destroy(mps_space_t mps_space) +{ + mps_arena_destroy(mps_space); +} +#endif + + +/* mps_fmt_create_A -- create an object format of variant A + * + * .fmt.create.A.purpose: This function converts an object format spec + * of variant "A" into an MPM Format object. See + * design.mps.interface.c.fmt.extend for justification of the way that + * the format structure is declared as "mps_fmt_A". */ + +mps_res_t mps_fmt_create_A(mps_fmt_t *mps_fmt_o, + mps_arena_t mps_arena, + mps_fmt_A_s *mps_fmt_A) +{ + Arena arena = (Arena)mps_arena; + Format format; + Res res; + + ArenaEnter(arena); + + AVER(mps_fmt_A != NULL); + + res = FormatCreate(&format, + arena, + (Align)mps_fmt_A->align, + FormatVarietyA, + (FormatScanMethod)mps_fmt_A->scan, + (FormatSkipMethod)mps_fmt_A->skip, + (FormatMoveMethod)mps_fmt_A->fwd, + (FormatIsMovedMethod)mps_fmt_A->isfwd, + (FormatCopyMethod)mps_fmt_A->copy, + (FormatPadMethod)mps_fmt_A->pad, + NULL, + (Size)0); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_fmt_o = (mps_fmt_t)format; + return MPS_RES_OK; +} + + +/* mps_fmt_create_B -- create an object format of variant B */ + +mps_res_t mps_fmt_create_B(mps_fmt_t *mps_fmt_o, + mps_arena_t mps_arena, + mps_fmt_B_s *mps_fmt_B) +{ + Arena arena = (Arena)mps_arena; + Format format; + Res res; + + ArenaEnter(arena); + + AVER(mps_fmt_B != NULL); + + res = FormatCreate(&format, + arena, + (Align)mps_fmt_B->align, + FormatVarietyB, + (FormatScanMethod)mps_fmt_B->scan, + (FormatSkipMethod)mps_fmt_B->skip, + (FormatMoveMethod)mps_fmt_B->fwd, + (FormatIsMovedMethod)mps_fmt_B->isfwd, + (FormatCopyMethod)mps_fmt_B->copy, + (FormatPadMethod)mps_fmt_B->pad, + (FormatClassMethod)mps_fmt_B->mps_class, + (Size)0); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_fmt_o = (mps_fmt_t)format; + return MPS_RES_OK; +} + + +/* mps_fmt_create_auto_header -- create a format of variant auto_header */ + +mps_res_t mps_fmt_create_auto_header(mps_fmt_t *mps_fmt_o, + mps_arena_t mps_arena, + mps_fmt_auto_header_s *mps_fmt) +{ + Arena arena = (Arena)mps_arena; + Format format; + Res res; + + ArenaEnter(arena); + + AVER(mps_fmt != NULL); + + res = FormatCreate(&format, + arena, + (Align)mps_fmt->align, + FormatVarietyAutoHeader, + (FormatScanMethod)mps_fmt->scan, + (FormatSkipMethod)mps_fmt->skip, + (FormatMoveMethod)mps_fmt->fwd, + (FormatIsMovedMethod)mps_fmt->isfwd, + (FormatCopyMethod)NULL, + (FormatPadMethod)mps_fmt->pad, + NULL, + (Size)mps_fmt->mps_headerSize); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_fmt_o = (mps_fmt_t)format; + return MPS_RES_OK; +} + + +/* mps_fmt_destroy -- destroy a format object */ + +void mps_fmt_destroy(mps_fmt_t mps_fmt) +{ + Format format = (Format)mps_fmt; + Arena arena; + + AVER(CHECKT(Format, format)); + arena = FormatArena(format); + + ArenaEnter(arena); + + FormatDestroy(format); + + ArenaLeave(arena); +} + + +mps_res_t mps_pool_create(mps_pool_t *mps_pool_o, mps_arena_t mps_arena, + mps_class_t mps_class, ...) +{ + mps_res_t res; + va_list args; + va_start(args, mps_class); + res = mps_pool_create_v(mps_pool_o, mps_arena, mps_class, args); + va_end(args); + return res; +} + +mps_res_t mps_pool_create_v(mps_pool_t *mps_pool_o, mps_arena_t mps_arena, + mps_class_t mps_class, va_list args) +{ + Arena arena = (Arena)mps_arena; + Pool pool; + PoolClass class = (PoolClass)mps_class; + Res res; + + ArenaEnter(arena); + + AVER(mps_pool_o != NULL); + AVERT(Arena, arena); + AVERT(PoolClass, class); + + res = PoolCreateV(&pool, arena, class, args); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_pool_o = (mps_pool_t)pool; + return res; +} + +void mps_pool_destroy(mps_pool_t mps_pool) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + PoolDestroy(pool); + + ArenaLeave(arena); +} + + +mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t mps_pool, size_t size, ...) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + Addr p; + Res res; + + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + ArenaPoll(ArenaGlobals(arena)); /* .poll */ + + AVER(p_o != NULL); + AVERT(Pool, pool); + AVER(size > 0); + /* Note: class may allow unaligned size, see */ + /* design.mps.class-interface.alloc.size.align. */ + /* Rest ignored, see .varargs. */ + + /* @@@@ There is currently no requirement for reservoirs to work */ + /* with unbuffered allocation. */ + res = PoolAlloc(&p, pool, size, FALSE); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *p_o = (mps_addr_t)p; + return MPS_RES_OK; +} + + +mps_res_t mps_alloc_v(mps_addr_t *p_o, mps_pool_t mps_pool, size_t size, + va_list args) +{ + mps_res_t res; + + UNUSED(args); /* See .varargs. */ + res = mps_alloc(p_o, mps_pool, size); + return res; +} + + +void mps_free(mps_pool_t mps_pool, mps_addr_t p, size_t size) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + AVERT(Pool, pool); + AVER(PoolHasAddr(pool, p)); + AVER(size > 0); + /* Note: class may allow unaligned size, see */ + /* design.mps.class-interface.alloc.size.align. */ + + PoolFree(pool, (Addr)p, size); + ArenaLeave(arena); +} + + +/* mps_ap_create -- create an allocation point */ + +mps_res_t mps_ap_create(mps_ap_t *mps_ap_o, mps_pool_t mps_pool, ...) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + Buffer buf; + BufferClass bufclass; + Res res; + va_list args; + + AVER(mps_ap_o != NULL); + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + AVERT(Pool, pool); + + va_start(args, mps_pool); + bufclass = PoolDefaultBufferClass(pool); + res = BufferCreateV(&buf, bufclass, pool, TRUE, args); + va_end(args); + + ArenaLeave(arena); + + if (res != ResOK) + return res; + *mps_ap_o = (mps_ap_t)BufferAP(buf); + return MPS_RES_OK; +} + + +/* mps_ap_create_v -- create an allocation point, with varargs */ + +mps_res_t mps_ap_create_v(mps_ap_t *mps_ap_o, mps_pool_t mps_pool, + va_list args) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + Buffer buf; + BufferClass bufclass; + Res res; + + AVER(mps_ap_o != NULL); + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + AVERT(Pool, pool); + + bufclass = PoolDefaultBufferClass(pool); + res = BufferCreateV(&buf, bufclass, pool, TRUE, args); + + ArenaLeave(arena); + + if (res != ResOK) + return res; + *mps_ap_o = (mps_ap_t)BufferAP(buf); + return MPS_RES_OK; +} + +void mps_ap_destroy(mps_ap_t mps_ap) +{ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + + BufferDestroy(buf); + + ArenaLeave(arena); +} + + +/* mps_reserve -- allocate store in preparation for initialization + * + * .reserve.call: mps_reserve does not call BufferReserve, but instead + * uses the in-line macro from impl.h.mps. This is so that it calls + * mps_ap_fill and thence ArenaPoll (.poll). The consistency checks are + * those which can be done outside the MPM. See also .commit.call. */ + +mps_res_t (mps_reserve)(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size) +{ + mps_res_t res; + + AVER(p_o != NULL); + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, BufferOfAP((AP)mps_ap))); + AVER(mps_ap->init == mps_ap->alloc); + AVER(size > 0); + + MPS_RESERVE_BLOCK(res, *p_o, mps_ap, size); + + return res; +} + + + +mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *p_o, + mps_ap_t mps_ap, size_t size) +{ + mps_res_t res; + + AVER(p_o != NULL); + AVER(size > 0); + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, BufferOfAP((AP)mps_ap))); + AVER(mps_ap->init == mps_ap->alloc); + + MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, *p_o, mps_ap, size); + + return res; +} + + + +/* mps_commit -- commit initialized object, finishing allocation + * + * .commit.call: mps_commit does not call BufferCommit, but instead uses + * the in-line commit macro from impl.h.mps. This is so that it calls + * mps_ap_trip and thence ArenaPoll in future (.poll). The consistency + * checks here are the ones which can be done outside the MPM. See also + * .reserve.call. */ + +mps_bool_t (mps_commit)(mps_ap_t mps_ap, mps_addr_t p, size_t size) +{ + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, BufferOfAP((AP)mps_ap))); + AVER(p != NULL); + AVER(size > 0); + AVER(p == mps_ap->init); + AVER((void *)((char *)mps_ap->init + size) == mps_ap->alloc); + + return mps_commit(mps_ap, p, size); +} + + +/* Allocation frame support + * + * These are candidates for being inlineable as macros. + * These functions are easier to maintain, so we'll avoid + * macros for now. */ + + +/* mps_ap_frame_push -- push a new allocation frame + * + * See design.mps.alloc-frame.lw-frame.push. */ + +mps_res_t (mps_ap_frame_push)(mps_frame_t *frame_o, mps_ap_t mps_ap) +{ + AVER(frame_o != NULL); + AVER(mps_ap != NULL); + + /* Fail if between reserve & commit */ + if ((char *)mps_ap->alloc != (char *)mps_ap->init) { + return MPS_RES_FAIL; + } + + if (!mps_ap->lwpoppending) { + /* Valid state for a lightweight push */ + *frame_o = (mps_frame_t)mps_ap->init; + return MPS_RES_OK; + } else { + /* Need a heavyweight push */ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + AllocFrame frame; + Res res; + + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + AVERT(Buffer, buf); + + res = BufferFramePush(&frame, buf); + + if (res == ResOK) { + *frame_o = (mps_frame_t)frame; + } + ArenaLeave(arena); + return (mps_res_t)res; + } +} + +/* mps_ap_frame_pop -- push a new allocation frame + * + * See design.mps.alloc-frame.lw-frame.pop. */ + +mps_res_t (mps_ap_frame_pop)(mps_ap_t mps_ap, mps_frame_t frame) +{ + AVER(mps_ap != NULL); + /* Can't check frame because it's an arbitrary value */ + + /* Fail if between reserve & commit */ + if ((char *)mps_ap->alloc != (char *)mps_ap->init) { + return MPS_RES_FAIL; + } + + if (mps_ap->enabled) { + /* Valid state for a lightweight pop */ + mps_ap->frameptr = (mps_addr_t)frame; /* record pending pop */ + mps_ap->lwpoppending = TRUE; + mps_ap->limit = (mps_addr_t)0; /* trap the buffer */ + return MPS_RES_OK; + + } else { + /* Need a heavyweight pop */ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + Res res; + + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + AVERT(Buffer, buf); + + res = BufferFramePop(buf, (AllocFrame)frame); + + ArenaLeave(arena); + return (mps_res_t)res; + } +} + + +/* mps_ap_fill -- called by mps_reserve when an AP hasn't enough arena + * + * .ap.fill.internal: Note that mps_ap_fill should never be "called" + * directly by the client code. It is invoked by the mps_reserve macro. */ + +mps_res_t mps_ap_fill(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size) +{ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + Addr p; + Res res; + + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + + ArenaPoll(ArenaGlobals(arena)); /* .poll */ + + AVER(p_o != NULL); + AVERT(Buffer, buf); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); + + res = BufferFill(&p, buf, size, FALSE); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *p_o = (mps_addr_t)p; + return MPS_RES_OK; +} + + +mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap, + size_t size) +{ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + Addr p; + Res res; + + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + + ArenaPoll(ArenaGlobals(arena)); /* .poll */ + + AVER(p_o != NULL); + AVERT(Buffer, buf); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); + + res = BufferFill(&p, buf, size, TRUE); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *p_o = (mps_addr_t)p; + return MPS_RES_OK; +} + + +/* mps_ap_trip -- called by mps_commit when an AP is tripped + * + * .ap.trip.internal: Note that mps_ap_trip should never be "called" + * directly by the client code. It is invoked by the mps_commit macro. */ + +mps_bool_t mps_ap_trip(mps_ap_t mps_ap, mps_addr_t p, size_t size) +{ + Buffer buf = BufferOfAP((AP)mps_ap); + Arena arena; + Bool b; + + AVER(mps_ap != NULL); + AVER(CHECKT(Buffer, buf)); + arena = BufferArena(buf); + + ArenaEnter(arena); + + AVERT(Buffer, buf); + AVER(size > 0); + AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); + + b = BufferTrip(buf, (Addr)p, size); + + ArenaLeave(arena); + + return b; +} + + +/* mps_sac_create -- create an SAC object */ + +mps_res_t mps_sac_create(mps_sac_t *mps_sac_o, mps_pool_t mps_pool, + size_t classes_count, mps_sac_classes_s *mps_classes) +{ + Pool pool = (Pool)mps_pool; + Arena arena; + SACClasses classes; + SAC sac; + Res res; + + AVER(mps_sac_o != NULL); + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + classes = (SACClasses)mps_classes; + res = SACCreate(&sac, pool, (Count)classes_count, classes); + + ArenaLeave(arena); + + if (res != ResOK) return (mps_res_t)res; + *mps_sac_o = (mps_sac_t)ExternalSACOfSAC(sac); + return (mps_res_t)res; +} + + +/* mps_sac_destroy -- destroy an SAC object */ + +void mps_sac_destroy(mps_sac_t mps_sac) +{ + SAC sac = SACOfExternalSAC((ExternalSAC)mps_sac); + Arena arena; + + AVER(CHECKT(SAC, sac)); + arena = SACArena(sac); + + ArenaEnter(arena); + + SACDestroy(sac); + + ArenaLeave(arena); +} + + +/* mps_sac_flush -- flush an SAC, releasing all memory held in it */ + +void mps_sac_flush(mps_sac_t mps_sac) +{ + SAC sac = SACOfExternalSAC((ExternalSAC)mps_sac); + Arena arena; + + AVER(CHECKT(SAC, sac)); + arena = SACArena(sac); + + ArenaEnter(arena); + + SACFlush(sac); + + ArenaLeave(arena); +} + + +/* mps_sac_fill -- alloc an object, and perhaps fill the cache */ + +mps_res_t mps_sac_fill(mps_addr_t *p_o, mps_sac_t mps_sac, size_t size, + mps_bool_t has_reservoir_permit) +{ + SAC sac = SACOfExternalSAC((ExternalSAC)mps_sac); + Arena arena; + Addr p; + Res res; + + AVER(p_o != NULL); + AVER(CHECKT(SAC, sac)); + arena = SACArena(sac); + + ArenaEnter(arena); + + res = SACFill(&p, sac, size, (has_reservoir_permit != 0)); + + ArenaLeave(arena); + + if (res != ResOK) return (mps_res_t)res; + *p_o = (mps_addr_t)p; + return (mps_res_t)res; +} + + +/* mps_sac_empty -- free an object, and perhaps empty the cache */ + +void mps_sac_empty(mps_sac_t mps_sac, mps_addr_t p, size_t size) +{ + SAC sac = SACOfExternalSAC((ExternalSAC)mps_sac); + Arena arena; + + AVER(CHECKT(SAC, sac)); + arena = SACArena(sac); + + ArenaEnter(arena); + + SACEmpty(sac, (Addr)p, (Size)size); + + ArenaLeave(arena); +} + + +/* mps_sac_alloc -- alloc an object, using cached space if possible */ + +mps_res_t mps_sac_alloc(mps_addr_t *p_o, mps_sac_t mps_sac, size_t size, + mps_bool_t has_reservoir_permit) +{ + Res res; + + AVER(p_o != NULL); + AVER(CHECKT(SAC, SACOfExternalSAC((ExternalSAC)mps_sac))); + AVER(size > 0); + + MPS_SAC_ALLOC_FAST(res, *p_o, mps_sac, size, (has_reservoir_permit != 0)); + return res; +} + + +/* mps_sac_free -- free an object, to the cache if possible */ + +void mps_sac_free(mps_sac_t mps_sac, mps_addr_t p, size_t size) +{ + AVER(CHECKT(SAC, SACOfExternalSAC((ExternalSAC)mps_sac))); + /* Can't check p outside arena lock */ + AVER(size > 0); + + MPS_SAC_FREE_FAST(mps_sac, p, size); +} + + +/* Roots */ + + +mps_res_t mps_root_create(mps_root_t *mps_root_o, mps_arena_t mps_arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_root_scan_t mps_root_scan, void *p, size_t s) +{ + Arena arena = (Arena)mps_arena; + Rank rank = (Rank)mps_rank; + Root root; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(mps_rm == (mps_rm_t)0); + + /* See .root-mode. */ + res = RootCreateFun(&root, arena, rank, + (RootScanMethod)mps_root_scan, p, s); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + +mps_res_t mps_root_create_table(mps_root_t *mps_root_o, mps_arena_t mps_arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_addr_t *base, size_t size) +{ + Arena arena = (Arena)mps_arena; + Rank rank = (Rank)mps_rank; + Root root; + RootMode mode = (RootMode)mps_rm; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(base != NULL); + AVER(size > 0); + + /* .root.table-size: size is the length of the array at base, not */ + /* the size in bytes. However, RootCreateTable expects base and */ + /* limit pointers. Be careful. */ + + res = RootCreateTable(&root, arena, rank, mode, + (Addr *)base, (Addr *)base + size); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + +mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o, + mps_arena_t mps_arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_addr_t *base, size_t size, + mps_word_t mask) +{ + Arena arena = (Arena)mps_arena; + Rank rank = (Rank)mps_rank; + Root root; + RootMode mode = (RootMode)mps_rm; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(base != NULL); + AVER(size > 0); + /* Can't check anything about mask */ + + /* See .root.table-size. */ + + res = RootCreateTableMasked(&root, arena, rank, mode, + (Addr *)base, (Addr *)base + size, + mask); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + +mps_res_t mps_root_create_fmt(mps_root_t *mps_root_o, mps_arena_t mps_arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_fmt_scan_t mps_fmt_scan, + mps_addr_t base, mps_addr_t limit) +{ + Arena arena = (Arena)mps_arena; + Rank rank = (Rank)mps_rank; + FormatScanMethod scan = (FormatScanMethod)mps_fmt_scan; + Root root; + RootMode mode = (RootMode)mps_rm; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + + res = RootCreateFmt(&root, arena, rank, mode, scan, (Addr)base, (Addr)limit); + + ArenaLeave(arena); + if (res != ResOK) return res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + +mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t mps_arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_thr_t mps_thr, mps_reg_scan_t mps_reg_scan, + void *reg_scan_p, size_t mps_size) +{ + Arena arena = (Arena)mps_arena; + Rank rank = (Rank)mps_rank; + Thread thread = (Thread)mps_thr; + Root root; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(mps_reg_scan != NULL); + AVER(mps_reg_scan == mps_stack_scan_ambig); /* .reg.scan */ + AVER(reg_scan_p != NULL); /* stackBot */ + AVER(rank == MPS_RANK_AMBIG); + AVER(mps_rm == (mps_rm_t)0); + + /* See .root-mode. */ + res = RootCreateReg(&root, arena, rank, thread, + (RootScanRegMethod)mps_reg_scan, + reg_scan_p, mps_size); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + + +/* mps_stack_scan_ambig -- scan the thread state ambiguously + * + * See .reg-scan. */ + +mps_res_t mps_stack_scan_ambig(mps_ss_t mps_ss, + mps_thr_t mps_thr, void *p, size_t s) +{ + ScanState ss = (ScanState)mps_ss; + Thread thread = (Thread)mps_thr; + + UNUSED(s); + return ThreadScan(ss, thread, p); +} + + +void mps_root_destroy(mps_root_t mps_root) +{ + Root root = (Root)mps_root; + Arena arena; + + arena = RootArena(root); + + ArenaEnter(arena); + + RootDestroy(root); + + ArenaLeave(arena); +} + + +void (mps_tramp)(void **r_o, + void *(*f)(void *p, size_t s), + void *p, size_t s) +{ + AVER(r_o != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + ProtTramp(r_o, f, p, s); +} + + +mps_res_t mps_thread_reg(mps_thr_t *mps_thr_o, mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Thread thread; + Res res; + + ArenaEnter(arena); + + AVER(mps_thr_o != NULL); + AVERT(Arena, arena); + + res = ThreadRegister(&thread, arena); + + ArenaLeave(arena); + + if (res != ResOK) return res; + *mps_thr_o = (mps_thr_t)thread; + return MPS_RES_OK; +} + +void mps_thread_dereg(mps_thr_t mps_thr) +{ + Thread thread = (Thread)mps_thr; + Arena arena; + + AVER(ThreadCheckSimple(thread)); + arena = ThreadArena(thread); + + ArenaEnter(arena); + + ThreadDeregister(thread, arena); + + ArenaLeave(arena); +} + +void mps_ld_reset(mps_ld_t mps_ld, mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + LD ld = (LD)mps_ld; + + ArenaEnter(arena); + + LDReset(ld, arena); + + ArenaLeave(arena); +} + + +/* mps_ld_add -- add a reference to a location dependency + * + * See design.mps.interface.c.lock-free. */ + +void mps_ld_add(mps_ld_t mps_ld, mps_arena_t mps_arena, mps_addr_t addr) +{ + Arena arena = (Arena)mps_arena; + LD ld = (LD)mps_ld; + + LDAdd(ld, arena, (Addr)addr); +} + + +/* mps_ld_merge -- merge two location dependencies + * + * See design.mps.interface.c.lock-free. */ + +void mps_ld_merge(mps_ld_t mps_ld, mps_arena_t mps_arena, + mps_ld_t mps_from) +{ + Arena arena = (Arena)mps_arena; + LD ld = (LD)mps_ld; + LD from = (LD)mps_from; + + LDMerge(ld, arena, from); +} + + +/* mps_ld_isstale -- check whether a location dependency is "stale" + * + * See design.mps.interface.c.lock-free. */ + +mps_bool_t mps_ld_isstale(mps_ld_t mps_ld, mps_arena_t mps_arena, + mps_addr_t addr) +{ + Arena arena = (Arena)mps_arena; + LD ld = (LD)mps_ld; + Bool b; + + b = LDIsStale(ld, arena, (Addr)addr); + + return (mps_bool_t)b; +} + +mps_res_t mps_fix(mps_ss_t mps_ss, mps_addr_t *ref_io) +{ + mps_res_t res; + + MPS_SCAN_BEGIN(mps_ss) { + res = MPS_FIX(mps_ss, ref_io); + } MPS_SCAN_END(mps_ss); + + return res; +} + +mps_word_t mps_collections(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + return ArenaEpoch(arena); /* thread safe: see impl.h.arena.epoch.ts */ +} + + +/* mps_finalize -- register for finalize */ + +mps_res_t mps_finalize(mps_arena_t mps_arena, mps_addr_t *refref) +{ + Res res; + Addr object; + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + + object = (Addr)ArenaPeek(arena, (Addr)refref); + res = ArenaFinalize(arena, object); + + ArenaLeave(arena); + return res; +} + +void mps_definalize(mps_arena_t arena, mps_addr_t *refref) +{ + /* Not yet implemented */ + UNUSED(arena); UNUSED(refref); + NOTREACHED; +} + + +/* Messages */ + + +mps_bool_t mps_message_poll(mps_arena_t mps_arena) +{ + Bool b; + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + + b = MessagePoll(arena); + + ArenaLeave(arena); + return b; +} + + +mps_message_type_t mps_message_type(mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + MessageType type; + + ArenaEnter(arena); + + type = MessageGetType(message); + + ArenaLeave(arena); + + return (mps_message_type_t)type; +} + +void mps_message_discard(mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + + ArenaEnter(arena); + + MessageDiscard(arena, message); + + ArenaLeave(arena); +} + +void mps_message_type_enable(mps_arena_t mps_arena, + mps_message_type_t mps_type) +{ + Arena arena = (Arena)mps_arena; + MessageType type = (MessageType)mps_type; + + ArenaEnter(arena); + + MessageTypeEnable(arena, type); + + ArenaLeave(arena); +} + +void mps_message_type_disable(mps_arena_t mps_arena, + mps_message_type_t mps_type) +{ + Arena arena = (Arena)mps_arena; + MessageType type = (MessageType)mps_type; + + ArenaEnter(arena); + + MessageTypeDisable(arena, type); + + ArenaLeave(arena); +} + +mps_bool_t mps_message_get(mps_message_t *mps_message_return, + mps_arena_t mps_arena, + mps_message_type_t mps_type) +{ + Bool b; + Arena arena = (Arena)mps_arena; + MessageType type = (MessageType)mps_type; + Message message; + + ArenaEnter(arena); + + b = MessageGet(&message, arena, type); + + ArenaLeave(arena); + if (b) { + *mps_message_return = (mps_message_t)message; + } + return b; +} + +mps_bool_t mps_message_queue_type(mps_message_type_t *mps_message_type_return, + mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + MessageType type; + Bool b; + + ArenaEnter(arena); + + b = MessageQueueType(&type, arena); + + ArenaLeave(arena); + if (b) { + *mps_message_type_return = (mps_message_type_t)type; + } + return b; +} + + +/* Message-Type-Specific Methods */ + +/* MPS_MESSAGE_TYPE_FINALIZATION */ + +void mps_message_finalization_ref(mps_addr_t *mps_addr_return, + mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + Ref ref; + + AVER(mps_addr_return != NULL); + + ArenaEnter(arena); + + AVERT(Arena, arena); + MessageFinalizationRef(&ref, arena, message); + ArenaPoke(arena, (Addr)mps_addr_return, ref); + + ArenaLeave(arena); +} + +/* MPS_MESSAGE_TYPE_GC */ + +size_t mps_message_gc_live_size(mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + Size size; + + ArenaEnter(arena); + + AVERT(Arena, arena); + size = MessageGCLiveSize(message); + + ArenaLeave(arena); + return (size_t)size; +} + +size_t mps_message_gc_condemned_size(mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + Size size; + + ArenaEnter(arena); + + AVERT(Arena, arena); + size = MessageGCCondemnedSize(message); + + ArenaLeave(arena); + return (size_t)size; +} + +size_t mps_message_gc_not_condemned_size(mps_arena_t mps_arena, + mps_message_t mps_message) +{ + Arena arena = (Arena)mps_arena; + Message message = (Message)mps_message; + Size size; + + ArenaEnter(arena); + + AVERT(Arena, arena); + size = MessageGCNotCondemnedSize(message); + + ArenaLeave(arena); + return (size_t)size; +} + + +/* Telemetry */ + +mps_word_t mps_telemetry_control(mps_word_t resetMask, mps_word_t flipMask) +{ + /* Doesn't require locking and isn't arena-specific. */ + return EventControl((Word)resetMask, (Word)flipMask); +} + +mps_word_t mps_telemetry_intern(const char *label) +{ + AVER(label != NULL); + return (mps_word_t)EventInternString(label); +} + +void mps_telemetry_label(mps_addr_t addr, mps_word_t intern_id) +{ + EventLabelAddr((Addr)addr, (Word)intern_id); +} + +void mps_telemetry_flush(void) +{ + /* Telemetry does its own concurrency control, so none here. */ + (void)EventSync(); +} + + +/* Allocation Patterns */ + + +mps_alloc_pattern_t mps_alloc_pattern_ramp(void) +{ + return (mps_alloc_pattern_t)AllocPatternRamp(); +} + +mps_alloc_pattern_t mps_alloc_pattern_ramp_collect_all(void) +{ + return (mps_alloc_pattern_t)AllocPatternRampCollectAll(); +} + + +/* mps_ap_alloc_pattern_begin -- signal start of an allocation pattern + * + * .ramp.hack: There are only two allocation patterns, both ramps. So + * we assume it's a ramp, and call BufferRampBegin/End directly, without + * dispatching. No point in creating a mechanism for that. */ + +mps_res_t mps_ap_alloc_pattern_begin(mps_ap_t mps_ap, + mps_alloc_pattern_t alloc_pattern) +{ + Buffer buf; + Arena arena; + + AVER(mps_ap != NULL); + buf = BufferOfAP((AP)mps_ap); + AVER(CHECKT(Buffer, buf)); + + arena = BufferArena(buf); + ArenaEnter(arena); + + BufferRampBegin(buf, (AllocPattern)alloc_pattern); + + ArenaLeave(arena); + return MPS_RES_OK; +} + + +mps_res_t mps_ap_alloc_pattern_end(mps_ap_t mps_ap, + mps_alloc_pattern_t alloc_pattern) +{ + Buffer buf; + Arena arena; + Res res; + + AVER(mps_ap != NULL); + buf = BufferOfAP((AP)mps_ap); + AVER(CHECKT(Buffer, buf)); + UNUSED(alloc_pattern); /* .ramp.hack */ + + arena = BufferArena(buf); + ArenaEnter(arena); + + res = BufferRampEnd(buf); + ArenaPoll(ArenaGlobals(arena)); /* .poll */ + + ArenaLeave(arena); + return res; +} + + +mps_res_t mps_ap_alloc_pattern_reset(mps_ap_t mps_ap) +{ + Buffer buf; + Arena arena; + + AVER(mps_ap != NULL); + buf = BufferOfAP((AP)mps_ap); + AVER(CHECKT(Buffer, buf)); + + arena = BufferArena(buf); + ArenaEnter(arena); + + BufferRampReset(buf); + ArenaPoll(ArenaGlobals(arena)); /* .poll */ + + ArenaLeave(arena); + return MPS_RES_OK; +} + + +/* Low memory reservoir */ + + +/* mps_reservoir_limit_set -- set the reservoir size */ + +void mps_reservoir_limit_set(mps_arena_t mps_arena, size_t size) +{ + Arena arena = (Arena)mps_arena; + + ArenaEnter(arena); + ReservoirSetLimit(ArenaReservoir(arena), size); + ArenaLeave(arena); +} + + +/* mps_reservoir_limit -- return the reservoir size */ + +size_t mps_reservoir_limit(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + + size = ReservoirLimit(ArenaReservoir(arena)); + + ArenaLeave(arena); + return size; +} + + +/* mps_reservoir_available -- return memory available in the reservoir */ + +size_t mps_reservoir_available(mps_arena_t mps_arena) +{ + Arena arena = (Arena)mps_arena; + Size size; + + ArenaEnter(arena); + + size = ReservoirAvailable(ArenaReservoir(arena)); + + ArenaLeave(arena); + return size; +} + + +/* Chains */ + + +/* mps_chain_create -- create a chain */ + +mps_res_t mps_chain_create(mps_chain_t *chain_o, mps_arena_t mps_arena, + size_t gen_count, mps_gen_param_s *params) +{ + Arena arena = (Arena)mps_arena; + Chain chain; + Res res; + + ArenaEnter(arena); + + AVER(gen_count > 0); + res = ChainCreate(&chain, arena, gen_count, (GenParamStruct *)params); + + ArenaLeave(arena); + if (res != ResOK) return res; + *chain_o = (mps_chain_t)chain; + return MPS_RES_OK; +} + + +/* mps_chain_destroy -- destroy a chain */ + +void mps_chain_destroy(mps_chain_t mps_chain) +{ + Arena arena; + Chain chain = (Chain)mps_chain; + + AVER(CHECKT(Chain, chain)); + arena = chain->arena; + + ArenaEnter(arena); + ChainDestroy(chain); + ArenaLeave(arena); +} diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c new file mode 100644 index 00000000000..2880e3c8380 --- /dev/null +++ b/mps/code/mpsicv.c @@ -0,0 +1,430 @@ +/* impl.c.mpsicv: MPSI COVERAGE TEST + * + * $HopeName: MMsrc!mpsicv.c(trunk.19) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + */ + +#include "testlib.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "mpscmv.h" +#include "fmtdy.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include +#include +#include + + +#define exactRootsCOUNT 49 +#define ambigRootsCOUNT 49 +#define OBJECTS 4000 +#define patternFREQ 100 + +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) +#define FILLER_OBJECT_SIZE 1023 + +#define genCOUNT 2 +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +static mps_pool_t amcpool; +static mps_ap_t ap; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; + + +/* Types for alignment tests */ + +#define hasLONG_LONG 1 + +#ifdef _MSC_VER +#define long_long_t __int64 +#else +#define long_long_t long long +#endif + +struct tdouble { + double d; +}; + +struct tlong { + long d; +}; + +#ifdef HAS_LONG_LONG +struct tlonglong { + long_long_t d; +}; +#endif + + +/* alignmentTest -- test default alignment is acceptable */ + +#define max(a, b) (((a) > (b)) ? (a) : (b)) + +static void alignmentTest(mps_arena_t arena) +{ + mps_pool_t pool; + void *p; + int dummy = 0; + size_t j, size; + + die(mps_pool_create(&pool, arena, mps_class_mv(), 0x1000, 1024, 16384), + "alignment pool create"); + size = max(sizeof(double), sizeof(long)); +#ifdef HAS_LONG_LONG + size = max(size, sizeof(long_long_t)); +#endif + for(j = 0; j <= size + (size_t)1; ++j) { + die(mps_alloc(&p, pool, size + 1), "alignment alloc"); + +#define access(type, p) *(type*)(p) = (type)dummy; dummy += (int)*(type*)(p); + + access(double, p); + access(long, p); +#ifdef HAS_LONG_LONG + access(long_long_t, p); +#endif + } + mps_pool_destroy(pool); +} + + +/* make -- allocate an object */ + +static mps_addr_t make(void) +{ + size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size); + if (res != MPS_RES_OK) die(res, "MPS_RESERVE_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if (res != MPS_RES_OK) die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + return p; +} + + +/* make_with_permit -- allocate an object, with reservoir permit */ + +static mps_addr_t make_with_permit(void) +{ + size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, p, ap, size); + if (res != MPS_RES_OK) die(res, "MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if (res != MPS_RES_OK) die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + return p; +} + + +/* make_no_inline -- allocate an object, using non-inlined interface */ + +static mps_addr_t make_no_inline(void) +{ + size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + res = (mps_reserve)(&p, ap, size); + if (res != MPS_RES_OK) die(res, "(mps_reserve)"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if (res != MPS_RES_OK) die(res, "dylan_init"); + } while(!(mps_commit)(ap, p, size)); + + return p; +} + + +/* alloc_v_test -- test mps_alloc_v */ + +static void alloc_v_test(mps_pool_t pool, ...) +{ + void *p; + size_t size = 32; + va_list args; + + va_start(args, pool); + die(mps_alloc_v(&p, pool, size, args), "alloc_v"); + va_end(args); + mps_free(pool, p, size); +} + + +static void pool_create_v_test(mps_arena_t arena, ...) +{ + va_list args; + + va_start(args, arena); + die(mps_pool_create_v(&amcpool, arena, mps_class_amc(), args), + "pool_create_v(amc)"); + va_end(args); +} + +static void ap_create_v_test(mps_pool_t pool, ...) +{ + mps_ap_t apt; + va_list args; + + va_start(args, pool); + die(mps_ap_create_v(&apt, pool, args), "ap_create_v"); + va_end(args); + mps_ap_destroy(apt); +} + + +static mps_res_t root_single(mps_ss_t ss, void *p, size_t s) +{ + testlib_unused(s); + return mps_fix(ss, (mps_addr_t *)p); +} + + +/* arena_commit_test + * + * intended to test: + * MPS_RES_COMMIT_LIMIT + * mps_arena_commit_limit + * mps_arena_commit_limit_set + * mps_arena_committed + * mps_arena_reserved + * incidentally tests: + * mps_alloc + * mps_class_mv + * mps_pool_create + * mps_pool_destroy + */ + +static void arena_commit_test(mps_arena_t arena) +{ + mps_pool_t pool; + size_t committed; + size_t reserved; + size_t limit; + void *p; + mps_res_t res; + + committed = mps_arena_committed(arena); + reserved = mps_arena_reserved(arena); + cdie(reserved >= committed, "reserved < committed"); + die(mps_pool_create(&pool, arena, mps_class_mv(), 0x1000, 1024, 16384), + "commit pool create"); + limit = mps_arena_commit_limit(arena); + mps_arena_commit_limit_set(arena, committed); + do { + res = mps_alloc(&p, pool, FILLER_OBJECT_SIZE); + } while (res == MPS_RES_OK); + die_expect(res, MPS_RES_COMMIT_LIMIT, "Commit limit allocation"); + mps_arena_commit_limit_set(arena, limit); + res = mps_alloc(&p, pool, FILLER_OBJECT_SIZE); + die_expect(res, MPS_RES_OK, "Allocation failed after raising commit_limit"); + mps_pool_destroy(pool); +} + + +/* reservoir_test -- Test the reservoir interface + * + * This has not been tuned to actually dip into the reservoir. See + * QA test 132 for that. + */ + +#define reservoirSIZE ((size_t)128 * 1024) + +static void reservoir_test(mps_arena_t arena) +{ + (void)make_with_permit(); + cdie(mps_reservoir_available(arena) == 0, "empty reservoir"); + cdie(mps_reservoir_limit(arena) == 0, "no reservoir"); + mps_reservoir_limit_set(arena, reservoirSIZE); + cdie(mps_reservoir_limit(arena) >= reservoirSIZE, "reservoir limit set"); + cdie(mps_reservoir_available(arena) >= reservoirSIZE, "got reservoir"); + (void)make_with_permit(); + mps_reservoir_limit_set(arena, 0); + cdie(mps_reservoir_available(arena) == 0, "empty reservoir"); + cdie(mps_reservoir_limit(arena) == 0, "no reservoir"); + (void)make_with_permit(); +} + + +static void *test(void *arg, size_t s) +{ + mps_arena_t arena; + mps_fmt_t format; + mps_chain_t chain; + mps_root_t exactRoot, ambigRoot, singleRoot, fmtRoot; + unsigned long i; + size_t j; + mps_word_t collections; + mps_pool_t mv; + mps_addr_t alloced_obj; + size_t asize = 32; /* size of alloced obj */ + mps_addr_t obj; + mps_ld_s ld; + mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp(); + + arena = (mps_arena_t)arg; + testlib_unused(s); + + die(dylan_fmt(&format, arena), "fmt_create"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + + die(mps_pool_create(&mv, arena, mps_class_mv(), 0x10000, 32, 0x10000), + "pool_create(mv)"); + + pool_create_v_test(arena, format, chain); /* creates amc pool */ + + ap_create_v_test(amcpool); + + die(mps_ap_create(&ap, amcpool), "ap_create"); + + for(j = 0; j < exactRootsCOUNT; ++j) + exactRoots[j] = objNULL; + for(j = 0; j < ambigRootsCOUNT; ++j) + ambigRoots[j] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); + + obj = objNULL; + + die(mps_root_create(&singleRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &root_single, &obj, 0), + "root_create(single)"); + + /* test non-inlined reserve/commit */ + obj = make_no_inline(); + + die(mps_alloc(&alloced_obj, mv, asize), "mps_alloc"); + die(dylan_init(alloced_obj, asize, exactRoots, exactRootsCOUNT), + "dylan_init(alloced_obj)"); + + die(mps_root_create_fmt(&fmtRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + dylan_fmt_A()->scan, + alloced_obj, + (mps_addr_t)(((char*)alloced_obj)+asize)), + "root_create_fmt"); + + mps_ld_reset(&ld, arena); + mps_ld_add(&ld, arena, obj); + + if (mps_ld_isstale(&ld, arena, obj)) { + mps_ld_reset(&ld, arena); + mps_ld_add(&ld, arena, obj); + } + + collections = mps_collections(arena); + + for(i = 0; i < OBJECTS; ++i) { + unsigned c; + size_t r; + + c = mps_collections(arena); + + if (collections != c) { + collections = c; + printf("\nCollection %u, %lu objects.\n", c, i); + for(r = 0; r < exactRootsCOUNT; ++r) + cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]), + "all roots check"); + } + + if (rnd() % patternFREQ == 0) + switch(rnd() % 4) { + case 0: case 1: mps_ap_alloc_pattern_begin(ap, ramp); break; + case 2: mps_ap_alloc_pattern_end(ap, ramp); break; + case 3: mps_ap_alloc_pattern_reset(ap); break; + } + + if (rnd() & 1) + exactRoots[rnd() % exactRootsCOUNT] = make(); + else + ambigRoots[rnd() % ambigRootsCOUNT] = make(); + + r = rnd() % exactRootsCOUNT; + if (exactRoots[r] != objNULL) + cdie(dylan_check(exactRoots[r]), "random root check"); + } + + arena_commit_test(arena); + reservoir_test(arena); + alignmentTest(arena); + + mps_arena_collect(arena); + + mps_free(mv, alloced_obj, 32); + alloc_v_test(mv); + mps_pool_destroy(mv); + mps_ap_destroy(ap); + mps_root_destroy(fmtRoot); + mps_root_destroy(singleRoot); + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_pool_destroy(amcpool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); + + return NULL; +} + + +#define TEST_ARENA_SIZE ((size_t)16<<20) + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + mps_root_t reg_root; + void *r; + void *marker = ▮ + + randomize(argc, argv); + + (void)mps_assert_install(mps_assert_default()); + die(mps_arena_create(&arena, mps_arena_class_vm(), TEST_ARENA_SIZE), + "arena_create"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + + die(mps_root_create_reg(®_root, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + thread, &mps_stack_scan_ambig, + marker, (size_t)0), + "root_create_reg"); + + (mps_tramp)(&r, test, arena, 0); /* non-inlined trampoline */ + mps_tramp(&r, test, arena, 0); + mps_root_destroy(reg_root); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/mpsio.h b/mps/code/mpsio.h new file mode 100644 index 00000000000..3eae6ecaa86 --- /dev/null +++ b/mps/code/mpsio.h @@ -0,0 +1,25 @@ +/* impl.h.mpsio: HARLEQUIN MEMORY POOL SYSTEM I/O INTERFACE + * + * $HopeName: MMsrc!mpsio.h(trunk.2) $ + * Copyright (C) 1996 Harlequin Limited. All rights reserved. + * + * .readership: For MPS client application developers, MPS developers. + * .sources: design.mps.io + */ + +#ifndef mpsio_h +#define mpsio_h + +#include "mps.h" /* for mps_res_t */ + + +typedef struct mps_io_s *mps_io_t; + +extern mps_res_t mps_io_create(mps_io_t *); +extern void mps_io_destroy(mps_io_t); + +extern mps_res_t mps_io_write(mps_io_t, void *, size_t); +extern mps_res_t mps_io_flush(mps_io_t); + + +#endif /* mpsio_h */ diff --git a/mps/code/mpsioan.c b/mps/code/mpsioan.c new file mode 100644 index 00000000000..556adbe5adb --- /dev/null +++ b/mps/code/mpsioan.c @@ -0,0 +1,87 @@ +/* impl.c.mpsioan: HARLEQUIN MEMORY POOL SYSTEM I/O IMPLEMENTATION (ANSI) + * + * $HopeName: MMsrc!mpsioan.c(trunk.4) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .readership: For MPS client application developers and MPS developers. + * .sources: design.mps.io + */ + +#include "mpsio.h" + +#include "mpstd.h" + +#ifdef MPS_OS_SU + +extern int fclose (FILE *stream); +extern int fflush (FILE *stream); +extern size_t fwrite (const void *ptr, size_t size, size_t nmemb, FILE *stream); + +/* These functions are used in the macro definitions of putc and getc + * but not declared in stdio.h. + */ +extern int _filbuf(FILE *stream); +extern int _flsbuf(unsigned char c, FILE *stream); + +#endif + +#ifdef MPS_OS_XC +#include "osxc.h" +#endif + +#include +#include "config.h" /* to get platform configurations */ + + +static FILE *ioFile = NULL; + + +mps_res_t mps_io_create(mps_io_t *mps_io_r) +{ + FILE *f; + + if(ioFile != NULL) /* See impl.c.event.trans.log */ + return MPS_RES_LIMIT; /* Cannot currently open more than one log */ + + f = fopen("mpsio.log", "wb"); + if(f == NULL) + return MPS_RES_IO; + + *mps_io_r = (mps_io_t)f; + ioFile = f; + return MPS_RES_OK; +} + + +void mps_io_destroy(mps_io_t mps_io) +{ + FILE *f = (FILE *)mps_io; + ioFile = NULL; /* Should check f == ioFile */ + (void)fclose(f); +} + + +mps_res_t mps_io_write(mps_io_t mps_io, void *buf, size_t size) +{ + FILE *f = (FILE *)mps_io; /* Should check f == ioFile */ + size_t n; + + n = fwrite(buf, size, 1, f); + if(n != 1) + return MPS_RES_IO; + + return MPS_RES_OK; +} + + +mps_res_t mps_io_flush(mps_io_t mps_io) +{ + FILE *f = (FILE *)mps_io; /* Should check f == ioFile */ + int e; + + e = fflush(f); + if(e == EOF) + return MPS_RES_IO; + + return MPS_RES_OK; +} diff --git a/mps/code/mpsiw3.c b/mps/code/mpsiw3.c new file mode 100644 index 00000000000..2d8fcfd8023 --- /dev/null +++ b/mps/code/mpsiw3.c @@ -0,0 +1,32 @@ +/* impl.c.mpsint: + * + * WIN32 MEMORY POOL SYSTEM INTERFACE LAYER EXTRAS + * + * $HopeName: MMsrc!mpsiw3.c(trunk.3) $ + * + * Copyright (C) 1996, 1997 Harlequin Group, all rights reserved + */ + +#include "mpm.h" +#include "mps.h" + +#include "mpswin.h" + +SRCID(mpsint, "$HopeName: MMsrc!mpsiw3.c(trunk.3) $"); + +/* This is defined in protnt.c */ +extern LONG ProtSEHfilter(LPEXCEPTION_POINTERS info); + +LONG mps_SEH_filter(LPEXCEPTION_POINTERS info, + void **hp_o, size_t *hs_o) +{ + UNUSED(hp_o); + UNUSED(hs_o); + return ProtSEHfilter(info); +} + +void mps_SEH_handler(void *p, size_t s) +{ + UNUSED(p); UNUSED(s); + NOTREACHED; +} diff --git a/mps/code/mpslib.h b/mps/code/mpslib.h new file mode 100644 index 00000000000..b9570e977a8 --- /dev/null +++ b/mps/code/mpslib.h @@ -0,0 +1,48 @@ +/* impl.h.mpslib: HARLEQUIN MEMORY POOL SYSTEM LIBRARY INTERFACE + * + * $HopeName: MMsrc!mpslib.h(trunk.8) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .readership: MPS client application developers, MPS developers. + * .sources: design.mps.lib + * + * .purpose: The purpose of this file is to declare the functions and types + * required for the MPS library interface. + */ + +#ifndef mpslib_h +#define mpslib_h + +#include + + +extern int mps_lib_get_EOF(void); +#define mps_lib_EOF (mps_lib_get_EOF()) + +typedef struct mps_lib_stream_s mps_lib_FILE; + +extern mps_lib_FILE *mps_lib_get_stderr(void); +extern mps_lib_FILE *mps_lib_get_stdout(void); +#define mps_lib_stderr (mps_lib_get_stderr()) +#define mps_lib_stdout (mps_lib_get_stdout()) + +extern int mps_lib_fputc(int, mps_lib_FILE *); +extern int mps_lib_fputs(const char *, mps_lib_FILE *); + + +extern void mps_lib_abort(void); + + +extern void *(mps_lib_memset)(void *, int, size_t); +extern void *(mps_lib_memcpy)(void *, const void *, size_t); +extern int (mps_lib_memcmp)(const void *, const void *, size_t); + + +typedef unsigned long mps_clock_t; +extern mps_clock_t mps_clock(void); + + +extern unsigned long mps_lib_telemetry_control(void); + + +#endif /* mpslib_h */ diff --git a/mps/code/mpsliban.c b/mps/code/mpsliban.c new file mode 100644 index 00000000000..39ad626b93f --- /dev/null +++ b/mps/code/mpsliban.c @@ -0,0 +1,121 @@ +/* impl.c.mpsliban: HARLEQUIN MEMORY POOL SYSTEM LIBRARY INTERFACE (ANSI) + * + * $HopeName: MMsrc!mpsliban.c(trunk.11) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: The purpose of this code is + * 1. to connect the MPS Library Interface to the ANSI C libraries, + * where they exist, and + * 2. to provide an example of how to implement the MPS Library + * Interface. + * + * .readership: For MPS client application developers and MPS developers. + * .sources: design.mps.lib + * + * + * TRANSGRESSIONS (rule.impl.trans) + * + * .trans.file: The ANSI standard says (in section 7.9.1) that FILE is an + * object type, and hence the casts between FILE and mps_lib_FILE (an + * incomplete type) are not necessarily valid. We assume that this trick + * works, however, in all current environments. + */ + +#include "mpslib.h" + +#include "mpstd.h" + +#ifdef MPS_OS_SU +#include "ossu.h" +#endif +#ifdef MPS_OS_XC +#include "osxc.h" +#endif + +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + +#ifdef MPS_OS_SU +extern int fputc (int c, FILE *stream); +extern int fputs (const char *s, FILE *stream); +extern clock_t clock(void); +extern long strtol(const char *, char **, int); +/* @@@@ This doesn't do quite the right thing, but will get by. */ +#define strtoul(a,b,c) (unsigned long)strtol(a, b, c) +extern void *memset(void *, int, size_t); +#endif + +#include +#include +#include + + +int mps_lib_get_EOF(void) +{ + return EOF; +} + +mps_lib_FILE *mps_lib_get_stderr(void) +{ + return (mps_lib_FILE *)stderr; /* see .trans.file */ +} + +mps_lib_FILE *mps_lib_get_stdout(void) +{ + return (mps_lib_FILE *)stdout; /* see .trans.file */ +} + +int mps_lib_fputc(int c, mps_lib_FILE *stream) +{ + return fputc(c, (FILE *)stream); /* see .trans.file */ +} + +int mps_lib_fputs(const char *s, mps_lib_FILE *stream) +{ + return fputs(s, (FILE *)stream); /* see .trans.file */ +} + + +void mps_lib_abort(void) +{ + abort(); +} + + +void *mps_lib_memset(void *s, int c, size_t n) +{ + return memset(s, c, n); +} + +void *mps_lib_memcpy(void *s1, const void *s2, size_t n) +{ + return memcpy(s1, s2, n); +} + +int mps_lib_memcmp(const void *s1, const void *s2, size_t n) +{ + return memcmp(s1, s2, n); +} + + +/* @@@@ Platform specific conversion? */ +/* See http://devworld.apple.com/dev/techsupport/insidemac/OSUtilities/OSUtilities-94.html#MARKER-9-32 */ +mps_clock_t mps_clock(void) +{ + return (unsigned long)clock(); +} + + +unsigned long mps_lib_telemetry_control(void) +{ + char *s; + char **null = NULL; + + s = getenv("MPS_TELEMETRY_CONTROL"); + if(s != NULL) + return strtoul(s, null, 0); + else + return 0; +} diff --git a/mps/code/mpstd.h b/mps/code/mpstd.h new file mode 100644 index 00000000000..2365ceb1a3f --- /dev/null +++ b/mps/code/mpstd.h @@ -0,0 +1,299 @@ +/* impl.h.mpstd: HARLEQUIN MEMORY POOL SYSTEM TARGET DETECTION + * + * $HopeName: MMsrc!mpstd.h(trunk.27) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * Detect the target platform using predefined preprocessor symbols + * defined by the build environment. The symbols are derived from the + * documentation, or, in the case of GCC, from the compiler itself. + * References to the documentation appear above each detection line. + * + * .macos.ppc.align: MacOS / PowerPC requires 8 bytes alignment (in + * general). See "Mac OS Runtime Architecture", table 4-2. + */ + +#ifndef mpstd_h +#define mpstd_h + + +/* Irix 5/6 man cc and man abi. We can't check for _ABIO32 (see + * os.i5), as we have to support Irix 5.2, which doesn't define it. We + * check the value of _MIPS_FPSET, as it is defined across all Irix 5 + * and 6 platforms, and on Irix 6 distinguishes O32 from the other two + * ABIs. When we support the other ABIs, we need a new OS name for + * them. Alignment from testing. + */ + +#if defined(__sgi) && defined(__unix) && defined(__mips) \ + && defined(_SYSTYPE_SVR4) && (_MIPS_FPSET == 16) +#define MPS_PF_I5M2CC +#define MPS_PF_STRING "i5m2cc" +#define MPS_OS_I5 +#define MPS_ARCH_M2 +#define MPS_BUILD_CC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* See above. Alignment from testing. */ + +#elif defined(__sgi) && defined(__unix) && defined(__mips) \ + && defined(_SYSTYPE_SVR4) && defined(_ABIN32) +#define MPS_PF_IAM4CC +#define MPS_PF_STRING "iam4cc" +#define MPS_OS_IA +#define MPS_ARCH_M4 +#define MPS_BUILD_CC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* winnt.h from MS VC 2.0 */ + +#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_ALPHA) +#define MPS_PF_W3ALMV +#define MPS_PF_STRING "w3almv" +#define MPS_OS_W3 +#define MPS_ARCH_AL +#define MPS_BUILD_MV +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 4 + +/* winnt.h from MS VC 2.0 */ + +#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_PPC) +#define MPS_PF_W3PPMV +#define MPS_PF_STRING "w3ppmv" +#define MPS_OS_W3 +#define MPS_ARCH_PP +#define MPS_BUILD_MV +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 4 + +/* Visual C++ 2.0, Books Online, C/C++ Book, Preprocessor Reference, + * Chapter 1: The Preprocessor, Macros, Predefined Macros. + * Alignment of 4 would work, but the MS library uses 8 bytes for + * doubles and __int64, so we choose that. The actual granularity of + * VC malloc is 16! + */ + +#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_IX86) +#define MPS_PF_W3I3MV +#define MPS_PF_STRING "w3i3mv" +#define MPS_OS_W3 +#define MPS_ARCH_I3 +#define MPS_BUILD_MV +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* MW C/C++/ASM Lang Ref (CW9), pp. 184-186. Metrowerks does not document + * a way to determine the OS -- we assume MacOS 7. + */ + +#elif defined(__MWERKS__) && __MC68K__ == 1 +#define MPS_PF_S760MW +#define MPS_PF_STRING "s760mw" +#define MPS_OS_S7 +#define MPS_ARCH_60 +#define MPS_BUILD_MW +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 1 + +/* MW C/C++/ASM Lang Ref (CW9), pp. 184-186. Metrowerks does not document + * a way to determine the OS -- we assume MacOS 7. + */ + +#elif defined(__MWERKS__) && __POWERPC__ == 1 +#define MPS_PF_S7PPMW +#define MPS_PF_STRING "s7ppmw" +#define MPS_OS_S7 +#define MPS_ARCH_PP +#define MPS_BUILD_MW +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 /* .macos.ppc.align */ + +/* 1. MPW 3.0 C Ref, p. 43. + * 2. MPW SC/SCpp C/C++ Compiler for 68k Macintosh, p 3-60. + * These are the two MPW 68k compilers. They do not define anything + * which lets us determine the system version. + */ + +#elif defined(m68k) && (defined (applec) || defined(__SC__)) +#define MPS_PF_S760AC +#define MPS_PF_STRING "s760ac" +#define MPS_OS_S7 +#define MPS_ARCH_60 +#define MPS_BUILD_AC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 1 + +/* 1. C++/C Compiler for Macintosh with PowerPC, p 3-36. + * 2. MPW MrC/MrCpp C/C++ Compiler for Power Macintosh, p 3-57. + * These are the two MPW PowerPC compilers. They do not define anything + * which lets us determine the system version. + */ + +#elif defined(__PPCC__) || (defined(__MRC__) && defined(__POWERPC)) +#define MPS_PF_S7PPAC +#define MPS_PF_STRING "s7ppac" +#define MPS_OS_S7 +#define MPS_ARCH_PP +#define MPS_BUILD_AC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 /* .macos.ppc.align */ + +/* GCC 2.7.2.1, gcc -E -dM -traditional-cpp and + */ + +#elif defined(__APPLE__) && defined(__ppc__) && defined(__MACH__) && defined(__GNUC__) +#define MPS_PF_XCPPGC +#define MPS_PF_STRING "xcppgc" +#define MPS_OS_XC +#define MPS_ARCH_PP +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 /* .macos.ppc.align */ + +/* GCC 2.5.8, gcc -E -dM, (__SVR4 indicates Solaris) */ + +#elif defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \ + && !defined(__svr4__) +#define MPS_PF_SUS8GC +#define MPS_PF_STRING "sus8gc" +#define MPS_OS_SU +#define MPS_ARCH_S8 +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* LCC 3.4 (ish), man page */ + +#elif defined(sun) && defined(sparc) && defined(__LCC__) \ + && !defined(__svr4__) +#define MPS_PF_SUS8LC +#define MPS_PF_STRING "sus8lc" +#define MPS_OS_SU +#define MPS_ARCH_S8 +#define MPS_BUILD_LC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* GCC 2.5.8, gcc -E -dM */ + +#elif defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \ + && defined(__svr4__) +#define MPS_PF_SOS8GC +#define MPS_PF_STRING "sos8gc" +#define MPS_OS_SO +#define MPS_ARCH_S8 +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* SunPro C, man cc (confirmed by grep). Note that this doesn't + * actually nail down UltraSPARCs; there are no compiler predefined + * macros for that. + */ + +#elif defined(__sun) && defined(__SUNPRO_C) && defined(__SVR4) \ + && defined(__sparc) + +#define MPS_PF_SOS9SC +#define MPS_PF_STRING "sos9sc" +#define MPS_OS_SO +#define MPS_ARCH_S9 +#define MPS_BUILD_SC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 + +/* GCC 2.6.3, gcc -E -dM */ + +#elif defined(__osf__) && defined(__alpha__) && defined(__GNUC__) +#define MPS_PF_O1ALGC +#define MPS_PF_STRING "o1algc" +#define MPS_OS_O1 +#define MPS_ARCH_AL +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_T_SHORT unsigned +#define MPS_WORD_WIDTH 64 +#define MPS_WORD_SHIFT 6 +#define MPS_PF_ALIGN 8 + +/* From the cc(1) man page */ + +#elif defined(__osf__) && defined(__alpha) && defined(__DECC) +#define MPS_PF_O1ALCC +#define MPS_PF_STRING "o1alcc" +#define MPS_OS_O1 +#define MPS_ARCH_AL +#define MPS_BUILD_CC +#define MPS_T_WORD unsigned long +#define MPS_T_SHORT unsigned +#define MPS_WORD_WIDTH 64 +#define MPS_WORD_SHIFT 6 +#define MPS_PF_ALIGN 8 + +/* GCC 2.6.3, gcc -E -dM + * The actual granularity of GNU malloc is 8, but field alignments are + * all 4. + */ + +#elif defined(__linux__) && defined(__i386__) && defined(__GNUC__) +#define MPS_PF_LII4GC +#define MPS_PF_STRING "lii4gc" +#define MPS_OS_LI +#define MPS_ARCH_I4 +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 4 + +/* GCC 2.7.2, gcc -E -dM */ + +#elif defined(__linux__) && defined(__PPC__) && defined(__GNUC__) +#define MPS_PF_LIPPGC +#define MPS_PF_STRING "lippgc" +#define MPS_OS_LI +#define MPS_ARCH_PP +#define MPS_BUILD_GC +#define MPS_T_WORD unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 8 /* @@@@ not tested */ + +#else +#error "Unable to detect target platform" +#endif + + +#endif /* mpstd_h */ diff --git a/mps/code/mpsw3.h b/mps/code/mpsw3.h new file mode 100644 index 00000000000..73d39adb763 --- /dev/null +++ b/mps/code/mpsw3.h @@ -0,0 +1,39 @@ +/* impl.h.mpsw3: HARLEQUIN MEMORY POOL SYSTEM C INTERFACE, WINDOWS PART + * + * $HopeName: MMsrc!mpsw3.h(trunk.2) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .readership: customers, MPS developers. + * .sources: design.mps.interface.c. + */ + +#ifndef mpsw3_h +#define mpsw3_h + +#include "mps.h" /* needed for mps_tramp_t */ +#include "mpswin.h" /* needed for SEH filter */ + + +extern LONG mps_SEH_filter(LPEXCEPTION_POINTERS, void **, size_t *); +extern void mps_SEH_handler(void *, size_t); + + +#undef mps_tramp /* Override generic version */ + +#define mps_tramp(r_o, f, p, s) \ + MPS_BEGIN \ + void **_r_o = (r_o); \ + mps_tramp_t _f = (f); \ + void *_p = (p); \ + size_t _s = (s); \ + void *_hp = NULL; size_t _hs = 0; \ + __try { \ + *_r_o = (*_f)(_p, _s); \ + } __except(mps_SEH_filter(GetExceptionInformation(), \ + &_hp, &_hs)) { \ + mps_SEH_handler(_hp, _hs); \ + } \ + MPS_END + + +#endif /* mpsw3_h */ diff --git a/mps/code/mpswin.h b/mps/code/mpswin.h new file mode 100644 index 00000000000..b2beded87bd --- /dev/null +++ b/mps/code/mpswin.h @@ -0,0 +1,31 @@ +/* impl.h.mpswin: HARLEQUIN MEMORY POOL SYSTEM WINDOWS.H INTERFACE + * + * $HopeName: MMsrc!mpswin.h(trunk.3) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + * + * .readership: For MPS client application developers, MPS developers. + * + * .purpose: Shared file for the incantations needed to include windows.h. + */ + +#ifndef mpswin_h +#define mpswin_h + +/* Suppress Visual C warnings from windows.h at warning level 4. */ +#ifdef MPS_BUILD_MV +#pragma warning(disable: 4115 4201 4209 4214) +#endif + +#include + +#ifdef MPS_BUILD_MV +#pragma warning(default: 4115 4201 4209 4214) +/* windows.h might also cause warnings about "unreferenced inline + * function has been removed". In Visual C, these can be turned off: + * #pragma warning(disable: 4514) + * But they are generated at the end of the compilation, so you have + * to turn them off permanently. + */ +#endif + +#endif /* mpswin_h */ diff --git a/mps/code/mv2test.c b/mps/code/mv2test.c new file mode 100644 index 00000000000..26df55ef8aa --- /dev/null +++ b/mps/code/mv2test.c @@ -0,0 +1,324 @@ +/* impl.c.mv2test: POOLMVT STRESS TEST + * + * $HopeName: MMsrc!mv2test.c(trunk.5) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#include +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + +#include "mpscmv2.h" +#include "mps.h" + +typedef MPS_T_WORD mps_count_t; /* machine word (target dep.) */ + +#include "mpslib.h" +#include "mpsavm.h" +#include "testlib.h" + +/* --- to get to describe */ +#include "mpm.h" + +#include + + +/* + * From + * + * "Minimal" random number generator of Park and Miller with + * Bays-Durham shuffle and added safeguards. Returns a uniform random + * deviate between 0.0 and 1.0 (exclusive of the endpoint + * values). Call with idum a negative integer to initialize; + * thereafter, do not alter idum between successive deviates in a + * sequence. RNMX should approximate the largest floating value that + * is less than 1. + */ +#define IA 16807 +#define IM 2147483647 +#define AM (1.0F/IM) +#define IQ 127773 +#define IR 2836 +#define NTAB 32 +#define NDIV (1+(IM-1)/NTAB) +#define EPS 1.2e-7F +#define RNMX (1.0F-EPS) + +static float ran1(long *idum) +{ + int j; + long k; + static long iy=0; + static long iv[NTAB]; + float temp; + if (*idum <= 0 || !iy) { /* Initialize. */ + if (-(*idum) < 1) /* Be sure to prevent idum = 0. */ + *idum=1; + else + *idum = -(*idum); + for (j=NTAB+7;j>=0;j--) { /* Load the shuffle table (after 8 + warm-ups). */ + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) + *idum += IM; + if (j < NTAB) + iv[j] = *idum; + } + iy=iv[0]; + } + k=(*idum)/IQ; /* Start here when not initializing. */ + *idum=IA*(*idum-k*IQ)-IR*k; /* Compute idum=(IA*idum) % IM without + overflows by Schrage's method. */ + if (*idum < 0) *idum += IM; + j=iy/NDIV; /* Will be in the range 0..NTAB-1. */ + iy=iv[j]; /* Output previously stored value and + refill the shuffle table. */ + iv[j] = *idum; + if ((temp=AM*(float)iy) > RNMX) /* Because users don't expect endpoint + values. */ + return RNMX; + else + return temp; +} + + +/* + * From + * + * Returns an exponentially distributed, positive, random deviate of + * unit mean, using ran1(idum) as the source of uniform deviates. + */ + +static float expdev(long *idum) +{ + float dum; + do + dum=ran1(idum); + while (dum == 0.0); + return (float)-log(dum); +} + + +#ifdef ndef +/* + From: Leva, Joseph L., A fast normal random number generator, ACM Transactions on + Mathematical Software Vol. 18, No. 4 (Dec. 1992), Pages 449-453 +*/ + +static double nrnd(void) +{ + double m = (double)((unsigned)-1); + double u; + double v; + double twor = 1.7156; /* 2 * sqrt(2.0 / exp(1.0)) */ + double s = 0.449871; + double t = -0.386595; + double a = 0.19600; + double b = 0.25472; + double r1 = 0.27597; + double r2 = 0.27846; + double x, y, Q; + +reject: + u = (double)rnd()/m; + v = (double)rnd()/m; + v = twor * (v - 0.5); + x = u - s; + y = fabs(v) - t; + Q = x * x + y * (a * y - b * x); + + if (Q < r1) + goto accept; + if (Q > r2) + goto reject; + if (v * v > -4 * u * u * log(u)) + goto reject; +accept: + return v / u; +} +#endif /* ndef */ + + +#define max(a, b) (((a) > (b)) ? (a) : (b)) + +static size_t min; +static size_t mean; +static size_t max; +static int verbose = 0; +static mps_pool_t pool; + + +extern void DescribeIt(void); + +void DescribeIt(void) +{ + PoolDescribe((Pool)pool, (mps_lib_FILE *)stderr); +} + + +static size_t randomSize(int i) +{ + /* Distribution centered on mean. Verify that allocations + below min and above max are handled correctly */ + static long seed = 7472366; + size_t s = (max - mean)/4; + size_t m = mean; + double r; + double x; + + testlib_unused(i); + + /* per SGR */ + do { + r = expdev(&seed); + x = (double)s * sqrt(2 * r); + x += (double)m; + } while (x <= 1.0); + + return (size_t)x; + +} + + +#define testArenaSIZE ((size_t)64<<20) +#define TEST_SET_SIZE 1234 +#define TEST_LOOPS 27 + +static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) +{ + mps_res_t res; + + /* --- align */ + size = ((size+7)/8)*8; + + do { + MPS_RESERVE_BLOCK(res, *p, ap, size); + if(res != MPS_RES_OK) + return res; + } while(!mps_commit(ap, *p, size)); + + return MPS_RES_OK; +} + + +static mps_res_t stress(mps_class_t class, mps_arena_t arena, + size_t (*size)(int i), ...) +{ + mps_res_t res; + mps_ap_t ap; + va_list arg; + int i, k; + int *ps[TEST_SET_SIZE]; + size_t ss[TEST_SET_SIZE]; + + va_start(arg, size); + res = mps_pool_create_v(&pool, arena, class, arg); + va_end(arg); + if(res != MPS_RES_OK) return res; + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + + /* allocate a load of objects */ + for(i=0; i 0) { + mps_free(pool, (mps_addr_t)ps[i], ss[i]); + ss[i] = 0; + } + } + /* allocate some new objects */ + for(i=x; i +#include +#include +#include +#include + + +/* stddef.h */ + +#ifndef offsetof /* true for platform.sus8lc for example */ +#define offsetof(ty,mem) ((size_t)((char*)&((ty*)0)->(mem) - (char*)0)) +#endif + + +/* stdio.h things */ + +extern int fclose (FILE *stream); +extern int fflush (FILE *stream); +extern int fgetc (FILE *stream); +extern int ungetc (int c, FILE *stram); +extern int fputc (int c, FILE *stream); +extern int printf (const char *format, ...); +extern int fprintf (FILE *stream, const char *format, ...); +extern int vfprintf (FILE *stream, const char *format, va_list arg); +extern int vsprintf (char *s, const char *format, va_list arg); +extern int fputs (const char *s, FILE *stream); +extern int puts(const char *); +extern int fscanf (FILE *stream, const char *format, ...); +extern int sscanf (const char *s, const char *format, ...); +extern int fseek (FILE *stream, long int offset, int whence); +extern size_t fread (void *ptr, size_t size, size_t nmemb, FILE *stream); +extern size_t fwrite (const void *ptr, size_t size, size_t nmemb, + FILE *stream); + +/* these functions are used in the macro definitions of putc and getc +but not declared in stdio.h */ + +extern int _filbuf(FILE *stream); + +extern int _flsbuf(unsigned char c, FILE *stream); + + +/* time.h things */ + +extern size_t strftime (char *s, size_t maxsize, const char *format, + const struct tm *timeptr); +extern time_t time (time_t *timer); +extern clock_t clock(void); + + +/* stdlib.h things */ + +extern int system(const char *string); +extern long strtol(const char *, char **, int); +#define EXIT_FAILURE 1 +#define EXIT_SUCCESS 0 +/* @@@@ This doesn't do quite the right thing, but will get by */ +#define strtoul(a,b,c) (unsigned long)strtol((a), (b), (c)) + + +/* string.h things */ + +extern void *memset(void *, int, size_t); + + +#ifdef MPS_PF_SUS8LC +/* .hack.malloc: builder.lc (LCC) uses Sun's header files. Sun's + * stdlib.h is broken, as it has an incorrect declaration of malloc. + * We fix that here in a very hacky way. + */ +#define malloc(x) (void *)malloc(x) +#endif /* MPS_PF_SUS8LC */ + + +#endif /* ossu_h */ diff --git a/mps/code/osxc.h b/mps/code/osxc.h new file mode 100644 index 00000000000..61f14cc3c44 --- /dev/null +++ b/mps/code/osxc.h @@ -0,0 +1,27 @@ +/* impl.h.osxc: MacOS X (Carbon-compatible) system header hacks + * + * $HopeName: MMsrc!osxc.h(MM_epcore_brisling.1) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: This header fixes bugs in the system headers. + */ + + +#ifndef osxc_h +#define osxc_h + + +#ifdef MPS_BUILD_GC +/* __inline__ is supposed to do nothing in gcc -ansi, but there's a bug in */ +/* DP3, that causes it to signal error (for __sputc in stdio.h). */ +#define __inline__ +#endif + + +/* cabs doesn't have a proper prototype; taken from glibc 2.0.6 manual. */ +/* Define a structure tag to avoid warnings. */ +struct mps_complex { double real, imag; }; +extern double cabs(struct mps_complex z); + + +#endif /* osxc_h */ diff --git a/mps/code/pool.c b/mps/code/pool.c new file mode 100644 index 00000000000..b02f41f638b --- /dev/null +++ b/mps/code/pool.c @@ -0,0 +1,576 @@ +/* impl.c.pool: POOL IMPLEMENTATION + * + * $HopeName: MMsrc!pool.c(trunk.75) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: See design.mps.class-interface and design.mps.pool. + * + * PURPOSE + * + * .purpose: This is the implementation of the generic pool interface. + * There are three sorts of functions provided: + * .purpose.support: Support functions for manipulating and accessing + * Pool and PoolClass objects (create, destroy, check, various + * accessors, and other miscellaneous functions). + * .purpose.dispatch: Dispatch functions that implement the generic + * function dispatch mechanism for Pool Classes (PoolAlloc, PoolFix, + * etc.). + * .purpose.core: A selection of default, trivial, or useful methods + * that Pool Classes can use as the implementations for some of their + * methods (such as PoolTrivWhiten, PoolNoFix, etc.). + * + * SOURCES + * + * .source: See .design also. PoolStruct and PoolClassStruct, the + * central types for this module, are defined in impl.h.mpmst, the + * corresponding abstract types in impl.h.mpmtypes. Declarations and + * prototypes are in impl.h.mpm. Several functions have macro versions + * defined in impl.h.mpm. */ + +#include "mpm.h" + +SRCID(pool, "$HopeName: MMsrc!pool.c(trunk.75) $"); + + +/* PoolClassCheck -- check a pool class */ + +Bool PoolClassCheck(PoolClass class) +{ + CHECKL(ProtocolClassCheck(&class->protocol)); + CHECKL(class->name != NULL); /* Should be <=6 char C identifier */ + CHECKL(class->size >= sizeof(PoolStruct)); + /* Offset of generic Pool within class-specific instance cannot be */ + /* greater than the size of the class-specific portion of the instance */ + CHECKL(class->offset <= (size_t)(class->size - sizeof(PoolStruct))); + CHECKL(AttrCheck(class->attr)); + CHECKL(FUNCHECK(class->init)); + CHECKL(FUNCHECK(class->finish)); + CHECKL(FUNCHECK(class->alloc)); + CHECKL(FUNCHECK(class->free)); + CHECKL(FUNCHECK(class->bufferFill)); + CHECKL(FUNCHECK(class->bufferEmpty)); + CHECKL(FUNCHECK(class->whiten)); + CHECKL(FUNCHECK(class->grey)); + CHECKL(FUNCHECK(class->scan)); + CHECKL(FUNCHECK(class->fix)); + CHECKL(FUNCHECK(class->reclaim)); + CHECKL(FUNCHECK(class->rampBegin)); + CHECKL(FUNCHECK(class->rampEnd)); + CHECKL(FUNCHECK(class->framePush)); + CHECKL(FUNCHECK(class->framePop)); + CHECKL(FUNCHECK(class->framePopPending)); + CHECKL(FUNCHECK(class->walk)); + CHECKL(FUNCHECK(class->describe)); + CHECKS(PoolClass, class); + return TRUE; +} + + +/* PoolCheck -- check the generic part of a pool */ + +Bool PoolCheck(Pool pool) +{ + /* Checks ordered as per struct decl in impl.h.mpmst.pool */ + CHECKS(Pool, pool); + /* Break modularity for checking efficiency */ + CHECKL(pool->serial < ArenaGlobals(pool->arena)->poolSerial); + CHECKD(PoolClass, pool->class); + CHECKU(Arena, pool->arena); + CHECKL(RingCheck(&pool->arenaRing)); + CHECKL(RingCheck(&pool->bufferRing)); + /* Cannot check pool->bufferSerial */ + CHECKL(RingCheck(&pool->segRing)); + CHECKL(AlignCheck(pool->alignment)); + /* normally pool->format iff pool->class->attr&AttrFMT, but not */ + /* during pool initialization */ + if (pool->format != NULL) { + CHECKL((pool->class->attr & AttrFMT) != 0); + } + CHECKL(pool->fillMutatorSize >= 0.0); + CHECKL(pool->emptyMutatorSize >= 0.0); + CHECKL(pool->fillInternalSize >= 0.0); + CHECKL(pool->emptyInternalSize >= 0.0); + return TRUE; +} + + +/* PoolInit, PoolInitV -- initialize a pool + * + * Initialize the generic fields of the pool and calls class-specific + * init. See design.mps.pool.align. */ + +Res PoolInit(Pool pool, Arena arena, PoolClass class, ...) +{ + Res res; + va_list args; + va_start(args, class); + res = PoolInitV(pool, arena, class, args); + va_end(args); + return res; +} + +Res PoolInitV(Pool pool, Arena arena, PoolClass class, va_list args) +{ + Res res; + Word classId; + Globals globals; + + AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(PoolClass, class); + globals = ArenaGlobals(arena); + + pool->class = class; + /* label the pool class with its name */ + if (!class->labelled) { + /* We could still get multiple labelling if multiple instances of */ + /* the pool class get created simultaneously, but it's not worth */ + /* putting another lock in the code. */ + class->labelled = TRUE; + classId = EventInternString(class->name); + /* @@@@ this breaks design.mps.type.addr.use */ + EventLabelAddr((Addr)class, classId); + } + + pool->arena = arena; + RingInit(&pool->arenaRing); + RingInit(&pool->bufferRing); + RingInit(&pool->segRing); + pool->bufferSerial = (Serial)0; + pool->alignment = MPS_PF_ALIGN; + pool->format = NULL; + pool->fix = class->fix; + pool->fillMutatorSize = 0.0; + pool->emptyMutatorSize = 0.0; + pool->fillInternalSize = 0.0; + pool->emptyInternalSize = 0.0; + + /* Initialise signature last; see design.mps.sig */ + pool->sig = PoolSig; + pool->serial = globals->poolSerial; + ++(globals->poolSerial); + + AVERT(Pool, pool); + + /* Do class-specific initialization. */ + res = (*class->init)(pool, args); + if (res != ResOK) + goto failInit; + + /* Add initialized pool to list of pools in arena. */ + RingAppend(&globals->poolRing, &pool->arenaRing); + + return ResOK; + +failInit: + pool->sig = SigInvalid; /* Leave arena->poolSerial incremented */ + RingFinish(&pool->segRing); + RingFinish(&pool->bufferRing); + RingFinish(&pool->arenaRing); + return res; +} + + +/* PoolCreate, PoolCreateV: Allocate and initialise pool */ + +Res PoolCreate(Pool *poolReturn, Arena arena, + PoolClass class, ...) +{ + Res res; + va_list args; + va_start(args, class); + res = PoolCreateV(poolReturn, arena, class, args); + va_end(args); + return res; +} + +Res PoolCreateV(Pool *poolReturn, Arena arena, + PoolClass class, va_list args) +{ + Res res; + Pool pool; + void *base; + + AVER(poolReturn != NULL); + AVERT(Arena, arena); + AVERT(PoolClass, class); + + /* .space.alloc: Allocate the pool instance structure with the size */ + /* requested in the pool class. See .space.free */ + res = ControlAlloc(&base, arena, class->size, + /* withReservoirPermit */ FALSE); + if (res != ResOK) + goto failControlAlloc; + + /* base is the address of the class-specific pool structure. */ + /* We calculate the address of the generic pool structure within the */ + /* instance by using the offset information from the class. */ + pool = (Pool)PointerAdd(base, class->offset); + + /* Initialize the pool. */ + res = PoolInitV(pool, arena, class, args); + if (res != ResOK) + goto failPoolInit; + + *poolReturn = pool; + return ResOK; + +failPoolInit: + ControlFree(arena, base, class->size); +failControlAlloc: + return res; +} + + +/* PoolFinish -- Finish pool including class-specific and generic fields. */ + +void PoolFinish(Pool pool) +{ + AVERT(Pool, pool); + + /* Do any class-specific finishing. */ + (*pool->class->finish)(pool); + + /* Detach the pool from the arena, and unsig it. */ + RingRemove(&pool->arenaRing); + pool->sig = SigInvalid; + + RingFinish(&pool->segRing); + RingFinish(&pool->bufferRing); + RingFinish(&pool->arenaRing); + + EVENT_P(PoolFinish, pool); +} + + +/* PoolDestroy -- Finish and free pool. */ + +void PoolDestroy(Pool pool) +{ + PoolClass class; + Arena arena; + Addr base; + + AVERT(Pool, pool); + + class = pool->class; /* } In case PoolFinish changes these */ + arena = pool->arena; /* } */ + + /* Finish the pool instance structure. */ + PoolFinish(pool); + + /* .space.free: Free the pool instance structure. See .space.alloc */ + base = AddrSub((Addr)pool, (Size)(class->offset)); + ControlFree(arena, base, (Size)(class->size)); +} + + +/* PoolDefaultBufferClass -- return the buffer class used by the pool */ + +BufferClass PoolDefaultBufferClass(Pool pool) +{ + AVERT(Pool, pool); + return (*pool->class->bufferClass)(); +} + + +/* PoolAlloc -- allocate a block of memory from a pool */ + +Res PoolAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + Res res; + + AVER(pReturn != NULL); + AVERT(Pool, pool); + AVER((pool->class->attr & AttrALLOC) != 0); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + res = (*pool->class->alloc)(pReturn, pool, size, withReservoirPermit); + if (res != ResOK) + return res; + /* Make sure that the allocated address was in the pool's memory. */ + /* .hasaddr.critical: The PoolHasAddr check is expensive, and in */ + /* allocation-bound programs this is on the critical path. */ + AVER_CRITICAL(PoolHasAddr(pool, *pReturn)); + + /* All PoolAllocs should advance the allocation clock, so we count */ + /* it all in the fillMutatorSize field. */ + pool->fillMutatorSize += size; + ArenaGlobals(PoolArena(pool))->fillMutatorSize += size; + + EVENT_PAW(PoolAlloc, pool, *pReturn, size); + + return ResOK; +} + + +/* PoolFree -- deallocate a block of memory allocated from the pool */ + +void PoolFree(Pool pool, Addr old, Size size) +{ + AVERT(Pool, pool); + AVER((pool->class->attr & AttrFREE) != 0); + AVER(old != NULL); + /* The pool methods should check that old is in pool. */ + AVER(size > 0); + (*pool->class->free)(pool, old, size); + + EVENT_PAW(PoolFree, pool, old, size); +} + + +Res PoolAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + /* Can't check mode as there is no check method */ + /* Can't check MutatorFaultContext as there is no check method */ + + return (*pool->class->access)(pool, seg, addr, mode, context); +} + + +/* PoolWhiten, PoolGrey, PoolBlacken -- change color of a segment in the pool */ + +Res PoolWhiten(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + AVER(PoolArena(pool) == trace->arena); + AVER(SegPool(seg) == pool); + return (*pool->class->whiten)(pool, trace, seg); +} + +void PoolGrey(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + AVER(pool->arena == trace->arena); + AVER(SegPool(seg) == pool); + (*pool->class->grey)(pool, trace, seg); +} + +void PoolBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + AVERT(Pool, pool); + AVERT(TraceSet, traceSet); + AVERT(Seg, seg); + AVER(SegPool(seg) == pool); + (*pool->class->blacken)(pool, traceSet, seg); +} + + +/* PoolScan -- scan a segment in the pool */ + +Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(ss->arena == pool->arena); + + /* The segment must belong to the pool. */ + AVER(pool == SegPool(seg)); + + /* We actually want to check that the rank we are scanning at */ + /* (ss->rank) is at least as big as all the ranks in */ + /* the segment (SegRankSet(seg)). It is tricky to check that, */ + /* so we only check that either ss->rank is in the segment's */ + /* ranks, or that ss->rank is exact. */ + /* See impl.c.trace.scan.conservative */ + AVER(ss->rank == RankEXACT || RankSetIsMember(SegRankSet(seg), ss->rank)); + + /* Should only scan segments which contain grey objects. */ + AVER(TraceSetInter(SegGrey(seg), ss->traces) != TraceSetEMPTY); + + return (*pool->class->scan)(totalReturn, ss, pool, seg); +} + + +/* PoolFix* -- fix a reference to an object in this pool + * + * See impl.h.mpm for macro version; see design.mps.pool.req.fix. */ + +Res (PoolFix)(Pool pool, ScanState ss, Seg seg, Addr *refIO) +{ + AVERT(Pool, pool); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVER(pool == SegPool(seg)); + AVER(refIO != NULL); + + /* Should only be fixing references to white segments. */ + AVER(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY); + + return PoolFix(pool, ss, seg, refIO); +} + +void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO) +{ + Res res; + + AVERT(Pool, pool); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVER(pool == SegPool(seg)); + AVER(refIO != NULL); + + /* Should only be fixing references to white segments. */ + AVER(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY); + + res = (pool->class->fixEmergency)(pool, ss, seg, refIO); + AVER(res == ResOK); +} + + +/* PoolReclaim -- reclaim a segment in the pool */ + +void PoolReclaim(Pool pool, Trace trace, Seg seg) +{ + AVERT_CRITICAL(Pool, pool); + AVERT_CRITICAL(Trace, trace); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(pool->arena == trace->arena); + AVER_CRITICAL(SegPool(seg) == pool); + + /* There shouldn't be any grey things left for this trace. */ + AVER_CRITICAL(!TraceSetIsMember(SegGrey(seg), trace)); + /* Should only be reclaiming segments which are still white. */ + AVER_CRITICAL(TraceSetIsMember(SegWhite(seg), trace)); + + (*pool->class->reclaim)(pool, trace, seg); +} + + +/* PoolWalk -- walk objects in this pool */ + +void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, + void *p, Size s) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary values, hence can't be checked. */ + + (*pool->class->walk)(pool, seg, f, p, s); +} + + +/* PoolDescribe -- describe a pool */ + +Res PoolDescribe(Pool pool, mps_lib_FILE *stream) +{ + Res res; + Ring node, nextNode; + + if (!CHECKT(Pool, pool)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial, + " class $P (\"$S\")\n", + (WriteFP)pool->class, pool->class->name, + " arena $P ($U)\n", + (WriteFP)pool->arena, (WriteFU)pool->arena->serial, + " alignment $W\n", (WriteFW)pool->alignment, + NULL); + if (res != ResOK) return res; + if (NULL != pool->format) { + res = FormatDescribe(pool->format, stream); + if (res != ResOK) return res; + } + res = WriteF(stream, + " fillMutatorSize $UKb\n", + (WriteFU)(pool->fillMutatorSize / 1024), + " emptyMutatorSize $UKb\n", + (WriteFU)(pool->emptyMutatorSize / 1024), + " fillInternalSize $UKb\n", + (WriteFU)(pool->fillInternalSize / 1024), + " emptyInternalSize $UKb\n", + (WriteFU)(pool->emptyInternalSize / 1024), + NULL); + if (res != ResOK) return res; + + res = (*pool->class->describe)(pool, stream); + if (res != ResOK) return res; + + RING_FOR(node, &pool->bufferRing, nextNode) { + Buffer buffer = RING_ELT(Buffer, poolRing, node); + res = BufferDescribe(buffer, stream); + if (res != ResOK) return res; + } + + res = WriteF(stream, + "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, + NULL); + if (res != ResOK) return res; + + return ResOK; +} + + +/* PoolFormat + * + * Returns the format of the pool (the format of objects in the pool). + * If the pool is unformatted or doesn't declare a format then this + * function returns FALSE and does not update *formatReturn. Otherwise + * this function returns TRUE and *formatReturn is updated to be the + * pool's format. */ + +Bool PoolFormat(Format *formatReturn, Pool pool) +{ + AVER(formatReturn != NULL); + AVERT(Pool, pool); + + if (pool->format) { + *formatReturn = pool->format; + return TRUE; + } + return FALSE; +} + + +/* PoolOfAddr -- return the pool containing the given address + * + * If the address points to a page assigned to a pool, this returns TRUE + * and sets *poolReturn to that pool. Otherwise, it returns FALSE, and + * *poolReturn is unchanged. */ + +Bool PoolOfAddr(Pool *poolReturn, Arena arena, Addr addr) +{ + Tract tract; + + AVER(poolReturn != NULL); + AVERT(Arena, arena); + + if (TractOfAddr(&tract, arena, addr)) { + *poolReturn = TractPool(tract); + return TRUE; + } + + return FALSE; +} + + +Bool PoolHasAddr(Pool pool, Addr addr) +{ + Pool addrPool; + Arena arena; + Bool managed; + + AVERT(Pool, pool); + + arena = PoolArena(pool); + managed = PoolOfAddr(&addrPool, arena, addr); + return (managed && addrPool == pool); +} diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c new file mode 100644 index 00000000000..0f530a1b68c --- /dev/null +++ b/mps/code/poolabs.c @@ -0,0 +1,627 @@ +/* impl.c.poolabs: ABSTRACT POOL CLASSES + * + * $HopeName: MMsrc!poolabs.c(trunk.8) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * PURPOSE + * + * .purpose: This defines the abstract pool classes, giving + * a single-inheritance framework which concrete classes + * may utilize. The purpose is to reduce the fragility of class + * definitions for pool implementations when small changes are + * made to the pool protocol. For now, the class hierarchy for + * the abstract classes is intended to be useful, but not to + * represent any particular design for pool inheritance. + * + * HIERARCHY + * + * .hierarchy: define the following hierarchy of abstract pool classes: + * AbstractPoolClass - implements init, finish, describe + * AbstractAllocFreePoolClass - implements alloc & free + * AbstractBufferPoolClass - implements the buffer protocol + * AbstractSegBufPoolClass - uses SegBuf buffer class + * AbstractScanPoolClass - implements basic scanning + * AbstractCollectPoolClass - implements basic GC + */ + +#include "mpm.h" + +SRCID(poolabs, "$HopeName: MMsrc!poolabs.c(trunk.8) $"); + + +typedef PoolClassStruct AbstractPoolClassStruct; +typedef PoolClassStruct AbstractAllocFreePoolClassStruct; +typedef PoolClassStruct AbstractBufferPoolClassStruct; +typedef PoolClassStruct AbstractSegBufPoolClassStruct; +typedef PoolClassStruct AbstractScanPoolClassStruct; +typedef PoolClassStruct AbstractCollectPoolClassStruct; + + +/* Mixins: + * + * For now (at least) we're avoiding multiple inheritance. + * However, there is a significant use of multiple inheritance + * in practice amongst the pool classes, as there are several + * orthogonal sub-protocols included in the pool protocol. + * The following mixin functions help to provide the inheritance + * via a simpler means than real multiple inheritance. + */ + + +/* PoolClassMixInAllocFree -- mix in the protocol for Alloc / Free */ + +void PoolClassMixInAllocFree(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->attr |= (AttrALLOC | AttrFREE); + class->alloc = PoolTrivAlloc; + class->free = PoolTrivFree; +} + + +/* PoolClassMixInBuffer -- mix in the protocol for buffer reserve / commit */ + +void PoolClassMixInBuffer(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->attr |= (AttrBUF | AttrBUF_RESERVE); + class->bufferFill = PoolTrivBufferFill; + class->bufferEmpty = PoolTrivBufferEmpty; + /* By default, buffered pools treat frame operations as NOOPs */ + class->framePush = PoolTrivFramePush; + class->framePop = PoolTrivFramePop; + class->bufferClass = BufferClassGet; +} + + +/* PoolClassMixInScan -- mix in the protocol for scanning */ + +void PoolClassMixInScan(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->attr |= AttrSCAN; + class->access = PoolSegAccess; + class->blacken = PoolTrivBlacken; + class->grey = PoolTrivGrey; + /* Scan is part of the scanning protocol - but there is */ + /* no useful default method */ +} + + +/* PoolClassMixInFormat -- mix in the protocol for formatted pools */ + +void PoolClassMixInFormat(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->attr |= AttrFMT; +} + + +/* PoolClassMixInCollect -- mix in the protocol for GC */ + +void PoolClassMixInCollect(PoolClass class) +{ + /* Can't check class because it's not initialized yet */ + class->attr |= (AttrGC | AttrINCR_RB); + class->whiten = PoolTrivWhiten; + /* Fix & reclaim are part of the collection protocol - but there */ + /* are no useful default methods for them. */ + class->rampBegin = PoolTrivRampBegin; + class->rampEnd = PoolTrivRampEnd; +} + + +/* Classes */ + + +DEFINE_CLASS(AbstractPoolClass, class) +{ + INHERIT_CLASS(&class->protocol, ProtocolClass); + class->name = "ABSTRACT"; + class->size = 0; + class->offset = 0; + class->attr = 0; + class->init = PoolTrivInit; + class->finish = PoolTrivFinish; + class->alloc = PoolNoAlloc; + class->free = PoolNoFree; + class->bufferFill = PoolNoBufferFill; + class->bufferEmpty = PoolNoBufferEmpty; + class->access = PoolNoAccess; + class->whiten = PoolNoWhiten; + class->grey = PoolNoGrey; + class->blacken = PoolNoBlacken; + class->scan = PoolNoScan; + class->fix = PoolNoFix; + class->fixEmergency = PoolNoFix; + class->reclaim = PoolNoReclaim; + class->rampBegin = PoolNoRampBegin; + class->rampEnd = PoolNoRampEnd; + class->framePush = PoolNoFramePush; + class->framePop = PoolNoFramePop; + class->framePopPending = PoolNoFramePopPending; + class->walk = PoolNoWalk; + class->bufferClass = PoolNoBufferClass; + class->describe = PoolTrivDescribe; + class->debugMixin = PoolNoDebugMixin; + class->labelled = FALSE; + class->sig = PoolClassSig; +} + +DEFINE_CLASS(AbstractAllocFreePoolClass, class) +{ + INHERIT_CLASS(class, AbstractPoolClass); + PoolClassMixInAllocFree(class); +} + +DEFINE_CLASS(AbstractBufferPoolClass, class) +{ + INHERIT_CLASS(class, AbstractPoolClass); + PoolClassMixInBuffer(class); +} + +DEFINE_CLASS(AbstractSegBufPoolClass, class) +{ + INHERIT_CLASS(class, AbstractBufferPoolClass); + class->bufferClass = SegBufClassGet; +} + +DEFINE_CLASS(AbstractScanPoolClass, class) +{ + INHERIT_CLASS(class, AbstractSegBufPoolClass); + PoolClassMixInScan(class); +} + +DEFINE_CLASS(AbstractCollectPoolClass, class) +{ + INHERIT_CLASS(class, AbstractScanPoolClass); + PoolClassMixInCollect(class); +} + + +/* PoolNo*, PoolTriv* -- Trivial and non-methods for Pool Classes + * + * See design.mps.pool.no and design.mps.pool.triv + */ + + +void PoolTrivFinish(Pool pool) +{ + AVERT(Pool, pool); + NOOP; +} + +Res PoolTrivInit(Pool pool, va_list args) +{ + AVERT(Pool, pool); + UNUSED(args); + return ResOK; +} + +Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + AVER(pReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + NOTREACHED; + return ResUNIMPL; +} + +Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + AVER(pReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + return ResLIMIT; +} + +void PoolNoFree(Pool pool, Addr old, Size size) +{ + AVERT(Pool, pool); + AVER(old != NULL); + AVER(size > 0); + NOTREACHED; +} + +void PoolTrivFree(Pool pool, Addr old, Size size) +{ + AVERT(Pool, pool); + AVER(old != NULL); + AVER(size > 0); + NOOP; /* trivial free has no effect */ +} + + +Res PoolNoBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + NOTREACHED; + return ResUNIMPL; +} + +Res PoolTrivBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Res res; + Addr p; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + res = PoolAlloc(&p, pool, size, withReservoirPermit); + if(res != ResOK) return res; + + *baseReturn = p; + *limitReturn = AddrAdd(p, size); + return ResOK; +} + + +void PoolNoBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit) +{ + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + AVER(init <= limit); + NOTREACHED; +} + +void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) +{ + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + AVER(init <= limit); + if (limit > init) + PoolFree(pool, init, AddrOffset(init, limit)); +} + + +Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream) +{ + AVERT(Pool, pool); + AVER(stream != NULL); + return WriteF(stream, " No class-specific description available.\n", NULL); +} + + +Res PoolNoTraceBegin(Pool pool, Trace trace) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVER(PoolArena(pool) == trace->arena); + NOTREACHED; + return ResUNIMPL; +} + +Res PoolTrivTraceBegin(Pool pool, Trace trace) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVER(PoolArena(pool) == trace->arena); + return ResOK; +} + +/* NoAccess + * + * Should be used (for the access method) by Pool Classes which do + * not expect to ever have pages which the mutator will fault on. + * That is, no protected pages, or only pages which are inaccessible + * by the mutator are protected. + */ +Res PoolNoAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + /* can't check AccessSet as there is no Check method */ + /* can't check context as there is no Check method */ + UNUSED(mode); + UNUSED(context); + + NOTREACHED; + return ResUNIMPL; +} + + +/* SegAccess + * + * Should be used (for the access method) by Pool Classes which intend + * to handle page faults by scanning the entire segment and lowering + * the barrier. + */ +Res PoolSegAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + AVER(SegPool(seg) == pool); + /* can't check AccessSet as there is no Check method */ + /* can't check context as there is no Check method */ + + UNUSED(addr); + UNUSED(context); + TraceSegAccess(PoolArena(pool), seg, mode); + return ResOK; +} + + +/* SingleAccess + * + * Handles page faults by attempting emulation. If the faulting + * instruction cannot be emulated then this function returns ResFAIL. + * + * Due to the assumptions made below, pool classes should only use + * this function if all words in an object are tagged or traceable. + * + * .single-access.assume.ref: It currently assumes that the address + * being faulted on contains a plain reference or a tagged non-reference. + * .single-access.improve.format: * later this will be abstracted + * through the cleint object format interface, so that + * no such assumption is necessary. + */ +Res PoolSingleAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context) +{ + Arena arena; + + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + AVER(SegPool(seg) == pool); + /* can't check AccessSet as there is no Check method */ + /* can't check context as there is no Check method */ + + arena = PoolArena(pool); + + if(ProtCanStepInstruction(context)) { + Ref ref; + Res res; + + ShieldExpose(arena, seg); + + if(mode & SegSM(seg) & AccessREAD) { + /* read access */ + /* .single-access.assume.ref */ + /* .single-access.improve.format */ + ref = *(Ref *)addr; + /* Check that the reference is aligned to a word boundary */ + /* (we assume it is not a reference otherwise) */ + if(WordIsAligned((Word)ref, sizeof(Word))) { + /* See the note in TraceSegAccess about using RankEXACT here */ + /* (impl.c.trace.scan.conservative) */ + TraceScanSingleRef(arena->flippedTraces, RankEXACT, arena, + seg, (Ref *)addr); + } + } + res = ProtStepInstruction(context); + AVER(res == ResOK); + + /* update SegSummary according to the possibly changed reference */ + ref = *(Ref *)addr; + SegSetSummary(seg, RefSetAdd(arena, SegSummary(seg), ref)); + + ShieldCover(arena, seg); + + return ResOK; + } else { + /* couldn't single-step instruction */ + return ResFAIL; + } +} + + +Res PoolTrivWhiten(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + + SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace)); + + return ResOK; +} + +Res PoolNoWhiten(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + NOTREACHED; + return ResUNIMPL; +} + + +void PoolNoGrey(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + NOTREACHED; +} + +void PoolTrivGrey(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + + /* @@@@ The trivial grey method probably shouldn't exclude */ + /* the white segments, since they might also contain grey objects. */ + if(!TraceSetIsMember(SegWhite(seg), trace)) + SegSetGrey(seg, TraceSetSingle(trace)); +} + + +void PoolNoBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + AVERT(Pool, pool); + AVERT(TraceSet, traceSet); + AVERT(Seg, seg); + NOTREACHED; +} + +void PoolTrivBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + AVERT(Pool, pool); + AVERT(TraceSet, traceSet); + AVERT(Seg, seg); + + /* The trivial blacken method does nothing; for pool classes which do */ + /* not keep additional colour information. */ + NOOP; +} + + +Res PoolNoScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Pool, pool); + AVERT(Seg, seg); + NOTREACHED; + return ResUNIMPL; +} + +Res PoolNoFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + AVERT(Pool, pool); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVER(refIO != NULL); + NOTREACHED; + return ResUNIMPL; +} + +void PoolNoReclaim(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + NOTREACHED; +} + + +void PoolNoRampBegin(Pool pool, Buffer buf, Bool collectAll) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + AVERT(Bool, collectAll); + NOTREACHED; +} + + +void PoolNoRampEnd(Pool pool, Buffer buf) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + NOTREACHED; +} + + +void PoolTrivRampBegin(Pool pool, Buffer buf, Bool collectAll) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + AVERT(Bool, collectAll); +} + + +void PoolTrivRampEnd(Pool pool, Buffer buf) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); +} + + +Res PoolNoFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf) +{ + AVER(frameReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buf); + NOTREACHED; + return ResUNIMPL; +} + + +Res PoolNoFramePop(Pool pool, Buffer buf, AllocFrame frame) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + /* frame is of a abstract type & can't be checked */ + UNUSED(frame); + NOTREACHED; + return ResUNIMPL; +} + + +void PoolNoFramePopPending(Pool pool, Buffer buf, AllocFrame frame) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + /* frame is of a abstract type & can't be checked */ + UNUSED(frame); + NOTREACHED; +} + + +Res PoolTrivFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf) +{ + AVER(frameReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buf); + return ResOK; +} + + +Res PoolTrivFramePop(Pool pool, Buffer buf, AllocFrame frame) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + /* frame is of a abstract type & can't be checked */ + UNUSED(frame); + return ResOK; +} + + +void PoolNoWalk(Pool pool, Seg seg, + FormattedObjectsStepMethod f, void *p, Size s) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary, hence can't be checked */ + UNUSED(p); + UNUSED(s); + + NOTREACHED; +} + + +BufferClass PoolNoBufferClass(void) +{ + NOTREACHED; + return NULL; +} diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c new file mode 100644 index 00000000000..519e5831bc2 --- /dev/null +++ b/mps/code/poolamc.c @@ -0,0 +1,2058 @@ +/* impl.c.poolamc: AUTOMATIC MOSTLY-COPYING MEMORY POOL CLASS + * + * $HopeName: MMsrc!poolamc.c(trunk.55) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .sources: design.mps.poolamc. + */ + +#include "mpscamc.h" +#include "chain.h" +#include "mpm.h" + +SRCID(poolamc, "$HopeName: MMsrc!poolamc.c(trunk.55) $"); + + +/* PType enumeration -- distinguishes AMCGen and AMCNailboard */ +enum {AMCPTypeGen = 1, AMCPTypeNailboard}; + +/* AMC typedef */ +typedef struct AMCStruct *AMC; + +/* amcGen typedef */ +typedef struct amcGenStruct *amcGen; + +/* forward declarations */ + +static Bool AMCCheck(AMC amc); +static Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO); +static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO); +static PoolClass AMCPoolClassGet(void); +static BufferClass amcBufClassGet(void); +static SegClass amcSegClassGet(void); + + +/* amcGenStruct -- pool AMC generation descriptor */ + +#define amcGenSig ((Sig)0x519A3C9E) /* SIGnature AMC GEn */ + +typedef struct amcGenStruct { + PoolGenStruct pgen; + int type; /* AMCPTypeGen for a gen */ + RingStruct amcRing; /* link in list of gens in pool */ + Buffer forward; /* forwarding buffer */ + Count segs; /* number of segs in gen */ + Sig sig; /* impl.h.misc.sig */ +} amcGenStruct; + +#define amcGenAMC(amcgen) Pool2AMC((amcgen)->pgen.pool) +#define amcGenPool(amcgen) ((amcgen)->pgen.pool) + +#define amcGenNr(amcgen) ((amcgen)->pgen.nr) + + +enum {outsideRamp = 1, beginRamp, ramping, finishRamp, collectingRamp}; + + +/* amcNailboard -- the nailboard */ + +typedef struct amcNailboardStruct *amcNailboard; +typedef struct amcNailboardStruct { + Sig sig; + int type; /* AMCPTypeNailboard for a nailboard */ + amcGen gen; /* generation of this segment */ + Count nails; /* number of ambigFixes, not necessarily distinct */ + Count distinctNails; /* number of distinct ambigFixes */ + Bool newMarks; /* set to TRUE if a new mark bit is added */ + Shift markShift; /* shift to convert offset into bit index for mark */ + BT mark; /* mark table used to record ambiguous fixes */ +} amcNailboardStruct; + +#define amcNailboardSig ((Sig)0x519A3C4B) /* SIGnature AMC Nailboard */ + + +/* AMCGSegStruct -- AMC segment structure + * + * .segtype: AMC segs have a pointer to the type field of either + * a nailboard or a generation. This initial value is passed + * as an additional parameter when the segment is allocated. + * See design.mps.poolamc.fix.nail.distinguish. + */ + +typedef struct amcSegStruct *amcSeg; + +#define amcSegSig ((Sig)0x519A3C59) /* SIGnature AMC SeG */ + +typedef struct amcSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + int *segTypeP; /* .segtype */ + Bool new; /* allocated since last GC */ + Sig sig; /* impl.h.misc.sig */ +} amcSegStruct; + +#define Seg2amcSeg(seg) ((amcSeg)(seg)) +#define amcSeg2Seg(amcseg) ((Seg)(amcseg)) + +#define amcSegTypeP(seg) (Seg2amcSeg(seg)->segTypeP) +#define amcSegSetTypeP(seg, type) (Seg2amcSeg(seg)->segTypeP = (type)) + + +static Bool amcSegCheck(amcSeg amcseg) +{ + CHECKS(amcSeg, amcseg); + CHECKD(GCSeg, &amcseg->gcSegStruct); + CHECKL(*amcseg->segTypeP == AMCPTypeNailboard + || *amcseg->segTypeP == AMCPTypeGen); + CHECKL(BoolCheck(amcseg->new)); + return TRUE; +} + + +/* AMCSegInit -- initialise an AMC segment */ + +static Res AMCSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + int *segtype = va_arg(args, int*); /* .segtype */ + SegClass super; + amcSeg amcseg; + Res res; + + AVERT(Seg, seg); + amcseg = Seg2amcSeg(seg); + /* no useful checks for base and size */ + AVERT(Bool, reservoirPermit); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(amcSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + + amcseg->segTypeP = segtype; /* .segtype */ + amcseg->new = TRUE; + amcseg->sig = amcSegSig; + AVERT(amcSeg, amcseg); + + return ResOK; +} + + +/* AMCSegDescribe -- describe the contents of a segment + * + * See design.mps.poolamc.seg-describe. + */ +static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) +{ + Res res; + Pool pool; + amcSeg amcseg; + SegClass super; + Addr i, p, base, limit, init; + Align step; + Size row; + + if (!CHECKT(Seg, seg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + amcseg = Seg2amcSeg(seg); + if (!CHECKT(amcSeg, amcseg)) return ResFAIL; + + /* Describe the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(GCSegClass); + res = super->describe(seg, stream); + if (res != ResOK) return res; + + pool = SegPool(seg); + step = PoolAlignment(pool); + row = step * 64; + + base = SegBase(seg); + p = AddrAdd(base, pool->format->headerSize); + limit = SegLimit(seg); + if (SegBuffer(seg) != NULL) + init = BufferGetInit(SegBuffer(seg)); + else + init = limit; + + res = WriteF(stream, + "AMC seg $P [$A,$A){\n", + (WriteFP)seg, (WriteFA)base, (WriteFA)limit, + " Map\n", + NULL); + if (res != ResOK) return res; + + for(i = base; i < limit; i = AddrAdd(i, row)) { + Addr j; + char c; + + res = WriteF(stream, " $A ", i, NULL); + if (res != ResOK) return res; + + /* @@@@ This needs to describe nailboards as well */ + /* @@@@ This misses a header-sized pad at the end. */ + for(j = i; j < AddrAdd(i, row); j = AddrAdd(j, step)) { + if (j >= limit) + c = ' '; + else if (j >= init) + c = '.'; + else if (j == p) { + c = '*'; + p = (pool->format->skip)(p); + } else + c = '='; + res = WriteF(stream, "$C", c, NULL); + if (res != ResOK) return res; + } + + res = WriteF(stream, "\n", NULL); + if (res != ResOK) return res; + } + + res = WriteF(stream, "} AMC Seg $P\n", (WriteFP)seg, NULL); + if (res != ResOK) return res; + + return ResOK; +} + + +/* amcSegClass -- Class definition for AMC segments */ + +DEFINE_SEG_CLASS(amcSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + SegClassMixInNoSplitMerge(class); /* no support for this (yet) */ + class->name = "AMCSEG"; + class->size = sizeof(amcSegStruct); + class->init = AMCSegInit; + class->describe = AMCSegDescribe; +} + + + +/* amcSegHasNailboard -- test whether the segment has a nailboard + * + * See design.mps.poolamc.fix.nail.distinguish. + */ +static Bool amcSegHasNailboard(Seg seg) +{ + int type; + + type = *amcSegTypeP(seg); + AVER(type == AMCPTypeNailboard || type == AMCPTypeGen); + return type == AMCPTypeNailboard; +} + + +/* amcSegNailboard -- get the nailboard for this segment */ + +static amcNailboard amcSegNailboard(Seg seg) +{ + int *p; + + p = amcSegTypeP(seg); + AVER(amcSegHasNailboard(seg)); + return PARENT(amcNailboardStruct, type, p); +} + + +/* amcSegGen -- get the generation structure for this segment */ + +static amcGen amcSegGen(Seg seg) +{ + if (amcSegHasNailboard(seg)) { + amcNailboard Nailboard = amcSegNailboard(seg); + return Nailboard->gen; + } else { + int *p; + p = amcSegTypeP(seg); + return PARENT(amcGenStruct, type, p); + } +} + + +/* AMCStruct -- pool AMC descriptor + * + * See design.mps.poolamc.struct. + */ + +#define AMCSig ((Sig)0x519A3C99) /* SIGnature AMC */ + +typedef struct AMCStruct { /* design.mps.poolamc.struct */ + PoolStruct poolStruct; /* generic pool structure */ + RankSet rankSet; /* rankSet for entire pool */ + RingStruct genRing; /* ring of generations */ + Bool gensBooted; /* used during boot (init) */ + Chain chain; /* chain used by this pool */ + size_t gens; /* number of generations */ + amcGen *gen; /* (pointer to) array of generations */ + amcGen nursery; /* the default mutator generation */ + amcGen rampGen; /* the ramp generation */ + amcGen afterRampGen; /* the generation after rampGen */ + unsigned rampCount; /* design.mps.poolamc.ramp.count */ + int rampMode; /* design.mps.poolamc.ramp.mode */ + Sig sig; /* design.mps.pool.outer-structure.sig */ +} AMCStruct; + +#define Pool2AMC(pool) PARENT(AMCStruct, poolStruct, (pool)) +#define AMC2Pool(amc) (&(amc)->poolStruct) + + +/* amcGenCheck -- check consistency of a generation structure */ + +static Bool amcGenCheck(amcGen gen) +{ + Arena arena; + AMC amc; + + CHECKS(amcGen, gen); + CHECKD(PoolGen, &gen->pgen); + amc = amcGenAMC(gen); + CHECKU(AMC, amc); + CHECKL(gen->type == AMCPTypeGen); + CHECKD(Buffer, gen->forward); + CHECKL(RingCheck(&gen->amcRing)); + CHECKL((gen->pgen.totalSize == 0) == (gen->segs == 0)); + arena = amc->poolStruct.arena; + CHECKL(gen->pgen.totalSize >= gen->segs * ArenaAlign(arena)); + return TRUE; +} + + +/* amcNailboardCheck -- check the nailboard */ + +static Bool amcNailboardCheck(amcNailboard board) +{ + CHECKS(amcNailboard, board); + CHECKL(board->type == AMCPTypeNailboard); + CHECKD(amcGen, board->gen); + /* nails is >= number of set bits in mark, but we can't check this. */ + /* We know that shift corresponds to pool->align */ + CHECKL(BoolCheck(board->newMarks)); + CHECKL(board->distinctNails <= board->nails); + CHECKL(1uL << board->markShift == PoolAlignment(amcGenPool(board->gen))); + /* weak check for BTs @@@@ */ + CHECKL(board->mark != NULL); + return TRUE; +} + + +/* amcBufStruct -- AMC Buffer subclass + * + * This subclass of SegBuf records a link to a generation. + */ + +#define amcBufSig ((Sig)0x519A3CBF) /* SIGnature AMC BuFfer */ + +typedef struct amcBufStruct *amcBuf; + +typedef struct amcBufStruct { + SegBufStruct segbufStruct; /* superclass fields must come first */ + amcGen gen; /* The AMC generation */ + Sig sig; /* design.mps.sig */ +} amcBufStruct; + + +/* Buffer2amcBuf -- convert generic Buffer to an amcBuf */ + +#define Buffer2amcBuf(buffer) ((amcBuf)(buffer)) + + + +/* amcBufCheck -- check consistency of an amcBuf */ + +static Bool amcBufCheck(amcBuf amcbuf) +{ + SegBuf segbuf; + + CHECKS(amcBuf, amcbuf); + segbuf = &amcbuf->segbufStruct; + CHECKL(SegBufCheck(segbuf)); + if (amcbuf->gen != NULL) + CHECKD(amcGen, amcbuf->gen); + return TRUE; +} + + +/* amcBufGen -- Return the AMC generation of an amcBuf */ + +static amcGen amcBufGen(Buffer buffer) +{ + return Buffer2amcBuf(buffer)->gen; +} + + +/* amcBufSetGen -- Set the AMC generation of an amcBuf */ + +static void amcBufSetGen(Buffer buffer, amcGen gen) +{ + amcBuf amcbuf; + + if (gen != NULL) + AVERT(amcGen, gen); + amcbuf = Buffer2amcBuf(buffer); + amcbuf->gen = gen; +} + + +/* AMCBufInit -- Initialize an amcBuf */ + +static Res AMCBufInit(Buffer buffer, Pool pool, va_list args) +{ + AMC amc; + amcBuf amcbuf; + BufferClass superclass; + Res res; + + AVERT(Buffer, buffer); + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + + /* call next method */ + superclass = BUFFER_SUPERCLASS(amcBufClass); + res = (*superclass->init)(buffer, pool, args); + if (res != ResOK) + return res; + + amcbuf = Buffer2amcBuf(buffer); + if (BufferIsMutator(buffer)) { + /* Set up the buffer to be allocating in the nursery. */ + amcbuf->gen = amc->nursery; + } else { + amcbuf->gen = NULL; /* no gen yet -- see design.mps.poolamc.forward.gen */ + } + amcbuf->sig = amcBufSig; + AVERT(amcBuf, amcbuf); + + BufferSetRankSet(buffer, amc->rankSet); + + return ResOK; +} + + +/* AMCBufFinish -- Finish an amcBuf */ + +static void AMCBufFinish(Buffer buffer) +{ + BufferClass super; + amcBuf amcbuf; + + AVERT(Buffer, buffer); + amcbuf = Buffer2amcBuf(buffer); + AVERT(amcBuf, amcbuf); + + amcbuf->sig = SigInvalid; + + /* finish the superclass fields last */ + super = BUFFER_SUPERCLASS(amcBufClass); + super->finish(buffer); +} + + +/* amcBufClass -- The class definition */ + +DEFINE_BUFFER_CLASS(amcBufClass, class) +{ + INHERIT_CLASS(class, SegBufClass); + class->name = "AMCBUF"; + class->size = sizeof(amcBufStruct); + class->init = AMCBufInit; + class->finish = AMCBufFinish; +} + + +/* amcGenCreate -- create a generation */ + +static Res amcGenCreate(amcGen *genReturn, AMC amc, Serial genNr) +{ + Arena arena; + Buffer buffer; + Pool pool; + amcGen gen; + Res res; + void *p; + + pool = AMC2Pool(amc); + arena = pool->arena; + + res = ControlAlloc(&p, arena, sizeof(amcGenStruct), FALSE); + if (res != ResOK) + goto failControlAlloc; + gen = (amcGen)p; + + res = BufferCreate(&buffer, EnsureamcBufClass(), pool, FALSE); + if (res != ResOK) + goto failBufferCreate; + + res = PoolGenInit(&gen->pgen, amc->chain, genNr, pool); + if (res != ResOK) + goto failGenInit; + gen->type = AMCPTypeGen; + RingInit(&gen->amcRing); + gen->segs = 0; + gen->forward = buffer; + gen->sig = amcGenSig; + + AVERT(amcGen, gen); + + RingAppend(&amc->genRing, &gen->amcRing); + EVENT_PP(AMCGenCreate, amc, gen); + *genReturn = gen; + return ResOK; + +failGenInit: + BufferDestroy(buffer); +failBufferCreate: + ControlFree(arena, p, sizeof(amcGenStruct)); +failControlAlloc: + return res; +} + + +/* amcGenDestroy -- destroy a generation */ + +static void amcGenDestroy(amcGen gen) +{ + Arena arena; + + AVERT(amcGen, gen); + AVER(gen->segs == 0); + AVER(gen->pgen.totalSize == 0); + + EVENT_P(AMCGenDestroy, gen); + arena = PoolArena(amcGenPool(gen)); + gen->sig = SigInvalid; + RingRemove(&gen->amcRing); + RingFinish(&gen->amcRing); + PoolGenFinish(&gen->pgen); + BufferDestroy(gen->forward); + ControlFree(arena, gen, sizeof(amcGenStruct)); +} + + +/* amcGenDescribe -- describe an AMC generation */ + +static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(amcGen, gen)) return ResFAIL; + + res = WriteF(stream, + " amcGen $P ($U) {\n", (WriteFP)gen, (WriteFU)amcGenNr(gen), + " buffer $P\n", gen->forward, + " segs $U, totalSize $U, newSize $U\n", (WriteFU)gen->segs, + (WriteFU)gen->pgen.totalSize, (WriteFU)gen->pgen.newSize, + " } amcGen\n", NULL); + return res; +} + + +/* amcSegCreateNailboard -- create nailboard for segment */ + +static Res amcSegCreateNailboard(Seg seg, Pool pool) +{ + amcNailboard board; + Arena arena; + Count bits; + Res res; + void *p; + + AVER(!amcSegHasNailboard(seg)); + + arena = PoolArena(pool); + + res = ControlAlloc(&p, arena, sizeof(amcNailboardStruct), FALSE); + if (res != ResOK) + goto failAllocNailboard; + board = p; + board->type = AMCPTypeNailboard; + board->gen = amcSegGen(seg); + board->nails = (Count)0; + board->distinctNails = (Count)0; + board->newMarks = FALSE; + board->markShift = SizeLog2((Size)pool->alignment); + /* See d.m.p.Nailboard.size. */ + bits = (SegSize(seg) + pool->format->headerSize) >> board->markShift; + res = ControlAlloc(&p, arena, BTSize(bits), FALSE); + if (res != ResOK) + goto failMarkTable; + board->mark = p; + BTResRange(board->mark, 0, bits); + board->sig = amcNailboardSig; + AVERT(amcNailboard, board); + amcSegSetTypeP(seg, &board->type); /* .segtype */ + return ResOK; + +failMarkTable: + ControlFree(arena, board, sizeof(amcNailboardStruct)); +failAllocNailboard: + return res; +} + + +/* amcSegDestroyNailboard -- destroy the nailboard of a segment */ + +static void amcSegDestroyNailboard(Seg seg, Pool pool) +{ + amcNailboard board; + amcGen gen; + Arena arena; + Count bits; + + gen = amcSegGen(seg); + board = amcSegNailboard(seg); + AVERT(amcNailboard, board); + + arena = PoolArena(pool); + bits = SegSize(seg) >> board->markShift; + ControlFree(arena, board->mark, BTSize(bits)); + board->sig = SigInvalid; + ControlFree(arena, board, sizeof(amcNailboardStruct)); + amcSegSetTypeP(seg, &gen->type); /* .segtype */ +} + + +/* amcNailGetMark -- get the mark bit for ref from the nailboard */ + +static Bool amcNailGetMark(Seg seg, Ref ref) +{ + amcNailboard board; + Index i; + + board = amcSegNailboard(seg); + AVERT(amcNailboard, board); + + i = AddrOffset(SegBase(seg), ref) >> board->markShift; + return BTGet(board->mark, i); +} + + +/* amcNailGetAndSetMark -- set the mark bit for ref in the nailboard + * + * Returns the old value. + */ +static Bool amcNailGetAndSetMark(Seg seg, Ref ref) +{ + amcNailboard board; + Index i; + + board = amcSegNailboard(seg); + AVERT(amcNailboard, board); + + ++board->nails; + i = AddrOffset(SegBase(seg), ref) >> board->markShift; + if (!BTGet(board->mark, i)) { + BTSet(board->mark, i); + board->newMarks = TRUE; + ++board->distinctNails; + return FALSE; + } + return TRUE; +} + + +/* amcNailMarkRange -- nail a range in the board + * + * We nail the objects laying between base and limit, i.e., mark the + * bits that correspond to client pointers for them. We may assume that + * the range is unmarked. + */ +static void amcNailMarkRange(Seg seg, Addr base, Addr limit) +{ + amcNailboard board; + Index ibase, ilimit; + Size headerSize; + + AVER(SegBase(seg) <= base && base < SegLimit(seg)); + AVER(SegBase(seg) <= limit && limit <= SegLimit(seg)); + AVER(base < limit); + + board = amcSegNailboard(seg); + AVERT(amcNailboard, board); + headerSize = SegPool(seg)->format->headerSize; + ibase = (AddrOffset(SegBase(seg), base) + headerSize) >> board->markShift; + ilimit = (AddrOffset(SegBase(seg), limit) + headerSize) >> board->markShift; + AVER(BTIsResRange(board->mark, ibase, ilimit)); + + BTSetRange(board->mark, ibase, ilimit); + board->nails += ilimit - ibase; + board->distinctNails += ilimit - ibase; +} + + +/* amcNailRangeIsMarked -- check that a range in the board is marked + * + * Like amcNailMarkRange, we take the arguments as referring to base + * pointers and look at the bits of the corresponding client pointers. + */ +static Bool amcNailRangeIsMarked(Seg seg, Addr base, Addr limit) +{ + amcNailboard board; + Index ibase, ilimit; + Size headerSize; + + AVER(SegBase(seg) <= base && base < SegLimit(seg)); + AVER(SegBase(seg) <= limit && limit <= SegLimit(seg)); + AVER(base < limit); + + board = amcSegNailboard(seg); + AVERT(amcNailboard, board); + headerSize = SegPool(seg)->format->headerSize; + ibase = (AddrOffset(SegBase(seg), base) + headerSize) >> board->markShift; + ilimit = (AddrOffset(SegBase(seg), limit) + headerSize) >> board->markShift; + return BTIsSetRange(board->mark, ibase, ilimit); +} + + +/* amcInitComm -- initialize AMC/Z pool + * + * See design.mps.poolamc.init. + * Shared by AMCInit and AMCZinit. + */ +static Res amcInitComm(Pool pool, RankSet rankSet, va_list arg) +{ + AMC amc; + Res res; + Arena arena; + Index i; + size_t genArraySize; + size_t genCount; + + AVER(pool != NULL); + + amc = Pool2AMC(pool); + arena = PoolArena(pool); + + pool->format = va_arg(arg, Format); + AVERT(Format, pool->format); + pool->alignment = pool->format->alignment; + amc->chain = va_arg(arg, Chain); + AVERT(Chain, amc->chain); + amc->rankSet = rankSet; + + RingInit(&amc->genRing); + /* amc gets checked before the generations get created, but they */ + /* do get created later in this function. */ + amc->gen = NULL; + amc->nursery = NULL; + amc->rampGen = NULL; + amc->afterRampGen = NULL; + amc->gensBooted = FALSE; + + amc->rampCount = 0; + amc->rampMode = outsideRamp; + + if (pool->format->headerSize == 0) { + pool->fix = AMCFix; + } else { + pool->fix = AMCHeaderFix; + } + + amc->sig = AMCSig; + AVERT(AMC, amc); + + /* Init generations. */ + genCount = ChainGens(amc->chain); + { + void *p; + + genArraySize = sizeof(amcGen) * (genCount + 1); /* chain plus dynamic gen */ + res = ControlAlloc(&p, arena, genArraySize, FALSE); + if (res != ResOK) + goto failGensAlloc; + amc->gen = p; + for(i = 0; i < genCount + 1; ++i) { + res = amcGenCreate(&amc->gen[i], amc, (Serial)i); + if (res != ResOK) { + goto failGenAlloc; + } + } + /* Set up forwarding buffers. */ + for(i = 0; i < genCount; ++i) { + amcBufSetGen(amc->gen[i]->forward, amc->gen[i+1]); + } + /* Dynamic gen forwards to itself. */ + amcBufSetGen(amc->gen[genCount]->forward, amc->gen[genCount]); + } + amc->nursery = amc->gen[0]; + amc->rampGen = amc->gen[genCount-1]; /* last ephemeral gen */ + amc->afterRampGen = amc->gen[genCount]; + amc->gensBooted = TRUE; + + AVERT(AMC, amc); + EVENT_PP(AMCInit, pool, amc); + if (rankSet == RankSetEMPTY) + EVENT_PP(PoolInitAMCZ, pool, pool->format); + else + EVENT_PP(PoolInitAMC, pool, pool->format); + return ResOK; + +failGenAlloc: + while(i > 0) { + --i; + amcGenDestroy(amc->gen[i]); + } + ControlFree(arena, amc->gen, genArraySize); +failGensAlloc: + return res; +} + +static Res AMCInit(Pool pool, va_list arg) +{ + return amcInitComm(pool, RankSetSingle(RankEXACT), arg); +} + +static Res AMCZInit(Pool pool, va_list arg) +{ + return amcInitComm(pool, RankSetEMPTY, arg); +} + + +/* AMCFinish -- finish AMC pool + * + * See design.mps.poolamc.finish. + */ +static void AMCFinish(Pool pool) +{ + AMC amc; + Ring ring; + Ring node, nextNode; + + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + + EVENT_P(AMCFinish, amc); + + /* @@@@ Make sure that segments aren't buffered by forwarding buffers. */ + /* This is a hack which allows the pool to be destroyed */ + /* while it is collecting. Note that there aren't any mutator */ + /* buffers by this time. */ + RING_FOR(node, &amc->genRing, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + BufferDetach(gen->forward, pool); + gen->pgen.newSize = (Size)0; /* to maintain invariant < totalSize */ + } + + ring = PoolSegRing(pool); + RING_FOR(node, ring, nextNode) { + Seg seg = SegOfPoolRing(node); + Size size; + amcGen gen = amcSegGen(seg); + + --gen->segs; + size = SegSize(seg); + gen->pgen.totalSize -= size; + + SegFree(seg); + } + + /* Disassociate forwarding buffers from gens before they are destroyed */ + ring = &amc->genRing; + RING_FOR(node, ring, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + amcBufSetGen(gen->forward, NULL); + } + RING_FOR(node, ring, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + amcGenDestroy(gen); + } + + amc->sig = SigInvalid; +} + + +/* AMCBufferFill -- refill an allocation buffer + * + * See design.mps.poolamc.fill. + */ +static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Seg seg; + AMC amc; + Res res; + Addr base, limit; + Arena arena; + Size alignedSize; + amcGen gen; + Serial genNr; + SegPrefStruct segPrefStruct; + + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + AVER(size > 0); + AVERT(Bool, withReservoirPermit); + + gen = amcBufGen(buffer); + AVERT(amcGen, gen); + + /* Create and attach segment. The location of this segment is */ + /* expressed as a generation number. We rely on the arena to */ + /* organize locations appropriately. */ + arena = PoolArena(pool); + alignedSize = SizeAlignUp(size, ArenaAlign(arena)); + segPrefStruct = *SegPrefDefault(); + SegPrefExpress(&segPrefStruct, SegPrefCollected, NULL); + genNr = PoolGenNr(&gen->pgen); + SegPrefExpress(&segPrefStruct, SegPrefGen, &genNr); + res = SegAlloc(&seg, amcSegClassGet(), &segPrefStruct, + alignedSize, pool, withReservoirPermit, + &gen->type); /* .segtype */ + if (res != ResOK) + return res; + + /* design.mps.seg.field.rankSet.start */ + if (BufferRankSet(buffer) == RankSetEMPTY) + SegSetRankAndSummary(seg, BufferRankSet(buffer), RefSetEMPTY); + else + SegSetRankAndSummary(seg, BufferRankSet(buffer), RefSetUNIV); + + /* Put the segment in the generation indicated by the buffer. */ + ++gen->segs; + gen->pgen.totalSize += alignedSize; + /* If ramping, don't count survivors in newSize. */ + if (amc->rampMode != ramping + || buffer != amc->rampGen->forward || gen != amc->rampGen) { + gen->pgen.newSize += alignedSize; + } else { + Seg2amcSeg(seg)->new = FALSE; + } + PoolGenUpdateZones(&gen->pgen, seg); + + /* Give the buffer the entire segment to allocate in. */ + base = SegBase(seg); + *baseReturn = base; + limit = AddrAdd(base, alignedSize); + AVER(limit == SegLimit(seg)); + *limitReturn = limit; + return ResOK; +} + + +/* amcBufferEmpty -- detach a buffer from a segment + * + * See design.mps.poolamc.flush. + */ +static void AMCBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) +{ + AMC amc; + Size size; + Arena arena; + Seg seg; + + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + seg = BufferSeg(buffer); + AVERT(Seg, seg); + AVER(init <= limit); + AVER(SegLimit(seg) == limit); + + arena = BufferArena(buffer); + + /* design.mps.poolamc.flush.pad */ + size = AddrOffset(init, limit); + if (size > 0) { + ShieldExpose(arena, seg); + (*pool->format->pad)(init, size); + ShieldCover(arena, seg); + } +} + + +/* AMCRampBegin -- note an entry into a ramp pattern */ + +static void AMCRampBegin(Pool pool, Buffer buf, Bool collectAll) +{ + AMC amc; + + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + AVERT(Buffer, buf); + AVERT(Bool, collectAll); + UNUSED(collectAll); /* obsolete */ + + AVER(amc->rampCount < UINT_MAX); + ++amc->rampCount; + if (amc->rampCount == 1) { + if (amc->rampMode != finishRamp) + amc->rampMode = beginRamp; + } +} + + +/* AMCRampEnd -- note an exit from a ramp pattern */ + +static void AMCRampEnd(Pool pool, Buffer buf) +{ + AMC amc; + + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + AVERT(Buffer, buf); + + AVER(amc->rampCount > 0); + --amc->rampCount; + if (amc->rampCount == 0) { + PoolGen pgen = &amc->rampGen->pgen; + Ring node, nextNode; + + if (amc->rampMode == ramping) /* if we are ramping, clean up */ + amc->rampMode = finishRamp; + else + amc->rampMode = outsideRamp; + + /* Adjust amc->rampGen->pgen.newSize: Now count all the segments in the */ + /* ramp generation as new (except if they're white). */ + RING_FOR(node, PoolSegRing(pool), nextNode) { + Seg seg = SegOfPoolRing(node); + + if (amcSegGen(seg) == amc->rampGen && !Seg2amcSeg(seg)->new + && SegWhite(seg) == TraceSetEMPTY) { + pgen->newSize += SegSize(seg); + Seg2amcSeg(seg)->new = TRUE; + } + } + } +} + + +/* AMCWhiten -- condemn the segment for the trace + * + * If the segment has a mutator buffer on it, we nail the buffer, + * because we can't scan or reclaim uncommitted buffers. + */ +static Res AMCWhiten(Pool pool, Trace trace, Seg seg) +{ + amcGen gen; + AMC amc; + Buffer buffer; + Res res; + + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + + buffer = SegBuffer(seg); + if (buffer != NULL) { + AVERT(Buffer, buffer); + + if (!BufferIsMutator(buffer)) { /* forwarding buffer */ + AVER(BufferIsReady(buffer)); + BufferDetach(buffer, pool); + } else { /* mutator buffer */ + if (BufferScanLimit(buffer) == SegBase(seg)) + /* There's nothing but the buffer, don't condemn. */ + return ResOK; + else /* if (BufferScanLimit(buffer) == BufferLimit(buffer)) { */ + /* The buffer is full, so it won't be used by the mutator. */ + /* @@@@ We should detach it, but can't for technical reasons. */ + /* BufferDetach(buffer, pool); */ + /* } else */ { + /* There is an active buffer, make sure it's nailed. */ + if (!amcSegHasNailboard(seg)) { + if (SegNailed(seg) == TraceSetEMPTY) { + res = amcSegCreateNailboard(seg, pool); + if (res != ResOK) + return ResOK; /* can't create nailboard, don't condemn */ + if (BufferScanLimit(buffer) != BufferLimit(buffer)) + amcNailMarkRange(seg, BufferScanLimit(buffer), + BufferLimit(buffer)); + ++trace->nailCount; + SegSetNailed(seg, TraceSetSingle(trace)); + } else { + /* Segment is nailed already, cannot create a nailboard */ + /* (see .nail.new), just give up condemning. */ + return ResOK; + } + } else { + /* We have a nailboard, the buffer must be nailed already. */ + AVER((BufferScanLimit(buffer) == BufferLimit(buffer)) + || amcNailRangeIsMarked(seg, BufferScanLimit(buffer), + BufferLimit(buffer))); + /* Nail it for this trace as well. */ + SegSetNailed(seg, TraceSetAdd(SegNailed(seg), trace)); + } + /* We didn't condemn the buffer, subtract it from the count. */ + /* @@@@ We could subtract all the nailed grains. */ + /* Relies on unsigned arithmetic wrapping round */ + /* on under- and overflow (which it does). */ + trace->condemned -= AddrOffset(BufferScanLimit(buffer), + BufferLimit(buffer)); + } + } + } + + SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace)); + trace->condemned += SegSize(seg); + + gen = amcSegGen(seg); + AVERT(amcGen, gen); + if (Seg2amcSeg(seg)->new) { + gen->pgen.newSize -= SegSize(seg); + Seg2amcSeg(seg)->new = FALSE; + } + + /* Ensure we are forwarding into the right generation. */ + + amc = Pool2AMC(pool); + AVERT(AMC, amc); + /* see design.mps.poolamc.gen.ramp */ + /* This switching needs to be more complex for multiple traces. */ + AVER(TraceSetIsSingle(PoolArena(pool)->busyTraces)); + if (amc->rampMode == beginRamp && gen == amc->rampGen) { + BufferDetach(gen->forward, pool); + amcBufSetGen(gen->forward, gen); + amc->rampMode = ramping; + } else { + if (amc->rampMode == finishRamp && gen == amc->rampGen) { + BufferDetach(gen->forward, pool); + amcBufSetGen(gen->forward, amc->afterRampGen); + amc->rampMode = collectingRamp; + } + } + + return ResOK; +} + + +/* amcScanNailedOnce -- make one scanning pass over a nailed segment + * + * *totalReturn set to TRUE iff all objects in segment scanned. + * *moreReturn set to FALSE only if there are no more objects + * on the segment that need scanning (which is normally the case). + * It is set to TRUE if scanning had to be abandoned early on, and + * also if during emergency fixing any new marks got added to the + * nailboard. + */ +static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, + ScanState ss, Pool pool, Seg seg, AMC amc) +{ + Addr p, limit; + Format format; + Res res; + Bool total = TRUE; + Size bytesScanned = 0; + + UNUSED(amc); /* Actually only unused when telemetry is off. @@@@ */ + + EVENT_PPP(AMCScanBegin, amc, seg, ss); /* @@@@ use own event */ + + format = pool->format; + amcSegNailboard(seg)->newMarks = FALSE; + + p = AddrAdd(SegBase(seg), format->headerSize); + while(SegBuffer(seg) != NULL) { + limit = AddrAdd(BufferScanLimit(SegBuffer(seg)), format->headerSize); + if (p >= limit) { + AVER(p == limit); + goto returnGood; + } + while(p < limit) { + Addr q; + q = (*format->skip)(p); + if (amcNailGetMark(seg, p)) { + res = (*format->scan)(ss, p, q); + if (res != ResOK) { + *totalReturn = FALSE; *moreReturn = TRUE; + return res; + } + bytesScanned += AddrOffset(p, q); + } else { + total = FALSE; + } + p = q; + } + AVER(p == limit); + } + + /* Should have a ScanMarkedRange or something like that @@@@ */ + /* to abstract common code. */ + limit = AddrAdd(SegLimit(seg), format->headerSize); + /* @@@@ Shouldn't p be set to BufferLimit here?! */ + while(p < limit) { + Addr q; + q = (*format->skip)(p); + if (amcNailGetMark(seg, p)) { + res = (*format->scan)(ss, p, q); + if (res != ResOK) { + *totalReturn = FALSE; *moreReturn = TRUE; + return res; + } + bytesScanned += AddrOffset(p, q); + } else { + total = FALSE; + } + p = q; + } + AVER(p == limit); + +returnGood: + EVENT_PPP(AMCScanEnd, amc, seg, ss); /* @@@@ use own event */ + + AVER(bytesScanned <= SegSize(seg)); + ss->scannedSize += bytesScanned; + *totalReturn = total; + *moreReturn = amcSegNailboard(seg)->newMarks; + return ResOK; +} + + +/* amcScanNailed -- scan a nailed segment */ + +static Res amcScanNailed(Bool *totalReturn, ScanState ss, Pool pool, + Seg seg, AMC amc) +{ + Bool total, moreScanning; + + do { + Res res; + res = amcScanNailedOnce(&total, &moreScanning, ss, pool, seg, amc); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + } while(moreScanning); + + *totalReturn = total; + return ResOK; +} + + +/* AMCScan -- scan a single seg, turning it black + * + * See design.mps.poolamc.seg-scan. + */ +static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + Addr base, limit; + Arena arena; + Format format; + AMC amc; + Res res; + + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVERT(Pool, pool); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + + + format = pool->format; + arena = pool->arena; + + if (amcSegHasNailboard(seg)) { + return amcScanNailed(totalReturn, ss, pool, seg, amc); + } + + EVENT_PPP(AMCScanBegin, amc, seg, ss); + + base = AddrAdd(SegBase(seg), format->headerSize); + while(SegBuffer(seg) != NULL) { /* design.mps.poolamc.seg-scan.loop */ + limit = AddrAdd(BufferScanLimit(SegBuffer(seg)), format->headerSize); + if (base >= limit) { + /* @@@@ Are we sure we don't need scan the rest of the segment? */ + AVER(base == limit); + *totalReturn = TRUE; + return ResOK; + } + res = (*format->scan)(ss, base, limit); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + ss->scannedSize += AddrOffset(base, limit); + base = limit; + } + + /* design.mps.poolamc.seg-scan.finish @@@@ base? */ + limit = AddrAdd(SegLimit(seg), format->headerSize); + AVER(SegBase(seg) <= base + && base <= AddrAdd(SegLimit(seg), format->headerSize)); + if (base < limit) { + res = (*format->scan)(ss, base, limit); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + } + + ss->scannedSize += AddrOffset(base, limit); + EVENT_PPP(AMCScanEnd, amc, seg, ss); + + *totalReturn = TRUE; + return ResOK; +} + + +/* amcFixInPlace -- fix an reference without moving the object + * + * Usually this function is used for ambiguous references, but during + * emergency tracing may be used for references of any rank. + * + * If the segment has a nailboard then we use that to record the fix. + * Otherwise we simply grey and nail the entire segment. + */ +static void amcFixInPlace(Pool pool, Seg seg, ScanState ss, Ref *refIO) +{ + Addr ref; + + UNUSED(pool); + + ref = (Addr)*refIO; + /* An ambiguous reference can point before the header. */ + AVER(SegBase(seg) <= ref); + /* .ref-limit: A reference passed to Fix can't be beyond the segment, */ + /* because then TraceFix would not have picked this segment. */ + AVER(ref < SegLimit(seg)); + + EVENT_0(AMCFixInPlace); + if (amcSegHasNailboard(seg)) { + Bool wasMarked = amcNailGetAndSetMark(seg, ref); + /* If there are no new marks (i.e., no new traces for which we */ + /* are marking, and no new mark bits set) then we can return */ + /* immediately, without changing colour. */ + if (TraceSetSub(ss->traces, SegNailed(seg)) && wasMarked) + return; + } else if (TraceSetSub(ss->traces, SegNailed(seg))) { + return; + } + SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces)); + if (SegRankSet(seg) != RankSetEMPTY) + SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces)); +} + + +/* AMCFixEmergency -- fix a reference, without allocating + * + * See design.mps.poolamc.emergency.fix. + */ +static Res AMCFixEmergency(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + Arena arena; + AMC amc; + Addr newRef; + + AVERT(Pool, pool); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVER(refIO != NULL); + + arena = PoolArena(pool); + AVERT(Arena, arena); + amc = Pool2AMC(pool); + AVERT(AMC, amc); + + ss->wasMarked = TRUE; + + if (ss->rank == RankAMBIG) + goto fixInPlace; + + ShieldExpose(arena, seg); + newRef = (*pool->format->isMoved)(*refIO); + ShieldCover(arena, seg); + if (newRef != (Addr)0) { + /* Object has been forwarded already, so snap-out pointer. */ + /* Useful weak pointer semantics not implemented. @@@@ */ + *refIO = newRef; + return ResOK; + } + +fixInPlace: /* see design.mps.poolamc.Nailboard.emergency */ + amcFixInPlace(pool, seg, ss, refIO); + return ResOK; +} + + +/* AMCFix -- fix a reference to the pool + * + * See design.mps.poolamc.fix. + */ +Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + Arena arena; + AMC amc; + Res res; + Format format; /* cache of pool->format */ + Ref ref; /* reference to be fixed */ + Ref newRef; /* new location, if moved */ + Size length; /* length of object to be relocated */ + Buffer buffer; /* buffer to allocate new copy into */ + amcGen gen; /* generation of old copy of object */ + TraceSet grey; /* greyness of object being relocated */ + TraceSet toGrey; /* greyness of object's destination */ + RefSet summary; /* summary of object being relocated */ + RefSet toSummary; /* summary of object's destination */ + Seg toSeg; /* segment to which object is being relocated */ + Bool shieldUp; /* whether we have exposed seg */ + + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Pool, pool); + AVERT_CRITICAL(ScanState, ss); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(refIO != NULL); + EVENT_0(AMCFix); + + /* For the moment, assume that the object was already marked. */ + /* (See design.mps.fix.protocol.was-marked.) */ + ss->wasMarked = TRUE; + + /* If the reference is ambiguous, set up the datastructures for */ + /* managing a nailed segment. This involves marking the segment */ + /* as nailed, and setting up a per-word mark table */ + if (ss->rank == RankAMBIG) { + /* .nail.new: Check to see whether we need a Nailboard for */ + /* this seg. We use "SegNailed(seg) == TraceSetEMPTY" */ + /* rather than "!amcSegHasNailboard(seg)" because this avoids */ + /* setting up a new nailboard when the segment was nailed, but had */ + /* no nailboard. This must be avoided because otherwise */ + /* assumptions in AMCFixEmergency will be wrong (essentially */ + /* we will lose some pointer fixes because we introduced a */ + /* nailboard). */ + if (SegNailed(seg) == TraceSetEMPTY) { + res = amcSegCreateNailboard(seg, pool); + if (res != ResOK) + return res; + ++ss->nailCount; + SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces)); + } + amcFixInPlace(pool, seg, ss, refIO); + return ResOK; + } + + amc = Pool2AMC(pool); + AVERT_CRITICAL(AMC, amc); + format = pool->format; + ref = *refIO; + AVER_CRITICAL(SegBase(seg) <= ref); + AVER_CRITICAL(ref < SegLimit(seg)); + arena = pool->arena; + + /* .access.read: Make sure seg isn't behind a read barrier. */ + shieldUp = FALSE; + if (SegPM(seg) & AccessREAD) { + ShieldExpose(arena, seg); + shieldUp = TRUE; + } + newRef = (*format->isMoved)(ref); + + if (newRef == (Addr)0) { + /* If object is nailed already then we mustn't copy it: */ + if (SegNailed(seg) != TraceSetEMPTY + && (!amcSegHasNailboard(seg) || amcNailGetMark(seg, ref))) { + /* Segment only needs greying if there are new traces for which */ + /* we are nailing. */ + if (!TraceSetSub(ss->traces, SegNailed(seg))) { + if (SegRankSet(seg) != RankSetEMPTY) + SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces)); + SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces)); + } + res = ResOK; + goto returnRes; + } else if (ss->rank == RankWEAK) { + /* object is not preserved (neither moved, nor nailed) */ + /* hence, reference should be splatted */ + goto updateReference; + } + /* object is not preserved yet (neither moved, nor nailed) */ + /* so should be preserved by forwarding */ + EVENT_A(AMCFixForward, newRef); + /* design.mps.fix.protocol.was-marked */ + ss->wasMarked = FALSE; + + /* Get the forwarding buffer from the object's generation. */ + gen = amcSegGen(seg); + buffer = gen->forward; + AVER_CRITICAL(buffer != NULL); + + length = AddrOffset(ref, (*format->skip)(ref)); + STATISTIC_STAT(++ss->forwardedCount); + ss->forwardedSize += length; + do { + res = BUFFER_RESERVE(&newRef, buffer, length, FALSE); + if (res != ResOK) + goto returnRes; + + toSeg = BufferSeg(buffer); + ShieldExpose(arena, toSeg); + + /* Since we're moving an object from one segment to another, */ + /* union the greyness and the summaries together. */ + grey = TraceSetUnion(ss->traces, SegGrey(seg)); + toGrey = SegGrey(toSeg); + if (TraceSetDiff(grey, toGrey) != TraceSetEMPTY + && SegRankSet(seg) != RankSetEMPTY) + SegSetGrey(toSeg, TraceSetUnion(toGrey, grey)); + summary = SegSummary(seg); + toSummary = SegSummary(toSeg); + if (RefSetDiff(summary, toSummary) != RefSetEMPTY) + SegSetSummary(toSeg, RefSetUnion(toSummary, summary)); + + /* design.mps.trace.fix.copy */ + (void)AddrCopy(newRef, ref, length); + + ShieldCover(arena, toSeg); + } while (!BUFFER_COMMIT(buffer, newRef, length)); + ss->copiedSize += length; + + /* Make sure there's no read or write barrier. */ + if (!shieldUp && (SegPM(seg) & (AccessWRITE | AccessREAD))) { + ShieldExpose(arena, seg); + shieldUp = TRUE; + } + (*format->move)(ref, newRef); + } else { + /* reference to broken heart (which should be snapped out -- */ + /* consider adding to (non-existant) snap-out cache here) */ + STATISTIC_STAT(++ss->snapCount); + } + + /* .fix.update: update the reference to whatever the above code */ + /* decided it should be */ +updateReference: + *refIO = newRef; + res = ResOK; + +returnRes: + if (shieldUp) + ShieldCover(arena, seg); + return res; +} + + +/* AMCHeaderFix -- fix a reference to the pool, with headers + * + * See design.mps.poolamc.header.fix. + */ +static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + Arena arena; + AMC amc; + Res res; + Format format; /* cache of pool->format */ + Ref ref; /* reference to be fixed */ + Ref newRef; /* new location, if moved */ + Addr newBase; /* base address of new copy */ + Size length; /* length of object to be relocated */ + Buffer buffer; /* buffer to allocate new copy into */ + amcGen gen; /* generation of old copy of object */ + TraceSet grey; /* greyness of object being relocated */ + TraceSet toGrey; /* greyness of object's destination */ + RefSet summary; /* summary of object being relocated */ + RefSet toSummary; /* summary of object's destination */ + Seg toSeg; /* segment to which object is being relocated */ + Bool shieldUp; /* whether we have exposed seg */ + + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Pool, pool); + AVERT_CRITICAL(ScanState, ss); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(refIO != NULL); + EVENT_0(AMCFix); + + /* For the moment, assume that the object was already marked. */ + /* (See design.mps.fix.protocol.was-marked.) */ + ss->wasMarked = TRUE; + + /* If the reference is ambiguous, set up the datastructures for */ + /* managing a nailed segment. This involves marking the segment */ + /* as nailed, and setting up a per-word mark table */ + if (ss->rank == RankAMBIG) { + /* .nail.new: Check to see whether we need a Nailboard for this seg. */ + /* We use "SegNailed(seg) == TraceSetEMPTY" rather than */ + /* "!amcSegHasNailboard(seg)" because this avoids setting up a new */ + /* nailboard when the segment was nailed, but had no nailboard. */ + /* This must be avoided because otherwise assumptions in */ + /* AMCFixEmergency will be wrong (essentially we will lose some */ + /* pointer fixes because we introduced a nailboard). */ + if (SegNailed(seg) == TraceSetEMPTY) { + res = amcSegCreateNailboard(seg, pool); + if (res != ResOK) + return res; + ++ss->nailCount; + SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces)); + } + amcFixInPlace(pool, seg, ss, refIO); + return ResOK; + } + + amc = Pool2AMC(pool); + AVERT_CRITICAL(AMC, amc); + format = pool->format; + ref = *refIO; + AVER_CRITICAL(AddrAdd(SegBase(seg), pool->format->headerSize) <= ref); + AVER_CRITICAL(ref < SegLimit(seg)); /* see .ref-limit */ + arena = pool->arena; + + /* .access.read.header: Make sure seg isn't behind a read barrier. */ + shieldUp = FALSE; + if (SegPM(seg) & AccessREAD) { + ShieldExpose(arena, seg); + shieldUp = TRUE; + } + newRef = (*format->isMoved)(ref); + + if (newRef == (Addr)0) { + /* If object is nailed already then we mustn't copy it: */ + if (SegNailed(seg) != TraceSetEMPTY + && (!amcSegHasNailboard(seg) || amcNailGetMark(seg, ref))) { + /* Segment only needs greying if there are new traces for which */ + /* we are nailing. */ + if (!TraceSetSub(ss->traces, SegNailed(seg))) { + if (SegRankSet(seg) != RankSetEMPTY) + SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces)); + SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces)); + } + res = ResOK; + goto returnRes; + } else if (ss->rank == RankWEAK) { + /* object is not preserved (neither moved, nor nailed) */ + /* hence, reference should be splatted */ + goto updateReference; + } + /* object is not preserved yet (neither moved, nor nailed) */ + /* so should be preserved by forwarding */ + EVENT_A(AMCFixForward, newRef); + /* design.mps.fix.protocol.was-marked */ + ss->wasMarked = FALSE; + + /* Get the forwarding buffer from the object's generation. */ + gen = amcSegGen(seg); + buffer = gen->forward; + AVER_CRITICAL(buffer != NULL); + + length = AddrOffset(ref, (*format->skip)(ref)); + STATISTIC_STAT(++ss->forwardedCount); + ss->forwardedSize += length; + do { + Size headerSize = format->headerSize; + + res = BUFFER_RESERVE(&newBase, buffer, length, FALSE); + if (res != ResOK) + goto returnRes; + newRef = AddrAdd(newBase, headerSize); + + toSeg = BufferSeg(buffer); + ShieldExpose(arena, toSeg); + + /* Since we're moving an object from one segment to another, */ + /* union the greyness and the summaries together. */ + grey = TraceSetUnion(ss->traces, SegGrey(seg)); + toGrey = SegGrey(toSeg); + if (TraceSetDiff(grey, toGrey) != TraceSetEMPTY + && SegRankSet(seg) != RankSetEMPTY) + SegSetGrey(toSeg, TraceSetUnion(toGrey, grey)); + summary = SegSummary(seg); + toSummary = SegSummary(toSeg); + if (RefSetDiff(summary, toSummary) != RefSetEMPTY) + SegSetSummary(toSeg, RefSetUnion(toSummary, summary)); + + /* design.mps.trace.fix.copy */ + (void)AddrCopy(newBase, AddrSub(ref, headerSize), length); + + ShieldCover(arena, toSeg); + } while (!BUFFER_COMMIT(buffer, newBase, length)); + ss->copiedSize += length; + + /* Make sure there's no read or write barrier. */ + if (!shieldUp && (SegPM(seg) & (AccessWRITE | AccessREAD))) { + ShieldExpose(arena, seg); + shieldUp = TRUE; + } + (*format->move)(ref, newRef); + } else { + /* reference to broken heart (which should be snapped out -- */ + /* consider adding to (non-existent) snap-out cache here) */ + STATISTIC_STAT(++ss->snapCount); + } + + /* .fix.update: update the reference to whatever the above code */ + /* decided it should be */ +updateReference: + *refIO = newRef; + res = ResOK; + +returnRes: + if (shieldUp) + ShieldCover(arena, seg); + return res; +} + + +/* amcReclaimNailed -- reclaim what you can from a nailed segment */ + +static void amcReclaimNailed(Pool pool, Trace trace, Seg seg) +{ + Addr p, limit; + Arena arena; + Format format; + Size bytesReclaimed = (Size)0; + Count preservedInPlaceCount = (Count)0; + Size preservedInPlaceSize = (Size)0; + AMC amc; + Size headerSize; + + /* All arguments AVERed by AMCReclaim */ + + amc = Pool2AMC(pool); + AVERT(AMC, amc); + format = pool->format; + + arena = PoolArena(pool); + AVERT(Arena, arena); + + if (!amcSegHasNailboard(seg)) { + /* We didn't keep a mark table, so preserve everything. */ + /* We can't do anything about preservedInPlaceCount. */ + trace->preservedInPlaceSize += SegSize(seg); + goto adjustColour; + } + + /* see design.mps.poolamc.Nailboard.limitations for improvements */ + headerSize = format->headerSize; + ShieldExpose(arena, seg); + p = AddrAdd(SegBase(seg), headerSize); + if (SegBuffer(seg) != NULL) + limit = BufferScanLimit(SegBuffer(seg)); + else + limit = SegLimit(seg); + limit = AddrAdd(limit, headerSize); + while(p < limit) { + Addr q; + Size length; + q = (*format->skip)(p); + length = AddrOffset(p, q); + if (!amcNailGetMark(seg, p)) { + (*format->pad)(AddrSub(p, headerSize), length); + bytesReclaimed += length; + } else { + ++preservedInPlaceCount; + preservedInPlaceSize += length; + } + + AVER(p < q); + p = q; + } + AVER(p == limit); + ShieldCover(arena, seg); + +adjustColour: + SegSetNailed(seg, TraceSetDel(SegNailed(seg), trace)); + SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); + if (SegNailed(seg) == TraceSetEMPTY && amcSegHasNailboard(seg)) { + amcSegDestroyNailboard(seg, pool); + } + + AVER(bytesReclaimed <= SegSize(seg)); + trace->reclaimSize += bytesReclaimed; + trace->preservedInPlaceCount += preservedInPlaceCount; + trace->preservedInPlaceSize += preservedInPlaceSize; +} + + +/* AMCReclaim -- recycle a segment if it is still white + * + * See design.mps.poolamc.reclaim. + */ +static void AMCReclaim(Pool pool, Trace trace, Seg seg) +{ + AMC amc; + amcGen gen; + Size size; + + AVERT_CRITICAL(Pool, pool); + amc = Pool2AMC(pool); + AVERT_CRITICAL(AMC, amc); + AVERT_CRITICAL(Trace, trace); + AVERT_CRITICAL(Seg, seg); + + gen = amcSegGen(seg); + AVERT_CRITICAL(amcGen, gen); + + EVENT_PPP(AMCReclaim, gen, trace, seg); + + /* This switching needs to be more complex for multiple traces. */ + AVER_CRITICAL(TraceSetIsSingle(PoolArena(pool)->busyTraces)); + if (amc->rampMode == collectingRamp) { + if (amc->rampCount > 0) + /* Entered ramp mode before previous one was cleaned up */ + amc->rampMode = beginRamp; + else + amc->rampMode = outsideRamp; + } + + if (SegNailed(seg) != TraceSetEMPTY) { + amcReclaimNailed(pool, trace, seg); + return; + } + + --gen->segs; + size = SegSize(seg); + gen->pgen.totalSize -= size; + + trace->reclaimSize += size; + + SegFree(seg); +} + + +/* AMCWalk -- Apply function to (black) objects in segment */ + +static void AMCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, + void *p, unsigned long s) +{ + Addr object, nextObject, limit; + AMC amc; + Format format; + + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures so can't be checked */ + + /* Avoid applying the function to grey or white objects. */ + /* White objects might not be alive, and grey objects */ + /* may have pointers to old-space. */ + + /* NB, segments containing a mix of colours (i.e., nailed segs) */ + /* are not handled properly: No objects are walked @@@@ */ + if (SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY + && SegNailed(seg) == TraceSetEMPTY) { + amc = Pool2AMC(pool); + AVERT(AMC, amc); + format = pool->format; + + /* If the segment is buffered, only walk as far as the end */ + /* of the initialized objects. cf. AMCScan */ + if (SegBuffer(seg) != NULL) + limit = BufferScanLimit(SegBuffer(seg)); + else + limit = SegLimit(seg); + limit = AddrAdd(limit, format->headerSize); + + object = AddrAdd(SegBase(seg), format->headerSize); + while(object < limit) { + /* Check not a broken heart. */ + AVER((*format->isMoved)(object) == NULL); + (*f)(object, pool->format, pool, p, s); + nextObject = (*pool->format->skip)(object); + AVER(nextObject > object); + object = nextObject; + } + AVER(object == limit); + } +} + + +/* amcWalkAll -- Apply a function to all (black) objects in a pool */ + +static void amcWalkAll(Pool pool, FormattedObjectsStepMethod f, + void *p, unsigned long s) +{ + Arena arena; + Ring ring, next, node; + + AVER(IsSubclassPoly(pool->class, AMCPoolClassGet())); + + arena = PoolArena(pool); + ring = PoolSegRing(pool); + node = RingNext(ring); + RING_FOR(node, ring, next) { + Seg seg = SegOfPoolRing(node); + + ShieldExpose(arena, seg); + AMCWalk(pool, seg, f, p, s); + ShieldCover(arena, seg); + } +} + + +/* AMCDescribe -- describe the contents of the AMC pool + * + * See design.mps.poolamc.describe. + */ +static Res AMCDescribe(Pool pool, mps_lib_FILE *stream) +{ + Res res; + AMC amc; + Ring node, nextNode; + char *rampmode; + + if (!CHECKT(Pool, pool)) return ResFAIL; + amc = Pool2AMC(pool); + if (!CHECKT(AMC, amc)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC", + " $P {\n", (WriteFP)amc, " pool $P ($U)\n", + (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial, + NULL); + if (res != ResOK) return res; + + switch(amc->rampMode) { + case outsideRamp: rampmode = "outside ramp"; break; + case beginRamp: rampmode = "begin ramp"; break; + case ramping: rampmode = "ramping"; break; + case finishRamp: rampmode = "finish ramp"; break; + case collectingRamp: rampmode = "collecting ramp"; break; + default: rampmode = "unknown ramp mode"; break; + } + res = WriteF(stream, + " ", rampmode, " ($U)\n", (WriteFU)amc->rampCount, + NULL); + if (res != ResOK) return res; + + RING_FOR(node, &amc->genRing, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + res = amcGenDescribe(gen, stream); + if (res != ResOK) return res; + } + + res = WriteF(stream, "} AMC $P\n", (WriteFP)amc, NULL); + if (res != ResOK) return res; + + return ResOK; +} + + +/* AMCPoolClass -- the class definition */ + +DEFINE_POOL_CLASS(AMCPoolClass, this) +{ + INHERIT_CLASS(this, AbstractCollectPoolClass); + PoolClassMixInFormat(this); + this->name = "AMC"; + this->size = sizeof(AMCStruct); + this->offset = offsetof(AMCStruct, poolStruct); + this->attr |= AttrMOVINGGC; + this->init = AMCInit; + this->finish = AMCFinish; + this->bufferFill = AMCBufferFill; + this->bufferEmpty = AMCBufferEmpty; + this->whiten = AMCWhiten; + this->scan = AMCScan; + this->fix = AMCFix; + this->fixEmergency = AMCFixEmergency; + this->reclaim = AMCReclaim; + this->rampBegin = AMCRampBegin; + this->rampEnd = AMCRampEnd; + this->walk = AMCWalk; + this->bufferClass = amcBufClassGet; + this->describe = AMCDescribe; +} + + +/* AMCZPoolClass -- the class definition */ + +DEFINE_POOL_CLASS(AMCZPoolClass, this) +{ + INHERIT_CLASS(this, AMCPoolClass); + this->name = "AMCZ"; + this->attr &= ~(AttrSCAN | AttrINCR_RB); + this->init = AMCZInit; + this->grey = PoolNoGrey; + this->scan = PoolNoScan; +} + + +/* mps_class_amc -- return the pool class descriptor to the client */ + +mps_class_t mps_class_amc(void) +{ + return (mps_class_t)AMCPoolClassGet(); +} + +/* mps_class_amcz -- return the pool class descriptor to the client */ + +mps_class_t mps_class_amcz(void) +{ + return (mps_class_t)AMCZPoolClassGet(); +} + + +/* mps_amc_apply -- apply function to all objects in pool + * + * The iterator that is passed by the client is stored in a closure + * structure which is passed to a local iterator in order to ensure that + * any type conversion necessary between Addr and mps_addr_t happen. + * They are almost certainly the same on all platforms, but this is the + * correct way to do it. +*/ + +typedef struct mps_amc_apply_closure_s { + void (*f)(mps_addr_t object, void *p, size_t s); + void *p; + size_t s; +} mps_amc_apply_closure_s; + +static void mps_amc_apply_iter(Addr addr, Format format, Pool pool, + void *p, unsigned long s) +{ + mps_amc_apply_closure_s *closure = p; + /* Can't check addr */ + AVERT(Format, format); + AVERT(Pool, pool); + /* We could check that s is the sizeof *p, but it would be slow */ + UNUSED(format); + UNUSED(pool); + UNUSED(s); + (*closure->f)(addr, closure->p, closure->s); +} + +void mps_amc_apply(mps_pool_t mps_pool, + void (*f)(mps_addr_t object, void *p, size_t s), + void *p, size_t s) +{ + Pool pool = (Pool)mps_pool; + mps_amc_apply_closure_s closure_s; + Arena arena; + + AVER(CHECKT(Pool, pool)); + arena = PoolArena(pool); + ArenaEnter(arena); + AVERT(Pool, pool); + + closure_s.f = f; closure_s.p = p; closure_s.s = s; + amcWalkAll(pool, mps_amc_apply_iter, &closure_s, sizeof(closure_s)); + + ArenaLeave(arena); +} + + +/* AMCCheck -- check consistency of the AMC pool + * + * See design.mps.poolamc.check. + */ +static Bool AMCCheck(AMC amc) +{ + CHECKS(AMC, amc); + CHECKD(Pool, &amc->poolStruct); + CHECKL(IsSubclassPoly(amc->poolStruct.class, EnsureAMCPoolClass())); + CHECKL(RankSetCheck(amc->rankSet)); + CHECKL(RingCheck(&amc->genRing)); + CHECKL(BoolCheck(amc->gensBooted)); + if (amc->gensBooted) { + CHECKD(amcGen, amc->nursery); + CHECKL(amc->gen != NULL); + CHECKD(amcGen, amc->rampGen); + CHECKD(amcGen, amc->afterRampGen); + } + /* nothing to check for rampCount */ + CHECKL(amc->rampMode >= outsideRamp && amc->rampMode <= collectingRamp); + + return TRUE; +} diff --git a/mps/code/poolams.c b/mps/code/poolams.c new file mode 100644 index 00000000000..45828b47a8b --- /dev/null +++ b/mps/code/poolams.c @@ -0,0 +1,1457 @@ +/* impl.c.poolams: AUTOMATIC MARK & SWEEP POOL CLASS + * + * $HopeName: MMsrc!poolams.c(trunk.51) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.poolams. + * + * + * TRANSGRESSSIONS + * + * .no-check.local: We have decided to omit checks in local functions of + * structure arguments that are simply passed down through the caller + * (as opposed to being constructed by the caller). + */ + +#include "mpscams.h" +#include "poolams.h" +#include "mpm.h" +#include + +SRCID(poolams, "$HopeName: MMsrc!poolams.c(trunk.51) $"); + + +#define AMSSig ((Sig)0x519A3599) /* SIGnature AMS */ +#define AMSSegSig ((Sig)0x519A3559) /* SIGnature AMS SeG */ + + +/* AMSSegCheck -- check an AMS segment */ + +Bool AMSSegCheck(AMSSeg amsseg) +{ + Seg seg = AMSSeg2Seg(amsseg); + CHECKS(AMSSeg, amsseg); + CHECKL(GCSegCheck(&amsseg->gcSegStruct)); + CHECKU(AMS, amsseg->ams); + CHECKL(AMS2Pool(amsseg->ams) == SegPool(seg)); + CHECKL(RingCheck(&amsseg->segRing)); + + CHECKL(amsseg->grains == AMSGrains(amsseg->ams, SegSize(seg))); + CHECKL(amsseg->grains > 0); + CHECKL(amsseg->grains >= amsseg->free + amsseg->newAlloc); + + if (SegWhite(seg) != TraceSetEMPTY) + /* design.mps.poolams.colour.single */ + CHECKL(TraceSetIsSingle(SegWhite(seg))); + + CHECKL(BoolCheck(amsseg->marksChanged)); + CHECKL(amsseg->allocTable != NULL); + CHECKL(amsseg->nongreyTable != NULL); + CHECKL(amsseg->nonwhiteTable != NULL); + + return TRUE; +} + + +/* amsCreateTables -- create the tables for an AMS seg */ + +static Res amsCreateTables(BT *allocReturn, + BT *nongreyReturn, BT *nonwhiteReturn, + Arena arena, Count length) +{ + Res res; + BT allocTable, nongreyTable, nonwhiteTable; + + AVER(allocReturn != NULL); + AVER(nongreyReturn != NULL); + AVER(nonwhiteReturn != NULL); + AVERT(Arena, arena); + AVER(length > 0); + + res = BTCreate(&allocTable, arena, length); + if (res != ResOK) + goto failAlloc; + res = BTCreate(&nongreyTable, arena, length); + if (res != ResOK) + goto failGrey; + res = BTCreate(&nonwhiteTable, arena, length); + if (res != ResOK) + goto failWhite; + + *allocReturn = allocTable; + *nongreyReturn = nongreyTable; + *nonwhiteReturn = nonwhiteTable; + return ResOK; + +failWhite: + BTDestroy(nongreyTable, arena, length); +failGrey: + BTDestroy(allocTable, arena, length); +failAlloc: + return res; +} + + +/* amsDestroyTables -- destroy the tables for an AMS seg */ + +static void amsDestroyTables(BT allocTable, + BT nongreyTable, BT nonwhiteTable, + Arena arena, Count length) +{ + AVER(allocTable != NULL); + AVER(nongreyTable != NULL); + AVER(nonwhiteTable != NULL); + AVERT(Arena, arena); + AVER(length > 0); + + BTDestroy(nonwhiteTable, arena, length); + BTDestroy(nongreyTable, arena, length); + BTDestroy(allocTable, arena, length); +} + + +/* AMSSegInit -- Init method for AMS segments */ + +static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + AMSSeg amsseg; + Res res; + Arena arena; + AMS ams; + + AVERT(Seg, seg); + amsseg = Seg2AMSSeg(seg); + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + arena = PoolArena(pool); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(AMSSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + goto failNextMethod; + + amsseg->grains = size >> ams->grainShift; + amsseg->free = amsseg->grains; + amsseg->newAlloc = (Count)0; + amsseg->marksChanged = FALSE; /* design.mps.poolams.marked.unused */ + amsseg->ambiguousFixes = FALSE; + + res = amsCreateTables(&amsseg->allocTable, + &amsseg->nongreyTable, &amsseg->nonwhiteTable, + arena, amsseg->grains); + if (res != ResOK) + goto failCreateTables; + + /* start off using firstFree, see design.mps.poolams.no-bit */ + amsseg->allocTableInUse = FALSE; + amsseg->firstFree = 0; + amsseg->colourTablesInUse = FALSE; + + amsseg->ams = ams; + RingInit(&amsseg->segRing); + RingAppend((ams->allocRing)(ams, SegRankSet(seg), size), + &amsseg->segRing); + + amsseg->sig = AMSSegSig; + ams->size += size; + AVERT(AMSSeg, amsseg); + + return ResOK; + +failCreateTables: + super->finish(seg); +failNextMethod: + return res; +} + + +/* AMSSegFinish -- Finish method for AMS segments */ + +static void AMSSegFinish(Seg seg) +{ + SegClass super; + AMSSeg amsseg; + AMS ams; + Arena arena; + + AVERT(Seg, seg); + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + ams = amsseg->ams; + AVERT(AMS, ams); + arena = PoolArena(AMS2Pool(ams)); + AVER(SegBuffer(seg) == NULL); + + /* keep the destructions in step with AMSSegInit failure cases */ + amsDestroyTables(amsseg->allocTable, amsseg->nongreyTable, + amsseg->nonwhiteTable, arena, amsseg->grains); + + RingRemove(&amsseg->segRing); + RingFinish(&amsseg->segRing); + + AVER(ams->size >= SegSize(seg)); + ams->size -= SegSize(seg); + amsseg->sig = SigInvalid; + + /* finish the superclass fields last */ + super = SEG_SUPERCLASS(AMSSegClass); + super->finish(seg); +} + + +/* AMSSegMerge & AMSSegSplit -- AMSSeg split & merge methods + * + * .empty: segment merging and splitting is limited to simple cases + * where the high segment is empty. + * See design.mps.poolams.split-merge.constrain. + * + * .grain-align: segment merging and splitting is limited to cases + * where the join is aligned with the grain alignment + * See design.mps.poolams.split-merge.constrain. + * + * .alloc-early: Allocations are performed before calling the + * next method to simplify the fail cases. See + * design.mps.seg.split-merge.fail + * + * .table-names: The names of local variables holding the new + * allocation and colour tables are chosen to have names which + * are derivable from the field names for tables in AMSSegStruct. + * (I.e. allocTable, nongreyTable, nonwhiteTable). This simplifies + * processing of all such tables by a macro. + */ + +static Res AMSSegMerge(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + Count loGrains, hiGrains, allGrains; + AMSSeg amsseg, amssegHi; + Arena arena; + AMS ams; + BT allocTable, nongreyTable, nonwhiteTable; /* .table-names */ + Res res; + + AVERT(Seg, seg); + AVERT(Seg, segHi); + amsseg = Seg2AMSSeg(seg); + amssegHi = Seg2AMSSeg(segHi); + AVERT(AMSSeg, amsseg); + AVERT(AMSSeg, amssegHi); + /* other parameters are checked by next-method */ + arena = PoolArena(SegPool(seg)); + ams = Pool2AMS(SegPool(seg)); + + loGrains = amsseg->grains; + hiGrains = amssegHi->grains; + allGrains = loGrains + hiGrains; + + /* checks for .grain-align */ + AVER(allGrains == AddrOffset(base, limit) >> ams->grainShift); + /* checks for .empty */ + AVER(amssegHi->free == hiGrains); + AVER(!amssegHi->marksChanged); + + /* .alloc-early */ + res = amsCreateTables(&allocTable, &nongreyTable, &nonwhiteTable, + arena, allGrains); + if (res != ResOK) + goto failCreateTables; + + /* Merge the superclass fields via next-method call */ + super = SEG_SUPERCLASS(AMSSegClass); + res = super->merge(seg, segHi, base, mid, limit, + withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + /* Update fields of seg. Finish segHi. */ + +#define MERGE_TABLES(table, setHighRangeFn) \ + /* Implementation depends on .table-names */ \ + BEGIN \ + BTCopyRange(amsseg->table, (table), 0, loGrains); \ + setHighRangeFn((table), loGrains, allGrains); \ + BTDestroy(amsseg->table, arena, loGrains); \ + BTDestroy(amssegHi->table, arena, hiGrains); \ + amsseg->table = (table); \ + END + + MERGE_TABLES(nonwhiteTable, BTSetRange); + MERGE_TABLES(nongreyTable, BTSetRange); + MERGE_TABLES(allocTable, BTResRange); + + amsseg->grains = allGrains; + amsseg->free = amsseg->free + amssegHi->free; + amsseg->newAlloc = amsseg->newAlloc + amssegHi->newAlloc; + /* other fields in amsseg are unaffected */ + + RingRemove(&amssegHi->segRing); + RingFinish(&amssegHi->segRing); + amssegHi->sig = SigInvalid; + + AVERT(AMSSeg, amsseg); + return ResOK; + +failSuper: + amsDestroyTables(allocTable, nongreyTable, nonwhiteTable, + arena, allGrains); +failCreateTables: + AVERT(AMSSeg, amsseg); + AVERT(AMSSeg, amssegHi); + return res; +} + + +static Res AMSSegSplit(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + Count loGrains, hiGrains, allGrains; + AMSSeg amsseg, amssegHi; + Arena arena; + AMS ams; + BT allocTableLo, nongreyTableLo, nonwhiteTableLo; /* .table-names */ + BT allocTableHi, nongreyTableHi, nonwhiteTableHi; /* .table-names */ + Res res; + + AVERT(Seg, seg); + AVER(segHi != NULL); /* can't check fully, it's not initialized */ + amsseg = Seg2AMSSeg(seg); + amssegHi = Seg2AMSSeg(segHi); + AVERT(AMSSeg, amsseg); + /* other parameters are checked by next-method */ + arena = PoolArena(SegPool(seg)); + ams = Pool2AMS(SegPool(seg)); + + loGrains = AMSGrains(ams, AddrOffset(base, mid)); + hiGrains = AMSGrains(ams, AddrOffset(mid, limit)); + allGrains = loGrains + hiGrains; + + /* checks for .grain-align */ + AVER(allGrains == amsseg->grains); + /* checks for .empty */ + AVER(amsseg->free >= hiGrains); + if (amsseg->allocTableInUse) { + AVER(BTIsResRange(amsseg->allocTable, loGrains, allGrains)); + } else { + AVER(amsseg->firstFree <= loGrains); + } + + /* .alloc-early */ + res = amsCreateTables(&allocTableLo, &nongreyTableLo, &nonwhiteTableLo, + arena, loGrains); + if (res != ResOK) + goto failCreateTablesLo; + res = amsCreateTables(&allocTableHi, &nongreyTableHi, &nonwhiteTableHi, + arena, hiGrains); + if (res != ResOK) + goto failCreateTablesHi; + + + /* Split the superclass fields via next-method call */ + super = SEG_SUPERCLASS(AMSSegClass); + res = super->split(seg, segHi, base, mid, limit, withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + /* Update seg. Full initialization for segHi. */ + +#define SPLIT_TABLES(table, setHighRangeFn) \ + /* Implementation depends on .table-names */ \ + BEGIN \ + BTCopyRange(amsseg->table, table ## Lo, 0, loGrains); \ + setHighRangeFn(table ## Hi, 0, hiGrains); \ + BTDestroy(amsseg->table, arena, allGrains); \ + amsseg->table = table ## Lo; \ + amssegHi->table = table ## Hi; \ + END + + SPLIT_TABLES(nonwhiteTable, BTSetRange); + SPLIT_TABLES(nongreyTable, BTSetRange); + SPLIT_TABLES(allocTable, BTResRange); + + amsseg->grains = loGrains; + amssegHi->grains = hiGrains; + amsseg->free -= hiGrains; + amssegHi->free = hiGrains; + amssegHi->newAlloc = (Count)0; + amssegHi->marksChanged = FALSE; /* design.mps.poolams.marked.unused */ + amssegHi->ambiguousFixes = FALSE; + + /* start off using firstFree, see design.mps.poolams.no-bit */ + amssegHi->allocTableInUse = FALSE; + amssegHi->firstFree = 0; + /* use colour tables if the segment is white */ + amssegHi->colourTablesInUse = (SegWhite(segHi) != TraceSetEMPTY); + + amssegHi->ams = ams; + RingInit(&amssegHi->segRing); + RingAppend((ams->allocRing)(ams, SegRankSet(segHi), SegSize(segHi)), + &amssegHi->segRing); + + amssegHi->sig = AMSSegSig; + AVERT(AMSSeg, amsseg); + AVERT(AMSSeg, amssegHi); + return ResOK; + +failSuper: + amsDestroyTables(allocTableHi, nongreyTableHi, nonwhiteTableHi, + arena, hiGrains); +failCreateTablesHi: + amsDestroyTables(allocTableLo, nongreyTableLo, nonwhiteTableLo, + arena, loGrains); +failCreateTablesLo: + AVERT(AMSSeg, amsseg); + return res; +} + + +/* AMSSegDescribe -- describe an AMS segment */ + +#define WRITE_BUFFER_LIMIT(stream, seg, i, buffer, accessor, char) \ + BEGIN \ + if ((buffer) != NULL \ + && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \ + Res _res = WriteF(stream, char, NULL); \ + if (_res != ResOK) return _res; \ + } \ + END + +static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) +{ + Res res; + AMSSeg amsseg; + SegClass super; + Buffer buffer; /* the segment's buffer, if it has one */ + Index i; + + if (!CHECKT(Seg, seg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + amsseg = Seg2AMSSeg(seg); + if (!CHECKT(AMSSeg, amsseg)) return ResFAIL; + + /* Describe the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(AMSSegClass); + res = super->describe(seg, stream); + if (res != ResOK) return res; + + buffer = SegBuffer(seg); + + res = WriteF(stream, + " AMS $P\n", (WriteFP)amsseg->ams, + " grains $W\n", (WriteFW)amsseg->grains, + NULL); + if (res != ResOK) return res; + if (amsseg->allocTableInUse) + res = WriteF(stream, + " alloctable $P\n", (WriteFP)amsseg->allocTable, + NULL); + else + res = WriteF(stream, + " firstFree $W\n", (WriteFW)amsseg->firstFree, + NULL); + if (res != ResOK) return res; + res = WriteF(stream, + " tables: nongrey $P, nonwhite $P\n", + (WriteFP)amsseg->nongreyTable, + (WriteFP)amsseg->nonwhiteTable, + " map: \n", + NULL); + if (res != ResOK) return res; + + for (i=0; i < amsseg->grains; ++i) { + char c = 0; + + if (i % 64 == 0) { + res = WriteF(stream, "\n ", NULL); + if (res != ResOK) return res; + } + + WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferBase, "["); + WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferGetInit, "|"); + WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferAlloc, ">"); + + if (AMS_ALLOCED(seg, i)) { + if (amsseg->colourTablesInUse) { + if (AMSIsInvalidColor(seg, i)) + c = '!'; + else if (AMSIsWhite(seg, i)) + c = '-'; + else if (AMSIsGrey(seg, i)) + c = '+'; + else /* must be black */ + c = '*'; + } else + c = '.'; + } else + c = ' '; + res = WriteF(stream, "$C", c, NULL); + if (res != ResOK) + return res; + + WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferScanLimit, "<"); + WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]"); + } + + res = WriteF(stream, "\n", NULL); + return res; +} + + +/* AMSSegClass -- Class definition for AMS segments */ + +DEFINE_CLASS(AMSSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + class->name = "AMSSEG"; + class->size = sizeof(AMSSegStruct); + class->init = AMSSegInit; + class->finish = AMSSegFinish; + class->merge = AMSSegMerge; + class->split = AMSSegSplit; + class->describe = AMSSegDescribe; +} + + + + +/* AMSPoolRing -- the ring of segments in the pool */ + +static Ring AMSPoolRing(AMS ams, RankSet rankSet, Size size) +{ + /* arguments checked in the caller */ + UNUSED(rankSet); UNUSED(size); + return &ams->segRing; +} + + +/* AMSSegSizePolicy + * + * Picks a segment size. This policy simply rounds the size + * up to the arena alignment. + */ +static Res AMSSegSizePolicy(Size *sizeReturn, + Pool pool, Size size, RankSet rankSet) +{ + Arena arena; + + AVER(sizeReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVER(RankSetCheck(rankSet)); + + arena = PoolArena(pool); + + size = SizeAlignUp(size, ArenaAlign(arena)); + if (size == 0) { + /* overflow */ + return ResMEMORY; + } + *sizeReturn = size; + return ResOK; +} + + +/* AMSSegCreate -- create a single AMSSeg */ + +static Res AMSSegCreate(Seg *segReturn, Pool pool, Size size, + SegPref segPref, RankSet rankSet, + Bool withReservoirPermit) +{ + Seg seg; + AMS ams; + Res res; + Arena arena; + Size prefSize; + + AVER(segReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVERT(RankSet, rankSet); + AVERT(SegPref, segPref); + AVER(BoolCheck(withReservoirPermit)); + + ams = Pool2AMS(pool); + AVERT(AMS,ams); + arena = PoolArena(pool); + + res = ams->segSize(&prefSize, pool, size, rankSet); + if (res != ResOK) + goto failSize; + + res = SegAlloc(&seg, (*ams->segClass)(), segPref, prefSize, + pool, withReservoirPermit); + if (res != ResOK) { /* try to allocate one that's just large enough */ + Size minSize = SizeAlignUp(size, ArenaAlign(arena)); + + if (minSize == prefSize) + goto failSeg; + res = SegAlloc(&seg, (*ams->segClass)(), segPref, minSize, + pool, withReservoirPermit); + if (res != ResOK) + goto failSeg; + } + PoolGenUpdateZones(&ams->pgen, seg); + + /* see design.mps.seg.field.rankset */ + if (rankSet != RankSetEMPTY) { + SegSetRankAndSummary(seg, rankSet, RefSetUNIV); + } else { + SegSetRankAndSummary(seg, rankSet, RefSetEMPTY); + } + + AVERT(AMSSeg, Seg2AMSSeg(seg)); + + *segReturn = seg; + return ResOK; + +failSeg: +failSize: + return res; +} + + +/* AMSSegsDestroy -- destroy all the segments */ + +static void AMSSegsDestroy(AMS ams) +{ + Ring ring, node, next; /* for iterating over the segments */ + + ring = PoolSegRing(AMS2Pool(ams)); + RING_FOR(node, ring, next) { + Seg seg = SegOfPoolRing(node); + AVER(Seg2AMSSeg(seg)->ams == ams); + SegFree(seg); + } +} + + +static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure); + + +/* AMSInit -- the pool class initialization method + * + * Takes one additional argument: the format of the objects + * allocated in the pool. See design.mps.poolams.init. + */ +static Res AMSInit(Pool pool, va_list args) +{ + Res res; + Format format; + Chain chain; + + AVERT(Pool, pool); + + format = va_arg(args, Format); + chain = va_arg(args, Chain); + res = AMSInitInternal(Pool2AMS(pool), format, chain); + if (res == ResOK) { + EVENT_PPP(PoolInitAMS, pool, PoolArena(pool), format); + } + return res; +} + + +/* AMSInitInternal -- initialize an AMS pool, given the format and the chain */ + +Res AMSInitInternal(AMS ams, Format format, Chain chain) +{ + Pool pool; + Res res; + + /* Can't check ams, it's not initialized. */ + AVERT(Format, format); + AVERT(Chain, chain); + + pool = AMS2Pool(ams); + AVERT(Pool, pool); + pool->format = format; + pool->alignment = pool->format->alignment; + ams->grainShift = SizeLog2(PoolAlignment(pool)); + + if (ChainGens(chain) != 1) + return ResPARAM; + ams->chain = chain; + res = PoolGenInit(&ams->pgen, ams->chain, 0, pool); + if (res != ResOK) + return res; + + RingInit(&ams->segRing); + + /* The next five might be overridden by a subclass. */ + ams->iterate = AMSIterate; /* should be done using a format variant */ + ams->segSize = AMSSegSizePolicy; + ams->allocRing = AMSPoolRing; + ams->segsDestroy = AMSSegsDestroy; + ams->segClass = AMSSegClassGet; + + ams->size = 0; + + ams->sig = AMSSig; + AVERT(AMS, ams); + return ResOK; +} + + +/* AMSFinish -- the pool class finishing method + * + * Destroys all the segs in the pool. Can't invalidate the AMS until + * we've destroyed all the segments, as it may be checked. + */ +void AMSFinish(Pool pool) +{ + AMS ams; + + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + + (ams->segsDestroy)(ams); + /* can't invalidate the AMS until we've destroyed all the segs */ + ams->sig = SigInvalid; + RingFinish(&ams->segRing); + PoolGenFinish(&ams->pgen); +} + + +/* amsSegAlloc -- try to allocate an area in the given segment + * + * Tries to find an area of at least the given size. If successful, + * makes that area black, if necessary, and returns its base and limit + * grain indices. + */ +static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn, + Seg seg, Size size) +{ + AMS ams; + AMSSeg amsseg; + Size grains; + Bool canAlloc; /* can we allocate in this segment? */ + Index base, limit; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + /* seg has already been checked, in AMSBufferFill. */ + amsseg = Seg2AMSSeg(seg); + + ams = amsseg->ams; + AVERT(AMS, ams); + + AVER(size > 0); + AVER(SizeIsAligned(size, PoolAlignment(AMS2Pool(ams)))); + + grains = AMSGrains(ams, size); + AVER(grains > 0); + if (grains > amsseg->grains) + return FALSE; + + if (amsseg->allocTableInUse) { + canAlloc = BTFindLongResRange(&base, &limit, amsseg->allocTable, + 0, amsseg->grains, grains); + if (!canAlloc) + return FALSE; + BTSetRange(amsseg->allocTable, base, limit); + } else { + if (amsseg->firstFree > amsseg->grains - grains) + return FALSE; + base = amsseg->firstFree; limit = amsseg->grains; + amsseg->firstFree = limit; + } + + amsseg->free -= limit - base; + amsseg->newAlloc += limit - base; + *baseReturn = base; + *limitReturn = limit; + return TRUE; +} + + +/* AMSBufferFill -- the pool class buffer fill method + * + * Iterates over the segments looking for space. See + * design.mps.poolams.fill. + */ +Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Res res; + AMS ams; + Seg seg; + Ring node, ring, nextNode; /* for iterating over the segments */ + Index base, limit; + RankSet rankSet; + Bool b; /* the return value of amsSegAlloc */ + SegPrefStruct segPrefStruct; + Size allocatedSize; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(SizeIsAligned(size, PoolAlignment(pool))); + AVER(BoolCheck(withReservoirPermit)); + + /* Check that we're not in the grey mutator phase (see */ + /* design.mps.poolams.fill.colour). */ + AVER(PoolArena(pool)->busyTraces == PoolArena(pool)->flippedTraces); + + rankSet = BufferRankSet(buffer); + ring = (ams->allocRing)(ams, rankSet, size); + /* design.mps.poolams.fill.slow */ + RING_FOR(node, ring, nextNode) { + AMSSeg amsseg = RING_ELT(AMSSeg, segRing, node); + AVERT_CRITICAL(AMSSeg, amsseg); + if (amsseg->free >= AMSGrains(ams, size)) { + seg = AMSSeg2Seg(amsseg); + + if (SegRankSet(seg) == rankSet && SegBuffer(seg) == NULL) { + b = amsSegAlloc(&base, &limit, seg, size); + if (b) + goto found; + } + } + } + + /* no segment has enough room; make a new segment */ + segPrefStruct = *SegPrefDefault(); + SegPrefExpress(&segPrefStruct, SegPrefCollected, NULL); + res = AMSSegCreate(&seg, pool, size, &segPrefStruct, rankSet, + withReservoirPermit); + if (res != ResOK) + return res; + b = amsSegAlloc(&base, &limit, seg, size); + +found: + AVER(b); + allocatedSize = AddrOffset(AMS_INDEX_ADDR(seg, base), + AMS_INDEX_ADDR(seg, limit)); + ams->pgen.totalSize += allocatedSize; + ams->pgen.newSize += allocatedSize; + + *baseReturn = AMS_INDEX_ADDR(seg, base); + *limitReturn = AMS_INDEX_ADDR(seg, limit); + return ResOK; +} + + +/* AMSBufferEmpty -- the pool class buffer empty method + * + * Frees the unused part of the buffer. The colour of the area doesn't + * need to be changed. See design.mps.poolams.empty. + */ +void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) +{ + AMS ams; + Index initIndex, limitIndex; + Seg seg; + AMSSeg amsseg; + Size size; + + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + AVERT(Buffer,buffer); + AVER(BufferIsReady(buffer)); + seg = BufferSeg(buffer); + AVER(SegCheck(seg)); + AVER(init <= limit); + AVER(AddrIsAligned(init, PoolAlignment(pool))); + AVER(AddrIsAligned(limit, PoolAlignment(pool))); + + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + + if (init == limit) + return; + + initIndex = AMS_ADDR_INDEX(seg, init); + limitIndex = AMS_ADDR_INDEX(seg, limit); + + if (amsseg->allocTableInUse) { + /* check that it's allocated */ + AVER(BTIsSetRange(amsseg->allocTable, initIndex, limitIndex)); + BTResRange(amsseg->allocTable, initIndex, limitIndex); + } else { + /* check that it's allocated */ + AVER(limitIndex <= amsseg->firstFree); + if (limitIndex == amsseg->firstFree) /* is it at the end? */ { + amsseg->firstFree = initIndex; + } else { /* start using allocTable */ + amsseg->allocTableInUse = TRUE; + BTSetRange(amsseg->allocTable, 0, amsseg->firstFree); + if (amsseg->firstFree < amsseg->grains) + BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains); + BTResRange(amsseg->allocTable, initIndex, limitIndex); + } + } + amsseg->free += limitIndex - initIndex; + /* The unused portion of the buffer must be new, since it's not condemned. */ + AVER(amsseg->newAlloc >= limitIndex - initIndex); + amsseg->newAlloc -= limitIndex - initIndex; + size = AddrOffset(init, limit); + ams->pgen.totalSize -= size; + ams->pgen.newSize -= size; +} + + +/* amsRangeCondemn -- Condemn a part of an AMS segment + * + * I.e., alloc -> white, free -> black. + * Allow calling it with base = limit, to simplify the callers. + */ +static void amsRangeCondemn(Seg seg, Index base, Index limit) +{ + if (base != limit) { + AMSSeg amsseg = Seg2AMSSeg(seg); + + AVER(base < limit); + AVER(limit <= amsseg->grains); + + if (amsseg->allocTableInUse) { + BTSetRange(amsseg->nongreyTable, base, limit); + BTCopyInvertRange(amsseg->allocTable, amsseg->nonwhiteTable, + base, limit); + } else { + if (base < amsseg->firstFree) { + AMSRangeWhiten(seg, base, amsseg->firstFree); + } + if (amsseg->firstFree < limit) { + AMSRangeBlacken(seg, amsseg->firstFree, limit); + } + } + } +} + + +/* AMSWhiten -- the pool class segment condemning method */ + +Res AMSWhiten(Pool pool, Trace trace, Seg seg) +{ + AMS ams; + AMSSeg amsseg; + Buffer buffer; /* the seg's buffer, if it has one */ + Count uncondemned; + + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + + AVERT(Trace, trace); + AVER(SegCheck(seg)); + + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + + /* design.mps.poolams.colour.single */ + AVER(SegWhite(seg) == TraceSetEMPTY); + AVER(!amsseg->colourTablesInUse); + + amsseg->colourTablesInUse = TRUE; + buffer = SegBuffer(seg); + if (buffer != NULL) { /* design.mps.poolams.condemn.buffer */ + Index scanLimitIndex, limitIndex; + scanLimitIndex = AMS_ADDR_INDEX(seg, BufferScanLimit(buffer)); + limitIndex = AMS_ADDR_INDEX(seg, BufferLimit(buffer)); + + amsRangeCondemn(seg, 0, scanLimitIndex); + if (scanLimitIndex < limitIndex) + AMSRangeBlacken(seg, scanLimitIndex, limitIndex); + amsRangeCondemn(seg, limitIndex, amsseg->grains); + /* We didn't condemn the buffer, subtract it from the count. */ + uncondemned = limitIndex - scanLimitIndex; + } else { /* condemn whole seg */ + amsRangeCondemn(seg, 0, amsseg->grains); + uncondemned = (Count)0; + } + + trace->condemned += SegSize(seg) - AMSGrainsSize(ams, uncondemned); + /* The unused part of the buffer is new allocation by definition. */ + ams->pgen.newSize -= AMSGrainsSize(ams, amsseg->newAlloc - uncondemned); + amsseg->newAlloc = uncondemned; + amsseg->marksChanged = FALSE; /* design.mps.poolams.marked.condemn */ + amsseg->ambiguousFixes = FALSE; + + SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace)); + + return ResOK; +} + + + +/* AMSIterate -- applies a function to each object in a segment + * + * AMSIterate(seg, f, closure) applies f to all the + * objects in the segment. It skips the buffer, if any (from + * BufferScanLimit to BufferLimit). + */ +static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure) +{ + Res res; + AMS ams; + AMSSeg amsseg; + Format format; + Align alignment; + Index i; + Addr p, next, limit; + Buffer buffer; + + AVERT(Seg, seg); + AVERT(AMSObjectFunction, f); + /* Can't check closure */ + + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + ams = amsseg->ams; + AVERT(AMS, ams); + format = AMS2Pool(ams)->format; + AVERT(Format, format); + alignment = PoolAlignment(AMS2Pool(ams)); + + p = SegBase(seg); + limit = SegLimit(seg); + buffer = SegBuffer(seg); + + while (p < limit) { /* loop over the objects in the segment */ + if (buffer != NULL + && p == BufferScanLimit(buffer) && p != BufferLimit(buffer)) { + /* skip buffer */ + next = BufferLimit(buffer); + AVER(AddrIsAligned(next, alignment)); + } else { + AVER((buffer == NULL) + || (p < BufferScanLimit(buffer)) + || (p >= BufferLimit(buffer))); /* not in the buffer */ + + i = AMS_ADDR_INDEX(seg, p); + if (!AMS_ALLOCED(seg, i)) { /* no object here */ + next = AddrAdd(p, alignment); /* @@@@ this could be improved */ + } else { /* there is an object here */ + next = (*format->skip)(p); + AVER(AddrIsAligned(next, alignment)); + res = (*f)(seg, i, p, next, closure); + if (res != ResOK) + return res; + } + } + AVER(next > p); /* make sure we make progress */ + p = next; + } + AVER(p == limit); + return ResOK; +} + + +/* amsScanObject -- scan a single object + * + * This is the object function passed to AMSIterate by AMSScan. + */ + +struct amsScanClosureStruct { + ScanState ss; + Bool scanAllObjects; +}; + +typedef struct amsScanClosureStruct *amsScanClosure; + +static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos) +{ + amsScanClosure closure; + AMSSeg amsseg; + Format format; + Res res; + + amsseg = Seg2AMSSeg(seg); + /* seg & amsseg have already been checked, in AMSIterate. */ + AVER(i < amsseg->grains); + AVER(p != 0); + AVER(p < next); + AVER(clos != NULL); + closure = clos; + AVERT(ScanState, closure->ss); + AVER(BoolCheck(closure->scanAllObjects)); + + format = AMS2Pool(amsseg->ams)->format; + AVERT(Format, format); + + /* @@@@ This isn't quite right for multiple traces. */ + if (closure->scanAllObjects || AMSIsGrey(seg, i)) { + res = (*format->scan)(closure->ss, p, next); + if (res != ResOK) + return res; + closure->ss->scannedSize += AddrOffset(p, next); + if (!closure->scanAllObjects) { + Index j = AMS_ADDR_INDEX(seg, next); + AVER(!AMSIsInvalidColor(seg, i)); + AMSGreyBlacken(seg, i); + if (i+1 < j) + AMSRangeWhiteBlacken(seg, i+1, j); + } + } + + return ResOK; +} + + +/* AMSScan -- the pool class segment scanning method + * + * See design.mps.poolams.scan + */ +Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + Res res; + AMS ams; + Arena arena; + AMSSeg amsseg; + struct amsScanClosureStruct closureStruct; + Format format; + Align alignment; + + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + arena = PoolArena(pool); + AVER(SegCheck(seg)); + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + + /* Check that we're not in the grey mutator phase (see */ + /* design.mps.poolams.not-req.grey). */ + AVER(TraceSetSub(ss->traces, arena->flippedTraces)); + + closureStruct.scanAllObjects = + (TraceSetDiff(ss->traces, SegWhite(seg)) != TraceSetEMPTY); + closureStruct.ss = ss; + /* @@@@ This isn't quite right for multiple traces. */ + if (closureStruct.scanAllObjects) { + /* The whole seg (except the buffer) is grey for some trace. */ + res = (ams->iterate)(seg, amsScanObject, &closureStruct); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + *totalReturn = TRUE; + } else { + AVER(amsseg->marksChanged); /* something must have changed */ + AVER(amsseg->colourTablesInUse); + format = pool->format; + AVERT(Format, format); + alignment = PoolAlignment(AMS2Pool(ams)); + do { /* design.mps.poolams.scan.iter */ + amsseg->marksChanged = FALSE; /* design.mps.poolams.marked.scan */ + /* design.mps.poolams.ambiguous.middle */ + if (amsseg->ambiguousFixes) { + res = (ams->iterate)(seg, amsScanObject, &closureStruct); + if (res != ResOK) { + /* design.mps.poolams.marked.scan.fail */ + amsseg->marksChanged = TRUE; + *totalReturn = FALSE; + return res; + } + } else { + Index i, j = 0; + Addr p, next; + + while(j < amsseg->grains + && AMSFindGrey(&i, &j, seg, j, amsseg->grains)) { + AVER(!AMSIsInvalidColor(seg, i)); + p = AMS_INDEX_ADDR(seg, i); + next = (*format->skip)(p); + AVER(AddrIsAligned(next, alignment)); + j = AMS_ADDR_INDEX(seg, next); + res = (*format->scan)(ss, p, next); + if (res != ResOK) { + /* design.mps.poolams.marked.scan.fail */ + amsseg->marksChanged = TRUE; + *totalReturn = FALSE; + return res; + } + ss->scannedSize += AddrOffset(p, next); + AMSGreyBlacken(seg, i); + if (i+1 < j) + AMSRangeWhiteBlacken(seg, i+1, j); + } + } + } while(amsseg->marksChanged); + *totalReturn = FALSE; + } + + return ResOK; +} + + +/* AMSFix -- the pool class fixing method */ + +Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + AMSSeg amsseg; + Index i; /* the index of the fixed grain */ + Ref ref; + + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(CHECKT(AMS, Pool2AMS(pool))); + AVERT_CRITICAL(ScanState, ss); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(refIO != NULL); + + amsseg = Seg2AMSSeg(seg); + AVERT_CRITICAL(AMSSeg, amsseg); + /* It's a white seg, so it must have colour tables. */ + AVER_CRITICAL(amsseg->colourTablesInUse); + + /* @@@@ We should check that we're not in the grey mutator phase */ + /* (see design.mps.poolams.not-req.grey), but there's no way of */ + /* doing that here (this can be called from RootScan, during flip). */ + + ref = *refIO; + i = AMS_ADDR_INDEX(seg, ref); + AVER_CRITICAL(!AMSIsInvalidColor(seg, i)); + + ss->wasMarked = TRUE; + + switch (ss->rank) { + case RankAMBIG: + /* not a real pointer if not aligned or not allocated */ + if (!AddrIsAligned((Addr)ref, PoolAlignment(pool)) + || !AMS_ALLOCED(seg, i)) { + break; + } + amsseg->ambiguousFixes = TRUE; + /* falls through */ + case RankEXACT: + case RankFINAL: + case RankWEAK: + AVER_CRITICAL(AddrIsAligned((Addr)ref, PoolAlignment(pool))); + AVER_CRITICAL(AMS_ALLOCED(seg, i)); + if (AMSIsWhite(seg, i)) { + ss->wasMarked = FALSE; + if (ss->rank == RankWEAK) { /* then splat the reference */ + *refIO = (Ref)0; + } else { + ++ss->preservedInPlaceCount; /* Size updated on reclaim */ + if (SegRankSet(seg) == RankSetEMPTY && ss->rank != RankAMBIG) { + /* design.mps.poolams.fix.to-black */ + Addr next; + + ShieldExpose(PoolArena(pool), seg); + next = (*pool->format->skip)(ref); + ShieldCover(PoolArena(pool), seg); + /* Part of the object might be grey, because of ambiguous */ + /* fixes, but that's OK, because scan will ignore that. */ + AMSRangeWhiteBlacken(seg, i, AMS_ADDR_INDEX(seg, next)); + } else { /* turn it grey */ + AMSWhiteGreyen(seg, i); + SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces)); + /* mark it for scanning - design.mps.poolams.marked.fix */ + amsseg->marksChanged = TRUE; + } + } + } + break; + default: + NOTREACHED; + } + + return ResOK; +} + + +/* AMSBlacken -- the pool class blackening method + * + * Turn all grey objects black. + */ +void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + AMS ams; + + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + AVERT(TraceSet, traceSet); + AVERT(Seg, seg); + + /* If it's white for any trace, remove the greyness from tables. */ + if (TraceSetInter(traceSet, SegWhite(seg)) != TraceSetEMPTY) { + AMSSeg amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + AVER(amsseg->marksChanged); /* there must be something grey */ + amsseg->marksChanged = FALSE; + /* This will turn grey->black, and not affect black or white. */ + BTSetRange(amsseg->nongreyTable, 0, amsseg->grains); + } +} + + +/* AMSReclaim -- the pool class reclamation method */ + +void AMSReclaim(Pool pool, Trace trace, Seg seg) +{ + AMS ams; + AMSSeg amsseg; + Format format; + Align alignment; + Count reclaimed = 0; + Index i, j = 0; + Addr p, next; + + AVERT(Pool, pool); + ams = Pool2AMS(pool); + AVERT(AMS, ams); + AVERT(Seg, seg); + + amsseg = Seg2AMSSeg(seg); + /* It's a white seg, so it must have colour tables. */ + AVER(amsseg->colourTablesInUse); + AVER(!amsseg->marksChanged); /* there must be nothing grey */ + format = pool->format; + AVERT(Format, format); + alignment = PoolAlignment(AMS2Pool(ams)); + + /* Start using allocTable */ + if (!amsseg->allocTableInUse) { + amsseg->allocTableInUse = TRUE; + if (0 < amsseg->firstFree) + BTSetRange(amsseg->allocTable, 0, amsseg->firstFree); + if (amsseg->firstFree < amsseg->grains) + BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains); + } + + /* Loop over all white objects and free them */ + while(j < amsseg->grains + && AMSFindWhite(&i, &j, seg, j, amsseg->grains)) { + AVER(!AMSIsInvalidColor(seg, i)); + p = AMS_INDEX_ADDR(seg, i); + next = (*format->skip)(p); + AVER(AddrIsAligned(next, alignment)); + j = AMS_ADDR_INDEX(seg, next); + BTResRange(amsseg->allocTable, i, j); + reclaimed += j - i; + } + + amsseg->free += reclaimed; + trace->reclaimSize += reclaimed << ams->grainShift; + ams->pgen.totalSize -= reclaimed << ams->grainShift; + /* preservedInPlaceCount is updated on fix */ + trace->preservedInPlaceSize += + (amsseg->grains - amsseg->free) << ams->grainShift; + + if (amsseg->free == amsseg->grains && SegBuffer(seg) == NULL) { + /* No survivors */ + SegFree(seg); + } else { + amsseg->colourTablesInUse = FALSE; + SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); + } +} + + +/* AMSDescribe -- the pool class description method + * + * Iterates over the segments, describing all of them. + */ +static Res AMSDescribe(Pool pool, mps_lib_FILE *stream) +{ + AMS ams; + Ring node, nextNode; + Res res; + + if (!CHECKT(Pool, pool)) return ResFAIL; + ams = Pool2AMS(pool); + if (!CHECKT(AMS, ams)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + (WriteFP)pool, (WriteFU)pool->serial, + " size $W\n", + (WriteFW)ams->size, + " grain shift $U\n", (WriteFU)ams->grainShift, + " chain $P\n", + (WriteFP)ams->chain, + NULL); + if (res != ResOK) return res; + + res = WriteF(stream, + " segments\n" + " * = black, + = grey, - = white, . = alloc, ! = bad\n" + " buffers: [ = base, < = scan limit, | = init,\n" + " > = alloc, ] = limit\n", + NULL); + if (res != ResOK) return res; + + RING_FOR(node, &ams->segRing, nextNode) { + AMSSeg amsseg = RING_ELT(AMSSeg, segRing, node); + res = SegDescribe(AMSSeg2Seg(amsseg), stream); + if (res != ResOK) return res; + } + return ResOK; +} + + +/* AMSPoolClass -- the class definition */ + +/* impl.h.poolams contains the type definition. Hence the use */ +/* of DEFINE_CLASS rather than DEFINE_POOL_CLASS */ + +DEFINE_CLASS(AMSPoolClass, this) +{ + INHERIT_CLASS(this, AbstractCollectPoolClass); + PoolClassMixInFormat(this); + this->name = "AMS"; + this->size = sizeof(AMSStruct); + this->offset = offsetof(AMSStruct, poolStruct); + this->init = AMSInit; + this->finish = AMSFinish; + this->bufferClass = RankBufClassGet; + this->bufferFill = AMSBufferFill; + this->bufferEmpty = AMSBufferEmpty; + this->whiten = AMSWhiten; + this->blacken = AMSBlacken; + this->scan = AMSScan; + this->fix = AMSFix; + this->fixEmergency = AMSFix; + this->reclaim = AMSReclaim; + this->describe = AMSDescribe; +} + + +/* AMSCheck -- the check method for an AMS */ + +Bool AMSCheck(AMS ams) +{ + CHECKS(AMS, ams); + CHECKD(Pool, AMS2Pool(ams)); + CHECKL(IsSubclassPoly(AMS2Pool(ams)->class, AMSPoolClassGet())); + CHECKL(PoolAlignment(AMS2Pool(ams)) == ((Size)1 << ams->grainShift)); + CHECKL(PoolAlignment(AMS2Pool(ams)) == AMS2Pool(ams)->format->alignment); + CHECKD(Chain, ams->chain); + CHECKD(PoolGen, &ams->pgen); + CHECKL(SizeIsAligned(ams->size, ArenaAlign(PoolArena(AMS2Pool(ams))))); + CHECKL(ams->iterate != NULL); + CHECKL(RingCheck(&ams->segRing)); + CHECKL(ams->allocRing != NULL); + CHECKL(ams->segsDestroy != NULL); + CHECKL(ams->segClass != NULL); + + return TRUE; +} + + +/* mps_class_ams -- return the pool class descriptor to the client */ + +mps_class_t mps_class_ams(void) +{ + return (mps_class_t)AMSPoolClassGet(); +} diff --git a/mps/code/poolams.h b/mps/code/poolams.h new file mode 100644 index 00000000000..405d5dd6b95 --- /dev/null +++ b/mps/code/poolams.h @@ -0,0 +1,207 @@ +/* impl.h.poolams: AUTOMATIC MARK & SWEEP POOL CLASS INTERFACE + * + * $HopeName: MMsrc!poolams.h(trunk.16) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .purpose: Internal interface to AMS functionality. + */ + +#ifndef poolams_h +#define poolams_h + +#include "mpm.h" +#include + + +typedef struct AMSStruct *AMS; +typedef struct AMSSegStruct *AMSSeg; + + +/* AMSRingFunction is the type of the method to find the ring that */ +/* the AMS pool is allocating on. */ +typedef Ring (*AMSRingFunction)(AMS ams, RankSet rankSet, Size size); +/* AMSSegClassFunction is the type of the method to indicate */ +/* the segment class of an AMS pool. Returns a subclass of AMSSegClass. */ +/* The type is congruent with SegClassGet functions. */ +typedef SegClass (*AMSSegClassFunction)(void); +/* AMSSegsDestroyFunction is the type of the method to destroy all */ +/* segs of an AMS pool. */ +typedef void (*AMSSegsDestroyFunction)(AMS ams); +/* AMSSegSizePolicyFunction is the type of the method which picks */ +/* a segment size given an object size. */ +typedef Res (*AMSSegSizePolicyFunction)(Size *sizeReturn, + Pool pool, Size size, + RankSet rankSet); +/* AMSObjectFunction is the type of the method that an */ +/* AMSIterateFunction applies to each object in a segment. */ +typedef Res (*AMSObjectFunction)( + /* the segment */ Seg seg, + /* the object grain index */ Index i, + /* the address of the object */Addr p, + /* " " after the object */Addr next, + /* the iteration closure */ void *closure); + +#define AMSObjectFunctionCheck(f) \ + ((f) != NULL) /* that's the best we can do */ + +typedef Res (*AMSIterateFunction)(Seg seg, AMSObjectFunction f, void *closure); + + +typedef struct AMSStruct { + PoolStruct poolStruct; /* generic pool structure */ + Shift grainShift; /* log2 of grain size */ + Chain chain; /* chain used by this pool */ + PoolGenStruct pgen; /* generation representing the pool */ + Size size; /* total segment size of the pool */ + AMSIterateFunction iterate; /* iterator function */ + AMSSegSizePolicyFunction segSize; /* SegSize policy */ + RingStruct segRing; /* ring of segments in the pool */ + AMSRingFunction allocRing; /* fn to get the ring to allocate from */ + AMSSegsDestroyFunction segsDestroy; + AMSSegClassFunction segClass;/* fn to get the class for segments */ + Sig sig; /* design.mps.pool.outer-structure.sig */ +} AMSStruct; + + +typedef struct AMSSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + AMS ams; /* owning ams */ + RingStruct segRing; /* ring that this seg belongs to */ + Count grains; /* number of grains */ + Count free; /* number of free grains */ + Count newAlloc; /* number of grains allocated since last GC */ + Bool allocTableInUse; /* whether we use allocTable */ + Index firstFree; /* 1st free grain, if allocTable is not used */ + BT allocTable; /* set if grain is allocated */ + /* design.mps.poolams.colour.single */ + Bool marksChanged; /* has been marked since last scan */ + Bool ambiguousFixes; /* has been ambiguously marked since last scan */ + Bool colourTablesInUse;/* whether we use the colour tables */ + BT nongreyTable; /* set if grain not grey */ + BT nonwhiteTable; /* set if grain not white */ + Sig sig; +} AMSSegStruct; + + +/* macros to get between child and parent structures */ + +#define Seg2AMSSeg(seg) ((AMSSeg)(seg)) +#define AMSSeg2Seg(amsseg) ((Seg)(amsseg)) + +#define Pool2AMS(pool) PARENT(AMSStruct, poolStruct, pool) +#define AMS2Pool(ams) (&(ams)->poolStruct) + + +/* macros for abstracting index/address computations */ +/* design.mps.poolams.addr-index.slow */ + +/* only use when size is a multiple of the grain size */ +#define AMSGrains(ams, size) ((size) >> (ams)->grainShift) + +#define AMSGrainsSize(ams, grains) ((grains) << (ams)->grainShift) + +#define AMSSegShift(seg) (Seg2AMSSeg(seg)->ams->grainShift) + +#define AMS_ADDR_INDEX(seg, addr) \ + ((Index)(AddrOffset(SegBase(seg), addr) >> AMSSegShift(seg))) +#define AMS_INDEX_ADDR(seg, index) \ + AddrAdd(SegBase(seg), (Size)(index) << AMSSegShift(seg)) + + +/* colour ops */ + +#define AMSIsWhite(seg, index) \ + (!BTGet(Seg2AMSSeg(seg)->nonwhiteTable, index)) + +#define AMSIsGrey(seg, index) \ + (!BTGet(Seg2AMSSeg(seg)->nongreyTable, index)) + +#define AMSIsBlack(seg, index) \ + (!AMSIsGrey(seg, index) && !AMSIsWhite(seg, index)) + +#define AMSIsInvalidColor(seg, index) \ + (AMSIsGrey(seg, index) && AMSIsWhite(seg, index)) + +#define AMSGreyBlacken(seg, index) \ + BEGIN \ + BTSet(Seg2AMSSeg(seg)->nongreyTable, index); \ + END + +#define AMSWhiteGreyen(seg, index) \ + BEGIN \ + BTSet(Seg2AMSSeg(seg)->nonwhiteTable, index); \ + BTRes(Seg2AMSSeg(seg)->nongreyTable, index); \ + END + +#define AMSWhiteBlacken(seg, index) \ + BEGIN \ + BTSet(Seg2AMSSeg(seg)->nonwhiteTable, index); \ + END + +#define AMSRangeWhiteBlacken(seg, base, limit) \ + BEGIN \ + BTSetRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \ + END + +#define AMSRangeWhiten(seg, base, limit) \ + BEGIN \ + BTResRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \ + BTSetRange(Seg2AMSSeg(seg)->nongreyTable, base, limit); \ + END + +#define AMSRangeBlacken(seg, base, limit) \ + BEGIN \ + BTSetRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \ + BTSetRange(Seg2AMSSeg(seg)->nongreyTable, base, limit); \ + END + +#define AMSFindGrey(pos, dummy, seg, base, limit) \ + BTFindShortResRange(pos, dummy, Seg2AMSSeg(seg)->nongreyTable, \ + base, limit, 1) \ + +#define AMSFindWhite(pos, dummy, seg, base, limit) \ + BTFindShortResRange(pos, dummy, Seg2AMSSeg(seg)->nonwhiteTable, \ + base, limit, 1) \ + + +#define AMS_ALLOCED(seg, index) \ + (Seg2AMSSeg(seg)->allocTableInUse \ + ? BTGet(Seg2AMSSeg(seg)->allocTable, index) \ + : (Seg2AMSSeg(seg)->firstFree > (index))) + + +/* the rest */ + +extern Res AMSInitInternal(AMS ams, Format format, Chain chain); +extern void AMSFinish(Pool pool); +extern Bool AMSCheck(AMS ams); + +extern Res AMSBufferInit(Pool pool, Buffer buffer, va_list args); +extern Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit); +extern void AMSBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit); + +extern Res AMSWhiten(Pool pool, Trace trace, Seg seg); +extern Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg); +extern Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO); +extern void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg); +extern void AMSReclaim(Pool pool, Trace trace, Seg seg); + +#define AMSChain(ams) ((ams)->chain) + + +typedef SegClass AMSSegClass; +typedef SegClassStruct AMSSegClassStruct; +extern AMSSegClass AMSSegClassGet(void); +extern Bool AMSSegCheck(AMSSeg seg); + + +typedef PoolClass AMSPoolClass; +typedef PoolClassStruct AMSPoolClassStruct; + +extern AMSPoolClass AMSPoolClassGet(void); + + +#endif /* poolams_h */ diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c new file mode 100644 index 00000000000..9e755c4185e --- /dev/null +++ b/mps/code/poolawl.c @@ -0,0 +1,1248 @@ +/* impl.c.poolawl: AUTOMATIC WEAK LINKED POOL CLASS + * + * $HopeName: MMsrc!poolawl.c(trunk.72) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * + * DESIGN + * + * .design: See design.mps.poolawl. This is Dylan-specific pool. + * + * + * ASSUMPTIONS (about when to scan single references on accesses) + * + * .assume.purpose: The purpose of scanning refs singly is to limit the + * amount of scanning of weak references which must be performed when + * the mutator hits a barrier. Weak references which are scanned at this + * time are not "weak splatted". Minimizing any loss of weak splats + * potentially reduces conservatism in the collector. + * + * .assume.noweak: It follows (from .assume.purpose) that there is no + * benefit from scanning single refs on barrier accesses for segments + * which don't contain any weak references. However, if a segment + * contains either all weak refs or a mixture of weak and non-weak + * references then there is a potential benefit. + * + * .assume.mixedrank: If a segment contains a mixture of references + * at different ranks (e.g. weak and strong references), there is + * no way to determine whether or not references at a rank other than + * the scan state rank will be scanned as a result of normal + * (non-barrier) scanning activity. (@@@@ This is a deficiency in MPS). + * Assume that such references will, in fact, be scanned at the + * incorrect rank. + * + * .assume.samerank: The pool doesn't support segments with mixed + * rank segments in any case (despite .assume.mixedrank). + * + * .assume.alltraceable: The pool assumes that all objects are entirely + * traceable. This must be documented elsewhere for the benefit of the + * client. + */ + +#include "mpscawl.h" +#include "mpm.h" +#include "chain.h" + + +SRCID(poolawl, "$HopeName: MMsrc!poolawl.c(trunk.72) $"); + + +#define AWLSig ((Sig)0x519B7A37) /* SIGnature PooL AWL */ + +#define AWLGen ((Serial)1) /* "generation" for AWL pools */ +/* This and the dynamic criterion are the only ways AWL will get collected. */ + + +/* awlStat* -- Statistics gathering about instruction emulation + * + * To support change.dylan.2.0.160044. + */ + + +/* Per-segment statistics maintained between segment scans */ + +typedef struct awlStatSegStruct { + Count sameAccesses; /* accesses involving same address as last access */ + Addr lastAccess; /* the address of last access */ +} awlStatSegStruct, *awlStatSeg; + +/* Per-pool statistics updated at segment scans */ + +typedef struct awlStatTotalStruct { + Count goodScans; /* total times a segment scanned at proper rank */ + Count badScans; /* total times a segment scanned at improper rank */ + Count savedScans; /* total times an entire segment scan was avoided */ + Count savedAccesses; /* total single references leading to a saved scan */ + Count declined; /* number of declined single accesses */ +} awlStatTotalStruct, *awlStatTotal; + + +/* AWLStruct -- AWL pool structure + * + * See design.mps.poolawl.poolstruct + */ + +typedef struct AWLStruct { + PoolStruct poolStruct; + Shift alignShift; + Chain chain; /* dummy chain */ + PoolGenStruct pgen; /* generation representing the pool */ + Size size; /* allocated size in bytes */ + Serial gen; /* associated generation (for SegAlloc) */ + Count succAccesses; /* number of successive single accesses */ + awlStatTotalStruct stats; + Sig sig; +} AWLStruct, *AWL; + +#define Pool2AWL(pool) PARENT(AWLStruct, poolStruct, pool) + + +static Bool AWLCheck(AWL awl); + + +/* Conversion between indexes and Addrs */ +#define awlIndexOfAddr(base, awl, p) \ + (AddrOffset((base), (p)) >> (awl)->alignShift) + + +/* AWLSegStruct -- AWL segment subclass + * + * Subclass of GCSeg + */ + +#define AWLSegSig ((Sig)0x519A3759) /* SIGnature AWL SeG */ + +/* design.mps.poolawl.seg */ +typedef struct AWLSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + BT mark; + BT scanned; + BT alloc; + Count grains; + Count free; /* number of free grains */ + Count singleAccesses; /* number of accesses processed singly */ + awlStatSegStruct stats; + Sig sig; +} AWLSegStruct, *AWLSeg; + +#define Seg2AWLSeg(seg) ((AWLSeg)(seg)) +#define AWLSeg2Seg(awlseg) ((Seg)(awlseg)) + + +static SegClass AWLSegClassGet(void); + + +static Bool AWLSegCheck(AWLSeg awlseg) +{ + CHECKS(AWLSeg, awlseg); + CHECKD(GCSeg, &awlseg->gcSegStruct); + CHECKL(awlseg->mark != NULL); + CHECKL(awlseg->scanned != NULL); + CHECKL(awlseg->alloc != NULL); + /* Can't do any real check on ->grains */ + CHECKL(awlseg->grains > 0); + CHECKL(awlseg->free <= awlseg->grains); + return TRUE; +} + + +/* Management of statistics for monitoring protection-driven accesses */ + +static void awlStatSegInit(AWLSeg awlseg) +{ + awlseg->stats.sameAccesses = 0; + awlseg->stats.lastAccess = NULL; +} + +static void awlStatTotalInit(AWL awl) +{ + awl->stats.goodScans = 0; + awl->stats.badScans = 0; + awl->stats.savedAccesses = 0; + awl->stats.savedScans = 0; + awl->stats.declined = 0; +} + + +/* AWLSegInit -- Init method for AWL segments */ + +static Res AWLSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + AWLSeg awlseg; + AWL awl; + Arena arena; + RankSet rankSet; + Count bits; /* number of grains */ + Res res; + Size tableSize; + void *v; + + AVERT(Seg, seg); + awlseg = Seg2AWLSeg(seg); + AVERT(Pool, pool); + arena = PoolArena(pool); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + rankSet = va_arg(args, RankSet); + /* .assume.samerank */ + /* AWL only accepts two ranks */ + AVER(RankSetSingle(RankEXACT) == rankSet + || RankSetSingle(RankWEAK) == rankSet); + awl = Pool2AWL(pool); + AVERT(AWL, awl); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(AWLSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + + bits = size >> awl->alignShift; + tableSize = BTSize(bits); + res = ControlAlloc(&v, arena, tableSize, reservoirPermit); + if (res != ResOK) + goto failControlAllocMark; + awlseg->mark = v; + res = ControlAlloc(&v, arena, tableSize, reservoirPermit); + if (res != ResOK) + goto failControlAllocScanned; + awlseg->scanned = v; + res = ControlAlloc(&v, arena, tableSize, reservoirPermit); + if (res != ResOK) + goto failControlAllocAlloc; + awlseg->alloc = v; + awlseg->grains = bits; + BTResRange(awlseg->mark, 0, bits); + BTResRange(awlseg->scanned, 0, bits); + BTResRange(awlseg->alloc, 0, bits); + SegSetRankAndSummary(seg, rankSet, RefSetUNIV); + awlseg->free = bits; + awlseg->sig = AWLSegSig; + awlseg->singleAccesses = 0; + awlStatSegInit(awlseg); + AVERT(AWLSeg, awlseg); + return ResOK; + +failControlAllocAlloc: + ControlFree(arena, awlseg->scanned, tableSize); +failControlAllocScanned: + ControlFree(arena, awlseg->mark, tableSize); +failControlAllocMark: + super->finish(seg); + return res; +} + + +/* AWLSegFinish -- Finish method for AWL segments */ + +static void AWLSegFinish(Seg seg) +{ + AWL awl; + AWLSeg awlseg; + SegClass super; + Pool pool; + Size tableSize; + Arena arena; + Count segGrains; + + AVERT(Seg, seg); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + pool = SegPool(seg); + AVERT(Pool, pool); + awl = Pool2AWL(pool); + AVERT(AWL, awl); + arena = PoolArena(pool); + AVERT(Arena, arena); + + /* This is one of the few places where it is easy to check */ + /* awlseg->grains, so we do */ + segGrains = SegSize(seg) >> awl->alignShift; + AVER(segGrains == awlseg->grains); + tableSize = BTSize(segGrains); + ControlFree(arena, awlseg->alloc, tableSize); + ControlFree(arena, awlseg->scanned, tableSize); + ControlFree(arena, awlseg->mark, tableSize); + awlseg->sig = SigInvalid; + + /* finish the superclass fields last */ + super = SEG_SUPERCLASS(AWLSegClass); + super->finish(seg); +} + + +/* AWLSegClass -- Class definition for AWL segments */ + +DEFINE_SEG_CLASS(AWLSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + SegClassMixInNoSplitMerge(class); /* no support for this (yet) */ + class->name = "AWLSEG"; + class->size = sizeof(AWLSegStruct); + class->init = AWLSegInit; + class->finish = AWLSegFinish; +} + + +/* Single access permission control parameters */ + +Count AWLSegSALimit = 0; /* Number of single accesses permitted per segment */ +Bool AWLHaveSegSALimit = FALSE; /* When TRUE, AWLSegSALimit applies */ + +Count AWLTotalSALimit = 0; /* Number of single accesses permitted in a row */ +Bool AWLHaveTotalSALimit = FALSE; /* When TRUE, AWLTotalSALimit applies */ + + +/* Determine whether to permit scanning a single ref. */ + +static Bool AWLCanTrySingleAccess(AWL awl, Seg seg, Addr addr) +{ + AVERT(AWL, awl); + AVERT(Seg, seg); + AVER(addr != NULL); + + /* .assume.noweak */ + /* .assume.alltraceable */ + if (RankSetIsMember(SegRankSet(seg), RankWEAK)) { + AWLSeg awlseg; + + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + if (AWLHaveTotalSALimit) { + if (AWLTotalSALimit < awl->succAccesses) { + STATISTIC(awl->stats.declined++); + return FALSE; /* decline single access because of total limit */ + } + } + + if (AWLHaveSegSALimit) { + if (AWLSegSALimit < awlseg->singleAccesses) { + STATISTIC(awl->stats.declined++); + return FALSE; /* decline single access because of segment limit */ + } + } + + return TRUE; + + } else { + return FALSE; /* Single access only for weak segs (.assume.noweak) */ + } +} + + +/* Record an access to a segment which required scanning a single ref */ + +static void AWLNoteRefAccess(AWL awl, Seg seg, Addr addr) +{ + AWLSeg awlseg; + + AVERT(AWL, awl); + AVERT(Seg, seg); + AVER(addr != NULL); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + awlseg->singleAccesses++; /* increment seg count of ref accesses */ + if (addr == awlseg->stats.lastAccess) { + /* If this is a repeated access, increment count */ + STATISTIC(awlseg->stats.sameAccesses++); + } + STATISTIC(awlseg->stats.lastAccess = addr); + awl->succAccesses++; /* Note a new successive access */ +} + + +/* Record an access to a segment which required scanning the entire seg */ + +static void AWLNoteSegAccess(AWL awl, Seg seg, Addr addr) +{ + AVERT(AWL, awl); + AVERT(Seg, seg); + AVER(addr != NULL); + + awl->succAccesses = 0; /* reset count of successive accesses */ +} + + +/* Record a scan of a segment which wasn't provoked by an access */ + +static void AWLNoteScan(AWL awl, Seg seg, ScanState ss) +{ + AWLSeg awlseg; + + AVERT(AWL, awl); + AVERT(Seg, seg); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + /* .assume.mixedrank */ + /* .assume.samerank */ + /* If this segment has any RankWEAK references, then */ + /* record statistics about whether weak splatting is being lost. */ + if (RankSetIsMember(SegRankSet(seg), RankWEAK)) { + if (RankWEAK == ss->rank) { + /* This is "successful" scan at proper rank. */ + STATISTIC(awl->stats.goodScans++); + if (0 < awlseg->singleAccesses) { + /* Accesses have been proceesed singly */ + /* Record that we genuinely did save a protection-provoked scan */ + STATISTIC(awl->stats.savedScans++); + STATISTIC(awl->stats.savedAccesses += awlseg->singleAccesses); + } + } else { + /* This is "failed" scan at improper rank. */ + STATISTIC(awl->stats.badScans++); + } + /* Reinitialize the segment statistics */ + awlseg->singleAccesses = 0; + STATISTIC(awlStatSegInit(awlseg)); + } +} + + +/* AWLSegCreate -- Create a new segment of at least given size */ + +static Res AWLSegCreate(AWLSeg *awlsegReturn, + RankSet rankSet, Pool pool, Size size, + Bool reservoirPermit) +{ + AWL awl; + Seg seg; + AWLSeg awlseg; + Res res; + Arena arena; + SegPrefStruct segPrefStruct; + + AVER(awlsegReturn != NULL); + AVER(RankSetCheck(rankSet)); + AVERT(Pool, pool); + AVER(size > 0); + AVER(BoolCheck(reservoirPermit)); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + + arena = PoolArena(pool); + AVERT(Arena, arena); + + size = SizeAlignUp(size, ArenaAlign(arena)); + /* beware of large sizes overflowing upon rounding */ + if (size == 0) + return ResMEMORY; + segPrefStruct = *SegPrefDefault(); + SegPrefExpress(&segPrefStruct, SegPrefCollected, NULL); + SegPrefExpress(&segPrefStruct, SegPrefGen, &awl->gen); + res = SegAlloc(&seg, AWLSegClassGet(), &segPrefStruct, size, pool, + reservoirPermit, rankSet); + if (res != ResOK) + return res; + + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + *awlsegReturn = awlseg; + return ResOK; +} + + +/* AWLSegAlloc -- allocate an object in a given segment */ + +static Bool AWLSegAlloc(Addr *baseReturn, Addr *limitReturn, + AWLSeg awlseg, AWL awl, Size size) +{ + Count n; /* number of grains equivalent to alloc size */ + Index i, j; + Seg seg; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(AWLSeg, awlseg); + AVERT(AWL, awl); + AVER(size > 0); + AVER(size << awl->alignShift >= size); + seg = AWLSeg2Seg(awlseg); + + if (size > SegSize(seg)) + return FALSE; + n = size >> awl->alignShift; + if (!BTFindLongResRange(&i, &j, awlseg->alloc, 0, awlseg->grains, n)) + return FALSE; + awl->size += size; + *baseReturn = AddrAdd(SegBase(seg), i << awl->alignShift); + *limitReturn = AddrAdd(SegBase(seg), j << awl->alignShift); + return TRUE; +} + + +/* AWLInit -- initialize an AWL pool */ + +static Res AWLInit(Pool pool, va_list arg) +{ + AWL awl; + Format format; + Chain chain; + Res res; + static GenParamStruct genParam = { SizeMAX, 0.5 /* dummy */ }; + + /* Weak check, as half-way through initialization. */ + AVER(pool != NULL); + + awl = Pool2AWL(pool); + + format = va_arg(arg, Format); + AVERT(Format, format); + pool->format = format; + + res = ChainCreate(&chain, pool->arena, 1, &genParam); + if (res != ResOK) + return res; + awl->chain = chain; + /* .gen: This must be the nursery in the chain, because it's the only */ + /* generation. awl->gen is just a hack for segment placement. */ + res = PoolGenInit(&awl->pgen, chain, 0 /* .gen */, pool); + if (res != ResOK) + goto failGenInit; + + awl->alignShift = SizeLog2(pool->alignment); + awl->gen = AWLGen; + awl->size = (Size)0; + + awl->succAccesses = 0; + awlStatTotalInit(awl); + awl->sig = AWLSig; + + AVERT(AWL, awl); + EVENT_PP(PoolInitAWL, pool, format); + return ResOK; + +failGenInit: + ChainDestroy(chain); + return res; +} + + +/* AWLFinish -- finish an AWL pool */ + +static void AWLFinish(Pool pool) +{ + AWL awl; + Ring ring, node, nextNode; + + AVERT(Pool, pool); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + + ring = &pool->segRing; + RING_FOR(node, ring, nextNode) { + Seg seg = SegOfPoolRing(node); + AVERT(Seg, seg); + SegFree(seg); + } + awl->sig = SigInvalid; + PoolGenFinish(&awl->pgen); + ChainDestroy(awl->chain); +} + + +/* AWLBufferFill -- BufferFill method for AWL */ + +static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool reservoirPermit) +{ + Addr base, limit; + AWLSeg awlseg; + AWL awl; + Res res; + Ring node, nextNode; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(BoolCheck(reservoirPermit)); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + + RING_FOR(node, &pool->segRing, nextNode) { + Seg seg; + + seg = SegOfPoolRing(node); + AVERT(Seg, seg); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + /* Only try to allocate in the segment if it is not already */ + /* buffered, and has the same ranks as the buffer. */ + if (SegBuffer(seg) == NULL && SegRankSet(seg) == BufferRankSet(buffer)) + if (awlseg->free << awl->alignShift >= size + && AWLSegAlloc(&base, &limit, awlseg, awl, size)) + goto found; + } + + /* No free space in existing awlsegs, so create new awlseg */ + + res = AWLSegCreate(&awlseg, BufferRankSet(buffer), pool, size, + reservoirPermit); + if (res != ResOK) + return res; + base = SegBase(AWLSeg2Seg(awlseg)); + limit = SegLimit(AWLSeg2Seg(awlseg)); + +found: + { + Index i, j; + Seg seg = AWLSeg2Seg(awlseg); + i = awlIndexOfAddr(SegBase(seg), awl, base); + j = awlIndexOfAddr(SegBase(seg), awl, limit); + AVER(i < j); + BTSetRange(awlseg->alloc, i, j); + /* Objects are allocated black. */ + /* Shouldn't this depend on trace phase? @@@@ */ + BTSetRange(awlseg->mark, i, j); + BTSetRange(awlseg->scanned, i, j); + awlseg->free -= j - i; + } + *baseReturn = base; + *limitReturn = limit; + return ResOK; +} + + +/* AWLBufferEmpty -- BufferEmpty method for AWL */ + +static void AWLBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) +{ + AWL awl; + AWLSeg awlseg; + Seg seg; + Addr segBase; + Index i, j; + + AVERT(Pool, pool); + AVERT(Buffer, buffer); + seg = BufferSeg(buffer); + AVERT(Seg, seg); + AVER(init <= limit); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + segBase = SegBase(seg); + + i = awlIndexOfAddr(segBase, awl, init); + j = awlIndexOfAddr(segBase, awl, limit); + AVER(i <= j); + if (i < j) { + BTResRange(awlseg->alloc, i, j); + awlseg->free += j - i; + } +} + + +/* AWLWhiten -- segment condemning method */ + +/* Split out of AWLWhiten because it's used in more than one place. */ +static void AWLRangeWhiten(AWLSeg awlseg, Index base, Index limit) +{ + if (base != limit) { + AVER(base < limit); + AVER(limit <= awlseg->grains); + BTResRange(awlseg->mark, base, limit); + BTResRange(awlseg->scanned, base, limit); + } +} + +static Res AWLWhiten(Pool pool, Trace trace, Seg seg) +{ + AWL awl; + AWLSeg awlseg; + Buffer buffer; + + /* all parameters checked by generic PoolWhiten */ + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + buffer = SegBuffer(seg); + + /* can only whiten for a single trace, */ + /* see design.mps.poolawl.fun.condemn */ + AVER(SegWhite(seg) == TraceSetEMPTY); + + if (buffer == NULL) { + AWLRangeWhiten(awlseg, 0, awlseg->grains); + trace->condemned += SegSize(seg); + } else { + /* Whiten everything except the buffer. */ + Addr base = SegBase(seg); + Index scanLimitIndex = awlIndexOfAddr(base, awl, + BufferScanLimit(buffer)); + Index limitIndex = awlIndexOfAddr(base, awl, + BufferLimit(buffer)); + + AWLRangeWhiten(awlseg, 0, scanLimitIndex); + AWLRangeWhiten(awlseg, limitIndex, awlseg->grains); + + /* Check the buffer is black. */ + /* This really ought to change when we have a non-trivial */ + /* pre-flip phase. @@@@ ('coz then we'll be allocating white) */ + if (scanLimitIndex != limitIndex) { + AVER(BTIsSetRange(awlseg->mark, scanLimitIndex, limitIndex)); + AVER(BTIsSetRange(awlseg->scanned, scanLimitIndex, limitIndex)); + } + + /* We didn't condemn the buffer, subtract it from the count. */ + /* @@@@ We could subtract all the free grains. */ + trace->condemned += SegSize(seg) + - AddrOffset(BufferScanLimit(buffer), + BufferLimit(buffer)); + } + + SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace)); + return ResOK; +} + + +/* AWLGrey -- Grey method for AWL pools */ + +/* AWLRangeGrey -- subroutine for AWLGrey */ +static void AWLRangeGrey(AWLSeg awlseg, Index base, Index limit) +{ + /* AWLSeg not checked as that's already been done */ + AVER(limit <= awlseg->grains); + /* copes with degenerate case as that makes caller simpler */ + if (base < limit) { + BTSetRange(awlseg->mark, base, limit); + BTResRange(awlseg->scanned, base, limit); + } else { + AVER(base == limit); + } +} + +static void AWLGrey(Pool pool, Trace trace, Seg seg) +{ + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + + if (!TraceSetIsMember(SegWhite(seg), trace)) { + AWL awl; + AWLSeg awlseg; + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + SegSetGrey(seg, TraceSetAdd(SegGrey(seg), trace)); + if (SegBuffer(seg) != NULL) { + Addr base = SegBase(seg); + Buffer buffer = SegBuffer(seg); + + AWLRangeGrey(awlseg, + 0, + awlIndexOfAddr(base, awl, BufferScanLimit(buffer))); + AWLRangeGrey(awlseg, + awlIndexOfAddr(base, awl, BufferLimit(buffer)), + awlseg->grains); + } else { + AWLRangeGrey(awlseg, 0, awlseg->grains); + } + } +} + + +/* AWLBlacken -- Blacken method for AWL pools */ + +static void AWLBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + AWL awl; + AWLSeg awlseg; + + AVERT(Pool, pool); + AVER(TraceSetCheck(traceSet)); + AVERT(Seg, seg); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + BTSetRange(awlseg->scanned, 0, awlseg->grains); +} + + +/* AWLDependentObject -- returns the linked object, if any + * + * see design.mps.poolawl.fun.dependent-object, and + * analysis.mps.poolawl.improve.dependent.abstract + */ + +static Bool AWLDependentObject(Addr *objReturn, Addr parent) +{ + Word *object; + Word *wrapper; + Word fword; + Word fl; + Word ff; + + AVER(objReturn != NULL); + AVER(parent != (Addr)0); + + object = (Word *)parent; + wrapper = (Word *)object[0]; + AVER(wrapper != NULL); + /* check wrapper wrapper is non-NULL */ + AVER(wrapper[0] != 0); + /* check wrapper wrapper is wrapper wrapper wrapper */ + AVER(wrapper[0] == ((Word *)wrapper[0])[0]); + fword = wrapper[3]; + ff = fword & 3; + /* Traceable Fixed part */ + AVER(ff == 1); + fl = fword & ~3uL; + /* At least one fixed field */ + AVER(fl >= 1); + if (object[1] == 0) + return FALSE; + *objReturn = (Addr)object[1]; + return TRUE; +} + + +/* awlScanObject -- scan a single object */ + +static Res awlScanObject(Arena arena, ScanState ss, + FormatScanMethod scan, Addr base, Addr limit) +{ + Res res; + Bool dependent; /* is there a dependent object? */ + Addr dependentObject; /* base address of dependent object */ + Seg dependentSeg = NULL; /* segment of dependent object */ + + AVERT(Arena, arena); + AVERT(ScanState, ss); + AVER(FUNCHECK(scan)); + AVER(base != 0); + AVER(base < limit); + + dependent = AWLDependentObject(&dependentObject, base) + && SegOfAddr(&dependentSeg, arena, dependentObject); + + if (dependent) { + /* design.mps.poolawl.fun.scan.pass.object.dependent.expose */ + ShieldExpose(arena, dependentSeg); + /* design.mps.poolawl.fun.scan.pass.object.dependent.summary */ + SegSetSummary(dependentSeg, RefSetUNIV); + } + + res = (*scan)(ss, base, limit); + if (res == ResOK) + ss->scannedSize += AddrOffset(base, limit); + + if (dependent) + ShieldCover(arena, dependentSeg); + + return res; +} + + +/* awlScanSinglePass -- a single scan pass over a segment */ + +static Res awlScanSinglePass(Bool *anyScannedReturn, + ScanState ss, Pool pool, + Seg seg, Bool scanAllObjects) +{ + Addr base, limit, bufferScanLimit; + Addr p; + Arena arena; + AWL awl; + AWLSeg awlseg; + Buffer buffer; + + AVERT(ScanState, ss); + AVERT(Pool, pool); + AVERT(Seg, seg); + AVERT(Bool, scanAllObjects); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + arena = PoolArena(pool); + AVERT(Arena, arena); + + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + *anyScannedReturn = FALSE; + base = SegBase(seg); + limit = SegLimit(seg); + p = base; + buffer = SegBuffer(seg); + if (buffer != NULL && BufferScanLimit(buffer) != BufferLimit(buffer)) + bufferScanLimit = BufferScanLimit(buffer); + else + bufferScanLimit = limit; + + while(p < limit) { + Index i; /* the index into the bit tables corresponding to p */ + Addr objectLimit; + + /* design.mps.poolawl.fun.scan.pass.buffer */ + if (p == bufferScanLimit) { + p = BufferLimit(buffer); + continue; + } + + i = awlIndexOfAddr(base, awl, p); + if (!BTGet(awlseg->alloc, i)) { + p = AddrAdd(p, pool->alignment); + continue; + } + objectLimit = (*pool->format->skip)(p); + /* design.mps.poolawl.fun.scan.pass.object */ + if (scanAllObjects + || (BTGet(awlseg->mark, i) && !BTGet(awlseg->scanned, i))) { + Res res = awlScanObject(arena, ss, pool->format->scan, + p, objectLimit); + if (res != ResOK) + return res; + *anyScannedReturn = TRUE; + BTSet(awlseg->scanned, i); + } + AVER(p < objectLimit); + p = AddrAlignUp(objectLimit, pool->alignment); + } + AVER(p == limit); + + return ResOK; +} + + +/* AWLScan -- segment scan method for AWL */ + +static Res AWLScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + AWL awl; + AWLSeg awlseg; + Bool anyScanned; + Bool scanAllObjects; + Res res; + + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Pool, pool); + AVERT(Seg, seg); + + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + + /* If the scanner isn't going to scan all the objects then the */ + /* summary of the unscanned objects must be added into the scan */ + /* state summary, so that it's a valid summary of the entire */ + /* segment on return. */ + + /* This pool assumes disjoint white sets and maintains mark and */ + /* scanned tables (effectively non-white and black tables) with */ + /* respect to the trace with respect to which the segment is */ + /* white. For any other trace, we cannot tell which objects */ + /* are grey and must therefore scan them all. */ + + scanAllObjects = + (TraceSetDiff(ss->traces, SegWhite(seg)) != TraceSetEMPTY); + + do { + res = awlScanSinglePass(&anyScanned, ss, pool, seg, scanAllObjects); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + /* we are done if we scanned all the objects or if we did a pass */ + /* and didn't scan any objects (since then, no new object can have */ + /* gotten fixed) */ + } while(!scanAllObjects && anyScanned); + + *totalReturn = scanAllObjects; + AWLNoteScan(awl, seg, ss); + return ResOK; +} + + +/* AWLFix -- Fix method for AWL */ + +static Res AWLFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + Ref ref; + Index i; + AWL awl; + AWLSeg awlseg; + + AVERT(Pool, pool); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVER(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY); + AVER(refIO != NULL); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + ref = *refIO; + i = awlIndexOfAddr(SegBase(seg), awl, ref); + + ss->wasMarked = TRUE; + + switch(ss->rank) { + case RankAMBIG: + /* not a real pointer if not aligned or not allocated */ + if (!AddrIsAligned((Addr)ref, pool->alignment) || !BTGet(awlseg->alloc, i)) + return ResOK; + /* falls through */ + case RankEXACT: + case RankFINAL: + case RankWEAK: + if (!BTGet(awlseg->mark, i)) { + ss->wasMarked = FALSE; + if (ss->rank == RankWEAK) { + *refIO = (Ref)0; + } else { + BTSet(awlseg->mark, i); + SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces)); + } + } + break; + default: + NOTREACHED; + return ResUNIMPL; + } + + return ResOK; +} + + +/* AWLReclaim -- reclaim dead objects in an AWL segment */ + +static void AWLReclaim(Pool pool, Trace trace, Seg seg) +{ + Addr base; + AWL awl; + AWLSeg awlseg; + Index i; + Count oldFree; + Count preservedInPlaceCount = (Count)0; + Size preservedInPlaceSize = (Size)0; + Size freed; /* amount reclaimed, in bytes */ + + AVERT(Pool, pool); + AVERT(Trace, trace); + AVERT(Seg, seg); + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + base = SegBase(seg); + + i = 0; oldFree = awlseg->free; + while(i < awlseg->grains) { + Addr p, q; + Index j; + + if (!BTGet(awlseg->alloc, i)) { + ++i; + continue; + } + p = AddrAdd(base, i << awl->alignShift); + if (SegBuffer(seg) != NULL) { + Buffer buffer = SegBuffer(seg); + + if (p == BufferScanLimit(buffer) + && BufferScanLimit(buffer) != BufferLimit(buffer)) { + i = awlIndexOfAddr(base, awl, BufferLimit(buffer)); + continue; + } + } + q = AddrAlignUp(pool->format->skip(p), pool->alignment); + j = awlIndexOfAddr(base, awl, q); + AVER(j <= awlseg->grains); + if (BTGet(awlseg->mark, i)) { + AVER(BTGet(awlseg->scanned, i)); + BTSetRange(awlseg->mark, i, j); + BTSetRange(awlseg->scanned, i, j); + ++preservedInPlaceCount; + preservedInPlaceSize += AddrOffset(p, q); + } else { + BTResRange(awlseg->mark, i, j); + BTSetRange(awlseg->scanned, i, j); + BTResRange(awlseg->alloc, i, j); + awlseg->free += j - i; + } + i = j; + } + AVER(i == awlseg->grains); + + freed = (awlseg->free - oldFree) << awl->alignShift; + awl->size -= freed; + trace->reclaimSize += freed; + trace->preservedInPlaceCount += preservedInPlaceCount; + trace->preservedInPlaceSize += preservedInPlaceSize; + SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); + /* @@@@ never frees a segment */ +} + + +/* AWLAccess -- handle a barrier hit */ + +static Res AWLAccess(Pool pool, Seg seg, Addr addr, + AccessSet mode, MutatorFaultContext context) +{ + AWL awl; + Res res; + + AVERT(Pool, pool); + awl = Pool2AWL(pool); + AVERT(AWL, awl); + AVERT(Seg, seg); + AVER(SegBase(seg) <= addr); + AVER(addr < SegLimit(seg)); + AVER(SegPool(seg) == pool); + + /* Attempt scanning a single reference if permitted */ + if (AWLCanTrySingleAccess(awl, seg, addr)) { + res = PoolSingleAccess(pool, seg, addr, mode, context); + switch(res) { + case ResOK: + AWLNoteRefAccess(awl, seg, addr); + return ResOK; + case ResFAIL: + /* Not all accesses can be managed singly. Default to segment */ + break; + default: + return res; + } + } + + /* Have to scan the entire seg anyway. */ + res = PoolSegAccess(pool, seg, addr, mode, context); + if (ResOK == res) + AWLNoteSegAccess(awl, seg, addr); + + return res; +} + + +/* AWLWalk -- walk all objects */ + +static void AWLWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, + void *p, unsigned long s) +{ + AWL awl; + AWLSeg awlseg; + Addr object, base, limit; + + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures and can't be checked */ + + awl = Pool2AWL(pool); + AVERT(AWL, awl); + awlseg = Seg2AWLSeg(seg); + AVERT(AWLSeg, awlseg); + + base = SegBase(seg); + object = base; + limit = SegLimit(seg); + + while(object < limit) { + /* object is a slight misnomer because it might point to a */ + /* free grain */ + Addr next; + Index i; + + if (SegBuffer(seg) != NULL) { + Buffer buffer = SegBuffer(seg); + if (object == BufferScanLimit(buffer) + && BufferScanLimit(buffer) != BufferLimit(buffer)) { + /* skip over buffered area */ + object = BufferLimit(buffer); + continue; + } + /* since we skip over the buffered area we are always */ + /* either before the buffer, or after it, never in it */ + AVER(object < BufferGetInit(buffer) || BufferLimit(buffer) <= object); + } + i = awlIndexOfAddr(base, awl, object); + if (!BTGet(awlseg->alloc, i)) { + /* This grain is free */ + object = AddrAdd(object, pool->alignment); + continue; + } + next = AddrAlignUp((*pool->format->skip)(object), pool->alignment); + if (BTGet(awlseg->mark, i) && BTGet(awlseg->scanned, i)) + (*f)(object, pool->format, pool, p, s); + object = next; + } +} + + +/* AWLPoolClass -- the class definition */ + +DEFINE_POOL_CLASS(AWLPoolClass, this) +{ + INHERIT_CLASS(this, AbstractCollectPoolClass); + PoolClassMixInFormat(this); + this->name = "AWL"; + this->size = sizeof(AWLStruct); + this->offset = offsetof(AWLStruct, poolStruct); + this->init = AWLInit; + this->finish = AWLFinish; + this->bufferClass = RankBufClassGet; + this->bufferFill = AWLBufferFill; + this->bufferEmpty = AWLBufferEmpty; + this->access = AWLAccess; + this->whiten = AWLWhiten; + this->grey = AWLGrey; + this->blacken = AWLBlacken; + this->scan = AWLScan; + this->fix = AWLFix; + this->fixEmergency = AWLFix; + this->reclaim = AWLReclaim; + this->walk = AWLWalk; +} + + +mps_class_t mps_class_awl(void) +{ + return (mps_class_t)AWLPoolClassGet(); +} + + +/* AWLCheck -- check an AWL pool */ + +static Bool AWLCheck(AWL awl) +{ + CHECKS(AWL, awl); + CHECKD(Pool, &awl->poolStruct); + CHECKL(awl->poolStruct.class == AWLPoolClassGet()); + CHECKL(1uL << awl->alignShift == awl->poolStruct.alignment); + CHECKD(Chain, awl->chain); + /* 30 is just a sanity check really, not a constraint. */ + CHECKL(0 <= awl->gen && awl->gen <= 30); + /* Nothing to check about succAccesses. */ + /* Don't bother to check stats. */ + return TRUE; +} diff --git a/mps/code/poollo.c b/mps/code/poollo.c new file mode 100644 index 00000000000..cbd04f19fd2 --- /dev/null +++ b/mps/code/poollo.c @@ -0,0 +1,801 @@ +/* impl.c.poollo: LEAF POOL CLASS + * + * $HopeName: MMsrc!poollo.c(trunk.19) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: See design.mps.poollo. This is a leaf pool class. + */ + +#include "mpsclo.h" +#include "mpm.h" +#include "mps.h" + +SRCID(poollo, "$HopeName: MMsrc!poollo.c(trunk.19) $"); + + +#define LOGen ((Serial)1) + + +/* LOStruct -- leaf object pool instance structure */ + +#define LOSig ((Sig)0x51970B07) /* SIGnature LO POoL */ + +typedef struct LOStruct *LO; + +typedef struct LOStruct { + PoolStruct poolStruct; /* generic pool structure */ + Shift alignShift; /* log_2 of pool alignment */ + Serial gen; /* generation for placement */ + Chain chain; /* chain used by this pool */ + PoolGenStruct pgen; /* generation representing the pool */ + Sig sig; +} LOStruct; + +#define PoolPoolLO(pool) PARENT(LOStruct, poolStruct, pool) +#define LOPool(lo) (&(lo)->poolStruct) + + +/* forward declaration */ +static Bool LOCheck(LO lo); + + +/* LOGSegStruct -- LO segment structure */ + +typedef struct LOSegStruct *LOSeg; + +#define LOSegSig ((Sig)0x519705E9) /* SIGnature LO SEG */ + +typedef struct LOSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + LO lo; /* owning LO */ + BT mark; /* mark bit table */ + BT alloc; /* alloc bit table */ + Count free; /* number of free grains */ + Count newAlloc; /* number of grains allocated since last GC */ + Sig sig; /* impl.h.misc.sig */ +} LOSegStruct; + +#define SegLOSeg(seg) ((LOSeg)(seg)) +#define LOSegSeg(loseg) ((Seg)(loseg)) + + +/* forward decls */ +static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args); +static void loSegFinish(Seg seg); + + +/* LOSegClass -- Class definition for LO segments */ + +DEFINE_SEG_CLASS(LOSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + SegClassMixInNoSplitMerge(class); + class->name = "LOSEG"; + class->size = sizeof(LOSegStruct); + class->init = loSegInit; + class->finish = loSegFinish; +} + + +/* LOSegCheck -- check an LO segment */ + +static Bool LOSegCheck(LOSeg loseg) +{ + CHECKS(LOSeg, loseg); + CHECKL(GCSegCheck(&loseg->gcSegStruct)); + CHECKU(LO, loseg->lo); + CHECKL(loseg->mark != NULL); + CHECKL(loseg->alloc != NULL); + /* Could check exactly how many bits are set in the alloc table. */ + CHECKL(loseg->free + loseg->newAlloc + <= SegSize(LOSegSeg(loseg)) >> loseg->lo->alignShift); + return TRUE; +} + + +/* loSegInit -- Init method for LO segments */ + +static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + LOSeg loseg; + LO lo; + Res res; + Size tablebytes; /* # bytes in each control array */ + Arena arena; + /* number of bits needed in each control array */ + unsigned long bits; + void *p; + + AVERT(Seg, seg); + loseg = SegLOSeg(seg); + AVERT(Pool, pool); + arena = PoolArena(pool); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(LOSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if(res != ResOK) + return res; + + AVER(SegWhite(seg) == TraceSetEMPTY); + + bits = size >> lo->alignShift; + tablebytes = BTSize(bits); + res = ControlAlloc(&p, arena, tablebytes, reservoirPermit); + if(res != ResOK) + goto failMarkTable; + loseg->mark = p; + res = ControlAlloc(&p, arena, tablebytes, reservoirPermit); + if(res != ResOK) + goto failAllocTable; + loseg->alloc = p; + BTResRange(loseg->alloc, 0, bits); + BTSetRange(loseg->mark, 0, bits); + loseg->lo = lo; + loseg->free = bits; + loseg->newAlloc = (Count)0; + loseg->sig = LOSegSig; + AVERT(LOSeg, loseg); + return ResOK; + +failAllocTable: + ControlFree(arena, loseg->mark, tablebytes); +failMarkTable: + super->finish(seg); + return res; +} + + +/* loSegFinish -- Finish method for LO segments */ + +static void loSegFinish(Seg seg) +{ + LO lo; + LOSeg loseg; + SegClass super; + Pool pool; + Arena arena; + Size tablesize; + unsigned long bits; + + AVERT(Seg, seg); + loseg = SegLOSeg(seg); + AVERT(LOSeg, loseg); + pool = SegPool(seg); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + arena = PoolArena(pool); + + bits = SegSize(seg) >> lo->alignShift; + tablesize = BTSize(bits); + ControlFree(arena, (Addr)loseg->alloc, tablesize); + ControlFree(arena, (Addr)loseg->mark, tablesize); + loseg->sig = SigInvalid; + + /* finish the superclass fields last */ + super = SEG_SUPERCLASS(LOSegClass); + super->finish(seg); +} + + +static Count loSegBits(LOSeg loseg) +{ + LO lo; + Size size; + + AVERT(LOSeg, loseg); + + lo = loseg->lo; + AVERT(LO, lo); + size = SegSize(LOSegSeg(loseg)); + return size >> lo->alignShift; +} + + +/* Conversion between indexes and Addrs */ +#define loIndexOfAddr(base, lo, p) \ + (AddrOffset((base), (p)) >> (lo)->alignShift) + +#define loAddrOfIndex(base, lo, i) \ + (AddrAdd((base), (i) << (lo)->alignShift)) + + +/* loSegFree -- mark block from baseIndex to limitIndex free */ + +static void loSegFree(LOSeg loseg, Index baseIndex, Index limitIndex) +{ + AVERT(LOSeg, loseg); + AVER(baseIndex < limitIndex); + AVER(limitIndex <= loSegBits(loseg)); + + AVER(BTIsSetRange(loseg->alloc, baseIndex, limitIndex)); + BTResRange(loseg->alloc, baseIndex, limitIndex); + BTSetRange(loseg->mark, baseIndex, limitIndex); + loseg->free += limitIndex - baseIndex; +} + + +/* Find a free block of size size in the segment. + * Return pointer to base and limit of block (which may be + * bigger than the requested size to accommodate buffering). + */ +static Bool loSegFindFree(Addr *bReturn, Addr *lReturn, + LOSeg loseg, Size size) +{ + Index baseIndex, limitIndex; + LO lo; + Seg seg; + Arena arena; + Count agrains; + unsigned long tablesize; + Addr segBase; + + AVER(bReturn != NULL); + AVER(lReturn != NULL); + AVERT(LOSeg, loseg); + + lo = loseg->lo; + seg = LOSegSeg(loseg); + AVER(SizeIsAligned(size, LOPool(lo)->alignment)); + arena = PoolArena(LOPool(lo)); + + /* agrains is the number of grains corresponding to the size */ + /* of the allocation request */ + agrains = size >> lo->alignShift; + AVER(agrains >= 1); + AVER(agrains <= loseg->free); + AVER(size <= SegSize(seg)); + + if(SegBuffer(seg) != NULL) { + /* Don't bother trying to allocate from a buffered segment */ + return FALSE; + } + + tablesize = SegSize(seg) >> lo->alignShift; + if(!BTFindLongResRange(&baseIndex, &limitIndex, loseg->alloc, + 0, tablesize, agrains)) { + return FALSE; + } + + /* check that BTFindLongResRange really did find enough space */ + AVER(baseIndex < limitIndex); + AVER((limitIndex-baseIndex) << lo->alignShift >= size); + segBase = SegBase(seg); + *bReturn = loAddrOfIndex(segBase, lo, baseIndex); + *lReturn = loAddrOfIndex(segBase, lo, limitIndex); + + return TRUE; +} + + +/* loSegCreate -- Creates a segment of size at least size. + * + * Segments will be ArenaAlign aligned . + */ + +static Res loSegCreate(LOSeg *loSegReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + LO lo; + Seg seg; + Res res; + SegPrefStruct segPrefStruct; + Serial gen; + Arena arena; + Size asize; /* aligned size */ + + AVER(loSegReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + arena = PoolArena(pool); + asize = SizeAlignUp(size, ArenaAlign(arena)); + segPrefStruct = *SegPrefDefault(); + gen = lo->gen; + SegPrefExpress(&segPrefStruct, SegPrefCollected, NULL); + SegPrefExpress(&segPrefStruct, SegPrefGen, &gen); + res = SegAlloc(&seg, EnsureLOSegClass(), &segPrefStruct, + asize, pool, withReservoirPermit); + if (res != ResOK) + return res; + PoolGenUpdateZones(&lo->pgen, seg); + + *loSegReturn = SegLOSeg(seg); + return ResOK; +} + + +/* loSegReclaim -- reclaim white objects in an LO segment + * + * Could consider implementing this using Walk. + */ + +static void loSegReclaim(LOSeg loseg, Trace trace) +{ + Addr p, base, limit; + Bool marked; + Count bytesReclaimed = (Count)0; + Seg seg; + LO lo; + Count preservedInPlaceCount = (Count)0; + Size preservedInPlaceSize = (Size)0; + + AVERT(LOSeg, loseg); + AVERT(Trace, trace); + + seg = LOSegSeg(loseg); + lo = loseg->lo; + base = SegBase(seg); + limit = SegLimit(seg); + marked = FALSE; + + /* i is the index of the current pointer, + * p is the actual address that is being considered. + * j and q act similarly for a pointer which is used to + * point at the end of the current object. + */ + p = base; + while(p < limit) { + Buffer buffer = SegBuffer(seg); + Addr q; + Index i; + + if(buffer != NULL) { + marked = TRUE; + if (p == BufferScanLimit(buffer) + && BufferScanLimit(buffer) != BufferLimit(buffer)) { + /* skip over buffered area */ + p = BufferLimit(buffer); + continue; + } + /* since we skip over the buffered area we are always */ + /* either before the buffer, or after it, never in it */ + AVER(p < BufferGetInit(buffer) || BufferLimit(buffer) <= p); + } + i = loIndexOfAddr(base, lo, p); + if(!BTGet(loseg->alloc, i)) { + /* This grain is free */ + p = AddrAdd(p, LOPool(lo)->alignment); + continue; + } + q = (*LOPool(lo)->format->skip)(p); + if(BTGet(loseg->mark, i)) { + marked = TRUE; + ++preservedInPlaceCount; + preservedInPlaceSize += AddrOffset(p, q); + } else { + Index j = loIndexOfAddr(base, lo, q); + /* This object is not marked, so free it */ + loSegFree(loseg, i, j); + bytesReclaimed += AddrOffset(p, q); + } + p = q; + } + AVER(p == limit); + + AVER(bytesReclaimed <= SegSize(seg)); + trace->reclaimSize += bytesReclaimed; + lo->pgen.totalSize -= bytesReclaimed; + trace->preservedInPlaceCount += preservedInPlaceCount; + trace->preservedInPlaceSize += preservedInPlaceSize; + + SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); + + if(!marked) { + SegFree(seg); + } +} + +/* This walks over _all_ objects in the heap, whether they are */ +/* black or white, they are still validly formatted as this is */ +/* a leaf pool, so there can't be any dangling references */ +static void LOWalk(Pool pool, Seg seg, + FormattedObjectsStepMethod f, + void *p, unsigned long s) +{ + Addr base; + LO lo; + LOSeg loseg; + Index i, limit; + + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures and can't be checked */ + + lo = PoolPoolLO(pool); + AVERT(LO, lo); + loseg = SegLOSeg(seg); + AVERT(LOSeg, loseg); + + base = SegBase(seg); + limit = SegSize(seg) >> lo->alignShift; + i = 0; + + while(i < limit) { + /* object is a slight misnomer because it might point to a */ + /* free grain */ + Addr object = loAddrOfIndex(base, lo, i); + Addr next; + Index j; + + if(SegBuffer(seg) != NULL) { + Buffer buffer = SegBuffer(seg); + if(object == BufferScanLimit(buffer) && + BufferScanLimit(buffer) != BufferLimit(buffer)) { + /* skip over buffered area */ + object = BufferLimit(buffer); + i = loIndexOfAddr(base, lo, object); + continue; + } + /* since we skip over the buffered area we are always */ + /* either before the buffer, or after it, never in it */ + AVER(object < BufferGetInit(buffer) || BufferLimit(buffer) <= object); + } + if(!BTGet(loseg->alloc, i)) { + /* This grain is free */ + ++i; + continue; + } + next = (*pool->format->skip)(object); + j = loIndexOfAddr(base, lo, next); + AVER(i < j); + (*f)(object, pool->format, pool, p, s); + i = j; + } +} + + +/* LOInit -- initialize an LO pool */ + +static Res LOInit(Pool pool, va_list arg) +{ + Format format; + LO lo; + Arena arena; + Res res; + static GenParamStruct loGenParam = { 1024, 0.2 }; + + AVERT(Pool, pool); + + arena = PoolArena(pool); + + format = va_arg(arg, Format); + AVERT(Format, format); + + lo = PoolPoolLO(pool); + + pool->format = format; + lo->poolStruct.alignment = format->alignment; + lo->alignShift = + SizeLog2((unsigned long)PoolAlignment(&lo->poolStruct)); + lo->gen = LOGen; /* may be modified in debugger */ + res = ChainCreate(&lo->chain, arena, 1, &loGenParam); + if (res != ResOK) + return res; + /* .gen: This must be the nursery in the chain, because it's the only */ + /* generation. lo->gen is just a hack for segment placement. */ + res = PoolGenInit(&lo->pgen, lo->chain, 0 /* .gen */, pool); + if (res != ResOK) + goto failGenInit; + + lo->sig = LOSig; + AVERT(LO, lo); + EVENT_PP(PoolInitLO, pool, format); + return ResOK; + +failGenInit: + ChainDestroy(lo->chain); + return res; +} + + +/* LOFinish -- finish an LO pool */ + +static void LOFinish(Pool pool) +{ + LO lo; + Ring node, nextNode; + + AVERT(Pool, pool); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + RING_FOR(node, &pool->segRing, nextNode) { + Seg seg = SegOfPoolRing(node); + LOSeg loseg = SegLOSeg(seg); + + AVERT(LOSeg, loseg); + UNUSED(loseg); /* impl.c.mpm.check.unused */ + SegFree(seg); + } + PoolGenFinish(&lo->pgen); + ChainDestroy(lo->chain); + + lo->sig = SigInvalid; +} + + +static Res LOBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, + Size size, Bool withReservoirPermit) +{ + Res res; + Ring node, nextNode; + LO lo; + LOSeg loseg; + Arena arena; + Addr base, limit; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + lo = PARENT(LOStruct, poolStruct, pool); + AVERT(LO, lo); + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + AVER(BufferRankSet(buffer) == RankSetEMPTY); + AVER(size > 0); + AVER(SizeIsAligned(size, PoolAlignment(pool))); + AVER(BoolCheck(withReservoirPermit)); + + arena = PoolArena(pool); + + /* Try to find a segment with enough space already. */ + RING_FOR(node, &pool->segRing, nextNode) { + Seg seg = SegOfPoolRing(node); + loseg = SegLOSeg(seg); + AVERT(LOSeg, loseg); + if((loseg->free << lo->alignShift) >= size + && loSegFindFree(&base, &limit, loseg, size)) + goto found; + } + + /* No segment had enough space, so make a new one. */ + res = loSegCreate(&loseg, pool, size, withReservoirPermit); + if(res != ResOK) { + goto failCreate; + } + base = SegBase(LOSegSeg(loseg)); + limit = SegLimit(LOSegSeg(loseg)); + +found: + { + Index baseIndex, limitIndex; + Addr segBase; + + segBase = SegBase(LOSegSeg(loseg)); + /* mark the newly buffered region as allocated */ + baseIndex = loIndexOfAddr(segBase, lo, base); + limitIndex = loIndexOfAddr(segBase, lo, limit); + AVER(BTIsResRange(loseg->alloc, baseIndex, limitIndex)); + AVER(BTIsSetRange(loseg->mark, baseIndex, limitIndex)); + BTSetRange(loseg->alloc, baseIndex, limitIndex); + loseg->free -= limitIndex - baseIndex; + loseg->newAlloc += limitIndex - baseIndex; + } + + lo->pgen.totalSize += AddrOffset(base, limit); + lo->pgen.newSize += AddrOffset(base, limit); + + *baseReturn = base; + *limitReturn = limit; + return ResOK; + +failCreate: + return res; +} + + +/* Synchronise the buffer with the alloc Bit Table in the segment. */ + +static void LOBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) +{ + LO lo; + Addr base, segBase; + Seg seg; + LOSeg loseg; + Index baseIndex, initIndex, limitIndex; + Arena arena; + + AVERT(Pool, pool); + lo = PARENT(LOStruct, poolStruct, pool); + AVERT(LO, lo); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + seg = BufferSeg(buffer); + AVERT(Seg, seg); + AVER(init <= limit); + + loseg = SegLOSeg(seg); + AVERT(LOSeg, loseg); + AVER(loseg->lo == lo); + + arena = PoolArena(pool); + base = BufferBase(buffer); + segBase = SegBase(seg); + + AVER(AddrIsAligned(base, PoolAlignment(pool))); + AVER(segBase <= base && base < SegLimit(seg)); + AVER(segBase <= init && init <= SegLimit(seg)); + + /* convert base, init, and limit, to quantum positions */ + baseIndex = loIndexOfAddr(segBase, lo, base); + initIndex = loIndexOfAddr(segBase, lo, init); + limitIndex = loIndexOfAddr(segBase, lo, limit); + + /* Record the unused portion at the end of the buffer */ + /* as being free. */ + AVER(baseIndex == limitIndex + || BTIsSetRange(loseg->alloc, baseIndex, limitIndex)); + if(initIndex != limitIndex) { + loSegFree(loseg, initIndex, limitIndex); + lo->pgen.totalSize -= AddrOffset(init, limit); + /* All of the buffer must be new, since buffered segs are not condemned. */ + AVER(loseg->newAlloc >= limitIndex - baseIndex); + loseg->newAlloc -= limitIndex - initIndex; + lo->pgen.newSize -= AddrOffset(init, limit); + } +} + + +/* LOWhiten -- whiten a segment */ + +static Res LOWhiten(Pool pool, Trace trace, Seg seg) +{ + LO lo; + unsigned long bits; + + AVERT(Pool, pool); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + AVERT(Trace, trace); + AVERT(Seg, seg); + AVER(SegWhite(seg) == TraceSetEMPTY); + + if(SegBuffer(seg) == NULL) { + LOSeg loseg = SegLOSeg(seg); + AVERT(LOSeg, loseg); + + bits = SegSize(seg) >> lo->alignShift; + /* Allocated objects should be whitened, free areas should */ + /* be left "black". */ + BTCopyInvertRange(loseg->alloc, loseg->mark, 0, bits); + /* @@@@ We could subtract all the free grains. */ + trace->condemned += SegSize(seg); + lo->pgen.newSize -= loseg->newAlloc << lo->alignShift; + loseg->newAlloc = (Count)0; + SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace)); + } + + return ResOK; +} + + +static Res LOFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + LO lo; + LOSeg loseg; + Ref ref; + + AVERT_CRITICAL(Pool, pool); + AVERT_CRITICAL(ScanState, ss); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY); + AVER_CRITICAL(refIO != NULL); + ref = *refIO; + lo = PARENT(LOStruct, poolStruct, pool); + AVERT_CRITICAL(LO, lo); + loseg = SegLOSeg(seg); + AVERT_CRITICAL(LOSeg, loseg); + + ss->wasMarked = TRUE; /* design.mps.fix.protocol.was-marked */ + + switch(ss->rank) { + case RankAMBIG: + if(!AddrIsAligned(ref, PoolAlignment(pool))) { + return ResOK; + } + /* fall through */ + + case RankEXACT: + case RankFINAL: + case RankWEAK: { + Size i = AddrOffset(SegBase(seg), (Addr)ref) >> lo->alignShift; + + if(!BTGet(loseg->mark, i)) { + ss->wasMarked = FALSE; /* design.mps.fix.protocol.was-marked */ + if(ss->rank == RankWEAK) { + *refIO = (Addr)0; + } else { + BTSet(loseg->mark, i); + } + } + } break; + + default: + NOTREACHED; + break; + } + + return ResOK; +} + + +static void LOReclaim(Pool pool, Trace trace, Seg seg) +{ + LO lo; + LOSeg loseg; + + AVERT(Pool, pool); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + AVERT(Trace, trace); + AVERT(Seg, seg); + AVER(TraceSetIsMember(SegWhite(seg), trace)); + + loseg = SegLOSeg(seg); + loSegReclaim(loseg, trace); +} + + +/* LOPoolClass -- the class definition */ + +DEFINE_POOL_CLASS(LOPoolClass, this) +{ + INHERIT_CLASS(this, AbstractCollectPoolClass); + PoolClassMixInFormat(this); + this->name = "LO"; + this->size = sizeof(LOStruct); + this->offset = offsetof(LOStruct, poolStruct); + this->attr &= ~(AttrSCAN | AttrINCR_RB); + this->init = LOInit; + this->finish = LOFinish; + this->bufferFill = LOBufferFill; + this->bufferEmpty = LOBufferEmpty; + this->whiten = LOWhiten; + this->grey = PoolNoGrey; + this->blacken = PoolNoBlacken; + this->scan = PoolNoScan; + this->fix = LOFix; + this->fixEmergency = LOFix; + this->reclaim = LOReclaim; + this->walk = LOWalk; +} + + +/* mps_class_lo -- the external interface to get the LO pool class */ + +mps_class_t mps_class_lo(void) +{ + return (mps_class_t)EnsureLOPoolClass(); +} + + +/* LOCheck -- check an LO pool */ + +static Bool LOCheck(LO lo) +{ + CHECKS(LO, lo); + CHECKD(Pool, &lo->poolStruct); + CHECKL(lo->poolStruct.class == EnsureLOPoolClass()); + CHECKL(ShiftCheck(lo->alignShift)); + CHECKL(1uL << lo->alignShift == PoolAlignment(&lo->poolStruct)); + CHECKD(Chain, lo->chain); + CHECKD(PoolGen, &lo->pgen); + return TRUE; +} diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c new file mode 100644 index 00000000000..b3094bb3873 --- /dev/null +++ b/mps/code/poolmfs.c @@ -0,0 +1,303 @@ +/* impl.c.poolmfs: MANUAL FIXED SMALL UNIT POOL + * + * $HopeName: MMsrc!poolmfs.c(trunk.34) $ + * Copyright (C) 1999. Harlequin Limited. All rights reserved. + * + * This is the implementation of the MFS pool class. + * + * DESIGN + * + * .design.misplaced: This design is misplaced, it should be in a + * separate document. + * + * MFS operates in a very simple manner: each region allocated from + * the arena is divided into units. Free units are kept on a linked + * list using a header stored in the unit itself. The linked list is + * not ordered; allocation anddeallocation simply pop and push from + * the head of the list. This is fast, but successive allocations might + * have poor locality if previous successive frees did. + * + * .restriction: This pool cannot allocate from the arena control + * pool (as the control pool is an instance of PoolClassMV and MV uses + * MFS in its implementation), nor can it allocate sub-pools, as that + * causes allocation in the control pool. + * + * Notes + * + * .freelist.fragments: The simple freelist policy might lead to poor + * locality of allocation if the list gets fragmented. + * + * .buffer.not: This pool doesn't support fast cache allocation, which + * is a shame. + */ + + +#include "poolmfs.h" +#include "mpm.h" + +SRCID(poolmfs, "$HopeName: MMsrc!poolmfs.c(trunk.34) $"); + + +/* ROUND -- Round up + * + * Rounds n up to the nearest multiple of unit. + */ + +#define ROUND(unit, n) ((n)+(unit)-1 - ((n)+(unit)-1)%(unit)) + + +#define PoolPoolMFS(pool) PARENT(MFSStruct, poolStruct, pool) + + +/* HeaderStruct -- Freelist structure */ + +typedef struct MFSHeaderStruct { + struct MFSHeaderStruct *next; +} HeaderStruct, *Header; + + + +#define UNIT_MIN sizeof(HeaderStruct) + +MFSInfo MFSGetInfo(void) +{ + static const struct MFSInfoStruct info = + { + /* unitSizeMin */ UNIT_MIN + }; + return &info; +} + + +Pool (MFSPool)(MFS mfs) +{ + AVERT(MFS, mfs); + return &mfs->poolStruct; +} + + +static Res MFSInit(Pool pool, va_list arg) +{ + Size extendBy, unitSize; + MFS mfs; + Arena arena; + + AVER(pool != NULL); + + extendBy = va_arg(arg, Size); + unitSize = va_arg(arg, Size); + + AVER(unitSize >= UNIT_MIN); + AVER(extendBy >= unitSize); + + mfs = PoolPoolMFS(pool); + arena = PoolArena(pool); + + mfs->unroundedUnitSize = unitSize; + + unitSize = SizeAlignUp(unitSize, MPS_PF_ALIGN); + extendBy = SizeAlignUp(extendBy, ArenaAlign(arena)); + + mfs->extendBy = extendBy; + mfs->unitSize = unitSize; + mfs->unitsPerExtent = extendBy/unitSize; + mfs->freeList = NULL; + mfs->tractList = NULL; + mfs->sig = MFSSig; + + AVERT(MFS, mfs); + EVENT_PPP(PoolInit, pool, arena, ClassOfPool(pool)); + return ResOK; +} + + +static void MFSFinish(Pool pool) +{ + Tract tract; + MFS mfs; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + tract = mfs->tractList; + while(tract != NULL) { + Tract nextTract = (Tract)TractP(tract); /* .tract.chain */ + ArenaFree(TractBase(tract), mfs->extendBy, pool); + tract = nextTract; + } + + mfs->sig = SigInvalid; +} + + +/* == Allocate == + * + * Allocation simply involves taking a unit from the front of the freelist + * and returning it. If there are none, a new region is allocated from the + * arena. + */ + +static Res MFSAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + Header f; + Res res; + MFS mfs; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + AVER(pReturn != NULL); + AVER(size == mfs->unroundedUnitSize); + AVER(BoolCheck(withReservoirPermit)); + + f = mfs->freeList; + + /* If the free list is empty then extend the pool with a new region. */ + + if(f == NULL) + { + Tract tract; + Word i, unitsPerExtent; + Size unitSize; + Addr base; + Header header = NULL, next; + + /* Create a new region and attach it to the pool. */ + res = ArenaAlloc(&base, SegPrefDefault(), mfs->extendBy, pool, + withReservoirPermit); + if(res != ResOK) + return res; + + /* .tract.chain: chain first tracts through TractP(tract) */ + tract = TractOfBaseAddr(PoolArena(pool), base); + TractSetP(tract, (void *)mfs->tractList); + mfs->tractList = tract; + + /* Sew together all the new empty units in the region, working down */ + /* from the top so that they are in ascending order of address on the */ + /* free list. */ + + unitsPerExtent = mfs->unitsPerExtent; + unitSize = mfs->unitSize; + next = NULL; + +#define SUB(b, s, i) ((Header)AddrAdd(b, (s)*(i))) + + for(i=0; ialignment)); + AVER(AddrAdd((Addr)header, unitSize) <= AddrAdd(base, mfs->extendBy)); + header->next = next; + next = header; + } + +#undef SUB + + /* The first unit in the region is now the head of the new free list. */ + f = header; + } + + AVER(f != NULL); + + /* Detach the first free unit from the free list and return its address. */ + + mfs->freeList = f->next; + + *pReturn = (Addr)f; + return ResOK; +} + + +/* == Free == + * + * Freeing a unit simply involves pushing it onto the front of the + * freelist. + */ + +static void MFSFree(Pool pool, Addr old, Size size) +{ + Header h; + MFS mfs; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + AVER(old != (Addr)0); + AVER(size == mfs->unroundedUnitSize); + + /* .freelist.fragments */ + h = (Header)old; + h->next = mfs->freeList; + mfs->freeList = h; +} + + +static Res MFSDescribe(Pool pool, mps_lib_FILE *stream) +{ + MFS mfs; + Res res; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + AVER(stream != NULL); + + res = WriteF(stream, + " unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize, + " unit size $W\n", (WriteFW)mfs->unitSize, + " extent size $W\n", (WriteFW)mfs->extendBy, + " units per extent $U\n", (WriteFU)mfs->unitsPerExtent, + " free list begins at $P\n", (WriteFP)mfs->freeList, + " tract list begin at $P\n", (WriteFP)mfs->tractList, + NULL); + if(res != ResOK) return res; + + return ResOK; +} + + +DEFINE_POOL_CLASS(MFSPoolClass, this) +{ + INHERIT_CLASS(this, AbstractAllocFreePoolClass); + this->name = "MFS"; + this->size = sizeof(MFSStruct); + this->offset = offsetof(MFSStruct, poolStruct); + this->init = MFSInit; + this->finish = MFSFinish; + this->alloc = MFSAlloc; + this->free = MFSFree; + this->describe = MFSDescribe; +} + + +PoolClass PoolClassMFS(void) +{ + return EnsureMFSPoolClass(); +} + + +Bool MFSCheck(MFS mfs) +{ + Arena arena; + + CHECKS(MFS, mfs); + CHECKD(Pool, &mfs->poolStruct); + CHECKL(mfs->poolStruct.class == EnsureMFSPoolClass()); + CHECKL(mfs->unroundedUnitSize >= UNIT_MIN); + CHECKL(mfs->extendBy >= UNIT_MIN); + arena = PoolArena(&mfs->poolStruct); + CHECKL(SizeIsAligned(mfs->extendBy, ArenaAlign(arena))); + CHECKL(SizeAlignUp(mfs->unroundedUnitSize, mfs->poolStruct.alignment) == + mfs->unitSize); + CHECKL(mfs->unitsPerExtent == mfs->extendBy/mfs->unitSize); + if(mfs->tractList != NULL) { + CHECKL(TractCheck(mfs->tractList)); + } + return TRUE; +} diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h new file mode 100644 index 00000000000..df83ac5aca3 --- /dev/null +++ b/mps/code/poolmfs.h @@ -0,0 +1,51 @@ +/* impl.h.poolmfs draft impl + * + * MANUAL FIXED SMALL UNIT POOL + * + * $HopeName: MMsrc!poolmfs.h(MMdevel_restr2.2) $ + * + * Copyright (C) 1994,1995 Harlequin Group, all rights reserved + * + * The MFS pool is used to manage small fixed-size chunks of memory. It + * stores control structures in the memory it manages, rather than to one + * side. It therefore achieves better locality for small objects, but + * wastes memory for large objects. It should not be used unless you are + * packing a reasonable number of objects on to a page. + * + * Create and Init take the following arguments: + * + * Size extendBy + * + * extendBy is the default number of bytes reserved by the pool at a time. + * A large size will make allocation cheaper but have a higher resource + * overhead. A typical value might be 65536. See note 2. + * + * Size unitSize + * + * unitSize is the size in bytes of the objects you with to allocate. It + * must be larger than the minimum unit size returned by GetInfo, and not + * larger than extendBy. + */ + +#ifndef poolmfs_h +#define poolmfs_h + +#include "mpm.h" + +typedef struct MFSStruct *MFS; + +extern PoolClass PoolClassMFS(void); + +extern Bool MFSCheck(MFS mfs); +extern Pool (MFSPool)(MFS mfs); + + +typedef const struct MFSInfoStruct *MFSInfo; + +struct MFSInfoStruct { + Size unitSizeMin; /* minimum unit size */ +}; + +extern MFSInfo MFSGetInfo(void); + +#endif /* poolmfs_h */ diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c new file mode 100644 index 00000000000..e352aa5cc06 --- /dev/null +++ b/mps/code/poolmrg.c @@ -0,0 +1,847 @@ +/* impl.c.poolmrg: MANUAL RANK GUARDIAN POOL + * + * $HopeName: MMsrc!poolmrg.c(trunk.41) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: See design.mps.poolmrg. + * + * NOTES + * + * .improve.rank: At the moment, the pool is a guardian for the final + * rank. It could be generalized to be a guardian for an arbitrary + * rank (a guardian for RankEXACT would tell you if the object was + * ambiguously referenced, for example). The code that would need to be + * modified bears this tag. + * + * TRANSGRESSIONS + * + * .addr.void-star: Breaks design.mps.type.addr.use all over the place, + * accessing the segments acquired from SegAlloc with C pointers. It + * would not be practical to use ArenaPeek/Poke everywhere. Blocks + * acquired from ControlAlloc must be directly accessible from C, or else + * none of the pools would work. Therefore, if we implement a variant + * where Addr != void*, we just use the same magic for the control pool + * and MRG pools, whatever that might be. + */ + +#include "mpm.h" +#include "poolmrg.h" + +SRCID(poolmrg, "$HopeName: MMsrc!poolmrg.c(trunk.41) $"); + + +/* Types */ + +/* enumerate the states of a Guardian */ +enum { + MRGGuardianFREE = 1, + MRGGuardianPREFINAL, + MRGGuardianFINAL, + MRGGuardianPOSTFINAL +}; + + +/* Link -- Unprotectable part of guardian */ + +typedef struct LinkStruct *Link; +typedef struct LinkStruct { + int state; /* Free, Prefinal, Final, Postfinal */ + union { + MessageStruct messageStruct; /* state = Final */ + RingStruct linkRing; /* state one of {Free, Prefinal} */ + } the; +} LinkStruct; + +#define linkOfMessage(message) \ + PARENT(LinkStruct, the.messageStruct, (message)) + +#define linkOfRing(ring) \ + PARENT(LinkStruct, the.linkRing, (ring)) + + +/* RefPart -- Protectable part of guardian + * + * This is trivial, but provides a useful abstraction + * at no performance cost. + */ +typedef struct RefPartStruct *RefPart; +typedef struct RefPartStruct { + Ref ref; +} RefPartStruct; + + +/* MRGRefPartRef,MRGRefPartSetRef -- Peek and poke the reference + * + * Might be more efficient to take a seg, rather than calculate it + * every time. + * + * See also .ref.direct which accesses it directly. + */ +static Ref MRGRefPartRef(Arena arena, RefPart refPart) +{ + Ref ref; + + AVER(refPart != NULL); + + ref = ArenaPeek(arena, (Addr)&refPart->ref); + return ref; +} + +static Addr MRGRefPartRefAddr(RefPart refPart) +{ + AVER(refPart != NULL); + + return (Addr)&refPart->ref; +} + +static void MRGRefPartSetRef(Arena arena, RefPart refPart, Ref ref) +{ + AVER(refPart != NULL); + + ArenaPoke(arena, (Addr)&refPart->ref, ref); +} + + +/* MRGStruct -- MRG pool structure */ + +#define MRGSig ((Sig)0x519369B0) /* SIGnature MRG POol */ + +typedef struct MRGStruct { + PoolStruct poolStruct; /* generic pool structure */ + RingStruct entryRing; /* design.mps.poolmrg.poolstruct.entry */ + RingStruct freeRing; /* design.mps.poolmrg.poolstruct.free */ + RingStruct refRing; /* design.mps.poolmrg.poolstruct.refring */ + Size extendBy; /* design.mps.poolmrg.extend */ + Sig sig; /* impl.h.mps.sig */ +} MRGStruct; + +#define Pool2MRG(pool) PARENT(MRGStruct, poolStruct, pool) +#define MRG2Pool(mrg) (&(mrg)->poolStruct) + + +/* MRGCheck -- check an MRG pool */ + +static Bool MRGCheck(MRG mrg) +{ + CHECKS(MRG, mrg); + CHECKD(Pool, &mrg->poolStruct); + CHECKL(MRG2Pool(mrg)->class == PoolClassMRG()); + CHECKL(RingCheck(&mrg->entryRing)); + CHECKL(RingCheck(&mrg->freeRing)); + CHECKL(RingCheck(&mrg->refRing)); + CHECKL(mrg->extendBy == ArenaAlign(PoolArena(MRG2Pool(mrg)))); + return TRUE; +} + + +#define MRGRefSegSig ((Sig)0x51936965) /* SIGnature MRG Ref Seg */ +#define MRGLinkSegSig ((Sig)0x51936915) /* SIGnature MRG Link Seg */ + +typedef struct MRGLinkSegStruct *MRGLinkSeg; +typedef struct MRGRefSegStruct *MRGRefSeg; + +typedef struct MRGLinkSegStruct { + SegStruct segStruct; /* superclass fields must come first */ + MRGRefSeg refSeg; /* design.mps.poolmrg.mrgseg.link.refseg */ + Sig sig; /* impl.h.misc.sig */ +} MRGLinkSegStruct; + +typedef struct MRGRefSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + RingStruct mrgRing; /* design.mps.poolmrg.mrgseg.ref.segring */ + MRGLinkSeg linkSeg; /* design.mps.poolmrg.mrgseg.ref.linkseg */ + Sig sig; /* impl.h.misc.sig */ +} MRGRefSegStruct; + +/* macros to get between child and parent seg structures */ + +#define Seg2LinkSeg(seg) ((MRGLinkSeg)(seg)) +#define LinkSeg2Seg(linkseg) ((Seg)(linkseg)) + +#define Seg2RefSeg(seg) ((MRGRefSeg)(seg)) +#define RefSeg2Seg(refseg) ((Seg)(refseg)) + + +/* forward declarations */ + +static SegClass MRGLinkSegClassGet(void); +static SegClass MRGRefSegClassGet(void); + + +/* MRGLinkSegCheck -- check a link segment + * + * .link.nullref: During initialization of a link segment the refSeg + * field will be NULL. This will be initialized when the reference + * segment is initialized. See design.mps.poolmrg.mrgseg.link.refseg. + */ +static Bool MRGLinkSegCheck(MRGLinkSeg linkseg) +{ + Seg seg; + + CHECKS(MRGLinkSeg, linkseg); + CHECKL(SegCheck(&linkseg->segStruct)); + seg = LinkSeg2Seg(linkseg); + if (NULL != linkseg->refSeg) { /* see .link.nullref */ + CHECKL(SegPool(seg) == SegPool(RefSeg2Seg(linkseg->refSeg))); + CHECKU(MRGRefSeg, linkseg->refSeg); + CHECKL(linkseg->refSeg->linkSeg == linkseg); + } + return TRUE; +} + +static Bool MRGRefSegCheck(MRGRefSeg refseg) +{ + Seg seg; + + CHECKS(MRGRefSeg, refseg); + CHECKL(GCSegCheck(&refseg->gcSegStruct)); + seg = RefSeg2Seg(refseg); + CHECKL(SegPool(seg) == SegPool(LinkSeg2Seg(refseg->linkSeg))); + CHECKL(RingCheck(&refseg->mrgRing)); + CHECKD(MRGLinkSeg, refseg->linkSeg); + CHECKL(refseg->linkSeg->refSeg == refseg); + return TRUE; +} + + +/* MRGLinkSegInit -- initialise a link segment */ + +static Res MRGLinkSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + MRGLinkSeg linkseg; + MRG mrg; + Res res; + + AVERT(Seg, seg); + linkseg = Seg2LinkSeg(seg); + AVERT(Pool, pool); + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(MRGLinkSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + linkseg->refSeg = NULL; /* .link.nullref */ + linkseg->sig = MRGLinkSegSig; + AVERT(MRGLinkSeg, linkseg); + + return ResOK; +} + + +/* MRGRefSegInit -- initialise a ref segment + * + * .ref.initarg: The paired link segment is passed as an additional + * (vararg) parameter when creating the ref segment. Initially the + * refSeg field of the link segment is NULL (see .link.nullref). + * It's initialized here to the newly initialized ref segment. + */ +static Res MRGRefSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + MRGLinkSeg linkseg = va_arg(args, MRGLinkSeg); /* .ref.initarg */ + MRGRefSeg refseg; + MRG mrg; + SegClass super; + Res res; + + AVERT(Seg, seg); + refseg = Seg2RefSeg(seg); + AVERT(Pool, pool); + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + AVERT(MRGLinkSeg, linkseg); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(MRGRefSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + + /* design.mps.seg.field.rankset.start, .improve.rank */ + SegSetRankSet(seg, RankSetSingle(RankFINAL)); + + RingInit(&refseg->mrgRing); + RingAppend(&mrg->refRing, &refseg->mrgRing); + refseg->linkSeg = linkseg; + AVER(NULL == linkseg->refSeg); /* .link.nullref */ + refseg->sig = MRGRefSegSig; + linkseg->refSeg = refseg; /* .ref.initarg */ + + AVERT(MRGRefSeg, refseg); + AVERT(MRGLinkSeg, linkseg); + + return ResOK; +} + + +/* MRGLinkSegClass -- Class definition */ + +DEFINE_SEG_CLASS(MRGLinkSegClass, class) +{ + INHERIT_CLASS(class, SegClass); + SegClassMixInNoSplitMerge(class); /* no support for this */ + class->name = "MRGLSEG"; + class->size = sizeof(MRGLinkSegStruct); + class->init = MRGLinkSegInit; +} + + +/* MRGRefSegClass -- Class definition */ + +DEFINE_SEG_CLASS(MRGRefSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + SegClassMixInNoSplitMerge(class); /* no support for this */ + class->name = "MRGRSEG"; + class->size = sizeof(MRGRefSegStruct); + class->init = MRGRefSegInit; +} + + +static Count MRGGuardiansPerSeg(MRG mrg) +{ + Count nGuardians; + AVERT(MRG, mrg); + + nGuardians = mrg->extendBy / sizeof(Ref); + AVER(nGuardians > 0); + + return(nGuardians); +} + + +/* design.mps.poolmrg.guardian.assoc */ + +#define refPartOfIndex(refseg, index) \ + ((RefPart)SegBase(RefSeg2Seg(refseg)) + (index)) + +static RefPart MRGRefPartOfLink(Link link, Arena arena) +{ + Seg seg; + Bool b; + Link linkBase; + Index index; + MRGLinkSeg linkseg; + + AVER(link != NULL); /* Better checks done by SegOfAddr */ + + b = SegOfAddr(&seg, arena, (Addr)link); + AVER(b); + AVER(SegPool(seg)->class == PoolClassMRG()); + linkseg = Seg2LinkSeg(seg); + AVERT(MRGLinkSeg, linkseg); + linkBase = (Link)SegBase(seg); + AVER(link >= linkBase); + index = link - linkBase; + AVER(index < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg)))); + + return refPartOfIndex(linkseg->refSeg, index); +} + +#define linkOfIndex(linkseg, index) \ + ((Link)SegBase(LinkSeg2Seg(linkseg)) + (index)) + +static Link MRGLinkOfRefPart(RefPart refPart, Arena arena) +{ + Seg seg; + Bool b; + RefPart refPartBase; + Index index; + MRGRefSeg refseg; + + AVER(refPart != NULL); /* Better checks done by SegOfAddr */ + + b = SegOfAddr(&seg, arena, (Addr)refPart); + AVER(b); + AVER(SegPool(seg)->class == PoolClassMRG()); + refseg = Seg2RefSeg(seg); + AVERT(MRGRefSeg, refseg); + refPartBase = (RefPart)SegBase(seg); + AVER(refPart >= refPartBase); + index = refPart - refPartBase; + AVER(index < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg)))); + + return linkOfIndex(refseg->linkSeg, index); +} + + +/* MRGGuardianInit -- Initialises both parts of a guardian */ + +static void MRGGuardianInit(MRG mrg, Link link, RefPart refPart) +{ + AVERT(MRG, mrg); + AVER(link != NULL); + AVER(refPart != NULL); + + RingInit(&link->the.linkRing); + link->state = MRGGuardianFREE; + RingAppend(&mrg->freeRing, &link->the.linkRing); + /* design.mps.poolmrg.free.overwrite */ + MRGRefPartSetRef(PoolArena(&mrg->poolStruct), refPart, 0); +} + + +/* MRGMessage* -- Implementation of MRG's MessageClass */ + + +/* MRGMessageDelete -- deletes the message (frees up the memory) */ + +static void MRGMessageDelete(Message message) +{ + RefPart refPart; + Pool pool; + Arena arena; + Link link; + + AVERT(Message, message); + + arena = MessageArena(message); + + { /* Calculate pool */ + Bool b; + Seg seg; + b = SegOfAddr(&seg, arena, (Addr)message); + AVER(b); + + pool = SegPool(seg); + } + AVER(pool->class == PoolClassMRG()); + + link = linkOfMessage(message); + MessageFinish(message); + AVER(link->state == MRGGuardianFINAL); + link->state = MRGGuardianPOSTFINAL; + refPart = MRGRefPartOfLink(link, arena); + PoolFree(pool, (Addr)refPart, sizeof(RefPartStruct)); +} + + +/* MRGMessageFinalizationRef -- extract the finalized reference from the msg */ + +static void MRGMessageFinalizationRef(Ref *refReturn, + Arena arena, Message message) +{ + Addr refAddr; + Link link; + Ref ref; + RefPart refPart; + + AVER(refReturn != NULL); + AVERT(Arena, arena); + AVERT(Message, message); + + AVER(message->type == MessageTypeFINALIZATION); + + link = linkOfMessage(message); + AVER(link->state == MRGGuardianFINAL); + refPart = MRGRefPartOfLink(link, arena); + + refAddr = MRGRefPartRefAddr(refPart); + + /* ensure that the reference is not (white and flipped) */ + ref = (Ref)ArenaRead(arena, refAddr); + + AVER(ref != 0); + *refReturn = ref; +} + + +static MessageClassStruct MRGMessageClassStruct = { + MessageClassSig, /* sig */ + "MRGFinal", /* name */ + MRGMessageDelete, /* Delete */ + MRGMessageFinalizationRef, /* FinalizationRef */ + MessageNoGCLiveSize, /* GCLiveSize */ + MessageNoGCCondemnedSize, /* GCCondemnedSize */ + MessageNoGCNotCondemnedSize, /* GCNoteCondemnedSize */ + MessageClassSig /* design.mps.message.class.sig.double */ +}; + + +/* MRGSegPairDestroy --- Destroys a pair of segments (link & ref) + * + * .segpair.destroy: We don't worry about the effect that destroying + * these segs has on any of the pool rings. + */ +static void MRGSegPairDestroy(MRGRefSeg refseg, MRG mrg) +{ + Pool pool; + + pool = MRG2Pool(mrg); + RingRemove(&refseg->mrgRing); + RingFinish(&refseg->mrgRing); + refseg->sig = SigInvalid; + SegFree(LinkSeg2Seg(refseg->linkSeg)); + SegFree(RefSeg2Seg(refseg)); +} + + +/* MRGSegPairCreate -- create a pair of segments (link & ref) */ + +static Res MRGSegPairCreate(MRGRefSeg *refSegReturn, MRG mrg, + Bool withReservoirPermit) +{ + RefPart refPartBase; + Count nGuardians; /* guardians per seg */ + Index i; + Link linkBase; + Pool pool; + Res res; + Seg segLink, segRefPart; + MRGLinkSeg linkseg; + MRGRefSeg refseg; + Size linkSegSize; + Arena arena; + + AVER(refSegReturn != NULL); + + pool = MRG2Pool(mrg); + arena = PoolArena(pool); + + nGuardians = MRGGuardiansPerSeg(mrg); + linkSegSize = nGuardians * sizeof(LinkStruct); + linkSegSize = SizeAlignUp(linkSegSize, ArenaAlign(arena)); + + res = SegAlloc(&segLink, EnsureMRGLinkSegClass(), + SegPrefDefault(), linkSegSize, pool, + withReservoirPermit); + if (res != ResOK) + goto failLinkSegAlloc; + linkseg = Seg2LinkSeg(segLink); + + res = SegAlloc(&segRefPart, EnsureMRGRefSegClass(), + SegPrefDefault(), mrg->extendBy, pool, + withReservoirPermit, + linkseg); /* .ref.initarg */ + if (res != ResOK) + goto failRefPartSegAlloc; + refseg = Seg2RefSeg(segRefPart); + + linkBase = (Link)SegBase(segLink); + refPartBase = (RefPart)SegBase(segRefPart); + + for(i = 0; i < nGuardians; ++i) + MRGGuardianInit(mrg, linkBase + i, refPartBase + i); + AVER((Addr)(&linkBase[i]) <= SegLimit(segLink)); + AVER((Addr)(&refPartBase[i]) <= SegLimit(segRefPart)); + + *refSegReturn = refseg; + + return ResOK; + +failRefPartSegAlloc: + SegFree(segLink); +failLinkSegAlloc: + return res; +} + + +/* MRGFinalise -- finalize the indexth guardian in the segment */ + +static void MRGFinalize(Arena arena, MRGLinkSeg linkseg, Index index) +{ + Link link; + Message message; + + AVER(index < MRGGuardiansPerSeg(Pool2MRG(SegPool(LinkSeg2Seg(linkseg))))); + + link = linkOfIndex(linkseg, index); + + /* only finalize it if it hasn't been finalized already */ + if (link->state != MRGGuardianFINAL) { + AVER(link->state == MRGGuardianPREFINAL); + RingRemove(&link->the.linkRing); + RingFinish(&link->the.linkRing); + link->state = MRGGuardianFINAL; + message = &link->the.messageStruct; + MessageInit(arena, message, &MRGMessageClassStruct, MessageTypeFINALIZATION); + MessagePost(arena, message); + } +} + + +static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg) +{ + Res res; + Arena arena; + MRGLinkSeg linkseg; + + RefPart refPart; + Index i; + Count nGuardians; + + AVERT(ScanState, ss); + AVERT(MRGRefSeg, refseg); + AVERT(MRG, mrg); + + arena = PoolArena(MRG2Pool(mrg)); + linkseg = refseg->linkSeg; + + nGuardians = MRGGuardiansPerSeg(mrg); + AVER(nGuardians > 0); + TRACE_SCAN_BEGIN(ss) { + for(i=0; i < nGuardians; ++i) { + refPart = refPartOfIndex(refseg, i); + + /* free guardians are not scanned */ + if (linkOfIndex(linkseg, i)->state != MRGGuardianFREE) { + ss->wasMarked = TRUE; + /* .ref.direct: We can access the reference directly */ + /* because we are in a scan and the shield is exposed. */ + if (TRACE_FIX1(ss, refPart->ref)) { + res = TRACE_FIX2(ss, &(refPart->ref)); + if (res != ResOK) + return res; + + if (ss->rank == RankFINAL && !ss->wasMarked) { /* .improve.rank */ + MRGFinalize(arena, linkseg, i); + } + } + } + } + } TRACE_SCAN_END(ss); + + return ResOK; +} + + +/* MRGInit -- init method for MRG */ + +static Res MRGInit(Pool pool, va_list args) +{ + MRG mrg; + + AVER(pool != NULL); /* Can't check more; see pool contract @@@@ */ + UNUSED(args); + + mrg = Pool2MRG(pool); + + RingInit(&mrg->entryRing); + RingInit(&mrg->freeRing); + RingInit(&mrg->refRing); + mrg->extendBy = ArenaAlign(PoolArena(pool)); + mrg->sig = MRGSig; + + AVERT(MRG, mrg); + EVENT_PPP(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); + return ResOK; +} + + +/* MRGFinish -- finish a MRG pool */ + +static void MRGFinish(Pool pool) +{ + MRG mrg; + Ring node, nextNode; + + AVERT(Pool, pool); + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + + /* .finish.ring: Before destroying the segments, we isolate the */ + /* rings in the pool structure. The problem we are avoiding here */ + /* is when the rings point to memory that has been unmapped by one */ + /* segPairDestroy and a subsequent segPairDestroy calls MRGCheck which */ + /* checks the rings which causes the program to fault because */ + /* RingCheck will access unmapped memory. */ + + /* We call RingRemove on the master node for the rings, thereby */ + /* effectively emptying them, but leaving the rest of the ring */ + /* "dangling". This is okay as we are about to destroy all the */ + /* segments so the contents of the rings will dissappear soon. */ + + /* .finish.no-final: Note that this relies on the fact that no */ + /* Guardians are in the FINAL state and hence on the Arena Message */ + /* Queue. We are guaranteed this because MRGFinish is only called */ + /* from ArenaDestroy, and the message queue has been emptied prior */ + /* to the call. See impl.c.arena.message.queue.empty */ + + if (!RingIsSingle(&mrg->entryRing)) { + RingRemove(&mrg->entryRing); + } + if (!RingIsSingle(&mrg->freeRing)) { + RingRemove(&mrg->freeRing); + } + + RING_FOR(node, &mrg->refRing, nextNode) { + MRGRefSeg refseg = RING_ELT(MRGRefSeg, mrgRing, node); + MRGSegPairDestroy(refseg, mrg); + } + + mrg->sig = SigInvalid; + RingFinish(&mrg->refRing); + /* design.mps.poolmrg.trans.no-finish */ +} + + +Res MRGRegister(Pool pool, Ref ref) +{ + Ring freeNode; + Arena arena; + Link link; + RefPart refPart; + MRG mrg; + Res res; + MRGRefSeg junk; /* unused */ + + AVERT(Pool, pool); + AVER(ref != 0); + + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + + arena = PoolArena(pool); + AVERT(Arena, arena); + + /* design.mps.poolmrg.alloc.grow */ + if (RingIsSingle(&mrg->freeRing)) { + /* .refseg.useless: refseg isn't used */ + /* @@@@ Should the client be able to use the reservoir for this? */ + res = MRGSegPairCreate(&junk, mrg, /* withReservoirPermit */ FALSE); + if (res != ResOK) + return res; + } + AVER(!RingIsSingle(&mrg->freeRing)); + freeNode = RingNext(&mrg->freeRing); + + link = linkOfRing(freeNode); + AVER(link->state == MRGGuardianFREE); + /* design.mps.poolmrg.alloc.pop */ + RingRemove(freeNode); + link->state = MRGGuardianPREFINAL; + RingAppend(&mrg->entryRing, freeNode); + + /* design.mps.poolmrg.guardian.ref.alloc */ + refPart = MRGRefPartOfLink(link, arena); + MRGRefPartSetRef(arena, refPart, ref); + + return ResOK; +} + + +/* MRGFree -- free a guardian */ + +static void MRGFree(Pool pool, Addr old, Size size) +{ + MRG mrg; + Arena arena; + Link link; + RefPart refPart; + + AVERT(Pool, pool); + AVER(old != (Addr)0); + AVER(size == sizeof(RefPartStruct)); + + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + + refPart = (RefPart)old; + + arena = PoolArena(pool); + AVERT(Arena, arena); + + /* design.mps.poolmrg.guardian.ref.free */ + link = MRGLinkOfRefPart(refPart, arena); + AVER(link->state == MRGGuardianPOSTFINAL); + + MRGGuardianInit(mrg, link, refPart); +} + + +/* MRGDescribe -- describe an MRG pool + * + * This could be improved by implementing MRGSegDescribe + * and having MRGDescribe iterate over all the pool's segments. + */ +static Res MRGDescribe(Pool pool, mps_lib_FILE *stream) +{ + MRG mrg; + Arena arena; + Ring node, nextNode; + RefPart refPart; + Res res; + + if (!CHECKT(Pool, pool)) return ResFAIL; + mrg = Pool2MRG(pool); + if (!CHECKT(MRG, mrg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + arena = PoolArena(pool); + res = WriteF(stream, " extendBy $W\n", mrg->extendBy, NULL); + if (res != ResOK) return res; + res = WriteF(stream, " Entry queue:\n", NULL); + if (res != ResOK) return res; + RING_FOR(node, &mrg->entryRing, nextNode) { + refPart = MRGRefPartOfLink(linkOfRing(node), arena); + res = WriteF(stream, " at $A Ref $A\n", + (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart), + NULL); + if (res != ResOK) return res; + } + + return ResOK; +} + + +static Res MRGScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + MRG mrg; + Res res; + MRGRefSeg refseg; + + AVERT(ScanState, ss); + AVERT(Pool, pool); + AVERT(Seg, seg); + + mrg = Pool2MRG(pool); + AVERT(MRG, mrg); + + AVER(SegRankSet(seg) == RankSetSingle(RankFINAL)); /* .improve.rank */ + AVER(TraceSetInter(SegGrey(seg), ss->traces) != TraceSetEMPTY); + refseg = Seg2RefSeg(seg); + AVERT(MRGRefSeg, refseg); + + res = MRGRefSegScan(ss, refseg, mrg); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + + *totalReturn = TRUE; + return ResOK; +} + + +DEFINE_POOL_CLASS(MRGPoolClass, this) +{ + INHERIT_CLASS(this, AbstractPoolClass); + this->name = "MRG"; + this->size = sizeof(MRGStruct); + this->offset = offsetof(MRGStruct, poolStruct); + this->attr |= (AttrSCAN | AttrFREE | AttrINCR_RB); + this->init = MRGInit; + this->finish = MRGFinish; + this->free = MRGFree; + this->grey = PoolTrivGrey; + this->blacken = PoolTrivBlacken; + this->scan = MRGScan; + this->describe = MRGDescribe; +} + + +PoolClass PoolClassMRG(void) +{ + return MRGPoolClassGet(); +} diff --git a/mps/code/poolmrg.h b/mps/code/poolmrg.h new file mode 100644 index 00000000000..00125c66bfb --- /dev/null +++ b/mps/code/poolmrg.h @@ -0,0 +1,19 @@ +/* impl.h.amc draft impl + * + * MANUAL RANK GUARDIAN POOL CLASS + * + * $HopeName: MMsrc!poolmrg.h(trunk.1) $ + * Copyright (C) 1995,1997 Harlequin Group, all rights reserved + */ + +#ifndef poolmrg_h +#define poolmrg_h + +#include "mpm.h" + +typedef struct MRGStruct *MRG; + +extern PoolClass PoolClassMRG(void); +extern Res MRGRegister(Pool, Ref); + +#endif /* poolmrg_h */ diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c new file mode 100644 index 00000000000..f8676339e45 --- /dev/null +++ b/mps/code/poolmv.c @@ -0,0 +1,866 @@ +/* impl.c.poolmv: MANUAL VARIABLE POOL + * + * $HopeName: MMsrc!poolmv.c(trunk.40) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * **** RESTRICTION: This pool may not allocate from the arena control + * pool, since it is used to implement that pool. + * + * An observation: Freeing memory introduces more information + * into the system than allocating it. This causes the problem + * described in note 2. + * + * Notes + * 1. Need to measure typical fragmentation levels and adjust the + * blockExtendBy parameter appropriately. richard 1994-11-08 + * 2. free can lose memory if it can't allocate a block descriptor. The + * memory could be pushed onto a special chain to be reclaimed later. + * richard 1994-11-09 + * 3. The span chain could be adaptive. richard 1994-11-09 + * 5. An MFS pool for the block descriptors is justified, but not really + * for the spans, which are much rarer. richard 1994-11-09 + * 8. By changing MVSpanAlloc it might be possible to keep track of all + * allocated blocks using descriptors, for debugging purposes. richard + * 1994-11-10 + */ + +#include "mpscmv.h" +#include "dbgpool.h" +#include "poolmv.h" +#include "poolmfs.h" +#include "mpm.h" + +SRCID(poolmv, "$HopeName: MMsrc!poolmv.c(trunk.40) $"); + + +#define mvBlockPool(mv) MFSPool(&(mv)->blockPoolStruct) +#define mvSpanPool(mv) MFSPool(&(mv)->spanPoolStruct) + + +#define PoolPoolMV(pool) PARENT(MVStruct, poolStruct, pool) + + +Pool (MVPool)(MV mv) +{ + AVERT(MV, mv); + return &mv->poolStruct; +} + + +/* MVDebug -- MV Debug pool class */ + +typedef struct MVDebugStruct { + MVStruct MVStruct; /* MV structure */ + PoolDebugMixinStruct debug; /* debug mixin */ +} MVDebugStruct; + +typedef MVDebugStruct *MVDebug; + + +#define MVPoolMVDebug(mv) PARENT(MVDebugStruct, MVStruct, mv) +#define MVDebugPoolMV(mvd) (&((mvd)->MVStruct)) + + +/* MVBlockStruct -- block structure + * + * The pool maintains a descriptor structure for each contiguous + * allocated block of memory it manages. The descriptor is on a simple + * linked-list of such descriptors, which is in ascending order of + * address. + */ + +typedef struct MVBlockStruct *MVBlock; +typedef struct MVBlockStruct { + MVBlock next; + Addr base, limit; +} MVBlockStruct; + + +/* MVBlockCheck -- check the consistency of a block structure */ + +static Bool MVBlockCheck(MVBlock block) +{ + AVER(block != NULL); + AVER(block->limit >= block->base); + /* Check that it is in the block pool. See note 7. */ + /* This turns out to be considerably tricky, as we cannot get hold */ + /* of the blockPool (pool is not a parameter). */ + return TRUE; +} + + +/* MVSpanStruct -- span structure + * + * The pool maintains a wrapper for each span allocated from the arena + * which contains a chain of descriptors for the allocated memory in that + * span. It also contains sentinel block descriptors which mark the + * start and end of the span. These blocks considerably simplify + * allocation, and may be zero-sized. + * + * .design.largest: If 'largestKnown' is TRUE, 'largest' is the size + * of the largest free block in the span. Otherwise, 'largest' is + * one more than the span size. + * + * .design.largest.alloc: When seeking a span in which to allocate, + * a span should not be examined if 'largest' is less than the + * space sought. + * + * .design.largest.free: When freeing, compute the size of the new + * free area. If it is larger than 'largest', set 'largest' to it. + */ + +#define MVSpanSig ((Sig)0x5193F5BA) /* SIGnature MV SPAn */ + +typedef struct MVSpanStruct *MVSpan; +typedef struct MVSpanStruct { + Sig sig; /* design.mps.sig */ + RingStruct spans; /* all the spans */ + MV mv; /* owning MV pool */ + Tract tract; /* first tract of the span */ + Size size; /* size of the span */ + MVBlockStruct base; /* sentinel at base of span */ + MVBlockStruct limit; /* sentinel at limit of span */ + MVBlock blocks; /* allocated blocks */ + Size space; /* total free space in span */ + Size largest; /* .design.largest */ + Bool largestKnown; /* .design.largest */ + unsigned blockCount; /* number of blocks on chain */ +} MVSpanStruct; + + +#define SpanSize(span) \ + AddrOffset((span)->base.base, (span)->limit.limit) +#define SpanInsideSentinels(span) \ + AddrOffset((span)->base.limit, (span)->limit.base) + + +/* MVSpanCheck -- check the consistency of a span structure */ + +static Bool MVSpanCheck(MVSpan span) +{ + Addr addr, base, limit; + Arena arena; + Tract tract; + + CHECKS(MVSpan, span); + + CHECKL(RingCheck(&span->spans)); + CHECKU(MV, span->mv); + CHECKD_NOSIG(Tract, span->tract); + CHECKL(MVBlockCheck(&span->base)); + CHECKL(MVBlockCheck(&span->limit)); + /* The block chain starts with the base sentinel. */ + CHECKL(span->blocks == &span->base); + /* Since there is a limit sentinel, the chain can't end just after the */ + /* base sentinel... */ + CHECKL(span->base.next != NULL); + /* ... and it's sure to have at least two blocks on it. */ + CHECKL(span->blockCount >= 2); + /* This is just defined this way. It shouldn't change. */ + CHECKL(span->limit.next == NULL); + /* The sentinels should mark the ends of the span. */ + base = TractBase(span->tract); + limit = AddrAdd(base, span->size); + CHECKL(span->base.base == base); + CHECKL(span->limit.limit == limit); + /* The sentinels mustn't overlap. */ + CHECKL(span->base.limit <= span->limit.base); + /* The free space can't be more than the gap between the sentinels. */ + CHECKL(span->space <= SpanInsideSentinels(span)); + + CHECKL(BoolCheck(span->largestKnown)); + if (span->largestKnown) { /* .design.largest */ + CHECKL(span->largest <= span->space); + /* at least this much is free */ + } else { + CHECKL(span->largest == SpanSize(span)+1); + } + + /* Each tract of the span must refer to the span */ + arena = PoolArena(TractPool(span->tract)); + TRACT_FOR(tract, addr, arena, base, limit) { + CHECKD_NOSIG(Tract, tract); + CHECKL(TractP(tract) == (void *)span); + } + CHECKL(addr == limit); + + return TRUE; +} + + +/* MVInit -- init method for class MV */ + +static Res MVInit(Pool pool, va_list arg) +{ + Size extendBy, avgSize, maxSize, blockExtendBy, spanExtendBy; + MV mv; + Arena arena; + Res res; + + extendBy = va_arg(arg, Size); + avgSize = va_arg(arg, Size); + maxSize = va_arg(arg, Size); + + AVER(extendBy > 0); + AVER(avgSize > 0); + AVER(avgSize <= extendBy); + AVER(maxSize > 0); + AVER(extendBy <= maxSize); + + mv = PoolPoolMV(pool); + arena = PoolArena(pool); + + /* At 100% fragmentation we will need one block descriptor for every other */ + /* allocated block, or (extendBy/avgSize)/2 descriptors. See note 1. */ + blockExtendBy = sizeof(MVBlockStruct) * (extendBy/avgSize)/2; + if(blockExtendBy < sizeof(MVBlockStruct)) { + blockExtendBy = sizeof(MVBlockStruct); + } + + res = PoolInit(&mv->blockPoolStruct.poolStruct, + arena, PoolClassMFS(), + blockExtendBy, sizeof(MVBlockStruct)); + if(res != ResOK) + return res; + + spanExtendBy = sizeof(MVSpanStruct) * (maxSize/extendBy); + + res = PoolInit(&mv->spanPoolStruct.poolStruct, + arena, PoolClassMFS(), + spanExtendBy, sizeof(MVSpanStruct)); + if(res != ResOK) + return res; + + mv->extendBy = extendBy; + mv->avgSize = avgSize; + mv->maxSize = maxSize; + RingInit(&mv->spans); + + mv->space = 0; + mv->lost = 0; + + mv->sig = MVSig; + AVERT(MV, mv); + EVENT_PPWWW(PoolInitMV, pool, arena, extendBy, avgSize, maxSize); + return ResOK; +} + + +/* MVFinish -- finish method for class MV */ + +static void MVFinish(Pool pool) +{ + MV mv; + Ring spans, node = NULL, nextNode; /* gcc whinge stop */ + MVSpan span; + + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + + /* Destroy all the spans attached to the pool. */ + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + ArenaFree(TractBase(span->tract), span->size, pool); + } + + mv->sig = SigInvalid; + + PoolFinish(&mv->blockPoolStruct.poolStruct); + PoolFinish(&mv->spanPoolStruct.poolStruct); +} + + +/* MVSpanAlloc -- allocate space from a span of memory + * + * MVSpanAlloc searches a span for a free block of the requested size. If it + * finds one it allocates it from the span, updates *addrReturn to point + * to it, and returns TRUE. + */ + +static Bool MVSpanAlloc(Addr *addrReturn, MVSpan span, Size size, + Pool blockPool) +{ + Size gap; + Size largest = 0; + MVBlock block; + + AVERT(MVSpan, span); + AVER(size > 0); + AVER(addrReturn != NULL); + + block = span->blocks; + AVER(block == &span->base); /* should be the base sentinel */ + + /* We're guaranteed at least one gap between sentinels, and therefore at */ + /* least one iteration of this loop. So, the test is at the end. */ + do { + AVER(block->next != NULL); + + gap = AddrOffset(block->limit, block->next->base); + + if (gap > largest) { + largest = gap; + AVER(largest <= span->largest); + } + + if(gap >= size) { + Addr new = block->limit; + + /* If the gap is exactly the right size then the preceeding and */ + /* following blocks can be merged, into the preceeding one, */ + /* unless the following block is the end sentinel. */ + if(gap == size && block->next != &span->limit) { + MVBlock old = block->next; + block->limit = old->limit; + block->next = old->next; + PoolFree(blockPool, (Addr)old, sizeof(MVBlockStruct)); + --span->blockCount; + } else + block->limit = AddrAdd(block->limit, size); + + if (gap == span->largest) { /* we've used a 'largest' gap */ + AVER(span->largestKnown); + span->largestKnown = FALSE; + span->largest = SpanSize(span) + 1; /* .design.largest */ + } + + span->space -= size; + *addrReturn = new; + return TRUE; + } + + block = block->next; + } + while(block->next != NULL); + + /* we've looked at all the gaps, so now we know the largest */ + AVER(span->largestKnown == FALSE); + span->largestKnown = TRUE; + span->largest = largest; + + return FALSE; +} + + +/* MVSpanFree -- free an area in a span of memory + * + * Searches a span for a block which contains the area specified by the + * base and limit, and frees it within that span. This may involve + * allocating a block descriptor, which may fail, in which case an error is + * returned. + * + * There are eight cases, depending on what we are freeing: + * 1. whole of non-sentinel + * 2. in body of any block + * 3. at base of non-base + * 4. at limit of non-limit + * 5. whole of base sentinel + * 6. whole of limit sentinel + * 7. at base of base sentinel + * 8. at limit of limit sentinel + */ + +static Res MVSpanFree(MVSpan span, Addr base, Addr limit, Pool blockPool) +{ + MVBlock prev, block; + Size freeAreaSize = 0; /* .design.largest.free */ + + AVERT(MVSpan, span); + AVER(span->base.base <= base && limit <= span->limit.limit); + AVERT(Pool, blockPool); + + prev = NULL; + block = span->blocks; + + AVER(block == &span->base); /* should be base sentinel */ + do { + AVERT(MVBlock, block); + + /* Is the freed area within the block? */ + if(block->base <= base && limit <= block->limit) { + Bool isBase = block == &span->base; + Bool isLimit = block == &span->limit; + Bool isSentinel = isBase || isLimit; + + if(!isSentinel && block->base == base && limit == block->limit) { + /* case 1 : the whole of a non-sentinel block */ + AVER(block->next != NULL); /* there must at least be a sentinel */ + AVER(prev != NULL); /* block isn't sentinel */ + freeAreaSize = AddrOffset(prev->limit, block->next->base); + prev->next = block->next; + PoolFree(blockPool, (Addr)block, sizeof(MVBlockStruct)); + --span->blockCount; + } else if(!isBase && block->base == base) { + /* cases 3 and 6: at base of a block other than the base sentinel */ + AVER(prev != NULL); /* block isn't sentinel */ + freeAreaSize = AddrOffset(prev->limit, limit); + block->base = limit; + } else if(!isLimit && limit == block->limit) { + /* cases 4 and 5: at limit of a block other than the limit sentinel */ + AVER(block->next != NULL); /* should at least be a sentinel */ + freeAreaSize = AddrOffset(base, block->next->base); + block->limit = base; + } else { + /* cases 2, 7, and 8: making a new fragment */ + Res res; + MVBlock new; + + /* The freed area is buried in the middle of the block, so the */ + /* block must be split into two parts. */ + res = PoolAlloc((Addr *)&new, blockPool, sizeof(MVBlockStruct), + /* withReservoirPermit */ FALSE); + if(res != ResOK) return res; + + freeAreaSize = AddrOffset(base, limit); + + /* If the freed area is in the base sentinel then insert the new */ + /* descriptor after it, otherwise insert before. */ + if(isBase) { /* case 7: new fragment at the base of the span */ + new->base = limit; + new->limit = block->limit; + block->limit = base; + new->next = block->next; + AVER(new->next != NULL); /* should at least be a sentinel */ + block->next = new; + } else { /* cases 2 and 8 */ + new->base = block->base; + new->limit = base; + block->base = limit; + new->next = block; + AVER(prev != NULL); + prev->next = new; + } + + AVERT(MVBlock, new); + ++span->blockCount; + } + + AVERT(MVBlock, block); + + span->space += AddrOffset(base, limit); + + if (freeAreaSize > span->largest) { /* .design.largest */ + AVER(span->largestKnown); + span->largest = freeAreaSize; + } + + return ResOK; + } + + prev = block; + block = block->next; + } while(block != NULL); + + /* The freed area is in the span, but not within a block. */ + NOTREACHED; + + return ResOK; +} + + +/* MVAlloc -- allocate method for class MV */ + +static Res MVAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + Res res; + MVSpan span; + Arena arena; + Addr base, limit, addr; + Tract tract; + MV mv; + Size regionSize; + Ring spans, node = NULL, nextNode; /* gcc whinge stop */ + + AVER(pReturn != NULL); + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + AVER(size > 0); + AVERT(Bool, withReservoirPermit); + + size = SizeAlignUp(size, pool->alignment); + + if(size <= mv->space) { + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + span = RING_ELT(MVSpan, spans, node); + if((size <= span->largest) && /* .design.largest.alloc */ + (size <= span->space)) { + Addr new; + + if(MVSpanAlloc(&new, span, size, mvBlockPool(mv))) { + mv->space -= size; + AVER(AddrIsAligned(new, pool->alignment)); + *pReturn = new; + return ResOK; + } + } + } + } + + /* There is no block large enough in any of the spans, so extend the */ + /* pool with a new region which will hold the requested allocation. */ + /* Allocate a new span descriptor and initialize it to point at the */ + /* region. */ + res = PoolAlloc((Addr *)&span, mvSpanPool(mv), sizeof(MVSpanStruct), + withReservoirPermit); + if(res != ResOK) + return res; + + if(size <= mv->extendBy) + regionSize = mv->extendBy; + else + regionSize = size; + + arena = PoolArena(pool); + regionSize = SizeAlignUp(regionSize, ArenaAlign(arena)); + + res = ArenaAlloc(&base, SegPrefDefault(), regionSize, pool, + withReservoirPermit); + if(res != ResOK) { /* try again with a region big enough for this object */ + regionSize = SizeAlignUp(size, ArenaAlign(arena)); + res = ArenaAlloc(&base, SegPrefDefault(), regionSize, pool, + withReservoirPermit); + if (res != ResOK) { + PoolFree(mvSpanPool(mv), (Addr)span, sizeof(MVSpanStruct)); + return res; + } + } + + limit = AddrAdd(base, regionSize); + span->size = regionSize; + span->tract = TractOfBaseAddr(arena, base); + span->mv = mv; + /* Set the p field for each tract of the span */ + TRACT_FOR(tract, addr, arena, base, limit) { + AVER(TractCheck(tract)); + AVER(TractP(tract) == NULL); + AVER(TractPool(tract) == pool); + TractSetP(tract, (void *)span); + } + AVER(addr == limit); + RingInit(&span->spans); + span->base.base = span->base.limit = base; + span->limit.base = span->limit.limit = limit; + span->space = AddrOffset(span->base.limit, span->limit.base); + span->limit.next = NULL; + span->base.next = &span->limit; + span->blocks = &span->base; + span->blockCount = 2; + + span->base.limit = AddrAdd(span->base.limit, size); + span->space -= size; + span->largest = span->space; + span->largestKnown = TRUE; + + span->sig = MVSpanSig; + AVERT(MVSpan, span); + + mv->space += span->space; + RingInsert(&mv->spans, &span->spans); + /* use RingInsert so that we examine this new span first when allocating */ + + *pReturn = span->base.base; + return ResOK; +} + + +/* MVFree -- free method for class MV */ + +static void MVFree(Pool pool, Addr old, Size size) +{ + Addr base, limit; + MVSpan span; + MV mv; + Res res; + Bool b; + Tract tract; + + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + + AVER(old != (Addr)0); + AVER(size > 0); + + size = SizeAlignUp(size, pool->alignment); + base = old; + limit = AddrAdd(base, size); + + /* Map the pointer onto the tract which contains it, and thence */ + /* onto the span. */ + b = TractOfAddr(&tract, PoolArena(pool), old); + AVER(b); + span = (MVSpan)TractP(tract); + AVERT(MVSpan, span); + + /* the to be freed area should be within the span just found */ + AVER(span->base.base <= base && limit <= span->limit.limit); + + /* Unfortunately, if allocating the new block descriptor fails we */ + /* can't do anything, and the memory is lost. See note 2. */ + res = MVSpanFree(span, base, limit, mvBlockPool(mv)); + if(res != ResOK) + mv->lost += size; + else + mv->space += size; + + /* free space should be less than total space */ + AVER(span->space <= SpanInsideSentinels(span)); + if(span->space == SpanSize(span)) { /* the whole span is free */ + AVER(span->blockCount == 2); + /* both blocks are the trivial sentinel blocks */ + AVER(span->base.limit == span->base.base); + AVER(span->limit.limit == span->limit.base); + mv->space -= span->space; + ArenaFree(TractBase(span->tract), span->size, pool); + RingRemove(&span->spans); + RingFinish(&span->spans); + PoolFree(mvSpanPool(mv), (Addr)span, sizeof(MVSpanStruct)); + } +} + + +/* MVDebugMixin - find debug mixin in class MVDebug */ + +static PoolDebugMixin MVDebugMixin(Pool pool) +{ + MV mv; + + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + /* Can't check MVDebug, because this is called during MVDebug init */ + return &(MVPoolMVDebug(mv)->debug); +} + + +static Res MVDescribe(Pool pool, mps_lib_FILE *stream) +{ + Res res; + MV mv; + MVSpan span; + Align step; + Size length; + char c; + Ring spans, node = NULL, nextNode; /* gcc whinge stop */ + + if(!CHECKT(Pool, pool)) return ResFAIL; + mv = PoolPoolMV(pool); + if(!CHECKT(MV, mv)) return ResFAIL; + if(stream == NULL) return ResFAIL; + + res = WriteF(stream, + " blockPool $P ($U)\n", + (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial, + " spanPool $P ($U)\n", + (WriteFP)mvSpanPool(mv), (WriteFU)mvSpanPool(mv)->serial, + " extendBy $W\n", (WriteFW)mv->extendBy, + " avgSize $W\n", (WriteFW)mv->avgSize, + " maxSize $W\n", (WriteFW)mv->maxSize, + " space $P\n", (WriteFP)mv->space, + NULL); + if(res != ResOK) return res; + + res = WriteF(stream, " Spans\n", NULL); + if(res != ResOK) return res; + + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + + res = WriteF(stream, + " span $P", (WriteFP)span, + " tract $P", (WriteFP)span->tract, + " space $W", (WriteFW)span->space, + " blocks $U", (WriteFU)span->blockCount, + " largest ", + NULL); + if(res != ResOK) return res; + + if (span->largestKnown) /* .design.largest */ + res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL); + else + res = WriteF(stream, "unknown\n", NULL); + + if(res != ResOK) return res; + } + + res = WriteF(stream, " Span allocation maps\n", NULL); + if(res != ResOK) return res; + + step = pool->alignment; + length = 0x40 * step; + + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + Addr i, j; + MVBlock block; + span = RING_ELT(MVSpan, spans, node); + res = WriteF(stream, " MVSpan $P\n", (WriteFP)span, NULL); + if(res != ResOK) return res; + + block = span->blocks; + + for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) { + res = WriteF(stream, " $A ", i, NULL); + if(res != ResOK) return res; + + for(j = i; + j < AddrAdd(i, length) && j < span->limit.limit; + j = AddrAdd(j, step)) { + + if(j >= block->limit) { + block = block->next; + if(block == NULL) return ResFAIL; /* shouldn't pass limit */ + } + + if(j == block->base) { + if(AddrAdd(j, step) == block->limit) + c = 'O'; + else + c = '['; + } else if(j < block->base) + c = '.'; + else if(AddrAdd(j, step) == block->limit) + c = ']'; + else /* j > block->base && j < block->limit */ + c = '='; + res = WriteF(stream, "$C", c, NULL); + if(res != ResOK) return res; + } + res = WriteF(stream, "\n", NULL); + if(res != ResOK) return res; + } + } + + return ResOK; +} + + +/* Pool class MV */ + + +DEFINE_POOL_CLASS(MVPoolClass, this) +{ + INHERIT_CLASS(this, AbstractBufferPoolClass); + PoolClassMixInAllocFree(this); + this->name = "MV"; + this->size = sizeof(MVStruct); + this->offset = offsetof(MVStruct, poolStruct); + this->init = MVInit; + this->finish = MVFinish; + this->alloc = MVAlloc; + this->free = MVFree; + this->describe = MVDescribe; +} + + +MVPoolClass PoolClassMV(void) +{ + return EnsureMVPoolClass(); +} + + +/* Pool class MVDebug */ + +DEFINE_POOL_CLASS(MVDebugPoolClass, this) +{ + INHERIT_CLASS(this, MVPoolClass); + PoolClassMixInDebug(this); + this->name = "MVDBG"; + this->size = sizeof(MVDebugStruct); + this->debugMixin = MVDebugMixin; +} + + +/* class functions + * + * Note this is an MPS interface extension + */ + +mps_class_t mps_class_mv(void) +{ + return (mps_class_t)(EnsureMVPoolClass()); +} + +mps_class_t mps_class_mv_debug(void) +{ + return (mps_class_t)(EnsureMVDebugPoolClass()); +} + + +/* mps_mv_free_size -- free bytes in pool */ + +size_t mps_mv_free_size(mps_pool_t mps_pool) +{ + Pool pool; + MV mv; + MVSpan span; + Size f = 0; + Ring spans, node = NULL, nextNode; /* gcc whinge stop */ + + pool = (Pool)mps_pool; + + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + f += span->space; + } + + return (size_t)f; +} + + +size_t mps_mv_size(mps_pool_t mps_pool) +{ + Pool pool; + MV mv; + MVSpan span; + Arena arena; + Size f = 0; + Ring spans, node = NULL, nextNode; /* gcc whinge stop */ + + pool = (Pool)mps_pool; + + AVERT(Pool, pool); + mv = PoolPoolMV(pool); + AVERT(MV, mv); + arena = PoolArena(pool); + + spans = &mv->spans; + RING_FOR(node, spans, nextNode) { + span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + f += span->size; + } + + return (size_t)f; +} + + +/* MVCheck -- check the consistency of an MV structure */ + +Bool MVCheck(MV mv) +{ + CHECKS(MV, mv); + CHECKD(Pool, &mv->poolStruct); + CHECKL(IsSubclassPoly(mv->poolStruct.class, EnsureMVPoolClass())); + CHECKD(MFS, &mv->blockPoolStruct); + CHECKD(MFS, &mv->spanPoolStruct); + CHECKL(mv->extendBy > 0); + CHECKL(mv->avgSize > 0); + CHECKL(mv->extendBy >= mv->avgSize); + /* @@@@ Could do more checks here. */ + return TRUE; +} diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h new file mode 100644 index 00000000000..0863d57746c --- /dev/null +++ b/mps/code/poolmv.h @@ -0,0 +1,56 @@ +/* .impl.h.poolmv: MANUAL VARIABLE POOL + * + * $HopeName: MMsrc!poolmv.h(trunk.6) $ + * Copyright (C) 1995 Harlequin Limited. All rights reserved. + * + * .purpose: This is the interface to the manual-variable pool class. + * + * .mv: Manual-variable pools manage variably-sized blocks of memory in a + * flexible manner. They have higher overheads than a fixed-size pool. + * + * .init: This class adds the following arguments to PoolCreate: + * + * Size extendBy + * + * extendBy is the default number of bytes reserved by the pool at a time. + * A large size will make allocation cheaper but have a higher resource + * overhead. A typical value might be 65536. See note 2. + * + * Size avgSize + * + * avgSize is an estimate of the average size of an allocation, and is used + * to choose the size of internal tables. An accurate estimate will + * improve the efficiency of the pool. A low estimate will make the pool + * less space efficient. A high estimate will make the pool less time + * efficient. A typical value might be 32. avgSize must not be less than + * extendBy. + * + * Size maxSize + * + * maxSize is an estimate of the maximum total size that the pool will + * reach. Setting this parameter does not actually contrain the pool, but + * an accurate estimate will improve the efficiency of the pool. maxSize + * must not be less than extendBy. + * + * Notes + * 2. The documentation could suggest a segment size according to the + * distribution of allocation size requests. richard 1994-11-08 + */ + +#ifndef poolmv_h +#define poolmv_h + + +#include "mpmtypes.h" + +typedef struct MVStruct *MV; + +extern PoolClass PoolClassMV(void); + +extern Bool MVCheck(MV mv); + +#define MVPool(mv) (&(mv)->poolStruct) +extern Pool (MVPool)(MV mv); + + +#endif /* poolmv_h */ diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c new file mode 100644 index 00000000000..5078735a236 --- /dev/null +++ b/mps/code/poolmv2.c @@ -0,0 +1,1148 @@ +/* impl.c.poolmv2: MANUAL VARIABLE-SIZED TEMPORAL POOL + * + * $HopeName: MMsrc!poolmv2.c(trunk.18) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .purpose: A manual-variable pool designed to take advantage of + * placement according to predicted deathtime. + * + * .design: See design.mps.poolmv2. + */ + +#include "mpm.h" +#include "poolmv2.h" +#include "mpscmv2.h" +#include "abq.h" +#include "cbs.h" +#include "meter.h" + +SRCID(poolmv2, "$HopeName: MMsrc!poolmv2.c(trunk.18) $"); + + +/* Signatures */ + +#define MVTSig ((Sig)0x5193F299) /* SIGnature MVT */ + + +/* Private prototypes */ + +typedef struct MVTStruct *MVT; +static Res MVTInit(Pool pool, va_list arg); +static Bool MVTCheck(MVT mvt); +static void MVTFinish(Pool pool); +static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size minSize, + Bool withReservoirPermit); +static void MVTBufferEmpty(Pool pool, Buffer buffer, Addr base, Addr limit); +static void MVTFree(Pool pool, Addr base, Size size); +static Res MVTDescribe(Pool pool, mps_lib_FILE *stream); +static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size, Pool pool, + Bool withReservoirPermit); + +static void MVTSegFree(MVT mvt, Seg seg); +static Bool MVTReturnBlockSegs(MVT mvt, CBSBlock block, Arena arena); +static void MVTNoteNew(CBS cbs, CBSBlock block, Size oldSize, Size newSize); +static void MVTNoteDelete(CBS cbs, CBSBlock block, Size oldSize, Size newSize); +static void ABQRefillIfNecessary(MVT mvt, Size size); +static Bool ABQRefillCallback(CBS cbs, CBSBlock block, void *closureP); +static Res MVTContingencySearch(CBSBlock *blockReturn, CBS cbs, Size min); +static Bool MVTContingencyCallback(CBS cbs, CBSBlock block, void *closureP); +static Bool MVTCheckFit(CBSBlock block, Size min, Arena arena); +static ABQ MVTABQ(MVT mvt); +static CBS MVTCBS(MVT mvt); +static MVT CBSMVT(CBS cbs); +static SegPref MVTSegPref(MVT mvt); + + +/* Types */ + + +typedef struct MVTStruct +{ + PoolStruct poolStruct; + CBSStruct cbsStruct; /* The coalescing block structure */ + ABQStruct abqStruct; /* The available block queue */ + SegPrefStruct segPrefStruct; /* The preferences for segments */ + /* design.mps.poolmvt:arch.parameters */ + Size minSize; /* Pool parameter */ + Size meanSize; /* Pool parameter */ + Size maxSize; /* Pool parameter */ + Count fragLimit; /* Pool parameter */ + /* design.mps.poolmvt:arch.overview.abq.reuse.size */ + Size reuseSize; /* Size at which blocks are recycled */ + /* design.mps.poolmvt:arch.ap.fill.size */ + Size fillSize; /* Size of pool segments */ + /* design.mps.poolmvt:arch.contingency */ + Size availLimit; /* Limit on available */ + /* design.mps.poolmvt:impl.c.free.merge.segment.overflow */ + Bool abqOverflow; /* ABQ dropped some candidates */ + /* design.mps.poolmvt:arch.ap.no-fit.* */ + Bool splinter; /* Saved splinter */ + Seg splinterSeg; /* Saved splinter seg */ + Addr splinterBase; /* Saved splinter base */ + Addr splinterLimit; /* Saved splinter size */ + + /* pool accounting --- one of these first four is redundant, but + size and available are used to implement fragmentation policy */ + Size size; /* size of segs in pool */ + Size allocated; /* bytes allocated to mutator */ + Size available; /* bytes available for allocation */ + Size unavailable; /* bytes lost to fragmentation */ + + /* pool meters*/ + METER_DECL(segAllocs); + METER_DECL(segFrees); + METER_DECL(bufferFills); + METER_DECL(bufferEmpties); + METER_DECL(poolFrees); + METER_DECL(poolSize); + METER_DECL(poolAllocated); + METER_DECL(poolAvailable); + METER_DECL(poolUnavailable); + METER_DECL(poolUtilization); + /* abq meters */ + METER_DECL(finds); + METER_DECL(overflows); + METER_DECL(underflows); + METER_DECL(refills); + METER_DECL(refillPushes); + METER_DECL(refillOverflows); + METER_DECL(refillReturns); + /* fragmentation meters */ + METER_DECL(perfectFits); + METER_DECL(firstFits); + METER_DECL(secondFits); + METER_DECL(failures); + /* contingency meters */ + METER_DECL(emergencyContingencies); + METER_DECL(fragLimitContingencies); + METER_DECL(contingencySearches); + METER_DECL(contingencyHardSearches); + /* splinter meters */ + METER_DECL(splinters); + METER_DECL(splintersUsed); + METER_DECL(splintersDropped); + METER_DECL(sawdust); + /* exception meters */ + METER_DECL(exceptions); + METER_DECL(exceptionSplinters); + METER_DECL(exceptionReturns); + + Sig sig; +} MVTStruct; + + +DEFINE_POOL_CLASS(MVTPoolClass, this) +{ + INHERIT_CLASS(this, AbstractSegBufPoolClass); + this->name = "MVT"; + this->size = sizeof(MVTStruct); + this->offset = offsetof(MVTStruct, poolStruct); + this->attr |= AttrFREE; + this->init = MVTInit; + this->finish = MVTFinish; + this->free = MVTFree; + this->bufferFill = MVTBufferFill; + this->bufferEmpty = MVTBufferEmpty; + this->describe = MVTDescribe; +} + +/* Macros */ + + +/* .trans.something: the C language sucks */ +#define unless(cond) if (!(cond)) +#define when(cond) if (cond) + + +#define Pool2MVT(pool) PARENT(MVTStruct, poolStruct, pool) +#define MVT2Pool(mvt) (&(mvt)->poolStruct) + + +/* Accessors */ + + +static ABQ MVTABQ(MVT mvt) +{ + return &mvt->abqStruct; +} + + +static CBS MVTCBS(MVT mvt) +{ + return &mvt->cbsStruct; +} + + +static MVT CBSMVT(CBS cbs) +{ + return PARENT(MVTStruct, cbsStruct, cbs); +} + + +static SegPref MVTSegPref(MVT mvt) +{ + return &mvt->segPrefStruct; +} + + +/* Methods */ + + +/* MVTInit -- initialize an MVT pool + * + * Parameters are: + * minSize, meanSize, maxSize, reserveDepth, fragLimit + */ +static Res MVTInit(Pool pool, va_list arg) +{ + Arena arena; + Size minSize, meanSize, maxSize, reuseSize, fillSize; + Count reserveDepth, abqDepth, fragLimit; + MVT mvt; + Res res; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + /* can't AVERT mvt, yet */ + arena = PoolArena(pool); + AVERT(Arena, arena); + + /* --- Should there be a ResBADARG ? */ + minSize = va_arg(arg, Size); + unless (minSize > 0) + return ResLIMIT; + meanSize = va_arg(arg, Size); + unless (meanSize >= minSize) + return ResLIMIT; + maxSize = va_arg(arg, Size); + unless (maxSize >= meanSize) + return ResLIMIT; + /* --- check that maxSize is not too large */ + reserveDepth = va_arg(arg, Count); + unless (reserveDepth > 0) + return ResLIMIT; + /* --- check that reserveDepth is not too large or small */ + fragLimit = va_arg(arg, Count); + unless (fragLimit <= 100) + return ResLIMIT; + + /* see design.mps.poolmvt:arch.parameters */ + fillSize = SizeAlignUp(maxSize, ArenaAlign(arena)); + /* see design.mps.poolmvt:arch.fragmentation.internal */ + reuseSize = 2 * fillSize; + abqDepth = (reserveDepth * meanSize + reuseSize - 1) / reuseSize; + /* keep the abq from being useless */ + if (abqDepth < 3) + abqDepth = 3; + + res = CBSInit(arena, MVTCBS(mvt), (void *)mvt, &MVTNoteNew, &MVTNoteDelete, + NULL, NULL, reuseSize, MPS_PF_ALIGN, TRUE, FALSE); + if (res != ResOK) + goto failCBS; + + res = ABQInit(arena, MVTABQ(mvt), (void *)mvt, abqDepth); + if (res != ResOK) + goto failABQ; + + { + ZoneSet zones; + /* --- Loci needed here, what should the pref be? */ + *MVTSegPref(mvt) = *SegPrefDefault(); + zones = ZoneSetComp(ArenaDefaultZONESET); + SegPrefExpress(MVTSegPref(mvt), SegPrefZoneSet, (void *)&zones); + } + + mvt->reuseSize = reuseSize; + mvt->fillSize = fillSize; + mvt->abqOverflow = FALSE; + mvt->minSize = minSize; + mvt->meanSize = meanSize; + mvt->maxSize = maxSize; + mvt->fragLimit = fragLimit; + mvt->splinter = FALSE; + mvt->splinterSeg = NULL; + mvt->splinterBase = (Addr)0; + mvt->splinterLimit = (Addr)0; + + /* accounting */ + mvt->size = 0; + mvt->allocated = 0; + mvt->available = 0; + mvt->availLimit = 0; + mvt->unavailable = 0; + + /* meters*/ + METER_INIT(mvt->segAllocs, "segment allocations", (void *)mvt); + METER_INIT(mvt->segFrees, "segment frees", (void *)mvt); + METER_INIT(mvt->bufferFills, "buffer fills", (void *)mvt); + METER_INIT(mvt->bufferEmpties, "buffer empties", (void *)mvt); + METER_INIT(mvt->poolFrees, "pool frees", (void *)mvt); + METER_INIT(mvt->poolSize, "pool size", (void *)mvt); + METER_INIT(mvt->poolAllocated, "pool allocated", (void *)mvt); + METER_INIT(mvt->poolAvailable, "pool available", (void *)mvt); + METER_INIT(mvt->poolUnavailable, "pool unavailable", (void *)mvt); + METER_INIT(mvt->poolUtilization, "pool utilization", (void *)mvt); + METER_INIT(mvt->finds, "ABQ finds", (void *)mvt); + METER_INIT(mvt->overflows, "ABQ overflows", (void *)mvt); + METER_INIT(mvt->underflows, "ABQ underflows", (void *)mvt); + METER_INIT(mvt->refills, "ABQ refills", (void *)mvt); + METER_INIT(mvt->refillPushes, "ABQ refill pushes", (void *)mvt); + METER_INIT(mvt->refillOverflows, "ABQ refill overflows", (void *)mvt); + METER_INIT(mvt->refillReturns, "ABQ refill returns", (void *)mvt); + METER_INIT(mvt->perfectFits, "perfect fits", (void *)mvt); + METER_INIT(mvt->firstFits, "first fits", (void *)mvt); + METER_INIT(mvt->secondFits, "second fits", (void *)mvt); + METER_INIT(mvt->failures, "failures", (void *)mvt); + METER_INIT(mvt->emergencyContingencies, "emergency contingencies", + (void *)mvt); + METER_INIT(mvt->fragLimitContingencies, + "fragmentation limit contingencies", (void *)mvt); + METER_INIT(mvt->contingencySearches, "contingency searches", (void *)mvt); + METER_INIT(mvt->contingencyHardSearches, + "contingency hard searches", (void *)mvt); + METER_INIT(mvt->splinters, "splinters", (void *)mvt); + METER_INIT(mvt->splintersUsed, "splinters used", (void *)mvt); + METER_INIT(mvt->splintersDropped, "splinters dropped", (void *)mvt); + METER_INIT(mvt->sawdust, "sawdust", (void *)mvt); + METER_INIT(mvt->exceptions, "exceptions", (void *)mvt); + METER_INIT(mvt->exceptionSplinters, "exception splinters", (void *)mvt); + METER_INIT(mvt->exceptionReturns, "exception returns", (void *)mvt); + + mvt->sig = MVTSig; + + AVERT(MVT, mvt); + EVENT_PWWWWW(PoolInitMVT, pool, minSize, meanSize, maxSize, + reserveDepth, fragLimit); + return ResOK; + +failABQ: + CBSFinish(MVTCBS(mvt)); +failCBS: + AVER(res != ResOK); + return res; +} + + +/* MVTCheck -- validate an MVT Pool */ + +static Bool MVTCheck(MVT mvt) +{ + CHECKS(MVT, mvt); + CHECKD(Pool, &mvt->poolStruct); + CHECKL(mvt->poolStruct.class == MVTPoolClassGet()); + CHECKD(CBS, &mvt->cbsStruct); + /* CHECKL(CBSCheck(MVTCBS(mvt))); */ + CHECKD(ABQ, &mvt->abqStruct); + /* CHECKL(ABQCheck(MVTABQ(mvt))); */ + CHECKD(SegPref, &mvt->segPrefStruct); + CHECKL(mvt->reuseSize >= 2 * mvt->fillSize); + CHECKL(mvt->fillSize >= mvt->maxSize); + CHECKL(mvt->maxSize >= mvt->meanSize); + CHECKL(mvt->meanSize >= mvt->minSize); + CHECKL(mvt->minSize > 0); + CHECKL(mvt->fragLimit <= 100); + CHECKL(mvt->availLimit == mvt->size * mvt->fragLimit / 100); + CHECKL(BoolCheck(mvt->abqOverflow)); + CHECKL(BoolCheck(mvt->splinter)); + if (mvt->splinter) { + CHECKL(AddrOffset(mvt->splinterBase, mvt->splinterLimit) >= + mvt->minSize); + /* CHECKD(Seg, mvt->splinterSeg); */ + CHECKL(SegCheck(mvt->splinterSeg)); + CHECKL(mvt->splinterBase >= SegBase(mvt->splinterSeg)); + CHECKL(mvt->splinterLimit <= SegLimit(mvt->splinterSeg)); + } + CHECKL(mvt->size == mvt->allocated + mvt->available + + mvt->unavailable); + /* --- could check that sum of segment sizes == mvt->size */ + /* --- check meters? */ + + return TRUE; +} + + +/* MVTFinish -- finish an MVT pool + */ +static void MVTFinish(Pool pool) +{ + MVT mvt; + Arena arena; + Ring ring; + Ring node, nextNode; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + arena = PoolArena(pool); + AVERT(Arena, arena); + + /* Free the segments in the pool */ + ring = PoolSegRing(pool); + RING_FOR(node, ring, nextNode) { + MVTSegFree(mvt, SegOfPoolRing(node)); + } + + /* Finish the ABQ and CBS structures */ + ABQFinish(arena, MVTABQ(mvt)); + CBSFinish(MVTCBS(mvt)); + + mvt->sig = SigInvalid; +} + + +/* MVTBufferFill -- refill an allocation buffer from an MVT pool + * + * See design.mps.poolmvt:impl.c.ap.fill + */ +static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size minSize, + Bool withReservoirPermit) +{ + Seg seg; + MVT mvt; + Res res; + Addr base, limit; + Arena arena; + Size alignedSize, fillSize; + CBSBlock block; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + AVER(minSize > 0); + AVER(SizeIsAligned(minSize, pool->alignment)); + AVER(BoolCheck(withReservoirPermit)); + + arena = PoolArena(pool); + fillSize = mvt->fillSize; + alignedSize = SizeAlignUp(minSize, ArenaAlign(arena)); + + /* design.mps.poolmvt:arch.ap.no-fit.oversize */ + /* Allocate oversize blocks exactly, directly from the arena */ + if (minSize > fillSize) { + res = MVTSegAlloc(&seg, mvt, alignedSize, pool, withReservoirPermit); + if (res == ResOK) { + base = SegBase(seg); + /* only allocate this block in the segment */ + limit = AddrAdd(base, minSize); + mvt->available -= alignedSize - minSize; + mvt->unavailable += alignedSize - minSize; + AVER(mvt->size == mvt->allocated + mvt->available + + mvt->unavailable); + METER_ACC(mvt->exceptions, minSize); + METER_ACC(mvt->exceptionSplinters, alignedSize - minSize); + goto done; + } + /* --- There cannot be a segment big enough to hold this object in + the free list, although there may be segments that could be + coalesced to do so. */ + AVER(res != ResOK); + return res; + } + + /* design.mps.poolmvt:arch.ap.no-fit.return */ + /* Use any splinter, if available */ + if (mvt->splinter) { + base = mvt->splinterBase; + limit = mvt->splinterLimit; + if(AddrOffset(base, limit) >= minSize) { + seg = mvt->splinterSeg; + mvt->splinter = FALSE; + METER_ACC(mvt->splintersUsed, AddrOffset(base, limit)); + goto done; + } + } + + /* Attempt to retrieve a free block from the ABQ */ + ABQRefillIfNecessary(mvt, minSize); + res = ABQPeek(MVTABQ(mvt), &block); + if (res != ResOK) { + METER_ACC(mvt->underflows, minSize); + /* design.mps.poolmvt:arch.contingency.fragmentation-limit */ + if (mvt->available >= mvt->availLimit) { + METER_ACC(mvt->fragLimitContingencies, minSize); + res = MVTContingencySearch(&block, MVTCBS(mvt), minSize); + } + } else { + METER_ACC(mvt->finds, minSize); + } +found: + if (res == ResOK) { + base = CBSBlockBase(block); + limit = CBSBlockLimit(block); + { + Bool b = SegOfAddr(&seg, arena, base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + /* Only pass out segments - may not be the best long-term policy. */ + { + Addr segLimit = SegLimit(seg); + + if (limit <= segLimit) { + /* perfect fit */ + METER_ACC(mvt->perfectFits, AddrOffset(base, limit)); + } else if (AddrOffset(base, segLimit) >= minSize) { + /* fit in 1st segment */ + limit = segLimit; + METER_ACC(mvt->firstFits, AddrOffset(base, limit)); + } else { + /* fit in 2nd second segment */ + base = segLimit; + { + Bool b = SegOfAddr(&seg, arena, base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + segLimit = SegLimit(seg); + if (limit > segLimit) + limit = segLimit; + METER_ACC(mvt->secondFits, AddrOffset(base, limit)); + } + } + { + Res r = CBSDelete(MVTCBS(mvt), base, limit); + AVER(r == ResOK); + UNUSED(r); /* impl.c.mpm.check.unused */ + } + goto done; + } + + /* Attempt to request a block from the arena */ + /* see design.mps.poolmvt:impl.c.free.merge.segment */ + res = MVTSegAlloc(&seg, mvt, fillSize, pool, withReservoirPermit); + if (res == ResOK) { + base = SegBase(seg); + limit = SegLimit(seg); + goto done; + } + + /* Try contingency */ + METER_ACC(mvt->emergencyContingencies, minSize); + res = MVTContingencySearch(&block, MVTCBS(mvt), minSize); + if (res == ResOK) + goto found; + + METER_ACC(mvt->failures, minSize); + AVER(res != ResOK); + return res; + +done: + *baseReturn = base; + *limitReturn = limit; + mvt->available -= AddrOffset(base, limit); + mvt->allocated += AddrOffset(base, limit); + AVER(mvt->size == mvt->allocated + mvt->available + + mvt->unavailable); + METER_ACC(mvt->poolUtilization, mvt->allocated * 100 / mvt->size); + METER_ACC(mvt->poolUnavailable, mvt->unavailable); + METER_ACC(mvt->poolAvailable, mvt->available); + METER_ACC(mvt->poolAllocated, mvt->allocated); + METER_ACC(mvt->poolSize, mvt->size); + METER_ACC(mvt->bufferFills, AddrOffset(base, limit)); + AVER(AddrOffset(base, limit) >= minSize); + return ResOK; +} + + +/* MVTBufferEmpty -- return an unusable portion of a buffer to the MVT + * pool + * + * See design.mps.poolmvt:impl.c.ap.empty + */ +static void MVTBufferEmpty(Pool pool, Buffer buffer, + Addr base, Addr limit) +{ + MVT mvt; + Size size; + Res res; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + AVER(base <= limit); + + size = AddrOffset(base, limit); + if (size == 0) + return; + + mvt->available += size; + mvt->allocated -= size; + AVER(mvt->size == mvt->allocated + mvt->available + + mvt->unavailable); + METER_ACC(mvt->poolUtilization, mvt->allocated * 100 / mvt->size); + METER_ACC(mvt->poolUnavailable, mvt->unavailable); + METER_ACC(mvt->poolAvailable, mvt->available); + METER_ACC(mvt->poolAllocated, mvt->allocated); + METER_ACC(mvt->poolSize, mvt->size); + METER_ACC(mvt->bufferEmpties, size); + + /* design.mps.poolmvt:arch.ap.no-fit.splinter */ + if (size < mvt->minSize) { + res = CBSInsert(MVTCBS(mvt), base, limit); + AVER(res == ResOK); + METER_ACC(mvt->sawdust, size); + return; + } + + METER_ACC(mvt->splinters, size); + /* design.mps.poolmvt:arch.ap.no-fit.return */ + if (mvt->splinter) { + Size oldSize = AddrOffset(mvt->splinterBase, mvt->splinterLimit); + + /* Old better, drop new */ + if (size < oldSize) { + res = CBSInsert(MVTCBS(mvt), base, limit); + AVER(res == ResOK); + METER_ACC(mvt->splintersDropped, size); + return; + } else { + /* New better, drop old */ + res = CBSInsert(MVTCBS(mvt), mvt->splinterBase, mvt->splinterLimit); + AVER(res == ResOK); + METER_ACC(mvt->splintersDropped, oldSize); + } + } + + mvt->splinter = TRUE; + mvt->splinterSeg = BufferSeg(buffer); + mvt->splinterBase = base; + mvt->splinterLimit = limit; +} + + +/* MVTFree -- free a block (previously allocated from a buffer) that + * is no longer in use + * + * see design.poolmvt.impl.c.free + */ +static void MVTFree(Pool pool, Addr base, Size size) +{ + MVT mvt; + Addr limit; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + AVER(base != (Addr)0); + AVER(size > 0); + + + /* We know the buffer observes pool->alignment */ + size = SizeAlignUp(size, pool->alignment); + limit = AddrAdd(base, size); + METER_ACC(mvt->poolFrees, size); + mvt->available += size; + mvt->allocated -= size; + AVER(mvt->size == mvt->allocated + mvt->available + mvt->unavailable); + METER_ACC(mvt->poolUtilization, mvt->allocated * 100 / mvt->size); + METER_ACC(mvt->poolUnavailable, mvt->unavailable); + METER_ACC(mvt->poolAvailable, mvt->available); + METER_ACC(mvt->poolAllocated, mvt->allocated); + METER_ACC(mvt->poolSize, mvt->size); + + /* design.mps.poolmvt:arch.ap.no-fit.oversize.policy */ + /* Return exceptional blocks directly to arena */ + if (size > mvt->fillSize) { + Seg seg; + { + Bool b = SegOfAddr(&seg, PoolArena(pool), base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + AVER(base == SegBase(seg)); + AVER(limit <= SegLimit(seg)); + mvt->available += SegSize(seg) - size; + mvt->unavailable -= SegSize(seg) - size; + AVER(mvt->size == mvt->allocated + mvt->available + + mvt->unavailable); + METER_ACC(mvt->exceptionReturns, SegSize(seg)); + if (SegBuffer(seg) != NULL) + BufferDetach(SegBuffer(seg), MVT2Pool(mvt)); + MVTSegFree(mvt, seg); + return; + } + + { + Res res = CBSInsert(MVTCBS(mvt), base, limit); + AVER(res == ResOK); + UNUSED(res); /* impl.c.mpm.check.unused */ + } +} + + +/* MVTDescribe -- describe an MVT pool */ + +static Res MVTDescribe(Pool pool, mps_lib_FILE *stream) +{ + Res res; + MVT mvt; + + if (!CHECKT(Pool, pool)) return ResFAIL; + mvt = Pool2MVT(pool); + if (!CHECKT(MVT, mvt)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "MVT $P\n{\n", (WriteFP)mvt, + " minSize: $U \n", (WriteFU)mvt->minSize, + " meanSize: $U \n", (WriteFU)mvt->meanSize, + " maxSize: $U \n", (WriteFU)mvt->maxSize, + " fragLimit: $U \n", (WriteFU)mvt->fragLimit, + " reuseSize: $U \n", (WriteFU)mvt->reuseSize, + " fillSize: $U \n", (WriteFU)mvt->fillSize, + " availLimit: $U \n", (WriteFU)mvt->availLimit, + " abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE", + " splinter: $S \n", mvt->splinter?"TRUE":"FALSE", + " splinterSeg: $P \n", (WriteFP)mvt->splinterSeg, + " splinterBase: $A \n", (WriteFA)mvt->splinterBase, + " splinterLimit: $A \n", (WriteFU)mvt->splinterLimit, + " size: $U \n", (WriteFU)mvt->size, + " allocated: $U \n", (WriteFU)mvt->allocated, + " available: $U \n", (WriteFU)mvt->available, + " unavailable: $U \n", (WriteFU)mvt->unavailable, + NULL); + if(res != ResOK) return res; + + res = CBSDescribe(MVTCBS(mvt), stream); + if(res != ResOK) return res; + + res = ABQDescribe(MVTABQ(mvt), stream); + if(res != ResOK) return res; + + res = METER_WRITE(mvt->segAllocs, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->segFrees, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->bufferFills, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->bufferEmpties, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolFrees, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolSize, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolAllocated, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolAvailable, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolUnavailable, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->poolUtilization, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->finds, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->overflows, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->underflows, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->refills, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->refillPushes, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->refillOverflows, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->refillReturns, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->perfectFits, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->firstFits, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->secondFits, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->failures, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->emergencyContingencies, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->fragLimitContingencies, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->contingencySearches, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->contingencyHardSearches, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->splinters, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->splintersUsed, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->splintersDropped, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->sawdust, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->exceptions, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->exceptionSplinters, stream); + if (res != ResOK) return res; + res = METER_WRITE(mvt->exceptionReturns, stream); + if (res != ResOK) return res; + + res = WriteF(stream, "}\n", NULL); + return res; +} + + +/* Pool Interface */ + + +/* PoolClassMVT -- the Pool (sub-)Class for an MVT pool */ + +PoolClass PoolClassMVT(void) +{ + return MVTPoolClassGet(); +} + + +/* MPS Interface */ + + +/* mps_class_mvt -- the class of an mvt pool */ + +mps_class_t mps_class_mvt(void) +{ + return (mps_class_t)(PoolClassMVT()); +} + + +/* MPS Interface extensions --- should these be pool generics? */ + + +/* mps_mvt_size -- number of bytes committed to the pool */ + +size_t mps_mvt_size(mps_pool_t mps_pool) +{ + Pool pool; + MVT mvt; + + pool = (Pool)mps_pool; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + + return (size_t)mvt->size; +} + + +/* mps_mvt_free_size -- number of bytes comitted to the pool that are + * available for allocation + */ +size_t mps_mvt_free_size(mps_pool_t mps_pool) +{ + Pool pool; + MVT mvt; + + pool = (Pool)mps_pool; + + AVERT(Pool, pool); + mvt = Pool2MVT(pool); + AVERT(MVT, mvt); + + return (size_t)mvt->available; +} + + +/* Internal methods */ + + +/* MVTSegAlloc -- encapsulates SegAlloc with associated accounting and + * metering + */ +static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size, + Pool pool, Bool withReservoirPermit) +{ + Res res = SegAlloc(segReturn, GCSegClassGet(), + MVTSegPref(mvt), size, pool, withReservoirPermit); + + if (res == ResOK) { + Size segSize = SegSize(*segReturn); + + /* see design.mps.poolmvt:arch.fragmentation.internal */ + AVER(segSize >= mvt->fillSize); + mvt->size += segSize; + mvt->available += segSize; + mvt->availLimit = mvt->size * mvt->fragLimit / 100; + AVER(mvt->size == mvt->allocated + mvt->available + mvt->unavailable); + METER_ACC(mvt->segAllocs, segSize); + } + return res; +} + + +/* MVTSegFree -- encapsulates SegFree with associated accounting and + * metering + */ +static void MVTSegFree(MVT mvt, Seg seg) +{ + Size size = SegSize(seg); + + mvt->available -= size; + mvt->size -= size; + mvt->availLimit = mvt->size * mvt->fragLimit / 100; + AVER(mvt->size == mvt->allocated + mvt->available + mvt->unavailable); + SegFree(seg); + METER_ACC(mvt->segFrees, size); +} + + +/* MVTReturnBlockSegs -- return (interior) segments of a block to the + * arena + */ +static Bool MVTReturnBlockSegs(MVT mvt, CBSBlock block, Arena arena) +{ + Addr base, limit; + Bool success = FALSE; + + base = CBSBlockBase(block); + limit = CBSBlockLimit(block); + + while (base < limit) { + Seg seg; + Addr segBase, segLimit; + + { + Bool b = SegOfAddr(&seg, arena, base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + segBase = SegBase(seg); + segLimit = SegLimit(seg); + if (base <= segBase && limit >= segLimit) { + Res r = CBSDelete(MVTCBS(mvt), segBase, segLimit); + + AVER(r == ResOK); + UNUSED(r); /* impl.c.mpm.check.unused */ + MVTSegFree(mvt, seg); + success = TRUE; + } + base = segLimit; + } + + return success; +} + + +/* MVTNoteNew -- callback invoked when a block on the CBS >= reuseSize + */ +static void MVTNoteNew(CBS cbs, CBSBlock block, Size oldSize, Size newSize) +{ + Res res; + MVT mvt; + + AVERT(CBS, cbs); + mvt = CBSMVT(cbs); + AVERT(MVT, mvt); + AVERT(CBSBlock, block); + AVER(CBSBlockSize(block) >= mvt->reuseSize); + UNUSED(oldSize); + UNUSED(newSize); + + res = ABQPush(MVTABQ(mvt), block); + /* See design.mps.poolmvt:impl.c.free.merge */ + if (res != ResOK) { + Arena arena = PoolArena(MVT2Pool(mvt)); + CBSBlock oldBlock; + res = ABQPeek(MVTABQ(mvt), &oldBlock); + AVER(res == ResOK); + /* --- This should always succeed */ + (void)MVTReturnBlockSegs(mvt, oldBlock, arena); + res = ABQPush(MVTABQ(CBSMVT(cbs)), block); + if (res != ResOK) { + unless(MVTReturnBlockSegs(mvt, block, arena)) { + mvt->abqOverflow = TRUE; + METER_ACC(mvt->overflows, CBSBlockSize(block)); + } + } + } +} + + +/* MVTNoteDelete -- callback invoked when a block on the CBS <= reuseSize */ + +static void MVTNoteDelete(CBS cbs, CBSBlock block, Size oldSize, Size newSize) +{ + Res res; + + AVERT(CBS, cbs); + AVERT(MVT, CBSMVT(cbs)); + AVERT(CBSBlock, block); + AVER(CBSBlockSize(block) < CBSMVT(cbs)->reuseSize); + UNUSED(oldSize); + UNUSED(newSize); + + res = ABQDelete(MVTABQ(CBSMVT(cbs)), block); + AVER(res == ResOK || CBSMVT(cbs)->abqOverflow); + UNUSED(res); /* impl.c.mpm.check.unused */ +} + + +/* ABQRefillIfNecessary -- refill the ABQ from the CBS if it had + * overflown and is now empty + */ +static void ABQRefillIfNecessary(MVT mvt, Size size) +{ + AVERT(MVT, mvt); + AVER(size > 0); + + if (mvt->abqOverflow && ABQIsEmpty(MVTABQ(mvt))) { + mvt->abqOverflow = FALSE; + METER_ACC(mvt->refills, size); + CBSIterateLarge(MVTCBS(mvt), &ABQRefillCallback, NULL); + } +} + + +/* ABQRefillCallback -- called from CBSIterate at the behest of + * ABQRefillIfNecessary + */ +static Bool ABQRefillCallback(CBS cbs, CBSBlock block, void *closureP) +{ + Res res; + MVT mvt; + + AVERT(CBS, cbs); + mvt = CBSMVT(cbs); + AVERT(MVT, mvt); + AVERT(ABQ, MVTABQ(mvt)); + AVERT(CBSBlock, block); + AVER(CBSBlockSize(block) >= mvt->reuseSize); + UNUSED(closureP); + + METER_ACC(mvt->refillPushes, ABQDepth(MVTABQ(mvt))); + res = ABQPush(MVTABQ(mvt), block); + if (res != ResOK) { + if (MVTReturnBlockSegs(mvt, block, PoolArena(MVT2Pool(mvt)))) { + METER_ACC(mvt->refillReturns, CBSBlockSize(block)); + return TRUE; + } else { + mvt->abqOverflow = TRUE; + METER_ACC(mvt->refillOverflows, CBSBlockSize(block)); + return FALSE; + } + } + + return TRUE; +} + + +/* Closure for MVTContingencySearch */ +typedef struct MVTContigencyStruct *MVTContigency; + +typedef struct MVTContigencyStruct +{ + CBSBlock blockReturn; + Arena arena; + Size min; + /* meters */ + Count steps; + Count hardSteps; +} MVTContigencyStruct; + + +/* MVTContingencySearch -- search the CBS for a block of size min */ + +static Res MVTContingencySearch(CBSBlock *blockReturn, CBS cbs, Size min) +{ + MVTContigencyStruct cls; + + cls.blockReturn = NULL; + cls.arena = PoolArena(MVT2Pool(CBSMVT(cbs))); + cls.min = min; + cls.steps = 0; + cls.hardSteps = 0; + + CBSIterate(cbs, &MVTContingencyCallback, (void *)&cls); + if (cls.blockReturn != NULL) { + AVER(CBSBlockSize(cls.blockReturn) >= min); + METER_ACC(CBSMVT(cbs)->contingencySearches, cls.steps); + if (cls.hardSteps) { + METER_ACC(CBSMVT(cbs)->contingencyHardSearches, cls.hardSteps); + } + *blockReturn = cls.blockReturn; + return ResOK; + } + + return ResFAIL; +} + + +/* MVTContingencyCallback -- called from CBSIterate at the behest of + * MVTContingencySearch + */ +static Bool MVTContingencyCallback(CBS cbs, CBSBlock block, void *closureP) +{ + MVTContigency cl; + Size size; + + AVERT(CBS, cbs); + AVERT(CBSBlock, block); + AVER(closureP != NULL); + + cl = (MVTContigency)closureP; + size = CBSBlockSize(block); + + cl->steps++; + if (size < cl->min) + return TRUE; + + /* verify that min will fit when seg-aligned */ + if (size >= 2 * cl->min) { + cl->blockReturn = block; + return FALSE; + } + + /* do it the hard way */ + cl->hardSteps++; + if (MVTCheckFit(block, cl->min, cl->arena)) { + cl->blockReturn = block; + return FALSE; + } + + /* keep looking */ + return TRUE; +} + + +/* MVTCheckFit -- verify that segment-aligned block of size min can + * fit in a candidate CBSblock + */ +static Bool MVTCheckFit(CBSBlock block, Size min, Arena arena) +{ + Addr base = CBSBlockBase(block); + Addr limit = CBSBlockLimit(block); + Seg seg; + Addr segLimit; + + { + Bool b = SegOfAddr(&seg, arena, base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + segLimit = SegLimit(seg); + + if (limit <= segLimit) { + if (AddrOffset(base, limit) >= min) + return TRUE; + } + + if (AddrOffset(base, segLimit) >= min) + return TRUE; + + base = segLimit; + { + Bool b = SegOfAddr(&seg, arena, base); + AVER(b); + UNUSED(b); /* impl.c.mpm.check.unused */ + } + segLimit = SegLimit(seg); + + if (AddrOffset(base, limit < segLimit ? limit : segLimit) >= min) + return TRUE; + + return FALSE; +} diff --git a/mps/code/poolmv2.h b/mps/code/poolmv2.h new file mode 100644 index 00000000000..94161595be0 --- /dev/null +++ b/mps/code/poolmv2.h @@ -0,0 +1,18 @@ +/* impl.h.poolmv2: MANUAL VARIABLE-SIZED TEMPORAL POOL + * + * $HopeName: MMsrc!poolmv2.h(trunk.2) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .purpose: The implementation of the new manual-variable pool class + * + * .design: See design.mps.poolmv2 + */ + +#ifndef poolmv2_h +#define poolmv2_h + +#include "mpm.h" + +extern PoolClass PoolClassMVT(void); + +#endif /* poolmv2_h */ diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c new file mode 100644 index 00000000000..f6abab4f853 --- /dev/null +++ b/mps/code/poolmvff.c @@ -0,0 +1,682 @@ +/* impl.c.poolmvff: First Fit Manual Variable Pool + * + * $HopeName: MMsrc!poolmvff.c(trunk.21) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .purpose: This is a pool class for manually managed objects of + * variable size where address-ordered first fit is an appropriate + * policy. Provision is made to allocate in reverse. This pool + * can allocate across segment boundaries. + * + * .design: design.mps.poolmvff + * + * + * TRANSGRESSIONS + * + * .trans.stat: mps_mvff_stat is a temporary hack for measurement purposes, + * see .stat below. + */ + +#include "mpscmvff.h" +#include "dbgpool.h" +#include "cbs.h" +#include "mpm.h" + +SRCID(poolmvff, "$HopeName: MMsrc!poolmvff.c(trunk.21) $"); + + +/* Would go in poolmvff.h if the class had any MPS-internal clients. */ +extern PoolClass PoolClassMVFF(void); + + +/* MVFFStruct -- MVFF (Manual Variable First Fit) pool outer structure + * + * The signature is placed at the end, see + * design.mps.pool.outer-structure.sig + */ + +#define MVFFSig ((Sig)0x5193FFF9) /* SIGnature MVFF */ + +typedef struct MVFFStruct *MVFF; +typedef struct MVFFStruct { /* MVFF pool outer structure */ + PoolStruct poolStruct; /* generic structure */ + SegPref segPref; /* the preferences for segments */ + Size extendBy; /* segment size to extend pool by */ + Size minSegSize; /* minimum size of segment */ + Size avgSize; /* client estimate of allocation size */ + Size total; /* total bytes in pool */ + Size free; /* total free bytes in pool */ + CBSStruct cbsStruct; /* free list */ + Bool firstFit; /* as opposed to last fit */ + Bool slotHigh; /* prefers high part of large block */ + Sig sig; /* design.mps.sig */ +} MVFFStruct; + + +#define PoolPoolMVFF(pool) PARENT(MVFFStruct, poolStruct, pool) +#define MVFFPool(mvff) (&((mvff)->poolStruct)) +#define CBSOfMVFF(mvff) (&((mvff)->cbsStruct)) +#define MVFFOfCBS(cbs) PARENT(MVFFStruct, cbsStruct, cbs) + +static Bool MVFFCheck(MVFF mvff); + + +/* MVFFDebug -- MVFFDebug class */ + +typedef struct MVFFDebugStruct { + MVFFStruct mvffStruct; /* MVFF structure */ + PoolDebugMixinStruct debug; /* debug mixin */ +} MVFFDebugStruct; + +typedef MVFFDebugStruct *MVFFDebug; + + +#define MVFFPoolMVFFDebug(mvff) PARENT(MVFFDebugStruct, mvffStruct, mvff) +#define MVFFDebugPoolMVFF(mvffd) (&((mvffd)->mvffStruct)) + + +/* MVFFAddToFreeList -- Add given range to free list + * + * Updates MVFF counters for additional free space. Returns maximally + * coalesced range containing given range. Does not attempt to free + * segments (see MVFFFreeSegs). Cannot(!) fail. + */ +static void MVFFAddToFreeList(Addr *baseIO, Addr *limitIO, MVFF mvff) { + Res res; + Addr base, limit; + + AVER(baseIO != NULL); + AVER(limitIO != NULL); + AVERT(MVFF, mvff); + base = *baseIO; + limit = *limitIO; + AVER(limit > base); + + res = CBSInsertReturningRange(baseIO, limitIO, CBSOfMVFF(mvff), base, limit); + AVER(res == ResOK); + mvff->free += AddrOffset(base, limit); + + return; +} + + +/* MVFFFreeSegs -- Free segments from given range + * + * Given a free range, attempts to find entire segments within + * it, and returns them to the arena, updating total size counter. + * + * This is usually called immediately after MVFFAddToFreeList. + * It is not combined with MVFFAddToFreeList because the latter + * is also called when new segments are added under MVFFAlloc. + */ +static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit) +{ + Seg seg; + Arena arena; + Bool b; + Addr segLimit; /* limit of the current segment when iterating */ + Addr segBase; /* base of the current segment when iterating */ + Res res; + + AVERT(MVFF, mvff); + AVER(base < limit); + /* Could profitably AVER that the given range is free, */ + /* but the CBS doesn't provide that facility. */ + + if (AddrOffset(base, limit) < mvff->minSegSize) + return; /* not large enough for entire segments */ + + arena = PoolArena(MVFFPool(mvff)); + b = SegOfAddr(&seg, arena, base); + AVER(b); + + segBase = SegBase(seg); + segLimit = SegLimit(seg); + + while(segLimit <= limit) { /* segment ends in range */ + if (segBase >= base) { /* segment starts in range */ + /* Must remove from free list first, in case free list */ + /* is using inline data structures. */ + res = CBSDelete(CBSOfMVFF(mvff), segBase, segLimit); + AVER(res == ResOK); + mvff->free -= AddrOffset(segBase, segLimit); + mvff->total -= AddrOffset(segBase, segLimit); + SegFree(seg); + } + + /* Avoid calling SegNext if the next segment would fail */ + /* the loop test, mainly because there might not be a */ + /* next segment. */ + if (segLimit == limit) /* segment ends at end of range */ + break; + + b = SegNext(&seg, arena, segBase); + AVER(b); + segBase = SegBase(seg); + segLimit = SegLimit(seg); + } + + return; +} + + +/* MVFFAddSeg -- Allocates a new segment from the arena + * + * Allocates a new segment from the arena (with the given + * withReservoirPermit flag) of at least the specified size. The + * specified size should be pool-aligned. Adds it to the free list. + */ +static Res MVFFAddSeg(Seg *segReturn, + MVFF mvff, Size size, Bool withReservoirPermit) +{ + Pool pool; + Arena arena; + Size segSize; + Seg seg; + Res res; + Align align; + Addr base, limit; + + AVERT(MVFF, mvff); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + pool = MVFFPool(mvff); + arena = PoolArena(pool); + align = ArenaAlign(arena); + + AVER(SizeIsAligned(size, PoolAlignment(pool))); + + /* Use extendBy unless it's too small (see */ + /* design.mps.poolmvff.design.seg-size). */ + if (size <= mvff->extendBy) + segSize = mvff->extendBy; + else + segSize = size; + + segSize = SizeAlignUp(segSize, align); + + res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool, + withReservoirPermit); + if (res != ResOK) { + /* try again for a seg just large enough for object */ + /* see design.mps.poolmvff.design.seg-fail */ + segSize = SizeAlignUp(size, align); + res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool, + withReservoirPermit); + if (res != ResOK) { + return res; + } + } + + mvff->total += segSize; + base = SegBase(seg); limit = AddrAdd(base, segSize); + MVFFAddToFreeList(&base, &limit, mvff); + AVER(base <= SegBase(seg)); + if (mvff->minSegSize > segSize) mvff->minSegSize = segSize; + + /* Don't call MVFFFreeSegs; that would be silly. */ + + *segReturn = seg; + return ResOK; +} + + +/* MVFFFindFirstFree -- Finds the first (or last) suitable free block + * + * Finds a free block of the given (pool aligned) size, according + * to a first (or last) fit policy controlled by the MVFF fields + * firstFit, slotHigh (for whether to allocate the top or bottom + * portion of a larger block). + * + * Will return FALSE if the free list has no large enough block. + * In particular, will not attempt to allocate a new segment. + */ +static Bool MVFFFindFirstFree(Addr *baseReturn, Addr *limitReturn, + MVFF mvff, Size size) +{ + Bool foundBlock; + CBSFindDelete findDelete; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(MVFF, mvff); + AVER(size > 0); + AVER(SizeIsAligned(size, PoolAlignment(MVFFPool(mvff)))); + + findDelete = mvff->slotHigh ? CBSFindDeleteHIGH : CBSFindDeleteLOW; + + foundBlock = + (mvff->firstFit ? CBSFindFirst : CBSFindLast) + (baseReturn, limitReturn, CBSOfMVFF(mvff), size, findDelete); + + if (foundBlock) + mvff->free -= size; + + return foundBlock; +} + + +/* MVFFAlloc -- Allocate a block */ + +static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + Res res; + MVFF mvff; + Addr base, limit; + Bool foundBlock; + + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + AVER(aReturn != NULL); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + size = SizeAlignUp(size, PoolAlignment(pool)); + + foundBlock = MVFFFindFirstFree(&base, &limit, mvff, size); + if (!foundBlock) { + Seg seg; + + res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit); + if (res != ResOK) + return res; + foundBlock = MVFFFindFirstFree(&base, &limit, mvff, size); + + /* We know that the found range must intersect the new segment. */ + /* In particular, it doesn't necessarily lie entirely within it. */ + /* The next three AVERs test for intersection of two intervals. */ + AVER(base >= SegBase(seg) || limit <= SegLimit(seg)); + AVER(base < SegLimit(seg)); + AVER(SegBase(seg) < limit); + + /* We also know that the found range is no larger than the segment. */ + AVER(SegSize(seg) >= AddrOffset(base, limit)); + } + AVER(foundBlock); + AVER(AddrOffset(base, limit) == size); + + *aReturn = base; + + return ResOK; +} + + +/* MVFFFree -- free the given block */ + +static void MVFFFree(Pool pool, Addr old, Size size) +{ + Addr base, limit; + MVFF mvff; + + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + AVER(old != (Addr)0); + AVER(AddrIsAligned(old, PoolAlignment(pool))); + AVER(size > 0); + + size = SizeAlignUp(size, PoolAlignment(pool)); + base = old; + limit = AddrAdd(base, size); + + + MVFFAddToFreeList(&base, &limit, mvff); + + MVFFFreeSegs(mvff, base, limit); +} + + +/* MVFFBufferFill -- Fill the buffer + * + * Fill it with the largest block we can find. + */ +static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + Res res; + MVFF mvff; + Addr base, limit; + Bool foundBlock; + Seg seg = NULL; + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(SizeIsAligned(size, PoolAlignment(pool))); + AVERT(Bool, withReservoirPermit); + + /* Hoping the largest is big enough, delete it and return if small. */ + foundBlock = CBSFindLargest(&base, &limit, CBSOfMVFF(mvff), + CBSFindDeleteENTIRE); + if (foundBlock && AddrOffset(base, limit) < size) { + foundBlock = FALSE; + res = CBSInsert(CBSOfMVFF(mvff), base, limit); + AVER(res == ResOK); + } + if (!foundBlock) { + res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit); + if (res != ResOK) + return res; + foundBlock = CBSFindLargest(&base, &limit, CBSOfMVFF(mvff), + CBSFindDeleteENTIRE); + AVER(foundBlock); /* We will find the new segment. */ + } + + AVER(AddrOffset(base, limit) >= size); + mvff->free -= AddrOffset(base, limit); + + *baseReturn = base; + *limitReturn = limit; + return ResOK; +} + + +/* MVFFBufferEmpty -- return unused portion of this buffer */ + +static void MVFFBufferEmpty(Pool pool, Buffer buffer, + Addr base, Addr limit) +{ + MVFF mvff; + + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + AVER(base <= limit); + + if (base == limit) + return; + + MVFFAddToFreeList(&base, &limit, mvff); + MVFFFreeSegs(mvff, base, limit); + + return; +} + + +/* MVFFInit -- initialize method for MVFF */ + +static Res MVFFInit(Pool pool, va_list arg) +{ + Size extendBy, avgSize, align; + Bool slotHigh, arenaHigh, firstFit; + MVFF mvff; + Arena arena; + Res res; + void *p; + ZoneSet zones; + + AVERT(Pool, pool); + + /* .arg: class-specific additional arguments; see */ + /* design.mps.poolmvff.method.init */ + /* .arg.check: we do the same checks here and in MVFFCheck */ + /* except for arenaHigh, which is stored only in the segPref. */ + extendBy = va_arg(arg, Size); + avgSize = va_arg(arg, Size); + align = va_arg(arg, Size); + slotHigh = va_arg(arg, Bool); + arenaHigh = va_arg(arg, Bool); + firstFit = va_arg(arg, Bool); + AVER(extendBy > 0); /* .arg.check */ + AVER(avgSize > 0); /* .arg.check */ + AVER(avgSize <= extendBy); /* .arg.check */ + AVER(BoolCheck(slotHigh)); + AVER(BoolCheck(arenaHigh)); + AVER(BoolCheck(firstFit)); + + mvff = PoolPoolMVFF(pool); + arena = PoolArena(pool); + + mvff->extendBy = extendBy; + if (extendBy < ArenaAlign(arena)) + mvff->minSegSize = ArenaAlign(arena); + else + mvff->minSegSize = extendBy; + mvff->avgSize = avgSize; + pool->alignment = align; + mvff->slotHigh = slotHigh; + mvff->firstFit = firstFit; + + res = ControlAlloc(&p, arena, sizeof(SegPrefStruct), FALSE); + if (res != ResOK) + return res; + + mvff->segPref = (SegPref)p; + *mvff->segPref = *SegPrefDefault(); + SegPrefExpress(mvff->segPref, arenaHigh ? SegPrefHigh : SegPrefLow, NULL); + /* If using zoneset placement, just put it apart from the others. */ + zones = ZoneSetComp(ArenaDefaultZONESET); + SegPrefExpress(mvff->segPref, SegPrefZoneSet, (void *)&zones); + + mvff->total = 0; + mvff->free = 0; + + CBSInit(arena, CBSOfMVFF(mvff), (void *)mvff, NULL, NULL, NULL, NULL, + mvff->extendBy, align, TRUE, TRUE); + + mvff->sig = MVFFSig; + AVERT(MVFF, mvff); + EVENT_PPWWWUUU(PoolInitMVFF, pool, arena, extendBy, avgSize, align, + slotHigh, arenaHigh, firstFit); + return ResOK; +} + + +/* MVFFFinish -- finish method for MVFF */ + +static void MVFFFinish(Pool pool) +{ + MVFF mvff; + Arena arena; + Seg seg; + Ring ring, node, nextNode; + + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + ring = PoolSegRing(pool); + RING_FOR(node, ring, nextNode) { + seg = SegOfPoolRing(node); + AVER(SegPool(seg) == pool); + SegFree(seg); + } + + /* Could maintain mvff->total here and check it falls to zero, */ + /* but that would just make the function slow. If only we had */ + /* a way to do operations only if AVERs are turned on. */ + + arena = PoolArena(pool); + ControlFree(arena, mvff->segPref, sizeof(SegPrefStruct)); + + CBSFinish(CBSOfMVFF(mvff)); + + mvff->sig = SigInvalid; +} + + +/* MVFFDebugMixin - find debug mixin in class MVFFDebug */ + +static PoolDebugMixin MVFFDebugMixin(Pool pool) +{ + MVFF mvff; + + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + /* Can't check MVFFDebug, because this is called during init */ + return &(MVFFPoolMVFFDebug(mvff)->debug); +} + + +/* MVFFDescribe -- describe an MVFF pool */ + +static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream) +{ + Res res; + MVFF mvff; + + if (!CHECKT(Pool, pool)) return ResFAIL; + mvff = PoolPoolMVFF(pool); + if (!CHECKT(MVFF, mvff)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "MVFF $P {\n", (WriteFP)mvff, + " pool $P ($U)\n", + (WriteFP)pool, (WriteFU)pool->serial, + " extendBy $W\n", (WriteFW)mvff->extendBy, + " avgSize $W\n", (WriteFW)mvff->avgSize, + " total $U\n", (WriteFU)mvff->total, + " free $U\n", (WriteFU)mvff->free, + NULL); + if (res != ResOK) + return res; + + res = CBSDescribe(CBSOfMVFF(mvff), stream); + if (res != ResOK) + return res; + + res = WriteF(stream, "}\n", NULL); + + return res; +} + + +DEFINE_POOL_CLASS(MVFFPoolClass, this) +{ + INHERIT_CLASS(this, AbstractAllocFreePoolClass); + PoolClassMixInBuffer(this); + this->name = "MVFF"; + this->size = sizeof(MVFFStruct); + this->offset = offsetof(MVFFStruct, poolStruct); + this->init = MVFFInit; + this->finish = MVFFFinish; + this->alloc = MVFFAlloc; + this->free = MVFFFree; + this->bufferFill = MVFFBufferFill; + this->bufferEmpty = MVFFBufferEmpty; + this->describe = MVFFDescribe; +} + + +PoolClass PoolClassMVFF(void) +{ + return MVFFPoolClassGet(); +} + + +/* Pool class MVFFDebug */ + +DEFINE_POOL_CLASS(MVFFDebugPoolClass, this) +{ + INHERIT_CLASS(this, MVFFPoolClass); + PoolClassMixInDebug(this); + this->name = "MVFFDBG"; + this->size = sizeof(MVFFDebugStruct); + this->debugMixin = MVFFDebugMixin; +} + + + +/* MPS Interface Extensions. */ + +mps_class_t mps_class_mvff(void) +{ + return (mps_class_t)(MVFFPoolClassGet()); +} + +mps_class_t mps_class_mvff_debug(void) +{ + return (mps_class_t)(MVFFDebugPoolClassGet()); +} + + +/* Total free bytes. See design.mps.poolmvff.design.arena-enter */ + +size_t mps_mvff_free_size(mps_pool_t mps_pool) +{ + Pool pool; + MVFF mvff; + + pool = (Pool)mps_pool; + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + return (size_t)mvff->free; +} + +/* Total owned bytes. See design.mps.poolmvff.design.arena-enter */ + +size_t mps_mvff_size(mps_pool_t mps_pool) +{ + Pool pool; + MVFF mvff; + + pool = (Pool)mps_pool; + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + return (size_t)mvff->total; +} + + +/* MVFFCheck -- check the consistency of an MVFF structure */ + +static Bool MVFFCheck(MVFF mvff) +{ + CHECKS(MVFF, mvff); + CHECKD(Pool, MVFFPool(mvff)); + CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, MVFFPoolClassGet())); + CHECKD(SegPref, mvff->segPref); + CHECKL(mvff->extendBy > 0); /* see .arg.check */ + CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFFPool(mvff)))); + CHECKL(mvff->avgSize > 0); /* see .arg.check */ + CHECKL(mvff->avgSize <= mvff->extendBy); /* see .arg.check */ + CHECKL(mvff->total >= mvff->free); + CHECKL(SizeIsAligned(mvff->free, PoolAlignment(MVFFPool(mvff)))); + CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFFPool(mvff))))); + CHECKD(CBS, CBSOfMVFF(mvff)); + CHECKL(BoolCheck(mvff->slotHigh)); + CHECKL(BoolCheck(mvff->firstFit)); + return TRUE; +} + + +/* mps_mvff_stat -- a hack to get statistics emitted + * + * .stat: The SW temp pool cannot be destroyed, so we're providing this + * to get the statistics. It breaks modularity to access CBS internals. + */ + +#include "meter.h" +extern void mps_mvff_stat(mps_pool_t pool); + +void mps_mvff_stat(mps_pool_t mps_pool) +{ + Pool pool; + MVFF mvff; + + pool = (Pool)mps_pool; + AVERT(Pool, pool); + mvff = PoolPoolMVFF(pool); + AVERT(MVFF, mvff); + + METER_EMIT(&CBSOfMVFF(mvff)->splaySearch); + METER_EMIT(&CBSOfMVFF(mvff)->eblSearch); + METER_EMIT(&CBSOfMVFF(mvff)->eglSearch); +} diff --git a/mps/code/pooln.c b/mps/code/pooln.c new file mode 100644 index 00000000000..2f03007cf6e --- /dev/null +++ b/mps/code/pooln.c @@ -0,0 +1,296 @@ +/* impl.c.pooln: NULL POOL CLASS + * + * $HopeName: MMsrc!pooln.c(trunk.27) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + +#include "pooln.h" +#include "mpm.h" + +SRCID(pooln, "$HopeName: MMsrc!pooln.c(trunk.27) $"); + + +/* PoolNStruct -- the pool structure */ + +typedef struct PoolNStruct { + PoolStruct poolStruct; /* generic pool structure */ + /* and that's it */ +} PoolNStruct; + + +/* PoolPoolN -- get the PoolN structure from generic Pool */ + +#define PoolPoolN(pool) PARENT(PoolNStruct, poolStruct, pool) + + +/* PoolPoolN -- get the generic pool structure from a PoolN */ + +#define PoolNPool(pooln) (&(poolN)->poolStruct) + + +/* NInit -- init method for class N */ + +static Res NInit(Pool pool, va_list args) +{ + PoolN poolN = PoolPoolN(pool); + + UNUSED(args); + + /* Initialize pool-specific structures. */ + + AVERT(PoolN, poolN); + EVENT_PPP(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); + return ResOK; +} + + +/* NFinish -- finish method for class N */ + +static void NFinish(Pool pool) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + /* Finish pool-specific structures. */ +} + + +/* NAlloc -- alloc method for class N */ + +static Res NAlloc(Addr *pReturn, Pool pool, Size size, + Bool withReservoirPermit) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVER(pReturn != NULL); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + return ResLIMIT; /* limit of nil blocks exceeded */ +} + + +/* NFree -- free method for class N */ + +static void NFree(Pool pool, Addr old, Size size) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVER(old != (Addr)0); + AVER(size > 0); + + NOTREACHED; /* can't allocate, should never free */ +} + + +/* NBufferFill -- buffer fill method for class N */ + +static Res NBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Buffer, buffer); + AVER(BufferIsReset(buffer)); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + + NOTREACHED; /* can't create buffers, so shouldn't fill them */ + return ResUNIMPL; +} + + +/* NBufferEmpty -- buffer empty method for class N */ + +static void NBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit) +{ + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(BufferIsReady(buffer)); + AVER(init <= limit); + + NOTREACHED; /* can't create buffers, so they shouldn't trip */ +} + + +/* NDescribe -- describe method for class N */ + +static Res NDescribe(Pool pool, mps_lib_FILE *stream) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + UNUSED(stream); /* @@@@ should output something here */ + + return ResOK; +} + + +/* NWhiten -- condemn method for class N */ + +static Res NWhiten(Pool pool, Trace trace, Seg seg) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVERT(Trace, trace); + AVERT(Seg, seg); + + NOTREACHED; /* pool doesn't have any actions */ + + return ResUNIMPL; +} + + +/* NGrey -- greyen method for class N */ + +static void NGrey(Pool pool, Trace trace, Seg seg) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVERT(Trace, trace); + AVERT(Seg, seg); +} + + +/* NBlacken -- blacken method for class N */ + +static void NBlacken(Pool pool, TraceSet traceSet, Seg seg) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVERT(TraceSet, traceSet); + AVERT(Seg, seg); +} + + +/* NScan -- scan method for class N */ + +static Res NScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + PoolN poolN; + + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + AVERT(Seg, seg); + + return ResOK; +} + + +/* NFix -- fix method for class N */ + +static Res NFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVERT(ScanState, ss); + UNUSED(refIO); + AVERT(Seg, seg); + NOTREACHED; /* Since we don't allocate any objects, should never */ + /* be called upon to fix a reference. */ + return ResFAIL; +} + + +/* NReclaim -- reclaim method for class N */ + +static void NReclaim(Pool pool, Trace trace, Seg seg) +{ + PoolN poolN; + + AVERT(Pool, pool); + poolN = PoolPoolN(pool); + AVERT(PoolN, poolN); + + AVERT(Trace, trace); + AVERT(Seg, seg); + /* all unmarked and white objects reclaimed */ +} + + +/* NPoolClass -- pool class definition for N */ + +DEFINE_POOL_CLASS(NPoolClass, this) +{ + INHERIT_CLASS(this, AbstractPoolClass); + this->name = "N"; + this->size = sizeof(PoolNStruct); + this->offset = offsetof(PoolNStruct, poolStruct); + this->attr = AttrSCAN | AttrALLOC | AttrFREE | AttrBUF | + AttrBUF_RESERVE | AttrGC; + this->init = NInit; + this->finish = NFinish; + this->alloc = NAlloc; + this->free = NFree; + this->bufferFill = NBufferFill; + this->bufferEmpty = NBufferEmpty; + this->whiten = NWhiten; + this->grey = NGrey; + this->blacken = NBlacken; + this->scan = NScan; + this->fix = NFix; + this->fixEmergency = NFix; + this->reclaim = NReclaim; + this->describe = NDescribe; +} + + +/* PoolClassN -- returns the PoolClass for the null pool class */ + +PoolClass PoolClassN(void) +{ + return EnsureNPoolClass(); +} + + +/* PoolNCheck -- check a pool of class N */ + +Bool PoolNCheck(PoolN poolN) +{ + CHECKL(poolN != NULL); + CHECKD(Pool, &poolN->poolStruct); + CHECKL(poolN->poolStruct.class == EnsureNPoolClass()); + UNUSED(poolN); /* impl.c.mpm.check.unused */ + + return TRUE; +} diff --git a/mps/code/pooln.h b/mps/code/pooln.h new file mode 100644 index 00000000000..1251ae38087 --- /dev/null +++ b/mps/code/pooln.h @@ -0,0 +1,40 @@ +/* impl.h.pooln: NULL POOL + * + * $HopeName$ + * Copyright (C) 1995 Harlequin Limited. All rights reserved. + * + * .purpose: The null pool class is here for pedagogical purposes. It + * is a skeleton of a pool class. The class exhibits all the generic + * pool functions; none of them have non-trivial implementations. + * + * .create: The generic create method for this class takes no extra + * parameters. + */ + + +#ifndef pooln_h +#define pooln_h + +#include "mpmtypes.h" + + +/* PoolN -- instance type */ + +typedef struct PoolNStruct *PoolN; + + +/* PoolClassN -- returns the PoolClass for the null pool class */ + +extern PoolClass PoolClassN(void); + + +/* PoolNCheck -- check a pool of class N + * + * Validates a PoolN object. This function conforms to the validation + * protocol defined in design.mps.check. + */ + +extern Bool PoolNCheck(PoolN poolN); + + +#endif /* pooln_h */ diff --git a/mps/code/poolncv.c b/mps/code/poolncv.c new file mode 100644 index 00000000000..2d905adcf6b --- /dev/null +++ b/mps/code/poolncv.c @@ -0,0 +1,49 @@ +/* impl.c.poolncv: NULL POOL COVERAGE TEST + * + * $HopeName: MMsrc!poolncv.c(trunk.8) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "pooln.h" +#include "mpsavm.h" +#include "testlib.h" + + +static Bool testit(ArenaClass class, ...) +{ + Bool eflag = FALSE; + Arena arena; + Pool pool; + Res res; + Addr p; + va_list args; + + va_start(args, class); + die(ArenaCreateV(&arena, class, args), "ArenaCreate"); + va_end(args); + + die(PoolCreate(&pool, arena, PoolClassN()), "PoolNCreate"); + res = PoolAlloc(&p, pool, 1, /* withReservoirPermit */ FALSE); + if(res == ResOK) { + fprintf(stderr, + "Error: Unexpectedly succeeded in" + "allocating block from PoolN\n"); + eflag = TRUE; + } + PoolDestroy(pool); + ArenaDestroy(arena); + + return eflag; +} + + +int main(void) +{ + if(testit((ArenaClass)mps_arena_class_vm(), (Size)200000)) { + fprintf(stderr, "Conclusion: Defects found.\n"); + } else { + fprintf(stderr, "Conclusion: Failed to find any defects.\n"); + } + return 0; +} diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c new file mode 100644 index 00000000000..022bc8df6f7 --- /dev/null +++ b/mps/code/poolsnc.c @@ -0,0 +1,697 @@ +/* impl.c.poolsnc: STACK NO CHECKING POOL CLASS + * + * $HopeName: MMsrc!poolsnc.c(trunk.12) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: design.mps.poolsnc + * + * LIGHTWEIGHT FRAMES + * + * .lw-frame-state: The pool uses lightweight frames as its only + * type of allocation frame. The lightweight frame state is set to + * Valid whenever a buffer has a segment and Disabled otherwise. + * See design.mps.alloc-frame.lw-frame.states. + * + * .lw-frame-null: The frame marker NULL is used as a special value + * to indicate bottom of stack. + */ + +#include "mpscsnc.h" +#include "mpm.h" + + +SRCID(poolsnc, "$HopeName: MMsrc!poolsnc.c(trunk.12) $"); + + +#define SNCGen ((Serial)1) /* "generation" for SNC pools */ + + +/* SNCStruct -- structure for an SNC pool + * + * See design.mps.poolsnc.poolstruct. + */ + +#define SNCSig ((Sig)0x519b754c) /* SIGPooLSNC */ + +typedef struct SNCStruct { + PoolStruct poolStruct; + Seg freeSegs; + SegPrefStruct segPrefStruct; + Sig sig; +} SNCStruct, *SNC; + +#define Pool2SNC(pool) \ + PARENT(SNCStruct, poolStruct, (pool)) + + +/* Forward declarations */ + +static SegClass SNCSegClassGet(void); +static BufferClass SNCBufClassGet(void); +static Bool SNCCheck(SNC snc); +static void sncPopPartialSegChain(SNC snc, Buffer buf, Seg upTo); + + +/* Management of segment chains + * + * Each buffer has an associated segment chain in stack order + * (top of stack first). We subclass the buffer to maintain the + * head of the chain. Segments are chained using the SegP field. + */ + + + +/* SNCBufStruct -- SNC Buffer subclass + * + * This subclass of RankBuf holds a segment chain. + */ + +#define SNCBufSig ((Sig)0x51954CBF) /* SIGnature SNC BuFfer */ + +typedef struct SNCBufStruct *SNCBuf; + +typedef struct SNCBufStruct { + SegBufStruct segBufStruct; /* superclass fields must come first */ + Seg topseg; /* The segment chain head -- may be NULL */ + Sig sig; /* design.mps.sig */ +} SNCBufStruct; + + +/* BufferSNCBuf -- convert generic Buffer to an SNCBuf */ + +#define BufferSNCBuf(buffer) ((SNCBuf)(buffer)) + + +/* SNCBufCheck -- check consistency of an SNCBuf */ + +static Bool SNCBufCheck(SNCBuf sncbuf) +{ + SegBuf segbuf; + + CHECKS(SNCBuf, sncbuf); + segbuf = &sncbuf->segBufStruct; + CHECKL(SegBufCheck(segbuf)); + if (sncbuf->topseg != NULL) { + CHECKL(SegCheck(sncbuf->topseg)); + } + return TRUE; +} + + +/* sncBufferTopSeg -- return the head of segment chain from an SNCBuf */ + +static Seg sncBufferTopSeg(Buffer buffer) +{ + SNCBuf sncbuf; + AVERT(Buffer, buffer); + sncbuf = BufferSNCBuf(buffer); + AVERT(SNCBuf, sncbuf); + return sncbuf->topseg; +} + + +/* sncBufferSetTopSeg -- set the head of segment chain from an SNCBuf */ + +static void sncBufferSetTopSeg(Buffer buffer, Seg seg) +{ + SNCBuf sncbuf; + AVERT(Buffer, buffer); + if (NULL != seg) + AVERT(Seg, seg); + sncbuf = BufferSNCBuf(buffer); + AVERT(SNCBuf, sncbuf); + sncbuf->topseg = seg; +} + + +/* SNCBufInit -- Initialize an SNCBuf */ + +static Res SNCBufInit (Buffer buffer, Pool pool, va_list args) +{ + SNCBuf sncbuf; + Res res; + BufferClass superclass; + + AVERT(Buffer, buffer); + AVERT(Pool, pool); + + /* call next method */ + superclass = BUFFER_SUPERCLASS(SNCBufClass); + res = (*superclass->init)(buffer, pool, args); + if (res != ResOK) + return res; + + sncbuf = BufferSNCBuf(buffer); + sncbuf->topseg = NULL; + sncbuf->sig = SNCBufSig; + + AVERT(SNCBuf, sncbuf); + return ResOK; +} + + +/* SNCBufFinish -- Finish an SNCBuf */ + +static void SNCBufFinish(Buffer buffer) +{ + BufferClass super; + SNCBuf sncbuf; + SNC snc; + Pool pool; + + AVERT(Buffer, buffer); + sncbuf = BufferSNCBuf(buffer); + AVERT(SNCBuf, sncbuf); + pool = BufferPool(buffer); + + snc = Pool2SNC(pool); + /* Put any segments which haven't bee popped onto the free list */ + sncPopPartialSegChain(snc, buffer, NULL); + + sncbuf->sig = SigInvalid; + + /* finish the superclass fields last */ + super = BUFFER_SUPERCLASS(SNCBufClass); + super->finish(buffer); +} + + +/* SNCBufClass -- The class definition */ + +DEFINE_BUFFER_CLASS(SNCBufClass, class) +{ + INHERIT_CLASS(class, RankBufClass); + class->name = "SNCBUF"; + class->size = sizeof(SNCBufStruct); + class->init = SNCBufInit; + class->finish = SNCBufFinish; +} + + + +/* SNCSegStruct -- SNC segment subclass + * + * This subclass of GCSeg links segments in chains. + */ + +#define SNCSegSig ((Sig)0x51954C59) /* SIGSNCSeG */ + +typedef struct SNCSegStruct *SNCSeg; + +typedef struct SNCSegStruct { + GCSegStruct gcSegStruct; /* superclass fields must come first */ + SNCSeg next; /* Next segment in chain, or NULL */ + Sig sig; +} SNCSegStruct; + +#define SegSNCSeg(seg) ((SNCSeg)(seg)) +#define SNCSegSeg(sncseg) ((Seg)(sncseg)) + +#define sncSegNext(seg) \ + (SNCSegSeg(SegSNCSeg(seg)->next)) + +#define sncSegSetNext(seg, nextseg) \ + ((void)(SegSNCSeg(seg)->next = SegSNCSeg(nextseg))) + +static Bool SNCSegCheck(SNCSeg sncseg) +{ + CHECKS(SNCSeg, sncseg); + CHECKL(GCSegCheck(&sncseg->gcSegStruct)); + if (NULL != sncseg->next) { + CHECKS(SNCSeg, sncseg->next); + } + return TRUE; +} + + +/* sncSegInit -- Init method for SNC segments */ + +static Res sncSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + SNCSeg sncseg; + Res res; + + AVERT(Seg, seg); + sncseg = SegSNCSeg(seg); + AVERT(Pool, pool); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(SNCSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + + sncseg->next = NULL; + sncseg->sig = SNCSegSig; + AVERT(SNCSeg, sncseg); + return ResOK; +} + + +/* SNCSegClass -- Class definition for SNC segments */ + +DEFINE_SEG_CLASS(SNCSegClass, class) +{ + INHERIT_CLASS(class, GCSegClass); + SegClassMixInNoSplitMerge(class); /* no support for this (yet) */ + class->name = "SNCSEG"; + class->size = sizeof(SNCSegStruct); + class->init = sncSegInit; +} + + +/* sncRecordAllocatedSeg - stores a segment on the buffer chain */ + +static void sncRecordAllocatedSeg(Buffer buffer, Seg seg) +{ + AVERT(Buffer, buffer); + AVERT(Seg, seg); + AVER(sncSegNext(seg) == NULL); + + sncSegSetNext(seg, sncBufferTopSeg(buffer)); + sncBufferSetTopSeg(buffer, seg); +} + + +/* sncRecordFreeSeg - stores a segment on the freelist */ + +static void sncRecordFreeSeg(SNC snc, Seg seg) +{ + AVERT(SNC, snc); + AVERT(Seg, seg); + AVER(sncSegNext(seg) == NULL); + + /* Make sure it's not grey, and set to RankSetEMPTY */ + /* This means it won't be scanned */ + SegSetGrey(seg, TraceSetEMPTY); + SegSetRankAndSummary(seg, RankSetEMPTY, RefSetEMPTY); + + sncSegSetNext(seg, snc->freeSegs); + snc->freeSegs = seg; +} + + +/* sncPopPartialSegChain + * + * Pops segments from the buffer chain up to a specified limit + */ + +static void sncPopPartialSegChain(SNC snc, Buffer buf, Seg upTo) +{ + Seg free; + AVERT(SNC, snc); + AVERT(Buffer, buf); + if (upTo != NULL) { + AVERT(Seg, upTo); + } + + /* Iterate the buffer chain of segments freeing all until upTo */ + free = sncBufferTopSeg(buf); + while (free != upTo) { + Seg next; + AVER(free != NULL); + next = sncSegNext(free); + sncSegSetNext(free, NULL); + sncRecordFreeSeg(snc, free); + free = next; + } + /* Make upTo the head of the buffer chain */ + sncBufferSetTopSeg(buf, upTo); +} + + +/* sncFindFreeSeg + * + * attempts to find and detach a large enough segment from the + * freelist. returns TRUE on success. + */ +static Bool sncFindFreeSeg(Seg *segReturn, SNC snc, Size size) +{ + Seg free = snc->freeSegs; + Seg last = NULL; + + AVER(size > 0); + + /* iterate over the free list returning anything big enough */ + while (free != NULL) { + AVERT(Seg, free); + if (SegSize(free) >= size) { + /* This segment is big enough. Detach & return it */ + if (last == NULL) { + snc->freeSegs = sncSegNext(free); + } else { + sncSegSetNext(last, sncSegNext(free)); + } + sncSegSetNext(free, NULL); + *segReturn = free; + return TRUE; + } + last = free; + free = sncSegNext(free); + } + + return FALSE; +} + + +/* SNCInit -- initialize an SNC pool */ + +static Res SNCInit(Pool pool, va_list arg) +{ + SNC snc; + Format format; + + /* weak check, as half-way through initialization */ + AVER(pool != NULL); + + snc = Pool2SNC(pool); + + format = va_arg(arg, Format); + + AVERT(Format, format); + pool->format = format; + snc->freeSegs = NULL; + /* Use the default segpref for the pool. At least this should avoid */ + /* clashes with collected pools */ + snc->segPrefStruct = *SegPrefDefault(); + snc->sig = SNCSig; + + AVERT(SNC, snc); + EVENT_PP(PoolInitSNC, pool, format); + return ResOK; +} + + +/* SNCFinish -- finish an SNC pool */ + +static void SNCFinish(Pool pool) +{ + SNC snc; + Ring ring, node, nextNode; + + AVERT(Pool, pool); + snc = Pool2SNC(pool); + AVERT(SNC, snc); + + ring = &pool->segRing; + RING_FOR(node, ring, nextNode) { + Seg seg = SegOfPoolRing(node); + AVERT(Seg, seg); + SegFree(seg); + } +} + + +static Res SNCBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + SNC snc; + Arena arena; + Res res; + Seg seg; + Size asize; /* aligned size */ + + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buffer); + AVER(size > 0); + AVER(BoolCheck(withReservoirPermit)); + AVER(BufferIsReset(buffer)); + + snc = Pool2SNC(pool); + AVERT(SNC, snc); + + /* Try to find a free segment with enough space already */ + if (sncFindFreeSeg(&seg, snc, size)) { + goto found; + } + + /* No free seg, so create a new one */ + arena = PoolArena(pool); + asize = SizeAlignUp(size, ArenaAlign(arena)); + res = SegAlloc(&seg, SNCSegClassGet(), &snc->segPrefStruct, + asize, pool, withReservoirPermit); + if (res != ResOK) + return res; + +found: + /* design.mps.seg.field.rankSet.start */ + if (BufferRankSet(buffer) == RankSetEMPTY) + SegSetRankAndSummary(seg, BufferRankSet(buffer), RefSetEMPTY); + else + SegSetRankAndSummary(seg, BufferRankSet(buffer), RefSetUNIV); + + AVERT(Seg, seg); + /* put the segment on the buffer chain */ + sncRecordAllocatedSeg(buffer, seg); + /* Permit the use of lightweight frames - .lw-frame-state */ + BufferFrameSetState(buffer, BufferFrameVALID); + *baseReturn = SegBase(seg); + *limitReturn = SegLimit(seg); + return ResOK; +} + + +static void SNCBufferEmpty(Pool pool, Buffer buffer, + Addr init, Addr limit) +{ + SNC snc; + Seg seg; + Arena arena; + Size size; + + AVERT(Pool, pool); + AVERT(Buffer, buffer); + seg = BufferSeg(buffer); + AVER(init <= limit); + AVER(SegLimit(seg) == limit); + snc = Pool2SNC(pool); + AVERT(SNC, snc); + AVER(BufferFrameState(buffer) == BufferFrameVALID); + /* .lw-frame-state */ + BufferFrameSetState(buffer, BufferFrameDISABLED); + + arena = BufferArena(buffer); + + /* Pad the end unused space at the end of the segment */ + size = AddrOffset(init, limit); + if (size > 0) { + ShieldExpose(arena, seg); + (*pool->format->pad)(init, size); + ShieldCover(arena, seg); + } +} + + +static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) +{ + Addr base, limit; + Format format; + SNC snc; + Res res; + + AVER(totalReturn != NULL); + AVERT(ScanState, ss); + AVERT(Seg, seg); + AVERT(Pool, pool); + snc = Pool2SNC(pool); + AVERT(SNC, snc); + + format = pool->format; + base = SegBase(seg); + + /* If the segment is buffered, only walk as far as the end */ + /* of the initialized objects. */ + if (SegBuffer(seg) != NULL) { + limit = BufferScanLimit(SegBuffer(seg)); + } else { + limit = SegLimit(seg); + } + + if (base < limit) { + res = (*format->scan)(ss, base, limit); + if (res != ResOK) { + *totalReturn = FALSE; + return res; + } + } else { + AVER(base == limit); + } + + ss->scannedSize += AddrOffset(base, limit); + + *totalReturn = TRUE; + return ResOK; +} + + + +static Res SNCFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf) +{ + FrameState state; + AVER(frameReturn != NULL); + AVERT(Pool, pool); + AVERT(Buffer, buf); + + state = BufferFrameState(buf); + /* Sould have been notified of pending pops before this */ + AVER(state == BufferFrameVALID || state == BufferFrameDISABLED); + if (state == BufferFrameDISABLED) { + AVER(BufferIsReset(buf)); /* The buffer must be reset */ + AVER(sncBufferTopSeg(buf) == NULL); /* The stack must be empty */ + /* Use NULL to indicate an empty stack. .lw-frame-null */ + *frameReturn = NULL; + } else { + /* Use the scan limit as the lightweight frame pointer */ + *frameReturn = (AllocFrame)BufferScanLimit(buf); + } + return ResOK; +} + + + +static Res SNCFramePop(Pool pool, Buffer buf, AllocFrame frame) +{ + AVERT(Pool, pool); + AVERT(Buffer, buf); + /* Normally the Pop would be handled as a lightweight pop */ + /* The only reason that might not happen is if the stack is empty */ + AVER(sncBufferTopSeg(buf) == NULL); + /* The only valid frame must also be NULL - .lw-frame-null */ + AVER(frame == NULL); + /* Popping an empty frame is a NOOP */ + return ResOK; +} + + +static void SNCFramePopPending(Pool pool, Buffer buf, AllocFrame frame) +{ + Addr addr; + SNC snc; + AVERT(Pool, pool); + AVERT(Buffer, buf); + /* frame is an Addr and can't be directly checked */ + snc = Pool2SNC(pool); + AVERT(SNC, snc); + + AVER(BufferFrameState(buf) == BufferFrameVALID); + + if (frame == NULL) { + /* corresponds to a pop to bottom of stack. .lw-frame-null */ + BufferDetach(buf, pool); + sncPopPartialSegChain(snc, buf, NULL); + + } else { + Arena arena; + Seg seg; + Bool foundSeg; + + arena = PoolArena(pool); + addr = (Addr)frame; + foundSeg = SegOfAddr(&seg, arena, addr); + AVER(foundSeg); + + if (SegBuffer(seg) == buf) { + /* don't need to change the segment - just the alloc pointers */ + AVER(addr <= BufferScanLimit(buf)); /* check direction of pop */ + BufferSetAllocAddr(buf, addr); + } else { + /* need to change segment */ + BufferDetach(buf, pool); + sncPopPartialSegChain(snc, buf, seg); + BufferAttach(buf, SegBase(seg), SegLimit(seg), addr, (Size)0); + /* Permit the use of lightweight frames - .lw-frame-state */ + BufferFrameSetState(buf, BufferFrameVALID); + } + } +} + + +static void SNCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, + void *p, unsigned long s) +{ + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures and can't be checked */ + + /* Avoid applying the function to grey objects. */ + /* They may have pointers to old-space. */ + if (SegGrey(seg) == TraceSetEMPTY) { + Addr object = SegBase(seg); + Addr nextObject; + Addr limit; + SNC snc; + Format format; + + snc = Pool2SNC(pool); + AVERT(SNC, snc); + format = pool->format; + + /* If the segment is buffered, only walk as far as the end */ + /* of the initialized objects. Cf. SNCScan. */ + if (SegBuffer(seg) != NULL) + limit = BufferScanLimit(SegBuffer(seg)); + else + limit = SegLimit(seg); + + while(object < limit) { + (*f)(object, pool->format, pool, p, s); + nextObject = (*pool->format->skip)(object); + AVER(nextObject > object); + object = nextObject; + } + AVER(object == limit); + } +} + + +/* SNCPoolClass -- the class definition */ + +DEFINE_POOL_CLASS(SNCPoolClass, this) +{ + INHERIT_CLASS(this, AbstractScanPoolClass); + PoolClassMixInFormat(this); + this->name = "SNC"; + this->size = sizeof(SNCStruct); + this->offset = offsetof(SNCStruct, poolStruct); + this->init = SNCInit; + this->finish = SNCFinish; + this->bufferFill = SNCBufferFill; + this->bufferEmpty = SNCBufferEmpty; + this->scan = SNCScan; + this->framePush = SNCFramePush; + this->framePop = SNCFramePop; + this->framePopPending = SNCFramePopPending; + this->walk = SNCWalk; + this->bufferClass = SNCBufClassGet; +} + + +mps_class_t mps_class_snc(void) +{ + return (mps_class_t)SNCPoolClassGet(); +} + + +/* SNCCheck -- Check an SNC pool */ + +static Bool SNCCheck(SNC snc) +{ + CHECKS(SNC, snc); + CHECKD(Pool, &snc->poolStruct); + CHECKD(SegPref, &snc->segPrefStruct); + CHECKL(snc->poolStruct.class == SNCPoolClassGet()); + if (snc->freeSegs != NULL) { + CHECKL(SegCheck(snc->freeSegs)); + } + return TRUE; +} diff --git a/mps/code/prmcan.c b/mps/code/prmcan.c new file mode 100644 index 00000000000..b5571aff386 --- /dev/null +++ b/mps/code/prmcan.c @@ -0,0 +1,37 @@ +/* impl.c.prmcan: PROTECTION MUTATOR CONTEXT (ANSI) + * + * $HopeName: MMsrc!prmcan.c(trunk.1) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.prot for the generic design of the interface + * which is implemented in this module including the contracts for the + * functions. + * + * .purpose: This module implements the part of the protection module + * that implements the MutatorFaultContext type. In this ANSI version + * none of the functions have a useful implementation. + */ + +#include "mpm.h" + +SRCID(prmcan, "$HopeName$"); + + +/* ProtCanStepInstruction -- can the current instruction be single-stepped */ + +Bool ProtCanStepInstruction(MutatorFaultContext context) +{ + UNUSED(context); + + return FALSE; +} + + +/* ProtStepInstruction -- step over instruction by modifying context */ + +Res ProtStepInstruction(MutatorFaultContext context) +{ + UNUSED(context); + + return ResUNIMPL; +} diff --git a/mps/code/prmci3.h b/mps/code/prmci3.h new file mode 100644 index 00000000000..2498b727332 --- /dev/null +++ b/mps/code/prmci3.h @@ -0,0 +1,23 @@ +/* impl.h.prmci3: PROTECTION MUTATOR CONTEXT (Intel 386) + * + * $HopeName: $ + * Copyright (C) 1999 The Harlequin Group Limited. All rights reserved. + * + * .readership: MPS developers. + */ + +#ifndef prmci3_h +#define prmci3_h + + +#include "mpm.h" + +typedef Word *MRef; /* pointer to a machine word */ + +MRef Prmci3AddressHoldingReg(MutatorFaultContext, unsigned int); + +void Prmci3DecodeFaultContext(MRef *, Byte **, MutatorFaultContext); + +void Prmci3StepOverIns(MutatorFaultContext, Size); + +#endif /* prmci3_h */ diff --git a/mps/code/prmci3li.c b/mps/code/prmci3li.c new file mode 100644 index 00000000000..f0013092970 --- /dev/null +++ b/mps/code/prmci3li.c @@ -0,0 +1,86 @@ +/* impl.c.prmci3li: PROTECTION MUTATOR CONTEXT INTEL 386 (LINUX) + * + * $HopeName: MMsrc!prmci3li.c(trunk.3) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .purpose: This module implements the part of the protection module + * that decodes the MutatorFaultContext. + * + * + * SOURCES + * + * .source.i486: Intel486 Microprocessor Family Programmer's + * Reference Manual + * + * .source.linux.kernel: Linux kernel source files. + * + * + * ASSUMPTIONS + * + * .assume.regref: The resisters in the context can be modified by + * storing into an MRef pointer. + */ + +/* prmcli.h will include mpm.h after defining open sesame magic */ +#include "prmcli.h" +#include "prmci3.h" + +SRCID(prmci3li, "$HopeName$"); + + +/* Prmci3AddressHoldingReg -- return an address of a register in a context */ + +MRef Prmci3AddressHoldingReg(MutatorFaultContext context, unsigned int regnum) +{ + struct sigcontext *scp; + + AVER(regnum <= 7); + AVER(regnum >= 0); + + scp = context->scp; + + /* .source.i486 */ + /* .assume.regref */ + switch (regnum) { + case 0: return (MRef)&scp->eax; + case 1: return (MRef)&scp->ecx; + case 2: return (MRef)&scp->edx; + case 3: return (MRef)&scp->ebx; + case 4: return (MRef)&scp->esp; + case 5: return (MRef)&scp->ebp; + case 6: return (MRef)&scp->esi; + case 7: return (MRef)&scp->edi; + } + NOTREACHED; + return (MRef)NULL; /* Keep compiler happy. */ +} + + +/* Prmci3DecodeFaultContext -- decode fault to find faulting address and IP */ + +void Prmci3DecodeFaultContext(MRef *faultmemReturn, + Byte **insvecReturn, + MutatorFaultContext context) +{ + struct sigcontext *scp; + + scp = context->scp; + + /* Assert that this is a page fault exception. The computation of */ + /* faultmem depends on this. See .source.i486 (9.9.14). */ + AVER(scp->trapno == 14); + + /* cr2 contains the address which caused the fault. */ + /* See .source.i486 (9.9.14) and */ + /* .source.linux.kernel (linux/arch/i386/mm/fault.c). */ + *faultmemReturn = (MRef)scp->cr2; + *insvecReturn = (Byte*)scp->eip; +} + + +/* Prmci3StepOverIns -- modify context to step over instruction */ + +void Prmci3StepOverIns(MutatorFaultContext context, Size inslen) +{ + context->scp->eip += (unsigned long)inslen; +} diff --git a/mps/code/prmci3w3.c b/mps/code/prmci3w3.c new file mode 100644 index 00000000000..b4131f78304 --- /dev/null +++ b/mps/code/prmci3w3.c @@ -0,0 +1,78 @@ +/* impl.c.prmci3w3: PROTECTION MUTATOR CONTEXT INTEL 386 (Win32) + * + * $HopeName: MMsrc!prmci3w3.c(trunk.1) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * PURPOSE + * + * .purpose: This module implements the part of the protection module + * that decodes the MutatorFaultContext. + * + * SOURCES + * + * .source.i486: Intel486 Microprocessor Family Programmer's + * Reference Manual (book.intel92). + * + * ASSUMPTIONS + * + * .assume.regref: The resisters in the context can be modified by + * storing into an MRef pointer. + */ + +#include "prmcw3.h" +#include "prmci3.h" +#include "mpm.h" + +SRCID(prmci3w3, "$HopeName$"); + + +/* Prmci3AddressHoldingReg -- Return an address for a given machine register */ + +MRef Prmci3AddressHoldingReg(MutatorFaultContext context, unsigned int regnum) +{ + PCONTEXT wincont; + + AVER(regnum <= 7); + AVER(regnum >= 0); + + wincont = context->ep->ContextRecord; + + switch (regnum) { + case 0: return (MRef)&wincont->Eax; + case 1: return (MRef)&wincont->Ecx; + case 2: return (MRef)&wincont->Edx; + case 3: return (MRef)&wincont->Ebx; + case 4: return (MRef)&wincont->Esp; + case 5: return (MRef)&wincont->Ebp; + case 6: return (MRef)&wincont->Esi; + case 7: return (MRef)&wincont->Edi; + } + NOTREACHED; + return NULL; /* suppress warning */ +} + + +/* Prmci3DecodeFaultContext -- decode fault context */ + +void Prmci3DecodeFaultContext(MRef *faultmemReturn, Byte **insvecReturn, + MutatorFaultContext context) +{ + LPEXCEPTION_RECORD er; + + er = context->ep->ExceptionRecord; + + /* Assert that this is an access violation. The computation of */ + /* faultmem depends on this. */ + AVER(er->ExceptionCode == EXCEPTION_ACCESS_VIOLATION); + + *faultmemReturn = (MRef)er->ExceptionInformation[1]; + *insvecReturn = (Byte*)context->ep->ContextRecord->Eip; +} + + +/* Prmci3StepOverIns -- skip an instruction by changing the context */ + +void Prmci3StepOverIns(MutatorFaultContext context, Size inslen) +{ + context->ep->ContextRecord->Eip += (DWORD)inslen; +} diff --git a/mps/code/prmcli.h b/mps/code/prmcli.h new file mode 100644 index 00000000000..477875303bc --- /dev/null +++ b/mps/code/prmcli.h @@ -0,0 +1,26 @@ +/* impl.h.prmcli: PROTECTION MUTATOR CONTEXT (Linux) + * + * $HopeName: $ + * Copyright (C) 1998 The Harlequin Group Limited. All rights reserved. + * + * .readership: MPS developers. + */ + +#ifndef prmcli_h +#define prmcli_h + + +/* open sesame magic */ +#define _BSD_SOURCE 1 +#define _POSIX_C_SOURCE 1 + +#include "mpm.h" + +#include + +typedef struct MutatorFaultContextStruct { /* Protection fault context data */ + struct sigcontext *scp; /* Linux sigcontext */ +} MutatorFaultContextStruct; + + +#endif /* prmcli_h */ diff --git a/mps/code/prmcw3.h b/mps/code/prmcw3.h new file mode 100644 index 00000000000..1bb1e98e430 --- /dev/null +++ b/mps/code/prmcw3.h @@ -0,0 +1,23 @@ +/* impl.h.prmcw3: PROTECTION FOR WIN32 + * + * $HopeName: $ + * Copyright (C) 1998, 1999 The Harlequin Group Limited. All rights reserved. + * + * .readership: MPS developers. + */ + +#ifndef prmcw3_h +#define prmcw3_h + + +#include "mpm.h" + +#include "mpswin.h" + + +typedef struct MutatorFaultContextStruct { /* Protection fault context data */ + LPEXCEPTION_POINTERS ep; /* Windows Exception Pointers */ +} MutatorFaultContextStruct; + + +#endif /* prmcw3_h */ diff --git a/mps/code/proddw.bat b/mps/code/proddw.bat new file mode 100644 index 00000000000..924aba40dec --- /dev/null +++ b/mps/code/proddw.bat @@ -0,0 +1,40 @@ +@rem impl.bat.proddw +@rem Script that automates building and collating a dylan product +rem $HopeName: MMsrc!proddw.bat(trunk.5) $ +nmake /f w3i3mv.nmk VARIETY=ci mmdw.lib mpsplan.lib +nmake /f w3i3mv.nmk VARIETY=hi mmdw.lib mpsplan.lib +nmake /f w3i3mv.nmk VARIETY=he mmdw.lib mpsplan.lib +nmake /f w3i3mv.nmk VARIETY=wi mmdw.lib mpsplan.lib +rmdir /Q/S dylan +mkdir dylan +mkdir dylan\mps +mkdir dylan\mps\include +mkdir dylan\mps\lib +mkdir dylan\mps\lib\w3i3 +mkdir dylan\mps\lib\w3i3\ci +mkdir dylan\mps\lib\w3i3\hi +mkdir dylan\mps\lib\w3i3\he +mkdir dylan\mps\lib\w3i3\wi +mkdir dylan\mps\src +copy mps.h dylan\mps\include +copy mpsavm.h dylan\mps\include +copy mpscamc.h dylan\mps\include +copy mpscawl.h dylan\mps\include +copy mpsclo.h dylan\mps\include +copy mpscsnc.h dylan\mps\include +copy mpscmv.h dylan\mps\include +copy mpsio.h dylan\mps\include +copy mpslib.h dylan\mps\include +copy mpstd.h dylan\mps\include +copy mpsw3.h dylan\mps\include +copy mpswin.h dylan\mps\include +copy w3i3mv\ci\mmdw.lib dylan\mps\lib\w3i3\ci +copy w3i3mv\hi\mmdw.lib dylan\mps\lib\w3i3\hi +copy w3i3mv\he\mmdw.lib dylan\mps\lib\w3i3\he +copy w3i3mv\wi\mmdw.lib dylan\mps\lib\w3i3\wi +copy w3i3mv\ci\mpsplan.lib dylan\mps\lib\w3i3\ci +copy w3i3mv\hi\mpsplan.lib dylan\mps\lib\w3i3\hi +copy w3i3mv\he\mpsplan.lib dylan\mps\lib\w3i3\he +copy w3i3mv\wi\mpsplan.lib dylan\mps\lib\w3i3\wi +copy mpsliban.c dylan\mps\src +copy mpsioan.c dylan\mps\src diff --git a/mps/code/protan.c b/mps/code/protan.c new file mode 100644 index 00000000000..fc4a6ca2a7b --- /dev/null +++ b/mps/code/protan.c @@ -0,0 +1,78 @@ +/* impl.c.protan: ANSI MEMORY PROTECTION + * + * $HopeName: MMsrc!protan.c(trunk.8) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + * + * + * DESIGN + * + * design.mps.protan + */ + +#include "mpm.h" + +SRCID(protan, "$HopeName: MMsrc!protan.c(trunk.8) $"); + + +/* ProtSetup -- global protection setup */ + +void ProtSetup(void) +{ + NOOP; +} + + +/* ProtSet -- set the protection for a page */ + +void ProtSet(Addr base, Addr limit, AccessSet pm) +{ + AVER(base < limit); + /* .improve.protset.check: There is nor AccessSetCheck, so we */ + /* don't check it. */ + UNUSED(pm); + NOOP; +} + + +/* ProtSync -- synchronize protection settings with hardware + * + * See design.mps.protan.fun.sync. + */ + +void ProtSync(Arena arena) +{ + Bool synced; + + AVERT(Arena, arena); + + do { + Seg seg; + + synced = TRUE; + if (SegFirst(&seg, arena)) { + Addr base; + do { + base = SegBase(seg); + if (SegPM(seg) != AccessSetEMPTY) { /* design.mps.protan.fun.sync.seg */ + ShieldEnter(arena); + TraceSegAccess(arena, seg, SegPM(seg)); + ShieldLeave(arena); + synced = FALSE; + } + } while(SegNext(&seg, arena, base)); + } + } while(!synced); +} + + +/* ProtTramp -- protection trampoline */ + +void ProtTramp(void **rReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + AVER(rReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + *(rReturn) = (*(f))(p, s); +} diff --git a/mps/code/proti3.c b/mps/code/proti3.c new file mode 100644 index 00000000000..1056ec5a96e --- /dev/null +++ b/mps/code/proti3.c @@ -0,0 +1,240 @@ +/* impl.c.proti3: PROTECTION MUTATOR CONTEXT (INTEL 386) + * + * $HopeName: MMsrc!proti3.c(trunk.1) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.prot for the generic design of the interface + * which is implemented in this module, including the contracts for the + * functions. + * + * .purpose: This module implements the part of the protection module + * that implements the MutatorFaultContext type. + * + * .requirements: Current requirements are for limited support only, for + * stepping the sorts of instructions that the Dylan compiler might + * generate for table vector access - i.e., a restricted subset of MOV + * addressing modes. This avoids the need to scan entire weak tables at + * an inappropriate rank when a page fault occurs. + * + * + * SOURCES + * + * .source.i486: Intel486 Microprocessor Family Programmer's + * Reference Manual + * + * .source.dylan: Dylan table code implementation. Especially the + * following HOPE units: + * D-lib-dylan!table.dylan (class , slot entry-element) + * D-dfmc-harp-cg!harp-primitives.dylan (method op--repeated-slot-element) + * D-harp-pentium-harp!moves.dylan (pentium-template ld-index) + * + * + * ASSUMPTIONS + * + * .assume.null: It's always safe for Prot*StepInstruction to return + * ResUNIMPL. A null implementation of this module would be overly + * conservative but otherwise correct. + * + * .assume.want: The Dylan implementation is likely to access a + * weak table vector using either MOV r/m32,r32 or MOV r32,r/m32 + * instructions, where the r/m32 operand will be of one of the forms + * disp8[reg], disp8[reg1][reg2], disp8[reg1][reg2*4] (see .source.dylan + * and .source.i486) + * + * .assume.i3: Assume the following about the i386 environment: + * Steppable instructions (.assume.want) use the CS, DS & SS + * segment registers only (see .source.i486 Table 2-3). + * The procesor runs in 32 bit mode. + * The CS, DS and SS segment registers all describe identical 32- + * bit flat address spaces. + */ + +#include "mpm.h" +#include "prmci3.h" + +SRCID(proti3, "$HopeName$"); + + +/* DecodeCB -- Decode an Intel x86 control byte into Hi, Medium & Low fields */ + +static void DecodeCB(unsigned int *hReturn, + unsigned int *mReturn, + unsigned int *lReturn, + Byte op) +{ + /* see .source.i486 Figure 26-2 */ + unsigned int uop = (unsigned int)op; + *lReturn = uop & 7; + uop = uop >> 3; + *mReturn = uop & 7; + uop = uop >> 3; + *hReturn = uop & 3; +} + + +/* DecodeSIB -- Decode a Scale Index Base byte for an Intel x86 instruction */ + +static void DecodeSIB(unsigned int *sReturn, + unsigned int *iReturn, + unsigned int *bReturn, + Byte op) +{ + DecodeCB(sReturn, iReturn, bReturn, op); +} + + +/* DecodeModRM -- Decode a ModR/M byte for an Intel x86 instruction */ + +static void DecodeModRM(unsigned int *modReturn, + unsigned int *rReturn, + unsigned int *mReturn, + Byte op) +{ + DecodeCB(modReturn, rReturn, mReturn, op); +} + + +/* RegValue -- Return the value of a machine register from a context */ + +static Word RegValue(MutatorFaultContext context, unsigned int regnum) +{ + MRef addr; + + addr = Prmci3AddressHoldingReg(context, regnum); + return *addr; +} + + +/* Return a byte element of an instruction vector as a + * Word value, with sign extension + */ +static Word SignedInsElt(Byte insvec[], Count i) +{ + signed char eltb; + + eltb = ((signed char*)insvec)[i]; + return (Word)eltb; +} + + +/* If a MOV instruction is a sufficiently simple example of a + * move between a register and memory (in either direction), + * then find the register, the effective address and the size + * of the instruction. The instruction is considered sufficiently + * simple if it uses a single byte displacement, a base register, + * and either no index or a (possibly scaled) register. + */ +static Bool DecodeSimpleMov(unsigned int *regnumReturn, + MRef *memReturn, + Size *inslenReturn, + MutatorFaultContext context, + Byte insvec[]) +{ + unsigned int mod; + unsigned int r; + unsigned int m; + + DecodeModRM(&mod, &r, &m, insvec[1]); /* .source.i486 Table 26-3 */ + if (1 == mod) { + /* only know about single byte displacements, .assume.want */ + Word base; + Word index; + Word disp; + + if (4 == m) { + /* There is an index */ + unsigned int s; + unsigned int i; + unsigned int b; + + DecodeSIB(&s, &i, &b, insvec[2]); /* .source.i486 Table 26-3 */ + if (4 == i) + return FALSE; /* degenerate SIB form - unused by Dylan compiler */ + disp = SignedInsElt(insvec, 3); + base = RegValue(context, b); + index = RegValue(context, i) << s; + *inslenReturn = 4; + } else { + /* MOV with reg1 & [reg2+byte] parameters */ + disp = SignedInsElt(insvec, 2); + base = RegValue(context, m); + index = 0; + *inslenReturn = 3; + } + *regnumReturn = r; + *memReturn = (MRef)(base + index + disp); /* .assume.i3 */ + return TRUE; + } + + return FALSE; +} + + +static Bool IsSimpleMov(Size *inslenReturn, + MRef *srcReturn, + MRef *destReturn, + MutatorFaultContext context) +{ + Byte *insvec; + unsigned int regnum; + MRef mem; + MRef faultmem; + + Prmci3DecodeFaultContext(&faultmem, &insvec, context); + + /* .assume.want */ + /* .source.i486 Page 26-210 */ + if ((Byte)0x8b == insvec[0]) { + /* This is an instruction of type MOV reg, r/m32 */ + if (DecodeSimpleMov(®num, &mem, inslenReturn, context, insvec)) { + AVER(faultmem == mem); /* Ensure computed address matches exception */ + *srcReturn = mem; + *destReturn = Prmci3AddressHoldingReg(context, regnum); + return TRUE; + } + } else if ((Byte)0x89 == insvec[0]) { + /* This is an instruction of type MOV r/m32, reg */ + if (DecodeSimpleMov(®num, &mem, inslenReturn, context, insvec)) { + AVER(faultmem == mem); /* Ensure computed address matches exception */ + *destReturn = mem; + *srcReturn = Prmci3AddressHoldingReg(context, regnum); + return TRUE; + } + } + + return FALSE; +} + + +Bool ProtCanStepInstruction(MutatorFaultContext context) +{ + Size inslen; + MRef src; + MRef dest; + + /* .assume.null */ + /* .assume.want */ + if (IsSimpleMov(&inslen, &src, &dest, context)) { + return TRUE; + } + + return FALSE; +} + + +Res ProtStepInstruction(MutatorFaultContext context) +{ + Size inslen; + MRef src; + MRef dest; + + /* .assume.null */ + /* .assume.want */ + if (IsSimpleMov(&inslen, &src, &dest, context)) { + *dest = *src; + Prmci3StepOverIns(context, inslen); + return ResOK; + } + + return ResUNIMPL; +} diff --git a/mps/code/protli.c b/mps/code/protli.c new file mode 100644 index 00000000000..20c9dfc5b55 --- /dev/null +++ b/mps/code/protli.c @@ -0,0 +1,90 @@ +/* impl.c.protli: PROTECTION FOR LINUX + * + * $HopeName: $ + * Copyright (C) 1995,1999 Harlequin Group, all rights reserved + * + */ + +#include "mpm.h" + +#ifndef MPS_OS_LI +#error "protli.c is Linux specific, but MPS_OS_LI is not set" +#endif +#ifndef PROTECTION +#error "protli.c implements protection, but PROTECTION is not set" +#endif + +#include +#include +#include +#include + +SRCID(protli, "$HopeName: $"); + + +/* ProtSet -- set protection + * + * This is just a thin veneer on top of mprotect(2). + */ + +void ProtSet(Addr base, Addr limit, AccessSet mode) +{ + int flags; + int res; + + AVER(sizeof(int) == sizeof(Addr)); /* should be redundant; will fail on Alpha */ + AVER(base < limit); + AVER(base != 0); + AVER(AddrOffset(base, limit) <= INT_MAX); /* should be redundant */ + +#if 0 + /* .flags.trouble: This less strict version of flags (which allows write + * access unless explicitly told not to) caused mmqa test 37 to fail. + * This might be a bug in MPS, so for now we go with the stricter + * version that matches the Win32 implementation. */ + flags = 0; + if((mode & AccessREAD) == 0) + flags |= PROT_READ | PROT_EXEC; + if((mode & AccessWRITE) == 0) + flags |= PROT_WRITE; +#endif + flags = PROT_READ | PROT_WRITE | PROT_EXEC; + if((mode & AccessWRITE) != 0) + flags = PROT_READ | PROT_EXEC; + if((mode & AccessREAD) != 0) + flags = 0; + + res = mprotect((void *)base, (size_t)AddrOffset(base, limit), flags); + AVER(res == 0); +} + + +/* ProtSync -- synchronize protection settings with hardware + * + * This does nothing under Linux. + */ + +void ProtSync(Arena arena) +{ + NOOP; +} + + + +/* ProtTramp -- protection trampoline + * + * The protection trampoline is trivial under Linux, as there is nothing + * that needs to be done in the dynamic context of the mutator in order + * to catch faults. (Contrast this with Win32 Structured Exception + * Handling.) + */ + +void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + AVER(resultReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + *resultReturn = (*f)(p, s); +} diff --git a/mps/code/protlii3.c b/mps/code/protlii3.c new file mode 100644 index 00000000000..3e3f6b3dd92 --- /dev/null +++ b/mps/code/protlii3.c @@ -0,0 +1,151 @@ +/* impl.c.protlii3: PROTECTION FOR LINUX (INTEL 386) + * + * $HopeName: MMsrc!protlii3.c(trunk.3) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * SOURCES + * + * .source.i486: Intel486 Microprocessor Family Programmer's + * Reference Manual + * + * .source.linux.kernel: Linux kernel source files. + */ + +#include "prmcli.h" + +#ifndef MPS_OS_LI +#error "protlii3.c is Linux-specific, but MPS_OS_LI is not set" +#endif +#if !defined(MPS_ARCH_I3) && !defined(MPS_ARCH_I4) +#error "protlii3.c is Intel-specific, but MPS_ARCH_I3 or MPS_ARCH_I4 is not set" +#endif +#ifndef PROTECTION +#error "protlii3.c implements protection, but PROTECTION is not set" +#endif + +#include +#include +#include +#include + +SRCID(protlii3, "$HopeName: MMsrc!protlii3.c(trunk.3) $"); + + +/* Useful stuff that doesn't appear to be in any header files. */ + +/* Interrupt number 14 is Page Fault. */ +#define TRAPNO_PAGE_FAULT 14 + +/* Bits in err field of sigcontext for interrupt 14 (page fault) */ +#define PAGE_FAULT_ERR_PAGEPROT 0x1 +#define PAGE_FAULT_ERR_WRITE 0x2 +#define PAGE_FAULT_ERR_USERMODE 0x4 + + +/* The previously-installed signal action, as returned by */ +/* sigaction(3). See ProtSetup. */ + +static struct sigaction sigNext; + + +typedef void (*__real_lii3_sighandler_t)(int, struct sigcontext); + + +/* sigHandle -- protection signal handler + * + * This is the signal handler installed by ProtSetup to deal with + * protection faults. It is installed on the SIGSEGV signal. + * It decodes the protection fault details from the signal context + * and passes them to ArenaAccess, which attempts to handle the + * fault and remove its cause. If the fault is handled, then + * the handler returns and execution resumes. If it isn't handled, + * then sigHandle does its best to pass the signal on to the + * previously installed signal handler (sigNext). + * + * .sigh.args: There is no officially documented way of getting the + * sigcontext, but on x86 Linux at least it is passed BY VALUE as a + * second argument to the signal handler. The prototype doesn't + * include this arg. + * See .source.linux.kernel (linux/arch/i386/kernel/signal.c). + * + * .sigh.context: We only know how to handle interrupt 14, where + * context.err gives the page fault error code and context.cr2 gives + * the fault address. See .source.i486 (9.9.14) and + * .source.linux.kernel (linux/arch/i386/mm/fault.c). + * + * .sigh.addr: We assume that the OS decodes the address to something + * sensible + */ + +static void sigHandle(int sig, struct sigcontext context) /* .sigh.args */ +{ + AVER(sig == SIGSEGV); + + if(context.trapno == TRAPNO_PAGE_FAULT) { /* .sigh.context */ + AccessSet mode; + Addr base, limit; + MutatorFaultContextStruct mfContext; + + mfContext.scp = &context; + + mode = ((context.err & PAGE_FAULT_ERR_WRITE) != 0) /* .sigh.context */ + ? (AccessREAD | AccessWRITE) + : AccessREAD; + + /* We assume that the access is for one word at the address. */ + base = (Addr)context.cr2; /* .sigh.addr */ + limit = AddrAdd(base, (Size)sizeof(Addr)); + + /* Offer each protection structure the opportunity to handle the */ + /* exception. If it succeeds, then allow the mutator to continue. */ + + if(ArenaAccess(base, mode, &mfContext)) + return; + } + + /* The exception was not handled by any known protection structure, */ + /* so throw it to the previously installed handler. */ + + /* @@@@ This is really weak. */ + /* Need to implement rest of the contract of sigaction */ + /* We might also want to set SA_RESETHAND in the flags and explicitly */ + /* reinstall the handler from withint itself so the SIG_DFL/SIG_IGN */ + /* case can work properly by just returning. */ + switch ((int)sigNext.sa_handler) { + case (int)SIG_DFL: + case (int)SIG_IGN: + abort(); + NOTREACHED; + break; + default: + (*(__real_lii3_sighandler_t)sigNext.sa_handler)(sig, context); + break; + } +} + + +/* ProtSetup -- global protection setup + * + * Under Linux, the global setup involves installing a signal handler + * on SIGSEGV to catch and handle page faults (see sigHandle). + * The previous handler is recorded so that it can be reached from + * sigHandle if it fails to handle the fault. + * + * NOTE: There are problems with this approach: + * 1. we can't honor the sa_flags for the previous handler, + * 2. what if this thread is suspended just after calling signal(3)? + * The sigNext variable will never be initialized! + */ + +void ProtSetup(void) +{ + struct sigaction sa; + int result; + + sa.sa_handler = (__sighandler_t)sigHandle; /* .sigh.args */ + sigemptyset(&sa.sa_mask); + sa.sa_flags = 0; + + result = sigaction(SIGSEGV, &sa, &sigNext); + AVER(result == 0); +} diff --git a/mps/code/proto1.c b/mps/code/proto1.c new file mode 100644 index 00000000000..12a39efe7ca --- /dev/null +++ b/mps/code/proto1.c @@ -0,0 +1,199 @@ +/* impl.c.proto1: PROTECTION FOR DIGITAL UNIX + * + * $HopeName: MMsrc!proto1.c(trunk.2) $ + * Copyright (C) 1995,1997 Harlequin Group, all rights reserved + */ + + +/* open sesame magic, see standards(5) */ +#define _POSIX_C_SOURCE 199309L +#define _XOPEN_SOURCE_EXTENDED 1 + +#include "mpm.h" + +#ifndef MPS_OS_O1 +#error "proto1.c is OSF/1-specific, but MPS_OS_O1 is not set" +#endif +#ifndef PROTECTION +#error "proto1.c implements protection, but PROTECTION is not set" +#endif + +#include +#include +#include +#include +#include +#include +/* for getpid() */ +#include + +SRCID(proto1, "$HopeName: MMsrc!proto1.c(trunk.2) $"); + + +/* The previously-installed signal action, as returned by */ +/* sigaction(3). See ProtSetup. */ + +static struct sigaction sigNext; + + +/* == Protection Signal Handler == + * + * This is the signal handler installed by ProtSetup to deal with + * protection faults. It is installed on the SIGSEGV signal. + * It decodes the protection fault details from the signal context + * and passes them to ArenaAccess, which attempts to handle the + * fault and remove its cause. If the fault is handled, then + * the handler returns and execution resumes. If it isn't handled, + * then sigHandle does its best to pass the signal on to the + * previously installed signal handler (sigNext). + * + * .sigh.addr: We assume that the OS decodes the address to something + * sensible + * .sigh.limit: We throw away the limit information. + */ + +static void sigHandle(int sig, siginfo_t *info, void *context) +{ + int e; + sigset_t sigset, oldset; + struct sigaction sa; + + AVER(sig == SIGSEGV); + AVER(info != NULL); + + if(info->si_code == SEGV_ACCERR) { + AccessSet mode; + Addr base, limit; + + /* We can't determine the access mode (read, write, etc.) */ + /* under Solaris without decoding the faulting instruction. */ + /* Don't bother, yet. We can do this if necessary. */ + + mode = AccessREAD | AccessWRITE; + + /* We assume that the access is for one word at the address. */ + + base = (Addr)info->si_addr; + limit = AddrAdd(base, (Size)sizeof(Addr)); + + /* Offer each protection structure the opportunity to handle the */ + /* exception. If it succeeds, then allow the mutator to continue. */ + + /* MutatorFaultContext parameter is a dummy parameter in this */ + /* implementation */ + if(ArenaAccess(base, mode, NULL)) + return; + } + + /* The exception was not handled by any known protection structure, */ + /* so throw it to the previously installed handler. */ + + /* @@ This is really weak. + * Need to implement rest of the contract of sigaction */ + + e = sigaction(SIGSEGV, &sigNext, &sa); + AVER(e == 0); + sigemptyset(&sigset); + sigaddset(&sigset, SIGSEGV); + e = sigprocmask(SIG_UNBLOCK, &sigset, &oldset); + AVER(e == 0); + kill(getpid(), SIGSEGV); + e = sigprocmask(SIG_SETMASK, &oldset, NULL); + AVER(e == 0); + e = sigaction(SIGSEGV, &sa, NULL); + AVER(e == 0); +} + + +/* ProtSetup -- global protection setup + * + * Under DIGITAL UNIX, the global setup involves installing a signal handler + * on SIGSEGV to catch and handle protection faults (see sigHandle). + * The previous handler is recorded so that it can be reached from + * sigHandle if it fails to handle the fault. + * + * NOTE: There are problems with this approach: + * 1. we can't honor the wishes of the sigaction(2) entry for the + * previous handler, + * 2. what if this thread is suspended just after calling signal(3)? + * The sigNext variable will never be initialized! + */ + +void ProtSetup(void) +{ + struct sigaction sa; + int result; + + sa.sa_sigaction = sigHandle; + sa.sa_flags = SA_SIGINFO; + + result = sigaction(SIGSEGV, &sa, &sigNext); + AVER(result == 0); +} + + +/* ProtSet -- set protection + * + * This is just a thin veneer on top of mprotect(2). + */ + +void ProtSet(Addr base, Addr limit, AccessSet mode) +{ + int flags; + + AVER(sizeof(size_t) == sizeof(Addr)); + AVER(base < limit); + AVER(base != 0); + AVER(AddrOffset(base, limit) <= INT_MAX); /* should be redundant */ + + /* convert between MPS AccessSet and UNIX PROT thingies. */ + switch(mode) { + case AccessWRITE | AccessREAD: + case AccessREAD: /* forbids writes as well */ + flags = PROT_NONE; + break; + case AccessWRITE: + flags = PROT_READ | PROT_EXEC; + break; + case AccessSetEMPTY: + flags = PROT_READ | PROT_WRITE | PROT_EXEC; + break; + default: + NOTREACHED; + flags = PROT_NONE; + } + + if(mprotect((void *)base, (size_t)AddrOffset(base, limit), flags) != 0) + NOTREACHED; +} + + +/* ProtSync -- synchronize protection settings with hardware + * + * This does nothing under Solaris. + */ + +void ProtSync(Arena arena) +{ + UNUSED(arena); + NOOP; +} + + +/* ProtTramp -- protection trampoline + * + * The protection trampoline is trivial under DIGITAL UNIX, as there is + * nothing that needs to be done in the dynamic context of the mutator in + * order to catch faults. (Contrast this with Win32 Structured Exception + * Handling.) + */ + +void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + AVER(resultReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + *resultReturn = (*f)(p, s); +} diff --git a/mps/code/protocol.c b/mps/code/protocol.c new file mode 100644 index 00000000000..8faec02f188 --- /dev/null +++ b/mps/code/protocol.c @@ -0,0 +1,125 @@ +/* impl.c.pool: PROTOCOL IMPLEMENTATION + * + * $HopeName: MMsrc!protocol.c(trunk.2) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * .design: See design.mps.protocol + */ + +#include "mpm.h" + + +SRCID(protocol, "$HopeName: MMsrc!protocol.c(trunk.2) $"); + + +/* ProtocolClassCheck -- check a protocol class */ + +Bool ProtocolClassCheck(ProtocolClass class) +{ + CHECKS(ProtocolClass, class); + CHECKS(ProtocolClass, class->superclass); + CHECKL(FUNCHECK(class->coerceInst)); + CHECKL(FUNCHECK(class->coerceClass)); + return TRUE; +} + + +/* ProtocolInstCheck -- check a protocol instance */ + +Bool ProtocolInstCheck(ProtocolInst inst) +{ + CHECKS(ProtocolInst, inst); + CHECKL(ProtocolClassCheck(inst->class)); + return TRUE; +} + + +/* ProtocolIsSubclass -- a predicate for testing subclass relationships + * + * A protocol class is always a subclass of itself. This is implemented + * via the coerceClass method provided by each class. + */ +Bool ProtocolIsSubclass(ProtocolClass sub, ProtocolClass super) +{ + ProtocolClass coerced; + + AVERT(ProtocolClass, sub); + AVERT(ProtocolClass, super); + + if (sub->coerceClass(&coerced, sub, super)) { + AVERT(ProtocolClass, coerced); + return TRUE; + } else { + return FALSE; + } +} + + +/* ProtocolCoerceClass -- the default method for coerceClass + * + * This default method must be inherited by any subclass + * which does not perform a multiple inheritance. + */ +static Bool ProtocolCoerceClass(ProtocolClass *coerceResult, + ProtocolClass proClass, + ProtocolClass super) +{ + ProtocolClass p = proClass; + ProtocolClass root = ProtocolClassGet(); + + AVERT(ProtocolClass, proClass); + AVERT(ProtocolClass, super); + AVERT(ProtocolClass, root); + + while (p != super) { + AVERT(ProtocolClass, p); + if (p == root) + return FALSE; + p = p->superclass; + } + *coerceResult = proClass; + return TRUE; +} + + +/* ProtocolCoerceInst -- the default method for coerceInst + * + * This default method must be inherited by any subclass + * which does not perform a multiple inheritance. + */ +static Bool ProtocolCoerceInst(ProtocolInst *coerceResult, + ProtocolInst proInst, + ProtocolClass super) +{ + ProtocolClass p = proInst->class; + ProtocolClass root = ProtocolClassGet(); + + AVERT(ProtocolInst, proInst); + AVERT(ProtocolClass, super); + AVERT(ProtocolClass, root); + + while (p != super) { + AVERT(ProtocolClass, p); + if (p == root) + return FALSE; + p = p->superclass; + } + *coerceResult = proInst; + return TRUE; +} + + +/* The class definition for the root of the hierarchy */ + +DEFINE_CLASS(ProtocolClass, theClass) +{ + theClass->sig = ProtocolClassSig; + theClass->superclass = theClass; + theClass->coerceInst = ProtocolCoerceInst; + theClass->coerceClass = ProtocolCoerceClass; +} + + + diff --git a/mps/code/protocol.h b/mps/code/protocol.h new file mode 100644 index 00000000000..f2c7e4134fb --- /dev/null +++ b/mps/code/protocol.h @@ -0,0 +1,184 @@ +/* impl.h.protocol: PROTOCOL INHERITANCE DEFINITIONS + * + * $HopeName: MMsrc!protocol.h(trunk.4) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + +#ifndef protocol_h +#define protocol_h + +#include "config.h" +#include "mpmtypes.h" + + +/* Name derivation macros. These are not intended to be used */ +/* outside of this file */ + +#define DERIVE_LOCAL(name) protocol ## name +#define DERIVE_STRUCT(name) name ## Struct +#define DERIVE_ENSURE(name) name ## Get +#define DERIVE_ENSURE_OLD(name) Ensure ## name +#define DERIVE_ENSURE_INTERNAL(name) protocolGet ## name +#define DERIVE_GUARDIAN(name) protocol ## name ## Guardian +#define DERIVE_STATIC_STORAGE(name) protocol ## name ## Struct + + +/* Macro to set the superclass field. This is not intended */ +/* to be used outside this file. This is a polymorphic macro */ +/* named as a function. See design.mps.protocol.introspect.c-lang */ + +#define ProtocolClassSetSuperclassPoly(class, super) \ + (((ProtocolClass)(class))->superclass) = (ProtocolClass)(super) + + +/* DEFINE_CLASS -- the standard macro for defining a ProtocolClass */ + +#define DEFINE_CLASS(className, var) \ + static Bool DERIVE_GUARDIAN(className) = FALSE; \ + static DERIVE_STRUCT(className) DERIVE_STATIC_STORAGE(className); \ + static void DERIVE_ENSURE_INTERNAL(className)(className); \ + extern className DERIVE_ENSURE(className)(void); \ + className DERIVE_ENSURE(className)(void) \ + { \ + if (DERIVE_GUARDIAN(className) == FALSE) { \ + LockClaimGlobalRecursive(); \ + if (DERIVE_GUARDIAN(className) == FALSE) { \ + DERIVE_ENSURE_INTERNAL(className) \ + (&DERIVE_STATIC_STORAGE(className)); \ + DERIVE_GUARDIAN(className) = TRUE; \ + } \ + LockReleaseGlobalRecursive(); \ + } \ + return &DERIVE_STATIC_STORAGE(className); \ + } \ + /* old name for backward compatibility */ \ + extern className DERIVE_ENSURE_OLD(className)(void); \ + className DERIVE_ENSURE_OLD(className)(void) \ + { \ + return DERIVE_ENSURE(className)(); \ + } \ + static void DERIVE_ENSURE_INTERNAL(className) (className var) + + +/* INHERIT_CLASS -- the standard macro for inheriting from a superclass */ + +#define INHERIT_CLASS(this, parentName) \ + BEGIN \ + parentName DERIVE_LOCAL(parentName) = DERIVE_ENSURE(parentName)(); \ + *this = *(DERIVE_LOCAL(parentName)); \ + ProtocolClassSetSuperclassPoly(this, DERIVE_LOCAL(parentName)); \ + END + + +/* DEFINE_ALIAS_CLASS -- define a new class for the same type + * + * A convenience macro. Aliases the structure and pointer types + * for className to be the same as typeName, and then defines + * the class className. + */ +#define DEFINE_ALIAS_CLASS(className, typeName, var) \ + typedef typeName className; \ + typedef DERIVE_STRUCT(typeName) DERIVE_STRUCT(className); \ + DEFINE_CLASS(className, var) + + + +#define ProtocolClassSig ((Sig)0x519B60C7) /* SIGnature PROtocol CLass */ +#define ProtocolInstSig ((Sig)0x519B6014) /* SIGnature PROtocol INst */ + + +/* ProtocolClass -- the class containing the support for the protocol */ + +typedef struct ProtocolClassStruct *ProtocolClass; + + +/* ProtocolInst -- the instance structure for support of the protocol */ + +typedef struct ProtocolInstStruct *ProtocolInst; + + +/* ProtocolCoerceInstMethod -- coerce "pro" to an instance of "interface" + * + * If "pro" is an instance of "interface", then returns TRUE + * and sets coerceResult to point directly to the part of "pro" + * which contains the slots for "interface" + */ +typedef Bool (*ProtocolCoerceInstMethod)(ProtocolInst *coerceResult, + ProtocolInst pro, + ProtocolClass interface); + +/* ProtocolCoerceClassMethod -- coerce "proClass" to an "interface" class + * + * If "proClass" is a subclass of "interface", then returns TRUE + * and sets coerceResult to point directly to the part of + * "proClass" which contains the slots for "interface". + */ +typedef Bool (*ProtocolCoerceClassMethod)(ProtocolClass *coerceResult, + ProtocolClass proClass, + ProtocolClass interface); + + + +typedef struct ProtocolClassStruct { + Sig sig; /* design.mps.sig */ + ProtocolClass superclass; /* the superclass */ + ProtocolCoerceInstMethod coerceInst; /* coerce instance to super */ + ProtocolCoerceClassMethod coerceClass; /* coerce class to superclass */ +} ProtocolClassStruct; + + +typedef struct ProtocolInstStruct { + Sig sig; /* design.mps.sig */ + ProtocolClass class; /* the class */ +} ProtocolInstStruct; + + +/* ProtocolClassGet -- Returns the root of the protocol class hierarchy + * + * Function name conforms to standard conventions for + * protocols. + */ +extern ProtocolClass ProtocolClassGet(void); + + +/* Checking functions */ + +extern Bool ProtocolClassCheck(ProtocolClass class); +extern Bool ProtocolInstCheck(ProtocolInst pro); + + +/* ProtocolIsSubclass - use macro IsSubclass to access this. + * + * A predicate for testing subclass relationships. + * A protocol class is always a subclass of itself. + */ +extern Bool ProtocolIsSubclass(ProtocolClass sub, ProtocolClass super); + + +/* Protocol introspection interface */ + +/* The following are macros because of the need to cast */ +/* subtypes of ProtocolClass. Nevertheless they are named */ +/* as functions. See design.mps.protocol.introspect.c-lang */ + + +#define ProtocolClassSuperclassPoly(class) \ + (((ProtocolClass)(class))->superclass) + +#define ClassOfPoly(inst) ((ProtocolInst)(inst)->class) + +#define IsSubclassPoly(sub, super) \ + ProtocolIsSubclass((ProtocolClass)(sub), (ProtocolClass)(super)) + + +/* SUPERCLASS - get the superclass object, given a class name + * + * Returns the superclass, with type ProtocolClass. Clients will + * probably wish to cast this. See + * design.mps.protocol.int.static-superclass + */ +#define SUPERCLASS(className) \ + ProtocolClassSuperclassPoly(DERIVE_ENSURE(className)()) + + +#endif /* protocol_h */ diff --git a/mps/code/protso.c b/mps/code/protso.c new file mode 100644 index 00000000000..192a61b3323 --- /dev/null +++ b/mps/code/protso.c @@ -0,0 +1,198 @@ +/* impl.c.protso: PROTECTION FOR SOLARIS + * + * $HopeName: MMsrc!protso.c(trunk.5) $ + * Copyright (C) 1995,1997 Harlequin Group, all rights reserved + * + */ + +#include "mpm.h" + +#ifndef MPS_OS_SO +#error "protso.c is Solaris specific, but MPS_OS_SO is not set" +#endif +#ifndef PROTECTION +#error "protso.c implements protection, but PROTECTION is not set" +#endif + +/* open sesame magic */ +#define _POSIX_SOURCE +#define _POSIX_C_SOURCE 199309L + +#include +#include +#include +#include +#include +#include + +#ifndef MPS_OS_SO +#error "protso.c is Solaris specific, but MPS_OS_SO is not set" +#endif + +SRCID(protso, "$HopeName: MMsrc!protso.c(trunk.5) $"); + + +/* Fix up unprototyped system calls. */ +/* Note that these are not fixed up by std.h because that only fixes */ +/* up discrepancies with ANSI. */ + +extern int getpagesize(void); +extern pid_t getpid(void); +extern int kill(pid_t, int); + +/* Crap that can't be included via "open sesame" */ +/* definitions for the sa_flags field */ +/* Where is the source for this? (which header files / man pages) @@ */ +#define SA_SIGINFO 0x00000008 +/* + * SIGSEGV signal codes + */ + +#define SEGV_MAPERR 1 /* address not mapped to object */ +#define SEGV_ACCERR 2 /* invalid permissions */ +#define NSIGSEGV 2 + + +/* The previously-installed signal action, as returned by */ +/* sigaction(3). See ProtSetup. */ + +static struct sigaction sigNext; + + +/* sigHandle -- protection signal handler + * + * This is the signal handler installed by ProtSetup to deal with + * protection faults. It is installed on the SIGSEGV signal. + * It decodes the protection fault details from the signal context + * and passes them to ArenaAccess, which attempts to handle the + * fault and remove its cause. If the fault is handled, then + * the handler returns and execution resumes. If it isn't handled, + * then sigHandle does its best to pass the signal on to the + * previously installed signal handler (sigNext). + * + * .sigh.addr: We assume that the OS decodes the address to something + * sensible + * .sigh.limit: We throw away the limit information. + */ + +static void sigHandle(int sig, siginfo_t *info, void *context) +{ + AVER(sig == SIGSEGV); + AVER(info != NULL); + + if(info->si_code == SEGV_ACCERR) { + AccessSet mode; + Addr base, limit; + + /* We can't determine the access mode (read, write, etc.) */ + /* under Solaris without decoding the faulting instruction. */ + /* Don't bother, yet. We can do this if necessary. */ + + mode = AccessREAD | AccessWRITE; + + /* We assume that the access is for one word at the address. */ + /* (Nb. ldd has to be dword aligned, + * hence cannot cross a page boundary) */ + + base = (Addr)info->si_addr; + limit = AddrAdd(base, (Size)sizeof(Addr)); + + /* Offer each protection structure the opportunity to handle the */ + /* exception. If it succeeds, then allow the mutator to continue. */ + + /* MutatorFaultContext parameter is a dummy parameter for this */ + /* implementation */ + if(ArenaAccess(base, mode, NULL)) + return; + } + + /* The exception was not handled by any known protection structure, */ + /* so throw it to the previously installed handler. */ + + /* @@ This is really weak. + * Need to implement rest of the contract of sigaction */ + (*sigNext.sa_handler)(sig, info, context); +} + + +/* ProtSetup -- global protection setup + * + * Under Solaris, the global setup involves installing a signal handler + * on SIGSEGV to catch and handle protection faults (see sigHandle). + * The previous handler is recorded so that it can be reached from + * sigHandle if it fails to handle the fault. + * + * NOTE: There are problems with this approach: + * 1. we can't honor the wishes of the sigvec(2) entry for the + * previous handler, + * 2. what if this thread is suspended just after calling signal(3)? + * The sigNext variable will never be initialized! + */ + +void ProtSetup(void) +{ + struct sigaction sa; + int result; + + sa.sa_handler = sigHandle; + sa.sa_flags = SA_SIGINFO; + + result = sigaction(SIGSEGV, &sa, &sigNext); + AVER(result == 0); +} + + +/* ProtSet -- set protection + * + * This is just a thin veneer on top of mprotect(2). + */ + +void ProtSet(Addr base, Addr limit, AccessSet mode) +{ + int flags; + + AVER(sizeof(int) == sizeof(Addr)); + AVER(base < limit); + AVER(base != 0); + AVER(AddrOffset(base, limit) <= INT_MAX); /* should be redundant */ + + flags = PROT_READ | PROT_WRITE | PROT_EXEC; + if((mode & AccessREAD) != 0) + flags &= ~PROT_READ; + if((mode & AccessWRITE) != 0) + flags &= ~PROT_WRITE; + + if(mprotect((caddr_t)base, (int)AddrOffset(base, limit), flags) != 0) + NOTREACHED; +} + + +/* ProtSync -- synchronize protection settings with hardware + * + * This does nothing under Solaris. + */ + +void ProtSync(Arena arena) +{ + NOOP; +} + + + +/* ProtTramp -- protection trampoline + * + * The protection trampoline is trivial under Solaris, as there is nothing + * that needs to be done in the dynamic context of the mutator in order + * to catch faults. (Contrast this with Win32 Structured Exception + * Handling.) + */ + +void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + AVER(resultReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + *resultReturn = (*f)(p, s); +} diff --git a/mps/code/protsu.c b/mps/code/protsu.c new file mode 100644 index 00000000000..d6d15377ffb --- /dev/null +++ b/mps/code/protsu.c @@ -0,0 +1,235 @@ +/* impl.c.protsu: PROTECTION FOR SUNOS + * + * $HopeName: MMsrc!protsu.c(trunk.10) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + * + * DESIGN + * + * see design.mps.prot for the generic design (including the interface), + * and design.mps.protsu for the design specific to this implementation. + * + * TRANSGRESSIONS + * + * .hack.sigdfl: GCC 2.5.8 produces a warning when we use SIG_DFL with + * -Wstrict-prototypes, which we want. SIG_DFL is just zero, so we + * have our own definition. We don't expect SIG_DFL to change, because + * that would break SunOS binaries. *sigh* + */ + +#include "mpm.h" + +#ifndef MPS_OS_SU +#error "protsu.c is SunOS 4 specific, but MPS_OS_SU is not set" +#endif +#ifndef PROTECTION +#error "protsu.c implements protection, but PROTECTION is not set" +#endif + +#include +#include +#include + +SRCID(protsu, "$HopeName: MMsrc!protsu.c(trunk.10) $"); + + +/* Fix up unprototyped system calls. */ + +extern int getpagesize(void); +extern int getpid(void); +/* .depend.caddrt.self-promote: The following prototype for mprotect + * assumes that the type caddr_t is compatible with type that is produced + * when the default argument promotions are applied to caddr_t. See + * ISO C clause 6.3.2.2. caddr_t is defined is defined in + * /usr/include/sys/types.h to be char *, so this assumption is valid. + */ +extern int mprotect(caddr_t, int, int); +extern int sigblock(int); +extern int sigsetmask(int); +typedef void (*handler_t)(int, int, struct sigcontext *, char *); + + +/* .hack.sigdfl */ +#ifndef SIG_DFL +#error "protsu.c expected SIG_DFL to be declared by signal.h" +#else +#undef SIG_DFL +#define SIG_DFL ((handler_t)0) +#endif + + +/* Pointer to the previously-installed signal handler, as returned by */ +/* signal(3). See ProtSetup. */ + +static handler_t sigNext = NULL; + + +/* sigHandle -- protection signal handler + * + * This is the signal handler installed by ProtSetup to deal with + * protection faults. It is installed on the SIGSEGV signal. + * It decodes the protection fault details from the signal context + * and passes them to ArenaAccess, which attempts to handle the + * fault and remove its cause. If the fault is handled, then + * the handler returns and execution resumes. + * + * If it isn't handled, then sigHandle does its best to pass the signal + * on to the previously installed signal handler (sigNext). sigHandle + * cannot emulate a signal precisely. The problems are that the signal + * mask for that signal (set by sigvec) will not be set properly, also + * the handler will be executed on the current stack and not on its own + * stack (if it requested it). + * + * .assume.addr: This code assumes that the system will decode the + * address of the protection violation. This is documented in the + * "ADDR" section of the sigvec(2) man page. + * + * .sigh.decode: We can't determine the access mode (read, write, etc.) + * without decoding the faulting instruction. We don't bother to do + * this yet. It can be done later, if necessary. + * + * .sigh.size: We also assume that the access only affects the page + * of the faulting address, i.e. is a single word access or a double- + * aligned double-word access. + */ + +static void sigHandle(int sig, int code, + struct sigcontext *scp, char *addr) +{ + AVER(sig == SIGSEGV); + AVER(scp != NULL); + + if(code == SEGV_PROT) { + AccessSet mode; + AVER(addr != SIG_NOADDR); /* .assume.addr */ + mode = AccessREAD | AccessWRITE; /* .sigh.decode */ + /* MutatorFaultContext parameter is a dummy parameter in */ + /* this implementation */ + if(ArenaAccess((Addr)addr, mode, NULL)) /* .sigh.size */ + return; + } + + /* The exception was not handled by any known protection structure, */ + /* so throw it to the previously installed handler. */ + AVER(sigNext != NULL); + (*sigNext)(sig, code, scp, addr); +} + + +/* sigDefault -- default signal handler + * + * This is a signal handler used as sigNext if the previous handler + * returned by signal(3) was SIG_DFL. It does its best to get to + * the default handler, which will probably dump core. + */ + +static void sigDefault(int sig, int code, + struct sigcontext *scp, char *addr) +{ + UNUSED(sig); + UNUSED(code); + UNUSED(scp); + UNUSED(addr); + + AVER(sig == SIGSEGV); + + (void)sigsetmask(sigblock(0) & ~sigmask(SIGSEGV)); + (void)signal(SIGSEGV, SIG_DFL); + (void)kill(getpid(), SIGSEGV); + NOTREACHED; + abort(); +} + + +/* ProtSetup -- global protection setup + * + * NOTE: There are problems with this approach: + * 1. If the thread is suspended just after calling signal(3) + * then the sigNext variable will not be set and sigHandle will + * be installed as the signal handler. sigHandle will fall over + * if it tries to call the next handler in the chain. + */ + +void ProtSetup(void) +{ + handler_t next; + + /* ProtSetup is called exactly once, see design.mps.prot.if.setup */ + AVER(sigNext == NULL); + + next = signal(SIGSEGV, sigHandle); + /* should always succeed as our parameters are valid */ + AVER(next != (handler_t)-1); + + if(next == SIG_DFL) /* use the suicide function */ + sigNext = sigDefault; + else + sigNext = next; +} + + +/* ProtSet -- set the protection for a page + * + * This is just a thin veneer on top of mprotect(2). + * + * .assume.size: We asssume the type int and the type Size are the + * same size. This assumption is made in the call to mprotect. + */ + +void ProtSet(Addr base, Addr limit, AccessSet mode) +{ + int flags; + + AVER(sizeof(int) == sizeof(Size)); /* See .assume.size */ + AVER(base < limit); + AVER(base != (Addr)0); + /* we assume that the difference between limit and base (which is */ + /* positive) will fit in an int */ + AVER(AddrOffset(base, limit) <= INT_MAX); /* should be redundant */ + /* There is no AccessSetCheck, so we don't */ + + /* convert between MPS AccessSet and SunOS PROT thingies. */ + switch(mode) { + case AccessWRITE | AccessREAD: + case AccessREAD: /* forbids writes as well */ + flags = PROT_NONE; + break; + case AccessWRITE: + flags = PROT_READ | PROT_EXEC; + break; + case AccessSetEMPTY: + flags = PROT_READ | PROT_WRITE | PROT_EXEC; + break; + default: + NOTREACHED; + flags = PROT_NONE; + } + + /* 2nd arg to mprotect, .assume.size */ + if(mprotect((caddr_t)base, (int)AddrOffset(base, limit), flags) != 0) { + /* design.mps.protsu.fun.set.assume.mprotect */ + NOTREACHED; + } +} + + +/* ProtSync -- synchronize protection settings with hardware */ + +void ProtSync(Arena arena) +{ + AVERT(Arena, arena); + UNUSED(arena); + NOOP; +} + + +/* ProtTramp -- protection trampoline */ + +void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + AVER(resultReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + *resultReturn = (*f)(p, s); +} diff --git a/mps/code/protw3.c b/mps/code/protw3.c new file mode 100644 index 00000000000..f4ac6ea57f3 --- /dev/null +++ b/mps/code/protw3.c @@ -0,0 +1,137 @@ +/* impl.c.protw3: PROTECTION FOR WIN32 + * + * $HopeName: MMsrc!protw3.c(trunk.15) $ + * Copyright (C) 1995, 1997 Harlequin Group, all rights reserved + */ + +#include "mpm.h" +/* prmcw3.h needed to share MutatorFaultContextStruct declation */ +/* with impl.c.prmcw3i3 */ +#include "prmcw3.h" + +#ifndef MPS_OS_W3 +#error "protw3.c is Win32-specific, but MPS_OS_W3 is not set" +#endif +#ifndef PROTECTION +#error "protw3.c implements protection, but PROTECTION is not set" +#endif + +#include "mpswin.h" + +SRCID(protw3, "$HopeName: MMsrc!protw3.c(trunk.15) $"); + + +void ProtSetup(void) +{ + return; +} + + +void ProtSet(Addr base, Addr limit, AccessSet mode) +{ + DWORD newProtect; + DWORD oldProtect; + + AVER(sizeof(int) == sizeof(Addr)); + AVER(base < limit); + AVER(base != 0); + + newProtect = PAGE_EXECUTE_READWRITE; + if((mode & AccessWRITE) != 0) + newProtect = PAGE_EXECUTE_READ; + if((mode & AccessREAD) != 0) + newProtect = PAGE_NOACCESS; + + if(VirtualProtect((LPVOID)base, (DWORD)AddrOffset(base, limit), + newProtect, &oldProtect) == 0) + NOTREACHED; +} + + +LONG ProtSEHfilter(LPEXCEPTION_POINTERS info) +{ + LPEXCEPTION_RECORD er; + DWORD iswrite; + DWORD address; + AccessSet mode; + Addr base, limit; + LONG action; + MutatorFaultContextStruct context; + + er = info->ExceptionRecord; + + if(er->ExceptionCode != EXCEPTION_ACCESS_VIOLATION) + return EXCEPTION_CONTINUE_SEARCH; + + context.ep = info; + + /* assert that the exception is continuable */ + /* Note that Microsoft say that this field should be 0 or */ + /* EXCEPTION_NONCONTINUABLE, but this is not true */ + AVER((er->ExceptionFlags & EXCEPTION_NONCONTINUABLE) == 0); + + /* er->ExceptionRecord is pointer to next exception in chain */ + /* er->ExceptionAddress is where exception occurred */ + + AVER(er->NumberParameters >= 2); + + iswrite = er->ExceptionInformation[0]; /* 0 read; 1 write */ + AVER(iswrite == 0 || iswrite == 1); + + /* Pages cannot be made write-only, so an attempt to write must + * also cause a read-access if necessary */ + if(iswrite) + mode = AccessREAD | AccessWRITE; + else + mode = AccessREAD; + + address = er->ExceptionInformation[1]; + + base = (Addr)address; + limit = AddrAdd(address, sizeof(Addr)); + + if(base < limit) { + if(ArenaAccess(base, mode, &context)) + action = EXCEPTION_CONTINUE_EXECUTION; + else + action = EXCEPTION_CONTINUE_SEARCH; + } else { + /* Access on last sizeof(Addr) (ie 4 on this platform) bytes */ + /* in memory. We assume we can't get this page anyway (see */ + /* impl.c.vmw3.assume.not-last) so it can't be our fault. */ + action = EXCEPTION_CONTINUE_SEARCH; + } + + return action; +} + + +/* ProtSync -- synchronize protection settings with hardware + * + * This does nothing under Win32. + */ + +void ProtSync(Arena arena) +{ + UNUSED(arena); + NOOP; +} + + +void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), + void *p, size_t s) +{ + void *result = NULL; /* stop warnings about uninitialized result */ + + AVER(resultReturn != NULL); + AVER(FUNCHECK(f)); + /* Can't check p and s as they are interpreted by the client */ + + __try { + result = f(p, s); + } __except(ProtSEHfilter(GetExceptionInformation())) { + NOTREACHED; + } + + *resultReturn = result; +} diff --git a/mps/code/pthrdext.c b/mps/code/pthrdext.c new file mode 100644 index 00000000000..2651e06db36 --- /dev/null +++ b/mps/code/pthrdext.c @@ -0,0 +1,363 @@ +/* impl.c.pthreadext: POSIX THREAD EXTENSIONS + * + * $HopeName: MMsrc!pthrdext.c(trunk.2) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: Provides extension to Pthreads. + * + * .design: see design.mps.pthreadext + * + * .acknowledgements: This was derived from code posted to + * comp.programming.threads by Dave Butenhof and Raymond Lau + * (, ). + */ + + +/* open sesame magic */ +#define _BSD_SOURCE 1 +#define _POSIX_C_SOURCE 1 + +#include +#include +#include +#include +#include +#include +#include + +#include "pthrdext.h" +#include "mpm.h" + +SRCID(pthreadext, "$HopeName$"); + + +/* PTHREADEXT_SIGSUSPEND, PTHREADEXT_SIGRESUME -- signals used + * + * See design.mps.pthreadext.impl.signals + */ + +#define PTHREADEXT_SIGSUSPEND SIGXFSZ +#define PTHREADEXT_SIGRESUME SIGPWR + + +/* Static data initiatialized on first use of the module + * See design.mps.pthreadext.impl.static.* + */ + +/* mutex */ +static pthread_mutex_t pthreadextMut = PTHREAD_MUTEX_INITIALIZER; + +/* semaphore */ +static sem_t pthreadextSem; + +/* initialization support */ +static pthread_once_t pthreadextOnce = PTHREAD_ONCE_INIT; +static Bool pthreadextModuleInitialized = FALSE; + + +/* Global variables protected by the mutex + * See design.mps.pthreadext.impl.global.* + */ + +static PThreadext suspendingVictim = NULL; /* current victim */ +static RingStruct suspendedRing; /* PThreadext suspend ring */ + + +static void suspendSignalHandler(int sig, struct sigcontext scp); +static void resumeSignalHandler(int sig); + + +/* PThreadextModuleInit -- Initialize the PThreadext module + * + * See design.mps.pthreadext.impl.static.init + * + * Dynamically initialize all state when first used + * (called by pthread_once). + */ + +static void PThreadextModuleInit(void) +{ + int status; + struct sigaction pthreadext_sigsuspend, pthreadext_sigresume; + + AVER(pthreadextModuleInitialized == FALSE); + + /* Initialize the ring of suspended threads */ + RingInit(&suspendedRing); + + /* Initialize the semaphore */ + status = sem_init(&pthreadextSem, 0, 0); + AVER(status != -1); + + /* Install the signal handlers for suspend/resume. */ + /* We add PTHREADEXT_SIGRESUME to the sa_mask field for the */ + /* PTHREADEXT_SIGSUSPEND handler. That avoids a race if one thread */ + /* suspends the target while another resumes that same target. (The */ + /* PTHREADEXT_SIGRESUME signal cannot be delivered before the */ + /* target thread calls sigsuspend.) */ + + pthreadext_sigsuspend.sa_flags = 0; + pthreadext_sigsuspend.sa_handler = (__sighandler_t)suspendSignalHandler; + status = sigemptyset(&pthreadext_sigsuspend.sa_mask); + AVER(status == 0); + status = sigaddset(&pthreadext_sigsuspend.sa_mask, PTHREADEXT_SIGRESUME); + AVER(status == 0); + + pthreadext_sigresume.sa_flags = 0; + pthreadext_sigresume.sa_handler = resumeSignalHandler; + status = sigemptyset(&pthreadext_sigresume.sa_mask); + AVER(status == 0); + + status = sigaction(PTHREADEXT_SIGSUSPEND, &pthreadext_sigsuspend, NULL); + AVER(status == 0); + + status = sigaction(PTHREADEXT_SIGRESUME, &pthreadext_sigresume, NULL); + AVER(status == 0); + + pthreadextModuleInitialized = TRUE; +} + + +/* PThreadextCheck -- check the consistency of a PThreadext structure */ + +extern Bool PThreadextCheck(PThreadext pthreadext) +{ + int status; + + status = pthread_mutex_lock(&pthreadextMut); + AVER(status == 0); + + CHECKS(PThreadext, pthreadext); + /* can't check ID */ + CHECKL(RingCheck(&pthreadext->threadRing)); + CHECKL(RingCheck(&pthreadext->idRing)); + if (pthreadext->suspendedScp == NULL) { + /* not suspended */ + CHECKL(RingIsSingle(&pthreadext->threadRing)); + CHECKL(RingIsSingle(&pthreadext->idRing)); + } else { + /* suspended */ + Ring node, next; + CHECKL(!RingIsSingle(&pthreadext->threadRing)); + RING_FOR(node, &pthreadext->idRing, next) { + PThreadext pt = RING_ELT(PThreadext, idRing, node); + CHECKL(pt->id == pthreadext->id); + CHECKL(pt->suspendedScp == pthreadext->suspendedScp); + } + } + status = pthread_mutex_unlock(&pthreadextMut); + AVER(status == 0); + + return TRUE; +} + + +/* PThreadextInit -- Initialize a pthreadext */ + +extern void PThreadextInit(PThreadext pthreadext, pthread_t id) +{ + int status; + + /* The first call to init will initialize the package. */ + status = pthread_once(&pthreadextOnce, PThreadextModuleInit); + AVER(status == 0); + + pthreadext->id = id; + pthreadext->suspendedScp = NULL; + RingInit(&pthreadext->threadRing); + RingInit(&pthreadext->idRing); + pthreadext->sig = PThreadextSig; + AVERT(PThreadext, pthreadext); +} + + +/* PThreadextFinish -- Finish a pthreadext + * + * See design.mps.pthreadext.impl.finish + */ + +extern void PThreadextFinish(PThreadext pthreadext) +{ + int status; + + AVERT(PThreadext, pthreadext); + + status = pthread_mutex_lock(&pthreadextMut); + AVER(status == 0); + + if(pthreadext->suspendedScp == NULL) { + AVER(RingIsSingle(&pthreadext->threadRing)); + AVER(RingIsSingle(&pthreadext->idRing)); + } else { + /* In suspended state: remove from rings. */ + AVER(!RingIsSingle(&pthreadext->threadRing)); + RingRemove(&pthreadext->threadRing); + if(!RingIsSingle(&pthreadext->idRing)) + RingRemove(&pthreadext->idRing); + } + + status = pthread_mutex_unlock(&pthreadextMut); + AVER(status == 0); + + RingFinish(&pthreadext->threadRing); + RingFinish(&pthreadext->idRing); + pthreadext->sig = SigInvalid; +} + + +/* suspendSignalHandler -- signal handler called when suspending a thread + * + * See design.mps.pthreadext.impl.suspend-handler + * + * The interface for determining the sigcontext might be platform specific. + * + * Handle PTHREADEXT_SIGSUSPEND in the target thread, to suspend it until + * receiving PTHREADEXT_SIGRESUME (resume). Note that this is run with both + * PTHREADEXT_SIGSUSPEND and PTHREADEXT_SIGRESUME blocked. Having + * PTHREADEXT_SIGRESUME blocked prevents a resume before we can finish the + * suspend protocol. + */ + +static void suspendSignalHandler(int sig, struct sigcontext scp) +{ + sigset_t signal_set; + + AVER(sig == PTHREADEXT_SIGSUSPEND); + UNUSED(sig); + + /* Tell caller about the sigcontext. */ + AVER(suspendingVictim != NULL); + suspendingVictim->suspendedScp = &scp; + + /* Block all signals except PTHREADEXT_SIGRESUME while suspended. */ + sigfillset(&signal_set); + sigdelset(&signal_set, PTHREADEXT_SIGRESUME); + sem_post(&pthreadextSem); + sigsuspend(&signal_set); + + /* Once here, the resume signal handler has run to completion. */ + return; +} + + +/* resumeSignalHandler -- signal handler called when resuming a thread + * + * See design.mps.pthreadext.impl.suspend-handler + */ + +static void resumeSignalHandler(int sig) +{ + AVER(sig == PTHREADEXT_SIGRESUME); + UNUSED(sig); + return; +} + + +/* PThreadextSuspend -- suspend a thread + * + * See design.mps.pthreadext.impl.suspend + */ + +Res PThreadextSuspend(PThreadext target, struct sigcontext **contextReturn) +{ + Ring node, next; + Res res; + int status; + + AVERT(PThreadext, target); + AVER(contextReturn != NULL); + AVER(target->suspendedScp == NULL); /* multiple suspends illegal */ + + /* Serialize access to suspend, makes life easier */ + status = pthread_mutex_lock(&pthreadextMut); + AVER(status == 0); + AVER(suspendingVictim == NULL); + + /* Threads are added to the suspended ring on suspension */ + /* If the same thread Id has already been suspended, then */ + /* don't signal the thread, just add the target onto the id ring */ + RING_FOR(node, &suspendedRing, next) { + PThreadext alreadySusp = RING_ELT(PThreadext, threadRing, node); + if (alreadySusp->id == target->id) { + RingAppend(&alreadySusp->idRing, &target->idRing); + target->suspendedScp = alreadySusp->suspendedScp; + goto noteSuspended; + } + } + + /* Ok, we really need to suspend this thread. */ + suspendingVictim = target; + status = pthread_kill(target->id, PTHREADEXT_SIGSUSPEND); + if (status != 0) { + res = ResFAIL; + goto unlock; + } + + /* Wait for the victim to acknowledge suspension. */ + while (sem_wait(&pthreadextSem) != 0) { + if (errno != EINTR) { + res = ResFAIL; + goto unlock; + } + } + +noteSuspended: + AVER(target->suspendedScp != NULL); + RingAppend(&suspendedRing, &target->threadRing); + *contextReturn = target->suspendedScp; + res = ResOK; + +unlock: + suspendingVictim = NULL; + status = pthread_mutex_unlock(&pthreadextMut); + AVER(status == 0); + return res; +} + + +/* PThreadextResume -- resume a suspended thread + * + * See design.mps.pthreadext.impl.resume + */ + +Res PThreadextResume(PThreadext target) +{ + Res res; + int status; + + AVERT(PThreadext, target); + AVER(pthreadextModuleInitialized); /* must have been a prior suspend */ + AVER(target->suspendedScp != NULL); + + /* Serialize access to suspend, makes life easier. */ + status = pthread_mutex_lock(&pthreadextMut); + AVER(status == 0); + + if (RingIsSingle(&target->idRing)) { + /* Really want to resume the thread. Signal it to continue. */ + status = pthread_kill(target->id, PTHREADEXT_SIGRESUME); + if (status == 0) { + goto noteResumed; + } else { + res = ResFAIL; + goto unlock; + } + + } else { + /* Leave thread suspended on behalf of another PThreadext. */ + /* Remove it from the id ring */ + RingRemove(&target->idRing); + goto noteResumed; + } + +noteResumed: + /* Remove the thread from the suspended ring */ + RingRemove(&target->threadRing); + target->suspendedScp = NULL; + res = ResOK; + +unlock: + status = pthread_mutex_unlock(&pthreadextMut); + AVER(status == 0); + return res; +} diff --git a/mps/code/pthrdext.h b/mps/code/pthrdext.h new file mode 100644 index 00000000000..4ec4daa99f9 --- /dev/null +++ b/mps/code/pthrdext.h @@ -0,0 +1,68 @@ +/* impl.h.pthreadext: POSIX THREAD EXTENSIONS + * + * $HopeName: $ + * Copyright (C) 2000 Harlequin Ltd, all rights reserved + * + * .readership: MM developers. + * + * .purpose: Provides extension to Pthreads. + */ + +#ifndef pthreadext_h +#define pthreadext_h + +#include + +#include "mpm.h" + + +#define PThreadextSig ((Sig)0x519B286E) /* SIGnature PTHReadExt */ + + +/* PThreadext -- extension datatype */ + +typedef struct PThreadextStruct *PThreadext; + + +/* PThreadextStruct -- structure definition + * + * Should be embedded in a client structure + */ + +typedef struct PThreadextStruct { + Sig sig; /* design.mps.sig */ + pthread_t id; /* Thread ID */ + struct sigcontext *suspendedScp; /* sigcontext if suspended */ + RingStruct threadRing; /* ring of suspended threads */ + RingStruct idRing; /* duplicate suspensions for id */ +} PThreadextStruct; + + + +/* PThreadextCheck -- Check a pthreadext */ + +extern Bool PThreadextCheck(PThreadext pthreadext); + + +/* PThreadextInit -- Initialize a pthreadext */ + +extern void PThreadextInit(PThreadext pthreadext, pthread_t id); + + +/* PThreadextFinish -- Finish a pthreadext */ + +extern void PThreadextFinish(PThreadext pthreadext); + + +/* PThreadextSuspend -- Suspend a pthreadext and return its context. */ + +extern Res PThreadextSuspend(PThreadext pthreadext, + struct sigcontext **contextReturn); + + +/* PThreadextResume -- Resume a suspended pthreadext */ + +extern Res PThreadextResume(PThreadext pthreadext); + + +#endif /* pthreadext_h */ diff --git a/mps/code/qs.c b/mps/code/qs.c new file mode 100644 index 00000000000..3e4c6f81f3b --- /dev/null +++ b/mps/code/qs.c @@ -0,0 +1,519 @@ +/* impl.c.qs: QUICKSORT + * + * $HopeName: MMsrc!qs.c(trunk.17) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * The purpose of this program is to act as a "real" client of the MM. + * It is a test, but (hopefully) less contrived than some of the other + * tests. + * + * C stack will contain the continuations (list of PCs). The + * activation stack will parallel the C stack and contain the program's + * variables. This is all slightly bizarre. + * And qs cheats a tiny bit by using the C stack to save leaf objects + * (integers). + * + * nil, the end of list, is represented by a NULL pointer. + * + * list length 1000 makes 40404 conses (by experiment). + * + * Some registers are not nulled out when they could be. + */ + +#include "testlib.h" +#include "mps.h" +#include "mpsavm.h" +#include "mpscamc.h" +#include "mpscmv.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include + + +#define testArenaSIZE ((size_t)1000*1024) +#define genCOUNT 2 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +static mps_res_t scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit); +static mps_addr_t skip(mps_addr_t object); +static void move(mps_addr_t object, mps_addr_t to); +static mps_addr_t isMoved(mps_addr_t object); +static void copy(mps_addr_t object, mps_addr_t to); +static void pad(mps_addr_t base, size_t size); + +struct mps_fmt_A_s fmt_A_s = + { + (mps_align_t)4, + scan, skip, copy, + move, isMoved, + pad + }; + + + +/* Tags used by object format */ +enum {QSInt, QSRef, QSEvac, QSPadOne, QSPadMany}; + +typedef struct QSCellStruct *QSCell; +typedef struct QSCellStruct { + mps_word_t tag; + mps_word_t value; + QSCell tail; +} QSCellStruct; + + +static mps_arena_t arena; +static mps_pool_t pool; /* automatic pool */ +static mps_ap_t ap; /* AP for above */ +static mps_pool_t mpool; /* manual pool */ +static mps_root_t regroot; +static mps_root_t actroot; + + +/* list holds an array that we qsort(), listl is its length */ +static mps_word_t *list; +static mps_word_t listl; + + +/* Machine State + * + * The machine consists of a stack and 3 registers. + */ + +static QSCell activationStack; +#define NREGS 3 +static mps_word_t reg[NREGS]; +static mps_word_t regtag[NREGS]; + + +/* Machine Instructions + * + * The machine can perform the following operations: + * cons + * append + * swap + */ + +/* should cons return in reg[0] or should it return via C? */ +static void cons(mps_word_t tag0, mps_word_t value0, QSCell tail) +{ + mps_addr_t p; + QSCell new; + + do { + die(mps_reserve(&p, ap, sizeof(QSCellStruct)), + "cons"); + new = (QSCell)p; + new->tag = tag0; + new->value = value0; + new->tail = tail; + } while(!mps_commit(ap, p, sizeof(QSCellStruct))); + + reg[0] = (mps_word_t)new; + regtag[0] = QSRef; + return; +} + + +/* Appends reg[1] to reg[0] */ +/* append nil, y = y + * append x::xs, y = x::append xs, y + * append x,y = (if (null x) y (cons (car x) (append (cdr x) y))) + */ +static void append(void) +{ + cdie(regtag[0] == QSRef, "append 0"); + cdie(regtag[1] == QSRef, "append 1"); + + if(reg[0] == (mps_word_t)0) { + reg[0] = reg[1]; + regtag[0] = regtag[1]; + goto ret; + } + + cons(regtag[0], reg[0], activationStack); + activationStack = (QSCell)reg[0]; + cons(regtag[1], reg[1], activationStack); + activationStack = (QSCell)reg[0]; + + reg[0] = activationStack->tail->value; + regtag[0] = activationStack->tail->tag; + cdie(regtag[0] == QSRef, "append tail"); + reg[0] = (mps_word_t)((QSCell)reg[0])->tail; /* (cdr x) */ + regtag[0] = QSRef; + append(); + reg[1] = reg[0]; + regtag[1] = regtag[0]; + reg[0] = activationStack->tail->value; + regtag[0] = activationStack->tail->tag; + cdie(regtag[0] == QSRef, "append sec"); + regtag[0] = ((QSCell)reg[0])->tag; + reg[0] = ((QSCell)reg[0])->value; /* (car x) */ + cons(regtag[0], reg[0], (QSCell)reg[1]); + activationStack = activationStack->tail->tail; + + ret: + /* null out reg[1] */ + regtag[1] = QSRef; + reg[1] = (mps_word_t)0; + return; +} + + +/* swaps reg[0] with reg[1], destroys reg[2] */ +static void swap(void) +{ + regtag[2]=regtag[0]; + reg[2]=reg[0]; + regtag[0]=regtag[1]; + reg[0]=reg[1]; + regtag[1]=regtag[2]; + reg[1]=reg[2]; + regtag[2]=QSRef; + reg[2]=(mps_word_t)0; +} + + +static void makerndlist(int l) +{ + int i; + mps_word_t r; + + cdie(l > 0, "list len"); + if(list != NULL) { + mps_free(mpool, (mps_addr_t)list, (listl * sizeof(mps_word_t))); + list = NULL; + } + listl = l; + die(mps_alloc((mps_addr_t *)&list, mpool, (l * sizeof(mps_word_t))), + "Alloc List"); + reg[0] = (mps_word_t)0; + regtag[0] = QSRef; + for(i = 0; i < l; ++i) { + r = rnd(); + cons(QSInt, r, (QSCell)reg[0]); + list[i] = r; + } +} + + +/* reg[0] is split into two lists: those elements less than p, and + * those elements >= p. The two lists are returned in reg[0] and reg[1] + */ +static void part(mps_word_t p) +{ + regtag[2]=regtag[0]; + reg[2]=reg[0]; + cdie(regtag[2] == QSRef, "part 0"); + regtag[0]=QSRef; + reg[0]=(mps_word_t)0; + regtag[1]=QSRef; + reg[1]=(mps_word_t)0; + + while(reg[2] != (mps_word_t)0) { + cdie(((QSCell)reg[2])->tag == QSInt, "part int"); + if(((QSCell)reg[2])->value < p) { + /* cons onto reg[0] */ + cons(QSInt, ((QSCell)reg[2])->value, (QSCell)reg[0]); + } else { + /* cons onto reg[1] */ + cons(QSRef, (mps_word_t)reg[0], activationStack); /* save reg0 */ + activationStack = (QSCell)reg[0]; + cons(QSInt, ((QSCell)reg[2])->value, (QSCell)reg[1]); + reg[1]=reg[0]; + reg[0]=activationStack->value; + activationStack = activationStack->tail; + } + reg[2]=(mps_word_t)((QSCell)reg[2])->tail; + } +} + + +/* applies the quicksort algorithm to sort reg[0] */ +static void qs(void) +{ + mps_word_t pivot; + + cdie(regtag[0] == QSRef, "qs 0"); + + /* base case */ + if(reg[0] == (mps_word_t)0) { + return; + } + + /* check that we have an int list */ + cdie(((QSCell)reg[0])->tag == QSInt, "qs int"); + + pivot = ((QSCell)reg[0])->value; + reg[0] = (mps_word_t)((QSCell)reg[0])->tail; + part(pivot); + + cons(QSRef, reg[0], activationStack); + activationStack = (QSCell)reg[0]; + cons(QSRef, reg[1], activationStack); + activationStack = (QSCell)reg[0]; + + reg[0] = reg[1]; + regtag[0] = regtag[1]; + cdie(regtag[0] == QSRef, "qs 1"); + qs(); + cons(QSInt, pivot, (QSCell)reg[0]); + activationStack = activationStack->tail; + cons(QSRef, (mps_word_t)reg[0], activationStack); + activationStack = (QSCell)reg[0]; + reg[0] = activationStack->tail->value; + regtag[0] = activationStack->tail->tag; + cdie(regtag[0] == QSRef, "qs tail"); + qs(); + reg[1] = activationStack->value; + regtag[1] = activationStack->tag; + activationStack = activationStack->tail->tail; + append(); +} + + +/* Compare + * + * Used as an argument to qsort() + */ +static int compare(const void *a, const void *b) +{ + mps_word_t aa, bb; + + aa = *(const mps_word_t *)a; + bb = *(const mps_word_t *)b; + if(aa < bb) { + return -1; + } else if(aa == bb) { + return 0; + } else { + return 1; + } +} + + +/* compares the qsort'ed list with our quicksorted list */ +static void validate(void) +{ + mps_word_t i; + + cdie(regtag[0] == QSRef, "validate 0"); + regtag[1] = regtag[0]; + reg[1] = reg[0]; + for(i = 0; i < listl; ++i) { + cdie(((QSCell)reg[1])->tag == QSInt, "validate int"); + if(((QSCell)reg[1])->value != list[i]) { + fprintf(stdout, + "mps_res_t: Element %lu of the two lists do not match.\n", + (unsigned long)i); + return; + } + reg[1] = (mps_word_t)((QSCell)reg[1])->tail; + } + cdie(reg[1] == (mps_word_t)0, "validate end"); + fprintf(stdout, "Note: Lists compare equal.\n"); +} + + +static void *go(void *p, size_t s) +{ + mps_fmt_t format; + mps_chain_t chain; + + testlib_unused(p); + testlib_unused(s); + + die(mps_pool_create(&mpool, arena, mps_class_mv(), + (size_t)65536, sizeof(QSCellStruct) * 1000, + (size_t)65536), + "MVCreate"); + die(mps_fmt_create_A(&format, arena, &fmt_A_s), "FormatCreate"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + die(mps_pool_create(&pool, arena, mps_class_amc(), format, chain), + "AMCCreate"); + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "APCreate"); + die(mps_root_create_table(®root, arena, MPS_RANK_AMBIG, 0, + (mps_addr_t *)reg, NREGS), + "RootCreateTable"); + die(mps_root_create_table(&actroot, arena, MPS_RANK_AMBIG, 0, + (mps_addr_t *)&activationStack, sizeof(QSCell)/sizeof(mps_addr_t)), + "RootCreateTable"); + + /* makes a random list */ + makerndlist(1000); + + part(0); + swap(); + qs(); + qsort(list, listl, sizeof(mps_word_t), &compare); + validate(); + + mps_root_destroy(regroot); + mps_root_destroy(actroot); + mps_ap_destroy(ap); + mps_pool_destroy(pool); + mps_pool_destroy(mpool); + mps_chain_destroy(chain); + mps_fmt_destroy(format); + + return NULL; +} + + +/* Machine Object Format */ + +static void pad(mps_addr_t base, size_t size) +{ + mps_word_t *object = base; + cdie(size >= sizeof(mps_word_t), "pad size"); + if(size == sizeof(mps_word_t)) { + object[0] = QSPadOne; + return; + } + cdie(size >= 2*sizeof(mps_word_t), "pad size 2"); + object[0] = QSPadMany; + object[1] = size; + return; +} + + +static mps_res_t scan1(mps_ss_t ss, mps_addr_t *objectIO) +{ + QSCell cell; + mps_res_t res; + + cdie(objectIO != NULL, "objectIO"); + + MPS_SCAN_BEGIN(ss) { + cell = (QSCell)*objectIO; + + switch(cell->tag) { + case QSRef: + if(!MPS_FIX1(ss, (mps_addr_t)cell->value)) + goto fixTail; + res = MPS_FIX2(ss, (mps_addr_t *)&cell->value); + if(res != MPS_RES_OK) + return res; + /* fall */ + + case QSInt: + fixTail: + if(!MPS_FIX1(ss, (mps_addr_t)cell->tail)) + break; + res = MPS_FIX2(ss, (mps_addr_t *)&cell->tail); + if(res != MPS_RES_OK) + return res; + break; + + case QSEvac: + /* skip */ + break; + + case QSPadOne: + *objectIO = (mps_addr_t)((mps_word_t *)cell+1); + return MPS_RES_OK; + + case QSPadMany: + *objectIO = (mps_addr_t)((mps_word_t)cell+((mps_word_t *)cell)[1]); + return MPS_RES_OK; + + default: + cdie(0, "unknown tag"); + return MPS_RES_OK; + } + } MPS_SCAN_END(ss); + + *objectIO = (mps_addr_t)(cell+1); + + return MPS_RES_OK; +} + + +static mps_res_t scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit) +{ + while(base < limit) { + mps_res_t res; + + res = scan1(ss, &base); + if(res != MPS_RES_OK) { + return res; + } + } + + cdie(base == limit, "scan limit"); + return MPS_RES_OK; +} + + +static mps_addr_t skip(mps_addr_t object) +{ + QSCell cell = (QSCell)object; + switch(cell->tag) + { + case QSPadOne: + return (mps_addr_t)((mps_word_t *)cell+1); + case QSPadMany: + return (mps_addr_t)((mps_word_t)cell+((mps_word_t *)cell)[1]); + default: + return (mps_addr_t)((QSCell)object + 1); + } +} + + +static void move(mps_addr_t object, mps_addr_t to) +{ + QSCell cell; + + cell = (QSCell)object; + + cell->tag = QSEvac; + cell->value = (mps_word_t)to; +} + + +static mps_addr_t isMoved(mps_addr_t object) +{ + QSCell cell; + + cell = (QSCell)object; + + if(cell->tag == QSEvac) { + return (mps_addr_t)cell->value; + } + return (mps_addr_t)0; +} + + +static void copy(mps_addr_t object, mps_addr_t to) +{ + QSCell cells, celld; + + cells = (QSCell)object; + celld = (QSCell)to; + + *celld = *cells; +} + + +int main(int argc, char **argv) +{ + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "mps_arena_create"); + mps_tramp(&r, &go, NULL, 0); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/ref.c b/mps/code/ref.c new file mode 100644 index 00000000000..8614cd5b451 --- /dev/null +++ b/mps/code/ref.c @@ -0,0 +1,81 @@ +/* impl.c.ref: REFERENCES + * + * $HopeName: MMsrc!ref.c(trunk.12) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .purpose: Implement operations on Ref, RefSet, ZoneSet, and Rank. + * + * .design: See design.mps.ref and design.mps.refset. + */ + +#include "mpm.h" + +SRCID(ref, "$HopeName: MMsrc!ref.c(trunk.12) $"); + + +/* RankCheck -- check a rank value */ + +Bool RankCheck(Rank rank) +{ + CHECKL(rank < RankLIMIT); + UNUSED(rank); /* impl.c.mpm.check.unused */ + return TRUE; +} + + +/* RankSetCheck -- check a rank set */ + +Bool RankSetCheck(RankSet rankSet) +{ + CHECKL(rankSet < (1uL << RankLIMIT)); + UNUSED(rankSet); /* impl.c.mpm.check.unused */ + return TRUE; +} + + +/* ZoneSetOfRange -- calculate the zone set of a range of addresses */ + +RefSet ZoneSetOfRange(Arena arena, Addr base, Addr limit) +{ + Word zbase, zlimit; + + AVERT(Arena, arena); + AVER(limit > base); + + /* The base and limit zones of the range are calculated. The limit */ + /* zone is the zone after the last zone of the range, not the zone of */ + /* the limit address. */ + zbase = (Word)base >> arena->zoneShift; + zlimit = (((Word)limit-1) >> arena->zoneShift) + 1; + + + /* If the range is large enough to span all zones, its zone set is */ + /* universal. */ + if (zlimit - zbase >= MPS_WORD_WIDTH) + return ZoneSetUNIV; + + zbase &= MPS_WORD_WIDTH - 1; + zlimit &= MPS_WORD_WIDTH - 1; + + /* If the base zone is less than the limit zone, the zone set looks */ + /* like 000111100, otherwise it looks like 111000011. */ + if (zbase < zlimit) + return ((ZoneSet)1< /* for size_t */ +#include /* for printf */ +#include /* for va_list */ +#include /* for EXIT_FAILURE */ +#include /* for strcmp */ +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif + + +typedef unsigned long ulong; + + +/* command-line arguments */ + +static Bool partialLog = FALSE; + +static char *prog; /* program name */ + + +/* Globals */ + +static Word eventTime = 0; /* current event time */ + + +/* error -- error signalling */ + +static void error(const char *format, ...) +{ + va_list args; + + fflush(stdout); /* sync */ + fprintf(stderr, "%s: @%lu ", prog, (ulong)eventTime); + va_start(args, format); + vfprintf(stderr, format, args); + fprintf(stderr, "\n"); + va_end(args); + exit(EXIT_FAILURE); +} + + +/* usage -- usage message */ + +static void usage(void) +{ + fprintf(stderr, + "Usage: %s [-f logfile] [-p] [-?]\n" + "See guide.mps.telemetry for instructions.\n", + prog); +} + + +/* usageError -- explain usage and error */ + +static void usageError(void) +{ + usage(); + error("Bad usage"); +} + + +/* parseArgs -- parse command line arguments, return log file name */ + +static char *parseArgs(int argc, char *argv[]) +{ + char *name = "mpsio.log"; + int i = 1; + + if (argc >= 1) + prog = argv[0]; + else + prog = "unknown"; + + while (i < argc) { /* consider argument i */ + if (argv[i][0] == '-') { /* it's an option argument */ + switch (argv[i][1]) { + case 'f': /* file name */ + ++ i; + if (i == argc) + usageError(); + else + name = argv[i]; + break; + case 'p': /* partial log */ + partialLog = TRUE; + break; + case '?': case 'h': /* help */ + usage(); + break; + default: + usageError(); + } + } /* if option */ + ++ i; + } + return name; +} + + +/* readLog -- read and parse log */ + + +static void readLog(EventProc proc) +{ + while (TRUE) { + Event event; + Res res; + + res = EventRead(&event, proc); + if (res == ResFAIL) break; /* eof */ + if (res != ResOK) error("Truncated log"); + eventTime = event->any.clock; + EventRecord(proc, event, eventTime); + EventReplay(event, eventTime); + EventDestroy(proc, event); + } +} + + +/* logReader -- reader function for a file log */ + +static FILE *input; + +static Res logReader(void *file, void *p, size_t len) +{ + size_t n; + + n = fread(p, 1, len, (FILE *)file); + return (n < len) ? (feof((FILE *)file) ? ResFAIL : ResIO) : ResOK; +} + + +/* main */ + +int main(int argc, char *argv[]) +{ + char *filename; + EventProc proc; + Res res; + + filename = parseArgs(argc,argv); + + if (strcmp(filename, "-") == 0) + input = stdin; + else { + input = fopen(filename, "rb"); + if (input == NULL) + error("unable to open \"%s\"\n", filename); + } + + res = EventProcCreate(&proc, partialLog, logReader, (void *)input); + if (res != ResOK) + error("Can't init EventProc module: error %d.", res); + + res = EventRepInit(partialLog); + if (res != ResOK) + error("Can't init EventRep module: error %d.", res); + + readLog(proc); + + EventRepFinish(); + EventProcDestroy(proc); + return EXIT_SUCCESS; +} diff --git a/mps/code/reserv.c b/mps/code/reserv.c new file mode 100644 index 00000000000..77fcc831baf --- /dev/null +++ b/mps/code/reserv.c @@ -0,0 +1,407 @@ +/* impl.c.reserv: ARENA RESERVOIR + * + * $HopeName: MMsrc!reserv.c(trunk.5) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * IMPROVEMENTS + * + * .improve.contiguous: There should be a means of grouping contiguous + * tracts together so that there's a likelihood of being able to meet + * requests for regions larger than the arena alignment. */ + +#include "mpm.h" + +SRCID(reserv, "$HopeName: MMsrc!reserv.c(trunk.5) $"); + + +/* The reservoir pool is defined here. See design.mps.reservoir */ + +#define Pool2Reservoir(pool) PARENT(ReservoirStruct, poolStruct, pool) + + +/* Management of tracts + * + * The reservoir maintains a linked list of tracts in arbitrary order. + * (see .improve.contiguous) + * + * Tracts are chained using the TractP field. */ + +#define resTractNext(tract) ((Tract)TractP((tract))) +#define resTractSetNext(tract, next) (TractSetP((tract), (void*)(next))) + + +#define reservoirArena(reservoir) ((reservoir)->poolStruct.arena) + + +/* ResPoolInit -- Reservoir pool init method */ + +static Res ResPoolInit(Pool pool, va_list arg) +{ + AVER(pool != NULL); + + UNUSED(arg); + /* Caller will set sig and AVERT. */ + EVENT_PPP(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); + return ResOK; +} + + +/* ResPoolFinish -- Reservoir pool finish method + * + * .reservoir.finish: This might be called from ArenaFinish, so the + * arena cannot be checked at this time. In order to avoid the check, + * insist that the reservoir is empty, by AVERing that the reserve list + * is NULL. */ + +static void ResPoolFinish(Pool pool) +{ + Reservoir reservoir; + + AVERT(Pool, pool); + reservoir = Pool2Reservoir(pool); + AVERT(Reservoir, reservoir); + AVER(reservoir->reserve == NULL); /* .reservoir.finish */ +} + + +/* ReservoirPoolClass -- Class definition */ + +DEFINE_POOL_CLASS(ReservoirPoolClass, this) +{ + INHERIT_CLASS(this, AbstractPoolClass); + this->name = "Reservoir"; + this->size = sizeof(ReservoirStruct); + this->offset = offsetof(ReservoirStruct, poolStruct); + this->init = ResPoolInit; + this->finish = ResPoolFinish; +} + + +/* ReservoirCheck -- Reservoir check method */ + +Bool ReservoirCheck(Reservoir reservoir) +{ + ReservoirPoolClass reservoircl = EnsureReservoirPoolClass(); + Arena arena; + Tract tract; + + CHECKS(Reservoir, reservoir); + CHECKD(Pool, &reservoir->poolStruct); + CHECKL(reservoir->poolStruct.class == reservoircl); + UNUSED(reservoircl); /* impl.c.mpm.check.unused */ + arena = reservoirArena(reservoir); + CHECKU(Arena, arena); + /* could call ReservoirIsConsistent, but it's costly. */ + tract = reservoir->reserve; + if (tract != NULL) { + CHECKL(TractCheck(tract)); + CHECKL(TractPool(tract) == &reservoir->poolStruct); + } + CHECKL(SizeIsAligned(reservoir->reservoirLimit, ArenaAlign(arena))); + CHECKL(SizeIsAligned(reservoir->reservoirSize, ArenaAlign(arena))); + + return TRUE; +} + + +/* reservoirIsConsistent -- returns FALSE if the reservoir is corrupt */ + +static Bool reservoirIsConsistent(Reservoir reservoir) +{ + Size alignment, size = 0; + Tract tract; + Pool pool; + Arena arena; + + arena = reservoirArena(reservoir); + pool = &reservoir->poolStruct; + + /* Check that the size of the tracts matches reservoirSize */ + alignment = ArenaAlign(arena); + tract = reservoir->reserve; + while (tract != NULL) { + AVERT(Tract, tract); + AVER(TractPool(tract) == pool); + tract = resTractNext(tract); + size += alignment; + } + + if (size != reservoir->reservoirSize) + return FALSE; + + /* design.mps.reservoir.align */ + return SizeIsAligned(reservoir->reservoirLimit, alignment) + && SizeIsAligned(reservoir->reservoirSize, alignment) + && (reservoir->reservoirLimit >= reservoir->reservoirSize); +} + + +/* ReservoirEnsureFull + * + * Ensures that the reservoir is the right size, by topping it up with + * fresh memory from the arena if possible. */ + +Res ReservoirEnsureFull(Reservoir reservoir) +{ + Size limit, alignment; + Pool pool; + Arena arena; + AVERT(Reservoir, reservoir); + arena = reservoirArena(reservoir); + + AVERT(Arena, arena); + alignment = ArenaAlign(arena); + limit = reservoir->reservoirLimit; + + /* optimize the common case of a full reservoir */ + if (reservoir->reservoirSize == limit) + return ResOK; + + pool = &reservoir->poolStruct; + + /* really ought to try hard to allocate contiguous tracts */ + /* see .improve.contiguous */ + while (reservoir->reservoirSize < limit) { + Res res; + Addr base; + Tract tract; + res = (*arena->class->alloc)(&base, &tract, SegPrefDefault(), + alignment, pool); + if (res != ResOK) { + AVER(reservoirIsConsistent(reservoir)); + return res; + } + reservoir->reservoirSize += alignment; + resTractSetNext(tract, reservoir->reserve); + reservoir->reserve = tract; + } + AVER(reservoirIsConsistent(reservoir)); + return ResOK; +} + + +/* reservoirShrink -- Reduce the size of the reservoir */ + +static void reservoirShrink(Reservoir reservoir, Size want) +{ + Arena arena; + Pool pool; + Size alignment; + + pool = &reservoir->poolStruct; + arena = reservoirArena(reservoir); + AVER(SizeIsAligned(want, ArenaAlign(arena))); + AVER(reservoir->reservoirSize >= want); + + if (reservoir->reservoirSize == want) + return; + + /* Iterate over tracts, freeing them while reservoir is too big */ + alignment = ArenaAlign(arena); + while (reservoir->reservoirSize > want) { + Tract tract = reservoir->reserve; + AVER(tract != NULL); + reservoir->reserve = resTractNext(tract); + (*arena->class->free)(TractBase(tract), alignment, pool); + reservoir->reservoirSize -= alignment; + } + AVER(reservoir->reservoirSize == want); + AVER(reservoirIsConsistent(reservoir)); +} + + +/* ReservoirWithdraw -- Attempt to supply memory from the reservoir */ + +Res ReservoirWithdraw(Addr *baseReturn, Tract *baseTractReturn, + Reservoir reservoir, Size size, Pool pool) +{ + Pool respool; + Arena arena; + + AVER(baseReturn != NULL); + AVER(baseTractReturn != NULL); + AVERT(Reservoir, reservoir); + arena = reservoirArena(reservoir); + AVERT(Arena, arena); + AVER(SizeIsAligned(size, ArenaAlign(arena))); + AVER(size > 0); + AVERT(Pool, pool); + respool = &reservoir->poolStruct; + + /* @@@@ As a short-term measure, we only permit the reservoir to */ + /* allocate single-page regions. */ + /* See .improve.contiguous & change.dylan.jackdaw.160125 */ + if (size != ArenaAlign(arena)) + return ResMEMORY; + + if (size <= reservoir->reservoirSize) { + /* Return the first tract */ + Tract tract = reservoir->reserve; + Addr base; + AVER(tract != NULL); + base = TractBase(tract); + reservoir->reserve = resTractNext(tract); + reservoir->reservoirSize -= ArenaAlign(arena); + TractFinish(tract); + TractInit(tract, pool, base); + AVER(reservoirIsConsistent(reservoir)); + *baseReturn = base; + *baseTractReturn = tract; + return ResOK; + } + + AVER(reservoirIsConsistent(reservoir)); + return ResMEMORY; /* no suitable region in the reservoir */ +} + + +/* ReservoirDeposit -- Top up the reservoir */ + +void ReservoirDeposit(Reservoir reservoir, Addr base, Size size) +{ + Pool respool; + Addr addr, limit; + Size reslimit, alignment; + Arena arena; + Tract tract; + + AVERT(Reservoir, reservoir); + arena = reservoirArena(reservoir); + AVERT(Arena, arena); + respool = &reservoir->poolStruct; + alignment = ArenaAlign(arena); + AVER(AddrIsAligned(base, alignment)); + AVER(SizeIsAligned(size, alignment)); + limit = AddrAdd(base, size); + reslimit = reservoir->reservoirLimit; + + /* put as many pages as necessary into the reserve & free the rest */ + TRACT_FOR(tract, addr, arena, base, limit) { + AVER(TractCheck(tract)); + if (reservoir->reservoirSize < reslimit) { + /* Reassign the tract to the reservoir pool */ + TractFinish(tract); + TractInit(tract, respool, addr); + reservoir->reservoirSize += alignment; + resTractSetNext(tract, reservoir->reserve); + reservoir->reserve = tract; + } else { + /* free the tract */ + (*arena->class->free)(addr, alignment, TractPool(tract)); + } + } + AVER(addr == limit); + AVER(reservoirIsConsistent(reservoir)); +} + + +/* mutatorBufferCount -- returns the number of mutator buffers for the arena + * + * This should probably be in the pool module, but it's only used here. */ + +static Count mutatorBufferCount(Globals arena) +{ + Ring nodep, nextp; + Count count = 0; + + /* Iterate over all pools, and count the mutator buffers in each */ + RING_FOR(nodep, &arena->poolRing, nextp) { + Pool pool = RING_ELT(Pool, arenaRing, nodep); + Ring nodeb, nextb; + + AVERT(Pool, pool); + RING_FOR(nodeb, &pool->bufferRing, nextb) { + Buffer buff = RING_ELT(Buffer, poolRing, nodeb); + if (buff->isMutator) + count++; + } + } + return count; +} + + +/* ReservoirSetLimit -- Set the reservoir limit */ + +void ReservoirSetLimit(Reservoir reservoir, Size size) +{ + Size needed; + Arena arena; + AVERT(Reservoir, reservoir); + arena = reservoirArena(reservoir); + AVERT(Arena, arena); + + if (size > 0) { + Size wastage; + /* design.mps.reservoir.wastage */ + wastage = ArenaAlign(arena) * mutatorBufferCount(ArenaGlobals(arena)); + /* design.mps.reservoir.align */ + needed = SizeAlignUp(size, ArenaAlign(arena)) + wastage; + } else { + needed = 0; /* design.mps.reservoir.really-empty */ + } + + AVER(SizeIsAligned(needed, ArenaAlign(arena))); + /* Emit event now, so subsequent change can be ascribed to it. */ + EVENT_PW(ReservoirLimitSet, arena, size); + + if (needed > reservoir->reservoirSize) { + /* Try to grow the reservoir */ + reservoir->reservoirLimit = needed; + ReservoirEnsureFull(reservoir); + } else { + /* Shrink the reservoir */ + reservoirShrink(reservoir, needed); + reservoir->reservoirLimit = needed; + AVER(reservoirIsConsistent(reservoir)); + } +} + + +/* ReservoirLimit -- Return the reservoir limit */ + +Size ReservoirLimit(Reservoir reservoir) +{ + AVERT(Reservoir, reservoir); + AVER(reservoirIsConsistent(reservoir)); + return reservoir->reservoirLimit; +} + + +/* ReservoirAvailable -- Return the amount in the reservoir */ + +Size ReservoirAvailable(Reservoir reservoir) +{ + AVERT(Reservoir, reservoir); + ReservoirEnsureFull(reservoir); + return reservoir->reservoirSize; +} + + +/* ReservoirInit -- Initialize a reservoir */ + +Res ReservoirInit(Reservoir reservoir, Arena arena) +{ + Res res; + + /* reservoir and arena are not initialized and can't be checked */ + reservoir->reservoirLimit = (Size)0; + reservoir->reservoirSize = (Size)0; + reservoir->reserve = NULL; + reservoir->sig = ReservoirSig; + /* initialize the reservoir pool, design.mps.reservoir */ + res = PoolInit(&reservoir->poolStruct, + arena, EnsureReservoirPoolClass()); + if (res == ResOK) { + AVERT(Reservoir, reservoir); + } + return res; +} + + +/* ReservoirFinish -- Finish a reservoir */ + +void ReservoirFinish (Reservoir reservoir) +{ + PoolFinish(&reservoir->poolStruct); + reservoir->sig = SigInvalid; +} diff --git a/mps/code/ring.c b/mps/code/ring.c new file mode 100644 index 00000000000..67674c9fbc7 --- /dev/null +++ b/mps/code/ring.c @@ -0,0 +1,122 @@ +/* impl.c.ring: RING IMPLEMENTATION + * + * $HopeName$ + * Copyright (C) 1995 Harlequin Limited. All rights reserved. + * + * .intro: This is a portable implementation of Rings. + * + * .purpose: Rings are used to manage potentially unbounded collections + * of things. + * + * .sources: design.mps.ring, + * item 6 of mail.richard_brooksby.1996-03-25.16-02 + */ + +#include "ring.h" +#include "check.h" +#include "misc.h" + + +SRCID(ring, "$HopeName: MMsrc!ring.c(trunk.7) $"); + + +/* RingCheck, RingCheckSingle -- check the validity of a ring node + * + * RingCheck performs a consistency check on the ring node. + * RingCheckSingle performs the same check, but also checks that + * the ring node is a singleton (design.mps.ring.def.singleton). + */ + +Bool RingCheck(Ring ring) +{ + CHECKL(ring != NULL); + CHECKL(ring->next != NULL); + CHECKL(ring->next->prev == ring); + CHECKL(ring->prev != NULL); + CHECKL(ring->prev->next == ring); + UNUSED(ring); /* impl.c.mpm.check.unused */ + return TRUE; +} + +Bool RingCheckSingle(Ring ring) +{ + CHECKL(RingCheck(ring)); + CHECKL(ring->next == ring); + CHECKL(ring->prev == ring); + UNUSED(ring); /* impl.c.mpm.check.unused */ + return TRUE; +} + +Bool RingIsSingle(Ring ring) +{ + AVERT(Ring, ring); + return (ring->next == ring); +} + + +/* RingInit -- initialize a ring node + */ + +void (RingInit)(Ring ring) +{ + RingInit(ring); /* impl.h.mpm.ring.init */ +} + + +/* RingFinish -- finish a ring node + */ + +void (RingFinish)(Ring ring) +{ + RingFinish(ring); /* impl.h.mpm.ring.finish */ +} + + +/* RingAppend -- add a ring node to the end of a ring + */ + +void (RingAppend)(Ring ring, Ring new) +{ + RingAppend(ring, new); /* impl.h.mpm.ring.append */ +} + + +/* RingInsert -- add a ring node to the start of a ring + */ + +void (RingInsert)(Ring ring, Ring new) +{ + RingInsert(ring, new); /* impl.h.mpm.ring.insert */ +} + + +/* RingRemove -- remove a node from a ring + */ + +void (RingRemove)(Ring old) +{ + RingRemove(old); /* impl.h.mpm.ring.remove */ +} + + +/* RingNext -- get the next element of a ring + */ + +Ring (RingNext)(Ring ring) +{ + return RingNext(ring); /* impl.h.mpm.ring.next */ +} + + +/* RING_ELT -- get the ring element structure + * + * RING_ELT has no function (as it does not have function-like + * behaviour), and is defined in impl.h.mpm.ring.elt. + */ + + +/* RING_FOR -- ring iterator construct + * + * RING_FOR has no function (as it does not have function-like + * behaviour), and is defined in impl.h.mpm.ring.for. + */ diff --git a/mps/code/ring.h b/mps/code/ring.h new file mode 100644 index 00000000000..43c71600ec0 --- /dev/null +++ b/mps/code/ring.h @@ -0,0 +1,108 @@ +/* impl.h.ring: RING INTERFACE + * + * $HopeName: MMsrc!ring.h(MMdevel_pekka_locus.1) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + + +#ifndef ring_h +#define ring_h + +#include "check.h" +#include "mpmtypes.h" + + +/* RingStruct -- double-ended queue structure + * + * .ring: The ring structure is used as a field in other structures + * in order to link them together into "rings". See impl.c.ring. + */ + +typedef struct RingStruct *Ring; +typedef struct RingStruct { /* double-ended queue structure */ + Ring next, prev; /* links to next and prev element */ +} RingStruct; + + +#define RingNONE ((Ring)0) + +extern Bool RingCheck(Ring ring); +extern Bool RingCheckSingle(Ring ring); +extern Bool RingIsSingle(Ring ring); + +/* .ring.init: */ +extern void (RingInit)(Ring ring); +#define RingInit(ring) \ + BEGIN \ + Ring _ring = (ring); \ + AVER(_ring != NULL); \ + _ring->next = _ring; \ + _ring->prev = _ring; \ + AVER(RingCheck(_ring)); \ + END + +/* .ring.finish: */ +extern void (RingFinish)(Ring ring); +#define RingFinish(ring) \ + BEGIN \ + Ring _ring = (ring); \ + AVER(RingCheckSingle(_ring)); \ + _ring->next = RingNONE; \ + _ring->prev = RingNONE; \ + END + +/* .ring.append: */ +extern void (RingAppend)(Ring ring, Ring new); +#define RingAppend(ring, new) \ + BEGIN \ + Ring _ring = (ring), _new = (new); \ + AVER(RingCheck(_ring)); \ + AVER(RingCheckSingle(_new)); \ + _new->prev = _ring->prev; \ + _new->next = _ring; \ + _ring->prev->next = _new; \ + _ring->prev = _new; \ + END + +/* .ring.insert: */ +extern void (RingInsert)(Ring ring, Ring new); +#define RingInsert(ring, new) \ + BEGIN \ + Ring _ring = (ring), _new = (new); \ + AVER(RingCheck(_ring)); \ + AVER(RingCheckSingle(_new)); \ + _new->prev = _ring; \ + _new->next = _ring->next; \ + _ring->next->prev = _new; \ + _ring->next = _new; \ + END + +/* .ring.remove: */ +extern void (RingRemove)(Ring old); +#define RingRemove(old) \ + BEGIN \ + Ring _old = (old); \ + AVER(RingCheck(_old)); \ + AVER(!RingIsSingle(_old)); \ + _old->next->prev = _old->prev; \ + _old->prev->next = _old->next; \ + _old->next = _old; \ + _old->prev = _old; \ + END + +/* .ring.next: */ +extern Ring (RingNext)(Ring ring); +#define RingNext(ring) ((ring)->next) + +/* .ring.elt: See design.mps.ring.elt */ +#define RING_ELT(type, field, node) \ + ((type)((char *)(node) - (size_t)(&((type)0)->field))) + +/* .ring.for: See design.mps.ring.for */ +#define RING_FOR(node, ring, next) \ + for(node = RingNext(ring), next = RingNext(node); \ + node != (ring); \ + node = (next), next = RingNext(node)) + + +#endif /* ring_h */ diff --git a/mps/code/root.c b/mps/code/root.c new file mode 100644 index 00000000000..2643f70785d --- /dev/null +++ b/mps/code/root.c @@ -0,0 +1,669 @@ +/* impl.c.root: ROOT IMPLEMENTATION + * + * $HopeName: MMsrc!root.c(trunk.34) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .purpose: This is the implementation of the root datatype. + * + * .design: For design, see design.mps.root and + * design.mps.root-interface. */ + +#include "mpm.h" + +SRCID(root, "$HopeName: MMsrc!root.c(trunk.34) $"); + + +/* RootStruct -- tracing root structure */ + +#define RootSig ((Sig)0x51960029) /* SIGnature ROOT */ + +typedef struct RootStruct { + Sig sig; + Serial serial; /* from arena->rootSerial */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* attachment to arena */ + Rank rank; /* rank of references in this root */ + TraceSet grey; /* traces for which root is grey */ + RefSet summary; /* summary of references in root */ + RootMode mode; /* mode */ + Bool protectable; /* Can protect root? */ + Addr protBase; /* base of protectable area */ + Addr protLimit; /* limit of protectable area */ + AccessSet pm; /* Protection Mode */ + RootVar var; /* union discriminator */ + union RootUnion { + struct { + RootScanMethod scan; /* the function which does the scanning */ + void *p; /* environment for scan */ + size_t s; /* environment for scan */ + } fun; + struct { + Addr *base; /* beginning of table */ + Addr *limit; /* one off end of table */ + } table; + struct { + Addr *base; /* beginning of table */ + Addr *limit; /* one off end of table */ + Word mask; /* tag mask for scanning */ + } tableMasked; + struct { + RootScanRegMethod scan; /* function for scanning registers */ + Thread thread; /* passed to scan */ + void *p; /* passed to scan */ + size_t s; /* passed to scan */ + } reg; + struct { + FormatScanMethod scan; /* format-like scanner */ + Addr base, limit; /* passed to scan */ + } fmt; + } the; +} RootStruct; + + +/* RootVarCheck -- check a Root union discriminator + * + * .rootvarcheck: Synchronize with impl.h.mpmtypes.rootvar */ + +Bool RootVarCheck(RootVar rootVar) +{ + CHECKL(rootVar == RootTABLE || rootVar == RootTABLE_MASKED + || rootVar == RootFUN || rootVar == RootFMT || rootVar == RootREG); + UNUSED(rootVar); + return TRUE; +} + + +/* RootModeCheck */ + +Bool RootModeCheck(RootMode mode) +{ + CHECKL((mode & (RootModeCONSTANT | RootModePROTECTABLE + | RootModePROTECTABLE_INNER)) + == mode); + /* RootModePROTECTABLE_INNER implies RootModePROTECTABLE */ + CHECKL((mode & RootModePROTECTABLE_INNER) == 0 + || (mode & RootModePROTECTABLE)); + UNUSED(mode); + + return TRUE; +} + + +/* RootCheck -- check the consistency of a root structure + * + * .rootcheck: Keep synchonized with impl.h.mpmst.root. */ + +Bool RootCheck(Root root) +{ + CHECKS(Root, root); + CHECKU(Arena, root->arena); + CHECKL(root->serial < ArenaGlobals(root->arena)->rootSerial); + CHECKL(RingCheck(&root->arenaRing)); + CHECKL(RankCheck(root->rank)); + CHECKL(TraceSetCheck(root->grey)); + /* Don't need to check var here, because of the switch below */ + switch(root->var) + { + case RootTABLE: + CHECKL(root->the.table.base != 0); + CHECKL(root->the.table.base < root->the.table.limit); + break; + + case RootTABLE_MASKED: + CHECKL(root->the.tableMasked.base != 0); + CHECKL(root->the.tableMasked.base < root->the.tableMasked.limit); + /* Can't check anything about the mask. */ + break; + + case RootFUN: + CHECKL(root->the.fun.scan != NULL); + break; + + case RootREG: + CHECKL(root->the.reg.scan != NULL); + CHECKL(ThreadCheck(root->the.reg.thread)); + break; + + case RootFMT: + CHECKL(root->the.fmt.scan != NULL); + CHECKL(root->the.fmt.base != 0); + CHECKL(root->the.fmt.base < root->the.fmt.limit); + break; + + default: + NOTREACHED; + } + CHECKL(RootModeCheck(root->mode)); + CHECKL(BoolCheck(root->protectable)); + if (root->protectable) { + CHECKL(root->protBase != (Addr)0); + CHECKL(root->protLimit != (Addr)0); + CHECKL(root->protBase < root->protLimit); + /* there is no AccessSetCheck */ + } else { + CHECKL(root->protBase == (Addr)0); + CHECKL(root->protLimit == (Addr)0); + CHECKL(root->pm == (AccessSet)0); + } + return TRUE; +} + + +/* rootCreate, RootCreateTable, RootCreateReg, RootCreateFmt, RootCreateFun + * + * RootCreate* set up the appropriate union member, and call the generic + * create function to do the actual creation + * + * See design.mps.root.init for initial value. */ + +static Res rootCreate(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, RootVar type, + union RootUnion *theUnionP) +{ + Root root; + Res res; + void *p; + Globals globals; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVERT(Rank, rank); + AVERT(RootVar, type); + globals = ArenaGlobals(arena); + + res = ControlAlloc(&p, arena, sizeof(RootStruct), FALSE); + if (res != ResOK) + return res; + root = (Root)p; /* Avoid pun */ + + root->arena = arena; + root->rank = rank; + root->var = type; + root->the = *theUnionP; + root->grey = TraceSetEMPTY; + root->summary = RefSetUNIV; + root->mode = mode; + root->pm = AccessSetEMPTY; + root->protectable = FALSE; + root->protBase = (Addr)0; + root->protLimit = (Addr)0; + + /* See design.mps.arena.root-ring */ + RingInit(&root->arenaRing); + + root->serial = globals->rootSerial; + ++globals->rootSerial; + root->sig = RootSig; + + AVERT(Root, root); + + RingAppend(&globals->rootRing, &root->arenaRing); + + *rootReturn = root; + return ResOK; +} + +static Res rootCreateProtectable(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, RootVar var, + Addr base, Addr limit, + union RootUnion *theUnion) +{ + Res res; + Root root; + Ring node, next; + + res = rootCreate(&root, arena, rank, mode, var, theUnion); + if (res != ResOK) + return res; + if (mode & RootModePROTECTABLE) { + root->protectable = TRUE; + if (mode & RootModePROTECTABLE_INNER) { + root->protBase = AddrAlignUp(base, ArenaAlign(arena)); + root->protLimit = AddrAlignDown(limit, ArenaAlign(arena)); + if (!(root->protBase < root->protLimit)) { + /* root had no inner pages */ + root->protectable = FALSE; + root->mode &=~ (RootModePROTECTABLE|RootModePROTECTABLE_INNER); + } + } else { + root->protBase = AddrAlignDown(base, ArenaAlign(arena)); + root->protLimit = AddrAlignUp(limit, ArenaAlign(arena)); + } + } + + /* Check that this root doesn't intersect with any other root */ + RING_FOR(node, &ArenaGlobals(arena)->rootRing, next) { + Root trial = RING_ELT(Root, arenaRing, node); + if (trial != root) { + /* (trial->protLimit <= root->protBase */ + /* || root->protLimit <= trial->protBase) */ + /* is the "okay" state. The negation of this is: */ + if (root->protBase < trial->protLimit + && trial->protBase < root->protLimit) { + NOTREACHED; + RootDestroy(root); + return ResFAIL; + } + } + } + + AVERT(Root, root); + + *rootReturn = root; + return ResOK; +} + +Res RootCreateTable(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, Addr *base, Addr *limit) +{ + Res res; + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + AVER(base != 0); + AVER(base < limit); + + theUnion.table.base = base; + theUnion.table.limit = limit; + + res = rootCreateProtectable(rootReturn, arena, rank, mode, + RootTABLE, (Addr)base, (Addr)limit, &theUnion); + return res; +} + +Res RootCreateTableMasked(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, Addr *base, Addr *limit, + Word mask) +{ + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + AVER(base != 0); + AVER(base < limit); + /* Can't check anything about mask. */ + + theUnion.tableMasked.base = base; + theUnion.tableMasked.limit = limit; + theUnion.tableMasked.mask = mask; + + return rootCreateProtectable(rootReturn, arena, rank, mode, RootTABLE_MASKED, + (Addr)base, (Addr)limit, &theUnion); +} + +Res RootCreateReg(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + RootScanRegMethod scan, void *p, size_t s) +{ + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + AVERT(Thread, thread); + AVER(scan != NULL); + + theUnion.reg.scan = scan; + theUnion.reg.thread = thread; + theUnion.reg.p = p; + theUnion.reg.s = s; + + return rootCreate(rootReturn, arena, rank, (RootMode)0, RootREG, &theUnion); +} + +Res RootCreateFmt(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, FormatScanMethod scan, + Addr base, Addr limit) +{ + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + AVER(FUNCHECK(scan)); + AVER(base != 0); + AVER(base < limit); + + theUnion.fmt.scan = scan; + theUnion.fmt.base = base; + theUnion.fmt.limit = limit; + + return rootCreateProtectable(rootReturn, arena, rank, mode, + RootFMT, base, limit, &theUnion); +} + +Res RootCreateFun(Root *rootReturn, Arena arena, Rank rank, + RootScanMethod scan, void *p, size_t s) +{ + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + AVER(FUNCHECK(scan)); + + theUnion.fun.scan = scan; + theUnion.fun.p = p; + theUnion.fun.s = s; + + return rootCreate(rootReturn, arena, rank, (RootMode)0, RootFUN, &theUnion); +} + + +/* RootDestroy -- destroy a root */ + +void RootDestroy(Root root) +{ + Arena arena; + + AVERT(Root, root); + + arena = RootArena(root); + + AVERT(Arena, arena); + + RingRemove(&root->arenaRing); + RingFinish(&root->arenaRing); + + root->sig = SigInvalid; + + ControlFree(arena, root, sizeof(RootStruct)); +} + + +/* RootArena -- return the rank of a root + * + * Must be thread-safe. */ + +Arena RootArena(Root root) +{ + AVER(CHECKT(Root, root)); + return root->arena; +} + + +/* RootRank -- return the rank of a root */ + +Rank RootRank(Root root) +{ + AVERT(Root, root); + return root->rank; +} + + +/* RootPM -- return the protection mode of a root */ + +AccessSet RootPM(Root root) +{ + AVERT(Root, root); + return root->pm; +} + + +/* RootSummary -- return the summary of a root */ + +RefSet RootSummary(Root root) +{ + AVERT(Root, root); + return root->summary; +} + + +/* RootGrey -- mark root grey */ + +void RootGrey(Root root, Trace trace) +{ + AVERT(Root, root); + AVERT(Trace, trace); + + root->grey = TraceSetAdd(root->grey, trace); +} + + +static void rootSetSummary(Root root, RefSet summary) +{ + AVERT(Root, root); + /* Can't check summary */ + if (root->protectable) { + if (summary == RefSetUNIV) { + root->summary = summary; + root->pm &= ~AccessWRITE; + } else { + root->pm |= AccessWRITE; + root->summary = summary; + } + } else + AVER(root->summary == RefSetUNIV); +} + + +/* RootScan -- scan root */ + +Res RootScan(ScanState ss, Root root) +{ + Res res; + + AVERT(Root, root); + AVERT(ScanState, ss); + AVER(root->rank == ss->rank); + + if (TraceSetInter(root->grey, ss->traces) == TraceSetEMPTY) + return ResOK; + + AVER(ScanStateSummary(ss) == RefSetEMPTY); + + if (root->pm != AccessSetEMPTY) { + ProtSet(root->protBase, root->protLimit, AccessSetEMPTY); + } + + switch(root->var) { + case RootTABLE: + res = TraceScanArea(ss, root->the.table.base, root->the.table.limit); + ss->scannedSize += AddrOffset(root->the.table.base, root->the.table.limit); + if (res != ResOK) + goto failScan; + break; + + case RootTABLE_MASKED: + res = TraceScanAreaMasked(ss, + root->the.tableMasked.base, + root->the.tableMasked.limit, + root->the.tableMasked.mask); + ss->scannedSize += AddrOffset(root->the.table.base, root->the.table.limit); + if (res != ResOK) + goto failScan; + break; + + case RootFUN: + res = (*root->the.fun.scan)(ss, root->the.fun.p, root->the.fun.s); + if (res != ResOK) + goto failScan; + break; + + case RootREG: + res = (*root->the.reg.scan)(ss, root->the.reg.thread, + root->the.reg.p, root->the.reg.s); + if (res != ResOK) + goto failScan; + break; + + case RootFMT: + res = (*root->the.fmt.scan)(ss, root->the.fmt.base, root->the.fmt.limit); + ss->scannedSize += AddrOffset(root->the.fmt.base, root->the.fmt.limit); + if (res != ResOK) + goto failScan; + break; + + default: + NOTREACHED; + res = ResUNIMPL; + goto failScan; + } + + AVER(res == ResOK); + root->grey = TraceSetDiff(root->grey, ss->traces); + rootSetSummary(root, ScanStateSummary(ss)); + EVENT_PWW(RootScan, root, ss->traces, ScanStateSummary(ss)); + +failScan: + if (root->pm != AccessSetEMPTY) { + ProtSet(root->protBase, root->protLimit, root->pm); + } + + return res; +} + + +/* RootOfAddr -- return the root at addr + * + * Returns TRUE if the addr is in a root (and returns the root in + * *rootReturn) otherwise returns FALSE. Cf. SegOfAddr. */ + +Bool RootOfAddr(Root *rootReturn, Arena arena, Addr addr) +{ + Ring node, next; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + /* addr is arbitrary and can't be checked */ + + RING_FOR(node, &ArenaGlobals(arena)->rootRing, next) { + Root root = RING_ELT(Root, arenaRing, node); + + if (root->protectable && root->protBase <= addr && addr < root->protLimit) { + *rootReturn = root; + return TRUE; + } + } + + return FALSE; +} + + +/* RootAccess -- handle barrier hit on root */ + +void RootAccess(Root root, AccessSet mode) +{ + AVERT(Root, root); + /* Can't AVERT mode. */ + AVER((root->pm & mode) != AccessSetEMPTY); + AVER(mode == AccessWRITE); /* only write protection supported */ + + rootSetSummary(root, RefSetUNIV); + + /* Access must now be allowed. */ + AVER((root->pm & mode) == AccessSetEMPTY); + ProtSet(root->protBase, root->protLimit, root->pm); +} + + +/* RootsIterate -- iterate over all the roots in the arena */ + +Res RootsIterate(Globals arena, RootIterateFn f, void *p) +{ + Res res = ResOK; + Ring node, next; + + RING_FOR(node, &arena->rootRing, next) { + Root root = RING_ELT(Root, arenaRing, node); + + res = (*f)(root, p); + if (res != ResOK) + return res; + } + return res; +} + + +/* RootDescribe -- describe a root */ + +Res RootDescribe(Root root, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(Root, root)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial, + " arena $P ($U)\n", (WriteFP)root->arena, + (WriteFU)root->arena->serial, + " rank $U\n", (WriteFU)root->rank, + " grey $B\n", (WriteFB)root->grey, + " summary $B\n", (WriteFB)root->summary, + NULL); + if (res != ResOK) return res; + + switch(root->var) { + case RootTABLE: + res = WriteF(stream, + " table base $A limit $A\n", + root->the.table.base, root->the.table.limit, + NULL); + if (res != ResOK) return res; + break; + + case RootTABLE_MASKED: + res = WriteF(stream, " table base $A limit $A mask $B\n", + root->the.tableMasked.base, root->the.tableMasked.limit, + root->the.tableMasked.mask, + NULL); + if (res != ResOK) return res; + break; + + case RootFUN: + res = WriteF(stream, + " scan function $F\n", (WriteFF)root->the.fun.scan, + " environment p $P s $W\n", + root->the.fun.p, (WriteFW)root->the.fun.s, + NULL); + if (res != ResOK) return res; + break; + + case RootREG: + res = WriteF(stream, + " thread $P\n", (WriteFP)root->the.reg.thread, + " environment p $P", root->the.reg.p, + NULL); + if (res != ResOK) return res; + break; + + case RootFMT: + res = WriteF(stream, + " scan function $F\n", (WriteFF)root->the.fmt.scan, + " format base $A limit $A\n", + root->the.fmt.base, root->the.fmt.limit, + NULL); + if (res != ResOK) return res; + break; + + default: + NOTREACHED; + } + + res = WriteF(stream, + "} Root $P ($U)\n", (WriteFP)root, (WriteFU)root->serial, + NULL); + if (res != ResOK) return res; + + return ResOK; +} + + +/* RootsDescribe -- describe all roots */ + +Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream) +{ + Res res = ResOK; + Ring node, next; + + RING_FOR(node, &arenaGlobals->rootRing, next) { + Root root = RING_ELT(Root, arenaRing, node); + res = RootDescribe(root, stream); /* this outputs too much */ + if (res != ResOK) return res; + } + return res; +} diff --git a/mps/code/s7ppac/Makefile b/mps/code/s7ppac/Makefile new file mode 100644 index 00000000000..33a41921b8a --- /dev/null +++ b/mps/code/s7ppac/Makefile @@ -0,0 +1,207 @@ +# impl.makefile.s7ppac: S7PPAC MPW MAKE FILE +# +# $HopeName: MMsrc!s7ppac:Makefile(trunk.24) $ +# +# Copyright (C) 1999 Harlequin Limited. All rights reserved. + +# .limit.epcore: This only knows about making the mmsw libraries for +# MM/EP-core. +# +# .usage: To invoke: +# +# directory {...}s7ppac +# BuildProgram -d Variety mmsw +# +# (this builds mmsw_TI.o, mmsw_HI.o, and mmsw_WE.o) +# +# to clean everything else away: +# +# directory {...}s7ppac +# BuildProgram -d Variety clean +# +# Notes: +# +# .dep.accum: If several single-f rules all produce the same product +# (left-hand-side of the f), they act together: at most one may have a +# body, the others only add additional dependencies. + + +# Options cribbed from SWbuild!macos:rules:rulemrc4.make(trunk.3) +CC_OPT_CONTROL= -nomfmem -y "{TempFolder}" +CC_OPT_SOURCE= -inclpath nosystem +CC_OPT_OBJECT= -align power -char signed -enum int -fp_contract off -ldsize 128 -target ppc + +CC_OPTT_AbsAPAD= -ansi strict -proto strict -typecheck strict +# Plus "warnings are errors": +CC_OPTT={CC_OPTT_AbsAPAD} -w error + +CC_OPTR_Dbg= -opt off -sym on -tb on +CC_OPTR_Qkb= -opt off -sym off -tb on +CC_OPTR_Spd= -opt speed,nounroll -sym off -tb on +CC_OPTR_= -opt speed,nounroll -sym off -w 35 + +SYS_CINCLUDES= -i {CIncludes96} + + +BB_OPT_CONTROL= -nomf -linkfaster on +BB_OPT_SOURCE= +BB_OPT_OBJECT= -xm Library + +BB_OPTR_Dbg= -sym on +BB_OPTR_Qkb= -sym off +BB_OPTR_Spd= -sym off +BB_OPTR_= -sym off + + +PRODDEFINES= -d CONFIG_VAR_{Variety} -d CONFIG_PROD_EPCORE + +":" Ä "::" + +OSffx = .c.{Variety}.o + +.c.TI.o Ä .c + {MPWCommands96}MrC2.0.2d1 ¶ + -o {Targ} ¶ + {CC_OPTT} ¶ + {CC_OPTR_Dbg} ¶ + {CC_OPT_CONTROL} {CC_OPT_SOURCE} {CC_OPT_OBJECT} ¶ + {ENVDEFINES} {PRODDEFINES} ¶ + {SYS_CINCLUDES} ¶ + {DepDir}{Default}.c + +.c.CI.o Ä .c + {MPWCommands96}MrC2.0.2d1 ¶ + -o {Targ} ¶ + {CC_OPTT} ¶ + {CC_OPTR_Dbg} ¶ + {CC_OPT_CONTROL} {CC_OPT_SOURCE} {CC_OPT_OBJECT} ¶ + {ENVDEFINES} {PRODDEFINES} ¶ + {SYS_CINCLUDES} ¶ + {DepDir}{Default}.c + +.c.HI.o Ä .c + {MPWCommands96}MrC2.0.2d1 ¶ + -o {Targ} ¶ + {CC_OPTT} ¶ + {CC_OPTR_} ¶ + {CC_OPT_CONTROL} {CC_OPT_SOURCE} {CC_OPT_OBJECT} ¶ + {ENVDEFINES} {PRODDEFINES} ¶ + {SYS_CINCLUDES} ¶ + {DepDir}{Default}.c + +.c.HE.o Ä .c + {MPWCommands96}MrC2.0.2d1 ¶ + -o {Targ} ¶ + {CC_OPTT} ¶ + {CC_OPTR_} ¶ + {CC_OPT_CONTROL} {CC_OPT_SOURCE} {CC_OPT_OBJECT} ¶ + {ENVDEFINES} {PRODDEFINES} ¶ + {SYS_CINCLUDES} ¶ + {DepDir}{Default}.c + +.c.WE.o Ä .c + {MPWCommands96}MrC2.0.2d1 ¶ + -o {Targ} ¶ + {CC_OPTT} ¶ + {CC_OPTR_} ¶ + {CC_OPT_CONTROL} {CC_OPT_SOURCE} {CC_OPT_OBJECT} ¶ + {ENVDEFINES} {PRODDEFINES} ¶ + {SYS_CINCLUDES} ¶ + {DepDir}{Default}.c + +# version.o has a special rule so that it is always built +version{OSffx} Ä $OutOfDate + +mmsw_{Variety}.o Ä ¶ + version{OSffx} ¶ + assert{OSffx} ¶ + ring{OSffx} ¶ + mpm{OSffx} ¶ + bt{OSffx} ¶ + boot{OSffx} ¶ + arenacl{OSffx} ¶ + arenavmx{OSffx} ¶ + locus{OSffx} ¶ + arena{OSffx} ¶ + global{OSffx} ¶ + tract{OSffx} ¶ + walk{OSffx} ¶ + reserv{OSffx} ¶ + pool{OSffx} ¶ + poolmfs{OSffx} ¶ + poolmv{OSffx} ¶ + root{OSffx} ¶ + format{OSffx} ¶ + buffer{OSffx} ¶ + ref{OSffx} ¶ + trace{OSffx} ¶ + protsw{OSffx} ¶ + shield{OSffx} ¶ + than{OSffx} ¶ + ssan{OSffx} ¶ + mpsi{OSffx} ¶ + ld{OSffx} ¶ + poolabs{OSffx} ¶ + poolepdl{OSffx} ¶ + poolepvm{OSffx} ¶ + poolams{OSffx} ¶ + protocol{OSffx} ¶ + action{OSffx} ¶ + seg{OSffx} ¶ + sac{OSffx} ¶ + event{OSffx} ¶ + mpsioan{OSffx} ¶ + dbgpool{OSffx} ¶ + meter{OSffx} ¶ + poolmrg{OSffx} ¶ + poolmvff{OSffx} ¶ + splay{OSffx} ¶ + cbs{OSffx} ¶ + message{OSffx} + +mmsw_TI.o Ä # .dep.accum + {MPWCommands97}PPCLink1.5 ¶ + -o {Targ} ¶ + {BB_OPTR_Dbg} ¶ + {BB_OPT_CONTROL} {BB_OPT_SOURCE} {BB_OPT_OBJECT} ¶ + {Deps} + +mmsw_CI.o Ä # .dep.accum + {MPWCommands97}PPCLink1.5 ¶ + -o {Targ} ¶ + {BB_OPTR_Dbg} ¶ + {BB_OPT_CONTROL} {BB_OPT_SOURCE} {BB_OPT_OBJECT} ¶ + {Deps} + +mmsw_HI.o Ä # .dep.accum + {MPWCommands97}PPCLink1.5 ¶ + -o {Targ} ¶ + {BB_OPTR_} ¶ + {BB_OPT_CONTROL} {BB_OPT_SOURCE} {BB_OPT_OBJECT} ¶ + {Deps} + +mmsw_HE.o Ä # .dep.accum + {MPWCommands97}PPCLink1.5 ¶ + -o {Targ} ¶ + {BB_OPTR_} ¶ + {BB_OPT_CONTROL} {BB_OPT_SOURCE} {BB_OPT_OBJECT} ¶ + {Deps} + +mmsw_WE.o Ä # .dep.accum + {MPWCommands97}PPCLink1.5 ¶ + -o {Targ} ¶ + {BB_OPTR_} ¶ + {BB_OPT_CONTROL} {BB_OPT_SOURCE} {BB_OPT_OBJECT} ¶ + {Deps} + + +cleanall Ä + Delete Å.o + +clean Ä + Delete Å.c.Å.o + +mmsw Ä + BuildProgram -d Variety=TI mmsw_TI.o + BuildProgram -d Variety=HI mmsw_HI.o + BuildProgram -d Variety=WE mmsw_WE.o diff --git a/mps/code/s7ppmw.sit b/mps/code/s7ppmw.sit new file mode 100644 index 00000000000..c651c0d1d13 Binary files /dev/null and b/mps/code/s7ppmw.sit differ diff --git a/mps/code/sac.c b/mps/code/sac.c new file mode 100644 index 00000000000..c63a2cafeed --- /dev/null +++ b/mps/code/sac.c @@ -0,0 +1,365 @@ +/* impl.c.sac: SEGREGATED ALLOCATION CACHES + * + * $HopeName: MMsrc!sac.c(trunk.3) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "sac.h" + +SRCID(sac, "$HopeName: MMsrc!sac.c(trunk.3) $"); + + +/* SACCheck -- check function for SACs */ + +static Bool sacFreeListBlockCheck(SACFreeListBlock fb) +{ + Count j; + Addr cb; + + /* nothing to check about size */ + CHECKL(fb->count <= fb->countMax); + /* check the freelist has the right number of blocks */ + for (j = 0, cb = fb->blocks; j < fb->count; ++j) { + CHECKL(cb != NULL); + /* @@@@ ignoring shields for now */ + cb = *ADDR_PTR(Addr, cb); + } + CHECKL(cb == NULL); + return TRUE; +} + +static Bool SACCheck(SAC sac) +{ + Index i, j; + Bool b; + Size prevSize; + + CHECKS(SAC, sac); + CHECKU(Pool, sac->pool); + CHECKL(sac->classesCount > 0); + CHECKL(sac->classesCount > sac->middleIndex); + CHECKL(BoolCheck(sac->esacStruct.trapped)); + CHECKL(sac->esacStruct.middle > 0); + /* check classes above middle */ + prevSize = sac->esacStruct.middle; + for (j = sac->middleIndex + 1, i = 0; + j <= sac->classesCount; ++j, i += 2) { + CHECKL(prevSize < sac->esacStruct.freelists[i].size); + b = sacFreeListBlockCheck(&(sac->esacStruct.freelists[i])); + if (!b) return b; + prevSize = sac->esacStruct.freelists[i].size; + } + /* check overlarge class */ + CHECKL(sac->esacStruct.freelists[i-2].size == SizeMAX); + CHECKL(sac->esacStruct.freelists[i-2].count == 0); + CHECKL(sac->esacStruct.freelists[i-2].countMax == 0); + CHECKL(sac->esacStruct.freelists[i-2].blocks == NULL); + /* check classes below middle */ + prevSize = sac->esacStruct.middle; + for (j = sac->middleIndex, i = 1; j > 0; --j, i += 2) { + CHECKL(prevSize > sac->esacStruct.freelists[i].size); + b = sacFreeListBlockCheck(&(sac->esacStruct.freelists[i])); + if (!b) return b; + prevSize = sac->esacStruct.freelists[i].size; + } + /* check smallest class */ + CHECKL(sac->esacStruct.freelists[i].size == 0); + b = sacFreeListBlockCheck(&(sac->esacStruct.freelists[i])); + return b; +} + + +/* sacSize -- calculate size of a SAC structure */ + +static Size sacSize(Index middleIndex, Count classesCount) +{ + Index indexMax; /* max index for the freelist */ + SACStruct dummy; + + if (middleIndex + 1 < classesCount - middleIndex) + indexMax = 2 * (classesCount - middleIndex - 1); + else + indexMax = 1 + 2 * middleIndex; + return PointerOffset(&dummy, &dummy.esacStruct.freelists[indexMax+1]); +} + + +/* SACCreate -- create an SAC object */ + +Res SACCreate(SAC *sacReturn, Pool pool, Count classesCount, + SACClasses classes) +{ + void *p; + SAC sac; + Res res; + Index i, j; + Index middleIndex; /* index of the size in the middle */ + Size prevSize; + unsigned totalFreq = 0; + + AVER(sacReturn != NULL); + AVERT(Pool, pool); + AVER(classesCount > 0); + /* In this cache type, there is no upper limit on classesCount. */ + prevSize = sizeof(Addr) - 1; /* must large enough for freelist link */ + /* @@@@ It would be better to dynamically adjust the smallest class */ + /* to be large enough, but that gets complicated, if you have to */ + /* merge classes because of the adjustment. */ + for (i = 0; i < classesCount; ++i) { + AVER(classes[i].blockSize > 0); + AVER(SizeIsAligned(classes[i].blockSize, PoolAlignment(pool))); + AVER(prevSize < classes[i].blockSize); + prevSize = classes[i].blockSize; + /* no restrictions on count */ + /* no restrictions on frequency */ + } + + /* Calculate frequency scale */ + for (i = 0; i < classesCount; ++i) { + unsigned oldFreq = totalFreq; + totalFreq += classes[i].frequency; + AVER(oldFreq <= totalFreq); /* check for overflow */ + UNUSED(oldFreq); /* impl.c.mpm.check.unused */ + } + + /* Find middle one */ + totalFreq /= 2; + for (i = 0; i < classesCount; ++i) { + if (totalFreq < classes[i].frequency) break; + totalFreq -= classes[i].frequency; + } + if (totalFreq <= classes[i].frequency / 2) + middleIndex = i; + else + middleIndex = i + 1; /* there must exist another class at i+1 */ + + /* Allocate SAC */ + res = ControlAlloc(&p, PoolArena(pool), sacSize(middleIndex, classesCount), + FALSE); + if(res != ResOK) + goto failSACAlloc; + sac = p; + + /* Move classes in place */ + /* It's important this matches SACFind. */ + for (j = middleIndex + 1, i = 0; j < classesCount; ++j, i += 2) { + sac->esacStruct.freelists[i].size = classes[j].blockSize; + sac->esacStruct.freelists[i].count = 0; + sac->esacStruct.freelists[i].countMax = classes[j].cachedCount; + sac->esacStruct.freelists[i].blocks = NULL; + } + sac->esacStruct.freelists[i].size = SizeMAX; + sac->esacStruct.freelists[i].count = 0; + sac->esacStruct.freelists[i].countMax = 0; + sac->esacStruct.freelists[i].blocks = NULL; + for (j = middleIndex, i = 1; j > 0; --j, i += 2) { + sac->esacStruct.freelists[i].size = classes[j-1].blockSize; + sac->esacStruct.freelists[i].count = 0; + sac->esacStruct.freelists[i].countMax = classes[j].cachedCount; + sac->esacStruct.freelists[i].blocks = NULL; + } + sac->esacStruct.freelists[i].size = 0; + sac->esacStruct.freelists[i].count = 0; + sac->esacStruct.freelists[i].countMax = classes[j].cachedCount; + sac->esacStruct.freelists[i].blocks = NULL; + + /* finish init */ + sac->esacStruct.trapped = FALSE; + sac->esacStruct.middle = classes[middleIndex].blockSize; + sac->pool = pool; + sac->classesCount = classesCount; + sac->middleIndex = middleIndex; + sac->sig = SACSig; + AVERT(SAC, sac); + *sacReturn = sac; + return ResOK; + +failSACAlloc: + return res; +} + + +/* SACDestroy -- destroy an SAC object */ + +void SACDestroy(SAC sac) +{ + AVERT(SAC, sac); + SACFlush(sac); + sac->sig = SigInvalid; + ControlFree(PoolArena(sac->pool), sac, + sacSize(sac->middleIndex, sac->classesCount)); +} + + +/* sacFind -- find the index corresponding to size + * + * This function replicates the loop in MPS_SAC_ALLOC_FAST, only with + * added checks. + */ + +static void sacFind(Index *iReturn, Size *blockSizeReturn, + SAC sac, Size size) +{ + Index i, j; + + if (size > sac->esacStruct.middle) { + i = 0; j = sac->middleIndex + 1; + AVER(j <= sac->classesCount); + while (size > sac->esacStruct.freelists[i].size) { + AVER(j < sac->classesCount); + i += 2; ++j; + } + *blockSizeReturn = sac->esacStruct.freelists[i].size; + } else { + Size prevSize = sac->esacStruct.middle; + + i = 1; j = sac->middleIndex; + while (size <= sac->esacStruct.freelists[i].size) { + AVER(j > 0); + prevSize = sac->esacStruct.freelists[i].size; + i += 2; --j; + } + *blockSizeReturn = prevSize; + } + *iReturn = i; +} + + +/* SACFill -- alloc an object, and perhaps fill the cache */ + +Res SACFill(Addr *p_o, SAC sac, Size size, Bool hasReservoirPermit) +{ + Index i; + Count blockCount, j; + Size blockSize; + Addr p, fl; + Res res = ResOK; /* stop compiler complaining */ + + AVER(p_o != NULL); + AVERT(SAC, sac); + AVER(size != 0); + AVER(BoolCheck(hasReservoirPermit)); + + sacFind(&i, &blockSize, sac, size); + /* Check it's empty (in the future, there will be other cases). */ + AVER(sac->esacStruct.freelists[i].count == 0); + + /* Fill 1/3 of the cache for this class. */ + blockCount = sac->esacStruct.freelists[i].countMax / 3; + /* Adjust size for the overlarge class. */ + if (blockSize == SizeMAX) + /* .align: align 'cause some classes don't accept unaligned. */ + blockSize = SizeAlignUp(size, PoolAlignment(sac->pool)); + for (j = 0, fl = sac->esacStruct.freelists[i].blocks; + j <= blockCount; ++j) { + res = PoolAlloc(&p, sac->pool, blockSize, hasReservoirPermit); + if (res != ResOK) + break; + /* @@@@ ignoring shields for now */ + *ADDR_PTR(Addr, p) = fl; fl = p; + } + /* If didn't get any, just return. */ + if (j == 0) { + AVER(res != ResOK); + return res; + } + + /* Take the last one off, and return it. */ + sac->esacStruct.freelists[i].count = j - 1; + *p_o = fl; + /* @@@@ ignoring shields for now */ + sac->esacStruct.freelists[i].blocks = *ADDR_PTR(Addr, fl); + return ResOK; +} + + +/* sacClassFlush -- discard elements from the cache for a given class + * + * blockCount says how many elements to discard. + */ + +static void sacClassFlush(SAC sac, Index i, Size blockSize, + Count blockCount) +{ + Addr cb, fl; + Count j; + + for (j = 0, fl = sac->esacStruct.freelists[i].blocks; + j < blockCount; ++j) { + /* @@@@ ignoring shields for now */ + cb = fl; fl = *ADDR_PTR(Addr, cb); + PoolFree(sac->pool, cb, blockSize); + } + sac->esacStruct.freelists[i].count -= blockCount; + sac->esacStruct.freelists[i].blocks = fl; +} + + +/* SACEmpty -- free an object, and perhaps empty the cache */ + +void SACEmpty(SAC sac, Addr p, Size size) +{ + Index i; + Size blockSize; + + AVERT(SAC, sac); + AVER(p != NULL); + AVER(PoolHasAddr(sac->pool, p)); + AVER(size > 0); + + sacFind(&i, &blockSize, sac, size); + /* Check it's full (in the future, there will be other cases). */ + AVER(sac->esacStruct.freelists[i].count + == sac->esacStruct.freelists[i].countMax); + + /* Adjust size for the overlarge class. */ + if (blockSize == SizeMAX) + /* see .align */ + blockSize = SizeAlignUp(size, PoolAlignment(sac->pool)); + if (sac->esacStruct.freelists[i].countMax > 0) { + Count blockCount; + + /* Flush 2/3 of the cache for this class. */ + /* Computed as count - count/3, so that the rounding works out right. */ + blockCount = sac->esacStruct.freelists[i].count; + blockCount -= sac->esacStruct.freelists[i].count / 3; + sacClassFlush(sac, i, blockSize, (blockCount > 0) ? blockCount : 1); + /* Leave the current one in the cache. */ + sac->esacStruct.freelists[i].count += 1; + /* @@@@ ignoring shields for now */ + *ADDR_PTR(Addr, p) = sac->esacStruct.freelists[i].blocks; + sac->esacStruct.freelists[i].blocks = p; + } else { + /* Free even the current one. */ + PoolFree(sac->pool, p, blockSize); + } +} + + +/* SACFlush -- flush the cache, releasing all memory held in it */ + +void SACFlush(SAC sac) +{ + Index i, j; + Size prevSize; + + AVERT(SAC, sac); + + for (j = sac->middleIndex + 1, i = 0; + j < sac->classesCount; ++j, i += 2) { + sacClassFlush(sac, i, sac->esacStruct.freelists[i].size, + sac->esacStruct.freelists[i].count); + AVER(sac->esacStruct.freelists[i].blocks == NULL); + } + /* no need to flush overlarge, there's nothing there */ + prevSize = sac->esacStruct.middle; + for (j = sac->middleIndex, i = 1; j > 0; --j, i += 2) { + sacClassFlush(sac, i, prevSize, sac->esacStruct.freelists[i].count); + AVER(sac->esacStruct.freelists[i].blocks == NULL); + prevSize = sac->esacStruct.freelists[i].size; + } + /* flush smallest class */ + sacClassFlush(sac, i, prevSize, sac->esacStruct.freelists[i].count); + AVER(sac->esacStruct.freelists[i].blocks == NULL); +} diff --git a/mps/code/sac.h b/mps/code/sac.h new file mode 100644 index 00000000000..51d55b2f51d --- /dev/null +++ b/mps/code/sac.h @@ -0,0 +1,80 @@ +/* impl.h.sac: SEGREGATED ALLOCATION CACHES INTERFACE + * + * $HopeName: MMsrc!sac.h(MM_epcore_brisling.1) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + +#ifndef sac_h +#define sac_h + +#include "mpmtypes.h" +#include "mpm.h" /* for PoolArena */ + + +#define sacClassLIMIT ((Count)8) + + +/* ExternalSAC -- the external face of segregated allocation caches */ +/* .sac: This structure must match impl.h.mps.sac. */ + +typedef struct ExternalSACStruct *ExternalSAC; + +typedef struct SACFreeListBlockStruct { + Size size; + Count count; + Count countMax; + Addr blocks; +} SACFreeListBlockStruct; + +typedef SACFreeListBlockStruct *SACFreeListBlock; + +typedef struct ExternalSACStruct { + size_t middle; /* block size for starting searches */ + Bool trapped; /* trap status */ + /* freelist, variable length */ + SACFreeListBlockStruct freelists[2 * sacClassLIMIT]; +} ExternalSACStruct; + + +/* SAC -- the real segregated allocation caches */ + +#define SACSig ((Sig)0x5195AC99) /* SIGnature SAC */ + +typedef struct SACStruct *SAC; + +typedef struct SACStruct { + Sig sig; + Pool pool; + Count classesCount; /* number of classes */ + Index middleIndex; /* index of the middle */ + ExternalSACStruct esacStruct; /* variable length, must be last */ +} SACStruct; + +#define SACOfExternalSAC(esac) PARENT(SACStruct, esacStruct, esac) + +#define ExternalSACOfSAC(sac) (&((sac)->esacStruct)) + +#define SACArena(sac) PoolArena((sac)->pool) + + +/* SACClasses -- structure for specifying classes in the cache */ +/* .sacc: This structure must match impl.h.mps.sacc. */ + +typedef struct SACClassesStruct *SACClasses; + +typedef struct SACClassesStruct { + Size blockSize; + Count cachedCount; + unsigned frequency; +} SACClassesStruct; + + +extern Res SACCreate(SAC *sac_o, Pool pool, Count classesCount, + SACClasses classes); +extern void SACDestroy(SAC sac); +extern Res SACFill(Addr *p_o, SAC sac, Size size, Bool hasReservoirPermit); +extern void SACEmpty(SAC sac, Addr p, Size size); +extern void SACFlush(SAC sac); + + +#endif /* sac_h */ diff --git a/mps/code/sacss.c b/mps/code/sacss.c new file mode 100644 index 00000000000..774c0fef474 --- /dev/null +++ b/mps/code/sacss.c @@ -0,0 +1,180 @@ +/* impl.c.sacss: SAC MANUAL ALLOC STRESS TEST + * + * $HopeName: MMsrc!sacss.c(trunk.3) $ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + */ + + +#include "mpscmv.h" +#include "mpscmvff.h" +#include "mpslib.h" +#include "mpsavm.h" +#include "mps.h" + +#include "testlib.h" + +#include +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif +#include +#include +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + + +#define TRUE 1 +#define FALSE 0 + +#define testArenaSIZE ((((size_t)64)<<20) - 4) +#define testSetSIZE 200 +#define testLOOPS 10 + +#define topClassSIZE 0xA00 +#define classCOUNT 4 + + +static mps_res_t make(mps_addr_t *p, mps_sac_t sac, size_t size) +{ + mps_res_t res; + + MPS_SAC_ALLOC(res, *p, sac, size, FALSE); + return res; +} + + +static mps_res_t stress(mps_class_t class, mps_arena_t arena, + size_t classes_count, mps_sac_classes_s *classes, + size_t (*size)(int i), ...) +{ + mps_res_t res; + mps_pool_t pool; + mps_sac_t sac; + va_list arg; + int i, k; + int *ps[testSetSIZE]; + size_t ss[testSetSIZE]; + + va_start(arg, size); + res = mps_pool_create_v(&pool, arena, class, arg); + va_end(arg); + if (res != MPS_RES_OK) + return res; + + die(mps_sac_create(&sac, pool, classes_count, classes), "SACCreate"); + + /* allocate a load of objects */ + for (i = 0; i < testSetSIZE; ++i) { + ss[i] = (*size)(i); + + res = make((mps_addr_t *)&ps[i], sac, ss[i]); + if (res != MPS_RES_OK) + return res; + if (ss[i] >= sizeof(ps[i])) + *ps[i] = 1; /* Write something, so it gets swap. */ + } + + mps_pool_check_fenceposts(pool); + + for (k = 0; k < testLOOPS; ++k) { + /* shuffle all the objects */ + for (i=0; i (b)) ? (a) : (b)) + + +static size_t randomSize8(int i) +{ + size_t maxSize = 2 * 160 * 0x2000; + size_t size; + + /* Reduce by a factor of 2 every 10 cycles. Total allocation about 40 MB. */ + size = rnd() % max((maxSize >> (i / 10)), 2) + 1; + return size; +} + + +static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 }; + +static mps_sac_classes_s classes[4] = { {8, 1, 1}, {16, 1, 2}, {136, 9, 5}, + {topClassSIZE, 9, 4} }; + +static int testInArena(mps_arena_t arena) +{ + printf("MVFF\n\n"); + die(stress(mps_class_mvff(), arena, classCOUNT, classes, randomSize8, + (size_t)65536, (size_t)32, (size_t)4, TRUE, TRUE, TRUE), + "stress MVFF"); + printf("MV debug\n\n"); + die(stress(mps_class_mv_debug(), arena, classCOUNT, classes, randomSize8, + &debugOptions, (size_t)65536, (size_t)32, (size_t)65536), + "stress MV debug"); + printf("MV\n\n"); + die(stress(mps_class_mv(), arena, classCOUNT, classes, randomSize8, + (size_t)65536, (size_t)32, (size_t)65536), + "stress MV"); + return 0; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vmnz(), testArenaSIZE), + "mps_arena_create"); + testInArena(arena); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/sc.gmk b/mps/code/sc.gmk new file mode 100644 index 00000000000..2c1da32adbd --- /dev/null +++ b/mps/code/sc.gmk @@ -0,0 +1,20 @@ +# impl.gmk.sc: GNUMAKEFILE FRAGMENT FOR SunPro C +# +# $HopeName: MMsrc!sc.gmk(trunk.4) $ +# +# This file is included by platform makefiles that use the SunPro C +# compiler. It defines the compiler specific variables that the +# common makefile fragment (impl.gmk.comm) requires. See builder.sc for +# discussion of the various flags. + +# if cc isn't on your PATH, try looking in /opt/SUNWspro/bin and +# /opt/SUNWspro/SC*/bin +CC = cc +CFLAGSCOMPILER = -v -Xc +CFLAGSDEBUG = -g +# Note that combining -O and -g won't work on HP-UX +# (so what? do we expect to use SunPro C on HP-UX? -- drj 1998-02-18) +CFLAGSOPT = -O -g +CFLAGSOPTNODEBUG = -O + +include comm.gmk diff --git a/mps/code/seg.c b/mps/code/seg.c new file mode 100644 index 00000000000..50225429efe --- /dev/null +++ b/mps/code/seg.c @@ -0,0 +1,1653 @@ +/* impl.c.seg: SEGMENTS + * + * $HopeName: MMsrc!seg.c(trunk.29) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .design: The design for this module is design.mps.seg. + * + * PURPOSE + * + * .purpose: This is the implementation of the generic segment interface. + * It defines the interface functions and two useful segment classes: + * .purpose.class.seg: Class Seg is a class which is as simple + * as efficiency demands permit. (It includes fields for storing colour + * for efficiency). It may be subclassed by clients of the module. + * .purpose.class.seg-gc: Class GCSeg is a concrete class support all + * all current GC features, and providing full backwards compatibility + * with "old-style" segments. It may be subclassed by clients of the + * module. + * + * TRANSGRESSIONS + * + * .check.shield: The "pm", "sm", and "depth" fields are not checked by + * SegCheck, because I haven't spent time working out the invariants. + * We should certainly work them out, by studying impl.c.shield, and + * assert things about shielding, protection, shield cache consistency, + * etc. richard 1997-04-03 + */ + +#include "tract.h" +#include "mpm.h" + +SRCID(seg, "$HopeName: MMsrc!seg.c(trunk.29) $"); + + +/* SegGCSeg -- convert generic Seg to GCSeg */ + +#define SegGCSeg(seg) ((GCSeg)(seg)) + +/* SegPoolRing -- Pool ring accessor */ + +#define SegPoolRing(seg) (&(seg)->poolRing) + + +/* forward declarations */ + +static void SegFinish(Seg seg); + +static Res SegInit(Seg seg, Pool pool, Addr base, Size size, + Bool withReservoirPermit, va_list args); + + +/* Generic interface support */ + + +/* SegAlloc -- allocate a segment from the arena */ + +Res SegAlloc(Seg *segReturn, SegClass class, SegPref pref, + Size size, Pool pool, Bool withReservoirPermit, ...) +{ + Res res; + Arena arena; + Seg seg; + Addr base; + va_list args; + + AVER(segReturn != NULL); + AVERT(SegClass, class); + AVERT(SegPref, pref); + AVER(size > (Size)0); + AVERT(Pool, pool); + AVER(BoolCheck(withReservoirPermit)); + + arena = PoolArena(pool); + AVERT(Arena, arena); + AVER(SizeIsAligned(size, arena->alignment)); + + /* allocate the memory from the arena */ + res = ArenaAlloc(&base, pref, size, pool, withReservoirPermit); + if (res != ResOK) + goto failArena; + + /* allocate the segment object from the control pool */ + res = ControlAlloc((void **)&seg, arena, class->size, withReservoirPermit); + if (res != ResOK) + goto failControl; + + va_start(args, withReservoirPermit); + seg->class = class; + res = SegInit(seg, pool, base, size, withReservoirPermit, args); + va_end(args); + if (res != ResOK) + goto failInit; + + EVENT_PPAWP(SegAlloc, arena, seg, SegBase(seg), size, pool); + *segReturn = seg; + return ResOK; + +failInit: + ControlFree(arena, seg, class->size); +failControl: + ArenaFree(base, size, pool); +failArena: + EVENT_PWP(SegAllocFail, arena, size, pool); + return res; +} + + +/* SegFree -- free a segment to the arena */ + +void SegFree(Seg seg) +{ + Arena arena; + Pool pool; + Addr base; + Size size; + SegClass class; + + AVERT(Seg, seg); + pool = SegPool(seg); + AVERT(Pool, pool); + arena = PoolArena(pool); + AVERT(Arena, arena); + base = SegBase(seg); + size = SegSize(seg); + class = seg->class; + + SegFinish(seg); + ControlFree(arena, seg, class->size); + ArenaFree(base, size, pool); + + EVENT_PP(SegFree, arena, seg); + return; +} + + +/* SegInit -- initialize a segment */ + +static Res SegInit(Seg seg, Pool pool, Addr base, Size size, + Bool withReservoirPermit, va_list args) +{ + Tract tract; + Addr addr, limit; + Size align; + Arena arena; + SegClass class; + Res res; + + AVER(seg != NULL); + AVERT(Pool, pool); + arena = PoolArena(pool); + align = ArenaAlign(arena); + AVER(AddrIsAligned(base, align)); + AVER(SizeIsAligned(size, align)); + class = seg->class; + AVERT(SegClass, class); + AVER(BoolCheck(withReservoirPermit)); + + limit = AddrAdd(base, size); + seg->limit = limit; + seg->rankSet = RankSetEMPTY; + seg->white = TraceSetEMPTY; + seg->nailed = TraceSetEMPTY; + seg->grey = TraceSetEMPTY; + seg->pm = AccessSetEMPTY; + seg->sm = AccessSetEMPTY; + seg->depth = 0; + seg->firstTract = NULL; + + seg->sig = SegSig; /* set sig now so tract checks will see it */ + + TRACT_FOR(tract, addr, arena, base, limit) { + AVER(TractCheck(tract)); /* design.mps.check.type.no-sig */ + AVER(TractP(tract) == NULL); + AVER(!TractHasSeg(tract)); + AVER(TractPool(tract) == pool); + AVER(TractWhite(tract) == TraceSetEMPTY); + TRACT_SET_SEG(tract, seg); + if (addr == base) { + AVER(seg->firstTract == NULL); + seg->firstTract = tract; + } + AVER(seg->firstTract != NULL); + } + AVER(addr == seg->limit); + + RingInit(SegPoolRing(seg)); + + /* Class specific initialization comes last */ + res = class->init(seg, pool, base, size, withReservoirPermit, args); + if (res != ResOK) + goto failInit; + + AVERT(Seg, seg); + RingAppend(&pool->segRing, SegPoolRing(seg)); + return ResOK; + +failInit: + RingFinish(SegPoolRing(seg)); + TRACT_FOR(tract, addr, arena, base, limit) { + AVER(TractCheck(tract)); /* design.mps.check.type.no-sig */ + TRACT_UNSET_SEG(tract); + } + seg->sig = SigInvalid; + return res; +} + + +/* SegFinish -- finish a segment */ + +static void SegFinish(Seg seg) +{ + Arena arena; + Addr addr, base, limit; + Tract tract; + SegClass class; + + AVERT(Seg, seg); + class = seg->class; + AVERT(SegClass, class); + + arena = PoolArena(SegPool(seg)); + if (seg->sm != AccessSetEMPTY) { + ShieldLower(arena, seg, seg->sm); + } + + /* Class specific finishing cames first */ + class->finish(seg); + + seg->rankSet = RankSetEMPTY; + + /* See impl.c.shield.shield.flush */ + ShieldFlush(PoolArena(SegPool(seg))); + + base = SegBase(seg); + limit = SegLimit(seg); + TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, limit) { + AVER(TractCheck(tract)); /* design.mps.check.type.no-sig */ + TractSetWhite(tract, TraceSetEMPTY); + TRACT_UNSET_SEG(tract); + } + AVER(addr == seg->limit); + + RingRemove(SegPoolRing(seg)); + RingFinish(SegPoolRing(seg)); + + seg->sig = SigInvalid; + + /* Check that the segment is not exposed, or in the shield */ + /* cache (see impl.c.shield.def.depth). */ + AVER(seg->depth == 0); + /* Check not shielded or protected (so that pages in hysteresis */ + /* fund are not protected) */ + AVER(seg->sm == AccessSetEMPTY); + AVER(seg->pm == AccessSetEMPTY); + +} + + +/* SegSetGrey -- change the greyness of a segment + * + * Sets the segment greyness to the trace set grey. + */ + +void SegSetGrey(Seg seg, TraceSet grey) +{ + AVERT(Seg, seg); + AVER(TraceSetCheck(grey)); + seg->class->setGrey(seg, grey); +} + + +/* SegSetWhite -- change the whiteness of a segment + * + * Sets the segment whiteness to the trace set ts. + */ + +void SegSetWhite(Seg seg, TraceSet white) +{ + AVERT(Seg, seg); + AVER(TraceSetCheck(white)); + seg->class->setWhite(seg, white); +} + + +/* SegSetRankSet -- set the rank set of a segment + * + * The caller must set the summary to empty before setting the rank + * set to empty. The caller must set the rank set to non-empty before + * setting the summary to non-empty. + */ + +void SegSetRankSet(Seg seg, RankSet rankSet) +{ + AVERT(Seg, seg); + AVER(RankSetCheck(rankSet)); + seg->class->setRankSet(seg, rankSet); +} + + +/* SegSetSummary -- change the summary on a segment */ + +void SegSetSummary(Seg seg, RefSet summary) +{ + AVERT(Seg, seg); + +#ifdef PROTECTION_NONE + summary = RefSetUNIV; +#endif + seg->class->setSummary(seg, summary); +} + + +/* SegSetRankAndSummary -- set both the rank set and the summary */ + +void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary) +{ + AVERT(Seg, seg); + AVER(RankSetCheck(rankSet)); + +#ifdef PROTECTION_NONE + if (rankSet != RankSetEMPTY) { + summary = RefSetUNIV; + } +#endif + seg->class->setRankSummary(seg, rankSet, summary); +} + + +/* SegBuffer -- return the buffer of a segment */ + +Buffer SegBuffer(Seg seg) +{ + AVERT_CRITICAL(Seg, seg); /* .seg.critical */ + return seg->class->buffer(seg); +} + + +/* SegSetBuffer -- change the buffer on a segment */ + +void SegSetBuffer(Seg seg, Buffer buffer) +{ + AVERT(Seg, seg); + if (buffer != NULL) + AVERT(Buffer, buffer); + seg->class->setBuffer(seg, buffer); +} + + +/* SegDescribe -- describe a segment */ + +Res SegDescribe(Seg seg, mps_lib_FILE *stream) +{ + Res res; + Pool pool; + + if (!CHECKT(Seg, seg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + pool = SegPool(seg); + + res = WriteF(stream, + "Segment $P [$A,$A) {\n", (WriteFP)seg, + (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg), + " class $P (\"$S\")\n", + (WriteFP)seg->class, seg->class->name, + " pool $P ($U)\n", + (WriteFP)pool, (WriteFU)pool->serial, + NULL); + if (res != ResOK) return res; + + res = seg->class->describe(seg, stream); + if (res != ResOK) return res; + + res = WriteF(stream, "\n", + "} Segment $P\n", (WriteFP)seg, NULL); + return res; +} + + +/* .seg.critical: These seg functions are low-level and used + * through-out. They are therefore on the critical path and their + * AVERs are so-marked. + */ + +/* SegBase -- return the base address of a seg */ + +Addr (SegBase)(Seg seg) +{ + AVERT_CRITICAL(Seg, seg); + return SegBase(seg); +} + + +/* SegLimit -- return the limit address of a segment */ + +Addr (SegLimit)(Seg seg) +{ + AVERT_CRITICAL(Seg, seg); + return SegLimit(seg); +} + + +/* SegSize -- return the size of a seg */ + +Size SegSize(Seg seg) +{ + AVERT_CRITICAL(Seg, seg); + return AddrOffset(SegBase(seg), SegLimit(seg)); +} + + +/* SegOfAddr -- return the seg the given address is in, if any */ + +Bool SegOfAddr(Seg *segReturn, Arena arena, Addr addr) +{ + Tract tract; + AVER_CRITICAL(segReturn != NULL); /* .seg.critical */ + AVERT_CRITICAL(Arena, arena); /* .seg.critical */ + if (TractOfAddr(&tract, arena, addr)) { + return TRACT_SEG(segReturn, tract); + } else { + return FALSE; + } +} + + +/* SegFirst -- return the first seg in the arena + * + * This is used to start an iteration over all segs in the arena. + */ + +Bool SegFirst(Seg *segReturn, Arena arena) +{ + Tract tract; + AVER(segReturn != NULL); + AVERT(Arena, arena); + + if (TractFirst(&tract, arena)) { + do { + Seg seg; + if (TRACT_SEG(&seg, tract)) { + *segReturn = seg; + return TRUE; + } + } while (TractNext(&tract, arena, TractBase(tract))); + } + return FALSE; +} + + +/* SegNext -- return the "next" seg in the arena + * + * This is used as the iteration step when iterating over all + * segs in the arena. + * + * SegNext finds the seg with the lowest base address which is + * greater than a specified address. The address must be (or once + * have been) the base address of a seg. + */ + +Bool SegNext(Seg *segReturn, Arena arena, Addr addr) +{ + Tract tract; + Addr base = addr; + AVER_CRITICAL(segReturn != NULL); /* .seg.critical */ + AVERT_CRITICAL(Arena, arena); + + while (TractNext(&tract, arena, base)) { + Seg seg; + if (TRACT_SEG(&seg, tract)) { + if (tract == seg->firstTract) { + *segReturn = seg; + return TRUE; + } else { + /* found the next tract in a large segment */ + /* base & addr must be the base of this segment */ + AVER_CRITICAL(TractBase(seg->firstTract) == addr); + AVER_CRITICAL(addr == base); + /* set base to the last tract in the segment */ + base = AddrSub(seg->limit, ArenaAlign(arena)); + AVER_CRITICAL(base > addr); + } + } else { + base = TractBase(tract); + } + } + return FALSE; +} + + + +/* SegMerge -- Merge two adjacent segments + * + * See design.mps.seg.merge + */ + +Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi, + Bool withReservoirPermit, ...) +{ + SegClass class; + Addr base, mid, limit; + Arena arena; + Res res; + va_list args; + + AVER(NULL != mergedSegReturn); + AVERT(Seg, segLo); + AVERT(Seg, segHi); + class = segLo->class; + AVER(segHi->class == class); + AVER(SegPool(segLo) == SegPool(segHi)); + base = SegBase(segLo); + mid = SegLimit(segLo); + limit = SegLimit(segHi); + AVER(SegBase(segHi) == SegLimit(segLo)); + AVER(BoolCheck(withReservoirPermit)); + arena = PoolArena(SegPool(segLo)); + + ShieldFlush(arena); /* see design.mps.seg.split-merge.shield */ + + /* Invoke class-specific methods to do the merge */ + va_start(args, withReservoirPermit); + res = class->merge(segLo, segHi, base, mid, limit, + withReservoirPermit, args); + va_end(args); + if (ResOK != res) + goto failMerge; + + EVENT_PPP(SegMerge, segLo, segLo, segHi); + /* Deallocate segHi object */ + ControlFree(arena, segHi, class->size); + AVERT(Seg, segLo); + *mergedSegReturn = segLo; + return ResOK; + +failMerge: + AVERT(Seg, segLo); /* check original segs are still valid */ + AVERT(Seg, segHi); + return res; +} + + +/* SegSplit -- Split a segment + * + * The segment is split at the indicated position. + * See design.mps.seg.split + */ + +Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at, + Bool withReservoirPermit, ...) +{ + Addr base, limit; + SegClass class; + Seg segNew; + Arena arena; + Res res; + va_list args; + + AVER(NULL != segLoReturn); + AVER(NULL != segHiReturn); + AVERT(Seg, seg); + class = seg->class; + arena = PoolArena(SegPool(seg)); + base = SegBase(seg); + limit = SegLimit(seg); + AVERT(Arena, arena); + AVER(AddrIsAligned(at, arena->alignment)); + AVER(at > base); + AVER(at < limit); + AVER(BoolCheck(withReservoirPermit)); + + ShieldFlush(arena); /* see design.mps.seg.split-merge.shield */ + + /* Allocate the new segment object from the control pool */ + res = ControlAlloc((void **)&segNew, arena, class->size, + withReservoirPermit); + if (ResOK != res) + goto failControl; + + /* Invoke class-specific methods to do the split */ + va_start(args, withReservoirPermit); + res = class->split(seg, segNew, base, at, limit, + withReservoirPermit, args); + va_end(args); + if (ResOK != res) + goto failSplit; + + EVENT_PPPA(SegSplit, seg, segNew, seg, at); + AVERT(Seg, seg); + AVERT(Seg, segNew); + *segLoReturn = seg; + *segHiReturn = segNew; + return ResOK; + +failSplit: + ControlFree(arena, segNew, class->size); +failControl: + AVERT(Seg, seg); /* check the original seg is still valid */ + return res; +} + + +/* Class Seg -- The most basic segment class + * + * .seg.method.check: Many seg methods are lightweight and used + * frequently. Their parameters are checked by the corresponding + * dispatching function, and so the their parameter AVERs are + * marked as critical. + */ + + +/* SegCheck -- check the integrity of a segment */ + +Bool SegCheck(Seg seg) +{ + Tract tract; + Arena arena; + Pool pool; + Addr addr; + Size align; + + CHECKS(Seg, seg); + CHECKL(TraceSetCheck(seg->white)); + + /* can't assume nailed is subset of white - mightn't be during whiten */ + /* CHECKL(TraceSetSub(seg->nailed, seg->white)); */ + CHECKL(TraceSetCheck(seg->grey)); + CHECKL(TractCheck(seg->firstTract)); /* design.mps.check.type.no-sig */ + pool = SegPool(seg); + CHECKU(Pool, pool); + arena = PoolArena(pool); + CHECKU(Arena, arena); + align = ArenaAlign(arena); + CHECKL(AddrIsAligned(TractBase(seg->firstTract), align)); + CHECKL(AddrIsAligned(seg->limit, align)); + CHECKL(seg->limit > TractBase(seg->firstTract)); + + /* Each tract of the segment must agree about white traces */ + TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) { + Seg trseg; + + UNUSED(trseg); /* @@@@ unused in hot varieties */ + CHECKL(TractCheck(tract)); /* design.mps.check.type.no-sig */ + CHECKL(TRACT_SEG(&trseg, tract) && (trseg == seg)); + CHECKL(TractWhite(tract) == seg->white); + CHECKL(TractPool(tract) == pool); + } + CHECKL(addr == seg->limit); + + /* The segment must belong to some pool, so it should be on a */ + /* pool's segment ring. (Actually, this isn't true just after */ + /* the segment is initialized.) */ + /* CHECKL(RingNext(&seg->poolRing) != &seg->poolRing); */ + + CHECKL(RingCheck(&seg->poolRing)); + + /* "pm", "sm", and "depth" not checked. See .check.shield. */ + CHECKL(RankSetCheck(seg->rankSet)); + if (seg->rankSet == RankSetEMPTY) { + /* design.mps.seg.field.rankSet.empty: If there are no refs */ + /* in the segment then it cannot contain black or grey refs. */ + CHECKL(seg->grey == TraceSetEMPTY); + CHECKL(seg->sm == AccessSetEMPTY); + CHECKL(seg->pm == AccessSetEMPTY); + } else { + /* design.mps.seg.field.rankSet.single: The Tracer only permits */ + /* one rank per segment [ref?] so this field is either empty or a */ + /* singleton. */ + CHECKL(RankSetIsSingle(seg->rankSet)); + /* Can't check barrier invariants because SegCheck is called */ + /* when raising or lowering the barrier. */ + /* .check.wb: If summary isn't universal then it must be */ + /* write shielded. */ + /* CHECKL(seg->_summary == RefSetUNIV || (seg->_sm & AccessWRITE)); */ + /* @@@@ What can be checked about the read barrier? */ + } + return TRUE; +} + + +/* segTrivInit -- method to initialize the base fields of a segment */ + +static Res segTrivInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + /* all the initialization happens in SegInit so checks are safe */ + Size align; + Arena arena; + + AVERT(Seg, seg); + AVERT(Pool, pool); + arena = PoolArena(pool); + align = ArenaAlign(arena); + AVER(AddrIsAligned(base, align)); + AVER(SizeIsAligned(size, align)); + AVER(SegBase(seg) == base); + AVER(SegSize(seg) == size); + AVER(SegPool(seg) == pool); + AVER(BoolCheck(reservoirPermit)); + UNUSED(args); + return ResOK; +} + + +/* segTrivFinish -- finish the base fields of a segment */ + +static void segTrivFinish(Seg seg) +{ + /* all the generic finishing happens in SegFinish */ + AVERT(Seg, seg); +} + + +/* segNoSetGrey -- non-method to change the greyness of a segment */ + +static void segNoSetGrey(Seg seg, TraceSet grey) +{ + AVERT(Seg, seg); + AVER(TraceSetCheck(grey)); + AVER(seg->rankSet != RankSetEMPTY); + NOTREACHED; +} + + +/* segNoSetWhite -- non-method to change the whiteness of a segment */ + +static void segNoSetWhite(Seg seg, TraceSet white) +{ + AVERT(Seg, seg); + AVER(TraceSetCheck(white)); + NOTREACHED; +} + + +/* segNoSetRankSet -- non-method to set the rank set of a segment */ + +static void segNoSetRankSet(Seg seg, RankSet rankSet) +{ + AVERT(Seg, seg); + AVER(RankSetCheck(rankSet)); + NOTREACHED; +} + + +/* segNoSetSummary -- non-method to set the summary of a segment */ + +static void segNoSetSummary(Seg seg, RefSet summary) +{ + AVERT(Seg, seg); + UNUSED(summary); + NOTREACHED; +} + + +/* segNoSetRankSummary -- non-method to set the rank set & summary */ + +static void segNoSetRankSummary(Seg seg, RankSet rankSet, RefSet summary) +{ + AVERT(Seg, seg); + AVER(RankSetCheck(rankSet)); + UNUSED(summary); + NOTREACHED; +} + + +/* segNoBuffer -- non-method to return the buffer of a segment */ + +static Buffer segNoBuffer(Seg seg) +{ + AVERT(Seg, seg); + NOTREACHED; + return NULL; +} + + +/* segNoSetBuffer -- non-method to set the buffer of a segment */ + +static void segNoSetBuffer(Seg seg, Buffer buffer) +{ + AVERT(Seg, seg); + if (buffer != NULL) + AVERT(Buffer, buffer); + NOTREACHED; +} + + + +/* segNoMerge -- merge method for segs which don't support merge */ + +static Res segNoMerge(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + AVERT(Seg, seg); + AVERT(Seg, segHi); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == mid); + AVER(SegBase(segHi) == mid); + AVER(SegLimit(segHi) == limit); + AVER(BoolCheck(withReservoirPermit)); + UNUSED(args); + NOTREACHED; + return ResFAIL; +} + + +/* segTrivMerge -- Basic Seg merge method + * + * .similar: Segments must be "sufficiently similar". + * See design.mps.seg.merge.inv.similar + */ + +static Res segTrivMerge(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + Pool pool; + Size align; + Arena arena; + Tract tract; + Addr addr; + + AVERT(Seg, seg); + AVERT(Seg, segHi); + pool = SegPool(seg); + arena = PoolArena(pool); + align = ArenaAlign(arena); + AVER(AddrIsAligned(base, align)); + AVER(AddrIsAligned(mid, align)); + AVER(AddrIsAligned(limit, align)); + AVER(base < mid); + AVER(mid < limit); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == mid); + AVER(SegBase(segHi) == mid); + AVER(SegLimit(segHi) == limit); + AVER(BoolCheck(withReservoirPermit)); + UNUSED(args); + + /* .similar. */ + AVER(seg->rankSet == segHi->rankSet); + AVER(seg->white == segHi->white); + AVER(seg->nailed == segHi->nailed); + AVER(seg->grey == segHi->grey); + AVER(seg->pm == segHi->pm); + AVER(seg->sm == segHi->sm); + AVER(seg->depth == segHi->depth); + /* Neither segment may be exposed, or in the shield cache */ + /* See design.mps.seg.split-merge.shield & impl.c.shield.def.depth */ + AVER(seg->depth == 0); + + /* no need to update fields which match. See .similar */ + + seg->limit = limit; + TRACT_FOR(tract, addr, arena, mid, limit) { + AVER(TractCheck(tract)); /* design.mps.check.type.no-sig */ + AVER(TractHasSeg(tract)); + AVER(segHi == TractP(tract)); + AVER(TractPool(tract) == pool); + TRACT_SET_SEG(tract, seg); + } + AVER(addr == seg->limit); + + /* Finish segHi. */ + RingRemove(SegPoolRing(segHi)); + RingFinish(SegPoolRing(segHi)); + segHi->sig = SigInvalid; + + AVERT(Seg, seg); + return ResOK; +} + + +/* segNoSplit -- split method for segs which don't support splitting */ + +static Res segNoSplit(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + AVERT(Seg, seg); + AVER(segHi != NULL); /* can't check fully, it's not initialized */ + AVER(base < mid); + AVER(mid < limit); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == limit); + AVER(BoolCheck(withReservoirPermit)); + UNUSED(args); + NOTREACHED; + return ResFAIL; + +} + + +/* segTrivSplit -- Basic Seg split method */ + +static Res segTrivSplit(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + Tract tract; + Pool pool; + Addr addr; + Size align; + Arena arena; + + AVERT(Seg, seg); + AVER(segHi != NULL); /* can't check fully, it's not initialized */ + pool = SegPool(seg); + arena = PoolArena(pool); + align = ArenaAlign(arena); + AVER(AddrIsAligned(base, align)); + AVER(AddrIsAligned(mid, align)); + AVER(AddrIsAligned(limit, align)); + AVER(base < mid); + AVER(mid < limit); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == limit); + AVER(BoolCheck(withReservoirPermit)); + UNUSED(args); + + /* Segment may not be exposed, or in the shield cache */ + /* See design.mps.seg.split-merge.shield & impl.c.shield.def.depth */ + AVER(seg->depth == 0); + + /* Full initialization for segHi. Just modify seg. */ + seg->limit = mid; + segHi->limit = limit; + segHi->rankSet = seg->rankSet; + segHi->white = seg->white; + segHi->nailed = seg->nailed; + segHi->grey = seg->grey; + segHi->pm = seg->pm; + segHi->sm = seg->sm; + segHi->depth = seg->depth; + segHi->firstTract = NULL; + segHi->class = seg->class; + segHi->sig = SegSig; + RingInit(SegPoolRing(segHi)); + + TRACT_FOR(tract, addr, arena, mid, limit) { + AVER(TractCheck(tract)); /* design.mps.check.type.no-sig */ + AVER(TractHasSeg(tract)); + AVER(seg == TractP(tract)); + AVER(TractPool(tract) == pool); + TRACT_SET_SEG(tract, segHi); + if (addr == mid) { + AVER(segHi->firstTract == NULL); + segHi->firstTract = tract; + } + AVER(segHi->firstTract != NULL); + } + AVER(addr == segHi->limit); + + RingAppend(&pool->segRing, SegPoolRing(segHi)); + AVERT(Seg, seg); + AVERT(Seg, segHi); + return ResOK; +} + + +/* segTrivDescribe -- Basic Seg description method */ + +static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream) +{ + Res res; + + if (!CHECKT(Seg, seg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, + " shield depth $U\n", (WriteFU)seg->depth, + " protection mode:", + NULL); + if (res != ResOK) return res; + if (SegPM(seg) & AccessREAD) { + res = WriteF(stream, " read", NULL); + if (res != ResOK) return res; + } + if (SegPM(seg) & AccessWRITE) { + res = WriteF(stream, " write", NULL); + if (res != ResOK) return res; + } + res = WriteF(stream, "\n shield mode:", NULL); + if (res != ResOK) return res; + if (SegSM(seg) & AccessREAD) { + res = WriteF(stream, " read", NULL); + if (res != ResOK) return res; + } + if (SegSM(seg) & AccessWRITE) { + res = WriteF(stream, " write", NULL); + if (res != ResOK) return res; + } + res = WriteF(stream, "\n ranks:", NULL); + /* This bit ought to be in a RankSetDescribe in ref.c. */ + if (RankSetIsMember(seg->rankSet, RankAMBIG)) { + res = WriteF(stream, " ambiguous", NULL); + if (res != ResOK) return res; + } + if (RankSetIsMember(seg->rankSet, RankEXACT)) { + res = WriteF(stream, " exact", NULL); + if (res != ResOK) return res; + } + if (RankSetIsMember(seg->rankSet, RankFINAL)) { + res = WriteF(stream, " final", NULL); + if (res != ResOK) return res; + } + if (RankSetIsMember(seg->rankSet, RankWEAK)) { + res = WriteF(stream, " weak", NULL); + if (res != ResOK) return res; + } + res = WriteF(stream, "\n", + " white $B\n", (WriteFB)seg->white, + " grey $B\n", (WriteFB)seg->grey, + " nailed $B\n", (WriteFB)seg->nailed, + NULL); + return res; +} + + +/* Class GCSeg -- Segment class with GC support + */ + + +/* GCSegCheck -- check the integrity of a GCSeg */ + +Bool GCSegCheck(GCSeg gcseg) +{ + Seg seg; + CHECKS(GCSeg, gcseg); + seg = &gcseg->segStruct; + CHECKL(SegCheck(seg)); + + if (gcseg->buffer != NULL) { + CHECKU(Buffer, gcseg->buffer); + /* design.mps.seg.field.buffer.owner */ + CHECKL(BufferPool(gcseg->buffer) == SegPool(seg)); + CHECKL(BufferRankSet(gcseg->buffer) == SegRankSet(seg)); + } + + /* The segment should be on a grey ring if and only if it is grey. */ + CHECKL(RingCheck(&gcseg->greyRing)); + CHECKL((seg->grey == TraceSetEMPTY) == + RingIsSingle(&gcseg->greyRing)); + + if (seg->rankSet == RankSetEMPTY) { + /* design.mps.seg.field.rankSet.empty */ + CHECKL(gcseg->summary == RefSetEMPTY); + } + + return TRUE; +} + + +/* gcSegInit -- method to initialize a GC segment */ + +static Res gcSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + GCSeg gcseg; + Arena arena; + Align align; + Res res; + + AVERT(Seg, seg); + AVERT(Pool, pool); + arena = PoolArena(pool); + align = ArenaAlign(arena); + AVER(AddrIsAligned(base, align)); + AVER(SizeIsAligned(size, align)); + gcseg = SegGCSeg(seg); + AVER(&gcseg->segStruct == seg); + AVER(BoolCheck(withReservoirPermit)); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(GCSegClass); + res = super->init(seg, pool, base, size, withReservoirPermit, args); + if (ResOK != res) + return res; + + gcseg->summary = RefSetEMPTY; + gcseg->buffer = NULL; + RingInit(&gcseg->greyRing); + gcseg->sig = GCSegSig; + + AVERT(GCSeg, gcseg); + return ResOK; +} + + +/* gcSegFinish -- finish a GC segment */ + +static void gcSegFinish(Seg seg) +{ + SegClass super; + GCSeg gcseg; + + AVERT(Seg, seg); + gcseg = SegGCSeg(seg); + AVERT(GCSeg, gcseg); + AVER(&gcseg->segStruct == seg); + + if (SegGrey(seg) != TraceSetEMPTY) { + RingRemove(&gcseg->greyRing); + seg->grey = TraceSetEMPTY; + } + gcseg->summary = RefSetEMPTY; + + gcseg->sig = SigInvalid; + + /* Don't leave a dangling buffer allocating into hyperspace. */ + AVER(gcseg->buffer == NULL); + + RingFinish(&gcseg->greyRing); + + /* finish the superclass fields last */ + super = SEG_SUPERCLASS(GCSegClass); + super->finish(seg); +} + + +/* gcSegSetGreyInternal -- change the greyness of a segment + * + * Internal method for updating the greyness of a GCSeg. + * Updates the grey ring and the grey seg count. + * Doesn't affect the shield (so it can be used by split + * & merge methods). + */ + +static void gcSegSetGreyInternal(Seg seg, TraceSet oldGrey, TraceSet grey) +{ + GCSeg gcseg; + Arena arena; + Rank rank; + + /* Internal method. Parameters are checked by caller */ + gcseg = SegGCSeg(seg); + arena = PoolArena(SegPool(seg)); + seg->grey = grey; + + /* If the segment is now grey and wasn't before, add it to the */ + /* appropriate grey list so that TraceFindGrey can locate it */ + /* quickly later. If it is no longer grey and was before, */ + /* remove it from the list. */ + if (oldGrey == TraceSetEMPTY) { + if (grey != TraceSetEMPTY) { + AVER(RankSetIsSingle(seg->rankSet)); + for(rank = 0; rank < RankLIMIT; ++rank) + if (RankSetIsMember(seg->rankSet, rank)) { + RingInsert(ArenaGreyRing(arena, rank), &gcseg->greyRing); + break; + } + AVER(rank != RankLIMIT); /* there should've been a match */ + } + } else { + if (grey == TraceSetEMPTY) + RingRemove(&gcseg->greyRing); + } + + STATISTIC_STAT + ({ + TraceId ti; Trace trace; + TraceSet diff; + + diff = TraceSetDiff(grey, oldGrey); + TRACE_SET_ITER(ti, trace, diff, arena) + ++trace->greySegCount; + if (trace->greySegCount > trace->greySegMax) + trace->greySegMax = trace->greySegCount; + TRACE_SET_ITER_END(ti, trace, diff, arena); + + diff = TraceSetDiff(oldGrey, grey); + TRACE_SET_ITER(ti, trace, diff, arena) + --trace->greySegCount; + TRACE_SET_ITER_END(ti, trace, diff, arena); + }); + +} + + +/* gcSegSetGrey -- GCSeg method to change the greyness of a segment + * + * Sets the segment greyness to the trace set grey and adjusts + * the shielding on the segment appropriately. + */ + +static void gcSegSetGrey(Seg seg, TraceSet grey) +{ + GCSeg gcseg; + TraceSet oldGrey, flippedTraces; + Arena arena; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + AVER_CRITICAL(TraceSetCheck(grey)); /* .seg.method.check */ + AVER(seg->rankSet != RankSetEMPTY); + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + UNUSED(gcseg); + + arena = PoolArena(SegPool(seg)); + oldGrey = seg->grey; + gcSegSetGreyInternal(seg, oldGrey, grey); /* do the work */ + + /* The read barrier is raised when the segment is grey for */ + /* some _flipped_ trace, i.e., is grey for a trace for which */ + /* the mutator is black. */ + flippedTraces = arena->flippedTraces; + if (TraceSetInter(oldGrey, flippedTraces) == TraceSetEMPTY) { + if (TraceSetInter(grey, flippedTraces) != TraceSetEMPTY) + ShieldRaise(arena, seg, AccessREAD); + } else { + if (TraceSetInter(grey, flippedTraces) == TraceSetEMPTY) + ShieldLower(arena, seg, AccessREAD); + } + + EVENT_PPU(SegSetGrey, arena, seg, grey); +} + + +/* gcSegSetWhite -- GCSeg method to change whiteness of a segment + * + * Sets the segment whiteness to the trace set ts. + */ + +static void gcSegSetWhite(Seg seg, TraceSet white) +{ + GCSeg gcseg; + Tract tract; + Arena arena; + Addr addr, limit; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + AVER_CRITICAL(TraceSetCheck(white)); /* .seg.method.check */ + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + + arena = PoolArena(SegPool(seg)); + AVERT_CRITICAL(Arena, arena); + limit = SegLimit(seg); + /* Each tract of the segment records white traces */ + TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, limit) { + Seg trseg; + + UNUSED(trseg); /* @@@@ hack: unused in hot varieties */ + AVER_CRITICAL(TractCheck(tract)); /* design.mps.check.type.no-sig */ + AVER_CRITICAL(TRACT_SEG(&trseg, tract) && (trseg == seg)); + TractSetWhite(tract, white); + } + AVER(addr == limit); + + seg->white = white; +} + + +/* gcSegSetRankSet -- GCSeg method to set the rank set of a segment + * + * If the rank set is made non-empty then the segment's summary is + * now a subset of the mutator's (which is assumed to be RefSetUNIV) + * so the write barrier must be imposed on the segment. If the + * rank set is made empty then there are no longer any references + * on the segment so the barrier is removed. + * + * The caller must set the summary to empty before setting the rank + * set to empty. The caller must set the rank set to non-empty before + * setting the summary to non-empty. + */ + +static void gcSegSetRankSet(Seg seg, RankSet rankSet) +{ + GCSeg gcseg; + RankSet oldRankSet; + Arena arena; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + AVER_CRITICAL(RankSetCheck(rankSet)); /* .seg.method.check */ + AVER_CRITICAL(rankSet == RankSetEMPTY + || RankSetIsSingle(rankSet)); /* .seg.method.check */ + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + + arena = PoolArena(SegPool(seg)); + oldRankSet = seg->rankSet; + seg->rankSet = rankSet; + + if (oldRankSet == RankSetEMPTY) { + if (rankSet != RankSetEMPTY) { + AVER(gcseg->summary == RefSetEMPTY); + ShieldRaise(arena, seg, AccessWRITE); + } + } else { + if (rankSet == RankSetEMPTY) { + AVER(gcseg->summary == RefSetEMPTY); + ShieldLower(arena, seg, AccessWRITE); + } + } +} + + +/* gcSegSetSummary -- GCSeg method to change the summary on a segment + * + * In fact, we only need to raise the write barrier if the + * segment contains references, and its summary is strictly smaller + * than the summary of the unprotectable data (i.e. the mutator). + * We don't maintain such a summary, assuming that the mutator can + * access all references, so its summary is RefSetUNIV. + */ + +static void gcSegSetSummary(Seg seg, RefSet summary) +{ + GCSeg gcseg; + RefSet oldSummary; + Arena arena; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + + arena = PoolArena(SegPool(seg)); + oldSummary = gcseg->summary; + gcseg->summary = summary; + + AVER(seg->rankSet != RankSetEMPTY); + + /* Note: !RefSetSuper is a test for a strict subset */ + if (!RefSetSuper(summary, RefSetUNIV)) { + if (RefSetSuper(oldSummary, RefSetUNIV)) + ShieldRaise(arena, seg, AccessWRITE); + } else { + if (!RefSetSuper(oldSummary, RefSetUNIV)) + ShieldLower(arena, seg, AccessWRITE); + } +} + + +/* gcSegSetRankSummary -- GCSeg method to set both rank set and summary */ + +static void gcSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary) +{ + GCSeg gcseg; + Bool wasShielded, willbeShielded; + Arena arena; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + AVER_CRITICAL(RankSetCheck(rankSet)); /* .seg.method.check */ + AVER_CRITICAL(rankSet == RankSetEMPTY + || RankSetIsSingle(rankSet)); /* .seg.method.check */ + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + + /* rankSet == RankSetEMPTY implies summary == RefSetEMPTY */ + AVER(rankSet != RankSetEMPTY || summary == RefSetEMPTY); + + arena = PoolArena(SegPool(seg)); + + wasShielded = (seg->rankSet != RankSetEMPTY && gcseg->summary != RefSetUNIV); + willbeShielded = (rankSet != RankSetEMPTY && summary != RefSetUNIV); + + seg->rankSet = rankSet; + gcseg->summary = summary; + + if (willbeShielded && !wasShielded) { + ShieldRaise(arena, seg, AccessWRITE); + } else if (wasShielded && !willbeShielded) { + ShieldLower(arena, seg, AccessWRITE); + } +} + + +/* gcSegBuffer -- GCSeg method to return the buffer of a segment */ + +static Buffer gcSegBuffer(Seg seg) +{ + GCSeg gcseg; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); /* .seg.method.check */ + AVER_CRITICAL(&gcseg->segStruct == seg); + + return gcseg->buffer; +} + + +/* gcSegSetBuffer -- GCSeg method to change the buffer of a segment */ + +static void gcSegSetBuffer(Seg seg, Buffer buffer) +{ + GCSeg gcseg; + + AVERT_CRITICAL(Seg, seg); /* .seg.method.check */ + if (buffer != NULL) + AVERT_CRITICAL(Buffer, buffer); + gcseg = SegGCSeg(seg); + AVERT_CRITICAL(GCSeg, gcseg); + AVER_CRITICAL(&gcseg->segStruct == seg); + + gcseg->buffer = buffer; +} + + +/* gcSegMerge -- GCSeg merge method + * + * .buffer: Can't merge two segments both with buffers. + * See design.mps.seg.merge.inv.buffer. + */ + +static Res gcSegMerge(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + GCSeg gcseg, gcsegHi; + TraceSet grey; + RefSet summary; + Buffer buf; + Res res; + + AVERT(Seg, seg); + AVERT(Seg, segHi); + gcseg = SegGCSeg(seg); + gcsegHi = SegGCSeg(segHi); + AVERT(GCSeg, gcseg); + AVERT(GCSeg, gcsegHi); + AVER(base < mid); + AVER(mid < limit); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == mid); + AVER(SegBase(segHi) == mid); + AVER(SegLimit(segHi) == limit); + AVER(BoolCheck(withReservoirPermit)); + + buf = gcsegHi->buffer; /* any buffer on segHi must be reassigned */ + AVER(buf == NULL || gcseg->buffer == NULL); /* See .buffer */ + grey = SegGrey(segHi); /* check greyness */ + AVER(SegGrey(seg) == grey); + + /* Merge the superclass fields via next-method call */ + super = SEG_SUPERCLASS(GCSegClass); + res = super->merge(seg, segHi, base, mid, limit, + withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + /* Update fields of gcseg. Finish gcsegHi. */ + summary = RefSetUnion(gcseg->summary, gcsegHi->summary); + if (summary != gcseg->summary) { + gcSegSetSummary(seg, summary); + /* design.mps.seg.split-merge.shield.re-flush */ + ShieldFlush(PoolArena(SegPool(seg))); + } + + gcSegSetGreyInternal(segHi, grey, TraceSetEMPTY); + gcsegHi->summary = RefSetEMPTY; + gcsegHi->sig = SigInvalid; + RingFinish(&gcsegHi->greyRing); + + /* Reassign any buffer that was connected to segHi */ + if (NULL != buf) { + AVER(gcseg->buffer == NULL); + gcseg->buffer = buf; + gcsegHi->buffer = NULL; + BufferReassignSeg(buf, seg); + } + + AVERT(GCSeg, gcseg); + return ResOK; + +failSuper: + AVERT(GCSeg, gcseg); + AVERT(GCSeg, gcsegHi); + return res; +} + + +/* gcSegSplit -- GCSeg split method */ + +static Res gcSegSplit(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + GCSeg gcseg, gcsegHi; + Buffer buf; + TraceSet grey; + Res res; + + AVERT(Seg, seg); + AVER(segHi != NULL); /* can't check fully, it's not initialized */ + gcseg = SegGCSeg(seg); + gcsegHi = SegGCSeg(segHi); + AVERT(GCSeg, gcseg); + AVER(base < mid); + AVER(mid < limit); + AVER(SegBase(seg) == base); + AVER(SegLimit(seg) == limit); + AVER(BoolCheck(withReservoirPermit)); + + grey = SegGrey(seg); + buf = gcseg->buffer; /* Look for buffer to reassign to segHi */ + if (buf != NULL) { + if (BufferLimit(buf) > mid) { + /* Existing buffer extends above the split point */ + AVER(BufferBase(buf) > mid); /* check it's all above the split */ + } else { + buf = NULL; /* buffer lies below split and is unaffected */ + } + } + + /* Split the superclass fields via next-method call */ + super = SEG_SUPERCLASS(GCSegClass); + res = super->split(seg, segHi, base, mid, limit, + withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + /* Full initialization for segHi. */ + gcsegHi->summary = gcseg->summary; + gcsegHi->buffer = NULL; + RingInit(&gcsegHi->greyRing); + gcsegHi->sig = GCSegSig; + gcSegSetGreyInternal(segHi, TraceSetEMPTY, grey); + + /* Reassign buffer if it's now connected to segHi */ + if (NULL != buf) { + gcsegHi->buffer = buf; + gcseg->buffer = NULL; + BufferReassignSeg(buf, segHi); + } + + AVERT(GCSeg, gcseg); + AVERT(GCSeg, gcsegHi); + return ResOK; + +failSuper: + AVERT(GCSeg, gcseg); + return res; +} + + +/* gcSegDescribe -- GCSeg description method */ + +static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream) +{ + Res res; + SegClass super; + GCSeg gcseg; + + if (!CHECKT(Seg, seg)) return ResFAIL; + if (stream == NULL) return ResFAIL; + gcseg = SegGCSeg(seg); + if (!CHECKT(GCSeg, gcseg)) return ResFAIL; + + /* Describe the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(GCSegClass); + res = super->describe(seg, stream); + if (res != ResOK) return res; + + if (gcseg->buffer != NULL) { + res = BufferDescribe(gcseg->buffer, stream); + if (res != ResOK) return res; + } + res = WriteF(stream, + " summary $W\n", (WriteFW)gcseg->summary, + NULL); + return res; +} + + +/* SegClassCheck -- check a segment class */ + +Bool SegClassCheck(SegClass class) +{ + CHECKL(ProtocolClassCheck(&class->protocol)); + CHECKL(class->name != NULL); /* Should be <= 6 char C identifier */ + CHECKL(class->size >= sizeof(SegStruct)); + CHECKL(FUNCHECK(class->init)); + CHECKL(FUNCHECK(class->finish)); + CHECKL(FUNCHECK(class->setGrey)); + CHECKL(FUNCHECK(class->setWhite)); + CHECKL(FUNCHECK(class->setRankSet)); + CHECKL(FUNCHECK(class->setRankSummary)); + CHECKL(FUNCHECK(class->merge)); + CHECKL(FUNCHECK(class->split)); + CHECKL(FUNCHECK(class->describe)); + CHECKS(SegClass, class); + return TRUE; +} + + +/* SegClass -- the vanilla segment class definition */ + +DEFINE_CLASS(SegClass, class) +{ + INHERIT_CLASS(&class->protocol, ProtocolClass); + class->name = "SEG"; + class->size = sizeof(SegStruct); + class->init = segTrivInit; + class->finish = segTrivFinish; + class->setSummary = segNoSetSummary; + class->buffer = segNoBuffer; + class->setBuffer = segNoSetBuffer; + class->setGrey = segNoSetGrey; + class->setWhite = segNoSetWhite; + class->setRankSet = segNoSetRankSet; + class->setRankSummary = segNoSetRankSummary; + class->merge = segTrivMerge; + class->split = segTrivSplit; + class->describe = segTrivDescribe; + class->sig = SegClassSig; +} + + +/* GCSegClass -- GC-supporting segment class definition */ + +typedef SegClassStruct GCSegClassStruct; + +DEFINE_CLASS(GCSegClass, class) +{ + INHERIT_CLASS(class, SegClass); + class->name = "GCSEG"; + class->size = sizeof(GCSegStruct); + class->init = gcSegInit; + class->finish = gcSegFinish; + class->setSummary = gcSegSetSummary; + class->buffer = gcSegBuffer; + class->setBuffer = gcSegSetBuffer; + class->setGrey = gcSegSetGrey; + class->setWhite = gcSegSetWhite; + class->setRankSet = gcSegSetRankSet; + class->setRankSummary = gcSegSetRankSummary; + class->merge = gcSegMerge; + class->split = gcSegSplit; + class->describe = gcSegDescribe; +} + + +/* SegClassMixInNoSplitMerge -- Mix-in for unsupported merge + * + * Classes which don't support segment splitting and merging + * may mix this in to ensure that erroneous calls are checked. + */ + +void SegClassMixInNoSplitMerge(SegClass class) +{ + /* Can't check class because it's not initialized yet */ + class->merge = segNoMerge; + class->split = segNoSplit; +} diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c new file mode 100644 index 00000000000..ba557fc6378 --- /dev/null +++ b/mps/code/segsmss.c @@ -0,0 +1,860 @@ +/* impl.c.segsmss: Segment splitting and merging stress test + * + * $HopeName: MMsrc!segsmss.c(trunk.7) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: Adapted from amsss.c (because AMS already supports + * a protocol for subclassing AMS segments). Defines a new pool + * class, AMST. Segments are split and merged during BufferFill + * operations. Buffered segments are also split and merged between + * allocation requests. + */ + +#include "mpm.h" +#include "poolams.h" +#include "fmtdy.h" +#include "testlib.h" +#include "chain.h" +#include "mpscams.h" +#include "mpsavm.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include "mps.h" +#include +#include +#include +#include + + +/* Forward declarations */ + +static SegClass AMSTSegClassGet(void); +static PoolClass AMSTPoolClassGet(void); + + +/* Start by defining the AMST pool (AMS Test pool) */ + +#define AMSTSig ((Sig)0x519A3529) /* SIGnature AMST */ + +/* AMSTStruct -- AMST pool instance structure */ + +typedef struct AMSTStruct { + AMSStruct amsStruct; /* generic AMS structure */ + Chain chain; /* chain to use */ + Bool failSegs; /* fail seg splits & merges when true */ + Count splits; /* count of successful segment splits */ + Count merges; /* count of successful segment merges */ + Count badSplits; /* count of unsuccessful segment splits */ + Count badMerges; /* count of unsuccessful segment merges */ + Count bsplits; /* count of buffered segment splits */ + Count bmerges; /* count of buffered segment merges */ + Sig sig; /* design.mps.pool.outer-structure.sig */ +} AMSTStruct; + +typedef struct AMSTStruct *AMST; + +#define Pool2AMST(pool) PARENT(AMSTStruct, amsStruct.poolStruct, (pool)) +#define AMST2AMS(amst) (&(amst)->amsStruct) + + +/* AMSTCheck -- the check method for an AMST */ + +static Bool AMSTCheck(AMST amst) +{ + CHECKS(AMST, amst); + CHECKL(AMSCheck(AMST2AMS(amst))); + return TRUE; +} + +/* AMSTFailOperation -- should a split/merge operation fail? + * + * returns TRUE if so. + */ +static Bool AMSTFailOperation(AMST amst) +{ + if (amst->failSegs) { + return rnd() % 2; + } else { + return FALSE; + } +} + +/* AMSTSegStruct: AMST segment instances */ + +#define AMSTSegSig ((Sig)0x519A3525) /* SIGnature AMST Seg */ + +typedef struct AMSTSegStruct *AMSTSeg; + +typedef struct AMSTSegStruct { + AMSSegStruct amsSegStruct; /* superclass fields must come first */ + AMSTSeg next; /* mergeable next segment, or NULL */ + AMSTSeg prev; /* mergeable prev segment, or NULL */ + Sig sig; /* design.mps.pool.outer-structure.sig */ +} AMSTSegStruct; + + + +/* AMSTSegCheck -- check the AMST segment */ + +static Bool AMSTSegCheck(AMSTSeg amstseg) +{ + CHECKS(AMSTSeg, amstseg); + CHECKL(AMSSegCheck(&amstseg->amsSegStruct)); + /* don't bother to do other checks - this is a stress test */ + return TRUE; +} + +#define Seg2AMSTSeg(seg) ((AMSTSeg)(seg)) +#define AMSTSeg2Seg(amstseg) ((Seg)(amstseg)) + + +/* amstSegInit -- initialise an amst segment */ + +static Res amstSegInit(Seg seg, Pool pool, Addr base, Size size, + Bool reservoirPermit, va_list args) +{ + SegClass super; + AMSTSeg amstseg; + AMST amst; + Res res; + + AVERT(Seg, seg); + amstseg = Seg2AMSTSeg(seg); + AVERT(Pool, pool); + amst = Pool2AMST(pool); + AVERT(AMST, amst); + /* no useful checks for base and size */ + AVER(BoolCheck(reservoirPermit)); + + /* Initialize the superclass fields first via next-method call */ + super = SEG_SUPERCLASS(AMSTSegClass); + res = super->init(seg, pool, base, size, reservoirPermit, args); + if (res != ResOK) + return res; + + amstseg->next = NULL; + amstseg->prev = NULL; + amstseg->sig = AMSTSegSig; + AVERT(AMSTSeg, amstseg); + + return ResOK; +} + + +/* amstSegFinish -- Finish method for AMST segments */ + +static void amstSegFinish(Seg seg) +{ + SegClass super; + AMSTSeg amstseg; + + AVERT(Seg, seg); + amstseg = Seg2AMSTSeg(seg); + AVERT(AMSTSeg, amstseg); + + if (amstseg->next != NULL) + amstseg->next->prev = NULL; + if (amstseg->prev != NULL) + amstseg->prev->next = NULL; + + amstseg->sig = SigInvalid; + /* finish the superclass fields last */ + super = SEG_SUPERCLASS(AMSTSegClass); + super->finish(seg); +} + + + +/* amstSegMerge -- AMSTSeg merge method + * + * .fail: Test proper handling of the most complex failure cases + * by deliberately detecting failure sometimes after calling the + * next method. We handle the error by calling the anti-method. + * This isn't strictly safe (see design.mps.poolams.split-merge.fail). + * But we assume here that we won't run out of memory when calling the + * anti-method. + */ +static Res amstSegMerge(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + AMST amst; + AMSTSeg amstseg, amstsegHi; + Res res; + + AVERT(Seg, seg); + AVERT(Seg, segHi); + amstseg = Seg2AMSTSeg(seg); + amstsegHi = Seg2AMSTSeg(segHi); + AVERT(AMSTSeg, amstseg); + AVERT(AMSTSeg, amstsegHi); + amst = Pool2AMST(SegPool(seg)); + + /* Merge the superclass fields via direct next-method call */ + super = SEG_SUPERCLASS(AMSTSegClass); + res = super->merge(seg, segHi, base, mid, limit, + withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + if (AMSTFailOperation(amst)) { + amst->badMerges++; + printf("D"); + goto failDeliberate; + } + + amstseg->next = amstsegHi->next; + amstsegHi->sig = SigInvalid; + AVERT(AMSTSeg, amstseg); + amst->merges++; + printf("M"); + return ResOK; + +failDeliberate: + /* Call the anti-method (see .fail) */ + res = super->split(seg, segHi, base, mid, limit, + withReservoirPermit, args); + AVER(res == ResOK); + res = ResFAIL; +failSuper: + AVERT(AMSTSeg, amstseg); + AVERT(AMSTSeg, amstsegHi); + return res; +} + + +/* amstSegSplit -- AMSTSeg split method */ + +static Res amstSegSplit(Seg seg, Seg segHi, + Addr base, Addr mid, Addr limit, + Bool withReservoirPermit, va_list args) +{ + SegClass super; + AMST amst; + AMSTSeg amstseg, amstsegHi; + Res res; + + AVERT(Seg, seg); + AVER(segHi != NULL); /* can't check fully, it's not initialized */ + amstseg = Seg2AMSTSeg(seg); + amstsegHi = Seg2AMSTSeg(segHi); + AVERT(AMSTSeg, amstseg); + amst = Pool2AMST(SegPool(seg)); + + /* Split the superclass fields via direct next-method call */ + super = SEG_SUPERCLASS(AMSTSegClass); + res = super->split(seg, segHi, base, mid, limit, + withReservoirPermit, args); + if (res != ResOK) + goto failSuper; + + if (AMSTFailOperation(amst)) { + amst->badSplits++; + printf("B"); + goto failDeliberate; + } + + /* Full initialization for segHi. */ + amstsegHi->next = amstseg->next; + amstsegHi->prev = amstseg; + amstsegHi->sig = AMSTSegSig; + amstseg->next = amstsegHi; + AVERT(AMSTSeg, amstseg); + AVERT(AMSTSeg, amstsegHi); + amst->splits++; + printf("S"); + return ResOK; + +failDeliberate: + /* Call the anti-method. (see .fail) */ + res = super->merge(seg, segHi, base, mid, limit, + withReservoirPermit, args); + AVER(res == ResOK); + res = ResFAIL; +failSuper: + AVERT(AMSTSeg, amstseg); + return res; +} + + +/* AMSTSegClass -- Class definition for AMST segments */ + +DEFINE_SEG_CLASS(AMSTSegClass, class) +{ + INHERIT_CLASS(class, AMSSegClass); + class->name = "AMSTSEG"; + class->size = sizeof(AMSTSegStruct); + class->init = amstSegInit; + class->finish = amstSegFinish; + class->split = amstSegSplit; + class->merge = amstSegMerge; +} + + +/* AMSTSegSizePolicy + * + * Picks double the default segment size. + */ +static Res AMSTSegSizePolicy(Size *sizeReturn, + Pool pool, Size size, RankSet rankSet) +{ + Arena arena; + Size basic, want; + + AVER(sizeReturn != NULL); + AVERT(Pool, pool); + AVER(size > 0); + AVER(RankSetCheck(rankSet)); + + arena = PoolArena(pool); + + basic = SizeAlignUp(size, ArenaAlign(arena)); + if (basic == 0) { + /* overflow */ + return ResMEMORY; + } + want = basic + basic; + if (want <= basic) { + /* overflow */ + return ResMEMORY; + } + *sizeReturn = want; + return ResOK; +} + + +/* AMSTInit -- the pool class initialization method */ + +static Res AMSTInit(Pool pool, va_list args) +{ + AMST amst; AMS ams; + Format format; + Chain chain; + Res res; + static GenParamStruct genParam = { 1024, 0.2 }; + + AVERT(Pool, pool); + + format = va_arg(args, Format); + res = ChainCreate(&chain, pool->arena, 1, &genParam); + if (res != ResOK) + return res; + res = AMSInitInternal(Pool2AMS(pool), format, chain); + if (res != ResOK) + return res; + amst = Pool2AMST(pool); + ams = Pool2AMS(pool); + ams->segSize = AMSTSegSizePolicy; + ams->segClass = AMSTSegClassGet; + amst->chain = chain; + amst->failSegs = TRUE; + amst->splits = 0; + amst->merges = 0; + amst->badSplits = 0; + amst->badMerges = 0; + amst->bsplits = 0; + amst->bmerges = 0; + amst->sig = AMSTSig; + AVERT(AMST, amst); + return ResOK; +} + + +/* AMSTFinish -- the pool class finish method */ + +static void AMSTFinish(Pool pool) +{ + AMST amst; + + AVERT(Pool, pool); + amst = Pool2AMST(pool); + AVERT(AMST, amst); + + printf("\nDestroying pool, having performed:\n"); + printf(" %lu splits (S)\n", (unsigned long)amst->splits); + printf(" %lu merges (M)\n", (unsigned long)amst->merges); + printf(" %lu aborted splits (B)\n", (unsigned long)amst->badSplits); + printf(" %lu aborted merges (D)\n", (unsigned long)amst->badMerges); + printf(" which included:\n"); + printf(" %lu buffered splits (C)\n", (unsigned long)amst->bsplits); + printf(" %lu buffered merges (J)\n", (unsigned long)amst->bmerges); + + AMSFinish(pool); + amst->sig = SigInvalid; + ChainDestroy(amst->chain); +} + + +/* AMSSegIsFree -- return TRUE if a seg is all unallocated */ + +static Bool AMSSegIsFree(Seg seg) +{ + AMSSeg amsseg; + AVERT(Seg, seg); + amsseg = Seg2AMSSeg(seg); + return(amsseg->free == amsseg->grains); +} + + +/* AMSSegRegionIsFree -- return TRUE if a region is all unallocated */ + +static Bool AMSSegRegionIsFree(Seg seg, Addr base, Addr limit) +{ + AMSSeg amsseg; + AMS ams; + Count bgrain, lgrain; + Addr sbase; + + AVERT(Seg, seg); + amsseg = Seg2AMSSeg(seg); + sbase = SegBase(seg); + ams = Pool2AMS(SegPool(seg)); + + bgrain = AMSGrains(ams, AddrOffset(sbase, base)); + lgrain = AMSGrains(ams, AddrOffset(sbase, limit)); + + if (amsseg->allocTableInUse) { + return BTIsResRange(amsseg->allocTable, bgrain, lgrain); + } else { + return amsseg->firstFree <= bgrain; + } +} + + +/* AMSUnallocateRange -- set a range to be unallocated + * + * Used as a means of overriding the behaviour of AMSBufferFill. + * The code is similar to AMSBufferEmpty. + */ +static void AMSUnallocateRange(Seg seg, Addr base, Addr limit) +{ + Pool pool; + AMS ams; + AMSSeg amsseg; + Index baseIndex, limitIndex; + /* parameters checked by caller */ + + pool = SegPool(seg); + ams = Pool2AMS(pool); + amsseg = Seg2AMSSeg(seg); + + baseIndex = AMS_ADDR_INDEX(seg, base); + limitIndex = AMS_ADDR_INDEX(seg, limit); + + if (amsseg->allocTableInUse) { + /* check that it's allocated */ + AVER(BTIsSetRange(amsseg->allocTable, baseIndex, limitIndex)); + BTResRange(amsseg->allocTable, baseIndex, limitIndex); + } else { + /* check that it's allocated */ + AVER(limitIndex <= amsseg->firstFree); + if (limitIndex == amsseg->firstFree) /* is it at the end? */ { + amsseg->firstFree = baseIndex; + } else { /* start using allocTable */ + amsseg->allocTableInUse = TRUE; + BTSetRange(amsseg->allocTable, 0, amsseg->firstFree); + if (amsseg->firstFree < amsseg->grains) + BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains); + BTResRange(amsseg->allocTable, baseIndex, limitIndex); + } + } + amsseg->free += limitIndex - baseIndex; + amsseg->newAlloc -= limitIndex - baseIndex; +} + + +/* AMSAllocateRange -- set a range to be allocated + * + * Used as a means of overriding the behaviour of AMSBufferFill. + * The code is similar to AMSUnallocateRange. + */ +static void AMSAllocateRange(Seg seg, Addr base, Addr limit) +{ + Pool pool; + AMS ams; + AMSSeg amsseg; + Index baseIndex, limitIndex; + /* parameters checked by caller */ + + pool = SegPool(seg); + ams = Pool2AMS(pool); + amsseg = Seg2AMSSeg(seg); + + baseIndex = AMS_ADDR_INDEX(seg, base); + limitIndex = AMS_ADDR_INDEX(seg, limit); + + if (amsseg->allocTableInUse) { + /* check that it's not allocated */ + AVER(BTIsResRange(amsseg->allocTable, baseIndex, limitIndex)); + BTSetRange(amsseg->allocTable, baseIndex, limitIndex); + } else { + /* check that it's not allocated */ + AVER(baseIndex >= amsseg->firstFree); + if (baseIndex == amsseg->firstFree) /* is it at the end? */ { + amsseg->firstFree = limitIndex; + } else { /* start using allocTable */ + amsseg->allocTableInUse = TRUE; + BTSetRange(amsseg->allocTable, 0, amsseg->firstFree); + if (amsseg->firstFree < amsseg->grains) + BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains); + BTSetRange(amsseg->allocTable, baseIndex, limitIndex); + } + } + AVER(amsseg->free >= limitIndex - baseIndex); + amsseg->free -= limitIndex - baseIndex; + amsseg->newAlloc += limitIndex - baseIndex; +} + + +/* AMSTBufferFill -- the pool class buffer fill method + * + * Calls next method - but possibly splits or merges the chosen + * segment. + * + * .merge: A merge is performed when the next method returns + * the entire segment, this segment had previously been split + * from the segment below, and the segment below is appropriately + * similar (i.e. not already attached to a buffer and similarly grey) + * + * .split: If we're not merging, a split is performed if the next method + * returns the entire segment, and yet lower half of the segment would + * meet the request. + */ +static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn, + Pool pool, Buffer buffer, Size size, + Bool withReservoirPermit) +{ + PoolClass super; + Addr base, limit; + Arena arena; + AMST amst; + Bool b; + Seg seg; + AMSTSeg amstseg; + Res res; + + AVERT(Pool, pool); + AVER(baseReturn != NULL); + AVER(limitReturn != NULL); + /* other parameters are checked by next method */ + arena = PoolArena(pool); + amst = Pool2AMST(pool); + + /* call next method */ + super = POOL_SUPERCLASS(AMSTPoolClass); + res = super->bufferFill(&base, &limit, pool, buffer, size, + withReservoirPermit); + if (res != ResOK) + return res; + + b = SegOfAddr(&seg, arena, base); + AVER(b); + amstseg = Seg2AMSTSeg(seg); + + if (SegLimit(seg) == limit && SegBase(seg) == base) { + if (amstseg->prev != NULL) { + Seg segLo = AMSTSeg2Seg(amstseg->prev); + if (SegBuffer(segLo) == NULL && SegGrey(segLo) == SegGrey(seg)) { + /* .merge */ + Seg mergedSeg; + Res mres; + + AMSUnallocateRange(seg, base, limit); + mres = SegMerge(&mergedSeg, segLo, seg, withReservoirPermit); + if (ResOK == mres) { /* successful merge */ + AMSAllocateRange(mergedSeg, base, limit); + /* leave range as-is */ + } else { /* failed to merge */ + AVER(amst->failSegs); /* deliberate fails only */ + AMSAllocateRange(seg, base, limit); + } + } + + } else { + Size half = SegSize(seg) / 2; + if (half >= size && SizeIsAligned(half, ArenaAlign(arena))) { + /* .split */ + Addr mid = AddrAdd(base, half); + Seg segLo, segHi; + Res sres; + AMSUnallocateRange(seg, mid, limit); + sres = SegSplit(&segLo, &segHi, seg, mid, withReservoirPermit); + if (ResOK == sres) { /* successful split */ + limit = mid; /* range is lower segment */ + } else { /* failed to split */ + AVER(amst->failSegs); /* deliberate fails only */ + AMSAllocateRange(seg, mid, limit); + } + + } + } + } + + *baseReturn = base; + *limitReturn = limit; + return ResOK; +} + + +/* AMSTStressBufferedSeg -- Stress test for a buffered seg + * + * Test splitting or merging a buffered seg. + * + * .bmerge: A merge is performed when the segment had previously + * been split and the segment above meets the constraints (i.e. empty, + * not already attached to a buffer and similar colour) + * + * .bsplit: Whether or not a merge happpened, a split is performed if + * the limit of the buffered region is arena aligned, and yet does not + * correspond to the segment limit, provided that the part of the segment + * above the buffer is all free. + */ +static void AMSTStressBufferedSeg(Seg seg, Buffer buffer) +{ + AMSTSeg amstseg; + AMST amst; + Arena arena; + Addr limit; + + AVERT(Seg, seg); + AVERT(Buffer, buffer); + AVER(SegBuffer(seg) == buffer); + amstseg = Seg2AMSTSeg(seg); + AVERT(AMSTSeg, amstseg); + limit = BufferLimit(buffer); + arena = PoolArena(SegPool(seg)); + amst = Pool2AMST(SegPool(seg)); + AVERT(AMST, amst); + + if (amstseg->next != NULL) { + Seg segHi = AMSTSeg2Seg(amstseg->next); + if (AMSSegIsFree(segHi) && SegGrey(segHi) == SegGrey(seg)) { + /* .bmerge */ + Seg mergedSeg; + Res res; + res = SegMerge(&mergedSeg, seg, segHi, FALSE); + if (ResOK == res) { + amst->bmerges++; + printf("J"); + } else { + /* deliberate fails only */ + AVER(amst->failSegs); + } + } + } + + if (SegLimit(seg) != limit && + AddrIsAligned(limit, ArenaAlign(arena)) && + AMSSegRegionIsFree(seg, limit, SegLimit(seg))) { + /* .bsplit */ + Seg segLo, segHi; + Res res; + res = SegSplit(&segLo, &segHi, seg, limit, FALSE); + if (ResOK == res) { + amst->bsplits++; + printf("C"); + } else { + /* deliberate fails only */ + AVER(amst->failSegs); + } + } +} + + + +/* AMSTPoolClass -- the pool class definition */ + +DEFINE_POOL_CLASS(AMSTPoolClass, this) +{ + INHERIT_CLASS(this, AMSPoolClass); + this->name = "AMST"; + this->size = sizeof(AMSTStruct); + this->offset = offsetof(AMSTStruct, amsStruct.poolStruct); + this->init = AMSTInit; + this->finish = AMSTFinish; + this->bufferFill = AMSTBufferFill; +} + + +/* mps_amst_ap_stress -- stress an active buffer + * + * Attempt to either split or merge a segment attached to an AP + */ +static void mps_amst_ap_stress(mps_ap_t ap) +{ + Buffer buffer; + Seg seg; + + buffer = BufferOfAP((AP)ap); + AVERT(Buffer, buffer); + seg = BufferSeg(buffer); + AMSTStressBufferedSeg(seg, buffer); +} + + +/* mps_class_amst -- return the pool class descriptor to the client */ + +static mps_class_t mps_class_amst(void) +{ + return (mps_class_t)AMSTPoolClassGet(); +} + + +#define exactRootsCOUNT 50 +#define ambigRootsCOUNT 100 +#define sizeScale 4 +/* This is enough for five GCs. */ +#define totalSizeMAX sizeScale * 800 * (size_t)1024 +#define totalSizeSTEP 200 * (size_t)1024 +/* objNULL needs to be odd so that it's ignored in exactRoots. */ +#define objNULL ((mps_addr_t)0xDECEA5ED) +#define testArenaSIZE ((size_t)16<<20) +#define initTestFREQ 6000 +#define stressTestFREQ 40 + + +static mps_pool_t pool; +static mps_ap_t ap; +static mps_addr_t exactRoots[exactRootsCOUNT]; +static mps_addr_t ambigRoots[ambigRootsCOUNT]; +static size_t totalSize = 0; + + +static mps_addr_t make(void) +{ + size_t length = rnd() % 20, size = (length+2) * sizeof(mps_word_t); + mps_addr_t p; + mps_res_t res; + + do { + MPS_RESERVE_BLOCK(res, p, ap, size); + if (res) + die(res, "MPS_RESERVE_BLOCK"); + res = dylan_init(p, size, exactRoots, exactRootsCOUNT); + if (res) + die(res, "dylan_init"); + } while(!mps_commit(ap, p, size)); + + totalSize += size; + return p; +} + + +static void *test(void *arg, size_t s) +{ + mps_arena_t arena; + mps_fmt_t format; + mps_root_t exactRoot, ambigRoot; + size_t lastStep = 0, i, r; + unsigned long objs; + mps_ap_t busy_ap; + mps_addr_t busy_init; + char *indent = " "; + + arena = (mps_arena_t)arg; + (void)s; /* unused */ + + die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create"); + + die(mps_pool_create(&pool, arena, mps_class_amst(), format), + "pool_create(amst)"); + + die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate"); + die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2"); + + for(i = 0; i < exactRootsCOUNT; ++i) + exactRoots[i] = objNULL; + for(i = 0; i < ambigRootsCOUNT; ++i) + ambigRoots[i] = (mps_addr_t)rnd(); + + die(mps_root_create_table_masked(&exactRoot, arena, + MPS_RANK_EXACT, (mps_rm_t)0, + &exactRoots[0], exactRootsCOUNT, + (mps_word_t)1), + "root_create_table(exact)"); + die(mps_root_create_table(&ambigRoot, arena, + MPS_RANK_AMBIG, (mps_rm_t)0, + &ambigRoots[0], ambigRootsCOUNT), + "root_create_table(ambig)"); + + printf(indent); + + /* create an ap, and leave it busy */ + die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + + objs = 0; + while(totalSize < totalSizeMAX) { + if (totalSize > lastStep + totalSizeSTEP) { + lastStep = totalSize; + printf("\nSize %lu bytes, %lu objects.\n", + (unsigned long)totalSize, objs); + printf(indent); + fflush(stdout); + for(i = 0; i < exactRootsCOUNT; ++i) + cdie(exactRoots[i] == objNULL || dylan_check(exactRoots[i]), + "all roots check"); + } + + r = (size_t)rnd(); + if (r & 1) { + i = (r >> 1) % exactRootsCOUNT; + if (exactRoots[i] != objNULL) + cdie(dylan_check(exactRoots[i]), "dying root check"); + exactRoots[i] = make(); + if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL) + dylan_write(exactRoots[(exactRootsCOUNT-1) - i], + exactRoots, exactRootsCOUNT); + } else { + i = (r >> 1) % ambigRootsCOUNT; + ambigRoots[(ambigRootsCOUNT-1) - i] = make(); + /* Create random interior pointers */ + ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1); + } + + if (rnd() % stressTestFREQ == 0) + mps_amst_ap_stress(ap); /* stress active buffer */ + + if (rnd() % initTestFREQ == 0) + *(int*)busy_init = -1; /* check that the buffer is still there */ + + ++objs; + if (objs % 256 == 0) { + printf("."); + fflush(stdout); + } + } + + (void)mps_commit(busy_ap, busy_init, 64); + mps_ap_destroy(busy_ap); + mps_ap_destroy(ap); + mps_root_destroy(exactRoot); + mps_root_destroy(ambigRoot); + mps_pool_destroy(pool); + mps_fmt_destroy(format); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + randomize(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create"); + die(mps_thread_reg(&thread, arena), "thread_reg"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + fprintf(stderr, "\nConclusion: Failed to find any defects.\n"); + return 0; +} diff --git a/mps/code/shield.c b/mps/code/shield.c new file mode 100644 index 00000000000..c472e48d71e --- /dev/null +++ b/mps/code/shield.c @@ -0,0 +1,305 @@ +/* impl.c.shield: SHIELD IMPLEMENTATION + * + * $HopeName: MMsrc!shield.c(trunk.15) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + * + * See: idea.shield, design.mps.shield. + * + * This implementation of the shield avoids suspending threads for + * as long as possible. When threads are suspended, it maintains a + * cache of covered segments where the desired and actual protection + * do not match. This cache is flushed on leaving the shield. + * + * + * Definitions + * + * .def.synced: a seg is synced if the prot and shield modes are the + * same, and unsynced otherwise. + * .def.depth: the depth of a segment is defined as + * depth == #exposes - #covers + I(in cache), where + * #exposes = the total number of times the seg has been exposed + * #covers = the total number of times the seg has been covered + * I(in cache) = 1 if the segment is in the cache + * 0 otherwise + * The cache is initially empty and cover should not be called + * without a matching expose, so this figure should always be + * non-negative. + * .def.total.depth: The total depth is the sum of the depth over + * all segments + * .def.outside: being outside the shield is being between calls + * to leave and enter, and similarly .def.inside: being inside the + * shield is being between calls to enter and leave. + * .def.suspended: suspended is true iff the threads are suspended + * + * + * Properties + * + * .prop.outside.running: The mutator may not be suspended while + * outside the shield. + * .prop.mutator.access: An attempt by the mutator to access + * shielded memory must cause an ArenaAccess. + * .prop.inside.access: Inside the shield it must be possible to access + * all unshielded segments and all exposed segments. + * + * + * Invariants + * + * These invariants are maintained by the code. + * + * .inv.outside.running: The mutator is running while outside the + * shield. + * .inv.unsynced.suspended: If any segment is not synced, + * the mutator is suspended. + * .inv.unsynced.depth: All unsynced segments have positive depth. + * .inv.outside.depth: The total depth is zero while outside the shield. + * .inv.prot.shield: The prot mode is never more than the shield mode. + * .inv.expose.prot: An exposed seg is not protected. + * + * Hints at proofs of properties from invariants + * + * inv.outside.running directly ensures prop.outside running. + * + * As the depth of a segment cannot be negative + * total depth == 0 => for all segments, depth == 0 + * => all segs are synced (by .inv.unsynced.depth) + * + * If the mutator is running then all segs must be synced + * (.inv.unsynced.suspend). Which means that the hardware protection + * (prot mode) must reflect the software protection (shield mode). + * Hence all shielded memory will be hardware protected while the + * mutator is running. This ensures .prop.mutator.access. + * + * inv.prot.shield and inv.expose.prot ensure prop.inside.access. + */ + +#include "mpm.h" + +SRCID(shield, "$HopeName: MMsrc!shield.c(trunk.15) $"); + + +void (ShieldSuspend)(Arena arena) +{ + AVERT(Arena, arena); + AVER(arena->insideShield); + + if (!arena->suspended) { + ThreadRingSuspend(ArenaThreadRing(arena)); + arena->suspended = TRUE; + } +} + + +void (ShieldResume)(Arena arena) +{ + AVERT(Arena, arena); + AVER(arena->insideShield); + AVER(arena->suspended); + /* It is only correct to actually resume the mutator here if shDepth is 0 */ +} + + +/* This ensures actual prot mode does not include mode */ +static void protLower(Arena arena, Seg seg, AccessSet mode) +{ + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Arena, arena); + UNUSED(arena); + AVERT_CRITICAL(Seg, seg); + + if (SegPM(seg) & mode) { + SegSetPM(seg, SegPM(seg) & ~mode); + ProtSet(SegBase(seg), SegLimit(seg), SegPM(seg)); + } +} + + +static void sync(Arena arena, Seg seg) +{ + AVERT(Arena, arena); + AVERT(Seg, seg); + + if (SegPM(seg) != SegSM(seg)) { + ProtSet(SegBase(seg), SegLimit(seg), SegSM(seg)); + SegSetPM(seg, SegSM(seg)); + /* inv.prot.shield */ + } +} + + +static void flush(Arena arena, Size i) +{ + Seg seg; + AVERT(Arena, arena); + AVER(i < arena->shCacheLimit); + + seg = arena->shCache[i]; + if (seg == NULL) return; + AVERT(Seg, seg); + + AVER(arena->shDepth > 0); + AVER(SegDepth(seg) > 0); + --arena->shDepth; + SegSetDepth(seg, SegDepth(seg) - 1); + + if (SegDepth(seg) == 0) + sync(arena, seg); + + arena->shCache[i] = NULL; +} + + +/* If the segment is out of sync, either sync it, or ensure + * depth > 0, and the arena is suspended. + */ +static void cache(Arena arena, Seg seg) +{ + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Arena, arena); + AVERT_CRITICAL(Seg, seg); + + if (SegSM(seg) == SegPM(seg)) return; + if (SegDepth(seg) > 0) { + ShieldSuspend(arena); + return; + } + if (ShieldCacheSIZE == 0 || !arena->suspended) + sync(arena, seg); + else { + SegSetDepth(seg, SegDepth(seg) + 1); + ++arena->shDepth; + AVER(arena->shDepth > 0); + AVER(SegDepth(seg) > 0); + AVER(arena->shCacheLimit <= ShieldCacheSIZE); + AVER(arena->shCacheI < arena->shCacheLimit); + flush(arena, arena->shCacheI); + arena->shCache[arena->shCacheI] = seg; + ++arena->shCacheI; + if (arena->shCacheI == ShieldCacheSIZE) + arena->shCacheI = 0; + if (arena->shCacheI == arena->shCacheLimit) + ++arena->shCacheLimit; + } +} + + +void (ShieldRaise) (Arena arena, Seg seg, AccessSet mode) +{ + /* .seg.broken: Seg's shield invariants may not be true at */ + /* this point (this function is called to enforce them) so we */ + /* can't check seg. Nor can we check arena as that checks the */ + /* segs in the cache. */ + + AVER((SegSM(seg) & mode) == AccessSetEMPTY); + SegSetSM(seg, SegSM(seg) | mode); /* inv.prot.shield preserved */ + + /* ensure inv.unsynced.suspended & inv.unsynced.depth */ + cache(arena, seg); + AVERT(Arena, arena); + AVERT(Seg, seg); +} + + +void (ShieldLower)(Arena arena, Seg seg, AccessSet mode) +{ + /* Don't check seg or arena, see .seg.broken */ + AVER((SegSM(seg) & mode) == mode); + /* synced(seg) is not changed by the following + * preserving inv.unsynced.suspended + * Also inv.prot.shield preserved + */ + SegSetSM(seg, SegSM(seg) & ~mode); + protLower(arena, seg, mode); + AVERT(Arena, arena); + AVERT(Seg, seg); +} + + +void (ShieldEnter)(Arena arena) +{ + Size i; + + AVERT(Arena, arena); + AVER(!arena->insideShield); + AVER(arena->shDepth == 0); + AVER(!arena->suspended); + AVER(arena->shCacheLimit <= ShieldCacheSIZE); + AVER(arena->shCacheI < arena->shCacheLimit); + for(i = 0; i < arena->shCacheLimit; i++) + AVER(arena->shCache[i] == NULL); + + arena->shCacheI = (Size)0; + arena->shCacheLimit = (Size)1; + arena->insideShield = TRUE; +} + + +/* .shield.flush: Flush empties the shield cache. + * This needs to be called before segments are destroyed as there + * may be references to them in the cache. + */ +void (ShieldFlush)(Arena arena) +{ + Size i; + + for(i = 0; i < arena->shCacheLimit; ++i) { + if (arena->shDepth == 0) + break; + flush(arena, i); + } +} + + +void (ShieldLeave)(Arena arena) +{ + AVERT(Arena, arena); + AVER(arena->insideShield); + + ShieldFlush(arena); + /* Cache is empty so inv.outside.depth holds */ + AVER(arena->shDepth == 0); + + /* Ensuring the mutator is running at this point + * guarantees inv.outside.running */ + if (arena->suspended) { + ThreadRingResume(ArenaThreadRing(arena)); + arena->suspended = FALSE; + } + arena->insideShield = FALSE; +} + + +void (ShieldExpose)(Arena arena, Seg seg) +{ + AccessSet mode = AccessREAD | AccessWRITE; + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Arena, arena); + AVER_CRITICAL(arena->insideShield); + + SegSetDepth(seg, SegDepth(seg) + 1); + ++arena->shDepth; + /* design.mps.trace.fix.noaver */ + AVER_CRITICAL(arena->shDepth > 0); + AVER_CRITICAL(SegDepth(seg) > 0); + if (SegPM(seg) & mode) + ShieldSuspend(arena); + + /* This ensures inv.expose.prot */ + protLower(arena, seg, mode); +} + + +void (ShieldCover)(Arena arena, Seg seg) +{ + /* design.mps.trace.fix.noaver */ + AVERT_CRITICAL(Arena, arena); + AVERT_CRITICAL(Seg, seg); + AVER_CRITICAL(SegPM(seg) == AccessSetEMPTY); + + AVER_CRITICAL(arena->shDepth > 0); + AVER_CRITICAL(SegDepth(seg) > 0); + SegSetDepth(seg, SegDepth(seg) - 1); + --arena->shDepth; + + /* ensure inv.unsynced.depth */ + cache(arena, seg); +} diff --git a/mps/code/sos8cx.gmk b/mps/code/sos8cx.gmk new file mode 100644 index 00000000000..0a961b81ddc --- /dev/null +++ b/mps/code/sos8cx.gmk @@ -0,0 +1,18 @@ +# impl.gmk.sos8cx: BUILD FOR SOLARIS/SPARC v8/CXREF PLATFORM +# +# $HopeName: MMsrc!sos8cx.gmk(trunk.9) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# Instead of compiling object files, this platform (using the cxref +# builder) generates a C cross reference listing. +# It falls over if you try and build an executable, but this is +# okay as we only wanted the C cross references. + +PFM = sos8cx + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmso.c \ + protso.c prmcan.c span.c +SWPF = than.c vmso.c protsw.c prmcan.c ssan.c +LIBS = -lm + +include cx.gmk diff --git a/mps/code/sos8gc.gmk b/mps/code/sos8gc.gmk new file mode 100644 index 00000000000..683fe408034 --- /dev/null +++ b/mps/code/sos8gc.gmk @@ -0,0 +1,16 @@ +# impl.gmk.sos8gc: BUILD FOR SOLARIS/SPARC V8/GCC PLATFORM +# +# $HopeName: MMsrc!sos8gc.gmk(trunk.28) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = sos8gc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmso.c \ + protso.c prmcan.c span.c +MPMS = sssos8.s +SWPF = than.c vmso.c protsw.c prmcan.c ssan.c +LIBS = -lm + +include gc.gmk + +include comm.gmk diff --git a/mps/code/sos8gp.gmk b/mps/code/sos8gp.gmk new file mode 100644 index 00000000000..cbac10da2b1 --- /dev/null +++ b/mps/code/sos8gp.gmk @@ -0,0 +1,17 @@ +# impl.gmk.sos8gp: BUILD FOR SOLARIS/SPARC v8/GCC WITH PROFILING PLATFORM +# +# $HopeName: MMsrc!sos8gp.gmk(trunk.6) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.sos8gp. + +PFM = sos8gp + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmso.c \ + protso.c prmcan.c span.c +MPMS = sssos8.s +SWPF = than.c vmso.c protsw.c prmcan.c ssan.c +# Need to pass the profile option to the linker as well. +LIBS = -lm -pg + +include gp.gmk diff --git a/mps/code/sos9sc.gmk b/mps/code/sos9sc.gmk new file mode 100644 index 00000000000..69969395de8 --- /dev/null +++ b/mps/code/sos9sc.gmk @@ -0,0 +1,17 @@ +# impl.gmk.sos9sc: BUILD FOR SOLARIS/SPARC V9/SUNPRO C PLATFORM +# +# $HopeName: MMsrc!sos9sc.gmk(trunk.22) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.sos9sc. + +PFM = sos9sc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmso.c \ + protso.c prmcan.c span.c +MPMS = sssos8.s # s9 is backward-compatible with s8 here +SWPF = than.c vmso.c protsw.c prmcan.c ssan.c + +LIBS = -lm + +include sc.gmk diff --git a/mps/code/span.c b/mps/code/span.c new file mode 100644 index 00000000000..24f203d26c4 --- /dev/null +++ b/mps/code/span.c @@ -0,0 +1,25 @@ +/* impl.c.span: ANSI STACK PROBE + * + * $HopeName: MMsrc!span.c(trunk.2) $ + * Copyright (C) 1997 Harlequin Limited. All rights reserved. + * + * PURPOSE + * + * .purpose: The purpose of the ANSI Stack Probe is to provide a + * non-functional implementation of the StackProbe interface. + * StackProbe has a function implementation on platforms where the + * MPS takes some special action to avoid stack overflow. + */ + +#include "mpm.h" + +SRCID(span, "$HopeName: MMsrc!span.c(trunk.2) $"); + + +/* StackProbe -- probe above the stack to provoke early stack overflow */ + +void StackProbe(Size depth) +{ + AVER(depth == 0); + NOOP; +} diff --git a/mps/code/spi3.asm b/mps/code/spi3.asm new file mode 100644 index 00000000000..c13e834ddad --- /dev/null +++ b/mps/code/spi3.asm @@ -0,0 +1,27 @@ +; impl.asm.spi3: STACK PROBE +; +; $HopeName: MMsrc!spi3.asm(trunk.1) $ +; Copyright (C) 1997 Harlequin Limited. All rights reserved. +; +; This function reads a location that is probeDepth words beyond +; the current stack pointer. On intel platforms the stack grows +; downwards so this means reading from a location with a lesser address. +; +; The registers edi, esi, ebx are the registers defined to be preserved +; across function calls, so we do not use those. + +.386 +.model flat +.code + +_StackProbe proc public ; (Size probeDepth) + push ebp ; frame pointer + mov ebp,esp + mov eax, [ebp+08] + neg eax + mov eax, [esp+eax*4] ; do the actual probe + leave + ret ; return +_StackProbe endp + +end diff --git a/mps/code/splay.c b/mps/code/splay.c new file mode 100644 index 00000000000..5416e922598 --- /dev/null +++ b/mps/code/splay.c @@ -0,0 +1,1019 @@ +/* impl.c.splay: SPLAY TREE IMPLEMENTATION + * + * $HopeName: MMsrc!splay.c(trunk.8) $ + * Copyright (C) 1998 Harlequin Group plc. All rights reserved. + * + * .purpose: Splay trees are used to manage potentially unbounded + * collections of ordered things. + * + * .source: design.mps.splay + * + * .note.stack: It's important that the MPS have a bounded stack + * size, and this is a problem for tree algorithms. Basically, + * we have to avoid recursion. + */ + + +#include "splay.h" +#include "mpm.h" + + +SRCID(splay, "$HopeName: MMsrc!splay.c(trunk.8) $"); + +/* Basic getter and setter methods */ +#define SplayTreeRoot(t) RVALUE((t)->root) +#define SplayTreeSetRoot(t, r) BEGIN ((t)->root = (r)); END +#define SplayNodeLeftChild(n) RVALUE((n)->left) +#define SplayNodeSetLeftChild(n, child) \ + BEGIN ((n)->left = (child)); END +#define SplayNodeRightChild(n) RVALUE((n)->right) +#define SplayNodeSetRightChild(n, child) \ + BEGIN ((n)->right = (child)); END + +#define SplayCompare(tree, key, node) \ + (((tree)->compare)((key), (node))) + +Bool SplayTreeCheck(SplayTree tree) +{ + UNUSED(tree); + CHECKL(tree != NULL); + CHECKL(FUNCHECK(tree->compare)); + CHECKL(tree->updateNode == NULL || FUNCHECK(tree->updateNode)); + return TRUE; +} + +Bool SplayNodeCheck(SplayNode node) +{ + UNUSED(node); + CHECKL(node != NULL); + return TRUE; +} + + +void SplayTreeInit(SplayTree tree, SplayCompareMethod compare, + SplayUpdateNodeMethod updateNode) +{ + AVER(tree != NULL); + AVER(FUNCHECK(compare)); + AVER(updateNode == NULL || FUNCHECK(updateNode)); + + tree->compare = compare; + tree->updateNode = updateNode; + SplayTreeSetRoot(tree, NULL); + + AVERT(SplayTree, tree); +} + +void SplayNodeInit(SplayNode node) +{ + AVER(node != NULL); + + /* We don't try to finish the attached nodes. See .note.stack. */ + SplayNodeSetLeftChild(node, NULL); + SplayNodeSetRightChild(node, NULL); + + AVERT(SplayNode, node); +} + +void SplayNodeFinish(SplayNode node) +{ + AVERT(SplayNode, node); + + /* we don't try to do a recursive finish. See .note.stack. */ + SplayNodeSetLeftChild(node, NULL); + SplayNodeSetRightChild(node, NULL); +} + +void SplayTreeFinish(SplayTree tree) +{ + AVERT(SplayTree, tree); + SplayTreeSetRoot(tree, NULL); + tree->compare = NULL; +} + +static void SplayNodeUpdate(SplayTree tree, SplayNode node) +{ + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + AVER(tree->updateNode != NULL); + + (*tree->updateNode)(tree, node, SplayNodeLeftChild(node), + SplayNodeRightChild(node)); + return; +} + + +/* SplayLinkRight -- Move top to left child of top + * + * Link the current top node into the left child of the right tree, + * leaving the top node as the left child of the old top node. + * + * See design.mps.splay.impl.link.right. + */ + +static void SplayLinkRight(SplayNode *topIO, SplayNode *rightIO) +{ + AVERT(SplayNode, *topIO); + AVERT(SplayNode, *rightIO); + + /* Don't fix client properties yet. */ + + /* .link.right.first: *rightIO is always the first node in the */ + /* right tree, so its left child must be null. */ + AVER(SplayNodeLeftChild(*rightIO) == NULL); + + SplayNodeSetLeftChild(*rightIO, *topIO); + *rightIO = *topIO; + *topIO = SplayNodeLeftChild(*topIO); + + /* The following line is only required for .link.right.first. */ + SplayNodeSetLeftChild(*rightIO, NULL); +} + +/* SplayLinkLeft -- Move top to right child of top + * + * Link the current top node into the right child of the left tree, + * leaving the top node as the right child of the old top node. + * + * See design.mps.splay.impl.link.left. + */ + +static void SplayLinkLeft(SplayNode *topIO, SplayNode *leftIO) { + AVERT(SplayNode, *topIO); + AVERT(SplayNode, *leftIO); + + /* Don't fix client properties yet. */ + + /* .link.left.first: *leftIO is always the last node in the */ + /* left tree, so its right child must be null. */ + AVER(SplayNodeRightChild(*leftIO) == NULL); + + SplayNodeSetRightChild(*leftIO, *topIO); + *leftIO = *topIO; + *topIO = SplayNodeRightChild(*topIO); + + /* The following line is only required for .link.left.first. */ + SplayNodeSetRightChild(*leftIO, NULL); +} + +/* SplayRotateLeft -- Rotate right child edge of node + * + * Rotates node, right child of node, and left child of right + * child of node, leftwards in the order stated. + * + * See design.mps.splay.impl.rotate.left. + */ + +static void SplayRotateLeft(SplayNode *nodeIO, SplayTree tree) { + SplayNode nodeRight; + + AVER(nodeIO != NULL); + AVERT(SplayNode, *nodeIO); + AVERT(SplayNode, SplayNodeRightChild(*nodeIO)); + AVERT(SplayTree, tree); + + nodeRight = SplayNodeRightChild(*nodeIO); + SplayNodeSetRightChild(*nodeIO, SplayNodeLeftChild(nodeRight)); + SplayNodeSetLeftChild(nodeRight, *nodeIO); + *nodeIO = nodeRight; + + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, SplayNodeLeftChild(nodeRight)); + /* Don't need to update new root because we know that we will */ + /* do either a link or an assemble next, and that will sort it */ + /* out. */ + } + + return; +} + +/* SplayRotateRight -- Rotate left child edge of node + * + * Rotates node, left child of node, and right child of left + * child of node, leftwards in the order stated. + * + * See design.mps.splay.impl.rotate.right. + */ + +static void SplayRotateRight(SplayNode *nodeIO, SplayTree tree) { + SplayNode nodeLeft; + + AVER(nodeIO != NULL); + AVERT(SplayNode, *nodeIO); + AVERT(SplayNode, SplayNodeLeftChild(*nodeIO)); + AVERT(SplayTree, tree); + + nodeLeft = SplayNodeLeftChild(*nodeIO); + SplayNodeSetLeftChild(*nodeIO, SplayNodeRightChild(nodeLeft)); + SplayNodeSetRightChild(nodeLeft, *nodeIO); + *nodeIO = nodeLeft; + + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, SplayNodeRightChild(nodeLeft)); + /* Don't need to update new root because we know that we will */ + /* do either a link or an assemble next, and that will sort it */ + /* out. */ + } + + return; +} + +/* SplayAssemble -- Assemble left right and top trees into one + * + * We do this by moving the children of the top tree to the last and + * first nodes in the left and right trees, and then moving the tops + * of the left and right trees to the children of the top tree. + * + * When we reach this function, the nodes between the roots of the + * left and right trees and their last and first nodes respectively + * will have out of date client properties. + * + * See design.mps.splay.impl.assemble. + */ + +static void SplayAssemble(SplayTree tree, SplayNode top, + SplayNode leftTop, SplayNode leftLast, + SplayNode rightTop, SplayNode rightFirst) { + AVERT(SplayTree, tree); + AVERT(SplayNode, top); + AVER(leftTop == NULL || + (SplayNodeCheck(leftTop) && SplayNodeCheck(leftLast))); + AVER(rightTop == NULL || + (SplayNodeCheck(rightTop) && SplayNodeCheck(rightFirst))); + + if(leftTop != NULL) { + SplayNodeSetRightChild(leftLast, SplayNodeLeftChild(top)); + SplayNodeSetLeftChild(top, leftTop); + + if(tree->updateNode != NULL) { + /* Update client property using pointer reversal (Ugh!). */ + SplayNode node, parent, rightChild; + + /* Reverse the pointers between leftTop and leftLast */ + /* leftLast is not reversed. */ + node = leftTop; + parent = NULL; + while(node != leftLast) { + rightChild = SplayNodeRightChild(node); + SplayNodeSetRightChild(node, parent); /* pointer reversal */ + parent = node; + node = rightChild; + } + + /* Now restore the pointers, updating the client property. */ + /* node is leftLast, parent is the last parent (or NULL). */ + SplayNodeUpdate(tree, node); + while(node != leftTop) { + rightChild = node; + node = parent; + parent = SplayNodeRightChild(node); + SplayNodeSetRightChild(node, rightChild); /* un-reverse pointer */ + SplayNodeUpdate(tree, node); + } + } + } + /* otherwise leave top->left alone */ + + if(rightTop != NULL) { + SplayNodeSetLeftChild(rightFirst, SplayNodeRightChild(top)); + SplayNodeSetRightChild(top, rightTop); + + if(tree->updateNode != NULL) { + /* Update client property using pointer reversal (Ugh!). */ + SplayNode node, parent, leftChild; + + /* Reverse the pointers between rightTop and rightFirst */ + /* ightFirst is not reversed. */ + node = rightTop; + parent = NULL; + while(node != rightFirst) { + leftChild = SplayNodeLeftChild(node); + SplayNodeSetLeftChild(node, parent); /* pointer reversal */ + parent = node; + node = leftChild; + } + + /* Now restore the pointers, updating the client property. */ + /* node is rightFirst, parent is the last parent (or NULL). */ + SplayNodeUpdate(tree, node); + while(node != rightTop) { + leftChild = node; + node = parent; + parent = SplayNodeLeftChild(node); + SplayNodeSetLeftChild(node, leftChild); /* un-reverse pointer */ + SplayNodeUpdate(tree, node); + } + } + } + /* otherwise leave top->right alone */ + + if(tree->updateNode != NULL) + SplayNodeUpdate(tree, top); +} + +/* SplaySplay -- Splay the tree (top-down) around a given key + * + * If the key is not found, splays around an arbitrary neighbour. + * Returns whether key was found. This is the real logic behind + * splay trees. + * + * See design.mps.splay.impl.splay. + */ + +static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree, + void *key, SplayCompareMethod compareMethod) { + /* The sides structure avoids a boundary case in SplayLink* */ + SplayNodeStruct sides; /* rightTop and leftTop */ + SplayNode top, leftLast, rightFirst; + Bool found; + Compare compareTop; + + AVERT(SplayTree, tree); + AVER(nodeReturn != NULL); + AVER(FUNCHECK(compareMethod)); + + top = SplayTreeRoot(tree); /* will be copied back at end */ + + if(top == NULL) { + *nodeReturn = NULL; + return FALSE; + } + + /* short-circuit case where node is already top */ + compareTop = (*compareMethod)(key, top); + if(compareTop == CompareEQUAL) { + *nodeReturn = top; + return TRUE; + } + + SplayNodeInit(&sides); /* left and right trees now NULL */ + leftLast = &sides; + rightFirst = &sides; + + while(TRUE) { + /* compareTop is already initialised above. */ + switch(compareTop) { + + case CompareLESS: { + SplayNode topLeft = SplayNodeLeftChild(top); + if(topLeft == NULL) { + found = FALSE; + goto assemble; + } else { + Compare compareTopLeft = (*compareMethod)(key, topLeft); + + switch(compareTopLeft) { + + case CompareEQUAL: { /* zig */ + SplayLinkRight(&top, &rightFirst); + found = TRUE; + goto assemble; + } /* break; */ + + case CompareLESS: { /* zig-zig */ + if(SplayNodeLeftChild(topLeft) == NULL) + goto terminalZig; + SplayRotateRight(&top, tree); + SplayLinkRight(&top, &rightFirst); + } break; + + case CompareGREATER: { /* zig-zag */ + if(SplayNodeRightChild(topLeft) == NULL) + goto terminalZig; + SplayLinkRight(&top, &rightFirst); + SplayLinkLeft(&top, &leftLast); + } break; + + default: { + NOTREACHED; + } break; + } + } + } break; + + case CompareGREATER: { + SplayNode topRight = SplayNodeRightChild(top); + if(topRight == NULL) { + found = FALSE; + goto assemble; + } else { + Compare compareTopRight = (*compareMethod)(key, topRight); + + switch(compareTopRight) { + + case CompareEQUAL: { /* zag */ + SplayLinkLeft(&top, &leftLast); + found = TRUE; + goto assemble; + } /* break; */ + + case CompareGREATER: { /* zag-zag */ + if(SplayNodeRightChild(topRight) == NULL) + goto terminalZag; + SplayRotateLeft(&top, tree); + SplayLinkLeft(&top, &leftLast); + } break; + + case CompareLESS: { /* zag-zig */ + if(SplayNodeLeftChild(topRight) == NULL) + goto terminalZag; + SplayLinkLeft(&top, &leftLast); + SplayLinkRight(&top, &rightFirst); + } break; + + default: { + NOTREACHED; + } break; + } + } + } break; + + case CompareEQUAL: { + found = TRUE; + goto assemble; + } /* break; */ + + default: { + NOTREACHED; + } break; + } + compareTop = (*compareMethod)(key, top); + } /* end while(TRUE) */ + +terminalZig: + SplayLinkRight(&top, &rightFirst); + found = FALSE; + goto assemble; + +terminalZag: + SplayLinkLeft(&top, &leftLast); + found = FALSE; + goto assemble; + +assemble: + SplayAssemble(tree, top, + SplayNodeRightChild(&sides), leftLast, + SplayNodeLeftChild(&sides), rightFirst); + + SplayTreeSetRoot(tree, top); + *nodeReturn = top; + + return found; +} + + +/* SplayTreeInsert -- Insert a node into a splay tree + * + * See design.mps.splay.function.splay.tree.insert and + * design.mps.splay.impl.insert. + */ + +Res SplayTreeInsert(SplayTree tree, SplayNode node, void *key) { + SplayNode neighbour; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + AVER(SplayNodeLeftChild(node) == NULL); + AVER(SplayNodeRightChild(node) == NULL); + + if(SplayTreeRoot(tree) == NULL) { + SplayTreeSetRoot(tree, node); + } else if(SplaySplay(&neighbour, tree, key, tree->compare)) { + return ResFAIL; + } else { + AVER(SplayTreeRoot(tree) == neighbour); + switch(SplayCompare(tree, key, neighbour)) { + + case CompareGREATER: { /* left neighbour */ + SplayTreeSetRoot(tree, node); + SplayNodeSetRightChild(node, SplayNodeRightChild(neighbour)); + SplayNodeSetLeftChild(node, neighbour); + SplayNodeSetRightChild(neighbour, NULL); + } break; + + case CompareLESS: { /* right neighbour */ + SplayTreeSetRoot(tree, node); + SplayNodeSetLeftChild(node, SplayNodeLeftChild(neighbour)); + SplayNodeSetRightChild(node, neighbour); + SplayNodeSetLeftChild(neighbour, NULL); + } break; + + case CompareEQUAL: + default: { + NOTREACHED; + } break; + } + + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, neighbour); + SplayNodeUpdate(tree, node); + } + } + + return ResOK; +} + + +/* SplayTreeDelete -- Delete a node from a splay tree + * + * See design.mps.splay.function.splay.tree.delete and + * design.mps.splay.impl.delete. + */ + +Res SplayTreeDelete(SplayTree tree, SplayNode node, void *key) { + SplayNode rightHalf, del, leftLast; + Bool found; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + + found = SplaySplay(&del, tree, key, tree->compare); + AVER(!found || del == node); + + if(!found) { + return ResFAIL; + } else if(SplayNodeLeftChild(node) == NULL) { + SplayTreeSetRoot(tree, SplayNodeRightChild(node)); + } else if(SplayNodeRightChild(node) == NULL) { + SplayTreeSetRoot(tree, SplayNodeLeftChild(node)); + } else { + rightHalf = SplayNodeRightChild(node); + SplayTreeSetRoot(tree, SplayNodeLeftChild(node)); + if(SplaySplay(&leftLast, tree, key, tree->compare)) { + return ResFAIL; + } else { + AVER(SplayNodeRightChild(leftLast) == NULL); + SplayNodeSetRightChild(leftLast, rightHalf); + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, leftLast); + } + } + } + + SplayNodeFinish(node); + + return ResOK; +} + + +/* SplayTreeSearch -- Search for a node in a splay tree matching a key + * + * See design.mps.splay.function.splay.tree.search and + * design.mps.splay.impl.search. + */ + + +Res SplayTreeSearch(SplayNode *nodeReturn, SplayTree tree, void *key) { + SplayNode node; + + AVERT(SplayTree, tree); + AVER(nodeReturn != NULL); + + if(SplaySplay(&node, tree, key, tree->compare)) { + *nodeReturn = node; + } else { + return ResFAIL; + } + + return ResOK; +} + + +/* SplayTreePredecessor -- Splays a tree at the root's predecessor + * + * Must not be called on en empty tree. Predecessor need not exist, + * in which case NULL is returned, and the tree is unchanged. + */ + +static SplayNode SplayTreePredecessor(SplayTree tree, void *key) { + SplayNode oldRoot, newRoot; + + AVERT(SplayTree, tree); + + oldRoot = SplayTreeRoot(tree); + AVERT(SplayNode, oldRoot); + + if(SplayNodeLeftChild(oldRoot) == NULL) { + newRoot = NULL; /* No predecessor */ + } else { + /* temporarily chop off the right half-tree, inclusive of root */ + SplayTreeSetRoot(tree, SplayNodeLeftChild(oldRoot)); + SplayNodeSetLeftChild(oldRoot, NULL); + if(SplaySplay(&newRoot, tree, key, tree->compare)) { + NOTREACHED; /* Another matching node found */ + } else { + AVER(SplayNodeRightChild(newRoot) == NULL); + SplayNodeSetRightChild(newRoot, oldRoot); + } + + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, oldRoot); + SplayNodeUpdate(tree, newRoot); + } + } + + return newRoot; +} + + +/* SplayTreeSuccessor -- Splays a tree at the root's successor + * + * Must not be called on en empty tree. Successor need not exist, + * in which case NULL is returned, and the tree is unchanged. + */ + +static SplayNode SplayTreeSuccessor(SplayTree tree, void *key) { + SplayNode oldRoot, newRoot; + + AVERT(SplayTree, tree); + + oldRoot = SplayTreeRoot(tree); + AVERT(SplayNode, oldRoot); + + if(SplayNodeRightChild(oldRoot) == NULL) { + newRoot = NULL; /* No successor */ + } else { + /* temporarily chop off the left half-tree, inclusive of root */ + SplayTreeSetRoot(tree, SplayNodeRightChild(oldRoot)); + SplayNodeSetRightChild(oldRoot, NULL); + if(SplaySplay(&newRoot, tree, key, tree->compare)) { + NOTREACHED; /* Another matching node found */ + } else { + AVER(SplayNodeLeftChild(newRoot) == NULL); + SplayNodeSetLeftChild(newRoot, oldRoot); + } + + if(tree->updateNode != NULL) { + SplayNodeUpdate(tree, oldRoot); + SplayNodeUpdate(tree, newRoot); + } + } + + return newRoot; +} + + +/* SplayTreeNeighbours + * + * Search for the two nodes in a splay tree neighbouring a key. + * + * See design.mps.splay.function.splay.tree.neighbours and + * design.mps.splay.impl.neighbours. + */ + + +Res SplayTreeNeighbours(SplayNode *leftReturn, SplayNode *rightReturn, + SplayTree tree, void *key) { + SplayNode neighbour; + + AVERT(SplayTree, tree); + AVER(leftReturn != NULL); + AVER(rightReturn != NULL); + + if(SplaySplay(&neighbour, tree, key, tree->compare)) { + return ResFAIL; + } else if(neighbour == NULL) { + *leftReturn = *rightReturn = NULL; + } else { + switch(SplayCompare(tree, key, neighbour)) { + + case CompareLESS: { + *rightReturn = neighbour; + *leftReturn = SplayTreePredecessor(tree, key); + } break; + + case CompareGREATER: { + *leftReturn = neighbour; + *rightReturn = SplayTreeSuccessor(tree, key); + } break; + + case CompareEQUAL: + default: { + NOTREACHED; + } break; + } + } + return ResOK; +} + + +/* SplayTreeFirst, SplayTreeNext -- Iterators + * + * SplayTreeFirst receives a key that must precede all + * nodes in the tree. It returns NULL if the tree is empty. + * Otherwise, it splays the tree to the first node, and returns the + * new root. See design.mps.splay.function.splay.tree.first. + * + * SplayTreeNext takes a tree and splays it to the successor of the + * old root, and returns the new root. Returns NULL is there are + * no successors. It takes a key for the old root. See + * design.mps.splay.function.splay.tree.next. + */ + +SplayNode SplayTreeFirst(SplayTree tree, void *zeroKey) { + SplayNode node; + AVERT(SplayTree, tree); + + if(SplayTreeRoot(tree) == NULL) { + node = NULL; + } else if(SplaySplay(&node, tree, zeroKey, tree->compare)) { + NOTREACHED; + } else { + AVER(SplayNodeLeftChild(node) == NULL); + } + + return node; +} + +SplayNode SplayTreeNext(SplayTree tree, SplayNode oldNode, void *oldKey) { + Bool b; + SplayNode node; + + AVERT(SplayTree, tree); + AVERT(SplayNode, oldNode); + + /* Make old node the root. Probably already is. */ + b = SplaySplay(&node, tree, oldKey, tree->compare); + AVER(b); + AVER(node == oldNode); + + return SplayTreeSuccessor(tree, oldKey); +} + + +/* SplayNodeDescribe -- Describe a node in the splay tree + * + * Note that this breaks the restriction of .note.stack. + * This is alright as the function is debug only. + */ + +static Res SplayNodeDescribe(SplayNode node, mps_lib_FILE *stream, + SplayNodeDescribeMethod nodeDescribe) { + Res res; + + AVERT(SplayNode, node); + /* stream and nodeDescribe checked by SplayTreeDescribe */ + + res = WriteF(stream, "( ", NULL); + if(res != ResOK) + return res; + + if(SplayNodeLeftChild(node) != NULL) { + res = SplayNodeDescribe(SplayNodeLeftChild(node), stream, nodeDescribe); + if(res != ResOK) + return res; + + res = WriteF(stream, " / ", NULL); + if(res != ResOK) + return res; + } + + res = (*nodeDescribe)(node, stream); + if(res != ResOK) + return res; + + if(SplayNodeRightChild(node) != NULL) { + res = WriteF(stream, " \\ ", NULL); + if(res != ResOK) + return res; + + res = SplayNodeDescribe(SplayNodeRightChild(node), stream, nodeDescribe); + if(res != ResOK) + return res; + } + + res = WriteF(stream, " )", NULL); + if(res != ResOK) + return res; + + return ResOK; +} + +typedef struct { + SplayTestNodeMethod testNode; + SplayTestTreeMethod testTree; + void *p; + unsigned long s; + SplayTree tree; +} SplayFindClosureStruct, *SplayFindClosure; + +static Compare SplayFindFirstCompare(void *key, SplayNode node) +{ + SplayFindClosure closure; + void *closureP; + unsigned long closureS; + SplayTestNodeMethod testNode; + SplayTestTreeMethod testTree; + SplayTree tree; + + AVERT(SplayNode, node); + AVER(key != NULL); + + closure = (SplayFindClosure)key; + closureP = closure->p; + closureS = closure->s; + testNode = closure->testNode; + testTree = closure->testTree; + tree = closure->tree; + + if(SplayNodeLeftChild(node) != NULL && + (*testTree)(tree, SplayNodeLeftChild(node), closureP, closureS)) { + return CompareLESS; + } else if((*testNode)(tree, node, closureP, closureS)) { + return CompareEQUAL; + } else { + AVER(SplayNodeRightChild(node) != NULL && + (*testTree)(tree, SplayNodeRightChild(node), closureP, closureS)); + return CompareGREATER; + } +} + +static Compare SplayFindLastCompare(void *key, SplayNode node) +{ + SplayFindClosure closure; + void *closureP; + unsigned long closureS; + SplayTestNodeMethod testNode; + SplayTestTreeMethod testTree; + SplayTree tree; + + AVERT(SplayNode, node); + AVER(key != NULL); + + closure = (SplayFindClosure)key; + closureP = closure->p; + closureS = closure->s; + testNode = closure->testNode; + testTree = closure->testTree; + tree = closure->tree; + + if(SplayNodeRightChild(node) != NULL && + (*testTree)(tree, SplayNodeRightChild(node), closureP, closureS)) { + return CompareGREATER; + } else if((*testNode)(tree, node, closureP, closureS)) { + return CompareEQUAL; + } else { + AVER(SplayNodeLeftChild(node) != NULL && + (*testTree)(tree, SplayNodeLeftChild(node), closureP, closureS)); + return CompareLESS; + } +} + + +/* SplayFindFirst -- Find first node that satisfies client property + * + * This function finds the first node (in address order) in the given + * tree that satisfies some property defined by the client. The + * property is such that the client can detect, given a sub-tree, + * whether that sub-tree contains any nodes satisfying the property. + * + * The given callbacks testNode and testTree detect this property in + * a single node or a sub-tree rooted at a node, and both receive the + * arbitrary closures closureP and closureS. + */ + +Bool SplayFindFirst(SplayNode *nodeReturn, SplayTree tree, + SplayTestNodeMethod testNode, + SplayTestTreeMethod testTree, + void *closureP, unsigned long closureS) +{ + SplayNode node; + SplayFindClosureStruct closureStruct; + + AVER(nodeReturn != NULL); + AVERT(SplayTree, tree); + AVER(FUNCHECK(testNode)); + AVER(FUNCHECK(testTree)); + + node = SplayTreeRoot(tree); + + if(node == NULL || !(*testTree)(tree, node, closureP, closureS)) + return FALSE; /* no suitable nodes in tree */ + + closureStruct.p = closureP; + closureStruct.s = closureS; + closureStruct.testNode = testNode; + closureStruct.testTree = testTree; + closureStruct.tree = tree; + + if(SplaySplay(&node, tree, (void *)&closureStruct, + &SplayFindFirstCompare)) { + *nodeReturn = node; + return TRUE; + } else { + return FALSE; + } +} + + +/* SplayFindLast -- As SplayFindFirst but in reverse address order */ + +Bool SplayFindLast(SplayNode *nodeReturn, SplayTree tree, + SplayTestNodeMethod testNode, + SplayTestTreeMethod testTree, + void *closureP, unsigned long closureS) +{ + SplayNode node; + SplayFindClosureStruct closureStruct; + + AVER(nodeReturn != NULL); + AVERT(SplayTree, tree); + AVER(FUNCHECK(testNode)); + AVER(FUNCHECK(testTree)); + + node = SplayTreeRoot(tree); + + if(node == NULL || !(*testTree)(tree, node, closureP, closureS)) + return FALSE; /* no suitable nodes in tree */ + + closureStruct.p = closureP; + closureStruct.s = closureS; + closureStruct.testNode = testNode; + closureStruct.testTree = testTree; + closureStruct.tree = tree; + + if(SplaySplay(&node, tree, (void *)&closureStruct, + &SplayFindLastCompare)) { + *nodeReturn = node; + return TRUE; + } else { + return FALSE; + } +} + + +/* SplayRoot -- return the root node of the tree */ + +Bool SplayRoot(SplayNode *nodeReturn, SplayTree tree) +{ + SplayNode node; + + AVER(nodeReturn != NULL); + AVERT(SplayTree, tree); + + node = SplayTreeRoot(tree); + if(node == NULL) + return FALSE; + else { + *nodeReturn = node; + return TRUE; + } +} + + +/* SplayNodeRefresh -- Updates the client property that has changed at a node + * + * This function undertakes to call the client updateNode callback for each + * node affected by the change in properties at the given node (which has + * the given key) in an appropriate order. + * + * The function fullfils its job by first splaying at the given node, and + * updating the single node. This may change. + */ + +void SplayNodeRefresh(SplayTree tree, SplayNode node, void *key) +{ + Bool b; + SplayNode node2; + + AVERT(SplayTree, tree); + AVERT(SplayNode, node); + + b = SplaySplay(&node2, tree, key, tree->compare); + AVER(b); + AVER(node == node2); + + (*tree->updateNode)(tree, node, SplayNodeLeftChild(node), + SplayNodeRightChild(node)); +} + + +/* SplayTreeDescribe -- Describe a splay tree + * + * See design.mps.splay.function.splay.tree.describe. + */ + +Res SplayTreeDescribe(SplayTree tree, mps_lib_FILE *stream, + SplayNodeDescribeMethod nodeDescribe) { + Res res; + + if(!SplayTreeCheck(tree)) return ResFAIL; + if(stream == NULL) return ResFAIL; + if(!FUNCHECK(nodeDescribe)) return ResFAIL; + + res = WriteF(stream, + "Splay $P {\n", (WriteFP)tree, + " compare $F\n", (WriteFF)tree->compare, + NULL); + if(res != ResOK) + return res; + + if(SplayTreeRoot(tree) != NULL) { + res = SplayNodeDescribe(SplayTreeRoot(tree), stream, nodeDescribe); + if(res != ResOK) + return res; + } + + res = WriteF(stream, "\n}\n", NULL); + return res; +} diff --git a/mps/code/splay.h b/mps/code/splay.h new file mode 100644 index 00000000000..98e41a0cd89 --- /dev/null +++ b/mps/code/splay.h @@ -0,0 +1,84 @@ +/* impl.h.splay: SPLAY TREE HEADER + * + * $HopeName: MMsrc!splay.h(trunk.2) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .source: design.mps.splay + */ + +#ifndef splay_h +#define splay_h + +#include "mpmtypes.h" /* for Res, etc. */ + + +typedef struct SplayTreeStruct *SplayTree; +typedef struct SplayNodeStruct *SplayNode; +typedef unsigned Compare; +typedef Compare (*SplayCompareMethod)(void *key, SplayNode node); +typedef Bool (*SplayTestNodeMethod)(SplayTree tree, SplayNode node, + void *closureP, unsigned long closureS); +typedef Bool (*SplayTestTreeMethod)(SplayTree tree, SplayNode node, + void *closureP, unsigned long closureS); +typedef void (*SplayUpdateNodeMethod)(SplayTree tree, SplayNode node, + SplayNode leftChild, + SplayNode rightChild); +typedef Res (*SplayNodeDescribeMethod)(SplayNode node, mps_lib_FILE *stream); +enum { + CompareLESS = 1, + CompareEQUAL, + CompareGREATER +}; + + +typedef struct SplayTreeStruct { + SplayCompareMethod compare; + SplayUpdateNodeMethod updateNode; + SplayNode root; +} SplayTreeStruct; + +typedef struct SplayNodeStruct { + SplayNode left; + SplayNode right; +} SplayNodeStruct; + + +extern Bool SplayTreeCheck(SplayTree tree); +extern Bool SplayNodeCheck(SplayNode node); +extern void SplayTreeInit(SplayTree tree, SplayCompareMethod compare, + SplayUpdateNodeMethod updateNode); +extern void SplayNodeInit(SplayNode node); +extern void SplayNodeFinish(SplayNode node); +extern void SplayTreeFinish(SplayTree tree); + +extern Res SplayTreeInsert(SplayTree tree, SplayNode node, void *key); +extern Res SplayTreeDelete(SplayTree tree, SplayNode node, void *key); + +extern Res SplayTreeSearch(SplayNode *nodeReturn, + SplayTree tree, void *key ); +extern Res SplayTreeNeighbours(SplayNode *leftReturn, + SplayNode *rightReturn, + SplayTree tree, void *key); + +extern SplayNode SplayTreeFirst(SplayTree tree, void *zeroKey); +extern SplayNode SplayTreeNext(SplayTree tree, SplayNode oldNode, + void *oldKey); + +extern Bool SplayFindFirst(SplayNode *nodeReturn, SplayTree tree, + SplayTestNodeMethod testNode, + SplayTestTreeMethod testTree, + void *closureP, unsigned long closureS); +extern Bool SplayFindLast(SplayNode *nodeReturn, SplayTree tree, + SplayTestNodeMethod testNode, + SplayTestTreeMethod testTree, + void *closureP, unsigned long closureS); + +extern void SplayNodeRefresh(SplayTree tree, SplayNode node, void *key); + +extern Res SplayTreeDescribe(SplayTree tree, mps_lib_FILE *stream, + SplayNodeDescribeMethod nodeDescribe); + +extern Bool SplayRoot(SplayNode *nodeReturn, SplayTree tree); + + +#endif /* splay_h */ diff --git a/mps/code/ss.h b/mps/code/ss.h new file mode 100644 index 00000000000..5bc8524d657 --- /dev/null +++ b/mps/code/ss.h @@ -0,0 +1,36 @@ +/* impl.h.ss + * STACK SCANNING + * + * $HopeName: MMsrc!ss.h(MMdevel_restr.2) $ + * + * Copyright (C) 1995 Harlequin Group, all rights reserved + * + * Provides a function for scanning the stack and registers + * + */ + +#ifndef ss_h +#define ss_h + +#include "mpm.h" + + +/* == StackScan == + * + * StackScan scans the current stack between the + * stackBot and the current top of stack. It also fixes + * any roots which may be in registers. + * + * See the specific implementation for the exact registers which + * are scanned. + * + * The word pointed to by stackBot is fixed if the stack + * is by convention empty, and not fixed if it is full. + * Where empty means sp points to first free word beyond the top of + * stack. Full means sp points to the top of stack itself. + */ + +extern Res StackScan(ScanState ss, Addr *stackBot); + + +#endif /* ss_h */ diff --git a/mps/code/ssan.c b/mps/code/ssan.c new file mode 100644 index 00000000000..0143a3738dc --- /dev/null +++ b/mps/code/ssan.c @@ -0,0 +1,22 @@ +/* impl.c.ssan: ANSI STACK SCANNER + * + * $HopeName$ + * Copyright (C) 1996 Harlequin Limited. All rights reserved. + * + * This module provides zero functionality. It exists to feed the + * linker (prevent linker errors). + */ + +#include "mpmtypes.h" +#include "misc.h" +#include "ss.h" + + +SRCID(ssan, "$HopeName$"); + + +Res StackScan(ScanState ss, Addr *stackBot) +{ + UNUSED(ss); UNUSED(stackBot); + return ResUNIMPL; +} diff --git a/mps/code/sslii3.c b/mps/code/sslii3.c new file mode 100644 index 00000000000..23e0f25c2a2 --- /dev/null +++ b/mps/code/sslii3.c @@ -0,0 +1,58 @@ +/* impl.c.sslii3: LINUX/INTEL STACK SCANNING + * + * $HopeName: MMsrc!sslii3.c(trunk.1) $ + * Copyright (C) 1999. Harlequin Group plc. All rights reserved. + * + * This scans the stack and fixes the registers which may contain + * roots. See design.mps.thread-manager + * + * The registers edi, esi, ebx are the registers defined to be preserved + * across function calls and therefore may contain roots. + * These are pushed on the stack for scanning. + * + * SOURCES + * + * .source.callees.saves: Set of callee-saved registers taken from + * CALL_USED_REGISTERS in /config/i386/i386.h. + * + * ASSUMPTIONS + * + * .assume.align: The stack pointer is assumed to be aligned on a word + * boundary. + * + * .assume.asm.stack: The compiler must not do wacky things with the + * stack pointer around a call since we need to ensure that the + * callee-save regs are visible during TraceScanArea. + * + * .assume.asm.order: The volatile modifier should prevent movement + * of code, which might break .assume.asm.stack. + * + */ + + +#include "mpm.h" + +SRCID(sslii3, "$HopeName: MMsrc!sslii3.c(trunk.1) $"); + +/* .assume.asm.order */ +#define ASMV(x) __asm__ volatile (x) + + +Res StackScan(ScanState ss, Addr *stackBot) +{ + Addr *stackTop; + Res res; + + /* .assume.asm.stack */ + ASMV("push %ebx"); /* These registers are callee-saved */ + ASMV("push %esi"); /* and so may contain roots. They are pushed */ + ASMV("push %edi"); /* for scanning. See .source.callees.saves. */ + ASMV("mov %%esp, %0" : "=r" (stackTop) :); /* stackTop = esp */ + + AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr))); /* .assume.align */ + res = TraceScanArea(ss, stackTop, stackBot); + + ASMV("add $12, %esp"); /* pop 3 regs to restore the stack pointer */ + + return res; +} diff --git a/mps/code/sso1al.s b/mps/code/sso1al.s new file mode 100644 index 00000000000..8ade1783d61 --- /dev/null +++ b/mps/code/sso1al.s @@ -0,0 +1,42 @@ + # impl.s.sso1al: STACK SCANNING FOR DIGITAL UNIX / ALPHA + # + # $HopeName: MMsrc!sso1al.s(trunk.1) $ + # Copyright (C) 1997 Harlequin Group, all rights reserved + # + # .readership: Any MPS developer that is prepared to read Alpha + # assembly code in DIGITAL UNIX 'as' syntax. + # + # See design.mps.sso1al for the design (exists). + + +.globl StackScan +.globl TraceScanArea + +.ent StackScan +StackScan: +ldgp $gp,0($27) # faff with global pointer +lda $sp,-64($sp) # build and declare frame and saveregs +.frame $sp,64,$26 +.mask 0x400FE00,-64 +stq $26,0($sp) # dump ra and other regs so that they get fixed +stq $9,8($sp) +stq $10,16($sp) +stq $11,24($sp) +stq $12,32($sp) +stq $13,40($sp) +stq $14,48($sp) +stq $15,56($sp) +.prologue 1 + + # bis $31,$16,$16 1st arg to TraceScanArea is same as our 1st arg +bis $31,$17,$18 # area to be scanned is from $sp to StackBot +bis $31,$sp,$17 + +jsr $26,TraceScanArea +ldgp $gp,0($26) + # our result is TraceScanArea's result, so leave $0 untouched + +ldq $26,0($sp) +lda $sp,+64($sp) +ret $31,($26),1 +.end StackScan diff --git a/mps/code/sssos8.s b/mps/code/sssos8.s new file mode 100644 index 00000000000..41c0ea5807e --- /dev/null +++ b/mps/code/sssos8.s @@ -0,0 +1,43 @@ +! impl.s.sssos8 +! +! STACK SCANNING +! +! $HopeName: MMsrc!sssos9sc.S(trunk.1) $ +! +! Copyright (C) 1995 Harlequin Group, all rights reserved +! +! This scans the stack and the preserved integer registers. +! See design.mps.thread-manager +! +! This file is identical to impl.s.sssus8, except for the +! leading underscore convention on C names. They should be +! changed in parallel. +! +! The non-global registers are preserved into the stackframe +! by the "ta 3" instruction. This leaves the global registers. +! According to the Sparc Architecture Manual: +! %g1 is assumed to be volatile across procedure calls +! %g2...%g4 are "reserved for use by application programmer" +! %g5...%g7 are "nonvolatile and reserved for (as-yet-undefined) +! use by the execution environment" +! To be safe %g2 to %g7 are pushed onto the stack before scanning +! it just in case. + +.text + .align 4 + .global StackScan +StackScan: !(ss, stackBot) + save %sp,-120,%sp !23 required + 6 globals = 29 words, 8-aligned + + std %g6,[%fp-8] !double stores + std %g4,[%fp-16] + std %g2,[%fp-24] + ta 3 !flushes register windows onto stack + + mov %i0,%o0 !ss + sub %fp,24,%o1 !stackTop (base) + call TraceScanArea !(stackTop,stackBot,trace,rank) returns e + mov %i1,%o2 !ds!stackBot (limit) + + ret + restore %g0,%o0,%o0 !ds!return e diff --git a/mps/code/sssus8.s b/mps/code/sssus8.s new file mode 100644 index 00000000000..8fd9e5845aa --- /dev/null +++ b/mps/code/sssus8.s @@ -0,0 +1,43 @@ +! impl.s.sssus8 +! +! STACK SCANNING +! +! $HopeName: MMsrc!sssos9sc.S(trunk.1) $ +! +! Copyright (C) 1995 Harlequin Group, all rights reserved +! +! This scans the stack and the preserved integer registers. +! See design.mps.thread-manager +! +! This file is identical to impl.s.sssos8, except for the +! leading underscore convention on C names. They should be +! changed in parallel. +! +! The non-global registers are preserved into the stackframe +! by the "ta 3" instruction. This leaves the global registers. +! According to the Sparc Architecture Manual: +! %g1 is assumed to be volatile across procedure calls +! %g2...%g4 are "reserved for use by application programmer" +! %g5...%g7 are "nonvolatile and reserved for (as-yet-undefined) +! use by the execution environment" +! To be safe %g2 to %g7 are pushed onto the stack before scanning +! it just in case. + +.text + .align 4 + .global _StackScan +_StackScan: !(ss, stackBot) + save %sp,-120,%sp !23 required + 6 globals = 29 words, 8-aligned + + std %g6,[%fp-8] !double stores + std %g4,[%fp-16] + std %g2,[%fp-24] + ta 3 !flushes register windows onto stack + + mov %i0,%o0 !ss + sub %fp,24,%o1 !stackTop (base) + call _TraceScanArea !(stackTop,stackBot,trace,rank) returns e + mov %i1,%o2 !ds!stackBot (limit) + + ret + restore %g0,%o0,%o0 !ds!return e diff --git a/mps/code/ssw3i3.c b/mps/code/ssw3i3.c new file mode 100644 index 00000000000..977ebffb180 --- /dev/null +++ b/mps/code/ssw3i3.c @@ -0,0 +1,45 @@ +/* impl.c.ssw3i3: WIN32/INTEL STACK SCANNING + * + * $HopeName: MMsrc!ssw3i3.c() $ + * Copyright (C) 1999. Harlequin Group plc. All rights reserved. + * + * This scans the stack and fixes the registers which may contain + * roots. See design.mps.thread-manager + * + * The registers edi, esi, ebx are the registers defined to be preserved + * across function calls and therefore may contain roots. + * These are pushed on the stack for scanning. + * + * ASSUMPTIONS + * + * .align: The stack pointer is assumed to be aligned on a word + * boundary. + */ + + +#include "mpm.h" + +SRCID(ssw3i3, "$HopeName: MMsrc!ssw3i3.c() $"); + + +Res StackScan(ScanState ss, Addr *stackBot) +{ + Addr *stackTop; + Res res; + + __asm { + push edi /* these registers are the save registers */ + push esi /* and so may contain roots. They are pushed */ + push ebx /* for scanning */ + mov stackTop, esp /* stack pointer */ + } + + AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr))); /* .align */ + res = TraceScanArea(ss, stackTop, stackBot); + + __asm { + add esp, 0xc /* pop 3 registers to restore the stack pointer */ + } + + return res; +} diff --git a/mps/code/sus8gc.gmk b/mps/code/sus8gc.gmk new file mode 100644 index 00000000000..53c9d7f6051 --- /dev/null +++ b/mps/code/sus8gc.gmk @@ -0,0 +1,16 @@ +# impl.gmk.sus8gc: BUILD FOR SUNOS/SPARC V8/GCC PLATFORM +# +# $HopeName: MMsrc!sus8gc.gmk(trunk.42) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = sus8gc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmsu.c \ + protsu.c prmcan.c span.c +MPMS = sssus8.s + +LIBS = -lm + +include gc.gmk + +include comm.gmk diff --git a/mps/code/sus8lc.gmk b/mps/code/sus8lc.gmk new file mode 100644 index 00000000000..fda51d3d574 --- /dev/null +++ b/mps/code/sus8lc.gmk @@ -0,0 +1,14 @@ +# impl.gmk.sus8lc: BUILD FOR SUNOS/SPARC V8/LCC PLATFORM +# +# $HopeName: MMsrc!sus8lc.gmk(trunk.20) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. +# +# This is the GNU makefile for platform.sus8lc. + +PFM = sus8lc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmsu.c \ + protsu.c prmcan.c span.c +MPMS = sssus8.s + +include lc.gmk diff --git a/mps/code/table.c b/mps/code/table.c new file mode 100644 index 00000000000..edc8fb884b4 --- /dev/null +++ b/mps/code/table.c @@ -0,0 +1,279 @@ +/* impl.h.table: A dictionary mapping a Word to a void* + * + * $HopeName$ + * Copyright (C) 1999 Harlequin Limited. All rights reserved. + * + * .note.good-hash: As is common in hash table implementations, we + * assume that the hash function is good. + */ + +#include "table.h" +#include "mpmtypes.h" + +#include +#include +#include +#include +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif + + +typedef unsigned long ulong; + + +#define tableUNUSED ((Word)0x2AB7E040) +#define tableDELETED ((Word)0x2AB7EDE7) +#define tableACTIVE ((Word)0x2AB7EAC2) + + +typedef struct TableEntryStruct *TableEntry; +typedef struct TableEntryStruct { + Word status; + Word key; + void *value; +} TableEntryStruct; + + +typedef struct TableStruct { + size_t length; + size_t count; + size_t limit; + TableEntry array; +} TableStruct; + + + +/* sizeFloorLog2 -- logarithm base 2 */ + +static size_t sizeFloorLog2(size_t size) +{ + size_t l = 0; + + assert(size != 0); + while(size > 1) { + ++l; + size >>= 1; + } + return l; +} + + +/* TableHash -- table hashing function */ + +static ulong TableHash(Word key) +{ + /* Shift some randomness into the low bits. */ + return (key >> 10) + key; +} + + +/* TableFind -- finds the entry for this key, or NULL + * + * .worst: In the worst case, this looks at every slot before giving up, + * but that's what you have to do in a closed hash table, to make sure + * that all the items still fit in after growing the table. + */ + +static TableEntry TableFind(Table table, Word key, int skip_deleted) +{ + ulong hash; + size_t i, mask = table->length - 1; + + hash = TableHash(key) & mask; + i = hash; + do { + switch (table->array[i].status) { + case tableACTIVE: + if (table->array[i].key == key) + return &table->array[i]; + break; + case tableDELETED: + if (!skip_deleted) + return &table->array[i]; + break; + case tableUNUSED: + return &table->array[i]; + break; + } + i = (i + 1) & mask; + } while(i != hash); + + return NULL; +} + + +/* TableGrow -- doubles the size of the table */ + +static Res TableGrow(Table table) +{ + TableEntry oldArray, newArray; + size_t i, oldLength, newLength; + + oldLength = table->length; + oldArray = table->array; + newLength = oldLength * 2; + newArray = malloc(sizeof(TableEntryStruct) * newLength); + if(newArray == NULL) return ResMEMORY; + + for(i = 0; i < newLength; ++i) { + newArray[i].key = 0; + newArray[i].value = NULL; + newArray[i].status = tableUNUSED; + } + + table->length = newLength; + table->array = newArray; + table->limit *= 2; + + for(i = 0; i < oldLength; ++i) { + if (oldArray[i].status == tableACTIVE) { + TableEntry entry; + entry = TableFind(table, oldArray[i].key, 0 /* none deleted */); + assert(entry != NULL); + assert(entry->status == tableUNUSED); + entry->key = oldArray[i].key; + entry->value = oldArray[i].value; + entry->status = tableACTIVE; + } + } + free(oldArray); + + return ResOK; +} + + +/* TableCreate -- makes a new table */ + +extern Res TableCreate(Table *tableReturn, size_t length) +{ + Table table; + size_t i; + + assert(tableReturn != NULL); + + table = malloc(sizeof(TableStruct)); + if(table == NULL) goto failMallocTable; + if (length < 2) length = 2; + /* Table size is length rounded up to the next power of 2. */ + table->length = 1 << (sizeFloorLog2(length-1) + 1); + table->count = 0; + table->limit = (size_t)(.5 * length); + table->array = malloc(sizeof(TableEntryStruct) * length); + if(table->array == NULL) goto failMallocArray; + for(i = 0; i < length; ++i) { + table->array[i].key = 0; + table->array[i].value = NULL; + table->array[i].status = tableUNUSED; + } + + *tableReturn = table; + return ResOK; + +failMallocArray: + free(table); +failMallocTable: + return ResMEMORY; +} + + +/* TableDestroy -- destroy a table */ + +extern void TableDestroy(Table table) +{ + assert(table != NULL); + free(table->array); + free(table); +} + + +/* TableLookup -- look up */ + +extern Bool TableLookup(void **valueReturn, Table table, Word key) +{ + TableEntry entry = TableFind(table, key, 1 /* skip deleted */); + + if(entry == NULL || entry->status != tableACTIVE) + return FALSE; + *valueReturn = entry->value; + return TRUE; +} + + +/* TableDefine -- add a new mapping */ + +extern Res TableDefine(Table table, Word key, void *value) +{ + TableEntry entry; + + if (table->count >= table->limit) { + Res res = TableGrow(table); + if(res != ResOK) return res; + entry = TableFind(table, key, 0 /* no deletions yet */); + assert(entry != NULL); + if (entry->status == tableACTIVE) + return ResFAIL; + } else { + entry = TableFind(table, key, 1 /* skip deleted */); + if (entry != NULL && entry->status == tableACTIVE) + return ResFAIL; + /* Search again to find the best slot, deletions included. */ + entry = TableFind(table, key, 0 /* don't skip deleted */); + assert(entry != NULL); + } + + entry->status = tableACTIVE; + entry->key = key; + entry->value = value; + ++table->count; + + return ResOK; +} + + +/* TableRedefine -- redefine an existing mapping */ + +extern Res TableRedefine(Table table, Word key, void *value) +{ + TableEntry entry = TableFind(table, key, 1 /* skip deletions */); + + if (entry == NULL || entry->status != tableACTIVE) + return ResFAIL; + assert(entry->key == key); + entry->value = value; + return ResOK; +} + + +/* TableRemove -- remove a mapping */ + +extern Res TableRemove(Table table, Word key) +{ + TableEntry entry = TableFind(table, key, 1); + + if (entry == NULL || entry->status != tableACTIVE) + return ResFAIL; + entry->status = tableDELETED; + --table->count; + return ResOK; +} + + +/* TableMap -- apply a function to all the mappings */ + +extern void TableMap(Table table, void(*fun)(Word key, void*value)) +{ + size_t i; + for (i = 0; i < table->length; i++) + if (table->array[i].status == tableACTIVE) + (*fun)(table->array[i].key, table->array[i].value); +} + + +/* TableCount -- count the number of mappings in the table */ + +extern size_t TableCount(Table table) +{ + return table->count; +} diff --git a/mps/code/table.h b/mps/code/table.h new file mode 100644 index 00000000000..46864a54b1b --- /dev/null +++ b/mps/code/table.h @@ -0,0 +1,26 @@ +/* impl.h.table: Interface for a dictionary + * Copyright (C) 1997, 1999 Harlequin Group plc. All rights reserved. + * + * $HopeName: MMsrc!table.h(trunk.1) $ + */ + +#ifndef table_h +#define table_h + +#include "mpmtypes.h" +#include + + +typedef struct TableStruct *Table; + +extern Res TableCreate(Table *tableReturn, size_t length); +extern void TableDestroy(Table table); +extern Res TableDefine(Table table, Word key, void *value); +extern Res TableRedefine(Table table, Word key, void *value); +extern Bool TableLookup(void **valueReturn, Table table, Word key); +extern Res TableRemove(Table table, Word key); +extern size_t TableCount(Table table); +extern void TableMap(Table table, void(*fun)(Word key, void *value)); + + +#endif /* table_h */ diff --git a/mps/code/teletest.c b/mps/code/teletest.c new file mode 100644 index 00000000000..8300355afe5 --- /dev/null +++ b/mps/code/teletest.c @@ -0,0 +1,221 @@ +/* impl.c.teletest: TELEMETRY TEST + * + * $HopeName: MMsrc!teletest.c(trunk.5) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .source: The command parser here was taken and adapted from bttest.c. + */ + +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "testlib.h" + +#include + + +SRCID(teletest, "$HopeName: MMsrc!teletest.c(trunk.5) $"); + + +static mps_arena_t arena; + + +#define MAX_ARGS 3 +#define INPUT_BUFFER_SIZE 512 + +#if (MPS_WORD_WIDTH == 32) +#define WORD_FORMAT "0x%08lx" +#elif (MPS_WORD_WIDTH == 64) +#define WORD_FORMAT "0x%016lx" +#else +#error "Unrecognized word width" +#endif + + +static mps_word_t args[MAX_ARGS]; +static char *stringArg; +static Count argCount; + + +static void callControl(mps_word_t reset, mps_word_t flip) +{ + mps_word_t old, new; + old = mps_telemetry_control(reset, flip); + new = mps_telemetry_control((mps_word_t)0, (mps_word_t)0); + + (void)printf(WORD_FORMAT " -> " WORD_FORMAT "\n", old, new); +} + + +static void doControl(void) +{ + callControl(args[0], args[1]); +} + + +static void doRead(void) +{ + mps_word_t old; + old = mps_telemetry_control((mps_word_t)0, (mps_word_t)0); + + (void)printf(WORD_FORMAT "\n", old); +} + + +static void doSet(void) +{ + callControl(args[0], args[0]); +} + + +static void doReset(void) +{ + callControl(args[0], (mps_word_t)0); +} + + +static void doFlip(void) +{ + callControl((mps_word_t)0, args[0]); +} + + +static void doIntern(void) +{ + mps_word_t id; + + id = mps_telemetry_intern(stringArg); + (void)printf(WORD_FORMAT "\n", id); +} + +static void doLabel(void) +{ + mps_telemetry_label((mps_addr_t)args[0], args[1]); +} + +static void doFlush(void) +{ + mps_telemetry_flush(); +} + +static void doQuit(void) +{ + mps_arena_destroy(arena); + exit(0); +} + + +static void doHelp(void) +{ + (void)printf("control -> Control filter\n" + "read -> Read filter\n" + "set -> Set filter\n" + "reset -> Reset filter\n" + "flip -> Toggle filter\n" + "intern -> Intern string\n" + "label
Label address\n" + "flush Flush buffer\n" + "help Print this message\n" + "quit Quit\n"); +} + + +static struct commandShapeStruct { + char *name; + Count int_args; + mps_bool_t string_arg; + void (*fun)(void); +} commandShapes[] = { + {"control", 2, 0, doControl}, + {"read", 0, 0, doRead}, + {"set", 1, 0, doSet}, + {"reset", 1, 0, doReset}, + {"flip", 1, 0, doFlip}, + {"intern", 0, 1, doIntern}, + {"label", 2, 0, doLabel}, + {"flush", 0, 0, doFlush}, + {"help", 0, 0, doHelp}, + {"quit", 0, 0, doQuit}, + {NULL, 0, 0, NULL} +}; + + +typedef struct commandShapeStruct *commandShape; + + +static void obeyCommand(char *command) +{ + commandShape shape = commandShapes; + while(shape->name != NULL) { + char *csp = shape->name; + char *p = command; + while (*csp == *p) { + csp++; + p++; + } + if ((*csp == 0) && ((*p == '\n') || (*p == ' '))) { /* complete match */ + argCount = 0; + while ((*p == ' ') && (argCount < shape->int_args)) { + /* get an argument */ + char *newP; + mps_word_t word; + word = (mps_word_t)strtoul(p, &newP, 0); + args[argCount] = word; + if (newP == p) { /* strtoul failed */ + printf("couldn't parse an integer argument\n"); + return; + } + p = newP; + ++ argCount; + } + if(shape->string_arg) { + char *end; + while(*p == ' ') + ++p; + for(end = p; *end != '\n'; end++) + NOOP; + *end = '\0'; + stringArg = p; + } else { + stringArg = NULL; + } + if (argCount < shape->int_args) { + printf("insufficient arguments to command\n"); + } else if (*p != '\n' && stringArg == NULL) { + printf("too many arguments to command\n"); + } else { /* do the command */ + shape->fun(); + } + return; + } else { + ++ shape; /* try next command */ + } + } + printf("command not understood\n> %s\n", command); + doHelp(); +} + + +#define testArenaSIZE (((size_t)64)<<20) + +extern int main(int argc, char *argv[]) +{ + testlib_unused(argc); + testlib_unused(argv); + + die(mps_arena_create((mps_arena_t*)&arena, mps_arena_class_vm(), + testArenaSIZE), + "mps_arena_create"); + doHelp(); + while(1) { + char input[INPUT_BUFFER_SIZE]; + printf("telemetry test> "); + fflush(stdout); + if (fgets(input, INPUT_BUFFER_SIZE , stdin)) { + obeyCommand(input); + } else { + doQuit(); + } + } + return EXIT_SUCCESS; +} diff --git a/mps/code/testlib.c b/mps/code/testlib.c new file mode 100644 index 00000000000..d7ea32271f9 --- /dev/null +++ b/mps/code/testlib.c @@ -0,0 +1,110 @@ +/* impl.c.testlib: TEST LIBRARY + * + * $HopeName: MMsrc!testlib.c(trunk.22) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: A library of functions that may be of use to unit tests. + */ + +#include "testlib.h" +#include "mps.h" +#include "mpm.h" +#include +#include +#ifdef MPS_OS_IA +struct itimerspec; /* stop complaints from time.h */ +#endif +#include + + +/* rnd -- a random number generator + * + * I nabbed it from "ML for the Working Programmer" + * Originally from: + * Stephen K Park & Keith W Miller (1988). Random number generators: + * good one are to find. Communications of the ACM, 31:1192-1201 + */ + +unsigned long rnd(void) +{ + static unsigned long seed = 1; + double s; + s = seed; + s *= 16807.0; + s = fmod(s, 2147483647.0); /* 2^31 - 1 */ + seed = (unsigned long)s; + return seed; +} + + +/* randomize -- randomize the generator, or initialize to replay */ + +void randomize(int argc, char **argv) +{ + int i, k, n; + + if(argc > 1) { + n = sscanf(argv[1], "%d", &k); + die((n == 1) ? MPS_RES_OK : MPS_RES_FAIL, "randomize"); + } else { + k = time(NULL) % 32000; + printf("Randomizing %d times.\n", k); + } + + /* Randomize the random number generator a bit. */ + for (i = k; i > 0; --i) + rnd(); +} + + +/* verror -- die with message */ + +void verror(const char *format, va_list args) +{ + fflush(stdout); /* synchronize */ + vfprintf(stderr, format, args); + fprintf(stderr, "\n"); + exit(1); +} + + +/* error -- die with message */ + +void error(const char *format, ...) +{ + va_list args; + + va_start(args, format); + verror(format, args); + va_end(args); +} + + +/* die -- Test a return code, and exit on error */ + +void die(mps_res_t res, const char *s) +{ + if (res != MPS_RES_OK) { + error("\n%s: %d\n", s, res); + } +} + + +/* die_expect -- Test a return code, and exit on unexpected result */ + +void die_expect(mps_res_t res, mps_res_t expected, const char *s) +{ + if (res != expected) { + error("\n%s: %d\n", s, res); + } +} + + +/* cdie -- Test a C boolean, and exit on error */ + +void cdie(int res, const char *s) +{ + if (!res) { + error("\n%s: %d\n", s, res); + } +} diff --git a/mps/code/testlib.h b/mps/code/testlib.h new file mode 100644 index 00000000000..0db0824c983 --- /dev/null +++ b/mps/code/testlib.h @@ -0,0 +1,153 @@ +/* impl.h.testlib: TEST LIBRARY INTERFACE + * + * $HopeName: MMsrc!testlib.h(trunk.21) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: A library of functions that may be of use to unit tests. + */ + +#ifndef testlib_h +#define testlib_h + +#include "mps.h" +#include "misc.h" /* for STR */ + +/* Include system header hackery. */ +#include "mpstd.h" +#ifdef MPS_OS_SU +#include "ossu.h" +#endif +#ifdef MPS_OS_XC +#include "osxc.h" +#endif + +#include + + +/* Suppress Visual C warnings at warning level 4, */ +/* see mail.richard.1997-09-25.13-26. */ +/* Essentially the same settings are done in config.h. */ + +#ifdef MPS_BUILD_MV + +/* "unreferenced inline function has been removed" (windows.h) */ +#pragma warning(disable: 4514) + +/* "constant conditional" (MPS_END) */ +#pragma warning(disable: 4127) + +/* MSVC 2.0 generates a warning when using NOCHECK or UNUSED */ +#ifdef _MSC_VER +#if _MSC_VER < 1000 +#pragma warning(disable: 4705) +#endif +#else /* _MSC_VER */ +#error "Expected _MSC_VER to be defined for builder.mv" +#endif /* _MSC_VER */ + + +/* MSVC 10.00 on PowerPC generates erroneous warnings about */ +/* uninitialized local variables, if you take their address. */ +#ifdef MPS_ARCH_PP +#pragma warning(disable: 4701) +#endif + +/* In white-hot versions, absolutely no checking is done. This leads to + * many spurious warnings because parameters are suddenly unused, etc. + * We aren't interested in these. + */ + +#if defined(CONFIG_VAR_WI) + +/* "unreferenced formal parameter" */ +#pragma warning(disable: 4100) + +/* "unreferenced local function has been removed" */ +#pragma warning(disable: 4505) + +#endif + + +#endif /* MPS_BUILD_MV */ + + +/* testlib_unused -- declares that a variable is unused + * + * It should be used to prevent compiler warnings about unused + * variables. Care should be exercised; the fact that a variable + * is unused may need justification. + */ + +#define testlib_unused(v) ((void)(v)) + + +/* die -- succeed or die + * + * If the first argument is not ResOK then prints the second + * argument on stderr and exits the program. Otherwise does nothing. + * + * Typical use: + * die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "APCreate"); + */ + +extern void die(mps_res_t res, const char *s); + + +/* die_expect -- get expected result or die + * + * If the first argument is not thename as the second argument, + * prints the third argument on stderr and exits the program. + * Otherwise does nothing. + * + * Typical use: + * die_expect(res, MPS_RES_COMMIT_LIMIT, "Commit limit allocation"); + */ + +extern void die_expect(mps_res_t res, mps_res_t expected, const char *s); + + +/* cdie -- succeed or die + * + * If the first argument is not true (non-zero) then prints the second + * argument on stderr and exits the program. Otherwise does nothing. + * + * Typical use: + * cdie(foo != NULL, "No foo"); + */ + +extern void cdie(int res, const char *s); + + +/* error, verror -- die with message */ + +extern void error(const char *format, ...); +extern void verror(const char *format, va_list args); + + +/* Insist -- like assert, but even in release varieties */ + +#define Insist(cond) insist1(cond, #cond) + +#define insist1(cond, condstring) \ + cdie(cond, condstring "\n" __FILE__ "\n" STR(__LINE__)) + + +/* rnd -- random number generator + * + * rnd() generates a sequence of integers in the range [0, 2^31-2]. + */ + +extern unsigned long rnd(void); + + +/* randomize -- randomize the generator, or initialize to replay + * + * randomize(argc, argv) randomizes the rnd generator (using time(3)) + * and prints out the randomization seed, or takes a seed (as a command- + * line argument) and initializes the generator to the same state. + */ + +extern void randomize(int argc, char **argv); + + +#endif /* testlib_h */ diff --git a/mps/code/th.h b/mps/code/th.h new file mode 100644 index 00000000000..66ade83520d --- /dev/null +++ b/mps/code/th.h @@ -0,0 +1,73 @@ +/* impl.h.th: THREAD MANAGER + * + * $HopeName$ + * Copyright (C) 1995 Harlequin Limited. All rights reserved. + * + * .purpose: Provides thread suspension facilities to the shield. + * See design.mps.thread-manager. Each thread has to be + * individually registered and deregistered with an arena. + */ + +#ifndef th_h +#define th_h + +#include "mpmtypes.h" +#include "ring.h" + + +#define ThreadSig ((Sig)0x519286ED) /* SIGnature THREaD */ + +extern Bool ThreadCheck(Thread thread); + + +/* ThreadCheckSimple + * + * Simple thread-safe check of a thread object. + */ + +extern Bool ThreadCheckSimple(Thread thread); + + +extern Res ThreadDescribe(Thread thread, mps_lib_FILE *stream); + + +/* Register/Deregister + * + * Explicitly register/deregister a thread on the arena threadRing. + * Register returns a "Thread" value which needs to be used + * for deregistration. + * + * Threads must not be multiply registered in the same arena. + */ + +extern Res ThreadRegister(Thread *threadReturn, Arena arena); + +extern void ThreadDeregister(Thread thread, Arena arena); + + +/* ThreadRingSuspend/Resume + * + * These functions suspend/resume the threads on the ring. + * If the current thread is among them, it is not suspended, + * nor is any attempt to resume it made. + */ + +extern void ThreadRingSuspend(Ring threadRing); +extern void ThreadRingResume(Ring threadRing); + + +/* ThreadRingThread + * + * Return the thread from an element of the Arena's + * thread ring. + */ + +extern Thread ThreadRingThread(Ring threadRing); + + +extern Arena ThreadArena(Thread thread); + +extern Res ThreadScan(ScanState ss, Thread thread, void *stackBot); + + +#endif /* th_h */ diff --git a/mps/code/than.c b/mps/code/than.c new file mode 100644 index 00000000000..266705a0293 --- /dev/null +++ b/mps/code/than.c @@ -0,0 +1,144 @@ +/* impl.c.than: ANSI THREADS MANAGER + * + * $HopeName: MMsrc!than.c(trunk.19) $ + * Copyright (C) 1999. Harlequin Limited. All rights reserved. + * + * This is a single-threaded implementation of the threads manager. + * Has stubs for thread suspension. + * See design.mps.thread-manager. + * + * .single: We only expect at most one thread on the ring. + * + * This supports the impl.h.th + */ + +#include "mpm.h" + +SRCID(than, "$HopeName: MMsrc!than.c(trunk.19) $"); + + +typedef struct ThreadStruct { /* ANSI fake thread structure */ + Sig sig; /* design.mps.sig */ + Serial serial; /* from arena->threadSerial */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* attaches to arena */ +} ThreadStruct; + + +Bool ThreadCheck(Thread thread) +{ + CHECKS(Thread, thread); + CHECKU(Arena, thread->arena); + CHECKL(thread->serial < thread->arena->threadSerial); + CHECKL(RingCheck(&thread->arenaRing)); + return TRUE; +} + + +Bool ThreadCheckSimple(Thread thread) +{ + CHECKS(Thread, thread); + return TRUE; +} + + +Res ThreadRegister(Thread *threadReturn, Arena arena) +{ + Res res; + Thread thread; + Ring ring; + void *p; + + AVER(threadReturn != NULL); + + res = ControlAlloc(&p, arena, sizeof(ThreadStruct), + /* withReservoirPermit */ FALSE); + if(res != ResOK) return res; + thread = (Thread)p; + + thread->arena = arena; + RingInit(&thread->arenaRing); + + thread->sig = ThreadSig; + thread->serial = arena->threadSerial; + ++arena->threadSerial; + + AVERT(Thread, thread); + + ring = ArenaThreadRing(arena); + AVER(RingCheckSingle(ring)); /* .single */ + + RingAppend(ring, &thread->arenaRing); + + *threadReturn = thread; + return ResOK; +} + + +void ThreadDeregister(Thread thread, Arena arena) +{ + AVERT(Thread, thread); + AVERT(Arena, arena); + + RingRemove(&thread->arenaRing); + + thread->sig = SigInvalid; + + RingFinish(&thread->arenaRing); + + ControlFree(arena, thread, sizeof(ThreadStruct)); +} + + +void ThreadRingSuspend(Ring threadRing) +{ + AVERT(Ring, threadRing); + return; +} + +void ThreadRingResume(Ring threadRing) +{ + AVERT(Ring, threadRing); + return; +} + +Thread ThreadRingThread(Ring threadRing) +{ + Thread thread; + AVERT(Ring, threadRing); + thread = RING_ELT(Thread, arenaRing, threadRing); + AVERT(Thread, thread); + return thread; +} + + +/* Must be thread-safe. See design.mps.interface.c.thread-safety. */ +Arena ThreadArena(Thread thread) +{ + /* Can't AVER thread as that would not be thread-safe */ + /* AVERT(Thread, thread); */ + return thread->arena; +} + + +Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +{ + UNUSED(thread); + return StackScan(ss, stackBot); +} + + +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +{ + Res res; + + res = WriteF(stream, + "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, + " arena $P ($U)\n", + (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, + NULL); + if(res != ResOK) return res; + + return ResOK; +} diff --git a/mps/code/thlii4.c b/mps/code/thlii4.c new file mode 100644 index 00000000000..f42e7a1f52a --- /dev/null +++ b/mps/code/thlii4.c @@ -0,0 +1,303 @@ +/* impl.c.thlii3: Threads Manager for Intel x86 systems with LinuxThreads + * + * $HopeName: MMsrc!thlii4.c(trunk.2) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: This is a pthreads implementation of the threads manager. + * This implements impl.h.th. + * + * .design: See design.mps.thread-manager. + * + * .thread.id: The thread id is used to identify the current thread. + * + * ASSUMPTIONS + * + * .error.resume: PThreadextResume is assumed to succeed unless the thread + * has been destroyed. + * .error.suspend: PThreadextSuspend is assumed to succeed unless the thread + * has been destroyed. In this case, the suspend context is set to NULL; + * + * .stack.full-descend: assumes full descending stack. + * i.e. stack pointer points to the last allocated location; + * stack grows downwards. + * + * .stack.below-bottom: it's legal for the stack pointer to be at a + * higher address than the registered bottom of stack. This might + * happen if the stack of another thread doesn't contain any frames + * belonging to the client language. In this case, the stack should + * not be scanned. + * + * .stack.align: assume roots on the stack are always word-aligned, + * but don't assume that the stack pointer is necessarily + * word-aligned at the time of reading the context of another thread. + * + * .sp: The stack pointer in the context is ESP. + * .context.regroots: The root regs are EDI, ESI, EBX, EDX, ECX, EAX are + * assumed to be recorded in the context at pointer-aligned boundaries. + */ + +#include "prmcli.h" +#include "mpm.h" + +#if !defined(MPS_OS_LI) || !defined(MPS_ARCH_I4) +#error "Compiling thlii4 when MPS_OS_LI or MPS_ARCH_I4 not defined." +#endif + +#include +#include "pthrdext.h" + +SRCID(thlii4, "$HopeName: MMsrc!thlii4.c(trunk.2) $"); + + +/* ThreadStruct -- thread desriptor */ + +typedef struct ThreadStruct { /* PThreads thread structure */ + Sig sig; /* design.mps.sig */ + Serial serial; /* from arena->threadSerial */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* threads attached to arena */ + PThreadextStruct thrextStruct; /* PThreads extension */ + pthread_t id; /* Pthread object of thread */ + struct sigcontext *scpSusp; /* Context if thread is suspended */ +} ThreadStruct; + + +/* ThreadCheck -- check a thread */ + +Bool ThreadCheck(Thread thread) +{ + CHECKS(Thread, thread); + CHECKU(Arena, thread->arena); + CHECKL(thread->serial < thread->arena->threadSerial); + CHECKL(RingCheck(&thread->arenaRing)); + CHECKD(PThreadext, &thread->thrextStruct); + return TRUE; +} + +Bool ThreadCheckSimple(Thread thread) +{ + CHECKS(Thread, thread); + return TRUE; +} + + +/* ThreadRegister -- register a thread with an arena */ + +Res ThreadRegister(Thread *threadReturn, Arena arena) +{ + Res res; + Thread thread; + void *p; + + AVER(threadReturn != NULL); + AVERT(Arena, arena); + + res = ControlAlloc(&p, arena, sizeof(ThreadStruct), + /* withReservoirPermit */ FALSE); + if(res != ResOK) + return res; + thread = (Thread)p; + + thread->id = pthread_self(); + + RingInit(&thread->arenaRing); + + thread->sig = ThreadSig; + thread->serial = arena->threadSerial; + ++arena->threadSerial; + thread->arena = arena; + thread->scpSusp = NULL; + + PThreadextInit(&thread->thrextStruct, thread->id); + + AVERT(Thread, thread); + + RingAppend(ArenaThreadRing(arena), &thread->arenaRing); + + *threadReturn = thread; + return ResOK; +} + + +/* ThreadDeregister -- deregister a thread from an arena */ + +void ThreadDeregister(Thread thread, Arena arena) +{ + AVERT(Thread, thread); + AVERT(Arena, arena); + + RingRemove(&thread->arenaRing); + + thread->sig = SigInvalid; + + RingFinish(&thread->arenaRing); + + PThreadextFinish(&thread->thrextStruct); + + ControlFree(arena, thread, sizeof(ThreadStruct)); +} + + +/* mapThreadRing -- map over threads on ring calling a function on each one + * except the current thread + */ + +static void mapThreadRing(Ring threadRing, void (*func)(Thread)) +{ + Ring node, next; + pthread_t self; + + AVERT(Ring, threadRing); + + self = pthread_self(); + RING_FOR(node, threadRing, next) { + Thread thread = RING_ELT(Thread, arenaRing, node); + AVERT(Thread, thread); + if(! pthread_equal(self, thread->id)) /* .thread.id */ + (*func)(thread); + } +} + + +/* ThreadRingSuspend -- suspend all threads on a ring, expect the current one */ + + +static void threadSuspend(Thread thread) +{ + /* .error.suspend */ + /* In the error case (PThreadextSuspend returning ResFAIL), we */ + /* assume the thread has been destroyed. */ + /* In which case we simply continue. */ + Res res; + res = PThreadextSuspend(&thread->thrextStruct, &thread->scpSusp); + if(res != ResOK) + thread->scpSusp = NULL; +} + + + +void ThreadRingSuspend(Ring threadRing) +{ + mapThreadRing(threadRing, threadSuspend); +} + + +/* ThreadRingResume -- resume all threads on a ring (expect the current one) */ + + +static void threadResume(Thread thread) +{ + /* .error.resume */ + /* If the previous suspend failed (thread->scpSusp == NULL), */ + /* or in the error case (PThreadextResume returning ResFAIL), */ + /* assume the thread has been destroyed. */ + /* In which case we simply continue. */ + if(thread->scpSusp != NULL) { + (void)PThreadextResume(&thread->thrextStruct); + thread->scpSusp = NULL; + } +} + +void ThreadRingResume(Ring threadRing) +{ + mapThreadRing(threadRing, threadResume); +} + + +/* ThreadRingThread -- return the thread at the given ring element */ + +Thread ThreadRingThread(Ring threadRing) +{ + Thread thread; + AVERT(Ring, threadRing); + thread = RING_ELT(Thread, arenaRing, threadRing); + AVERT(Thread, thread); + return thread; +} + + +/* ThreadArena -- get the arena of a thread + * + * Must be thread-safe. See design.mps.interface.c.thread-safety. + */ + +Arena ThreadArena(Thread thread) +{ + /* Can't check thread as that would not be thread-safe. */ + return thread->arena; +} + + +/* ThreadScan -- scan the state of a thread (stack and regs) */ + +Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +{ + pthread_t self; + Res res; + + AVERT(Thread, thread); + self = pthread_self(); + if(pthread_equal(self, thread->id)) { + /* scan this thread's stack */ + res = StackScan(ss, stackBot); + if(res != ResOK) + return res; + } else { + struct sigcontext *scp; + Addr *stackBase, *stackLimit, stackPtr; + + scp = thread->scpSusp; + if(scp == NULL) { + /* .error.suspend */ + /* We assume that the thread must have been destroyed. */ + /* We ignore the situation by returning immediately. */ + return ResOK; + } + + stackPtr = (Addr)scp->esp; /* .i3.sp */ + /* .stack.align */ + stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); + stackLimit = (Addr *)stackBot; + if (stackBase >= stackLimit) + return ResOK; /* .stack.below-bottom */ + + /* scan stack inclusive of current sp and exclusive of + * stackBot (.stack.full-descend) + */ + res = TraceScanAreaTagged(ss, stackBase, stackLimit); + if(res != ResOK) + return res; + + /* (.context.regroots) + * This scans the root registers (.context.regroots). It also + * unecessarily scans the rest of the context. The optimisation + * to scan only relevent parts would be machine dependent. + */ + res = TraceScanAreaTagged(ss, (Addr *)scp, + (Addr *)((char *)scp + sizeof(*scp))); + if(res != ResOK) + return res; + } + + return ResOK; +} + + +/* ThreadDescribe -- describe a thread */ + +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +{ + Res res; + + res = WriteF(stream, + "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, + " arena $P ($U)\n", + (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + " id $U\n", (WriteFU)thread->id, + "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, + NULL); + if(res != ResOK) + return res; + + return ResOK; +} diff --git a/mps/code/thw3i3.c b/mps/code/thw3i3.c new file mode 100644 index 00000000000..1f193147753 --- /dev/null +++ b/mps/code/thw3i3.c @@ -0,0 +1,330 @@ +/* impl.c.thw3i3: WIN32 THREAD MANAGER + * + * $HopeName: MMsrc!thw3i3.c(trunk.24) $ + * Copyright (C) 1999. Harlequin Limited. All rights reserved. + * + * Implements thread registration, suspension, and stack + * scanning. See design.mps.thread-manager + * + * This supports the impl.h.th + * + * .thread.id: The thread id is used to identify the current thread. + * .thread.handle: The thread handle needs the enough access to + * be able to suspend threads and to get their context. i.e. + * .thread.handle.susp-res: THREAD_SUSPEND_RESUME access + * .thread.handle.get-context: THREAD_GET_CONTEXT access + * An appropriate handle is created on registration. + * + * + * ASSUMPTIONS + * + * .error: some major errors are assumed not to happen. + * .error.close-handle: CloseHandle is assumed to succeed. + * + * Other errors are assumed to only happen in certain circumstances. + * .error.resume: ResumeThread is assumed to succeed unless the thread + * has been destroyed (in fact, perversely, it appears to succeeed even + * when the thread has been destroyed). + * .error.suspend: SuspendThread is assumed to succeed unless the thread + * has been destroyed. + * .error.get-context: GetThreadContext is assumed to succeed unless the + * thread has been destroyed. + * + * .stack.full-descend: assumes full descending stack. + * i.e. stack pointer points to the last allocated location; + * stack grows downwards. + * + * .stack.below-bottom: it's legal for the stack pointer to be at a + * higher address than the registered bottom of stack. This might + * happen if the stack of another thread doesn't contain any frames + * belonging to the client language. In this case, the stack should + * not be scanned. + * + * .stack.align: assume roots on the stack are always word-aligned, + * but don't assume that the stack pointer is necessarily + * word-aligned at the time of reading the context of another thread. + * + * .i3: assumes MPS_ARCH_I3 + * .i3.sp: The sp in the context is Esp + * .i3.context: Esp is in control context so .context.sp holds + * The root registers are Edi, Esi, Ebx, Edx, Ecx, Eax + * these are given by CONTEXT_INTEGER, so .context.regroots holds. + * + * .nt: uses Win32 specific stuff + * HANDLE + * DWORD + * GetCurrentProcess + * DuplicateHandle + * THREAD_SUSPEND_RESUME | THREAD_GET_CONTEXT + * GetCurrentThreadId + * CloseHandle + * SuspendThread + * ResumeThread + * CONTEXT + * CONTEXT_CONTROL | CONTEXT_INTEGER + * GetThreadContext + * + * .context: ContextFlags determine what is recorded by + * GetThreadContext. This should be set to whichever bits of the + * context that need to be recorded. This should include: + * .context.sp: sp assumed to be recorded by CONTEXT_CONTROL. + * .context.regroots: assumed to be recorded by CONTEXT_INTEGER. + * see winnt.h for description of CONTEXT and ContextFlags. + */ + +#include "mpm.h" + +#if !defined(MPS_OS_W3) || !defined(MPS_ARCH_I3) /* .i3 .nt */ +#error "Compiling thnti3 when MPS_OS_W3 or MPS_ARCH_I3 not defined." +#endif + +#include "mpswin.h" + +SRCID(thw3i3, "$HopeName: MMsrc!thw3i3.c(trunk.24) $"); + + +typedef struct ThreadStruct { /* Win32 thread structure */ + Sig sig; /* design.mps.sig */ + Serial serial; /* from arena->threadSerial */ + Arena arena; /* owning arena */ + RingStruct arenaRing; /* threads attached to arena */ + HANDLE handle; /* Handle of thread, see + * impl.c.thnti3.thread.handle */ + DWORD id; /* Thread id of thread */ +} ThreadStruct; + + +Bool ThreadCheck(Thread thread) +{ + CHECKS(Thread, thread); + CHECKU(Arena, thread->arena); + CHECKL(thread->serial < thread->arena->threadSerial); + CHECKL(RingCheck(&thread->arenaRing)); + return TRUE; +} + + +Bool ThreadCheckSimple(Thread thread) +{ + CHECKS(Thread, thread); + return TRUE; +} + + +Res ThreadRegister(Thread *threadReturn, Arena arena) +{ + Res res; + Thread thread; + HANDLE procHandle; + BOOL b; + void *p; + + AVER(threadReturn != NULL); + AVERT(Arena, arena); + + res = ControlAlloc(&p, arena, sizeof(ThreadStruct), + /* withReservoirPermit */ FALSE); + if(res != ResOK) + return res; + thread = (Thread)p; /* avoid pun */ + + /* Duplicate handle gives us a new handle with updated privileges. + * .thread.handle describes the ones needed. + */ + procHandle = GetCurrentProcess(); + + b = DuplicateHandle(procHandle, GetCurrentThread(), procHandle, + &thread->handle, + THREAD_SUSPEND_RESUME | THREAD_GET_CONTEXT, + FALSE, 0); + if(!b) + return ResRESOURCE; + + thread->id = GetCurrentThreadId(); + + RingInit(&thread->arenaRing); + + thread->sig = ThreadSig; + thread->serial = arena->threadSerial; + ++arena->threadSerial; + thread->arena = arena; + + AVERT(Thread, thread); + + RingAppend(ArenaThreadRing(arena), &thread->arenaRing); + + *threadReturn = thread; + return ResOK; +} + +void ThreadDeregister(Thread thread, Arena arena) +{ + Bool b; + + AVERT(Thread, thread); + AVERT(Arena, arena); + + RingRemove(&thread->arenaRing); + + thread->sig = SigInvalid; + + RingFinish(&thread->arenaRing); + + b = CloseHandle(thread->handle); + AVER(b); /* .error.close-handle */ + + ControlFree(arena, thread, sizeof(ThreadStruct)); +} + + +/* Map over threads on ring calling f on each one except the + * current thread. + */ +static void mapThreadRing(Ring ring, void (*f)(Thread thread)) +{ + Ring node; + DWORD id; + + id = GetCurrentThreadId(); + node = RingNext(ring); + while(node != ring) { + Ring next = RingNext(node); + Thread thread; + + thread = RING_ELT(Thread, arenaRing, node); + AVERT(Thread, thread); + if(id != thread->id) /* .thread.id */ + (*f)(thread); + + node = next; + } +} + +static void suspend(Thread thread) +{ + /* .thread.handle.susp-res */ + /* .error.suspend */ + /* In the error case (SuspendThread returning 0xFFFFFFFF), we */ + /* assume the thread has been destroyed (as part of process shutdown). */ + /* In which case we simply continue. */ + /* [GetLastError appears to return 5 when SuspendThread is called */ + /* on a destroyed thread, but I'm not sufficiently confident of this */ + /* to check -- drj 1998-04-09] */ + (void)SuspendThread(thread->handle); +} + +void ThreadRingSuspend(Ring ring) +{ + mapThreadRing(ring, suspend); +} + +static void resume(Thread thread) +{ + /* .thread.handle.susp-res */ + /* .error.resume */ + /* In the error case (ResumeThread returning 0xFFFFFFFF), we */ + /* assume the thread has been destroyed (as part of process shutdown). */ + /* In which case we simply continue. */ + (void)ResumeThread(thread->handle); +} + +void ThreadRingResume(Ring ring) +{ + mapThreadRing(ring, resume); +} + + +Thread ThreadRingThread(Ring threadRing) +{ + Thread thread; + AVERT(Ring, threadRing); + thread = RING_ELT(Thread, arenaRing, threadRing); + AVERT(Thread, thread); + return thread; +} + + +Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +{ + DWORD id; + Res res; + + id = GetCurrentThreadId(); + + if(id != thread->id) { /* .thread.id */ + CONTEXT context; + BOOL success; + Addr *stackBase, *stackLimit, stackPtr; + + /* scan stack and register roots in other threads */ + + /* This dumps the relevent registers into the context */ + /* .context.flags */ + context.ContextFlags = CONTEXT_CONTROL | CONTEXT_INTEGER; + /* .thread.handle.get-context */ + success = GetThreadContext(thread->handle, &context); + if(!success) { + /* .error.get-context */ + /* We assume that the thread must have been destroyed. */ + /* We ignore the situation by returning immediately. */ + return ResOK; + } + + stackPtr = (Addr)context.Esp; /* .i3.sp */ + /* .stack.align */ + stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); + stackLimit = (Addr *)stackBot; + if (stackBase >= stackLimit) + return ResOK; /* .stack.below-bottom */ + + /* scan stack inclusive of current sp and exclusive of + * stackBot (.stack.full-descend) + */ + res = TraceScanAreaTagged(ss, stackBase, stackLimit); + if(res != ResOK) + return res; + + /* (.context.regroots) + * This scans the root registers (.context.regroots). It also + * unecessarily scans the rest of the context. The optimisation + * to scan only relevent parts would be machine dependent. + */ + res = TraceScanAreaTagged(ss, (Addr *)&context, + (Addr *)((char *)&context + sizeof(CONTEXT))); + if(res != ResOK) + return res; + + } else { /* scan this thread's stack */ + res = StackScan(ss, stackBot); + if(res != ResOK) + return res; + } + + return ResOK; +} + +/* Must be thread-safe. See design.mps.interface.c.thread-safety. */ +Arena ThreadArena(Thread thread) +{ + /* Can't AVER thread as that would not be thread-safe */ + /* AVERT(Thread, thread); */ + return thread->arena; +} + +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +{ + Res res; + + res = WriteF(stream, + "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, + " arena $P ($U)\n", + (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + " handle $W\n", (WriteFW)thread->handle, + " id $U\n", (WriteFU)thread->id, + "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, + NULL); + if(res != ResOK) + return res; + + return ResOK; +} diff --git a/mps/code/trace.c b/mps/code/trace.c new file mode 100644 index 00000000000..619e67480f0 --- /dev/null +++ b/mps/code/trace.c @@ -0,0 +1,1666 @@ +/* impl.c.trace: GENERIC TRACER IMPLEMENTATION + * + * $HopeName: MMsrc!trace.c(trunk.102) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + * + * .design: design.mps.trace. */ + +#include "chain.h" +#include "mpm.h" +#include /* for LONG_MAX */ + +SRCID(trace, "$HopeName: MMsrc!trace.c(trunk.102) $"); + + +/* Types */ + +enum {traceAccountingPhaseRootScan = 1, traceAccountingPhaseSegScan, + traceAccountingPhaseSingleScan}; +typedef int traceAccountingPhase; + + +/* TraceMessage -- type of GC end messages */ + +#define TraceMessageSig ((Sig)0x51926359) + +typedef struct TraceMessageStruct { + Sig sig; + Size liveSize; + Size condemnedSize; + Size notCondemnedSize; + MessageStruct messageStruct; +} TraceMessageStruct, *TraceMessage; + +#define TraceMessageMessage(TraceMessage) (&((TraceMessage)->messageStruct)) +#define MessageTraceMessage(message) \ + (PARENT(TraceMessageStruct, messageStruct, message)) + +static Bool TraceMessageCheck(TraceMessage message) +{ + CHECKS(TraceMessage, message); + CHECKD(Message, TraceMessageMessage(message)); + CHECKL(MessageGetType(TraceMessageMessage(message)) == + MessageTypeGC); + /* We can't check anything about the statistics. In particular, */ + /* liveSize may exceed condemnedSize because they are only estimates. */ + + return TRUE; +} + +static void TraceMessageDelete(Message message) +{ + TraceMessage tMessage; + Arena arena; + + AVERT(Message, message); + tMessage = MessageTraceMessage(message); + AVERT(TraceMessage, tMessage); + + arena = MessageArena(message); + ControlFree(arena, (void *)tMessage, sizeof(TraceMessageStruct)); +} + +static Size TraceMessageLiveSize(Message message) +{ + TraceMessage tMessage; + + AVERT(Message, message); + tMessage = MessageTraceMessage(message); + AVERT(TraceMessage, tMessage); + + return tMessage->liveSize; +} + +static Size TraceMessageCondemnedSize(Message message) +{ + TraceMessage tMessage; + + AVERT(Message, message); + tMessage = MessageTraceMessage(message); + AVERT(TraceMessage, tMessage); + + return tMessage->condemnedSize; +} + +static Size TraceMessageNotCondemnedSize(Message message) +{ + TraceMessage tMessage; + + AVERT(Message, message); + tMessage = MessageTraceMessage(message); + AVERT(TraceMessage, tMessage); + + return tMessage->notCondemnedSize; +} + +static MessageClassStruct TraceMessageClassStruct = { + MessageClassSig, /* sig */ + "TraceGC", /* name */ + TraceMessageDelete, /* Delete */ + MessageNoFinalizationRef, /* FinalizationRef */ + TraceMessageLiveSize, /* GCLiveSize */ + TraceMessageCondemnedSize, /* GCCondemnedSize */ + TraceMessageNotCondemnedSize, /* GCNotCondemnedSize */ + MessageClassSig /* design.mps.message.class.sig.double */ +}; + +static void TraceMessageInit(Arena arena, TraceMessage tMessage) +{ + AVERT(Arena, arena); + + MessageInit(arena, TraceMessageMessage(tMessage), + &TraceMessageClassStruct, MessageTypeGC); + tMessage->liveSize = (Size)0; + tMessage->condemnedSize = (Size)0; + tMessage->notCondemnedSize = (Size)0; + + tMessage->sig = TraceMessageSig; + AVERT(TraceMessage, tMessage); +} + + +/* ScanStateCheck -- check consistency of a ScanState object */ + +Bool ScanStateCheck(ScanState ss) +{ + TraceId ti; + Trace trace; + ZoneSet white; + + CHECKS(ScanState, ss); + CHECKL(FUNCHECK(ss->fix)); + CHECKL(ss->zoneShift == ss->arena->zoneShift); + white = ZoneSetEMPTY; + TRACE_SET_ITER(ti, trace, ss->traces, ss->arena) + white = ZoneSetUnion(white, ss->arena->trace[ti].white); + TRACE_SET_ITER_END(ti, trace, ss->traces, ss->arena); + CHECKL(ss->white == white); + CHECKU(Arena, ss->arena); + /* Summaries could be anything, and can't be checked. */ + CHECKL(TraceSetCheck(ss->traces)); + CHECKL(TraceSetSuper(ss->arena->busyTraces, ss->traces)); + CHECKL(RankCheck(ss->rank)); + CHECKL(BoolCheck(ss->wasMarked)); + /* @@@@ checks for counts missing */ + return TRUE; +} + + +/* ScanStateInit -- Initialize a ScanState object */ + +void ScanStateInit(ScanState ss, TraceSet ts, Arena arena, + Rank rank, ZoneSet white) +{ + TraceId ti; + Trace trace; + + AVER(TraceSetCheck(ts)); + AVERT(Arena, arena); + AVER(RankCheck(rank)); + /* white is arbitrary and can't be checked */ + + ss->fix = TraceFix; + TRACE_SET_ITER(ti, trace, ts, arena) + if (trace->emergency) + ss->fix = TraceFixEmergency; + TRACE_SET_ITER_END(ti, trace, ts, arena); + ss->rank = rank; + ss->traces = ts; + ss->zoneShift = arena->zoneShift; + ss->unfixedSummary = RefSetEMPTY; + ss->fixedSummary = RefSetEMPTY; + ss->arena = arena; + ss->wasMarked = TRUE; + ss->white = white; + STATISTIC(ss->fixRefCount = (Count)0); + STATISTIC(ss->segRefCount = (Count)0); + STATISTIC(ss->whiteSegRefCount = (Count)0); + STATISTIC(ss->nailCount = (Count)0); + STATISTIC(ss->snapCount = (Count)0); + STATISTIC(ss->forwardedCount = (Count)0); + ss->forwardedSize = (Size)0; /* see .message.data */ + STATISTIC(ss->preservedInPlaceCount = (Count)0); + ss->preservedInPlaceSize = (Size)0; /* see .message.data */ + STATISTIC(ss->copiedSize = (Size)0); + ss->scannedSize = (Size)0; /* see .workclock */ + ss->sig = ScanStateSig; + + AVERT(ScanState, ss); +} + + +/* ScanStateFinish -- Finish a ScanState object */ + +void ScanStateFinish(ScanState ss) +{ + AVERT(ScanState, ss); + ss->sig = SigInvalid; +} + + +/* TraceIdCheck -- check that a TraceId is valid */ + +Bool TraceIdCheck(TraceId ti) +{ + CHECKL(ti < TraceLIMIT); + UNUSED(ti); /* impl.c.mpm.check.unused */ + return TRUE; +} + + +/* TraceSetCheck -- check that a TraceSet is valid */ + +Bool TraceSetCheck(TraceSet ts) +{ + CHECKL(ts < (1uL << TraceLIMIT)); + UNUSED(ts); /* impl.c.mpm.check.unused */ + return TRUE; +} + + +/* TraceCheck -- check consistency of Trace object */ + +Bool TraceCheck(Trace trace) +{ + CHECKS(Trace, trace); + CHECKU(Arena, trace->arena); + CHECKL(TraceIdCheck(trace->ti)); + CHECKL(trace == &trace->arena->trace[trace->ti]); + CHECKL(TraceSetIsMember(trace->arena->busyTraces, trace)); + CHECKL(ZoneSetSub(trace->mayMove, trace->white)); + /* Use trace->state to check more invariants. */ + switch(trace->state) { + case TraceINIT: + /* @@@@ What can be checked here? */ + break; + + case TraceUNFLIPPED: + CHECKL(!TraceSetIsMember(trace->arena->flippedTraces, trace)); + /* @@@@ Assert that mutator is grey for trace. */ + break; + + case TraceFLIPPED: + CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace)); + /* @@@@ Assert that mutator is black for trace. */ + break; + + case TraceRECLAIM: + CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace)); + /* @@@@ Assert that grey set is empty for trace. */ + break; + + case TraceFINISHED: + CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace)); + /* @@@@ Assert that grey and white sets is empty for trace. */ + break; + + default: + NOTREACHED; + } + CHECKL(BoolCheck(trace->emergency)); + if (trace->chain != NULL) + CHECKU(Chain, trace->chain); + /* @@@@ checks for counts missing */ + return TRUE; +} + + +/* traceUpdateCounts - dumps the counts from a ScanState into the Trace */ + +static void traceUpdateCounts(Trace trace, ScanState ss, + traceAccountingPhase phase) +{ + switch(phase) { + case traceAccountingPhaseRootScan: + STATISTIC(trace->rootScanSize += ss->scannedSize); + STATISTIC(trace->rootCopiedSize += ss->copiedSize); + STATISTIC(++trace->rootScanCount); + break; + + case traceAccountingPhaseSegScan: + trace->segScanSize += ss->scannedSize; /* see .workclock */ + STATISTIC(trace->segCopiedSize += ss->copiedSize); + STATISTIC(++trace->segScanCount); + break; + + case traceAccountingPhaseSingleScan: + STATISTIC(trace->singleScanSize += ss->scannedSize); + STATISTIC(trace->singleCopiedSize += ss->copiedSize); + break; + + default: + NOTREACHED; + } + STATISTIC(trace->fixRefCount += ss->fixRefCount); + STATISTIC(trace->segRefCount += ss->segRefCount); + STATISTIC(trace->whiteSegRefCount += ss->whiteSegRefCount); + STATISTIC(trace->nailCount += ss->nailCount); + STATISTIC(trace->snapCount += ss->snapCount); + STATISTIC(trace->forwardedCount += ss->forwardedCount); + trace->forwardedSize += ss->forwardedSize; /* see .message.data */ + STATISTIC(trace->preservedInPlaceCount += ss->preservedInPlaceCount); + trace->preservedInPlaceSize += ss->preservedInPlaceSize; + + return; +} + + +/* traceSetUpdateCounts -- update counts for a set of traces */ + +static void traceSetUpdateCounts(TraceSet ts, Arena arena, ScanState ss, + traceAccountingPhase phase) +{ + TraceId ti; Trace trace; + + AVERT(ScanState, ss); /* check that we're not copying garbage */ + + TRACE_SET_ITER(ti, trace, ts, arena) + traceUpdateCounts(trace, ss, phase); + TRACE_SET_ITER_END(ti, trace, ts, arena); + return; +} + + +/* traceSetSignalEmergency -- move a set of traces into emergency mode. */ + +static void traceSetSignalEmergency(TraceSet ts, Arena arena) +{ + TraceId ti; + Trace trace; + + TRACE_SET_ITER(ti, trace, ts, arena) + trace->emergency = TRUE; + TRACE_SET_ITER_END(ti, trace, ts, arena); + + return; +} + + +/* traceSetWhiteUnion + * + * Returns a ZoneSet describing the union of the white sets of all the + * specified traces. */ + +static ZoneSet traceSetWhiteUnion(TraceSet ts, Arena arena) +{ + TraceId ti; + Trace trace; + ZoneSet white = ZoneSetEMPTY; + + TRACE_SET_ITER(ti, trace, ts, arena) + white = ZoneSetUnion(white, trace->white); + TRACE_SET_ITER_END(ti, trace, ts, arena); + + return white; +} + + +/* TraceAddWhite -- add a segment to the white set of a trace */ + +Res TraceAddWhite(Trace trace, Seg seg) +{ + Res res; + Pool pool; + + AVERT(Trace, trace); + AVERT(Seg, seg); + AVER(!TraceSetIsMember(SegWhite(seg), trace)); /* .start.black */ + + pool = SegPool(seg); + AVERT(Pool, pool); + + /* Give the pool the opportunity to turn the segment white. */ + /* If it fails, unwind. */ + res = PoolWhiten(pool, trace, seg); + if (res != ResOK) + return res; + + /* Add the segment to the approximation of the white set the */ + /* pool made it white. */ + if (TraceSetIsMember(SegWhite(seg), trace)) { + trace->white = ZoneSetUnion(trace->white, ZoneSetOfSeg(trace->arena, seg)); + /* if the pool is a moving GC, then condemned objects may move */ + if (pool->class->attr & AttrMOVINGGC) { + trace->mayMove = ZoneSetUnion(trace->mayMove, + ZoneSetOfSeg(trace->arena, seg)); + } + } + + return ResOK; +} + + +/* TraceCondemnZones -- condemn all objects in the given zones + * + * TraceCondemnZones is passed a trace in state TraceINIT, and a set of + * objects to condemn. + * + * @@@@ For efficiency, we ought to find the condemned set and the + * foundation in one search of the segment ring. This hasn't been done + * because some pools still use TraceAddWhite for the condemned set. + * + * @@@@ This function would be more efficient if there were a cheaper + * way to select the segments in a particular zone set. */ + +Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet) +{ + Seg seg; + Arena arena; + Res res; + + AVERT(Trace, trace); + AVER(condemnedSet != ZoneSetEMPTY); + AVER(trace->state == TraceINIT); + AVER(trace->white == ZoneSetEMPTY); + + arena = trace->arena; + + if (SegFirst(&seg, arena)) { + Addr base; + do { + base = SegBase(seg); + /* Segment should be black now. */ + AVER(!TraceSetIsMember(SegGrey(seg), trace)); + AVER(!TraceSetIsMember(SegWhite(seg), trace)); + + /* A segment can only be white if it is GC-able. */ + /* This is indicated by the pool having the GC attribute */ + /* We only condemn segments that fall entirely within */ + /* the requested zone set. Otherwise, we would bloat the */ + /* foundation to no gain. Note that this doesn't exclude */ + /* any segments from which the condemned set was derived, */ + if ((SegPool(seg)->class->attr & AttrGC) != 0 + && ZoneSetSuper(condemnedSet, ZoneSetOfSeg(arena, seg))) { + res = TraceAddWhite(trace, seg); + if (res != ResOK) + return res; + } + } while (SegNext(&seg, arena, base)); + } + + /* The trace's white set must be a subset of the condemned set */ + AVER(ZoneSetSuper(condemnedSet, trace->white)); + + return ResOK; +} + + +/* traceFlipBuffers -- flip all buffers in the arena */ + +static void traceFlipBuffers(Globals arena) +{ + Ring nodep, nextp; + + RING_FOR(nodep, &arena->poolRing, nextp) { + Pool pool = RING_ELT(Pool, arenaRing, nodep); + Ring nodeb, nextb; + + AVERT(Pool, pool); + RING_FOR(nodeb, &pool->bufferRing, nextb) { + BufferFlip(RING_ELT(Buffer, poolRing, nodeb)); + } + } +} + + +/* traceScanRootRes -- scan a root, with result code */ + +static Res traceScanRootRes(TraceSet ts, Rank rank, Arena arena, Root root) +{ + ZoneSet white; + Res res; + ScanStateStruct ss; + + white = traceSetWhiteUnion(ts, arena); + + ScanStateInit(&ss, ts, arena, rank, white); + + res = RootScan(&ss, root); + + traceSetUpdateCounts(ts, arena, &ss, traceAccountingPhaseRootScan); + ScanStateFinish(&ss); + return res; +} + + +/* traceScanRoot + * + * Scan a root without fail. The traces may enter emergency mode to + * ensure this. */ + +static void traceScanRoot(TraceSet ts, Rank rank, Arena arena, Root root) +{ + Res res; + + res = traceScanRootRes(ts, rank, arena, root); + if (res != ResOK) { + AVER(ResIsAllocFailure(res)); + traceSetSignalEmergency(ts, arena); + res = traceScanRootRes(ts, rank, arena, root); + /* Should be OK in emergency mode */ + } + AVER(ResOK == res); + + return; +} + + +/* traceFlip -- blacken the mutator */ + +struct rootFlipClosureStruct { + TraceSet ts; + Arena arena; + Rank rank; +}; + +static Res rootFlip(Root root, void *p) +{ + struct rootFlipClosureStruct *rf = (struct rootFlipClosureStruct *)p; + + AVERT(Root, root); + AVER(p != NULL); + AVER(TraceSetCheck(rf->ts)); + AVERT(Arena, rf->arena); + AVER(RankCheck(rf->rank)); + + AVER(RootRank(root) <= RankEXACT); /* see .root.rank */ + + if (RootRank(root) == rf->rank) + traceScanRoot(rf->ts, rf->rank, rf->arena, root); + + return ResOK; +} + +static void traceFlip(Trace trace) +{ + Ring node, nextNode; + Arena arena; + Rank rank; + struct rootFlipClosureStruct rfc; + + AVERT(Trace, trace); + rfc.ts = TraceSetSingle(trace); + + arena = trace->arena; + rfc.arena = arena; + ShieldSuspend(arena); + + AVER(trace->state == TraceUNFLIPPED); + AVER(!TraceSetIsMember(arena->flippedTraces, trace)); + + EVENT_PP(TraceFlipBegin, trace, arena); + + traceFlipBuffers(ArenaGlobals(arena)); + + /* Update location dependency structures. */ + /* mayMove is a conservative approximation of the zones of objects */ + /* which may move during this collection. */ + if (trace->mayMove != ZoneSetEMPTY) { + LDAge(arena, trace->mayMove); + } + + /* .root.rank: At the moment we must scan all roots, because we don't have */ + /* a mechanism for shielding them. There can't be any weak or final roots */ + /* either, since we must protect these in order to avoid scanning them too */ + /* early, before the pool contents. @@@@ This isn't correct if there are */ + /* higher ranking roots than data in pools. */ + + for(rank = RankAMBIG; rank <= RankEXACT; ++rank) { + Res res; + + rfc.rank = rank; + res = RootsIterate(ArenaGlobals(arena), rootFlip, (void *)&rfc); + AVER(res == ResOK); + } + + /* .flip.alloc: Allocation needs to become black now. While we flip */ + /* at the start, we can get away with always allocating black. This */ + /* needs to change when we flip later (i.e. have a read-barrier */ + /* collector), so that we allocate grey or white before the flip */ + /* and black afterwards. For instance, see */ + /* design.mps.poolams.invariant.alloc. */ + + /* Now that the mutator is black we must prevent it from reading */ + /* grey objects so that it can't obtain white pointers. This is */ + /* achieved by read protecting all segments containing objects */ + /* which are grey for any of the flipped traces. */ + for(rank = 0; rank < RankLIMIT; ++rank) + RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) { + Seg seg = SegOfGreyRing(node); + if (TraceSetInter(SegGrey(seg), arena->flippedTraces) == TraceSetEMPTY + && TraceSetIsMember(SegGrey(seg), trace)) + ShieldRaise(arena, seg, AccessREAD); + } + + /* @@@@ When write barrier collection is implemented, this is where */ + /* write protection should be removed for all segments which are */ + /* no longer blacker than the mutator. Possibly this can be done */ + /* lazily as they are touched. */ + + /* Mark the trace as flipped. */ + trace->state = TraceFLIPPED; + arena->flippedTraces = TraceSetAdd(arena->flippedTraces, trace); + + EVENT_PP(TraceFlipEnd, trace, arena); + + ShieldResume(arena); + + return; +} + + +/* TraceCreate -- create a Trace object + * + * Allocates and initializes a new Trace object with a TraceId which is + * not currently active. + * + * Returns ResLIMIT if there aren't any available trace IDs. + * + * Trace objects are allocated directly from a small array in the arena + * structure which is indexed by the TraceId. This is so that it's + * always possible to start a trace (provided there's a free TraceId) + * even if there's no available memory. + * + * This code is written to be adaptable to allocating Trace objects + * dynamically. */ + +Res TraceCreate(Trace *traceReturn, Arena arena) +{ + TraceId ti; + Trace trace; + + AVER(traceReturn != NULL); + AVERT(Arena, arena); + + /* Find a free trace ID */ + TRACE_SET_ITER(ti, trace, TraceSetComp(arena->busyTraces), arena) + goto found; + TRACE_SET_ITER_END(ti, trace, TraceSetComp(arena->busyTraces), arena); + return ResLIMIT; /* no trace IDs available */ + +found: + trace = ArenaTrace(arena, ti); + AVER(trace->sig == SigInvalid); /* design.mps.arena.trace.invalid */ + + trace->arena = arena; + trace->white = ZoneSetEMPTY; + trace->mayMove = ZoneSetEMPTY; + trace->ti = ti; + trace->state = TraceINIT; + trace->emergency = FALSE; + trace->chain = NULL; + trace->condemned = (Size)0; /* nothing condemned yet */ + trace->notCondemned = (Size)0; + trace->foundation = (Size)0; /* nothing grey yet */ + trace->rate = (Size)0; /* no scanning to be done yet */ + STATISTIC(trace->greySegCount = (Count)0); + STATISTIC(trace->greySegMax = (Count)0); + STATISTIC(trace->rootScanCount = (Count)0); + STATISTIC(trace->rootScanSize = (Size)0); + STATISTIC(trace->rootCopiedSize = (Size)0); + STATISTIC(trace->segScanCount = (Count)0); + trace->segScanSize = (Size)0; /* see .workclock */ + STATISTIC(trace->segCopiedSize = (Size)0); + STATISTIC(trace->singleScanCount = (Count)0); + STATISTIC(trace->singleScanSize = (Size)0); + STATISTIC(trace->singleCopiedSize = (Size)0); + STATISTIC(trace->fixRefCount = (Count)0); + STATISTIC(trace->segRefCount = (Count)0); + STATISTIC(trace->whiteSegRefCount = (Count)0); + STATISTIC(trace->nailCount = (Count)0); + STATISTIC(trace->snapCount = (Count)0); + STATISTIC(trace->readBarrierHitCount = (Count)0); + STATISTIC(trace->pointlessScanCount = (Count)0); + STATISTIC(trace->forwardedCount = (Count)0); + trace->forwardedSize = (Size)0; /* see .message.data */ + STATISTIC(trace->preservedInPlaceCount = (Count)0); + trace->preservedInPlaceSize = (Size)0; /* see .message.data */ + STATISTIC(trace->reclaimCount = (Count)0); + STATISTIC(trace->reclaimSize = (Size)0); + trace->sig = TraceSig; + arena->busyTraces = TraceSetAdd(arena->busyTraces, trace); + AVERT(Trace, trace); + + /* We suspend the mutator threads so that the PoolWhiten methods */ + /* can calculate white sets without the mutator allocating in */ + /* buffers under our feet. */ + /* @@@@ This is a short-term fix for request.dylan.160098. */ + ShieldSuspend(arena); + + *traceReturn = trace; + return ResOK; +} + + +/* TraceDestroy -- destroy a trace object + * + * Finish and deallocate a Trace object, freeing up a TraceId. + * + * This code does not allow a Trace to be destroyed while it is active. + * It would be possible to allow this, but the colours of segments + * etc. would need to be reset to black. This also means the error + * paths in this file don't work. @@@@ */ + +void TraceDestroy(Trace trace) +{ + AVERT(Trace, trace); + AVER(trace->state == TraceFINISHED); + + if (trace->chain == NULL) { + Ring chainNode, nextChainNode; + + /* Notify all the chains. */ + RING_FOR(chainNode, &trace->arena->chainRing, nextChainNode) { + Chain chain = RING_ELT(Chain, chainRing, chainNode); + + ChainEndGC(chain, trace); + } + } else { + ChainEndGC(trace->chain, trace); + } + + STATISTIC_STAT(EVENT_PWWWWWWWWWWWW + (TraceStatScan, trace, + trace->rootScanCount, trace->rootScanSize, + trace->rootCopiedSize, + trace->segScanCount, trace->segScanSize, + trace->segCopiedSize, + trace->singleScanCount, trace->singleScanSize, + trace->singleCopiedSize, + trace->readBarrierHitCount, trace->greySegMax, + trace->pointlessScanCount)); + STATISTIC_STAT(EVENT_PWWWWWWWWW + (TraceStatFix, trace, + trace->fixRefCount, trace->segRefCount, + trace->whiteSegRefCount, + trace->nailCount, trace->snapCount, + trace->forwardedCount, trace->forwardedSize, + trace->preservedInPlaceCount, + trace->preservedInPlaceSize)); + STATISTIC_STAT(EVENT_PWW + (TraceStatReclaim, trace, + trace->reclaimCount, trace->reclaimSize)); + + trace->sig = SigInvalid; + trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace); + trace->arena->flippedTraces = TraceSetDel(trace->arena->flippedTraces, trace); + EVENT_P(TraceDestroy, trace); +} + + +/* tracePostMessage -- post trace end message + * + * .message.data: The trace end message contains the live size + * (forwardedSize + preservedInPlaceSize), the condemned size + * (condemned), and the not-condemned size (notCondemned). */ + +static void tracePostMessage(Trace trace) +{ + Arena arena; + void *p; + TraceMessage message; + Res res; + + AVERT(Trace, trace); + AVER(trace->state == TraceFINISHED); + + arena = trace->arena; + res = ControlAlloc(&p, arena, sizeof(TraceMessageStruct), FALSE); + if (res == ResOK) { + message = (TraceMessage)p; + TraceMessageInit(arena, message); + message->liveSize = trace->forwardedSize + trace->preservedInPlaceSize; + message->condemnedSize = trace->condemned; + message->notCondemnedSize = trace->notCondemned; + MessagePost(arena, TraceMessageMessage(message)); + } + + return; +} + + +/* traceReclaim -- reclaim the remaining objects white for this trace */ + +static void traceReclaim(Trace trace) +{ + Arena arena; + Seg seg; + + AVER(trace->state == TraceRECLAIM); + + EVENT_P(TraceReclaim, trace); + arena = trace->arena; + if (SegFirst(&seg, arena)) { + Addr base; + do { + base = SegBase(seg); + /* There shouldn't be any grey stuff left for this trace. */ + AVER_CRITICAL(!TraceSetIsMember(SegGrey(seg), trace)); + + if (TraceSetIsMember(SegWhite(seg), trace)) { + AVER_CRITICAL((SegPool(seg)->class->attr & AttrGC) != 0); + STATISTIC(++trace->reclaimCount); + PoolReclaim(SegPool(seg), trace, seg); + + /* If the segment still exists, it should no longer be white. */ + /* Note that the seg returned by this SegOfAddr may not be */ + /* the same as the one above, but in that case it's new and */ + /* still shouldn't be white for this trace. */ + + /* The code from the class-specific reclaim methods to */ + /* unwhiten the segment could in fact be moved here. */ + { + Seg nonWhiteSeg = NULL; /* prevents compiler warning */ + AVER_CRITICAL(!(SegOfAddr(&nonWhiteSeg, arena, base) + && TraceSetIsMember(SegWhite(nonWhiteSeg), trace))); + UNUSED(nonWhiteSeg); /* impl.c.mpm.check.unused */ + } + } + } while (SegNext(&seg, arena, base)); + } + + trace->state = TraceFINISHED; + tracePostMessage(trace); + return; +} + + +/* traceFindGrey -- find a grey segment + * + * This function finds a segment which is grey for the trace given and + * which does not have a higher rank than any other such segment (i.e., + * a next segment to scan). */ + +static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn, + Arena arena, TraceId ti) +{ + Rank rank; + Trace trace; + Ring node, nextNode; + + AVER(segReturn != NULL); + AVER(TraceIdCheck(ti)); + + trace = ArenaTrace(arena, ti); + + for(rank = 0; rank < RankLIMIT; ++rank) { + RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) { + Seg seg = SegOfGreyRing(node); + AVERT(Seg, seg); + AVER(SegGrey(seg) != TraceSetEMPTY); + AVER(RankSetIsMember(SegRankSet(seg), rank)); + if (TraceSetIsMember(SegGrey(seg), trace)) { + *segReturn = seg; *rankReturn = rank; + return TRUE; + } + } + } + + return FALSE; /* There are no grey segments for this trace. */ +} + + +/* ScanStateSetSummary -- set the summary of scanned references + * + * This function sets unfixedSummary and fixedSummary such that + * ScanStateSummary will return the summary passed. Subsequently fixed + * references are accumulated into this result. */ + +void ScanStateSetSummary(ScanState ss, RefSet summary) +{ + AVERT(ScanState, ss); + /* Can't check summary, as it can be anything. */ + + ss->unfixedSummary = RefSetEMPTY; + ss->fixedSummary = summary; + AVER(ScanStateSummary(ss) == summary); +} + + +/* ScanStateSummary -- calculate the summary of scanned references + * + * The summary of the scanned references is the summary of the unfixed + * references, minus the white set, plus the summary of the fixed + * references. This is because TraceFix is called for all references in + * the white set, and accumulates a summary of references after they + * have been fixed. */ + +RefSet ScanStateSummary(ScanState ss) +{ + AVERT(ScanState, ss); + + return RefSetUnion(ss->fixedSummary, + RefSetDiff(ss->unfixedSummary, ss->white)); +} + + +/* traceScanSegRes -- scan a segment to remove greyness + * + * @@@@ During scanning, the segment should be write-shielded to prevent + * any other threads from updating it while fix is being applied to it + * (because fix is not atomic). At the moment, we don't bother, because + * we know that all threads are suspended. */ + +static Res traceScanSegRes(TraceSet ts, Rank rank, Arena arena, Seg seg) +{ + Bool wasTotal; + ZoneSet white; + Res res; + + /* The reason for scanning a segment is that it's grey. */ + AVER(TraceSetInter(ts, SegGrey(seg)) != TraceSetEMPTY); + EVENT_UUPP(TraceScanSeg, ts, rank, arena, seg); + + white = traceSetWhiteUnion(ts, arena); + + /* only scan a segment if it refers to the white set */ + if (ZoneSetInter(white, SegSummary(seg)) == ZoneSetEMPTY) { + PoolBlacken(SegPool(seg), ts, seg); + /* setup result code to return later */ + res = ResOK; + } else { /* scan it */ + ScanStateStruct ss; + ScanStateInit(&ss, ts, arena, rank, white); + + /* Expose the segment to make sure we can scan it. */ + ShieldExpose(arena, seg); + res = PoolScan(&wasTotal, &ss, SegPool(seg), seg); + /* Cover, regardless of result */ + ShieldCover(arena, seg); + + traceSetUpdateCounts(ts, arena, &ss, traceAccountingPhaseSegScan); + /* Count segments scanned pointlessly */ + STATISTIC_STAT + ({ + TraceId ti; Trace trace; + Count whiteSegRefCount = 0; + + TRACE_SET_ITER(ti, trace, ts, arena) + whiteSegRefCount += trace->whiteSegRefCount; + TRACE_SET_ITER_END(ti, trace, ts, arena); + if (whiteSegRefCount == 0) + TRACE_SET_ITER(ti, trace, ts, arena) + ++trace->pointlessScanCount; + TRACE_SET_ITER_END(ti, trace, ts, arena); + }); + + /* following is true whether or not scan was total */ + /* See design.mps.scan.summary.subset. */ + AVER(RefSetSub(ss.unfixedSummary, SegSummary(seg))); + + if (res != ResOK || !wasTotal) { + /* scan was partial, so... */ + /* scanned summary should be ORed into segment summary. */ + SegSetSummary(seg, RefSetUnion(SegSummary(seg), ScanStateSummary(&ss))); + } else { + /* all objects on segment have been scanned, so... */ + /* scanned summary should replace the segment summary. */ + SegSetSummary(seg, ScanStateSummary(&ss)); + } + + ScanStateFinish(&ss); + } + + if (res == ResOK) { + /* The segment is now black only if scan was successful. */ + /* Remove the greyness from it. */ + SegSetGrey(seg, TraceSetDiff(SegGrey(seg), ts)); + } + + return res; +} + + +/* traceScanSeg + * + * Scans a segment without fail. May put the traces into emergency mode + * to ensure this. */ + +static void traceScanSeg(TraceSet ts, Rank rank, Arena arena, Seg seg) +{ + Res res; + + res = traceScanSegRes(ts, rank, arena, seg); + if (res != ResOK) { + AVER(ResIsAllocFailure(res)); + traceSetSignalEmergency(ts, arena); + res = traceScanSegRes(ts, rank, arena, seg); + /* should be OK in emergency mode */ + } + AVER(ResOK == res); + + return; +} + + +/* TraceSegAccess -- handle barrier hit on a segment */ + +void TraceSegAccess(Arena arena, Seg seg, AccessSet mode) +{ + TraceId ti; + + AVERT(Arena, arena); + AVERT(Seg, seg); + + /* If it's a read access, then the segment must be grey for a trace */ + /* which is flipped. */ + AVER((mode & SegSM(seg) & AccessREAD) == 0 + || TraceSetInter(SegGrey(seg), arena->flippedTraces) != TraceSetEMPTY); + + /* If it's a write acess, then the segment must have a summary that */ + /* is smaller than the mutator's summary (which is assumed to be */ + /* RefSetUNIV). */ + AVER((mode & SegSM(seg) & AccessWRITE) == 0 || SegSummary(seg) != RefSetUNIV); + + EVENT_PPU(TraceAccess, arena, seg, mode); + + if ((mode & SegSM(seg) & AccessREAD) != 0) { /* read barrier? */ + /* Pick set of traces to scan for: */ + TraceSet traces = arena->flippedTraces; + + /* .scan.conservative: At the moment we scan at RankEXACT. Really */ + /* we should be scanning at the "phase" of the trace, which is the */ + /* minimum rank of all grey segments. (see request.mps.170160) */ + traceScanSeg(traces, RankEXACT, arena, seg); + + /* The pool should've done the job of removing the greyness that */ + /* was causing the segment to be protected, so that the mutator */ + /* can go ahead and access it. */ + AVER(TraceSetInter(SegGrey(seg), traces) == TraceSetEMPTY); + + STATISTIC_STAT({ + Trace trace; + + TRACE_SET_ITER(ti, trace, traces, arena) + ++trace->readBarrierHitCount; + TRACE_SET_ITER_END(ti, trace, traces, arena); + }); + } else { /* write barrier */ + STATISTIC(++arena->writeBarrierHitCount); + } + + /* The write barrier handling must come after the read barrier, */ + /* because the latter may set the summary and raise the write barrier. */ + if ((mode & SegSM(seg) & AccessWRITE) != 0) /* write barrier? */ + SegSetSummary(seg, RefSetUNIV); + + /* The segment must now be accessible. */ + AVER((mode & SegSM(seg)) == AccessSetEMPTY); +} + + +/* TraceFix -- fix a reference */ + +Res TraceFix(ScanState ss, Ref *refIO) +{ + Ref ref; + Tract tract; + Pool pool; + + /* See design.mps.trace.fix.noaver */ + AVERT_CRITICAL(ScanState, ss); + AVER_CRITICAL(refIO != NULL); + + ref = *refIO; + + STATISTIC(++ss->fixRefCount); + EVENT_PPAU(TraceFix, ss, refIO, ref, ss->rank); + + TRACT_OF_ADDR(&tract, ss->arena, ref); + if (tract) { + if (TraceSetInter(TractWhite(tract), ss->traces) != TraceSetEMPTY) { + Seg seg; + if (TRACT_SEG(&seg, tract)) { + Res res; + STATISTIC(++ss->segRefCount); + STATISTIC(++ss->whiteSegRefCount); + EVENT_P(TraceFixSeg, seg); + EVENT_0(TraceFixWhite); + pool = TractPool(tract); + /* Could move the rank switch here from the class-specific */ + /* fix methods. */ + res = PoolFix(pool, ss, seg, refIO); + if (res != ResOK) + return res; + } + } else { + /* Tract isn't white. Don't compute seg for non-statistical */ + /* variety. See design.mps.trace.fix.tractofaddr */ + STATISTIC_STAT + ({ + Seg seg; + if (TRACT_SEG(&seg, tract)) { + ++ss->segRefCount; + EVENT_P(TraceFixSeg, seg); + } + }); + } + } else { + /* See design.mps.trace.exact.legal */ + AVER(ss->rank < RankEXACT + || !ArenaIsReservedAddr(ss->arena, ref)); + } + + /* See design.mps.trace.fix.fixed.all */ + ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO); + + return ResOK; +} + + +/* TraceFixEmergency -- fix a reference in emergency mode */ + +Res TraceFixEmergency(ScanState ss, Ref *refIO) +{ + Ref ref; + Tract tract; + Pool pool; + + AVERT(ScanState, ss); + AVER(refIO != NULL); + + ref = *refIO; + + STATISTIC(++ss->fixRefCount); + EVENT_PPAU(TraceFix, ss, refIO, ref, ss->rank); + + TRACT_OF_ADDR(&tract, ss->arena, ref); + if (tract) { + if (TraceSetInter(TractWhite(tract), ss->traces) != TraceSetEMPTY) { + Seg seg; + if (TRACT_SEG(&seg, tract)) { + STATISTIC(++ss->segRefCount); + STATISTIC(++ss->whiteSegRefCount); + EVENT_P(TraceFixSeg, seg); + EVENT_0(TraceFixWhite); + pool = TractPool(tract); + PoolFixEmergency(pool, ss, seg, refIO); + } + } else { + /* Tract isn't white. Don't compute seg for non-statistical */ + /* variety. See design.mps.trace.fix.tractofaddr */ + STATISTIC_STAT + ({ + Seg seg; + if (TRACT_SEG(&seg, tract)) { + ++ss->segRefCount; + EVENT_P(TraceFixSeg, seg); + } + }); + } + } else { + /* See design.mps.trace.exact.legal */ + AVER(ss->rank < RankEXACT || + !ArenaIsReservedAddr(ss->arena, ref)); + } + + /* See design.mps.trace.fix.fixed.all */ + ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO); + + return ResOK; +} + + +/* traceScanSingleRefRes -- scan a single reference, with result code */ + +static Res traceScanSingleRefRes(TraceSet ts, Rank rank, Arena arena, + Seg seg, Ref *refIO) +{ + RefSet summary; + ZoneSet white; + Res res; + ScanStateStruct ss; + + EVENT_UUPA(TraceScanSingleRef, ts, rank, arena, (Addr)refIO); + + white = traceSetWhiteUnion(ts, arena); + if (ZoneSetInter(SegSummary(seg), white) == ZoneSetEMPTY) { + return ResOK; + } + + ScanStateInit(&ss, ts, arena, rank, white); + ShieldExpose(arena, seg); + + TRACE_SCAN_BEGIN(&ss) { + res = TRACE_FIX(&ss, refIO); + } TRACE_SCAN_END(&ss); + ss.scannedSize = sizeof *refIO; + + summary = SegSummary(seg); + summary = RefSetAdd(arena, summary, *refIO); + SegSetSummary(seg, summary); + ShieldCover(arena, seg); + + traceSetUpdateCounts(ts, arena, &ss, traceAccountingPhaseSingleScan); + ScanStateFinish(&ss); + + return res; +} + + +/* TraceScanSingleRef -- scan a single reference + * + * This one can't fail. It may put the traces into emergency mode in + * order to achieve this. */ + +void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena, + Seg seg, Ref *refIO) +{ + Res res; + + AVER(TraceSetCheck(ts)); + AVER(RankCheck(rank)); + AVERT(Arena, arena); + AVER(SegCheck(seg)); + AVER(refIO != NULL); + + res = traceScanSingleRefRes(ts, rank, arena, seg, refIO); + if (res != ResOK) { + traceSetSignalEmergency(ts, arena); + res = traceScanSingleRefRes(ts, rank, arena, seg, refIO); + /* ought to be OK in emergency mode now */ + } + AVER(ResOK == res); + + return; +} + + +/* TraceScanArea -- scan contiguous area of references + * + * This is a convenience function for scanning the contiguous area + * [base, limit). I.e., it calls Fix on all words from base up to + * limit, inclusive of base and exclusive of limit. */ + +Res TraceScanArea(ScanState ss, Addr *base, Addr *limit) +{ + Res res; + Addr *p; + Ref ref; + + AVER(base != NULL); + AVER(limit != NULL); + AVER(base < limit); + + EVENT_PPP(TraceScanArea, ss, base, limit); + + TRACE_SCAN_BEGIN(ss) { + p = base; + loop: + if (p >= limit) goto out; + ref = *p++; + if (!TRACE_FIX1(ss, ref)) + goto loop; + res = TRACE_FIX2(ss, p-1); + if (res == ResOK) + goto loop; + return res; + out: + AVER(p == limit); + } TRACE_SCAN_END(ss); + + return ResOK; +} + + +/* TraceScanAreaTagged -- scan contiguous area of tagged references + * + * This is as TraceScanArea except words are only fixed if they are + * tagged as Dylan references (i.e., bottom two bits are zero). @@@@ + * This Dylan-specificness should be generalized in some way. */ + +Res TraceScanAreaTagged(ScanState ss, Addr *base, Addr *limit) +{ + return TraceScanAreaMasked(ss, base, limit, (Word)3); +} + + +/* TraceScanAreaMasked -- scan contiguous area of filtered references + * + * This is as TraceScanArea except words are only fixed if they are zero + * when masked with a mask. */ + +Res TraceScanAreaMasked(ScanState ss, Addr *base, Addr *limit, Word mask) +{ + Res res; + Addr *p; + Ref ref; + + AVER(base != NULL); + AVER(limit != NULL); + AVER(base < limit); + + EVENT_PPP(TraceScanAreaTagged, ss, base, limit); + + TRACE_SCAN_BEGIN(ss) { + p = base; + loop: + if (p >= limit) goto out; + ref = *p++; + if (((Word)ref & mask) != 0) goto loop; + if (!TRACE_FIX1(ss, ref)) goto loop; + res = TRACE_FIX2(ss, p-1); + if (res == ResOK) + goto loop; + return res; + out: + AVER(p == limit); + } TRACE_SCAN_END(ss); + + return ResOK; +} + + +/* traceCondemnAll -- condemn everything and notify all the chains */ + +static Res traceCondemnAll(Trace trace) +{ + Res res; + Arena arena; + Ring chainNode, nextChainNode; + Bool haveWhiteSegs = FALSE; + + arena = trace->arena; + AVERT(Arena, arena); + /* Condemn all the chains. */ + RING_FOR(chainNode, &arena->chainRing, nextChainNode) { + Chain chain = RING_ELT(Chain, chainRing, chainNode); + + AVERT(Chain, chain); + res = ChainCondemnAll(chain, trace); + if (res != ResOK) + goto failBegin; + haveWhiteSegs = TRUE; + } + /* Notify all the chains. */ + RING_FOR(chainNode, &arena->chainRing, nextChainNode) { + Chain chain = RING_ELT(Chain, chainRing, chainNode); + + ChainStartGC(chain, trace); + } + return ResOK; + +failBegin: + AVER(!haveWhiteSegs); /* Would leave white sets inconsistent. */ + return res; +} + + +/* Collection control parameters */ + +double TraceTopGenMortality = 0.51; +double TraceWorkFactor = 0.25; + + +/* TraceStart -- condemn a set of objects and start collection + * + * TraceStart should be passed a trace with state TraceINIT, i.e., + * recently returned from TraceCreate, with some condemned segments + * added. mortality is the fraction of the condemned set expected to + * survive. finishingTime is relative to the current polling clock, see + * design.mps.arena.poll.clock. + * + * .start.black: All segments are black w.r.t. a newly allocated trace. + * However, if TraceStart initialized segments to black when it + * calculated the grey set then this condition could be relaxed, making + * it easy to destroy traces half-way through. */ + +static Res rootGrey(Root root, void *p) +{ + Trace trace = (Trace)p; + + AVERT(Root, root); + AVERT(Trace, trace); + + if (ZoneSetInter(RootSummary(root), trace->white) != ZoneSetEMPTY) + RootGrey(root, trace); + + return ResOK; +} + +void TraceStart(Trace trace, double mortality, double finishingTime) +{ + Arena arena; + Seg seg; + Size size; + Res res; + + AVERT(Trace, trace); + AVER(trace->state == TraceINIT); + AVER(0.0 <= mortality && mortality <= 1.0); + arena = trace->arena; + AVER(finishingTime >= 0.0); + + /* From the already set up white set, derive a grey set. */ + + /* @@@@ Instead of iterating over all the segments, we could */ + /* iterate over all pools which are scannable and thence over */ + /* all their segments. This might be better if the minority */ + /* of segments are scannable. Perhaps we should choose */ + /* dynamically which method to use. */ + + if (SegFirst(&seg, arena)) { + Addr base; + do { + base = SegBase(seg); + size = SegSize(seg); + AVER(!TraceSetIsMember(SegGrey(seg), trace)); + + /* A segment can only be grey if it contains some references. */ + /* This is indicated by the rankSet begin non-empty. Such */ + /* segments may only belong to scannable pools. */ + if (SegRankSet(seg) != RankSetEMPTY) { + /* Segments with ranks may only belong to scannable pools. */ + AVER((SegPool(seg)->class->attr & AttrSCAN) != 0); + + /* Turn the segment grey if there might be a reference in it */ + /* to the white set. This is done by seeing if the summary */ + /* of references in the segment intersects with the */ + /* approximation to the white set. */ + if (ZoneSetInter(SegSummary(seg), trace->white) != ZoneSetEMPTY) { + PoolGrey(SegPool(seg), trace, seg); + if (TraceSetIsMember(SegGrey(seg), trace)) + trace->foundation += size; + } + + if ((SegPool(seg)->class->attr & AttrGC) + && !TraceSetIsMember(SegWhite(seg), trace)) + trace->notCondemned += size; + } + } while (SegNext(&seg, arena, base)); + } + + res = RootsIterate(ArenaGlobals(arena), rootGrey, (void *)trace); + AVER(res == ResOK); + + STATISTIC_STAT(EVENT_PW(ArenaWriteFaults, arena, arena->writeBarrierHitCount)); + + /* Calculate the rate of scanning. */ + { + Size sSurvivors = (Size)(trace->condemned * (1.0 - mortality)); + double nPolls = finishingTime / ArenaPollALLOCTIME; + + /* There must be at least one poll. */ + if (nPolls < 1.0) + nPolls = 1.0; + /* We use casting to long to truncate nPolls down to the nearest */ + /* integer, so try to make sure it fits. */ + if (nPolls >= (double)LONG_MAX) + nPolls = (double)LONG_MAX; + /* rate equals scanning work per number of polls available */ + trace->rate = (trace->foundation + sSurvivors) / (long)nPolls + 1; + } + + STATISTIC_STAT(EVENT_PWWWWDD(TraceStatCondemn, trace, + trace->condemned, trace->notCondemned, + trace->foundation, trace->rate, + mortality, finishingTime)); + trace->state = TraceUNFLIPPED; + + /* All traces must flip at beginning at the moment. */ + traceFlip(trace); + + return; +} + + +/* traceWorkClock -- a measure of the work done for this trace + * + * .workclock: Segment scanning work is the regulator. */ + +#define traceWorkClock(trace) (trace)->segScanSize + + +/* traceQuantum -- progresses a trace by one quantum */ + +static void traceQuantum(Trace trace) +{ + Size pollEnd; + + pollEnd = traceWorkClock(trace) + trace->rate; + do { + switch(trace->state) { + case TraceUNFLIPPED: + /* all traces are flipped in TraceStart at the moment */ + NOTREACHED; + break; + case TraceFLIPPED: { + Arena arena = trace->arena; + Seg seg; + Rank rank; + + if (traceFindGrey(&seg, &rank, arena, trace->ti)) { + AVER((SegPool(seg)->class->attr & AttrSCAN) != 0); + traceScanSeg(TraceSetSingle(trace), rank, arena, seg); + } else + trace->state = TraceRECLAIM; + } break; + case TraceRECLAIM: + traceReclaim(trace); + break; + default: + NOTREACHED; + break; + } + } while (trace->state != TraceFINISHED + && (trace->emergency || traceWorkClock(trace) < pollEnd)); +} + + +/* TracePoll -- Check if there's any tracing work to be done */ + +void TracePoll(Globals globals) +{ + Trace trace; + Res res; + Arena arena; + + AVERT(Globals, globals); + arena = GlobalsArena(globals); + + if (arena->busyTraces == TraceSetEMPTY) { + /* If no traces are going on, see if we need to start one. */ + Size sFoundation, sCondemned, sSurvivors, sConsTrace; + double tTracePerScan; /* tTrace/cScan */ + double dynamicDeferral; + + /* Compute dynamic criterion. See strategy.lisp-machine. */ + AVER(TraceTopGenMortality >= 0.0); + AVER(TraceTopGenMortality <= 1.0); + sFoundation = (Size)0; /* condemning everything, only roots @@@@ */ + /* @@@@ sCondemned should be scannable only */ + sCondemned = ArenaCommitted(arena) - ArenaSpareCommitted(arena); + sSurvivors = (Size)(sCondemned * (1 - TraceTopGenMortality)); + tTracePerScan = sFoundation + (sSurvivors * (1 + TraceCopyScanRATIO)); + AVER(TraceWorkFactor >= 0); + AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX); + sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor); + dynamicDeferral = (double)sConsTrace - (double)ArenaAvail(arena); + + if (dynamicDeferral > 0.0) { /* start full GC */ + double finishingTime; + + res = TraceCreate(&trace, arena); + AVER(res == ResOK); /* succeeds because no other trace is busy */ + traceCondemnAll(trace); + finishingTime = ArenaAvail(arena) + - trace->condemned * (1.0 - TraceTopGenMortality); + if (finishingTime < 0) + /* Run out of time, should really try a smaller collection. @@@@ */ + finishingTime = 0.0; + TraceStart(trace, TraceTopGenMortality, finishingTime); + } else { /* Find the nursery most over its capacity. */ + Ring node, nextNode; + double firstTime = 0.0; + Chain firstChain = NULL; + + RING_FOR(node, &arena->chainRing, nextNode) { + Chain chain = RING_ELT(Chain, chainRing, node); + double time; + + AVERT(Chain, chain); + time = ChainDeferral(chain); + if (time < firstTime) { + firstTime = time; firstChain = chain; + } + } + + /* If one was found, start collection on that chain. */ + if (firstTime < 0) { + double mortality; + + res = TraceCreate(&trace, arena); + AVER(res == ResOK); + res = ChainCondemnAuto(&mortality, firstChain, trace); + if (res != ResOK) + goto failCondemn; + trace->chain = firstChain; + ChainStartGC(firstChain, trace); + TraceStart(trace, mortality, trace->condemned * TraceWorkFactor); + } + } /* (dynamicDeferral > 0.0) */ + } /* (arena->busyTraces == TraceSetEMPTY) */ + + /* If there is a trace, do one quantum of work. */ + if (arena->busyTraces != TraceSetEMPTY) { + trace = ArenaTrace(arena, (TraceId)0); + AVER(arena->busyTraces == TraceSetSingle(trace)); + traceQuantum(trace); + if (trace->state == TraceFINISHED) + TraceDestroy(trace); + } + return; + +failCondemn: + TraceDestroy(trace); +} + + +/* ArenaClamp -- clamp the arena (no new collections) */ + +void ArenaClamp(Globals globals) +{ + AVERT(Globals, globals); + globals->clamped = TRUE; +} + + +/* ArenaRelease -- release the arena (allow new collections) */ + +void ArenaRelease(Globals globals) +{ + AVERT(Globals, globals); + globals->clamped = FALSE; + TracePoll(globals); +} + + +/* ArenaClamp -- finish all collections and clamp the arena */ + +void ArenaPark(Globals globals) +{ + TraceId ti; + Trace trace; + Arena arena; + + AVERT(Globals, globals); + arena = GlobalsArena(globals); + + globals->clamped = TRUE; + + while (arena->busyTraces != TraceSetEMPTY) { + /* Poll active traces to make progress. */ + TRACE_SET_ITER(ti, trace, arena->busyTraces, arena) + traceQuantum(trace); + if (trace->state == TraceFINISHED) + TraceDestroy(trace); + TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena); + } +} + + +/* ArenaCollect -- collect everything in arena */ + +Res ArenaCollect(Globals globals) +{ + Trace trace; + Res res; + + AVERT(Globals, globals); + ArenaPark(globals); + + res = TraceCreate(&trace, GlobalsArena(globals)); + AVER(res == ResOK); /* should be a trace available -- we're parked */ + + res = traceCondemnAll(trace); + if (res != ResOK) + goto failBegin; + + TraceStart(trace, 0.0, 0.0); + ArenaPark(globals); + return ResOK; + +failBegin: + TraceDestroy(trace); + return res; +} diff --git a/mps/code/tract.c b/mps/code/tract.c new file mode 100644 index 00000000000..8028ff8b1c5 --- /dev/null +++ b/mps/code/tract.c @@ -0,0 +1,615 @@ +/* impl.c.tract: PAGE TABLES + * + * $HopeName: MMsrc!tract.c(trunk.5) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .ullagepages: Pages whose page index is < allocBase are recorded as + * free but never allocated as alloc starts searching after the tables. + * TractOfAddr uses the fact that these pages are marked as free in order + * to detect "references" to these pages as being bogus. + */ + +#include "tract.h" +#include "boot.h" +#include "mpm.h" + +SRCID(tract, "$HopeName: MMsrc!tract.c(trunk.5) $"); + + +static void ChunkDecache(Arena arena, Chunk chunk); + + +/* TractArena -- get the arena of a tract */ + +#define TractArena(seg) PoolArena(TractPool(tract)) + + +/* TractCheck -- check the integrity of a tract */ + +Bool TractCheck(Tract tract) +{ + CHECKU(Pool, TractPool(tract)); + CHECKL(AddrIsAligned(TractBase(tract), ArenaAlign(TractArena(tract)))); + if (TractHasSeg(tract)) { + CHECKL(TraceSetCheck(TractWhite(tract))); + CHECKU(Seg, (Seg)TractP(tract)); + } else { + CHECKL(TractWhite(tract) == TraceSetEMPTY); + } + return TRUE; +} + + +/* TractInit -- initialize a tract */ + +void TractInit(Tract tract, Pool pool, Addr base) +{ + AVER(tract != NULL); + AVERT(Pool, pool); + + tract->pool = pool; + tract->base = base; + tract->p = NULL; + tract->white = TraceSetEMPTY; + tract->hasSeg = FALSE; + + AVERT(Tract, tract); + +} + + +/* TractFinish -- finish a tract */ + +void TractFinish(Tract tract) +{ + AVERT(Tract, tract); + + /* Check that there's no segment - and hence no shielding. */ + AVER(!TractHasSeg(tract)); + tract->pool = NULL; +} + + + +/* .tract.critical: These tract functions are low-level and used + * throughout. They are therefore on the critical path and their + * AVERs are so-marked. + */ + + +/* TractBase -- return the base address of a tract */ + +Addr (TractBase)(Tract tract) +{ + Addr base; + AVERT_CRITICAL(Tract, tract); /* .tract.critical */ + + base = tract->base; + return base; +} + + +/* TractLimit -- return the limit address of a segment */ + +Addr TractLimit(Tract tract) +{ + Arena arena; + AVERT_CRITICAL(Tract, tract); /* .tract.critical */ + arena = TractArena(tract); + AVERT_CRITICAL(Arena, arena); + return AddrAdd(TractBase(tract), arena->alignment); +} + + +/* Chunk functions */ + + +/* ChunkCheck -- check a chunk */ + +Bool ChunkCheck(Chunk chunk) +{ + CHECKS(Chunk, chunk); + CHECKU(Arena, chunk->arena); + CHECKL(chunk->serial < chunk->arena->chunkSerial); + CHECKL(RingCheck(&chunk->chunkRing)); + CHECKL(ChunkPagesToSize(chunk, 1) == ChunkPageSize(chunk)); + CHECKL(ShiftCheck(ChunkPageShift(chunk))); + + CHECKL(chunk->base != (Addr)0); + CHECKL(chunk->base < chunk->limit); + /* check chunk is in itself */ + CHECKL(chunk->base <= (Addr)chunk); + CHECKL((Addr)(chunk+1) <= chunk->limit); + CHECKL(ChunkSizeToPages(chunk, AddrOffset(chunk->base, chunk->limit)) + == chunk->pages); + /* check that the tables fit in the chunk */ + CHECKL(chunk->allocBase <= chunk->pages); + CHECKL(chunk->allocBase >= chunk->pageTablePages); + + CHECKL(chunk->allocTable != NULL); + /* check that allocTable is in the chunk overhead */ + CHECKL((Addr)chunk->allocTable >= chunk->base); + CHECKL(AddrAdd((Addr)chunk->allocTable, BTSize(chunk->pages)) + <= PageIndexBase(chunk, chunk->allocBase)); + + /* check they don't overlap (knowing the order) */ + CHECKL(AddrAdd((Addr)chunk->allocTable, BTSize(chunk->pages)) + <= (Addr)chunk->pageTable); + + CHECKL(chunk->pageTable != NULL); + CHECKL((Addr)chunk->pageTable >= chunk->base); + CHECKL((Addr)&chunk->pageTable[chunk->pageTablePages] + <= PageIndexBase(chunk, chunk->allocBase)); + /* check there's enough space in the page table */ + CHECKL(INDEX_OF_ADDR(chunk, (Addr)chunk->pageTable) >= 0); + CHECKL(INDEX_OF_ADDR(chunk, AddrSub(chunk->limit, 1)) < chunk->pages); + CHECKL(chunk->pageTablePages < chunk->pages); + + /* Could check the consistency of the tables, but not O(1). */ + return TRUE; +} + + +/* ChunkInit -- initialize generic part of chunk */ + +Res ChunkInit(Chunk chunk, Arena arena, + Addr base, Addr limit, Align pageSize, BootBlock boot) +{ + Size size; + Count pages; + PageStruct *pageTable; + Shift pageShift; + Size pageTableSize; + void *p; + Res res; + + /* chunk is supposed to be uninitialized, so don't check it. */ + AVERT(Arena, arena); + AVER(base != NULL); + AVER(AddrIsAligned(base, pageSize)); + AVER(base < limit); + AVER(AddrIsAligned(limit, pageSize)); + AVERT(Align, pageSize); + AVER(pageSize > MPS_PF_ALIGN); + AVERT(BootBlock, boot); + + chunk->serial = (arena->chunkSerial)++; + chunk->arena = arena; + RingInit(&chunk->chunkRing); + RingAppend(&arena->chunkRing, &chunk->chunkRing); + + chunk->pageSize = pageSize; + chunk->pageShift = pageShift = SizeLog2(pageSize); + chunk->base = base; + chunk->limit = limit; + size = AddrOffset(base, limit); + + chunk->pages = pages = size >> pageShift; + res = BootAlloc(&p, boot, (size_t)BTSize(pages), MPS_PF_ALIGN); + if (res != ResOK) + goto failAllocTable; + chunk->allocTable = p; + + pageTableSize = SizeAlignUp(pages * sizeof(PageStruct), pageSize); + chunk->pageTablePages = pageTableSize >> pageShift; + + res = (arena->class->chunkInit)(chunk, boot); + if (res != ResOK) + goto failClassInit; + + /* Put the page table as late as possible, as in VM systems we don't want */ + /* to map it. */ + res = BootAlloc(&p, boot, (size_t)pageTableSize, (size_t)pageSize); + if (res != ResOK) + goto failAllocPageTable; + chunk->pageTable = pageTable = p; + + /* @@@@ Is BootAllocated always right? */ + chunk->allocBase = (Index)(BootAllocated(boot) >> pageShift); + + /* Init allocTable after class init, because it might be mapped there. */ + BTResRange(chunk->allocTable, 0, pages); + + chunk->sig = ChunkSig; + AVERT(Chunk, chunk); + return ResOK; + + /* .no-clean: No clean-ups needed for boot, as we will discard the chunk. */ +failAllocPageTable: + (arena->class->chunkFinish)(chunk); +failClassInit: +failAllocTable: + return res; +} + + +/* ChunkFinish -- finish the generic fields of a chunk */ + +void ChunkFinish(Chunk chunk) +{ + AVERT(Chunk, chunk); + AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages)); + ChunkDecache(chunk->arena, chunk); + chunk->sig = SigInvalid; + RingRemove(&chunk->chunkRing); + /* Finish all other fields before class finish, because they might be */ + /* unmapped there. */ + (chunk->arena->class->chunkFinish)(chunk); +} + + +/* Chunk Cache + * + * Functions for manipulating the chunk cache in the arena. + */ + + +/* ChunkCacheEntryCheck -- check a chunk cache entry */ + +Bool ChunkCacheEntryCheck(ChunkCacheEntry entry) +{ + CHECKS(ChunkCacheEntry, entry); + if (entry->chunk != NULL) { + CHECKD(Chunk, entry->chunk); + CHECKL(entry->base == entry->chunk->base); + CHECKL(entry->limit == entry->chunk->limit); + CHECKL(entry->pageTableBase == &entry->chunk->pageTable[0]); + CHECKL(entry->pageTableLimit + == &entry->chunk->pageTable[entry->chunk->pages]); + } + return TRUE; +} + + +/* ChunkCacheEntryInit -- initialize a chunk cache entry */ + +void ChunkCacheEntryInit(ChunkCacheEntry entry) +{ + entry->chunk = NULL; + /* No need to init other fields. */ + entry->sig = ChunkCacheEntrySig; + return; +} + + +/* ChunkEncache -- cache a chunk */ + +void ChunkEncache(Arena arena, Chunk chunk) +{ + AVERT(Arena, arena); + AVERT(Chunk, chunk); + AVER(arena == chunk->arena); + + /* check chunk already in cache first */ + if (arena->chunkCache.chunk == chunk) { + return; + } + + arena->chunkCache.chunk = chunk; + arena->chunkCache.base = chunk->base; + arena->chunkCache.limit = chunk->limit; + arena->chunkCache.pageTableBase = &chunk->pageTable[0]; + arena->chunkCache.pageTableLimit = &chunk->pageTable[chunk->pages]; + + AVERT(ChunkCacheEntry, &arena->chunkCache); + return; +} + + +/* ChunkDecache -- make sure a chunk is not in the cache */ + +static void ChunkDecache(Arena arena, Chunk chunk) +{ + if (arena->chunkCache.chunk == chunk) { + arena->chunkCache.chunk = NULL; + } +} + + +/* ChunkOfAddr -- return the chunk which encloses an address */ + +Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr) +{ + Ring node, next; + + AVER_CRITICAL(chunkReturn != NULL); + AVERT_CRITICAL(Arena, arena); + /* addr is arbitrary */ + + /* check cache first */ + if (arena->chunkCache.base <= addr && addr < arena->chunkCache.limit) { + *chunkReturn = arena->chunkCache.chunk; + return TRUE; + } + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + if (chunk->base <= addr && addr < chunk->limit) { + /* Gotcha! */ + ChunkEncache(arena, chunk); + *chunkReturn = chunk; + return TRUE; + } + } + return FALSE; +} + + +/* ChunkOfNextAddr + * + * Finds the next higher chunk in memory which does _not_ contain addr. + * Returns FALSE if there is none. + */ + +static Bool ChunkOfNextAddr(Chunk *chunkReturn, Arena arena, Addr addr) +{ + Addr leastBase; + Chunk leastChunk; + Ring node, next; + + leastBase = (Addr)(Word)-1; + leastChunk = NULL; + RING_FOR(node, &arena->chunkRing, next) { + Chunk chunk = RING_ELT(Chunk, chunkRing, node); + if (addr < chunk->base && chunk->base < leastBase) { + leastBase = chunk->base; + leastChunk = chunk; + } + } + if (leastChunk != NULL) { + *chunkReturn = leastChunk; + return TRUE; + } + return FALSE; +} + + +/* ArenaIsReservedAddr -- is address managed by this arena? */ + +Bool ArenaIsReservedAddr(Arena arena, Addr addr) +{ + Chunk dummy; + + AVERT(Arena, arena); + /* addr is arbitrary */ + + return ChunkOfAddr(&dummy, arena, addr); +} + + +/* IndexOfAddr -- return the index of the page containing an address + * + * Function version of INDEX_OF_ADDR, for debugging purposes. + */ + +Index IndexOfAddr(Chunk chunk, Addr addr) +{ + AVERT(Chunk, chunk); + /* addr is arbitrary */ + + return INDEX_OF_ADDR(chunk, addr); +} + + +/* Page table functions */ + +/* .tract.critical: These Tract functions are low-level and are on + * the critical path in various ways. The more common therefore + * use AVER_CRITICAL. + */ + + +/* TractOfAddr -- return the tract the given address is in, if any + * + * If the address is within the bounds of the arena, calculate the + * page table index from the address and see if the page is allocated. + * If so, return it. + */ + +Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr) +{ + Bool b; + Index i; + Chunk chunk; + + /* design.mps.trace.fix.noaver */ + AVER_CRITICAL(tractReturn != NULL); /* .tract.critical */ + AVERT_CRITICAL(Arena, arena); + + b = ChunkOfAddr(&chunk, arena, addr); + if (!b) + return FALSE; + /* design.mps.trace.fix.tractofaddr */ + i = INDEX_OF_ADDR(chunk, addr); + /* .addr.free: If the page is recorded as being free then */ + /* either the page is free or it is */ + /* part of the arena tables (see .ullagepages). */ + if (BTGet(chunk->allocTable, i)) { + Page page = &chunk->pageTable[i]; + *tractReturn = PageTract(page); + return TRUE; + } + + return FALSE; +} + + +/* TractOfBaseAddr -- return a tract given a base address + * + * The address must have been allocated to some pool. + */ + +Tract TractOfBaseAddr(Arena arena, Addr addr) +{ + Tract tract; + Bool found; + + AVERT_CRITICAL(Arena, arena); + AVER_CRITICAL(AddrIsAligned(addr, arena->alignment)); + + /* Check first in the cache, see design.mps.arena.tract.cache. */ + if (arena->lastTractBase == addr) { + tract = arena->lastTract; + } else { + found = TractOfAddr(&tract, arena, addr); + AVER_CRITICAL(found); + } + + AVER_CRITICAL(TractBase(tract) == addr); + return tract; +} + + +/* tractSearchInChunk -- search for a tract + * + * .tract-search: Searches for a tract in the chunk starting at page + * index i, return NULL if there is none. .tract-search.private: This + * function is private to this module and is used in the tract iteration + * protocol (TractFirst and TractNext). + */ + +static Bool tractSearchInChunk(Tract *tractReturn, Chunk chunk, Index i) +{ + AVER_CRITICAL(chunk->allocBase <= i); + AVER_CRITICAL(i <= chunk->pages); + + while(i < chunk->pages + && !(BTGet(chunk->allocTable, i) + && PageIsAllocated(&chunk->pageTable[i]))) { + ++i; + } + if (i == chunk->pages) + return FALSE; + AVER(i < chunk->pages); + *tractReturn = PageTract(&chunk->pageTable[i]); + return TRUE; +} + + +/* tractSearch + * + * Searches for the next tract in increasing address order. + * The tract returned is the next one along from addr (i.e., + * it has a base address bigger than addr and no other tract + * with a base address bigger than addr has a smaller base address). + * + * Returns FALSE if there is no tract to find (end of the arena). + */ + +static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr) +{ + Bool b; + Chunk chunk; + + b = ChunkOfAddr(&chunk, arena, addr); + if (b) { + Index i; + + i = INDEX_OF_ADDR(chunk, addr); + /* There are fewer pages than addresses, therefore the */ + /* page index can never wrap around */ + AVER_CRITICAL(i+1 != 0); + + if (tractSearchInChunk(tractReturn, chunk, i+1)) { + return TRUE; + } + } + while (ChunkOfNextAddr(&chunk, arena, addr)) { + /* If the ring was kept in address order, this could be improved. */ + addr = chunk->base; + /* Start from allocBase to skip the tables. */ + if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) { + return TRUE; + } + } + return FALSE; +} + + +/* TractFirst -- return the first tract in the arena + * + * This is used to start an iteration over all tracts in the arena, not + * including the ones used for page tables and other arena structures. + */ + +Bool TractFirst(Tract *tractReturn, Arena arena) +{ + AVER(tractReturn != NULL); + AVERT(Arena, arena); + + /* .tractfirst.assume.nozero: We assume that there is no tract */ + /* with base address (Addr)0. Happily this assumption is sound */ + /* for a number of reasons. */ + return tractSearch(tractReturn, arena, (Addr)0); +} + + +/* TractNext -- return the "next" tract in the arena + * + * TractNext finds the tract with the lowest base address which is + * greater than a specified address. The address must be (or once + * have been) the base address of a tract. + * + * This is used as the iteration step when iterating over all + * tracts in the arena. + */ + +Bool TractNext(Tract *tractReturn, Arena arena, Addr addr) +{ + AVER_CRITICAL(tractReturn != NULL); /* .tract.critical */ + AVERT_CRITICAL(Arena, arena); + AVER_CRITICAL(AddrIsAligned(addr, arena->alignment)); + + return tractSearch(tractReturn, arena, addr); +} + + +/* PageAlloc + * + * Sets up the PageStruct for an allocated page to turn it into a Tract. + */ + +void PageAlloc(Chunk chunk, Index pi, Pool pool) +{ + Tract tract; + Addr base; + + AVERT(Chunk, chunk); + AVER(pi >= chunk->allocBase); + AVER(pi < chunk->pages); + AVER(!BTGet(chunk->allocTable, pi)); + AVERT(Pool, pool); + + tract = PageTract(&chunk->pageTable[pi]); + base = PageIndexBase(chunk, pi); + BTSet(chunk->allocTable, pi); + TractInit(tract, pool, base); + return; +} + + +/* PageInit -- initialize a page (as free) */ + +void PageInit(Chunk chunk, Index pi) +{ + AVERT(Chunk, chunk); + AVER(pi < chunk->pages); + + BTRes(chunk->allocTable, pi); + PagePool(&chunk->pageTable[pi]) = NULL; + PageType(&chunk->pageTable[pi]) = PageTypeFree; + return; +} + + +/* PageFree -- free an allocated page */ + +void PageFree(Chunk chunk, Index pi) +{ + AVERT(Chunk, chunk); + AVER(pi >= chunk->allocBase); + AVER(pi < chunk->pages); + AVER(BTGet(chunk->allocTable, pi)); + + PageInit(chunk, pi); + return; +} diff --git a/mps/code/tract.h b/mps/code/tract.h new file mode 100644 index 00000000000..427e480f5f2 --- /dev/null +++ b/mps/code/tract.h @@ -0,0 +1,281 @@ +/* impl.h.tract: PAGE TABLE INTERFACE + * + * $HopeName: MMsrc!tract.h(trunk.6) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + */ + + +#ifndef tract_h +#define tract_h + +#include "mpmtypes.h" +#include "ring.h" + + +/* TractStruct -- tract structure + * + * .tract: Tracts represent the grains of memory allocation from + * the arena. See design.mps.arena. + * + * .bool: The hasSeg field is a boolean, but can't be represented + * as type Bool. See design.mps.arena.tract.field.hasSeg. + */ + +typedef struct TractStruct { /* Tract structure */ + Pool pool; /* MUST BE FIRST (design.mps.arena.tract.field pool) */ + void *p; /* pointer for use of owning pool */ + Addr base; /* Base address of the tract */ + TraceSet white : TraceLIMIT; /* traces for which tract is white */ + unsigned int hasSeg : 1; /* does tract have a seg in p? See .bool */ +} TractStruct; + + +extern Addr (TractBase)(Tract tract); +#define TractBase(tract) ((tract)->base) +extern Addr TractLimit(Tract tract); + +#define TractPool(tract) ((tract)->pool) +#define TractP(tract) ((tract)->p) +#define TractSetP(tract, pp) ((void)((tract)->p = (pp))) +#define TractHasSeg(tract) ((Bool)(tract)->hasSeg) +#define TractSetHasSeg(tract, b) ((void)((tract)->hasSeg = (b))) +#define TractWhite(tract) ((tract)->white) +#define TractSetWhite(tract, w) ((void)((tract)->white = (w))) + +extern Bool TractCheck(Tract tract); +extern void TractInit(Tract tract, Pool pool, Addr base); +extern void TractFinish(Tract tract); + + +/* TRACT_*SEG -- Test / set / unset seg->tract associations + * + * These macros all multiply evaluate the tract parameter + */ + +#define TRACT_SEG(segReturn, tract) \ + (TractHasSeg(tract) && ((*(segReturn) = (Seg)TractP(tract)), TRUE)) + +#define TRACT_SET_SEG(tract, seg) \ + (TractSetHasSeg(tract, TRUE), TractSetP(tract, seg)) + +#define TRACT_UNSET_SEG(tract) \ + (TractSetHasSeg(tract, FALSE), TractSetP(tract, NULL)) + + +/* PageStruct -- Page structure + * + * .page-table: The page table (defined as a PageStruct array) + * is central to the design of the arena. + * See design.mps.arena.vm.table.*. + * + * .page: The "pool" field must be the first field of the "tail" + * field of this union. See design.mps.arena.tract.field.pool. + * + * .states: Pages (hence PageStructs that describe them) can be in + * one of 3 states: + * allocated (to a pool as tracts) + * allocated pages are mapped + * BTGet(allocTable, i) == 1 + * PageRest()->pool == pool + * spare + * these pages are mapped + * BTGet(allocTable, i) == 0 + * PageRest()->pool == NULL + * PageRest()->type == PageTypeSpare + * free + * these pages are not mapped + * BTGet(allocTable, i) == 0 + * PTE may itself be unmapped, but when it is (use pageTableMapped + * to determine whether page occupied by page table is mapped): + * PageRest()->pool == NULL + * PageRest()->type == PageTypeFree + */ + +enum {PageTypeSpare=1, PageTypeFree}; + +typedef struct PageStruct { /* page structure */ + union { + TractStruct tractStruct; /* allocated tract */ + struct { + Pool pool; /* NULL, must be first field (.page) */ + int type; /* see .states */ + } rest; /* other (non-allocated) page */ + } the; +} PageStruct; + + +/* PageTract -- tract descriptor of an allocated page */ + +#define PageTract(page) (&(page)->the.tractStruct) + +/* PageOfTract -- VM page descriptor from arena tract */ + +#define PageOfTract(tract) PARENT(PageStruct, the.tractStruct, (tract)) + +/* PagePool -- pool field of a page */ + +#define PagePool(page) ((page)->the.rest.pool) + +/* PageIsAllocated -- is a page allocated? + * + * See design.mps.arena.vm.table.disc. + */ + +#define PageIsAllocated(page) ((page)->the.rest.pool != NULL) + +/* PageType -- type of page */ + +#define PageType(page) ((page)->the.rest.type) + + +/* Chunks */ + + +#define ChunkSig ((Sig)0x519C804C) /* SIGnature CHUNK */ + +typedef struct ChunkStruct { + Sig sig; /* design.mps.sig */ + Serial serial; /* serial within the arena */ + Arena arena; /* parent arena */ + RingStruct chunkRing; /* ring of all chunks in arena */ + Size pageSize; /* size of pages */ + Shift pageShift; /* log2 of page size, for shifts */ + Addr base; /* base address of chunk */ + Addr limit; /* limit address of chunk */ + Index allocBase; /* index of first page allocatable to clients */ + Index pages; /* index of the page after the last allocatable page */ + BT allocTable; /* page allocation table */ + PageStruct* pageTable; /* the page table */ + Count pageTablePages; /* number of pages occupied by page table */ +} ChunkStruct; + + +#define ChunkArena(chunk) ((chunk)->arena) +#define ChunkPageSize(chunk) ((chunk)->pageSize) +#define ChunkPageShift(chunk) ((chunk)->pageShift) +#define ChunkPagesToSize(chunk, pages) ((Size)(pages) << (chunk)->pageShift) +#define ChunkSizeToPages(chunk, size) ((Count)((size) >> (chunk)->pageShift)) + +extern Bool ChunkCheck(Chunk chunk); +extern Res ChunkInit(Chunk chunk, Arena arena, + Addr base, Addr limit, Align pageSize, BootBlock boot); +extern void ChunkFinish(Chunk chunk); + +extern Bool ChunkCacheEntryCheck(ChunkCacheEntry entry); +extern void ChunkCacheEntryInit(ChunkCacheEntry entry); +extern void ChunkEncache(Arena arena, Chunk chunk); + +extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr); + +/* CHUNK_OF_ADDR -- return the chunk containing an address + * + * arena and addr are evaluated multiple times. + */ + +#define CHUNK_OF_ADDR(chunkReturn, arena, addr) \ + (((arena)->chunkCache.base <= (addr) && (addr) < (arena)->chunkCache.limit) \ + ? (*(chunkReturn) = (arena)->chunkCache.chunk, TRUE) \ + : ChunkOfAddr(chunkReturn, arena, addr)) + + +/* AddrPageBase -- the base of the page this address is on */ + +#define AddrPageBase(chunk, addr) \ + AddrAlignDown((addr), ChunkPageSize(chunk)) + + +/* Page table functions */ + +extern Tract TractOfBaseAddr(Arena arena, Addr addr); +extern Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr); + +/* TRACT_OF_ADDR -- return the tract containing an address */ + +#define TRACT_OF_ADDR(tractReturn, arena, addr) \ + BEGIN \ + Arena _arena = (arena); \ + Addr _addr = (addr); \ + Chunk _chunk; \ + Index _i; \ + \ + if (CHUNK_OF_ADDR(&_chunk, _arena, _addr)) { \ + _i = INDEX_OF_ADDR(_chunk, _addr); \ + if (BTGet(_chunk->allocTable, _i)) \ + *(tractReturn) = PageTract(&_chunk->pageTable[_i]); \ + else \ + *(tractReturn) = NULL; \ + } else \ + *(tractReturn) = NULL; \ + END + + +/* INDEX_OF_ADDR -- return the index of the page containing an address + * + * .index.addr: The address passed may be equal to the limit of the + * arena, in which case the last page index plus one is returned. (It + * is, in a sense, the limit index of the page table.) + */ + +#define INDEX_OF_ADDR(chunk, addr) \ + ((Index)ChunkSizeToPages(chunk, AddrOffset((chunk)->base, addr))) + +extern Index IndexOfAddr(Chunk chunk, Addr addr); + + +/* PageIndexBase -- map page index to base address of page + * + * See design.mps.arena.vm.table.linear + */ + +#define PageIndexBase(chunk, i) \ + AddrAdd((chunk)->base, ChunkPagesToSize(chunk, i)) + + +/* TractIsContiguousRange -- do base and limit define a contiguous range */ + +#define AverTractIsContiguousRange(arena, rangeBase, rangeLimit) \ + BEGIN \ + Chunk _ch; \ + \ + UNUSED(_ch); \ + AVER(ChunkOfAddr(&_ch, arena, rangeBase) && (rangeLimit) <= _ch->limit); \ + END + + +extern Bool TractFirst(Tract *tractReturn, Arena arena); +extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr); + + +/* TRACT_TRACT_FOR -- iterate over a range of tracts + * + * See design.mps.arena.tract-iter.if.macro. + * Parameters arena & limit are evaluated multiple times. + * Check first tract & last tract lie with the same chunk. + */ + +#define TRACT_TRACT_FOR(tract, addr, arena, firstTract, limit) \ + tract = (firstTract); addr = TractBase(tract); \ + AverTractIsContiguousRange(arena, addr, limit); \ + for(; tract != NULL; \ + (addr = AddrAdd(addr, (arena)->alignment)), \ + (addr < (limit) ? \ + (tract = PageTract(PageOfTract(tract) + 1)) : \ + (tract = NULL) /* terminate loop */)) + + +/* TRACT_FOR -- iterate over a range of tracts + * + * See design.mps.arena.tract.for. + * Parameters arena & limit are evaluated multiple times. + */ + +#define TRACT_FOR(tract, addr, arena, base, limit) \ + TRACT_TRACT_FOR(tract, addr, arena, TractOfBaseAddr(arena, base), limit) + + +extern void PageAlloc(Chunk chunk, Index pi, Pool pool); +extern void PageInit(Chunk chunk, Index pi); +extern void PageFree(Chunk chunk, Index pi); + + +#endif /* tract_h */ diff --git a/mps/code/version.c b/mps/code/version.c new file mode 100644 index 00000000000..73517ab5a09 --- /dev/null +++ b/mps/code/version.c @@ -0,0 +1,58 @@ +/* impl.c.version: VERSION INSPECTION + * + * $HopeName$ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * PURPOSE + * + * The purpose of this module is to provide a means by which the + * version of the MM library being used can be determined. + * + * DESIGN + * + * .design: See design.mps.version-library, but to let you in on a + * secret it works by declaring a string with all the necessary info + * in. + */ + +#include "mpm.h" + + +SRCID(version, "$HopeName$"); + + +/* MPS_RELEASE -- the release name + * + * .release: When making a new release, change the expansion of + * MPS_RELEASE to be a string of the form "release.dylan.crow.2" or + * whatever. + */ + +#define MPS_RELEASE "$HopeName$ *** DEVELOPMENT ONLY ***" + + +/* MPSCopyrightNotice -- copyright notice for the binary + * + * .copyright.year: This one should have the current year in it + * (assuming we've made any substantial changes to the library this year). + */ + +char MPSCopyrightNotice[] = + "Copyright (C) 2000 Harlequin Limited. All rights reserved."; + + +/* MPSVersion -- return version string + * + * The value of MPSVersion is a declared object comprising the + * concatenation of all the version info. + */ + +char MPSVersionString[] = + "@(#)HQNMPS, " + "product." MPS_PROD_STRING ", " MPS_RELEASE ", platform." MPS_PF_STRING + ", variety." MPS_VARIETY_STRING ", compiled on " __DATE__ " " __TIME__; + +char *MPSVersion(void) +{ + return MPSVersionString; +} diff --git a/mps/code/vman.c b/mps/code/vman.c new file mode 100644 index 00000000000..d57a056320f --- /dev/null +++ b/mps/code/vman.c @@ -0,0 +1,204 @@ +/* impl.c.vman: ANSI VM: MALLOC-BASED PSEUDO MEMORY MAPPING + * + * $HopeName: MMsrc!vman.c(trunk.21) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" + +#include /* for malloc and free */ +#include /* for memset */ + +SRCID(vman, "$HopeName: MMsrc!vman.c(trunk.21) $"); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +/* ANSI fake VM structure, see design.mps.vman */ +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + Addr base, limit; /* boundaries of malloc'd memory */ + void *block; /* pointer to malloc'd block, for free() */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +/* VMCheck -- check a VM structure */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->base != (Addr)0); + CHECKL(vm->limit != (Addr)0); + CHECKL(vm->base < vm->limit); + CHECKL(AddrIsAligned(vm->base, VMANPageALIGNMENT)); + CHECKL(AddrIsAligned(vm->limit, VMANPageALIGNMENT)); + CHECKL(vm->block != NULL); + CHECKL((Addr)vm->block <= vm->base); + CHECKL(vm->mapped <= vm->reserved); + return TRUE; +} + + +/* VMAlign -- return the page size */ + +Align VMAlign(VM vm) +{ + UNUSED(vm); + return VMANPageALIGNMENT; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + VM vm; + + AVER(vmReturn != NULL); + + /* Note that because we add VMANPageALIGNMENT rather than */ + /* VMANPageALIGNMENT-1 we are not in danger of overflowing */ + /* vm->limit even if malloc were perverse enough to give us */ + /* a block at the end of memory. */ + size = SizeAlignUp(size, VMANPageALIGNMENT) + VMANPageALIGNMENT; + if ((size < VMANPageALIGNMENT) || (size > (Size)(size_t)-1)) + return ResRESOURCE; + + vm = (VM)malloc(sizeof(VMStruct)); + if (vm == NULL) + return ResMEMORY; + + vm->block = malloc((size_t)size); + if (vm->block == NULL) { + free(vm); + return ResMEMORY; + } + + vm->base = AddrAlignUp((Addr)vm->block, VMANPageALIGNMENT); + vm->limit = AddrAdd(vm->base, size - VMANPageALIGNMENT); + AVER(vm->limit < AddrAdd((Addr)vm->block, size)); + + memset((void *)vm->block, VMJunkBYTE, size); + + /* Lie about the reserved address space, to simulate real */ + /* virtual memory. */ + vm->reserved = size - VMANPageALIGNMENT; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + *vmReturn = vm; + return ResOK; +} + + +/* VMDestroy -- destroy the VM structure */ + +void VMDestroy(VM vm) +{ + /* All vm areas should have been unmapped. */ + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + AVER(vm->reserved == AddrOffset(vm->base, vm->limit)); + + memset((void *)vm->base, VMJunkBYTE, AddrOffset(vm->base, vm->limit)); + free(vm->block); + + vm->sig = SigInvalid; + free(vm); + + EVENT_P(VMDestroy, vm); +} + + +/* VMBase -- return the base address of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + + return vm->base; +} + + +/* VMLimit -- return the limit address of the memory reserved */ + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + + return vm->limit; +} + + +/* VMReserved -- return the amount of address space reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + + return vm->reserved; +} + + +/* VMMapped -- return the amount of memory actually mapped */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + + return vm->mapped; +} + + +/* VMMap -- map the given range of memory */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVER(base != (Addr)0); + AVER(vm->base <= base); + AVER(base < limit); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, VMANPageALIGNMENT)); + AVER(AddrIsAligned(limit, VMANPageALIGNMENT)); + + size = AddrOffset(base, limit); + memset((void *)base, (int)0, size); + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- unmap the given range of memory */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVER(base != (Addr)0); + AVER(vm->base <= base); + AVER(base < limit); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, VMANPageALIGNMENT)); + AVER(AddrIsAligned(limit, VMANPageALIGNMENT)); + + size = AddrOffset(base, limit); + memset((void *)base, VM_JUNKBYTE, size); + + AVER(vm->mapped >= size); + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmi5.c b/mps/code/vmi5.c new file mode 100644 index 00000000000..6eda6c4b16d --- /dev/null +++ b/mps/code/vmi5.c @@ -0,0 +1,275 @@ +/* impl.c.vmi5: VIRTUAL MEMORY MAPPING FOR IRIX 5 (AND 6) + * + * $HopeName: MMsrc!vmi5.c(trunk.4) $ + * Copyright (C) 1997, 1998 Harlequin Group plc. All rights reserved. + * + * Design: design.mps.vm + * + * This is the implementation of the virtual memory mapping interface + * (vm.h) for IRIX 5.x. + * + * mmap(2) is used to reserve address space by creating a mapping to + * /dev/zero with page access none. mmap(2) is used to map pages + * onto store by creating a copy-on-write mapping to /dev/zero. + * + * .assume.not-last: The implementation of VMCreate assumes that + * mmap() will not choose a region which contains the last page + * in the address space, so that the limit of the mapped area + * is representable. + * + * .assume.mmap.err: EAGAIN is the only error we really expect to get + * from mmap when committing and ENOMEM when reserving or committing (we + * have actually observed ENOMEM when committing). The others are + * either caused by invalid params or features we don't use. See + * mmap(2) for details. + * + * TRANSGRESSIONS + * + * .fildes.name: VMStruct has one fields whose name violates our naming + * conventions. It's called zero_fd to emphasize that it's a file + * descriptor and this fact is not reflected in the type. + */ + +#include "mpm.h" + +#if !defined(MPS_OS_I5) && !defined(MPS_OS_IA) +#error "vmi5.c is IRIX-specific, but MPS_OS_I5 or MPS_OS_IA is not set" +#endif + +#define _POSIX_SOURCE +#define _POSIX_C_SOURCE 199309L + +#include +#include +#include +#include +#include +#include + +/* No constant for the mmap error return on IRIX 5, so define one. */ +#if !defined(MAP_FAILED) && defined(MPS_OS_I5) +#define MAP_FAILED ((void *)-1) +#endif + +SRCID(vmi5, "$HopeName: MMsrc!vmi5.c(trunk.4) $"); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +/* The name zero_fd is a transgression, see .fildes.name. */ +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + int zero_fd; /* fildes for mmap */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->zero_fd >= 0); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +Res VMCreate(VM *vmReturn, Size size) +{ + void *addr; + Align align; + int zero_fd; + VM vm; + Res res; + + AVER(vmReturn != NULL); + + align = (Align)sysconf(_SC_PAGESIZE); + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if((size == 0) || (size > (Size)(size_t)-1)) + return ResRESOURCE; + + zero_fd = open("/dev/zero", O_RDONLY); + if(zero_fd == -1) + return ResFAIL; + + /* Map in a page to store the descriptor on. */ + addr = mmap((void *)0, (size_t)SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, MAP_PRIVATE, + zero_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == ENOMEM || errno == EAGAIN); /* .assume.mmap.err */ + res = (errno == ENOMEM || errno == EAGAIN) ? ResMEMORY : ResFAIL; + goto failVMMap; + } + vm = (VM)addr; + + vm->zero_fd = zero_fd; + vm->align = align; + + /* .map.reserve: MAP_AUTORESRV is necessary to avoid reserving swap. */ + addr = mmap((void *)0, (size_t)size, PROT_NONE, MAP_SHARED | MAP_AUTORESRV, + zero_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + res = (errno == ENOMEM) ? ResRESOURCE : ResFAIL; + goto failReserve; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + + *vmReturn = vm; + return ResOK; + +failReserve: + (void)munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align)); +failVMMap: + (void)close(zero_fd); + return res; +} + + +void VMDestroy(VM vm) +{ + int r; + int zero_fd; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + zero_fd = vm->zero_fd; + r = munmap((void *)vm->base, (size_t)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); + r = close(zero_fd); + AVER(r == 0); + + EVENT_P(VMDestroy, vm); +} + + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + return vm->base; +} + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + return vm->limit; +} + + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + return vm->reserved; +} + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + return vm->mapped; +} + + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + void *addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* Map /dev/zero onto the area with a copy-on-write policy. This */ + /* effectively populates the area with zeroed memory. */ + size = AddrOffset(base, limit); + /* Check it won't lose any bits. */ + AVER(size <= (Size)(size_t)-1); + addr = mmap((void *)base, (size_t)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_PRIVATE | MAP_FIXED, + vm->zero_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == ENOMEM || errno == EAGAIN); /* .assume.mmap.err */ + return ResMEMORY; + } + AVER(addr == (void *)base); + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + void *addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* .unmap.reserve: Map /dev/zero onto the area, allowing no access. */ + /* This effectively depopulates the area from memory, but keeps */ + /* it "busy" as far as the OS is concerned, so that it will not */ + /* be re-used by other calls to mmap which do not specify */ + /* MAP_FIXED. See also .map.reserve. */ + /* The OS doesn't merge this mapping with any neighbours, but it */ + /* can keep track of at least 16K mappings, so it's good enough. */ + size = AddrOffset(base, limit); + /* Check it won't lose any bits. */ + AVER(size <= (Size)(size_t)-1); + addr = mmap((void *)base, (size_t)size, + PROT_NONE, MAP_SHARED | MAP_FIXED | MAP_AUTORESRV, + vm->zero_fd, (off_t)AddrOffset(vm->base, base)); + AVER(addr == (void *)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmli.c b/mps/code/vmli.c new file mode 100644 index 00000000000..8fb9c978ed4 --- /dev/null +++ b/mps/code/vmli.c @@ -0,0 +1,292 @@ +/* impl.c.vmli: VIRTUAL MEMORY MAPPING FOR LINUX + * + * $HopeName: MMsrc!vmli.c(trunk.7) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .purpose: This is the implementation of the virtual memory mapping + * interface (vm.h) for Linux. It was created by copying vmo1.c (the + * DIGITAL UNIX implementation) as that seemed to be closest. + * + * .design: See design.mps.vm. .design.linux: mmap(2) is used to + * reserve address space by creating a mapping with page access none. + * mmap(2) is used to map pages onto store by creating a copy-on-write + * (MAP_PRIVATE) mapping with the flag MAP_ANONYMOUS. + * + * .assume.not-last: The implementation of VMCreate assumes that + * mmap() will not choose a region which contains the last page + * in the address space, so that the limit of the mapped area + * is representable. + * + * .assume.mmap.err: ENOMEM is the only error we really expect to + * get from mmap. The others are either caused by invalid params + * or features we don't use. See mmap(2) for details. + * + * .assume.off_t: We assume that the Size type (defined by the MM) fits + * in the off_t type (define by the system (POSIX?)). In fact we test + * the more stringent requirement that they are the same size. This + * assumption is made in VMUnmap. + * + * .remap: Possibly this should use mremap to reduce the number of + * distinct mappings. According to our current testing, it doesn't + * seem to be a problem. + */ + +/* Use all extensions */ +#define _GNU_SOURCE 1 + +/* for open(2) */ +#include +#include +#include + +/* for mmap(2), munmap(2) */ +#include + +/* for errno(2) */ +#include + +/* for sysconf(2), close(2) */ +#include + +#include "mpm.h" + + +#ifndef MPS_OS_LI +#error "vmli.c is LINUX specific, but MPS_OS_LI is not set" +#endif + +SRCID(vmli, "$HopeName: MMsrc!vmli.c(trunk.7) $"); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +/* VMAlign -- return page size */ + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +/* VMCheck -- check a VM */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + Align align; + VM vm; + long pagesize; + void *addr; + Res res; + + AVER(vmReturn != NULL); + + /* sysconf code copied wholesale from vmso.c */ + /* Find out the page size from the OS */ + pagesize = sysconf(_SC_PAGESIZE); + /* check the actual returned pagesize will fit in an object of */ + /* type Align. */ + AVER(pagesize > 0); + AVER((unsigned long)pagesize <= (unsigned long)(Align)-1); + /* Note implicit conversion from "long" to "Align". */ + align = pagesize; + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if((size == 0) || (size > (Size)(size_t)-1)) + return ResRESOURCE; + + /* Map in a page to store the descriptor on. */ + addr = mmap(0, (size_t)SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, + MAP_ANONYMOUS | MAP_PRIVATE, + -1, 0); + if(addr == MAP_FAILED) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + return ResMEMORY; + } + vm = (VM)addr; + + vm->align = align; + + /* See .assume.not-last. */ + addr = mmap(0, (size_t)size, + PROT_NONE, MAP_ANONYMOUS | MAP_PRIVATE, + -1, 0); + if(addr == MAP_FAILED) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + res = ResRESOURCE; + goto failReserve; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + + *vmReturn = vm; + return ResOK; + +failReserve: + (void)munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align)); + return res; +} + + +/* VMDestroy -- release all address space and destroy VM structure */ + +void VMDestroy(VM vm) +{ + int r; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + r = munmap((void *)vm->base, (size_t)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((void *)vm, + (size_t)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); + + EVENT_P(VMDestroy, vm); +} + + +/* VMBase -- return the base address of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + + return vm->base; +} + + +/* VMLimit -- return the limit address of the memory reserved */ + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + + return vm->limit; +} + + +/* VMReserved -- return the amount of memory reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + + return vm->reserved; +} + + +/* VMMapped -- return the amount of memory actually mapped */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + + return vm->mapped; +} + + +/* VMMap -- map the given range of memory */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVERT(VM, vm); + AVER(sizeof(void *) == sizeof(Addr)); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + size = AddrOffset(base, limit); + + if(mmap((void *)base, (size_t)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, + -1, 0) + == MAP_FAILED) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + return ResMEMORY; + } + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- unmap the given range of memory */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + void *addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + AVER(sizeof(off_t) == sizeof(Size)); /* .assume.off_t */ + + size = AddrOffset(base, limit); + + /* see design.mps.vmo1.fun.unmap.offset */ + addr = mmap((void *)base, (size_t)size, + PROT_NONE, MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, + -1, 0); + AVER(addr == (void *)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmo1.c b/mps/code/vmo1.c new file mode 100644 index 00000000000..84c2e08e6da --- /dev/null +++ b/mps/code/vmo1.c @@ -0,0 +1,297 @@ +/* impl.c.vmo1: VIRTUAL MEMORY MAPPING FOR DIGITAL UNIX + * + * $HopeName: MMsrc!vmo1.c(trunk.9) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .design: design.mps.vm, design.mps.vmo1 + * + * .status: A bit hacky, but probably working. + * + * .assume.mmap.err: ENOMEM is the only error we really expect to + * get from mmap. The others are either caused by invalid params + * or features we don't use. See mmap(2) for details. + * + * .assume.off_t: We assume that the Size type (defined by the MM) fits + * in the off_t type (define by the system (POSIX?)). In fact we test + * the more stringent requirement that they are the same size. This + * assumption is made in VMUnmap. + */ + +#include "mpm.h" + +#ifndef MPS_OS_O1 +#error "vmo1.c is DEC UNIX / OSF1 specific, but MPS_OS_O1 is not set" +#endif + +/* open sesame magic, see standards(5) */ +#define _POSIX_C_SOURCE 199309L +#define _XOPEN_SOURCE_EXTENDED 1 + +/* for open(2) */ +#include +#include +#include + +/* for mmap(2),munmap(2) */ +#include + +/* for errno(2) */ +#include + +/* for getpagesize(2),close(2) */ +#include + +SRCID(vmo1, "$HopeName: MMsrc!vmo1.c(trunk.9) $"); + + +/* Fix unprototyped system calls + * + * For some bizarre reason DEC go out of their way to not prototype + * these calls when using gcc. See /usr/include/standards.h and + * /usr/include/unistd.h for the very gory details. + */ +#ifdef MPS_BUILD_GC +extern int close(int); +extern int getpagesize(void); +#endif + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ + int none_fd; /* fildes for reserved memory */ +} VMStruct; + + +/* VMAlign -- return the page size */ + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +/* VMCheck -- check a VM structure */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->none_fd >= 0); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + void *addr; + Align align; + int none_fd; + VM vm; + Res res; + + AVER(vmReturn != NULL); + + align = (Align)getpagesize(); + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if ((size == 0) || (size > (Size)(size_t)-1)) + return ResRESOURCE; + + none_fd = open("/etc/passwd", O_RDONLY); + if (none_fd == -1) { + return ResFAIL; + } + + /* Map in a page to store the descriptor on. */ + addr = mmap(0, (size_t)SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, + MAP_ANONYMOUS | MAP_PRIVATE | MAP_VARIABLE, + -1, 0); + if (addr == (void *)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + res = (e == ENOMEM) ? ResMEMORY : ResFAIL; + goto failVMMap; + } + vm = (VM)addr; + + vm->none_fd = none_fd; + vm->align = align; + + /* See .assume.not-last. */ + addr = mmap(0, (size_t)size, + PROT_NONE, MAP_FILE | MAP_SHARED | MAP_VARIABLE, + none_fd, 0); + if (addr == (void *)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + res = (e == ENOMEM) ? ResRESOURCE : ResFAIL; + goto failReserve; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + AVERT(VM, vm); + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + *vmReturn = vm; + return ResOK; + +failReserve: + (void)munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align)); +failVMMap: + (void)close(none_fd); /* see .close.fail */ + return res; +} + + +/* VMDestroy -- destroy the VM structure */ + +void VMDestroy(VM vm) +{ + int r; + int none_fd; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the space descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + none_fd = vm->none_fd; + r = munmap((void *)vm->base, (size_t)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); + /* .close.fail: We ignore failure from close() as there's very */ + /* little we can do anyway. */ + (void)close(none_fd); + + EVENT_P(VMDestroy, vm); +} + + +/* VMBase -- return the base address of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + + return vm->base; +} + + +/* VMLimit -- return the limit address of the memory reserved */ + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + + return vm->limit; +} + + +/* VMReserved -- return the amount of address space reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + + return vm->reserved; +} + + +/* VMMapped -- return the amount of memory actually mapped */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + + return vm->mapped; +} + + +/* VMMap -- map the given range of memory */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVERT(VM, vm); + AVER(sizeof(void *) == sizeof(Addr)); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + size = AddrOffset(base, limit); + + if (mmap((void *)base, (size_t)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_ANONYMOUS | MAP_PRIVATE | MAP_FIXED, + -1, 0) + == (void *)-1) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + return ResMEMORY; + } + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- unmap the given range of memory + * + * See design.mps.vmo1.fun.unmap. + */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + void *addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + AVER(sizeof(off_t) == sizeof(Size)); /* .assume.off_t */ + + size = AddrOffset(base, limit); + + /* see design.mps.vmo1.fun.unmap.offset */ + addr = mmap((void *)base, (size_t)size, + PROT_NONE, MAP_FILE | MAP_SHARED | MAP_FIXED, + vm->none_fd, (off_t)AddrOffset(vm->base, base)); + AVER(addr == (void *)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmso.c b/mps/code/vmso.c new file mode 100644 index 00000000000..4bc1122721c --- /dev/null +++ b/mps/code/vmso.c @@ -0,0 +1,306 @@ +/* impl.c.vmso: VIRTUAL MEMORY MAPPING FOR SOLARIS 2.x + * + * $HopeName: MMsrc!vmso.c(trunk.14) $ + * Copyright (C) 1998 Harlequin Group plc. All rights reserved. + * + * DESIGN + * + * .design: design.mps.vmso + * + * PURPOSE + * + * .purpose: This is the implementation of the virtual memory mapping + * interface (vm.h) for Solaris 2.x. It allows arenas (typically + * arenavm is the only client of the interface) to reserve virtual + * address space and to map ranges with RAM and unmap memory. + * + * ASSUMPTIONS + * + * .assume.not-last: The implementation of VMCreate assumes that mmap() + * will not choose a region which contains the last page in the address + * space, so that the limit of the mapped area is representable. + * (VMCheck checks limit != 0 which is a roundabout way of checking + * this.) + * + * .assume.mmap.err: EAGAIN is the only error we really expect to get + * from mmap when committing and ENOMEM when reserving. The others are + * either caused by invalid params or features we don't use. See + * mmap(2) for details. + * + * TRANSGRESSIONS + * + * .fildes.name: VMStruct has two fields whose names violate our naming + * conventions. They are called none_fd and zero_fd to emphasize that + * they are file descriptors and this fact is not reflected in their + * type (we can't change their type as that is restricted by the + * interface provided by Solaris). + */ + +#include "mpm.h" + +#ifndef MPS_OS_SO +#error "vmso.c is Solaris 2.x specific, but MPS_OS_SO is not set" +#endif + +/* Open sesame magic */ +#define _POSIX_SOURCE + +#include +#include +#include +#include +#include +/* unistd for _SC_PAGESIZE */ +#include + +SRCID(vmso, "$HopeName: MMsrc!vmso.c(trunk.14) $"); + + +/* Fix up unprototyped system calls. */ + +extern int close(int fd); +extern int munmap(caddr_t addr, size_t len); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +/* The names of zero_fd and none_fd are transgressions, see .fildes.name */ +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + int zero_fd; /* fildes for mmap */ + int none_fd; /* fildes for mmap */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->zero_fd >= 0); + CHECKL(vm->none_fd >= 0); + CHECKL(vm->zero_fd != vm->none_fd); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +Res VMCreate(VM *vmReturn, Size size) +{ + caddr_t addr; + Align align; + int zero_fd; + int none_fd; + VM vm; + long pagesize; + Res res; + + AVER(vmReturn != NULL); + + /* Find out the page size from the OS */ + pagesize = sysconf(_SC_PAGESIZE); + /* check the actual returned pagesize will fit in an object of */ + /* type Align. */ + AVER(pagesize > 0); + AVER((unsigned long)pagesize <= (unsigned long)(Align)-1); + /* Note implicit conversion from "long" to "Align". */ + align = pagesize; + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if((size == 0) || (size > (Size)(size_t)-1)) + return ResRESOURCE; + + zero_fd = open("/dev/zero", O_RDONLY); + if(zero_fd == -1) + return ResFAIL; + none_fd = open("/etc/passwd", O_RDONLY); + if(none_fd == -1) { + res = ResFAIL; + goto failNoneOpen; + } + + /* Map in a page to store the descriptor on. */ + addr = mmap((caddr_t)0, (size_t)SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, MAP_PRIVATE, + zero_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == EAGAIN); /* .assume.mmap.err */ + res = ResMEMORY; + goto failVMMap; + } + vm = (VM)addr; + + vm->zero_fd = zero_fd; + vm->none_fd = none_fd; + vm->align = align; + + /* .map.reserve: See .assume.not-last. */ + addr = mmap((caddr_t)0, (size_t)size, PROT_NONE, MAP_SHARED, + none_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + res = (errno == ENOMEM) ? ResRESOURCE : ResFAIL; + goto failReserve; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + + *vmReturn = vm; + return ResOK; + +failReserve: + (void)munmap((caddr_t)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align)); +failVMMap: + (void)close(none_fd); /* see .close.fail */ +failNoneOpen: + (void)close(zero_fd); + return res; +} + + +void VMDestroy(VM vm) +{ + int r; + int zero_fd, none_fd; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + zero_fd = vm->zero_fd; none_fd = vm->none_fd; + r = munmap((caddr_t)vm->base, (size_t)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((caddr_t)vm, + (size_t)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); + /* .close.fail: We ignore failure from close() as there's very */ + /* little we can do anyway. */ + (void)close(zero_fd); + (void)close(none_fd); + + EVENT_P(VMDestroy, vm); +} + + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + return vm->base; +} + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + return vm->limit; +} + + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + return vm->reserved; +} + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + return vm->mapped; +} + + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + caddr_t addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* Map /dev/zero onto the area with a copy-on-write policy. This */ + /* effectively populates the area with zeroed memory. */ + + size = AddrOffset(base, limit); + /* Check it won't lose any bits. */ + AVER(size <= (Size)(size_t)-1); + + addr = mmap((caddr_t)base, (size_t)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_PRIVATE | MAP_FIXED, + vm->zero_fd, (off_t)0); + if(addr == MAP_FAILED) { + AVER(errno == EAGAIN); /* .assume.mmap.err */ + return ResMEMORY; + } + AVER(addr == (caddr_t)base); + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + caddr_t addr; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* Map /etc/passwd onto the area, allowing no access. This */ + /* effectively depopulates the area from memory, but keeps */ + /* it "busy" as far as the OS is concerned, so that it will not */ + /* be re-used by other calls to mmap which do not specify */ + /* MAP_FIXED. The offset is specified to mmap so that */ + /* the OS merges this mapping with .map.reserve. */ + size = AddrOffset(base, limit); + /* Check it won't lose any bits. */ + AVER(size <= (Size)(size_t)-1); + addr = mmap((caddr_t)base, (size_t)size, + PROT_NONE, MAP_SHARED | MAP_FIXED, + vm->none_fd, (off_t)AddrOffset(vm->base, base)); + AVER(addr == (caddr_t)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmsu.c b/mps/code/vmsu.c new file mode 100644 index 00000000000..50ab350b3c8 --- /dev/null +++ b/mps/code/vmsu.c @@ -0,0 +1,313 @@ +/* impl.c.vmsu: VIRTUAL MEMORY MAPPING FOR SUNOS 4 + * + * $HopeName: MMsrc!vmsu.c(trunk.20) $ + * Copyright (C) 1998 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.vm for general design. + * + * mmap(2) is used to reserve address space by creating a mapping to + * /etc/passwd with page access none. mmap(2) is used to map pages + * onto store by creating a copy-on-write mapping to /dev/zero. + * + * Experiments have shown that attempting to reserve address space + * by mapping /dev/zero results in swap being reserved. This + * appears to be a bug, so we work round it by using /etc/passwd, + * the only file we can think of which is pretty much guaranteed + * to be around. + * + * .assume.not-last: The implementation of VMCreate assumes that + * mmap() will not choose a region which contains the last page + * in the address space, so that the limit of the mapped area + * is representable. + * + * .assume.size: The maximum size of the reserved address space is + * limited by the range of "int" (because doc of munmap(2) says so). + * This will probably be half of the address space. + * + * .assume.mmap.err: ENOMEM is the only error we really expect to + * get from mmap. The others are either caused by invalid params + * or features we don't use. See mmap(2) for details. + * + * TRANSGRESSIONS + * + * .fildes.name: VMStruct has two fields whose names violate our + * naming conventions. They are called none_fd and zero_fd to + * emphasize that they are file descriptors and this fact is not + * reflected in their type. + */ + +#include "mpm.h" + +#ifndef MPS_OS_SU +#error "vmsu.c is SunOS 4 specific, but MPS_OS_SU is not set" +#endif + +#include +#include +#include +#include +#include +#include + +SRCID(vmsu, "$HopeName: MMsrc!vmsu.c(trunk.20) $"); + + +/* Fix up unprototyped system calls. */ + +extern int close(int fd); +extern int munmap(caddr_t addr, int len); +extern int getpagesize(void); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +/* The names of zero_fd and none_fd are transgressions, see .fildes.name */ +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + int zero_fd; /* fildes for mmap, see impl.c.vms{o,u} */ + int none_fd; /* fildes for mmap, see impl.c.vms{o,u} */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +/* VMAlign -- return the page size */ + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +/* VMCheck -- check a VM structure */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->zero_fd >= 0); + CHECKL(vm->none_fd >= 0); + CHECKL(vm->zero_fd != vm->none_fd); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + caddr_t addr; + Align align; + int zero_fd; + int none_fd; + VM vm; + Res res; + + AVER(vmReturn != NULL); + + align = (Align)getpagesize(); + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if ((size == 0) || (size > (Size)INT_MAX)) /* see .assume.size */ + return ResRESOURCE; + + zero_fd = open("/dev/zero", O_RDONLY); + if (zero_fd == -1) + return ResFAIL; + none_fd = open("/etc/passwd", O_RDONLY); + if (none_fd == -1) { + res = ResFAIL; + goto failNoneOpen; + } + + /* Map in a page to store the descriptor on. */ + addr = mmap((caddr_t)0, SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, MAP_PRIVATE, + zero_fd, (off_t)0); + if (addr == (caddr_t)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + res = (e == ENOMEM) ? ResMEMORY : ResFAIL; + goto failVMMap; + } + vm = (VM)addr; + + vm->zero_fd = zero_fd; + vm->none_fd = none_fd; + vm->align = align; + + /* .map.reserve: See .assume.not-last. */ + addr = mmap((caddr_t)0, size, PROT_NONE, MAP_SHARED, none_fd, + (off_t)0); + if (addr == (caddr_t)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + res = (e == ENOMEM) ? ResRESOURCE : ResFAIL; + goto failReserve; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + + *vmReturn = vm; + return ResOK; + +failReserve: + (void)munmap((caddr_t)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align)); +failVMMap: + (void)close(none_fd); /* see .close.fail */ +failNoneOpen: + (void)close(zero_fd); + return res; +} + + +/* VMDestroy -- destroy the VM structure and release the address space */ + +void VMDestroy(VM vm) +{ + int r; + int zero_fd, none_fd; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the space descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + zero_fd = vm->zero_fd; none_fd = vm->none_fd; + r = munmap((caddr_t)vm->base, (int)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((caddr_t)vm, + (int)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); + /* .close.fail: We ignore failure from close() as there's very */ + /* little we can do anyway. */ + (void)close(zero_fd); + (void)close(none_fd); + + EVENT_P(VMDestroy, vm); +} + + +/* VMBase, VMLimit -- return the base & limit of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + return vm->base; +} + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + return vm->limit; +} + + +/* VMReserved -- return the amount of the memory reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + return vm->reserved; +} + + +/* VMMapped -- return the amount of the memory committed */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + return vm->mapped; +} + + +/* VMMap -- commit memory between base & limit */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVERT(VM, vm); + AVER(sizeof(int) == sizeof(Addr)); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrOffset(base, limit) <= INT_MAX); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* Map /dev/zero onto the area with a copy-on-write policy. This */ + /* effectively populates the area with zeroed memory. */ + + size = AddrOffset(base, limit); + + if (mmap((caddr_t)base, (int)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_PRIVATE | MAP_FIXED, + vm->zero_fd, (off_t)0) + == (caddr_t)-1) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + return ResMEMORY; + } + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- decommit memory between base & limit */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + caddr_t addr; + + AVERT(VM, vm); + AVER(sizeof(int) == sizeof(Addr)); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* Map /etc/passwd onto the area, allowing no access. This */ + /* effectively depopulates the area from memory, but keeps */ + /* it "busy" as far as the OS is concerned, so that it will not */ + /* be re-used by other calls to mmap which do not specify */ + /* MAP_FIXED. The offset is specified to mmap so that */ + /* the OS merges this mapping with .map.reserve. */ + size = AddrOffset(base, limit); + addr = mmap((caddr_t)base, (int)size, + PROT_NONE, MAP_SHARED | MAP_FIXED, + vm->none_fd, (off_t)AddrOffset(vm->base, base)); + AVER(addr == (caddr_t)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmw3.c b/mps/code/vmw3.c new file mode 100644 index 00000000000..e57cee185c1 --- /dev/null +++ b/mps/code/vmw3.c @@ -0,0 +1,274 @@ +/* impl.c.vmw3: VIRTUAL MEMORY MAPPING FOR WIN32 + * + * $HopeName: MMsrc!vmw3.c(trunk.34) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .design: See design.mps.vm. + * + * .purpose: This is the implementation of the virtual memory mapping + * interface (vm.h) for Win32s. + * + * The documentation for Win32 used is the "Win32 Programmer's Reference" + * provided with Microsoft Visual C++ 2.0. + * + * VirtualAlloc is used to reserve address space and to "commit" (map) + * address ranges onto storage. VirtualFree is used to release and + * "decommit" (unmap) pages. These functions are documented in the + * Win32 SDK help, under System Services/Memory Management. + * + * .assume.free.success: We assume that VirtualFree will never return + * an error; this is because we always pass in legal parameters + * (hopefully). + * + * .assume.not-last: We assume that VirtualAlloc will never return + * a block of memory that occupies the last page in memory, so + * that limit is representable and bigger than base. + * + * .assume.dword-addr: We assume that the windows type DWORD and + * the MM type Addr are the same size. + * + * .assume.dword-align: We assume that the windows type DWORD and + * the MM type Align are assignment-compatible. + * + * .assume.lpvoid-addr: We assume that the windows type LPVOID and + * the MM type Addr are assignment-compatible. + * + * .assume.sysalign: We assume that the page size on the system + * is a power of two. + * + * Notes + * 1. GetSystemInfo returns a thing called szAllocationGranularity + * the purpose of which is unclear but which might affect the + * reservation of address space. Experimentally, it does not. + * Microsoft's documentation is extremely unclear on this point. + * richard 1995-02-15 + */ + +#include "mpm.h" + +#ifndef MPS_OS_W3 +#error "vmw3.c is Win32 specific, but MPS_OS_W3 is not set" +#endif +#ifdef VM_RM +#error "vmw3.c compiled with VM_RM set" +#endif + +#include "mpswin.h" + +SRCID(vmw3, "$HopeName: MMsrc!vmw3.c(trunk.34) $"); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +/* VMAlign -- return the page size */ + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +/* VMCheck -- check a VM structure */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + LPVOID vbase; + SYSTEM_INFO si; + Align align; + VM vm; + Res res; + BOOL b; + + AVER(vmReturn != NULL); + + AVER(CHECKTYPE(LPVOID, Addr)); /* .assume.lpvoid-addr */ + AVER(sizeof(DWORD) == sizeof(Addr)); /* See .assume.dword-addr */ + AVER(CHECKTYPE(DWORD, Align)); /* See .assume.dword-align */ + + GetSystemInfo(&si); + align = (Align)si.dwPageSize; + AVER(SizeIsP2(align)); /* see .assume.sysalign */ + size = SizeAlignUp(size, align); + if ((size == 0) || (size > (Size)(DWORD)-1)) + return ResRESOURCE; + + /* Allocate the vm descriptor. This is likely to be wasteful. */ + vbase = VirtualAlloc(NULL, SizeAlignUp(sizeof(VMStruct), align), + MEM_COMMIT, PAGE_READWRITE); + if (vbase == NULL) + return ResMEMORY; + vm = (VM)vbase; + + /* Allocate the address space. */ + vbase = VirtualAlloc(NULL, size, MEM_RESERVE, PAGE_NOACCESS); + if (vbase == NULL) { + res = ResRESOURCE; + goto failReserve; + } + + AVER(AddrIsAligned(vbase, align)); + + vm->align = align; + vm->base = (Addr)vbase; + vm->limit = AddrAdd(vbase, size); + vm->reserved = size; + vm->mapped = 0; + AVER(vm->base < vm->limit); /* .assume.not-last */ + + vm->sig = VMSig; + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + *vmReturn = vm; + return ResOK; + +failReserve: + b = VirtualFree((LPVOID)vm, (DWORD)0, MEM_RELEASE); + AVER(b != 0); + return res; +} + + +/* VMDestroy -- destroy the VM structure */ + +void VMDestroy(VM vm) +{ + BOOL b; + + AVERT(VM, vm); + AVER(vm->mapped == 0); + + /* This appears to be pretty pointless, since the vm descriptor page + * is about to vanish completely. However, the VirtualFree might + * fail and it would be nice to have a dead sig there. */ + vm->sig = SigInvalid; + + b = VirtualFree((LPVOID)vm->base, (DWORD)0, MEM_RELEASE); + AVER(b != 0); + + b = VirtualFree((LPVOID)vm, (DWORD)0, MEM_RELEASE); + AVER(b != 0); + EVENT_P(VMDestroy, vm); +} + + +/* VMBase -- return the base address of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + + return vm->base; +} + + +/* VMLimit -- return the limit address of the memory reserved */ + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + + return vm->limit; +} + + +/* VMReserved -- return the amount of address space reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + + return vm->reserved; +} + + +/* VMMapped -- return the amount of memory actually mapped */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + + return vm->mapped; +} + + +/* VMMap -- map the given range of memory */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + LPVOID b; + Align align; + + AVERT(VM, vm); + align = vm->align; + AVER(AddrIsAligned(base, align)); + AVER(AddrIsAligned(limit, align)); + AVER(vm->base <= base); + AVER(base < limit); + AVER(limit <= vm->limit); + + /* .improve.query-map: We could check that the pages we are about to + * map are unmapped using VirtualQuery. */ + + b = VirtualAlloc((LPVOID)base, (DWORD)AddrOffset(base, limit), + MEM_COMMIT, PAGE_EXECUTE_READWRITE); + if (b == NULL) + return ResMEMORY; + AVER((Addr)b == base); /* base should've been aligned */ + + vm->mapped += AddrOffset(base, limit); + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- unmap the given range of memory */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Align align; + BOOL b; + + AVERT(VM, vm); + align = vm->align; + AVER(AddrIsAligned(base, align)); + AVER(AddrIsAligned(limit, align)); + AVER(vm->base <= base); + AVER(base < limit); + AVER(limit <= vm->limit); + + /* .improve.query-unmap: Could check that the pages we are about */ + /* to unmap are mapped, using VirtualQuery. */ + b = VirtualFree((LPVOID)base, (DWORD)AddrOffset(base, limit), MEM_DECOMMIT); + AVER(b != 0); /* .assume.free.success */ + vm->mapped -= AddrOffset(base, limit); + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/vmxc.c b/mps/code/vmxc.c new file mode 100644 index 00000000000..26070589a57 --- /dev/null +++ b/mps/code/vmxc.c @@ -0,0 +1,257 @@ +/* impl.c.vmxc: VIRTUAL MEMORY MAPPING FOR MacOS X + * + * $HopeName: MMsrc!vmxc.c(trunk.2) $ + * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * + * .design: design.mps.vm + * + * .details: mmap(2) is used to reserve address space by creating a + * mapping to the swap with page access none. mmap(2) is used to map + * pages onto store by creating a copy-on-write mapping to swap. + * + * .assume.not-last: The implementation of VMCreate assumes that mmap() + * will not choose a region which contains the last page in the address + * space, so that the limit of the mapped area is representable. + * + * .assume.mmap.err: ENOMEM is the only error we really expect to get + * from mmap. The others are either caused by invalid params or + * features we don't use. See mmap(2) for details. + * + * .overcommit: Apparently, MacOS X will overcommit, instead of + * returning ENOMEM from mmap. There appears to be no way to tell + * whether the process is running out of swap and no way to reserve the + * swap, apart from actually touching every page. + */ + +#include "mpm.h" + +#ifndef MPS_OS_XC +#error "vmxc.c is MacOS X specific, but MPS_OS_XC is not set" +#endif +#ifdef VM_RM +#error "vmxc.c compiled with VM_RM set" +#endif /* VM_RM */ + +#include +#include +#include +#include +#include /* for INT_MAX */ + +SRCID(vmxc, "$HopeName: MMsrc!vmxc.c(trunk.2) $"); + + +/* VMStruct -- virtual memory structure */ + +#define VMSig ((Sig)0x519B3999) /* SIGnature VM */ + +typedef struct VMStruct { + Sig sig; /* design.mps.sig */ + Align align; /* page size */ + Addr base, limit; /* boundaries of reserved space */ + Size reserved; /* total reserved address space */ + Size mapped; /* total mapped memory */ +} VMStruct; + + +/* VMAlign -- return the page size */ + +Align VMAlign(VM vm) +{ + return vm->align; +} + + +/* VMCheck -- check a VM structure */ + +Bool VMCheck(VM vm) +{ + CHECKS(VM, vm); + CHECKL(vm->base != 0); + CHECKL(vm->limit != 0); + CHECKL(vm->base < vm->limit); + CHECKL(vm->mapped <= vm->reserved); + CHECKL(SizeIsP2(vm->align)); + CHECKL(AddrIsAligned(vm->base, vm->align)); + CHECKL(AddrIsAligned(vm->limit, vm->align)); + return TRUE; +} + + +/* VMCreate -- reserve some virtual address space, and create a VM structure */ + +Res VMCreate(VM *vmReturn, Size size) +{ + caddr_t addr; + Align align; + VM vm; + + AVER(vmReturn != NULL); + + align = (Align)getpagesize(); + AVER(SizeIsP2(align)); + size = SizeAlignUp(size, align); + if(size == 0) + return ResRESOURCE; + + /* Map in a page to store the descriptor on. */ + AVER(sizeof(caddr_t) == sizeof(Addr)); /* verify address spaces match */ + addr = mmap((caddr_t)0, SizeAlignUp(sizeof(VMStruct), align), + PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, (off_t)0); + if(addr == (caddr_t)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + if(e == ENOMEM) + return ResMEMORY; + else + return ResFAIL; + } + vm = (VM)addr; + + vm->align = align; + + addr = mmap((caddr_t)0, size, PROT_NONE, MAP_SHARED | MAP_ANON, -1, (off_t)0); + if(addr == (caddr_t)-1) { + int e = errno; + AVER(e == ENOMEM); /* .assume.mmap.err */ + if(e == ENOMEM) + return ResRESOURCE; + else + return ResFAIL; + } + + vm->base = (Addr)addr; + vm->limit = AddrAdd(vm->base, size); /* .assume.not-last. */ + vm->reserved = size; + vm->mapped = (Size)0; + + vm->sig = VMSig; + + AVERT(VM, vm); + + EVENT_PAA(VMCreate, vm, vm->base, vm->limit); + + *vmReturn = vm; + return ResOK; +} + + +/* VMDestroy -- destroy the VM structure and release the address space */ + +void VMDestroy(VM vm) +{ + int r; + + AVERT(VM, vm); + AVER(vm->mapped == (Size)0); + + /* This appears to be pretty pointless, since the space descriptor */ + /* page is about to vanish completely. However, munmap might fail */ + /* for some reason, and this would ensure that it was still */ + /* discovered if sigs were being checked. */ + vm->sig = SigInvalid; + + r = munmap((caddr_t)vm->base, (int)AddrOffset(vm->base, vm->limit)); + AVER(r == 0); + r = munmap((caddr_t)vm, + (int)SizeAlignUp(sizeof(VMStruct), vm->align)); + AVER(r == 0); +} + + +/* VMBase, VMLimit -- return the base & limit of the memory reserved */ + +Addr VMBase(VM vm) +{ + AVERT(VM, vm); + return vm->base; +} + +Addr VMLimit(VM vm) +{ + AVERT(VM, vm); + return vm->limit; +} + + +/* VMReserved -- return the amount of the memory reserved */ + +Size VMReserved(VM vm) +{ + AVERT(VM, vm); + return vm->reserved; +} + + +/* VMMapped -- return the amount of the memory committed */ + +Size VMMapped(VM vm) +{ + AVERT(VM, vm); + return vm->mapped; +} + + +/* VMMap -- commit memory between base & limit */ + +Res VMMap(VM vm, Addr base, Addr limit) +{ + Size size; + + AVERT(VM, vm); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrOffset(base, limit) <= INT_MAX); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + size = AddrOffset(base, limit); + + if(mmap((caddr_t)base, (int)size, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_PRIVATE | MAP_FIXED | MAP_ANON, + -1, (off_t)0) + == (caddr_t)-1) { + AVER(errno == ENOMEM); /* .assume.mmap.err */ + return ResMEMORY; + } + + vm->mapped += size; + + EVENT_PAA(VMMap, vm, base, limit); + return ResOK; +} + + +/* VMUnmap -- decommit memory between base & limit */ + +void VMUnmap(VM vm, Addr base, Addr limit) +{ + Size size; + caddr_t addr; + + AVERT(VM, vm); + AVER(sizeof(int) == sizeof(Addr)); + AVER(base < limit); + AVER(base >= vm->base); + AVER(limit <= vm->limit); + AVER(AddrIsAligned(base, vm->align)); + AVER(AddrIsAligned(limit, vm->align)); + + /* .unmap: Map with MAP_ANON, allowing no access. This */ + /* effectively depopulates the area from memory, but keeps */ + /* it "busy" as far as the OS is concerned, so that it will not */ + /* be re-used by other calls to mmap which do not specify */ + /* MAP_FIXED. The offset is specified to mmap so that */ + /* the OS can merge this mapping with .map.reserve. */ + size = AddrOffset(base, limit); + addr = mmap((caddr_t)base, (int)size, + PROT_NONE, MAP_SHARED | MAP_FIXED | MAP_ANON, + -1, (off_t)AddrOffset(vm->base, base)); + AVER(addr == (caddr_t)base); + + vm->mapped -= size; + + EVENT_PAA(VMUnmap, vm, base, limit); +} diff --git a/mps/code/w3almv.nmk b/mps/code/w3almv.nmk new file mode 100644 index 00000000000..93bf29d665f --- /dev/null +++ b/mps/code/w3almv.nmk @@ -0,0 +1,292 @@ +# impl.nmk.w3almv: WINDOWS (ALPHA) NMAKE FILE +# +# $HopeName: MMsrc!w3almv.nmk(trunk.42) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = w3almv + +RAINBOWPATH = MSVISUAL\WIN32\ALPHA +DONGLELIB = $(RAINBOWPATH)\spromeps.lib + +PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH) + +MPM = \ + \ + \ + \ + \ + \ + \ + \ + \ + \ + +SW = \ + \ + \ + \ + \ + \ + \ + \ + +PLINTH = +AMC = +AMS = +AWL = +LO = +DW = +DWTEST = +POOLN = +TESTLIB = + + +!INCLUDE commpre.nmk + + +# Source to object file mappings +# and CFLAGS amalgamation +# %%VARIETY %%PART: Add new macros which expand to the files included +# in the part for each variety +# %%VARIETY: Add a CFLAGS macro which expands to the flags that that variety +# should use when compiling C. And a LINKFLAGS macro which expands to the +# flags that the variety should use when building executables. And a LIBFLAGS +# macro which expands to the flags that the variety should use when builing +# libraries + +!IF "$(VARIETY)" == "he" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHE) +MPMOBJ0 = $(MPM:<=w3almv\he\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\he\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\he\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\he\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\he\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\he\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\he\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\he\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\he\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\he\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\he\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\he\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ce" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCE) +MPMOBJ0 = $(MPM:<=w3almv\ce\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\ce\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\ce\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\ce\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\ce\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\ce\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\ce\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\ce\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\ce\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\ce\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\ce\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\ce\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "hi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHI) +MPMOBJ0 = $(MPM:<=w3almv\hi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\hi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\hi\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\hi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\hi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\hi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\hi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\hi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\hi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\hi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\hi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\hi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ci" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCI) +MPMOBJ0 = $(MPM:<=w3almv\ci\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\ci\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\ci\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\ci\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\ci\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\ci\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\ci\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\ci\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\ci\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\ci\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\ci\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\ci\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ti" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFTI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFTI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSTI) +MPMOBJ0 = $(MPM:<=w3almv\ti\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\ti\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\ti\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\ti\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\ti\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\ti\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\ti\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\ti\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\ti\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\ti\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\ti\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\ti\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "wi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWI) +MPMOBJ0 = $(MPM:<=w3almv\wi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\wi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\wi\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\wi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\wi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\wi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\wi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\wi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\wi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\wi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\wi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\wi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "we" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWE) +MPMOBJ0 = $(MPM:<=w3almv\we\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3almv\we\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3almv\we\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3almv\we\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3almv\we\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3almv\we\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3almv\we\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3almv\we\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3almv\we\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3almv\we\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3almv\we\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3almv\we\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +#!ELSEIF "$(VARIETY)" == "cv" +#CFLAGS=$(CFLAGSCOMMON) $(CFCV) +#LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCV) +#LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCV) +#MPMOBJ0 = $(MPM:<=w3almv\cv\) +#MPMOBJ = $(MPMOBJ0:>=.obj) +#PLINTHOBJ0 = $(PLINTH:<=w3almv\cv\) +#PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +#SWOBJ0 = $(SW:<=w3almv\cv\) +#SWOBJ = $(SWOBJ0:>=.obj) +#AMSOBJ0 = $(AMS:<=w3almv\cv\) +#AMSOBJ = $(AMSOBJ0:>=.obj) +#AMCOBJ0 = $(AMC:<=w3almv\cv\) +#AMCOBJ = $(AMCOBJ0:>=.obj) +#AWLOBJ0 = $(AWL:<=w3almv\cv\) +#AWLOBJ = $(AWLOBJ0:>=.obj) +#LOOBJ0 = $(LO:<=w3almv\cv\) +#LOOBJ = $(LOOBJ0:>=.obj) +#SNCOBJ0 = $(SNC:<=w3almv\cv\) +#SNCOBJ = $(SNCOBJ0:>=.obj) +#MRGOBJ0 = $(MRG:<=w3almv\cv\) +#MRGOBJ = $(MRGOBJ0:>=.obj) +#DWOBJ0 = $(DW:<=w3almv\cv\) +#DWOBJ = $(DWOBJ0:>=.obj) +#POOLNOBJ0 = $(POOLN:<=w3almv\cv\) +#POOLNOBJ = $(POOLNOBJ0:>=.obj) +#TESTLIBOBJ0 = $(TESTLIB:<=w3almv\cv\) +#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ENDIF + + +!INCLUDE commpost.nmk diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk new file mode 100644 index 00000000000..d4a812c576d --- /dev/null +++ b/mps/code/w3i3mv.nmk @@ -0,0 +1,307 @@ +# impl.nmk.w3i3mv: WINDOWS (INTEL) NMAKE FILE +# +# $HopeName: MMsrc!w3i3mv.nmk(trunk.71) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = w3i3mv + +RAINBOWPATH = MSVISUAL\WIN32\I386 +DONGLELIB = $(RAINBOWPATH)\spromeps.lib + +PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH) + +MPM = \ + \ + \ + \ + \ + \ + \ + +SW = \ + \ + \ + \ + \ + \ + \ + \ + +CONFIGURA = \ + \ + \ + \ + \ + \ + \ + +PLINTH = +AMC = +AMS = +AWL = +LO = +SNC = +DW = +DWTEST = +POOLN = +TESTLIB = + + +!INCLUDE commpre.nmk + + +# Source to object file mappings and CFLAGS amalgamation +# %%VARIETY %%PART: Add new macros which expand to the files included +# in the part for each variety +# %%VARIETY: Add a CFLAGS macro which expands to the flags that that variety +# should use when compiling C. And a LINKFLAGS macro which expands to the +# flags that the variety should use when building executables. And a LIBFLAGS +# macro which expands to the flags that the variety should use when building +# libraries + +!IF "$(VARIETY)" == "he" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHE) +MPMOBJ0 = $(MPM:<=w3i3mv\he\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\he\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\he\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\he\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\he\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\he\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\he\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\he\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\he\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\he\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\he\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\he\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\he\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ce" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCE) +MPMOBJ0 = $(MPM:<=w3i3mv\ce\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\ce\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\ce\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\ce\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\ce\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\ce\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\ce\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\ce\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\ce\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\ce\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\ce\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\ce\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\ce\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "hi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHI) +MPMOBJ0 = $(MPM:<=w3i3mv\hi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\hi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\hi\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\hi\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\hi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\hi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\hi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\hi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\hi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\hi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\hi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\hi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\hi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ci" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCI) +MPMOBJ0 = $(MPM:<=w3i3mv\ci\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\ci\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\ci\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\ci\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\ci\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\ci\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\ci\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\ci\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\ci\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\ci\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\ci\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\ci\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\ci\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ti" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFTI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFTI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSTI) +MPMOBJ0 = $(MPM:<=w3i3mv\ti\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\ti\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\ti\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\ti\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\ti\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\ti\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\ti\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\ti\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\ti\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\ti\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\ti\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\ti\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\ti\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "wi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWI) +MPMOBJ0 = $(MPM:<=w3i3mv\wi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\wi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\wi\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\wi\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\wi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\wi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\wi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\wi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\wi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\wi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\wi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\wi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\wi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "we" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWE) +MPMOBJ0 = $(MPM:<=w3i3mv\we\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3i3mv\we\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3i3mv\we\) +SWOBJ = $(SWOBJ0:>=.obj) +CONFIGURAOBJ0 = $(CONFIGURA:<=w3i3mv\we\) +CONFIGURAOBJ = $(CONFIGURAOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3i3mv\we\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3i3mv\we\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3i3mv\we\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3i3mv\we\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3i3mv\we\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3i3mv\we\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3i3mv\we\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3i3mv\we\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\we\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +#!ELSEIF "$(VARIETY)" == "cv" +#CFLAGS=$(CFLAGSCOMMON) $(CFCV) +#LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCV) +#LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCV) +#MPMOBJ0 = $(MPM:<=w3i3mv\cv\) +#MPMOBJ = $(MPMOBJ0:>=.obj) +#PLINTHOBJ0 = $(PLINTH:<=w3i3mv\cv\) +#PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +#AMSOBJ0 = $(AMS:<=w3i3mv\cv\) +#AMSOBJ = $(AMSOBJ0:>=.obj) +#AMCOBJ0 = $(AMC:<=w3i3mv\cv\) +#AMCOBJ = $(AMCOBJ0:>=.obj) +#AWLOBJ0 = $(AWL:<=w3i3mv\cv\) +#AWLOBJ = $(AWLOBJ0:>=.obj) +#LOOBJ0 = $(LO:<=w3i3mv\cv\) +#LOOBJ = $(LOOBJ0:>=.obj) +#SNCOBJ0 = $(SNC:<=w3i3mv\cv\) +#SNCOBJ = $(SNCOBJ0:>=.obj) +#DWOBJ0 = $(DW:<=w3i3mv\cv\) +#DWOBJ = $(DWOBJ0:>=.obj) +#POOLNOBJ0 = $(POOLN:<=w3i3mv\cv\) +#POOLNOBJ = $(POOLNOBJ0:>=.obj) +#TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\cv\) +#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ENDIF + + +!INCLUDE commpost.nmk diff --git a/mps/code/w3ppmv.nmk b/mps/code/w3ppmv.nmk new file mode 100644 index 00000000000..3d08649ddeb --- /dev/null +++ b/mps/code/w3ppmv.nmk @@ -0,0 +1,291 @@ +# impl.nmk.w3ppmv: WINDOWS (POWERPC) NMAKE FILE +# +# $HopeName: MMsrc!w3ppmv.nmk(trunk.43) $ +# Copyright (C) 2000 Harlequin Limited. All rights reserved. + +PFM = w3ppmv + +RAINBOWPATH = MSVISUAL\WIN32\PPC +DONGLELIB = $(RAINBOWPATH)\spromeps.lib + +PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH) + +MPM = \ + \ + \ + \ + \ + \ + \ + +SW = \ + \ + \ + \ + \ + \ + \ + \ + +PLINTH = +AMC = +AMS = +AWL = +LO = +DW = +DWTEST = +POOLN = +TESTLIB = + + +!INCLUDE commpre.nmk + + +# Source to object file mappings +# and CFLAGS amalgamation +# %%VARIETY %%PART: Add new macros which expand to the files included +# in the part for each variety +# %%VARIETY: Add a CFLAGS macro which expands to the flags that that variety +# should use when compiling C. And a LINKFLAGS macro which expands to the +# flags that the variety should use when building executables. And a LIBFLAGS +# macro which expands to the flags that the variety should use when builing +# libraries + +!IF "$(VARIETY)" == "he" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHE) +MPMOBJ0 = $(MPM:<=w3ppmv\he\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\he\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\he\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\he\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\he\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\he\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\he\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\he\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\he\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\he\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\he\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\he\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ce" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCE) +MPMOBJ0 = $(MPM:<=w3ppmv\ce\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\ce\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\ce\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\ce\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\ce\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\ce\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\ce\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\ce\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\ce\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\ce\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\ce\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\ce\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "hi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFHI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHI) +MPMOBJ0 = $(MPM:<=w3ppmv\hi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\hi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\hi\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\hi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\hi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\hi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\hi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\hi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\hi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\hi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\hi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\hi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ci" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCI) +MPMOBJ0 = $(MPM:<=w3ppmv\ci\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\ci\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\ci\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\ci\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\ci\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\ci\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\ci\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\ci\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\ci\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\ci\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\ci\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\ci\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "ti" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFTI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFTI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSTI) +MPMOBJ0 = $(MPM:<=w3ppmv\ti\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\ti\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\ti\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\ti\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\ti\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\ti\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\ti\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\ti\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\ti\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\ti\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\ti\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\ti\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "wi" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWI) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWI) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWI) +MPMOBJ0 = $(MPM:<=w3ppmv\wi\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\wi\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\wi\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\wi\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\wi\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\wi\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\wi\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\wi\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\wi\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\wi\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\wi\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\wi\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ELSEIF "$(VARIETY)" == "we" +CFLAGS=$(CFLAGSCOMMONPRE) $(CFWE) $(CFLAGSCOMMONPOST) +LINKFLAGS=$(LINKFLAGSCOMMON) $(LFWE) +LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSWE) +MPMOBJ0 = $(MPM:<=w3ppmv\we\) +MPMOBJ = $(MPMOBJ0:>=.obj) +PLINTHOBJ0 = $(PLINTH:<=w3ppmv\we\) +PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +SWOBJ0 = $(SW:<=w3ppmv\we\) +SWOBJ = $(SWOBJ0:>=.obj) +AMSOBJ0 = $(AMS:<=w3ppmv\we\) +AMSOBJ = $(AMSOBJ0:>=.obj) +AMCOBJ0 = $(AMC:<=w3ppmv\we\) +AMCOBJ = $(AMCOBJ0:>=.obj) +AWLOBJ0 = $(AWL:<=w3ppmv\we\) +AWLOBJ = $(AWLOBJ0:>=.obj) +LOOBJ0 = $(LO:<=w3ppmv\we\) +LOOBJ = $(LOOBJ0:>=.obj) +SNCOBJ0 = $(SNC:<=w3ppmv\we\) +SNCOBJ = $(SNCOBJ0:>=.obj) +DWOBJ0 = $(DW:<=w3ppmv\we\) +DWOBJ = $(DWOBJ0:>=.obj) +DWTESTOBJ0 = $(DWTEST:<=w3ppmv\we\) +DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +POOLNOBJ0 = $(POOLN:<=w3ppmv\we\) +POOLNOBJ = $(POOLNOBJ0:>=.obj) +TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\we\) +TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +#!ELSEIF "$(VARIETY)" == "cv" +#CFLAGS=$(CFLAGSCOMMON) $(CFCV) +#LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCV) +#LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCV) +#MPMOBJ0 = $(MPM:<=w3ppmv\cv\) +#MPMOBJ = $(MPMOBJ0:>=.obj) +#PLINTHOBJ0 = $(PLINTH:<=w3ppmv\cv\) +#PLINTHOBJ = $(PLINTHOBJ0:>=.obj) +#SWOBJ0 = $(SW:<=w3ppmv\cv\) +#SWOBJ = $(SWOBJ0:>=.obj) +#AMSOBJ0 = $(AMS:<=w3ppmv\cv\) +#AMSOBJ = $(AMSOBJ0:>=.obj) +#AMCOBJ0 = $(AMC:<=w3ppmv\cv\) +#AMCOBJ = $(AMCOBJ0:>=.obj) +#AWLOBJ0 = $(AWL:<=w3ppmv\cv\) +#AWLOBJ = $(AWLOBJ0:>=.obj) +#LOOBJ0 = $(LO:<=w3ppmv\cv\) +#LOOBJ = $(LOOBJ0:>=.obj) +#SNCOBJ0 = $(SNC:<=w3ppmv\cv\) +#SNCOBJ = $(SNCOBJ0:>=.obj) +#MRGOBJ0 = $(MRG:<=w3ppmv\cv\) +#MRGOBJ = $(MRGOBJ0:>=.obj) +#DWOBJ0 = $(DW:<=w3ppmv\cv\) +#DWOBJ = $(DWOBJ0:>=.obj) +#DWTESTOBJ0 = $(DWTEST:<=w3ppmv\cv\) +#DWTESTOBJ = $(DWTESTOBJ0:>=.obj) +#POOLNOBJ0 = $(POOLN:<=w3ppmv\cv\) +#POOLNOBJ = $(POOLNOBJ0:>=.obj) +#TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\cv\) +#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj) + +!ENDIF + + +!INCLUDE commpost.nmk diff --git a/mps/code/walk.c b/mps/code/walk.c new file mode 100644 index 00000000000..9a3bd0122e3 --- /dev/null +++ b/mps/code/walk.c @@ -0,0 +1,363 @@ +/* impl.c.walk: OBJECT WALKER + * + * $HopeName: MMsrc!walk.c(trunk.6) $ + * Copyright (C) 2001 Harlequin Limited. All rights reserved. + */ + +#include "mpm.h" +#include "mps.h" + +SRCID(walk, "$HopeName: MMsrc!walk.c(trunk.6) $"); + + +/* Heap Walking + */ + + +#define FormattedObjectsStepClosureSig ((Sig)0x519F05C1) + +typedef struct FormattedObjectsStepClosureStruct *FormattedObjectsStepClosure; + +typedef struct FormattedObjectsStepClosureStruct { + Sig sig; + mps_formatted_objects_stepper_t f; + void *p; + size_t s; +} FormattedObjectsStepClosureStruct; + + +static Bool FormattedObjectsStepClosureCheck(FormattedObjectsStepClosure c) +{ + CHECKS(FormattedObjectsStepClosure, c); + CHECKL(FUNCHECK(c->f)); + /* p and s fields are arbitrary closures which cannot be checked */ + return TRUE; +} + + +static void ArenaFormattedObjectsStep(Addr object, Format format, Pool pool, + void *p, Size s) +{ + FormattedObjectsStepClosure c; + /* Can't check object */ + AVERT(Format, format); + AVERT(Pool, pool); + c = p; + AVERT(FormattedObjectsStepClosure, c); + AVER(s == 0); + + (*c->f)((mps_addr_t)object, (mps_fmt_t)format, (mps_pool_t)pool, + c->p, c->s); +} + + +/* ArenaFormattedObjectsWalk -- iterate over all objects + * + * So called because it walks all formatted objects in an arena. */ + +static void ArenaFormattedObjectsWalk(Arena arena, FormattedObjectsStepMethod f, + void *p, Size s) +{ + Seg seg; + FormattedObjectsStepClosure c; + + AVERT(Arena, arena); + AVER(FUNCHECK(f)); + AVER(f == ArenaFormattedObjectsStep); + /* p and s are arbitrary closures. */ + /* Know that p is a FormattedObjectsStepClosure */ + /* Know that s is 0 */ + AVER(p != NULL); + AVER(s == 0); + + c = p; + AVERT(FormattedObjectsStepClosure, c); + + if (SegFirst(&seg, arena)) { + Addr base; + do { + Pool pool; + base = SegBase(seg); + pool = SegPool(seg); + if (pool->class->attr & AttrFMT) { + ShieldExpose(arena, seg); + PoolWalk(pool, seg, f, p, s); + ShieldCover(arena, seg); + } + } while(SegNext(&seg, arena, base)); + } +} + + +/* mps_arena_formatted_objects_walk -- iterate over all objects + * + * Client interface to ArenaFormattedObjectsWalk. */ + +void mps_arena_formatted_objects_walk(mps_arena_t mps_arena, + mps_formatted_objects_stepper_t f, + void *p, size_t s) +{ + Arena arena = (Arena)mps_arena; + FormattedObjectsStepClosureStruct c; + + ArenaEnter(arena); + AVERT(Arena, arena); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures, hence can't be checked */ + c.sig = FormattedObjectsStepClosureSig; + c.f = f; + c.p = p; + c.s = s; + ArenaFormattedObjectsWalk(arena, ArenaFormattedObjectsStep, &c, 0); + ArenaLeave(arena); +} + + + +/* Root Walking + * + * This involves more code than it should. The roots are walked by + * scanning them. But there's no direct support for invoking the scanner + * without there being a trace, and there's no direct support for + * creating a trace without also condemning part of the heap. (@@@@ This + * looks like a useful canditate for inclusion in the future). For now, + * the root walker contains its own code for creating a minimal trace + * and scan state. + * + * ASSUMPTIONS + * + * .assume.parked: The root walker must be invoked with a parked + * arena. It's only strictly necessary for there to be no current trace, + * but the client has no way to ensure this apart from parking the + * arena. + * + * .assume.rootaddr: The client closure is called with a parameter which + * is the address of a reference to an object referenced from a + * root. The client may desire this address to be the address of the + * actual reference in the root (so that the debugger can be used to + * determine details about the root). This is not always possible, since + * the root might actually be a register, or the format scan method + * might not pass this address directly to the fix method. If the format + * code does pass on the address, the client can be sure to be passed + * the address of any root other than a register or stack. */ + + +/* rootsStepClosure -- closure environment for root walker + * + * Defined as a subclass of ScanState. */ + +/* SIGnature Roots Step CLOsure */ +#define rootsStepClosureSig ((Sig)0x51965C10) + +typedef struct rootsStepClosureStruct *rootsStepClosure; +typedef struct rootsStepClosureStruct { + ScanStateStruct ssStruct; /* generic scan state object */ + mps_roots_stepper_t f; /* client closure function */ + void *p; /* client closure data */ + size_t s; /* client closure data */ + Root root; /* current root, or NULL */ + Sig sig; /* impl.h.misc.sig */ +} rootsStepClosureStruct; + +#define rootsStepClosure2ScanState(rsc) (&(rsc)->ssStruct) +#define ScanState2rootsStepClosure(ss) \ + PARENT(rootsStepClosureStruct, ssStruct, ss) + + +/* rootsStepClosureCheck -- check a rootsStepClosure */ + +static Bool rootsStepClosureCheck(rootsStepClosure rsc) +{ + CHECKS(rootsStepClosure, rsc); + CHECKD(ScanState, &rsc->ssStruct); + CHECKL(FUNCHECK(rsc->f)); + /* p and s fields are arbitrary closures which cannot be checked */ + if (rsc->root != NULL) { + CHECKL(RootCheck(rsc->root)); + } + return TRUE; +} + + +/* rootsStepClosureInit -- Initialize a rootsStepClosure + * + * Initialize the parent ScanState too. */ + +static void rootsStepClosureInit(rootsStepClosure rsc, + Globals arena, Trace trace, + TraceFixMethod rootFix, + mps_roots_stepper_t f, void *p, Size s) +{ + ScanState ss; + + /* First initialize the ScanState superclass */ + ss = &rsc->ssStruct; + ScanStateInit(ss, TraceSetSingle(trace), GlobalsArena(arena), RankAMBIG, + trace->white); + + /* Initialize the fix method in the ScanState */ + ss->fix = rootFix; + + /* Initialize subclass specific data */ + rsc->f = f; + rsc->p = p; + rsc->s = s; + rsc->root = NULL; + + rsc->sig = rootsStepClosureSig; + + AVERT(rootsStepClosure, rsc); +} + + +/* rootsStepClosureFinish -- Finish a rootsStepClosure + * + * Finish the parent ScanState too. */ + +static void rootsStepClosureFinish(rootsStepClosure rsc) +{ + ScanState ss; + + ss = rootsStepClosure2ScanState(rsc); + rsc->sig = SigInvalid; + ScanStateFinish(ss); +} + + +/* RootsWalkFix -- the fix method used during root walking + * + * This doesn't cause further scanning of transitive references, it just + * calls the client closure. */ + +static Res RootsWalkFix(ScanState ss, Ref *refIO) +{ + rootsStepClosure rsc; + Ref ref; + Seg seg; + Arena arena; + + AVERT(ScanState, ss); + AVER(refIO != NULL); + rsc = ScanState2rootsStepClosure(ss); + AVERT(rootsStepClosure, rsc); + + arena = ss->arena; + ref = *refIO; + + /* Check that the reference is to a valid segment */ + if (SegOfAddr(&seg, arena, ref)) { + /* Test if the segment belongs to a GCable pool */ + /* If it isn't then it's not in the heap, and the reference */ + /* shouldn't be passed to the client */ + if ((SegPool(seg)->class->attr & AttrGC) != 0) { + /* Call the client closure - .assume.rootaddr */ + rsc->f((mps_addr_t*)refIO, (mps_root_t)rsc->root, rsc->p, rsc->s); + } + } else { + /* See design.mps.trace.exact.legal */ + AVER(ss->rank < RankEXACT || !ArenaIsReservedAddr(arena, ref)); + } + + /* See design.mps.trace.fix.fixed.all */ + ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO); + + AVER(ref == *refIO); /* can walk object graph - but not modify it */ + + return ResOK; +} + + +/* rootWalk -- the step function for ArenaRootsWalk */ + +static Res rootWalk(Root root, void *p) +{ + ScanState ss = (ScanState)p; + + AVERT(ScanState, ss); + + if (RootRank(root) == ss->rank) { + /* set the root for the benefit of the fix method */ + ScanState2rootsStepClosure(ss)->root = root; + /* Scan it */ + ScanStateSetSummary(ss, RefSetEMPTY); + return RootScan(ss, root); + } else + return ResOK; +} + + +/* ArenaRootsWalk -- walks all the root in the arena */ + +static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f, + void *p, size_t s) +{ + Arena arena; + rootsStepClosureStruct rscStruct; + rootsStepClosure rsc = &rscStruct; + Trace trace; + ScanState ss; + Rank rank; + Res res; + + AVERT(Globals, arenaGlobals); + AVER(FUNCHECK(f)); + /* p and s are arbitrary client-provided closure data. */ + arena = GlobalsArena(arenaGlobals); + + /* Scan all the roots with a minimal trace. Invoke the scanner with a */ + /* rootsStepClosure, which is a subclass of ScanState and contains the */ + /* client-provided closure. Supply a special fix method in order to */ + /* call the client closure. This fix method must perform no tracing */ + /* operations of its own. */ + + res = TraceCreate(&trace, arena); + /* Have to fail if no trace available. Unlikely due to .assume.parked. */ + if (res != ResOK) + return res; + /* Set the white set to universal so that the scanner */ + /* doesn't filter out any references from roots into the arena. */ + trace->white = ZoneSetUNIV; + /* Make the roots grey so that they are scanned */ + res = RootsIterate(arenaGlobals, (RootIterateFn)RootGrey, (void *)trace); + /* Make this trace look like any other trace. */ + arena->flippedTraces = TraceSetAdd(arena->flippedTraces, trace); + + rootsStepClosureInit(rsc, arenaGlobals, trace, RootsWalkFix, f, p, s); + ss = rootsStepClosure2ScanState(rsc); + + for(rank = RankAMBIG; rank < RankLIMIT; ++rank) { + ss->rank = rank; + AVERT(ScanState, ss); + res = RootsIterate(arenaGlobals, rootWalk, (void *)ss); + if (res != ResOK) + break; + } + + rootsStepClosureFinish(rsc); + /* Make this trace look like any other finished trace. */ + trace->state = TraceFINISHED; + TraceDestroy(trace); + + return res; +} + + +/* mps_arena_roots_walk -- Client interface for walking */ + +void mps_arena_roots_walk(mps_arena_t mps_arena, mps_roots_stepper_t f, + void *p, size_t s) +{ + Arena arena = (Arena)mps_arena; + Res res; + + ArenaEnter(arena); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures, hence can't be checked */ + + AVER(ArenaGlobals(arena)->clamped); /* .assume.parked */ + AVER(arena->busyTraces == TraceSetEMPTY); /* .assume.parked */ + + res = ArenaRootsWalk(ArenaGlobals(arena), f, p, s); + AVER(res == ResOK); + ArenaLeave(arena); +} diff --git a/mps/code/xcppgc.gmk b/mps/code/xcppgc.gmk new file mode 100644 index 00000000000..6c2cd7e64a8 --- /dev/null +++ b/mps/code/xcppgc.gmk @@ -0,0 +1,29 @@ +# impl.gmk.xcppgc: BUILD FOR MACOS X (CARBON)/POWERPC/GCC PLATFORM +# +# $HopeName: MMsrc!xcppgc.gmk(MM_epcore_brisling.1) $ +# Copyright (C) 2001 Harlequin Limited. All rights reserved. + +PFM = xcppgc + +MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmxc.c \ + protan.c prmcan.c span.c ssan.c +SWPF = than.c vmxc.c protsw.c prmcan.c ssan.c + +LIBS = + +RANLIB=ranlib + +include gc.gmk + +CC = cc + +# Suppress some warnings (last checked in DP3). +# .cabs: -Wstrict-prototypes cannot be used because the math.h header has a +# traditional declaration of cabs. +# .sputc: -Wno-unused is needed, because stdio.h declares __sputc as an +# inline function. +# .types: sys/types.h uses 'long long' even under -ansi. +CFLAGSCOMPILER := $(subst -Wstrict-prototypes,,$(CFLAGSCOMPILER)) \ + -Wno-unused -Wno-long-long + +include comm.gmk -- cgit v1.2.1