home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / fort / f3 / f39.s < prev   
Encoding:
Text File  |  1975-07-17  |  2.9 KB  |  259 lines

  1. /
  2. /
  3.  
  4. / f39 -- i/o statements
  5.  
  6. .globl    sread
  7. .globl    swrit
  8. .globl    sprin
  9. .globl    sback
  10. .globl    srewi
  11. .globl    sendf
  12.  
  13. .globl    getsym
  14. .globl    error
  15. .globl    geticon
  16. .globl    e2
  17. .globl    lvalue
  18. .globl    rvalue
  19. .globl    iserror
  20. .globl    convrt
  21. .globl    code
  22. .globl    chrtab
  23. .globl    blocks
  24. .globl    blockp
  25. .globl    doend
  26. .globl    genop
  27. .globl    levzer
  28. .globl    dobeg
  29. .globl    intexp
  30. .globl    ptemp
  31. .globl    blocks
  32. .globl    blockp
  33. .globl    intexp
  34. .globl    newline
  35. .globl    nelem
  36.  
  37. sprin:
  38.     mov    $8.,-(sp)
  39.     jsr    r5,getfmt
  40.         br 9f
  41.     cmp    r0,$36.            / ,
  42.     beq    1f
  43.     cmp    r0,$40.            / =|
  44.     bne    8f
  45.     clrb    (r1)
  46. 1:
  47.     mov    $34.,r0            / simulate )
  48.     br    2f
  49.  
  50. sread:
  51.     mov    $2,-(sp)
  52.     br    1f
  53.  
  54. swrit:
  55.     clr    -(sp)
  56.  
  57. 1:
  58.     cmpb    (r1)+,$'(
  59.     bne    8f
  60.     jsr    r5,intexp
  61.     mov    $blocks,blockp
  62.     cmp    r0,$34.            / ), implies unformatted
  63.     beq    2f
  64.     cmp    r0,$36.            / ,
  65.     bne    8f
  66.     jsr    r5,getfmt
  67.         br 9f
  68.     add    $4,(sp)
  69.     cmp    r0,$34.            / )
  70.     bne    8f
  71. 2:
  72.     mov    (sp),r0
  73.     mov    iotype(r0),r0
  74.     jsr    r5,code
  75.         <    %s\n\0>; .even
  76.         r0
  77. 1:
  78.     tstb    (r1)
  79.     beq    9f
  80. 1:
  81.     jsr    r5,list
  82.     cmp    r0,$40.            / |=
  83.     beq    9f
  84. 8:
  85.     jsr    r5,error; 41.
  86. 9:
  87.     jsr    r5,code
  88.         <    endio\n\0>; .even
  89.     tst    (sp)+
  90.     rts    r5
  91.  
  92. iotype:
  93.     1f
  94.     2f
  95.     3f
  96.     4f
  97.     5f
  98.  
  99. 1:
  100.     <iowu\0>
  101. 2:
  102.     <ioru\0>
  103. 3:
  104.     <iowf\0>
  105. 4:
  106.     <iorf\0>
  107. 5:
  108.     <iowp\0>
  109.     .even
  110.  
  111. getfmt:
  112.     movb    (r1),r0
  113.     cmpb    chrtab(r0),$4        / digit
  114.     beq    1f
  115.     jsr    r5,e2
  116.     jsr    r5,iserror
  117.         rts r5
  118.     mov    r0,-(sp)
  119.     jsr    r5,lvalue
  120.     mov    $blocks,blockp
  121.     br    8f
  122. 1:
  123.     jsr    r5,geticon
  124.         br 8f
  125.     mov    r0,temp
  126.     jsr    r5,ptemp; 'i; temp; line    / register use of format
  127.     jsr    r5,code
  128.         <    lval; .%d\n\0>; .even
  129.         r0
  130.     jsr    r5,getsym
  131.     mov    r0,-(sp)
  132. 8:
  133.     mov    (sp)+,r0
  134.     tst    (r5)+
  135.     rts    r5
  136.  
  137. list:
  138.     jsr    r5,lstitm
  139.     cmp    r0,$36.            / ,
  140.     beq    list
  141.     rts    r5
  142.  
  143. lstitm:
  144.     mov    $blocks,blockp
  145.     cmpb    (r1),$'(        / test for sublist
  146.     beq    1f
  147.     jsr    r5,e2
  148.     jsr    r5,iserror
  149.         rts r5
  150.     mov    r0,-(sp)
  151.     clr    -(sp)
  152.     tst    (r2)
  153.     bne    2f            / test for name
  154.     mov    2(r2),r3
  155.     mov    symtab(r3),r0
  156.     bic    $!70,r0
  157.     cmp    r0,$20            / test for short list
  158.     bne    2f
  159.     mov    pc,(sp)
  160.     mov    symtab+2(r3),r3
  161.     mov    (r3)+,-(sp)
  162.     asl    (sp)
  163.     add    (sp)+,r3
  164.     mov    (r3),r3
  165.     jsr    r5,code
  166.         <    slist1; d%d\n2:\0>; .even
  167.         r3
  168. 2:
  169.     jsr    r5,lvalue
  170.     tst    (sp)
  171.     beq    3f
  172.     jsr    r5,code
  173.         <    slist3\n\0>; .even
  174. 3:
  175.     mov    $"io,r0
  176.     jsr    r5,genop
  177.     tst    (sp)+
  178.     beq    2f
  179.     jsr    r5,code
  180.         <\n    slist2; 2b\0>; .even
  181. 2:
  182.     jsr    r5,newline
  183.     mov    (sp)+,r0
  184.     rts    r5
  185. 1:
  186.     inc    r1
  187.     jsr    r5,levzer; '=
  188.         br  1f            / yes, implied do
  189.     jsr    r5,list
  190.     jsr    r5,chkel
  191.     jsr    r5,getsym
  192.     rts    r5
  193. 1:
  194.     cmp    r1,r0
  195.     bhis    8f
  196.     cmpb    -(r0),$',        / look backwards
  197.     bne    1b
  198.     mov    r0,-(sp)
  199.     mov    r1,-(sp)
  200.     movb    $'),(r0)        / fake!!
  201.     mov    r0,r1
  202.     inc    r1
  203.     clr    r0
  204.     jsr    r5,dobeg        / get do
  205.     jsr    r5,chkel
  206.     mov    (sp)+,r0
  207.     mov    r1,-(sp)
  208.     mov    r0,r1
  209.     jsr    r5,list
  210.     jsr    r5,chkel
  211.     clr    r0
  212.     jsr    r5,doend
  213.     mov    (sp)+,r1
  214.     movb    $',,*(sp)+        / unfake!!
  215.     jsr    r5,getsym
  216.     rts    r5
  217.  
  218. chkel:
  219.     cmp    r0,$34.            / )
  220.     beq    1f
  221. 8:
  222.     jsr    r5,error; 41.
  223. 1:
  224.     rts    r5
  225.  
  226. sback:
  227.     mov    $bksp,r2
  228.     br    1f
  229.  
  230. srewi:
  231.     mov    $rewi,r2
  232.     br    1f
  233.  
  234. sendf:
  235.     mov    $enfl,r2
  236.  
  237. 1:
  238.     mov    r2,-(sp)
  239.     jsr    r5,intexp
  240.     mov    (sp),r2
  241.     jsr    r5,code
  242.         <    %s\n\0>; .even
  243.         r2
  244.     cmp    r0,$40.            / =|
  245.     beq    9f
  246. 8:
  247.     jsr    r5,error; 41.
  248. 9:
  249.     tst    (sp)+
  250.     rts    r5
  251.  
  252. bksp:
  253.     <bksp\0>
  254. rewi:
  255.     <rewi\0>
  256. enfl:
  257.     <enfl\0>
  258.  
  259.