Contents of file "zapper.pf"
#! /usr/local/postforth/pfkern
: MINUTES ( n1 - n2) ' LIT , 10# 60 , ' * , ' ;S , ( convert seconds)
( editable parameters)
: ZAPPER-PORT " /dev/ttyS0" ' ;S , ( change if necessary to ttyS1)
CONSTANT SECONDS-PER-ZAP 10# 7 MINUTES , ( minutes per zap)
CONSTANT SECONDS-REST 10# 20 MINUTES , ( minutes rest between zaps)
( end of editable parameters)
: ZAP ( -) ( Three zaps as per Hulda Regehr Clark's instructions)
' INIT-ZAPPER , ( open zapper port or die)
' LIT , 16# 4 , ' 1 , ( silly humans always like 1-based displays)
DO ' R , ' CYCLE ,
LOOP " Zapper session complete!" ' 1 , ' TYPE , ' 1 , ' CR ,
' 0 , ' EXIT , ( with errorlevel 0)
: INIT-ZAPPER ( -) ( side effect: stores filehandle in ZAPPER)
' ZAPPER-PORT , ' LIT , 8# 755 ,
' UMASK , ' ~ , ' & , ' FCREATE , ' DUP , ' 0< ,
IF " Cannot open " ' 2 , ' TYPE , ' ZAPPER-PORT , ' 2 , ' TYPE ,
' 2 , ' CR , ' 1 , ' EXIT , ( die now if we cannot open serial port)
ELSE ' ZAPPER , ' ! , ( save filehandle)
ENDIF ' ;S ,
VARIABLE ZAPPER 0 , ( holds filehandle for zapper)
: CYCLE ( n -) ( single zap cycle, pass the number)
" Starting zap cycle " ' 1 , ' TYPE , ' LIT , ASCII 0 , ' + ,
' 1 , ' EMIT , ' 1 , ' CR ,
' FORK , ' DUP ,
IF ( parent process)
( " Parent process " ' 2 , ' TYPE , ' .S , ' 2 , ' CR , ( debugging only)
' SECONDS-PER-ZAP , ' COUNTDOWN , ( then kill the child process)
' _KILL , ' SWAP , ' LIT , 16# 9 , ' 0 , ' SYSCALL ,
ELSE ( child process just sends pulsetrain out the serial port)
( " Child process " ' 2 , ' TYPE , ' .S , ' 2 , ' CR , ( debugging only)
' DROP , ( null PID) ' PULSETRAIN ,
ENDIF
" Starting rest period" ' 1 , ' TYPE , ' 1 , ' CR ,
' SECONDS-REST , ' COUNTDOWN ,
' ;S ,
: PULSETRAIN ( -) ( just writes UUUUU... to the serial port)
( the letter U, with start and stop bits, is 0101010101)
BEGIN ' LIT , ASCII U , ' ZAPPER , ' @ , ' EMIT , ' 0 , ( loop forever)
UNTIL ( killed) ' ;S ,
CREATE RET 16# C3 C, ( do-nothing alarm handler, for SLEEP)
: SLEEP ( n -) ( sleep for n seconds, ignore return code)
' >R , ( save n until we're ready)
' _SIGNAL , ' LIT , 16# E , ' LIT , ' RET @ ,
' 0 , ' SYSCALL , ' DROP , ( set alarm handler to 'ret')
' _ALARM , ' R> , ' 0 , ' 0 , ' SYSCALL , ' DROP , ( timeout in n seconds)
' _PAUSE , ' 0 , ' 0 , ' 0 , ' SYSCALL , ' DROP , ( pause until signal)
' ;S ,
: MM:SS ( n -) ( show minutes and seconds remaining)
' BASE , ' @ , ' DECIMAL , ( set base to decimal)
' SWAP , ' 0 , ' LIT , 10# 60 , ' U/M , ( divide by 60 and get remainder)
' SWAP , ( seconds first) ' <# , ' # , ' # ,
' LIT , ASCII : , ' HOLD , ' DROP , ( now do the minutes)
' # , ' # , ' #> , ' 1 , ' TYPE , ' LIT , 16# D , ' 1 , ' EMIT ,
' BASE , ' ! , ( restore base before exiting) ' ;S ,
: COUNTDOWN ( n -) ( display countdown to zero)
BEGIN ' DUP , ' MM:SS , ' 1 , ' SLEEP , ' 1- , ' DUP , ' 0< ,
UNTIL ' DROP , ' ;S ,
ZAP ( uncomment when debugged)