home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / fort / f4 / f45.s < prev    next >
Encoding:
Text File  |  1975-07-17  |  1.6 KB  |  145 lines
  1. /
  2. /
  3.  
  4. / f45 -- constant pool
  5.  
  6. .globl    constn
  7. .globl    evalcon
  8.  
  9. .globl    error
  10. .globl    perror
  11. .globl    code
  12. .globl    getcon
  13. .globl    setln
  14. .globl    getln
  15. .globl    xbuf
  16. .globl    symbuf
  17. .globl    negflg
  18.  
  19. constn:
  20.     jsr    r5,setln
  21.     mov    $xbuf+518.,r3        / pool max pointer
  22.     mov    $ibuf+518.,r4        / pool pointer pointer
  23. 1:
  24.     jsr    r5,getln
  25.         br 1f
  26.     cmp    r0,$'c
  27.     bne    1b
  28.     jsr    r5,packcon
  29.     mov    r2,-(r4)        / put p ptr in p p ptr
  30.     cmp    r3,r4
  31.     blo    1b
  32.     jsr    r5,error; 99.
  33.     jsr    r5,perror
  34. 1:
  35.     mov    $xbuf+518.,r2
  36. 1:
  37.     cmp    r2,r3
  38.     bhis    1f
  39.     mov    $ibuf+518.,r1
  40. 2:
  41.     cmp    r1,r4
  42.     blo    2f
  43.     cmp    -(r1),r2
  44.     bne    2b
  45.     mov    r1,r0
  46.     sub    $ibuf+516.,r0
  47.     asr    r0
  48.     neg    r0
  49.     jsr    r5,code
  50.         <c%d:\n\0>; .even
  51.         r0
  52.     br    2b
  53. 2:
  54.     mov    (r2)+,r0
  55.     jsr    r5,code
  56.         <    %o\n\0>; .even
  57.         r0
  58.     br    1b
  59. 1:
  60.     rts    r5
  61.  
  62. packcon:
  63.     mov    $line,r1
  64.     jsr    r5,evalcon
  65.     mov    r1,-(sp)
  66.     mov    r3,-(sp)
  67.     sub    r2,(sp)
  68.     asr    (sp)
  69.     mov    r2,-(sp)
  70.     mov    $xbuf+518.,r2
  71. 1:
  72.     mov    (sp),r3
  73.     mov    r2,r1
  74.     tst    (r2)+
  75.     mov    2(sp),r0
  76. 2:
  77.     cmp    (r1)+,(r3)+
  78.     bne    1b
  79.     dec    r0
  80.     bgt    2b
  81.     tst    -(r2)
  82.     mov    (sp)+,r3
  83.     asl    (sp)
  84.     add    r2,(sp)
  85.     cmp    (sp),r3
  86.     blos    1f
  87.     mov    (sp),r3            / eureka
  88. 1:
  89.     tst    (sp)+
  90.     mov    (sp)+,r1
  91.     rts    r5
  92.  
  93. evalcon:
  94.     cmpb    efno,$5
  95.     bne    2f
  96.     movb    efno+1,r0
  97.     mov    r3,r2
  98.     br    1f
  99. 2:
  100.     jsr    r5,getcon
  101.     tst    negflg
  102.     beq    2f
  103.     negf    fr0
  104.     negf    fr1
  105. 2:
  106.     mov    r3,r2
  107.     mov    efno,r0
  108.     mov    r0,r1
  109.     clrb    r0
  110.     swab    r0
  111.     bic    $!7,r1
  112.     cmpb    r1,$realcon
  113.     beq    3f
  114.     cmpb    r1,$cplxcon
  115.     beq    2f
  116.     setl
  117.     movfi    r0,symbuf+1
  118.     seti
  119.     mov    $symbuf+5,r1
  120.     sub    r0,r1
  121.     br    1f
  122. 2:
  123.     mov    $symbuf+1,r1
  124.     movf    fr1,symbuf+1
  125.     cmp    r0,$8
  126.     beq    2f
  127.     movf    fr0,symbuf+9.
  128.     br    1f
  129. 2:
  130.     movf    fr0,symbuf+5
  131.     br    1f
  132. 3:
  133.     movf    fr0,symbuf+1
  134.     mov    $symbuf+1,r1
  135. 1:
  136.     movb    (r1)+,(r3)+
  137.     dec    r0
  138.     bgt    1b
  139.     bit    $1,r3
  140.     beq    1f
  141.     clrb    (r3)+
  142. 1:
  143.     rts    r5
  144.  
  145.