basis/stack-checker/known-words/known-words.factor

   1 ! Copyright (C) 2004, 2010 Slava Pestov, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: fry accessors alien alien.accessors arrays byte-arrays
   4 classes continuations.private effects generic hashtables
   5 hashtables.private io io.backend io.files io.files.private
   6 io.streams.c kernel kernel.private math math.private
   7 math.parser.private memory memory.private namespaces
   8 namespaces.private parser quotations quotations.private sbufs
   9 sbufs.private sequences sequences.private slots.private strings
  10 strings.private system threads.private classes.tuple
  11 classes.tuple.private vectors vectors.private words
  12 words.private definitions assocs summary compiler.units
  13 system.private combinators combinators.short-circuit locals
  14 locals.backend locals.types combinators.private
  15 stack-checker.values generic.single generic.single.private
  16 alien.libraries tools.dispatch.private tools.profiler.private
  17 stack-checker.alien
  18 stack-checker.state
  19 stack-checker.errors
  20 stack-checker.visitor
  21 stack-checker.backend
  22 stack-checker.branches
  23 stack-checker.transforms
  24 stack-checker.dependencies
  25 stack-checker.recursive-state
  26 stack-checker.row-polymorphism ;
  27 IN: stack-checker.known-words
  28
  29 : infer-primitive ( word -- )
  30     dup
  31     [ "input-classes" word-prop ]
  32     [ "default-output-classes" word-prop ] bi <effect>
  33     apply-word/effect ;
  34
  35 {
  36     { drop  (( x     --             )) }
  37     { 2drop (( x y   --             )) }
  38     { 3drop (( x y z --             )) }
  39     { dup   (( x     -- x x         )) }
  40     { 2dup  (( x y   -- x y x y     )) }
  41     { 3dup  (( x y z -- x y z x y z )) }
  42     { rot   (( x y z -- y z x       )) }
  43     { -rot  (( x y z -- z x y       )) }
  44     { dupd  (( x y   -- x x y       )) }
  45     { swapd (( x y z -- y x z       )) }
  46     { nip   (( x y   -- y           )) }
  47     { 2nip  (( x y z -- z           )) }
  48     { over  (( x y   -- x y x       )) }
  49     { pick  (( x y z -- x y z x     )) }
  50     { swap  (( x y   -- y x         )) }
  51 } [ "shuffle" set-word-prop ] assoc-each
  52
  53 : infer-shuffle ( shuffle -- )
  54     [ in>> length consume-d ] keep ! inputs shuffle
  55     [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
  56     [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
  57     #shuffle, ;
  58
  59 : infer-shuffle-word ( word -- )
  60     "shuffle" word-prop infer-shuffle ;
  61
  62 : check-declaration ( declaration -- declaration )
  63     dup { [ array? ] [ [ class? ] all? ] } 1&&
  64     [ bad-declaration-error ] unless ;
  65
  66 : infer-declare ( -- )
  67     pop-literal nip check-declaration
  68     [ length ensure-d ] keep zip
  69     #declare, ;
  70
  71 \ declare [ infer-declare ] "special" set-word-prop
  72
  73 GENERIC: infer-call* ( value known -- )
  74
  75 : (infer-call) ( value -- ) dup known infer-call* ;
  76
  77 : infer-call ( -- ) pop-d (infer-call) ;
  78
  79 \ call [ infer-call ] "special" set-word-prop
  80
  81 \ (call) [ infer-call ] "special" set-word-prop
  82
  83 M: literal infer-call*
  84     [ 1array #drop, ] [ infer-literal-quot ] bi* ;
  85
  86 M: curried infer-call*
  87     swap push-d
  88     [ uncurry ] infer-quot-here
  89     [ quot>> known pop-d [ set-known ] keep ]
  90     [ obj>> known pop-d [ set-known ] keep ] bi
  91     push-d (infer-call) ;
  92
  93 M: composed infer-call*
  94     swap push-d
  95     [ uncompose ] infer-quot-here
  96     [ quot2>> known pop-d [ set-known ] keep ]
  97     [ quot1>> known pop-d [ set-known ] keep ] bi
  98     push-d push-d
  99     1 infer->r infer-call
 100     terminated? get [ 1 infer-r> infer-call ] unless ;
 101
 102 M: declared-effect infer-call*
 103     [ [ known>> infer-call* ] keep ] with-effect-here check-declared-effect ;
 104
 105 M: input-parameter infer-call* \ call unknown-macro-input ;
 106 M: object infer-call* \ call bad-macro-input ;
 107
 108 : infer-ndip ( word n -- )
 109     [ literals get ] 2dip
 110     [ '[ _ def>> infer-quot-here ] ]
 111     [ '[ _ [ pop ] dip [ infer->r infer-quot-here ] [ infer-r> ] bi ] ] bi*
 112     if-empty ;
 113
 114 : infer-dip ( -- ) \ dip 1 infer-ndip ;
 115
 116 \ dip [ infer-dip ] "special" set-word-prop
 117
 118 : infer-2dip ( -- ) \ 2dip 2 infer-ndip ;
 119
 120 \ 2dip [ infer-2dip ] "special" set-word-prop
 121
 122 : infer-3dip ( -- ) \ 3dip 3 infer-ndip ;
 123
 124 \ 3dip [ infer-3dip ] "special" set-word-prop
 125
 126 : infer-builder ( quot word -- )
 127     [
 128         [ 2 consume-d ] dip
 129         [ dup first2 ] dip call make-known
 130         [ push-d ] [ 1array ] bi
 131     ] dip #call, ; inline
 132
 133 : infer-curry ( -- ) [ <curried> ] \ curry infer-builder ;
 134
 135 \ curry [ infer-curry ] "special" set-word-prop
 136
 137 : infer-compose ( -- ) [ <composed> ] \ compose infer-builder ;
 138
 139 \ compose [ infer-compose ] "special" set-word-prop
 140
 141 ERROR: bad-executable obj ;
 142
 143 M: bad-executable summary
 144     drop "execute must be given a word" ;
 145
 146 : infer-execute ( -- )
 147     pop-literal nip
 148     dup word? [
 149         apply-object
 150     ] [
 151         \ bad-executable boa time-bomb
 152     ] if ;
 153
 154 \ execute [ infer-execute ] "special" set-word-prop
 155
 156 \ (execute) [ infer-execute ] "special" set-word-prop
 157
 158 : infer-<tuple-boa> ( -- )
 159     \ <tuple-boa>
 160     peek-d literal value>> second 1 + "obj" <array> { tuple } <effect>
 161     apply-word/effect ;
 162
 163 \ <tuple-boa> [ infer-<tuple-boa> ] "special" set-word-prop
 164
 165 \ <tuple-boa> t "flushable" set-word-prop
 166
 167 : infer-effect-unsafe ( word -- )
 168     pop-literal nip
 169     add-effect-input
 170     apply-word/effect ;
 171
 172 : infer-execute-effect-unsafe ( -- )
 173     \ (execute) infer-effect-unsafe ;
 174
 175 \ execute-effect-unsafe [ infer-execute-effect-unsafe ] "special" set-word-prop
 176
 177 : infer-call-effect-unsafe ( -- )
 178     \ call infer-effect-unsafe ;
 179
 180 \ call-effect-unsafe [ infer-call-effect-unsafe ] "special" set-word-prop
 181
 182 : infer-exit ( -- )
 183     \ exit (( n -- * )) apply-word/effect ;
 184
 185 \ exit [ infer-exit ] "special" set-word-prop
 186
 187 : infer-load-locals ( -- )
 188     pop-literal nip
 189     consume-d dup copy-values dup output-r
 190     [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ;
 191
 192 \ load-locals [ infer-load-locals ] "special" set-word-prop
 193
 194 : infer-load-local ( -- )
 195     1 infer->r ;
 196
 197 \ load-local [ infer-load-local ] "special" set-word-prop
 198
 199 :: infer-get-local ( -- )
 200     pop-literal nip 1 swap - :> n
 201     n consume-r :> in-r
 202     in-r first copy-value 1array :> out-d
 203     in-r copy-values :> out-r
 204
 205     out-d output-d
 206     out-r output-r
 207     f out-d in-r out-r
 208     out-r in-r zip out-d first in-r first 2array suffix
 209     #shuffle, ;
 210
 211 \ get-local [ infer-get-local ] "special" set-word-prop
 212
 213 : infer-drop-locals ( -- )
 214     f f pop-literal nip consume-r f f #shuffle, ;
 215
 216 \ drop-locals [ infer-drop-locals ] "special" set-word-prop
 217
 218 : infer-call-effect ( word -- )
 219     1 ensure-d first literal value>>
 220     add-effect-input add-effect-input
 221     apply-word/effect ;
 222
 223 { call-effect execute-effect } [
 224     dup t "no-compile" set-word-prop
 225     dup '[ _ infer-call-effect ] "special" set-word-prop
 226 ] each
 227
 228 \ if [ infer-if ] "special" set-word-prop
 229 \ dispatch [ infer-dispatch ] "special" set-word-prop
 230
 231 \ alien-invoke [ infer-alien-invoke ] "special" set-word-prop
 232 \ alien-indirect [ infer-alien-indirect ] "special" set-word-prop
 233 \ alien-assembly [ infer-alien-assembly ] "special" set-word-prop
 234 \ alien-callback [ infer-alien-callback ] "special" set-word-prop
 235
 236 {
 237     do-primitive
 238     mega-cache-miss
 239     mega-cache-lookup
 240     inline-cache-miss
 241     inline-cache-miss-tail
 242     unwind-native-frames
 243     set-datastack
 244     set-callstack
 245     set-retainstack
 246     unwind-native-frames
 247     lazy-jit-compile
 248     c-to-factor
 249     call-clear
 250 } [ dup '[ _ do-not-compile ] "special" set-word-prop ] each
 251
 252 : infer-special ( word -- )
 253     [ current-word set ] [ "special" word-prop call( -- ) ] bi ;
 254
 255 : infer-local-reader ( word -- )
 256     (( -- value )) apply-word/effect ;
 257
 258 : infer-local-writer ( word -- )
 259     (( value -- )) apply-word/effect ;
 260
 261 : infer-local-word ( word -- )
 262     "local-word-def" word-prop infer-quot-here ;
 263
 264 {
 265     declare call (call) dip 2dip 3dip curry compose
 266     execute (execute) call-effect-unsafe execute-effect-unsafe if
 267     dispatch <tuple-boa> exit load-local load-locals get-local
 268     drop-locals do-primitive alien-invoke alien-indirect
 269     alien-callback
 270 } [ t "no-compile" set-word-prop ] each
 271
 272 ! Exceptions to the above
 273 \ curry f "no-compile" set-word-prop
 274 \ compose f "no-compile" set-word-prop
 275
 276 ! More words not to compile
 277 \ clear t "no-compile" set-word-prop
 278
 279 : non-inline-word ( word -- )
 280     dup depends-on-effect
 281     {
 282         { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
 283         { [ dup "special" word-prop ] [ infer-special ] }
 284         { [ dup "primitive" word-prop ] [ infer-primitive ] }
 285         { [ dup "transform-quot" word-prop ] [ apply-transform ] }
 286         { [ dup "macro" word-prop ] [ apply-macro ] }
 287         { [ dup local? ] [ infer-local-reader ] }
 288         { [ dup local-reader? ] [ infer-local-reader ] }
 289         { [ dup local-writer? ] [ infer-local-writer ] }
 290         { [ dup local-word? ] [ infer-local-word ] }
 291         [ infer-word ]
 292     } cond ;
 293
 294 : define-primitive ( word inputs outputs -- )
 295     [ 2drop t "primitive" set-word-prop ]
 296     [ drop "input-classes" set-word-prop ]
 297     [ nip "default-output-classes" set-word-prop ]
 298     3tri ;
 299
 300 ! Stack effects for all primitives
 301 \ fixnum< { fixnum fixnum } { object } define-primitive
 302 \ fixnum< make-foldable
 303
 304 \ fixnum<= { fixnum fixnum } { object } define-primitive
 305 \ fixnum<= make-foldable
 306
 307 \ fixnum> { fixnum fixnum } { object } define-primitive
 308 \ fixnum> make-foldable
 309
 310 \ fixnum>= { fixnum fixnum } { object } define-primitive
 311 \ fixnum>= make-foldable
 312
 313 \ eq? { object object } { object } define-primitive
 314 \ eq? make-foldable
 315
 316 \ bignum>fixnum { bignum } { fixnum } define-primitive
 317 \ bignum>fixnum make-foldable
 318
 319 \ float>fixnum { float } { fixnum } define-primitive
 320 \ bignum>fixnum make-foldable
 321
 322 \ fixnum>bignum { fixnum } { bignum } define-primitive
 323 \ fixnum>bignum make-foldable
 324
 325 \ float>bignum { float } { bignum } define-primitive
 326 \ float>bignum make-foldable
 327
 328 \ fixnum>float { fixnum } { float } define-primitive
 329 \ fixnum>float make-foldable
 330
 331 \ bignum>float { bignum } { float } define-primitive
 332 \ bignum>float make-foldable
 333
 334 \ (float>string) { float } { byte-array } define-primitive
 335 \ (float>string) make-foldable
 336
 337 \ float>bits { real } { integer } define-primitive
 338 \ float>bits make-foldable
 339
 340 \ double>bits { real } { integer } define-primitive
 341 \ double>bits make-foldable
 342
 343 \ bits>float { integer } { float } define-primitive
 344 \ bits>float make-foldable
 345
 346 \ bits>double { integer } { float } define-primitive
 347 \ bits>double make-foldable
 348
 349 \ both-fixnums? { object object } { object } define-primitive
 350
 351 \ fixnum+ { fixnum fixnum } { integer } define-primitive
 352 \ fixnum+ make-foldable
 353
 354 \ fixnum+fast { fixnum fixnum } { fixnum } define-primitive
 355 \ fixnum+fast make-foldable
 356
 357 \ fixnum- { fixnum fixnum } { integer } define-primitive
 358 \ fixnum- make-foldable
 359
 360 \ fixnum-fast { fixnum fixnum } { fixnum } define-primitive
 361 \ fixnum-fast make-foldable
 362
 363 \ fixnum* { fixnum fixnum } { integer } define-primitive
 364 \ fixnum* make-foldable
 365
 366 \ fixnum*fast { fixnum fixnum } { fixnum } define-primitive
 367 \ fixnum*fast make-foldable
 368
 369 \ fixnum/i { fixnum fixnum } { integer } define-primitive
 370 \ fixnum/i make-foldable
 371
 372 \ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive
 373 \ fixnum/i-fast make-foldable
 374
 375 \ fixnum-mod { fixnum fixnum } { fixnum } define-primitive
 376 \ fixnum-mod make-foldable
 377
 378 \ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive
 379 \ fixnum/mod make-foldable
 380
 381 \ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive
 382 \ fixnum/mod-fast make-foldable
 383
 384 \ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive
 385 \ fixnum-bitand make-foldable
 386
 387 \ fixnum-bitor { fixnum fixnum } { fixnum } define-primitive
 388 \ fixnum-bitor make-foldable
 389
 390 \ fixnum-bitxor { fixnum fixnum } { fixnum } define-primitive
 391 \ fixnum-bitxor make-foldable
 392
 393 \ fixnum-bitnot { fixnum } { fixnum } define-primitive
 394 \ fixnum-bitnot make-foldable
 395
 396 \ fixnum-shift { fixnum fixnum } { integer } define-primitive
 397 \ fixnum-shift make-foldable
 398
 399 \ fixnum-shift-fast { fixnum fixnum } { fixnum } define-primitive
 400 \ fixnum-shift-fast make-foldable
 401
 402 \ bignum= { bignum bignum } { object } define-primitive
 403 \ bignum= make-foldable
 404
 405 \ bignum+ { bignum bignum } { bignum } define-primitive
 406 \ bignum+ make-foldable
 407
 408 \ bignum- { bignum bignum } { bignum } define-primitive
 409 \ bignum- make-foldable
 410
 411 \ bignum* { bignum bignum } { bignum } define-primitive
 412 \ bignum* make-foldable
 413
 414 \ bignum/i { bignum bignum } { bignum } define-primitive
 415 \ bignum/i make-foldable
 416
 417 \ bignum-mod { bignum bignum } { bignum } define-primitive
 418 \ bignum-mod make-foldable
 419
 420 \ bignum/mod { bignum bignum } { bignum bignum } define-primitive
 421 \ bignum/mod make-foldable
 422
 423 \ bignum-bitand { bignum bignum } { bignum } define-primitive
 424 \ bignum-bitand make-foldable
 425
 426 \ bignum-bitor { bignum bignum } { bignum } define-primitive
 427 \ bignum-bitor make-foldable
 428
 429 \ bignum-bitxor { bignum bignum } { bignum } define-primitive
 430 \ bignum-bitxor make-foldable
 431
 432 \ bignum-bitnot { bignum } { bignum } define-primitive
 433 \ bignum-bitnot make-foldable
 434
 435 \ bignum-shift { bignum fixnum } { bignum } define-primitive
 436 \ bignum-shift make-foldable
 437
 438 \ bignum< { bignum bignum } { object } define-primitive
 439 \ bignum< make-foldable
 440
 441 \ bignum<= { bignum bignum } { object } define-primitive
 442 \ bignum<= make-foldable
 443
 444 \ bignum> { bignum bignum } { object } define-primitive
 445 \ bignum> make-foldable
 446
 447 \ bignum>= { bignum bignum } { object } define-primitive
 448 \ bignum>= make-foldable
 449
 450 \ bignum-bit? { bignum integer } { object } define-primitive
 451 \ bignum-bit? make-foldable
 452
 453 \ bignum-log2 { bignum } { bignum } define-primitive
 454 \ bignum-log2 make-foldable
 455
 456 \ byte-array>bignum { byte-array } { bignum } define-primitive
 457 \ byte-array>bignum make-foldable
 458
 459 \ float= { float float } { object } define-primitive
 460 \ float= make-foldable
 461
 462 \ float+ { float float } { float } define-primitive
 463 \ float+ make-foldable
 464
 465 \ float- { float float } { float } define-primitive
 466 \ float- make-foldable
 467
 468 \ float* { float float } { float } define-primitive
 469 \ float* make-foldable
 470
 471 \ float/f { float float } { float } define-primitive
 472 \ float/f make-foldable
 473
 474 \ float-mod { float float } { float } define-primitive
 475 \ float-mod make-foldable
 476
 477 \ float< { float float } { object } define-primitive
 478 \ float< make-foldable
 479
 480 \ float<= { float float } { object } define-primitive
 481 \ float<= make-foldable
 482
 483 \ float> { float float } { object } define-primitive
 484 \ float> make-foldable
 485
 486 \ float>= { float float } { object } define-primitive
 487 \ float>= make-foldable
 488
 489 \ float-u< { float float } { object } define-primitive
 490 \ float-u< make-foldable
 491
 492 \ float-u<= { float float } { object } define-primitive
 493 \ float-u<= make-foldable
 494
 495 \ float-u> { float float } { object } define-primitive
 496 \ float-u> make-foldable
 497
 498 \ float-u>= { float float } { object } define-primitive
 499 \ float-u>= make-foldable
 500
 501 \ (word) { object object object } { word } define-primitive
 502 \ (word) make-flushable
 503
 504 \ word-code { word } { integer integer } define-primitive
 505 \ word-code make-flushable
 506
 507 \ special-object { fixnum } { object } define-primitive
 508 \ special-object make-flushable
 509
 510 \ set-special-object { object fixnum } { } define-primitive
 511
 512 \ context-object { fixnum } { object } define-primitive
 513 \ context-object make-flushable
 514
 515 \ set-context-object { object fixnum } { } define-primitive
 516
 517 \ (exists?) { string } { object } define-primitive
 518
 519 \ minor-gc { } { } define-primitive
 520
 521 \ gc { } { } define-primitive
 522
 523 \ compact-gc { } { } define-primitive
 524
 525 \ (save-image) { byte-array byte-array } { } define-primitive
 526
 527 \ (save-image-and-exit) { byte-array byte-array } { } define-primitive
 528
 529 \ data-room { } { byte-array } define-primitive
 530 \ data-room make-flushable
 531
 532 \ (code-blocks) { } { array } define-primitive
 533 \ (code-blocks)  make-flushable
 534
 535 \ code-room { } { byte-array } define-primitive
 536 \ code-room  make-flushable
 537
 538 \ system-micros { } { integer } define-primitive
 539 \ system-micros make-flushable
 540
 541 \ nano-count { } { integer } define-primitive
 542 \ nano-count make-flushable
 543
 544 \ tag { object } { fixnum } define-primitive
 545 \ tag make-foldable
 546
 547 \ (dlopen) { byte-array } { dll } define-primitive
 548
 549 \ (dlsym) { byte-array object } { c-ptr } define-primitive
 550
 551 \ dlclose { dll } { } define-primitive
 552
 553 \ <byte-array> { integer } { byte-array } define-primitive
 554 \ <byte-array> make-flushable
 555
 556 \ (byte-array) { integer } { byte-array } define-primitive
 557 \ (byte-array) make-flushable
 558
 559 \ <displaced-alien> { integer c-ptr } { c-ptr } define-primitive
 560 \ <displaced-alien> make-flushable
 561
 562 \ alien-signed-cell { c-ptr integer } { integer } define-primitive
 563 \ alien-signed-cell make-flushable
 564
 565 \ set-alien-signed-cell { integer c-ptr integer } { } define-primitive
 566
 567 \ alien-unsigned-cell { c-ptr integer } { integer } define-primitive
 568 \ alien-unsigned-cell make-flushable
 569
 570 \ set-alien-unsigned-cell { integer c-ptr integer } { } define-primitive
 571
 572 \ alien-signed-8 { c-ptr integer } { integer } define-primitive
 573 \ alien-signed-8 make-flushable
 574
 575 \ set-alien-signed-8 { integer c-ptr integer } { } define-primitive
 576
 577 \ alien-unsigned-8 { c-ptr integer } { integer } define-primitive
 578 \ alien-unsigned-8 make-flushable
 579
 580 \ set-alien-unsigned-8 { integer c-ptr integer } { } define-primitive
 581
 582 \ alien-signed-4 { c-ptr integer } { integer } define-primitive
 583 \ alien-signed-4 make-flushable
 584
 585 \ set-alien-signed-4 { integer c-ptr integer } { } define-primitive
 586
 587 \ alien-unsigned-4 { c-ptr integer } { integer } define-primitive
 588 \ alien-unsigned-4 make-flushable
 589
 590 \ set-alien-unsigned-4 { integer c-ptr integer } { } define-primitive
 591
 592 \ alien-signed-2 { c-ptr integer } { fixnum } define-primitive
 593 \ alien-signed-2 make-flushable
 594
 595 \ set-alien-signed-2 { integer c-ptr integer } { } define-primitive
 596
 597 \ alien-unsigned-2 { c-ptr integer } { fixnum } define-primitive
 598 \ alien-unsigned-2 make-flushable
 599
 600 \ set-alien-unsigned-2 { integer c-ptr integer } { } define-primitive
 601
 602 \ alien-signed-1 { c-ptr integer } { fixnum } define-primitive
 603 \ alien-signed-1 make-flushable
 604
 605 \ set-alien-signed-1 { integer c-ptr integer } { } define-primitive
 606
 607 \ alien-unsigned-1 { c-ptr integer } { fixnum } define-primitive
 608 \ alien-unsigned-1 make-flushable
 609
 610 \ set-alien-unsigned-1 { integer c-ptr integer } { } define-primitive
 611
 612 \ alien-float { c-ptr integer } { float } define-primitive
 613 \ alien-float make-flushable
 614
 615 \ set-alien-float { float c-ptr integer } { } define-primitive
 616
 617 \ alien-double { c-ptr integer } { float } define-primitive
 618 \ alien-double make-flushable
 619
 620 \ set-alien-double { float c-ptr integer } { } define-primitive
 621
 622 \ alien-cell { c-ptr integer } { pinned-c-ptr } define-primitive
 623 \ alien-cell make-flushable
 624
 625 \ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
 626
 627 \ alien-address { alien } { integer } define-primitive
 628 \ alien-address make-flushable
 629
 630 \ slot { object fixnum } { object } define-primitive
 631 \ slot make-flushable
 632
 633 \ set-slot { object object fixnum } { } define-primitive
 634
 635 \ string-nth { fixnum string } { fixnum } define-primitive
 636 \ string-nth make-flushable
 637
 638 \ set-string-nth-slow { fixnum fixnum string } { } define-primitive
 639 \ set-string-nth-fast { fixnum fixnum string } { } define-primitive
 640
 641 \ resize-array { integer array } { array } define-primitive
 642 \ resize-array make-flushable
 643
 644 \ resize-byte-array { integer byte-array } { byte-array } define-primitive
 645 \ resize-byte-array make-flushable
 646
 647 \ resize-string { integer string } { string } define-primitive
 648 \ resize-string make-flushable
 649
 650 \ <array> { integer object } { array } define-primitive
 651 \ <array> make-flushable
 652
 653 \ all-instances { } { array } define-primitive
 654
 655 \ size { object } { fixnum } define-primitive
 656 \ size make-flushable
 657
 658 \ die { } { } define-primitive
 659
 660 \ (fopen) { byte-array byte-array } { alien } define-primitive
 661
 662 \ fgetc { alien } { object } define-primitive
 663
 664 \ fwrite { c-ptr integer alien } { } define-primitive
 665
 666 \ fputc { object alien } { } define-primitive
 667
 668 \ fread { integer alien } { object } define-primitive
 669
 670 \ fflush { alien } { } define-primitive
 671
 672 \ fseek { integer integer alien } { } define-primitive
 673
 674 \ ftell { alien } { integer } define-primitive
 675
 676 \ fclose { alien } { } define-primitive
 677
 678 \ <wrapper> { object } { wrapper } define-primitive
 679 \ <wrapper> make-foldable
 680
 681 \ (clone) { object } { object } define-primitive
 682 \ (clone) make-flushable
 683
 684 \ <string> { integer integer } { string } define-primitive
 685 \ <string> make-flushable
 686
 687 \ array>quotation { array } { quotation } define-primitive
 688 \ array>quotation make-flushable
 689
 690 \ quotation-code { quotation } { integer integer } define-primitive
 691 \ quotation-code make-flushable
 692
 693 \ <tuple> { tuple-layout } { tuple } define-primitive
 694 \ <tuple> make-flushable
 695
 696 \ datastack { } { array } define-primitive
 697 \ datastack make-flushable
 698
 699 \ check-datastack { array integer integer } { object } define-primitive
 700 \ check-datastack make-flushable
 701
 702 \ retainstack { } { array } define-primitive
 703 \ retainstack make-flushable
 704
 705 \ callstack { } { callstack } define-primitive
 706 \ callstack make-flushable
 707
 708 \ callstack>array { callstack } { array } define-primitive
 709 \ callstack>array make-flushable
 710
 711 \ (sleep) { integer } { } define-primitive
 712
 713 \ become { array array } { } define-primitive
 714
 715 \ innermost-frame-executing { callstack } { object } define-primitive
 716
 717 \ innermost-frame-scan { callstack } { fixnum } define-primitive
 718
 719 \ set-innermost-frame-quot { quotation callstack } { } define-primitive
 720
 721 \ dll-valid? { object } { object } define-primitive
 722
 723 \ modify-code-heap { array object object } { } define-primitive
 724
 725 \ unimplemented { } { } define-primitive
 726
 727 \ jit-compile { quotation } { } define-primitive
 728
 729 \ lookup-method { object array } { word } define-primitive
 730
 731 \ reset-dispatch-stats { } { } define-primitive
 732 \ dispatch-stats { } { byte-array } define-primitive
 733
 734 \ optimized? { word } { object } define-primitive
 735
 736 \ strip-stack-traces { } { } define-primitive
 737
 738 \ <callback> { integer word } { alien } define-primitive
 739
 740 \ enable-gc-events { } { } define-primitive
 741 \ disable-gc-events { } { object } define-primitive
 742
 743 \ profiling { object } { } define-primitive
 744
 745 \ (identity-hashcode) { object } { fixnum } define-primitive
 746
 747 \ compute-identity-hashcode { object } { } define-primitive
 748
 749 \ (exit) { integer } { } define-primitive
 750
 751 \ quot-compiled? { quotation } { object } define-primitive