1## Jitter specification for the GNU Poke Virtual Machine. 2 3## Copyright (C) 2019, 2020, 2021 Jose E. Marchesi 4## Written by Jose E. Marchesi 5 6## This program is free software: you can redistribute it and/or modify 7## it under the terms of the GNU General Public License as published by 8## the Free Software Foundation, either version 3 of the License, or 9## (at your option) any later version. 10## 11## This program is distributed in the hope that it will be useful, 12## but WITHOUT ANY WARRANTY; without even the implied warranty of 13## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14## GNU General Public License for more details. 15## 16## You should have received a copy of the GNU General Public License 17## along with this program. If not, see <http://www.gnu.org/licenses/>. 18 19vm 20 set prefix "pvm" 21end 22 23 24 25## Stacks. 26 27stack s 28 long-name "stack" 29 c-element-type "pvm_val" 30 tos-optimized 31 element-no 65536 32 guard-underflow 33 guard-overflow 34end 35 36stack t 37 long-name "returnstack" 38 c-element-type "pvm_val" 39 non-tos-optimized 40 element-no 65536 41 guard-underflow 42 guard-overflow 43end 44 45stack x 46 long-name "exceptionstack" 47 c-element-type "struct pvm_exception_handler" 48 non-tos-optimized 49 element-no 65536 50 guard-underflow 51 guard-overflow 52end 53 54 55 56## Register classes. 57 58register-class r 59 c-type "pvm_val" 60 fast-register-no 0 61 slow-registers 62end 63 64 65 66## Functions and globals to wrap. 67 68wrapped-functions 69 pk_term_class 70 pk_term_end_class 71 pk_printf 72 printf 73 pvm_array_insert 74 pvm_array_set 75 pvm_assert 76 pvm_env_lookup 77 pvm_env_register 78 pvm_env_pop_frame 79 pvm_env_push_frame 80 pvm_env_toplevel 81 pvm_make_string 82 pvm_make_array 83 pvm_make_struct 84 pvm_make_offset 85 pvm_make_integral_type 86 pvm_make_string_type 87 pvm_make_offset_type 88 pvm_make_array_type 89 pvm_allocate_struct_attrs 90 pvm_make_struct_type 91 pvm_typeof 92 pvm_type_equal_p 93 pvm_ref_struct 94 pvm_ref_struct_cstr 95 pvm_set_struct 96 pvm_val_reloc 97 pvm_val_unmap 98 pvm_val_ureloc 99 ios_cur 100 ios_read_int 101 ios_read_uint 102 ios_read_string 103 ios_write_string 104 random 105 srandom 106 secure_getenv 107 gettime 108end 109 110#wrapped-globals 111# pvm_printf_format_string 112#end 113 114 115## Embedded C code. 116 117initial-header-c 118 code 119# include <config.h> 120 end 121end 122 123early-header-c 124 code 125# include "pvm.h" 126# include "pvm-val.h" 127# include "ios.h" 128# include "pkt.h" 129# include "pk-utils.h" 130 131 /* Exception handlers, that are installed in the "exceptionstack". 132 133 EXCEPTION is the exception type, either one of the E_* values defined 134 above, or any integer >= 256 for user-defined exceptions. 135 136 MAIN_STACK_HEIGHT and RETURN_STACK_HEIGHT are the heights of 137 the main and return stacks, to restore before transferring 138 control to the exception handler. 139 140 CODE is the program point where the exception handler starts. 141 142 ENV is the run-time environment to restore before transferring 143 control to the exception handler. */ 144 145 struct pvm_exception_handler 146 { 147 int exception; 148 jitter_stack_height main_stack_height; 149 jitter_stack_height return_stack_height; 150 pvm_program_point code; 151 pvm_env env; 152 }; 153 end 154end 155 156initial-vm1-c 157 code 158# include <config.h> 159 end 160end 161 162initial-vm2-c 163 code 164# include <config.h> 165 end 166end 167 168early-c 169 code 170# include <config.h> 171# include <stdlib.h> 172# include <string.h> 173# include <assert.h> 174# include "xalloc.h" 175# include "timespec.h" 176# include "intprops.h" 177 178# include "pvm-alloc.h" 179 end 180end 181 182late-header-c 183 code 184 /* Macros to raise an exception from within an instruction. This 185 is used in the RAISE instruction itself, and also in instructions 186 that can fail, such as integer division or IO. 187 188 The code in the macro looks for the first matching exception 189 handler in the exception handlers stack. Then it restores the 190 heights of the main stack and the return stack, restores the 191 original dynamic environment, and then pushes the exception 192 type as an integer in the main stack, before branching to the 193 exception handler. */ 194 195#define PVM_RAISE_DIRECT(EXCEPTION) \ 196 do \ 197 { \ 198 int exception_code \ 199 = PVM_VAL_INT (pvm_ref_struct_cstr ((EXCEPTION), "code")); \ 200 \ 201 while (1) \ 202 { \ 203 struct pvm_exception_handler ehandler \ 204 = JITTER_TOP_EXCEPTIONSTACK (); \ 205 int handler_exception = ehandler.exception; \ 206 \ 207 JITTER_DROP_EXCEPTIONSTACK (); \ 208 \ 209 if (handler_exception == 0 \ 210 || handler_exception == exception_code) \ 211 { \ 212 JITTER_SET_HEIGHT_STACK (ehandler.main_stack_height); \ 213 JITTER_SET_HEIGHT_RETURNSTACK (ehandler.return_stack_height); \ 214 \ 215 JITTER_PUSH_STACK ((EXCEPTION)); \ 216 \ 217 jitter_state_runtime.env = ehandler.env; \ 218 JITTER_BRANCH (ehandler.code); \ 219 break; \ 220 } \ 221 } \ 222 } while (0) 223 224 225#define PVM_RAISE(CODE,STR,ESTATUS) \ 226 do \ 227 { \ 228 pvm_val exception = pvm_make_exception ((CODE),(STR),(ESTATUS)); \ 229 PVM_RAISE_DIRECT (exception); \ 230 } while (0) 231 232#define PVM_RAISE_DFL(BASE) \ 233 do \ 234 { \ 235 PVM_RAISE (BASE,BASE##_MSG,BASE##_ESTATUS); \ 236 } while (0) 237 238 /* Macros to implement different kind of instructions. These are to 239 avoid flagrant code replication below. */ 240 241/* Binary numeric operations generating a boolean on the stack. 242 ( TYPE TYPE -- TYPE TYPE INT ) */ 243# define PVM_BOOL_BINOP(TYPE,OP) \ 244 do \ 245 { \ 246 pvm_val res = PVM_MAKE_INT (PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()) \ 247 OP PVM_VAL_##TYPE (JITTER_TOP_STACK ()), 32); \ 248 JITTER_PUSH_STACK (res); \ 249 } while (0) 250 251/* Unary numeric operations. 252 ( TYPE -- TYPE TYPE) */ 253# define PVM_UNOP(TYPE,TYPER,TYPERLC,OP) \ 254 do \ 255 { \ 256 int size = PVM_VAL_##TYPER##_SIZE (JITTER_TOP_STACK ()); \ 257 pvm_val res = pvm_make_##TYPERLC (OP PVM_VAL_##TYPE (JITTER_TOP_STACK ()), size); \ 258 JITTER_PUSH_STACK (res); \ 259 } while (0) 260 261/* Signed negation. 262 We check for overflow, raising E_overflow whenever appropriate. */ 263 264# define PVM_NEG_SIGNED(TYPE,CTYPE) \ 265 do \ 266 { \ 267 CTYPE a = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 268 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 269 int64_t a64 = ((int64_t) a << (64 - size)); \ 270 \ 271 if (INT_NEGATE_OVERFLOW (a64)) \ 272 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 273 else \ 274 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (-a, size)); \ 275 } while (0) 276 277 278/* Signed addition. 279 The two operands and the result are assumed to be PVM integers, having 280 the same bit size. 281 We check for overflow, raising E_overflow whenever appropriate. */ 282 283# define PVM_ADD_SIGNED(TYPE,CTYPE) \ 284 do \ 285 { \ 286 CTYPE a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 287 CTYPE b = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 288 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 289 int64_t a64 = ((int64_t) a << (64 - size)); \ 290 int64_t b64 = ((int64_t) b << (64 - size)); \ 291 \ 292 if (INT_ADD_OVERFLOW (a64, b64)) \ 293 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 294 else \ 295 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (a + b, size)); \ 296 } while (0) 297 298/* Signed subtraction. 299 The two operands and the result are assumed to be PVM integers, having 300 the same bit size. 301 We check for overflow, raising E_overflow whenever appropriate. */ 302 303# define PVM_SUB_SIGNED(TYPE,CTYPE) \ 304 do \ 305 { \ 306 CTYPE a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 307 CTYPE b = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 308 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 309 int64_t a64 = ((int64_t) a << (64 - size)); \ 310 int64_t b64 = ((int64_t) b << (64 - size)); \ 311 \ 312 if (INT_SUBTRACT_OVERFLOW (a64, b64)) \ 313 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 314 else \ 315 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (a - b, size)); \ 316 } while (0) 317 318/* Signed multiplication. 319 The two operands and the result are assumed to be PVM integers, having 320 the same bit size. 321 We check for overflow, raising E_overflow whenever appropriate. */ 322 323# define PVM_MUL_SIGNED(TYPE,CTYPE) \ 324 do \ 325 { \ 326 CTYPE a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 327 CTYPE b = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 328 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 329 int64_t a64 = ((int64_t) a << (64 - size)); \ 330 \ 331 if (INT_MULTIPLY_OVERFLOW (a64, b)) \ 332 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 333 else \ 334 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (a * b, size)); \ 335 } while (0) 336 337/* Signed division. 338 We check for overflow, raising E_overflow whenever appropriate. */ 339 340# define PVM_DIV_SIGNED(TYPE,CTYPE) \ 341 if (PVM_VAL_##TYPE (JITTER_TOP_STACK ()) == 0) \ 342 { \ 343 PVM_RAISE_DFL (PVM_E_DIV_BY_ZERO); \ 344 } \ 345 else \ 346 { \ 347 CTYPE a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 348 CTYPE b = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 349 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 350 int64_t a64 = ((int64_t) a << (64 - size)); \ 351 \ 352 if (INT_DIVIDE_OVERFLOW (a64, b)) \ 353 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 354 else \ 355 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (a / b, size)); \ 356 } 357 358# define PVM_MOD_SIGNED(TYPE,CTYPE) \ 359 if (PVM_VAL_##TYPE (JITTER_TOP_STACK ()) == 0) \ 360 { \ 361 PVM_RAISE_DFL (PVM_E_DIV_BY_ZERO); \ 362 } \ 363 else \ 364 { \ 365 CTYPE a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 366 CTYPE b = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 367 int size = PVM_VAL_##TYPE##_SIZE (JITTER_TOP_STACK ()); \ 368 int64_t a64 = ((int64_t) a << (64 - size)); \ 369 \ 370 if (INT_DIVIDE_OVERFLOW (a64, b)) \ 371 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 372 else \ 373 JITTER_PUSH_STACK (PVM_MAKE_##TYPE (a % b, size)); \ 374 } 375 376/* Binary numeric operations. 377 ( TYPE TYPE -- TYPE TYPE TYPE ) */ 378# define PVM_BINOP(TYPEA,TYPEB,TYPER,OP) \ 379 do \ 380 { \ 381 int size = PVM_VAL_##TYPER##_SIZE (JITTER_UNDER_TOP_STACK ()); \ 382 pvm_val res = PVM_MAKE_##TYPER (PVM_VAL_##TYPEA (JITTER_UNDER_TOP_STACK ()) \ 383 OP PVM_VAL_##TYPEB (JITTER_TOP_STACK ()), size); \ 384 JITTER_PUSH_STACK (res); \ 385 } while (0) 386 387/* Same, but with division by zero run-time check. */ 388# define PVM_CHECKED_BINOP(TYPEA,TYPEB,TYPER,OP) \ 389 if (PVM_VAL_##TYPEB (JITTER_TOP_STACK ()) == 0) \ 390 { \ 391 PVM_RAISE_DFL (PVM_E_DIV_BY_ZERO); \ 392 } \ 393 else \ 394 { \ 395 PVM_BINOP (TYPEA, TYPEB, TYPER, OP); \ 396 } 397 398/* Same, but for left-shifts, which includes an overflow check on the 399 bit count. */ 400# define PVM_BINOP_SL(TYPEA, TYPEB,TYPER, OP) \ 401 { \ 402 pvm_val type = pvm_typeof (JITTER_UNDER_TOP_STACK ()); \ 403 uint64_t size = PVM_VAL_INTEGRAL (PVM_VAL_TYP_I_SIZE (type)); \ 404 \ 405 if (PVM_VAL_##TYPEB (JITTER_TOP_STACK ()) >= size) \ 406 { \ 407 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); \ 408 } \ 409 else \ 410 { \ 411 PVM_BINOP (TYPEA, TYPEB, TYPER, OP); \ 412 } \ 413 } 414 415/* Unsigned exponentiation. */ 416 417# define PVM_POWOP(TYPE,TYPEC,TYPELC) \ 418 do \ 419 { \ 420 uint64_t size = PVM_VAL_##TYPE##_SIZE (JITTER_UNDER_TOP_STACK ()); \ 421 TYPEC res \ 422 = (TYPEC) pk_upow (PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()), \ 423 PVM_VAL_UINT (JITTER_TOP_STACK ())); \ 424 \ 425 JITTER_PUSH_STACK (pvm_make_##TYPELC (res, size)); \ 426 } \ 427 while (0) 428 429/* Signed exponentiation, with overflow check. */ 430 431# define PVM_POWOP_SIGNED(TYPE,TYPEC,TYPELC) \ 432 do \ 433 { \ 434 int overflow_p; \ 435 uint32_t i; \ 436 TYPEC res; \ 437 uint64_t size = PVM_VAL_##TYPE##_SIZE (JITTER_UNDER_TOP_STACK ()); \ 438 TYPEC a = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 439 uint32_t b = PVM_VAL_UINT (JITTER_TOP_STACK ()); \ 440 int64_t res64 = 1L << (64 - size); \ 441 \ 442 overflow_p = 0; \ 443 for (i = 0; i < b; ++i) \ 444 { \ 445 if (INT_MULTIPLY_OVERFLOW (res64, a)) \ 446 { \ 447 PVM_RAISE_DFL (PVM_E_OVERFLOW); \ 448 overflow_p = 1; \ 449 break; \ 450 } \ 451 \ 452 res64 *= a; \ 453 } \ 454 \ 455 if (!overflow_p) \ 456 { \ 457 res = res64 >> (64 - size); \ 458 JITTER_PUSH_STACK (pvm_make_##TYPELC (res, size)); \ 459 } \ 460 } \ 461 while (0) 462 463 464/* Conversion instructions. 465 ( TYPE -- TYPE RTYPE ) */ 466#define PVM_CONVOP(TYPE, TYPEC, RTYPELC, RTYPEC) \ 467 do \ 468 { \ 469 jitter_uint tsize = JITTER_ARGN0; \ 470 TYPEC val = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 471 JITTER_PUSH_STACK (pvm_make_##RTYPELC ((RTYPEC) val, tsize)); \ 472 } while (0) 473 474/* Auxiliary macros used in PVM_PEEK and PVM_POKE below. */ 475#define PVM_IOS_ARGS_INT \ 476 io, offset, 0, bits, endian, nenc, &value 477#define PVM_IOS_ARGS_UINT \ 478 io, offset, 0, bits, endian, &value 479#define PVM_IOS_ARGS_WRITE_INT \ 480 io, offset, 0, bits, endian, nenc, value 481#define PVM_IOS_ARGS_WRITE_UINT \ 482 io, offset, 0, bits, endian, value 483 484/* Integral peek instructions. 485 ( IOS BOFF -- VAL ) */ 486#define PVM_PEEK(TYPE,IOTYPE,NENC,ENDIAN,BITS,IOARGS) \ 487 do \ 488 { \ 489 int ret; \ 490 __attribute__((unused)) enum ios_nenc nenc = (NENC); \ 491 enum ios_endian endian = (ENDIAN); \ 492 int bits = (BITS); \ 493 IOTYPE##64_t value; \ 494 ios io; \ 495 ios_off offset; \ 496 \ 497 offset = PVM_VAL_ULONG (JITTER_TOP_STACK ()); \ 498 if (JITTER_UNDER_TOP_STACK () == PVM_NULL) \ 499 io = ios_cur (); \ 500 else \ 501 io = ios_search_by_id (PVM_VAL_INT (JITTER_UNDER_TOP_STACK ())); \ 502 \ 503 if (io == NULL) \ 504 PVM_RAISE_DFL (PVM_E_NO_IOS); \ 505 \ 506 JITTER_DROP_STACK (); \ 507 if ((ret = ios_read_##IOTYPE (IOARGS)) != IOS_OK) \ 508 { \ 509 if (ret == IOS_EIOFF) \ 510 PVM_RAISE_DFL (PVM_E_EOF); \ 511 else if (ret == IOS_ENOMEM) \ 512 PVM_RAISE (PVM_E_IO, "out of memory", PVM_E_IO_ESTATUS); \ 513 else \ 514 PVM_RAISE_DFL (PVM_E_IO); \ 515 JITTER_TOP_STACK () = PVM_NULL; \ 516 } \ 517 else \ 518 JITTER_TOP_STACK () = pvm_make_##TYPE (value, bits); \ 519 } while (0) 520 521/* Integral poke instructions. 522 ( IOS BOFF VAL -- ) */ 523#define PVM_POKE(TYPE,IOTYPE,NENC,ENDIAN,BITS,IOARGS) \ 524 do \ 525 { \ 526 int ret; \ 527 __attribute__((unused)) enum ios_nenc nenc = (NENC); \ 528 enum ios_endian endian = (ENDIAN); \ 529 int bits = (BITS); \ 530 IOTYPE##64_t value = PVM_VAL_##TYPE (JITTER_TOP_STACK ()); \ 531 pvm_val offset_val = JITTER_UNDER_TOP_STACK (); \ 532 ios io; \ 533 ios_off offset; \ 534 \ 535 JITTER_DROP_STACK (); \ 536 JITTER_DROP_STACK (); \ 537 \ 538 if (JITTER_TOP_STACK () == PVM_NULL) \ 539 io = ios_cur (); \ 540 else \ 541 io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ())); \ 542 \ 543 if (io == NULL) \ 544 PVM_RAISE_DFL (PVM_E_NO_IOS); \ 545 JITTER_DROP_STACK (); \ 546 \ 547 offset = PVM_VAL_ULONG (offset_val); \ 548 if ((ret = ios_write_##IOTYPE (IOARGS)) != IOS_OK) \ 549 { \ 550 if (ret == IOS_EIOFF) \ 551 PVM_RAISE_DFL (PVM_E_EOF); \ 552 else \ 553 PVM_RAISE_DFL (PVM_E_IO); \ 554 } \ 555 } while (0) 556 557/* Macro to call to a closure. This is used in the instruction CALL, 558 and also other instructions required to... call :D The argument 559 should be a closure (surprise.) */ 560 561#define PVM_CALL(CLS) \ 562 do \ 563 { \ 564 /* Make place for the return address in the return stack. */ \ 565 /* actual value will be written by the callee. */ \ 566 JITTER_PUSH_UNSPECIFIED_RETURNSTACK(); \ 567 \ 568 /* Save the current environment and use the callee's environment. */ \ 569 JITTER_PUSH_RETURNSTACK ((jitter_uint) (uintptr_t) jitter_state_runtime.env); \ 570 jitter_state_runtime.env = PVM_VAL_CLS_ENV ((CLS)); \ 571 \ 572 /* Branch-and-link to the native code, whose first instruction will */ \ 573 /* be a prolog. */ \ 574 JITTER_BRANCH_AND_LINK (PVM_VAL_CLS_ENTRY_POINT ((CLS))); \ 575 } while (0) 576 577/* Macros to implement printi* and printl* instructions. */ 578 579#define PVM_PRINTI(TYPE,TYPEC,IFORMAT,BASE) \ 580 do \ 581 { \ 582 TYPEC val = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 583 char fmt[6]; /* %0NNd */ \ 584 uint32_t mask \ 585 = JITTER_ARGN0 == 32 ? (uint32_t)-1 \ 586 : (((uint32_t)1 << JITTER_ARGN0) - 1); \ 587 \ 588 fmt[0] = '%'; \ 589 fmt[1] = '0'; \ 590 if ((BASE) == 10) \ 591 { \ 592 fmt[2] = IFORMAT; \ 593 fmt[3] = '\0'; \ 594 } \ 595 else \ 596 { \ 597 int prec = 0; \ 598 \ 599 if ((BASE) == 256) \ 600 { \ 601 fmt[4] = 'c'; \ 602 prec = 1; \ 603 } \ 604 else if ((BASE) == 16) \ 605 { \ 606 fmt[4] = 'x'; \ 607 prec = (JITTER_ARGN0 / 4) + ((JITTER_ARGN0 % 4) != 0); \ 608 } \ 609 else if ((BASE) == 8) \ 610 { \ 611 fmt[4] = 'o'; \ 612 prec = (JITTER_ARGN0 / 3) + ((JITTER_ARGN0 % 3) != 0); \ 613 } \ 614 else if ((BASE) == 2) \ 615 { \ 616 pk_print_binary (pk_puts, val, JITTER_ARGN0, 1); \ 617 JITTER_DROP_STACK (); \ 618 JITTER_DROP_STACK (); \ 619 break; \ 620 } \ 621 \ 622 assert (prec != 0); \ 623 fmt[2] = '0' + (prec / 10); \ 624 fmt[3] = '0' + prec - (prec / 10 * 10); \ 625 fmt[5] = '\0'; \ 626 } \ 627 \ 628 pk_printf (fmt, (BASE) == 10 ? val : val & mask); \ 629 JITTER_DROP_STACK (); \ 630 JITTER_DROP_STACK (); \ 631 } while (0) 632 633#define PVM_PRINTL(TYPE,TYPEC,IFORMAT,BASE) \ 634 do \ 635 { \ 636 TYPEC val = PVM_VAL_##TYPE (JITTER_UNDER_TOP_STACK ()); \ 637 char fmt[7]; /* %0NNff */ \ 638 uint64_t mask \ 639 = JITTER_ARGN0 == 64 ? (uint64_t)-1 \ 640 : (((uint64_t)1 << JITTER_ARGN0) - 1); \ 641 \ 642 fmt[0] = '%'; \ 643 fmt[1] = '0'; \ 644 fmt[4] = 'l'; \ 645 if ((BASE) == 10) \ 646 { \ 647 fmt[2] = IFORMAT; \ 648 fmt[3] = '\0'; \ 649 } \ 650 else \ 651 { \ 652 int prec = 0; \ 653 \ 654 if ((BASE) == 16) \ 655 { \ 656 fmt[5] = 'x'; \ 657 prec = (JITTER_ARGN0 / 4) + ((JITTER_ARGN0 % 4) != 0); \ 658 } \ 659 else if ((BASE) == 8) \ 660 { \ 661 fmt[5] = 'o'; \ 662 prec = (JITTER_ARGN0 / 3) + ((JITTER_ARGN0 % 3) != 0); \ 663 } \ 664 else if ((BASE) == 2) \ 665 { \ 666 pk_print_binary (pk_puts, val, JITTER_ARGN0, 1); \ 667 JITTER_DROP_STACK (); \ 668 JITTER_DROP_STACK (); \ 669 break; \ 670 } \ 671 \ 672 fmt[2] = '0' + (prec / 10); \ 673 fmt[3] = '0' + prec - (prec / 10 * 10); \ 674 fmt[6] = '\0'; \ 675 } \ 676 \ 677 pk_printf (fmt, (BASE) == 10 ? val : val & mask); \ 678 JITTER_DROP_STACK (); \ 679 JITTER_DROP_STACK (); \ 680 } while (0) 681 682 end 683end 684 685late-c 686 code 687 void 688 pvm_handle_signal (int signal_number) 689 { 690 struct vmprefix_state *s; 691 692 /* For every state... */ 693 VMPREFIX_FOR_EACH_STATE (s) 694 { 695 /* ...Mark the signal signal_number as pending... */ 696 VMPREFIX_STATE_AND_SIGNAL_TO_PENDING_SIGNAL_NOTIFICATION 697 (s, signal_number) = true; 698 /* ...And record the fact that there is at least one notification to 699 handle. */ 700 VMPREFIX_STATE_TO_PENDING_NOTIFICATIONS (s) = true; 701 } 702 } 703 end 704end 705 706printer-c 707 code 708 static jitter_uint printer_hi; 709 710 static void 711 pvm_literal_printer_cast (jitter_print_context out, jitter_uint val) 712 { 713 pk_printf ("%" JITTER_PRIu, val); 714 pk_term_flush (); 715 } 716 717 static void 718 pvm_literal_printer (jitter_print_context out, jitter_uint val) 719 { 720 pvm_print_val_with_params (NULL /* not used since no 721 pretty-print */, 722 (pvm_val) val, 723 1 /* depth */, 724 PVM_PRINT_FLAT, 725 16 /* base */, 726 0 /* indent */, 727 2 /* acutoff */, 728 0 /* flags */); 729 pk_term_flush (); 730 } 731 732 static void 733 pvm_literal_printer_hi (jitter_print_context out, jitter_uint hi) 734 { 735 pk_printf ("%%hi(0x%" JITTER_PRIx ")", hi); 736 pk_term_flush (); 737 printer_hi = hi; /* This sucks */ 738 } 739 740 static void 741 pvm_literal_printer_lo (jitter_print_context out, jitter_uint lo) 742 { 743 pk_printf ("%%lo(0x%" JITTER_PRIx") (", lo); 744 745 pvm_print_val_with_params (NULL /* not used since no 746 pretty-print */, 747 ((pvm_val) printer_hi << 32) | lo, 748 1 /* depth */, 749 PVM_PRINT_FLAT, 750 16 /* base */, 751 0 /* indent */, 752 2 /* acutoff */, 753 0 /* flags */); 754 pk_puts (")"); 755 pk_term_flush (); 756 printer_hi = 0; 757 } 758 759 static void 760 popf_printer (jitter_print_context out, jitter_uint nframes) 761 { 762 pk_printf ("%" JITTER_PRIu, nframes); 763 pk_term_flush (); 764 } 765 766 static void 767 bits_printer (jitter_print_context out, jitter_uint val) 768 { 769 pk_printf ("%" JITTER_PRIu, val); 770 pk_term_flush (); 771 } 772 773 static void 774 endian_printer (jitter_print_context out, jitter_uint val) 775 { 776 pk_printf ("%s", val == IOS_ENDIAN_MSB ? "big" : "little"); 777 pk_term_flush (); 778 } 779 780 static void 781 nenc_printer (jitter_print_context out, jitter_uint val) 782 { 783 pk_printf ("%s", val == IOS_NENC_1 ? "1c" : "2c"); 784 pk_term_flush (); 785 } 786 end 787end 788 789 790## PVM state. 791 792# Jitter supports maintaining a VM state which is splitted in 793# `backing' and `runtime', so the question arises what to put in either 794# part of the state. According to the comments generated by jitterc: 795# 796# "The machine state is separated into the backing and the more 797# compact runtime data structures, to be allocated in registers as 798# far as possible. These are just a forward-declarations: the actual 799# definitions are machine-generated." 800# 801# and: 802# 803# "The state backing and runtime are initialized at the same time, and 804# in fact the distinction between them is invisible to the VM user." 805# 806# So it looks like both `backing' and `runtime' are available at 807# runtime, but accessing runtime is much more efficient because it is 808# kept in host machine registers if possible. 809 810state-struct-backing-c 811 code 812 enum pvm_exit_code exit_code; 813 pvm_val result_value; 814 jitter_stack_height canary; 815 pvm vm; 816 end 817end 818 819state-struct-runtime-c 820 code 821 pvm_env env; 822 uint32_t push_hi; 823 uint32_t endian; 824 uint32_t nenc; 825 uint32_t pretty_print; 826 enum pvm_omode omode; 827 int obase; 828 int omaps; 829 uint32_t odepth; 830 uint32_t oindent; 831 uint32_t oacutoff; 832 end 833end 834 835state-initialization-c 836 code 837 jitter_state_backing->vm = NULL; 838 jitter_state_backing->canary = NULL; 839 jitter_state_backing->exit_code = PVM_EXIT_OK; 840 jitter_state_backing->result_value = PVM_NULL; 841 jitter_state_runtime->endian = IOS_ENDIAN_MSB; 842 jitter_state_runtime->nenc = IOS_NENC_2; 843 jitter_state_runtime->pretty_print = 0; 844 jitter_state_runtime->omode = PVM_PRINT_FLAT; 845 jitter_state_runtime->obase = 10; 846 jitter_state_runtime->omaps = 0; 847 jitter_state_runtime->odepth = 0; 848 jitter_state_runtime->oindent = 2; 849 jitter_state_runtime->oacutoff = 0; 850 end 851end 852 853state-finalization-c 854 code 855 /* Finalize extra state here. */ 856 end 857end 858 859 860### Begin of instructions 861 862# In the instruction descriptions below, references to "the stack" 863# refer to the main stack. References to the other stacks (exceptions 864# stack, return stack) are always explicit. 865 866## VM instructions 867 868# Instruction: canary 869# 870# This instruction installs a canary to mark the bottom of the stack, 871# which is cheched by the `exit' instruction. To be most effective this 872# should be executed before the stack is used for the first time. 873# 874# Stack: ( -- ) 875 876instruction canary () 877 code 878 JITTER_STATE_BACKING_FIELD (canary) = JITTER_HEIGHT_STACK (); 879 end 880end 881 882# Instruction: exit 883# 884# Do some cleanup and finish execution of a PVM program. This checks 885# the stack centinel installed by the `canary' instruction. 886# 887# Stack: ( -- ) 888 889instruction exit () 890 code 891 /* The element at the top of the stack is the exit 892 code to report to the PVM caller. */ 893 JITTER_STATE_BACKING_FIELD (exit_code) 894 = PVM_VAL_INT (JITTER_TOP_STACK()); 895 896 JITTER_DROP_STACK (); 897 898 /* Get the result of the execution, if any. */ 899 JITTER_STATE_BACKING_FIELD (result_value) 900 = JITTER_TOP_STACK(); 901 JITTER_DROP_STACK (); 902 903 /* Check for the stack centinel, but only if it was 904 installed. */ 905 if (JITTER_STATE_BACKING_FIELD (canary) != NULL) 906 assert (JITTER_STATE_BACKING_FIELD (canary) 907 == JITTER_HEIGHT_STACK ()); 908 909 /* Clear pending signals. */ 910 { 911 int i; 912 for (i = 0; i < JITTER_SIGNAL_NO; i ++) 913 if (JITTER_PENDING_SIGNAL_NOTIFICATION (i)) 914 JITTER_PENDING_SIGNAL_NOTIFICATION (i) = false; 915 JITTER_PENDING_NOTIFICATIONS = false; 916 } 917 918 JITTER_EXIT (); 919 end 920end 921 922# Instruction: pushend 923# 924# Push the current endianness on the stack. This endianness is part 925# of the global state of the PVM. 926# 927# Stack: ( -- INT ) 928 929instruction pushend () 930 code 931 JITTER_PUSH_STACK (PVM_MAKE_INT (jitter_state_runtime.endian, 932 32)); 933 end 934end 935 936# Instruction: popend 937# 938# Pop a signed integer from the stack and make it the current 939# endianness in the PVM. The possible values for endianness are 940# IOS_ENDIAN_LSB and IOS_ENDIAN_MSB. 941# 942# Stack: ( INT -- ) 943 944instruction popend () 945 code 946 uint32_t endian = PVM_VAL_INT (JITTER_TOP_STACK ()); 947 jitter_state_runtime.endian = endian; 948 JITTER_DROP_STACK (); 949 end 950end 951 952# Instruction: pushob 953# 954# Push output base. 955# 956# This instruction pushes a signed integer value with the output base 957# that is used when printing PVM values. Valid values are 2, 8, 10 958# and 16. 959# 960# Stack: ( -- INT ) 961 962instruction pushob () 963 code 964 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 965 int obase = pvm_obase (vm); 966 967 JITTER_PUSH_STACK (PVM_MAKE_INT (obase, 32)); 968 end 969end 970 971# Instruction: popob 972# 973# Pop and set output base. 974# 975# This instructions pops a signed integer from the stack and uses it 976# to set the new output base to be used when printing PVM values. 977# Valid values are 2, 8, 10 and 16. 978# 979# If an invalid obase is specified then this instruction raises 980# PVM_E_INVAL. 981# 982# Stack: ( INT -- ) 983# Exceptions: PVM_E_INVAL 984 985instruction popob () 986 code 987 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 988 int obase = PVM_VAL_INT (JITTER_TOP_STACK ()); 989 990 if (obase != 2 && obase != 8 && obase != 10 && obase != 16) 991 PVM_RAISE (PVM_E_INVAL, "invalid output base", PVM_E_INVAL_ESTATUS); 992 993 pvm_set_obase (vm, obase); 994 JITTER_DROP_STACK (); 995 end 996end 997 998# Instruction: pushom 999# 1000# Push output mode. 1001# 1002# This instruction pushes a signed integer value with the output mode 1003# that is used when printing PVM values. Valid values are 0 for flat 1004# mode, and 1 for tree mode. 1005# 1006# Stack: ( -- INT ) 1007 1008instruction pushom () 1009 code 1010 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1011 int omode = pvm_omode (vm); 1012 1013 JITTER_PUSH_STACK (PVM_MAKE_INT (omode, 32)); 1014 end 1015end 1016 1017# Instruction: popom 1018# 1019# Pop and set output mode. 1020# 1021# This instructions pops a signed integer from the stack and uses it 1022# to set the new output mode to be used when printing PVM values. 1023# Valid values are 0 for flat mode and 1 for tree mode. 1024# 1025# If an invalid omode is specified then this instruction raises 1026# PVM_E_INVAL. 1027# 1028# Stack: ( INT -- ) 1029# Exceptions: PVM_E_INVAL 1030 1031instruction popom () 1032 code 1033 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1034 int omode = PVM_VAL_INT (JITTER_TOP_STACK ()); 1035 1036 if (omode != PVM_PRINT_FLAT && omode != PVM_PRINT_TREE) 1037 PVM_RAISE (PVM_E_INVAL, "invalid output mode", PVM_E_INVAL_ESTATUS); 1038 1039 pvm_set_omode (vm, omode); 1040 JITTER_DROP_STACK (); 1041 end 1042end 1043 1044# Instruction: pushoo 1045# 1046# Push output offsets mode. 1047# 1048# This instruction pushes a boolean encoded in a signed integer value 1049# indicating whether to show offsets when printing PVM values. 1050# 1051# Stack: ( -- INT ) 1052 1053instruction pushoo () 1054 code 1055 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1056 int omaps = pvm_omaps (vm); 1057 1058 JITTER_PUSH_STACK (PVM_MAKE_INT (omaps, 32)); 1059 end 1060end 1061 1062# Instruction: popoo 1063# 1064# Pop and set output offsets mode. 1065# 1066# This instructions pops a boolean encoded in a signed integer from 1067# the stack and uses it to set the new output offset mode to be used 1068# when printing PVM values. 1069# 1070# Stack: ( INT -- ) 1071 1072instruction popoo () 1073 code 1074 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1075 int omaps = PVM_VAL_INT (JITTER_TOP_STACK ()); 1076 1077 pvm_set_omaps (vm, omaps); 1078 JITTER_DROP_STACK (); 1079 end 1080end 1081 1082# Instruction: pushoi 1083# 1084# Push output indentation mode. 1085# 1086# This instructions pushes an integer to the stack with the current 1087# indentation step configured in the VM. The indentation step 1088# determines how many white characters to use in each indentation 1089# level when printing output. 1090# 1091# Stack: ( -- INT ) 1092 1093instruction pushoi () 1094 code 1095 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1096 int oindent = pvm_oindent (vm); 1097 1098 JITTER_PUSH_STACK (PVM_MAKE_INT (oindent, 32)); 1099 end 1100end 1101 1102# Instruction: popoi 1103# 1104# Pop and set output indentation step mode. 1105# 1106# This instructions pops an integer from the stack and uses it to 1107# set the current indentation step in the VM. The indentation step 1108# determines how many white characters to use in each indentation 1109# level when printing output. 1110# 1111# Stack: ( INT -- ) 1112 1113instruction popoi () 1114 code 1115 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1116 int oindent = PVM_VAL_INT (JITTER_TOP_STACK ()); 1117 1118 pvm_set_oindent (vm, oindent); 1119 JITTER_DROP_STACK (); 1120 end 1121end 1122 1123# Instruction: pushod 1124# 1125# Push output depth. 1126# 1127# This instruction pushes a signed integer indicating the depth to use 1128# when printing PVM values. 1129# 1130# Stack: ( -- INT ) 1131 1132instruction pushod () 1133 code 1134 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1135 int odepth = pvm_odepth (vm); 1136 1137 JITTER_PUSH_STACK (PVM_MAKE_INT (odepth, 32)); 1138 end 1139end 1140 1141# Instruction: popod 1142# 1143# Pop and set output depth. 1144# 1145# This instructions pops a signed integer indicating the maximum depth 1146# included by the VM when printing values. 1147# 1148# Stack: ( INT -- ) 1149 1150instruction popod () 1151 code 1152 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1153 int odepth = PVM_VAL_INT (JITTER_TOP_STACK ()); 1154 1155 pvm_set_odepth (vm, odepth); 1156 JITTER_DROP_STACK (); 1157 end 1158end 1159 1160# Instruction: pushoac 1161# 1162# Push output array cutoff. 1163# 1164# This instruction pushes a signed integer indicating the number of 1165# elements that the VM includes in the printed representation of PVM 1166# array values. 1167# 1168# Stack: ( -- INT ) 1169 1170instruction pushoac () 1171 code 1172 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1173 int oacutoff = pvm_oacutoff (vm); 1174 1175 JITTER_PUSH_STACK (PVM_MAKE_INT (oacutoff, 32)); 1176 end 1177end 1178 1179# Instruction: popoac 1180# 1181# Pop and set output array cutoff. 1182# 1183# This instructions pops a signed integer indicating the number of 1184# elements that the VM includes in the printed representation of PVM 1185# array values. 1186# 1187# Stack: ( INT -- ) 1188 1189instruction popoac () 1190 code 1191 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1192 int oacutoff = PVM_VAL_INT (JITTER_TOP_STACK ()); 1193 1194 pvm_set_oacutoff (vm, oacutoff); 1195 JITTER_DROP_STACK (); 1196 end 1197end 1198 1199# Instruction: pushopp 1200# 1201# Push pretty-print usage. 1202# 1203# This instruction pushes a signed integer indicating whether the VM 1204# is configured to use pretty-printers. 1205# 1206# Stack: ( -- INT ) 1207 1208instruction pushopp () 1209 code 1210 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1211 int pp = pvm_pretty_print (vm); 1212 1213 JITTER_PUSH_STACK (PVM_MAKE_INT (pp, 32)); 1214 end 1215end 1216 1217# Instruction: popopp 1218# 1219# Pop and set usage of pretty-printers. 1220# 1221# This instructions pops a signed integer indicating whether to use 1222# pretty-printers when printing values and sets it in the VM. 1223# 1224# Stack: ( INT -- ) 1225 1226instruction popopp () 1227 code 1228 pvm vm = JITTER_STATE_BACKING_FIELD (vm); 1229 int pp = PVM_VAL_INT (JITTER_TOP_STACK ()); 1230 1231 pvm_set_pretty_print (vm, pp); 1232 JITTER_DROP_STACK (); 1233 end 1234end 1235 1236# Instruction: pushoc 1237# 1238# Push the current output color to the stack, encoded as a 1239# RGB triplet. 1240# 1241# Stack: ( -- INT INT INT ) 1242 1243instruction pushoc () 1244 code 1245 struct pk_color color = pk_term_get_color (); 1246 1247 JITTER_PUSH_STACK (PVM_MAKE_INT (color.red, 32)); 1248 JITTER_PUSH_STACK (PVM_MAKE_INT (color.green, 32)); 1249 JITTER_PUSH_STACK (PVM_MAKE_INT (color.blue, 32)); 1250 end 1251end 1252 1253# Instruction: popoc 1254# 1255# Pop the RGB triplet at the top of the stack and use it to set 1256# the new terminal output color. 1257# 1258# Stack: ( INT INT INT -- ) 1259 1260instruction popoc () 1261 code 1262 struct pk_color color; 1263 1264 color.blue = PVM_VAL_INT (JITTER_TOP_STACK ()); 1265 color.green = PVM_VAL_INT (JITTER_UNDER_TOP_STACK ()); 1266 JITTER_DROP_STACK (); 1267 JITTER_DROP_STACK (); 1268 color.red = PVM_VAL_INT (JITTER_TOP_STACK ()); 1269 JITTER_DROP_STACK (); 1270 1271 pk_term_set_color (color); 1272 end 1273end 1274 1275# Instruction: pushobc 1276# 1277# Push the current output background color to the stack, encoded as a 1278# RGB triplet. 1279# 1280# Stack: ( -- INT INT INT ) 1281 1282instruction pushobc () 1283 code 1284 struct pk_color color = pk_term_get_bgcolor (); 1285 1286 JITTER_PUSH_STACK (PVM_MAKE_INT (color.red, 32)); 1287 JITTER_PUSH_STACK (PVM_MAKE_INT (color.green, 32)); 1288 JITTER_PUSH_STACK (PVM_MAKE_INT (color.blue, 32)); 1289 end 1290end 1291 1292# Instruction: popobc 1293# 1294# Pop the RGB triplet at the top of the stack and use it to set 1295# the new terminal output background color. 1296# 1297# Stack: ( INT INT INT -- ) 1298 1299instruction popobc () 1300 code 1301 struct pk_color color; 1302 1303 color.blue = PVM_VAL_INT (JITTER_TOP_STACK ()); 1304 color.green = PVM_VAL_INT (JITTER_UNDER_TOP_STACK ()); 1305 JITTER_DROP_STACK (); 1306 JITTER_DROP_STACK (); 1307 color.red = PVM_VAL_INT (JITTER_TOP_STACK ()); 1308 JITTER_DROP_STACK (); 1309 1310 pk_term_set_bgcolor (color); 1311 end 1312end 1313 1314# Instruction: sync 1315# 1316# Handle pending signals, and raise exceptions accordingly. This 1317# instruction should be emitted in strategic places, such as before 1318# backwards jumps and at function prolog, to assure signals are 1319# eventually attended to. 1320# 1321# Stack: ( -- ) 1322# Exceptions: PVM_E_SIGNAL 1323 1324instruction sync () 1325 code 1326 /* XXX for now we treat all signals the same way. 1327 As soon as we support exception arguments, we shall 1328 pass the mask of signals to the signal handler. */ 1329 if (JITTER_PENDING_NOTIFICATIONS) 1330 PVM_RAISE_DFL (PVM_E_SIGNAL); 1331 end 1332end 1333 1334 1335## IOS related instructions 1336 1337# Instruction: open 1338# 1339# Open a new IO space. The handler string and a set of flags are 1340# passed on the stack. The descriptor of the opened IOS is pushed to 1341# the stack as a signed integer. 1342# 1343# If there is no other IO space opened when this instruction is 1344# executed, then the just opened space becomes the current IO space. 1345# 1346# If it is not possible to open the IO space according to the provided 1347# flags, the PVM_E_IOFLAGS exception is raised. If there is any other 1348# error performing the operation, PVM_E_IO is raised. 1349# 1350# Stack: ( STR ULONG -- INT ) 1351# Exceptions: PVM_E_IOFLAGS, PVM_E_IO 1352 1353instruction open () 1354 code 1355 char *filename = PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()); 1356 uint64_t flags = PVM_VAL_ULONG (JITTER_TOP_STACK ()); 1357 1358 int ret = ios_open (filename, flags, 0); 1359 1360 if (ret == IOS_EFLAGS) 1361 PVM_RAISE_DFL (PVM_E_IOFLAGS); 1362 else if (ret < IOS_OK) 1363 PVM_RAISE_DFL (PVM_E_IO); 1364 1365 JITTER_DROP_STACK (); 1366 JITTER_TOP_STACK () = PVM_MAKE_INT (ret, 32); 1367 end 1368end 1369 1370# Instruction: close 1371# 1372# Close an IO space. The descriptor of the space to close is provided 1373# on the stack as a signed integer. 1374# 1375# If the specified IO space doesn't exist, this instruction raises 1376# PVM_E_IO. 1377# 1378# Stack: ( INT -- ) 1379# Exceptions: PVM_E_IO 1380 1381instruction close () 1382 code 1383 int io_id = PVM_VAL_INT (JITTER_TOP_STACK ()); 1384 ios io = ios_search_by_id (io_id); 1385 1386 if (io == NULL) 1387 PVM_RAISE_DFL (PVM_E_IO); 1388 1389 ios_close (io); 1390 JITTER_DROP_STACK (); 1391 end 1392end 1393 1394# Instruction: flush 1395# 1396# 1397# Flush an IO space. The descriptor of the space to flush, and the 1398# bit-offset up to which perform the flushing are provided on the stack. 1399# 1400# If the specified IO space doesn't exist, this instruction raises 1401# PVM_E_IO. 1402# 1403# Stack: ( INT ULONG -- ) 1404# Exceptions: PVM_E_IO 1405 1406instruction flush () 1407 code 1408 ios_off offset = PVM_VAL_ULONG (JITTER_TOP_STACK ()); 1409 int io_id = PVM_VAL_INT (JITTER_UNDER_TOP_STACK ()); 1410 ios io = ios_search_by_id (io_id); 1411 1412 if (io == NULL) 1413 PVM_RAISE_DFL (PVM_E_IO); 1414 1415 if (ios_flush (io, offset) != IOS_OK) 1416 PVM_RAISE_DFL (PVM_E_IO); 1417 1418 JITTER_DROP_STACK (); 1419 JITTER_DROP_STACK (); 1420 end 1421end 1422 1423# Instruction: pushios 1424# 1425# Push the descriptor of the current IO space on the stack, as a 1426# signed integer. If no IO space is currently opened, raise 1427# PVM_E_NO_IOS. 1428# 1429# Stack: ( -- INT ) 1430# Exceptions: PVM_E_NO_IOS 1431 1432instruction pushios () 1433 code 1434 ios cur_io = ios_cur (); 1435 1436 if (cur_io == NULL) 1437 PVM_RAISE_DFL (PVM_E_NO_IOS); 1438 JITTER_PUSH_STACK (PVM_MAKE_INT (ios_get_id (cur_io), 32)); 1439 end 1440end 1441 1442# Instruction: popios 1443# 1444# Pop an IO space descriptor from the stack and set it as the current 1445# IO space. If the specified descriptor doesn't identify an IO space, 1446# raise PVM_E_NO_IOS. 1447# 1448# Stack: ( INT -- ) 1449# Exceptions: PVM_E_NO_IOS 1450 1451instruction popios () 1452 code 1453 ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ())); 1454 1455 if (io == NULL) 1456 PVM_RAISE_DFL (PVM_E_NO_IOS); 1457 ios_set_cur (io); 1458 JITTER_DROP_STACK (); 1459 end 1460end 1461 1462# Instruction: iosize 1463# 1464# Push the size of the given IO space on the stack, as an offset. The 1465# IO space is identified by a descriptor, which is a signed integer. 1466# If the given IO space doesn't exist, raise PVM_E_NO_IOS. 1467# 1468# Stack: ( INT -- INT OFF ) 1469# Exceptions: PVM_E_NO_IOS 1470 1471instruction iosize () 1472 code 1473 ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ())); 1474 1475 if (io == NULL) 1476 PVM_RAISE_DFL (PVM_E_NO_IOS); 1477 1478 JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (ios_size (io), 64), 1479 PVM_MAKE_ULONG (1, 64))); 1480 end 1481end 1482 1483 1484# Instruction: iogetb 1485# 1486# Each IO space has a bias associated with it, which by default is 0 1487# bits. This bias is applied to the offset given to every read/write 1488# operation. 1489# 1490# This instruction pushes the bias associated to the given IO space to 1491# the stack, as an offset. If the given IO space doesn't exist then 1492# the exception PVM_E_NO_IOS is raised. 1493# 1494# Stack: ( INT - INT OFF ) 1495# Exceptions: PVM_E_NO_IOS 1496 1497instruction iogetb () 1498 code 1499 ios io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ())); 1500 1501 if (io == NULL) 1502 PVM_RAISE_DFL (PVM_E_NO_IOS); 1503 1504 JITTER_PUSH_STACK (pvm_make_offset (PVM_MAKE_ULONG (ios_get_bias (io), 64), 1505 PVM_MAKE_ULONG (1, 64))); 1506 end 1507end 1508 1509# Instruction: iosetb 1510# 1511# Each IO space has a bias associated with it, which by default is 0 1512# bits. This bias is applied to the offset given to every read/write 1513# operation. 1514# 1515# This instruction sets the bias associated to the given IO space. 1516# The bias is specified as an offset. If the given IO space doesn't 1517# exist, the exception PVM_E_NO_IOS is raised. 1518# 1519# Stack: ( INT OFF -- INT ) 1520# Exceptions: PVM_E_NO_IOS 1521 1522instruction iosetb () 1523 code 1524 pvm_val bias = JITTER_TOP_STACK(); 1525 ios io = ios_search_by_id (PVM_VAL_INT (JITTER_UNDER_TOP_STACK ())); 1526 1527 JITTER_DROP_STACK (); 1528 1529 if (io == NULL) 1530 PVM_RAISE_DFL (PVM_E_NO_IOS); 1531 1532 ios_set_bias (io, 1533 (PVM_VAL_INTEGRAL (PVM_VAL_OFF_MAGNITUDE (bias)) 1534 * PVM_VAL_INTEGRAL (PVM_VAL_OFF_UNIT (bias)))); 1535 end 1536end 1537 1538 1539## Function management instructions 1540 1541# Instruction: call 1542# 1543# Call a closure on the stack, passing the specified arguments. After 1544# the execution of the closure, control is transferred to the 1545# instruction immediately following the call instruction. 1546# 1547# Stack: ( ARG1 ... ARGN CLOSURE -- RETVAL ) 1548 1549instruction call () 1550 caller 1551 code 1552 pvm_val closure = JITTER_TOP_STACK (); 1553 1554 assert (PVM_VAL_CLS_ENV (closure) != NULL); 1555 JITTER_DROP_STACK (); 1556 PVM_CALL (closure); 1557 end 1558end 1559 1560# Instruction: prolog 1561# 1562# Prepare the PVM for the execution of a function. This instruction 1563# shall be the target of every `call' instruction and shall be the 1564# first instruction in every function body. 1565# 1566# Stack: ( -- ) 1567 1568instruction prolog () 1569 callee 1570 code 1571 /* Fill the return stack slot with the return address. The return 1572 stack has already been pushesd (with an unspecified value on the 1573 under top) by the caller. */ 1574 JITTER_UNDER_TOP_RETURNSTACK() = (jitter_uint) JITTER_LINK; 1575 end 1576end 1577 1578# Instruction: return 1579# 1580# Return from a function. A function can have many `return' 1581# instructions. 1582# 1583# Stack: ( -- ) 1584 1585instruction return () 1586 code 1587 jitter_uint return_address; 1588 1589 /* Restore the environment of the caller. Note the cast to 1590 jitter_uint is to avoid a warning in 32-bit. */ 1591 jitter_state_runtime.env = (pvm_env) (jitter_int) JITTER_TOP_RETURNSTACK (); 1592 JITTER_DROP_RETURNSTACK(); 1593 1594 return_address = JITTER_TOP_RETURNSTACK(); 1595 JITTER_DROP_RETURNSTACK(); 1596 1597 JITTER_RETURN (return_address); 1598 end 1599end 1600 1601 1602## Environment instructions 1603 1604# Instruction: pushf N 1605# 1606# Push a new lexical frame. If the argument N is bigger than zero, it 1607# indicates the number of entries in the frame. If N is 0, it means 1608# we don't know how many entries will be stored in the frame. 1609# 1610# Stack: ( -- ) 1611 1612instruction pushf (?n popf_printer) 1613 code 1614 jitter_state_runtime.env 1615 = pvm_env_push_frame (jitter_state_runtime.env, 1616 JITTER_ARGN0); 1617 end 1618end 1619 1620# Instruction: popf N 1621# 1622# Pop N lexical frames. 1623# 1624# Stack: ( -- ) 1625 1626instruction popf (?n popf_printer) 1627 code 1628 jitter_uint i; 1629 1630 for (i = 0; i < JITTER_ARGN0; ++i) 1631 jitter_state_runtime.env 1632 = pvm_env_pop_frame (jitter_state_runtime.env); 1633 end 1634end 1635 1636# Instruction: pushvar BACK, OVER 1637# 1638# Retrieve the value of a variable from the lexical environment and 1639# push it on the stack. The lexical address of the variable is 1640# specified as arguments to the instruction. 1641# 1642# Stack: ( -- VAL ) 1643 1644instruction pushvar (?n 0, ?n 0 1 2 3 4 5) 1645 code 1646 JITTER_PUSH_STACK (pvm_env_lookup (jitter_state_runtime.env, 1647 (int) JITTER_ARGN0, 1648 (int) JITTER_ARGN1)); 1649 end 1650end 1651 1652# Instruction: pushtopvar OVER 1653# 1654# Retrive the value of a variable from the top-level frame of the 1655# lexical environment and put it on the stack. The OVER part of the 1656# lexical address of the variable is specified as an argument to the 1657# instruction. 1658# 1659# If the variable is not found then raise E_INVAL. 1660# 1661# Stack: ( -- VAL ) 1662 1663instruction pushtopvar (?n) 1664 code 1665 pvm_env topenv = pvm_env_toplevel (jitter_state_runtime.env); 1666 pvm_val val = pvm_env_lookup (topenv, 0 /* back */, 1667 (int) JITTER_ARGN0 /* over */); 1668 1669 if (val == PVM_NULL) 1670 PVM_RAISE (PVM_E_INVAL, "no top-level variable found", 1671 PVM_E_INVAL_ESTATUS); 1672 1673 JITTER_PUSH_STACK (val); 1674 end 1675end 1676 1677# Instruction: popvar BACK, OVER 1678# 1679# Pop a value from the stack and set it as the value of a variable 1680# having the lexical address specified in the arguments, in the 1681# current lexical environment. 1682# 1683# Stack: ( VAL -- ) 1684 1685instruction popvar (?n, ?n) 1686 code 1687 pvm_env_set_var (jitter_state_runtime.env, 1688 (int) JITTER_ARGN0, 1689 (int) JITTER_ARGN1, 1690 JITTER_TOP_STACK ()); 1691 JITTER_DROP_STACK (); 1692 end 1693end 1694 1695# Instruction: regvar 1696# 1697# Pop a value from the stack and use it as the value for a new 1698# variable in the current lexical environment. 1699# 1700# Stack: ( VAL -- ) 1701 1702instruction regvar () 1703 code 1704 pvm_env_register (jitter_state_runtime.env, 1705 JITTER_TOP_STACK ()); 1706 JITTER_DROP_STACK (); 1707 end 1708end 1709 1710# Instruction: duc 1711# 1712# Make a copy of the closure at the top of the stack, and 1713# replace it. 1714# 1715# Stack: ( CLS -- CLS ) 1716 1717instruction duc () 1718 code 1719 pvm_val cls = JITTER_TOP_STACK (); 1720 pvm_val new_cls = pvm_make_cls (PVM_VAL_CLS_PROGRAM (cls)); 1721 1722 JITTER_DROP_STACK (); 1723 JITTER_PUSH_STACK (new_cls); 1724 end 1725end 1726 1727# Instruction: pec 1728# 1729# Put the current lexical environment to the closure at the top of the 1730# stack. 1731# 1732# Stack: ( CLS -- CLS ) 1733 1734instruction pec () 1735 code 1736 pvm_val cls = JITTER_TOP_STACK (); 1737 PVM_VAL_CLS_ENV (cls) = jitter_state_runtime.env; 1738 end 1739end 1740 1741 1742## Printing Instructions 1743 1744# In the following instructions the meaning of the argument BASE is 1745# the following: 1746# 1747# 2 - print the number in binary. 1748# 8 - print the number in octal. 1749# 16 - print the number in hexadecimal. 1750# Any other value - print the number in decimal. 1751 1752# Instruction: printind 1753# 1754# Indent the output in the terminal for LVL levels of indentation, 1755# using STEP white chars in each indentation level. 1756# 1757# LVL is an integer in the under top stack. 1758# STEP is an integer in the top of the stack. 1759# 1760# Stack: ( INT INT -- ) 1761 1762instruction indent () 1763 code 1764 pk_term_indent (PVM_VAL_INT (JITTER_UNDER_TOP_STACK ()), 1765 PVM_VAL_INT (JITTER_TOP_STACK ())); 1766 JITTER_DROP_STACK (); 1767 JITTER_DROP_STACK (); 1768 end 1769end 1770 1771# Instruction: printi BITS 1772# 1773# Given a signed integer and a numeration base in the stack, print the 1774# integer to the terminal. 1775# 1776# Stack: ( INT INT -- ) 1777 1778instruction printi (?n popf_printer) 1779 code 1780 int base = PVM_VAL_INT (JITTER_TOP_STACK ()); 1781 PVM_PRINTI (INT, int32_t, 'd', base); 1782 end 1783end 1784 1785# Instruction: printiu BITS 1786# 1787# Given an unsigned integer and a numeration base in the stack, print 1788# the integer to the terminal. 1789# 1790# Stack: ( UINT INT -- ) 1791 1792instruction printiu (?n popf_printer) 1793 code 1794 int base = PVM_VAL_INT (JITTER_TOP_STACK ()); 1795 PVM_PRINTI (UINT, uint32_t, 'u', base); 1796 end 1797end 1798 1799# Instruction: printl BITS 1800# 1801# Given a long and a numeration base in the stack, print the integer 1802# to the terminal. 1803# 1804# Stack: ( LONG INT -- ) 1805 1806instruction printl (?n popf_printer) 1807 code 1808 int base = PVM_VAL_INT (JITTER_TOP_STACK ()); 1809 PVM_PRINTL (LONG, int64_t, 'd', base); 1810 end 1811end 1812 1813# Instruction: printlu BITS 1814# 1815# Given an unsigned long and a numeration base in the stack, print the 1816# integer to the terminal. 1817# 1818# Stack: ( ULONG INT -- ) 1819 1820instruction printlu (?n popf_printer) 1821 code 1822 int base = PVM_VAL_INT (JITTER_TOP_STACK ()); 1823 PVM_PRINTL (ULONG, uint64_t, 'u', base); 1824 end 1825end 1826 1827# Instruction: prints 1828# 1829# Print the string at the top of the stack. 1830# 1831# Stack: ( STR -- ) 1832 1833instruction prints () 1834 code 1835 pvm_print_string (JITTER_TOP_STACK ()); 1836 JITTER_DROP_STACK (); 1837 end 1838end 1839 1840# Instruction: beghl 1841# 1842# Begin an hyperlink, using the URL and ID on the stack. 1843# 1844# Stack: ( STR STR -- ) 1845 1846instruction beghl () 1847 code 1848 char *url = PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()); 1849 char *id = PVM_VAL_STR (JITTER_TOP_STACK ()); 1850 1851 JITTER_DROP_STACK (); 1852 JITTER_DROP_STACK (); 1853 pk_term_hyperlink (url, id); 1854 end 1855end 1856 1857# Instruction: endhl 1858# 1859# End the current hyperlink. 1860# 1861# If no hyperlink is currently being generated, this instruction 1862# raises an exception. 1863# 1864# Stack: ( -- ) 1865# Exceptions: PVM_E_GENERIC 1866 1867instruction endhl () 1868 code 1869 if (!pk_term_end_hyperlink ()) 1870 PVM_RAISE (PVM_E_GENERIC, 1871 "no current hyperlink", 1872 PVM_E_GENERIC_ESTATUS); 1873 end 1874end 1875 1876# Instruction: begsc 1877# 1878# Begin the styling class whose name is found on the stack. This 1879# class will be in effect in subsequent print operations until it is 1880# explicitly ended by a `endsc' instruction. 1881# 1882# Stack: ( STR -- ) 1883 1884instruction begsc () 1885 code 1886 pk_term_class (PVM_VAL_STR (JITTER_TOP_STACK ())); 1887 JITTER_DROP_STACK (); 1888 end 1889end 1890 1891# Instruction: endsc 1892# 1893# End the styling class whose name is found on the stack. This class 1894# should have been previously began by a `begsc' instruction. 1895# 1896# Stack: ( STR -- ) 1897 1898instruction endsc () 1899 code 1900 if (!pk_term_end_class (PVM_VAL_STR (JITTER_TOP_STACK ()))) 1901 PVM_RAISE (PVM_E_INVAL, 1902 "invalid class", 1903 PVM_E_INVAL_ESTATUS); 1904 JITTER_DROP_STACK (); 1905 end 1906end 1907 1908 1909## Main stack manipulation instructions 1910 1911# Instruction: push VAL 1912# 1913# Push the value given as an argument to the main stack. 1914# 1915# Stack: ( -- VAL ) 1916 1917instruction push (?nl pvm_literal_printer) 1918 code 1919 pvm_val k = JITTER_ARGN0; 1920 JITTER_PUSH_STACK(k); 1921 end 1922end 1923 1924# Instruction: drop 1925# 1926# Pop the value at the top of the main stack, and discard it. 1927# 1928# Stack: ( VAL -- ) 1929 1930instruction drop () 1931 code 1932 JITTER_DROP_STACK(); 1933 end 1934end 1935 1936# Instruction: drop2 1937# 1938# Pop the two values at the top of the main stack, and discard them. 1939# 1940# Stack: ( VAL VAL -- ) 1941 1942instruction drop2 () 1943 code 1944 JITTER_DROP_STACK(); 1945 JITTER_DROP_STACK(); 1946 end 1947end 1948 1949# Instruction: drop3 1950# 1951# Pop the three values at the top of the main stack, and discard them. 1952# 1953# Stack: ( VAL VAL VAL -- ) 1954 1955instruction drop3 () 1956 code 1957 JITTER_DROP_STACK(); 1958 JITTER_DROP_STACK(); 1959 JITTER_DROP_STACK(); 1960 end 1961end 1962 1963# Instruction: drop4 1964# 1965# Pop the four values at the top of the stack, and discard them. 1966# 1967# Stack: ( VAL VAL VAL VAL -- ) 1968 1969instruction drop4 () 1970 code 1971 JITTER_DROP_STACK(); 1972 JITTER_DROP_STACK(); 1973 JITTER_DROP_STACK(); 1974 JITTER_DROP_STACK(); 1975 end 1976end 1977 1978# Instruction: swap 1979# 1980# Exchange the two elements at the top of the stack. 1981# 1982# Stack: ( A B -- B A) 1983 1984instruction swap () 1985 code 1986 pvm_val tmp = JITTER_UNDER_TOP_STACK (); 1987 JITTER_UNDER_TOP_STACK () = JITTER_TOP_STACK (); 1988 JITTER_TOP_STACK () = tmp; 1989 end 1990end 1991 1992# Instruction: nip 1993# 1994# Discard the element at the under top of the main stack. 1995# 1996# Stack: ( A B -- B ) 1997 1998instruction nip () 1999 code 2000 JITTER_NIP_STACK(); 2001 end 2002end 2003 2004# Instruction: nip2 2005# 2006# Discard the two elements at the under top of the main stack. 2007# 2008# Stack: ( A B C -- C ) 2009 2010instruction nip2 () 2011 code 2012 JITTER_NIP_STACK (); 2013 JITTER_NIP_STACK (); 2014 end 2015end 2016 2017# Instruction: nip3 2018# 2019# Discard the three elements at the under top of the main stack. 2020# 2021# Stack: ( A B C D -- D ) 2022 2023instruction nip3 () 2024 code 2025 JITTER_NIP_STACK (); 2026 JITTER_NIP_STACK (); 2027 JITTER_NIP_STACK (); 2028 end 2029end 2030 2031# Instruction: dup 2032# 2033# Push a copy of the element at the top of the main stack. 2034# 2035# Stack: ( A -- A A ) 2036 2037instruction dup () 2038 code 2039 JITTER_DUP_STACK (); 2040 end 2041end 2042 2043# Instruction: over 2044# 2045# Push a copy of the element at the under top of the main stack. 2046# 2047# Stack: ( A B -- A B A ) 2048 2049instruction over () 2050 code 2051 JITTER_PUSH_STACK (JITTER_UNDER_TOP_STACK ()); 2052 end 2053end 2054 2055# Instruction: rot 2056# 2057# Rotate the three elements at the top of the main stack, clock-wise. 2058# 2059# Stack: ( A B C -- B C A ) 2060 2061instruction rot () 2062 code 2063 JITTER_ROT_STACK (); 2064 end 2065end 2066 2067# Instruction: nrot 2068# 2069# Rotate the three elements at the top of the stack, counter 2070# clock-wise. 2071# 2072# Stack: ( A B C -- C A B ) 2073 2074instruction nrot () 2075 code 2076 JITTER_MROT_STACK (); 2077 end 2078end 2079 2080# Instruction: tuck 2081# 2082# Tuck a copy of the element at the top of the stack down two 2083# positions. 2084# 2085# Stack: ( A B -- B A B ) 2086 2087instruction tuck () 2088 code 2089 JITTER_TUCK_STACK (); 2090 end 2091end 2092 2093# Instruction: quake 2094# 2095# Swap the two elements at the under top of the stack. 2096# 2097# Stack: ( A B C - B A C ) 2098 2099instruction quake () 2100 code 2101 JITTER_QUAKE_STACK (); 2102 end 2103end 2104 2105# Instruction: revn N 2106# 2107# Reverse the N elements at the top of the stack. 2108# 2109# Stack: ( VAL... -- VAL... ) 2110 2111instruction revn (?n 3 4 popf_printer) 2112 code 2113 JITTER_REVERSE_STACK (JITTER_ARGU0); 2114 end 2115end 2116 2117# Instruction: pushhi VAL 2118# 2119# Push the high 32 bits of the value passed as an argument to the main 2120# stack. This instruction shall be completed with a `pushlo'. 2121# 2122# This instruction is a workaround to a limitation of Jitter. 2123# 2124# Stack: ( -- HI32(VAL) ) 2125 2126instruction pushhi (?nl pvm_literal_printer_hi) 2127 code 2128 jitter_state_runtime.push_hi 2129 = JITTER_ARGN0; 2130 end 2131end 2132 2133# Instruction: pushlo VAL 2134# 2135# Push the low 32 bits of the value passed as an argument to the main 2136# stack. This instruction shall be preceded by a `pushhi'. 2137# 2138# This instruction is a workaround to a limitation of Jitter. 2139# 2140# Stack: ( -- LO32(VAL) ) 2141 2142instruction pushlo (?nl pvm_literal_printer_lo) 2143 code 2144 pvm_val k 2145 = ((pvm_val) jitter_state_runtime.push_hi << 32) 2146 | JITTER_ARGN0; 2147 JITTER_PUSH_STACK (k); 2148 end 2149end 2150 2151# Instruction: push32 VAL 2152# 2153# Push the value passed as an argument on the stack. This assumes 2154# that the internal representation of VAL doesn't require more than 2155# 32-bit. 2156# 2157# This instruction is a workaround to a limitation of Jitter. 2158# 2159# Stack: ( -- VAL ) 2160 2161instruction push32 (?nl pvm_literal_printer) 2162 code 2163 pvm_val k = JITTER_ARGN0; 2164 JITTER_PUSH_STACK (k); 2165 end 2166end 2167 2168 2169## Registers manipulation instructions 2170 2171# Instruction: pushr REGNO 2172# 2173# Push the contents of the register REGNO on the stack. 2174# 2175# Stack: ( -- VAL ) 2176 2177instruction pushr (?R) 2178 code 2179 JITTER_PUSH_STACK (JITTER_ARG0); 2180 end 2181end 2182 2183# Instruction: popr REGNO 2184# 2185# Pop the element at the top of the stack and put it in the 2186# register REGNO. 2187# 2188# Stack: ( VAL -- ) 2189 2190instruction popr (!R) 2191 code 2192 JITTER_ARG0 = JITTER_TOP_STACK (); 2193 JITTER_DROP_STACK (); 2194 end 2195end 2196 2197# Instruction: setr REGNO 2198# 2199# Set the element at the top of the stack to the value of the 2200# register REGNO. 2201# 2202# Stack: ( -- ) 2203 2204instruction setr (!R) 2205 code 2206 JITTER_ARG0 = JITTER_TOP_STACK(); 2207 end 2208end 2209 2210 2211## Return stack manipulation instructions 2212 2213# Instruction: saver REGNO 2214# 2215# Push the contents of the register REGNO to the return stack. 2216# 2217# Stack: ( -- ) 2218# ReturnStack: ( -- VAL ) 2219 2220instruction saver (?R) 2221 code 2222 JITTER_PUSH_RETURNSTACK (JITTER_ARG0); 2223 end 2224end 2225 2226# Instruction: restorer REGNO 2227# 2228# Pop the element at the top of the return stack and put it in the 2229# register REGNO. 2230# 2231# Stack: ( -- ) 2232# ReturnStack: ( VAL -- ) 2233 2234instruction restorer (!R) 2235 code 2236 JITTER_ARG0 = JITTER_TOP_RETURNSTACK (); 2237 JITTER_DROP_RETURNSTACK (); 2238 end 2239end 2240 2241# Instruction: tor 2242# 2243# Pop an element from the stack and push it in the return stack. 2244# 2245# Stack: ( VAL -- ) 2246# ReturnStack: ( -- VAL ) 2247 2248instruction tor () 2249 code 2250 JITTER_PUSH_RETURNSTACK (JITTER_TOP_STACK ()); 2251 JITTER_DROP_STACK (); 2252 end 2253end 2254 2255# Instruction: fromr 2256# 2257# Pop an element from the return stack and push it on the stack. 2258# 2259# Stack: ( -- VAL) 2260# ReturnStack: ( VAL -- ) 2261 2262instruction fromr () 2263 code 2264 JITTER_PUSH_STACK (JITTER_TOP_RETURNSTACK ()); 2265 JITTER_DROP_RETURNSTACK (); 2266 end 2267end 2268 2269# Instruction: atr 2270# 2271# Push a copy of the element at the top of the return stack into the 2272# stack. 2273# 2274# Stack: ( -- VAL ) 2275 2276instruction atr () 2277 code 2278 JITTER_PUSH_STACK (JITTER_TOP_RETURNSTACK ()); 2279 end 2280end 2281 2282 2283## Arithmetic instructions 2284 2285# The following instructions assume that both operands have the same 2286# size in bits. 2287 2288# Instruction: addi 2289# 2290# Push the result of adding the two integers at the top of the stack. 2291# If the operation would result in overflow, raise PVM_E_OVERFLOW. 2292# 2293# Stack: ( INT INT -- INT INT INT ) 2294# Exceptions: PVM_E_OVERFLOW 2295 2296instruction addi () 2297 code 2298 PVM_ADD_SIGNED (INT,int); 2299 end 2300end 2301 2302# Instruction: addiu 2303# 2304# Push the result of adding the two unsigned integers at the top of 2305# the stack. 2306# 2307# Stack: ( UINT UINT -- UINT UINT UINT ) 2308 2309instruction addiu () 2310 code 2311 PVM_BINOP (UINT, UINT, UINT, +); 2312 end 2313end 2314 2315# Instruction addl 2316# 2317# Push the result of adding the two longs at the top of the stack. 2318# If the operation would result in overflow, raise PVM_E_OVERFLOW. 2319# 2320# Stack: ( LONG LONG -- LONG LONG LONG ) 2321# Exceptions: PVM_E_OVERFLOW 2322 2323instruction addl () 2324 code 2325 PVM_ADD_SIGNED (LONG, int64_t); 2326 end 2327end 2328 2329# Instruction: addlu 2330# 2331# Push the result of adding the two unsigned longs at the top of 2332# the stack. 2333# 2334# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 2335 2336instruction addlu () 2337 code 2338 PVM_BINOP (ULONG, ULONG, ULONG, +); 2339 end 2340end 2341 2342# Instruction: subi 2343# 2344# Push the result of subtracting the two integers at the top of 2345# the stack. 2346# 2347# Stack: ( INT INT -- INT INT INT ) 2348 2349instruction subi () 2350 code 2351 PVM_SUB_SIGNED (INT, int); 2352 end 2353end 2354 2355# Instruction: subiu 2356# 2357# Push the result of subtracting the two unsigned integers at the 2358# top of the stack. 2359# 2360# Stack: ( UINT UINT -- UINT UINT UINT ) 2361 2362instruction subiu () 2363 code 2364 PVM_BINOP (UINT, UINT, UINT, -); 2365 end 2366end 2367 2368# Instruction: subl 2369# 2370# Push the result of subtracting the two longs at the top 2371# of the stack. 2372# 2373# Stack: ( LONG LONG -- LONG LONG LONG ) 2374 2375instruction subl () 2376 code 2377 PVM_SUB_SIGNED (LONG, int64_t); 2378 end 2379end 2380 2381# Instruction: sublu 2382# 2383# Push the result of subtracting the two unsigned longs at the 2384# top of the stack. 2385# 2386# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 2387 2388instruction sublu () 2389 code 2390 PVM_BINOP (ULONG, ULONG, ULONG, -); 2391 end 2392end 2393 2394# Instruction: muli 2395# 2396# Push the result of multiplying the two integers at the top of the 2397# stack. 2398# 2399# Stack: ( INT INT -- INT INT INT ) 2400 2401instruction muli () 2402 code 2403 PVM_MUL_SIGNED (INT, int); 2404 end 2405end 2406 2407# Instruction: muliu 2408# 2409# Push the result of multiplying the two unsigned integers at the 2410# top of the stack. 2411# 2412# Stack: ( UINT UINT -- UINT UINT UINT ) 2413 2414instruction muliu () 2415 code 2416 PVM_BINOP (UINT, UINT, UINT, *); 2417 end 2418end 2419 2420# Instruction: mull 2421# 2422# Push the result of multiplying the two longs at the top of the 2423# stack. 2424# 2425# Stack: ( LONG LONG -- LONG LONG LONG ) 2426 2427instruction mull () 2428 code 2429 PVM_MUL_SIGNED (LONG, int64_t); 2430 end 2431end 2432 2433# Instruction: mullu 2434# 2435# Push the result of multiplying the two unsigned longs at the top 2436# of the stack. 2437# 2438# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 2439 2440instruction mullu () 2441 code 2442 PVM_BINOP (ULONG, ULONG, ULONG, *); 2443 end 2444end 2445 2446# Instruction: divi 2447# 2448# Push the result of the integer division of the two integers at the 2449# top of the stack. If the denominator is zero, raise 2450# PVM_E_DIV_BY_ZERO. 2451# 2452# Stack: ( INT INT -- INT INT INT ) 2453# Exceptions: PVM_E_DIV_BY_ZERO 2454 2455instruction divi () 2456 code 2457 PVM_DIV_SIGNED (INT, int); 2458 end 2459end 2460 2461# Instruction: diviu 2462# 2463# Push the result of the integer division of the two unsigned integers 2464# at the top of the stack. If the denominator is zero, raise 2465# PVM_E_DIV_BY_ZERO. 2466# 2467# Stack: ( UINT UINT -- UINT UINT UINT ) 2468# Exceptions: PVM_E_DIV_BY_ZERO 2469 2470instruction diviu () 2471 code 2472 PVM_CHECKED_BINOP (UINT, UINT, UINT, /); 2473 end 2474end 2475 2476# Instruction: divl 2477# 2478# Push the result of the integer division of the two longs at the top 2479# of the stack. If the denominator is zero, raise PVM_E_DIV_BY_ZERO. 2480# 2481# Stack: ( LONG LONG -- LONG LONG LONG ) 2482# Exceptions: PVM_E_DIV_BY_ZERO 2483 2484instruction divl () 2485 code 2486 PVM_DIV_SIGNED (LONG, int64_t); 2487 end 2488end 2489 2490# Instruction: divlu 2491# 2492# Push the result of the integer division of the two unsigned 2493# longs at the top of the stack. If the denominator is zero, 2494# raise PVM_E_DIV_BY_ZERO. 2495# 2496# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 2497# Exceptions: PVM_E_DIV_BY_ZERO 2498 2499instruction divlu () 2500 code 2501 PVM_CHECKED_BINOP (ULONG, ULONG, ULONG, /); 2502 end 2503end 2504 2505# Instruction: modi 2506# 2507# Push the result of the modulus of the two integers at the top of the 2508# stack. If the denominator is zero, raise PVM_E_DIV_BY_ZERO. 2509# 2510# Stack: ( INT INT -- INT INT INT ) 2511# Exceptions: PVM_E_DIV_BY_ZERO 2512 2513instruction modi () 2514 code 2515 PVM_MOD_SIGNED (INT, int); 2516 end 2517end 2518 2519# Instruction: modiu 2520# 2521# Push the result of the modulus of the two unsigned integers at the 2522# top of the stack. If the denominator is zero, raise 2523# PVM_E_DIV_BY_ZERO. 2524# 2525# Stack: ( UINT UINT -- UINT UINT UINT ) 2526# Exceptions: PVM_E_DIV_BY_ZERO 2527 2528instruction modiu () 2529 code 2530 PVM_CHECKED_BINOP (UINT, UINT, UINT, %); 2531 end 2532end 2533 2534# Instruction: modl 2535# 2536# Push the result of the modulus of the two longs at the top of the 2537# stack. If the denominator is zero, raise PVM_E_DIV_BY_ZERO. 2538# 2539# Stack: ( LONG LONG -- LONG LONG LONG ) 2540# Exceptions: PVM_E_DIV_BY_ZERO 2541 2542instruction modl () 2543 code 2544 PVM_MOD_SIGNED (LONG, int64_t); 2545 end 2546end 2547 2548# Instruction: modlu 2549# 2550# Push the result of the modulus of the two unsigned longs at the top 2551# of the stack. If the denominator is zero, raise PVM_E_DIV_BY_ZERO. 2552# 2553# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 2554# Exceptions: PVM_E_DIV_BY_ZERO 2555 2556instruction modlu () 2557 code 2558 PVM_CHECKED_BINOP (ULONG, ULONG, ULONG, %); 2559 end 2560end 2561 2562# Instruction: negi 2563# 2564# Push the result of the negation of the integer at the top of the 2565# stack. 2566# 2567# Stack: ( INT -- INT INT ) 2568 2569instruction negi () 2570 code 2571 PVM_NEG_SIGNED (INT, int); 2572 end 2573end 2574 2575# Instruction: negiu 2576# 2577# Push the result of the negation of the unsigned integer at the 2578# top of the stack. 2579# 2580# Stack: ( UINT -- UINT UINT UINT ) 2581 2582instruction negiu () 2583 code 2584 PVM_UNOP (UINT, UINT, uint, -); 2585 end 2586end 2587 2588# Instruction: negl 2589# 2590# Push the result of the negation of the long at the top of the 2591# stack. 2592# 2593# Stack: ( LONG -- LONG LONG ) 2594 2595instruction negl () 2596 code 2597 PVM_NEG_SIGNED (LONG, int64_t); 2598 end 2599end 2600 2601# Instruction: neglu 2602# 2603# Push the result of the negation of the unsigned long at the top of 2604# the stack. 2605# 2606# Stack: ( ULONG -- ULONG ULONG ) 2607 2608instruction neglu () 2609 code 2610 PVM_UNOP (ULONG, ULONG, ulong, -); 2611 end 2612end 2613 2614# Instruction: powi 2615# 2616# Perform the exponentiation of the integer at the under top of the 2617# stack. The exponent is the unsigned integer at the top of the 2618# stack. If the exponent is 0, the result is 1. 2619# 2620# Stack: ( INT UINT -- INT UINT INT ) 2621 2622instruction powi () 2623 code 2624 PVM_POWOP_SIGNED (INT,int64_t,int); 2625 end 2626end 2627 2628# Instruction: powiu 2629# 2630# Perform the exponentiation of the unsigned integer at the under top 2631# of the stack. The exponent is the unsigned integer at the top of 2632# the stack. If the exponent is 0, the result is 1. 2633# 2634# Stack: ( UINT UINT -- UINT UINT UINT ) 2635 2636instruction powiu () 2637 code 2638 PVM_POWOP (UINT,uint64_t,uint); 2639 end 2640end 2641 2642# Instruction: powl 2643# 2644# Perform the exponentiation of the long at the under top of the 2645# stack. The exponent is the unsigned integer at the top of the 2646# stack. If the exponent is 0, the result is 1. 2647# 2648# Stack: ( LONG UINT -- LONG UINT LONG ) 2649 2650instruction powl () 2651 code 2652 PVM_POWOP_SIGNED (LONG,int64_t,long); 2653 end 2654end 2655 2656# Instruction: powlu 2657# 2658# Perform the exponentiation of the unsigned long at the under top of 2659# the stack. The exponent is the unsigned integer at the top of the 2660# stack. If the exponent is 0, the result is 1. 2661# 2662# Stack: ( ULONG UINT -- ULONG UINT ULONG ) 2663 2664instruction powlu () 2665 code 2666 PVM_POWOP (ULONG,uint64_t,ulong); 2667 end 2668end 2669 2670 2671## Relational instructions 2672 2673# Instruction: eqi 2674# 2675# Push 1 on the stack if the two integers at the top of the stack are 2676# equal. Otherwise push 0. 2677# 2678# Stack: ( INT INT -- INT INT INT ) 2679 2680instruction eqi () 2681 code 2682 PVM_BOOL_BINOP (INT, ==); 2683 end 2684end 2685 2686# Instruction: eqiu 2687# 2688# Push 1 on the stack if the two unsigned integers at the top of the 2689# stack are equal. Otherwise push 0. 2690# 2691# Stack: ( UINT UINT -- UINT UINT UINT ) 2692 2693instruction eqiu () 2694 code 2695 PVM_BOOL_BINOP (UINT, ==); 2696 end 2697end 2698 2699# Instruction: eql 2700# 2701# Push 1 on the stack if the two longs at the top of the stack are 2702# equal. Otherwise push 0. 2703# 2704# Stack: ( LONG LONG -- LONG LONG INT ) 2705 2706instruction eql () 2707 code 2708 PVM_BOOL_BINOP (LONG, ==); 2709 end 2710end 2711 2712# Instruction: eqlu 2713# 2714# Push 1 on the stack if the two unsigned longs at the top of the 2715# stack are equal. Otherwise push 0. 2716# 2717# Stack: ( ULONG ULONG -- ULONG ULONG INT ) 2718 2719instruction eqlu () 2720 code 2721 PVM_BOOL_BINOP (ULONG, ==); 2722 end 2723end 2724 2725# Instruction: eqs 2726# 2727# Push 1 on the stack if the two strings at the top of the stack are 2728# equal. Otherwise push 0. 2729# 2730# Stack: ( STR STR -- STR STR INT ) 2731 2732instruction eqs () 2733 code 2734 pvm_val res = PVM_MAKE_INT (STREQ (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 2735 PVM_VAL_STR (JITTER_TOP_STACK ())), 2736 32); 2737 JITTER_PUSH_STACK (res); 2738 end 2739end 2740 2741# Instruction: nei 2742# 2743# Push 1 on the stack if the two integers at the top of the stack are 2744# not equal. Otherwise push 0. 2745# 2746# Stack: ( INT INT -- INT INT INT ) 2747 2748instruction nei () 2749 code 2750 PVM_BOOL_BINOP (INT, !=); 2751 end 2752end 2753 2754# Instruction: neiu 2755# 2756# Push 1 on the stack if the two unsigned integers at the top of the 2757# stack are not equal. Otherwise push 0. 2758# 2759# Stack: ( UINT UINT -- UINT UINT INT ) 2760 2761instruction neiu () 2762 code 2763 PVM_BOOL_BINOP (UINT, !=); 2764 end 2765end 2766 2767# Instruction: nel 2768# 2769# Push 1 on the stack if the two longs at the top of the stack are not 2770# equal. Otherwise push 0. 2771# 2772# Stack: ( LONG LONG -- LONG LONG INT ) 2773 2774instruction nel () 2775 code 2776 PVM_BOOL_BINOP (LONG, !=); 2777 end 2778end 2779 2780# Instruction: nelu 2781# 2782# Push 1 on the stack if the two unsigned longs at the top of the 2783# stack are not equal. Otherwise push 0. 2784# 2785# Stack: ( ULONG ULONG -- ULONG ULONG INT ) 2786 2787instruction nelu () 2788 code 2789 PVM_BOOL_BINOP (ULONG, !=); 2790 end 2791end 2792 2793# Instruction: nes 2794# 2795# Push 1 on the stack if the two strings at the top of the stack are 2796# not equal. Otherwise push 0. 2797# 2798# Stack: ( STR STR -- STR STR INT ) 2799 2800instruction nes () 2801 code 2802 pvm_val res = PVM_MAKE_INT (STRNEQ (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 2803 PVM_VAL_STR (JITTER_TOP_STACK ())), 2804 32); 2805 JITTER_PUSH_STACK (res); 2806 end 2807end 2808 2809# Instruction: nn 2810# 2811# Push 0 on the stack if the value at the top of the stack equals 2812# PVM_NULL. Otherwise push 1. 2813# 2814# Stack: ( VAL -- VAL INT ) 2815 2816instruction nn () 2817 code 2818 JITTER_PUSH_STACK (PVM_MAKE_INT (JITTER_TOP_STACK () != PVM_NULL, 2819 32)); 2820 end 2821end 2822 2823# Instruction: nnn 2824# 2825# Push 1 on the stack if the value at the top of the stack equals 2826# PVM_NULL. Otherwise push 0. 2827# 2828# Stack: ( VAL -- VAL INT ) 2829 2830instruction nnn () 2831 code 2832 JITTER_PUSH_STACK (PVM_MAKE_INT (JITTER_TOP_STACK () == PVM_NULL, 2833 32)); 2834 end 2835end 2836 2837# Instruction: lti 2838# 2839# Push 1 on the stack if the integer at the under top is less that the 2840# integer at the top. Otherwise push 0. 2841# 2842# Stack: ( INT INT -- INT INT INT ) 2843 2844instruction lti () 2845 code 2846 PVM_BOOL_BINOP (INT, <); 2847 end 2848end 2849 2850# Instruction: ltiu 2851# 2852# Push 1 on the stack if the unsigned integer at the under top is less 2853# that the unsigned integer at the top. Otherwise push 0. 2854# 2855# Stack: ( UINT INT -- UINT UINT INT ) 2856 2857instruction ltiu () # ( UINT UINT -- UINT UINT INT ) 2858 code 2859 PVM_BOOL_BINOP (UINT, <); 2860 end 2861end 2862 2863# Instruction: ltl 2864# 2865# Push 1 on the stack if the long at the under top is less that the 2866# long at the top. Otherwise push 0. 2867# 2868# Stack: ( LONG LONG -- LONG LONG INT ) 2869 2870instruction ltl () # ( LONG LONG -- LONG LONG INT ) 2871 code 2872 PVM_BOOL_BINOP (LONG, <); 2873 end 2874end 2875 2876# Instruction: ltlu 2877# 2878# Push 1 on the stack if the unsigned long at the under top is less 2879# that the unsigned long at the top. Otherwise push 0. 2880# 2881# Stack: ( ULONG ULONG -- ULONG ULONG INT ) 2882 2883instruction ltlu () 2884 code 2885 PVM_BOOL_BINOP (ULONG, <); 2886 end 2887end 2888 2889# Instruction: lei 2890# 2891# Push 1 on the stack if the integer at the under top is less or equal 2892# that the integer at the top. Otherwise push 0. 2893# 2894# Stack: ( INT INT -- INT INT INT ) 2895 2896instruction lei () # ( INT INT -- INT INT INT ) 2897 code 2898 PVM_BOOL_BINOP (INT, <=); 2899 end 2900end 2901 2902# Instruction: leiu 2903# 2904# Push 1 on the stack if the unsigned integer at the under top is less 2905# or equal that the unsigned integer at the top. Otherwise push 0. 2906# 2907# Stack: ( UINT UINT -- UINT UINT INT ) 2908 2909instruction leiu () # ( UINT UINT -- UINT UINT INT ) 2910 code 2911 PVM_BOOL_BINOP (UINT, <=); 2912 end 2913end 2914 2915# Instruction: lel 2916# 2917# Push 1 on the stack if the long at the under top is less or equal 2918# that the long at the top. Otherwise push 0. 2919# 2920# Stack: ( LONG LONG -- LONG LONG INT ) 2921 2922instruction lel () # ( LONG LONG -- LONG LONG INT ) 2923 code 2924 PVM_BOOL_BINOP (LONG, <=); 2925 end 2926end 2927 2928# Instruction: lelu 2929# 2930# Push 1 on the stack if the unsigned long at the under top is less or 2931# equal that the unsigned long at the top. Otherwise push 0. 2932# 2933# Stack: ( ULONG ULONG -- ULONG ULONG INT ) 2934 2935instruction lelu () 2936 code 2937 PVM_BOOL_BINOP (ULONG, <=); 2938 end 2939end 2940 2941# Instruction: gti 2942# 2943# Push 1 on the stack if the integer at the under top is greater than 2944# the integer at the top. Otherwise push 0. 2945# 2946# Stack: ( INT INT -- INT INT INT ) 2947 2948instruction gti () 2949 code 2950 PVM_BOOL_BINOP (INT, >); 2951 end 2952end 2953 2954# Instruction: gtiu 2955# 2956# Push 1 on the stack if the unsigned integer at the under top is 2957# greater than the unsigned integer at the top. Otherwise push 0. 2958# 2959# Stack: ( UINT UINT -- UINT UINT INT ) 2960 2961instruction gtiu () 2962 code 2963 PVM_BOOL_BINOP (UINT, >); 2964 end 2965end 2966 2967# Instruction: gtl 2968# 2969# Push 1 on the stack if the long at the under top is greater than the 2970# long at the top. Otherwise push 0. 2971# 2972# Stack: ( LONG LONG -- LONG LONG INT ) 2973 2974instruction gtl () 2975 code 2976 PVM_BOOL_BINOP (LONG, >); 2977 end 2978end 2979 2980# Instruction: gtlu 2981# 2982# Push 1 on the stack if the unsigned long at the under top is greater 2983# than the unsigned long at the top. Otherwise push 0. 2984# 2985# Stack: ( LONG LONG -- LONG LONG INT ) 2986 2987instruction gtlu () 2988 code 2989 PVM_BOOL_BINOP (ULONG, >); 2990 end 2991end 2992 2993# Instruction: gei 2994# 2995# Push 1 on the stack if the integer at the under top is greater or 2996# equal than the integer at the top. Otherwise push 0. 2997# 2998# Stack: ( INT INT -- INT INT INT ) 2999 3000instruction gei () 3001 code 3002 PVM_BOOL_BINOP (INT, >=); 3003 end 3004end 3005 3006# Instruction: geiu 3007# 3008# Push 1 on the stack if the unsigned integer at the under top is 3009# greater or equal than the unsigned integer at the top. Otherwise 3010# push 0. 3011# 3012# Stack: ( UINT UINT -- UINT UINT INT ) 3013 3014instruction geiu () 3015 code 3016 PVM_BOOL_BINOP (UINT, >=); 3017 end 3018end 3019 3020# Instruction: gel 3021# 3022# Push 1 on the stack if the long at the under top is greater or equal 3023# than the long at the top. Otherwise push 0. 3024# 3025# Stack: ( LONG LONG -- LONG LONG INT ) 3026 3027instruction gel () 3028 code 3029 PVM_BOOL_BINOP (LONG, >=); 3030 end 3031end 3032 3033# Instruction: gelu 3034# 3035# Push 1 on the stack if the unsigned long at the under top is greater 3036# or equal than the unsigned long at the top. Otherwise push 0. 3037# 3038# Stack: ( ULONG ULONG -- ULONG ULONG INT ) 3039 3040instruction gelu () 3041 code 3042 PVM_BOOL_BINOP (ULONG, >=); 3043 end 3044end 3045 3046# Instruction: lts 3047# 3048# Push 1 on the stack if the string at the under top is less than the 3049# string at the top, in lexicographic order. Otherwise push 0. 3050# 3051# Stack: ( STR STR -- STR STR INT ) 3052 3053instruction lts () 3054 code 3055 pvm_val res = PVM_MAKE_INT (strcmp (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 3056 PVM_VAL_STR (JITTER_TOP_STACK ())) < 0, 32); 3057 JITTER_PUSH_STACK (res); 3058 end 3059end 3060 3061# Instruction: gts 3062# 3063# Push 1 on the stack if the string at the under top is greater than 3064# the string at the top, in lexicographic order. Otherwise push 0. 3065# 3066# Stack: ( STR STR -- STR STR INT ) 3067 3068instruction gts () 3069 code 3070 pvm_val res = PVM_MAKE_INT (strcmp (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 3071 PVM_VAL_STR (JITTER_TOP_STACK ())) > 0, 32); 3072 JITTER_PUSH_STACK (res); 3073 end 3074end 3075 3076# Instruction: ges 3077# 3078# Push 1 on the stack if the string at the under top is greater or 3079# equal than the string at the top, in lexicographic order. Otherwise 3080# push 0. 3081# 3082# Stack: ( STR STR -- STR STR INT ) 3083 3084instruction ges () 3085 code 3086 pvm_val res = PVM_MAKE_INT (strcmp (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 3087 PVM_VAL_STR (JITTER_TOP_STACK ())) >= 0, 32); 3088 JITTER_PUSH_STACK (res); 3089 end 3090end 3091 3092# Instruction: les 3093# 3094# Push 1 on the stack if the string at the under top is less or equal 3095# than the string at the top, in lexicographic order. Otherwise push 3096# 0. 3097# 3098# Stack: ( STR STR -- STR STR INT ) 3099 3100instruction les () 3101 code 3102 pvm_val res = PVM_MAKE_INT (strcmp (PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()), 3103 PVM_VAL_STR (JITTER_TOP_STACK ())) <= 0, 32); 3104 JITTER_PUSH_STACK (res); 3105 end 3106end 3107 3108 3109## Concatenation instructions 3110 3111# Instruction: sconc 3112# 3113# Push the concatenation of the two strings at the top of the stack. 3114# 3115# Stack: ( STR STR -- STR STR STR ) 3116 3117instruction sconc () 3118 code 3119 pvm_val res; 3120 char *sa = PVM_VAL_STR (JITTER_UNDER_TOP_STACK ()); 3121 char *sb = PVM_VAL_STR (JITTER_TOP_STACK ()); 3122 char *s = pvm_alloc (strlen (sa) + strlen (sb) + 1); 3123 strcpy (s, sa); 3124 strcat (s, sb); 3125 res = pvm_make_string (s); 3126 3127 JITTER_PUSH_STACK (res); 3128#undef F 3129 end 3130end 3131 3132 3133## Logical instructions 3134 3135# Instruction: and 3136# 3137# Push the logical and of the two elements at the top of the stack. 3138# 3139# Stack: ( INT INT -- INT INT INT ) 3140 3141instruction and () 3142 code 3143 PVM_BOOL_BINOP (INT, &&); 3144 end 3145end 3146 3147# Instruction: or 3148# 3149# Push the logical or of the two elements at the top of the stack. 3150# 3151# Stack: ( INT INT -- INT INT INT ) 3152 3153instruction or () 3154 code 3155 PVM_BOOL_BINOP (INT, ||); 3156 end 3157end 3158 3159# Instruction: not 3160# 3161# Push the logical not of the element at the top of the stack. 3162# 3163# Stack: ( INT -- INT INT ) 3164 3165instruction not () 3166 code 3167 pvm_val res = PVM_MAKE_INT (! PVM_VAL_INT (JITTER_TOP_STACK ()), 32); 3168 JITTER_PUSH_STACK (res); 3169 end 3170end 3171 3172 3173## Bitwise instructions 3174 3175# Instruction: bxori 3176# 3177# Push the bitwise exclusive or of the two integers at the top of the 3178# stack. 3179# 3180# Stack: ( INT INT -- INT INT INT ) 3181 3182instruction bxori () 3183 code 3184 PVM_BINOP (INT, INT, INT, ^); 3185 end 3186end 3187 3188# Instruction: bxoriu 3189# 3190# Push the bitwise exclusive or of the two unsigned integers at the 3191# top of the stack. 3192# 3193# Stack: ( UINT UINT -- UINT UINT UINT ) 3194 3195instruction bxoriu () 3196 code 3197 PVM_BINOP (UINT, UINT, UINT, ^); 3198 end 3199end 3200 3201# Instruction: bxorl 3202# 3203# Push the bitwise exclusive or of the two longs at the top of the 3204# stack. 3205# 3206# Stack: ( LONG LONG -- LONG LONG LONG ) 3207 3208instruction bxorl () 3209 code 3210 PVM_BINOP (LONG, LONG, LONG, ^); 3211 end 3212end 3213 3214# Instruction: bxorlu 3215# 3216# Push the bitwise exclusive or of the two unsigned longs at the top 3217# of the stack. 3218# 3219# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 3220 3221instruction bxorlu () 3222 code 3223 PVM_BINOP (ULONG, ULONG, ULONG, ^); 3224 end 3225end 3226 3227# Instruction: bori 3228# 3229# Push the bitwise or of the two integers at the top of the stack. 3230# 3231# Stack: ( INT INT -- INT INT INT ) 3232 3233instruction bori () 3234 code 3235 PVM_BINOP (INT, INT, INT, |); 3236 end 3237end 3238 3239# Instruction: boriu 3240# 3241# Push the bitwise or of the two unsigned integers at the top of the 3242# stack. 3243# 3244# Stack: ( UINT UINT -- UINT UINT UINT ) 3245 3246instruction boriu () 3247 code 3248 PVM_BINOP (UINT, UINT, UINT, |); 3249 end 3250end 3251 3252# Instruction: borl 3253# 3254# Push the bitwise or of the two longs at the top of the stack. 3255# 3256# Stack: ( LONG LONG -- LONG LONG LONG ) 3257 3258instruction borl () 3259 code 3260 PVM_BINOP (LONG, LONG, LONG, |); 3261 end 3262end 3263 3264# Instruction: borlu 3265# 3266# Push the bitwise or of the two longs at the top of the stack. 3267# 3268# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 3269 3270instruction borlu () 3271 code 3272 PVM_BINOP (ULONG, ULONG, ULONG, |); 3273 end 3274end 3275 3276# Instruction: bandi 3277# 3278# Push the bitwise and of the two integers at the top of the stack. 3279# 3280# Stack: ( INT INT -- INT INT INT ) 3281 3282instruction bandi () 3283 code 3284 PVM_BINOP (INT, INT, INT, &); 3285 end 3286end 3287 3288# Instruction: bandiu 3289# 3290# Push the bitwise and of the two unsigned integers at the top of the 3291# stack. 3292# 3293# Stack: ( UINT UINT -- UINT UINT UINT ) 3294 3295instruction bandiu () 3296 code 3297 PVM_BINOP (UINT, UINT, UINT, &); 3298 end 3299end 3300 3301# Instruction: bandl 3302# 3303# Push the bitwise and of the two longs at the top of the stack. 3304# 3305# Stack: ( LONG LONG -- LONG LONG LONG ) 3306 3307instruction bandl () 3308 code 3309 PVM_BINOP (LONG, LONG, LONG, &); 3310 end 3311end 3312 3313# Instruction: bandlu 3314# 3315# Push the bitwise and of the two unsigned longs at the top of the 3316# stack. 3317# 3318# Stack: ( ULONG ULONG -- ULONG ULONG ULONG ) 3319 3320instruction bandlu () 3321 code 3322 PVM_BINOP (ULONG, ULONG, ULONG, &); 3323 end 3324end 3325 3326# Instruction: bnoti 3327# 3328# Push the bitwise not of the integer at the top of the stack. 3329# 3330# Stack: ( INT -- INT INT INT ) 3331 3332instruction bnoti () 3333 code 3334 PVM_UNOP (INT, INT, int, ~); 3335 end 3336end 3337 3338# Instruction: bnotiu 3339# 3340# Push the bitwise not of the unsigned integer at the top of the 3341# stack. 3342# 3343# Stack: ( UINT -- UINT UINT ) 3344 3345instruction bnotiu () 3346 code 3347 PVM_UNOP (UINT, UINT, uint, ~); 3348 end 3349end 3350 3351# Instruction: bnotl 3352# 3353# Push the bitwise not of the long at the top of the stack. 3354# 3355# Stack: ( LONG -- LONG LONG ) 3356 3357instruction bnotl () # ( LONG -- LONG LONG ) 3358 code 3359 PVM_UNOP (LONG, LONG, long, ~); 3360 end 3361end 3362 3363# Instruction: bnotlu 3364# 3365# Push the bitwise not of the unsigned long at the top of the stack. 3366# 3367# Stack: ( ULONG -- ULONG ULONG ) 3368 3369instruction bnotlu () 3370 code 3371 PVM_UNOP (ULONG, ULONG, ulong, ~); 3372 end 3373end 3374 3375 3376## Shift instructions 3377 3378# Instruction: bsli 3379# 3380# Left-shift the integer at the under top of the stack the number of 3381# bits indicated by the unsigned int at the top of the stack. 3382# 3383# If the bit count is equal or bigger than the size of the left 3384# operand, then raise PVM_E_OUT_OF_BOUNDS. 3385# 3386# Stack: ( INT UINT -- INT UINT INT ) 3387# Exceptions: PVM_E_OUT_OF_BOUNDS 3388 3389instruction bsli () # ( INT UINT -- INT UINT INT ) 3390 code 3391 PVM_BINOP_SL (INT, UINT, INT, <<); 3392 end 3393end 3394 3395# Instruction: bsliu 3396# 3397# Left-shift the unsigned integer at the under top of the stack the 3398# number of bits indicated by the unsigned int at the top of the 3399# stack. 3400# 3401# If the bit count is equal or bigger than the size of the left 3402# operand, then raise PVM_E_OUT_OF_BOUNDS. 3403# 3404# Stack: ( UINT UINT -- UINT UINT UINT ) 3405# Exceptions: PVM_E_OUT_OF_BOUNDS 3406 3407instruction bsliu () # ( UINT UINT -- UINT UINT UINT ) 3408 code 3409 PVM_BINOP_SL (UINT, UINT, UINT, <<); 3410 end 3411end 3412 3413# Instruction: bsll 3414# 3415# Left-shift the long at the under top of the stack the number of bits 3416# indicated by the unsigned int at the top of the stack. 3417# 3418# If the bit count is equal or bigger than the size of the left 3419# operand, then raise PVM_E_OUT_OF_BOUNDS. 3420# 3421# Stack: ( LONG UINT -- LONG UINT LONG ) 3422# Exceptions: PVM_E_OUT_OF_BOUNDS 3423 3424instruction bsll () # ( LONG UINT -- LONG UINT LONG ) 3425 code 3426 PVM_BINOP_SL (LONG, UINT, LONG, <<); 3427 end 3428end 3429 3430# Instruction: bslu 3431# 3432# Left-shift the unsigned long at the under top of the stack the 3433# number of bits indicated by the unsigned int at the top of the 3434# stack. 3435# 3436# If the bit count is equal or bigger than the size of the left 3437# operand, then raise PVM_E_OUT_OF_BOUNDS. 3438# 3439# Stack: ( ULONG UINT -- ULONG UINT ULONG ) 3440# Exceptions: PVM_E_OUT_OF_BOUNDS 3441 3442instruction bsllu () # ( ULONG UINT -- ULONG UINT ULONG ) 3443 code 3444 PVM_BINOP_SL (ULONG, UINT, ULONG, <<); 3445 end 3446end 3447 3448# Instruction: bsri 3449# 3450# Right-shift the integer at the under top of the stack the number of 3451# tis indicated by the unsigned int at the top of the stack. 3452# 3453# Stack: ( INT UINT -- INT UINT INT ) 3454 3455instruction bsri () 3456 code 3457 PVM_BINOP (INT, UINT, INT, >>); 3458 end 3459end 3460 3461# Instruction: bsriu 3462# 3463# Right-shift the unsigned integer at the under top of the stack the 3464# number of tis indicated by the unsigned int at the top of the stack. 3465# 3466# Stack: ( UINT UINT -- UINT UINT UINT ) 3467 3468instruction bsriu () 3469 code 3470 PVM_BINOP (UINT, UINT, UINT, >>); 3471 end 3472end 3473 3474# Instruction: bsrl 3475# 3476# Right-shift the long at the under top of the stack the number of tis 3477# indicated by the unsigned int at the top of the stack. 3478# 3479# Stack: ( LONG UINT -- LONG UINT LONG ) 3480 3481instruction bsrl () 3482 code 3483 PVM_BINOP (LONG, UINT, LONG, >>); 3484 end 3485end 3486 3487# Instruction: bsrlu 3488# 3489# Right-shift the unsigned long at the under top of the stack the 3490# number of tis indicated by the unsigned int at the top of the stack. 3491# 3492# Stack: ( ULONG UINT -- ULONG UINT ULONG ) 3493 3494instruction bsrlu () 3495 code 3496 PVM_BINOP (ULONG, UINT, ULONG, >>); 3497 end 3498end 3499 3500 3501## Compare-and-swap instructions 3502 3503# Instruction: swapgti 3504# 3505# Swap the two integers at the top of the stack if the element at the 3506# under-top is greater than the element at the top. 3507# 3508# Stack: ( INT INT -- INT INT ) 3509 3510instruction swapgti () 3511 code 3512 pvm_val a = JITTER_UNDER_TOP_STACK (); 3513 pvm_val b = JITTER_TOP_STACK (); 3514 if (PVM_VAL_INT (a) > PVM_VAL_INT (b)) 3515 { 3516 JITTER_UNDER_TOP_STACK () = b; 3517 JITTER_TOP_STACK () = a; 3518 } 3519 end 3520end 3521 3522# Instruction: swapgtiu 3523# 3524# Swap the two unsigned integers at the top of the stack if the 3525# element at the under-top is greater than the element at the top. 3526# 3527# Stack: ( UINT UINT -- UINT UINT ) 3528 3529instruction swapgtiu () 3530 code 3531 pvm_val a = JITTER_UNDER_TOP_STACK (); 3532 pvm_val b = JITTER_TOP_STACK (); 3533 if (PVM_VAL_UINT (a) > PVM_VAL_UINT (b)) 3534 { 3535 JITTER_UNDER_TOP_STACK () = b; 3536 JITTER_TOP_STACK () = a; 3537 } 3538 end 3539end 3540 3541# Instruction: swapgtl 3542# 3543# Swap the two longs at the top of the stack if the element at the 3544# under-top is greater than the element at the top. 3545# 3546# Stack: ( LONG LONG -- LONG LONG ) 3547 3548instruction swapgtl () 3549 code 3550 pvm_val a = JITTER_UNDER_TOP_STACK (); 3551 pvm_val b = JITTER_TOP_STACK (); 3552 if (PVM_VAL_LONG (a) > PVM_VAL_LONG (b)) 3553 { 3554 JITTER_UNDER_TOP_STACK () = b; 3555 JITTER_TOP_STACK () = a; 3556 } 3557 end 3558end 3559 3560# Instruction: swapgtlu 3561# 3562# Swap the two unsigned longs at the top of the stack if the element 3563# at the under-top is greater than the element at the top. 3564# 3565# Stack: ( ULONG ULONG -- ULONG ULONG ) 3566 3567instruction swapgtlu () 3568 code 3569 pvm_val a = JITTER_UNDER_TOP_STACK (); 3570 pvm_val b = JITTER_TOP_STACK (); 3571 if (PVM_VAL_ULONG (a) > PVM_VAL_ULONG (b)) 3572 { 3573 JITTER_UNDER_TOP_STACK () = b; 3574 JITTER_TOP_STACK () = a; 3575 } 3576 end 3577end 3578 3579 3580## Branch instructions 3581 3582# Instruction: ba LABEL 3583# 3584# Branch unconditionally to the given LABEL. 3585# 3586# Stack: ( -- ) 3587 3588instruction ba (?f) 3589 code 3590 JITTER_BRANCH_FAST(JITTER_ARGF0); 3591 end 3592end 3593 3594# Instruction: bn LABEL 3595# 3596# Branch to the given LABEL if the value at the top of the stack is 3597# PVM_NULL. 3598# 3599# Stack: ( VAL -- VAL ) 3600 3601instruction bn (?f) 3602 code 3603 pvm_val tmp = JITTER_TOP_STACK (); 3604 JITTER_BRANCH_FAST_IF_ZERO (tmp != PVM_NULL, JITTER_ARGF0); 3605 end 3606end 3607 3608# Instruction: bnn LABEL 3609# 3610# Branch to the given LABEL if the value at the top of the stack is 3611# not PVM_NULL. 3612# 3613# Stack: ( VAL -- VAL ) 3614 3615instruction bnn (?f) 3616 code 3617 pvm_val tmp = JITTER_TOP_STACK (); 3618 JITTER_BRANCH_FAST_IF_ZERO (tmp == PVM_NULL, JITTER_ARGF0); 3619 end 3620end 3621 3622# Instruction: bzi LABEL 3623# 3624# Branch to the given LABEL if the integer at the top of the stack is 3625# zero. 3626# 3627# Stack: ( INT -- INT ) 3628 3629instruction bzi (?f) 3630 code 3631 pvm_val tmp = JITTER_TOP_STACK (); 3632 JITTER_BRANCH_FAST_IF_ZERO (PVM_VAL_INT (tmp), JITTER_ARGF0); 3633 end 3634end 3635 3636# Instruction: bziu LABEL 3637# 3638# Branch to the given LABEL if the unsigned integer at the top of 3639# the stack is zero. 3640# 3641# Stack: ( UINT -- UINT ) 3642 3643instruction bziu (?f) 3644 code 3645 pvm_val tmp = JITTER_TOP_STACK (); 3646 JITTER_BRANCH_FAST_IF_ZERO (PVM_VAL_UINT (tmp), JITTER_ARGF0); 3647 end 3648end 3649 3650# Instruction: bzl LABEL 3651# 3652# Branch to the given LABEL if the long at the top of the stack 3653# is zero. 3654# 3655# Stack: ( LONG -- LONG ) 3656 3657instruction bzl (?f) 3658 code 3659 pvm_val tmp = JITTER_TOP_STACK (); 3660 JITTER_BRANCH_FAST_IF_ZERO (PVM_VAL_LONG (tmp), JITTER_ARGF0); 3661 end 3662end 3663 3664# Instruction: bzlu LABEL 3665# 3666# Branch to the given LABEL if the unsigned long at the top of the 3667# stack is zero. 3668# 3669# Stack: ( ULONG -- ULONG ) 3670 3671instruction bzlu (?f) 3672 code 3673 pvm_val tmp = JITTER_TOP_STACK (); 3674 JITTER_BRANCH_FAST_IF_ZERO (PVM_VAL_ULONG (tmp), JITTER_ARGF0); 3675 end 3676end 3677 3678# Instruction: bzni LABEL 3679# 3680# Branch to the given LABEL if the integer at the top of the stack 3681# is nonzero. 3682# 3683# Stack: ( INT -- INT ) 3684 3685instruction bnzi (?f) 3686 code 3687 pvm_val tmp = JITTER_TOP_STACK (); 3688 JITTER_BRANCH_FAST_IF_NONZERO (PVM_VAL_INT (tmp), JITTER_ARGF0); 3689 end 3690end 3691 3692# Instruction: bnziu LABEL 3693# 3694# Branch to the given LABEL if the unsigned integer at the top of the 3695# stack is nonzero. 3696# 3697# Stack: ( UINT -- UINT ) 3698 3699instruction bnziu (?f) 3700 code 3701 pvm_val tmp = JITTER_TOP_STACK (); 3702 JITTER_BRANCH_FAST_IF_NONZERO (PVM_VAL_UINT (tmp), JITTER_ARGF0); 3703 end 3704end 3705 3706# Instruction: bnzl LABEL 3707# 3708# Branch to the given LABEL if the long at the top of the stack is 3709# nonzero. 3710# 3711# Stack: ( LONG -- LONG ) 3712 3713instruction bnzl (?f) 3714 code 3715 pvm_val tmp = JITTER_TOP_STACK (); 3716 JITTER_BRANCH_FAST_IF_NONZERO (PVM_VAL_LONG (tmp), JITTER_ARGF0); 3717 end 3718end 3719 3720# Instruction: bnzlu LABEL 3721# 3722# Branch to the given LABEL if the unsigned long at the top of the 3723# stack is nonzero. 3724# 3725# Stack: ( ULONG -- ULONG ) 3726 3727instruction bnzlu (?f) 3728 code 3729 pvm_val tmp = JITTER_TOP_STACK (); 3730 JITTER_BRANCH_FAST_IF_NONZERO (PVM_VAL_ULONG (tmp), JITTER_ARGF0); 3731 end 3732end 3733 3734 3735## Conversion instructions 3736 3737# Instruction: ctos 3738# 3739# Convert the character encoded as an unsigned integer at the top of 3740# the stack to a string that contains just that character. 3741# 3742# Stack: ( UINT -- UINT STR ) 3743 3744instruction ctos () 3745 code 3746 uint8_t c = PVM_VAL_UINT (JITTER_TOP_STACK ()); 3747 char *str = pvm_alloc (2); 3748 str[0] = c; 3749 str[1] = '\0'; 3750 3751 JITTER_PUSH_STACK (pvm_make_string (str)); 3752 end 3753end 3754 3755# Instruction: itoi NBITS 3756# 3757# Convert the integer at the top of the stack to an integer 3758# featuring NBITS bits. 3759# 3760# NBITS can be any number from 1 to 32. 3761# 3762# Stack: ( INT -- INT INT ) 3763 3764instruction itoi (?n pvm_literal_printer_cast) 3765 code 3766 PVM_CONVOP (INT, int32_t, int, int32_t); 3767 end 3768end 3769 3770# Instruction: itoiu NBITS 3771# 3772# Convert the integer at the top of the stack to an unsigned integer 3773# featuring NBITS bits. 3774# 3775# NBITS can be any number from 1 to 32. 3776# 3777# Stack: ( INT -- INT UINT ) 3778 3779instruction itoiu (?n pvm_literal_printer_cast) 3780 code 3781 PVM_CONVOP (INT, int32_t, uint, uint32_t); 3782 end 3783end 3784 3785# Instruction: itol NBITS 3786# 3787# Convert the integer at the top of the stack to a long featuring 3788# NBITS bits. 3789# 3790# NBITS can be any number from 1 to 64. 3791# 3792# Stack: ( INT -- INT LONG ) 3793 3794instruction itol (?n pvm_literal_printer_cast) 3795 code 3796 PVM_CONVOP (INT, int32_t, long, int64_t); 3797 end 3798end 3799 3800# Instruction: itolu NBITS 3801# 3802# Convert the integer at the top of the stack to an unsigned long 3803# featuring NBITS bits. 3804# 3805# NBITS can be any number from 1 to 64. 3806# 3807# Stack: ( INT -- INT ULONG ) 3808 3809instruction itolu (?n pvm_literal_printer_cast) # ( INT -- INT ULONG ) 3810 code 3811 PVM_CONVOP (INT, int32_t, ulong, uint64_t); 3812 end 3813end 3814 3815# Instruction: iutoi NBITS 3816# 3817# Convert the unsigned integer at the top of the stack to an integer 3818# featuring NBITS bits. 3819# 3820# NBITS can be any number from 1 to 32. 3821# 3822# Stack: ( UINT -- UINT INT ) 3823 3824instruction iutoi (?n pvm_literal_printer_cast) # ( UINT -- UINT INT ) 3825 code 3826 PVM_CONVOP (UINT, uint32_t, int, int32_t); 3827 end 3828end 3829 3830# Instruction: iutoiu NBITS 3831# 3832# Convert the unsigned integer at the top of the stack to an unsigned 3833# integer featuring NBITS bits. 3834# 3835# NBITS can be any number from 1 to 32. 3836# 3837# Stack: ( UINT -- UINT UINT ) 3838 3839instruction iutoiu (?n pvm_literal_printer_cast) # ( UINT -- UINT UINT ) 3840 code 3841 PVM_CONVOP (UINT, uint32_t, uint, uint32_t); 3842 end 3843end 3844 3845# Instruction: iutol NBITS 3846# 3847# Convert the unsigned integer at the top of the stack to a long 3848# featuring NBITS bits. 3849# 3850# NBITS can be any number from 1 to 64. 3851# 3852# Stack: ( UINT -- UINT LONG ) 3853 3854instruction iutol (?n pvm_literal_printer_cast) 3855 code 3856 PVM_CONVOP (UINT, uint32_t, long, int64_t); 3857 end 3858end 3859 3860# Instruction: iutolu NBITS 3861# 3862# Convert the unsigned integer at the top of the stack to an 3863# unsigned long featuring NBITS bits. 3864# 3865# NBITS can be any number from 1 to 64. 3866# 3867# Stack: ( UINT -- UINT ULONG ) 3868 3869instruction iutolu (?n pvm_literal_printer_cast) 3870 code 3871 PVM_CONVOP (UINT, uint32_t, ulong, uint64_t); 3872 end 3873end 3874 3875# Instruction: ltoi NBITS 3876# 3877# Convert the long at the top of the stack to an integer 3878# featuring NBITS bits. 3879# 3880# NBITS can be any number from 1 to 32. 3881# 3882# Stack: ( LONG -- LONG INT ) 3883 3884instruction ltoi (?n pvm_literal_printer_cast) 3885 code 3886 PVM_CONVOP (LONG, int64_t, int, int32_t); 3887 end 3888end 3889 3890# Instruction: ltoiu NBITS 3891# 3892# Convert the long at the top of the stack to an unsigned 3893# integer featuring NBITS bits. 3894# 3895# NBITS can be any number from 1 to 32. 3896# 3897# Stack: ( LONG -- LONG UINT ) 3898 3899instruction ltoiu (?n pvm_literal_printer_cast) 3900 code 3901 PVM_CONVOP (LONG, int64_t, uint, uint32_t); 3902 end 3903end 3904 3905# Instruction: ltol NBITS 3906# 3907# Convert the long at the top of the stack to a long featuring 3908# NBITS bits. 3909# 3910# NBITS can be any number from 1 to 64. 3911# 3912# Stack: ( LONG -- LONG LONG ) 3913 3914instruction ltol (?n pvm_literal_printer_cast) 3915 code 3916 PVM_CONVOP (LONG, int64_t, long, int64_t); 3917 end 3918end 3919 3920# Instruction: ltolu NBITS 3921# 3922# Convert the long at the top of the stack to an unsigned long 3923# featuring NBITS bits. 3924# 3925# NBITS can be any number from 1 to 64. 3926# 3927# Stack: ( LONG -- LONG ULONG ) 3928 3929instruction ltolu (?n pvm_literal_printer_cast) 3930 code 3931 PVM_CONVOP (LONG, int64_t, ulong, uint64_t); 3932 end 3933end 3934 3935# Instruction: lutoi NBITS 3936# 3937# Convert the unsigned long at the top of the stack to an integer 3938# featuring NBITS bits. 3939# 3940# NBITS can be any number from 1 to 32. 3941# 3942# Stack: ( ULONG -- ULONG INT ) 3943 3944instruction lutoi (?n pvm_literal_printer_cast) 3945 code 3946 PVM_CONVOP (ULONG, uint64_t, int, int32_t); 3947 end 3948end 3949 3950# Instruction: lutoiu NBITS 3951# 3952# Convert the unsigned long at the top of the stack to an unsigned 3953# integer featuring NBITS bits. 3954# 3955# NBITS can be any number from 1 to 32. 3956# 3957# Stack: ( ULONG -- ULONG UINT ) 3958 3959instruction lutoiu (?n pvm_literal_printer_cast) 3960 code 3961 PVM_CONVOP (ULONG, uint64_t, uint, uint32_t); 3962 end 3963end 3964 3965# Instruction: lutol NBITS 3966# 3967# Convert the unsigned long at the top of the stack to a long 3968# featuring NBITS bits. 3969# 3970# Stack: ( ULONG -- ULONG LONG ) 3971 3972instruction lutol (?n pvm_literal_printer_cast) 3973 code 3974 PVM_CONVOP (ULONG, uint64_t, long, int64_t); 3975 end 3976end 3977 3978# Instruction: lutolu NBITS 3979# 3980# Convert the unsigned long at the top of the stack to an 3981# unsigned long featuring NBITS bits. 3982# 3983# Stack: ( ULONG -- ULONG ULONG ) 3984 3985instruction lutolu (?n pvm_literal_printer_cast) 3986 code 3987 PVM_CONVOP (ULONG, uint64_t, ulong, uint64_t); 3988 end 3989end 3990 3991 3992## String instructions 3993 3994# Instruction: strref 3995# 3996# Given a string and an unsigned long at the top of the stack, push an 3997# unsigned integer with the code of the character that occupies that 3998# position in the string, on the stack. 3999# 4000# The index is zero-based. If it is less than 0 or exceeds the 4001# length of the string, then PVM_E_OUT_OF_BOUNDS is raised. 4002# 4003# Stack: ( STR ULONG -- STR ULONG UINT ) 4004# Exceptions: PVM_E_OUT_OF_BOUNDS 4005 4006instruction strref () # ( STR ULONG -- STR ULONG VAL ) 4007 code 4008 pvm_val string = JITTER_UNDER_TOP_STACK (); 4009 pvm_val index = JITTER_TOP_STACK (); 4010 4011 if (PVM_VAL_ULONG (index) < 0 4012 || (PVM_VAL_ULONG (index) >= 4013 strlen (PVM_VAL_STR (string)))) 4014 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4015 4016 JITTER_PUSH_STACK (PVM_MAKE_UINT (PVM_VAL_STR (string)[PVM_VAL_ULONG (index)], 4017 8)); 4018 end 4019end 4020 4021# Instruction: substr 4022# 4023# Given a string and two indexes FROM AND to conforming a semi-open 4024# interval [FROM,TO), push the substring enclosed by that interval. 4025# 4026# Both indexes are zero-based. 4027# 4028# If FROM >= the size of the string, or if TO > the size of the 4029# string, or if FROM >= TO, raise the PVM_E_OUT_OF_BOUNDS exception. 4030# 4031# Stack: ( STR ULONG(from) ULONG(to) -- STR ULONG(from) ULONG(to) STR ) 4032# Exceptions: PVM_E_OUT_OF_BOUNDS 4033 4034instruction substr () # ( STR ULONG ULONG -- STR ULONG ULONG STR ) 4035 code 4036 pvm_val str; 4037 char *s; 4038 pvm_val to = JITTER_TOP_STACK (); 4039 pvm_val from = JITTER_UNDER_TOP_STACK (); 4040 size_t slen = PVM_VAL_ULONG (to) - PVM_VAL_ULONG (from); 4041 4042 JITTER_DROP_STACK (); 4043 str = JITTER_UNDER_TOP_STACK (); 4044 JITTER_PUSH_STACK (to); 4045 4046 if (PVM_VAL_ULONG (from) >= strlen (PVM_VAL_STR (str)) 4047 || PVM_VAL_ULONG (to) > strlen (PVM_VAL_STR (str)) 4048 || PVM_VAL_ULONG (from) > PVM_VAL_ULONG (to)) 4049 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4050 4051 s = pvm_alloc (slen + 1); 4052 strncpy (s, 4053 PVM_VAL_STR (str) + PVM_VAL_ULONG (from), 4054 slen); 4055 s[slen] = '\0'; 4056 4057 JITTER_PUSH_STACK (pvm_make_string (s)); 4058 end 4059end 4060 4061# Instruction: muls 4062# 4063# Given a string and an unsigned long on the stack, push a new 4064# string value whose value is the concatenation of the argument 4065# string applied to itself as many times as the unsigned long. If 4066# the second argument to muls is 0 then the result of the operation 4067# is the empty string. 4068# 4069# Stack: ( STR ULONG -- STR ULONG STR ) 4070 4071instruction muls () 4072 code 4073 pvm_val str = JITTER_UNDER_TOP_STACK (); 4074 size_t i, num = PVM_VAL_ULONG (JITTER_TOP_STACK ()); 4075 char *res = xmalloc (strlen (PVM_VAL_STR (str)) * num + 1); 4076 4077 *res = '\0'; 4078 for (i = 0; i < num; ++i) 4079 strcat (res, PVM_VAL_STR (str)); 4080 4081 JITTER_PUSH_STACK (pvm_make_string (res)); 4082 free (res); 4083 end 4084end 4085 4086 4087## Array instructions 4088 4089# Instruction: mka 4090# 4091# Make a new empty array value. 4092# 4093# TYP is the type of the new array. 4094# 4095# NELEM is a hint on how many elements to use to initialize the array 4096# value. This is to avoid allocating memory that will never be used. 4097# Use 0UL when the number of elements in the array are not known 4098# in advance; this will make the PVM to choose a reasonable default. 4099# 4100# Stack: ( TYP ULONG(nelem) -- ARR ) 4101 4102instruction mka () 4103 code 4104 pvm_val arr = pvm_make_array (JITTER_TOP_STACK (), 4105 JITTER_UNDER_TOP_STACK ()); 4106 4107 PVM_VAL_ARR_OFFSET (arr) = PVM_MAKE_ULONG (0, 64); 4108 JITTER_DROP_STACK (); 4109 JITTER_DROP_STACK (); 4110 JITTER_PUSH_STACK (arr); 4111 end 4112end 4113 4114# Instruction: ains 4115# 4116# Insert a new element VAL, with bit-offset BOFF, at the end of 4117# the array ARR, making it grow. 4118# 4119# If IDX is less than the current size of the array, the value is 4120# stored in the referred argument. 4121# 4122# If IDX is equal or bigger than the current size of the array, the 4123# same element is replicated in the previous elements. 4124# 4125# Examples: 4126# 4127# a = [a1, a2, a3] 4128# 4129# [a1, a2, a3] BOFF 2 VAL ains -> INVAL exception 4130# [a1, a2, a3] BOFF 3 VAL ains -> [a1, a2, a3, VAL] 4131# [a1, a2, a3] BOFF 5 VAL ains -> [a1, a2, a3, VAL, VAL, VAL] 4132# 4133# Stack: ( ARR IDX VAL -- ARR ) 4134# Exceptions: PVM_E_INVAL 4135 4136instruction ains () 4137 code 4138 pvm_val val = JITTER_TOP_STACK (); 4139 pvm_val idx = JITTER_UNDER_TOP_STACK (); 4140 pvm_val arr; 4141 4142 JITTER_DROP_STACK (); 4143 JITTER_DROP_STACK (); 4144 arr = JITTER_TOP_STACK (); 4145 4146 if (PVM_VAL_ULONG (idx) < PVM_VAL_ULONG (PVM_VAL_ARR_NELEM (arr))) 4147 /* Note that pvm_array_set can't return 0 here due 4148 to the index check. */ 4149 pvm_array_set (arr, idx, val); 4150 else 4151 { 4152 if (!pvm_array_insert (arr, idx, val)) 4153 PVM_RAISE_DFL (PVM_E_INVAL); 4154 } 4155 end 4156end 4157 4158# Instruction: arem 4159# 4160# Remove an element from an array at the specified index, making it 4161# schrink. 4162# 4163# If IDX doesn't correspond to an element in the array, raise 4164# PVM_E_OUT_OF_BOUNDS. This always happens if the array is empty. 4165# 4166# Stack: ( ARR IDX -- ARR ) 4167# Exception: PVM_E_OUT_OF_BOUNDS 4168 4169instruction arem () 4170 code 4171 pvm_val arr = JITTER_UNDER_TOP_STACK (); 4172 pvm_val idx = JITTER_TOP_STACK (); 4173 4174 if (PVM_VAL_ULONG (idx) >= PVM_VAL_ULONG (PVM_VAL_ARR_NELEM (arr))) 4175 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4176 4177 /* This call can't fail (return 0) due to the index check above. */ 4178 (void) pvm_array_rem (arr, idx); 4179 JITTER_DROP_STACK (); 4180 end 4181end 4182 4183# Instruction: aset 4184# 4185# Set the value with index ULONG in the array ARR to have the value 4186# VAL. 4187# 4188# If the specified index exceeds the capability of the array, then 4189# PVM_E_OUT_OF_BOUNDS is raised. If the array is bounded by size and 4190# the new value makes the total size of the array to change, then 4191# PVM_E_CONV is raised. 4192# 4193# Stack: ( ARR ULONG VAL -- ARR ) 4194# Exceptions: PVM_E_CONV, PVM_E_OUT_OF_BOUNDS 4195 4196instruction aset () 4197 code 4198 pvm_val idx; 4199 pvm_val val; 4200 pvm_val arr; 4201 pvm_val array_type, bound; 4202 size_t index; 4203 4204 val= JITTER_TOP_STACK (); 4205 idx = JITTER_UNDER_TOP_STACK (); 4206 index = PVM_VAL_ULONG (idx); 4207 JITTER_DROP_STACK (); 4208 JITTER_DROP_STACK (); 4209 4210 arr = JITTER_TOP_STACK (); 4211 4212 if (index >= PVM_VAL_INTEGRAL (PVM_VAL_ARR_NELEM (arr))) 4213 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4214 4215 /* If the array is bounded by size, check whether the new value 4216 results in a different size. */ 4217 array_type = PVM_VAL_ARR_TYPE (arr); 4218 bound = PVM_VAL_TYP_A_BOUND (array_type); 4219 4220 if (PVM_IS_OFF (bound)) 4221 { 4222 pvm_val oval = PVM_VAL_ARR_ELEM_VALUE (arr, index); 4223 uint64_t old_size_bits; 4224 uint64_t new_size_bits; 4225 4226 PVM_VAL_ARR_ELEM_VALUE (arr, index) = val; 4227 4228 old_size_bits = (PVM_VAL_INTEGRAL (PVM_VAL_OFF_MAGNITUDE (bound)) 4229 * PVM_VAL_INTEGRAL (PVM_VAL_OFF_UNIT (bound))); 4230 new_size_bits = pvm_sizeof (arr); 4231 4232 if (new_size_bits != old_size_bits) 4233 { 4234 PVM_VAL_ARR_ELEM_VALUE (arr, index) = oval; 4235 PVM_RAISE_DFL (PVM_E_CONV); 4236 } 4237 } 4238 else 4239 { 4240 /* Note that pvm_aray_set cannot fail here, due to the check 4241 on index above. This is done like this in order to avoid 4242 checking the bound by size if the index is out of bounds. */ 4243 pvm_array_set (arr, idx, val); 4244 } 4245 end 4246end 4247 4248# Instruction: aref 4249# 4250# Given an array ARR and an index ULONG, push the element of the array 4251# occupying that position on the stack. 4252# 4253# If the provided index is out of bounds, then raise 4254# PVM_E_OUT_OF_BOUNDS. 4255# 4256# Stack: ( ARR ULONG -- ARR ULONG VAL ) 4257# Exceptions: PVM_E_OUT_OF_BOUNDS 4258 4259instruction aref () 4260 code 4261 pvm_val array = JITTER_UNDER_TOP_STACK (); 4262 pvm_val index = JITTER_TOP_STACK (); 4263 4264 if ((PVM_VAL_ULONG (index) >= 4265 PVM_VAL_INTEGRAL (PVM_VAL_ARR_NELEM (array)))) 4266 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4267 4268 JITTER_PUSH_STACK (PVM_VAL_ARR_ELEM_VALUE (array, 4269 PVM_VAL_ULONG (index))); 4270 end 4271end 4272 4273# Instruction: arefo 4274# 4275# Given an array ARR and an index ULONG, push the offset of the 4276# element occupying that position in the array. 4277# 4278# If the provided index is out of bounds, then raise 4279# PVM_E_OUT_OF_BOUNDS. 4280# 4281# Stack: ( ARR ULONG -- ARR ULONG OFF ) 4282# Exceptions: PVM_E_OUT_OF_BOUNDS 4283 4284instruction arefo () 4285 code 4286 pvm_val array = JITTER_UNDER_TOP_STACK (); 4287 pvm_val index = JITTER_TOP_STACK (); 4288 4289 if (PVM_VAL_ULONG (index) < 0 4290 || (PVM_VAL_ULONG (index) >= 4291 PVM_VAL_INTEGRAL (PVM_VAL_ARR_NELEM (array)))) 4292 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4293 4294 JITTER_PUSH_STACK (PVM_VAL_ARR_ELEM_OFFSET (array, 4295 PVM_VAL_ULONG (index))); 4296 end 4297end 4298 4299# Instruction: asettb 4300# 4301# Given an array ARR and a closure BOUND, set the later as the array's 4302# bounder function. This is a function that, once executed with no 4303# arguments, returns the size of the array. 4304# 4305# Stack: ( ARR BOUND -- ARR ) 4306 4307instruction asettb () # ( ARR BOUND -- ARR ) 4308 code 4309 pvm_val type = PVM_VAL_ARR_TYPE (JITTER_UNDER_TOP_STACK ()); 4310 4311 PVM_VAL_TYP_A_BOUND (type) = JITTER_TOP_STACK (); 4312 JITTER_DROP_STACK (); 4313 end 4314end 4315 4316 4317## Struct instructions 4318 4319# Instruction: mksct 4320# 4321# Given an offset, a list of fields, a list of methods and a struct 4322# type, create a struct value and push it on the stack. 4323# 4324# Each field is specified as a triplet [OFF STR VAL] where OFF is the 4325# offset of field, STR the name of the field or PVM_NULL if the field 4326# is anonymous, and VAL is a value. 4327# 4328# Each method is specified as a tuple [STR VAL] where STR is the name 4329# of the method and VAL is the closure value corresponding to the 4330# method. 4331# 4332# Stack: ( OFF [OFF STR VAL]... [STR VAL]... ULONG ULONG TYP -- SCT ) 4333 4334instruction mksct () 4335 code 4336 size_t e; 4337 pvm_val nfields, nmethods, sct, type; 4338 4339 type = JITTER_TOP_STACK (); 4340 JITTER_DROP_STACK (); 4341 4342 nfields = JITTER_TOP_STACK (); 4343 JITTER_DROP_STACK (); 4344 4345 nmethods = JITTER_TOP_STACK (); 4346 JITTER_DROP_STACK (); 4347 4348 sct = pvm_make_struct (nfields, nmethods, type); 4349 4350 for (e = 0; e < PVM_VAL_ULONG (nmethods); ++e) 4351 { 4352 PVM_VAL_SCT_METHOD_VALUE (sct, PVM_VAL_ULONG (nmethods) - e - 1) 4353 = JITTER_TOP_STACK (); 4354 PVM_VAL_SCT_METHOD_NAME (sct, PVM_VAL_ULONG (nmethods) - e - 1) 4355 = JITTER_UNDER_TOP_STACK (); 4356 4357 JITTER_DROP_STACK (); 4358 JITTER_DROP_STACK (); 4359 } 4360 4361 for (e = 0; e < PVM_VAL_ULONG (nfields); ++e) 4362 { 4363 PVM_VAL_SCT_FIELD_VALUE (sct, PVM_VAL_ULONG (nfields) - e - 1) 4364 = JITTER_TOP_STACK (); 4365 PVM_VAL_SCT_FIELD_NAME (sct, PVM_VAL_ULONG (nfields) - e - 1) 4366 = JITTER_UNDER_TOP_STACK (); 4367 4368 JITTER_DROP_STACK (); 4369 JITTER_DROP_STACK (); 4370 4371 PVM_VAL_SCT_FIELD_OFFSET (sct, PVM_VAL_ULONG (nfields) - e -1) 4372 = JITTER_TOP_STACK (); 4373 JITTER_DROP_STACK (); 4374 } 4375 4376 PVM_VAL_SCT_OFFSET (sct) = JITTER_TOP_STACK(); 4377 JITTER_DROP_STACK (); 4378 4379 JITTER_PUSH_STACK (sct); 4380 end 4381end 4382 4383# Instruction: sset 4384# 4385# Given a struct, a field name and a value, replace the value of 4386# the referred struct field with the given value. If the struct 4387# does not have a field with the given name, then raise PVM_E_ELEM. 4388# 4389# Stack: ( SCT STR VAL -- SCT ) 4390 4391instruction sset () 4392 code 4393 pvm_val val = JITTER_TOP_STACK (); 4394 pvm_val name = JITTER_UNDER_TOP_STACK (); 4395 pvm_val sct; 4396 4397 JITTER_DROP_STACK (); 4398 JITTER_DROP_STACK (); 4399 4400 sct = JITTER_TOP_STACK (); 4401 if (!pvm_set_struct (sct, name, val)) 4402 PVM_RAISE_DFL (PVM_E_ELEM); 4403 end 4404end 4405 4406# Instruction: sref 4407# 4408# Given a struct and a field name, push the value contained in the 4409# referred struct field on the stack. If the struct does not have a 4410# field with the given name, or if the field is absent from the struct 4411# value then raise PVM_E_ELEM. 4412# 4413# Stack: ( SCT STR -- SCT STR VAL ) 4414# Exceptions: PVM_E_ELEM 4415 4416instruction sref () 4417 code 4418 pvm_val val = pvm_ref_struct (JITTER_UNDER_TOP_STACK (), 4419 JITTER_TOP_STACK ()); 4420 4421 if (val == PVM_NULL) 4422 PVM_RAISE_DFL (PVM_E_ELEM); 4423 JITTER_PUSH_STACK (val); 4424 end 4425end 4426 4427# Instruction: srefo 4428# 4429# Given a struct and a field name, push the bit-offset of the referred 4430# field on the stack. If the struct does not have a field with the given 4431# name, or if the field is absent from the struct value then raise 4432# PVM_E_ELEM. 4433# 4434# Stack: ( SCT STR -- SCT STR BOFF ) 4435# Exceptions: PVM_E_ELEM 4436 4437instruction srefo () 4438 code 4439 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4440 pvm_val fname = JITTER_TOP_STACK (); 4441 pvm_val boff = pvm_refo_struct (sct, fname); 4442 4443 if (boff == PVM_NULL) 4444 PVM_RAISE_DFL (PVM_E_ELEM); 4445 JITTER_PUSH_STACK (boff); 4446 end 4447end 4448 4449# Instruction: srefmnt 4450# 4451# Given a struct and a method name, push the closure value corresponding 4452# to that method on the stack. If the struct does not have a method with 4453# the given name then push PVM_NULL. 4454# 4455# Stack: ( SCT STR - SCT STR CLS ) 4456 4457instruction srefmnt () 4458 code 4459 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4460 pvm_val name = JITTER_TOP_STACK (); 4461 pvm_val cls = pvm_get_struct_method (sct, PVM_VAL_STR (name)); 4462 4463 JITTER_PUSH_STACK (cls); 4464 end 4465end 4466 4467# Instruction: srefnt 4468# 4469# Given a struct and a field name, push the value contained in the 4470# struct field on the stack. If the struct does not have a field with 4471# the given name, or if the field is absent from the struct value then 4472# push PVM_NULL. 4473# 4474# Stack: ( SCT STR -- SCT STR VAL ) 4475 4476instruction srefnt () 4477 code 4478 pvm_val val = pvm_ref_struct (JITTER_UNDER_TOP_STACK (), 4479 JITTER_TOP_STACK ()); 4480 4481 JITTER_PUSH_STACK (val); 4482 end 4483end 4484 4485# Instruction: srefi 4486# 4487# Given a struct and an index, push the value of the field occupying 4488# the position specified by the index in the given struct. If the 4489# struct doesn't have that many fields, raise PVM_E_OUT_OF_BOUNDS. 4490# 4491# Stack: ( SCT ULONG -- SCT ULONG VAL ) 4492# Exceptions: PVM_E_OUT_OF_BOUNDS 4493 4494instruction srefi () 4495 code 4496 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4497 pvm_val index = JITTER_TOP_STACK (); 4498 4499 if (PVM_VAL_ULONG (index) < 0 4500 || (PVM_VAL_ULONG (index) >= 4501 PVM_VAL_INTEGRAL (PVM_VAL_SCT_NFIELDS (sct)))) 4502 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4503 4504 JITTER_PUSH_STACK (PVM_VAL_SCT_FIELD_VALUE (sct, 4505 PVM_VAL_ULONG (index))); 4506 end 4507end 4508 4509# Instruction: srefia 4510# 4511# Given a struct and an index, push 1 if the field occupying the 4512# position specified by the index in the given struct is absent. Push 4513# 0 otherwise. If the struct doesn't have that many fields, raise 4514# PVM_E_OUT_OF_BOUNDS. 4515# 4516# Stack: ( SCT ULONG -- SCT ULONG INT ) 4517# Exceptions: PVM_E_OUT_OF_BOUNDS 4518 4519instruction srefia () 4520 code 4521 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4522 pvm_val index = JITTER_TOP_STACK (); 4523 int absent_p; 4524 4525 if (PVM_VAL_ULONG (index) < 0 4526 || (PVM_VAL_ULONG (index) >= 4527 PVM_VAL_INTEGRAL (PVM_VAL_SCT_NFIELDS (sct)))) 4528 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4529 4530 absent_p = PVM_VAL_SCT_FIELD_ABSENT_P (sct, PVM_VAL_ULONG (index)); 4531 JITTER_PUSH_STACK (PVM_MAKE_INT (absent_p, 32)); 4532 end 4533end 4534 4535# Instruction: srefio 4536# 4537# Given a struct and an index, push the offset of the field occupying 4538# the position specified by the index in the given struct. If the 4539# struct doesn't have that many fields, raise PVM_E_OUT_OF_BOUNDS. 4540# 4541# Stack: ( SCT ULONG -- SCT ULONG BOFF ) 4542# Exceptions: PVM_E_OUT_OF_BOUNDS 4543 4544instruction srefio () 4545 code 4546 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4547 pvm_val index = JITTER_TOP_STACK (); 4548 4549 if (PVM_VAL_ULONG (index) < 0 4550 || (PVM_VAL_ULONG (index) >= 4551 PVM_VAL_INTEGRAL (PVM_VAL_SCT_NFIELDS (sct)))) 4552 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4553 4554 JITTER_PUSH_STACK (PVM_VAL_SCT_FIELD_OFFSET (sct, 4555 PVM_VAL_ULONG (index))); 4556 end 4557end 4558 4559# Instruction: smodi 4560# 4561# Given a struct and an index, push the modified flags of the field 4562# occupying the position specified by the index in the given struct. 4563# If the struct doesn't have that many fields, raise 4564# PVM_E_OUT_OF_BOUNDS. 4565# 4566# Stack: ( SCT ULONG -- SCT ULONG BOOL ) 4567# Exceptions: PVM_E_OUT_OF_BOUNDS 4568 4569instruction smodi () 4570 code 4571 pvm_val sct = JITTER_UNDER_TOP_STACK (); 4572 pvm_val index = JITTER_TOP_STACK (); 4573 4574 if (PVM_VAL_ULONG (index) < 0 4575 || (PVM_VAL_ULONG (index) >= 4576 PVM_VAL_INTEGRAL (PVM_VAL_SCT_NFIELDS (sct)))) 4577 PVM_RAISE_DFL (PVM_E_OUT_OF_BOUNDS); 4578 4579 JITTER_PUSH_STACK (PVM_VAL_SCT_FIELD_MODIFIED (sct, 4580 PVM_VAL_ULONG (index))); 4581 end 4582end 4583 4584 4585## Offset Instructions 4586 4587# Instruction: mko 4588# 4589# Given an integral magnitude VAL and an unit expressed in an ULONG, 4590# make an offset value and push it on the stack. 4591# 4592# Stack: ( VAL ULONG -- OFF ) 4593 4594instruction mko () 4595 code 4596 pvm_val res = pvm_make_offset (JITTER_UNDER_TOP_STACK (), 4597 JITTER_TOP_STACK ()); 4598 JITTER_DROP_STACK (); 4599 JITTER_TOP_STACK () = res; 4600 end 4601end 4602 4603# Instruction: ogetm 4604# 4605# Given an offset OFF, push its magnitude on the stack. 4606# 4607# Stack: ( OFF -- OFF VAL ) 4608 4609instruction ogetm () 4610 code 4611 JITTER_PUSH_STACK (PVM_VAL_OFF_MAGNITUDE (JITTER_TOP_STACK ())); 4612 end 4613end 4614 4615# Instruction: osetm 4616# 4617# Given an offset OFF and an integral value VAL, make it the 4618# offset's magnitude. 4619# 4620# Stack: ( OFF VAL -- OFF ) 4621 4622instruction osetm () 4623 code 4624 PVM_VAL_OFF_MAGNITUDE (JITTER_UNDER_TOP_STACK ()) 4625 = JITTER_TOP_STACK (); 4626 JITTER_DROP_STACK (); 4627 end 4628end 4629 4630# Instruction: ogetu 4631# 4632# Given an offset OFF, push its unit on the stack. 4633# 4634# Stack: ( OFF -- OFF ULONG ) 4635 4636instruction ogetu () 4637 code 4638 JITTER_PUSH_STACK (PVM_VAL_OFF_UNIT (JITTER_TOP_STACK ())); 4639 end 4640end 4641 4642# Instruction: ogetbt 4643# 4644# Given an offset OFF, push its base type on the stack. 4645# 4646# Stack: ( OFF -- OFF TYP ) 4647 4648instruction ogetbt () 4649 code 4650 JITTER_PUSH_STACK (PVM_VAL_OFF_BASE_TYPE (JITTER_TOP_STACK ())); 4651 end 4652end 4653 4654 4655## Instructions to handle mapped values 4656 4657# Instruction: mm 4658# 4659# Given a value, push 1 on the stack if the value is mapped. 4660# Push 0 otherwise. 4661# 4662# Stack: ( VAL -- VAL INT ) 4663 4664instruction mm () 4665 code 4666 pvm_val mapped_p = PVM_MAKE_INT (PVM_VAL_MAPPED_P (JITTER_TOP_STACK ()), 4667 32); 4668 JITTER_PUSH_STACK (mapped_p); 4669 end 4670end 4671 4672# Instruction: map 4673# 4674# Given a value, mark it as as mapped. If the value can't be 4675# mapped then PVM_E_INVAL is raised. 4676# 4677# Stack: ( VAL -- VAL ) 4678# Exceptions: PVM_E_INVAL 4679 4680instruction map () 4681 code 4682 pvm_val val = JITTER_TOP_STACK (); 4683 4684 if (!(PVM_IS_ARR (val) || PVM_IS_SCT (val))) 4685 PVM_RAISE_DFL (PVM_E_INVAL); 4686 4687 PVM_VAL_SET_MAPPED_P (JITTER_TOP_STACK (), 1); 4688 end 4689end 4690 4691# Instruction: unmap 4692# 4693# Given a value, mark it as as not mapped. If the value can't be 4694# mapped then this is a no-operation. 4695# 4696# Stack: ( VAL -- VAL ) 4697 4698instruction unmap () 4699 code 4700 pvm_val_unmap (JITTER_TOP_STACK ()); 4701 end 4702end 4703 4704# Instruction: reloc 4705# 4706# Given a value, a IO space expressed in an ulong, and a bit-offset 4707# expressed in an ulong, relocate the value to the given bit-offset at 4708# the given IO space. 4709# 4710# If the given value is not map-able then raise PVM_E_INVAL. 4711# 4712# Stack: ( VAL ULONG ULONG -- VAL ULONG ULONG ) 4713# Exceptions: PVM_E_INVAL 4714 4715instruction reloc () 4716 code 4717 pvm_val boffset = JITTER_TOP_STACK (); 4718 pvm_val ios = JITTER_UNDER_TOP_STACK (); 4719 pvm_val val; 4720 4721 JITTER_DROP_STACK (); 4722 val = JITTER_UNDER_TOP_STACK (); 4723 JITTER_PUSH_STACK (boffset); 4724 4725 if (!(PVM_IS_ARR (val) || PVM_IS_SCT (val))) 4726 PVM_RAISE_DFL (PVM_E_INVAL); 4727 4728 pvm_val_reloc (val, ios, boffset); 4729 end 4730end 4731 4732# Instruction: ureloc 4733# 4734# Given a value, undo the last reloc performed on the value. 4735# 4736# If the given value is not map-able then raise PVM_E_INVAL. 4737# 4738# Stack: ( VAL -- VAL ) 4739# Exceptions: PVM_E_INVAL 4740 4741instruction ureloc () 4742 code 4743 pvm_val val = JITTER_TOP_STACK (); 4744 4745 if (!(PVM_IS_ARR (val) || PVM_IS_SCT (val))) 4746 PVM_RAISE_DFL (PVM_E_INVAL); 4747 4748 pvm_val_ureloc (val); 4749 end 4750end 4751 4752# Instruction: mgets 4753# 4754# Given a value, push a boolean indicating whether the 4755# value is strict. If the given value is not map-able then push 4756# false, i.e. 0. 4757# 4758# Stack: ( VAL -- VAL INT ) 4759 4760instruction mgets () 4761 code 4762 int strict_p = PVM_VAL_STRICT_P (JITTER_TOP_STACK ()); 4763 JITTER_PUSH_STACK (PVM_MAKE_INT (strict_p, 32)); 4764 end 4765end 4766 4767# Instruction: msets 4768# 4769# Given a value and a boolean, set the strictness of the value 4770# to the given boolean. If the value is not map-able this is 4771# a no-operation. 4772# 4773# Stack: ( VAL INT -- VAL ) 4774 4775instruction msets () 4776 code 4777 int strict_p = PVM_VAL_INT (JITTER_TOP_STACK ()); 4778 4779 PVM_VAL_SET_STRICT_P (JITTER_UNDER_TOP_STACK (), strict_p); 4780 JITTER_DROP_STACK (); 4781 end 4782end 4783 4784# Instruction: mgeto 4785# 4786# Given a map-able value, push its bit-offset on the stack as an 4787# unsigned long. If the given value is not map-able then push 4788# PVM_NULL. 4789# 4790# Stack: ( VAL -- VAL ULONG ) 4791 4792instruction mgeto () 4793 code 4794 JITTER_PUSH_STACK (PVM_VAL_OFFSET (JITTER_TOP_STACK ())); 4795 end 4796end 4797 4798# Instruction: mseto 4799# 4800# Given a map-able value an a bit-offset, set its offset to the value. 4801# If the given value is not map-able, then the offset is ignored. 4802# 4803# Stack: ( VAL ULONG -- VAL ) 4804 4805instruction mseto () 4806 code 4807 PVM_VAL_SET_OFFSET (JITTER_UNDER_TOP_STACK (), 4808 JITTER_TOP_STACK ()); 4809 JITTER_DROP_STACK (); 4810 end 4811end 4812 4813# Instruction: mgetios 4814# 4815# Given a map-able value, push its associated IO space on the stack. 4816# If the given value is not map-able, then push PVM_NULL. 4817# 4818# Stack: ( VAL -- VAL INT ) 4819 4820instruction mgetios () 4821 code 4822 JITTER_PUSH_STACK (PVM_VAL_IOS (JITTER_TOP_STACK ())); 4823 end 4824end 4825 4826# Instruction: msetios 4827# 4828# Given a map-able value and an IOS descriptor, set it as its 4829# associated IO space. If the IOS descriptor is PVM_NULL then it uses 4830# the current IO space. If the given value is not map-able then the 4831# IO space is ignored. 4832# 4833# Stack: ( VAL INT -- VAL ) 4834 4835instruction msetios () 4836 code 4837 PVM_VAL_SET_IOS (JITTER_UNDER_TOP_STACK (), 4838 JITTER_TOP_STACK ()); 4839 JITTER_DROP_STACK (); 4840 end 4841end 4842 4843# Instruction: mgetm 4844# 4845# Given a map-able value, push its mapper closure on the stack. If 4846# the given value is not map-able, then push PVM_NULL. 4847# 4848# Stack: ( VAL -- VAL CLS ) 4849 4850instruction mgetm () 4851 code 4852 JITTER_PUSH_STACK (PVM_VAL_MAPPER (JITTER_TOP_STACK ())); 4853 end 4854end 4855 4856# Instruction: msetm 4857# 4858# Given a map-able value and a closure, set it as its mapper. If the 4859# given value is not map-able then the closure is ignored. 4860# 4861# Stack: ( VAL CLS -- VAL ) 4862 4863instruction msetm () 4864 code 4865 PVM_VAL_SET_MAPPER (JITTER_UNDER_TOP_STACK (), JITTER_TOP_STACK ()); 4866 JITTER_DROP_STACK (); 4867 end 4868end 4869 4870# Instruction: mgetw 4871# 4872# Given a map-able value, push its writer closure on the stack. If 4873# the given value is not map-able, then push PVM_NULL. 4874# 4875# Stack: ( VAL -- VAL CLS ) 4876 4877instruction mgetw () 4878 code 4879 JITTER_PUSH_STACK (PVM_VAL_WRITER (JITTER_TOP_STACK ())); 4880 end 4881end 4882 4883# Instruction: msetw 4884# 4885# Given a map-able value and a closure, set it as its writer. If the 4886# given value is not map-able then the closure is ignored. 4887# 4888# Stack: ( VAL CLS -- VAL ) 4889 4890instruction msetw () 4891 code 4892 PVM_VAL_SET_WRITER (JITTER_UNDER_TOP_STACK (), JITTER_TOP_STACK ()); 4893 JITTER_DROP_STACK (); 4894 end 4895end 4896 4897# Instruction: mgetsel 4898# 4899# Given a map-able value in the TOS, push the number of elements to 4900# which its mapping is bounded to. If the value is not mapped, or 4901# if it is not bounded by number of elements, push PVM_NULL. 4902# 4903# Note that only array values can have mappings bounded by number of 4904# elements. 4905# 4906# Stack: ( VAL -- VAL ULONG ) 4907 4908instruction mgetsel () 4909 code 4910 JITTER_PUSH_STACK (PVM_VAL_ELEMS_BOUND (JITTER_TOP_STACK ())); 4911 end 4912end 4913 4914# Instruction: msetsel 4915# 4916# Given a map-able value and an unsigned long, set it as the mapping 4917# bound by number of elements. If the value is not map-able the 4918# unsigned long is ignored. 4919# 4920# Note that only array values can have mappings bounded by number of 4921# elements. 4922# 4923# Stack: ( VAL ULONG -- VAL ) 4924 4925instruction msetsel () 4926 code 4927 PVM_VAL_SET_ELEMS_BOUND (JITTER_UNDER_TOP_STACK (), JITTER_TOP_STACK ()); 4928 JITTER_DROP_STACK (); 4929 end 4930end 4931 4932# Instruction: mgetsiz 4933# 4934# Given a map-able value in the TOS, push its mapping size-bound as a 4935# bit-offset. If the value is not map-able, or if it is not bounded 4936# by size, push PVM_NULL. 4937# 4938# Note that only array values can have mappings bounded by size. 4939# 4940# Stack: ( VAL -- VAL ULONG ) 4941 4942instruction mgetsiz () 4943 code 4944 JITTER_PUSH_STACK (PVM_VAL_SIZE_BOUND (JITTER_TOP_STACK ())); 4945 end 4946end 4947 4948# Instruction: msetsiz 4949# 4950# Given a map-able value and a bit-offset, set it as the mapping 4951# size-bound. If the value is not map-able, the bit-offset is 4952# ignored. 4953# 4954# Note that only array values can have mappings bounded by size. 4955# 4956# Stack: ( VAL ULONG -- VAL ) 4957 4958instruction msetsiz () 4959 code 4960 PVM_VAL_SET_SIZE_BOUND (JITTER_UNDER_TOP_STACK (), JITTER_TOP_STACK ()); 4961 JITTER_DROP_STACK (); 4962 end 4963end 4964 4965 4966## Type related instructions 4967 4968# Instruction: isa 4969# 4970# Given a value and a type, push 1 on the stack if the value is of the 4971# given type. Push 0 otherwise. 4972# 4973# Stack: ( VAL TYPE -- TYPE VAL INT ) 4974 4975instruction isa () 4976 code 4977 pvm_val type = JITTER_TOP_STACK (); 4978 pvm_val val = JITTER_UNDER_TOP_STACK (); 4979 pvm_val val_type = pvm_typeof (val); 4980 4981 JITTER_PUSH_STACK (PVM_MAKE_INT (pvm_type_equal_p (type, val_type), 4982 32)); 4983 end 4984end 4985 4986# Instruction: typof 4987# 4988# Given a value, push its type on the stack. 4989# 4990# Stack: ( VAL -- VAL TYPE ) 4991 4992instruction typof () 4993 code 4994 JITTER_PUSH_STACK (pvm_typeof (JITTER_TOP_STACK ())); 4995 end 4996end 4997 4998# Instruction: tyisc 4999# 5000# Given a value, push 1 on the stack if it is a closure. Push 0 5001# otherwise. 5002# 5003# Stack: ( VAL -- VAL INT ) 5004 5005instruction tyisc () 5006 code 5007 JITTER_PUSH_STACK (PVM_MAKE_INT (PVM_IS_CLS (JITTER_TOP_STACK ()), 32)); 5008 end 5009end 5010 5011# Instruction: tyissct 5012# 5013# Given a value, push 1 on the stack if it is a struct. Push 0 5014# otherwise. 5015# 5016# Stack: ( VAL -- VAL INT ) 5017 5018instruction tyissct () 5019 code 5020 JITTER_PUSH_STACK (PVM_MAKE_INT (PVM_IS_SCT (JITTER_TOP_STACK ()), 32)); 5021 end 5022end 5023 5024# Instruction: mktyv 5025# 5026# Build a "void" type and push it on the stack. 5027# 5028# Stack: ( -- TYPE ) 5029 5030instruction mktyv () 5031 code 5032 JITTER_PUSH_STACK (pvm_make_void_type ()); 5033 end 5034end 5035 5036# Instruction: mktyany 5037# 5038# Build an "any" type and push it on the stack. 5039# 5040# Stack: ( -- TYPE ) 5041 5042instruction mktyany () 5043 code 5044 JITTER_PUSH_STACK (pvm_make_any_type ()); 5045 end 5046end 5047 5048# Instruction: mktyi 5049# 5050# Given an unsigned long denoting a bit width, and an unsigned int 5051# denoting signedness (0 is unsigned, 1 is signed), build a an 5052# integral type with these features and push it on the stack. 5053# 5054# Stack: ( ULONG UINT -- TYPE ) 5055 5056instruction mktyi () 5057 code 5058 pvm_val size = JITTER_UNDER_TOP_STACK (); 5059 pvm_val signed_p = JITTER_TOP_STACK (); 5060 JITTER_DROP_STACK (); 5061 5062 JITTER_TOP_STACK () = pvm_make_integral_type (size, signed_p); 5063 end 5064end 5065 5066# Instruction: mktys 5067# 5068# Push a string type on the stack. 5069# 5070# Stack: ( -- TYPE ) 5071 5072instruction mktys () 5073 code 5074 JITTER_PUSH_STACK (pvm_make_string_type ()); 5075 end 5076end 5077 5078# Instruction: mktyo 5079# 5080# Given a base integral type and an integer denoting an offset unit 5081# (multiple of the base unit) construct an offset type having these 5082# features, and push it on the stack. 5083# 5084# Stack: ( TYPE INT -- TYPE ) 5085 5086instruction mktyo () 5087 code 5088#define F(res, a, b) \ 5089 { res = pvm_make_offset_type (a, b); } 5090 JITTER_BINARY_STACK(F); 5091#undef F 5092 end 5093end 5094 5095# Instruction: mktya 5096# 5097# Given an elements type and an unsigned long denoting a length, build 5098# an array type having these features and push it on the stack. If 5099# the type array is unbounded then length is PVM_NULL. 5100# 5101# Stack: ( TYPE (ULONG|NULL) -- TYPE ) 5102 5103instruction mktya () 5104 code 5105 pvm_val bound = JITTER_TOP_STACK (); 5106 pvm_val etype = JITTER_UNDER_TOP_STACK (); 5107 5108 JITTER_DROP_STACK (); 5109 JITTER_TOP_STACK () = pvm_make_array_type (etype, bound); 5110 end 5111end 5112 5113# Instruction: tyagett 5114# 5115# Given an array type, push the type of its elements on the stack. 5116# 5117# Stack: ( TYPE -- TYPE TYPE ) 5118 5119instruction tyagett () 5120 code 5121 JITTER_PUSH_STACK (PVM_VAL_TYP_A_ETYPE (JITTER_TOP_STACK ())); 5122 end 5123end 5124 5125# Instruction: tyagetb 5126# 5127# Given an array type, push its bound on the stack. 5128# 5129# Stack: ( TYPE -- TYPE (ULONG|NULL) ) 5130 5131instruction tyagetb () 5132 code 5133 JITTER_PUSH_STACK (PVM_VAL_TYP_A_BOUND (JITTER_TOP_STACK ())); 5134 end 5135end 5136 5137# Instruction: mktyc 5138# 5139# Given a list of argument types, a return type and a number of 5140# arguments, build a closure type and push it on the stack. 5141# 5142# Stack: ( TYPE... TYPE ULONG -- TYPE ) 5143 5144instruction mktyc () 5145 code 5146 size_t i; 5147 pvm_val nargs, rtype, *atypes; 5148 5149 nargs = JITTER_TOP_STACK (); 5150 JITTER_DROP_STACK (); 5151 5152 rtype = JITTER_TOP_STACK (); 5153 JITTER_DROP_STACK (); 5154 5155 pvm_allocate_closure_attrs (nargs, &atypes); 5156 5157 for (i = 0; i < PVM_VAL_ULONG (nargs); ++i) 5158 { 5159 atypes[i] = JITTER_TOP_STACK (); 5160 JITTER_DROP_STACK (); 5161 } 5162 5163 JITTER_PUSH_STACK (pvm_make_closure_type (rtype, 5164 nargs, atypes)); 5165 end 5166end 5167 5168# Instruction: mktysct 5169# 5170# Given a list of field descriptors, a number of fields and a struct 5171# type name, build a struct type and push it on the stack. 5172# 5173# Each field descriptor has the form [STRING TYPE] and contains the 5174# name of the field and its type. 5175# 5176# Stack: ( [STRING TYPE]... ULONG STR -- TYPE ) 5177 5178instruction mktysct () 5179 code 5180 size_t i; 5181 pvm_val nelem, name, *etypes, *enames; 5182 5183 name = JITTER_TOP_STACK (); 5184 JITTER_DROP_STACK (); 5185 5186 nelem = JITTER_TOP_STACK (); 5187 JITTER_DROP_STACK (); 5188 5189 pvm_allocate_struct_attrs (nelem, &etypes, &enames); 5190 5191 for (i = 0; i < PVM_VAL_ULONG (nelem); ++i) 5192 { 5193 enames[PVM_VAL_ULONG (nelem) - i - 1] = JITTER_UNDER_TOP_STACK (); 5194 etypes[PVM_VAL_ULONG (nelem) - i - 1] = JITTER_TOP_STACK (); 5195 5196 JITTER_DROP_STACK (); 5197 JITTER_DROP_STACK (); 5198 } 5199 5200 JITTER_PUSH_STACK (pvm_make_struct_type (nelem, name, 5201 enames, etypes)); 5202 end 5203end 5204 5205# Instruction: tysctn 5206# 5207# Given a struct type, push its name to the stack. If the struct 5208# type is not named push PVM_NULL. 5209# 5210# Stack: ( SCT -- SCT STR ) 5211 5212instruction tysctn () 5213 code 5214 pvm_val type = JITTER_TOP_STACK (); 5215 pvm_val type_name = PVM_VAL_TYP_S_NAME (type); 5216 5217 JITTER_PUSH_STACK (type_name); 5218 end 5219end 5220 5221 5222## IO instructions 5223 5224# Instruction: write 5225# 5226# If the value at the TOS is mapped, then write it to its associated 5227# IO space. Otherwise, this is a no-op. 5228# 5229# Stack: ( VAL -- VAL ) 5230# Exceptions: PVM_E_IOS_FULL, PVM_E_CONSTRAINT_ERROR 5231 5232instruction write () 5233 caller 5234 code 5235 pvm_val val = JITTER_TOP_STACK (); 5236 pvm_val writer = pvm_val_writer (val); 5237 5238 if (writer != PVM_NULL) 5239 { 5240 JITTER_DUP_STACK (); /* VAL VAL */ 5241 JITTER_PUSH_STACK (PVM_VAL_OFFSET (val)); /* VAL VAL OFF */ 5242 PVM_CALL (writer); 5243 } 5244 end 5245end 5246 5247# Instruction: peeki NENC,ENDIAN,BITS 5248# 5249# Given an IOS descriptor and a bit-offset, peek an integer value of 5250# width BITS bits. The negative encoding and endianness to be used 5251# are specified in the instruction arguments. 5252# 5253# Stack: ( INT ULONG -- INT ) 5254 5255instruction peeki (?n nenc_printer,?n endian_printer,?n bits_printer) 5256 code 5257 PVM_PEEK (int, int, JITTER_ARGN0, JITTER_ARGN1, JITTER_ARGN2, 5258 PVM_IOS_ARGS_INT); 5259 end 5260end 5261 5262# Instruction: peekiu ENDIAN,BITS 5263# 5264# Given an IOS descriptor and a bit-offset, peek an unsigned integer 5265# value of width BITS bits. The endianness to be used is specified in 5266# the instruction arguments. 5267# 5268# Stack: ( INT ULONG -- INT ) 5269 5270instruction peekiu (?n endian_printer,?n bits_printer) 5271 code 5272 PVM_PEEK (uint, uint, 0 /* unused */, JITTER_ARGN0, JITTER_ARGN1, 5273 PVM_IOS_ARGS_UINT); 5274 end 5275end 5276 5277# Instruction: peekl NENC,ENDIAN,BITS 5278# 5279# Given an IOS descriptor and a bit-offset, peek a long value of width 5280# BITS bits. The negative encoding and endianness to be used are 5281# specified in the instruction arguments. 5282# 5283# Stack: ( INT ULONG -- LONG ) 5284 5285instruction peekl (?n nenc_printer,?n endian_printer,?n bits_printer) 5286 code 5287 PVM_PEEK (long, int, JITTER_ARGN0, JITTER_ARGN1, JITTER_ARGN2, 5288 PVM_IOS_ARGS_INT); 5289 end 5290end 5291 5292# Instruction: peeklu ENDIAN,BITS 5293# 5294# Given an IOS descriptor and a bit-offset, peek an unsigned long value 5295# of width BITS bits. The endianness to be used is specified in the 5296# instruction arguments. 5297# 5298# Stack: ( INT ULONG -- ULONG ) 5299 5300instruction peeklu (?n endian_printer,?n bits_printer) 5301 code 5302 PVM_PEEK (ulong, uint, 0 /* unused */, JITTER_ARGN0, JITTER_ARGN1, 5303 PVM_IOS_ARGS_UINT); 5304 end 5305end 5306 5307# Instruction: peekdi BITS 5308# 5309# Given an IOS descriptor and a bit-offset, peek an integer value of 5310# width BITS bits. Use the default endianness and negative encoding. 5311# 5312# Stack: ( INT ULONG -- INT ) 5313 5314instruction peekdi (?n bits_printer) 5315 code 5316 PVM_PEEK (int, int, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5317 JITTER_ARGN0, PVM_IOS_ARGS_INT); 5318 end 5319end 5320 5321# Instruction: peekdiu BITS 5322# 5323# Given an IOS descriptor and a bit-offset, peek an unsigned integer 5324# value of width BITS bits. Use the default endianness. 5325# 5326# Stack: ( INT ULONG -- UINT ) 5327 5328instruction peekdiu (?n bits_printer) 5329 code 5330 PVM_PEEK (uint, uint, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5331 JITTER_ARGN0, PVM_IOS_ARGS_UINT); 5332 end 5333end 5334 5335# Instruction: peekdl BITS 5336# 5337# Given an IOS descriptor and a bit-offset, peek a long value of width 5338# BITS bits. Use the default endianness and negative encoding. 5339# 5340# Stack: ( INT ULONG -- LONG ) 5341 5342instruction peekdl (?n bits_printer) 5343 code 5344 PVM_PEEK (long, int, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5345 JITTER_ARGN0, PVM_IOS_ARGS_INT); 5346 end 5347end 5348 5349# Instruction: peekdlu BITS 5350# 5351# Given an IOS descriptor and a bit-offset, peek an unsigned long value 5352# of width BITS bits. Use the default endianness. 5353# 5354# Stack: ( INT ULONG -- ULONG ) 5355 5356instruction peekdlu (?n bits_printer) 5357 code 5358 PVM_PEEK (ulong, uint, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5359 JITTER_ARGN0, PVM_IOS_ARGS_UINT); 5360 end 5361end 5362 5363# Instruction: pokei NENC,ENDIAN,BITS 5364# 5365# Given an IOS descriptor, a bit-offset and an integer value of BITS 5366# bits, poke it. Use the negative encoding and endianness specified 5367# in the instruction arguments. 5368# 5369# Stack: ( INT ULONG INT -- ) 5370 5371instruction pokei (?n nenc_printer,?n endian_printer,?n bits_printer) 5372 code 5373 PVM_POKE (INT, int, JITTER_ARGN0, JITTER_ARGN1, JITTER_ARGN2, 5374 PVM_IOS_ARGS_WRITE_INT); 5375 end 5376end 5377 5378# Instruction: pokeiu ENDIAN,BITS 5379# 5380# Given an IOS descriptor, a bit-offset and an unsigned integer value 5381# of BITS bits, poke it. Use the endianness specified in the 5382# instruction arguments. 5383# 5384# Stack: ( INT ULONG INT -- ) 5385 5386instruction pokeiu (?n endian_printer,?n bits_printer) 5387 code 5388 PVM_POKE (UINT, uint, 0 /* unused */, JITTER_ARGN0, JITTER_ARGN1, 5389 PVM_IOS_ARGS_WRITE_UINT); 5390 end 5391end 5392 5393# Instruction: pokel NENC,ENDIAN,BITS 5394# 5395# Given an IOS descriptor, a bit-offset and a long value of BITS bits, 5396# poke it. Use the negative encoding and endianness specified in the 5397# instruction arguments. 5398# 5399# Stack: ( INT ULONG LONG -- ) 5400 5401instruction pokel (?n nenc_printer,?n endian_printer,?n bits_printer) 5402 code 5403 PVM_POKE (LONG, int, JITTER_ARGN0, JITTER_ARGN1, JITTER_ARGN2, 5404 PVM_IOS_ARGS_WRITE_INT); 5405 end 5406end 5407 5408# Instruction: pokelu ENDIAN,BITS 5409# 5410# Given an IOS descriptor, a bit-offset and an unsigned long value of 5411# BITS bits, poke it. Use the endianness specified in the instruction 5412# arguments. 5413# 5414# Stack: ( INT ULONG ULONG -- ) 5415 5416instruction pokelu (?n endian_printer,?n bits_printer) 5417 code 5418 PVM_POKE (ULONG, uint, 0 /* unused */, JITTER_ARGN0, JITTER_ARGN1, 5419 PVM_IOS_ARGS_WRITE_UINT); 5420 end 5421end 5422 5423# Instruction: pokedi BITS 5424# 5425# Given an IOS descriptor, a bit-offset and an integer of BITS bits, 5426# poke it. Use the default negative encoding and endianness. 5427# 5428# Stack: ( INT ULONG INT -- ) 5429 5430instruction pokedi (?n bits_printer) 5431 code 5432 PVM_POKE (INT, int, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5433 JITTER_ARGN0, PVM_IOS_ARGS_WRITE_INT); 5434 end 5435end 5436 5437# Instruction: pokediu BITS 5438# 5439# Given an IOS descriptor, a bit-offset and an unsigned integer of BITS 5440# bits, poke it. Use the default endianness. 5441# 5442# Stack: ( INT ULONG UINT -- ) 5443 5444instruction pokediu (?n bits_printer) 5445 code 5446 PVM_POKE (UINT, uint, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5447 JITTER_ARGN0, PVM_IOS_ARGS_WRITE_UINT); 5448 end 5449end 5450 5451# Instruction: pokedl BITS 5452# 5453# Given an IOS descriptor, a bit-offset and a long of BITS bits, poke 5454# it. Use the default negative encoding and endianness. 5455# 5456# Stack: ( INT ULONG LONG -- ) 5457 5458instruction pokedl (?n bits_printer) 5459 code 5460 PVM_POKE (LONG, int, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5461 JITTER_ARGN0, PVM_IOS_ARGS_WRITE_INT); 5462 end 5463end 5464 5465# Instruction: pokedlu BITS 5466# 5467# Given an IOS descriptor, a bit-offset and an unsigned long of BITS 5468# bits, poke it. Use the default endianness. 5469# 5470# Stack: ( INT ULONG ULONG -- ) 5471 5472instruction pokedlu (?n bits_printer) 5473 code 5474 PVM_POKE (ULONG, uint, jitter_state_runtime.nenc, jitter_state_runtime.endian, 5475 JITTER_ARGN0, PVM_IOS_ARGS_WRITE_UINT); 5476 end 5477end 5478 5479# Instruction: peeks 5480# 5481# Given an IOS descriptor and a bit-offset, peek a string. 5482# 5483# Stack: ( INT ULONG -- STR ) 5484 5485instruction peeks () 5486 code 5487 ios io; 5488 ios_off offset; 5489 char *ios_str; 5490 int ret; 5491 5492 offset = PVM_VAL_ULONG (JITTER_TOP_STACK ()); 5493 io = ios_search_by_id (PVM_VAL_INT (JITTER_UNDER_TOP_STACK ())); 5494 5495 if (io == NULL) 5496 PVM_RAISE_DFL (PVM_E_NO_IOS); 5497 5498 JITTER_DROP_STACK (); 5499 if ((ret = ios_read_string (io, offset, 0 /* flags */, &ios_str)) != IOS_OK) 5500 { 5501 if (ret == IOS_EIOFF) 5502 PVM_RAISE_DFL (PVM_E_EOF); 5503 else if (ret == IOS_ENOMEM) 5504 PVM_RAISE (PVM_E_IO, "out of memory", PVM_E_IO_ESTATUS); 5505 else 5506 PVM_RAISE_DFL (PVM_E_IO); 5507 JITTER_TOP_STACK () = PVM_NULL; 5508 } 5509 else 5510 JITTER_TOP_STACK () = pvm_make_string (ios_str); 5511 end 5512end 5513 5514# Instruction: pokes 5515# 5516# Given an IOS descriptor, a bit-offset and a string, poke it. 5517# 5518# Stack: ( INT ULONG STR -- ) 5519 5520instruction pokes () 5521 code 5522 ios io; 5523 ios_off offset; 5524 char *str; 5525 int ret; 5526 5527 str = PVM_VAL_STR (JITTER_TOP_STACK ()); 5528 offset = PVM_VAL_ULONG (JITTER_UNDER_TOP_STACK ()); 5529 JITTER_DROP_STACK(); 5530 JITTER_DROP_STACK(); 5531 5532 io = ios_search_by_id (PVM_VAL_INT (JITTER_TOP_STACK ())); 5533 5534 if (io == NULL) 5535 PVM_RAISE_DFL (PVM_E_NO_IOS); 5536 5537 JITTER_DROP_STACK (); 5538 if ((ret = ios_write_string (io, offset, 0 /* flags */, str)) != IOS_OK) 5539 { 5540 if (ret == IOS_EIOFF) 5541 PVM_RAISE_DFL (PVM_E_EOF); 5542 else 5543 PVM_RAISE_DFL (PVM_E_IO); 5544 } 5545 end 5546end 5547 5548 5549## Exceptions handling instructions 5550 5551# Instruction: pushe LABEL 5552# 5553# Given an exception, push a handler for it on the exceptions stack. 5554# 5555# Stack: ( EXCEPTION -- ) 5556# Exceptions Stack: ( -- EXCEPTION_HANDLER ) 5557 5558instruction pushe (?l) 5559 code 5560 struct pvm_exception_handler ehandler; 5561 pvm_val exception = JITTER_TOP_STACK (); 5562 pvm_val exception_code = pvm_ref_struct_cstr (exception, "code"); 5563 5564 ehandler.exception = PVM_VAL_INT (exception_code); 5565 JITTER_DROP_STACK (); 5566 ehandler.main_stack_height = JITTER_HEIGHT_STACK (); 5567 ehandler.return_stack_height = JITTER_HEIGHT_RETURNSTACK (); 5568 ehandler.code = JITTER_ARGP0; 5569 ehandler.env = jitter_state_runtime.env; 5570 5571 JITTER_PUSH_EXCEPTIONSTACK (ehandler); 5572 end 5573end 5574 5575# Instruction: pope 5576# 5577# Pop an exception handler from the exceptions stack. 5578# 5579# Stack: ( -- ) 5580# Exceptions Stack: ( EXCEPTION_HANDLER -- ) 5581 5582instruction pope () 5583 code 5584 JITTER_DROP_EXCEPTIONSTACK (); 5585 end 5586end 5587 5588# Instruction: raise 5589# 5590# Raise the given exception. 5591# 5592# Stack: ( EXCEPTION -- ) 5593# Exceptions Stack: ( -- ) 5594 5595instruction raise () 5596 code 5597 pvm_val exception = JITTER_TOP_STACK (); 5598 JITTER_DROP_STACK (); 5599 PVM_RAISE_DIRECT (exception); 5600 end 5601end 5602 5603 5604## Debugging Instructions 5605 5606# Instruction: strace DEPTH 5607# 5608# Print a debugging trace with the elements of the top of the stack. 5609# The number of elements to print is specified in DEPTH. A depth of 5610# zero means to print the whole stack. 5611# 5612# Stack: ( -- ) 5613 5614instruction strace (?n) 5615 code 5616 pvm_val tmp[1024]; 5617 int i = 0, j; 5618 int num_elems = (int) JITTER_ARGN0; 5619 5620 while (((num_elems == 0 || i < num_elems) 5621 && (JITTER_HEIGHT_STACK () != 5622 JITTER_STATE_BACKING_FIELD (canary)))) 5623 { 5624 assert (i < 1024); 5625 pvm_print_val_with_params (JITTER_STATE_BACKING_FIELD (vm), 5626 JITTER_TOP_STACK (), 5627 0 /* depth */, 5628 PVM_PRINT_FLAT, 5629 16 /* base */, 5630 2 /* indent */, 5631 0 /* acutoff */, 5632 PVM_PRINT_F_MAPS); 5633 pk_puts ("\n"); 5634 tmp[i++] = JITTER_TOP_STACK (); 5635 JITTER_DROP_STACK (); 5636 } 5637 5638 /* Restore the stack. */ 5639 for (j = (i - 1); j >= 0; j--) 5640 JITTER_PUSH_STACK (tmp[j]); 5641 end 5642end 5643 5644# Instruction: disas 5645# 5646# Print out the disassembling of the program executed by the 5647# closure in the top of the stack. 5648# 5649# Stack: ( CLS -- CLS ) 5650 5651instruction disas () 5652 code 5653 pvm_val cls = JITTER_TOP_STACK (); 5654 pvm_disassemble_program (PVM_VAL_CLS_PROGRAM (cls)); 5655 end 5656end 5657 5658# Instruction: note VALUE 5659# 5660# This instruction is intended to be used to insert annotations that 5661# help to understand disassemblies. Most of the times VALUE is a 5662# string. 5663# 5664# Semantically, this instruction does nothing. 5665# 5666# Stack: ( -- ) 5667 5668instruction note (?n pvm_literal_printer) 5669 code 5670 end 5671end 5672 5673 5674## System Interaction Instructions 5675 5676# Instruction: getenv 5677# 5678# This instruction gets the name of an environment variable on the 5679# stack and pushes the value of the corresponding environment 5680# variable. If no variable with the given name is defined on the 5681# environment, then push PVM_NULL. 5682# 5683# Stack: ( STR -- STR STR ) 5684 5685instruction getenv () 5686 code 5687 const char *varname = PVM_VAL_STR (JITTER_TOP_STACK ()); 5688 char *value = secure_getenv (varname); 5689 5690 if (value == NULL) 5691 JITTER_PUSH_STACK (PVM_NULL); 5692 else 5693 JITTER_PUSH_STACK (pvm_make_string (value)); 5694 end 5695end 5696 5697 5698## Miscellaneous Instructions 5699 5700# Instruction: nop 5701# 5702# Do nothing. 5703# 5704# Stack: ( -- ) 5705 5706instruction nop () 5707 code 5708 end 5709end 5710 5711# Instruction: rand 5712# 5713# Push a pseudo-random integer to the stack. 5714# 5715# If the argument is 0U then it is ignored. Otherwise it is 5716# used to set the seed for a new sequence of pseudo-random numbers. 5717# 5718# Stack: ( UINT -- INT ) 5719 5720instruction rand () 5721 code 5722 unsigned int seed = PVM_VAL_UINT (JITTER_TOP_STACK ()); 5723 5724 if (seed != 0) 5725 srandom (seed); 5726 JITTER_DROP_STACK (); 5727 JITTER_PUSH_STACK (PVM_MAKE_INT (random (), 32)); 5728 end 5729end 5730 5731# Instruction: time 5732# 5733# Push the current system time to the stack in the form of 5734# an array of two long elements containing the number of seconds 5735# and nanoseconds since the epoch. 5736# 5737# Stack: ( -- ARR ) 5738 5739instruction time () 5740 code 5741 struct timespec ts; 5742 pvm_val arr = pvm_make_array (PVM_MAKE_ULONG (2, 64), 5743 pvm_make_integral_type (64, 1)); 5744 5745 gettime (&ts); 5746 (void) pvm_array_insert (arr, PVM_MAKE_LONG (0, 64), 5747 PVM_MAKE_LONG (ts.tv_sec, 64)); 5748 (void) pvm_array_insert (arr, PVM_MAKE_LONG (1, 64), 5749 PVM_MAKE_LONG (ts.tv_nsec, 64)); 5750 5751 JITTER_PUSH_STACK (arr); 5752 end 5753end 5754 5755# Instruction: siz 5756# 5757# Given a value, push its size as a bit-offset. 5758# 5759# Stack: ( VAL -- VAL ULONG ) 5760 5761instruction siz () 5762 code 5763 uint64_t size = pvm_sizeof (JITTER_TOP_STACK ()); 5764 JITTER_PUSH_STACK (PVM_MAKE_ULONG (size, 64)); 5765 end 5766end 5767 5768# Instruction: sel 5769# 5770# Given a value, push its length as an unsigned long. 5771# 5772# The length of an array is the number of values contained in it. 5773# The lenght of a struct is the number of fields contained in it. 5774# The lenght of a string is the number of characters contained in it. 5775# The length of any other value is 1. 5776# 5777# Stack: ( VAL -- VAL ULONG ) 5778 5779instruction sel () 5780 code 5781 JITTER_PUSH_STACK (pvm_elemsof (JITTER_TOP_STACK ())); 5782 end 5783end 5784 5785### End of instructions 5786 5787 5788## Peephole optimizations 5789 5790rule swap-drop-to-nip rewrite 5791 swap; drop 5792into 5793 nip 5794end 5795 5796rule rot-rot-to-nrot rewrite 5797 rot; rot 5798into 5799 nrot 5800end 5801 5802rule nip-nip-to-nip2 rewrite 5803 nip; nip 5804into 5805 nip2 5806end 5807 5808rule nip2-nip-to-nip3 rewrite 5809 nip2; nip 5810into 5811 nip3 5812end 5813 5814rule drop-drop-to-drop2 rewrite 5815 drop; drop 5816into 5817 drop2 5818end 5819 5820rule drop2-drop-to-drop3 rewrite 5821 drop2; drop 5822into 5823 drop3 5824end 5825 5826rule drop3-drop-to-drop4 rewrite 5827 drop3; drop 5828into 5829 drop4 5830end 5831 5832rule swap-over-to-tuck rewrite 5833 swap; over 5834into 5835 tuck 5836end 5837 5838rule rot-swap-to-quake rewrite 5839 rot; swap 5840into 5841 quake 5842end 5843