\ This is the header file for the PROBE2 serial communications utility. \ For more information on PROBE2 and the *other* ChAoS Utilities, please \ visit www.glod.net. \ 20010413 MSD 001 Added TOUPPER and TOLOWER. \ ------------------------------------------------------------------------- : not 0= ; : on true swap ! ; : off false swap ! ; : bounds over + swap ; : 2dup over over ; : 2drop drop drop ; \ ------------------------------------------------------------------------- : keywaste begin key? 0<> while key drop repeat ; : serwaste begin sget 0<> while drop repeat ; \ ------------------------------------------------------------------------- : u.hex ( value -- ) \ Variable width. base @ swap hex <# #S #> type base ! ; : -rot rot rot ; : uN.hex ( value width -- ) \ User-specified width. base @ -rot hex swap <# swap 0 ?do # loop #> type base ! ; : .hex u.hex ; ( value -- ) : u2.hex 2 uN.hex ; ( value -- ) : u4.hex 4 uN.hex ; ( value -- ) : u6.hex 6 uN.hex ; ( value -- ) : u8.hex 8 uN.hex ; ( value -- ) : $u.hex ." $" u.hex ; ( value -- ) : $uN.hex ." $" uN.hex ; ( value width -- ) : $u2.hex ." $" u2.hex ; ( value -- ) : $u4.hex ." $" u4.hex ; ( value -- ) : $u6.hex ." $" u6.hex ; ( value -- ) : $u8.hex ." $" u8.hex ; ( value -- ) : .ascii \ char -- ; dup bl < over [char] ~ > or if drop [char] . endif emit ; : dump bounds cr do i cr i 8 0 do i 7 and 0<> 1+ 1+ spaces dup i + c@ u2.hex loop drop 2 spaces i 8 bounds do i c@ .ascii loop 8 +loop cr space ; \ ------------------------------------------------------------------------- : .s cr depth dup 0> if dup begin dup while rot >r 1- repeat drop dup begin dup while r> dup . rot rot 1- repeat drop endif ." <- TOS " drop ; \ ------------------------------------------------------------------------- : StartTimer \ SystemTicks TimerAddr -- ; swap ticks + swap ! ; : TimerExpired \ TimerAddr -- t/f ; @ ticks < ; \ ------------------------------------------------------------------------- variable PauseTimer : tpause \ system-ticks-to-wait -- ; PauseTimer StartTimer begin PauseTimer TimerExpired not while pause repeat ; \ ------------------------------------------------------------------------- : semit \ char -- ; Send a character to the serial port. sput \ Send the character itself. ; : stype bounds ?do i c@ semit loop ; : scr 13 sput 10 sput ; \ ------------------------------------------------------------------------- variable TrafficTimer variable QuietPeriod : sdropa \ period -- ; Discard all serial input; time out when quiet. dup QuietPeriod ! TrafficTimer StartTimer begin begin sget while \ While there's any serial input drop QuietPeriod @ TrafficTimer StartTimer repeat TrafficTimer TimerExpired key? 0<> or if \ Have we timed out or a key been pressed? exit \ Bail out. endif pause again ; : sgeta \ period -- ; Display all serial input; time out when quiet. dup QuietPeriod ! TrafficTimer StartTimer begin begin sget while \ While there's any serial input emit \ display it. QuietPeriod @ TrafficTimer StartTimer repeat TrafficTimer TimerExpired key? 0<> or if \ Have we timed out or a key been pressed? exit \ Bail out. endif pause again ; : waitfortraffic begin sget 0<> dup if nip endif key? or not while pause repeat ; : waitrxtimeout \ period -- ; TrafficTimer StartTimer begin sget 0<> dup if nip endif key? TrafficTimer TimerExpired or or not while pause repeat ; \ ------------------------------------------------------------------------- : secs>ticks \ time-in-seconds -- time-system-clock-ticks ; 182 * 10 / ; : ticks>secs \ time-system-clock-ticks -- time-in-seconds ; 10 * 182 / ; \ ------------------------------------------------------------------------- : sgettil \ milliseconds -- ; Display serial input for required period. TrafficTimer StartTimer begin begin sget while \ While there's any serial input emit \ display it. repeat sget if emit endif \ Display any input. TrafficTimer TimerExpired key? 0<> or if \ Have timed out or has a key been pressed? exit \ Bail out. endif pause again ; \ ------------------------------------------------------------------------- : scommand \ zaddr -- ; Send supplied command string to serial port. count stype \ Send the actual command string to the serial port. 13 semit \ Terminate it with a carriage-return. ; \ ------------------------------------------------------------------------- : wait-for \ char -- ; Waits until CHAR is received. begin sget if over = if drop exit endif endif pause again ; \ ------------------------------------------------------------------------- variable ShiftRegister 1 ShiftRegister ! : RandBit \ -- 0..1 ; Generates a "random" bit. ShiftRegister @ 1 and \ Gen result bit for this time thru. ShiftRegister @ 1 and 0<> \ Tap at position 31. ShiftRegister @ 8 and 0<> \ Tap at position 28. xor 0<> \ If the XOR of the taps is non-zero... if 1073741824 ( 0x40000000 ) \ ...shift in a "one" bit else... else 0 \ ...shift in a "zero" bit. endif ShiftRegister @ 2/ \ Shift register one bit right. or \ OR in new left-hand bit. ShiftRegister ! \ Store new shift register value. ; : RandBits \ n -- 0..2^(n-1) ; Generate an n-bit "random" number. 0 \ Result's start value. swap 0 do 2* RandBit or \ Generate next "random" bit. loop ; : RandBits<>0 \ bits -- num ; Returns *non-zero* random number 0 begin dup 0= while drop dup randbits repeat nip ; : RandTest \ n -- ; begin key? 0= while dup RandBits <# #s #> type dup 3 > if cr endif pause repeat key drop drop ; \ ------------------------------------------------------------------------- : toupper \ letter -- toupper(letter) ; dup [char] a >= over [char] z <= and if [char] a - [char] A + endif ; : tolower \ letter -- tolower(letter) ; dup [char] A >= over [char] Z <= and if [char] A - [char] a + endif ; \ -------------------------------------------------------------------------