Contents of file "pfkern.4th"

#! /usr/local/postforth/pf

: ENUM ( n -) ( S: name [ name ...]) ( n is the starting number)
 ( compile constants such as ENUM 1 AF_UNIX AF_INET /ENUM)
 BEGIN ' >IN , ' @ ,
  ' ' , ' LIT , ' /ENUM , ' = , ' SWAP , ' >IN , ' ! ,
  IF ( return true for UNTIL) ' -1 ,
  ( otherwise compile the constant)
  ( then increment n to the next enumerated value)
  ELSE ' CONSTANT , ' DUP , ' , , ' 1+ , ' 0 ,
  ENDIF
 UNTIL ' ;S ,

: /ENUM ( n -) ( end of ENUM block, discard n) ' DROP , ' ;S ,

0 ( begin building constants for the system calls, starting at _SETUP=0)
 ( note that you cannot have any comments between ENUM and /ENUM)
 ENUM
 _SETUP _EXIT _FORK _READ _WRITE
 _OPEN _CLOSE _WAITPID _CREAT _LINK
 _UNLINK _EXECVE _CHDIR _TIME _MKNOD
 _CHMOD _CHOWN _BREAK _OLDSTAT _LSEEK
 _GETPID _MOUNT _UMOUNT _SETUID _GETUID
 _STIME _PTRACE _ALARM _OLDFSTAT _PAUSE
 _UTIME _STTY _GTTY _ACCESS _NICE
 _FTIME _SYNC _KILL _RENAME _MKDIR
 _RMDIR _DUP _PIPE _TIMES _PROF
 _BRK _SETGID _GETGID _SIGNAL _GETEUID
 _GETEGID _ACCT _PHYS _LOCK _IOCTL
 _FCNTL _MPX _SETPGID _ULIMIT _OLDOLDUNAME
 _UMASK _CHROOT _USTAT _DUP2 _GETPPID
 _GETPGRP _SETSID _SIGACTION _SGETMASK _SSETMASK
 _SETREUID _SETREGID _SIGSUSPEND _SIGPENDING _SETHOSTNAME
 _SETRLIMIT _GETRLIMIT _GETRUSAGE _GETTIMEOFDAY _SETTIMEOFDAY
 _GETGROUPS _SETGROUPS _SELECT _SYMLINK _OLDLSTAT
 _READLINK _USELIB _SWAPON _REBOOT _READDIR
 _MMAP _MUNMAP _TRUNCATE _FTRUNCATE _FCHMOD
 _FCHOWN _GETPRIORITY _SETPRIORITY _PROFIL _STATFS
 _FSTATFS _IOPERM _SOCKETCALL _SYSLOG _SETITIMER
 _GETITIMER _STAT _LSTAT _FSTAT _OLDUNAME
 _IOPL _VHANGUP _IDLE _VM86 _WAIT4
 _SWAPOFF _SYSINFO _IPC _FSYNC _SIGRETURN
 _CLONE _SETDOMAINNAME _UNAME _MODIFY_LDT _ADJTIMEX
 _MPROTECT _SIGPROCMASK _CREATE_MODULE _INIT_MODULE _DELETE_MODULE
 _GET_KERNEL_SYMS _QUOTACTL _GETPGID _FCHDIR _BDFLUSH
 _SYSFS _PERSONALITY _AFS_SYSCALL _SETFSUID _SETFSGID
 __LLSEEK _GETDENTS __NEWSELECT _FLOCK _MSYNC
 _READV _WRITEV _GETSID _FDATASYNC __SYSCTL
 _MLOCK _MUNLOCK _MLOCKALL _MUNLOCKALL _SCHED_SETPARAM
 _SCHED_GETPARAM _SCHED_SETSCHEDULER
  _SCHED_GETSCHEDULER _SCHED_YIELD _SCHED_GET_PRIORITY_MAX
 _SCHED_GET_PRIORITY_MIN _SCHED_RR_GET_INTERVAL _NANOSLEEP _MREMAP _MREMAP+1
 _MREMAP+2 _MREMAP+3 +MREMAP+4 _POLL _POLL+1
 _POLL+2 _POLL+3 _POLL+4 _POLL+5 _POLL+6
 _POLL+7 _POLL+8 _POLL+9 _POLL+10 _POLL+11
 _POLL+12 _POLL+13 _POLL+14 _POLL+15 _POLL+16
 _POLL+17 _POLL+18 _POLL+19 _GETPMSG _PUTPMSG
 /ENUM

