#! /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