1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1992-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): ECRC GmbH 21% Contributor(s): IC-Parc, Imperal College London 22% 23% END LICENSE BLOCK 24% 25% System: ECLiPSe Constraint Logic Programming System 26% Version: $Id: asm.pl,v 1.10 2013/06/21 19:27:26 kish_shen Exp $ 27% ---------------------------------------------------------------------- 28 29% 30% SEPIA PROLOG LIBRARY MODULE 31% 32% IDENTIFICATION: asm.pl 33% 34% AUTHORS: Joachim Schimpf 35% Pierre Lim 36% Kish Shen -- Major changes to add disasm/2 and 37% generalisation of code 38% 39% CONTENTS: asm(+PredSpec, +WAMList) 40% disasm(+PredSpec, -WAMList) 41% pasm(+WAMList, -Size, -BTPos, -WordList) 42% wam(+PredSpec) 43% 44% DESCRIPTION: 45% 46% asm(+PredSpec, +WAMList) creates the predicate PredSpec 47% with the code specified by WAMList. 48% 49% disasm(+PredSpec, -WAMList) unifies WAMList to the WAM code of a 50% currently defined predicate PredSpec. 51% 52% pasm(+WAMList, -Size, -BTPos, -WordList) partially assembles WAMList to a 53% platform independent format of the words that need to be stored into 54% memory. BTPos is offset in words from start of code to the port/break, 55% table, or 0 if none. 56% 57% A single instruction is a term whose functor specifies the instruction 58% and whose arguments are the instruction operands, e.g. 59% 60% get_integer(a(3), 99) 61% move(a(1), y(3)) 62% branch(ref(Label)) 63% 64% Format of labels: 65% 66% label(<variable>) variable should not occur in other labels 67% 68% 69% Instruction operands are of the form: 70% 71% ref(<variable>) reference (refers to a label(<variable>)) 72% <int> integer constant or 73% offset 74% <float> float value 75% <atom> atom did or 76% named variable or 77% attribute name 78% a(N) argument register N 79% y(N) permanent variable N 80% t(N) temporary variable N 81% N/A procedure descriptor for predicate N/A 82% M:N/A procedure descriptor for predicate N/A in M 83% N/A did for functor N/A 84% y(<vmask>) vmask 85% y(<named vmask>) named vmask 86% tags(<Tag switch list>) 87% switch labels for switch_on_type 88% 89% <switch table> entries for a switch table 90% <try refs> switches for try_parallel instruction 91% 92% vmask is a list of int, where each int is a variable to be initialised. 93% The first element should be the smallest argument number 94% 95% named vmask is a list of VarName-<int>, where VarName is an atom 96% representing the name of the variable to be initialised. First element 97% should be the smallest argument number 98% 99% Tag switch list is a list of TagName:<label>, where TagName is 100% a tag type. Each tag type can occur at most once in the list. 101% Unmentioned tag types are assumed to have ref(fail) as labels 102% 103% switch table is a list of Key-<label>. Keys in an integer table 104% must be ordered. Range tables has the same form as an integer 105% switch table, except that the first two entries are the minimum 106% and maximum of the range (and thus not ordered with the rest) 107% 108% try_refs is a list of references to switch to for try_parallel instr. 109% 110% 111% 112% CAUTION: - The integer opcodes of the abstract instructions are 113% currently hardcoded in this file. The mapping must 114% correspond to the one in opcode.h. 115% 116% 117 118%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 119 120:- module(asm). 121 122:- comment(categories, ["Development Tools"]). 123:- comment(summary, "Assemble and disassemble predicates"). 124 125:- comment(desc, "\ 126 The asm library provide tools for assembling and disassembling the WAM 127 code representation of predicates to and from memory. It also allows 128 the formatted printing of the WAM code. This library is used by the 129 fcompile library to generate the object code, which is a form of the 130 WAM code that can be read back in and assembled into the predicates." 131). 132 133:- comment(asm / 2, [ 134 summary:"Assemble the WAM instructions WAMCode into ECLiPSe as predicate PredSpec. 135 136", 137 template:"asm(+PredSpec, +WAMCode)", 138 desc:html(" Assembles the WAM instruction WAMCode into the current ECLiPSe session 139 as the predicate PredSpec. The WAM code is in the form of a list, with 140 each element representing one WAM instruction. The format of the WAMCode 141 is the same as that generated by disasm/2,3. Thus the predicate can be 142 used to load a predicate previously dissasembled by disasm/2,3 without 143 having to compile the source Prolog form of the predicate. 144 145<P> 146 If PredSpec is an existing defined predicate, the older definition will 147 be replaced. If WAMCode is not in the correct format, an exception will 148 be generated and the predicate PredSpec would not be redefined. 149 150<P> 151"), 152 args:["+PredSpec" : "Atom/Integer.", "+WAMCode" : "A list of WAM instructions in the right format."], 153 resat:" No.", 154 fail_if:" None.", 155 exceptions:[5 : "PredSpec is not in correct form.", 6 : "WAMCode is not in correct form. "], 156 see_also:[asm / 3, disasm / 2, disasm / 3, pasm / 4]]). 157 158:- comment(asm / 3, [ 159 summary:"Assemble the WAM instructions WAMCode into ECLiPSe in module Module as 160predicate PredSpec. 161 162", 163 template:"asm(+PredSpec, +WAMCode, +Flags)", 164 desc:html(" Assembles the WAM instruction WAMCode into the current ECLiPSe session 165 in an existing module Module as the predicate PredSpec. The WAM code is 166 in the form of a list, with each element representing one WAM 167 instruction. The format of the WAMCode is the same as that generated by 168 disasm/2,3. Thus the predicate can be used to load a predicate 169 previously dissasembled by disasm/2,3 without having to compile the 170 source Prolog form of the predicate. 171 172<P> 173 If PredSpec is an existing defined predicate, the older definition will 174 be replaced. If WAMCode is not in the correct format, an exception will 175 be generated and the predicate PredSpec would not be redefined. 176 177<P> 178"), 179 args:["+PredSpec" : "Atom/Integer.", 180 "+WAMCode" : "A list of WAM instructions in the right format.", 181 "+Flags" : "An integer."], 182 resat:" No.", 183 fail_if:" None.", 184 exceptions:[5 : "PredSpec or Module is not in correct form.", 6 : "WAMCode is not in correct form. ", 80 : "Module is not an existing module."], 185 see_also:[asm / 2, disasm / 2, disasm / 3, pasm / 4]]). 186 187:- comment(disasm / 2, [ 188 summary:"Disassemble an existing predicate PredSpec in the current module to its WAM 189abstract machine representation WAMCode. 190 191", 192 template:"disasm(+PredSpec, ?WAMCode)", 193 desc:html(" Unifies WAMCode with the WAM instructions representing the abstract 194 machine code for the predicate specified by PredSpec (in Name/Arity 195 form). The WAM code is in the form of a list, with each element 196 representing one WAM instruction. The format of the WAMCode is the same 197 as that used by asm/2,3 and pasm/4 to assemble a predicate. Thus, the 198 WAM code generated by disasm/2,3 can be used to load the predicate into 199 ECLiPSe without having to compile the source Prolog form. 200 201<P> 202 The library asm must be loaded to use diasm/2. 203 204<P> 205 Currently asm/2 cannot disassemble dynamic predicates. 206 207<P> 208"), 209 args:["+PredSpec" : "Atom/Integer.", "?WAMCode" : "Variable or a list of WAM instructions in the right format."], 210 resat:" No.", 211 fail_if:" Fails if WAMCode is initially instantiated and does not unify with the WAM code generated by asm/1 for the predicate, or if PredSpec is dynamic.", 212 exceptions:[5 : "PredSpec is not in correct form.", 60 : "PredSpec does not exist in current module."], 213 eg:" 214 for fruit/1 defined by: 215 216 fruit(orange). 217 218 ?- disasm(fruit / 1, W). 219 W = [get_atom(a(1), orange), retd, code_end] 220 221 222 223", 224 see_also:[disasm / 3, asm / 2, asm / 3, pasm / 4, wam / 1]]). 225 226:- comment(disasm / 3, [ 227 summary:"Disassemble an existing predicate PredSpec in the module Module to its WAM 228abstract machine representation WAMCode. 229 230", 231 template:"disasm(+PredSpec, ?WAMCode, +Module)", 232 desc:html(" Unifies WAMCode with the WAM instructions representing the abstract 233 machine code for the predicate specified by PredSpec (in Name/Arity 234 form) in module Module. The WAM code is in the form of a list, with each 235 element representing one WAM instruction. The format of the WAMCode is 236 the same as that used by asm/2,3 and pasm/4 to assemble a 237 predicate. Thus, the WAM code generated by disasm/2,3 can be used to 238 load the predicate into ECLiPSe without having to compile the source 239 Prolog form. 240 241<P> 242 The library asm must be loaded to use diasm/3. 243 244<P> 245 Currently disasm/3 cannot disassemble dynamic predicates. 246 247<P> 248 If PredSpec is dynamic. 249 250<P> 251"), 252 args:["+PredSpec" : "Atom/Integer.", "?WAMCode" : "Variable or a list of WAM instructions in the right format.", "+Module" : "Atom"], 253 resat:" No.", 254 fail_if:" Fails if WAMCode is initially instantiated and does not unify with the WAM code generated by asm/1 for the predicate, or if PredSpec is dynamic.", 255 exceptions:[5 : "PredSpec or Module not in correct form.", 60 : "PredSpec does not exist in module Module.", 80 : "Module is not an existing module."], 256 see_also:[disasm / 2, asm / 2, asm / 3, pasm / 4, wam / 1]]). 257 258:- comment(pasm / 4, [ 259 summary:"Partially assemble WAMCode into an object format. 260 261", 262 desc:html(" Partially assemble the WAM instructions given WAMCode without loading it 263 into the current session. Instead, an object format is generated. This 264 object format can be loaded into an ECLiPSe session using the low level 265 built-in store_pred/9. fcompile/1,2 uses this predicate to generate the 266 object code for predicates. BTPos is the offset in words to the break/ 267 port table, which are the addresses to the positions in the code for the 268 predicate where a breakpoint can be set (body goals which are tracable). 269 270<P> 271 The partially assembled code consists of Object, which is a typed 272 representation of the words that need to be stored into memory; and 273 Size, the size in words that this object code will occupy in memory. 274 275<P> 276"), 277 amode:(pasm(+,-,-,-) is semidet), 278 args:["WAMCode" : "A list of WAM instructions in the right format.", 279 "Size" : "Variable or integer", 280 "BTPos" : "Variable or integer", 281 "Object" : "A list of object words in the right format."], 282 resat:" No.", 283 fail_if:" If WAMCode is not in correct format.", 284 see_also:[asm / 2, asm / 3, disasm / 2, disasm / 3, fcompile / 1, fcompile / 2, portable_object_code/1]]). 285 286:- comment(portable_object_code / 1, [ 287 summary:"Check whether abstract machine code is 32/64 bit portable", 288 desc:html("\ 289 This check can be run on the output of pasm/4. 290 <P> 291 ECLiPSe runtime engines on 32/64 bit hardware use different abstract 292 machine instructions when processing integers that are between 32 and 293 64 bits in size. Code (and .eco files) that contain such instructions 294 cannot be used on a runtime with different word-size from where it was 295 assembled. This predicate prints warnings and fails if the given code 296 contains such constructs. 297"), 298 amode:(portable_object_code(++) is semidet), 299 args:["Object" : "A list of object words, as produced by pasm/4."], 300 fail_if:"If Object is not portable between 32/64 bit.", 301 see_also:[pasm/4]]). 302 303:- comment(wam / 1, [ 304 summary:"Prints the formatted WAM code for predicate PredSpec. 305 306", 307 template:"wam(+PredSpec)", 308 desc:html(" Prints the WAM instructions representing the predicate specified by 309 PredSpec from the current module in a formatted form. Requires the 310 library asm to be loaded. 311 312<P> 313 If PredSpec is an atom (i.e. no arity is given), then a predicate with 314 that name is printed, and if there are more than one predicate defined 315 (i.e. same name but different arities), then these different predicates 316 will be printed by backtracking. 317 318<P> 319 This predicate is intended as a replacement for the lower level als/1, 320 which performs the same function. The differences are that the abstract 321 instruction names are printed in a more human oriented form (rather than 322 the internal names used by ECLiPSe), and labels and their references are 323 printed symbolically. Note that the predicate is implemented via the 324 disasm/3 predicate of the library, and hence the same restrictions 325 applies: it cannot be used to print the code for dynamic predicates. 326 327<P> 328"), 329 args:["+PredSpec" : "Atom, or Atom/Integer"], 330 resat:" Yes.", 331 fail_if:" If PredSpec is a dynamic predicate.", 332 exceptions:[5 : "PredSpec not in correct form.", 60 : "PredSpec not defined in the current module."], 333 see_also:[disasm / 2, disasm / 3, wam / 2, als / 1]]). 334 335:- comment(wam / 2, [ 336 summary:"Prints the formatted WAM code for predicate PredSpec from module Module.", 337 template:"wam(+PredSpec, +Module)", 338 desc:html(" Prints the WAM instructions representing the predicate specified by 339 PredSpec in a formatted form. Requires the library asm to be loaded. 340 341<P> 342 If PredSpec is an atom (i.e. no arity is given), then a predicate with 343 that name is printed, and if there are more than one predicate defined 344 (i.e. same name but different arities), then these different predicates 345 will be printed by backtracking. 346 347<P> 348 This predicate is intended as a replacement for the lower level als/1, 349 which performs the same function. The differences are that the abstract 350 instruction names are printed in a more human oriented form (rather than 351 the internal names used by ECLiPSe), and labels and their references are 352 printed symbolically. Note that the predicate is implemented via the 353 disasm/3 predicate of the library, and hence the same restrictions 354 applies: it cannot be used to print the code for dynamic predicates. 355 356<P> 357"), 358 args:["+PredSpec" : "Atom, or Atom/Integer", "+Module" : "Atom."], 359 resat:" Yes.", 360 fail_if:" If PredSpec is a dynamic predicate.", 361 exceptions:[5 : "PredSpec or Module not in correct form.", 60 : "PredSpec not defined in module Module.", 80 : "Module is not an existing module."], 362 see_also:[disasm / 2, disasm / 3, wam / 1, als / 1]]). 363 364%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 365 366:- export asm/2, asm/3, 367 disasm/2, disasm/3, 368 wam/1, wam/2, 369 print_wam/1, 370 portable_object_code/1, 371 pasm/4. 372 373:- local struct(label(add,label)), struct(tab(type,table)), 374 struct(try(table,size,ref)). 375 376:- tool(asm/2, asm_/3), 377 tool(asm/3, asm_/4), 378 tool(disasm/2, disasm/3), 379 tool(wam/1, wam/2). 380 381%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 382 383:- import get_bip_error/1, % for error handling 384 set_bip_error/1 385 from sepia_kernel. 386 387:- import store_pred/9, 388 retrieve_code/3, 389 meta_index/2, 390 decode_code/2, 391 integer_list/3, 392 functor_did/2 393 from sepia_kernel. 394 395:- lib(hash). 396 397 398 399%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 400 401/* INSTRUCTION TABLE 402 403 instr/3 lists the abtract instructions for ECLiPSe's WAM: 404 405 instr(WAM, OpCode, TypeList) 406 407 where 408 409 WAM is the symbolic WAM form of the instruction 410 OpCode is the instruction's Op-code 411 TypeList is a list of the types expected for the arguments of the 412 instruction, in the order in which they are stored in memory. 413 414 The following types are recognised: 415 416 Syntax Meaning Size 417 ===================================================================== 418 a(A) argument register A 1 419 y(Y) permanent variable Y 1 420 t(X) temporary variable X 1 421 pw(N) pword offset 1 422 edesc(EnvDesc) environment activity descriptor 423 (integer N, or eam(Bitmap) 1[+table] 424 i(I) integer value I 1 425 f(Z) floating value Z 1 426 atom(C) atom did for C 1 427 s(S) string pointer for string S 1 428 ref(L) reference to label L 1 429 func(D) functor did for functor D 1 430 proc(P) procedure pri for procedure P 1 431 vmask(V) vmask V 2 432 nvmask(V) named vmask 2+ 433 nv(V) named var V 1 434 tags(L) switch labels for switch_on_type # tagtypes 435 tags(L,Ref) labels for switch_on_type + default # tagtypes 436 port(P) port 1 437 brk_port(P) port (can be used to indicate breakpoint) 1 438 tagval(C) tag + value for constant C (in that order) 2 439 valtag(C) value + tag for constant C (in that order) 2 440 mv(M) meta variable M 1 441 an(Name) symbolic name of attribute 1 442 try(Table,Size,Ref) try table 1+table 443 tab(Type,Table) switch table of Type (int,atom,functor, 444 range) 2+table 445 o(O) opcode O. Should only appear in typed-list if 1 446 instruction is `hidden'. 447 tref(L) references to data labels, i.e. outside the 1 448 `code' portion of WAM code. 449 skip(S) skip the next S words 1 450 451Missing: 452 c(CFunction) address of this C function (for external* instructions, 453 currently using i(CAddress)) 454 455*/ 456 457 458instr(label(X), pseudo, [label(X)]). % asm pseudo instr 459 460instr(code_end, 0, []). 461instr(move(a(A)), 1, [a(A)]). 462instr(move(a(A1),a(A2)), 2, [a(A1),a(A2)]). 463instr(move(a(A),y(Y)), 3, [a(A),y(Y)]). 464instr(move(y(Y),a(A)), 4, [y(Y),a(A)]). 465instr(move(t(X),a(A)), 5, [t(X),a(A)]). 466instr(get_variable(N,a(A),y(Y)), 6, [pw(N),a(A),y(Y)]). 467instr(get_value(a(A1),a(A2)), 7, [a(A1),a(A2)]). 468instr(get_value(a(A),y(Y)), 8, [a(A),y(Y)]). 469instr(get_value(y(Y),a(A)), 8, [a(A),y(Y)]). % alias 470instr(get_value(a(A),t(X)), 9, [a(A),t(X)]). 471instr(get_nil(a(A)), 10, [a(A)]). 472instr(get_integer(a(A),C), 11, [a(A),i(C)]). 473instr(get_float(a(A),C), 12, [a(A),f(C)]). 474instr(get_atom(a(A),C), 13, [a(A),atom(C)]). 475instr(get_string(a(A),C), 14, [a(A),s(C)]). 476instr(get_list(a(A),ref(L)), 15, [a(A),ref(L)]). 477instr(get_structure(a(A),D,ref(L)), 16, [a(A),func(D),ref(L)]). 478instr(in_get_nil(a(A)), 17, [a(A)]). 479instr(in_get_integer(a(A),C), 18, [a(A),i(C)]). 480instr(in_get_float(a(A),C), 19, [a(A),f(C)]). 481instr(in_get_atom(a(A),C), 20, [a(A),atom(C)]). 482instr(in_get_string(a(A),C), 21, [a(A),s(C)]). 483instr(in_get_list(a(A),ref(L)), 22, [a(A),ref(L)]). 484instr(in_get_structure(a(A),D,ref(L)), 23, [a(A),func(D),ref(L)]). 485instr(out_get_nil(a(A)), 24, [a(A)]). 486instr(out_get_integer(a(A),C), 25, [a(A),i(C)]). 487instr(out_get_float(a(A),C), 26, [a(A),f(C)]). 488instr(out_get_atom(a(A),C), 27, [a(A),atom(C)]). 489instr(out_get_string(a(A),C), 28, [a(A),s(C)]). 490instr(out_get_list(a(A)), 29, [a(A)]). 491instr(out_get_structure(a(A),D), 30, [a(A),func(D)]). 492instr(get_list_arguments(a(A)), 31, [a(A)]). 493instr(get_structure_arguments(a(A)), 32, [a(A)]). 494instr(write_void, 33, []). 495instr(read_void, 34, []). 496instr(write_variable, 35, []). 497instr(read_variable, 36, []). 498instr(write_variable(a(A)), 37, [a(A)]). 499instr(read_variable(a(A)), 38, [a(A)]). 500instr(write_variable(N,y(Y)), 39, [pw(N),y(Y)]). 501instr(read_variable(N,y(Y)), 40, [pw(N),y(Y)]). 502instr(write_variable(y(Y)), 41, [y(Y)]). 503instr(read_variable(y(Y)), 42, [y(Y)]). 504instr(write_value(a(A)), 43, [a(A)]). 505instr(read_value(a(A)), 44, [a(A)]). 506instr(read_matched_value(a(A)), 45, [a(A)]). 507instr(write_local_value(a(A)), 46, [a(A)]). 508instr(write_value(y(Y)), 47, [y(Y)]). 509instr(read_value(y(Y)), 48, [y(Y)]). 510instr(read_matched_value(y(Y)), 49, [y(Y)]). 511instr(write_local_value(y(Y)), 50, [y(Y)]). 512instr(write_value(t(X)), 51, [t(X)]). 513instr(read_value(t(X)), 52, [t(X)]). 514instr(read_matched_value(t(X)), 53, [t(X)]). 515instr(write_local_value(t(X)), 54, [t(X)]). 516instr(write_nil, 55, []). 517instr(read_nil, 56, []). 518instr(write_integer(C), 57, [i(C)]). 519instr(read_integer(C), 58, [i(C)]). 520instr(write_float(C), 59, [f(C)]). 521instr(read_float(C), 60, [f(C)]). 522instr(write_did(C), 61, [func(C)]). 523instr(write_atom(C), 61, [atom(C)]). % = write_did 524instr(read_atom(C), 62, [atom(C)]). 525instr(write_string(C), 63, [s(C)]). 526instr(read_string(C), 64, [s(C)]). 527instr(write_list, 65, []). 528instr(write_structure(D), 66, [func(D)]). 529instr(read_list(ref(L)), 67, [ref(L)]). 530instr(read_list(t(X),ref(L)), 68, [t(X),ref(L)]). 531instr(read_next_list(t(X),ref(L)), 69, [t(X),ref(L)]). 532instr(read_last_list(ref(L)), 70, [ref(L)]). 533instr(read_structure(D,ref(L)), 71, [func(D),ref(L)]). 534instr(read_structure(D,t(X),ref(L)), 72, [func(D),t(X),ref(L)]). 535instr(read_next_structure(D,t(X),ref(L)),73, [func(D),t(X),ref(L)]). 536instr(read_last_structure(D,ref(L)), 74, [func(D),ref(L)]). 537instr(push_void, 75, []). 538instr(push_variable(a(A)), 76, [a(A)]). 539instr(push_variable(y(Y)), 77, [y(Y)]). 540instr(push_variable, 78, []). 541instr(push_value(a(A)), 79, [a(A)]). 542instr(push_value(y(Y)), 80, [y(Y)]). 543instr(push_value(t(X)), 81, [t(X)]). 544instr(push_local_value(a(A)), 82, [a(A)]). 545instr(push_local_value(y(Y)), 83, [y(Y)]). 546instr(push_local_value(t(X)), 84, [t(X)]). 547instr(push_nil, 85, []). 548instr(push_integer(C), 86, [i(C)]). 549instr(push_float(C), 87, [f(C)]). 550instr(push_init_variable(y(Y)), 88, [y(Y)]). 551instr(push_string(C), 89, [s(C)]). 552instr(push_list, 90, []). 553instr(push_structure(N), 91, [pw(N)]). 554instr(bounce(P), 92, [proc(P)]). 555instr(first, 93, []). 556instr(next(t(X)), 94, [t(X)]). 557instr(mode(t(X)), 95, [t(X)]). 558instr(next(t(X),ref(L)), 96, [t(X),ref(L)]). 559instr(mode(t(X),ref(L)), 97, [t(X),ref(L)]). 560instr(put_variable(a(A),y(Y)), 98, [a(A),y(Y)]). 561instr(put_variable(a(A)), 99, [a(A)]). 562instr(put_unsafe_value(a(A),y(Y)), 100, [a(A),y(Y)]). 563instr(put_nil(a(A)), 101, [a(A)]). 564instr(put_integer(a(A),C), 102, [a(A),i(C)]). 565instr(put_float(a(A),C), 103, [a(A),f(C)]). 566instr(put_atom(a(A),C), 104, [a(A),atom(C)]). 567instr(put_string(a(A),C), 105, [a(A),s(C)]). 568instr(put_list(a(A)), 106, [a(A)]). 569instr(put_structure(a(A),D), 107, [a(A),func(D)]). 570instr(puts_variable, 108, []). 571instr(puts_variable(y(Y)), 109, [y(Y)]). 572instr(puts_value(a(A)), 110, [a(A)]). 573instr(puts_value(y(Y)), 111, [y(Y)]). 574instr(puts_value(t(X)), 112, [t(X)]). 575instr(puts_nil, 113, []). 576instr(puts_integer(C), 114, [i(C)]). 577instr(puts_float(C), 115, [f(C)]). 578instr(puts_atom(C), 116, [atom(C)]). 579instr(puts_string(C), 117, [s(C)]). 580instr(puts_list, 118, []). 581instr(puts_structure(D), 119, [func(D)]). 582instr(integer_switch(a(A),IT,ref(Ld)), 120, [a(A),tab{type:int, 583 table:IT},ref(Ld)]). 584instr(atom_switch(a(A),AT,ref(Ld)), 121, [a(A),tab{type:atom, 585 table:AT},ref(Ld)]). 586instr(list_switch(a(A),ref(Ll),ref(Ln),ref(Ld)), 587 122, [a(A),ref(Ll),ref(Ln),ref(Ld)]). 588instr(functor_switch(a(A),FT,ref(Ld)), 123, [a(A),tab{type:functor, 589 table:FT},ref(Ld)]). 590instr(switch_on_type(a(A),LSt), 124, [a(A),tags(LSt)]). 591instr(atom_switch(y(Y),AT,ref(Ld)), 125, [y(Y),tab{type:atom, 592 table:AT},ref(Ld)]). 593instr(functor_switch(y(Y),FT,ref(Ld)), 126, [y(Y),tab{type:functor, 594 table:FT},ref(Ld)]). 595instr(integer_switch(y(Y),IT,ref(Ld)), 127, [y(Y),tab{type:int, 596 table:IT},ref(Ld)]). 597instr(try_me_else(D,N,ref(L)), 128, [port(D),i(N),ref(L)]). 598instr(try(D,N,ref(L)), 129, [port(D),i(N),ref(L)]). 599instr(try(D,N,ref(La),ref(L)), 130, [port(D),i(N),ref(La),ref(L)]). 600instr(retry_me_else(D,ref(L)), 131, [port(D),ref(L)]). 601instr(retry(D,ref(L)), 132, [port(D),ref(L)]). 602instr(retry(D,ref(La),ref(L)), 133, [port(D),ref(La),ref(L)]). 603instr(trust_me(D), 134, [port(D)]). 604instr(trust(D,ref(L)), 135, [port(D),ref(L)]). 605instr(allocate(N), 136, [pw(N)]). 606instr(space(N), 137, [pw(N)]). 607instr(initialize(y(VList)), 138, [vmask(VList)]). 608instr(branch(ref(L)), 139, [ref(L)]). 609instr(call(ref(L),N), 140, [ref(L),edesc(N)]). 610instr(call(P,N), 141, [proc(P),edesc(N)]). 611instr(callf(ref(L),N), 142, [ref(L),edesc(N)]). 612instr(callf(P,N), 143, [proc(P),edesc(N)]). 613instr(chain(ref(L)), 144, [ref(L)]). 614instr(chain(P), 145, [proc(P)]). 615instr(chainc(ref(L)), 146, [ref(L)]). 616instr(chainc(P), 147, [proc(P)]). 617instr(chaind(ref(L)), 148, [ref(L)]). 618instr(chaind(P), 149, [proc(P)]). 619instr(jmp(ref(L)), 150, [ref(L)]). 620instr(jmp(P), 151, [proc(P)]). 621instr(jmpd(ref(L)), 152, [ref(L)]). 622instr(jmpd(P), 153, [proc(P)]). 623instr(exit, 154, []). 624instr(exitd, 155, []). 625instr(exitc, 156, []). 626instr(ret, 157, []). 627instr(retd, 158, []). 628instr(retn, 159, []). 629instr(savecut, 160, []). 630instr(neckcut, 161, []). 631instr(cut1(O), 162, [pw(O)]). % cut(y(1),O) 632instr(failure, 163, []). 633instr(continue_after_event, 164, []). 634instr(continue_after_event_debug, 165, []). 635instr(escape(P), 166, [proc(P)]). 636instr(list_switch(y(Y),ref(Ll),ref(Ln),ref(Ld)), 637 167, [y(Y),ref(Ll),ref(Ln),ref(Ld)]). 638instr(external(P,CFun), 168, [proc(P),i(CFun)]). 639instr(puts_proc(P), 169, [proc(P)]). 640instr(debug_call_simple(P,Port,Path,L,F,T,MT,NArgs), 170, 641 [proc(P),brk_port(Port),atom(Path),i(L),i(F),i(T),i(MT),i(NArgs)]). 642instr(gc, 171, []). 643instr(debug_exit_simple, 172, []). 644instr(refail, 173, []). 645instr(exit_emulator(N), 174, [i(N)]). 646instr(debug_exit, 175, []). 647instr(get_matched_value(a(A),y(Y)), 176, [a(A),y(Y)]). 648instr(get_matched_value(y(Y),a(A)), 176, [a(A),y(Y)]). % alias 649instr(nop, 177, []). 650instr(ress(Nt,Na,Ne), 178, [pw(Nt),i(Na),edesc(Ne)]). 651instr(deallocate, 179, []). 652instr(get_constant(a(A),C), 180, [a(A),valtag(C)]). 653instr(in_get_constant(a(A),C), 181, [a(A),valtag(C)]). 654instr(out_get_constant(a(A),C), 182, [a(A),valtag(C)]). 655instr(read_constant(C), 183, [valtag(C)]). 656instr(write_constant(C), 184, [valtag(C)]). 657instr(push_constant(C), 185, [valtag(C)]). 658% orders for value, tag is correct for put*_constant!! 659instr(put_constant(a(A),C), 186, [a(A),tagval(C)]). 660instr(puts_constant(C), 187, [tagval(C)]). 661instr(get_matched_value(a(A1),a(A2)), 188, [a(A1),a(A2)]). 662instr(get_matched_value(a(A),t(X)), 189, [a(A),t(X)]). 663instr(debug_exit_simple(MT,ref(Args)), 190, [i(MT),ref(Args)]). 664instr(put_unsafe_value(a(A),t(X)), 191, [a(A),t(X)]). 665instr(branchs(N,ref(L)), 192, [pw(N),ref(L)]). 666instr(gc_test(M), 193, [pw(M)]). 667instr(gc_test(M,N), 194, [pw(M),i(N)]). 668%instr(try_me_dynamic(...), 195, [...]). 669%instr(retry_me_dynamic(...), 196, [...]). 670instr(read_test_var, 197, []). 671instr(retry_me_inline(D,ref(L),N), 198, [port(D),ref(L),edesc(N)]). 672instr(trust_me_inline(D,N), 199, [port(D),edesc(N)]). 673instr(set_bp(ref(L)), 200, [ref(L)]). 674instr(restore_bp, 201, []). 675instr(new_bp(ref(L)), 202, [ref(L)]). 676instr(savecut(y(Y)), 203, [y(Y)]). 677instr(cut(y(Y),O), 204, [y(Y),pw(O)]). 678instr(jmpd(N,ref(L)), 205, [pw(N),ref(L)]). 679instr(switch_on_type(y(Y),LSt), 206, [y(Y),tags(LSt)]). 680instr(metacall(N), 207, [edesc(N)]). 681instr(fastcall(P,N), 208, [port(P),edesc(N)]). 682instr(integer_range_switch(y(Y),RT,ref(Le),ref(Ld)), 683 209, [y(Y),tab{type:range, 684 table:RT},ref(Le),ref(Ld)]). 685instr(suspension_call(N), 210, [edesc(N)]). 686instr(throw, 211, []). 687instr(savecut(a(A)), 212, [a(A)]). 688instr(cut_single, 213, []). 689instr(initialize_named(y(NVList)), 214, [nvmask(NVList)]). 690instr(write_named_void(N), 215, [nv(N)]). 691instr(write_named_variable(N), 216, [nv(N)]). 692instr(write_named_variable(a(A),N), 217, [a(A),nv(N)]). 693instr(write_named_variable(y(Y),N), 218, [y(Y),nv(N)]). 694instr(write_named_variable(O,y(Y),N), 219, [pw(O),y(Y),nv(N)]). 695instr(put_reference(a(A),O,N), 220, [a(A),pw(O),nv(N)]). 696instr(put_reference(a(A),y(Y),O,N), 221, [a(A),y(Y),pw(O),nv(N)]). 697instr(push_self_reference(N), 222, [nv(N)]). 698instr(push_void_reference(O), 223, [pw(O)]). 699instr(push_reference(O), 224, [pw(O)]). 700instr(push_reference(a(A),O), 225, [a(A),pw(O)]). 701instr(push_reference(y(Y),O), 226, [y(Y),pw(O)]). 702instr(puts_reference(O,N), 227, [pw(O),nv(N)]). 703instr(puts_reference(y(Y),O,N), 228, [y(Y),pw(O),nv(N)]). 704instr(occur_check_next, 229, []). 705instr(softcut(y(Y)), 230, [y(Y)]). 706instr(dfid_test(y(Y)), 231, [y(Y)]). 707instr(dfid_test, 232, []). 708instr(depth(y(Y)), 233, [y(Y)]). 709%instr(meta_jmp(...), 234, [...]). 710%instr(undefined(P), 235, [proc(P)]). 711%instr(label, 236, []). % PSEUDO 712instr(comment(S), 237, [skip(S)]). % PSEUDO 713%instr(reserve, 238, []). % PSEUDO 714instr(get_meta(a(A),M), 239, [a(A),mv(M)]). 715instr(in_get_meta(a(A),ref(L)), 240, [a(A),ref(L)]). 716instr(write_meta(N), 241, [nv(N)]). 717instr(match_meta, 242, []). 718instr(match_next_meta(t(X)), 243, [t(X)]). 719instr(match_meta(t(X)), 244, [t(X)]). 720instr(match_last_meta, 245, []). 721instr(read_meta(N,ref(L)), 246, [nv(N),ref(L)]). 722instr(read_next_meta(t(X),N,ref(L)), 247, [t(X),nv(N),ref(L)]). 723instr(read_meta(t(X),N,ref(L)), 248, [t(X),nv(N),ref(L)]). 724instr(read_last_meta(N,ref(L)), 249, [nv(N),ref(L)]). 725instr(continue_after_exception, 250, []). 726instr(cut(a(A)), 251, [a(A)]). 727instr(catch, 252, []). 728instr(res(Arity,Size), 253, [i(Arity),edesc(Size)]). 729instr(handler_call(O), 254, [edesc(O)]). 730instr(retd_nowake, 255, []). 731instr(push_init_reference(y(Y),O), 256, [y(Y),pw(O)]). 732instr(exitd_nowake, 257, []). 733instr(meta_jmp, 258, []). 734instr(suspension_jmp, 259, []). 735instr(explicit_jmp, 260, []). 736instr(read_reference(N,y(Y)), 261, [pw(N),y(Y)]). 737instr(read_reference(y(Y)), 262, [y(Y)]). 738instr(read_reference(a(A)), 263, [a(A)]). 739instr(read_reference, 264, []). 740instr(read_void(N), 265, [pw(N)]). 741instr(integer_range_switch(a(A),RT,ref(Le),ref(Ld)), 742 266, [a(A),tab{type:range, 743 table:RT},ref(Le),ref(Ld)]). 744instr(puts_value(G), 267, [pw(G)]). 745instr(push_value(G), 268, [pw(G)]). 746instr(guard(y(Y),ref(L)), 269, [y(Y),ref(L)]). 747instr(try_parallel(Size,Ar,TT,O), 270, [i(Size),i(Ar),try{table:TT,size:Size,ref:Lt}, 748 /*retry_seq(ref(Lt))*/ o(271),tref(Lt), 749 /*fail_clause(O)*/ o(272),edesc(O), 750 /*try_clause(ref(Lt))*/ o(273),tref(Lt)]). 751instr(read_attribute(At), 274, [an(At)]). 752instr(wake_init(N), 275, [edesc(N)]). 753instr(wake, 276, []). 754instr(ret_nowake, 277, []). 755instr(neckcut_par, 278, []). 756instr(extcall(P), 279, [proc(P)]). 757instr(external0(P,CFun), 280, [proc(P),i(CFun)]). 758instr(external1(P,CFun), 281, [proc(P),i(CFun)]). 759instr(external2(P,CFun), 282, [proc(P),i(CFun)]). 760instr(external3(P,CFun), 283, [proc(P),i(CFun)]). 761instr(clause, 284, []). 762 763% new instructions for ECLiPSe 6.0 764instr(put_global_variable(a(A),y(Y)), 285, [a(A),y(Y)]). 765instr(put_global_variable(y(Y)), 286, [y(Y)]). 766instr(put_global_variable(a(A)), 287, [a(A)]). 767instr(move(y(Y1),y(Y2)), 288, [y(Y1),y(Y2)]). 768instr(get_value(y(Y1),y(Y2)), 289, [y(Y1),y(Y2)]). 769%instr(escape(P,Args), 290, [proc(P),arglist(Args)]). 770 771% new WAM instructions for inlined builtins 772instr(bi_exit(a(A)), 291, [a(A)]). 773instr(bi_bignum(a(A1)), 292, [a(A1)]). 774instr(bi_callable(a(A1)), 293, [a(A1)]). 775instr(bi_cut_to_stamp(a(A1),a(A2),0), 294, [a(A1),a(A2),0]). 776instr(bi_set_bip_error(a(A1)), 295, [a(A1)]). 777instr(bi_get_bip_error(a(A1)), 296, [a(A1)]). 778instr(bi_free(a(A1)), 297, [a(A1)]). 779instr(bi_var(a(A1)), 298, [a(A1)]). 780instr(bi_nonvar(a(A1)), 299, [a(A1)]). 781instr(bi_atom(a(A1)), 300, [a(A1)]). 782instr(bi_integer(a(A1)), 301, [a(A1)]). 783instr(bi_float(a(A1)), 302, [a(A1)]). 784instr(bi_breal(a(A1)), 303, [a(A1)]). 785instr(bi_real(a(A1)), 304, [a(A1)]). 786instr(bi_rational(a(A1)), 305, [a(A1)]). 787instr(bi_string(a(A1)), 306, [a(A1)]). 788instr(bi_number(a(A1)), 307, [a(A1)]). 789instr(bi_atomic(a(A1)), 308, [a(A1)]). 790instr(bi_compound(a(A1)), 309, [a(A1)]). 791instr(bi_meta(a(A1)), 310, [a(A1)]). 792instr(bi_is_suspension(a(A1)), 311, [a(A1)]). 793instr(bi_is_handle(a(A1)), 312, [a(A1)]). 794instr(bi_is_event(a(A1)), 313, [a(A1)]). 795instr(bi_is_list(a(A1)), 314, [a(A1)]). 796instr(bi_identical(a(A1),a(A2)), 315, [a(A1),a(A2)]). 797instr(bi_not_identical(a(A1),a(A2)), 316, [a(A1),a(A2)]). 798instr(bi_inequality(a(A1),a(A2)), 317, [a(A1),a(A2)]). 799instr(bi_not_ident_list(a(A1),a(A2),a(A3)), 318, [a(A1),a(A2),a(A3)]). 800instr(bi_cont_debug, 319, []). 801instr(bi_minus(a(A1),a(UA2),4), 320, [a(A1),a(UA2),i(4)]). 802instr(bi_addi(a(A1),I,a(A2),24), 321, [a(A1),i(I),a(A2),i(24)]). 803instr(bi_add(a(A1),a(A2),a(UA3),16), 322, [a(A1),a(A2),a(UA3),i(16)]). 804instr(bi_sub(a(A1),a(A2),a(UA3),16), 323, [a(A1),a(A2),a(UA3),i(16)]). 805instr(bi_mul(a(A1),a(A2),a(UA3),16), 324, [a(A1),a(A2),a(UA3),i(16)]). 806instr(bi_quot(a(A1),a(A2),a(UA3),16), 325, [a(A1),a(A2),a(UA3),i(16)]). 807instr(bi_div(a(A1),a(A2),a(UA3),16), 326, [a(A1),a(A2),a(UA3),i(16)]). 808instr(bi_rem(a(A1),a(A2),a(UA3),16), 327, [a(A1),a(A2),a(UA3),i(16)]). 809instr(bi_fdiv(a(A1),a(A2),a(UA3),16), 328, [a(A1),a(A2),a(UA3),i(16)]). 810instr(bi_mod(a(A1),a(A2),a(UA3),16), 329, [a(A1),a(A2),a(UA3),i(16)]). 811instr(bi_and(a(A1),a(A2),a(UA3),16), 330, [a(A1),a(A2),a(UA3),i(16)]). 812instr(bi_or(a(A1),a(A2),a(UA3),16), 331, [a(A1),a(A2),a(UA3),i(16)]). 813instr(bi_xor(a(A1),a(A2),a(UA3),16), 332, [a(A1),a(A2),a(UA3),i(16)]). 814instr(bi_bitnot(a(A1),a(UA2),4), 333, [a(A1),a(UA2),i(4)]). 815instr(bi_lt(a(A1),a(A2),a(A3),0), 334, [a(A1),a(A2),a(A3),i(0)]). 816instr(bi_lt(a(A1),a(A2),M,48), 334, [a(A1),a(A2),atom(M),i(48)]). 817instr(bi_le(a(A1),a(A2),a(A3),0), 335, [a(A1),a(A2),a(A3),i(0)]). 818instr(bi_le(a(A1),a(A2),M,48), 335, [a(A1),a(A2),atom(M),i(48)]). 819instr(bi_gt(a(A1),a(A2),a(A3),0), 336, [a(A1),a(A2),a(A3),i(0)]). 820instr(bi_gt(a(A1),a(A2),M,48), 336, [a(A1),a(A2),atom(M),i(48)]). 821instr(bi_ge(a(A1),a(A2),a(A3),0), 337, [a(A1),a(A2),a(A3),i(0)]). 822instr(bi_ge(a(A1),a(A2),M,48), 337, [a(A1),a(A2),atom(M),i(48)]). 823instr(bi_eq(a(A1),a(A2),a(A3),0), 338, [a(A1),a(A2),a(A3),i(0)]). 824instr(bi_eq(a(A1),a(A2),M,48), 338, [a(A1),a(A2),atom(M),i(48)]). 825instr(bi_ne(a(A1),a(A2),a(A3),0), 339, [a(A1),a(A2),a(A3),i(0)]). 826instr(bi_ne(a(A1),a(A2),M,48), 339, [a(A1),a(A2),atom(M),i(48)]). 827instr(bi_arg(a(A1),a(A2),a(UA3),16), 340, [a(A1),a(A2),a(UA3),i(16)]). 828instr(bi_arg(I,a(A2),a(UA3),18), 340, [i(I),a(A2),a(UA3),i(18)]). 829instr(bi_make_suspension(a(A1),a(A2),a(A3),a(A4),0), 830 341, [a(A1),a(A2),a(A3),a(A4),i(0)]). 831instr(debug_call(P,Port,Path,L,F,T), 342, [proc(P),brk_port(Port),atom(Path),i(L),i(F),i(T)]). 832 /* caution: p_proc_flags() and p_proc_set_flags() 833 in bip_db.c relies on the above argument order! 834 */ 835instr(retry_inline(D,ref(L),N), 343, [port(D),ref(L),edesc(N)]). 836instr(trust_inline(D,ref(L),N), 344, [port(D),ref(L),edesc(N)]). 837instr(put_named_variable(a(A),N), 345, [a(A),nv(N)]). 838instr(put_named_variable(y(Y),N), 346, [y(Y),nv(N)]). 839instr(put_named_variable(a(A),y(Y),N), 347, [a(A),y(Y),nv(N)]). 840%instr(call_dynamic(P,ref(L)), 348, [proc(P),ref(L)]). 841% more new instructions for ECLiPSe 6.0 - generated by peephole optimizer 842instr(write_void(N), 349, [pw(N)]). 843instr(push_void(N), 350, [pw(N)]). 844instr(move(N, y(Y), a(A)), 351, [i(N), y(Y), a(A)]). 845instr(move(N, a(A), y(Y)), 352, [i(N), a(A), y(Y)]). 846instr(move(y(Y1),a(A1),y(Y2),a(A2)), 353, [y(Y1),a(A1),y(Y2),a(A2)]). 847instr(move(y(Y1),a(A1),y(Y2),a(A2),y(Y3),a(A3)), 848 354, [y(Y1),a(A1),y(Y2),a(A2),y(Y3),a(A3)]). 849instr(move(a(A1),y(Y1),a(A2),y(Y2)), 355, [a(A1),y(Y1),a(A2),y(Y2)]). 850instr(move(a(A1),y(Y1),a(A2),y(Y2),a(A3),y(Y3)), 851 356, [a(A1),y(Y1),a(A2),y(Y2),a(A3),y(Y3)]). 852instr(move(a(A1),a(A2),a(A3),a(A4)), 357, [a(A1),a(A2),a(A3),a(A4)]). 853instr(move(a(A1),a(A2),a(A3),a(A4),a(A5),a(A6)), 854 358, [a(A1),a(A2),a(A3),a(A4),a(A5),a(A6)]). 855instr(move(y(Y1),y(Y2),y(Y3),y(Y4)), 359, [y(Y1),y(Y2),y(Y3),y(Y4)]). 856instr(move(y(Y1),y(Y2),y(Y3),y(Y4),y(Y5),y(Y6)), 857 360, [y(Y1),y(Y2),y(Y3),y(Y4),y(Y5),y(Y6)]). 858instr(swap(a(A1),a(A2)), 361, [a(A1),a(A2)]). 859instr(shift(a(A1),a(A2),a(A3)), 362, [a(A1),a(A2),a(A3)]). 860instr(shift(a(A1),a(A2),a(A3),a(A4)), 363, [a(A1),a(A2),a(A3),a(A4)]). 861instr(shift(a(A1),a(A2),a(A3),a(A4),a(A5)), 862 364, [a(A1),a(A2),a(A3),a(A4),a(A5)]). 863instr(read_variable2(a(A1),y(Y2)), 365, [a(A1),y(Y2)]). 864instr(read_variable2(a(A1),a(A2)), 366, [a(A1),a(A2)]). 865instr(read_variable2(y(Y1),y(Y2)), 367, [y(Y1),y(Y2)]). 866instr(write_variable2(a(A1),y(Y2)), 368, [a(A1),y(Y2)]). 867instr(write_variable2(a(A1),a(A2)), 369, [a(A1),a(A2)]). 868instr(write_variable2(y(Y1),y(Y2)), 370, [y(Y1),y(Y2)]). 869instr(write_local_value2(a(A1),a(A2)), 371, [a(A1),a(A2)]). 870instr(write_local_value2(y(Y1),y(Y2)), 372, [y(Y1),y(Y2)]). 871instr(push_local_value2(a(A1),a(A2)), 373, [a(A1),a(A2)]). 872instr(push_local_value2(y(Y1),y(Y2)), 374, [y(Y1),y(Y2)]). 873instr(put_global_variable2(a(A1),y(Y1),a(A2),y(Y2)), 874 375, [a(A1),y(Y1),a(A2),y(Y2)]). 875instr(put_variable2(a(A1),a(A2)), 376, [a(A1),a(A2)]). 876%instr(get_atom2(a(A1),C1,a(A2),C2), 377, [a(A1),atom(C1),a(A2),atom(C2)]). 877%instr(get_integer2(a(A1),C1,a(A2),C2), 378, [a(A1),i(C1),a(A2),i(C2)]). 878%instr(get_atominteger(a(A1),C,a(A2),I), 379, [a(A1),atom(C),a(A2),i(I)]). 879instr(write_first_structure(D), 380, [func(D)]). 880instr(write_first_list, 381, []). 881instr(write_next_structure(D,t(X)), 382, [func(D),t(X)]). 882instr(write_next_list(t(X)), 383, [t(X)]). 883instr(write_next_structure(D,t(X),ref(L)), 884 384, [func(D),t(X),ref(L)]). 885instr(write_next_list(t(X),ref(L)), 385, [t(X),ref(L)]). 886%instr(read_atom2(C1,C2), 386, [atom(C1),atom(C2)]). 887%instr(read_integer2(C1,C2), 387, [i(C1),i(C2)]). 888%instr(read_integeratom(C1,C2), 388, [i(C1),atom(C2)]). 889%instr(read_atominteger(C1,C2), 389, [atom(C1),i(C2)]). 890instr(write_did2(C1,C2), 390, [func(C1),func(C2)]). 891instr(write_atom2(C1,C2), 390, [atom(C1),atom(C2)]). %=write_did2 892instr(write_atomdid(C1,C2), 390, [atom(C1),func(C2)]). %=write_did2 893instr(write_didatom(C1,C2), 390, [func(C1),atom(C2)]). %=write_did2 894instr(write_integer2(C1,C2), 391, [i(C1),i(C2)]). 895instr(write_integerdid(C1,C2), 392, [i(C1),func(C2)]). 896instr(write_integeratom(C1,C2), 392, [i(C1),atom(C2)]). %=write_integerdid 897instr(write_didinteger(C1,C2), 393, [func(C1),i(C2)]). 898instr(write_atominteger(C1,C2), 393, [atom(C1),i(C2)]). %=writedidinteger 899instr(move_callf(y(Y),a(A),ref(L),N), 394, [y(Y),a(A),ref(L),edesc(N)]). 900instr(move_callf(y(Y),a(A),P,N), 395, [y(Y),a(A),proc(P),edesc(N)]). 901instr(move_chain(y(Y),a(A),ref(L)), 396, [y(Y),a(A),ref(L)]). 902instr(move_chain(y(Y),a(A),P), 397, [y(Y),a(A),proc(P)]). 903instr(put_global_variable_callf(a(A),y(Y),ref(L),N), 904 398, [a(A),y(Y),ref(L),edesc(N)]). 905instr(put_global_variable_callf(a(A),y(Y),P,N), 906 399, [a(A),y(Y),proc(P),edesc(N)]). 907instr(rot(a(A1),a(A2),a(A3)), 400, [a(A1),a(A2),a(A3)]). 908instr(bi_arity(a(A1),a(UA2),4), 401, [a(A1),a(UA2),i(4)]). 909instr(exits(N), 402, [pw(N)]). 910instr(cut(a(A),O), 403, [a(A),pw(O)]). 911instr(put_module(a(A),C), 404, [a(A),atom(C)]). 912instr(bi_compare(a(UA),a(A1),a(A2)), 405, [a(UA),a(A1),a(A2)]). 913instr(bi_list_end(a(A1),a(UA)), 406, [a(A1),a(UA)]). 914instr(bi_qualify(a(A1),a(UA),a(A3)), 407, [a(A1),a(UA),a(A3)]). 915 916 917/*************************************************************************** 918 assemble 919****************************************************************************/ 920% 921% IMPLEMENTATION: 922% 923% asm/2 is based on the low-level builtins store_pred/9. 924% store_pred(+PredSpec, +CodeList, +Size, +BTPos, +Flags, 925% +File, +Line, +Offset, +Module) 926% maps every element of CodeList into memory. CodeList is a session 927% independent representation of the WAM code for PredSpec. Each 928% element generally maps onto one memory word, except for switch 929% tables which must be sorted at load-time. Size is the size in words 930% for the WAM code (including break-table) of PredSpec. BTPos is the 931% offset in words from the start of code to the break-table, or 0 if 932% there is no break-table. File, Line, Offset gives source 933% information for the predicate, but is unused here (all set to 0) 934% 935% FORMAT 936% 937% The CodeList for a predicate consists of two parts: the instruction 938% part, followed by the data part. The instruction part contains the 939% WAM instructions, and the data part the tables for the predicate. 940% The tables must be pword aligned. 941 942% asm(+PredSpec, +ListOfInstructions, +Module) 943 944 945asm_(Pred, WAMList, Module) :- 946 asm_(Pred, WAMList, 0, Module). 947 948 949asm_(Pred, WAMList, Flags, Module) :- 950 ( integer(Flags) -> 951 (Pred = F/A, is_proc(F/A) -> 952 pass1(WAMList, _H, WordList0, BrkTable0), 953 !, 954 (BrkTable0 = [0] -> 955 % no break ports, terminating 0 only 956 BTSize = 0, BTPos = 0, BrkTable = [] 957 ; 958 BTPos = CSize, BrkTable = BrkTable0, 959 length(BrkTable, BTSize) 960 ), 961 link(WordList0, 0, CSize, OutputList, BrkTable), 962 Size is CSize + BTSize, 963 store_pred(Pred, OutputList, Size, BTPos, Flags, 0, 0, 0, Module) 964 ; 965 set_bip_error(5) 966 ) 967 ; atom(Flags) -> 968 % backward compatibility: allow asm(Pred,WAM,Module) 969 asm_(Pred, WAMList, 0, Flags) 970 ; 971 set_bip_error(5) 972 ). 973asm_(Pred, WAMList, Flags, Module) :- 974 get_bip_error(E), 975 error(E, asm(Pred,WAMList,Flags), Module). 976 977 978/* pasm(+WAMList, -Size, -BTPos, -OutList) 979 980 WAMList: list of WAM code for PredSpec 981 Size: size in words of assembled code, including break-table 982 BTPos: offset from start of code in words to the break-points table 983 OutList: a flat word list of assembled code, with tables which cannot be 984 resolved until load time bracketed by dep_table(..) 985*/ 986pasm(WAMList, Size, BTPos, OutList) :- 987 pass1(WAMList, _H, WordList0, BrkTable0), 988 !, 989 (BrkTable0 = [0] -> 990 % no break ports, terminating 0 only 991 BTSize = 0, BTPos = 0, BrkTable = [] 992 ; 993 BTPos = CSize, BrkTable = BrkTable0, 994 length(BrkTable, BTSize) 995 ), 996 link(WordList0, 0, CSize, OutList, BrkTable), 997 Size is CSize + BTSize. 998pasm(WAMList, Size, BTPos, OutList) :- 999 get_bip_error(E), 1000 error(E, pasm(WAMList, Size, BTPos, OutList)). 1001 1002 1003/* pass1(+WAMList, -Hash, -WordList, -BrkList) 1004 1005 generates the independent typed WordList from the WAM instructions list 1006 WAMList, and a list BrkList of ref to brk_port words, which forms the 1007 break-table (terminated by a 0). 1008 1009 This typed word list has no low level dependencies in that the switch 1010 tables whose entries may be session dependent are stored in source form 1011 at the place where the table is to be inserted in memory. The format 1012 for this list is what is accepted by the allocate_code built-in 1013 1014 Hash is used to store the label index to variable mapping - this allow 1015 label in WAMList to be an integer, which is replaced with a variable. 1016*/ 1017pass1(WAMList, H, WordList, BrkList) :- 1018 hash_create(H), 1019 instr(code_end, Code_end, _), 1020 % made sure there is a code_end at end of instructions 1021 pass1(WAMList, H, WordList, [o(Code_end)|TList], TList, BrkList). 1022 1023 1024pass1([], _, IList, IList, [], [0]). % leave IList tail as var, terminating 0 for BrkList 1025pass1([Instr|Instrs], H, IList0, IList, TList0, BrkList0) :- 1026 (instr(Instr, Opc, Typed) -> 1027 (fill_wordlist(Opc, Typed, H, IList0, IList1, TList0, TList1, BrkList0, BrkList1) -> 1028 pass1(Instrs, H, IList1, IList, TList1, BrkList1) 1029 ; printf(error, "%w contains unexpected arguments.%n", [Instr]), 1030 set_bip_error(6) 1031 ) 1032 ; printf(error, "%w instruction not recognised.%n", [Instr]), 1033 set_bip_error(6) 1034 ). 1035 1036 1037 1038fill_wordlist(pseudo, Typed, H, IList0, IList, TList0, TList, BList0, BList) :- !, 1039% asm psuedo instruction, do not add Opc to list 1040 asm_args(Typed, H, IList0, IList, TList0, TList, BList0, BList). 1041fill_wordlist(Opc, Typed, H, IList0, IList, TList0, TList, BList0, BList) :- 1042 integer(Opc), 1043 IList0 = [o(Opc)|IList1], 1044 asm_args(Typed, H, IList1, IList, TList0, TList, BList0, BList). 1045 1046 1047asm_args([], _H, IList0, IList, TList0, TList, BList0, BList) ?- 1048 IList0 = IList, TList0 = TList, BList0 = BList. 1049asm_args([Arg|Args], H, IList0, IList, TList0, TList, BList0, BList) ?- 1050 asm_arg(Arg, H, IList0, IList1, TList0, TList1, BList0, BList1), 1051 asm_args(Args, H, IList1, IList, TList1, TList, BList1, BList). 1052 1053/* asm_arg(+Arg, +Hash, -InstrIn, -InstrOut, +TableIn, -TableOut, +BrkIn, -BrkOut) 1054 1055 assembles an argument for a WAM instr. It performs some simple type checking 1056 on Arg and then creates the corresponding typed word(s). 1057 1058 Arg: current argument 1059 Hash: hash table storing the mapping for any integer index label 1060 to their variable label replacements 1061 Instr: independent word list pair, where the corresponding typed 1062 word(s) to Arg will be generated 1063 Table: table word list pair, where any tables generated by an 1064 argument is placed. This list is later appended to the end 1065 of the instruction list 1066 BList: list of ref to brk_port words in code for predicate. This 1067 list is later appended to the end of the word list (after 1068 Table, with a terminating 0, to form the full independent 1069 word list. 1070 The cut in each clause is not strictly needed as the clauses are mutually 1071 exclusive. They are used to distinguish the type testing and the typed 1072 word creation phases. 1073 1074 Arg's type corresponds to the types used in instr/3 1075*/ 1076asm_arg(a(A), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1077 integer(A), A >= 0, !, 1078 TList0 = TList, 1079 BList0 = BList, 1080 IList0 = [a(A)|IList]. 1081asm_arg(arglist(AList), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1082 nonvar(AList), !, 1083 TList0 = TList, 1084 BList0 = BList, 1085 ( foreach(Arg,AList), fromto(IList0,[Arg|IList1],IList1,IList) do 1086 nonvar(Arg), Arg = a(A), integer(A), A>0 1087 ). 1088asm_arg(y(Y), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1089 integer(Y), Y >= 0, !, 1090 TList0 = TList, 1091 BList0 = BList, 1092 IList0 = [y(Y)|IList]. 1093asm_arg(t(X), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1094 integer(X), !, 1095 TList0 = TList, 1096 BList0 = BList, 1097 IList0 = [t(X)|IList]. 1098asm_arg(pw(N), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1099 integer(N), !, % no wrappers 1100 TList0 = TList, 1101 BList0 = BList, 1102 IList0 = [pw(N)|IList]. 1103asm_arg(edesc(EDesc), _H, IList0, IList, TList0, TList, BList0, BList) ?- !, 1104 BList0 = BList, 1105 encode_edesc(EDesc, IList0, IList, TList0, TList). 1106asm_arg(i(N), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1107 integer(N), !, 1108 TList0 = TList, 1109 BList0 = BList, 1110 IList0 = [N|IList]. 1111asm_arg(f(N), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1112 float(N), !, 1113 TList0 = TList, 1114 BList0 = BList, 1115 IList0 = [N|IList]. 1116asm_arg(atom(A), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1117 atom(A), !, 1118 TList0 = TList, 1119 BList0 = BList, 1120 IList0 = [A|IList]. 1121asm_arg(s(S), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1122 string(S), !, 1123 TList0 = TList, 1124 BList0 = BList, 1125 IList0 = [S|IList]. 1126asm_arg(ref(L0), H, IList0, IList, TList0, TList, BList0, BList) ?- 1127 valid_reflab(L0), !, 1128 label_idx_to_var(L0, H, L), 1129 TList0 = TList, 1130 BList0 = BList, 1131 IList0 = [ref(L)|IList]. 1132asm_arg(label(L0), H, IList0, IList, TList0, TList, BList0, BList) ?- 1133 ( var(L0) -> 1134 L0 = L 1135 ; integer(L0) -> 1136 label_idx_to_var(L0, H, L) 1137 ; 1138 fail 1139 ), !, 1140 TList0 = TList, 1141 BList0 = BList, 1142 IList0 = [label(L)|IList]. 1143asm_arg(func(N/A), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1144 atom(N), integer(A), !, 1145 TList0 = TList, 1146 BList0 = BList, 1147 IList0 = [functor(N/A)|IList]. 1148asm_arg(proc(P), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1149 is_proc(P), !, 1150 TList0 = TList, 1151 BList0 = BList, 1152 IList0 = [proc(P)|IList]. 1153asm_arg(vmask(VList), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1154 sort(VList,Sorted), 1155 (foreach(E,Sorted) do integer(E)), !, 1156 Sorted = [First|_], 1157 TList0 = TList, 1158 BList0 = BList, 1159 IList0 = [y(First),ymask(Sorted)|IList]. 1160asm_arg(nvmask(NVList), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1161 sort(1, <, NVList, NVSorted), 1162 split_varsnames(NVSorted, VList, NList), !, 1163 TList0 = TList, 1164 BList0 = BList, 1165 VList = [First|_], 1166 % NList elements already in form nv(Name) 1167 append([y(First),ymask(VList)|NList], IList, IList0). 1168asm_arg(nv(VN), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1169 atom(VN), !, 1170 TList0 = TList, 1171 BList0 = BList, 1172 IList0 = [nv(VN)|IList]. 1173asm_arg(tags(LList), H, IList0, IList, TList0, TList, BList0, BList) ?- 1174 decode_code(tags, Tags), 1175 functor(Tags, tags, Arity), 1176 functor(TagLabels, tags, Arity), % create 1177 (foreach(Tag:Ref,LList), param([TagLabels,Tags]) do 1178 valid_ref(Ref), 1179 find_arg_in_struct(Tag, Tags, Pos), 1180 arg(Pos, TagLabels, Ref) 1181 ), 1182 TList0 = TList, 1183 BList0 = BList, 1184 (foreacharg(Ref0,TagLabels), 1185 fromto(IList0,[Ref|IList1],IList1,IList), param(H) do 1186 ( var(Ref0) -> 1187 Ref = ref(fail) 1188 ; 1189 Ref0 = ref(L0), 1190 Ref = ref(L), 1191 label_idx_to_var(L0, H, L) 1192 ) 1193 ). 1194asm_arg(tags(LList,DefRef), H, IList0, IList, TList0, TList, BList0, BList) ?- 1195 valid_ref(DefRef0), 1196 DefRef0 = ref(L0), 1197 DefRef = ref(L), 1198 label_idx_to_var(L0, H, L), 1199 decode_code(tags, Tags), 1200 functor(Tags, tags, Arity), 1201 functor(TagLabels, tags, Arity), % create 1202 (foreach(Tag:Ref,LList), param([TagLabels,Tags]) do 1203 valid_ref(Ref), 1204 find_arg_in_struct(Tag, Tags, Pos), 1205 arg(Pos, TagLabels, Ref) 1206 ), 1207 TList0 = TList, 1208 BList0 = BList, 1209 (foreacharg(Ref0,TagLabels), 1210 fromto(IList0,[Ref|IList1],IList1,IList), param(DefRef, H) do 1211 (var(Ref0) -> 1212 Ref = DefRef 1213 ; 1214 Ref0 - ref(L0), 1215 Ref = ref(L), 1216 label_idx_to_var(L0, H, L) 1217 ) 1218 ). 1219asm_arg(port(P), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1220 integer(P), !, % treat in raw form as an int for now 1221 TList0 = TList, 1222 BList0 = BList, 1223 IList0 = [P|IList]. 1224asm_arg(brk_port(P), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1225 integer(P), !, % treat in raw form as an int for now 1226 TList0 = TList, 1227 BList0 = [ref(BLab)|BList], 1228 IList0 = [brk_port(P,BLab)|IList]. 1229asm_arg(valtag(C), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1230 ground(C), !, 1231 TList0 = TList, 1232 BList0 = BList, 1233 IList0 = [val(C),tag(C)|IList]. 1234asm_arg(tagval(C), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1235 ground(C), !, 1236 TList0 = TList, 1237 BList0 = BList, 1238 IList0 = [tag(C),val(C)|IList]. 1239asm_arg(mv(M), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1240 atom(M), !, 1241 TList0 = TList, 1242 BList0 = BList, 1243 IList0 = [mv(M)|IList]. 1244asm_arg(an(Att), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1245 atom(Att), !, 1246 TList0 = TList, 1247 BList0 = BList, 1248 IList0 = [an(Att)|IList]. 1249asm_arg(try{table:Table,ref:TLabel}, H, IList0, IList, TList0, TList, BList0, BList) ?- 1250 (foreach(Branch, Table) do 1251 valid_ref(Branch) 1252 ), !, 1253 BList0 = BList, 1254 IList0 = [ref(TLabel0)|IList], 1255 label_idx_to_var(TLabel0, H, TLabel), 1256 append([align(2),label(TLabel)|Table], TList, TList0). 1257asm_arg(tab{table:Table,type:Type}, H, IList0, IList, TList0, TList, BList0, BList) ?- !, 1258 table_size(Table, Type, Size), 1259 IList0 = [ref(TLabel), Size|IList], 1260 BList0 = BList, 1261 make_switch_table(Type, H, TLabel, Table, TList0, TList). 1262asm_arg(o(N), _H, IList0, IList, TList0, TList, BList0, BList) ?- 1263 integer(N), N >= 0, !, 1264 TList0 = TList, 1265 BList0 = BList, 1266 IList0 = [o(N)|IList]. 1267asm_arg(tref(L), H, IList0, IList, TList0, TList, BList0, BList) ?- !, 1268% for assembly, treat just like normal refs 1269 BList0 = BList, 1270 asm_arg(ref(L), H, IList0, IList, TList0, TList, BList0, BList). 1271asm_arg(skip(_S), _H, _IList0, _IList, _TList0, _TList, _BList0, _BList) ?- !, 1272 printf(error, "comment instruction not supported for asm/3"), 1273 set_bip_error(6). 1274 1275 1276is_proc(M:N/A) ?- atom(M), atom(N), integer(A). 1277is_proc(N/A) ?- atom(N), integer(A). 1278 1279valid_functor(N/A) ?- atom(N), integer(A). 1280 1281 1282valid_ref(ref(L)) ?- valid_reflab(L). 1283 1284valid_reflab(L) :- var(L), !. 1285valid_reflab(I) :- integer(I), !. % Code segment index (new compiler) 1286valid_reflab(L) :- valid_symbol(L). 1287 1288 1289% Warn and fail if the code contains bignums between 32 and 64 bits 1290portable_object_code(Ws) :- 1291 portable_object_code(Ws, Res), 1292 Res = true. % fail late 1293 1294portable_object_code([], true). 1295portable_object_code([W|Ws], Result) :- 1296 ( ( unsafe_integer(W), C=W ; W=tag(C), unsafe_bignum(C)) -> 1297 Result = false, 1298 printf(warning_output, 1299 "WARNING: integer between 32 and 64 bit found in code (%w)%n", [C]), 1300 portable_object_code(Ws, _) 1301 ; 1302 portable_object_code(Ws, Result) 1303 ). 1304 1305 unsafe_integer(I) :- integer(I), ( I < -2147483647 -> true ; I > 2147483647 ). 1306 1307 unsafe_bignum(I) :- integer(I), -2^63 =< I, I < 2^63. 1308 1309 1310% encode/decode environment descriptors 1311% We allow the following specifications 1312% - integer (environment size, for a transition period) 1313% - eam(integer or bignum) (environment activity bitmap) 1314% - SlotList (list of active Y slot numbers) 1315encode_edesc(ESize, Is, Is0, Ts, Ts0) :- 1316 integer(ESize), !, 1317 Is = [pw(ESize)|Is0], Ts = Ts0. 1318encode_edesc(eam(EAM), Is, Is0, Ts, Ts0) ?- !, 1319 ( EAM =< 2147483647 -> 1320 % small bitmap, store inline 1321 Is = [MarkedChunk|Is0], Ts = Ts0, 1322 shl_32bit(EAM, ShiftedChunk), 1323 MarkedChunk is ShiftedChunk+1 % mark as inline bitmap 1324 ; 1325 % large bitmap, store separately, pointer in code 1326 % The pointer is tagged by adding 2. 1327 Is = [refm(BigMap,2)|Is0], 1328 Ts = [label(BigMap)|Ts1], 1329 integer_list(EAM, 31, Chunks), % make 31-bit chunks 1330 ( 1331 fromto(Chunks,[Chunk|Chunks1],Chunks1,[ChunkN]), 1332 fromto(Ts1,[ShiftedChunk|Ts2],Ts2,[MarkedChunkN|Ts0]) 1333 do 1334 shl_32bit(Chunk, ShiftedChunk) 1335 ), 1336 MarkedChunkN is shl_32bit(ChunkN) + 1 % mark as last chunk 1337 ). 1338encode_edesc(Bits, Is, Is0, Ts, Ts0) :- 1339 is_list(Bits), 1340 ( foreach(Bit,Bits), fromto(0,EAM1,EAM2,EAM) do 1341 EAM2 is setbit(EAM1, Bit-1) 1342 ), 1343 encode_edesc(eam(EAM), Is, Is0, Ts, Ts0). 1344 1345 1346 % shift left by one, simulating 32-bit two's complement arithmetic 1347 shl_32bit(X, R) :- 1348 ( X >= 16'40000000 -> 1349 % shift would overflow signed 32 bits: subtract 2^32, i.e. 1350 % R is X<<1 - 2^32, then rewrite to avoid bignums: 1351 R is -2147483647 - 1 + (X-16'40000000)<<1 1352 ; 1353 R is X << 1 1354 ). 1355 1356 1357/* link(+CodeList, +PosIn, -PosOut, -FinalCodeList) 1358 1359 generates the final code list that will be stored by store_pred/9. It takes 1360 the CodeList generated by pass1, and fills in the references, remove 1361 labels, fills in alignments, and computes the size in words for the final 1362 code list. 1363 1364 PosIn: current position in final code list (in words) from start of list 1365 PosOut: final position at end of final code list, i.e. size of list 1366*/ 1367link([], Size, Size, Output, Output). 1368link([label(Displ)|Ws], Pos0, Pos, Output, OutputT) ?- !, 1369 Displ = Pos0, 1370 link(Ws, Pos0, Pos, Output, OutputT). 1371link([align(N)|Ws], Pos0, Pos, Output, OutputT) ?- !, 1372 insert_nops(N, Pos0, Pos1, Output, Output1), 1373 link(Ws, Pos1, Pos, Output1, OutputT). 1374link([table(Table,Size)|Ws], Pos0, Pos, Output, OutputT) ?- !, 1375 Pos1 is Pos0 + Size, 1376 Output = [table(Table,Size)|Output1], 1377 link(Ws, Pos1, Pos, Output1, OutputT). 1378link([brk_port(P,Displ)|Ws], Pos0, Pos, Output, OutputT) ?- !, 1379 Displ = Pos0, 1380 Output = [P|Output1], 1381 Pos1 is Pos0 + 1, 1382 link(Ws, Pos1, Pos, Output1, OutputT). 1383link([W|Ws], Pos0, Pos, Output, OutputT) ?- 1384 Output = [W|Output1], 1385 Pos1 is Pos0 + 1, 1386 link(Ws, Pos1, Pos, Output1, OutputT). 1387 1388 1389 1390 1391 1392make_switch_table(int, H, TL, Table, [align(2),label(TL)|Ts0], Ts) :- !, 1393 % add alignment and label for table 1394 keysort(Table, SortedTable), 1395 insert_table(SortedTable, int, H, Ts0, Ts). 1396make_switch_table(range, H, TL, Table, [align(2),label(TL)|Ts0], Ts) :- !, 1397 % add alignment and label for table 1398 Table = [Min,Max|TableRest], 1399 keysort(TableRest, SortedTableRest), 1400 insert_table([Min,Max|SortedTableRest], int, H, Ts0, Ts). 1401make_switch_table(Type, H, TL, Table, [align(2),label(TL)|Ts0], Ts) :- 1402 % add alignment and label for table 1403 (Type == atom ; Type == functor), !, 1404 make_nonint_table(Table, H, Ts0, Ts). 1405 1406 1407make_nonint_table(Table, H, Ts0, Ts) ?- 1408 length(Table, N), 1409 Size is N * 2, % 2 words per entry. Size here is for *all* entries 1410 ( foreach(Key-ref(LabIdx),Table), foreach(Key-ref(Lab),Table1), param(H) do 1411 label_idx_to_var(LabIdx, H, Lab) 1412 ), 1413 Ts0 = [table(Table1,Size)|Ts]. 1414 1415table_size(Table, Type, Size) :- 1416 length(Table, Size0), 1417 extra_table_entries(Type, Extra), 1418 % extra entries are not included in size calculations 1419 Size is Size0 - Extra. 1420 1421 1422% insert entries of switch table to the tables word list 1423insert_table([], _, _H, Ts, Ts). 1424insert_table([Key-L0|Es], Type, H, [Key,L|Ts0], Ts) :- 1425% ref. may already be instantiated as linking is in progress 1426 valid_ref(L0), 1427 valid_key(Type, Key), 1428 L0 = ref(Lab0), 1429 L = ref(Lab), 1430 label_idx_to_var(Lab0, H, Lab), 1431 insert_table(Es, Type, H, Ts0, Ts). 1432 1433valid_key(int, I) ?- integer(I). 1434% Key is an integer either because it is an integer or an address 1435valid_key(atom, A) ?- atom(A). 1436valid_key(functor, F) ?- valid_functor(F). 1437 1438 1439% the number of Padding words (as nops) that has to be inserted for alignment 1440% to N multiple of words in word list In, at the Lth word. 1441insert_nops(N, L, NewL, In, Out) :- 1442 Padding is N - (((L - 1) mod N) + 1), 1443 NewL is Padding + L, 1444 instr(nop, NopCode, _), 1445 (for(_,1,Padding), param(NopCode), 1446 fromto(In, [o(NopCode)|Pads], Pads, Out) do true 1447 ). 1448 1449 1450/* label_idx_to_var(+LabelIn, +Hash, -LabelOut) 1451 maps LabelIn to LabelOut: if LabelIn is a integer index label, LabelOut 1452 is the equivalent variable label. This predicate assumes LabelIn is a 1453 valid label, i.e. it should only be called after a call to valid_reflab/1 1454*/ 1455label_idx_to_var(L0, H, L) :- 1456 ( integer(L0) -> 1457 ( hash_find(H, L0, L) -> true ; hash_add(H, L0, L) /*new var*/) 1458 ; L0 = L 1459 ). 1460 1461 1462/************************************************************************** 1463 disassemble 1464***************************************************************************/ 1465% 1466% IMPLEMENTATION: 1467% 1468% disasm/2 is based on the low-level builtins retrieve_code/3 1469% and decode_code/2. retrieve_code retrieves the machine word 1470% representation of the code for a predicate, and decode_code is 1471% used to help decode the words into WAM representation 1472% 1473 1474%disasm(+PredSpec, -ListOfInstructions, +Module) 1475disasm(Pred, WAMList, Module) :- 1476% is_existing_pred(Pred, Module), 1477 hash_create(H), 1478 retrieve_code(Pred, [code(Base,WordList)|_], Module), 1479 interpret_pred(WordList, Base, H, 0, WAMList0, InstrStarts), 1480 hash_list(H, _, Labels), 1481 sort(add of label, <, Labels, SortedLs), 1482 add_labels(SortedLs, InstrStarts, WAMList0, WAMList), !. 1483% pretty_print(WAMList). 1484disasm(Pred, WAMList, Module) :- 1485 get_bip_error(E), 1486 error(E, disasm(Pred,WAMList,Module), Module). 1487 1488 1489/* interpret_pred(+WordList, +Base, +HashTable, +IStart, -WAMList, -Starts) 1490 1491 generates the initial WAM code for a predicate from the memory word list. 1492 1493 1494 WordList: current tail of the list of integers in memory representing the 1495 predicate 1496 Base: the base address of the predicate in memory 1497 HashTable: hash-table used to store references to labels encountered 1498 WAMList: current tail of initial WAM list 1499 IStart: the offset to the start of the current WAM instruction 1500 Starts: current tail of the start list, where each element represents 1501 the offset in words from the base of the current WAM instruction. 1502 IStart is the next start position to be added to this list 1503*/ 1504 1505interpret_pred([IWord|Ws0], Base, H, IStart, WAM0, Starts0) :- 1506 decode_code(o(IWord), OpCode), 1507 ( 1508 instr(Instr, OpCode, Args), % nondet 1509 FirstPos is IStart + 1, % +1 for opc 1510 disasm_args(Args, Ws0, Ws1, Base, H, FirstPos, PosEnd) % may fail 1511 -> 1512 ( Instr = code_end -> 1513 Starts0 = [IStart], WAM0 = [Instr] 1514 ; Instr = comment(_) -> 1515 interpret_pred(Ws1, Base, H, PosEnd, WAM0, Starts0) 1516 ; 1517 Starts0 = [IStart|Starts1], WAM0 = [Instr|WAM1], 1518 interpret_pred(Ws1, Base, H, PosEnd, WAM1, Starts1) 1519 ) 1520 ; 1521 printf(error, "Unrecognised opcode (%w) or invalid instruction arguments.%n", [OpCode]), 1522 set_bip_error(6) 1523 ). 1524 1525 1526/* disasm_args(+ArgTypes, +WordListIn, -WordListOut, +Base, +Hash, 1527 +PosIn, -PosOut) 1528 1529 disassembles the arguments of a WAM instruction: 1530 1531 ArgTypes: types of remaining args in WAM instruction 1532 WordListIn: remaining memory list of values of consecutive words in memory 1533 representing the predicate. The head corresponds to the (start 1534 of) the binary value for ArgType. 1535 WordListOut: remaining memory list after current instruction has been 1536 disassembled. 1537 Base: Base address of predicate 1538 Hash: Hash table for storing references to label 1539 PosIn: offset from base in words for current argument. 1540 PosOut: will contain the offset at the end of current instruction 1541 1542*/ 1543disasm_args([], Ws0, Ws, _, _, Pos0, Pos) ?- Ws0 = Ws, Pos0 = Pos. 1544disasm_args([Arg|Args], Ws0, Ws, Base, H, Pos0, Pos) ?- 1545 disasm_arg(Arg, Ws0, Ws1, Base, H, Pos0, Pos1), 1546 disasm_args(Args, Ws1, Ws, Base, H, Pos1, Pos). 1547 1548disasm_arg(a(A), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1549 decode_code(a(D), A), 1550 Ws1 = Ws, 1551 Pos is Pos0 + 1. 1552disasm_arg(y(Y), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1553 decode_code(y(D), Y), 1554 Ws1 = Ws, 1555 Pos is Pos0 + 1. 1556disasm_arg(t(T), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1557 decode_code(t(D), T), 1558 Ws1 = Ws, 1559 Pos is Pos0 + 1. 1560disasm_arg(pw(O), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1561 decode_code(pw(D), O), 1562 Ws1 = Ws, 1563 Pos is Pos0 + 1. 1564disasm_arg(edesc(EDesc), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1565 decode_code(edesc(D), EDesc), 1566 Ws1 = Ws, 1567 Pos is Pos0 + 1. 1568disasm_arg(i(I), [W|Ws1], Ws, _, _, Pos0, Pos) ?- 1569 W = I, 1570 Ws1 = Ws, 1571 Pos is Pos0 + 1. 1572disasm_arg(f(Z), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1573 decode_code(float(D), Z), 1574 Ws1 = Ws, 1575 Pos is Pos0 + 1. 1576disasm_arg(atom(A), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1577 decode_code(atom(D), A), 1578 Ws1 = Ws, 1579 Pos is Pos0 + 1. 1580disasm_arg(s(S), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1581 decode_code(string(D), S), 1582 Ws1 = Ws, 1583 Pos is Pos0 + 1. 1584disasm_arg(ref(Lab), [D|Ws1], Ws, Base, H, Pos0, Pos) ?- 1585 add_label_to_hashed(D, ref(Lab), Base, H), 1586 Ws1 = Ws, 1587 Pos is Pos0 + 1. 1588disasm_arg(func(Pred), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1589 decode_code(functor(D), Pred), 1590 Ws1 = Ws, 1591 Pos is Pos0 + 1. 1592disasm_arg(proc(Proc), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1593 decode_code(proc(D), Proc), 1594 Ws1 = Ws, 1595 Pos is Pos0 + 1. 1596disasm_arg(vmask(VList), [First,Mask|Ws1], Ws, _, _, Pos0, Pos) ?- 1597 decode_code(init(First,Mask),VList), 1598 Ws1 = Ws, 1599 Pos is Pos0 + 2. 1600disasm_arg(nvmask(NVList), [First,Mask|Ws1], Ws, _, _, Pos0, Pos) ?- 1601 decode_code(init(First,Mask),VList), 1602 Pos1 is Pos0 + 2, 1603 construct_nvlist(VList, Ws1, Ws, NVList, Pos1, Pos). 1604disasm_arg(nv(N), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1605 decode_code(nv(D), N), 1606 Ws1 = Ws, 1607 Pos is Pos0 + 1. 1608disasm_arg(tags(Ls), Ws0, Ws, Base, H, Pos0, Pos) ?- 1609 decode_code(tags, Tags), 1610 Tags =.. [tags|TagsL], 1611 Pos1 is Pos0 + 1, % start counting at 1 1612 (foreach(Tag, TagsL), fromto(Ls, Ls1,Ls2, []), count(_, Pos1, Pos), 1613 fromto(Ws0,[Add|Ws1],Ws1,Ws), param([Base,H]) do 1614 decode_code(ref(Add,Base), Mapped), 1615 (integer(Mapped) -> 1616 Ls1 = [Tag:TRef|Ls2], 1617 add_label_to_hashed(Add, TRef, Base, H) 1618 ; % do not add external refs to Ls 1619 Ls1 = Ls2 1620 ) 1621 ). 1622disasm_arg(port(P), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1623 P = D, % just use raw form for now 1624 Ws1 = Ws, 1625 Pos is Pos0 + 1. 1626disasm_arg(brk_port(P), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1627 P is D /\ port_mask, % mask out the non-Port bits 1628 Ws1 = Ws, 1629 Pos is Pos0 + 1. 1630disasm_arg(valtag(C), [V,T|Ws1], Ws, _, _, Pos0, Pos) ?- 1631 decode_code(constant(V,T), C), 1632 Ws1 = Ws, 1633 Pos is Pos0 + 2. 1634disasm_arg(tagval(C), [T,V|Ws1], Ws, _, _, Pos0, Pos) ?- 1635 decode_code(constant(V,T), C), 1636 Ws1 = Ws, 1637 Pos is Pos0 + 2. 1638disasm_arg(mv(M), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1639 decode_code(mv(D), M), 1640 Ws1 = Ws, 1641 Pos is Pos0 + 1. 1642disasm_arg(an(Att), [D|Ws1], Ws, _, _, Pos0, Pos) ?- 1643 decode_code(pw(D), I), % raw form in # bytes -> pw offset 1644 meta_index(Att, I), 1645 Ws1 = Ws, 1646 Pos is Pos0 + 1. 1647disasm_arg(try{table:Table,size:Size,ref:Offset}, [Address|Ws1], Ws, 1648 Base, H, Pos0, Pos) ?- 1649 decode_code(ref(Address,Base), Offset), 1650 Pos is Pos0 + 1, 1651 Ws1 = Ws, 1652 decode_code(try_table(Address,Size), Trys), 1653 (foreach(Try, Trys), foreach(TryRef, Table), param([Base,H]) do 1654 add_label_to_hashed(Try, TryRef, Base, H) 1655 1656 ). 1657disasm_arg(tab{type:Type,table:Table}, [Address,Size0|Ws1], Ws, 1658 Base, H, Pos0, Pos) ?- 1659 extra_table_entries(Type, Extra), 1660 Size is Size0 + Extra, % number of actual entries to extract 1661 decode_code(table(Address,Size), Entries), 1662 Ws1 = Ws, 1663 Pos is Pos0 + 2, 1664 interpret_switch_table(Entries, Type, Base, H, Table). 1665disasm_arg(o(Op), [W|Ws1], Ws, _, _, Pos0, Pos) ?- 1666% `hidden' instruction 1667 (decode_code(o(W), Op) -> % check op-code is as expected 1668 Ws1 = Ws, 1669 Pos is Pos0 + 1 1670 ; printf(error, "Expected op-code %w not found.%n", [Op]), 1671 fail 1672 ). 1673disasm_arg(tref(TL), [W|Ws1], Ws, Base, _, Pos0, Pos) ?- 1674% trefs are references to data, not added to hash table 1675 decode_code(ref(W,Base), Offset), 1676 (TL = Offset -> 1677 Ws1 = Ws, 1678 Pos is Pos0 + 1 1679 ; printf(error, "inconsistent references to data tables.%n"), 1680 fail 1681 ). 1682disasm_arg(skip(N), [W|Ws1], Ws, _, _, Pos0, Pos) ?- 1683 % skip the next W words 1684 N is W, 1685 Pos is Pos0 + W + 1, % +1 for the skip arg itself 1686 skip_words(W, Ws1, Ws). 1687 1688 1689skip_words(0, Ws, Ws) :- !. 1690skip_words(N, [_|Ws0], Ws) :- 1691 N > 0, N1 is N - 1, 1692 skip_words(N1, Ws0, Ws). 1693 1694 1695/* add_labels(+LabelList, +StartList, +WAMIn, -WAMOut) 1696 1697 takes the initial WAM list and adds labels to it 1698 1699 LabelList: a sorted list of all labels found in predicate 1700 StartList: current tail of start positions of each WAM instruction. 1701 head is start for current WAM instruction 1702 WAMIn: current position in the initial WAM list (where labels 1703 have not yet been added) 1704 WAMOut: final remaining WAM list (with label inserted) 1705*/ 1706add_labels([], _, WAM0, WAM) ?- WAM0 = WAM. 1707add_labels(Ls0, [Current|Ss], [Instr|WAM0], WAM) :- 1708 Ls0 = [label{add:Offset,label:N}|Ls1], 1709 ( Offset == Current -> 1710 WAM = [label(N),Instr|WAM1], 1711 Ls = Ls1 1712 ; Offset > Current -> 1713 WAM = [Instr|WAM1], 1714 Ls = Ls0 1715 ; printf(error, "Label not at instruction boundary: %w%n", [Instr]), 1716 set_bip_error(6) 1717 ), 1718 add_labels(Ls, Ss, WAM0, WAM1). 1719 1720 1721add_label_to_hashed(Absolute, ref(LabelRef), Base, H) :- 1722 decode_code(ref(Absolute,Base), Mapped), 1723 (valid_symbol(Mapped) -> 1724 % label is an outside symbol; not added to hash 1725 LabelRef = Mapped 1726 ;integer(Mapped) -> % label is coverted to a displacement 1727 % LabelRef is left as var. 1728 Label = label{add:Mapped,label:LabelRef}, 1729 (hash_find(H, Mapped, Label) -> 1730 true % unified with existing label 1731 ; hash_add(H, Mapped, Label) % add new label 1732 ) 1733 ). 1734 1735 1736valid_symbol(fail) ?- true. 1737valid_symbol(par_fail) ?- true. 1738 1739split_varsnames([], [], []). 1740split_varsnames([V-N|NVs], [V|Vs], [nv(N)|Ns]) :- 1741 (integer(V) -> 1742 split_varsnames(NVs, Vs, Ns) 1743 ; writeln(error, "Namedvars mask contains non-integers arg. positions"), 1744 set_bip_error(5) 1745 ). 1746 1747construct_nvlist([], Ws, Ws, [], Pos, Pos). 1748construct_nvlist([Y|Ys], [W|Ws1], Ws, [Y-Name|NVs], Pos0, Pos) :- 1749 decode_code(nv(W), Name), 1750 Pos1 is Pos0 + 1, 1751 construct_nvlist(Ys, Ws1, Ws, NVs, Pos1, Pos). 1752 1753 1754interpret_switch_table([], _, _, _, []). 1755interpret_switch_table([Key-A|Entries], Type, Base, H, [TKey-Ref|Table]) :- 1756 add_label_to_hashed(A, Ref, Base, H), 1757 typed_key(Type, Key, TKey), 1758 interpret_switch_table(Entries, Type, Base, H, Table). 1759 1760% the key types for switch table entries 1761typed_key(atom, V, A) :- decode_code(atom(V), A). 1762typed_key(int, V, V) :- integer(V). 1763typed_key(functor, V, F) :- decode_code(functor(V), F). 1764typed_key(range, V, V) :- integer(V). 1765 1766 1767%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1768 1769 1770is_existing_pred(F/A, Module) ?- 1771 is_proc(F/A), !, 1772 ((current_predicate(F/A)@Module ; current_built_in(F/A)@Module) -> 1773 true ; set_bip_error(60) 1774 ). 1775is_existing_pred(_, _) :- 1776 set_bip_error(5). 1777 1778/* find_arg_in_struct(?Term, +Struct, -Pos) 1779 returns the position Pos in Struct for the first occurrance of Term 1780*/ 1781find_arg_in_struct(Term, Struct, Pos) :- 1782 functor(Struct, _, Arity), 1783 find_arg_in_struct1(Arity, Term, Struct, Pos). 1784 1785find_arg_in_struct1(N, Term, Struct, Pos) :- 1786 N > 0, 1787 arg(N, Struct, Arg), 1788 (Arg == Term -> 1789 Pos = N 1790 ; N1 is N - 1, 1791 find_arg_in_struct1(N1, Term, Struct, Pos) 1792 ). 1793 1794 1795% extra_table entries specifies the number of extra entries for particular 1796% types of switch tables that is not included in the Size word of the 1797% instruction. Currently only range tables have extra entries for the 1798% two cases outside the range 1799extra_table_entries(range, Extra) ?- !, Extra = 2. 1800extra_table_entries(_, 0). 1801 1802% Mask for brk_port(..) word to mask out the port bits. Must match 1803% PORT_MASK in debug.h 1804port_mask(16'3f). 1805 1806%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1807% pretty print 1808 1809wam(Pred0, Module) :- 1810 find_pred(Pred0, Pred, Module), 1811 disasm(Pred, WAM, Module), !, 1812 printf("%w:%n", [Pred]), 1813 print_wam(WAM). 1814wam(Pred, Module) :- 1815 get_bip_error(E), 1816 error(E, wam(Pred, Module), Module). 1817 1818print_wam(WAM) :- 1819 \+ \+ ( 1820 fill_label(WAM, 0), 1821 pretty_print(WAM) 1822 ). 1823 1824 1825find_pred(F/A, Pred, Module) ?- !, 1826 Pred = F/A, 1827 is_existing_pred(Pred, Module). 1828find_pred(F, Pred, Module) :- 1829 atom(F), !, 1830 (current_predicate(F/_)@Module -> 1831 current_predicate(F/A)@Module, 1832 Pred = F/A 1833 ; set_bip_error(60) 1834 ). 1835find_pred(_, _, _) :- 1836 set_bip_error(5). 1837 1838fill_label([], _). 1839fill_label([WAM|WAMs], N) :- 1840 (WAM = label(L), var(L) -> 1841 concat_atom(['L',N], L), 1842 N1 is N + 1 1843 ; N1 = N 1844 ), 1845 fill_label(WAMs, N1). 1846 1847 1848pretty_print([]). 1849pretty_print([label(N)|Is]) ?- !, 1850 printf("%Vw", [label(N)]), writeln(":"), 1851 pretty_print(Is). 1852pretty_print([I|Is]) :- 1853 ( instr(I, _, ArgTypes) -> 1854 pretty_print_instr(I, ArgTypes), 1855 pretty_print(Is) 1856 ; 1857 printf(error, "Unrecognised instruction %w.%n", [I]), 1858 abort 1859 ). 1860 1861pretty_print_instr(I, ArgTypes) :- 1862 I =.. [Name|Args], 1863 printf("\t%-20s ",[Name]), 1864 pretty_print_args(Args, ArgTypes). 1865 1866pretty_print_args([], []) :- nl. 1867pretty_print_args([Table,ref(E),ref(D)|As], 1868 [tab{type:range,table:Table},ref(E),ref(D)|ATs]) :- 1869 !, 1870 nl, 1871 print_rangetable(Table, E, D), 1872 pretty_print_args(As, ATs). 1873pretty_print_args([Table,ref(D)|As], [tab{table:Table},ref(D)|ATs]) :- 1874 !, 1875 nl, 1876 (foreach(Key-Ref, Table) do 1877 printf("\t\t%QDVw: \t%w%n", [Key,Ref]) 1878 ), 1879 printf("\t\tdefault: \t%w%n", [ref(D)]), 1880 pretty_print_args(As, ATs). 1881pretty_print_args([ref(L)|As], [ref(L)|ATs]) :- !, 1882 printf(" %DVw ", [ref(L)]), 1883 pretty_print_args(As, ATs). 1884pretty_print_args([N|As], [edesc(N)|ATs]) :- !, 1885 ( N = eam(EAM) -> 1886 integer_bits(EAM, Ys), 1887 printf(" Y%DKw ", [Ys]) 1888 ; N = [_|_] -> 1889 printf(" Y%DKw ", [N]) 1890 ; 1891 printf(" %DVw ", [N]) 1892 ), 1893 pretty_print_args(As, ATs). 1894pretty_print_args([Ls|As], [tags(Ls)|ATs]) :- 1895 !, 1896 nl, 1897 (foreach(Tag:Ref, Ls) do 1898 printf("\t\t%QDVw: \t%w%n", [Tag,Ref]) 1899 ), 1900 pretty_print_args(As, ATs). 1901pretty_print_args([A|As], [_|ATs]) :- 1902 printf(" %QDVw ", [A]), 1903 pretty_print_args(As, ATs). 1904 1905 1906integer_bits(N, Bits) :- 1907 ( 1908 fromto(N,N1,N2,0), 1909 count(I,1,_), 1910 fromto(Bits,Bits1,Bits2,[]) 1911 do 1912 N2 is N1 >> 1, 1913 ( getbit(N1,0,1) -> Bits1 = [I|Bits2] ; Bits1 = Bits2 ) 1914 ). 1915 1916 1917print_rangetable([Min-MinRef,Max-MaxRef|Sws], E, D) :- 1918 printf("\t\tdefault:\t%w%n", [D]), 1919 printf("\t\t< % 11d:\t%w%n", [Min,MinRef]), 1920 printf("\t\t> % 11d:\t%w%n", [Max,MaxRef]), 1921 print_rangetable1(Sws), 1922 printf("\t\telse:\t\t%w%n", [E]). 1923 1924print_rangetable1([]). 1925print_rangetable1([N-Ref|Sws]) :- 1926 printf("\t\t % 11d:\t%w%n", [N,Ref]), 1927 print_rangetable1(Sws). 1928 1929 1930 1931 1932 1933