1: ; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System 2: ; Science Center, Harvard University 3: .psect shrcode con 4: 5: ; 6: ;;this section of code is the garbage collector 7: ;;it reclaims unused atoms, dtprs, numbers, and bcd 8: ;; 9: ;;in interest of speed, the collection of atoms is not enabled 10: ;;normally. if one feels that he can use this feature, then 11: ;;there is a language level switch 12: ;;that enables full collection 13: ;; 14: ;; 15: ;;this code is the recursive part of the collector that does the marking 16: ;;the driver and marker follow 17: ;; 18: ;;note that the gc bit on each object is the 0 bit in the first 19: ;;word of that object. this gives a quick check as to whether the 20: ;;object is already loved or not, and therefore whether on needs to fool 21: ;;around with it. 22: ; 23: ; 24: gcolinr: 25: 26: .if eq,multiseg 27: .if ne,nilas0 28: jmpifnil a,31$ 29: .endc 30: .endc 31: mov b,np ;use np to tell how many things on stack 32: br 21$ 33: 10$: pop a 34: 20$: 35: .if eq,multiseg 36: .if ne,nilas0 37: jmpifnil a,2$,nl 38: .endc 39: .endc 40: 21$: bit b,(a) ;b is loaded with constant 1 41: bne 2$ 42: 7$: 43: dispatch 44: br 3$ ;if number 45: .word 0 ;for dispatch allowing 2 words/inst 46: br 4$ ;dtpr 47: .word 0 48: br 5$ ;atom 49: .word 0 50: br 6$ ;bcd 51: 1$: bis b,(a) ;hole... 52: 2$: sob np,10$ ;port + other stuff 53: 31$: ret 54: 55: 3$: brifsmalint a,2$ ;integer code 56: br 1$ 57: 58: 59: 5$: jmpifnil (a),35$ ;save push if possible 60: push (a) ;trace atom out 61: inc np 62: 35$: bis b,(a)+ ;mark it 63: tst (a)+ ;point to fb 64: jmpifnil (a),36$ ;and this one 65: push (a) ;trace shallowest (probably) first 66: inc np 67: 36$: mov -(a),a ;get middle 68: br 20$ 69: 70: 71: 4$: tst (a)+ ;want to push on cdr,trace car 72: jmpifnil (a),37$ ;again, don't push nil on 73: push (a) 74: inc np ;one deeper 75: 37$: 76: bis b,-(a) 77: mov (a),a ;get car 78: bic b,a ;and clear it 79: br 20$ 80: 81: 6$: tstb supcol 82: beq 8$ 83: .if eq,multiseg 84: cmp a,#firpage 85: blos 8$ 86: .endc 87: bis b,(a) 88: 8$: 89: mov 2(a),a 90: br 20$ 91: 92: .rsect shrcode 93: 94: nogcol: ;not enough stack space 95: add #100.+20,sp ;see if np is too large 96: mov npbottom,np 97: cmp sp,np 98: blo 1$ 99: add #20,npbottom ;help in future gcol's 100: 1$: 101: mov np,sp 102: generm </not enough stack space to attempt gcol/<12>//> 103: mov #tmp-<^pl errorm>,a 104: call geterr 105: loadnil @np 106: call putstr 107: jmp lsploop 108: 109: 110: 111: ;this is the collector driver 112: 113: gcol: incb noint ;do not allow 5^c's 114: mov j1,-(sp) ;save r0 115: $sig 116: 11. ;seg fault 117: nogcol 118: mov %0,$$sig+4 ;prepare to reset trap 119: add #-100.,sp ;gotta make sp point... 120: mov sp,j1 ;first move sp to j1 and 121: bic #17777,j1 ;see about testing somebody's seg 122: cmp j1,$$break+2 ;instead of nowhere 123: blos nogcol ;woops--this is owned!!! 124: tst (sp) ;now see if is in no man's land 125: add #100.,sp ;there had to be room 126: mov #11.,$$sig+2 ;and trap type 127: $indir 128: $$sig 129: push a 130: push b 131: push j2 132: push j3 133: push np 134: mov sp,gcolf ;save sp 135: .if df,gctrace 136: .globl gcex,gcem 137: npush #anil 138: outstr gcem 139: call dmpport 140: .if df,width 141: clrb poport+1 142: .endc 143: add #-4,np 144: .endc 145: 146: 147: resgcol: 148: 149: 150: mov #1,b 151: tstb supcol 152: beq 10$ ;if in short mode, save all atoms 153: 154: .if eq, hash 155: .ift 156: mov xoblist,j1 157: 1$: bic b,j1 ;clear tracebit if nec. 158: jmpifnil j1,20$ 159: car j1,j2 160: bis b,(j1) 161: bit b,(j2) 162: bne 9$ 163: cmp j2,#lsatm 164: blo 2$ 165: .if ne,nilas0 166: tst (j2) 167: bne 2$ 168: tst 2(j2) 169: bne 2$ 170: tst 4(j2) 171: beq 9$ 172: .iff 173: cmp (j2),#anil 174: bne 2$ 175: cmp 2(j2),#anil 176: bne 2$ 177: jmpifnil 4(j2),9$ 178: .endc 179: 2$: mov j2,a 180: call gcolinr 181: 9$: cdr j1,j1 182: br 1$ 183: .iff 184: mov #<2*hash>,j3 185: 7$: mov <hasht-2>(j3),j1 186: 1$: bic b,j1 187: jmpifnil j1,9$ 188: car j1,j2 189: bis b,(j1)+ 190: bit b,(j2) 191: bne 8$ 192: mov j2,a 193: cmp j2,#lsatm 194: blo 6$ 195: .if ne,nilas0 196: tst (j2)+ 197: bne 6$ 198: tst (j2)+ 199: bne 6$ 200: tst (j2) 201: beq 8$ 202: .iff 203: jmpnnil (j2)+,6$ 204: jmpnnil (j2)+,6$ 205: jmpifnil (j2),8$ 206: .endc 207: 6$: call gcolinr 208: 8$: mov @j1,j1 209: br 1$ 210: 9$: bit #2,j3 211: beq 2$ 212: bis b,<hasht-2>(j3) 213: 2$: dec j3 214: sob j3,7$ 215: .endc 216: 10$: mov xoblist,a 217: call gcolinr 218: 219: ;now we trace the namestack 220: ;j1-j3 are available 221: 222: 223: 20$: mov (sp),j1 224: mov cptop,j2 225: tst (j2)+ ;get to first entry 226: 11$: cmp j2,j1 227: bhi 19$ ;if past stack, quit 228: mov (j2)+,a 229: call gcolinr 230: br 11$ 231: 232: ;and now the cstk 233: ;the things that are traced are oddaddresses, and things protected by snags 234: ;which are at the moment eexit,(eexit1),brksnag,register snags 235: 236: 237: 19$: mov sp,j1 238: add #14,j1 239: mov cptop,j2 240: 21$: bit b,(j1) 241: beq 22$ 242: mov (j1)+,a 243: bic b,a 244: call gcolinr 245: br 23$ 246: 22$: cmp #eexit,(j1) 247: bne 29$ 248: 28$: tst (j1)+ 249: mov (j1)+,a 250: call gcolinr 251: tst (j1)+ 252: mov (j1)+,a 253: call gcolinr 254: br 23$ 255: 29$: 256: .if ne,xfer 257: cmp #eexit1,(j1) 258: beq 28$ 259: .endc 260: cmp #brksnag,(j1) 261: beq 56$ 262: cmp #r4rres,(j1) 263: beq 55$ 264: cmp #r3rres,(j1) 265: beq 54$ 266: cmp #r2rres,(j1) 267: beq 52$ 268: cmp #r1rres,(j1)+ 269: beq 51$ 270: br 23$ 271: 56$: cmp (j1)+,(j1)+ 272: 55$: tst (j1)+ 273: 54$: tst (j1)+ 274: 52$: tst (j1)+ 275: tst (j1)+ 276: 51$: tst (j1)+ 277: 23$: cmp j1,j2 278: blo 21$ 279: 280: 281: 282: 283: 284: ;well, that it for the tracing. 285: ;now we gotta go around and collect the stuff we've played with 286: ;and reset the gcbits back to 0 287: ;refreshing our memory on the qmap values 288: ; -5 owned by monitor 289: ; -4 stack space(np+cp) 290: ; -3 not allocated but owned by us 291: ; -2 allocatecd by port 292: ; -1 binary code 293: ; 0 word 294: ; 1 dtpr 295: ; 2 atom 296: ; 3 bcd(p) 297: ; 4 port 298: ; 299: ;first we gotta get rid of the freelists 300: 301: 302: loadnil fnumber 303: loadnil fdtpr 304: tstb supcol 305: beq 30$ 306: loadnil fbcd 307: 30$: clr cdtpr 308: clr cnumber 309: 310: 311: 312: ;reminder a,j1-np are available for the gathering process 313: ;b still contains 1 314: 315: .if eq,multiseg 316: .ift 317: mov #firpage,np 318: .iff 319: mov #starbc,np 320: .endc 321: colloop: mov np,j3 322: swab j3 323: movb qmap(j3),j2 324: 1$: add #^d256,np 325: asl j2; mult by two 326: jmp @gcjmtbl(j2) 327: 328: .psect shrwddat con 329: gcfinup ;if in monitor core 330: gcfinup ;or in stack space 331: colloop 332: colloop ;if port or free ignore page 333: colloop ;ditto for sys 334: gcjmtbl: gccolwd 335: gccoldt 336: colloop ;atoms are taken care of latter 337: gccolbcd ;for bcd 338: colloop ;take care of ports 339: 340: .psect shrcode con 341: gccoldt: mov fdtpr,j1 342: mov cdtpr,j2 343: call gcwdat 344: mov j1,fdtpr 345: mov j2,cdtpr 346: br colloop 347: gccolwd: mov fnumber,j1 348: mov cnumber,j2 349: call gcwdatt 350: mov j1,fnumber 351: mov j2,cnumber 352: br colloop 353: gcwdat: mov np,a 354: mov #^d64,j3 355: 1$: add #-4,a 356: bit b,(a) 357: beq 2$ 358: bic b,(a) 359: sob j3,1$ 360: ret 361: 2$: mov j1,(a) 362: inc j2 363: mov a,j1 364: sob j3,1$ 365: ret 366: 367: gccolbcd: tstb supcol 368: bne 2$ 369: 6$: br colloop 370: 2$: 371: .if eq,multiseg 372: .ift 373: mov np,a 374: sub #^d256,a 375: 3$: mov (a),j1 376: bic #177001,j1 377: bit b,(a) 378: bne 4$ 379: mov fbcd,2(a) 380: mov a,fbcd 381: 4$: bic b,(a) 382: add j1,a 383: cmp a,np 384: blo 3$ 385: br 6$ 386: .iff 387: mov np,a 388: mov np,j3 389: sub #6,j3 390: sub #^d256,a 391: 4$: bit b,(a) 392: bne 5$ 393: mov fbcd,2(a) 394: mov a,fbcd 395: 5$: bic b,(a) 396: add #6,a 397: cmp a,j3 398: blo 4$ 399: br 6$ 400: .endc 401: 402: gcfinup: tstb supcol 403: beq 20$ 404: .if eq,hash ;implement supercolect on atoms... 405: mov #<xoblist-2>,a 406: 9$: cdr a,j1 407: jmpifnil j1,30$,nl 408: car j1,j3 409: bit b,(j3) 410: beq 10$ 411: bic b,(j3) 412: mov j1,a 413: br 9$ 414: 10$: cdr j1,2(a) 415: mov fdtpr,(j1) 416: mov j1,fdtpr 417: inc cdtpr 418: mov #4,j2 419: mov j3,np 420: add #6,np 421: 11$: inc np 422: tstb (np)+ 423: beq 12$ 424: inc j2 425: br 11$ 426: 12$: mov j2,2(j3) ;save count 427: mov fratom,(j3) 428: mov j3,fratom 429: br 9$ 430: 431: 432: .iff 433: 434: 435: mov #<2*hash>,np 436: 5$: mov np,a 437: add #<hasht-2>,a 438: jmpifnil (a),14$ 439: 6$: mov @a,j1 440: jmpifnil j1,14$,nl 441: mov (j1)+,j2 442: bit b,(j2) 443: beq 10$ 444: bic b,(j2) 445: mov j1,a 446: br 6$ 447: 10$: mov @j1,(a) 448: mov fdtpr,-(j1) 449: mov j1,fdtpr 450: inc cdtpr 451: mov #4,j3 452: mov j2,j1 453: add #6,j1 454: 11$: inc j1 455: tstb (j1)+ 456: beq 12$ 457: inc j3 458: br 11$ 459: 12$: mov j3,2(j2) 460: mov fratom,(j2) 461: mov j2,fratom 462: br 6$ 463: 14$: dec np 464: sob np,5$ 465: br 30$ 466: .endc 467: 468: 20$: ;here if not supcol, to clear oblist bits 469: call clrobl ;clear bits... 470: ; br 30$ ;and finish up 471: 472: 473: 474: 475: 30$: cmp mfdtpr,cdtpr 476: blos 31$ 477: call globallc 478: mov a,np 479: beq fgcexit 480: movb #1,qmap(a) 481: swab np 482: add #400,np 483: mov cdtpr,j2 484: mov fdtpr,j1 485: call gcwdat 486: mov j1,fdtpr 487: mov j2,cdtpr 488: 31$: cmp mfnumb,cnumber 489: blos 32$ 490: call globallc 491: mov a,np 492: beq fgcexit 493: clrb qmap(a) 494: swab np 495: add #400,np 496: mov cnumber,j2 497: mov fnumber,j1 498: call gcwdatt 499: mov j1,fnumber 500: mov j2,cnumber 501: br 30$ 502: 32$: 503: cmp mfdtpr,cdtpr 504: bhi 30$ 505: 506: resstack: 507: pop np 508: .if df,gctrace 509: npush #anil 510: outstr gcex 511: call dmpport 512: .if df,width 513: clrb poport+1 514: .endc 515: add #-4,np 516: .endc 517: pop j3 518: pop j2 519: pop b 520: pop a 521: pop j1 522: clr gcolf 523: decb noint ;and allow ^c's 524: ret 525: 526: 527: 528: 529: 530: 531: fgcexit: 532: mov 14(sp),saveloc ;save real return 533: mov #1$,14(sp) 534: br resstack ;pop off things 535: 1$: ;and return here... 536: 537: .if ne,xfer ;if we are env xfer material 538: call noroom ;go to routine 539: nroomg: ;leaving trail...... 540: .iff 541: push saveloc ;push return back on 542: save1 543: mov a,j3 ;this saves register a 544: ;now we go into the error routine 545: ;if no more dtprs avail, and brksig#0, then give differnt error, and 546: ;allow break to return to tl. 547: 548: 549: .if ne, brksig 550: tst cdtpr 551: beq fgcebrk 552: .iftf 553: error </cannot reclaim required amount of ints or dtprs/>,3$ 554: 3$: mov j3,a 555: mov 2(sp),j3 556: cmp (sp)+,(sp)+ 557: 4$: jmp gcol 558: .ift 559: fgcebrk: 560: $sig 561: brksig 562: lsploop 563: error </no more dtprs--hit break to return to top level/> 564: .endc 565: 566: .endc 567: .rsect shrcode 568: 569: clrobl: ;this file clears the oblist bits 570: ;used when overflow occurs 571: ;and when gcfinup finishes up 572: .if eq,hash 573: mov xoblist,a 574: 21$: 575: jmpifnil a,30$,nl 576: bic b,(a) ;clear the mark bit 577: car a,j1 578: bic b,(j1) 579: cdr a,a 580: br 21$ 581: .iff 582: mov #<2*hash>,j1 583: 21$: bic b,<hasht-2>(j1) 584: mov <hasht-2>(j1),a 585: 22$: 586: jmpifnil a,23$,nl 587: bic b,(a) 588: mov (a)+,j2 ;get ready for cdr as well as take car 589: bic b,(j2) 590: mov (a),a ;the cdr refered to above 591: br 22$ 592: 23$: dec j1 593: sob j1,21$ 594: .endc 595: ret 596: 597: .rsect shrcode 598: 599: 600: gcolovr: ;this routine takes care of 601: ;gc overflow.............. 602: 603: ;first, restore stack 604: 605: mov gcolf,sp 606: 607: 608: .if ne,gcrec 609: 610: ;rearm stack ovr 611: 612: $sig 613: 11. 614: segfault 615: .if df,gctrace ;get out message... 616: loadnil -(sp) ;load nil on sp 617: mov sp,np ;and fool np 618: generm <//<12>/***attempt to recover from gcol stack overflow ***/<12>//> 619: mov #tmp-<^pl errorm>,a 620: call geterr 621: call putstr 622: call dmpport 623: .if df,width 624: clrb poport+1 625: .endc 626: tst (sp)+ ;back up sp 627: .endc 628: mov #1,b ;leave b ok 629: ;and now scan the env to fix things up... 630: 631: .if eq,multiseg 632: mov #firpage,j3 633: .iff 634: mov #starbc,j3 635: .endc 636: 637: 1$: mov j3,j2 638: mov j3,a 639: swab a 640: add #400,j3 641: movb qmap(a),a 642: bmi 10$ 643: cmp a,#1 644: beq 5$ 645: cmp a,#3 646: bne 1$ ;loop for more... 647: 648: 2$: ;here for binary code 649: .if eq,multiseg ;case for d space only 650: 651: cmp j2,j3 652: bhis 1$ ;done... 653: mov 2(j2),a ;get arg ready 654: mov (j2),j1 655: bic #177000,j1 656: add j1,j2 ;and make j2 point to next 657: bit b,j2 ;if odd, we collect 658: beq 3$ 659: call gcolinr ;collect thing 660: 3$: 661: bic b,j2 662: br 2$ 663: 664: .iff 665: mov j2,j1 666: add #6,j2 667: cmp j2,j3 668: bhis 1$ 669: bit b,(j1)+ 670: beq 2$ 671: mov (j1)+,a 672: call gcolinr 673: br 2$ 674: .endc 675: 676: 677: 678: 679: 5$: ;here for dtprs... 680: 681: bit b,(j2) 682: beq 6$ 683: mov (j2)+,a 684: bic b,a ;clear it 685: call gcolinr 686: mov (j2)+,a 687: call gcolinr 688: br 8$ 689: 6$: 690: cmp (j2)+,(j2)+ 691: 8$: 692: cmp j2,j3 693: blo 5$ 694: br 1$ 695: 696: 697: 10$: 698: .if df,gctrace 699: generm <//<12>/*** about to clear all those oblist bits ***/<12>//> 700: mov #tmp-<^pl errorm>,a 701: call geterr 702: loadnil -(sp) 703: mov sp,np 704: call putstr 705: call dmpport 706: .if df,width 707: clrb poport+1 708: .endc 709: tst (sp)+ 710: mov #1,%0 711: .endc 712: 713: call clrobl ;clear the oblist bits.... 714: .if ne,hash ;gotta clear oblist 715: mov xoblist,a 716: mov #<hash/2>,j1 717: 12$: bic b,(a)+ 718: mov (a),a 719: sob j1,12$ 720: .endc 721: 722: 723: .if df,gctrace 724: 725: generm </about to jump to gcresume/<12>//> 726: mov #tmp-<^pl errorm>,a 727: call geterr 728: loadnil -(sp) 729: mov sp,np 730: call putstr 731: call dmpport 732: .if df,width 733: clrb poport+1 734: .endc 735: tst (sp)+ 736: mov #1,b 737: .endc 738: jmp resgcol 739: .iff 740: 741: generm <//<12>/gc stack overflow--lisp exit/<12>/**********/> 742: mov #tmp-<^pl errorm>,a 743: call geterr 744: loadnil -(sp) 745: mov sp,np 746: call putstr 747: call dmpport 748: $exit 749: .endc
|
Last modified: 1981-05-10
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1459 |
|