```;   _____ _        _              __          __            _
;  / ____| |      (_)             \ \        / /           | |
; | (___ | |_ _ __ _ _ __   __ _   \ \  /\  / /___  _ __ __| |___
;  \___ \| __| '__| | '_ \ / _` |   \ \/  \/ // _ \| '__/ _` / __|
;  ____) | |_| |  | | | | | (_| |    \  /\  /| (_) | | | (_| \__ \
; |_____/ \__|_|  |_|_| |_|\__, |     \/  \/  \___/|_|  \__,_|___/
; string related words      __/ |
;                          |___/

; RND ( limit -- n)
; pushes a pseudo random number between 0 and limit-1 (rnd MOD limit)
; For the full range (0-65535) use a limit of 0
_rnd    mov @seed,r1
li r0,>6fe5                 ; multiplier
mpy r0,r1                   ; mpultiply r1 by r0
ai r2,>7ab9                 ; add 7ab9 to r2
src r2,5                    ; rotate r2 5 bits right
mov r2,@seed
clr r1                      ; msw of dividend
div *stack,r1               ; divide R1 by # on stack
mov r2,*stack               ; copy remainder, R2, to stack
rndx    b @retb0

; COUNT ( addr1 -- addr2 len )
; addr2 is addr1+1 and len is the length of the counted string at addr1.
; The byte at addr1 contains the byte count len. Range of len is {0.255}
_count  mov *stack,r0               ; get addr1
movb *r0,r7                 ; get length byte from addr1
srl r7,8                    ; move to low byte
inc *stack                  ; increment addr1 to make addr2
PAE     dect stack                  ; make space on stack
mov r7,*stack               ; push length
jmp rndx

; -TRAILING ( addr len -- addr len )
; modifies len such that trailing spaces are excluded from the string
_trail  mov *stack,*stack           ; check length
jeq trlout                  ; if 0 then exit
jlt trlout                  ; if negative then exit
mov @2(stack),r0            ; address
a *stack,r0                 ; move to end of string+1
dec r0                      ; correct to point to last character
trail2  cb *r0,@_space              ; compare to a space
jeq trail1                  ; if a space, reduce length
trlout  jmp rndx                    ; else exit
trail1  dec *stack                  ; reduce length
jeq rndx                    ; if we get to 0 then exit
dec r0                      ; else check next address
jmp trail2

; S" Compile time:( -- ) Immediate:( -- address length )
; When Compiling:
; compiles: (S")
; e.g S" HELLO" compiles (S") 5 H E L L O
; At the end of string compilation, HERE is aligned to an even address.
; At run time, (S") (see below) pushes the address of the beginning of
; the string and the length to the stack.
;
; When Interpreting:
; Compiles the string to the address PAD, as above, and pushes the address and
; length to the stack.
_strin  mov @_state,r0              ; check state
jne _stri1                  ; jump if compiling

; not compiling, move string to PAD and adjust address
mov r0,r6                   ; copy it
mov *stack,r2               ; get length
mov @2(stack),r1            ; get source address

strc1   movb *r1+,*r0+              ; copy to pad
dec r2
jne strc1
mov r6,@2(stack)            ; put PAD address in place of original
jmp rndx

; compiling. compile (S")
mov @here,r0                ; compilation address
li r1,str                   ; CFA of (S")
mov r1,*r0+                 ' compile (S")
mov *stack+,r2              ; get length
swpb r2                     ; move to high byte
movb r2,*r0+                ; compile length byte

swpb r2                     ; restore length
mov *stack+,r1              ; address of string in cpu memory
_stri2  movb *r1+,*r0+              ; copy string to definition
dec r2                      ; finished?
jne _stri2
inc r0                      ; round up HERE
andi r0,>fffe               ; mask off LSB
mov r0,@here                ; store it
b @mpadj                    ; adjust memory pointers and exit via mpadj

; (S") ( -- cpu_addr len )
; pushes the address and length of the string (compiled by S") onto the stack
; On entry, PC is actually pointing at the length byte. The address of the
; string is actually the address of the length byte+1. The length is just the
; value of the length byte. PC is adjusted to resume execution at the first even
; cell following the string.
_str    movb *pc+,r0                ; get length
dect stack                  ; make space on stack
mov pc,*stack               ; move address of string to stack
dect stack                  ; make space on stack
srl r0,8                    ; place length in low byte
mov r0,*stack               ; place length on stack
a r0,pc                     ; advance program counter
ai pc,1                     ; round up PC...
andi pc,>fffe               ; ...to an even value
b @retB0

; NUMBER TO STRING ( num -- addr len )
; Takes a number off the stack and converts it to a signed string equivalent,
; with respect to the current number base. Number base may be between
; 2 and 36. The routine checks location DOSIGN, and if 0, the
; number is treated as signed, else its unsigned. The routine also checks
; location LZI, and, if zero, leading zero's will be supressed.
; This is quite a bitch of a routine. Since any number base (between 2 and 36)
; can be employed this routine is rather complex. The routine must first
; determine the appropriate powers of the number base so we can divide the
; target number later. Obviously this is expensive, so the routine remembers
; what the active number base was the last time it was called, and ONLY
; re-computes the exponents if the base has changed since the last time it was
; called.
; This first part computes the column values.
; So, if the base is 10, you end up with 1,10,100,1000,10000
_nts    mov rstack,r14              ; save rstack 'cos we're using it
mov *stack,r9               ; get number off stack
li r7,2                     ; exponent counter (base^0 and base^1 are
; easy to compute ;-)
; used as a word offset into workbuffer so
; counts in multiples of 2.
c @base,@lbase              ; check if base has chaged since the last
; time we were called
jeq dodiv                   ; base hasn't changed, no need to compute
; powers of the base.
mov @base,@lbase            ; base has changed, store it in 'last base'
li r0,1                     ; base^0 is always 1 - easy ;-)
li r1,wrkbuf                ; place to store the powers of our base
; determine base^x until result > 65535
mov r0,*r1+                 ; store base^0 and move forward in buffer
mov @base,*r1               ; base^1 is always base ;-) store it
pwr     mov *r1+,r5                 ; get previous exponent
mpy @base,r5                ; multiply it by base - lower 16 bit result
; in r6
mov r5,r5                   ; see if the result overflowed into upper
; 16 bits
jne pwrout                  ; there was an overflow, exit loop
mov r6,*r1                  ; otherwise store result
inct r7                     ; and increment exponent counter
jmp pwr                     ; and repeat
; Ok we have computed the 'column values' (powers) for our base. Now we
; sucessively divide the number down until nothing is left, building
; the string equivalent as we compute each digit. Just to make life
; harder for ourselves, we will optionally allow leading zero's to be
; supressed. If the word at LZI<>0 then leading zero's are suppressed.
pwrout  mov r7,@expcnt              ; save exponent count for next time routine
; is run
dodiv   mov @expcnt,r7              ; entry point when exponents arent computed.
; restore exponent count
li r0,strbuf                ; address of string buffer where we build
; the string
clr r1                      ; buffer length counter
mov @dosign,r8              ; check if producing an unsigned number
jne ninn                    ; skip if we are
mov r9,r8                   ; else, check if number is negative and if
; so, add "-" character
andi r8,>8000               ; is it negative
jeq ninn                    ; its not negative, jump
li r8,'-'*256               ; the number is negative, add a minus sign
; to the string buffer
movb r8,*r0+                ; place it in the buffer
inc r1                      ; increment length counter
neg r9                      ; change the number to positive
ninn    clr r8                      ; div instruction uses 32 bit dividend, our
; 16 bit argument is in r9
mov @lzi,r10                ; leading zero indicator 0=suppress
nxtdig  div @wrkbuf(r7),r8          ; divide our number by exponent value.
; result=r8, remainder=r9
mov r8,r8                   ; was the result 0?
jeq testlz                  ; if yes then check if ignoring leading
; zeros
seto r10                    ; not zero, so reset leading zero indicator
dodig   movb @tlut(r8),*r0+         ; lookup digit value, move it to string
clr r8                      ; clear result for next interation
inc r1                      ; increment length counter
iglz    dect r7                     ; done all our columns/exponents?
jne nxtdig                  ; loop if not
movb @tlut(r9),*r0+         ; lookup digit value, move it to string
; we've done our division, push address & length to the stack and exit
li r0,strbuf                ; address of string buffer
mov r0,*stack               ; move address to stack
dect stack                  ; new stack entry
inc r1                      ; adjust length for remainder
mov r1,*stack               ; move length to stack
mov r14,rstack              ; restore return stack pointer
b @retB0
; we're looking for leading zero's and ignoring them
testlz  mov r10,r10                 ; are we ignoring leading zero's?
jeq iglz                    ; 0=ignore leading digit
jmp dodig                   ; else do digit normally
; character lookup table for printing numbers between bases 2 to 36
tlut    text '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'

```