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)