diff --git a/src/blister.c b/src/blister.c index cae2fe590f..4cd66f541f 100644 --- a/src/blister.c +++ b/src/blister.c @@ -284,17 +284,30 @@ Obj DoCopyBlist(Obj list, Int mut) { } +Obj CopyBlistImm ( + Obj list, + Int mut ) +{ + return list; +} + Obj CopyBlist ( Obj list, Int mut ) { - - /* don't change immutable objects */ - if ( ! IS_MUTABLE_OBJ(list) ) { - return list; - } - - return DoCopyBlist(list, mut); + Obj copy; + Obj tmp; + + copy = DoCopyBlist(list, mut); + /* leave a forwarding pointer */ + tmp = NEW_PLIST( T_PLIST, 2 ); + SET_LEN_PLIST( tmp, 2 ); + SET_ELM_PLIST( tmp, 1, ADDR_OBJ(list)[0] ); + SET_ELM_PLIST( tmp, 2, copy ); + ADDR_OBJ(list)[0] = tmp; + CHANGED_BAG(list); + RetypeBag( list, TNUM_OBJ(list) + COPYING ); + return copy; } Obj ShallowCopyBlist ( Obj list) @@ -308,11 +321,9 @@ Obj ShallowCopyBlist ( Obj list) ** *F CopyBlistCopy( , ) . . . . . . . copy a already copied blist */ -Obj CopyBlistCopy ( - Obj list, - Int mut ) +Obj CopyBlistCopy(Obj list, Int mut) { - return ADDR_OBJ(list)[0]; + return ELM_PLIST(ADDR_OBJ(list)[0], 2); } @@ -330,14 +341,13 @@ void CleanBlist ( ** *F CleanBlistCopy( ) . . . . . . . . . . . . . clean a copied blist */ -void CleanBlistCopy ( - Obj list ) +void CleanBlistCopy(Obj list) { - /* remove the forwarding pointer */ - ADDR_OBJ(list)[0] = ADDR_OBJ( ADDR_OBJ(list)[0] )[0]; + /* remove the forwarding pointer */ + ADDR_OBJ(list)[0] = ELM_PLIST(ADDR_OBJ(list)[0], 1); - /* now it is cleaned */ - RetypeBag( list, TNUM_OBJ(list) - COPYING ); + /* now it is cleaned */ + RetypeBag(list, TNUM_OBJ(list) - COPYING); } @@ -2670,7 +2680,7 @@ static Int InitKernel ( /* install the copy functions */ for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) { CopyObjFuncs [ t1 ] = CopyBlist; - CopyObjFuncs [ t1 +IMMUTABLE ] = CopyBlist; + CopyObjFuncs [ t1 +IMMUTABLE ] = CopyBlistImm; CopyObjFuncs [ t1 +COPYING ] = CopyBlistCopy; CopyObjFuncs [ t1 +IMMUTABLE +COPYING ] = CopyBlistCopy; CleanObjFuncs[ t1 ] = CleanBlist;