home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / krtsub.mac < prev    next >
Text File  |  2020-01-01  |  21KB  |  736 lines
  1.     .title    KRTSUB    Commonly used subroutines
  2.     .ident    "V03.63"
  3.  
  4. ; /63/    27-Sep-97  Billy Youdelman  V03.63
  5. ;
  6. ;    move unfmts here so KRTMDM can live in KRTCVT's overlay ...
  7.  
  8. ; /62/    27-Jul-93  Billy Youdelman  V03.62
  9. ;
  10. ;    remove unused code to save memory
  11.  
  12. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  13. ;
  14. ;    added a couple upper case routines
  15. ;    moved itoa here
  16. ;    add support for non-EIS CPUs
  17.  
  18. ;    Brian Nelson  01-Dec-83  13:19:14
  19. ;
  20. ;    Copyright 1983 Change Software, Inc.
  21. ;
  22. ;    This software is furnished under a license and may
  23. ;    be  used  and  copied  only in accordance with the
  24. ;    terms of such license and with  the  inclusion  of
  25. ;    the  above copyright notice.  This software or any
  26. ;    other copies thereof may not be provided or other-
  27. ;    wise made available to any other person.  No title
  28. ;    to and ownership of the software is hereby  trans-
  29. ;    ferred.
  30. ;
  31. ;    The information in this  software  is  subject  to
  32. ;    change  without notice and should not be construed
  33. ;    as a commitment by the author.
  34.  
  35.  
  36.     .include "IN:KRTMAC.MAC"
  37.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  38.  
  39.  
  40.     .sbttl    Local data
  41.  
  42.     .psect    $pdata        ; /63/ consolidate local data
  43. X4$:    .word    1000., 100.    ; do "thousands," "hundreds," then..
  44. X2$:    .word    10., 1., 0    ; do "tens," "ones," null terminator
  45. junkch:    .byte    cr ,lf ,ff ,esc    ; for the c.crlf option
  46.     .byte    0        ; terminator
  47. radchr:    .ascii    " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789"
  48.     .even
  49.  
  50.  
  51.     .psect    $code
  52.     .sbttl    BASIC+ CVT$$ function    ; /62/ unused functions pulled..
  53.  
  54. ;    calls    cvt$$    ,<addr(input),len(input),val(cvt_bit_pattern)>
  55. ;
  56. ;    returns:  addr(input)    = trimmed string
  57. ;            r0        = length of what's left
  58.  
  59.     ; supported cvt_bit_pattern bits
  60.     C.CRLF    =    4    ; discard CR LF FF ESC
  61.     C.LSPA    =    10    ; discard leading spaces and tabs
  62.     C.SSPA    =    20    ; reduce spaces and tabs to a single space
  63.     C.LCUC    =    40    ; convert lower case to upper case
  64.     C.TSPA    =    200    ; discard trailing spaces and tabs
  65.  
  66.     ; offsets into local work space on stack
  67.     PAT    =    0    ; cvt_bit_pattern
  68.     LASTCH    =    2    ; last character
  69.     SADDR    =    4    ; string address
  70.     LSIZE    =    6    ; work space size (for the above 3 words)
  71.  
  72. cvt$$::    save    <r1,r2,r3,r4,r5>
  73.     sub    #lsize    ,sp        ; allocate some work space
  74.     mov    sp    ,r4        ; point to it
  75.     mov    (r5)+    ,r2        ; the string address for output
  76.     mov    r2    ,saddr(r4)    ; and save it for a while
  77.     mov    (r5)+    ,r1        ; get the string length also
  78.     mov    (r5)+    ,pat(r4)    ; and finally the bit pattern
  79.     clrb    lastch(r4)        ; no previous character please
  80.     mov    r2    ,r5        ; where to get the input string
  81.     tst    r1            ; the length
  82.     beq    90$            ; nothing to do
  83.  
  84. 10$:    clr    r3            ; avoid the movb sxt please
  85.     bisb    (r5)+    ,r3        ; get the next character
  86.  
  87.     bit    #c.lspa    ,pat(r4)    ; how about removing spaces and tabs?
  88.     bne    30$            ; if ne, yes
  89.  
  90.     bit    #c.sspa    ,pat(r4)    ; embedded tabs/spaces = just a space?
  91.     beq    40$            ; no
  92.     cmpb    r3    ,#tab        ; yes, if this char is a tab
  93.     bne    20$            ; then make it into
  94.     movb    #space    ,r3        ; a space first please
  95. 20$:    cmpb    lastch(r4),#space    ; was the last char a space?
  96.     beq    30$            ; or a tab?
  97.     cmpb    lastch(r4),#tab        ; please check both
  98.     bne    40$            ; no
  99. 30$:     cmpb    r3    ,#space        ; is the current character a space?
  100.      beq    80$            ; /62/ no
  101.      cmpb    r3    ,#tab        ; not a space, try a horizontal tab
  102.      beq    80$            ; /62/ char was a tab, ignore it
  103.       bic    #c.lspa    ,pat(r4)    ; for leading spaces and tabs
  104.  
  105. 40$:    bit    #c.crlf    ,pat(r4)    ; ignore FF, ESC, CR, LF?
  106.     beq    60$            ; no
  107.  
  108.     mov    #junkch    ,r0        ; ya, get the address of the spec
  109.     tstb    r3            ; is the current char a null?
  110.     beq    80$            ; yes, please skip it then
  111. 50$:    tstb    @r0            ; anything left in the list?
  112.     beq    60$            ; no
  113.     cmpb    r3    ,(r0)+        ; see if we have a match
  114.     beq    80$            ; /62/ if so, we will skip the char
  115.     br    50$            ; no, next check please
  116.  
  117. 60$:    bit    #c.lcuc    ,pat(r4)    ; how about converting lower
  118.     beq    70$            ; case to upper case?
  119.     cmpb    r3    ,#'z!40        ; try against a lower case "z"
  120.     bhi    70$            ; it's higher than that
  121.     cmpb    r3    ,#'a!40        ; if less than a lower z, try
  122.     blo    70$            ; against a lower case "a"
  123.      bicb    #40    ,r3        ; char is in range, translate
  124.  
  125. 70$:    movb    r3    ,(r2)+        ; if all ok, return the char
  126. 80$:    movb    r3    ,lastch(r4)    ; please save the last char
  127.     dec    r1            ; and go back
  128.     bgt    10$            ; for some more
  129.  
  130. 90$:    mov    r2    ,r0        ; current pointer
  131.     sub    saddr(r4),r0        ; return the length of what's left
  132.     ble    120$            ; nothing left to do
  133.     bit    #c.tspa    ,pat(r4)    ; remove trailing blanks?
  134.     beq    120$            ; no
  135.     mov    saddr(r4),r1        ; address of the string
  136.     add    r0    ,r1        ; point to end of string+1
  137. 100$:    cmpb    -(r1)    ,#space        ; try for a space first
  138.     beq    110$            ; found one..
  139.     cmpb    (r1)    ,#tab        ; not a space, try a tab
  140.     bne    120$            ; not a tab
  141. 110$:    sob    r0    ,100$        ; tab or space, check next
  142. 120$:    add    #lsize    ,sp        ; pop small work area
  143.     unsave    <r5,r4,r3,r2,r1>
  144.     return
  145.  
  146.  
  147.     .sbttl    Get length of .asciz string
  148.  
  149. ;    input:     r0    = address of .asciz string
  150. ;    output:     r0    = length of it
  151.  
  152. l$len::    mov    r0    ,-(sp)        ; save start address to calc length
  153. 10$:    tstb    (r0)+            ; look for a null character
  154.     bne    10$            ; this wasn't it, keep going
  155.     sub    (sp)+    ,r0        ; subtract start address from current
  156.     dec    r0            ; pointer less 1 returns the length
  157.     return
  158.  
  159.  
  160.     .sbttl    Write a right justified decimal number to TT
  161.  
  162.     DFWIDTH    = 6            ; default width
  163.  
  164. ;    input:   (r5)    = number to write
  165.  
  166. l$wrdec::save    <r1,r4,r5>
  167.     mov    #dfwidth,r1        ; the width
  168.     mov    r1    ,r4        ; save for a moment
  169.     add    #6    ,r1        ; make it round up to even number
  170.     bic    #1    ,r1        ; at last...
  171.     mov    r4    ,-(sp)        ; /62/ the field width please
  172.     mov    @r5    ,-(sp)        ; and the number to print out
  173.     mov    sp    ,r5        ; setup the parameter list address
  174.     tst    -(r5)            ; make room for the buffer on
  175.     sub    r1    ,sp        ; the stack
  176.     mov    sp    ,@r5        ; insert the buffer address
  177.     call    l$cvtnum        ; and convert the number
  178.     add    (r5)    ,r4        ; find end of buffer
  179.     clrb    (r4)            ; null terminate
  180.     wrtall    (r5)            ; print it out
  181.     add    r1    ,sp        ; pop buffer
  182.     cmp    (sp)+    ,(sp)+        ; pop width and number buffers
  183.     unsave    <r5,r4,r1>
  184.     mov    (sp)+    ,(sp)        ; put return address where number was
  185.     return
  186.  
  187.  
  188.     .sbttl    The real number conversion subroutine
  189.  
  190. ;    input:     (r5)    = buffer address
  191. ;        2(r5)    = value to print, string will be right justified
  192. ;        4(r5)    = field width, if zero will be set to dfwidth
  193.  
  194. l$cvtnum::save    <r0,r1,r2,r3,r4>
  195.     mov    (r5)    ,r2        ; the buffer address to use
  196.     mov    4(r5)    ,r3        ; the field width to use
  197.     bgt    10$            ; non-zero
  198.      mov    #dfwidth,r3        ; zero, use default width
  199. 10$:    mov    r3    ,r1        ; put it here to clear buffer
  200. 20$:    movb    #space    ,(r2)+        ; fill the buffer with blanks
  201.     sob    r1    ,20$        ; for "width" number of chars
  202.     mov    r3    ,r4        ; save buffer size also
  203.     mov    2(r5)    ,r1        ; get the value to print out
  204.     bpl    30$            ; it's a positive number
  205.      neg    r1            ; it wasn't positive, but it is now..
  206. 30$:    clr    r0            ; set up for the divide by 10
  207.     div    #10.    ,r0        ; remainder in r1, quotient r0
  208.     add    #'0    ,r1        ; convert remainder to character
  209.     cmp    r2    ,@r5        ; overflowed the buffer at all?
  210.     beq    50$            ; yes, get out of here!
  211.     movb    r1    ,-(r2)        ; and return the character now
  212.     mov    r0    ,r1        ; copy the quotient
  213.     beq    40$            ; it was zero
  214.     sob    r3    ,30$        ; more to do, go back for it
  215.     tst    r1            ; something left over by chance?
  216.     bne    50$            ; yes, that's a definite error
  217. 40$:    tst    2(r5)            ; was this a negative number?
  218.     bpl    60$            ; /62/ no, exit
  219.     cmp    r2    ,@r5        ; yes, room left for a "-" sign?
  220.     beq    50$            ; no, flag an error please
  221.      movb    #'-    ,-(r2)        ; yes, insert a minus symbol
  222.     br    60$
  223. 50$:    movb    #'*    ,@r2        ; field overflow, place a "*" in
  224. 60$:    unsave    <r4,r3,r2,r1,r0>    ; beginning of the buffer
  225.     return
  226.  
  227.  
  228.     .sbttl    Simple (non-wildcarded) string comparison
  229.  
  230. ;    input:   (r5)    = address of the first string
  231. ;        2(r5)    = length of the first string
  232. ;        4(r5)    = address of the second string, the one to find
  233. ;        6(r5)    = length of the second string
  234. ;    output:   r0    if > 0 then r0=position of second in first
  235. ;            if = 0 the second is not a substring
  236.  
  237. instr::    save    <r1,r2,r3,r4>
  238.     mov    (r5)    ,r0        ; address of first string
  239.     mov    4(r5)    ,r1        ; address of second one
  240.     mov    6(r5)    ,r2        ; length of second one
  241.     ble    60$            ; a null string..
  242.     mov    2(r5)    ,r4        ; the length of first
  243.     ble    60$            ; a null string..
  244.     sub    r2    ,r4        ; convert to looping counter
  245.     clr    r3            ; the real loop counter
  246.  
  247. 10$:    cmp    r3    ,r4        ; are we done yet?
  248.     bgt    60$            ; yes, if r3 > r4
  249.  
  250.       cmpb    (r0)+    ,(r1)        ; see if current character in
  251.       bne    50$            ; matches first one in second
  252.  
  253.         save    <r0,r1,r2>    ; found first character match
  254.         inc    r1            ; point to the next character
  255.         dec    r2            ; length of pattern thats left
  256.         ble    30$            ; in case the len(pattern)=1
  257.  
  258. 20$:        cmpb    (r0)+ , (r1)+    ; check the rest of the pattern
  259.         bne    40$            ; not a match..
  260.         sob    r2    ,20$        ; loop for len(pattern)-1
  261. 30$:        mov    r3    ,r0        ; the current loop count
  262.         inc    r0            ; point to the next character
  263.         add    #6    ,sp        ; fix the stack from save <r0,r1,r2>
  264.         br    70$
  265.  
  266. 40$:        unsave    <r2,r1,r0>    ; the match failed, restore the
  267. 50$:      inc    r3            ; pointers and go try the next
  268.     br    10$            ; character in the first string
  269.  
  270. 60$:    clr    r0            ; no match
  271. 70$:    unsave    <r4,r3,r2,r1>
  272.     return
  273.  
  274.  
  275.     .sbttl    Convert rad50 word to 3 ascii bytes
  276.  
  277. ;    input:     (r5)    = address of where to put ascii chars
  278. ;        2(r5)    = the value of rad 50 word
  279.  
  280. rdtoa::    save    <r0,r1,r3>
  281.     mov    2(r5)    ,r1        ; go get the rad50 character
  282.     mov    (r5)    ,r3        ; where to put the characters
  283.     clr    r0            ; prepare for divide
  284.     div    #50*50    ,r0        ; get first char
  285.     movb    radchr(r0),(r3)+    ; put in buffer
  286.     clr    r0            ; another divide
  287.     div    #50    ,r0        ; this one gives char 2
  288.     movb    radchr(r0),(r3)+    ; put this in buffer
  289.     movb    radchr(r1),(r3)+    ; and also char 3
  290.     unsave    <r3,r1,r0>
  291.     return
  292.  
  293.  
  294.     .sbttl    16-bit integer to ascii conversion routines    ; /BBS/
  295.  
  296. L10012::MOV    R0    ,-(SP)    ; convert integer in r0
  297.     CLR    R0        ; to ascii in buffer @r1
  298. L10016:    INC    R0
  299.     SUB    #12    ,(SP)
  300.     BCC    L10016
  301.     ADD    #72    ,(SP)
  302.     DEC    R0
  303.     BEQ    L10042
  304.     JSR    PC    ,L10012
  305. L10042:    MOVB    (SP)+    ,(R1)+    ; r1 is left at end of the string on exit..
  306.     RTS    PC
  307.  
  308. L10266::MOV    R0    ,-(SP)    ; print integer in r0
  309.     CLR    R0        ; as decimal number on TT
  310. L10272:    INC    R0
  311.     SUB    #12    ,(SP)
  312.     BCC    L10272
  313.     ADD    #72    ,(SP)
  314.     DEC    R0
  315.     BEQ    L10316
  316.     JSR    PC    ,L10266
  317. L10316:    MOVB    (SP)+    ,R0
  318.     jmp    writ1ch
  319.  
  320.  
  321.     .sbttl    32-bit integer to ascii from RSX SYSLIB.OLB
  322.  
  323. ;    clr    r2            ; suppress leading 0s in $CDDMG output
  324. ;    mov    #xblock    ,r1        ; address of 32-bit (two words) number
  325. ;    mov    #sizbuf    ,r0        ; address of ascii output buff
  326. ;    call    $cddmg            ; convert 32-bit integer to ascii
  327. ;    clrb    @r0            ; null terminate the ascii string
  328.  
  329. $CDDMG::JSR    R5    ,$SAVRG
  330.     MOV    R0    ,R3
  331.     MOV    #23420    ,R4
  332.     MOV    #12    ,R5
  333.     TST    R2
  334.     BEQ    C00024
  335. C00022:    BIS    #1000    ,R5
  336. C00024=    C00022+2
  337.     CMP    (R1)    ,R4
  338.     BCC    C00104
  339.     MOV    (R1)+    ,R0
  340.     MOV    (R1)    ,R1
  341.     DIV    R4    ,R0
  342.     MOV    R1    ,-(SP)
  343.     MOV    R0    ,R1
  344.     BEQ    C00064
  345.     MOV    #24000    ,R2
  346.     CALL    C00072
  347.     BIS    #1000    ,R5
  348.     MOV    R0    ,R3
  349. C00064:    MOV    (SP)+    ,R1
  350.     MOV    #20000    ,R2
  351. C00072:    MOV    R3    ,R0
  352.     BIS    R5    ,R2
  353.     CALL    $CBTA
  354.     BR    C00116
  355. C00104:    MOV    #5    ,R2
  356. C00110:    MOVB    #52    ,(R0)+
  357.     SOB    R2    ,C00110
  358. C00116:    RETURN
  359.  
  360. $CBTA:    JSR    R5    ,$SAVRG
  361.     MOVB    R2    ,R5
  362.     CLRB    R2
  363.     SWAB    R2
  364.     ASR    R2
  365.     BCC    E00134
  366.     TST    R1
  367.     BPL    E00134
  368.     NEG    R1
  369.     MOVB    #55    ,(R0)+
  370. E00134:    MOV    R0    ,R4
  371.     ROR    R2
  372.     ROR    R2
  373.     ROR    R3
  374.     CLRB    R3
  375.     BISB    R2    ,R3
  376.     CLRB    R2
  377.     BISB    #60    ,R2
  378.     MOV    R1    ,R0
  379. E00160:    MOV    R0    ,R1
  380.     CLR    R0
  381.     DIV    R5    ,R0
  382.     CMP    R1    ,#11
  383.     BLOS    E00200
  384.     ADD    #7    ,R1
  385. E00200:    ADD    R2    ,R1
  386.     MOV    R1    ,-(SP)
  387.     DECB    R3
  388.     BLE    E00234
  389.     TST    R0
  390.     BNE    E00230
  391.     TST    R2
  392.     BPL    E00234
  393.     TST    R3
  394.     BPL    E00230
  395.     BIC    #20    ,R2
  396. E00230:    CALL    E00160
  397. E00234:    MOVB    (SP)+    ,(R4)+
  398.     MOV    R4    ,R0
  399.     RETURN
  400.  
  401. $SAVRG:    MOV    R4    ,-(SP)
  402.     MOV    R3    ,-(SP)
  403.     MOV    R5    ,-(SP)
  404.     MOV    6(SP)    ,R5
  405.     CALL    @(SP)+
  406.     MOV    (SP)+    ,R3
  407.     MOV    (SP)+    ,R4
  408.     MOV    (SP)+    ,R5
  409.     RETURN
  410.  
  411.  
  412.     .sbttl    Decimal ascii to integer    ; /BBS/ made this unsigned..
  413.  
  414. ;    input:     (r5)    = address of .asciz decimal number string to convert
  415. ;    output:      r1    = binary value of the string
  416. ;          r0    = if <>, not a number
  417.  
  418. l$val::    save    <r3>
  419.     clr    r1            ; initialize the result
  420.     mov    (r5)    ,r3        ; the address of the string
  421. 10$:    movb    (r3)+    ,r0        ; /62/ next char
  422.     beq    30$            ; if null, exit please
  423.     cmp    r0    ,#dot        ; /63/ a decimal point?
  424.     beq    30$            ; /63/ ya, number has ended..
  425.     sub    #'9+1    ,r0        ; /62/ convert ascii byte
  426.     add    #9.+1    ,r0        ; /62/ to an integer
  427.     bcc    20$            ; /62/ not a number
  428.     mul    #10.    ,r1        ; /62/ bump accumulator by tens
  429.     bcs    20$            ; /62/ overflowed, bail out..
  430.     add    r0    ,r1        ; /62/ add in result from this pass
  431.     bcc    10$            ; /62/ ok, try the next byte
  432. 20$:    mov    #er$bad    ,r0        ; /63/ illegal number, flag an error
  433.     br    40$
  434. 30$:    clr    r0            ; indicate success
  435. 40$:    unsave    <r3>
  436.     return
  437.  
  438.  
  439.     .sbttl    Octal ascii to integer
  440.  
  441. ;    input:     (r5)    = address of .asciz octal number string to convert
  442. ;    output:      r1    = binary value of the string
  443. ;          r0    = if <>, not a number
  444.  
  445. octval::save    <r3>            ; /62/ all new..
  446.     clr    r1            ; initialize the result
  447.     mov    (r5)    ,r3        ; the address of the string
  448. 10$:    movb    (r3)+    ,r0        ; next char
  449.     beq    30$            ; if null, exit please
  450.     sub    #'7+1    ,r0        ; convert ascii byte
  451.     add    #7+1    ,r0        ; to an integer
  452.     bcc    20$            ; not an octal number
  453.     ash    #3    ,r1        ; bump accumulator * 8
  454.     add    r0    ,r1        ; add in result from this pass
  455.     br    10$
  456. 20$:    mov    #er$bad    ,r0        ; /63/ illegal number, flag an error
  457.     br    40$
  458. 30$:    clr    r0            ; indicate success
  459. 40$:    unsave    <r3>
  460.     return
  461.  
  462.  
  463.     .sbttl    Integer to ascii octal conversion
  464.  
  465. ;    input:     (r5)    = buffer address
  466. ;        2(r5)    = binary number to write as ascii string in above
  467.  
  468. l$otoa::save    <r0,r1,r2>        ; /62/ all new..
  469.     mov    (r5)    ,r1        ; the buffer for ascii output
  470.     mov    2(r5)    ,r0        ; the binary number to convert
  471.     mov    #6    ,r2        ; loop 6 times, zero filling..
  472.     call    10$            ; call conversion routine
  473.     clrb    (r1)            ; add null termination byte
  474.     unsave    <r2,r1,r0>
  475.     return
  476.  
  477. 10$:    mov    r0    ,-(sp)        ; copy of the number
  478.     bic    #^c<7>    ,(sp)        ; mask for lower 3 bits
  479.     add    #60    ,(sp)        ; make result an ascii digit
  480.     ror    r0            ; rotate next group of 3 bits into low
  481.     asr    r0            ; order bits of r0..
  482.     asr    r0
  483.     dec    r2            ; loop for six passes
  484.     beq    20$            ; we are done
  485.     call    10$            ; if not, call ourself
  486. 20$:    movb    (sp)+    ,(r1)+        ; last in first out back to text buff
  487.     return
  488.  
  489.  
  490.     .sbttl    Write integer in (r5) to TT as octal number
  491.  
  492. l$wroc::save    <r0>
  493.     sub    #10    ,sp        ; use stack for a buffer
  494.     mov    sp    ,r0        ; pointer to said buffer
  495.     calls    l$otoa    ,<r0,(r5)>    ; call the conversion subroutine
  496.     wrtall    r0            ; display the number on terminal
  497.     add    #10    ,sp        ; dump the buffer
  498.     unsave    <r0>
  499.     return
  500.  
  501.  
  502.     .sbttl    Copy an .asciz string
  503.  
  504. ;    input:    2(sp)    = destination string address
  505. ;        4(sp)    = source string address
  506. ;        6(sp)    = length to copy or zero for max
  507.  
  508. copyz$::save    <r0,r1>
  509.     tst    4+6(sp)            ; see if a maxlen was passed
  510.     bne    10$            ; yes
  511.     mov    #77777    ,4+6(sp)    ; no, say we can have max int chars
  512. 10$:    mov    4+4(sp)    ,r0        ; source string address
  513.     mov    4+2(sp)    ,r1        ; destination string address
  514. 20$:    movb    (r0)+    ,(r1)+        ; copy a byte
  515.     beq    30$            ; until a null is found
  516.     dec    4+6(sp)            ; or we have copied maxlen number
  517.     bne    20$            ; of characters over
  518.     clrb    -(r1)            ; ensure output .asciz please
  519. 30$:    unsave    <r1,r0>            ; /63/ move 30$ here
  520.     mov    @sp    ,6(sp)        ; move return address up
  521.     add    #6    ,sp        ; fix the stack
  522.     return
  523.  
  524.  
  525.     .sbttl    STRCAT and STRCPY
  526.  
  527. ;    input:     (sp)    = return address
  528. ;        2(sp)    = destination address
  529. ;        4(sp)    = source address
  530. ;    output:      r0    = destination address
  531.  
  532. strcpy::save    <r1>
  533.     mov    2+2(sp)    ,r0        ; destination address
  534.     mov    2+4(sp)    ,r1        ; source .asciz address
  535. 10$:    movb    (r1)+    ,(r0)+        ; copy until a null
  536.     bne    10$            ; not done
  537.     mov    2+2(sp)    ,r0        ; return the dst address
  538.     unsave    <r1>
  539.     mov    (sp)    ,4(sp)        ; move return address up now
  540.     cmp    (sp)+    ,(sp)+        ; pop junk
  541.     return
  542.  
  543. strcat::save    <r1>
  544.     mov    2+2(sp)    ,r0        ; destination address
  545.     mov    2+4(sp)    ,r1        ; source .asciz address
  546. 10$:    tstb    (r0)+            ; look for the end of the dst string
  547.     bne    10$            ; not found yet
  548.     dec    r0            ; found it, fix the pointer
  549. 20$:    movb    (r1)+    ,(r0)+        ; copy until a null
  550.     bne    20$            ; not done
  551.     mov    2+2(sp)    ,r0        ; return the dst address
  552.     unsave    <r1>
  553.     mov    (sp)    ,4(sp)        ; move return address up now
  554.     cmp    (sp)+    ,(sp)+        ; pop junk
  555.     return
  556.  
  557.  
  558.     .sbttl    Control or uncontrol a char
  559.  
  560. l$xor::    save    <r0>
  561.     mov    4(sp)    ,r0        ; the input
  562.     ixor    #100    ,r0        ; bump up or down 64. in ascii table
  563.     mov    r0    ,4(sp)        ; the output
  564.     unsave    <r0>
  565.     return
  566.  
  567.  
  568.     .sbttl    Scan a string for a character
  569.  
  570. ;    input:    4(sp)    = string address
  571. ;        2(sp)    = character to look for
  572. ;    output:      r0    = position of char in string
  573.  
  574. scanch::save    <r2>
  575.     mov    6(sp)    ,r2        ; get address of the string
  576.     clr    r0            ; initial found position
  577. 10$:    tstb    @r2            ; end of the string yet?
  578.     beq    20$            ; yes
  579.     inc    r0            ; no, pos := succ(pos)
  580.     cmpb    4(sp)    ,(r2)+        ; does the ch match the next one?
  581.     bne    10$            ; no, try again
  582.     br    30$            ; yes, exit loop
  583. 20$:    clr    r0            ; failure, return position = 0
  584. 30$:    unsave    <r2>
  585.     mov    @sp    ,4(sp)        ; move return address up
  586.     cmp    (sp)+    ,(sp)+        ; pop stack
  587.     return
  588.  
  589.  
  590.     .sbttl    Upper case one arg, or all of them  ; /BBS/ added
  591.     .enabl    lsb
  592.  
  593. upone::    save    <r1,r0>
  594.     mov    #space    ,r1        ; stop at next space
  595.     br    10$            ; share common code
  596.  
  597. upcase::save    <r1,r0>
  598.     clr    r1            ; stop at null, do the whole string
  599. 10$:    cmpb    (r0)    ,r1        ; hit the delimiter yet?
  600.     blos    30$            ; yes, exit
  601.     cmpb    (r0)    ,#'a!40        ; a small letter?
  602.     blo    20$            ; no
  603.     cmpb    (r0)    ,#'z!40        ; a small letter?
  604.     bhi    20$            ; no
  605.     bicb    #40    ,(r0)        ; yes, make it upper case
  606. 20$:    inc    r0            ; bump pointer to next char
  607.     br    10$            ; and go check it
  608. 30$:    unsave    <r0,r1>
  609.     return
  610.  
  611.     .dsabl    lsb
  612.  
  613.  
  614.     .sbttl    Integer to decimal ascii conversion  ; /BBS/ added
  615.  
  616. i4toa::    mov    #X4$    ,r2    ; four decimal places, or 0000 if need be
  617.     br    itoa        ; share the rest
  618. i2toa::    mov    #X2$    ,r2    ; come here for 2 place numbers
  619. itoa:    save    <r0>        ; enter here with r2 loaded
  620. 10$:    movb    #'0-1    ,r0    ; initialize the ascii char output register
  621. 20$:    inc    r0        ; step thru ascii 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
  622.     sub    (r2)    ,r3    ; while subtracting divisor from input integer
  623.     bcc    20$        ; until less than the divisor is left
  624.     add    (r2)+    ,r3    ; recover remainder and set for next pass
  625.     movb    r0    ,(r1)+    ; put ascii equiv in out buff
  626.     tst    (r2)        ; done yet?
  627.     bne    10$        ; nope, next one, please..
  628.     unsave    <r0>
  629.     rts    pc
  630.  
  631.  
  632.     .sbttl    Unformat a string, inverse of PRSARG
  633.                     ; /63/ moved here from KRTCVT so
  634. unfmts::save    <r1,r2,r3,r4>        ; /63/ KRTMDM can be in KRTCVT's ovrly
  635.     mov    r0    ,r3        ; /63/ copy the address of the data
  636.     mov    #spare1    ,r4        ; /63/ (bigger) target buffer
  637. 10$:    movb    (r3)+    ,r1        ; /63/ get the data
  638.     beq    100$            ; all done
  639.     cmpb    r1    ,#space        ; control character?
  640.     blo    20$            ; yes
  641.     movb    r1    ,(r4)+        ; no, just copy as is
  642.     br    40$            ; and do the next one
  643. 20$:    movb    #'\    ,(r4)+        ; control character, insert "\"
  644.     clr    r0            ; get setup for conversion
  645.     div    #10    ,r0        ; got it
  646.     movb    r1    ,r2        ; save the LSB
  647.     mov    r0    ,r1        ; and get the last two out
  648.     clr    r0            ; ....
  649.     div    #10    ,r0        ; do it
  650.     add    #'0    ,r0        ; convert to ascii
  651.     add    #'0    ,r1        ; ..ditto
  652.     add    #'0    ,r2        ; ....ditto
  653.     movb    r0    ,(r4)+        ; insert
  654.     movb    r1    ,(r4)+        ; the
  655.     movb    r2    ,(r4)+        ; data
  656. 40$:    br    10$            ; next please
  657. 100$:    clrb    @r4            ; ensure .asciz
  658.     mov    #spare1    ,r0        ; /53/ return addr of converted data
  659.     unsave    <r4,r3,r2,r1>        ; /63/
  660.     return
  661.  
  662.  
  663.     .if df NONEIS        ; /BBS/ only do this for non-EIS version!
  664.  
  665.     .sbttl    MUL for a non-EIS CPU    ; /BBS/ rewrote this ..
  666.  
  667. ; /BBS/     WARNING:  This routine does _NOT_ set the V bit ala the EIS multiply!
  668.  
  669. p$mul::    mov    r0    ,-(sp)    ; this a is SINGLE PRECISION multiply!
  670.     mov    r1    ,-(sp)    ; save regs used here
  671.     mov    r2    ,-(sp)
  672.  
  673.     mov    10(sp)    ,r0    ; src, the multiplier
  674.     mov    12(sp)    ,r1    ; reg, the multiplicand
  675.     clr    r2        ; init the product
  676.  
  677. 10$:    asr    r1        ; divide by 2
  678.     bcc    20$        ; don't add when result is even number
  679.     add    r0    ,r2    ; add asl'd multiplier to product
  680.     bcs    30$        ; if overflow, bail out leaving carry set..
  681. 20$:    asl    r0        ; multiply by 2 for the next pass
  682.     tst    r1        ; anything left to do?  also clears carry..
  683.     bne    10$        ; ya
  684.  
  685. 30$:    mov    r2    ,12(sp)    ; done, put product on stack for caller
  686.  
  687.     mov    (sp)+    ,r2    ; restore everything to as when called
  688.     mov    (sp)+    ,r1
  689.     mov    (sp)+    ,r0
  690.  
  691.     mov    (sp)+    ,(sp)    ; move return address up, calling macro
  692.     return            ; pushes 2 args on stack but only pops 1
  693.  
  694.  
  695.     .sbttl    DIV for a non-EIS CPU    ; /BBS/ moved here + commented this..
  696.  
  697. ; /BBS/     WARNING:  This routine does _NOT_ set C or V bits ala the EIS divide!
  698.  
  699. p$div::    mov    r0    ,-(sp)        ; patched for double precision input
  700.     mov    r1    ,-(sp)        ; output is SINGLE PRECISION!
  701.     mov    r2    ,-(sp)        ; save all regs used here
  702.  
  703.     mov    10(sp)    ,r2        ; high word of dividend
  704.     mov    12(sp)    ,r0        ; low word of dividend
  705.     mov    14(sp)    ,r1        ; divisor
  706.  
  707.     mov    #40    ,-(sp)        ; do 32. iterations for 32. bits
  708.     mov    r1    ,-(sp)        ; the divisor
  709.     clr    r1            ; init remainder
  710.  
  711. 10$:    asl    r0            ; shift dividend (low word then..
  712.     rol    r2            ; ..hi word) to left 1 bit, and
  713.     rol    r1            ; into the remainder
  714.     cmp    r1    ,(sp)        ; is remainder now .gt. divisor?
  715.     bcs    20$            ; no
  716.     sub    (sp)    ,r1        ; ya, subtract divisor from it
  717.     inc    r0            ; and bump quotient accordingly
  718. 20$:    dec    2(sp)            ; do next iteration?
  719.     bgt    10$            ; ya, there is something left to do..
  720.  
  721.     cmp    (sp)+    ,(sp)+        ; no, pop iterations + divisor buffers
  722.  
  723.     mov    r1    ,12(sp)        ; the remainder
  724.     mov    r0    ,14(sp)        ; the quotient
  725.  
  726.     mov    (sp)+    ,r2        ; restore everything to as when called
  727.     mov    (sp)+    ,r1
  728.     mov    (sp)+    ,r0
  729.  
  730.     mov    (sp)+    ,(sp)        ; move return address up, calling
  731.     return                ; macro pushes 3 args, only pops 2..
  732.  
  733.     .endc
  734.  
  735.     .end
  736.