home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / s1 / form6.s < prev    next >
Encoding:
Text File  |  1975-05-13  |  6.3 KB  |  457 lines
  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
  457.