1: / 2: / 3: / here to allocate a new block 4: / 5: / mov ...,r0 6: / jsr pc,allocate 7: / mov r1,... 8: / 9: / requested size in bytes in r0 10: / pointer to header of allocated block returned in r1 11: / r0 is preserved 12: / 13: / convert to words, adjust for header, round up 14: / to a power of two 15: / 16: / each block has a four-word header 17: / W - write ptr (also used as link ptr in frlist) 18: / R - read ptr 19: / A - pointer to head of data 20: / L - ptr to (end+1) of data 21: w=0 22: r=2 23: a=4 24: l=6 25: / 26: allocate: 27: clr garbage 28: mov r0,-(sp) 29: mov r2,-(sp) 30: tst stats 31: bne 1f 32: jsr pc,init 33: 1: 34: inc stats 35: bne 9f; inc stats; 9: 36: cmp r0,$strend-strbuf 37: blos 9f; 4; 9: 38: 1: 39: cmp $8.,r0 40: blo 2f 41: mov $3.,r0 42: br 1f 43: 2: 44: sub $1,r0 45: bmi 1f 46: jsr pc,log2 47: add $1,r0 48: 1: asl r0 /bite to word 49: mov r0,-(sp) 50: add $2,r0 51: cmp r0,$frend-frlist+2 52: blo zzz 53: jmp err 54: / 55: / look on free list for block of required size 56: / 57: zzz: 58: mov (sp),r0 59: tst frlist(r0) 60: beq xxx 61: / 62: / found it, allocate and return 63: / 64: mov frlist(r0),r1 65: mov (r1),frlist(r0) 66: mov a(r1),r0 67: mov r0,w(r1) /W 68: mov r0,r(r1) /R 69: tst (sp)+ 70: mov (sp)+,r2 71: mov (sp)+,r0 72: rts pc 73: / 74: / no block of required size 75: / look for larger block 76: / 77: xxx: 78: tst hdrptr 79: bne 1f 80: mov r0,-(sp) 81: jsr pc,morehd 82: tst r0 83: bne out 84: mov (sp)+,r0 85: 1: 86: tst (r0)+ 87: cmp r0,$frend-frlist 88: bhis www 89: tst frlist(r0) 90: bne yyy 91: br xxx 92: / 93: / there are no larger blocks; must garbage collect 94: / 95: www: 96: jsr pc,collect 97: tst r0 98: bne zzz 99: jsr pc,moresp 100: tst r0 101: beq zzz 102: / 103: / out of space 104: / 105: out: 106: mov $1,r0 107: sys write; 1f; 2f-1f 108: jmp reset 109: 1: <Out of space.\n> 110: 2: .even 111: / 112: / split larger block into two smaller pieces and 113: / link together as smaller blocks in the free list. 114: / 115: yyy: 116: mov frlist(r0),r1 117: mov (r1),frlist(r0) 118: mov hdrptr,r2 119: bne 1f 120: mov r0,-(sp) 121: jsr pc,morehd 122: tst r0 123: bne out 124: mov (sp)+,r0 125: mov hdrptr,r2 126: 1: 127: mov (r2),hdrptr 128: clr (r2) 129: mov r2,(r1) 130: mov r1,hdrptr(r0) 131: mov l(r1),l(r2) 132: mov l(r1),r0 133: sub a(r1),r0 134: asr r0 135: add a(r1),r0 136: mov r0,l(r1) 137: mov r0,a(r2) 138: br zzz 139: / 140: / 141: / here to release a block 142: / 143: / mov ...,r1 144: / jsr pc,release 145: / 146: / pointer to block in r1 147: / 148: release: 149: / 150: / discover that this is a plausible pointer 151: / 152: mov r0,-(sp) 153: jsr pc,preposterous 154: / 155: / find free list index and link block to that entry 156: / 157: inc stats+2 158: mov frlist(r0),(r1) 159: clr r(r1) 160: mov r1,frlist(r0) 161: clr r1 /self-defense 162: mov (sp)+,r0 163: rts pc 164: / 165: / 166: / jsr pc,collect 167: / 168: / coalesce free storage by rejoining paired blocks 169: / on the free list. 170: / zero is returned in r0 if no paired blocks were found. 171: / 172: collect: 173: mov r1,-(sp) 174: mov r2,-(sp) 175: mov r3,-(sp) 176: mov r4,-(sp) 177: clr useful 178: inc stats+4. 179: clr r0 /start with smallest blocks 180: /r0 contains frlist index 181: loop1: mov $frlist,r1 182: add r0,r1 183: / 184: / try next list member at this level 185: / 186: loop2: mov (r1),r3 187: beq advance /list is empty 188: tst *(r1) /W 189: beq advance /only one list element 190: / 191: / calculate address of buddy 192: / 193: mov a(r3),r4 194: mov $block,r2 195: 1: 196: cmp r4,(r2) 197: blo 1f 198: cmp r2,lblock 199: beq 2f 200: add $2,r2 201: br 1b 202: 1: 203: sub $2,r2 204: 2: 205: mov (r2),beg 206: sub beg,r4 207: bit exp2(r0),r4 208: beq 2f 209: bic exp2(r0),r4 210: br 1f 211: 2: bis exp2(r0),r4 212: 1: add beg,r4 213: / 214: / and search for him 215: / 216: loop3: tst 0(r3) 217: beq nocoal 218: mov (r3),r2 219: cmp a(r2),r4 220: beq coal 221: mov (r3),r3 222: br loop3 223: / 224: / have found a pair; remove both blocks from list, 225: / coalesce them, and put them on next higher list 226: / 227: coal: inc useful 228: mov (r3),r4 229: mov (r4),(r3) /remove him from list 230: mov (r1),r2 231: mov (r2),(r1) /remove the other one 232: cmp a(r2),a(r4) 233: bgt 1f 234: mov r2,-(sp) 235: mov r4,r2 236: mov (sp)+,r4 237: 1: add exp2(r0),l(r4) 238: clr r(r4) 239: mov frlist+2(r0),(r4) 240: mov r4,frlist+2(r0) 241: mov hdrptr,(r2) 242: mov r2,hdrptr 243: clr r(r2) 244: mov beg,a(r2) 245: mov beg,l(r2) 246: br loop2 247: / 248: / no buddy found, try next block on this list 249: / 250: nocoal: 251: mov (r1),r1 252: br loop2 253: / 254: / advance to next free list 255: / 256: advance: 257: tst (r0)+ 258: cmp r0,$frend-frlist 259: blo loop1 260: mov useful,r0 261: / 262: / do we have enough headers to continue? 263: / 264: cmp garbage,$2 265: blo 1f 266: mov $1,r0 267: sys write; 4f; 5f-4f 268: jmp reset 269: / 270: 4: <Out of space - too big a block.\n> 271: 5: .even 272: / 273: / 274: / restore registers and return 275: / 276: 1: 277: inc garbage 278: mov (sp)+,r4 279: mov (sp)+,r3 280: mov (sp)+,r2 281: mov (sp)+,r1 282: rts pc 283: / 284: .bss 285: garbage: .=.+2 286: .text 287: / 288: / routine to get more space for strings 289: / 290: moresp: 291: mov r2,-(sp) 292: mov r1,-(sp) 293: mov brk,r1 294: mov $block,r2 295: add nblock,r2 296: cmp r2,$blkend 297: bhis rout 298: mov r1,(r2) 299: mov r1,lblock 300: add $2,nblock 301: add $10000,r1 302: mov r1,9f 303: sys break;9:.. 304: bes 2f 305: mov hdrptr,r2 306: bne 1f 307: jsr pc,morehd 308: tst r0 309: beq 2f 310: mov hdrptr,r2 311: 1: 312: mov (r2),hdrptr 313: mov brk,a(r2) 314: mov r1,brk 315: mov r1,l(r2) 316: clr r(r2) 317: mov $10000,r0 318: jsr pc,log2 319: asl r0 320: mov frlist(r0),w(r2) 321: mov r2,frlist(r0) 322: clr r0 323: mov (sp)+,r1 324: mov (sp)+,r2 325: rts pc 326: 2: 327: mov $1,r0 328: mov (sp)+,r1 329: mov (sp)+,r2 330: rts pc 331: / 332: / routine to get move space for headers 333: / 334: morehd: 335: mov r2,-(sp) 336: mov brk,r0 337: mov $hblock,r2 338: add nhdr,r2 339: cmp r2,$hblkend 340: bhis rout 341: mov r0,(r2) 342: mov r0,lhblock 343: add $2,nhdr 344: add $1024.,r0 345: mov r0,9f 346: sys break;9:.. 347: bes 2f 348: mov brk,r2 349: mov r2,hdrptr 350: mov r0,brk 351: sub $8,r0 352: 1: 353: add $8,r2 354: mov r2,-8(r2) 355: cmp r2,r0 356: blos 1b 357: clr -8(r2) 358: clr r0 359: mov (sp)+,r2 360: rts pc 361: 2: 362: mov $1,r0 363: mov (sp)+,r2 364: rts pc 365: rout: 366: mov $1,r0 367: sys write; 4f; 5f-4f 368: jmp reset 369: / 370: 4: <out of space - no more block storage\n> 371: 5: .even 372: / 373: / routine to find integer part of log2(x) 374: / 375: / jsr pc,log2 376: / 377: / r0 = log2(r0) 378: / 379: log2: 380: mov r0,-(sp) 381: bge 9f; 4; 9: 382: mov $15.,r0 383: 1: 384: rol (sp) 385: bmi 1f 386: sob r0,1b 387: 1: 388: dec r0 389: tst (sp)+ 390: rts pc 391: / 392: 0 /Don't move me, I'm exp(-1) 393: exp2: 394: 1;2;4;10;20;40;100;200;400;1000;2000;4000; 395: 10000;20000;40000;100000 396: / 397: / routine to discover whether r1 points to 398: / a plausible header - to avoid ruination. 399: / 400: / r1 is preserved and r0 gets a suitable index for frlist 401: / 402: / jsr pc,preposterous 403: / 404: preposterous: 405: mov r2,-(sp) 406: mov $hblock,r2 407: 1: 408: cmp r1,(r2) 409: blo 1f 410: cmp (r2),lhblock 411: beq 2f 412: add $2,r2 413: br 1b 414: 1: 415: sub $2,r2 416: 2: 417: mov (r2),r2 418: add $1024.,r2 419: cmp r1,r2 420: blo 9f;4;9: 421: mov $block,r2 422: 1: 423: cmp a(r1),(r2) 424: blo 1f 425: cmp (r2),lblock 426: beq 2f 427: add $2,r2 428: br 1b 429: 1: 430: sub $2,r2 431: 2: 432: cmp l(r1),(r2) 433: bhis 9f;4;9: 434: mov (r2),r2 435: add $10000,r2 436: cmp a(r1),r2 437: blo 9f;4;9: 438: cmp l(r1),r2 439: blos 9f;4;9: 440: mov (sp)+,r2 441: mov l(r1),r0 /L 442: sub a(r1),r0 /A 443: mov r0,-(sp) 444: jsr pc,log2 445: asl r0 446: cmp exp2(r0),(sp) 447: beq 9f; 4; 9: 448: add $2,r0 449: cmp r0,$frend-frlist+2 450: blo 9f; 4; 9: 451: sub $2,r0 452: mov r0,(sp) 453: mov frlist(r0),r0 454: 1: beq 1f 455: cmp r0,r1 456: bne 9f; 4; 9: 457: mov (r0),r0 458: br 1b 459: 1: mov (sp)+,r0 460: rts pc 461: / 462: / 463: / routine to initialize storage area, headers and 464: / free list upon first call to allocate a block. 465: / The entire storage area is formed into a single block. 466: / 467: init: 468: mov r0,-(sp) 469: mov r1,-(sp) 470: / 471: / form all the headers into a single list. 472: / 473: mov $headers,r0 474: mov r0,hdrptr 475: 1: add $8,r0 476: mov r0,-8(r0) 477: cmp r0,$headend-8 478: blos 1b 479: clr -8(r0) 480: mov $frlist,r0 481: 1: clr (r0)+ 482: cmp r0,$frend 483: blo 1b 484: / 485: mov hdrptr,r1 486: mov (r1),hdrptr 487: clr w(r1) 488: mov $strbuf,r0 489: mov r0,a(r1) 490: mov $strend-strbuf,r0 491: jsr pc,log2 492: asl r0 493: cmp r0,$frend-frlist 494: blo 9f; 4; 9: 495: mov r1,frlist(r0) 496: mov exp2(r0),r0 497: add $strbuf,r0 498: mov r0,l(r1) 499: mov $hdrptr,r1 500: 1: mov (r1),r1 501: tst r1 502: beq 1f 503: mov $strbuf,a(r1) 504: mov $strbuf,l(r1) 505: br 1b 506: 1: 507: mov $end,brk 508: add $2,nblock 509: mov $strbuf,block 510: mov $strbuf,lblock 511: mov $headers,hblock 512: add $2,nhdr 513: mov $headers,lhblock 514: mov (sp)+,r1 515: mov (sp)+,r0 516: rts pc 517: / 518: / 519: .bss 520: nhdr: .=.+2 521: lhblock: .=.+2 522: hblock: .=.+20. 523: hblkend: 524: stats: .=.+16. 525: useful: .=.+2 526: beg: .=.+2 527: lblock: .=.+2 528: nblock: .=.+2 529: block: .=.+40. 530: blkend: 531: brk: .=.+2 532: hdrptr: .=.+2 /do not move me 533: frlist: .=hdrptr+32. 534: frend: 535: headers:.=hdrptr+1024. 536: headend: 537: strbuf: .=.+10000 538: strend: 539: end: 540: signal = 48.
|
Last modified: 1975-05-14
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 472 |
|