1: .globl b1 2: .globl log2 3: .globl frlist 4: .globl stats 5: .globl b1s 6: .globl b1e 7: .globl w1 8: / here to allocate a new block 9: / 10: / 11: / mov ...,r0 12: / jsr pc,allocate 13: / mov r1,... 14: / 15: / requested size in bytes in r0 16: / pointer to header of allocated block returned in r1 17: / r0 is preserved 18: / 19: / convert to words, adjust for header, round up 20: / to a power of two 21: / 22: / each block has a four-word header 23: / W - write ptr (also used as link ptr in frlist) 24: / R - read ptr 25: / A - pointer to head of data 26: / L - ptr to (end+1) of data 27: hsz=6144. 28: datasz = 32768. 29: numb=4. 30: numb2=2*numb 31: w=0 32: r=2 33: a=4 34: l=6 35: / 36: allocate: 37: clr garbage 38: mov r0,-(sp) 39: mov r2,-(sp) 40: mov r3,-(sp) 41: inc stats 42: bne 9f; inc stats; 9: 43: cmp r0,$datasz 44: blo 9f; 4; 9: 45: dec r0 46: bmi 1f 47: jsr pc,log2 48: inc r0 49: 1: asl r0 50: mov r0,-(sp) 51: add $2,r0 52: cmp r0,$frend-frlist+2 53: blo zzz 54: 4 55: / 56: / look on free list for block of required size 57: / 58: zzz: 59: mov (sp),r0 60: tst frlist(r0) 61: beq xxx 62: / 63: / found it, allocate and return 64: / 65: mov frlist(r0),r1 66: add $hblk,r1 67: mov (r1),frlist(r0) 68: mov a(r1),r0 69: mov r0,w(r1) /W 70: mov r0,r(r1) /R 71: tst (sp)+ 72: mov (sp)+,r3 73: mov (sp)+,r2 74: mov (sp)+,r0 75: / jsr pc,whead 76: rts pc 77: / 78: / no block of required size 79: / look for larger block 80: / 81: xxx: 82: tst hblk 83: beq www 84: tst (r0)+ 85: cmp r0,$frend-frlist 86: bhis www 87: tst frlist(r0) 88: bne yyy 89: br xxx 90: / 91: / there are no larger blocks; must garbage collect 92: / 93: www: jsr pc,collect 94: tst r0 95: bne zzz 96: / 97: / out of space 98: / 99: mov $1,r0 100: sys write; 1f; 2f-1f 101: jmp interrupt 102: 1: <Out of space.\n> 103: 2: .even 104: / 105: / split larger block into two smaller pieces and 106: / link together as smaller blocks in the free list. 107: / 108: yyy: 109: mov hblk,r3 /get free header block 110: beq www /should never get this 111: mov frlist(r0),r1 112: add $hblk,r1 113: mov w(r1),frlist(r0) 114: mov r3,w(r1) 115: add $hblk,r3 116: mov exp2-2(r0),r2 117: add a(r1),r2 118: mov w(r3),hblk 119: mov l(r1),l(r3) 120: mov r2,l(r1) /L 121: mov r2,a(r3) 122: clr w(r3) /W' 123: mov r1,r2 124: sub $hblk,r2 125: mov r2,frlist-2(r0) 126: br zzz 127: / 128: / 129: / here to release a block 130: / 131: / mov ...,r1 132: / jsr pc,release 133: / 134: / pointer to block in r1 135: / 136: release: 137: / 138: / discover that this is a plausible pointer 139: / 140: mov r0,-(sp) 141: jsr pc,preposterous 142: / 143: / find free list index and link block to that entry 144: / 145: inc stats+2 146: mov frlist(r0),w(r1) 147: clr r(r1) 148: sub $hblk,r1 149: mov r1,frlist(r0) 150: clr r1 /self-defense 151: mov (sp)+,r0 152: rts pc 153: / 154: / 155: / jsr pc,collect 156: / 157: / coalesce free storage by rejoining paired blocks 158: / on the free list. 159: / zero is returned in r0 if no paired blocks were found. 160: / 161: collect: 162: mov r1,-(sp) 163: mov r2,-(sp) 164: mov r3,-(sp) 165: mov r4,-(sp) 166: clr useful 167: inc stats+4. 168: clr r0 /start with smallest blocks 169: /r0 contains frlist index 170: loop1: mov $frlist,r1 171: add r0,r1 172: / 173: / try next list member at this level 174: / 175: loop2: mov (r1),r3 176: beq advance /list is empty 177: add $hblk,r3 178: tst (r3) /W 179: beq advance /only one list element 180: / 181: / calculate address of buddy 182: / 183: mov a(r3),r4 184: sub $hsz,r4 185: mov exp2(r0),r2 186: xor r2,r4 187: 1: add $hsz,r4 188: / 189: / and search for him 190: / 191: loop3: 192: cmp a(r3),r4 193: beq coal 194: mov r3,r2 195: mov w(r3),r3 196: tst r3 197: beq nocoal 198: add $hblk,r3 199: br loop3 200: / 201: / have found a pair; remove both blocks from list, 202: / coalesce them, and put them on next higher list 203: / 204: coal: mov $1,useful 205: mov w(r3),w(r2) /remove him from list 206: mov (r1),r2 207: add $hblk,r2 208: mov r3,r4 209: mov w(r2),w(r1) /remove other one 210: cmp a(r2),a(r4) 211: bhi 1f 212: mov r2,-(sp) 213: mov r4,r2 214: mov (sp)+,r4 215: 1: mov hblk,(r2) 216: clr r(r2) 217: mov $hsz,a(r2) 218: mov $hsz,l(r2) 219: sub $hblk,r2 220: mov r2,hblk 221: add exp2(r0),l(r4) /L 222: clr r(r4) 223: mov frlist+2(r0),w(r4) 224: sub $hblk,r4 225: mov r4,frlist+2(r0) 226: br loop2 227: / 228: / no buddy found, try next block on this list 229: / 230: nocoal: 231: mov (r1),r1 232: add $hblk,r1 233: br loop2 234: / 235: / advance to next free list 236: / 237: advance: 238: tst (r0)+ 239: cmp r0,$frend-frlist 240: blo loop1 241: mov useful,r0 242: / 243: / do we have enough headers to continue? 244: / 245: tst garbage 246: beq 1f 247: mov $1,r0 248: sys write; 4f; 5f-4f 249: 4 250: / 251: 4: <Out of headers.\n> 252: 5: .even 253: / 254: / 255: / restore registers and return 256: / 257: 1: 258: inc garbage 259: mov (sp)+,r4 260: mov (sp)+,r3 261: mov (sp)+,r2 262: mov (sp)+,r1 263: rts pc 264: / 265: garbage:.=.+2 266: / 267: / routine to find integer part of log2(x) 268: / 269: / jsr pc,log2 270: / 271: / r0 = log2(r0) 272: / 273: log2: 274: mov $15.,-(sp) 275: tst r0 276: bne 1f 277: clr (sp) 278: br 2f 279: 1: asl r0 280: bcs 2f 281: dec (sp) 282: br 1b 283: 2: mov (sp)+,r0 284: rts pc 285: / 286: 0 287: exp2: 288: 1;2;4;10;20;40;100;200;400;1000;2000;4000; 289: 10000;20000;40000;100000 290: / 291: / routine to discover whether r1 points to 292: / a plausible header - to avoid ruination. 293: / 294: / r1 is preserved and r0 gets a suitable index for frlist 295: / 296: / jsr pc,preposterous 297: / 298: preposterous: 299: cmp r1,$headers 300: bhis 9f; 4; 9: 301: cmp r1,$headend 302: blo 9f; 4; 9: 303: cmp a(r1),$hsz /A 304: bhis 9f; 4; 9: 305: cmp l(r1),$hsz+datasz /L 306: blos 9f; 4; 9: 307: mov l(r1),r0 /L 308: sub a(r1),r0 /A 309: mov r0,-(sp) 310: jsr pc,log2 311: asl r0 312: cmp exp2(r0),(sp) 313: beq 9f; 4; 9: 314: add $2,r0 315: cmp r0,$frend-frlist+2 316: blo 9f; 4; 9: 317: sub $2,r0 318: mov r0,(sp) 319: mov frlist(r0),r0 320: 1: beq 1f 321: add $hblk,r0 322: cmp r0,r1 323: bne 9f; 4; 9: 324: mov (r0),r0 325: br 1b 326: 1: mov (sp)+,r0 327: rts pc 328: / 329: / 330: / 331: whead: 332: inc stats+22. 333: mov r0,-(sp) 334: mov afout,r0 335: sys seek; 0; 0 336: sys write; hblk; hsz 337: mov (sp)+,r0 338: rts pc 339: / 340: / 341: initl: 342: clr hblk 343: mov r0,-(sp) 344: mov r2,-(sp) 345: sys open;almem; 1 /open for write 346: bec 2f 347: sys creat;almem; 666 348: bes err2 349: inc hblk 350: 2: 351: mov r0,afout 352: sys open; almem; 0 /open for read 353: bes err2 354: mov r0,afi 355: br 1f 356: / 357: err2: 358: mov $1,r0 359: sys write; 4f; 5f-4f 360: 4 361: .data 362: 4: <cannot open output file\n> 363: 5: 364: almem: <form.m\0> 365: .even 366: .text 367: / 368: 1: 369: tst hblk 370: bgt 1f 371: sys read; hblk; hsz /r0 already afi 372: mov asmdisc,asmem 373: add $hblk,asmem 374: br 2f 375: 1: 376: mov $headers,r2 377: mov r2,r0 378: sub $hblk,r0 379: mov r0,hblk 380: 1: 381: add $8,r0 382: mov r0,(r2) 383: add $8,r2 384: cmp r2,$headend-8. 385: blo 1b 386: clr -8(r2) 387: mov $frlist,r0 388: 1: 389: clr (r0)+ 390: cmp r0,$frend 391: blo 1b 392: 393: mov hblk,r2 394: add $hblk,r2 395: mov (r2),hblk 396: clr w(r2) 397: mov $hsz,a(r2) 398: mov $hsz+datasz,l(r2) 399: mov $datasz,r0 400: jsr pc,log2 401: asl r0 402: cmp r0,$frend-frlist 403: blo 9f; 4; 9: 404: sub $hblk,r2 405: mov r2,frlist(r0) 406: / 407: / install plausible pointers to make octal dumps look nice 408: / 409: mov $hblk,r1 410: 1: 411: mov (r1),r1 412: tst r1 413: beq 1f 414: add $hblk,r1 415: mov $hsz,a(r1) 416: mov $hsz,l(r1) 417: mov $hsz,r(r1) 418: br 1b 419: 1: 420: mov afout,r0 421: sys write;hblk;hsz 422: jsr pc,reset 423: mov $4,r0 424: jsr pc,allocate 425: mov r1,asmem 426: mov r1,asmdisc 427: sub $hblk,asmdisc 428: 2: 429: mov (sp)+,r2 430: mov (sp)+,r0 431: rts pc 432: / 433: / 434: .bss 435: / 436: b1s: .=.+numb2 437: b1e: .=.+numb2 438: w1: .=.+numb2 439: u1: .=.+numb2 440: b1: .=. + [512.*numb] 441: flag: .=.+2 442: stats: .=.+24. /alloc/release/collect/get/put/seek/copy 443: useful: .=.+2 444: afi: .=.+2 445: afout: .=.+2 446: asmem: .=.+2 447: nchar: .=.+2 448: / 449: / 450: hblk: .=.+2 /must remain here - pointer to free header 451: frlist: .=hblk+34. 452: frend: 453: asmdisc:.=.+2 454: headers: .=hblk+hsz 455: headend: 456: .text
Defined functions
Defined variables
|
Last modified: 1975-05-14
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 539 |
|