<< Home | About Forth | About TurboForth | Download | Language Reference | Resources | Tutorials | YouTube >>
; _____ _ _ __ __ _ ; / ____| | (_) \ \ / / | | ; | (___ | |_ _ __ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___ ; \___ \| __| '__| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __| ; ____) | |_| | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \ ; |_____/ \__|_| |_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/ ; 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 *stack+,r0 ; get pad 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 ; address jmp rndx ; compiling. compile (S") _stri1 mov *stack+,r0 ; discard pad address on stack 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 ; buffer and advance buffer address 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 ; buffer and advance buffer address ; 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