gc.l (24778B)
1 # 25may13abu 2 # (c) Software Lab. Alexander Burger 3 4 # Mark data 5 (code 'markE 0) 6 ld X 0 # Clear TOS 7 do 8 do 9 cnt E # Short number? 10 while z # No 11 ld A E # Get cell pointer in A 12 off A 15 13 test (A CDR) 1 # Already marked? 14 while nz # No 15 off (A CDR) 1 # Mark cell 16 big E # Bigum? 17 if nz # Yes 18 ld C (A CDR) # Second digit 19 do 20 cnt C # Any? 21 while z # Yes 22 test (C BIG) 1 # Marked? 23 while nz # Yes 24 off (C BIG) 1 # Else mark it 25 ld C (C BIG) # Next digit 26 loop 27 break T 28 end 29 ld C E # Previous item 30 ld E (A) # Get CAR 31 or X 1 # First visit 32 ld (A) X # Keep TOS 33 ld X C # TOS on previous 34 loop 35 do 36 ld A X # TOS cell pointer in A 37 and A -16 # Empty? 38 jz ret # Yes 39 test (A) 1 # Second visit? 40 while z # Yes 41 ld C X # TMP 42 ld X (A CDR) # TOS up 43 ld (A CDR) E # Restore CDR 44 ld E C # E up 45 loop 46 ld C (A) # Up pointer 47 ld (A) E # Restore CAR 48 ld E (A CDR) # Get CDR 49 off C 1 # Set second visit 50 ld (A CDR) C # Store up pointer 51 loop 52 53 # Reserve cells 54 (code 'needC 0) 55 ld A (Avail) # Get avail list 56 do 57 null A # Enough free cells? 58 jeq gc # No: Collect garbage 59 ld A (A) 60 dec C 61 until z 62 ret 63 64 # Garbage collector 65 (code 'gc 0) 66 push A # Save 67 push C 68 push E 69 push X 70 push Y 71 push Z 72 ld (DB) ZERO # Cut off DB root 73 ### Prepare all cells ### 74 ld X Nil # Symbol table 75 or (X) 1 # Set mark bit 76 add X 32 # Skip padding 77 do 78 or (X) 1 # Set mark bit 79 add X II # Next symbol 80 cmp X GcSymEnd 81 until gt 82 ld X (Heaps) # Heap pointer 83 do 84 ld C CELLS 85 do 86 or (X CDR) 1 # Set mark bit 87 add X II # Next cell 88 dec C # Done? 89 until z # Yes 90 ld X (X) # Next heap 91 null X # Done? 92 until eq # Yes 93 ### Mark ### 94 ld Y GcMark # Mark globals 95 do 96 ld E (Y) # Next global 97 call markE # Mark it 98 add Y I 99 cmp Y GcMarkEnd # Done? 100 until eq # Yes 101 ### Mark Env ### 102 ld E (EnvIntern) # Mark current namespace 103 call markE 104 ### Mark stack(s) ### 105 ld Y L 106 do 107 null Y # End of stack? 108 while ne # No 109 ld Z (Y) # Keep end of frame in Z 110 do 111 add Y I # End of frame? 112 cmp Y Z 113 while ne # No 114 ld E (Y) # Next item 115 call markE # Mark it 116 loop 117 ld Y (Y) # Next frame 118 loop 119 ld Y (Catch) # Catch frames 120 do 121 null Y # Any? 122 while ne # Yes 123 ld E (Y I) # Mark 'tag' 124 null E # Any? 125 if ne 126 call markE # Yes 127 end 128 ld E (Y II) # Mark 'fin' 129 call markE 130 ld Y (Y) # Next frame 131 loop 132 ld Y (Stack1) # Search through stack segments 133 ld C (Stacks) # Segment count 134 do 135 null C # Any? 136 while nz # Yes 137 null (Y -I) # In use? 138 if nz # Yes 139 push C # Save count 140 null (Y -II) # Active? 141 if z # Yes 142 ld E (Y -I) # Mark 'tag' 143 call markE 144 else 145 push Y # <S> 146 ld Y ((Y -II)) # Else get saved L 147 do 148 ld Z (Y) # Keep end of frame in Z 149 do 150 add Y I # End of frame? 151 cmp Y Z 152 while ne # No 153 ld E (Y) # Next item 154 call markE # Mark it 155 loop 156 ld Y (Y) # Next frame 157 null Y # End of stack? 158 until eq # Yes 159 ld Y ((S) (pack -II "-(EnvMid-Catch)")) # Saved catch frames 160 do 161 null Y # Any? 162 while ne # Yes 163 ld E (Y I) # Mark 'tag' 164 null E # Any? 165 if ne 166 call markE # Yes 167 end 168 ld E (Y II) # Mark 'fin' 169 call markE 170 ld Y (Y) # Next frame 171 loop 172 pop Y 173 end 174 pop C 175 dec C # Decrement count 176 end 177 sub Y (StkSize) # Next segment 178 loop 179 # Mark externals 180 ld Y Extern 181 ld Z 0 # Clear TOS 182 do 183 do 184 off (Y CDR) 1 # Clear mark bit 185 ld A (Y CDR) # Get subtrees 186 off (A CDR) 1 # Clear mark bit 187 atom (A CDR) # Right subtree? 188 while z # Yes 189 ld C Y # Go right 190 ld Y (A CDR) # Invert tree 191 ld (A CDR) Z # TOS 192 ld Z C 193 loop 194 do 195 ld E (Y) # Get external symbol 196 test (E) 1 # Already marked? 197 if nz # No 198 ld A (E TAIL) 199 num A # Any properties? 200 if z # Yes 201 off A (| SYM 1) # Clear 'extern' tag and mark bit 202 do 203 ld A (A CDR) # Skip property 204 off A 1 # Clear mark bit 205 num A # Find name 206 until nz 207 end 208 rcl A 1 # Dirty or deleted? 209 if c # Yes 210 call markE # Mark external symbol 211 end 212 end 213 ld A (Y CDR) # Left subtree? 214 atom (A) 215 if z # Yes 216 ld C Y # Go left 217 ld Y (A) # Invert tree 218 ld (A) Z # TOS 219 or C SYM # First visit 220 ld Z C 221 break T 222 end 223 do 224 ld A Z # TOS 225 null A # Empty? 226 jeq 10 # Done 227 sym A # Second visit? 228 if z # Yes 229 ld C (A CDR) # Nodes 230 ld Z (C CDR) # TOS on up link 231 ld (C CDR) Y 232 ld Y A 233 break T 234 end 235 off A SYM # Set second visit 236 ld C (A CDR) # Nodes 237 ld Z (C) 238 ld (C) Y 239 ld Y A 240 loop 241 loop 242 loop 243 10 ld A Db1 # DB root object 244 ld (DB) A # Restore '*DB' 245 test (A) 1 # Marked? 246 if nz # No 247 ld (A) Nil # Clear 248 ld (A TAIL) DB1 # Set to "not loaded" 249 end 250 ld Y Extern # Clean up 251 ld Z 0 # Clear TOS 252 20 do 253 do 254 ld A (Y CDR) 255 atom (A CDR) # Right subtree? 256 while z # Yes 257 ld C Y # Go right 258 ld Y (A CDR) # Invert tree 259 ld (A CDR) Z # TOS 260 ld Z C 261 loop 262 do 263 test ((Y)) 1 # External symbol marked? 264 if nz # No: Remove it 265 ld A (Y CDR) # Get subtrees 266 atom A # Any? 267 if nz # No 268 or (Y CDR) 1 # Set mark bit again 269 ld Y A # Use NIL 270 jmp 40 # Already traversed 271 end 272 atom (A) # Left branch? 273 if nz # No 274 or (Y CDR) 1 # Set mark bit again 275 ld Y (A CDR) # Use right branch 276 jmp 40 # Already traversed 277 end 278 atom (A CDR) # Right branch? 279 if nz # No 280 or (Y CDR) 1 # Set mark bit again 281 ld Y (A) # Use left branch 282 jmp 20 283 end 284 ld A (A CDR) # A on right branch 285 ld X (A CDR) # X on sub-branches 286 atom (X) # Left? 287 if nz # No 288 ld (Y) (A) # Insert right sub-branch 289 ld ((Y CDR) CDR) (X CDR) 290 jmp 30 # Traverse left branch 291 end 292 ld X (X) # Left sub-branch 293 do 294 ld C (X CDR) # More left branches? 295 atom (C) 296 while z # Yes 297 ld A X # Go down left 298 ld X (C) 299 loop 300 ld (Y) (X) # Insert left sub-branch 301 ld ((A CDR)) (C CDR) 302 end 303 30 ld A (Y CDR) # Left subtree? 304 atom (A) 305 if z # Yes 306 ld C Y # Go left 307 ld Y (A) # Invert tree 308 ld (A) Z # TOS 309 or C SYM # First visit 310 ld Z C 311 break T 312 end 313 40 do 314 ld A Z # TOS 315 null A # Empty? 316 jeq 50 # Done 317 sym A # Second visit? 318 if z # Yes 319 ld C (A CDR) # Nodes 320 ld Z (C CDR) # TOS on up link 321 ld (C CDR) Y 322 ld Y A 323 break T 324 end 325 off A SYM # Set second visit 326 ld C (A CDR) # Nodes 327 ld Z (C) 328 ld (C) Y 329 ld Y A 330 loop 331 loop 332 loop 333 50 ### Clean up ### 334 ld Y (Stack1) # Search through stack segments 335 ld C (Stacks) # Segment count 336 do 337 null C # Any? 338 while nz # Yes 339 null (Y -I) # In use? 340 if nz # Yes 341 test ((Y -I)) 1 # 'tag' symbol gone? 342 if nz # Yes 343 ld (Y -I) 0 # Mark segment as unused 344 dec (Stacks) # Last coroutine? 345 if z # Yes 346 ld (StkLimit) 0 # Clear stack limit 347 end 348 else 349 null (Y -II) # Active? 350 if nz # No 351 ld X (Y (pack -II "-(EnvMid-EnvApply)")) # Saved apply stack 352 do 353 null X # End of stack? 354 while ne # No 355 ld Z (X) # Keep end of frame in Z 356 add X II 357 do 358 off (X) 1 # Clear 359 add X II # Next gc mark 360 cmp X Z # End of frame? 361 until ge # Yes 362 ld X (Z I) # Next frame 363 loop 364 end 365 end 366 dec C # Decrement count 367 end 368 sub Y (StkSize) # Next segment 369 loop 370 ld Y (EnvApply) # Apply stack 371 do 372 null Y # End of stack? 373 while ne # No 374 ld Z (Y) # Keep end of frame in Z 375 add Y II 376 do 377 off (Y) 1 # Clear 378 add Y II # Next gc mark 379 cmp Y Z # End of frame? 380 until ge # Yes 381 ld Y (Z I) # Next frame 382 loop 383 ### Sweep ### 384 ld X 0 # Avail list 385 ld Y (Heaps) # Heap list in Y 386 ld C (GcCount) # Get cell count 387 null C 388 if ne # Non-zero: 389 do 390 lea Z (Y (- HEAP II)) # Z on last cell in chunk 391 do 392 test (Z CDR) 1 # Free cell? 393 if nz # Yes 394 ld (Z) X # Link avail 395 ld X Z 396 dec C 397 end 398 sub Z II 399 cmp Z Y # Done? 400 until lt # Yes 401 ld Y (Y HEAP) # Next heap 402 null Y 403 until eq # All heaps done 404 ld (Avail) X # Set new Avail 405 do 406 null C # Count minimum reached? 407 while ns # No 408 call heapAlloc # Allocate heap 409 sub C CELLS 410 loop 411 else # Zero: Try to free heaps 412 ld E Heaps # Heap list link pointer in E 413 do 414 ld A (Avail) # Keep avail list 415 ld C CELLS # Counter 416 lea Z (Y (- HEAP II)) # Z on last cell in chunk 417 do 418 test (Z CDR) 1 # Free cell? 419 if nz # Yes 420 ld (Z) X # Link avail 421 ld X Z 422 dec C 423 end 424 sub Z II 425 cmp Z Y # Done? 426 until lt # Yes 427 null C # Remaining cells? 428 if nz # Yes 429 lea E (Y HEAP) # Point to link of next heap 430 ld Y (E) # Next heap 431 else 432 ld (Avail) A # Reset avail list 433 ld Y (Y HEAP) # Next heap 434 cc free((E)) # Free empty heap 435 ld (E) Y # Store next heap in list link 436 end 437 null Y # Next heap? 438 until z # No 439 end 440 pop Z 441 pop Y 442 pop X 443 pop E 444 pop C 445 pop A 446 ret 447 448 # (gc ['cnt]) -> cnt | NIL 449 (code 'doGc 2) 450 push X 451 ld X E 452 ld E (E CDR) # Get arg 453 ld E (E) 454 eval # Eval 455 cmp E Nil # Nil? 456 if eq # Yes 457 call gc # Collect with default 458 else 459 ld X E # Save return value in X 460 call xCntEX_FE # Else get number of megabytes 461 shl E 16 # Multiply with CELLS 462 ld C (GcCount) # Save default 463 ld (GcCount) E # Set new value 464 call gc # Collect with given count 465 ld (GcCount) C # Restore default 466 ld E X 467 end 468 pop X 469 ret 470 471 ### Build cons pair ### 472 (code 'cons_A 0) 473 ld A (Avail) # Get avail list 474 null A # Empty? 475 if ne # No 476 ld (Avail) (A) # Set new avail list 477 ret 478 end 479 call gc # Collect garbage 480 ld A (Avail) # Get avail list again 481 ld (Avail) (A) # Set new avail list 482 ret 483 484 (code 'cons_C 0) 485 ld C (Avail) # Get avail list 486 null C # Empty? 487 if ne # No 488 ld (Avail) (C) # Set new avail list 489 ret 490 end 491 call gc # Collect garbage 492 ld C (Avail) # Get avail list again 493 ld (Avail) (C) # Set new avail list 494 ret 495 496 (code 'cons_E 0) 497 ld E (Avail) # Get avail list 498 null E # Empty? 499 if ne # No 500 ld (Avail) (E) # Set new avail list 501 ret 502 end 503 call gc # Collect garbage 504 ld E (Avail) # Get avail list again 505 ld (Avail) (E) # Set new avail list 506 ret 507 508 (code 'cons_X 0) 509 ld X (Avail) # Get avail list 510 null X # Empty? 511 if ne # No 512 ld (Avail) (X) # Set new avail list 513 ret 514 end 515 call gc # Collect garbage 516 ld X (Avail) # Get avail list again 517 ld (Avail) (X) # Set new avail list 518 ret 519 520 (code 'cons_Y 0) 521 ld Y (Avail) # Get avail list 522 null Y # Empty? 523 if ne # No 524 ld (Avail) (Y) # Set new avail list 525 ret 526 end 527 call gc # Collect garbage 528 ld Y (Avail) # Get avail list again 529 ld (Avail) (Y) # Set new avail list 530 ret 531 532 (code 'cons_Z 0) 533 ld Z (Avail) # Get avail list 534 null Z # Empty? 535 if ne # No 536 ld (Avail) (Z) # Set new avail list 537 ret 538 end 539 call gc # Collect garbage 540 ld Z (Avail) # Get avail list again 541 ld (Avail) (Z) # Set new avail list 542 ret 543 544 (code 'consA_A 0) 545 null (Avail) # Avail list empty? 546 if ne # No 547 ld A (Avail) # Get avail list 548 ld (Avail) (A) # Set new avail list 549 ret 550 end 551 link # Save A 552 push A 553 link 554 call gc # Collect garbage 555 drop 556 ld A (Avail) # Get avail list 557 ld (Avail) (A) # Set new avail list 558 ret 559 560 (code 'consC_A 0) 561 ld A (Avail) # Get avail list 562 null A # Empty? 563 if ne # No 564 ld (Avail) (A) # Set new avail list 565 ret 566 end 567 link # Save C 568 push C 569 link 570 call gc # Collect garbage 571 drop 572 ld A (Avail) # Get avail list again 573 ld (Avail) (A) # Set new avail list 574 ret 575 576 (code 'consE_A 0) 577 ld A (Avail) # Get avail list 578 null A # Empty? 579 if ne # No 580 ld (Avail) (A) # Set new avail list 581 ret 582 end 583 link # Save E 584 push E 585 link 586 call gc # Collect garbage 587 drop 588 ld A (Avail) # Get avail list again 589 ld (Avail) (A) # Set new avail list 590 ret 591 592 (code 'consX_A 0) 593 ld A (Avail) # Get avail list 594 null A # Empty? 595 if ne # No 596 ld (Avail) (A) # Set new avail list 597 ret 598 end 599 link # Save X 600 push X 601 link 602 call gc # Collect garbage 603 drop 604 ld A (Avail) # Get avail list again 605 ld (Avail) (A) # Set new avail list 606 ret 607 608 (code 'consA_C 0) 609 ld C (Avail) # Get avail list 610 null C # Empty? 611 if ne # No 612 ld (Avail) (C) # Set new avail list 613 ret 614 end 615 link # Save A 616 push A 617 link 618 call gc # Collect garbage 619 drop 620 ld C (Avail) # Get avail list again 621 ld (Avail) (C) # Set new avail list 622 ret 623 624 (code 'consC_C 0) 625 null (Avail) # Avail list empty? 626 if ne # No 627 ld C (Avail) # Get avail list 628 ld (Avail) (C) # Set new avail list 629 ret 630 end 631 link # Save C 632 push C 633 link 634 call gc # Collect garbage 635 drop 636 ld C (Avail) # Get avail list 637 ld (Avail) (C) # Set new avail list 638 ret 639 640 (code 'consE_C 0) 641 ld C (Avail) # Get avail list 642 null C # Empty? 643 if ne # No 644 ld (Avail) (C) # Set new avail list 645 ret 646 end 647 link # Save E 648 push E 649 link 650 call gc # Collect garbage 651 drop 652 ld C (Avail) # Get avail list again 653 ld (Avail) (C) # Set new avail list 654 ret 655 656 (code 'consA_E 0) 657 ld E (Avail) # Get avail list 658 null E # Empty? 659 if ne # No 660 ld (Avail) (E) # Set new avail list 661 ret 662 end 663 link # Save A 664 push A 665 link 666 call gc # Collect garbage 667 drop 668 ld E (Avail) # Get avail list again 669 ld (Avail) (E) # Set new avail list 670 ret 671 672 (code 'consC_E 0) 673 ld E (Avail) # Get avail list 674 null E # Empty? 675 if ne # No 676 ld (Avail) (E) # Set new avail list 677 ret 678 end 679 link # Save C 680 push C 681 link 682 call gc # Collect garbage 683 drop 684 ld E (Avail) # Get avail list again 685 ld (Avail) (E) # Set new avail list 686 ret 687 688 (code 'consE_E 0) 689 null (Avail) # Avail list empty? 690 if ne # No 691 ld E (Avail) # Get avail list 692 ld (Avail) (E) # Set new avail list 693 ret 694 end 695 link # Save E 696 push E 697 link 698 call gc # Collect garbage 699 drop 700 ld E (Avail) # Get avail list 701 ld (Avail) (E) # Set new avail list 702 ret 703 704 (code 'consX_E 0) 705 ld E (Avail) # Get avail list 706 null E # Empty? 707 if ne # No 708 ld (Avail) (E) # Set new avail list 709 ret 710 end 711 link # Save X 712 push X 713 link 714 call gc # Collect garbage 715 drop 716 ld E (Avail) # Get avail list again 717 ld (Avail) (E) # Set new avail list 718 ret 719 720 (code 'consA_X 0) 721 ld X (Avail) # Get avail list 722 null X # Empty? 723 if ne # No 724 ld (Avail) (X) # Set new avail list 725 ret 726 end 727 link # Save A 728 push A 729 link 730 call gc # Collect garbage 731 drop 732 ld X (Avail) # Get avail list again 733 ld (Avail) (X) # Set new avail list 734 ret 735 736 (code 'consE_X 0) 737 ld X (Avail) # Get avail list 738 null X # Empty? 739 if ne # No 740 ld (Avail) (X) # Set new avail list 741 ret 742 end 743 link # Save E 744 push E 745 link 746 call gc # Collect garbage 747 drop 748 ld X (Avail) # Get avail list again 749 ld (Avail) (X) # Set new avail list 750 ret 751 752 (code 'consY_X 0) 753 ld X (Avail) # Get avail list 754 null X # Empty? 755 if ne # No 756 ld (Avail) (X) # Set new avail list 757 ret 758 end 759 link # Save Y 760 push Y 761 link 762 call gc # Collect garbage 763 drop 764 ld X (Avail) # Get avail list again 765 ld (Avail) (X) # Set new avail list 766 ret 767 768 (code 'consA_Y 0) 769 ld Y (Avail) # Get avail list 770 null Y # Empty? 771 if ne # No 772 ld (Avail) (Y) # Set new avail list 773 ret 774 end 775 link # Save A 776 push A 777 link 778 call gc # Collect garbage 779 drop 780 ld Y (Avail) # Get avail list again 781 ld (Avail) (Y) # Set new avail list 782 ret 783 784 (code 'consA_Z 0) 785 ld Z (Avail) # Get avail list 786 null Z # Empty? 787 if ne # No 788 ld (Avail) (Z) # Set new avail list 789 ret 790 end 791 link # Save A 792 push A 793 link 794 call gc # Collect garbage 795 drop 796 ld Z (Avail) # Get avail list again 797 ld (Avail) (Z) # Set new avail list 798 ret 799 800 (code 'consAC_E 0) 801 ld E (Avail) # Get avail list 802 null E # Empty? 803 if ne # No 804 ld (Avail) (E) # Set new avail list 805 ret 806 end 807 link # Save A and C 808 push A 809 push C 810 link 811 call gc # Collect garbage 812 drop 813 ld E (Avail) # Get avail list again 814 ld (Avail) (E) # Set new avail list 815 ret 816 817 ### Build symbol cells ### 818 (code 'consSymX_E 0) 819 cmp X ZERO # Name? 820 jeq retNil # No 821 ld E (Avail) # Get avail list 822 null E # Empty? 823 if eq # Yes 824 link # Save name 825 push X 826 link 827 call gc # Collect garbage 828 drop 829 ld E (Avail) # Get avail list again 830 end 831 ld (Avail) (E) # Set new avail list 832 ld (E) X # Set new symbol's name 833 or E SYM # Make symbol 834 ld (E) E # Set value to itself 835 ret 836 837 ### Build number cells ### 838 (code 'boxNum_A 0) 839 ld A (Avail) # Get avail list 840 null A # Empty? 841 if eq # Yes 842 call gc # Collect garbage 843 ld A (Avail) # Get avail list again 844 end 845 ld (Avail) (A) # Set new avail list 846 ld (A CDR) ZERO # Set CDR to ZERO 847 or B BIG # Make number 848 ret 849 850 (code 'boxNum_C 0) 851 ld C (Avail) # Get avail list 852 null C # Empty? 853 if eq # Yes 854 call gc # Collect garbage 855 ld C (Avail) # Get avail list again 856 end 857 ld (Avail) (C) # Set new avail list 858 ld (C CDR) ZERO # Set CDR to ZERO 859 or C BIG # Make number 860 ret 861 862 (code 'boxNum_E 0) 863 ld E (Avail) # Get avail list 864 null E # Empty? 865 if eq # Yes 866 call gc # Collect garbage 867 ld E (Avail) # Get avail list again 868 end 869 ld (Avail) (E) # Set new avail list 870 ld (E CDR) ZERO # Set CDR to ZERO 871 or E BIG # Make number 872 ret 873 874 (code 'boxNum_X 0) 875 ld X (Avail) # Get avail list 876 null X # Empty? 877 if eq # Yes 878 call gc # Collect garbage 879 ld X (Avail) # Get avail list again 880 end 881 ld (Avail) (X) # Set new avail list 882 ld (X CDR) ZERO # Set CDR to ZERO 883 or X BIG # Make number 884 ret 885 886 (code 'boxNumA_A 0) 887 push A 888 ld A (Avail) # Get avail list 889 null A # Empty? 890 if eq # Yes 891 call gc # Collect garbage 892 ld A (Avail) # Get avail list again 893 end 894 ld (Avail) (A) # Set new avail list 895 pop (A) # Set new cell's CAR 896 ld (A CDR) ZERO # Set CDR to ZERO 897 or B BIG # Make number 898 ret 899 900 (code 'boxNumE_E 0) 901 push E 902 ld E (Avail) # Get avail list 903 null E # Empty? 904 if eq # Yes 905 call gc # Collect garbage 906 ld E (Avail) # Get avail list again 907 end 908 ld (Avail) (E) # Set new avail list 909 pop (E) # Set new cell's CAR 910 ld (E CDR) ZERO # Set CDR to ZERO 911 or E BIG # Make number 912 ret 913 914 (code 'consNumAC_A 0) 915 push A 916 ld A (Avail) # Get avail list 917 null A # Empty? 918 if eq # Yes 919 link # Save C 920 push C 921 link 922 call gc # Collect garbage 923 drop 924 ld A (Avail) # Get avail list again 925 end 926 ld (Avail) (A) # Set new avail list 927 pop (A) # Set new cell's CAR 928 ld (A CDR) C # Set CDR 929 or B BIG # Make number 930 ret 931 932 (code 'consNumAE_A 0) 933 push A 934 ld A (Avail) # Get avail list 935 null A # Empty? 936 if eq # Yes 937 link # Save E 938 push E 939 link 940 call gc # Collect garbage 941 drop 942 ld A (Avail) # Get avail list again 943 end 944 ld (Avail) (A) # Set new avail list 945 pop (A) # Set new cell's CAR 946 ld (A CDR) E # Set CDR 947 or B BIG # Make number 948 ret 949 950 (code 'consNumCA_C 0) 951 push C 952 ld C (Avail) # Get avail list 953 null C # Empty? 954 if eq # Yes 955 link # Save A 956 push A 957 link 958 call gc # Collect garbage 959 drop 960 ld C (Avail) # Get avail list again 961 end 962 ld (Avail) (C) # Set new avail list 963 pop (C) # Set new cell's CAR 964 ld (C CDR) A # Set CDR 965 or C BIG # Make number 966 ret 967 968 (code 'consNumCE_A 0) 969 ld A (Avail) # Get avail list 970 null A # Empty? 971 if eq # Yes 972 link # Save E 973 push E 974 link 975 call gc # Collect garbage 976 drop 977 ld A (Avail) # Get avail list again 978 end 979 ld (Avail) (A) # Set new avail list 980 ld (A) C # Set new cell's CAR 981 ld (A CDR) E # Set CDR 982 or B BIG # Make number 983 ret 984 985 (code 'consNumCE_C 0) 986 push C 987 ld C (Avail) # Get avail list 988 null C # Empty? 989 if eq # Yes 990 link # Save E 991 push E 992 link 993 call gc # Collect garbage 994 drop 995 ld C (Avail) # Get avail list again 996 end 997 ld (Avail) (C) # Set new avail list 998 pop (C) # Set new cell's CAR 999 ld (C CDR) E # Set CDR 1000 or C BIG # Make number 1001 ret 1002 1003 (code 'consNumCE_E 0) 1004 null (Avail) # Avail list empty? 1005 if eq # Yes 1006 link # Save E 1007 push E 1008 link 1009 call gc # Collect garbage 1010 drop 1011 end 1012 push E 1013 ld E (Avail) # Get avail list 1014 ld (Avail) (E) # Set new avail list 1015 ld (E) C # Set new cell's CAR 1016 pop (E CDR) # Set CDR 1017 or E BIG # Make number 1018 ret 1019 1020 (code 'consNumEA_A 0) 1021 null (Avail) # Avail list empty? 1022 if eq # Yes 1023 link # Save A 1024 push A 1025 link 1026 call gc # Collect garbage 1027 drop 1028 end 1029 push A 1030 ld A (Avail) # Get avail list 1031 ld (Avail) (A) # Set new avail list 1032 ld (A) E # Set new cell's CAR 1033 pop (A CDR) # Set CDR 1034 or B BIG # Make number 1035 ret 1036 1037 (code 'consNumEA_E 0) 1038 push E 1039 ld E (Avail) # Get avail list 1040 null E # Empty? 1041 if eq # Yes 1042 link # Save A 1043 push A 1044 link 1045 call gc # Collect garbage 1046 drop 1047 ld E (Avail) # Get avail list again 1048 end 1049 ld (Avail) (E) # Set new avail list 1050 pop (E) # Set new cell's CAR 1051 ld (E CDR) A # Set CDR 1052 or E BIG # Make number 1053 ret 1054 1055 (code 'consNumEC_E 0) 1056 push E 1057 ld E (Avail) # Get avail list 1058 null E # Empty? 1059 if eq # Yes 1060 link # Save C 1061 push C 1062 link 1063 call gc # Collect garbage 1064 drop 1065 ld E (Avail) # Get avail list again 1066 end 1067 ld (Avail) (E) # Set new avail list 1068 pop (E) # Set new cell's CAR 1069 ld (E CDR) C # Set CDR 1070 or E BIG # Make number 1071 ret 1072 1073 # vi:et:ts=3:sw=3