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