1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Joachim Schimpf. 20% 21% END LICENSE BLOCK 22% ---------------------------------------------------------------------- 23% System: ECLiPSe Constraint Logic Programming System 24% Component: ECLiPSe III compiler 25% Version: $Id: compiler_varclass.ecl,v 1.15 2009/07/16 09:11:23 jschimpf Exp $ 26% 27% Related paper (although we haven't used any of their algorithms): 28% H.Vandecasteele,B.Demoen,G.Janssens: Compiling Large Disjunctions 29% KU Leuven 2001 30% ---------------------------------------------------------------------- 31 32 33:- module(compiler_varclass). 34 35:- comment(summary, "ECLiPSe III compiler - variable classification"). 36:- comment(copyright, "Cisco Technology Inc"). 37:- comment(author, "Joachim Schimpf"). 38:- comment(date, "$Date: 2009/07/16 09:11:23 $"). 39 40:- comment(desc, html(" 41 This pass (consisting of several phases) does the following jobs: 42 <UL> 43 <LI> 44 Computing the lifetimes of variables, thus classifying them into void 45 variables (for which singleton warnings may be generated), temporary 46 variables (whose lifetime does not extend across regular predicate calls), 47 and permanent variables (which require an environment slot). This 48 information is filled into the class-slots of the Body's variable{} 49 descriptors. Note that variables of the same name which occur only in 50 alternative disjunctive branches, are considered separate variables, 51 and may be assigned difference storage classes. 52 <LI> 53 Decide whether values should be passed into disjunctions via environment 54 variables or as pseudo-aruments via argument registers. 55 <LI> 56 The second phase assigns concrete environment slots to variables, 57 ordered such that lifetimes that end later are put in slots with 58 lower numbers (if possible), which enables environment trimming. 59 It also computes the total environment size needed. 60 <LI> 61 The third phase computes environment activity maps for every relevant 62 position in the code. These are needed to tell the garbage collector 63 which slots are not yet initialised, and which slots lifetime has 64 already ended even if the environment hasn't been trimmed (yet). 65 </UL> 66 <P> 67 Note that, in this context, we talk about 'first' and 'last' occurrences 68 only with a granularity of 'call positions', e.g. all occurrences of a 69 variable in the first chunk it occurs in are considered 'first'. 70 That way, later compiler stages are still free to reorder operations 71 within each chunk without affecting the variable classification. 72 <P> 73 This pass recognises the options 'print_lifetimes' (on/off) and 74 'warnings' (on/off) for singleton variable warnings. 75")). 76 77 78:- lib(hash). 79 80:- use_module(compiler_common). 81:- use_module(compiler_map). 82 83 84% struct(slot) describes one true, distinct variable. There may be more 85% of those than there are variables in the source, because we classify 86% variables in parallel disjunctive branches as being distinct. 87 88:- local struct(slot( % one for every truly distinct variable 89 source_info, % for error messages only 90 firstpos, % position of first occurrence 91 % (must be first for sorting!) 92 lastpos, % position of last occurrence 93 class % shared with all occurrences (struct(variable)) 94 )). 95 96:- comment(struct(slot), [ 97 summary:"Temporary data structure during computation of lifetimes", 98 fields:[ 99 firstpos:"call position of first variable occurrence", 100 lastpos:"call position of last variable occurrence", 101 class:"shared class-field of all variable occurrences" 102 ], 103 see_also:[struct(variable)] 104]). 105 106% Maybe we could speed up processing by sharing the variable descriptors 107% for each chunk, and keeping them separately. This would benefit the passes 108% compute_lifetimes and assign_env_slots - they would not have to deal 109% with multiple occurrences in the same chunk. 110 111 112%---------------------------------------------------------------------- 113% Variable lifetimes and detection of false sharing 114% 115% We build a map that stores for each variable the first and last occurrences 116% (in terms of call positions). This is needed for classifying variables 117% as permanent. We are not interested to know which occurrence _within_ a chunk 118% is first, this will be determined later when generating code for the chunk. 119% This has the advantage that everything within the chunk can still be 120% reordered after this pass. 121% 122% Because of disjunctive branches, there can be more than one 123% first and last occurrence of each variable. Moreover, variables 124% with the same name in different branches are really different 125% variables, so this pass finds out how many different variables 126% there really are. 127% 128% The disjunctions are conceptually traversed in parallel. 129% When joining up, we merge the branches's maps into one. 130% 131% Data structures: 132% Variable occurrence: 133% variable(VarId, IsAFirst, IsALast, ClassAndPermLocation) 134% Maintain map of: 135% VarId - [slot(FirstPos,LastPos,LastFlag,Location), ...] 136% one slot for each truly distinct variable 137% 138% The two interesting operations are 139% 140% - registering a new occurrence of a variable 141% - merging the information when disjunctive branches join up 142% 143% 144% TODO: could keep slot lists in reverse order wrt firstpos, 145% then they could be merged more efficiently. 146%---------------------------------------------------------------------- 147 148:- comment(classify_variables/3, [ 149 summary:"Compute variable sharing, lifetimes and storage locations", 150 amode:classify_variables(+,+,+), 151 args:[ 152 "Body":"Normalised predicate", 153 "EnvSize":"Extra environment slots needed", 154 "Options":"options-structure" 155 ], 156 see_also:[print_occurrences/1] 157]). 158 159:- export classify_variables/3. 160classify_variables(Body, EnvSize, Options) :- 161 verify EnvSize == 0, % not yet done 162 compiler_map:init(Lifetimes0), 163 compute_lifetimes(Body, nohead, _PredHead, Lifetimes0, Lifetimes), 164 assign_env_slots(Lifetimes, MaxEnvSize, Options), 165 mark_env_activity(Body, MaxEnvSize), 166 ( Options = options{print_lifetimes:on} -> 167 printf("------ Environment size %d ------%n", [EnvSize]), 168 print_occurrences(Lifetimes) 169 ; 170 true 171 ). 172 173 174compute_lifetimes([], _PredHead, nohead, Map, Map). 175compute_lifetimes([Goal|Goals], PredHead0, PredHead, Map0, Map) :- 176 compute_lifetimes(Goal, PredHead0, PredHead1, Map0, Map1), 177 compute_lifetimes(Goals, PredHead1, PredHead, Map1, Map). 178compute_lifetimes(disjunction{branches:Branches,callpos:DisjPos, 179 branchlabels:BLA, indexvars:IndexArgs, 180 arity:Arity,args:DisjArgs,branchheadargs:HeadArgsArray}, 181 PredHead, nohead, Map0, Map) :- 182 % Index variables are accessed just before the disjunction 183 prev_call_pos(DisjPos, PreDisjPos), 184 compute_lifetimes_term(PreDisjPos, IndexArgs, Map0, Map1), 185 % Select pseudo-arguments to pass into the disjunction 186 select_pseudo_arguments(Branches, PredHead, PreDisjPos, Map1, Map2, DisjArgs, Arity), 187 ( DisjArgs == [] -> 188 HeadArgsArray = [] % instead of []([],...,[]), save some space 189 ; 190 arity(BLA, NBranches), 191 dim(HeadArgsArray, [NBranches]) 192 ), 193 ( 194 foreach(Branch,Branches), 195 foreach(BranchMap,BranchMaps), 196 count(I,1,_), 197 param(Map2,DisjArgs,HeadArgsArray,DisjPos,Arity) 198 do 199 % prefix pseudo-head arguments to the branch 200 make_branch_head(I, HeadArgsArray, DisjArgs, HeadArgs), 201 append(DisjPos, [I,1], BranchFirstPos), 202 compute_lifetimes_term(BranchFirstPos, HeadArgs, Map2, Map3), 203 compute_lifetimes(Branch, Arity-HeadArgs, _PredHead, Map3, BranchMap) 204 ), 205 merge_branches(DisjPos, BranchMaps, Map). 206compute_lifetimes(Goal, PredHead0, PredHead, Map0, Map) :- 207 Goal = goal{kind:Kind,callpos:GoalPos,args:Args,functor:_/Arity}, 208 ( Kind == head -> verify PredHead0==nohead, PredHead = Arity-Args 209 ; Kind == simple -> PredHead = PredHead0 210 ; PredHead = nohead 211 ), 212 compute_lifetimes_term(GoalPos, Args, Map0, Map). 213 214 compute_lifetimes_term(CallPos, [X|Xs], Map0, Map) :- 215 compute_lifetimes_term(CallPos, X, Map0, Map1), 216 compute_lifetimes_term(CallPos, Xs, Map1, Map). 217 compute_lifetimes_term(CallPos, Occurrence, Map0, Map) :- 218 Occurrence = variable{}, 219 register_occurrence(CallPos, Occurrence, Map0, Map). 220 compute_lifetimes_term(CallPos, attrvar{variable:Avar,meta:Meta}, Map0, Map) :- 221 compute_lifetimes_term(CallPos, Avar, Map0, Map1), 222 compute_lifetimes_term(CallPos, Meta, Map1, Map). 223 compute_lifetimes_term(CallPos, structure{args:Args}, Map0, Map) :- 224 compute_lifetimes_term(CallPos, Args, Map0, Map). 225 compute_lifetimes_term(_CallPos, Term, Map, Map) :- atomic(Term). 226 227 228% When encountering a variable VarId at CallPos: 229% 230% VarId not seen at all so far: 231% - add new slot entry 232% - it's the first and last occurrence 233% 234% VarId has one slot: 235% - it's a new last ocurrence of that variable 236% - update the slot's last-information 237% 238% VarId has multiple slots: 239% - the new occurrence means the multiple slots must be merged 240% - the summary slot takes the common prefix of all first occurrences 241% - the current occurrence is the last 242% - the locations are all unified 243 244register_occurrence(CallPos, Occurrence, Map0, Map) :- 245 Occurrence = variable{source_info:Source,varid:VarId,class:Location}, 246 ( compiler_map:search(Map0, VarId, OldEntry) -> 247 OldEntry = [OldSlot|Slots], 248 OldSlot = slot{firstpos:FP0,class:Location}, 249 merge_slots(Slots, FP0, FP, Location), 250 update_struct(slot, [firstpos:FP,lastpos:CallPos], OldSlot, NewSlot), 251 compiler_map:det_update(Map0, VarId, [NewSlot], Map) 252 ; 253 % first occurrence 254 compiler_map:det_insert(Map0, VarId, [slot{source_info:Source,firstpos:CallPos, 255 lastpos:CallPos, class:Location}], Map) 256 ). 257 258 % - unifies all the slot's class fields 259 % - computes the common prefix for the first position 260 merge_slots([], FP, FP, nonvoid(_)). 261 merge_slots([slot{firstpos:ThisFP,class:Location}|Slots], FP0, FP, Location) :- 262 common_pos(ThisFP, FP0, FP1), 263 merge_slots(Slots, FP1, FP, Location). 264 265 266% Merge the slot information from the branches: 267% 268% The maps from the different branches may contain (for a particular VarId): 269% 270% all first occurrence(s) in current disjunction: 271% ---C1--C2-- C1-C2 272% ---------------| -> C1-C2,D1-D2 273% ---D1--D2-- D1-D2 274% keep all (they are different) 275% 276% common, identical entries: 277% ----------- A1-A2 278% ---A1--A2------| -> A1-A2 279% ----------- A1-A2 280% first and last occurrence are older than the disjunction 281% we keep one of them (they are all the same). 282% 283% multiple entries, last occurrences older than current disjunction: 284% ---A1--A2-- ----------- A1-A2,B1-B2 285% |---| -> A1-A2,B1-B2 286% ---B1--B2-- ----------- A1-A2,B1-B2 287% keep one of each (they are different) 288% 289% first occurrence older, last in current disjunction: 290% some branches will still have old-old entry 291% -----C----- A1-C 292% ---A1--A2------| -> A1-CD 293% ----------- A1-A2 294% where CD is the end of disjunction's callpos (C<CD) 295% 296% first occurrence older, last in current disjunction: 297% some branches may still have old-old entry 298% -----C----- A1-C 299% ---A1--A2------| -> A1-CD 300% -----D----- A1-D 301% where CD is the end of disjunction's callpos (C<CD,D<CD) 302% 303% first occurrences older, last in current disjunction: 304% some branches will still have multiple old-old entries 305% ---A1--A2-- -----C----- AB-C 306% |---| -> AB-CD 307% ---B1--B2-- ----------- A1-A2,B1-B2 308% where CD is the end of disjunction's callpos (C<CD) 309% and AB the common prefix of the first occurrences (AB<A1,AB<B1). 310% 311% first occurrence older, last _is_ current disjunction: 312% some branches may still have multiple old-old entries 313% ---A1--A2-- -----C----- AB-C 314% |---| -> AB-CD 315% ---B1--B2-- -----D----- AB-D 316% where CD is the end of disjunction's callpos (C<CD,D<CD) 317% and AB the common prefix of the first occurrences (AB<A1,AB<B1). 318% 319% entries with common first and different last occurrences: 320% - first occurrence is older than the disjunction! 321% - summarise them into one entry (by taking the common prefix of the 322% last occurrences, and unifying the class) 323% 324% entries whose first occurrence differs: 325% - the first occurrence may be in this or in an earlier disjunction! 326% - keep them both, they represent conceptually different variables. 327 328merge_branches(DisjPos, BranchMaps, MergedMap) :- 329 ( 330 foreach(Map,BranchMaps), 331 fromto(Lists, [MapList|Lists1], Lists1, Tail) 332 do 333 compiler_map:to_sorted_assoc_list(Map, MapList) 334 ), 335 merge_sorted_lists(Lists, Tail, MergedList), 336 concat_same_key_values_unstable(MergedList, GroupedList), 337 ( 338 foreach(VarId-Slots,GroupedList), 339 foreach(VarId-NewSlots,NewGroupedList), 340 param(DisjPos) 341 do 342 % remove duplicates AND sort by ascending firstpos 343 sort(Slots, SortedNoDupSlots), 344 SortedNoDupSlots = [slot{firstpos:OldestFirst}|_], 345 ( 346 compare_pos(OldestFirst, DisjPos, Res), 347 verify Res = (<), 348 slots_ending_ge(DisjPos, SortedNoDupSlots, SlotsEnteringDisj), 349 SlotsEnteringDisj = [Slot1|_] 350 -> 351 % replace with a single summary slot 352 append(DisjPos, [?,?], DisjEndPos), 353 update_struct(slot, [firstpos:OldestFirst, lastpos:DisjEndPos], Slot1, NewSlot), 354 NewSlots = [NewSlot] 355 ; 356 % all occurrences in current disjunction 357 % or all before current disjunction 358 NewSlots = SortedNoDupSlots 359 ) 360 ), 361 compiler_map:from_sorted_assoc_list(NewGroupedList, MergedMap). 362 363 364 slots_ending_ge(_Pos, [], []). 365 slots_ending_ge(Pos, [Slot|Slots], SlotsGe) :- 366 Slot = slot{lastpos:LP}, 367 ( compare_pos(LP, Pos, Res) -> 368 verify Res = (<), 369 slots_ending_ge(Pos, Slots, SlotsGe) 370 ; 371 SlotsGe = [Slot|SlotsGe1], 372 slots_ending_ge(Pos, Slots, SlotsGe1) 373 ). 374 375 376% From the candidates in VarIdTable, pick those that (so far) have their only occurrences 377% in the chunk before the disjunction at PreDisjPos. 378select_pseudo_arguments(Branches, PredHead, PreDisjPos, Map0, Map, DisjArgs, DisjArity) :- 379 vars_in_first_chunks(Branches, VarIdTable), 380 hash_list(VarIdTable, VarIds, _), 381 ( 382 foreach(VarId,VarIds), 383 fromto(Map0,Map1,Map2,Map), 384 param(PreDisjPos,VarIdTable) 385 do 386 % a variable that only occurs in PreDisPos can have only one slot 387 ( 388 compiler_map:search(Map1, VarId, Slots), 389 Slots = [slot{firstpos:PreDisjPos,lastpos:LP,class:Location,source_info:Source}] 390 -> 391 verify PreDisjPos == LP, 392 % instantiate VarId's table entry to argument descriptor 393 hash_get(VarIdTable, VarId, ArgDesc), 394 verify var(ArgDesc), 395 ArgDesc = variable{varid:VarId,class:Location,source_info:Source}, 396 % Classify the pre-disjunction occurrence as nonvoid(temp) here, 397 % and remove its entry from the Map. That way, future 398 % occurrences will be considered first occurrences again. 399 Location = nonvoid(temp), 400 compiler_map:delete(Map1, VarId, Map2) 401 ; 402 % Not useful as pseudo-argument: delete it from the candidate table 403 hash_delete(VarIdTable, VarId), 404 Map1 = Map2 405 ) 406 ), 407 % Table now contains the varids we want to use as arguments 408 hash_count(VarIdTable, IdealDisjArity), 409 % For those disjunction-pseudo-args that match clause head args, 410 % put them in the same argument position (provided it is not beyond 411 % the disjunction's arity) 412 ( PredHead = HeadArity-HeadArgs -> 413 ( 414 for(_,1,min(HeadArity,IdealDisjArity)), 415 fromto(HeadArgs,[variable{varid:VarId}|HeadArgs1],HeadArgs1,_), 416 fromto(DisjArgs,[ArgDesc|DisjArgs1],DisjArgs1,DisjArgs2), 417 fromto(RemainingPositions,RemPos1,RemPos2,DisjArgs2), 418 param(VarIdTable) 419 do 420 ( hash_remove(VarIdTable, VarId, ArgDesc) -> 421 RemPos1 = RemPos2 422 ; 423 RemPos1 = [ArgDesc|RemPos2] 424 ) 425 ) 426 ; 427 verify PredHead==nohead, 428 RemainingPositions = DisjArgs 429 ), 430 DisjArity is min(IdealDisjArity, #wam_registers), 431 length(DisjArgs, DisjArity), 432 hash_list(VarIdTable, _VarIds, RemainingArgDescs0), 433 sort(varid of variable, =<, RemainingArgDescs0, RemainingArgDescs), 434 ( 435 foreach(ArgDesc,RemainingPositions), 436 fromto(RemainingArgDescs,[ArgDesc|ArgDescs],ArgDescs,Overflow) 437 do 438 true 439 ), 440 verify (Overflow==[] ; IdealDisjArity > DisjArity). 441 442 443% Build a hash map of all VarIds that occur in first chunks of 444% the given disjunctive branches. This is just a heuristic, and we do in fact 445% look beyond true/0 to catch some special cases like true,cut_to(C) sequences. 446vars_in_first_chunks(Branches, Occurs) :- 447 hash_create(Occurs), 448 ( 449 foreach(Branch,Branches), 450 param(Occurs) 451 do 452 vars_in_first_chunk(Branch, Occurs) 453 ). 454 455 vars_in_first_chunk([], _Occurs). 456 vars_in_first_chunk([Goal|Goals], Occurs) :- 457 ( Goal = goal{kind:Kind,args:Args,functor:F} -> 458 vars_in_term(Args, Occurs), 459 ( Kind == regular, F \== true/0 -> 460 true 461 ; 462 vars_in_first_chunk(Goals, Occurs) 463 ) 464 ; 465 true 466 ). 467 468 vars_in_term([X|Xs], Occurs) :- 469 vars_in_term(X, Occurs), 470 vars_in_term(Xs, Occurs). 471 vars_in_term(variable{varid:VarId}, Occurs) :- 472 hash_set(Occurs, VarId, _empty). 473 vars_in_term(attrvar{variable:Avar,meta:Meta}, Occurs) :- 474 vars_in_term(Avar, Occurs), 475 vars_in_term(Meta, Occurs). 476 vars_in_term(structure{args:Args}, Occurs) :- 477 vars_in_term(Args, Occurs). 478 vars_in_term(Term, _Occurs) :- atomic(Term). 479 480 481% Make head variables for the branch's pseudo-arguments 482% Set their source_info field to 'none' because we don't want singleton 483% warnings in case they are the only occurrence in a branch and behind. 484make_branch_head(_I, [], [], []) :- !. 485make_branch_head(I, HeadArgsArray, DisjArgs, HeadArgs) :- 486 arg(I, HeadArgsArray, HeadArgs), 487 ( 488 foreach(variable{varid:VarId,source_info:_Source},DisjArgs), 489 foreach(variable{varid:VarId,source_info:none},HeadArgs) 490 do 491 true 492 ). 493 494 495:- comment(print_occurrences/1, [ 496 summary:"Debugging: print result of variable lifetime analysis", 497 amode:print_occurrences(+), 498 args:[ 499 "Lifetimes":"A map varid->struct(slot)" 500 ], 501 see_also:[classify_variables/3] 502]). 503 504print_occurrences(Map) :- 505 writeln("------ Variable Lifetimes ------"), 506 compiler_map:count(Map, N), 507 ( for(VarId,1,N), param(Map) do 508 compiler_map:lookup(Map, VarId, Slots), 509 printf("Variable #%d:%n", [VarId]), 510 ( foreach(Slot,Slots) do printf(" %w%n", [Slot]) ), 511 nl 512 ). 513 514 515%---------------------------------------------------------------------- 516% This pass does: 517% - Variable classification (void, temp, perm) 518% - Environment slot allocation 519% - Environment size computation: 520% -1 no environment needed 521% 0 empty environment needed 522% >0 environment of given size needed 523% 524% Environment slots are allocated in a similar way as in the WAM or 525% in ECLiPSe I, i.e. ordered according to their last occurrence. This 526% means that the environment can shrink during clause execution (whether 527% physically by trimming, or virtually - for gc only - by size tracking). 528% 529% If we have variables local to branches, they can use the same slot as 530% other local variables in parallel branches. 531% But we do NOT reuse slots for consecutive lifetimes, e.g. 532% p :- p(X), q(X), r(Y), s(Y). 533% This could only be done when either determinism information is 534% available, or an extra trail check/trailing is accepted: If there 535% were a choicepoint inside p/1 or q/1, reusing X's slot would require 536% conditional (value-)trailing of the old slot value before it is reused 537% for Y. 538% 539% A problem is posed by variables whose lifetime starts before a disjunction 540% and extends into one or more disjunctive branches (without surviving the 541% disjunction): it may not be possible to compute an optimal slot with 542% minimal lifetime, because the relative order of the ends of lifetimes 543% with other variables may be different in different branches. We currently 544% treat such slots as always surviving until the end of the disjunction, 545% but note that environment activity maps contain precise information, 546% so that garbage collection is not negatively affected by this. 547%---------------------------------------------------------------------- 548 549assign_env_slots(Map, EnvSize, Options) :- 550 compiler_map:to_assoc_list(Map, MapList), 551 % strip keys and flatten 552 ( 553 foreach(_-Slots,MapList) >> foreach(Slot,Slots), 554 foreach(Slot,FlatSlots) 555 do 556 true 557 ), 558 classify_voids_and_temps(FlatSlots, PermSlots, Options), 559 % The sorting here is a bit subtle: we rely on the callpos 560 % partial order being compatible with the total term order. 561 sort(firstpos of slot, >=, PermSlots, SlotsIncStart), 562 sort(lastpos of slot, >=, SlotsIncStart, SlotsInc), 563 init_branch(Branch), 564 foreachcallposinbranch(Branch, SlotsInc, SlotsRest, 0, EnvSize), 565 verify SlotsRest==[]. 566 567 568% Deal with the void and temporary variables, and filter them out 569classify_voids_and_temps(AllSlots, PermSlots, Options) :- 570 ( 571 foreach(Slot,AllSlots), 572 fromto(PermSlots,PermSlots2,PermSlots1,[]), 573 param(Options) 574 do 575 Slot = slot{firstpos:First,lastpos:Last,class:Loc,source_info:Source}, 576 ( var(Loc) -> % void 577 Loc = void, 578 singleton_warning(Source, Options), 579 PermSlots2=PermSlots1 580 ; 581 Loc = nonvoid(Where), % needs assignment 582 verify var(Where), 583 ( First == Last -> 584 Where = temp, 585 PermSlots2=PermSlots1 586 ; 587 PermSlots2=[Slot|PermSlots1] 588 ) 589 ) 590 ). 591 592 593log_assignment(slot{source_info:Source}, Loc) ?- !, 594 ( Source = annotated_term{type:var(Name),line:Line} -> 595 printf(log_output, "%w %w (%d)%n", [Loc,Name,Line]) 596 ; 597 printf(log_output, "%w %w%n", [Loc,Source]) 598 ). 599 600 601foreachcallposinbranch(_Branch, [], [], Y, Y). 602foreachcallposinbranch(Branch, [Slot|Slots], RestSlots, Y0, Y) :- 603 % Branch is list of even length, e.g. [], [7,2] 604 % SlotPos is list of odd length, e.g. [7], [7,2,7] but not [7,?,?] 605 Slot = slot{lastpos:SlotPos,class:nonvoid(Loc)}, 606 ( append(Branch, RelPos, SlotPos) -> 607 RelPos = [PosInBranch|SubBranch], 608 verify PosInBranch \== ?, 609 ( (SubBranch = [] ; SubBranch = [?,?]) -> 610 Y1 is Y0+1, Loc = y(Y1), % assign env slot 611% log_assignment(Slot, Loc), 612 Slots1 = Slots 613 ; 614 % SlotPos is deeper down, RelPos=[7,2,7], [7,2,7,?,?] or longer 615 % process branches at callpos [7] 616 append(Branch, [PosInBranch], Pos), % nested disjunction 617 foreachbranchatcallpos(Pos, [Slot|Slots], Slots1, Y0, Y0, Y1) 618 ), 619 foreachcallposinbranch(Branch, Slots1, RestSlots, Y1, Y) 620 ; 621 % the first slot does not end in this branch, return 622 RestSlots = [Slot|Slots], 623 Y = Y0 624 ). 625 626% process all slots that start with Pos 627foreachbranchatcallpos(_Pos, [], [], _Y0, Y, Y). 628foreachbranchatcallpos(Pos, [Slot|Slots], RestSlots, Y0, Ymax0, Ymax) :- 629 % Pos is list of odd length, e.g. [7], [7,2,7], but not [7,?,?] 630 % SlotPos is list of odd length, e.g. [7], [7,2,7] but not [7,?,?] 631 Slot = slot{lastpos:SlotPos}, 632 % is Slot in a branch below this callpos? Always true for initial invocation 633 ( append(Pos, RelPos, SlotPos) -> 634 RelPos = [RelBranch|SubPos], 635 verify RelBranch \== ?, 636 % RelPos is [2,7] or [2,7,?,?] or [2,7,2,7] or longer 637 % which means we are going into branch 2 at Pos 638 ( (SubPos = [_] ; SubPos = [_,?,?]) -> 639 append(Pos, [RelBranch], Branch), 640 foreachcallposinbranch(Branch, [Slot|Slots], Slots1, Y0, Y1), 641 Ymax1 is max(Ymax0,Y1), 642 foreachbranchatcallpos(Pos, Slots1, RestSlots, Y0, Ymax1, Ymax) 643 ; 644 append(Pos, [_,_], Pos1), % branch deeper down 645 append(Pos1, _, SlotPos), 646 foreachbranchatcallpos(Pos1, [Slot|Slots], RestSlots, Y0, Ymax0, Ymax) 647 ) 648 ; 649 % Slot not at this callpos, return 650 RestSlots = [Slot|Slots], 651 Ymax = Ymax0 652 ). 653 654 655%---------------------------------------------------------------------- 656% Computing environment activity maps 657% 658% We assume that environment slots are already allocated to permanent 659% variables. The job of this phase is to compute environment slot activity 660% maps for various points in the code, in particular call positions 661% and entry and exit points of disjunctive branches. These maps are 662% simple bitmaps, with bit i-1 (i>0) indicating that Yi is active. 663% 664% We make a forward and a backward pass through the directed acyclic 665% graph formed by the normalised clause. During the forward pass, we 666% annotate every goal with two sets: 667% - seen_before (the slots that occurred before this goal) 668% - seen_here (the slots that occur in this goal) 669% 670% Then we make a backward pass to discover the last occurrences and 671% compute the actual environment activity maps. With the current strategy 672% of globalising all environment variables, a slot's activity ends at 673% the call that has its last occurrence(s). 674%---------------------------------------------------------------------- 675 676% Auxiliary structures built during forward pass, and traversed backward 677:- local struct(rev_goal( % wrapper for goal{} 678 goal, % the goal{} all this belongs to 679 max_y, % max y slot accessed in this goal 680 seen_before, % bitmap of variables seen before this goal 681 seen_here) % bitmap of variables occurring in this goal 682 ). 683 684:- local struct(rev_disj( % wrapper for disjunction{} 685 disjunction, % the disjunction{} all this belongs to 686 rev_branches, % list of reversed branches, for backward traversal 687 max_y_setup, % max y slot in setup before disjunction entry 688 max_y_heads, % max y slot accessed in all branch heads 689 seen_before, % bitmap of variables seen before this branch 690 seen_at_end, % bitmap of variables seen at end of each branch 691 seen_at_ends) % list of bitmaps of variables seen at end of each branch 692 ). 693 694 695mark_env_activity(Clause, MaxEnvSize) :- 696 mark_env_activity_fwd(Clause, 0, _Before, [], Reverse), 697 mark_env_activity_bwd(Reverse, 0, _After, -1, EntryEnvSize), 698 verify MaxEnvSize =:= max(EntryEnvSize,0). 699 700 701mark_env_activity_fwd([], Seen, Seen, Reverse, Reverse). 702mark_env_activity_fwd([Goal|Goals], Seen0, Seen, Reverse0, Reverse) :- 703 mark_env_activity_fwd(Goal, Seen0, Seen1, Reverse0, Reverse1), 704 mark_env_activity_fwd(Goals, Seen1, Seen, Reverse1, Reverse). 705mark_env_activity_fwd(Disjunction, Seen0, Seen, Reverse, [RevDisj|Reverse]) :- 706 Disjunction = disjunction{branches:Branches,args:DisjArgs, 707 branchheadargs:HeadArgsArray,indexvars:IndexVars}, 708 RevDisj = rev_disj{rev_branches:RevBranches,disjunction:Disjunction, 709 max_y_setup:MaxYSetup, max_y_heads:MaxYHeads, 710 seen_before:SeenBefore, seen_at_end:Seen, seen_at_ends:SeenEnds}, 711 mark_env_activity_args(IndexVars, Seen0, Seen1, -1, MaxY1), 712 mark_env_activity_args(DisjArgs, Seen1, SeenBefore, MaxY1, MaxYSetup), 713 ( 714 foreach(Branch,Branches), 715 foreach(RevBranch,RevBranches), 716 foreach(SeenEndBranch,SeenEnds), 717 fromto(SeenBefore,Seen3,Seen4,Seen), 718 fromto(-1,MaxY1,MaxY2,MaxYHeads), 719 count(BranchI,1,_), 720 param(SeenBefore,HeadArgsArray) 721 do 722 ( HeadArgsArray == [] -> 723 SeenAfterHead = SeenBefore, MaxY1 = MaxY2 724 ; 725 arg(BranchI, HeadArgsArray, HeadArgs), 726 mark_env_activity_args(HeadArgs, SeenBefore, SeenAfterHead, MaxY1, MaxY2) 727 ), 728 mark_env_activity_fwd(Branch, SeenAfterHead, SeenEndBranch, [], RevBranch), 729 Seen4 is Seen3 \/ SeenEndBranch 730 ). 731mark_env_activity_fwd(Goal, Seen0, Seen, Reverse, [RevGoal|Reverse]) :- 732 Goal = goal{args:Args}, 733 RevGoal = rev_goal{max_y:MaxY,seen_here:UsedHere,seen_before:Seen0,goal:Goal}, 734 mark_env_activity_args(Args, 0, UsedHere, -1, MaxY), 735 Seen is Seen0 \/ UsedHere. 736 737 738 :- mode mark_env_activity_args(+,+,-,+,-). 739 mark_env_activity_args([], EAM, EAM, MaxY, MaxY). 740 mark_env_activity_args([X|Xs], EAM0, EAM, MaxY0, MaxY) :- 741 mark_env_activity_term(X, EAM0, EAM1, MaxY0, MaxY1), 742 mark_env_activity_args(Xs, EAM1, EAM, MaxY1, MaxY). 743 744 :- mode mark_env_activity_term(+,+,-,+,-). 745 mark_env_activity_term(Var, EAM0, EAM, MaxY0, MaxY) :- 746 Var = variable{class:Loc}, 747 ( Loc = nonvoid(y(Y)) -> 748 EAM is setbit(EAM0, Y-1), % set the seen-flag 749 MaxY is max(MaxY0,Y) 750 ; 751 EAM0=EAM, MaxY0=MaxY 752 ). 753 mark_env_activity_term(attrvar{variable:Avar,meta:Meta}, EAM0, EAM, MaxY0, MaxY) :- 754 mark_env_activity_term(Avar, EAM0, EAM1, MaxY0, MaxY1), 755 mark_env_activity_term(Meta, EAM1, EAM, MaxY1, MaxY). 756 mark_env_activity_term([X|Xs], EAM0, EAM, MaxY0, MaxY) :- 757 mark_env_activity_term(X, EAM0, EAM1, MaxY0, MaxY1), 758 mark_env_activity_term(Xs, EAM1, EAM, MaxY1, MaxY). 759 mark_env_activity_term(structure{args:Args}, EAM0, EAM, MaxY0, MaxY) :- 760 mark_env_activity_term(Args, EAM0, EAM, MaxY0, MaxY). 761 mark_env_activity_term(Term, EAM, EAM, MaxY, MaxY) :- atomic(Term). 762 763 764 765% Backwards traversal of the clause DAG to discover last occurrences. 766% Using the auxiliary data structure created during the forward pass, 767% and the seen_before/seen_here-fields filled in during the forward pass. 768 769mark_env_activity_bwd([], After, After, ESize, ESize). 770mark_env_activity_bwd([Goal|Goals], After0, After, ESize0, ESize) :- 771 mark_env_activity_bwd(Goal, After0, After1, ESize0, ESize1), 772 mark_env_activity_bwd(Goals, After1, After, ESize1, ESize). 773mark_env_activity_bwd(rev_disj{rev_branches:Branches, 774 max_y_setup:MaxYSetup, 775 max_y_heads:MaxYHeads, 776 seen_before:SeenBeforeDisj, 777 seen_at_end:SeenEndDisj, 778 seen_at_ends:SeenEnds, 779 disjunction:disjunction{ 780 entrymap:DisjEntryEAM, 781 exitmap:DisjExitEAM, 782 entrysize:EntryESize, 783 exitsize:ExitESize, 784 branchentrymaps:BranchEntryEamArray, 785 branchinitmaps:BranchExitInits}}, 786 After0, After, ExitESize, ESize) :- 787 % EAM after exiting the disjunction 788 DisjExitEAM is SeenEndDisj /\ After0, 789 ( 790 foreach(Branch,Branches), 791 foreach(SeenEnd,SeenEnds), 792 foreach(BranchEntryEAM,BranchEntryEAMs), 793 foreach(BranchExitInit,BranchExitInits), 794 fromto(After0,After1,After2,After), 795 fromto(ExitESize,ESize1,ESize2,ESize3), 796 param(SeenBeforeDisj,After0,ExitESize,DisjExitEAM) 797 do 798 % slots that are active after the disjunction, but not 799 % at the end of the branch, must be initialised 800 % on branch exit! 801 BranchExitEAM is SeenEnd /\ After0, 802 BranchExitInit is DisjExitEAM /\ \BranchExitEAM, 803 mark_env_activity_bwd(Branch, After0, BranchAndAfter, ExitESize, BranchEntryESize), 804 ESize2 is max(ESize1,BranchEntryESize), 805 BranchEntryEAM is SeenBeforeDisj /\ BranchAndAfter, 806 After2 is After1 \/ BranchAndAfter 807 ), 808 % EntryESize is at least 0 because disjunctions are assumed 809 % to be regular and require at least an empty environment 810 EntryESize is max(0,max(ESize3,MaxYHeads)), 811 ESize is max(EntryESize,MaxYSetup), 812 % EAM before entering the disjunction 813 DisjEntryEAM is SeenBeforeDisj /\ After, 814 BranchEntryEamArray =.. [[]|BranchEntryEAMs]. 815mark_env_activity_bwd(rev_goal{max_y:MaxY,seen_before:Before,seen_here:UsedHere,goal:Goal}, After0, After, ESize0, ESize) :- 816 Goal = goal{envmap:EAM,envsize:ESize0}, 817 ESize is max(max(0,ESize0),MaxY), % need at least empty environment 818 % if variables were not globalised, slots would remain active during call: 819% EAM is UsedHere \/ (Before /\ After0), 820 % when unsafe variables are globalised, slots are released on call: 821 EAM is (UsedHere \/ Before) /\ After0, 822 After is After0 \/ UsedHere. 823 824