From 1cd2b8acfcb479261f84bb7d9756b19910dc9067 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Thu, 6 Sep 2007 22:45:20 -0400 Subject: [PATCH] * Handling weak-pairs is now generational, fixing performance problems when guardians were used to implement hash tables. --- bin/ikarus | Bin 68100 -> 68100 bytes bin/ikarus-collect.c | 84 ++++----- src/ikarus.hash-tables.guardians.ss | 273 ---------------------------- src/ikarus.hash-tables.rehashing.ss | 174 ------------------ src/ikarus.hash-tables.ss | 222 ---------------------- 5 files changed, 35 insertions(+), 718 deletions(-) delete mode 100644 src/ikarus.hash-tables.guardians.ss delete mode 100644 src/ikarus.hash-tables.rehashing.ss delete mode 100644 src/ikarus.hash-tables.ss diff --git a/bin/ikarus b/bin/ikarus index 20b0dfd34af80eff30114cba8b6e566895a5c51b..a5d29f4dd83255a1d60f7dd060c80270b3db0b1d 100755 GIT binary patch delta 9667 zcma)C3w#ts(x0Ae!UhtSM?!eyNfI6cLNE#o0YgYIA|Oft&jUq8M0^2m5HRNwCW9H8 zkzi*z;KG3%B6{FOmWA*LCIMMQML-U@^E^>ev*y&`DGx#O{i|n^p!fRn`}ORbUl|<6>WV0^2N{oqMWx?ic+#uU1FCCJuETz_|Ff^Bs))b7K<1)E-shfw&vg8@7uz zaeditQ5V;f?222+4vBlZUe6kZ*)>hg+$Q{8Co_+T>}Eib=ynU+BtGc&I{Qidu6q)z z^Y80^n57JRMNte#T7A_)MS%mF@K^5zo@{(JN&81k{Rd)Gd{6d-cq2ZEbj0VWnOjBw zgk*Kl4lyAiP3^i>coJ?`om<5l3HP$IB0ce*?E04!B{Uq8Os$dNAPFxKOqa03R>1BO zDg<4CP&jo8RA$xh6$ca3*#UnjF^s{}UnM=nj)=+0BiT+-o_sr7E6yd4XCW~-`zT3m!zh#x*cgd7&|Kb>1lA!ne;7qdV3vFZ`|s?wfBQe9lu^w_8Gu7h`;wq z>+|V)%Vk4$x4P`7U9B#=dkZ2!`+S$!o1VaSi2S}=*$V&pzB5#|*?(vMag6=lzhOWW zQ^&0JZ@=E9Vs5Gj{h;Qq7JD-C*+QWXzC|rqEp8i}+^J$U0;9ayGez}mz5h3ZpJ!~5 zzeDC1VQPv`Tpscb`_Ug7dQfGfM2E~S;^6Qu>U}={2g9FWLst3V+vz_wH5ud5oTj#& zsuQUCt?NJ?0#pX6seMfJn~08>HMJ9>ctkAwT>N&#mue0d+Q^_9v0RM1xk4Sw#g{h^ zRNHgWBYPyfAnwjiOz*{E;)eQ{H(<;%kg9<4;mFBWhniwc&Mfv1u{|dqE8}R+BvvUBM^9oK#r)B|uoTwfxmDEQxl?>G`UXUJ zkKEDhxVSg>S+-4lk(ki5nj3*D0LAe8(RxXXxcTAJFPx%rr-TYUU)=QI5wBdqGax3)<-nW9oAuH zH#p_EcJ^lN(#@`tOWnn-^OD&(F=t+U%)~2AO~IUe>_iF={EcQIP$1ULOYq)>20kI4 zFUaJ+afHjop8Fuiw}L7p7EW7 zm-Umb(!&^wp+5>*P~Qq$Xbyt<$qW-KYa62c+m zx$9vG_emkXnP3R&+t5N>#)*aut{O#4omveuR82Nu3W&?WWz8+cxJp7K)SM|?o_;-d zlGQpn!_cdMYrl-*x+KPwX`i@;`>Mn=&xm$pj9%mE#C_#rv!~}Qsv8p=MnHnYAcGKM zSO`HGLMo{UP%woSqs20r=Qxb{4)R4JhGCqx{1AEp$}iN070%}-`9XivRkB}Nh%=@z zWjJ{Rs@rpuP_g?bgk<3v{er7x3eI{y#u3B}l2@qNm;#$5I1GMKT9`aq4#u%uMmLSn zwQ@Sl9+f{NJPop+81#F}y)J8m9*i%F==;4(*^pjN-53XDpFNS<_ z878%7RUV*O?& zvm#JKjCwJZ!{ubTp4(1hq;48SZ#f7V(>1QrZRi}-YamjJ2@v8snZPplrpvd$Z891G1S|NHinf|IV2#}F&F)Xo1ygB%~mR9b+BpgsfRBzFh( zu2*RMFHR%phaz`5GakAh| z*K;_wVF6JMeHxxY{cW@muTj@9fJYcb%jBYpNYi8sRu!>fRS}yt1Yp#&TYlZo3~%gN^?jLmBCO0d6w~nc&@LMoO~7ovNuJ2qcDq-r28!+ zjar`Vz$o>a!g?N%y*zr3p)Zf%W+Q6G zI6IIv*~qjYVwl+6I`#GlKDBu;Z=C|W-Y8tpbY=I7KF`E^wQ90D+>?)G4Zwcky_s0% zAiL!wI4^Bd&qA0`)jHkpE)e3XH_aQ=%ODa&IFXKD3;kQ z=>BV(CsFg^jGEAzi>-Y|T10P6D4en?pLC^9x>8QQVUo#6?|D1h+RAmkNOpagHchf)=1G!6(@79^a;eZHNv@I%+MrBo=N&K9IX!RF zKrb51IIVr&#t1mk(428AILHf2xs+LZHpw$wQBzy*aP2aQ z_}WfoYylA`hrWrD% zvg0uybZUp4?&^3be`*6azoTVtc14X+$#rzh9OEOA zD6&h2o(!@(=+Y`MJkfFK!24U2DE}`d)Sr})cs|cbdk$VdDMnOU{fO1H=Xf%WfNX5h zC^EEoZ=`I*nzt_@QfGC4IiRY3(=%8x?(gHFL%Z7|{AZx&nJ3vEm>66fod=>Z?+xmIL09+hxdBJE5 zHBspJ$TwDMrAfy@DtQsBklaW|k{5gESZ)%P2k7~4eX9S7LdVY1{*$PtCY(uyQNb}o z$+N*RS@gs8iI_YbOm1xSKn<$#6Mx3p{0?x8cvo-N`^xh$vpHZg)9Sw!=+ad9E?tRp z9R1Ycc}~}Jry~Sg786^HtDij3Al%G5LucCLY2vzNS?c$Sn7wS0xG11&?wx*cKz5Ex;p3x>V!BJ2Im{@oB0GP^q}MDe6X&1p>h-|kkYmK* zH(d5Cj53x{@@nQZ8O!i`P6=Hh-<;WS zJZLgy_YtzLMLZX|qP#$JPur`Mz_|}m{8w*8H|sD8>MMXr7{&J)bfx%?ma9Z^`3le; z)K7{2i*vmuG1FS79$eO}tk_lZ6;T+@42Uoa?EF~MPoat+At4A7s<}qOyzrmZ6+YjR z-WiK!(*G>@jrT1lgz6}`b!kS6;=WRGVX5Ba$>Fy+f|z*m_|u)d%W0ri9l%E(F{V0< zY6*gtQ$n9ZVDriU5(h^xqo(0c*Erjhvm|ed@-iBr?p(h0FgzWR(9_In*8FOWp)*$##~7dcw)i#$7CQf7dX zs;|J)&}UL>pbXF2&!d8R33_3yh%Jwe8U~vO#Ol%*FA?YzBo<9J;}j%fvS(-&(k=xj zrNyI5sfAV6shFyhzJJ%R@JNeY+KXhSiwC5&zI?JOb4N;mlyQ@uk8}Cb&4|KFfC6fk z@9jdr2~niZ27%1xT@X*6zB1F%F17I_*%|7PAUaqXY6Rt?QA;CD>O(h)i%-3YR{^NV zLpjs|uEb6(ikEcFpK4+;hOqqp#i@^y1wV7@Tu_>w>Y>(Fr*0F)r3s?Zh>Bc@fshaJ z-Jmozme^XoL;|R#p)}D;;^7RbrPUeRq%-Il(ka&Tg<$({!#@26?D)m7sZYzWsbUSA zz8Y9Bm$0FK5!h%@tmk_-o9&l{KKFtXC>r)`Gt$x()CW)7k|cTTpk zI5+fH+PbU|v|f@rR6{R1}pd z+-Fc@U-S1b!xEze|IV-Moxl0OXtEBB&;xR(x86z1t$)Dx#Ya<7`^d8hO z#%bm^@rhU1QNtI5R$3mus~9BDS~}b$%9DM>Yb9NxiAK3>t;3D%_6KtS>md3(m*5O( z^57^FV|j91%dWEq+-_eLy1TTm6;aINydOcY(b!KX;-c_yI>Tx&MH+f8DI4Rcy@a@^ zAnfadr_orSi`QUy0buybi8}U*VQvJF`IFq^vdZwPU^3qHf=Ywpx@0t|&I_D$ws=xn z_5yF5y&0UYwMR)p+GQ=(qyXG1sh?XX9o_&p$tgwhe8UV$83 z)1Oe3@XDLW{YZ2Uf&&2x!<*{Y5_bW8lF9&g!wCz2h3u%|4Schi9y)zi+_W-}IYrUR zH}Ih_r|cnoZh58bCiT2ed{TCsy4fcNu8LP*n;^!o+NB;V_lM)#8GBN+5djt}s>LdH ztGK;<4hs`|%X_uIJhoMJ%~=1}<%1b35Gkv#W6Q+2)wyhxf7R*?mAS;hHFv4IOp&nm zM|JlK5x=fb9WX|$PfZY&>zwUV@>-?T=ZeGYUSM;??B5+#_l*{r6+P80qs3hnDJ(`T zuE=6N#O{hwEJIwbNLJU67CqLd4_lkl+J6SHQA7?{mC@|3^`psMwzsBV!+e8SyuN3* z3!tPlx`WSrkDD$fg9j)LssAWP1lB*xd}74!&#F706-gV8sjp;&Y% zWKF<~n_Knw7RxsFSA#eEcW(SMWBFqFrY-6Vnt$*g?qFQmwk~8R6c#h$Z>`TbD5P_eJ8y zSI()GLu9XlURJNQnXSEMi1B|+W;6Yd|M4x>%$H^JEgIa)mn|OKzFDnVC_2BoiN*VO zy?PHzu3kX zyG6a^@qh3dER_riu{)D36Q}lXWlR(+{V%I)=Zj%G`yps%?fixni7A0h_40LMMc_Cq z6w`MNWm#hNu5{K#?B6w#m53|5=CDWovvyBlEI|aSGSv;eMMKqib?swf*q&Z&p15z% zI<>Nw_;F8q*XJ*?xJLG3hOUX&E6EX@ez@< zuba3ExRYQun=fYU8^s2R{`(V{B5L;aVhv*6{seV>nyB5E&bG+PqgLfUS-Huo#LLQi zsl=wf|F9UaKVIFGD!NyvvT`x9`bPC0i`I@fVuf*_v)bih@%sab?3}1Ra2%-UkvdQ8%uivc3S`0PG;_t8bQQw*+ zoHg6qhbLVVk4|y0rauc8jWy3l=O_MbYHFvd=MqGHZKCUEJ$5IE*t*5h!xLJWJNhf? zVxl8x8Ks>PiN||}7yLz0risGiy(24us!(dg%g2)jIR2_AQ7ADe@hE91{ZTSevQTnS z#-S9TO!N0W5yu`}_yPW71!W0J2}&u-3Y0RGa+EbF6(}1~Hlu7s*@jYyvJ<5WWj{&{ z${~~^C~u=2M>&OZ2IX)55huS%h+guMqCBiBN@Ca&rO5AYY{S@h{!!;|XY9BBRo{+g z-urOpdlsM7To~$~UQ(3RHZ~6{%1bsr@iKJU_|gl|XX8b0D9Zab?)|Ewd~V~9k0{DT z8&AL`v<*IllKlJ8*N0q=@F#fn@CSz?CViKHh@AJ`K<}?NDoO-yv($RBucA!An?S;o zk1NW9Hja2lQJ%DM?c0h{Y~$NNUuokZpjX&L< zlpAfFctBC|Y<%}2geKukjDGD7MR~w(IEm?a(#Ba^6lJN6J)p0$@n_>lTmS@%<8M+0yD@OrC)v!xi#ub_#XY!ij&Y$Hc>yMVNm-6QjDl_;AZ1 zxp*IcCU6%S%#Q@dllJ__z@eli?-JBj-d)Tm1&x&p_wv(0t>lY)`NNk<82RVJy!A7yv0#(Pwu` z5;etD9ylsV;D9Rlt8@T7jQ%)8xgK2k4&M|OL+bM5VUajTScZIRJ8vBxC6|B92ZYDT z1>3nj{3SVmJ3k)&8kxo8BSxn#+%8GJWRRpOOA%}@z*Pvw3vdU5%>=jxK`VeT;qXkD zGNp1bKN=BFGTpuiKLVb<5&0$=!-qw6CH;7A)Jr6hUy15ZvU!K-Uh>*4d~S3EnakHj zkCLl4^9Rw9@}u3nSxk<6eKSvt4dJCR{p9@3yg_WFT#T5uvS$|`8~d_cw22qSMxaY# z$Jbt zWsmpOy6pB=$N=T)K7J@Zob=(n6Lyd|_pO96GD&d{ZrzWN8SV{jEJXfpjeAd9s|>Lz zYX4CF#>EdN_9hLu+@Y6z-NpNMh-#Fy8WJP7+B5Si*XFtBcX*eOhVBMQKl#ZAbNPc# z|0FKAuk%q^{xX+0ObX#glN-wqa@}7izfC$NxWKui9#>V-esN|^$-wRa?B2G1S_&B| zvQ$%MBmPf_hose%i9Gv-5VC;3_rlNeSIfB4)hmBMdB1LX^5tdx=WgxfZOizxsa?qm z{z_^@{HM!6#|@P`H-OP1lZpV+1vO(Zo@s9oC*PA6220~)+7Qy4NAws%I`ip0n!{RH3(r(u49|Z2ryd<4#h*>@K_>9m z(wC5Q{!@A)nZlc9M9SY#cbANVW)khb)Bkl@KD@yF>Oh}And{ET%nBm!xet$TAB z`IR^N%jf3uj&HVV^wC_L^A~a5xg2INpIXMm2O(qx5Fe! z5i=4+#R*Kzh4b57sBD(XhFMr2i{dlU3v95NsVRW1y!dZWDl^#Vt^XDr&@-52j&vB9 zXuet{M0K5+16aWdp+OVb6)f*_Z{>P}+8G)<<>PbZ)Baf=-05BH{QcA~D zmmL76VV89uuNGUK+n>SUqF^e-d)0h^aXP;8oyKE!8y#3aY9WXMmKAMbUWgU4xF*2U zs~&(6WTBs5OJp*gx5%s%6DliW0341~CMJ3|A;#+T0XfqqaI3vlOfl-HqUlsU25`yG z7N!bh@G9l9HQ9BHkF>u~A9YcS?TwggH{W89c?0`&fQfnpPzGo~_z0xES0s##Q+P0S zd~;w#SDB@m=yVfW9sy?13%b?5jWGG$62GkJOx+@;u{sNdhFf^+tmv>E0%s3m8baB& z$B=+o7uCB~XR}89T2>5aS>Zi|#-?Q=VbKih%2A*T6Ar}*(;z?fUUp{`V0E?!3@!0x z0vXEM(~uvU9m|7eG;@e~)Ds6V#MX3?0#rPihJw4eNl zxzG?MGJy`Q^N0yIF%1(!(5sjWUXYJkO#xWZlS+ZKb3nY3MMSJC_MjLSCLtuIb2Y3i zJyu}S(%r!9RZqc~5aU9Ki7aHnIn-4lnC!1XUW70Y_Sg)Fmq6dO_ola40M*VT(TN5B z&S=Ow%txF)vZdOtvDV%=-R!g0c=MLIuLakFK{PgqHfIqyM#XF@e?j z4U|4Z>Xv`OfUpm(I0^%hGGHgV+pD(!741jAxZ0!68m=ZbwB94?%0p*p0;?}A@I1O@ z0n{b0nhT@4BLrO|>iP!fK5Jb8TQHuUN4iFk)(-FpP455*44k5e zPboD~5wq&#HN(2D4fJLx30@WR0e$3EM*^oF@+83N5l2X0RV*E*)05d=?-9EC7!b1} z;Xt(w{&>|@@I+x)Ag=%`kgW(rGNV9_5LB1=O*P#ih*1u5Fb!GtQet)9Kn!87N)SPZ z8ZK7UOVEW>Kp_x0?AbJ&#r_wjA(FjlrW*3FK~;B4{jBOZa33vaHOuGqFF>Wc_F36o zANzHMJIPd5r+N}2;dFnX7ykQnS?_{5{MO=-XVGY1sc@>8wq~Lm=Xvy!SO*+CCDzO2 zg5Yy9K zT`7?eE9HO4$#NVp=1o`OY)}AmD@CZizt!0nlU67Nd$+C^vo9LY1QjN25xP%9o@*_c z3xA>BJXKEMx>Qq6a2)Cd)c5sZ^F8)|2X>eTSXE2v~7hrFpxmA0NUdAICvXC4(3i)HM+4 zRpg>-1AN}{If0gbp8Y-EWKipSOi)vC)u~I>U?9tWpxUWdH3@K3`;%u>U^5b&(mvk4(7+^1@5et%&XM~&nL|1Zg{4aq2zO%quF zZ{#FuiL1;Pi^-luJz}tC8lbd!t&8x$1ZUHyd8Rn@6?m%p!Y0(IIYYJ+Wgl_Wl?rm; z6bVn54}wiEC?&I~mX3Cv04P-n6QAFyc+~!yh`x?+=_?@{5I`rwfFqg)~u9HI!@9aJHuw zOJna!UA2FrY@sN<>3bE#FqZ?9r{uDQy5i9PYAAGp3U+i#z=x_a7lz0STH!Ln_`x#5 zU_#orfAk`{PV5qW;6{Mt9(?{`Xw?Kv=ac_M6rZX@)Sm!`K;5@7&jh|!i5PehRti=s zk)uga@N;0iD(f?RGm&O$B`0T?tt-yJ8C6s7qj3GDFsfQP`W1)*?iKK-Wn9D(*Wndj z*O?-3COpGAM1GF&b|m1s6zZ?!Z+vkw3OFNL#@;j5unN53}es8`(q zh5;I4ySoP3QUm21kniVTFcEUAyW}=>jiddC40L?@Xzy5et9E=Pj+Z4C`_A8}Mb4>4 zb_c<*0zJ5%d{yw41P&l{1f-!qD$lYkbg`~~6ojVCjb{puiZ^n;1Rn-vAt1mOi8aRclu)ytB8>yY4`smM5(kJn zcv7$|3eb=TFWUEJo?sxLZ&j68UcLsn{{Pc_C(ihk`AY#)ZT@l`tu=o+&tQpUIiJa5 zLvX0pUStYTm-CNUgabu_y+U%Wy~~BY`1I|B2*5P~$o@CewjKYyX~JEfmDe$B>E8qJXI+_a0;dhDh>N=s2Q)1_UM{4X=0>F!Z8p4=^-+ue##<6MS3_6;*U*5 z`3?`$P^FUZ<#Rs;6rl-B=%o}#Dwpn)GMlFmaMmSp;B22G5Y4U08x2M=? zc5Cxyq2Z4M5FQD373`n8q^d|}e-+{c!ff|uv|yPg)IYRF{~$yENk_pmJxzGjxHt1l zMO}zzbJ&ScP?Xi#0e=2ScGgyXJp#iM^jYV91iE_6;b>MJ^Mos?wAdc6TBzq3&;UCg z+&$$;4`)!k4~r7*05nsP1k3bqgCz;7k(v#$WhxTe#F$kPZ*_zyuNnq;;McQa1J2vi zto5#91AiqasVfRbMTpD*u#`o~8e-mQ`NunHAX4E@T4J(kQM`}VhJ^81TDap{z1oSG zOKg|9;^lm_3+HDZ@ze$aOcQ;-VX3c4*P3`LTQRe(@a_@gsExsAa89&KB!x#jMFFKr za1Wb;qrJn})Fj`w9~>ah*g6I{VG7(Dy291~A1UFpk2(^Z2|FB9)VC$czW{uI?&~rL zylQ+HYyfa&Bs}ylJsknkKZ)!F-fN}0oD&G|gRd&1d|kg6-}N%#Ln6y+!1%6}o#Dgh zm6gZIeg4-~Z<#qf&O z^d;`e*(d+W<$epkgORWK+uTFu^Z48x@-g3^J4v2A0KcK~RF^quY~NbVTlRHlx;hY2 z$m#0m$S-{F>U6Tx{a|&XOlI;{Ye&ctE4aG$H#t({&UIO`t0!L{8{Rk|N%sNGsFgG@ zgSUNuBRR_}-ajeFrt`eK7&$1N7w1KjdHix-3Q>6E`tD>cAG2bbiqrF_YTGjgNue0csixmy}|AwICYTdk;-{FnUJa=TP_*v2miDd4v^ZIc6> z?sc075wg#HeT$hiJN?2FYOL*2%lkGD+7?ZwyW4M@L&#~qYkTv+i=AtSH}LPam&me% zZ`?7PEO9@(b0LxI%;)R>dPNTH%y(}O=lQ$Lf#msGj&knV6-7?DFYNjosirC3V-Ebj zLoLk?{>7dxa?9C#?uVO*(;e~AXd=hYSImJ^_^s!o3FJk=C_@i}^kGPMN^R?!B!bA13avZ6eNVvixx+9|Z1icmcM9NL& ztx8&hQ%01$8(0wWRCG#)%l#twz|sioQyh^Ie17Siz|G;c#IxO|qrriEs{e#KxJnAo z@ra6;=dWLsq&v_aK{I_RNfv0q(88d_L2C^y30exY-p~d@8^JRwS_JL}XfL!vXvcU~ zMdVoNE06)r49xuB}q%* zCT|5}du^Ab)dn12CP~{3cq06d#{mOgwNaAF4Y=WPN&341AK4>GR}FY}xg^~);H&Vq zxh{MtMfnf&CCLTnFoZ9+lcdcii4VCGPU`V#ciK7rwLy~V;M)=yJ)0m&1M2DUjnCj~ zssVp+N|N3&;Fkf;HsBusUTMIe{Y{ec4A>0tP6KXP0ah4rI^fF)4R{>j3k|pv$cZz2-*JZ| z;RkEm36=zg3bJ8L$QLIR-qR54syGZ{5IW k+-)m=wSjNDy9oa8BH>;;`MYiWm3xEXe<1eU8{X)D0N-8DZ~y=R diff --git a/bin/ikarus-collect.c b/bin/ikarus-collect.c index 0941f98..49ec8f5 100644 --- a/bin/ikarus-collect.c +++ b/bin/ikarus-collect.c @@ -369,6 +369,7 @@ ik_collect(int mem_req, ikpcb* pcb){ #ifndef NDEBUG verify_integrity(pcb, "entry"); #endif + { /* ACCOUNTING */ int bytes = ((int)pcb->allocation_pointer) - ((int)pcb->heap_base); @@ -409,6 +410,7 @@ ik_collect(int mem_req, ikpcb* pcb){ */ scan_dirty_pages(&gc); + collect_stack(&gc, pcb->frame_pointer, pcb->frame_base - wordsize); pcb->next_k = add_object(&gc, pcb->next_k, "next_k"); pcb->symbol_table = add_object(&gc, pcb->symbol_table, "symbol_table"); @@ -826,7 +828,6 @@ forward_guardians(gc_t* gc){ ik_munmap(cache, sizeof(ik_ptr_page)); cache = next; } - //exit(-1); } static void @@ -851,7 +852,15 @@ empty_dropped_guardians(gc_t* gc){ ref(a, off_cdr) = false_object; ref(tc, off_cdr) = a; pcb->dirty_vector[page_index(tc)] = -1; - pcb->dirty_vector[page_index(d)] = -1; + //pcb->dirty_vector[page_index(d)] = -1; + { + int dgen = pcb->segment_vector[page_index(d)] & gen_mask; + if( (dgen > (pcb->segment_vector[page_index(obj)] & gen_mask)) + || + (dgen > (pcb->segment_vector[page_index(a)] & gen_mask))){ + pcb->dirty_vector[page_index(d)] = -1; + } + } } ik_ptr_page* next = src->next; ik_munmap(src, sizeof(ik_ptr_page)); @@ -1628,9 +1637,10 @@ fix_weak_pointers(gc_t* gc){ int collect_gen = gc->collect_gen; while(i < hi_idx){ unsigned int t = segment_vec[i]; - if((t & type_mask) == weak_pairs_type){ - int gen = t & gen_mask; - if(gen > collect_gen){ + if((t & (type_mask|new_gen_mask)) == + (weak_pairs_type|new_gen_tag)){ + //int gen = t & gen_mask; + if (1) { //(gen > collect_gen){ ikp p = (ikp)(i << pageshift); ikp q = p + pagesize; while(p < q){ @@ -1640,13 +1650,22 @@ fix_weak_pointers(gc_t* gc){ if(tag != immediate_tag){ ikp fst = ref(x, -tag); if(fst == forward_ptr){ - ref(p, 0) = ref(x, wordsize-tag); } - else { + ref(p, 0) = ref(x, wordsize-tag); + } else { int x_gen = segment_vec[page_index(x)] & gen_mask; if(x_gen <= collect_gen){ - ref(p, 0) = bwp_object; } } } } - p += (2*wordsize); } } } - i++; } } + ref(p, 0) = bwp_object; + } + } + } + } + p += (2*wordsize); + } + } + } + i++; + } +} static unsigned int dirty_mask[generation_count] = { 0x88888888, @@ -1750,38 +1769,6 @@ scan_dirty_code_page(gc_t* gc, int page_idx, unsigned int mask){ dirty_vec[page_idx] = new_d; } -/* scanning dirty weak pointers should add the cdrs of the pairs - * but leave the cars unmodified. The dirty mask is also kept - * unmodified so that the after-pass fixes it. - */ - -static void -scan_dirty_weak_pointers_page(gc_t* gc, int page_idx, int mask){ - unsigned int* dirty_vec = gc->pcb->dirty_vector; - unsigned int d = dirty_vec[page_idx]; - unsigned int masked_d = d & mask; - ikp p = (ikp)(page_idx << pageshift); - int j; - for(j=0; jsegment_vector; } else if (type == weak_pairs_type){ - if((t & gen_mask) > collect_gen){ - scan_dirty_weak_pointers_page(gc, i, mask); - dirty_vec = pcb->dirty_vector; - segment_vec = pcb->segment_vector; - } + scan_dirty_pointers_page(gc, i, mask); + dirty_vec = pcb->dirty_vector; + segment_vec = pcb->segment_vector; } else if (type == code_type){ if((t & gen_mask) > collect_gen){ @@ -1879,8 +1864,9 @@ fix_new_pages(gc_t* gc){ int i = lo_idx; while(i < hi_idx){ unsigned int t = segment_vec[i]; - if((t & new_gen_mask) || - ((t & type_mask) == weak_pairs_type)){ +// if((t & new_gen_mask) || +// ((t & type_mask) == weak_pairs_type)){ + if(t & new_gen_mask){ segment_vec[i] = t & ~new_gen_mask; int page_gen = t & old_gen_mask; if(((t & type_mask) == pointers_type) || diff --git a/src/ikarus.hash-tables.guardians.ss b/src/ikarus.hash-tables.guardians.ss deleted file mode 100644 index 47531f5..0000000 --- a/src/ikarus.hash-tables.guardians.ss +++ /dev/null @@ -1,273 +0,0 @@ - -(library (ikarus hash-tables) - (export hash-table? make-hash-table get-hash-table put-hash-table!) - (import - (ikarus system $vectors) - (ikarus system $fx) - (except (ikarus) hash-table? make-hash-table - get-hash-table put-hash-table!)) - - (define-syntax inthash - (syntax-rules () - [(_ x) x])) - - - (define-record ht (g v count threashold rehashed)) - (define-record lk (key val next)) - - (define make-transport-guardian - (lambda () - (define loop - (lambda (m g) - (and m - (let ([x (car m)]) - (if (bwp-object? x) - (loop (g) g) - (begin (g m) x)))))) - (let ([g (make-guardian)]) - (case-lambda - [(x) (g (weak-cons x #f))] - [() (loop (g) g)])))) - - (define initial-size 8) - - ;;; assq-like lookup - (define direct-lookup - (lambda (x b) - (if (fixnum? b) - #f - (if (eq? x (lk-key b)) - b - (direct-lookup x (lk-next b)))))) - - (define rehash-lookup - (lambda (h g x) - (cond - [(g) => - (lambda (b) - (re-add! h b) - (if (eq? x (lk-key b)) - b - (rehash-lookup h g x)))] - [else #f]))) - - (define get-bucket-index - (lambda (b) - (let ([next (lk-next b)]) - (if (fixnum? next) - next - (get-bucket-index next))))) - - (define replace! - (lambda (lb x y) - (let ([n (lk-next lb)]) - (cond - [(eq? n x) - (set-lk-next! lb y)] - [else - (replace! n x y)])))) - - (define re-add! - (lambda (h b) - (let ([vec (ht-v h)] - [next (lk-next b)]) - ;;; first remove it from its old place - (set-ht-rehashed! h (fx+ (ht-rehashed h) 1)) - (let ([idx - (if (fixnum? next) - next - (get-bucket-index next))]) - (let ([fst ($vector-ref vec idx)]) - (cond - [(eq? fst b) - ($vector-set! vec idx next)] - [else - (replace! fst b next)]))) - (let ([k (lk-key b)]) - (let ([ih (inthash (pointer-value k))]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([n ($vector-ref vec idx)]) - (set-lk-next! b n) - ($vector-set! vec idx b)))))))) - - (define get-hash - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (ht-v h)]) - (let ([ih (inthash pv)]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([b ($vector-ref vec idx)]) - (cond - [(or (direct-lookup x b) (rehash-lookup h (ht-g h) x)) - => - (lambda (b) - (lk-val b))] - [else v]))))))) - - (define put-hash! - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (ht-v h)]) - (let ([ih (inthash pv)]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([b ($vector-ref vec idx)]) - (cond - [(or (direct-lookup x b) (rehash-lookup h (ht-g h) x)) - => - (lambda (b) - (set-lk-val! b v))] - [else - (let ([bucket (make-lk x v ($vector-ref vec idx))]) - ((ht-g h) bucket) - (if ($fx= (pointer-value x) pv) - ($vector-set! vec idx bucket) - (let* ([ih (inthash (pointer-value x))] - [idx - ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (set-lk-next! bucket ($vector-ref vec idx)) - ($vector-set! vec idx bucket)))) - (let ([ct (ht-count h)]) - (set-ht-count! h ($fx+ 1 ct)) - (when ($fx> ct ($vector-length vec)) - (enlarge-table h)))]))))))) - - (define insert-b - (lambda (b vec mask) - (let* ([x (lk-key b)] - [pv (pointer-value x)] - [ih (inthash pv)] - [idx ($fxlogand ih mask)] - [next (lk-next b)]) - (set-lk-next! b ($vector-ref vec idx)) - ($vector-set! vec idx b) - (unless (fixnum? next) - (insert-b next vec mask))))) - - (define move-all - (lambda (vec1 i n vec2 mask) - (unless ($fx= i n) - (let ([b ($vector-ref vec1 i)]) - (unless (fixnum? b) - (insert-b b vec2 mask)) - (move-all vec1 ($fx+ 1 i) n vec2 mask))))) - - (define enlarge-table - (lambda (h) - (let* ([vec1 (ht-v h)] - [n1 ($vector-length vec1)] - [n2 ($fxsll n1 1)] - [vec2 (make-base-vec n2)]) - (move-all vec1 0 n1 vec2 ($fx- n2 1)) - (set-ht-v! h vec2)))) - - (define make-base-vec - (lambda (n) - (init-vec (make-vector n) 0 n))) - - (define init-vec - (lambda (v i n) - (if ($fx= i n) - v - (begin - ($vector-set! v i i) - (init-vec v ($fx+ 1 i) n))))) - - ;;; public interface - (define hash-table? - (lambda (x) (ht? x))) - - (define make-hash-table - (lambda () - (make-ht (make-transport-guardian) - (init-vec (make-vector initial-size) 0 initial-size) - 0 - initial-size - 0))) - - (define get-hash-table - (lambda (h x v) - (if (ht? h) - (get-hash h x v) - (error 'get-hash-table "~s is not a hash table" h)))) - - (define put-hash-table! - (lambda (h x v) - (if (ht? h) - (put-hash! h x v) - (error 'put-hash-table! "~s is not a hash table" h)))) - - (define hasht-rehash-count - (lambda (h) - (if (ht? h) - (ht-rehashed h) - (error 'hasht-rehash-count "~s is not a hash table" h)))) - - (define hasht-reset-count! - (lambda (h) - (if (ht? h) - (set-ht-rehashed! h 0) - (error 'hasht-rehash-count "~s is not a hash table" h)))) -) - -#!eof - -(import ght) - -(define (test1) - (printf "test1 ...\n") - (let ([ls (let f ([i 100000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) (put-hash-table! ht x x)) ls) - (let f ([i 1000]) - (unless (fx= i 0) - (collect) - (f (fx- i 1)))) - (for-each - (lambda (x) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test1 "failed"))) - ls))) - (printf "passed test1\n")) - -(define (test2) - (printf "test2 ...\n") - (let ([ls (let f ([i 10000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) (put-hash-table! ht x x)) ls) - (for-each - (lambda (x) - (collect) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test2 "failed"))) - ls))) - (printf "passed test2\n")) - -(define (test3) - (printf "test3 ...\n") - (let ([ls (let f ([i 10000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) - (collect) - (put-hash-table! ht x x)) - ls) - (for-each - (lambda (x) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test3 "failed"))) - ls))) - (printf "passed test3\n")) - -(define (test-all) - (test1) - (test2) - (test3)) - diff --git a/src/ikarus.hash-tables.rehashing.ss b/src/ikarus.hash-tables.rehashing.ss deleted file mode 100644 index f506cbb..0000000 --- a/src/ikarus.hash-tables.rehashing.ss +++ /dev/null @@ -1,174 +0,0 @@ - -(library (ikarus hash-tables) - (export hash-table? make-hash-table get-hash-table put-hash-table!) - (import - (except (ikarus) hash-table? make-hash-table - get-hash-table put-hash-table!)) - - (define-syntax inthash - (syntax-rules () - [(_ x) x])) - - (define-record hasht (vec count gckey)) - - (define stretch - (lambda (h v n) - (set-hasht-gckey! h (collect-key)) - (let ([newv (make-vector (fx* n 2) '())] - [mask (fx- (* n 2) 1)]) - (do ([i 0 (fx+ i 1)]) - ((fx= i n)) - (let f ([b (vector-ref v i)]) - (unless (null? b) - (let ([idx (fxlogand (inthash (pointer-value (caar b))) mask)] - [next (cdr b)]) - (set-cdr! b (vector-ref newv idx)) - (vector-set! newv idx b) - (f next))))) - (set-hasht-vec! h newv)))) - - (define rehash - (lambda (h v) - (set-hasht-gckey! h (collect-key)) - (let ([n (vector-length v)]) - (let f ([i 0]) - (if (fx= i n) - (void) - (let ([b (vector-ref v i)]) - (if (null? b) - (f (fx+ i 1)) - (begin - (vector-set! v i '()) - (let g ([i (fx+ i 1)] [loc (last-pair b)]) - (if (fx= i n) - (let ([mask (fx- n 1)]) - (void) - (let f ([b b]) - (unless (null? b) - (let ([idx (fxlogand (inthash (pointer-value (caar b))) mask)]) - (let ([next (cdr b)]) - (set-cdr! b (vector-ref v idx)) - (vector-set! v idx b) - (f next)))))) - (let ([b (vector-ref v i)]) - (if (null? b) - (g (fx+ i 1) loc) - (begin - (vector-set! v i '()) - (set-cdr! loc b) - (g (fx+ i 1) (last-pair b))))))))))))))) - - (define get-hash - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (hasht-vec h)]) - (let ([ih (inthash pv)]) - (let ([idx (fxlogand ih (fx- (vector-length vec) 1))]) - (let ([b (vector-ref vec idx)]) - (cond - [(assq x b) => cdr] - [(not (eq? (hasht-gckey h) (collect-key))) - (rehash h vec) - (get-hash h x v)] - [else v]))))))) - - (define put-hash! - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (hasht-vec h)]) - (let ([ih (inthash pv)]) - (let ([idx (fxlogand ih (fx- (vector-length vec) 1))]) - (let ([b (vector-ref vec idx)]) - (cond - [(assq x b) => (lambda (a) (set-cdr! a v))] - [(not (eq? (hasht-gckey h) (collect-key))) - (rehash h vec) - (put-hash! h x v)] - [else - (vector-set! vec idx (cons (cons x v) b)) - (let ([ct (hasht-count h)]) - (set-hasht-count! h (fxadd1 ct)) - (let ([n (vector-length vec)]) - (when (fx> ct n) - (stretch h vec n))))]))))))) - - ;;; public interface - (define (hash-table? x) (hasht? x)) - - (define (make-hash-table) - (make-hasht (make-vector 32 '()) 0 (collect-key))) - - (define get-hash-table - (lambda (h x v) - (if (hasht? h) - (get-hash h x v) - (error 'get-hash-table "~s is not a hash table" h)))) - - (define put-hash-table! - (lambda (h x v) - (if (hasht? h) - (put-hash! h x v) - (error 'put-hash-table! "~s is not a hash table" h)))) -) - -#!eof - -(import rht) - -(define (test1) - (printf "test1 ...\n") - (let ([ls (let f ([i 100000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) (put-hash-table! ht x x)) ls) - (let f ([i 1000]) - (unless (fx= i 0) - (collect) - (f (fx- i 1)))) - (for-each - (lambda (x) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test1 "failed"))) - ls))) - (printf "passed test1\n")) - -(define (test2) - (printf "test2 ...\n") - (let ([ls (let f ([i 10000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) (put-hash-table! ht x x)) ls) - (for-each - (lambda (x) - (collect) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test2 "failed"))) - ls))) - (printf "passed test2\n")) - -(define (test3) - (printf "test3 ...\n") - (let ([ls (let f ([i 10000] [ac '()]) - (cond - [(fx= i 0) ac] - [else (f (fx- i 1) (cons (cons i i) ac))]))]) - (let ([ht (make-hash-table)]) - (for-each (lambda (x) - (collect) - (put-hash-table! ht x x)) - ls) - (for-each - (lambda (x) - (unless (eq? x (get-hash-table ht x #f)) - (error 'test3 "failed"))) - ls))) - (printf "passed test3\n")) - -(define (test-all) - (test1) - (test2) - (test3)) diff --git a/src/ikarus.hash-tables.ss b/src/ikarus.hash-tables.ss deleted file mode 100644 index 0aa3917..0000000 --- a/src/ikarus.hash-tables.ss +++ /dev/null @@ -1,222 +0,0 @@ - -(library (ikarus hash-tables) - (export hash-table? make-hash-table get-hash-table put-hash-table!) - (import - (ikarus system $pairs) - (ikarus system $vectors) - (ikarus system $tcbuckets) - (ikarus system $fx) - (except (ikarus) hash-table? make-hash-table get-hash-table - put-hash-table!)) - - (define-record hasht (vec count tc)) - - ;;; directly from Dybvig's paper - (define tc-pop - (lambda (tc) - (let ([x ($car tc)]) - (if (eq? x ($cdr tc)) - #f - (let ([v ($car x)]) - ($set-car! tc ($cdr x)) - ($set-car! x #f) - ($set-cdr! x #f) - v))))) - - (define-syntax inthash - (syntax-rules () - [(_ x) x])) - - #;(define-syntax inthash - (syntax-rules () - [(_ x) ($fxinthash x)])) - - #;(define inthash - (lambda (key) - ;static int inthash(int key) { /* from Bob Jenkin's */ - ; key += ~(key << 15); - ; key ^= (key >> 10); - ; key += (key << 3); - ; key ^= (key >> 6); - ; key += ~(key << 11); - ; key ^= (key >> 16); - ; return key; - ;} - (let* ([key ($fx+ key ($fxlognot ($fxsll key 15)))] - [key ($fxlogxor key ($fxsra key 10))] - [key ($fx+ key ($fxsll key 3))] - [key ($fxlogxor key ($fxsra key 6))] - [key ($fx+ key ($fxlognot ($fxsll key 11)))] - [key ($fxlogxor key ($fxsra key 16))]) - key))) - - ;;; assq-like lookup - (define direct-lookup - (lambda (x b) - (if (fixnum? b) - #f - (if (eq? x ($tcbucket-key b)) - b - (direct-lookup x ($tcbucket-next b)))))) - - (define rehash-lookup - (lambda (h tc x) - (cond - [(tc-pop tc) => - (lambda (b) - (if (eq? ($tcbucket-next b) #f) - (rehash-lookup h tc x) - (begin - (re-add! h b) - (if (eq? x ($tcbucket-key b)) - b - (rehash-lookup h tc x)))))] - [else #f]))) - - (define get-bucket-index - (lambda (b) - (let ([next ($tcbucket-next b)]) - (if (fixnum? next) - next - (get-bucket-index next))))) - - (define replace! - (lambda (lb x y) - (let ([n ($tcbucket-next lb)]) - (cond - [(eq? n x) - ($set-tcbucket-next! lb y) - (void)] - [else - (replace! n x y)])))) - - (define re-add! - (lambda (h b) - (let ([vec (hasht-vec h)] - [next ($tcbucket-next b)]) - ;;; first remove it from its old place - (let ([idx - (if (fixnum? next) - next - (get-bucket-index next))]) - (let ([fst ($vector-ref vec idx)]) - (cond - [(eq? fst b) - ($vector-set! vec idx next)] - [else - (replace! fst b next)]))) - ;;; reset the tcbucket-tconc FIRST - ($set-tcbucket-tconc! b (hasht-tc h)) - ;;; then add it to the new place - (let ([k ($tcbucket-key b)]) - (let ([ih (inthash (pointer-value k))]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([n ($vector-ref vec idx)]) - ($set-tcbucket-next! b n) - ($vector-set! vec idx b) - (void)))))))) - - (define get-hash - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (hasht-vec h)]) - (let ([ih (inthash pv)]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([b ($vector-ref vec idx)]) - (cond - [(or (direct-lookup x b) (rehash-lookup h (hasht-tc h) x)) - => - (lambda (b) - ($tcbucket-val b))] - [else v]))))))) - - (define put-hash! - (lambda (h x v) - (let ([pv (pointer-value x)] - [vec (hasht-vec h)]) - (let ([ih (inthash pv)]) - (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) - (let ([b ($vector-ref vec idx)]) - (cond - [(or (direct-lookup x b) (rehash-lookup h (hasht-tc h) x)) - => - (lambda (b) - ($set-tcbucket-val! b v) - (void))] - [else - (let ([bucket - ($make-tcbucket (hasht-tc h) x v ($vector-ref vec idx))]) - (if ($fx= (pointer-value x) pv) - ($vector-set! vec idx bucket) - (let* ([ih (inthash (pointer-value x))] - [idx - ($fxlogand ih ($fx- ($vector-length vec) 1))]) - ($set-tcbucket-next! bucket ($vector-ref vec idx)) - ($vector-set! vec idx bucket)))) - (let ([ct (hasht-count h)]) - (set-hasht-count! h ($fxadd1 ct)) - (when ($fx> ct ($vector-length vec)) - (enlarge-table h)))]))))))) - - (define insert-b - (lambda (b vec mask) - (let* ([x ($tcbucket-key b)] - [pv (pointer-value x)] - [ih (inthash pv)] - [idx ($fxlogand ih mask)] - [next ($tcbucket-next b)]) - ($set-tcbucket-next! b ($vector-ref vec idx)) - ($vector-set! vec idx b) - (unless (fixnum? next) - (insert-b next vec mask))))) - - (define move-all - (lambda (vec1 i n vec2 mask) - (unless ($fx= i n) - (let ([b ($vector-ref vec1 i)]) - (unless (fixnum? b) - (insert-b b vec2 mask)) - (move-all vec1 ($fxadd1 i) n vec2 mask))))) - - (define enlarge-table - (lambda (h) - (let* ([vec1 (hasht-vec h)] - [n1 ($vector-length vec1)] - [n2 ($fxsll n1 1)] - [vec2 (make-base-vec n2)]) - (move-all vec1 0 n1 vec2 ($fx- n2 1)) - (set-hasht-vec! h vec2)))) - - (define init-vec - (lambda (v i n) - (if ($fx= i n) - v - (begin - ($vector-set! v i i) - (init-vec v ($fxadd1 i) n))))) - - (define make-base-vec - (lambda (n) - (init-vec (make-vector n) 0 n))) - - ;;; public interface - (define (hash-table? x) (hasht? x)) - - (define (make-hash-table) - (let ([x (cons #f #f)]) - (let ([tc (cons x x)]) - (make-hasht (make-base-vec 32) 0 tc)))) - - (define get-hash-table - (lambda (h x v) - (if (hasht? h) - (get-hash h x v) - (error 'get-hash-table "~s is not a hash table" h)))) - - (define put-hash-table! - (lambda (h x v) - (if (hasht? h) - (put-hash! h x v) - (error 'put-hash-table! "~s is not a hash table" h)))) - -)