AUSAM/source/S/dc5.s
/
/
/ 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: .=.+20000
strend:
end:
signal = 48.