home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / s1 / dc1.s < prev    next >
Encoding:
Text File  |  1975-05-13  |  28.4 KB  |  2,543 lines
  1. .globl log2
  2. .globl    getchar
  3. .globl    lookchar
  4. .globl    fsfile
  5. .globl    seekchar
  6. .globl    backspace
  7. .globl    putchar
  8. .globl    alterchar
  9. .globl    move
  10. .globl    rewind
  11. .globl    create
  12. .globl    zero
  13. .globl    allocate
  14. .globl    release
  15. .globl    collect
  16. .globl    w, r, a, l
  17. /
  18.     cmp    (sp)+,$2
  19.     blo    1f
  20.     tst    (sp)+
  21.     mov    (sp)+,0f
  22.     cmpb    *0f,$'-
  23.     beq    8f
  24.     sys    0; 9f
  25. .data
  26. 9:
  27.     sys    open; 0:.=.+2; 0
  28. .text
  29.     bec    2f
  30.     mov    $1,r0
  31.     sys    write; 4f; 5f-4f
  32.     sys    exit
  33.  
  34. /
  35. 4:    <Input file.\n>
  36. 5:    .even
  37. /
  38. 2:
  39.     mov    r0,source
  40. 1:
  41.     sys    signal; 2; 1
  42.     ror    r0
  43.     bcs    1f
  44.     sys    signal; 2; case177
  45. 1:
  46. 8:
  47.     clr    delflag
  48.     mov    $pdl,r5
  49. /
  50.     mov    $10.,r0
  51.     jsr    pc,log2
  52.     mov    r0,log10
  53.     mov    $1,r0
  54.     jsr    pc,allocate
  55.     mov    r1,scalptr
  56.     clr    r0
  57.     jsr    pc,putchar
  58.     clr    r0
  59.     jsr    pc,allocate
  60.     mov    r1,basptr
  61.     mov    $10.,r0
  62.     jsr    pc,putchar
  63.     mov    $1,r0
  64.     jsr    pc,allocate
  65.     mov    r1,inbas
  66.     mov    $10.,r0
  67.     jsr    pc,putchar
  68.     mov    $1,r0
  69.     jsr    pc,allocate
  70.     mov    $10.,r0
  71.     jsr    pc,putchar
  72.     mov    r1,tenptr
  73.     clr    r0
  74.     jsr    pc,allocate
  75.     mov    r1,chptr
  76.     clr    r0
  77.     jsr    pc,allocate
  78.     mov    r1,strptr
  79.     mov    $1,r0
  80.     jsr    pc,allocate
  81.     mov    $2,r0
  82.     jsr    pc,putchar
  83.     mov    r1,sqtemp
  84.     clr    r0
  85.     jsr    pc,allocate
  86.     mov    r1,divxyz
  87. loop:
  88.     tst    delflag
  89.     bne    in177
  90.     mov    sp,errstack
  91.     jsr    pc,readc
  92.     mov    $casetab,r1
  93. 1:    tst    (r1)+
  94.     beq    2f
  95.     cmp    r0,(r1)+
  96.     bne    1b
  97.     jmp    *-4(r1)
  98. 2:    jmp    eh
  99. /
  100. /
  101. /    case for new line (which is special for apl box)
  102. /
  103. case012:
  104.     br    loop
  105. /
  106. /
  107. /    case q for quit
  108. /
  109. case161:
  110.     cmp    readptr,$readstack+2
  111.     blos    1f
  112.     mov    *readptr,r1
  113.     beq    2f
  114.     jsr    pc,release
  115. 2:
  116.     sub    $2,readptr
  117.     mov    *readptr,r1
  118.     beq    2f
  119.     jsr    pc,release
  120. 2:
  121.     sub    $2,readptr
  122.     jmp    loop
  123. 1:
  124.     sys    exit
  125. /
  126. /
  127. /    case Q for controlled quit
  128. /
  129. case121:
  130.     jsr    pc,pop
  131.     jes    eh
  132.     jsr    pc,length
  133.     cmp    r0,$2
  134.     jhi    eh1
  135.     jsr    pc,rewind
  136.     jsr    pc,getchar
  137.     jmi    eh1
  138.     jsr    pc,release
  139. 1:
  140.     cmp    readptr,$readstack
  141.     jlos    eh
  142.     mov    *readptr,r1
  143.     beq    2f
  144.     jsr    pc,release
  145. 2:
  146.     sub    $2,readptr
  147.     sob    r0,1b
  148.     jbr    loop
  149. /
  150. /
  151. /    case of delete character
  152. /
  153. case177:
  154.     sys    signal; 2; case177
  155.     mov    $1,delflag
  156.     mov    r0,-(sp)
  157.     mov    2(sp),r0
  158.     cmp    -6(r0),$sys+read
  159.     bne    1f
  160.     sub    $6,2(sp)
  161.     clr    delflag
  162. 1:
  163.     mov    (sp)+,r0
  164.     2            /rti
  165. /
  166. in177:
  167.     mov    $' ,ch
  168.     mov    $1,r0
  169.     sys    write; 1f; 1
  170.     clr delflag
  171.     jmp    eh
  172. /
  173. .bss
  174. delflag: .=.+2
  175. .text
  176. 1:    <\n>
  177.     .even
  178. /
  179. /
  180. /    case digit
  181. /
  182. case060:
  183.     movb    r0,savec
  184.     jsr    pc,readin
  185.     jsr    pc,push
  186.     br    loop
  187. /
  188. /
  189. /    case _ for negative numbers
  190. /
  191. case137:
  192.     jsr    pc,readin
  193.     jsr    pc,fsfile
  194.     jsr    pc,backspace
  195.     mov    r0,savk
  196.     dec    w(r1)
  197.     jsr    pc,chsign
  198.     mov    savk,r0
  199.     jsr    pc,putchar
  200.     jsr    pc,push
  201.     jbr    loop
  202. /
  203. /
  204. /    case screamer
  205. /
  206. case041:
  207.     jsr    pc,in041
  208.     jbr    loop
  209. /
  210. in041:
  211.     jsr    pc,readc
  212.     cmp    r0,$'<
  213.     jeq    in74a
  214.     cmp    r0,$'=
  215.     jeq    in75a
  216.     cmp    r0,$'>
  217.     jeq    in76a
  218. /
  219.     mov    $field,r1
  220.     movb    r0,(r1)+
  221. 1:
  222.     jsr    pc,readc
  223.     movb    r0,(r1)+
  224.     cmpb    r0,$'\n
  225.     bne    1b
  226.     clrb    (r1)+
  227. /
  228.     sys    fork
  229.         br    9f
  230.     sys    wait
  231.     mov    $1,r0
  232.     sys    write; screamer; 2
  233.     rts    pc
  234. 9:    sys    exec; 6f; 8f
  235.     sys    exit
  236. .data
  237. 8:    6f; 7f; field; 0
  238. 6:    </bin/sh\0>
  239. 7:    <-c\0>
  240. screamer: <!\n>
  241.     .even
  242. .bss
  243. field:    .=.+70.
  244. .text
  245. /
  246. /
  247. /    case d for duplicate
  248. /
  249. case144:
  250.     cmp    r5,$pdl
  251.     jeq    eh
  252.     clr    r0
  253.     jsr    pc,allocate
  254.     mov    -2(r5),r0
  255.     jsr    pc,move
  256.     jsr    pc,push
  257.     jmp    loop
  258. /
  259. /
  260. /    case z for stack size
  261. /
  262. case172:
  263.     clr    r0
  264.     jsr    pc,allocate
  265.     mov    r5,r3
  266.     sub    $pdl,r3
  267.     asr    r3
  268. 2:
  269.     beq    2f
  270.     clr    r2
  271.     dvd    $100.,r2
  272.     mov    r3,r0
  273.     jsr    pc,putchar
  274.     mov    r2,r3
  275.     br    2b
  276. 2:
  277.     clr    r0
  278.     jsr    pc,putchar
  279.     jsr    pc,push
  280.     jmp    loop
  281. /
  282. /
  283. /    case c for flush
  284. /
  285. case143:
  286. 2:    jsr    pc,pop
  287.     jes    loop
  288.     jsr    pc,release
  289.     br    2b
  290. /
  291. /    case s for save
  292. /
  293. case163:
  294.     tst    sfree
  295.     bne    1f
  296.     jsr    pc,sinit
  297. 1:
  298.     jsr    pc,readc
  299.     cmp    r5,$pdl
  300.     bne    2f
  301.     movb    $'s,ch
  302.     jmp    eh
  303. 2:
  304.     clr    r2
  305.     cmpb    r0,$128.    / check for array
  306.     blo    1f
  307.     inc    r2
  308. 1:
  309.     asl    r0
  310.     mov    stable(r0),r1
  311.     beq    2f
  312.     mov    r1,r0
  313.     mov    2(r0),r1
  314.     tst    r2
  315.     beq    4f
  316.     mov    r1,-(sp)    / have array - release elements
  317.     jsr    pc,rewind
  318. 1:
  319.     mov    (sp),r1
  320. 3:
  321.     jsr    pc,getword
  322.     bes    1f
  323.     tst    r0
  324.     beq    3b
  325.     mov    r0,r1
  326.     jsr    pc,release
  327.     br    1b
  328. 1:
  329.     mov    (sp)+,r1
  330. 4:
  331.     jsr    pc,release
  332.     jsr    pc,pop
  333.     mov    r1,2(r0)
  334.     jbr    loop
  335. 2:
  336.     mov    sfree,stable(r0)
  337.     mov    stable(r0),r0
  338.     mov    (r0),sfree
  339.     beq    symout
  340.     clr    (r0)
  341.     jsr    pc,pop
  342.     mov    r1,2(r0)
  343.     jmp    loop
  344. /
  345. symout:
  346.     mov    $1,r0
  347.     sys    write; 7f; 8f-7f
  348.     jmp    reset
  349. /
  350. 7:    <Symbol table overflow.\n>
  351. 8:    .even
  352. /
  353. /
  354. sinit:
  355.     mov    $sfree+4,r0
  356. 1:
  357.     mov    r0,-4(r0)
  358.     clr    -2(r0)
  359.     add    $4,r0
  360.     cmp    r0,$sfend
  361.     blos    1b
  362.     clr    sfend-4
  363.     rts    pc
  364. /
  365. /
  366. .bss
  367. sfree:    .=.+512.
  368. sfend:
  369. .text
  370. /
  371. /
  372. /    case S for save
  373. /
  374. case123:
  375.     tst    sfree
  376.     bne    1f
  377.     jsr    pc,sinit
  378. 1:
  379.     jsr    pc,readc
  380.     cmp    r5,$pdl
  381.     bne    2f
  382.     movb    $'S,ch
  383.     jbr    eh
  384. 2:
  385.     clr    r3
  386.     cmp    r0,$128.    / check for array
  387.     blo    1f
  388.     inc    r3
  389. 1:
  390.     asl    r0
  391.     mov    stable(r0),r1
  392.     beq    2f
  393.     mov    sfree,r2
  394.     mov    (r2),sfree
  395.     beq    symout
  396.     mov    stable(r0),(r2)
  397.     mov    r2,stable(r0)
  398.     jsr    pc,pop
  399.     tst    r3
  400.     beq    1f
  401.     jsr    pc,length    / to make auto arrays work
  402.     cmp    r0,$1
  403.     bhi    1f
  404.     jsr    pc,zero
  405. 1:
  406.     mov    r1,2(r2)
  407.     jbr    loop
  408. 2:
  409.     mov    sfree,stable(r0)
  410.     mov    stable(r0),r2
  411.     mov    (r2),sfree
  412.     beq    symout
  413.     clr    (r2)
  414.     jsr    pc,pop
  415.     tst    r3
  416.     beq    1f
  417.     jsr    pc,length
  418.     cmp    r0,$1
  419.     bhi    1f
  420.     jsr    pc,zero
  421. 1:
  422.     mov    r1,2(r2)
  423.     jbr    loop
  424. /
  425. /
  426. /    case l for load
  427. /
  428. case154:
  429.     jsr    pc,in154
  430.     jmp    loop
  431. /
  432. in154:
  433.     jsr    pc,readc
  434.     clr    r2
  435.     cmp    r0,$128.    / check for array
  436.     blo    1f
  437.     inc    r2
  438. 1:
  439.     asl    r0
  440.     mov    stable(r0),r1
  441.     beq    1f
  442.     mov    2(r1),r1
  443.     mov    r1,-(sp)
  444.     jsr    pc,length
  445.     jsr    pc,allocate
  446.     tst    r2
  447.     beq    2f
  448.     mov    r1,-(sp)    / have array - copy elements
  449.     mov    2(sp),r1
  450.     jsr    pc,rewind
  451. 3:
  452.     mov    2(sp),r1
  453.     jsr    pc,getword
  454.     bes    3f
  455.     tst    r0
  456.     beq    4f
  457.     mov    r0,-(sp)
  458.     mov    r0,r1
  459.     jsr    pc,length
  460.     jsr    pc,allocate
  461.     mov    (sp)+,r0
  462.     jsr    pc,move
  463.     mov    r1,r0
  464.     mov    (sp),r1
  465.     jsr    pc,putword
  466.     br    3b
  467. 4:
  468.     clr    r0
  469.     mov    (sp),r1
  470.     jsr    pc,putword
  471.     br    3b
  472. 3:
  473.     mov    (sp)+,r1
  474.     jsr    pc,push
  475.     tst    (sp)+
  476.     rts    pc
  477. 2:
  478.     mov    (sp)+,r0
  479.     jsr    pc,move
  480.     jsr    pc,push
  481.     rts    pc
  482. 1:
  483.     clr    r0
  484.     jsr    pc,allocate
  485.     jsr    pc,putword
  486.     jsr    pc,push
  487.     rts    pc
  488. /
  489. /    case : for save array
  490. /
  491. case072:
  492.     tst    sfree
  493.     bne    1f
  494.     jsr    pc,sinit
  495. 1:
  496.     jsr    pc,pop
  497.     jes    eh
  498.     jsr    pc,scalint
  499.     jsr    pc,fsfile
  500.     jsr    pc,backspace
  501.     tst    r0
  502.     jmi    eh1    / neg. index
  503.     jsr    pc,length
  504.     cmp    r0,$2
  505.     jhi    eh1    / index too high
  506.     jsr    pc,fsfile
  507.     clr    r3
  508.     cmp    r0,$1
  509.     blo    1f
  510.     beq    2f
  511.     jsr    pc,backspace
  512.     mov    r0,r3
  513.     mul    $100.,r3
  514. 2:
  515.     jsr    pc,backspace
  516.     add    r0,r3
  517.     cmp    r3,$2048.
  518.     jhis    eh1    / index too high
  519.     asl    r3
  520. 1:
  521.     jsr    pc,release
  522.     jsr    pc,readc
  523.     cmp    r5,$pdl
  524.     bne    2f
  525.     movb    $':,ch
  526.     jmp    eh
  527. 2:
  528.     asl    r0
  529.     mov    stable(r0),r1
  530.     beq    2f
  531.     mov    r1,-(sp)
  532.     mov    2(r1),r1
  533.     mov    l(r1),r0
  534.     sub    a(r1),r0
  535.     sub    $2,r0
  536.     cmp    r3,r0
  537.     blos    1f
  538.     mov    r1,-(sp)    / need more space
  539.     mov    r3,r0
  540.     add    $2,r0
  541.     jsr    pc,allocate
  542.     jsr    pc,zero
  543.     mov    (sp)+,r0
  544.     jsr    pc,move
  545.     mov    r1,-(sp)
  546.     mov    r0,r1
  547.     jsr    pc,release
  548.     mov    (sp)+,r1
  549. 1:
  550.     mov    r1,-(sp)
  551.     mov    r3,r0
  552.     jsr    pc,seekchar
  553.     jsr    pc,getword
  554.     bes    1f
  555.     sub    $2,r(r1)
  556.     tst    r0
  557.     beq    1f
  558.     mov    r0,r1
  559.     jsr    pc,release
  560. 1:
  561.     jsr    pc,pop
  562.     jes    eh
  563.     mov    r1,r0
  564.     mov    (sp)+,r1
  565.     jsr    pc,alterchar
  566.     swab    r0
  567.     jsr    pc,alterchar
  568.     mov    (sp)+,r0
  569.     mov    r1,2(r0)
  570.     jmp    loop
  571. 2:
  572.     mov    sfree,stable(r0)
  573.     mov    stable(r0),r0
  574.     mov    (r0),sfree
  575.     jeq    symout
  576.     clr    (r0)
  577.     mov    r0,-(sp)
  578.     mov    r3,r0
  579.     add    $2,r0
  580.     jsr    pc,allocate
  581.     jsr    pc,zero
  582.     sub    $2,r0
  583.     jsr    pc,seekchar
  584.     mov    r1,-(sp)
  585.     br    1b
  586. /
  587. /    case ; for load array
  588. /
  589. case073:
  590.     tst    sfree
  591.     bne    1f
  592.     jsr    pc,sinit
  593. 1:
  594.     jsr    pc,pop
  595.     jes    eh
  596.     jsr    pc,scalint
  597.     jsr    pc,fsfile
  598.     jsr    pc,backspace
  599.     tst    r0
  600.     jmi    eh1    / neg. index
  601.     jsr    pc,length
  602.     cmp    r0,$2
  603.     jhi    eh1
  604.     jsr    pc,fsfile
  605.     clr    r3
  606.     cmp    r0,$1
  607.     blo    1f
  608.     beq    2f
  609.     jsr    pc,backspace
  610.     mov    r0,r3
  611.     mul    $100.,r3
  612. 2:
  613.     jsr    pc,backspace
  614.     add    r0,r3
  615.     cmp    r3,$2048.
  616.     jhis    eh1    / index too high
  617.     asl    r3
  618. 1:
  619.     jsr    pc,release
  620.     jsr    pc,readc
  621.     asl    r0
  622.     mov    stable(r0),r1
  623.     beq    1f
  624.     mov    2(r1),r1
  625.     jsr    pc,length
  626.     sub    $2,r0
  627.     cmp    r3,r0
  628.     bhi    1f    / element not here
  629.     mov    r3,r0
  630.     jsr    pc,seekchar
  631.     jsr    pc,getword
  632.     tst    r0
  633.     beq    1f
  634.     mov    r0,r1
  635.     mov    r1,-(sp)
  636.     jsr    pc,length
  637.     jsr    pc,allocate
  638.     mov    (sp)+,r0
  639.     jsr    pc,move
  640.     jsr    pc,push
  641.     jmp    loop
  642. 1:
  643.     clr    r0
  644.     jsr    pc,allocate
  645.     jsr    pc,putword
  646.     jsr    pc,push
  647.     jmp    loop
  648. /
  649. /
  650. /    case L for load
  651. /
  652. case114:
  653.     jsr    pc,readc
  654.     clr    r2
  655.     cmp    r0,$128.    / check for array
  656.     blo    1f
  657.     inc    r2
  658. 1:
  659.     asl    r0
  660.     mov    stable(r0),r1
  661.     beq    4f
  662.     mov    (r1),stable(r0)
  663.     mov    sfree,(r1)
  664.     mov    r1,sfree
  665.     mov    2(r1),r1
  666.     tst    r2
  667.     beq    2f
  668.     mov    r1,-(sp)    / have array - assume a throw away
  669.     jsr    pc,rewind
  670. 1:
  671.     mov    (sp),r1
  672. 3:
  673.     jsr    pc,getword
  674.     bes    1f
  675.     tst    r0
  676.     beq    3b
  677.     mov    r0,r1
  678.     jsr    pc,release
  679.     br    1b
  680. 1:
  681.     mov    (sp)+,r1
  682. 2:
  683.     jsr    pc,push
  684.     jbr    loop
  685. 4:
  686.     movb    $'L,ch
  687.     jbr    eh
  688. /
  689. /
  690. /    case - for subtract
  691. /
  692. case055:
  693.     jsr    pc,in055
  694.     jmp    loop
  695. /
  696. in055:
  697.     jsr    pc,pop
  698.     jes    eh
  699.     jsr    pc,fsfile
  700.     jsr    pc,backspace
  701.     mov    r0,savk
  702.     dec    w(r1)
  703.     jsr    pc,chsign
  704.     mov    savk,r0
  705.     jsr    pc,putchar
  706.     jsr    pc,push
  707.     br    in053
  708. /
  709. /
  710. /    case + for add
  711. /
  712. case053:
  713.     jsr    pc,in053
  714.     jmp    loop
  715. /
  716. in053:
  717.     jsr    pc,eqk
  718.     mov    $add3,r0
  719.     jsr    pc,binop
  720.     jsr    pc,pop
  721.     mov    savk,r0
  722.     jsr    pc,putchar
  723.     jsr    pc,push
  724.     rts    pc
  725. /
  726. /
  727. /    case * for multiply
  728. /
  729. case052:
  730.     jsr    pc,pop
  731.     jes    eh
  732.     mov    r1,-(sp)
  733.     jsr    pc,pop
  734.     jec    1f
  735.     mov    (sp)+,r1
  736.     jsr    pc,push
  737.     jbr    eh
  738. 1:
  739.     jsr    pc,fsfile
  740.     jsr    pc,backspace
  741.     mov    r0,savk2
  742.     dec    w(r1)
  743.     mov    r1,r2
  744.     mov    (sp)+,r1
  745.     jsr    pc,fsfile
  746.     jsr    pc,backspace
  747.     mov    r0,savk1
  748.     dec    w(r1)
  749.     mov    r1,r3
  750.     mov    $mul3,r0
  751.     jsr    pc,binop
  752.     jsr    pc,pop
  753.     cmp    savk1,savk2
  754.     blo    1f
  755.     mov    savk1,r2
  756.     br    2f
  757. 1:
  758.     mov    savk2,r2
  759. 2:
  760.     cmp    r2,k
  761.     bhis    1f
  762.     mov    k,r2
  763. 1:
  764.     add    savk2,savk1
  765.     cmp    r2,savk1
  766.     bhis    1f
  767.     mov    r2,-(sp)
  768.     neg    r2
  769.     add    savk1,r2
  770.     jsr    pc,removc
  771.     mov    (sp)+,r0
  772. 2:
  773.     jsr    pc,putchar
  774.     jsr    pc,push
  775.     jmp    loop
  776. 1:
  777.     mov    savk1,r0
  778.     br    2b
  779. /
  780. /    r1 = string
  781. /    r2 = count
  782. /    result returned in r1 (old r1 released)
  783. /
  784. removc:
  785.     mov    r1,-(sp)
  786.     jsr    pc,rewind
  787. 1:
  788.     cmp    r2,$1
  789.     blos    1f
  790.     jsr    pc,getchar
  791.     sub    $2,r2
  792.     br    1b
  793. 1:
  794.     mov    $2,r0
  795.     jsr    pc,allocate
  796.     mov    r1,-(sp)
  797. 1:
  798.     mov    2(sp),r1
  799.     jsr    pc,getchar
  800.     bes    1f
  801.     mov    (sp),r1
  802.     jsr    pc,putchar
  803.     mov    r1,(sp)
  804.     br    1b
  805. 1:
  806.     cmp    r2,$1
  807.     bne    1f
  808.     mov    (sp),r3
  809.     mov    tenptr,r2
  810.     jsr    pc,div3
  811.     mov    r1,(sp)
  812.     mov    r3,r1
  813.     jsr    pc,release
  814.     mov    r4,r1
  815.     jsr    pc,release
  816. 1:
  817.     mov    2(sp),r1
  818.     jsr    pc,release
  819.     mov    (sp)+,r1
  820.     tst    (sp)+
  821.     rts    pc
  822. /
  823. /    case / for divide
  824. /
  825. case057:
  826.     jsr    pc,dscale
  827.     mov    $div3,r0
  828.     jsr    pc,binop
  829.     mov    r4,r1
  830.     jsr    pc,release
  831.     jsr    pc,pop
  832.     mov    savk,r0
  833.     jsr    pc,putchar
  834.     jsr    pc,push
  835.     jmp    loop
  836. /
  837. /
  838. dscale:
  839.     jsr    pc,pop
  840.     jes    eh
  841.     mov    r1,-(sp)
  842.     jsr    pc,pop
  843.     bec    1f
  844.     mov    (sp)+,r1
  845.     jsr    pc,push
  846.     jmp    eh
  847. 1:
  848.     mov    r1,-(sp)
  849.     jsr    pc,fsfile
  850.     jsr    pc,backspace
  851.     mov    r0,savk1
  852.     dec    w(r1)
  853.     jsr    pc,rewind
  854.     mov    2(sp),r1
  855.     jsr    pc,fsfile
  856.     jsr    pc,backspace
  857.     mov    r0,savk2
  858.     dec    w(r1)
  859.     mov    k,r2
  860.     sub    savk1,r2
  861.     add    savk2,r2
  862.     mov    k,savk
  863.     mov    (sp)+,r1
  864.     tst    r2
  865.     bmi    1f
  866.     jsr    pc,add0
  867.     br    2f
  868. 1:
  869.     neg    r2
  870.     jsr    pc,removc
  871. 2:
  872.     mov    r1,r3
  873.     mov    (sp)+,r2
  874.     rts    pc
  875. /
  876. /
  877. /    case % for remaindering
  878. /
  879. case045:
  880.     jsr    pc,dscale
  881.     mov    $div3,r0
  882.     jsr    pc,binop
  883.     jsr    pc,pop
  884.     jsr    pc,release
  885.     mov    r4,r1
  886.     mov    savk1,r0
  887.     add    k,r0
  888.     jsr    pc,putchar
  889.     jsr    pc,push
  890.     jmp    loop
  891. /
  892. /
  893. binop:
  894.     jsr    pc,(r0)
  895.     jsr    pc,push
  896.     mov    r2,r1
  897.     jsr    pc,release
  898.     mov    r3,r1
  899.     jsr    pc,release
  900.     rts    pc
  901. /
  902. eqk:
  903.     jsr    pc,pop
  904.     jes    eh
  905.     mov    r1,-(sp)
  906.     jsr    pc,pop
  907.     bec    1f
  908.     mov    (sp)+,r1
  909.     jsr    pc,push
  910.     jbr    eh
  911. 1:
  912.     mov    r1,-(sp)
  913.     mov    2(sp),r1
  914.     jsr    pc,fsfile
  915.     jsr    pc,backspace
  916.     mov    r0,savk1
  917.     dec    w(r1)
  918.     mov    (sp),r1
  919.     jsr    pc,fsfile
  920.     jsr    pc,backspace
  921.     mov    r0,savk2
  922.     dec    w(r1)
  923.     cmp    r0,savk1
  924.     beq    1f
  925.     blo    2f
  926.     mov    savk2,savk
  927.     mov    r0,r2
  928.     sub    savk1,r2
  929.     mov    2(sp),r1
  930.     jsr    pc,add0
  931.     mov    r1,2(sp)
  932.     br    4f
  933. 2:
  934.     mov    savk1,r2
  935.     sub    savk2,r2
  936.     mov    (sp),r1
  937.     jsr    pc,add0
  938.     mov    r1,(sp)
  939. 1:
  940.     mov    savk1,savk
  941. 4:
  942.     mov    2(sp),r3
  943.     mov    (sp)+,r2
  944.     tst    (sp)+
  945.     rts    pc
  946. .bss
  947. savk1:    .=.+2
  948. savk2:    .=.+2
  949. savk:    .=.+2
  950. .text
  951. /
  952. /
  953. /    r2 = count
  954. /    r1 = ptr
  955. /    returns ptr in r1
  956. add0:
  957.     mov    r1,-(sp)
  958.     jsr    pc,length
  959.     jsr    pc,allocate
  960.     clr    r0
  961. 1:
  962.     cmp    r2,$1
  963.     blos    1f
  964.     jsr    pc,putchar
  965.     sub    $2,r2
  966.     br    1b
  967. 1:
  968.     mov    r1,-(sp)
  969.     mov    2(sp),r1
  970.     jsr    pc,rewind
  971. 1:
  972.     jsr    pc,getchar
  973.     bes    1f
  974.     mov    (sp),r1
  975.     jsr    pc,putchar
  976.     mov    r1,(sp)
  977.     mov    2(sp),r1
  978.     br    1b
  979. 1:
  980.     cmp    r2,$1
  981.     bne    1f
  982.     mov    (sp),r3
  983.     mov    tenptr,r2
  984.     jsr    pc,mul3
  985.     mov    r1,(sp)
  986.     mov    r3,r1
  987.     jsr    pc,release
  988. 1:
  989.     mov    2(sp),r1
  990.     jsr    pc,release
  991.     mov    (sp)+,r1
  992.     tst    (sp)+
  993.     rts    pc
  994. /    case i for input base
  995. /
  996. case151:
  997.     jsr    pc,in151
  998.     jmp    loop
  999. /
  1000. in151:
  1001.     jsr    pc,pop
  1002.     jes    eh
  1003.     jsr    pc,scalint
  1004.     mov    r1,-(sp)
  1005.     mov    inbas,r1
  1006.     mov    (sp)+,inbas
  1007.     jsr    pc,release
  1008.     rts    pc
  1009. case111:
  1010.     mov    inbas,r1
  1011.     jsr    pc,length
  1012.     inc    r0
  1013.     jsr    pc,allocate
  1014.     mov    inbas,r0
  1015.     jsr    pc,move
  1016.     clr    r0
  1017.     jsr    pc,putchar    /scale
  1018.     jsr    pc,push
  1019.     jmp    loop
  1020. /
  1021. .bss
  1022. inbas:    .=.+2
  1023. .data
  1024. /
  1025. /
  1026. /    case o for output base
  1027. /
  1028. case157:
  1029.     jsr    pc,in157
  1030.     jmp    loop
  1031. /
  1032. in157:
  1033.     jsr    pc,pop
  1034.     jes    eh
  1035.     jsr    pc,scalint
  1036.     mov    r1,-(sp)
  1037.     jsr    pc,length
  1038.     jsr    pc,allocate
  1039.     mov    (sp),r0
  1040.     jsr    pc,move
  1041.     jsr    pc,fsfile
  1042.     jsr    pc,length
  1043. 1:
  1044.     cmp    r0,$1
  1045.     beq    1f
  1046.     jsr    pc,backspace
  1047.     bpl    2f
  1048.     jsr    pc,chsign
  1049.     jsr    pc,length
  1050.     br    1b
  1051. 2:
  1052.     clr    sav
  1053.     mov    r0,-(sp)
  1054. 2:
  1055.     jsr    pc,backspace
  1056.     bes    2f
  1057.     mov    (sp),r2
  1058.     clr    r3
  1059.     mul    $100.,r2
  1060.     add    r0,r3
  1061.     mov    r3,(sp)
  1062.     tst    sav
  1063.     beq    3f
  1064.     mov    r2,r0
  1065.     clr    r3
  1066.     mov    sav,r2
  1067.     mul    $100.,r2
  1068.     mov    r3,sav
  1069.     add    r0,sav
  1070.     br    2b
  1071. 3:
  1072.     mov    r2,sav
  1073.     br    2b
  1074. 2:
  1075.     mov    (sp)+,r0
  1076.     tst    sav
  1077.     beq    2f
  1078.     mov    sav,r0
  1079.     jsr    pc,log2
  1080.     add    $16.,r0
  1081.     mov    r0,logo
  1082.     br    3f
  1083. 1:
  1084.     jsr    pc,backspace
  1085. 2:
  1086.     tst    r0
  1087.     bpl    1f
  1088.     mov    $15.,logo
  1089.     br    3f
  1090. 1:
  1091.     jsr    pc,log2
  1092.     mov    r0,logo
  1093. 3:
  1094.     jsr    pc,release
  1095.     mov    basptr,r1
  1096.     jsr    pc,release
  1097.     mov    (sp),basptr
  1098. /
  1099. /    set field widths for output
  1100. /    and set output digit handling routines
  1101. /
  1102.     mov    (sp),r1
  1103.     mov    $bigout,outdit
  1104.     jsr    pc,length
  1105.     cmp    r0,$1.
  1106.     bne    2f
  1107.     jsr    pc,fsfile
  1108.     jsr    pc,backspace
  1109.     cmp    r0,$16.
  1110.     bhi    2f
  1111.     mov    $hexout,outdit
  1112. 2:
  1113.     jsr    pc,length
  1114.     jsr    pc,allocate
  1115.     mov    (sp),r0
  1116.     jsr    pc,move
  1117.     clr    (sp)
  1118.     jsr    pc,fsfile
  1119.     jsr    pc,backspace
  1120.     bpl    2f
  1121.     add    $1.,(sp)
  1122.     jsr    pc,chsign
  1123. 2:
  1124.     mov    r1,r2
  1125.     mov    $1,r0
  1126.     jsr    pc,allocate
  1127.     mov    $-1,r0
  1128.     jsr    pc,putchar
  1129.     mov    r1,r3
  1130.     jsr    pc,add3
  1131.     jsr    pc,length
  1132.     asl    r0
  1133.     add    r0,(sp)
  1134.     jsr    pc,fsfile
  1135.     jsr    pc,backspace
  1136.     cmp    r0,$9.
  1137.     blos    2f
  1138.     add    $1,(sp)
  1139. 2:
  1140.     jsr    pc,release
  1141.     mov    r2,r1
  1142.     jsr    pc,release
  1143.     mov    r3,r1
  1144.     jsr    pc,release
  1145.     mov    (sp)+,fw
  1146.     mov    fw,fw1
  1147.     dec    fw1
  1148.     cmp    outdit,$hexout
  1149.     bne    2f
  1150.     mov    $1,fw
  1151.     clr    fw1
  1152. 2:
  1153.     mov    $70.,ll
  1154.     cmp    fw,$70.
  1155.     blo 9f; rts pc; 9:
  1156.     mov    $70.,r1
  1157.     clr    r0
  1158.     dvd    fw,r0
  1159.     mov    r0,r1
  1160.     mpy    fw,r1
  1161.     mov    r1,ll
  1162.     rts    pc
  1163. case117:
  1164.     mov    basptr,r1
  1165.     jsr    pc,length
  1166.     inc    r0
  1167.     jsr    pc,allocate
  1168.     mov    basptr,r0
  1169.     jsr    pc,move
  1170.     clr    r0
  1171.     jsr    pc,putchar    /scale
  1172.     jsr    pc,push
  1173.     jmp    loop
  1174. /
  1175. .data
  1176. fw:    1            /field width for digits
  1177. fw1:    0
  1178. ll:    70.            /line length
  1179. .text
  1180. /
  1181. /
  1182. /    case k for skale factor
  1183. /
  1184. case153:
  1185.     jsr    pc,pop
  1186.     jes    eh
  1187.     jsr    pc,scalint
  1188.     mov    w(r1),r0
  1189.     sub    a(r1),r0
  1190.     cmp    r0,$1
  1191.     jhi    eh1
  1192.     jsr    pc,rewind
  1193.     jsr    pc,getchar
  1194.     jmi    eh1
  1195.     mov    r0,k
  1196.     mov    r1,-(sp)
  1197.     mov    scalptr,r1
  1198.     jsr    pc,release
  1199.     mov    (sp)+,scalptr
  1200.     jmp    loop
  1201. /
  1202. case113:
  1203.     mov    scalptr,r1
  1204.     jsr    pc,length
  1205.     inc    r0
  1206.     jsr    pc,allocate
  1207.     mov    scalptr,r0
  1208.     jsr    pc,move
  1209.     clr    r0
  1210.     jsr    pc,putchar
  1211.     jsr    pc,push
  1212.     jmp    loop
  1213. scalint:
  1214.     jsr    pc,fsfile
  1215.     jsr    pc,backspace
  1216.     dec    w(r1)
  1217.     mov    r0,r2
  1218.     jsr    pc,removc
  1219.     rts    pc
  1220. /
  1221. /    case ^ for exponentiation
  1222. /
  1223. case136:
  1224.     jsr    pc,pop
  1225.     jes    eh
  1226.     jsr    pc,scalint
  1227.     jsr    pc,fsfile
  1228.     jsr    pc,backspace
  1229.     tst    r0
  1230.     bge    1f
  1231.     inc    negexp
  1232.     jsr    pc,chsign
  1233. 1:
  1234.     jsr    pc,length
  1235.     cmp    r0,$3
  1236.     jhis    eh1
  1237.     mov    r1,r3
  1238.     jsr    pc,pop
  1239.     jes    eh
  1240.     jsr    pc,fsfile
  1241.     jsr    pc,backspace
  1242.     mov    r0,savk
  1243.     dec    w(r1)
  1244.     mov    r1,r2
  1245.     jsr    pc,exp3
  1246.     mov    r1,-(sp)
  1247.     mov    r2,r1
  1248.     jsr    pc,release
  1249.     mov    r3,r1
  1250.     jsr    pc,rewind
  1251.     jsr    pc,getchar
  1252.     mov    r0,-(sp)
  1253.     jsr    pc,getchar
  1254.     bes    2f
  1255.     mov    r0,r1
  1256.     mul    $100.,r1
  1257.     add    (sp)+,r1
  1258.     br    3f
  1259. 2:
  1260.     mov    (sp)+,r1
  1261. 3:
  1262.     mul    savk,r1
  1263.     mov    r1,r2
  1264.     mov    r3,r1
  1265.     jsr    pc,release
  1266.     tst    negexp
  1267.     bne    4f
  1268.     cmp    k,savk
  1269.     blo    1f
  1270.     mov    k,r3
  1271.     br    2f
  1272. 1:
  1273.     mov    savk,r3
  1274. 2:
  1275.     cmp    r3,r2
  1276.     bhis    4f
  1277.     sub    r3,r2
  1278.     mov    (sp)+,r1
  1279.     mov    r3,-(sp)
  1280.     jsr    pc,removc
  1281.     mov    (sp)+,r0
  1282.     jsr    pc,putchar
  1283.     jsr    pc,push
  1284.     br    3f
  1285. 4:
  1286.     mov    (sp)+,r1
  1287.     mov    r2,r0
  1288.     jsr    pc,putchar
  1289.     jsr    pc,push
  1290. 3:
  1291.     tst    negexp
  1292.     jeq    loop
  1293.     clr    negexp
  1294.     jsr    pc,pop
  1295.     mov    r1,-(sp)
  1296.     mov    $2,r0
  1297.     jsr    pc,allocate
  1298.     mov    $1,r0
  1299.     jsr    pc,putchar
  1300.     clr    r0
  1301.     jsr    pc,putchar
  1302.     jsr    pc,push
  1303.     mov    (sp)+,r1
  1304.     jsr    pc,push
  1305.     jmp    case057
  1306. /
  1307. .bss
  1308. sav:    .=.+2
  1309. negexp:    .=.+2
  1310. .text
  1311. /
  1312. /    case v for square root
  1313. /
  1314. case166:
  1315.     jsr    pc,pop
  1316.     jes    eh
  1317. /
  1318.     jsr    pc,fsfile
  1319.     jsr    pc,backspace
  1320.     mov    r0,savk
  1321.     dec    w(r1)
  1322.     mov    w(r1),r2
  1323.     sub    a(r1),r2
  1324.     tst    r2
  1325.     beq    sqz
  1326.     jsr    pc,backspace
  1327.     tst    r0
  1328.     jmi    eh1
  1329.     mov    k,r2
  1330.     asl    r2
  1331.     sub    savk,r2
  1332.     beq    1f
  1333.     blo    2f
  1334.     jsr    pc,add0
  1335.     br    1f
  1336. 2:
  1337.     neg    r2
  1338.     jsr    pc,removc
  1339. 1:
  1340.     jsr    pc,sqrt
  1341.     mov    k,r0
  1342.     jsr    pc,putchar
  1343.     jsr    pc,push
  1344.     jmp    loop
  1345. /
  1346. /
  1347. sqz:
  1348.     mov    savk,r0
  1349.     jsr    pc,putchar
  1350.     jsr    pc,push
  1351.     jmp    loop
  1352. .bss
  1353. sqtemp:    .=.+2
  1354. .text
  1355. /
  1356. /
  1357. /    case [ for subroutine definition
  1358. /
  1359. case133:
  1360.     clr    -(sp)
  1361.     clr    r0
  1362.     jsr    pc,allocate
  1363.     jsr    pc,push
  1364. 1:    jsr    pc,readc
  1365.     cmp    r0,$']
  1366.     bne    3f
  1367.     tst    (sp)
  1368.     beq    1f
  1369.     dec    (sp)
  1370.     br    2f
  1371. 3:
  1372.     cmp    r0,$'[
  1373.     bne    2f
  1374.     inc    (sp)
  1375. 2:
  1376.     jsr    pc,putchar
  1377.     br    1b
  1378. /
  1379. 1:    tst    (sp)+
  1380.     jmp    loop
  1381. /
  1382. /
  1383. /    case x for execute top of stack
  1384. /
  1385. case170:
  1386.     jsr    pc,in170
  1387.     jmp    loop
  1388. /
  1389. in170:
  1390.     jsr    pc,pop
  1391.     jes    eh
  1392.     mov    r1,-(sp)
  1393.     tst    *readptr
  1394.     beq    1f
  1395.     mov    *readptr,r1
  1396.     cmp    r(r1),w(r1)
  1397.     bne    1f
  1398.     jsr    pc,release
  1399.     br    2f
  1400. 1:
  1401.     add    $2,readptr
  1402.     cmp    readptr,$readtop
  1403.     bhis    1f
  1404. 2:    mov    (sp)+,r1
  1405.     mov    r1,*readptr
  1406.     beq    2f
  1407.     jsr    pc,rewind
  1408.     rts    pc
  1409. 2:
  1410.     jsr    pc,readc
  1411.     cmp    r0,$'\n
  1412.     beq    3f
  1413.     mov    r0,savec
  1414. 3:
  1415.     rts    pc
  1416. 1:
  1417. nderr:
  1418.     mov    $1,r0
  1419.     sys    write; 1f; 2f-1f
  1420.     jmp    reset
  1421. 1:    <Nesting depth.\n>
  1422. 2:    .even
  1423. /
  1424. .data
  1425. readptr: readstack
  1426. .bss
  1427. readstack: .=.+100.
  1428. readtop:
  1429. .text
  1430. /
  1431. /    case ? for apl box function
  1432. /
  1433. case077:
  1434.     add    $2,readptr
  1435.     cmp    readptr,$readtop
  1436.     bhis    nderr
  1437.     clr    *readptr
  1438. in077:
  1439.     mov    source,-(sp)
  1440.     clr    source
  1441.     jsr    pc,readc
  1442.     cmp    r0,$'!
  1443.     bne    1f
  1444.     jsr    pc,in041
  1445.     mov    (sp)+,source
  1446.     br    in077
  1447. 1:
  1448.     mov    r0,savec
  1449.     clr    r0
  1450.     jsr    pc,allocate
  1451. 2:
  1452.     jsr    pc,readc
  1453.     jsr    pc,putchar
  1454. 1:
  1455.     jsr    pc,readc
  1456.     jsr    pc,putchar
  1457.     cmp    r0,$'\\
  1458.     beq    2b
  1459.     cmp    r0,$'\n
  1460.     bne    1b
  1461.     mov    (sp)+,source
  1462.     mov    r1,*readptr
  1463.     jmp    loop
  1464. /
  1465. /
  1466. /    case < for conditional execution
  1467. /
  1468. case074:
  1469.     jsr    pc,in074
  1470.     ble    neg074
  1471.     jmp    aff074
  1472. /
  1473. /
  1474. /    case !< for conditional execution
  1475. /
  1476. in74a:
  1477.     jsr    pc,in074
  1478.     bgt    inneg
  1479.     jmp    inaff
  1480. /
  1481. in074:
  1482.     jsr    pc,in055    /go subtract
  1483.     jsr    pc,pop
  1484.     jsr    pc,length
  1485.     tst    r0
  1486.     beq    1f
  1487.     jsr    pc,fsfile
  1488.     jsr    pc,backspace
  1489.     jsr    pc,backspace
  1490.     tst    r0
  1491. 1:
  1492.     rts    pc
  1493. /
  1494. aff074:
  1495.     jsr    pc,release
  1496.     jsr    pc,in154    /load from register
  1497.     jmp    case170
  1498. /
  1499. neg074:
  1500.     jsr    pc,release
  1501.     jsr    pc,readc
  1502.     jmp    loop
  1503. /
  1504. /
  1505. /    case = for conditional execution
  1506. /
  1507. case075:
  1508.     jsr    pc,in074
  1509.     beq    aff074
  1510.     jmp    neg074
  1511. /
  1512. /
  1513. /    case != for conditional execution
  1514. /
  1515. in75a:
  1516.     jsr    pc,in074
  1517.     bne    inaff
  1518.     jmp    inneg
  1519. /
  1520. /
  1521. /    case > for conditional execution
  1522. /
  1523. case076:
  1524.     jsr    pc,in074
  1525.     bge    neg074
  1526.     jmp    aff074
  1527. /
  1528. /
  1529. /    case !> for conditional execution
  1530. /
  1531. in76a:
  1532.     jsr    pc,in074
  1533.     blt    inneg
  1534.     jmp    inaff
  1535. /
  1536. inaff:
  1537.     jsr    pc,release
  1538.     jsr    pc,in154
  1539.     jsr    pc,in170
  1540.     rts    pc
  1541. /
  1542. inneg:
  1543.     jsr    pc,release
  1544.     jsr    pc,readc
  1545.     rts    pc
  1546. /
  1547. err:
  1548.     mov    $1,r0
  1549.     sys    write; 1f; 2f-1f
  1550.     jmp    reset
  1551. 1:    <Fatal error\n>; 2: .even
  1552. /
  1553. eh1:
  1554.     jsr    pc,release
  1555. eh:
  1556.     movb    ch,1f+2
  1557.     mov    $1,r0
  1558.     sys    write; 1f; 2f-1f
  1559.     mov    $readstack,readptr
  1560.     mov    errstack,sp
  1561.     jmp    loop
  1562. .data
  1563. 1:    <(  ) ?\n>
  1564. 2:    .even
  1565. .text
  1566. /
  1567. /
  1568. /    routine to read and convert a number from the
  1569. /    input stream.  Numbers beginnig with 0 are
  1570. /    converted as octal.  Routine converts
  1571. /    up to next nonnumeric.
  1572. /
  1573. /
  1574. readin:
  1575.     clr    dp
  1576.     clr    dpt
  1577.     clr    r0
  1578.     jsr    pc,allocate
  1579.     mov    r1,-(sp)
  1580.     mov    strptr,r1
  1581.     jsr    pc,create
  1582.     jsr    pc,readc
  1583. 1:
  1584.     cmpb    ch,$'0
  1585.     blt    3f
  1586.     cmpb    ch,$'9
  1587.     bgt    3f
  1588.     mov    ch,r0
  1589.     sub    $'0,r0
  1590. 4:
  1591.     tst    dp
  1592.     beq    8f
  1593.     cmp    dpt,$99.
  1594.     beq    5f
  1595.     inc    dpt
  1596. 8:
  1597.     mov    chptr,r1
  1598.     jsr    pc,create
  1599.     tst    r0
  1600.     beq    2f
  1601.     jsr    pc,putchar
  1602. 2:    mov    r1,chptr
  1603.     mov    (sp),r3
  1604.     mov    inbas,r2
  1605.     jsr    pc,mul3
  1606.     mov    r1,(sp)
  1607.     mov    r3,r1
  1608.     jsr    pc,release
  1609.     mov    (sp),r3
  1610.     mov    chptr,r2
  1611.     jsr    pc,add3
  1612.     mov    r1,(sp)
  1613.     mov    r3,r1
  1614.     jsr    pc,release
  1615. 5:
  1616.     jsr    pc,readc
  1617.     mov    r0,ch
  1618.     br    1b
  1619. 3:
  1620.     cmpb    ch,$'A
  1621.     blt    1f
  1622.     cmpb    ch,$'F
  1623.     bgt    1f
  1624.     mov    ch,r0
  1625.     sub    $67,r0
  1626.     br    4b
  1627. 1:
  1628.     cmpb    ch,$134        /backslash
  1629.     bne    1f
  1630.     jsr    pc,readc
  1631.     br    5b
  1632. 1:
  1633.     cmpb    ch,$'.
  1634.     bne    1f
  1635.     tst    dp
  1636.     bne    1f
  1637.     inc    dp
  1638.     clr    dpt
  1639.     br    5b
  1640. 1:
  1641.     mov    r0,savec
  1642. /
  1643. /    scale up or down
  1644. 2:
  1645.     tst    dp
  1646.     bne    1f
  1647.     mov    (sp)+,r1
  1648.     clr    r0
  1649.     jsr    pc,putchar
  1650.     rts    pc
  1651. 1:
  1652.     mov    (sp),r1
  1653.     jsr    pc,scale
  1654.     mov    dpt,r0
  1655.     jsr    pc,putchar
  1656.     tst    (sp)+
  1657.     rts    pc
  1658. /
  1659. .bss
  1660. dp:    .=.+2
  1661. dpt:    .=.+2
  1662. .text
  1663. /
  1664. scale:
  1665.     mov    dpt,r2
  1666.     jsr    pc,add0
  1667.     mov    r1,-(sp)
  1668.     mov    $1,r0
  1669.     jsr    pc,allocate
  1670.     mov    dpt,r0
  1671.     jsr    pc,putchar
  1672.     mov    r1,r3
  1673.     mov    inbas,r2
  1674.     jsr    pc,exp3
  1675.     mov    r1,-(sp)
  1676.     mov    r3,r1
  1677.     jsr    pc,release
  1678.     mov    (sp)+,r2
  1679.     mov    (sp)+,r3
  1680.     jsr    pc,div3
  1681.     mov    r1,-(sp)
  1682.     mov    r2,r1
  1683.     jsr    pc,release
  1684.     mov    r3,r1
  1685.     jsr    pc,release
  1686.     mov    r4,r1
  1687.     jsr    pc,release
  1688.     mov    (sp)+,r1
  1689.     rts    pc
  1690. /
  1691. /    routine to read another character from the input
  1692. /    stream.  If the caller does not want the character,
  1693. /    it is to be placed in the cell savec.
  1694. /    The routine exits to the system on end of file.
  1695. /    Character is returned in r0.
  1696. /
  1697. /    jsr    pc,readc
  1698. /    movb    r0,...
  1699. /
  1700. /
  1701. readc:
  1702.     tst    savec
  1703.     beq    1f
  1704.     movb    savec,r0
  1705.     bic    $177400,r0
  1706.     clr    savec
  1707.     rts    pc
  1708. 1:
  1709.     tst    *readptr
  1710.     bne    1f
  1711. 2:    mov    source,r0
  1712.     sys    read; ch; 1
  1713.     bes    eof
  1714.     tst    r0
  1715.     beq    eof
  1716.     movb    ch,r0
  1717.     bic    $177400,r0
  1718.     rts    pc
  1719. 1:
  1720.     mov    r1,-(sp)
  1721.     mov    *readptr,r1
  1722.     jsr    pc,getchar
  1723.     bes    eof1
  1724.     bic    $177400,r0
  1725.     mov    r0,ch
  1726.     mov    (sp)+,r1
  1727.     rts    pc
  1728. /
  1729. eof:
  1730.     tst    source
  1731.     beq    1f
  1732.     clr    source
  1733.     br    2b
  1734. 1:
  1735.     sys    exit
  1736. /
  1737. eof1:
  1738.     mov    *readptr,r1
  1739.     beq    2f
  1740.     jsr    pc,release
  1741. 2:
  1742.     sub    $2,readptr
  1743.     mov    (sp)+,r1
  1744.     jmp    readc
  1745. /
  1746. /
  1747. /    case p for print
  1748. /
  1749. case160:
  1750.     cmp    r5,$pdl
  1751.     jeq    eh
  1752.     jsr    pc,in160
  1753.     jmp    loop
  1754. /
  1755. /
  1756. in160:
  1757. /    mov    $1,r0
  1758. /    sys    write; sphdr; 4
  1759.     br    1f
  1760. /
  1761. sphdr:    <    >
  1762.     .even
  1763. /
  1764. 1:    cmp    r5,$pdl
  1765.     bne    1f
  1766.     mov    $1,r0
  1767.     sys    write; qm; 1
  1768.     mov    $1,r0
  1769.     sys    write; nl; 1
  1770.     rts    pc
  1771. /
  1772. /    do the conversion
  1773. /
  1774. 1:
  1775.     mov    -2(r5),r1
  1776.     jsr    pc,printf
  1777.     rts    pc
  1778. /
  1779. /
  1780. /    case f for print the stack
  1781. /
  1782. case146:
  1783.     mov    r5,-(sp)
  1784. 1:
  1785.     cmp    r5,$pdl
  1786.     beq    2f
  1787. 1:
  1788.     jsr    pc,in160
  1789.     jsr    pc,pop
  1790.     cmp    r5,$pdl
  1791.     bne    1b
  1792. 2:
  1793.     mov    $stable-2,r2
  1794. 1:
  1795.     tst    (r2)+
  1796.     cmp    r2,$stable+254.
  1797.     bhi    1f
  1798. /
  1799.     mov    (r2),r3
  1800.     beq    1b
  1801.     movb    $'0,7f+3
  1802.     mov    r2,r0
  1803.     sub    $stable,r0
  1804.     asr    r0
  1805.     movb    r0,7f+1
  1806. 3:
  1807.     mov    $1,r0
  1808.     sys    write; 7f; 8f-7f
  1809. .data
  1810. 7:    <" (0)">
  1811. 8:    .even
  1812. .text
  1813.     mov    2(r3),r1
  1814.     jsr    pc,printf
  1815.     tst    (r3)
  1816.     beq    1b
  1817.     incb    7b+3
  1818.     mov    (r3),r3
  1819.     br    3b
  1820. 1:
  1821.     mov    (sp)+,r5
  1822.     jbr    loop
  1823. /
  1824. /
  1825. /    routine to convert to decimal and print the
  1826. /    top element of the stack.
  1827. /
  1828. /    jsr    pc,printf
  1829. /
  1830. /
  1831. printf:
  1832.     mov    r4,-(sp)
  1833.     mov    r3,-(sp)
  1834.     mov    r2,-(sp)
  1835.     mov    r1,-(sp)
  1836.     mov    r0,-(sp)
  1837.     clr    -(sp)
  1838.     jsr    pc,rewind
  1839. 2:
  1840.     jsr    pc,getchar
  1841.     bes    2f
  1842.     cmp    r0,$143
  1843.     blos    2b
  1844.     cmp    r0,$-1
  1845.     beq    2b
  1846.     bis    $1,(sp)
  1847.     br    2b
  1848. 2:
  1849.     tst    (sp)+
  1850.     beq    2f
  1851.     jsr    pc,length
  1852.     mov    r0,0f
  1853.     mov    a(r1),3f
  1854.     mov    $1,r0
  1855.     sys    0; 9f
  1856. .data
  1857. 9:
  1858.     sys    write; 3:.=.+2; 0:.=.+2
  1859. .text
  1860.     jbr    prout
  1861. 2:
  1862.     jsr    pc,fsfile
  1863.     jsr    pc,backspace
  1864.     bec    1f
  1865.     mov    $1,r0
  1866.     sys    write; asczero; 1
  1867.     jbr    prout
  1868. 1:
  1869.     jsr    pc,length
  1870.     mov    r1,-(sp)
  1871.     jsr    pc,allocate
  1872.     mov    (sp),r0
  1873.     mov    r1,(sp)
  1874.     jsr    pc,move
  1875.     mov    ll,count
  1876. /    inc    count
  1877.     jsr    pc,fsfile
  1878.     jsr    pc,backspace
  1879.     mov    r0,savk
  1880.     dec    w(r1)
  1881.     jsr    pc,backspace
  1882.     cmpb    r0,$-1
  1883.     bne    2f
  1884.     mov    basptr,r1
  1885.     jsr    pc,fsfile
  1886.     jsr    pc,backspace
  1887.     cmp    r0,$-1
  1888.     beq    2f
  1889.     mov    (sp),r1
  1890.     jsr    pc,chsign
  1891.     mov    $'-,ch
  1892.     jsr    pc,wrchar
  1893.     br    1f
  1894. 2:
  1895. /    mov    $' ,ch
  1896. /    jsr    pc,wrchar
  1897. 1:
  1898.     mov    strptr,r1
  1899.     jsr    pc,create
  1900.     mov    basptr,r1
  1901.     jsr    pc,length
  1902.     cmp    r0,$1
  1903.     jlo    dingout
  1904.     bne    1f
  1905.     jsr    pc,rewind
  1906.     jsr    pc,getchar
  1907.     cmp    r0,$1.
  1908.     jeq    unout
  1909.     cmp    r0,$-1
  1910.     jeq    dingout
  1911.     cmp    r0,$10.
  1912.     jeq    tenout
  1913. 1:
  1914.     mov    log10,r1
  1915.     mul    savk,r1
  1916.     clr    r0
  1917.     div    logo,r0
  1918.     mov    r0,dout
  1919.     clr    ct
  1920. 1:
  1921.     mov    (sp),r3
  1922.     mov    savk,r2
  1923.     jsr    pc,getdec
  1924.     mov    r1,decimal
  1925.     clr    dflg
  1926.     mov    (sp),r1
  1927.     mov    savk,r2
  1928.     jsr    pc,removc
  1929.     mov    r1,(sp)
  1930. 1:
  1931.     mov    (sp),r3
  1932.     mov    basptr,r2
  1933.     jsr    pc,div3
  1934.     mov    r1,r2
  1935.     mov    (sp),r1
  1936.     jsr    pc,release
  1937.     mov    r2,(sp)
  1938.     mov    r4,r1
  1939.     jsr    pc,*outdit
  1940.     mov    (sp),r1
  1941.     jsr    pc,length
  1942.     bne    1b
  1943. /
  1944.     mov    strptr,r1
  1945.     jsr    pc,fsfile
  1946. 1:
  1947.     jsr    pc,backspace
  1948.     bes    1f
  1949.     mov    r0,ch
  1950.     jsr    pc,wrchar
  1951.     br    1b
  1952. 1:
  1953.     mov    (sp)+,r1
  1954.     jsr    pc,release
  1955.     tst    savk
  1956.     bne    1f
  1957.     mov    decimal,r1
  1958.     jsr    pc,release
  1959.     br    prout
  1960. 1:
  1961.     mov    dot,ch
  1962.     jsr    pc,wrchar
  1963.     mov    strptr,r1
  1964.     jsr    pc,create
  1965.     mov    decimal,-(sp)
  1966.     inc    dflg
  1967. 1:
  1968.     mov    (sp),r3
  1969.     mov    basptr,r2
  1970.     jsr    pc,mul3
  1971.     mov    r1,(sp)
  1972.     mov    r3,r1
  1973.     jsr    pc,release
  1974.     mov    (sp),r3
  1975.     mov    savk,r2
  1976.     jsr    pc,getdec
  1977.     mov    r1,(sp)
  1978.     mov    r3,r1
  1979.     mov    savk,r2
  1980.     jsr    pc,removc
  1981.     jsr    pc,*outdit
  1982.     mov    strptr,r1
  1983.     inc    ct
  1984.     cmp    ct,dout
  1985.     blo    1b
  1986.     mov    (sp)+,r1
  1987.     jsr    pc,release
  1988.     mov    strptr,r1
  1989.     jsr    pc,rewind
  1990. 1:
  1991.     jsr    pc,getchar
  1992.     bes    1f
  1993.     mov    r0,ch
  1994.     jsr    pc,wrchar
  1995.     br    1b
  1996. 1:
  1997. /
  1998. /    cleanup, print new line and return
  1999. /
  2000. prout:    mov    $1,r0
  2001.     sys    write; nl; 1
  2002.     mov    (sp)+,r0
  2003.     mov    (sp)+,r1
  2004.     mov    (sp)+,r2
  2005.     mov    (sp)+,r3
  2006.     mov    (sp)+,r4
  2007.     rts    pc
  2008. /
  2009. /
  2010. /
  2011. /    r2 = count
  2012. /    r3 = pointer (not released)
  2013. /
  2014. .bss
  2015. dflg:    .=.+2
  2016. dout:    .=.+2
  2017. logo:    .=.+2
  2018. log10:    .=.+2
  2019. decimal:    .=.+2
  2020. .text
  2021. getdec:
  2022.     mov    r3,-(sp)
  2023.     mov    r3,r1
  2024.     jsr    pc,rewind
  2025.     jsr    pc,length
  2026.     jsr    pc,allocate
  2027.     mov    r1,-(sp)
  2028. 1:
  2029.     cmp    r2,$1
  2030.     blt    1f
  2031.     mov    2(sp),r1
  2032.     jsr    pc,getchar
  2033.     mov    (sp),r1
  2034.     jsr    pc,putchar
  2035.     mov    r1,(sp)
  2036.     sub    $2,r2
  2037.     br    1b
  2038. 1:
  2039.     tst    r2
  2040.     beq    1f
  2041.     mov    tenptr,r2
  2042.     mov    (sp),r3
  2043.     jsr    pc,mul3
  2044.     mov    r1,(sp)
  2045.     mov    r3,r1
  2046.     jsr    pc,length
  2047.     jsr    pc,release
  2048.     mov    r0,r3
  2049.     jsr    pc,allocate
  2050.     mov    r1,-(sp)
  2051.     mov    2(sp),r1
  2052.     jsr    pc,rewind
  2053. 2:
  2054.     tst    r3
  2055.     beq    2f
  2056.     jsr    pc,getchar
  2057.     mov    (sp),r1
  2058.     jsr    pc,putchar
  2059.     mov    r1,(sp)
  2060.     dec    r3
  2061.     mov    2(sp),r1
  2062.     br    2b
  2063. 2:
  2064.     clr    r0
  2065.     mov    (sp),r1
  2066.     jsr    pc,putchar
  2067.     mov    2(sp),r1
  2068.     jsr    pc,release
  2069.     mov    (sp),r3
  2070.     mov    tenptr,r2
  2071.     jsr    pc,div3
  2072.     mov    r1,(sp)
  2073.     mov    r3,r1
  2074.     jsr    pc,release
  2075.     mov    r4,r1
  2076.     jsr    pc,release
  2077.     mov    (sp)+,r1
  2078.     tst    (sp)+
  2079.     mov    (sp)+,r3
  2080.     rts    pc
  2081. 1:
  2082.     mov    (sp)+,r1
  2083.     mov    (sp)+,r3
  2084.     rts    pc
  2085. tenout:
  2086.     mov    savk,ct
  2087.     mov    $2,r0
  2088.     jsr    pc,allocate
  2089.     mov    r1,-(sp)
  2090.     mov    2(sp),r1
  2091.     jsr    pc,fsfile
  2092.     jsr    pc,backspace
  2093.     mov    r0,r3
  2094.     clr    r2
  2095.     dvd    $10.,r2
  2096.     beq    1f
  2097. 3:
  2098.     add    $60,r2
  2099.     mov    r2,r0
  2100.     mov    (sp),r1
  2101.     jsr    pc,putchar
  2102.     mov    r1,(sp)
  2103. 1:
  2104.     mov    (sp),r1
  2105.     add    $60,r3
  2106.     mov    r3,r0
  2107.     jsr    pc,putchar
  2108.     mov    2(sp),r1
  2109. 1:
  2110.     jsr    pc,backspace
  2111.     bec    2f
  2112.     mov    (sp),r1
  2113.     jsr    pc,length
  2114.     cmp    r0,ct
  2115.     beq    4f
  2116.     blo    5f
  2117.     sub    ct,r0
  2118.     mov    r0,ct
  2119. 1:
  2120.     jsr    pc,getchar
  2121.     mov    r0,ch
  2122.     jsr    pc,wrchar
  2123.     dec    ct
  2124.     bne    1b
  2125.     jsr    pc,getchar
  2126.     bes    6f
  2127.     jsr    pc,backspace
  2128. 4:
  2129.     movb    dot,ch
  2130.     jsr    pc,wrchar
  2131. 1:
  2132.     jsr    pc,getchar
  2133.     bes    1f
  2134.     mov    r0,ch
  2135.     jsr    pc,wrchar
  2136.     br    1b
  2137. 5:
  2138.     sub    r0,ct
  2139.     movb    dot,ch
  2140.     jsr    pc,wrchar
  2141.     mov    $60,ch
  2142. 5:
  2143.     jsr    pc,wrchar
  2144.     dec    ct
  2145.     bne    5b
  2146.     br    1b
  2147. 1:
  2148. 6:
  2149.     mov    (sp)+,r1
  2150.     jsr    pc,release
  2151.     mov    (sp)+,r1
  2152.     jsr    pc,release
  2153.     jbr    prout
  2154. 2:
  2155.     mov    r0,r3
  2156.     clr    r2
  2157.     dvd    $10.,r2
  2158.     br    3b
  2159. dot:    <.>
  2160.     .even
  2161. ct:    .=.+2
  2162. /
  2163. /
  2164. dingout:
  2165.     clr    -(sp)
  2166.     br    1f
  2167. unout:
  2168.     mov    $1,-(sp)
  2169. 1:
  2170.     mov    2(sp),r1
  2171.     mov    savk,r2
  2172.     jsr    pc,removc
  2173.     mov    r1,2(sp)
  2174.     mov    strptr,r1
  2175.     jsr    pc,create
  2176.     mov    $-1,r0
  2177.     jsr    pc,putchar
  2178.     mov    r1,r3
  2179. 1:
  2180.     mov    2(sp),r1
  2181.     jsr    pc,length
  2182.     beq    1f
  2183.     mov    r1,r2
  2184.     jsr    pc,add3
  2185.     mov    r1,2(sp)
  2186.     mov    r2,r1
  2187.     jsr    pc,release
  2188.     mov    $1,r0
  2189.     tst    (sp)
  2190.     beq    2f
  2191.     mov    $'1,ch
  2192.     jsr    pc,wrchar
  2193.     br    1b
  2194. 2:
  2195.     tst    delflag
  2196.     jne    in177
  2197.     sys    write; ding; 3
  2198.     br    1b
  2199. 1:
  2200.     tst    (sp)+
  2201.     mov    (sp)+,r1
  2202.     jsr    pc,release
  2203.     jmp    prout
  2204. /
  2205. ding:    < >            /<bell prefix form feed>
  2206. sp5:    <\\\n     >
  2207. minus:    <->
  2208. one:    <1>
  2209.     .even
  2210. .bss
  2211. count:    .=.+2
  2212. .text
  2213. /
  2214. bigout:
  2215.     mov    r1,-(sp)    /big digit
  2216.     tst    dflg
  2217.     beq    1f
  2218.     clr    r0
  2219.     jsr    pc,allocate
  2220.     mov    r1,tptr
  2221. 1:
  2222.     mov    strptr,r1
  2223.     jsr    pc,length
  2224.     add    fw,r0
  2225.     dec    r0
  2226.     mov    r0,-(sp)    /end of field
  2227.     clr    -(sp)        /negative
  2228.     mov    4(sp),r1
  2229.     jsr    pc,length
  2230.     bne    2f
  2231.     mov    $'0,r0
  2232.     tst    dflg
  2233.     beq    3f
  2234.     mov    tptr,r1
  2235.     jsr    pc,putchar
  2236.     mov    r1,tptr
  2237.     br    1f
  2238. 3:
  2239.     mov    strptr,r1
  2240.     jsr    pc,putchar
  2241.     br    1f
  2242. 2:
  2243.     mov    4(sp),r1    /digit
  2244.     jsr    pc,fsfile
  2245.     jsr    pc,backspace
  2246.     bpl    2f
  2247.     mov    $1,(sp)        /negative
  2248.     jsr    pc,chsign
  2249. 2:
  2250.     mov    4(sp),r3    /digit
  2251.     mov    r3,r1
  2252.     jsr    pc,length
  2253.     beq    1f
  2254.     mov    tenptr,r2
  2255.     jsr    pc,div3
  2256.     mov    r1,4(sp)    /digit
  2257.     mov    r3,r1
  2258.     jsr    pc,release
  2259.     mov    r4,r1
  2260.     jsr    pc,rewind
  2261.     jsr    pc,getchar
  2262.     jsr    pc,release
  2263.     add    $'0,r0
  2264.     tst    dflg
  2265.     beq    3f
  2266.     mov    tptr,r1
  2267.     jsr    pc,putchar
  2268.     mov    r1,tptr
  2269.     br    2b
  2270. 3:
  2271.     mov    strptr,r1
  2272.     jsr    pc,putchar
  2273.     br    2b
  2274. 1:
  2275.     tst    dflg
  2276.     beq    4f
  2277.     mov    tptr,r1
  2278.     jsr    pc,length
  2279.     cmp    r0,fw1
  2280.     bhis    2f
  2281.     mov    fw1,r1
  2282.     sub    r0,r1
  2283.     mov    r1,-(sp)
  2284.     mov    strptr,r1
  2285. 3:
  2286.     mov    $'0,r0
  2287.     jsr    pc,putchar
  2288.     dec    (sp)
  2289.     bne    3b
  2290.     tst    (sp)+
  2291. 2:
  2292.     mov    tptr,r1
  2293.     jsr    pc,fsfile
  2294. 2:
  2295.     mov    tptr,r1
  2296.     jsr    pc,backspace
  2297.     bes    2f
  2298.     mov    strptr,r1
  2299.     jsr    pc,putchar
  2300.     br    2b
  2301. 2:
  2302.     mov    tptr,r1
  2303.     jsr    pc,release
  2304.     br    1f
  2305. 4:
  2306.     mov    strptr,r1
  2307.     jsr    pc,length
  2308.     cmp    r0,2(sp)    /end of field
  2309.     bhis    1f
  2310.     mov    $'0,r0
  2311.     jsr    pc,putchar
  2312.     br    1b
  2313. 1:
  2314.     tst    (sp)        /negative
  2315.     beq    1f
  2316.     mov    $'-,r0
  2317.     mov    strptr,r1
  2318.     dec    w(r1)
  2319.     jsr    pc,putchar
  2320. 1:
  2321.     mov    strptr,r1
  2322.     mov    $' ,r0
  2323.     jsr    pc,putchar
  2324.     tst    (sp)+
  2325.     tst    (sp)+
  2326.     mov    (sp)+,r1
  2327.     jsr    pc,release
  2328.     rts    pc
  2329. /
  2330. .bss
  2331. tptr:    .=.+2
  2332. tenptr:    .=.+2
  2333. .text
  2334. /
  2335. /
  2336. /
  2337. hexout:
  2338.     mov    r1,-(sp)
  2339.     jsr    pc,rewind
  2340.     jsr    pc,getchar
  2341.     cmp    r0,$16.
  2342.     blo    1f
  2343.     jmp    err
  2344. 1:
  2345.     add    $60,r0
  2346.     cmp    r0,$'9
  2347.     blos    2f
  2348.     add    $'A-'9-1,r0
  2349. 2:
  2350.     mov    strptr,r1
  2351.     jsr    pc,putchar
  2352.     mov    (sp)+,r1
  2353.     jsr    pc,release
  2354.     rts    pc
  2355. /
  2356. /
  2357. wrchar:
  2358.     tst    delflag
  2359.     jne    in177
  2360.     mov    $1,r0
  2361.     tst    count
  2362.     bne    7f
  2363.     sys    write; sp5; 2
  2364.     mov    ll,count
  2365.     mov    $1,r0
  2366. 7:
  2367.     dec    count
  2368.     sys    write; ch; 1
  2369.     rts    pc
  2370. /
  2371. /
  2372. /    case P for print an ascii string
  2373. /
  2374. /
  2375. case120:
  2376.     jsr    pc,pop
  2377.     jes    eh
  2378.     jsr    pc,length
  2379.     mov    r0,0f
  2380.     mov    a(r1),3f
  2381.     mov    $1,r0
  2382.     sys    0; 9f
  2383.     jsr    pc,release
  2384.     jmp    loop
  2385. .data
  2386. 9:    sys    write; 3:.=.+2; 0:.=.+2
  2387. .text
  2388. /
  2389. /
  2390. /    here for unimplemented stuff
  2391. /
  2392. junk:
  2393.     movb    r0,1f
  2394.     mov    $1,r0
  2395.     sys    write; 1f; 2f-1f
  2396.     jmp    loop
  2397. .data
  2398. 1:    <0 not in switch.\n>
  2399. 2:    .even
  2400. .text
  2401. /
  2402. /
  2403. /
  2404. /    routine to place one word onto the pushdown list
  2405. /    Error exit to system on overflow.
  2406. /
  2407. /
  2408. push:
  2409.     mov    r1,(r5)+
  2410.     cmp    r5,$pdltop
  2411.     bhis    pdlout
  2412.     rts    pc
  2413. /
  2414. pdlout:
  2415.     mov    $1,r0
  2416.     sys    write; 1f; 2f-1f
  2417.     jmp    reset
  2418. 1:    <Out of pushdown.\n>
  2419. 2:    .even
  2420. /
  2421. /
  2422. /    routine to remove one word from the pushdown list
  2423. /    carry bit set on empty stack
  2424. /
  2425. /
  2426. /    jsr    pc,pop
  2427. /
  2428. pop:
  2429.     cmp    r5,$pdl
  2430.     bhi    1f
  2431.     clr    r1
  2432.     sec
  2433.     rts    pc
  2434. 1:    mov    -(r5),r1
  2435.     clc
  2436.     rts    pc
  2437. /
  2438. /
  2439. /
  2440. /
  2441. .data
  2442. outdit:    hexout
  2443. .bss
  2444. source: .=.+2
  2445. savec:    .=.+2
  2446. ch:    .=.+2
  2447. .text
  2448. nl:    <\n>
  2449. asczero:    <0>
  2450. qm:    <?\n>
  2451.     .even
  2452. /
  2453. .bss
  2454. chptr:    .=.+2
  2455. strptr:    .=.+2
  2456. basptr:    .=.+2
  2457. scalptr:    .=.+2
  2458. errstack:.=.+2
  2459. /
  2460. stable:    .=.+512.
  2461. .text
  2462. casetab:
  2463.     case012; 012    /nl
  2464.     loop;    040    /sp
  2465.     case041; 041    /!
  2466.     case045; 045    /%
  2467.     case052; 052    /*
  2468.     case053; 053    /+
  2469.     case055; 055    /-
  2470.     case060; 056    /.
  2471.     case057; 057    //
  2472.     case060; 060    /0
  2473.     case060; 061    /1
  2474.     case060; 062    /2
  2475.     case060; 063    /3
  2476.     case060; 064    /4
  2477.     case060; 065    /5
  2478.     case060; 066    /6
  2479.     case060; 067    /7
  2480.     case060; 070    /8
  2481.     case060; 071    /9
  2482.     case072; 072    /:
  2483.     case073; 073    /;
  2484.     case074; 074    /<
  2485.     case075; 075    /=
  2486.     case076; 076    />
  2487.     case077; 077    /?
  2488.     case060; 101    /A
  2489.     case060; 102    /B
  2490.     case060; 103    /C
  2491.     case060; 104    /D
  2492.     case060; 105    /E
  2493.     case060; 106    /F
  2494.     case111; 111    /I
  2495.     case113; 113    /K
  2496.     case114; 114    /L
  2497.     case117; 117    /O
  2498.     case120; 120    /P
  2499.     case121; 121    /Q
  2500.     case123; 123    /S
  2501.     case166;  126    /V
  2502.     case170; 130    /X
  2503.     case172; 132    /Z
  2504.     case133; 133    /[
  2505.     case136; 136    /^
  2506.     case137; 137    /_
  2507.     case143; 143    /c
  2508.     case144; 144    /d
  2509.     case146; 146    /f
  2510.     case151; 151    /i
  2511.     case153; 153    /k
  2512.     case154; 154    /l
  2513.     case157; 157    /o
  2514.     case160; 160    /p
  2515.     case161; 161    /q
  2516.     case163; 163    /s
  2517.     case166; 166    /v
  2518.     case170; 170    /x
  2519.     case172; 172    /z
  2520.     0;0
  2521. /
  2522. .bss
  2523. pdl:    .=.+100.
  2524. pdltop:
  2525. .text
  2526.  
  2527. reset:
  2528.     clr    r0
  2529.     sys    seek; 0; 2
  2530. 1:
  2531.     clr    r0
  2532.     sys    read; rathole; 1
  2533.     bes    1f
  2534.     tst    r0
  2535.     beq    1f
  2536.     cmpb    rathole,$'q
  2537.     bne    1b
  2538. 1:
  2539.     sys    exit
  2540. .bss
  2541. rathole:    .=.+2
  2542. .text
  2543.