home *** CD-ROM | disk | FTP | other *** search
- /
- /
- / here to allocate a new block
- /
- / mov ...,r0
- / jsr pc,allocate
- / mov r1,...
- /
- / requested size in bytes in r0
- / pointer to header of allocated block returned in r1
- / r0 is preserved
- /
- / convert to words, adjust for header, round up
- / to a power of two
- /
- / each block has a four-word header
- / W - write ptr (also used as link ptr in frlist)
- / R - read ptr
- / A - pointer to head of data
- / L - ptr to (end+1) of data
- w=0
- r=2
- a=4
- l=6
- /
- allocate:
- clr garbage
- mov r0,-(sp)
- mov r2,-(sp)
- tst stats
- bne 1f
- jsr pc,init
- 1:
- inc stats
- bne 9f; inc stats; 9:
- cmp r0,$strend-strbuf
- blos 9f; 4; 9:
- 1:
- cmp $8.,r0
- blo 2f
- mov $3.,r0
- br 1f
- 2:
- sub $1,r0
- bmi 1f
- jsr pc,log2
- add $1,r0
- 1: asl r0 /bite to word
- mov r0,-(sp)
- add $2,r0
- cmp r0,$frend-frlist+2
- blo zzz
- jmp err
- /
- / look on free list for block of required size
- /
- zzz:
- mov (sp),r0
- tst frlist(r0)
- beq xxx
- /
- / found it, allocate and return
- /
- mov frlist(r0),r1
- mov (r1),frlist(r0)
- mov a(r1),r0
- mov r0,w(r1) /W
- mov r0,r(r1) /R
- tst (sp)+
- mov (sp)+,r2
- mov (sp)+,r0
- rts pc
- /
- / no block of required size
- / look for larger block
- /
- xxx:
- tst hdrptr
- bne 1f
- mov r0,-(sp)
- jsr pc,morehd
- tst r0
- bne out
- mov (sp)+,r0
- 1:
- tst (r0)+
- cmp r0,$frend-frlist
- bhis www
- tst frlist(r0)
- bne yyy
- br xxx
- /
- / there are no larger blocks; must garbage collect
- /
- www:
- jsr pc,collect
- tst r0
- bne zzz
- jsr pc,moresp
- tst r0
- beq zzz
- /
- / out of space
- /
- out:
- mov $1,r0
- sys write; 1f; 2f-1f
- jmp reset
- 1: <Out of space.\n>
- 2: .even
- /
- / split larger block into two smaller pieces and
- / link together as smaller blocks in the free list.
- /
- yyy:
- mov frlist(r0),r1
- mov (r1),frlist(r0)
- mov hdrptr,r2
- bne 1f
- mov r0,-(sp)
- jsr pc,morehd
- tst r0
- bne out
- mov (sp)+,r0
- mov hdrptr,r2
- 1:
- mov (r2),hdrptr
- clr (r2)
- mov r2,(r1)
- mov r1,hdrptr(r0)
- mov l(r1),l(r2)
- mov l(r1),r0
- sub a(r1),r0
- asr r0
- add a(r1),r0
- mov r0,l(r1)
- mov r0,a(r2)
- br zzz
- /
- /
- / here to release a block
- /
- / mov ...,r1
- / jsr pc,release
- /
- / pointer to block in r1
- /
- release:
- /
- / discover that this is a plausible pointer
- /
- mov r0,-(sp)
- jsr pc,preposterous
- /
- / find free list index and link block to that entry
- /
- inc stats+2
- mov frlist(r0),(r1)
- clr r(r1)
- mov r1,frlist(r0)
- clr r1 /self-defense
- mov (sp)+,r0
- rts pc
- /
- /
- / jsr pc,collect
- /
- / coalesce free storage by rejoining paired blocks
- / on the free list.
- / zero is returned in r0 if no paired blocks were found.
- /
- collect:
- mov r1,-(sp)
- mov r2,-(sp)
- mov r3,-(sp)
- mov r4,-(sp)
- clr useful
- inc stats+4.
- clr r0 /start with smallest blocks
- /r0 contains frlist index
- loop1: mov $frlist,r1
- add r0,r1
- /
- / try next list member at this level
- /
- loop2: mov (r1),r3
- beq advance /list is empty
- tst *(r1) /W
- beq advance /only one list element
- /
- / calculate address of buddy
- /
- mov a(r3),r4
- mov $block,r2
- 1:
- cmp r4,(r2)
- blo 1f
- cmp r2,lblock
- beq 2f
- add $2,r2
- br 1b
- 1:
- sub $2,r2
- 2:
- mov (r2),beg
- sub beg,r4
- bit exp2(r0),r4
- beq 2f
- bic exp2(r0),r4
- br 1f
- 2: bis exp2(r0),r4
- 1: add beg,r4
- /
- / and search for him
- /
- loop3: tst 0(r3)
- beq nocoal
- mov (r3),r2
- cmp a(r2),r4
- beq coal
- mov (r3),r3
- br loop3
- /
- / have found a pair; remove both blocks from list,
- / coalesce them, and put them on next higher list
- /
- coal: inc useful
- mov (r3),r4
- mov (r4),(r3) /remove him from list
- mov (r1),r2
- mov (r2),(r1) /remove the other one
- cmp a(r2),a(r4)
- bgt 1f
- mov r2,-(sp)
- mov r4,r2
- mov (sp)+,r4
- 1: add exp2(r0),l(r4)
- clr r(r4)
- mov frlist+2(r0),(r4)
- mov r4,frlist+2(r0)
- mov hdrptr,(r2)
- mov r2,hdrptr
- clr r(r2)
- mov beg,a(r2)
- mov beg,l(r2)
- br loop2
- /
- / no buddy found, try next block on this list
- /
- nocoal:
- mov (r1),r1
- br loop2
- /
- / advance to next free list
- /
- advance:
- tst (r0)+
- cmp r0,$frend-frlist
- blo loop1
- mov useful,r0
- /
- / do we have enough headers to continue?
- /
- cmp garbage,$2
- blo 1f
- mov $1,r0
- sys write; 4f; 5f-4f
- jmp reset
- /
- 4: <Out of space - too big a block.\n>
- 5: .even
- /
- /
- / restore registers and return
- /
- 1:
- inc garbage
- mov (sp)+,r4
- mov (sp)+,r3
- mov (sp)+,r2
- mov (sp)+,r1
- rts pc
- /
- .bss
- garbage: .=.+2
- .text
- /
- / routine to get more space for strings
- /
- moresp:
- mov r2,-(sp)
- mov r1,-(sp)
- mov brk,r1
- mov $block,r2
- add nblock,r2
- cmp r2,$blkend
- bhis rout
- mov r1,(r2)
- mov r1,lblock
- add $2,nblock
- add $10000,r1
- mov r1,9f
- sys break;9:..
- bes 2f
- mov hdrptr,r2
- bne 1f
- jsr pc,morehd
- tst r0
- beq 2f
- mov hdrptr,r2
- 1:
- mov (r2),hdrptr
- mov brk,a(r2)
- mov r1,brk
- mov r1,l(r2)
- clr r(r2)
- mov $10000,r0
- jsr pc,log2
- asl r0
- mov frlist(r0),w(r2)
- mov r2,frlist(r0)
- clr r0
- mov (sp)+,r1
- mov (sp)+,r2
- rts pc
- 2:
- mov $1,r0
- mov (sp)+,r1
- mov (sp)+,r2
- rts pc
- /
- / routine to get move space for headers
- /
- morehd:
- mov r2,-(sp)
- mov brk,r0
- mov $hblock,r2
- add nhdr,r2
- cmp r2,$hblkend
- bhis rout
- mov r0,(r2)
- mov r0,lhblock
- add $2,nhdr
- add $1024.,r0
- mov r0,9f
- sys break;9:..
- bes 2f
- mov brk,r2
- mov r2,hdrptr
- mov r0,brk
- sub $8,r0
- 1:
- add $8,r2
- mov r2,-8(r2)
- cmp r2,r0
- blos 1b
- clr -8(r2)
- clr r0
- mov (sp)+,r2
- rts pc
- 2:
- mov $1,r0
- mov (sp)+,r2
- rts pc
- rout:
- mov $1,r0
- sys write; 4f; 5f-4f
- jmp reset
- /
- 4: <out of space - no more block storage\n>
- 5: .even
- /
- / routine to find integer part of log2(x)
- /
- / jsr pc,log2
- /
- / r0 = log2(r0)
- /
- log2:
- mov r0,-(sp)
- bge 9f; 4; 9:
- mov $15.,r0
- 1:
- rol (sp)
- bmi 1f
- sob r0,1b
- 1:
- dec r0
- tst (sp)+
- rts pc
- /
- 0 /Don't move me, I'm exp(-1)
- exp2:
- 1;2;4;10;20;40;100;200;400;1000;2000;4000;
- 10000;20000;40000;100000
- /
- / routine to discover whether r1 points to
- / a plausible header - to avoid ruination.
- /
- / r1 is preserved and r0 gets a suitable index for frlist
- /
- / jsr pc,preposterous
- /
- preposterous:
- mov r2,-(sp)
- mov $hblock,r2
- 1:
- cmp r1,(r2)
- blo 1f
- cmp (r2),lhblock
- beq 2f
- add $2,r2
- br 1b
- 1:
- sub $2,r2
- 2:
- mov (r2),r2
- add $1024.,r2
- cmp r1,r2
- blo 9f;4;9:
- mov $block,r2
- 1:
- cmp a(r1),(r2)
- blo 1f
- cmp (r2),lblock
- beq 2f
- add $2,r2
- br 1b
- 1:
- sub $2,r2
- 2:
- cmp l(r1),(r2)
- bhis 9f;4;9:
- mov (r2),r2
- add $10000,r2
- cmp a(r1),r2
- blo 9f;4;9:
- cmp l(r1),r2
- blos 9f;4;9:
- mov (sp)+,r2
- mov l(r1),r0 /L
- sub a(r1),r0 /A
- mov r0,-(sp)
- jsr pc,log2
- asl r0
- cmp exp2(r0),(sp)
- beq 9f; 4; 9:
- add $2,r0
- cmp r0,$frend-frlist+2
- blo 9f; 4; 9:
- sub $2,r0
- mov r0,(sp)
- mov frlist(r0),r0
- 1: beq 1f
- cmp r0,r1
- bne 9f; 4; 9:
- mov (r0),r0
- br 1b
- 1: mov (sp)+,r0
- rts pc
- /
- /
- / routine to initialize storage area, headers and
- / free list upon first call to allocate a block.
- / The entire storage area is formed into a single block.
- /
- init:
- mov r0,-(sp)
- mov r1,-(sp)
- /
- / form all the headers into a single list.
- /
- mov $headers,r0
- mov r0,hdrptr
- 1: add $8,r0
- mov r0,-8(r0)
- cmp r0,$headend-8
- blos 1b
- clr -8(r0)
- mov $frlist,r0
- 1: clr (r0)+
- cmp r0,$frend
- blo 1b
- /
- mov hdrptr,r1
- mov (r1),hdrptr
- clr w(r1)
- mov $strbuf,r0
- mov r0,a(r1)
- mov $strend-strbuf,r0
- jsr pc,log2
- asl r0
- cmp r0,$frend-frlist
- blo 9f; 4; 9:
- mov r1,frlist(r0)
- mov exp2(r0),r0
- add $strbuf,r0
- mov r0,l(r1)
- mov $hdrptr,r1
- 1: mov (r1),r1
- tst r1
- beq 1f
- mov $strbuf,a(r1)
- mov $strbuf,l(r1)
- br 1b
- 1:
- mov $end,brk
- add $2,nblock
- mov $strbuf,block
- mov $strbuf,lblock
- mov $headers,hblock
- add $2,nhdr
- mov $headers,lhblock
- mov (sp)+,r1
- mov (sp)+,r0
- rts pc
- /
- /
- .bss
- nhdr: .=.+2
- lhblock: .=.+2
- hblock: .=.+20.
- hblkend:
- stats: .=.+16.
- useful: .=.+2
- beg: .=.+2
- lblock: .=.+2
- nblock: .=.+2
- block: .=.+40.
- blkend:
- brk: .=.+2
- hdrptr: .=.+2 /do not move me
- frlist: .=hdrptr+32.
- frend:
- headers:.=hdrptr+1024.
- headend:
- strbuf: .=.+10000
- strend:
- end:
- signal = 48.
-