Skip to content

Commit 394826d

Browse files
committed
support SoA indirections when GC is off
1 parent caa8364 commit 394826d

File tree

5 files changed

+57
-19
lines changed

5 files changed

+57
-19
lines changed

gibbon-compiler/examples/soa_examples/packedList.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,14 @@ sumList lst = case lst of
4040
sumRst = sumList rst
4141
in j + i' + sumRst
4242

43+
id :: List -> List
44+
id lst = lst
45+
46+
4347
gibbon_main = let
4448
pi = mkPackedInt 10
4549
lst = mkList 100
46-
lst' = add1 lst
50+
lst' = id (add1 lst)
4751
in (sumList lst')
4852

4953

gibbon-compiler/examples/soa_examples/tree.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,14 +28,17 @@ sumTree tr =
2828
Leaf n m -> n
2929
Node i j k _ l r ll rr -> i + j + k + (sumTree l) + (sumTree r) + (sumTree ll) + (sumTree rr)
3030

31+
id :: Tree -> Tree
32+
id tree = tree
33+
3134
gibbon_main =
32-
let tree = mkTree 7
33-
tree' = add1Tree tree
35+
let tree = id (mkTree 7)
36+
tree' = id (add1Tree tree)
3437
val = sumTree tree'
3538
_ = printsym (quote "(sum: ")
3639
_ = printint val
3740
_ = printsym (quote ", rightmost: ")
3841
rmost = rightmost tree'
3942
_ = printint rmost
4043
_ = printsym (quote ")\n\n")
41-
in ()
44+
in val

gibbon-compiler/src/Gibbon/Passes/AddCastInstructions.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -456,6 +456,7 @@ addCastsExp fundef cenv env ex =
456456
Ext (Assert e) -> do
457457
e' <- go e
458458
pure $ Ext $ Assert e'
459+
Ext (CastPtr v ty) -> pure ex
459460
Ext {} -> error $ "addCastsExp : Unexpected instruction " ++ show ex
460461
MapE {} -> error "addCastsExp: MapE TODO"
461462
FoldE {} -> error "addCastsExp: FoldE TODO"

gibbon-compiler/src/Gibbon/Passes/Cursorize.hs

Lines changed: 34 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1362,7 +1362,12 @@ cursorizePackedExp freeVarToVarEnv lenv ddfs fundefs denv tenv senv ex =
13621362
CursorTy -> do
13631363
rnd' <- cursorizeExp freeVarToVarEnv lenv ddfs fundefs denv tenv senv rnd
13641364
after_indirection <- gensym "aft_indirection"
1365-
LetE (d',[], CursorTy, Ext $ WriteTaggedCursor aft_dloc rnd') <$>
1365+
casted_var <- gensym "cast"
1366+
let rnd_var = case rnd' of
1367+
VarE v -> v
1368+
_ -> error "Did not expected variable!"
1369+
LetE (casted_var, [], CursorTy, Ext $ CastPtr rnd_var CursorTy) <$>
1370+
LetE (d',[], CursorTy, Ext $ WriteTaggedCursor aft_dloc (VarE casted_var)) <$>
13661371
LetE (after_indirection,[], CursorTy, VarE d') <$> --Ext $ AddCursor aft_dloc (L3.LitE 8)
13671372
go2 marker_added freeVarToVarEnv after_indirection from_rec_end aft_flocs rst
13681373

@@ -1587,13 +1592,34 @@ cursorizePackedExp freeVarToVarEnv lenv ddfs fundefs denv tenv senv ex =
15871592
Just var -> var
15881593
go freeVarToVarEnv tenv senv (DataConE from dcon [VarE locs_var])
15891594
else do
1590-
start <- gensym "start"
1591-
end <- gensym "end"
1592-
return $ Di $
1593-
(mkLets [("_",[],ProdTy [],Ext (IndirectionBarrier tycon (((unwrapLocVar . toLocVar) from),((unwrapLocVar . toLocVar) from_reg),((unwrapLocVar . toLocVar) to),((unwrapLocVar . toLocVar) to_reg)))),
1594-
(start, [], CursorTy, VarE ((unwrapLocVar . toLocVar) from)),
1595-
(end, [], CursorTy, Ext $ AddCursor ((unwrapLocVar . toLocVar) from) (L3.LitE 9))]
1596-
(MkProdE [VarE start, VarE end]))
1595+
case (toLocVar from) of
1596+
Single{} -> do
1597+
start <- gensym "start"
1598+
end <- gensym "end"
1599+
let from_var = case M.lookup (fromLocArgToFreeVarsTy from) freeVarToVarEnv of
1600+
Nothing -> error "Did not find variable for location!"
1601+
Just var -> var
1602+
let to_var = case M.lookup (fromLocArgToFreeVarsTy to) freeVarToVarEnv of
1603+
Nothing -> error "Did not find variable for location!"
1604+
Just var -> var
1605+
let reg_from_reg = fromLocVarToRegVar (toLocVar from_reg)
1606+
let reg_to_reg = fromLocVarToRegVar (toLocVar to_reg)
1607+
let from_reg_var = case M.lookup (fromRegVarToFreeVarsTy reg_from_reg) freeVarToVarEnv of
1608+
Nothing -> error "Did not find variable for location!"
1609+
Just var -> var
1610+
let to_reg_var = case M.lookup (fromRegVarToFreeVarsTy reg_to_reg) freeVarToVarEnv of
1611+
Nothing -> error "Did not find variable for location!"
1612+
Just var -> var
1613+
-- VS : [09/20/2025 -- For SoA case, indirection with gc need a bit more thinking]
1614+
-- One way could be to call indirection barrier seperately on every buffer/region
1615+
-- Then follow them seperately for every region in the case.
1616+
-- For now i'm erroring out but this needs more thought.
1617+
return $ Di $
1618+
(mkLets [("_",[],ProdTy [],Ext (IndirectionBarrier tycon ((from_var),(from_reg_var),(to_var),(to_reg_var)))),
1619+
(start, [], CursorTy, VarE (from_var)),
1620+
(end, [], CursorTy, Ext $ AddCursor (from_var) (L3.LitE 9))]
1621+
(MkProdE [VarE start, VarE end]))
1622+
SoA _ flds -> error "Indirection when GC is enabled is not implemented for SoA! Please turn off the GC!"
15971623

15981624
AddFixed{} -> error "cursorizePackedExp: AddFixed not handled."
15991625

gibbon-compiler/src/Gibbon/Passes/ThreadRegions2.hs

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -687,13 +687,17 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd
687687
rlocs_env' = updRLocsEnv (unTy2 ty) rlocs_env
688688
wlocs_env' = foldr (\loc2 acc -> M.delete loc2 acc) wlocs_env (NewL2.locsInTy ty)
689689
bod' <- threadRegionsExp ddefs fundefs fnLocArgs renv env2' lfenv rlocs_env' wlocs_env' pkd_env' region_locs ran_env indirs redirs bod
690-
let boundscheck =
691-
let locarg = a'
692-
regarg = b'
693-
-- bc = boundsCheck ddefs tcon
694-
bc = 18
695-
in LetE ("_", [], MkTy2 IntTy, Ext $ BoundsCheck bc regarg locarg)
696-
pure $ boundscheck $ LetE (v, locs, ty, (Ext (IndirectionE tcon dcon (a', b') (c', d') cpy))) bod'
690+
-- VS: 09/20/2025
691+
-- Removing bounds check for now since assuming that the function should do this and may not need this.
692+
-- TODO: this might not be true though
693+
--let boundscheck =
694+
-- let locarg = a'
695+
-- regarg = b'
696+
-- -- bc = boundsCheck ddefs tcon
697+
-- bc = 18
698+
-- in LetE ("_", [], MkTy2 IntTy, Ext $ BoundsCheck bc regarg locarg)
699+
--pure $ boundscheck $ LetE (v, locs, ty, (Ext (IndirectionE tcon dcon (a', b') (c', d') cpy))) bod'
700+
pure $ LetE (v, locs, ty, (Ext (IndirectionE tcon dcon (a', b') (c', d') cpy))) bod'
697701
Ext (StartOfPkdCursor cur) -> do
698702
let (PackedTy _ loc) = unTy2 (lookupVEnvLocVar (fromVarToFreeVarsTy cur) env2)
699703
case M.lookup loc pkd_env of

0 commit comments

Comments
 (0)