newlib/compiler/optimize/utils.ajla

   1 {*
   2  * Copyright (C) 2024, 2025 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 private unit compiler.optimize.utils;
  20
  21 uses compiler.optimize.defs;
  22
  23 fn function_pcode(params : list(pcode_t)) : list(pcode_t);
  24 fn function_name(params : list(pcode_t)) : bytes;
  25 fn function_extract_nested(pc : list(pcode_t), fn_idx : list(int)) : list(pcode_t);
  26 fn function_specifier_length(params : list(pcode_t)) : int;
  27 fn function_load(params : list(pcode_t)) : (int, function);
  28 fn function_store(f : function) : list(pcode_t);
  29
  30 fn create_instr(opcode : pcode_t, params : list(pcode_t), bgi : int) : instruction;
  31 fn load_function_context(pc : list(pcode_t)) : context;
  32 fn dump_basic_blocks(ctx : context, dump_it : bool) : list(pcode_t);
  33
  34 implementation
  35
  36 uses exception;
  37 uses compiler.common.blob;
  38 uses compiler.common.evaluate;
  39 uses compiler.parser.util;
  40
  41 fn function_specifier_length(params : list(pcode_t)) : int
  42 [
  43         var bl := blob_length(params[1 .. ]);
  44         return 1 + bl + 1 + params[1 + bl];
  45 ]
  46
  47 fn function_load(params : list(pcode_t)) : (int, function)
  48 [
  49         var bl := blob_length(params[1 .. ]);
  50         var r := function.[
  51                 path_idx : params[0] shr 1,
  52                 program : (params[0] and 1) <> 0,
  53                 un : blob_load(params[1 .. ]),
  54                 fn_idx : fill(0, params[1 + bl]),
  55         ];
  56         for i := 0 to params[1 + bl] do
  57                 r.fn_idx[i] := params[1 + bl + 1 + i];
  58         return function_specifier_length(params), r;
  59 ]
  60
  61 fn function_store(f : function) : list(pcode_t)
  62 [
  63         var pc := list(pcode_t).[ (f.path_idx shl 1) + select(f.program, 0, 1) ];
  64         pc += blob_store(f.un);
  65         pc += list(pcode_t).[ len(f.fn_idx) ];
  66         for i := 0 to len(f.fn_idx) do
  67                 pc +<= f.fn_idx[i];
  68         return pc;
  69 ]
  70
  71 fn function_pcode(params : list(pcode_t)) : list(pcode_t)
  72 [
  73         var l, f := function_load(params);
  74         var fi := list(pcode_t).[ len(f.fn_idx) ];
  75         for i := 0 to len(f.fn_idx) do
  76                 fi +<= f.fn_idx[i];
  77         return load_optimized_pcode(f.path_idx, f.un, f.program, fi, false);
  78 ]
  79
  80 fn function_name(params : list(pcode_t)) : bytes
  81 [
  82         var pc := function_pcode(params);
  83         return blob_load(pc[9 .. ]);
  84 ]
  85
  86 fn function_extract_nested(pc : list(pcode_t), fn_idx : list(int)) : list(pcode_t)
  87 [
  88         fn_idx := fn_idx[1 .. ];
  89         for idx in list_consumer(fn_idx) do [
  90                 if idx >= pc[2] then
  91                         abort internal("function_extract_nested: too high function index: " + ntos(idx) + " >= " + ntos(pc[2]));
  92                 var ptr := 9 + blob_length(pc[9 .. ]);
  93                 while idx > 0 do [
  94                         ptr += pc[ptr] + 1;
  95                         idx -= 1;
  96                 ]
  97                 pc := pc[ptr + 1 .. ptr + 1 + pc[ptr]];
  98         ]
  99         return pc;
 100 ]
 101
 102
 103 fn decode_structured_params(offs : int, params : list(pcode_t)) : (int, param_set, param_set)
 104 [
 105         var ps : param_set := 0;
 106         var ls : param_set := 0;
 107         for i := 0 to params[0] do [
 108                 var scode := params[offs];
 109                 if scode = Structured_Record then [
 110                         ls bts= offs + 1;
 111                         offs += 3;
 112                 ] else if scode = Structured_Option then [
 113                         offs += 2;
 114                 ] else if scode = Structured_Array then [
 115                         ps bts= offs + 1;
 116                         ls bts= offs + 2;
 117                         offs += 3;
 118                 ] else [
 119                         abort internal("invalid structured type");
 120                 ]
 121         ]
 122         return offs, ps, ls;
 123 ]
 124
 125 fn create_instr(opcode : pcode_t, params : list(pcode_t), bgi : int) : instruction
 126 [
 127         var xlen := -1;
 128         var ins := instruction.[
 129                 opcode : opcode,
 130                 params : params,
 131                 read_set : 0,
 132                 write_set : 0,
 133                 free_set : 0,
 134                 lt_set : 0,
 135                 conflict_1 : 0,
 136                 conflict_2 : 0,
 137                 borrow : -1,
 138                 bb : bgi,
 139         ];
 140         if opcode = P_BinaryOp then [
 141                 ins.read_set := 0 bts 3 bts 5;
 142                 ins.free_set := ins.read_set;
 143                 ins.write_set := 0 bts 1;
 144                 xlen := 6;
 145         ] else if opcode = P_BinaryConstOp then [
 146                 ins.read_set := 0 bts 3;
 147                 ins.free_set := ins.read_set;
 148                 ins.write_set := 0 bts 1;
 149                 xlen := 5;
 150         ] else if opcode = P_UnaryOp then [
 151                 ins.read_set := 0 bts 3;
 152                 ins.free_set := ins.read_set;
 153                 ins.write_set := 0 bts 1;
 154                 xlen := 4;
 155         ] else if opcode = P_Copy then [
 156                 ins.read_set := 0 bts 2;
 157                 ins.free_set := ins.read_set;
 158                 ins.write_set := 0 bts 0;
 159                 xlen := 3;
 160         ] else if opcode = P_Copy_Type_Cast then [
 161                 ins.read_set := 0 bts 2;
 162                 ins.free_set := ins.read_set;
 163                 ins.write_set := 0 bts 0;
 164                 xlen := 3;
 165         ] else if opcode = P_Free then [
 166                 ins.read_set := 0 bts 0;
 167                 xlen := 1;
 168         ] else if opcode = P_Eval then [
 169                 ins.read_set := 0 bts 0;
 170                 xlen := 1;
 171         ] else if opcode = P_Keep then [
 172                 ins.read_set := 0 bts 0;
 173                 xlen := 1;
 174         ] else if opcode = P_Fn then [
 175                 ins.write_set := 0 bts 0;
 176                 xlen := 3 + params[1] + params[2];
 177                 for i := 3 to xlen do [
 178                         var p := params[i];
 179                         if p >= 0 then
 180                                 ins.read_set bts= i;
 181                 ]
 182         ] else if opcode = P_Load_Local_Type then [
 183                 ins.write_set := 0 bts 0;
 184                 xlen := 3;
 185         ] else if opcode = P_Load_Fn then [
 186                 var l := function_specifier_length(params[3 .. ]);
 187                 for i := 0 to params[1] do [
 188                         ins.read_set bts= 3 + l + i * 2 + 1;
 189                         ins.free_set bts= 3 + l + i * 2 + 1;
 190                 ]
 191                 ins.write_set := 0 bts 0;
 192                 xlen := 3 + l + params[1] * 2;
 193         ] else if opcode = P_Curry then [
 194                 ins.read_set := 0 bts 3;
 195                 ins.free_set := 0 bts 3;
 196                 for i := 0 to params[1] do [
 197                         ins.read_set bts= 4 + i * 2 + 1;
 198                         ins.free_set bts= 4 + i * 2 + 1;
 199                 ]
 200                 ins.write_set := 0 bts 0;
 201                 xlen := 4 + params[1] * 2;
 202         ] else if opcode = P_Call then [
 203                 var l := function_specifier_length(params[3 .. ] );
 204                 for i := 0 to params[2] do [
 205                         ins.read_set bts= 3 + l + i * 2 + 1;
 206                         ins.free_set bts= 3 + l + i * 2 + 1;
 207                 ]
 208                 for i := 0 to params[1] do
 209                         ins.write_set bts= 3 + l + params[2] * 2 + i;
 210                 xlen := 3 + l + params[2] * 2 + params[1];
 211         ] else if opcode = P_Call_Indirect then [
 212                 ins.read_set := 0 bts 4;
 213                 ins.free_set := 0 bts 4;
 214                 for i := 0 to params[2] do [
 215                         ins.read_set bts= 5 + i * 2 + 1;
 216                         ins.free_set bts= 5 + i * 2 + 1;
 217                 ]
 218                 for i := 0 to params[1] do
 219                         ins.write_set bts= 5 + params[2] * 2 + i;
 220                 xlen := 5 + params[2] * 2 + params[1];
 221         ] else if opcode = P_Load_Const then [
 222                 ins.write_set := 0 bts 0;
 223                 xlen := 1 + blob_length(params[1 .. ]);
 224         ] else if opcode = P_Structured_Write then [
 225                 ins.read_set := 0 bts 3 bts 5;
 226                 ins.free_set := 0 bts 3 bts 5;
 227                 ins.write_set := 0 bts 1;
 228                 var pmask lmask : param_set;
 229                 xlen, pmask, lmask := decode_structured_params(6, params);
 230                 ins.read_set or= pmask;
 231                 ins.lt_set := lmask;
 232                 ins.conflict_1 := 0 bts 5 or pmask;
 233                 ins.conflict_2 := 0 bts 1;
 234         ] else if opcode = P_Record_Type or opcode = P_Option_Type then [
 235                 for i := 0 to params[1] do
 236                         ins.read_set bts= 2 + i;
 237                 ins.write_set := 0 bts 0;
 238                 var l := function_specifier_length(params[2 + params[1] .. ]);
 239                 xlen := 2 + params[1] + l;
 240         ] else if opcode = P_Record_Create then [
 241                 ins.write_set := 0 bts 0;
 242                 for i := 0 to params[1] do [
 243                         ins.read_set bts= 2 + i * 2 + 1;
 244                         ins.free_set bts= 2 + i * 2 + 1;
 245                 ]
 246                 xlen := 2 + params[1] * 2;
 247         ] else if opcode = P_Record_Load_Slot then [
 248                 ins.read_set := 0 bts 1;
 249                 ins.write_set := 0 bts 0;
 250                 xlen := 3;
 251         ] else if opcode = P_Record_Load then [
 252                 ins.read_set := 0 bts 2;
 253                 ins.write_set := 0 bts 0;
 254                 ins.borrow := 2;
 255                 xlen := 4;
 256         ] else if opcode = P_Option_Create then [
 257                 ins.read_set := 0 bts 3;
 258                 ins.free_set := 0 bts 3;
 259                 ins.write_set := 0 bts 0;
 260                 xlen := 4;
 261         ] else if opcode = P_Option_Load then [
 262                 ins.read_set := 0 bts 2;
 263                 ins.write_set := 0 bts 0;
 264                 ins.borrow := 2;
 265                 xlen := 4;
 266         ] else if opcode = P_Option_Test then [
 267                 ins.read_set := 0 bts 1;
 268                 ins.write_set := 0 bts 0;
 269                 xlen := 3;
 270         ] else if opcode = P_Option_Ord then [
 271                 ins.read_set := 0 bts 1;
 272                 ins.write_set := 0 bts 0;
 273                 xlen := 2;
 274         ] else if opcode = P_Array_Flexible then [
 275                 ins.read_set := 0 bts 1;
 276                 ins.write_set := 0 bts 0;
 277                 xlen := 2;
 278         ] else if opcode = P_Array_Fixed then [
 279                 ins.read_set := 0 bts 1 bts 2;
 280                 ins.write_set := 0 bts 0;
 281                 xlen := 3;
 282         ] else if opcode = P_Array_Create then [
 283                 ins.read_set := 0 bts 3;
 284                 ins.write_set := 0 bts 0;
 285                 for i := 0 to params[2] do [
 286                         ins.read_set bts= 4 + i * 2 + 1;
 287                         ins.free_set bts= 4 + i * 2 + 1;
 288                 ]
 289                 ins.lt_set := 0 bts 1;
 290                 xlen := 4 + params[2] * 2;
 291         ] else if opcode = P_Array_Fill then [
 292                 ins.read_set := 0 bts 3 bts 4;
 293                 ins.free_set := 0 bts 3;
 294                 ins.write_set := 0 bts 0;
 295                 ins.lt_set := 0 bts 1;
 296                 xlen := 5;
 297         ] else if opcode = P_Array_String then [
 298                 ins.write_set := 0 bts 0;
 299                 xlen := 1 + blob_length(params[1 .. ]);
 300         ] else if opcode = P_Array_Unicode then [
 301                 ins.write_set := 0 bts 0;
 302                 xlen := len(params);
 303         ] else if opcode = P_Array_Load then [
 304                 ins.read_set := 0 bts 2 bts 3;
 305                 ins.write_set := 0 bts 0;
 306                 ins.borrow := 2;
 307                 xlen := 4;
 308         ] else if opcode = P_Array_Len then [
 309                 ins.read_set := 0 bts 1;
 310                 ins.write_set := 0 bts 0;
 311                 xlen := 3;
 312         ] else if opcode = P_Array_Len_Greater_Than then [
 313                 ins.read_set := 0 bts 1 bts 2;
 314                 ins.write_set := 0 bts 0;
 315                 xlen := 4;
 316         ] else if opcode = P_Array_Sub then [
 317                 ins.read_set := 0 bts 2 bts 3 bts 4;
 318                 ins.free_set := 0 bts 2;
 319                 ins.write_set := 0 bts 0;
 320                 xlen := 5;
 321         ] else if opcode = P_Array_Skip then [
 322                 ins.read_set := 0 bts 2 bts 3;
 323                 ins.free_set := 0 bts 2;
 324                 ins.write_set := 0 bts 0;
 325                 xlen := 4;
 326         ] else if opcode = P_Array_Append then [
 327                 ins.read_set := 0 bts 2 bts 4;
 328                 ins.free_set := 0 bts 2 bts 4;
 329                 ins.write_set := 0 bts 0;
 330                 xlen := 5;
 331         ] else if opcode = P_Array_Append_One then [
 332                 ins.read_set := 0 bts 2 bts 4;
 333                 ins.free_set := 0 bts 2 bts 4;
 334                 ins.write_set := 0 bts 0;
 335                 xlen := 5;
 336         ] else if opcode = P_Array_Flatten then [
 337                 ins.read_set := 0 bts 2;
 338                 ins.free_set := 0 bts 2;
 339                 ins.write_set := 0 bts 0;
 340                 xlen := 3;
 341         ] else if opcode = P_Jmp then [
 342                 xlen := 1;
 343         ] else if opcode = P_Jmp_False then [
 344                 ins.read_set := 0 bts 0;
 345                 xlen := 3;
 346         ] else if opcode = P_Label then [
 347                 xlen := 1;
 348         ] else if opcode = P_IO then [
 349                 for i := 0 to params[1] do [
 350                         ins.write_set bts= 4 + i;
 351                 ]
 352                 for i := params[1] to params[1] + params[2] do [
 353                         ins.read_set bts= 4 + i;
 354                 ]
 355                 ins.conflict_1 := ins.read_set;
 356                 ins.conflict_2 := ins.write_set;
 357                 xlen := 4 + params[1] + params[2] + params[3];
 358         ] else if opcode = P_Args then [
 359                 for i := 0 to len(params) do
 360                         ins.write_set bts= i;
 361                 xlen := len(params);
 362         ] else if opcode = P_Return_Vars then [
 363                 for i := 0 to len(params) do
 364                         ins.write_set bts= i;
 365                 xlen := len(params);
 366         ] else if opcode = P_Return then [
 367                 var i := 1;
 368                 while i < len(params) do [
 369                         ins.read_set bts= i;
 370                         ins.free_set bts= i;
 371                         i += 2;
 372                 ]
 373                 xlen := len(params);
 374         ] else if opcode = P_Assume then [
 375                 ins.read_set := 0 bts 0;
 376                 xlen := 1;
 377         ] else if opcode = P_Claim then [
 378                 ins.read_set := 0 bts 0;
 379                 xlen := 1;
 380         ] else if opcode = P_Invariant then [
 381                 ins.read_set := 0 bts 0;
 382                 xlen := 1;
 383         ] else if opcode = P_Checkpoint then [
 384                 xlen := len(params);
 385         ] else if opcode = P_Line_Info then [
 386                 if params[0] < 0 then
 387                         abort internal("P_Line_Info: negative line info");
 388                 xlen := 1;
 389         ] else if opcode = P_Phi then [
 390                 ins.write_set := 0 bts 0;
 391                 for i := 1 to len(params) do
 392                         ins.read_set bts= i;
 393                 xlen := len(params);
 394         ] else [
 395                 abort internal("invalid opcode");
 396         ]
 397
 398         if xlen <> len(params) then
 399                 abort internal("length mismatch on opcode " + ntos(opcode) + ": " + ntos(xlen) + " <> " + ntos(len(params)));
 400
 401         var rs := ins.read_set;
 402         while rs <> 0 do [
 403                 var s : int := bsr rs;
 404                 rs btr= s;
 405                 if ins.params[s] < 0 then [
 406                         ins.read_set btr= s;
 407                         ins.conflict_1 btr= s;
 408                         ins.conflict_2 btr= s;
 409                 ]
 410         ]
 411         var ls := ins.lt_set;
 412         while ls <> 0 do [
 413                 var s : int := bsr ls;
 414                 ls btr= s;
 415                 if ins.params[s] < 0 then [
 416                         ins.lt_set btr= s;
 417                 ]
 418         ]
 419
 420         return ins;
 421 ]
 422
 423
 424 fn set_arrow(ctx : context, src : int, dst : int) : context
 425 [
 426         {var sblk := ctx.blocks[src];
 427         for i := 0 to len(sblk.instrs) do [
 428                 eval debug("pcode: " + ntos(sblk.instrs[i].opcode));
 429         ]}
 430         ctx.blocks[dst].pred_position +<= len(ctx.blocks[src].post_list);
 431         ctx.blocks[dst].pred_list +<= src;
 432         ctx.blocks[src].post_list +<= dst;
 433         //eval debug("arrow from " + ntos(src) + " to " + ntos(dst) + " total " + ntos(len(ctx.blocks)));
 434         return ctx;
 435 ]
 436
 437 fn load_function_context(pc : list(pcode_t)) : context
 438 [
 439         var ctx := context.[
 440                 local_types : empty(local_type),
 441                 instrs : empty(instruction),
 442                 blocks : empty(basic_block),
 443
 444                 variables : exception_make(list(variable), ec_sync, error_record_field_not_initialized, 0, false),
 445                 label_to_block : exception_make(list(int), ec_sync, error_record_field_not_initialized, 0, false),
 446                 var_map : exception_make(list(int), ec_sync, error_record_field_not_initialized, 0, false),
 447                 cm : exception_make(conflict_map, ec_sync, error_record_field_not_initialized, 0, false),
 448                 should_retry : exception_make(bool, ec_sync, error_record_field_not_initialized, 0, false),
 449
 450                 name : blob_load(pc[9 .. ]),
 451         ];
 452
 453         var ptr := 9 + blob_length(pc[9 .. ]);
 454
 455         for i := 0 to pc[2] do [
 456                 ptr += 1 + pc[ptr];
 457         ]
 458
 459         for i := 0 to pc[3] do [
 460                 var ft := pc[ptr];
 461                 ptr += 1;
 462                 var lt : local_type;
 463                 if ft = Local_Type_Record then [
 464                         var n, f := function_load(pc[ptr .. ]);
 465                         ptr += n;
 466                         lt := local_type.rec.(f);
 467                 ] else if ft = Local_Type_Flat_Record then [
 468                         var non_flat_rec := pc[ptr];
 469                         var n_entries := pc[ptr + 1];
 470                         lt := local_type.flat_rec.(local_type_flat_record.[ non_flat_record : non_flat_rec, flat_types : empty(int) ]);
 471                         ptr += 2;
 472                         for j := 0 to n_entries do [
 473                                 lt.flat_rec.flat_types +<= pc[ptr];
 474                                 ptr += 1;
 475                         ]
 476                 ] else if ft = Local_Type_Flat_Array then [
 477                         lt := local_type.flat_array.(local_type_flat_array.[ flat_type : pc[ptr], number_of_elements : pc[ptr + 1] ]);
 478                         ptr += 2;
 479                 ] else [
 480                         abort internal("unknown local type " + ntos(ft));
 481                 ]
 482                 ctx.local_types +<= lt;
 483         ]
 484
 485         var n_variables := pc[4];
 486         ctx.variables := fill(new_variable, n_variables);
 487
 488         ctx.label_to_block := fill(-1, pc[8]);
 489
 490         for i := 0 to n_variables do [
 491                 ctx.variables[i].type_index := pc[ptr];
 492                 ctx.variables[i].runtime_type := pc[ptr + 1];
 493                 ctx.variables[i].local_type := -1;
 494                 ctx.variables[i].color := pc[ptr + 2];
 495                 ctx.variables[i].must_be_flat := pc[ptr + 3] bt bsf VarFlag_Must_Be_Flat;
 496                 ctx.variables[i].must_be_data := pc[ptr + 3] bt bsf VarFlag_Must_Be_Data;
 497                 ctx.variables[i].is_option_type := false;
 498                 ptr += 4;
 499                 ctx.variables[i].name := blob_load(pc[ptr .. ]);
 500                 ptr += blob_length(pc[ptr .. ]);
 501
 502                 if ctx.variables[i].runtime_type < T_Undetermined then
 503                         abort internal("load_function_context: invalid runtime type: " + ctx.name + ", " + ntos(i) + "(" + ctx.variables[i].name + "): " + ntos(ctx.variables[i].runtime_type));
 504         ]
 505
 506         var b := new_basic_block;
 507
 508         while ptr < len(pc) do [
 509                 var instr_len := pc[ptr + 1] + 2;
 510                 var ins := create_instr(pc[ptr], pc[ptr + 2 .. ptr + instr_len], len(ctx.blocks));
 511
 512                 var free_set : param_set := ins.free_set;
 513                 while free_set <> 0 do [
 514                         var arg : int := bsr free_set;
 515                         free_set btr= arg;
 516                         ins.params[arg - 1] and= not Flag_Free_Argument;
 517                 ]
 518
 519                 if ins.opcode = P_Jmp or ins.opcode = P_Jmp_False or ins.opcode = P_Return then [
 520                         b.instrs +<= len(ctx.instrs);
 521                         ctx.instrs +<= ins;
 522                         ctx.blocks +<= b;
 523                         b := new_basic_block;
 524                 ] else if ins.opcode = P_Label then [
 525                         if len_greater_than(int, b.instrs, 0) then [
 526                                 ctx.blocks +<= b;
 527                                 b := new_basic_block;
 528                                 ins.bb += 1;
 529                         ]
 530                         if ctx.label_to_block[ins.params[0]] >= 0 then
 531                                 abort internal("load_function_context: label already defined");
 532                         ctx.label_to_block[ins.params[0]] := len(ctx.blocks);
 533                         b.instrs +<= len(ctx.instrs);
 534                         ctx.instrs +<= ins;
 535                 ] else if ins.opcode = P_Free then [
 536                 ] else if ins.opcode = P_Checkpoint then [
 537                 ] else [
 538                         b.instrs +<= len(ctx.instrs);
 539                         ctx.instrs +<= ins;
 540                 ]
 541
 542                 ptr += instr_len;
 543         ]
 544         if ptr > len(pc) then
 545                 abort internal("load_function_context: " + ctx.name + ": pcode doesn't match");
 546         if len(b.instrs) > 0 then
 547                 abort internal("load_function_context: " + ctx.name + ": the last basic block is not finished");
 548
 549         for i := 0 to len(ctx.blocks) do [
 550 again:
 551                 var block := ctx.blocks[i];
 552                 if len(block.instrs) = 0 then [
 553                         ctx := set_arrow(ctx, i, i + 1);
 554                         continue;
 555                 ]
 556                 var first := ctx.instrs[ block.instrs[0] ];
 557                 if first.opcode = P_Label then [
 558                         ctx.blocks[i].instrs := block.instrs[1 .. ];
 559                         goto again;
 560                 ]
 561                 var last := ctx.instrs[ block.instrs[ len(block.instrs) - 1 ] ];
 562
 563                 if last.opcode = P_Jmp then [
 564                         var target := last.params[0];
 565                         ctx := set_arrow(ctx, i, ctx.label_to_block[target]);
 566                         ctx.blocks[i].instrs := block.instrs[ .. len(block.instrs) - 1];
 567                 ] else if last.opcode = P_Jmp_False then [
 568                         var target1 := last.params[1];
 569                         var target2 := last.params[2];
 570                         ctx := set_arrow(ctx, i, i + 1);
 571                         ctx := set_arrow(ctx, i, ctx.label_to_block[target1]);
 572                         ctx := set_arrow(ctx, i, ctx.label_to_block[target2]);
 573                 ] else if last.opcode <> P_Return then [
 574                         ctx := set_arrow(ctx, i, i + 1);
 575                 ]
 576         ]
 577
 578         return ctx;
 579 ]
 580
 581 fn dump_basic_blocks(ctx : context, dump_it : bool) : list(pcode_t)
 582 [
 583         //dump_it := ctx.name = "main" or ctx.name = "fact";
 584         if dump_it then [
 585                 eval debug("-----------------------------------------------------------------");
 586                 eval debug("dump_basic_blocks: " + ctx.name);
 587         ]
 588         var rpc := empty(pcode_t);
 589         var worklist : node_set := 1;
 590         var done : node_set := 0;
 591         while worklist <> 0 do [
 592                 var bgi : int := bsr worklist;
 593
 594                 if dump_it then
 595                         eval debug("process block from worklist " + ntos(bgi));
 596
 597                 if bgi = 0 then
 598                         goto process_block_no_label;
 599 process_block:
 600                 rpc +<= P_Label;
 601                 rpc +<= 1;
 602                 rpc +<= bgi - 1;
 603                 if dump_it then
 604                         eval debug("generate label " + ntos(bgi - 1));
 605 process_block_no_label:
 606                 worklist btr= bgi;
 607
 608                 var block := ctx.blocks[bgi];
 609                 for ili := 0 to len(block.instrs) do [
 610                         var ins := ctx.instrs[block.instrs[ili]];
 611                         rpc +<= ins.opcode;
 612                         rpc +<= len(ins.params);
 613                         rpc += ins.params;
 614                         if dump_it then [
 615                                 var instr_name := (pcode_name(ins.opcode) + "                    ")[ .. 20];
 616                                 var msg := "instr: " + instr_name + "   ";
 617                                 if ins.opcode = P_Jmp_False then [
 618                                         ins.params[1] := block.post_list[1] - 1;
 619                                         ins.params[2] := block.post_list[2] - 1;
 620                                 ]
 621                                 for i := 0 to len(ins.params) do
 622                                         msg += " " + ntos(ins.params[i]);
 623                                 msg += "       ";
 624                                 var read_elided := true;
 625                                 var write_elided := true;
 626                                 var read_set := ins.read_set;
 627                                 if ins.opcode = P_Free then [
 628                                         read_set := 0 bts 0;
 629                                 ]
 630                                 while read_set <> 0 do [
 631                                         var x : int := bsf read_set;
 632                                         read_set btr= x;
 633                                         var v := ins.params[x];
 634                                         var va := ctx.variables[v];
 635                                         msg += " r(" + ntos(v) + "," + ntos(va.type_index) + "," + ntos(va.runtime_type) + ":" + ntos(va.color) + ")";
 636                                         if v < 0 or ctx.variables[v].color = -1 then
 637                                                 msg += "el";
 638                                         else
 639                                                 read_elided := false;
 640                                 ]
 641                                 var write_set := ins.write_set;
 642                                 var something_written := false;
 643                                 while write_set <> 0 do [
 644                                         var x : int := bsf write_set;
 645                                         write_set btr= x;
 646                                         var v := ins.params[x];
 647                                         var va := ctx.variables[v];
 648                                         msg += " w(" + ntos(v) + "," + ntos(va.type_index) + "," + ntos(va.runtime_type) + ":" + ntos(va.color) + ")";
 649                                         if ctx.variables[v].color = -1 then
 650                                                 msg += "el";
 651                                         else
 652                                                 write_elided := false;
 653                                         something_written := true;
 654                                 ]
 655                                 if ins.opcode = P_Call or ins.opcode = P_Load_Fn then [
 656                                         msg += " " + function_name(ins.params[3 .. ]);
 657                                 ]
 658                                 if read_elided and write_elided then
 659                                         msg := bytes.[27] + "[31m" + msg +< 27 + "[0m";
 660                                 else if write_elided and something_written then
 661                                         msg := bytes.[27] + "[35m" + msg +< 27 + "[0m";
 662                                 else
 663                                         msg := bytes.[27] + "[32m" + msg +< 27 + "[0m";
 664                                 eval debug(msg);
 665                         ]
 666                 ]
 667
 668                 done bts= bgi;
 669
 670                 if len(block.post_list) = 0 then
 671                         continue;
 672                 for i := 1 to len(block.post_list) do [
 673                         var post_idx := block.post_list[i];
 674                         if not done bt post_idx then
 675                                 worklist bts= post_idx;
 676                         if rpc[len(rpc) - 5] <> P_Jmp_False then
 677                                 abort internal("a block with multiple outputs doesn't end with P_Jmp_False");
 678                         rpc[len(rpc) - 3 + i] := post_idx - 1;
 679                 ]
 680                 var next_bgi := block.post_list[0];
 681                 if done bt next_bgi then [
 682                         rpc +<= P_Jmp;
 683                         rpc +<= 1;
 684                         rpc +<= next_bgi - 1;
 685                         if dump_it then
 686                                 eval debug("generating jump to label " + ntos(next_bgi - 1));
 687                         continue;
 688                 ]
 689                 bgi := next_bgi;
 690                 if dump_it then
 691                         eval debug("process following block " + ntos(bgi));
 692                 if len(ctx.blocks[bgi].pred_list) <= 1 then
 693                         goto process_block_no_label;
 694                 goto process_block;
 695         ]
 696         return rpc;
 697 ]