home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / krtsub.min < prev    next >
Text File  |  2020-01-01  |  9KB  |  639 lines
  1.     .title    KRTSUB    Commonly used subroutines
  2.     .ident    "V03.62"
  3.  
  4. ; /62/    31-May-93  Billy Youdelman
  5.  
  6. ;    Copyright 1983 Change Software, Inc.
  7. ;
  8. ;    This software is furnished under a license and may
  9. ;    be  used  and  copied  only in accordance with the
  10. ;    terms of such license and with  the  inclusion  of
  11. ;    the  above copyright notice.  This software or any
  12. ;    other copies thereof may not be provided or other-
  13. ;    wise made available to any other person.  No title
  14. ;    to and ownership of the software is hereby  trans-
  15. ;    ferred.
  16. ;
  17. ;    The information in this  software  is  subject  to
  18. ;    change  without notice and should not be construed
  19. ;    as a commitment by the author.
  20.  
  21.     .include "IN:KRTMAC.MIN"
  22.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MIN failed>
  23.  
  24.  
  25.     .psect    $code
  26.     .sbttl    BASIC+ CVT$$ function
  27.     .enabl    lsb
  28.  
  29.     C.CRLF    =    4
  30.     C.LSPA    =    10
  31.     C.SSPA    =    20
  32.     C.LCUC    =    40
  33.     C.TSPA    =    200
  34.  
  35.     PAT    =    0
  36.     LASTCH    =    2
  37.     SADDR    =    4
  38.     LSIZE    =    6
  39.  
  40. cvt$$::    save    <r1,r2,r3,r4,r5>
  41.     sub    #lsize    ,sp
  42.     mov    sp    ,r4
  43.     mov    (r5)+    ,r2
  44.     mov    r2    ,saddr(r4)
  45.     mov    (r5)+    ,r1
  46.     mov    (r5)+    ,pat(r4)
  47.     clrb    lastch(r4)
  48.     mov    r2    ,r5
  49.     tst    r1
  50.     beq    130$
  51.  
  52. 10$:    clr    r3
  53.     bisb    (r5)+    ,r3
  54.  
  55.     bit    #c.lspa    ,pat(r4)
  56.     bne    25$
  57.  
  58.     bit    #c.sspa    ,pat(r4)
  59.     beq    30$
  60.     cmpb    r3    ,#tab
  61.     bne    21$
  62.     movb    #space    ,r3
  63. 21$:    cmpb    lastch(r4),#space
  64.     beq    25$
  65.     cmpb    lastch(r4),#tab
  66.     bne    30$
  67. 25$:     cmpb    r3    ,#space
  68.      beq    120$
  69.      cmpb    r3    ,#tab
  70.      beq    120$
  71.       bic    #c.lspa    ,pat(r4)
  72.  
  73. 30$:    bit    #c.crlf    ,pat(r4)
  74.     beq    50$
  75.  
  76.     mov    #junkch    ,r0
  77.     tstb    r3
  78.     beq    120$
  79. 40$:    tstb    @r0
  80.     beq    50$
  81.     cmpb    r3    ,(r0)+
  82.     beq    120$
  83.     br    40$
  84.  
  85. 50$:    bit    #c.lcuc    ,pat(r4)
  86.     beq    60$
  87.     cmpb    r3    ,#'z!40
  88.     bhi    60$
  89.     cmpb    r3    ,#'a!40
  90.     blo    60$
  91.      bicb    #40    ,r3
  92.  
  93. 60$:    movb    r3    ,(r2)+
  94. 120$:    movb    r3    ,lastch(r4)
  95.     dec    r1
  96.     bgt    10$
  97.  
  98. 130$:    mov    r2    ,r0
  99.     sub    saddr(r4),r0
  100.     ble    160$
  101.     bit    #c.tspa    ,pat(r4)
  102.     beq    160$
  103.     mov    saddr(r4),r1
  104.     add    r0    ,r1
  105. 140$:    cmpb    -(r1)    ,#space
  106.     beq    150$
  107.     cmpb    (r1)    ,#tab
  108.     bne    160$
  109. 150$:    sob    r0    ,140$
  110. 160$:    add    #lsize    ,sp
  111.     unsave    <r5,r4,r3,r2,r1>
  112.     return
  113.  
  114.     .save
  115.     .psect    $pdata
  116. junkch:    .byte    cr ,lf ,ff ,esc
  117.     .byte    0
  118.     .even
  119.     .restore
  120.  
  121.     .dsabl    lsb
  122.  
  123.  
  124.     .sbttl    Get length of .asciz string
  125.  
  126. l$len::    mov    r0    ,-(sp)
  127. 10$:    tstb    (r0)+
  128.     bne    10$
  129.     sub    (sp)+    ,r0
  130.     dec    r0
  131.     return
  132.  
  133.  
  134.     .sbttl    Write a right justified decimal number to TT
  135.  
  136.     DFWIDTH    = 6
  137.  
  138. l$wrdec::save    <r1,r4,r5>
  139.     mov    #dfwidth,r1
  140.     mov    r1    ,r4
  141.     add    #6    ,r1
  142.     bic    #1    ,r1
  143.     mov    r4    ,-(sp)
  144.     mov    @r5    ,-(sp)
  145.     mov    sp    ,r5
  146.     tst    -(r5)
  147.     sub    r1    ,sp
  148.     mov    sp    ,@r5
  149.     call    l$cvtnum
  150.     add    (r5)    ,r4
  151.     clrb    (r4)
  152.     wrtall    (r5)
  153.     add    r1    ,sp
  154.     cmp    (sp)+    ,(sp)+
  155.     unsave    <r5,r4,r1>
  156.     mov    (sp)+    ,(sp)
  157.     return
  158.  
  159.  
  160.     .sbttl    The real number conversion subroutine
  161.  
  162. l$cvtnum::save    <r0,r1,r2,r3,r4>
  163.     mov    (r5)    ,r2
  164.     mov    4(r5)    ,r3
  165.     bgt    80$
  166.      mov    #dfwidth,r3
  167. 80$:    mov    r3    ,r1
  168. 1$:    movb    #space    ,(r2)+
  169.     sob    r1    ,1$
  170.     mov    r3    ,r4
  171.     mov    2(r5)    ,r1
  172.     bpl    2$
  173.      neg    r1
  174. 2$:    clr    r0
  175.     div    #10.    ,r0
  176.     add    #'0    ,r1
  177.     cmp    r2    ,@r5
  178.     beq    100$
  179.     movb    r1    ,-(r2)
  180.     mov    r0    ,r1
  181.     beq    3$
  182.     sob    r3    ,2$
  183.     tst    r1
  184.     bne    100$
  185. 3$:    tst    2(r5)
  186.     bpl    4$
  187.     cmp    r2    ,@r5
  188.     beq    100$
  189.      movb    #'-    ,-(r2)
  190.     br    4$
  191. 100$:    movb    #'*    ,@r2
  192. 4$:    unsave    <r4,r3,r2,r1,r0>
  193.     return
  194.  
  195.  
  196.     .sbttl    Simple (non-wildcarded) string comparison
  197.  
  198. instr::    save    <r1,r2,r3,r4>
  199.     mov    (r5)    ,r0
  200.     mov    4(r5)    ,r1
  201.     mov    6(r5)    ,r2
  202.     ble    6$
  203.     mov    2(r5)    ,r4
  204.     ble    6$
  205.     sub    r2    ,r4
  206.     clr    r3
  207.  
  208. 1$:    cmp    r3    ,r4
  209.     bgt    6$
  210.  
  211.       cmpb    (r0)+    ,(r1)
  212.       bne    5$
  213.  
  214.         save    <r0,r1,r2>
  215.         inc    r1
  216.         dec    r2
  217.         ble    3$
  218.  
  219. 2$:        cmpb    (r0)+ , (r1)+
  220.         bne    4$
  221.         sob    r2    ,2$
  222. 3$:        mov    r3    ,r0
  223.         inc    r0
  224.         add    #6    ,sp
  225.         br    7$
  226.  
  227. 4$:        unsave    <r2,r1,r0>
  228. 5$:      inc    r3
  229.     br    1$
  230.  
  231. 6$:    clr    r0
  232. 7$:    unsave    <r4,r3,r2,r1>
  233.     return
  234.  
  235.  
  236.     .sbttl    Convert rad50 word to 3 ascii bytes
  237.  
  238. rdtoa::    save    <r0,r1,r3>
  239.     mov    2(r5)    ,r1
  240.     mov    (r5)    ,r3
  241. com:    clr    r0
  242.     div    #50*50    ,r0
  243.     movb    radchr(r0),(r3)+
  244.     clr    r0
  245.     div    #50    ,r0
  246.     movb    radchr(r0),(r3)+
  247.     movb    radchr(r1),(r3)+
  248.     unsave    <r3,r1,r0>
  249.     return
  250.  
  251.     .save
  252.     .psect    $pdata
  253. radchr:    .ascii    " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:"
  254.     .even
  255.     .restore
  256.  
  257.  
  258.     .sbttl    16-bit integer to ascii
  259.  
  260. L10012::MOV    R0    ,-(SP)
  261.     CLR    R0
  262. L10016:    INC    R0
  263.     SUB    #12    ,(SP)
  264.     BCC    L10016
  265.     ADD    #72    ,(SP)
  266.     DEC    R0
  267.     BEQ    L10042
  268.     JSR    PC    ,L10012
  269. L10042:    MOVB    (SP)+    ,(R1)+
  270.     RTS    PC
  271.  
  272. L10266::MOV    R0    ,-(SP)
  273.     CLR    R0
  274. L10272:    INC    R0
  275.     SUB    #12    ,(SP)
  276.     BCC    L10272
  277.     ADD    #72    ,(SP)
  278.     DEC    R0
  279.     BEQ    L10316
  280.     JSR    PC    ,L10266
  281. L10316:    MOVB    (SP)+    ,R0
  282. L10320:    jmp    writ1ch
  283.  
  284.  
  285.     .sbttl    32-bit integer to ascii from RSX SYSLIB.OLB
  286.  
  287. $CDDMG::JSR    R5    ,$SAVRG
  288.     MOV    R0    ,R3
  289.     MOV    #23420    ,R4
  290.     MOV    #12    ,R5
  291.     TST    R2
  292.     BEQ    C00024
  293. C00022:    BIS    #1000    ,R5
  294. C00024=    C00022+2
  295.     CMP    (R1)    ,R4
  296.     BCC    C00104
  297.     MOV    (R1)+    ,R0
  298.     MOV    (R1)    ,R1
  299.     DIV    R4    ,R0
  300.     MOV    R1    ,-(SP)
  301.     MOV    R0    ,R1
  302.     BEQ    C00064
  303.     MOV    #24000    ,R2
  304.     CALL    C00072
  305.     BIS    #1000    ,R5
  306.     MOV    R0    ,R3
  307. C00064:    MOV    (SP)+    ,R1
  308.     MOV    #20000    ,R2
  309. C00072:    MOV    R3    ,R0
  310.     BIS    R5    ,R2
  311.     CALL    $CBTA
  312.     BR    C00116
  313. C00104:    MOV    #5    ,R2
  314. C00110:    MOVB    #52    ,(R0)+
  315.     SOB    R2    ,C00110
  316. C00116:    RETURN
  317.  
  318. $CBTA::    JSR    R5    ,$SAVRG
  319.     MOVB    R2    ,R5
  320.     CLRB    R2
  321.     SWAB    R2
  322.     ASR    R2
  323.     BCC    E00134
  324.     TST    R1
  325.     BPL    E00134
  326.     NEG    R1
  327.     MOVB    #55    ,(R0)+
  328. E00134:    MOV    R0    ,R4
  329.     ROR    R2
  330.     ROR    R2
  331.     ROR    R3
  332.     CLRB    R3
  333.     BISB    R2    ,R3
  334.     CLRB    R2
  335.     BISB    #60    ,R2
  336.     MOV    R1    ,R0
  337. E00160:    MOV    R0    ,R1
  338.     CLR    R0
  339.     DIV    R5    ,R0
  340.     CMP    R1    ,#11
  341.     BLOS    E00200
  342.     ADD    #7    ,R1
  343. E00200:    ADD    R2    ,R1
  344.     MOV    R1    ,-(SP)
  345.     DECB    R3
  346.     BLE    E00234
  347.     TST    R0
  348.     BNE    E00230
  349.     TST    R2
  350.     BPL    E00234
  351.     TST    R3
  352.     BPL    E00230
  353.     BIC    #20    ,R2
  354. E00230:    CALL    E00160
  355. E00234:    MOVB    (SP)+    ,(R4)+
  356.     MOV    R4    ,R0
  357.     RETURN
  358.  
  359. $SAVRG::MOV    R4    ,-(SP)
  360.     MOV    R3    ,-(SP)
  361.     MOV    R5    ,-(SP)
  362.     MOV    6(SP)    ,R5
  363.     CALL    @(SP)+
  364.     MOV    (SP)+    ,R3
  365.     MOV    (SP)+    ,R4
  366.     MOV    (SP)+    ,R5
  367.     RETURN
  368.  
  369.  
  370.     .sbttl    Get value of decimal number
  371.  
  372. l$val::    save    <r3>
  373.     clr    r1
  374.     mov    (r5)    ,r3
  375. 30$:    movb    (r3)+    ,r0
  376.     beq    5$
  377.     sub    #'9+1    ,r0
  378.     add    #9.+1    ,r0
  379.     bcc    70$
  380.     mul    #10.    ,r1
  381.     bcs    70$
  382.     add    r0    ,r1
  383.     bcc    30$
  384. 70$:    mov    sp    ,r0
  385.     br    100$
  386. 5$:    clr    r0
  387. 100$:    unsave    <r3>
  388.     return
  389.  
  390.  
  391.     .sbttl    Integer ascii to octal value
  392.  
  393. octval::save    <r3>
  394.     clr    r1
  395.     mov    (r5)    ,r3
  396. 30$:    movb    (r3)+    ,r0
  397.     beq    5$
  398.     sub    #'7+1    ,r0
  399.     add    #7+1    ,r0
  400.     bcc    70$
  401.     ash    #3    ,r1
  402.     add    r0    ,r1
  403.     br    30$
  404. 70$:    mov    sp    ,r0
  405.     br    100$
  406. 5$:    clr    r0
  407. 100$:    unsave    <r3>
  408.     return
  409.  
  410.  
  411.     .sbttl    Integer to ascii octal conversion
  412.  
  413. l$otoa::save    <r0,r1,r2>
  414.     mov    (r5)    ,r1
  415.     mov    2(r5)    ,r0
  416.     mov    #6    ,r2
  417.     call    10$
  418.     clrb    (r1)
  419.     unsave    <r2,r1,r0>
  420.     return
  421.  
  422. 10$:    mov    r0    ,-(sp)
  423.     bic    #^c<7>    ,(sp)
  424.     add    #60    ,(sp)
  425.     ror    r0
  426.     asr    r0
  427.     asr    r0
  428.     dec    r2
  429.     beq    20$
  430.     call    10$
  431. 20$:    movb    (sp)+    ,(r1)+
  432.     return
  433.  
  434.  
  435.     .sbttl    Write integer in (r5) to TT as octal number
  436.  
  437. l$wroc::save    <r0>
  438.     sub    #10    ,sp
  439.     mov    sp    ,r0
  440.     calls    l$otoa    ,<r0,(r5)>
  441.     wrtall    r0
  442.     add    #10    ,sp
  443.     unsave    <r0>
  444.     return
  445.  
  446.  
  447.     .sbttl    Copy an .asciz string
  448.  
  449. copyz$::save    <r0,r1>
  450.     tst    4+6(sp)
  451.     bne    5$
  452.     mov    #77777    ,4+6(sp)
  453. 5$:    mov    4+4(sp)    ,r0
  454.     mov    4+2(sp)    ,r1
  455. 10$:    movb    (r0)+    ,(r1)+
  456.     beq    20$
  457.     dec    4+6(sp)
  458.     bne    10$
  459. 20$:    clrb    -(r1)
  460.     unsave    <r1,r0>
  461.     mov    @sp    ,6(sp)
  462.     add    #6    ,sp
  463.     return
  464.  
  465.  
  466.     .sbttl    STRCAT and STRCPY
  467.  
  468. strcpy::save    <r1>
  469.     mov    2+2(sp)    ,r0
  470.     mov    2+4(sp)    ,r1
  471. 10$:    movb    (r1)+    ,(r0)+
  472.     bne    10$
  473.     mov    2+2(sp)    ,r0
  474.     unsave    <r1>
  475.     mov    (sp)    ,4(sp)
  476.     cmp    (sp)+    ,(sp)+
  477.     return
  478.  
  479. strcat::save    <r1>
  480.     mov    2+2(sp)    ,r0
  481.     mov    2+4(sp)    ,r1
  482. 5$:    tstb    (r0)+
  483.     bne    5$
  484.     dec    r0
  485. 10$:    movb    (r1)+    ,(r0)+
  486.     bne    10$
  487.     mov    2+2(sp)    ,r0
  488.     unsave    <r1>
  489.     mov    (sp)    ,4(sp)
  490.     cmp    (sp)+    ,(sp)+
  491.     return
  492.  
  493.  
  494.     .sbttl    Uncontrol a char
  495.  
  496. l$xor::    save    <r0>
  497.     mov    4(sp)    ,r0
  498.     ixor    #100    ,r0
  499.     mov    r0    ,4(sp)
  500.     unsave    <r0>
  501.     return
  502.  
  503.  
  504.     .sbttl    Scan a string for a character
  505.  
  506. scanch::save    <r2>
  507.     mov    6(sp)    ,r2
  508.     clr    r0
  509. 10$:    tstb    @r2
  510.     beq    90$
  511.     inc    r0
  512.     cmpb    4(sp)    ,(r2)+
  513.     bne    10$
  514.     br    100$
  515. 90$:    clr    r0
  516. 100$:    unsave    <r2>
  517.     mov    @sp    ,4(sp)
  518.     cmp    (sp)+    ,(sp)+
  519.     return
  520.  
  521.  
  522.     .sbttl    Upper case one arg, or all of them
  523.     .enabl    lsb
  524.  
  525. upone::    save    <r1,r0>
  526.     mov    #space    ,r1
  527.     br    10$
  528.  
  529. upcase::save    <r1,r0>
  530.     clr    r1
  531. 10$:    cmpb    (r0)    ,r1
  532.     blos    100$
  533.     cmpb    (r0)    ,#'a!40
  534.     blo    20$
  535.     cmpb    (r0)    ,#'z!40
  536.     bhi    20$
  537.     bicb    #40    ,(r0)
  538. 20$:    inc    r0
  539.     br    10$
  540. 100$:    unsave    <r0,r1>
  541.     return
  542.  
  543.     .dsabl    lsb
  544.  
  545.  
  546.     .sbttl    Integer to decimal ascii conversion
  547.  
  548. i4toa::    mov    #x4$    ,r2
  549.     br    itoa
  550. i2toa::    mov    #x2$    ,r2
  551. itoa::    save    <r0>
  552. 10$:    movb    #'0-1    ,r0
  553. 20$:    inc    r0
  554.     sub    (r2)    ,r3
  555.     bcc    20$
  556.     add    (r2)+    ,r3
  557.     movb    r0    ,(r1)+
  558.     tst    (r2)
  559.     bne    10$
  560.     unsave    <r0>
  561.     rts    pc
  562.  
  563.     .save
  564.     .psect    $pdata
  565. x4$:    .word    1000., 100.
  566. x2$:    .word    10., 1., 0
  567.     .restore
  568.  
  569.  
  570.     .if df NONEIS
  571.  
  572.     .sbttl    MUL for a non-EIS CPU
  573.  
  574. p$mul::    mov    r0    ,-(sp)
  575.     mov    r1    ,-(sp)
  576.     mov    r2    ,-(sp)
  577.  
  578.     mov    10(sp)    ,r0
  579.     mov    12(sp)    ,r1
  580.     clr    r2
  581.  
  582. 10$:    asr    r1
  583.     bcc    20$
  584.     add    r0    ,r2
  585.     bcs    30$
  586. 20$:    asl    r0
  587.     tst    r1
  588.     bne    10$
  589.  
  590. 30$:    mov    r2    ,12(sp)
  591.  
  592.     mov    (sp)+    ,r2
  593.     mov    (sp)+    ,r1
  594.     mov    (sp)+    ,r0
  595.  
  596.     mov    (sp)+    ,(sp)
  597.     return
  598.  
  599.  
  600.     .sbttl    DIV for a non-EIS CPU
  601.  
  602. p$div::    mov    r0    ,-(sp)
  603.     mov    r1    ,-(sp)
  604.     mov    r2    ,-(sp)
  605.  
  606.     mov    10(sp)    ,r2
  607.     mov    12(sp)    ,r0
  608.     mov    14(sp)    ,r1
  609.  
  610.     mov    #40    ,-(sp)
  611.     mov    r1    ,-(sp)
  612.     clr    r1
  613.  
  614. 40$:    asl    r0
  615.     rol    r2
  616.     rol    r1
  617.     cmp    r1    ,(sp)
  618.     bcs    54$
  619.     sub    (sp)    ,r1
  620.     inc    r0
  621. 54$:    dec    2(sp)
  622.     bgt    40$
  623.  
  624.     cmp    (sp)+    ,(sp)+
  625.  
  626.     mov    r1    ,12(sp)
  627.     mov    r0    ,14(sp)
  628.  
  629.     mov    (sp)+    ,r2
  630.     mov    (sp)+    ,r1
  631.     mov    (sp)+    ,r0
  632.  
  633.     mov    (sp)+    ,(sp)
  634.     return
  635.  
  636.     .endc
  637.  
  638.     .end
  639.