( _CONNECT has a hash of 0x8000 and collides with null; prepend _ )
1 ENUM
 _SOCKET _BIND __CONNECT _LISTEN _ACCEPT _GETSOCKNAME
 _GETPEERNAME _SOCKETPAIR _SEND _RECV _SENDTO _RECVFROM
 _SHUTDOWN _SETSOCKOPT _GETSOCKOPT _SENDMSG _RECVMSG
/ENUM

1 ENUM
 SIGHUP SIGINT SIGQUIT SIGILL SIGTRAP SIGABRT SIGBUS SIGFPE
 SIGKILL SIGUSR1 SIGSEGV SIGUSR2 SIGPIPE SIGALRM SIGTERM SIGSTKFLT
 SIGCHLD SIGCONT SIGSTOP SIGTSTP SIGTTIN SIGTTOU SIGURG SIGXCPU
 SIGXFSZ SIGVTALRM SIGPROF SIGWINCH SIGIO SIGLOST SIGPWR SIGUNUSED
 NSIG
/ENUM

CONSTANT SIGIOT SIGABRT ,
CONSTANT SIGPOLL SIGIO ,
CONSTANT _NSIG NSIG ,
CONSTANT SA_NOCLDSTOP ' 1 ,
CONSTANT SA_SHIRQ 16# 04000000 ,
CONSTANT SA_STACK 16# 08000000 ,
CONSTANT SA_RESTART 16# 10000000 ,
CONSTANT SA_INTERRUPT 16# 20000000 ,
CONSTANT SA_NOMASK 16# 40000000 ,
CONSTANT SA_ONESHOT 16# 80000000 ,
CONSTANT SA_PROBE SA_ONESHOT ,
CONSTANT SA_SAMPLE_RANDOM SA_RESTART ,
CONSTANT SIG_BLOCK 0 , ( for blocking signals)
CONSTANT SIG_UNBLOCK 1 , ( for unblocking signals)
CONSTANT SIG_SETMASK 2 , ( for setting the signal mask)
CONSTANT SIG_DFL 0 , ( default signal handling)
CONSTANT SIG_IGN 1 , ( ignore signal)
CONSTANT SIG_ERR -1 , ( error return from signal)

: UMASK ( - n) ( return umask; use NOT & on it before use)
 ' _UMASK , ' 0 , ' 0 , ' 0 , ' SYSCALL , ' ;S ,

: FORK ( - pid) ( pid is 0 in child process, child's pid in parent)
 ' _FORK , ' 0 , ' 0 , ' 0 , ' SYSCALL , ' ;S ,

CREATE [ ( -) ( create array on stack, leave pointer on RS)
 ( can't make this high level, because it modifies return stack!)
 16# 83 C, 16# ED C, 16# 4 C, ( sub bp,4)
 16# 89 C, 16# 65 C, 0 C, ( mov [bp+0],sp)
 ' NEXT JMP,

CREATE ] ( - ptr) ( return stack pointer before array was built)
 ( this also cannot be made high level, it's kludgy enough as it is)
 16# FF C, 16# 75 C, 0 C, ( push [bp+0])
 16# 83 C, 16# C5 C, 16# 4 C, ( add bp,4)
 ' NEXT JMP,

CREATE [DROP] ( [ n n1 n2 ... ] ptr -) ( drop array from stack)
 ' SP! JMP,

: [LENGTH] ( ptr - ptr n) ( length of array on stack)
 ' SP@ , ' OVER , ' SWAP , ' - , ' CELL , ' / , ' 1- , ' ;S ,

: [] ( ptr n - ptr ptr2) ( get address of array element)
 ( n=0 to get stack item just before array
 n>=1 to get other stack items before array
 n<=-1 to get array elements)
 ' CELL , ' * , ' OVER , ' + , ' ;S ,

: []@ ( ptr n - ptr n2) ( get contents of array element)
 ( see [] comments for usage)
 ' CELL , ' * , ' OVER , ' + , ' @ , ' ;S ,

: []! ( ptr n n2 - ptr) ( update array element contents)
 ( n is offset, see [] above; n2 is new contents)
 ' SWAP , ' CELL , ' * , ' OVER , ' + , ' SWAP , ' ! , ' ;S ,

10# 16 NEG ENUM -16 -15 -14 -13 -12 -11 -10 -9 -8 -7 -6 -5 -4 -3 -2 /ENUM

10# 3 ENUM 3 4 5 6 7 8 9 10 11 12 13 14 15 16 /ENUM ( define constants)

: SIGNAL ( n addr -) ( set signal handler for n to addr)
 ' >R , ' >R , ' _SIGNAL , ' R> , ' R> , ' 0 , ' SYSCALL , ' DROP , ' ;S ,

: SBRK ( size_requested - ptr | 0) ( see K&R2 p 187)
 ' _BRK , ' 0 , ' 0 , ' 0 , ' SYSCALL , ( get current end of dataseg)
 ' SWAP , ' OVER , ' + , ' _BRK , ' OVER , ' 0 , ' 0 , ' SYSCALL , ' = , ' ~ ,
 IF ' DROP , ' 0 ,
 ENDIF ' ;S ,

VARIABLE MEMLIST ' MEMLIST , 0 , ( for use by MALLOC)

VARIABLE FREELIST ' MEMLIST , 0 , ( for use by MALLOC)

: MALLOC ( bytes_requested - addr | 0)
 ' 2 , ' CELLS , ' + , ( must have room for list header)
 
 ' ;S ,

: REAPER ( -) ( reap zombie child processes)
 ' _WAITPID , ' 0 , ' 0 , ' 0 , ' SYSCALL , ' DROP ,
 ( now set up handler for next time)
 ' SIGCHLD , ' LIT , ' REAPER @ , ' SIGNAL ,
 ' >CODE , 16# C3 C, ( ret)

: RESTART ( -) ( handler for SIGSEGV)
 " Undefined instruction or other catastropic error, restarting..."
 ' 2 , ' TYPE , ' 2 , ' CR , ' 2 , ' CR ,
 ' SIGSEGV , ' LIT , ' RESTART @ , ' SIGNAL , ( reset handler)
 ' COLD , ( clean restart)

0 ' TASK ! ( erase previous definition of TASK)
: TASK
 ' ARGC , ' 1 , ' > , IF ( any arg is a file to be read as STDIN)
 ' 1 , ' ARGV , ' 0 , ' 0 ,
 ' OPEN , ( open read-only) ' B/BUF , ' IN , ' READ , ' DROP ,
 ' IN , ' >IN , ' ! , ( zero buffer pointer)
 ' SIGCHLD , ' LIT , ' REAPER @ , ' SIGNAL ,
 ' INTERPRET , ' TAIL , ' >CODE , ' QUIT JMP,
 ELSE ( show banner and launch into normal query-interpret loop)
 ' HELLO ,
 ' SIGCHLD , ' LIT , ' REAPER @ , ' SIGNAL , ( catch zombie processes)
 ' SIGSEGV , ' LIT , ' RESTART @ , ' SIGNAL , ( save session on error)
 ' >CODE , ' QUIT JMP, ( jump to original definition of QUIT)
 ENDIF

' TASK @ ' QUIT BIND !
.S ( let us know if anything left on stack [meaning a bug!])
S" pfkern" SAVESYSTEM 0 EXIT