nybble
/
jumpforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

reorganize into multiple word lists & shrink bootstrap words

This commit is contained in:
Jesse D. McDonald 2020-10-23 19:39:29 -05:00
parent 4b98e19304
commit 92d806298b
2 changed files with 638 additions and 541 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

487
jumpforth.S
View File

@ -207,416 +207,6 @@ defconst __F_IMMED,F_IMMED,"F_IMMED"
defconst __F_HIDDEN,F_HIDDEN,"F_HIDDEN" defconst __F_HIDDEN,F_HIDDEN,"F_HIDDEN"
defconst __F_LENMASK,F_LENMASK,"F_LENMASK" defconst __F_LENMASK,F_LENMASK,"F_LENMASK"
/*
** x86 system call numbers
*/
defconst SYS_EXIT,__NR_exit
/* defconst SYS_FORK,__NR_fork */
defconst SYS_READ,__NR_read
defconst SYS_WRITE,__NR_write
/* defconst SYS_CLOSE,__NR_close */
/* defconst SYS_WAITPID,__NR_waitpid */
/* defconst SYS_CHDIR,__NR_chdir */
/* defconst SYS_TIME,__NR_time */
/* defconst SYS_CHMOD,__NR_chmod */
/* defconst SYS_LSEEK,__NR_lseek */
defconst SYS_GETPID,__NR_getpid
/* defconst SYS_MOUNT,__NR_mount */
/* defconst SYS_STIME,__NR_stime */
/* defconst SYS_PTRACE,__NR_ptrace */
/* defconst SYS_ALARM,__NR_alarm */
/* defconst SYS_PAUSE,__NR_pause */
/* defconst SYS_UTIME,__NR_utime */
/* defconst SYS_ACCESS,__NR_access */
/* defconst SYS_NICE,__NR_nice */
/* defconst SYS_SYNC,__NR_sync */
/* defconst SYS_KILL,__NR_kill */
/* defconst SYS_RMDIR,__NR_rmdir */
/* defconst SYS_DUP,__NR_dup */
/* defconst SYS_TIMES,__NR_times */
defconst SYS_BRK,__NR_brk
/* defconst SYS_SIGNAL,__NR_signal */
/* defconst SYS_UMOUNT2,__NR_umount2 */
defconst SYS_IOCTL,__NR_ioctl
/* defconst SYS_SETPGID,__NR_setpgid */
/* defconst SYS_UMASK,__NR_umask */
/* defconst SYS_CHROOT,__NR_chroot */
/* defconst SYS_USTAT,__NR_ustat */
/* defconst SYS_GETPPID,__NR_getppid */
/* defconst SYS_GETPGRP,__NR_getpgrp */
/* defconst SYS_SETSID,__NR_setsid */
/* defconst SYS_SGETMASK,__NR_sgetmask */
/* defconst SYS_SSETMASK,__NR_ssetmask */
/* defconst SYS_SETHOSTNAME,__NR_sethostname */
/* defconst SYS_SETRLIMIT,__NR_setrlimit */
/* defconst SYS_GETRLIMIT,__NR_getrlimit */
/* defconst SYS_GETRUSAGE,__NR_getrusage */
/* defconst SYS_GETTIMEOFDAY,__NR_gettimeofday */
/* defconst SYS_SETTIMEOFDAY,__NR_settimeofday */
/* defconst SYS_SELECT,__NR_select */
/* defconst SYS_SWAPON,__NR_swapon */
/* defconst SYS_REBOOT,__NR_reboot */
/* defconst SYS_READDIR,__NR_readdir */
defconst SYS_MUNMAP,__NR_munmap
/* defconst SYS_GETPRIORITY,__NR_getpriority */
/* defconst SYS_SETPRIORITY,__NR_setpriority */
/* defconst SYS_IOPERM,__NR_ioperm */
/* defconst SYS_SYSLOG,__NR_syslog */
/* defconst SYS_SETITIMER,__NR_setitimer */
/* defconst SYS_GETITIMER,__NR_getitimer */
/* defconst SYS_IOPL,__NR_iopl */
/* defconst SYS_VHANGUP,__NR_vhangup */
/* defconst SYS_IDLE,__NR_idle */
/* defconst SYS_WAIT4,__NR_wait4 */
/* defconst SYS_SWAPOFF,__NR_swapoff */
/* defconst SYS_SYSINFO,__NR_sysinfo */
/* defconst SYS_IPC,__NR_ipc */
/* defconst SYS_FSYNC,__NR_fsync */
/* defconst SYS_SETDOMAINNAME,__NR_setdomainname */
/* defconst SYS_UNAME,__NR_uname */
/* defconst SYS_MODIFY_LDT,__NR_modify_ldt */
/* defconst SYS_ADJTIMEX,__NR_adjtimex */
/* defconst SYS_MPROTECT,__NR_mprotect */
/* defconst SYS_INIT_MODULE,__NR_init_module */
/* defconst SYS_DELETE_MODULE,__NR_delete_module */
/* defconst SYS_QUOTACTL,__NR_quotactl */
/* defconst SYS_GETPGID,__NR_getpgid */
/* defconst SYS_FCHDIR,__NR_fchdir */
/* defconst SYS_SYSFS,__NR_sysfs */
/* defconst SYS_PERSONALITY,__NR_personality */
/* defconst SYS__LLSEEK,__NR__llseek */
/* defconst SYS__NEWSELECT,__NR__newselect */
/* defconst SYS_FLOCK,__NR_flock */
/* defconst SYS_MSYNC,__NR_msync */
/* defconst SYS_READV,__NR_readv */
/* defconst SYS_WRITEV,__NR_writev */
/* defconst SYS_GETSID,__NR_getsid */
/* defconst SYS_FDATASYNC,__NR_fdatasync */
/* defconst SYS__SYSCTL,__NR__sysctl */
/* defconst SYS_MUNLOCK,__NR_munlock */
/* defconst SYS_MLOCKALL,__NR_mlockall */
/* defconst SYS_MUNLOCKALL,__NR_munlockall */
/* defconst SYS_SCHED_SETPARAM,__NR_sched_setparam */
/* defconst SYS_SCHED_GETPARAM,__NR_sched_getparam */
/* defconst SYS_SCHED_SETSCHEDULER,__NR_sched_setscheduler */
/* defconst SYS_SCHED_GETSCHEDULER,__NR_sched_getscheduler */
/* defconst SYS_SCHED_YIELD,__NR_sched_yield */
/* defconst SYS_SCHED_GET_PRIORITY_MAX,__NR_sched_get_priority_max */
/* defconst SYS_SCHED_GET_PRIORITY_MIN,__NR_sched_get_priority_min */
/* defconst SYS_NANOSLEEP,__NR_nanosleep */
/* defconst SYS_MREMAP,__NR_mremap */
/* defconst SYS_VM86,__NR_vm86 */
/* defconst SYS_POLL,__NR_poll */
/* defconst SYS_PRCTL,__NR_prctl */
/* defconst SYS_RT_SIGRETURN,__NR_rt_sigreturn */
/* defconst SYS_RT_SIGACTION,__NR_rt_sigaction */
/* defconst SYS_RT_SIGPROCMASK,__NR_rt_sigprocmask */
/* defconst SYS_RT_SIGPENDING,__NR_rt_sigpending */
/* defconst SYS_RT_SIGQUEUEINFO,__NR_rt_sigqueueinfo */
/* defconst SYS_RT_SIGSUSPEND,__NR_rt_sigsuspend */
/* defconst SYS_PREAD64,__NR_pread64 */
/* defconst SYS_PWRITE64,__NR_pwrite64 */
/* defconst SYS_GETCWD,__NR_getcwd */
/* defconst SYS_CAPGET,__NR_capget */
/* defconst SYS_CAPSET,__NR_capset */
/* defconst SYS_SIGALTSTACK,__NR_sigaltstack */
/* defconst SYS_VFORK,__NR_vfork */
defconst SYS_MMAP2,__NR_mmap2
/* defconst SYS_TRUNCATE64,__NR_truncate64 */
/* defconst SYS_FTRUNCATE64,__NR_ftruncate64 */
/* defconst SYS_STAT64,__NR_stat64 */
/* defconst SYS_LSTAT64,__NR_lstat64 */
/* defconst SYS_LCHOWN32,__NR_lchown32 */
/* defconst SYS_GETUID32,__NR_getuid32 */
/* defconst SYS_GETGID32,__NR_getgid32 */
/* defconst SYS_GETEUID32,__NR_geteuid32 */
/* defconst SYS_GETEGID32,__NR_getegid32 */
/* defconst SYS_SETREUID32,__NR_setreuid32 */
/* defconst SYS_SETREGID32,__NR_setregid32 */
/* defconst SYS_GETGROUPS32,__NR_getgroups32 */
/* defconst SYS_SETGROUPS32,__NR_setgroups32 */
/* defconst SYS_SETRESUID32,__NR_setresuid32 */
/* defconst SYS_GETRESUID32,__NR_getresuid32 */
/* defconst SYS_SETRESGID32,__NR_setresgid32 */
/* defconst SYS_GETRESGID32,__NR_getresgid32 */
/* defconst SYS_CHOWN32,__NR_chown32 */
/* defconst SYS_SETUID32,__NR_setuid32 */
/* defconst SYS_SETGID32,__NR_setgid32 */
/* defconst SYS_SETFSUID32,__NR_setfsuid32 */
/* defconst SYS_SETFSGID32,__NR_setfsgid32 */
/* defconst SYS_PIVOT_ROOT,__NR_pivot_root */
/* defconst SYS_MINCORE,__NR_mincore */
/* defconst SYS_MADVISE,__NR_madvise */
/* defconst SYS_GETDENTS64,__NR_getdents64 */
/* defconst SYS_FCNTL64,__NR_fcntl64 */
defconst SYS_GETTID,__NR_gettid
/* defconst SYS_READAHEAD,__NR_readahead */
/* defconst SYS_SETXATTR,__NR_setxattr */
/* defconst SYS_LSETXATTR,__NR_lsetxattr */
/* defconst SYS_FSETXATTR,__NR_fsetxattr */
/* defconst SYS_GETXATTR,__NR_getxattr */
/* defconst SYS_LGETXATTR,__NR_lgetxattr */
/* defconst SYS_FGETXATTR,__NR_fgetxattr */
/* defconst SYS_LISTXATTR,__NR_listxattr */
/* defconst SYS_LLISTXATTR,__NR_llistxattr */
/* defconst SYS_FLISTXATTR,__NR_flistxattr */
/* defconst SYS_REMOVEXATTR,__NR_removexattr */
/* defconst SYS_LREMOVEXATTR,__NR_lremovexattr */
/* defconst SYS_FREMOVEXATTR,__NR_fremovexattr */
/* defconst SYS_SENDFILE64,__NR_sendfile64 */
/* defconst SYS_SCHED_SETAFFINITY,__NR_sched_setaffinity */
/* defconst SYS_SCHED_GETAFFINITY,__NR_sched_getaffinity */
/* defconst SYS_SET_THREAD_AREA,__NR_set_thread_area */
/* defconst SYS_GET_THREAD_AREA,__NR_get_thread_area */
/* defconst SYS_IO_SETUP,__NR_io_setup */
/* defconst SYS_IO_DESTROY,__NR_io_destroy */
/* defconst SYS_IO_GETEVENTS,__NR_io_getevents */
/* defconst SYS_IO_SUBMIT,__NR_io_submit */
/* defconst SYS_IO_CANCEL,__NR_io_cancel */
/* defconst SYS_EXIT_GROUP,__NR_exit_group */
/* defconst SYS_LOOKUP_DCOOKIE,__NR_lookup_dcookie */
/* defconst SYS_EPOLL_CTL,__NR_epoll_ctl */
/* defconst SYS_EPOLL_WAIT,__NR_epoll_wait */
/* defconst SYS_REMAP_FILE_PAGES,__NR_remap_file_pages */
/* defconst SYS_SET_TID_ADDRESS,__NR_set_tid_address */
/* defconst SYS_TIMER_CREATE,__NR_timer_create */
/* defconst SYS_TIMER_GETOVERRUN,__NR_timer_getoverrun */
/* defconst SYS_TIMER_DELETE,__NR_timer_delete */
/* defconst SYS_STATFS64,__NR_statfs64 */
/* defconst SYS_FSTATFS64,__NR_fstatfs64 */
defconst SYS_TGKILL,__NR_tgkill
/* defconst SYS_UTIMES,__NR_utimes */
/* defconst SYS_FADVISE64_64,__NR_fadvise64_64 */
/* defconst SYS_MBIND,__NR_mbind */
/* defconst SYS_GET_MEMPOLICY,__NR_get_mempolicy */
/* defconst SYS_SET_MEMPOLICY,__NR_set_mempolicy */
/* defconst SYS_MQ_OPEN,__NR_mq_open */
/* defconst SYS_MQ_UNLINK,__NR_mq_unlink */
/* defconst SYS_MQ_NOTIFY,__NR_mq_notify */
/* defconst SYS_MQ_GETSETATTR,__NR_mq_getsetattr */
/* defconst SYS_KEXEC_LOAD,__NR_kexec_load */
/* defconst SYS_WAITID,__NR_waitid */
/* defconst SYS_ADD_KEY,__NR_add_key */
/* defconst SYS_REQUEST_KEY,__NR_request_key */
/* defconst SYS_KEYCTL,__NR_keyctl */
/* defconst SYS_IOPRIO_SET,__NR_ioprio_set */
/* defconst SYS_IOPRIO_GET,__NR_ioprio_get */
/* defconst SYS_INOTIFY_ADD_WATCH,__NR_inotify_add_watch */
/* defconst SYS_INOTIFY_RM_WATCH,__NR_inotify_rm_watch */
/* defconst SYS_MIGRATE_PAGES,__NR_migrate_pages */
/* defconst SYS_MKDIRAT,__NR_mkdirat */
/* defconst SYS_MKNODAT,__NR_mknodat */
/* defconst SYS_FCHOWNAT,__NR_fchownat */
/* defconst SYS_FUTIMESAT,__NR_futimesat */
/* defconst SYS_FSTATAT64,__NR_fstatat64 */
/* defconst SYS_UNLINKAT,__NR_unlinkat */
/* defconst SYS_LINKAT,__NR_linkat */
/* defconst SYS_SYMLINKAT,__NR_symlinkat */
/* defconst SYS_READLINKAT,__NR_readlinkat */
/* defconst SYS_FCHMODAT,__NR_fchmodat */
/* defconst SYS_UNSHARE,__NR_unshare */
/* defconst SYS_SET_ROBUST_LIST,__NR_set_robust_list */
/* defconst SYS_GET_ROBUST_LIST,__NR_get_robust_list */
/* defconst SYS_SPLICE,__NR_splice */
/* defconst SYS_SYNC_FILE_RANGE,__NR_sync_file_range */
/* defconst SYS_TEE,__NR_tee */
/* defconst SYS_VMSPLICE,__NR_vmsplice */
/* defconst SYS_MOVE_PAGES,__NR_move_pages */
/* defconst SYS_GETCPU,__NR_getcpu */
/* defconst SYS_EPOLL_PWAIT,__NR_epoll_pwait */
/* defconst SYS_TIMERFD_CREATE,__NR_timerfd_create */
/* defconst SYS_FALLOCATE,__NR_fallocate */
/* defconst SYS_SIGNALFD4,__NR_signalfd4 */
/* defconst SYS_EVENTFD2,__NR_eventfd2 */
/* defconst SYS_EPOLL_CREATE1,__NR_epoll_create1 */
/* defconst SYS_DUP3,__NR_dup3 */
/* defconst SYS_PIPE2,__NR_pipe2 */
/* defconst SYS_INOTIFY_INIT1,__NR_inotify_init1 */
/* defconst SYS_RT_TGSIGQUEUEINFO,__NR_rt_tgsigqueueinfo */
/* defconst SYS_PERF_EVENT_OPEN,__NR_perf_event_open */
/* defconst SYS_FANOTIFY_INIT,__NR_fanotify_init */
/* defconst SYS_FANOTIFY_MARK,__NR_fanotify_mark */
/* defconst SYS_PRLIMIT64,__NR_prlimit64 */
/* defconst SYS_NAME_TO_HANDLE_AT,__NR_name_to_handle_at */
/* defconst SYS_OPEN_BY_HANDLE_AT,__NR_open_by_handle_at */
/* defconst SYS_SYNCFS,__NR_syncfs */
/* defconst SYS_SENDMMSG,__NR_sendmmsg */
/* defconst SYS_SETNS,__NR_setns */
/* defconst SYS_PROCESS_VM_READV,__NR_process_vm_readv */
/* defconst SYS_PROCESS_VM_WRITEV,__NR_process_vm_writev */
/* defconst SYS_KCMP,__NR_kcmp */
/* defconst SYS_FINIT_MODULE,__NR_finit_module */
/* defconst SYS_SCHED_SETATTR,__NR_sched_setattr */
/* defconst SYS_SCHED_GETATTR,__NR_sched_getattr */
/* defconst SYS_RENAMEAT2,__NR_renameat2 */
/* defconst SYS_SECCOMP,__NR_seccomp */
/* defconst SYS_GETRANDOM,__NR_getrandom */
/* defconst SYS_MEMFD_CREATE,__NR_memfd_create */
/* defconst SYS_BPF,__NR_bpf */
/* defconst SYS_EXECVEAT,__NR_execveat */
/* defconst SYS_SOCKET,__NR_socket */
/* defconst SYS_SOCKETPAIR,__NR_socketpair */
/* defconst SYS_BIND,__NR_bind */
/* defconst SYS_CONNECT,__NR_connect */
/* defconst SYS_LISTEN,__NR_listen */
/* defconst SYS_ACCEPT4,__NR_accept4 */
/* defconst SYS_GETSOCKOPT,__NR_getsockopt */
/* defconst SYS_SETSOCKOPT,__NR_setsockopt */
/* defconst SYS_GETSOCKNAME,__NR_getsockname */
/* defconst SYS_GETPEERNAME,__NR_getpeername */
/* defconst SYS_SENDTO,__NR_sendto */
/* defconst SYS_SENDMSG,__NR_sendmsg */
/* defconst SYS_RECVFROM,__NR_recvfrom */
/* defconst SYS_RECVMSG,__NR_recvmsg */
/* defconst SYS_SHUTDOWN,__NR_shutdown */
/* defconst SYS_USERFAULTFD,__NR_userfaultfd */
/* defconst SYS_MEMBARRIER,__NR_membarrier */
/* defconst SYS_MLOCK2,__NR_mlock2 */
/* defconst SYS_COPY_FILE_RANGE,__NR_copy_file_range */
/* defconst SYS_PREADV2,__NR_preadv2 */
/* defconst SYS_PWRITEV2,__NR_pwritev2 */
/* defconst SYS_PKEY_MPROTECT,__NR_pkey_mprotect */
/* defconst SYS_PKEY_ALLOC,__NR_pkey_alloc */
/* defconst SYS_PKEY_FREE,__NR_pkey_free */
/* defconst SYS_STATX,__NR_statx */
/* defconst SYS_ARCH_PRCTL,__NR_arch_prctl */
/* defconst SYS_RSEQ,__NR_rseq */
/* defconst SYS_SEMGET,__NR_semget */
/* defconst SYS_SEMCTL,__NR_semctl */
/* defconst SYS_SHMGET,__NR_shmget */
/* defconst SYS_SHMCTL,__NR_shmctl */
/* defconst SYS_SHMAT,__NR_shmat */
/* defconst SYS_SHMDT,__NR_shmdt */
/* defconst SYS_MSGGET,__NR_msgget */
/* defconst SYS_MSGSND,__NR_msgsnd */
/* defconst SYS_MSGRCV,__NR_msgrcv */
/* defconst SYS_MSGCTL,__NR_msgctl */
/* defconst SYS_CLOCK_GETTIME64,__NR_clock_gettime64 */
/* defconst SYS_CLOCK_SETTIME64,__NR_clock_settime64 */
/* defconst SYS_CLOCK_ADJTIME64,__NR_clock_adjtime64 */
/* defconst SYS_CLOCK_GETRES_TIME64,__NR_clock_getres_time64 */
/* defconst SYS_CLOCK_NANOSLEEP_TIME64,__NR_clock_nanosleep_time64 */
/* defconst SYS_TIMER_GETTIME64,__NR_timer_gettime64 */
/* defconst SYS_TIMER_SETTIME64,__NR_timer_settime64 */
/* defconst SYS_TIMERFD_GETTIME64,__NR_timerfd_gettime64 */
/* defconst SYS_TIMERFD_SETTIME64,__NR_timerfd_settime64 */
/* defconst SYS_UTIMENSAT_TIME64,__NR_utimensat_time64 */
/* defconst SYS_PSELECT6_TIME64,__NR_pselect6_time64 */
/* defconst SYS_PPOLL_TIME64,__NR_ppoll_time64 */
/* defconst SYS_IO_PGETEVENTS_TIME64,__NR_io_pgetevents_time64 */
/* defconst SYS_RECVMMSG_TIME64,__NR_recvmmsg_time64 */
/* defconst SYS_MQ_TIMEDSEND_TIME64,__NR_mq_timedsend_time64 */
/* defconst SYS_MQ_TIMEDRECEIVE_TIME64,__NR_mq_timedreceive_time64 */
/* defconst SYS_SEMTIMEDOP_TIME64,__NR_semtimedop_time64 */
/* defconst SYS_RT_SIGTIMEDWAIT_TIME64,__NR_rt_sigtimedwait_time64 */
/* defconst SYS_FUTEX_TIME64,__NR_futex_time64 */
/* defconst SYS_SCHED_RR_GET_INTERVAL_TIME64,__NR_sched_rr_get_interval_time64 */
/* defconst SYS_PIDFD_SEND_SIGNAL,__NR_pidfd_send_signal */
/* defconst SYS_IO_URING_SETUP,__NR_io_uring_setup */
/* defconst SYS_IO_URING_ENTER,__NR_io_uring_enter */
/* defconst SYS_IO_URING_REGISTER,__NR_io_uring_register */
/* defconst SYS_OPEN_TREE,__NR_open_tree */
/* defconst SYS_MOVE_MOUNT,__NR_move_mount */
/* defconst SYS_FSOPEN,__NR_fsopen */
/* defconst SYS_FSCONFIG,__NR_fsconfig */
/* defconst SYS_FSMOUNT,__NR_fsmount */
/* defconst SYS_FSPICK,__NR_fspick */
/* defconst SYS_PIDFD_OPEN,__NR_pidfd_open */
/* defconst SYS_CLONE3,__NR_clone3 */
/* defconst SYS_OPENAT2,__NR_openat2 */
/* defconst SYS_PIDFD_GETFD,__NR_pidfd_getfd */
/* defconst SYS_FACCESSAT2,__NR_faccessat2 */
/* Special dirfd for *at syscalls to resolve path relative to current directory */
/* defconst AT_FDCWD,-100 */
/*
** errno values
*/
/* defconst ERRNO_EPERM,1 */
/* defconst ERRNO_ENOENT,2 */
/* defconst ERRNO_ESRCH,3 */
defconst ERRNO_EINTR,4
/* defconst ERRNO_EIO,5 */
/* defconst ERRNO_ENXIO,6 */
/* defconst ERRNO_E2BIG,7 */
/* defconst ERRNO_ENOEXEC,8 */
/* defconst ERRNO_EBADF,9 */
/* defconst ERRNO_ECHILD,10 */
/* defconst ERRNO_EAGAIN,11 */
/* defconst ERRNO_ENOMEM,12 */
/* defconst ERRNO_EACCES,13 */
/* defconst ERRNO_EFAULT,14 */
/* defconst ERRNO_ENOTBLK,15 */
/* defconst ERRNO_EBUSY,16 */
/* defconst ERRNO_EEXIST,17 */
/* defconst ERRNO_EXDEV,18 */
/* defconst ERRNO_ENODEV,19 */
/* defconst ERRNO_ENOTDIR,20 */
/* defconst ERRNO_EISDIR,21 */
/* defconst ERRNO_EINVAL,22 */
/* defconst ERRNO_ENFILE,23 */
/* defconst ERRNO_EMFILE,24 */
/* defconst ERRNO_ENOTTY,25 */
/* defconst ERRNO_ETXTBSY,26 */
/* defconst ERRNO_EFBIG,27 */
/* defconst ERRNO_ENOSPC,28 */
/* defconst ERRNO_ESPIPE,29 */
/* defconst ERRNO_EROFS,30 */
/* defconst ERRNO_EMLINK,31 */
/* defconst ERRNO_EPIPE,32 */
/* defconst ERRNO_EDOM,33 */
/* defconst ERRNO_ERANGE,34 */
/*
** signal numbers
*/
/* defconst SIGHUP,1 */
/* defconst SIGINT,2 */
/* defconst SIGQUIT,3 */
/* defconst SIGILL,4 */
/* defconst SIGTRAP,5 */
defconst SIGABRT,6
/* defconst SIGIOT,6 */
/* defconst SIGBUS,7 */
/* defconst SIGFPE,8 */
/* defconst SIGKILL,9 */
/* defconst SIGUSR1,10 */
/* defconst SIGSEGV,11 */
/* defconst SIGUSR2,12 */
/* defconst SIGPIPE,13 */
/* defconst SIGALRM,14 */
/* defconst SIGTERM,15 */
/* defconst SIGSTKFLT,16 */
/* defconst SIGCHLD,17 */
/* defconst SIGCONT,18 */
/* defconst SIGSTOP,19 */
/* defconst SIGTSTP,20 */
/* defconst SIGTTIN,21 */
/* defconst SIGTTOU,22 */
/* defconst SIGURG,23 */
/* defconst SIGXCPU,24 */
/* defconst SIGXFSZ,25 */
/* defconst SIGVTALRM,26 */
/* defconst SIGPROF,27 */
/* defconst SIGWINCH,28 */
/* defconst SIGIO,29 */
/* defconst SIGPOLL,29 */
/* defconst SIGPWR,30 */
/* defconst SIGSYS,31 */
/*
** openat2() flags
*/
/* defconst __O_RDONLY,0,"O_RDONLY" */
/* defconst __O_WRONLY,1,"O_WRONLY" */
/* defconst __O_RDWR,2,"O_RDWR" */
/* defconst __O_CREAT,0100,"O_CREAT" */
/* defconst __O_EXCL,0200,"O_EXCL" */
/* defconst __O_TRUNC,01000,"O_TRUNC" */
/* defconst __O_APPEND,02000,"O_APPEND" */
/* defconst __O_NONBLOCK,04000,"O_NONBLOCK" */
/* NOTE: These are initialized in _start and read-only thereafter. */ /* NOTE: These are initialized in _start and read-only thereafter. */
defvalue C0 /* first byte of the heap */ defvalue C0 /* first byte of the heap */
defvalue S0 /* initial (empty) data stack pointer */ defvalue S0 /* initial (empty) data stack pointer */
@ -631,9 +221,6 @@ defvar IN,0,">IN"
defvar CP /* "compilation pointer", next free byte in the heap */ defvar CP /* "compilation pointer", next free byte in the heap */
defvar BRK /* the (current) end of the heap */ defvar BRK /* the (current) end of the heap */
/* The list of primitive (native code) words provided by this file */
defvar PRIMITIVE_WORDLIST,last_primitive,"PRIMITIVE-WORDLIST"
/* The list of basic non-primitive words used to bootstrap the startup.4th file */ /* The list of basic non-primitive words used to bootstrap the startup.4th file */
defvar BOOTSTRAP_WORDLIST,last_word,"BOOTSTRAP-WORDLIST" defvar BOOTSTRAP_WORDLIST,last_word,"BOOTSTRAP-WORDLIST"
@ -645,16 +232,6 @@ defvar FORTH_WORDLIST,last_primitive,"FORTH-WORDLIST"
/* The current compilation word list, initially FORTH-WORDLIST */ /* The current compilation word list, initially FORTH-WORDLIST */
defvar CURRENT,data_FORTH_WORDLIST defvar CURRENT,data_FORTH_WORDLIST
.section .data
.align 4
/* This is a linked list; initial_order points to the head of the list */
0: .int 0,data_BOOTSTRAP_WORDLIST
initial_order:
.int 0b,data_FORTH_WORDLIST
/* Head of the linked list representing the current search order */
defvar CURRENT_ORDER,initial_order,"CURRENT-ORDER"
/* ( a -- ) */ /* ( a -- ) */
defcode DROP defcode DROP
pop %eax pop %eax
@ -1541,11 +1118,11 @@ bootstrap_data_begin:
/* ( c-addr u -- "ccc" ) */ /* ( c-addr u -- "ccc" ) */
defword TYPE defword TYPE
.int LIT,1,NROT,SYS_WRITE,SYSCALL3,DROP,EXIT .int LIT,1,NROT,LIT,__NR_write,SYSCALL3,DROP,EXIT
/* ( c -- "c" ) */ /* ( c -- "c" ) */
defword EMIT defword EMIT
.int SPFETCH,LIT,1,SWAP,LIT,1,SYS_WRITE,SYSCALL3,TWODROP,EXIT .int SPFETCH,LIT,1,SWAP,LIT,1,LIT,__NR_write,SYSCALL3,TWODROP,EXIT
/* ( -- "<eol>" ) */ /* ( -- "<eol>" ) */
defword EOL defword EOL
@ -1556,7 +1133,7 @@ defword BAILOUT
.int BREAK .int BREAK
litstring "Fatal error\n" litstring "Fatal error\n"
.int TYPE .int TYPE
0: .int LIT,254,SYS_EXIT,SYSCALL1,DROP,BRANCH,(0b - .) 0: .int LIT,254,LIT,__NR_exit,SYSCALL1,DROP,BRANCH,(0b - .)
.int EXIT /* just to mark the end */ .int EXIT /* just to mark the end */
defword UNEXPECTED_EOF,"UNEXPECTED-EOF" defword UNEXPECTED_EOF,"UNEXPECTED-EOF"
@ -1568,13 +1145,9 @@ defword UNEXPECTED_EOF,"UNEXPECTED-EOF"
defword SOURCE defword SOURCE
.int LIT,startup_defs,LIT,(startup_defs_end - startup_defs),EXIT .int LIT,startup_defs,LIT,(startup_defs_end - startup_defs),EXIT
/* ( c-addr u1 u2 -- c-addr+u2 u1-u2 ) */
defword DROP_PREFIX,"DROP-PREFIX"
.int ROT,OVER,ADD,NROT,SUB,EXIT
/* ( -- c-addr u ) Current parse area (input buffer minus first >IN characters) */ /* ( -- c-addr u ) Current parse area (input buffer minus first >IN characters) */
defword PARSE_AREA,"PARSE-AREA" defword PARSE_AREA,"PARSE-AREA"
.int SOURCE,IN,FETCH,DROP_PREFIX,EXIT .int SOURCE,IN,FETCH,ROT,OVER,ADD,NROT,SUB,EXIT
/* ( "c" -- c ) Leaves c at the start of the parse area */ /* ( "c" -- c ) Leaves c at the start of the parse area */
defword PEEK_CHAR,"PEEK-CHAR" defword PEEK_CHAR,"PEEK-CHAR"
@ -1664,13 +1237,10 @@ defword ISBOOTSTRAP,"BOOTSTRAP?"
.int LIT,bootstrap_data_end,ULT,EXIT .int LIT,bootstrap_data_end,ULT,EXIT
0: .int DROP,FALSE,EXIT 0: .int DROP,FALSE,EXIT
/* Convert search order entry address to address of word list identifier field */ /* ( -- widn ... wid1 n ) Return the current search order */
defword ORDER_TWID,"ORDER>WID" /* Redefining this word with DEFER! will change the bootstrap search order */
.int CELL,ADD,EXIT defword GET_ORDER,"BOOTSTRAP-GET-ORDER"
.int BOOTSTRAP_WORDLIST,FORTH_WORDLIST,LIT,2,EXIT
/* Convert search order entry address to address of link field */
defword ORDER_TLINK,"ORDER>LINK"
.int EXIT
/* ( c-addr u wid -- 0 | xt 1 | xt -1 ) */ /* ( c-addr u wid -- 0 | xt 1 | xt -1 ) */
/* 0 = not found; 1 = non-immediate; -1 = immediate */ /* 0 = not found; 1 = non-immediate; -1 = immediate */
@ -1683,25 +1253,24 @@ defword SEARCH_WORDLIST,"SEARCH-WORDLIST"
.int STREQU,ZBRANCH,(3f - .) /* entry c-addr u */ .int STREQU,ZBRANCH,(3f - .) /* entry c-addr u */
.int TWODROP,DUP,ISIMMEDIATE,LIT,1,OR,EXIT /* entry 1 | entry -1 */ .int TWODROP,DUP,ISIMMEDIATE,LIT,1,OR,EXIT /* entry 1 | entry -1 */
3: .int ROT,BRANCH,(1b - .) /* c-addr u entry */ 3: .int ROT,BRANCH,(1b - .) /* c-addr u entry */
4: .int NIP,NIP,EXIT /* entry (= 0) */ 4: .int NIP,NIP,EXIT /* 0 */
/* ( c-addr u -- c-addr u 0 | xt 1 | xt -1 ) */ /* ( c-addr u -- c-addr u 0 | xt 1 | xt -1 ) */
defword FIND defword FIND
.int TWOTOR,CURRENT_ORDER .int TWOTOR,GET_ORDER
0: .int FETCH,QDUP,ZBRANCH,(1f - .) 0: .int DUP,ZBRANCH,(1f - .)
.int DUP,ORDER_TLINK,SWAP,ORDER_TWID,FETCH .int SUB1,SWAP,TWORFETCH,ROT,SEARCH_WORDLIST,QDUP,ZBRANCH,(0b - .)
.int TWORFETCH,ROT,SEARCH_WORDLIST,QDUP,ZBRANCH,(0b - .) .int TWORDROP,TWOTOR,NDROP,TWOFROMR,EXIT
.int TWORDROP,ROT,DROP,EXIT 1: .int TWOFROMR,ROT,EXIT
1: .int TWOFROMR,LIT,0,EXIT
/* ( c-addr u -- xt 1 | xt -1 ) */ /* ( c-addr u -- xt 1 | xt -1 ) */
defword FIND_OR_ABORT,"FIND-OR-ABORT" defword FIND_OR_BAILOUT,"FIND-OR-BAILOUT"
.int FIND,QDUP,ZBRANCH,(0f - .),EXIT .int FIND,QDUP,ZBRANCH,(0f - .),EXIT
0: litstring "Word not found: " 0: litstring "Word not found: "
.int TYPE,TYPE,EOL,BAILOUT,EXIT .int TYPE,TYPE,EOL,BAILOUT,EXIT
/* ( "<spaces>" -- ) */ /* ( "<spaces>" -- ) */
defword SKIPSPACE defword SKIP_SPACE,"SKIP-SPACE"
0: .int PARSE_AREA,ZBRANCH,(1f - .) 0: .int PARSE_AREA,ZBRANCH,(1f - .)
.int FETCHBYTE,ISSPACE,ZBRANCH,(2f - .) .int FETCHBYTE,ISSPACE,ZBRANCH,(2f - .)
.int LIT,1,IN,INCREMENT,BRANCH,(0b - .) .int LIT,1,IN,INCREMENT,BRANCH,(0b - .)
@ -1710,7 +1279,7 @@ defword SKIPSPACE
/* ( "<spaces?>ccc" -- c-addr u ) */ /* ( "<spaces?>ccc" -- c-addr u ) */
defword WORD defword WORD
.int SKIPSPACE .int SKIP_SPACE
.int PARSE_AREA,DROP,LIT,1 .int PARSE_AREA,DROP,LIT,1
.int NEXT_CHAR,DROP .int NEXT_CHAR,DROP
0: .int PARSE_AREA,ZBRANCH,(1f - .) 0: .int PARSE_AREA,ZBRANCH,(1f - .)
@ -1759,7 +1328,7 @@ defword PARSENUMBER
9: .int TRUE,EXIT 9: .int TRUE,EXIT
defword INTERPRET defword INTERPRET
.int SKIPSPACE .int SKIP_SPACE
.int PEEK_CHAR,LIT,34,EQU,ZBRANCH,(1f - .) .int PEEK_CHAR,LIT,34,EQU,ZBRANCH,(1f - .)
.int LIT,1,IN,INCREMENT .int LIT,1,IN,INCREMENT
.int STATE,FETCH,ZBRANCH,(0f - .) .int STATE,FETCH,ZBRANCH,(0f - .)
@ -1774,7 +1343,7 @@ defword INTERPRET
.int LIT,LIT,COMMA,COMMA .int LIT,LIT,COMMA,COMMA
2: .int EXIT 2: .int EXIT
/* ELSE */ /* ELSE */
3: .int FIND_OR_ABORT,DROP 3: .int FIND_OR_BAILOUT,DROP
.int STATE,FETCH,ZBRANCH,(4f - .) .int STATE,FETCH,ZBRANCH,(4f - .)
/* ( OR ) */ /* ( OR ) */
.int DUP,ISIMMEDIATE,ZBRANCH,(5f - .) .int DUP,ISIMMEDIATE,ZBRANCH,(5f - .)
@ -1812,19 +1381,19 @@ defword LBRACKET,"[",F_IMMED
defword RBRACKET,"]",F_IMMED defword RBRACKET,"]",F_IMMED
.int TRUE,STATE,STORE,EXIT .int TRUE,STATE,STORE,EXIT
defword SLASH,"\\",F_IMMED defword BACKSLASH,"\\",F_IMMED
0: .int NEXT_CHAR,LIT,10,EQU,ZBRANCH,(0b - .),EXIT 0: .int NEXT_CHAR,LIT,10,EQU,ZBRANCH,(0b - .),EXIT
defword PAREN,"(",F_IMMED defword OPENPAREN,"(",F_IMMED
0: .int NEXT_CHAR,LIT,')',EQU,ZBRANCH,(0b - .),EXIT 0: .int NEXT_CHAR,LIT,')',EQU,ZBRANCH,(0b - .),EXIT
defword COLON,":" defword COLON,":"
/* Make word & fetch address */ /* Make word & fetch address */
.int CREATE,LATEST .int CREATE
/* Set as hidden */ /* Set as hidden */
.int DUP,TFLAGS,DUP,FETCHBYTE,__F_HIDDEN,OR,SWAP,STOREBYTE .int LATEST,TFLAGS,DUP,FETCHBYTE,__F_HIDDEN,OR,SWAP,STOREBYTE
/* Convert to DOCOL codeword */ /* Convert to DOCOL codeword */
.int __DOCOL,SWAP,TCFA,STORE .int __DOCOL,LATEST,TCFA,STORE
/* Enter compilation mode */ /* Enter compilation mode */
.int TRUE,STATE,STORE,EXIT .int TRUE,STATE,STORE,EXIT
@ -1845,16 +1414,12 @@ defword CONSTANT
defword DEFERSTORE,"DEFER!" defword DEFERSTORE,"DEFER!"
.int __DODEFER,OVER,TCFA,STORE,TDFA,STORE,EXIT .int __DODEFER,OVER,TCFA,STORE,TDFA,STORE,EXIT
/* ( deferred-xt -- target-xt ) */
defword DEFERFETCH,"DEFER@"
.int TDFA,FETCH,EXIT
/* ( "<spaces>ccc" -- ) */ /* ( "<spaces>ccc" -- ) */
defword DEFER defword DEFER
.int CREATE,LIT,BAILOUT,LATEST,DEFERSTORE,EXIT .int CREATE,LIT,BAILOUT,LATEST,DEFERSTORE,EXIT
defword QUOTE,"'" defword QUOTE,"'"
.int WORD,FIND_OR_ABORT,DROP,EXIT .int WORD,FIND_OR_BAILOUT,DROP,EXIT
defword LITERAL,,F_IMMED defword LITERAL,,F_IMMED
.int LIT,LIT,COMMA,COMMA,EXIT .int LIT,LIT,COMMA,COMMA,EXIT
@ -1869,7 +1434,7 @@ defword COMPILE_CHAR,"[CHAR]",F_IMMED
.int CHAR,LITERAL,EXIT .int CHAR,LITERAL,EXIT
defword POSTPONE,,F_IMMED defword POSTPONE,,F_IMMED
.int WORD,FIND_OR_ABORT,ZGT,ZBRANCH,(0f - .) .int WORD,FIND_OR_BAILOUT,ZGT,ZBRANCH,(0f - .)
.int LITERAL .int LITERAL
/* this would compile bootstrap COMMA into the definition */ /* this would compile bootstrap COMMA into the definition */
/* .int LITERAL,LIT,COMMA,COMMA,EXIT */ /* .int LITERAL,LIT,COMMA,COMMA,EXIT */

692
startup.4th
View File

@ -1,3 +1,29 @@
\ Get and set the current compilation word list
: GET-CURRENT ( -- wid ) CURRENT @ ;
: SET-CURRENT ( wid -- ) CURRENT ! ;
\ Keep internal system definitions and ABI constants out of the main word list
CREATE SYSTEM-WORDLIST 0 ,
CREATE LINUX-WORDLIST 0 ,
SYSTEM-WORDLIST SET-CURRENT
\ Use this list until we get around to defining the real GET-ORDER
: STARTUP-ORDER BOOTSTRAP-WORDLIST LINUX-WORDLIST SYSTEM-WORDLIST FORTH-WORDLIST 4 ;
LATEST ' BOOTSTRAP-GET-ORDER DEFER!
\ Shorthand for selecting the current compilation word list
: >>SYSTEM SYSTEM-WORDLIST SET-CURRENT ;
: >>FORTH FORTH-WORDLIST SET-CURRENT ;
: >>LINUX LINUX-WORDLIST SET-CURRENT ;
>>FORTH
0 CONSTANT NULL
: KB 10 LSHIFT ;
: MB 20 LSHIFT ;
\ Shorthand for working with cell-aligned addresses \ Shorthand for working with cell-aligned addresses
: CELL+ ( addr1 -- addr2 ) CELL + ; : CELL+ ( addr1 -- addr2 ) CELL + ;
: CELL- ( addr1 -- addr2 ) CELL - ; : CELL- ( addr1 -- addr2 ) CELL - ;
@ -16,6 +42,8 @@
: ALIGNED-TO ( addr1 u -- addr2 ) : ALIGNED-TO ( addr1 u -- addr2 )
NATURALLY-ALIGNED TUCK 1- + SWAP NEGATE AND ; NATURALLY-ALIGNED TUCK 1- + SWAP NEGATE AND ;
>>SYSTEM
\ Field accessors for execution tokens \ Field accessors for execution tokens
: >CFA ( xt -- a-addr ) ; : >CFA ( xt -- a-addr ) ;
: >DFA ( xt -- a-addr ) CELL+ ; : >DFA ( xt -- a-addr ) CELL+ ;
@ -24,13 +52,21 @@
: >NAME ( xt -- c-addr u ) >FLAGS DUP 1+ SWAP C@ F_LENMASK AND ; : >NAME ( xt -- c-addr u ) >FLAGS DUP 1+ SWAP C@ F_LENMASK AND ;
: >BODY ( xt -- a-addr ) >NAME + ALIGNED ; : >BODY ( xt -- a-addr ) >NAME + ALIGNED ;
: IMMEDIATE? ( xt -- flag ) >FLAGS C@ F_IMMED AND 0<> ;
: HIDDEN? ( xt -- flag ) >FLAGS C@ F_HIDDEN AND 0<> ;
\ Set or clear the HIDDEN flag for word with the given execution token \ Set or clear the HIDDEN flag for word with the given execution token
: (HIDE) ( xt -- ) >FLAGS DUP C@ F_HIDDEN OR SWAP C! ; : (HIDE) ( xt -- ) >FLAGS DUP C@ F_HIDDEN OR SWAP C! ;
: (UNHIDE) ( xt -- ) >FLAGS DUP C@ F_HIDDEN INVERT AND SWAP C! ; : (UNHIDE) ( xt -- ) >FLAGS DUP C@ F_HIDDEN INVERT AND SWAP C! ;
\ Use GET-CURRENT and SET-CURRENT to manipulate the compilation word list
' CURRENT (HIDE)
\ This is only used during early startup
' STARTUP-ORDER (HIDE)
>>FORTH
: IMMEDIATE? ( xt -- flag ) >FLAGS C@ F_IMMED AND 0<> ;
: HIDDEN? ( xt -- flag ) >FLAGS C@ F_HIDDEN AND 0<> ;
\ Fetch and store the target of the deferred word denoted by deferred-xt \ Fetch and store the target of the deferred word denoted by deferred-xt
\ Note that this DEFER! can turn any word into a deferred word \ Note that this DEFER! can turn any word into a deferred word
: DEFER@ ( deferred-xt -- xt ) >DFA @ ; : DEFER@ ( deferred-xt -- xt ) >DFA @ ;
@ -43,7 +79,7 @@
-1 CONSTANT EXCP-ABORT -1 CONSTANT EXCP-ABORT
-2 CONSTANT EXCP-FAIL -2 CONSTANT EXCP-FAIL
-3 CONSTANT EXCP-STACK-OVERFLOW -3 CONSTANT EXCP-STACK-OVERFLOW
-4 CONSTANT EXCP-STACk-UNDERFLOW -4 CONSTANT EXCP-STACK-UNDERFLOW
-5 CONSTANT EXCP-RETURN-OVERFLOW -5 CONSTANT EXCP-RETURN-OVERFLOW
-6 CONSTANT EXCP-RETURN-UNDERFLOW -6 CONSTANT EXCP-RETURN-UNDERFLOW
-8 CONSTANT EXCP-DICTIONARY-OVERFLOW -8 CONSTANT EXCP-DICTIONARY-OVERFLOW
@ -54,15 +90,20 @@
\ Non-standard system error codes (-4095 ... -256) \ Non-standard system error codes (-4095 ... -256)
-256 CONSTANT EXCP-HEAP-OVERFLOW -256 CONSTANT EXCP-HEAP-OVERFLOW
>>SYSTEM
\ THROWN-STRING holds the address and size of the string passed to FAIL \ THROWN-STRING holds the address and size of the string passed to FAIL
\ It may also be used to hold context strings for other system exception codes \ It may also be used to hold context strings for other system exception codes
CREATE THROWN-STRING 0 , 0 , CREATE THROWN-STRING 2 CELLS ALLOT
0 0 THROWN-STRING 2!
\ This is called by THROW when n is nonzero \ This is called by THROW when n is nonzero
\ The initial value (DEFAULT-UNWIND) performs the function of ABORT \ The initial value (DEFAULT-UNWIND) performs the function of ABORT
\ CATCH saves and restores the current target and substitutes its own version \ CATCH saves and restores the current target and substitutes its own version
DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> ) DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
>>FORTH
\ If n is nonzero, return control to the nearest CATCH on the return stack \ If n is nonzero, return control to the nearest CATCH on the return stack
\ If there is no CATCH, perform the function of ABORT (clear data stack and QUIT) \ If there is no CATCH, perform the function of ABORT (clear data stack and QUIT)
\ Absent CATCH, whether a message is displayed depends on the value of n: \ Absent CATCH, whether a message is displayed depends on the value of n:
@ -94,11 +135,420 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
: ?FAIL ( flag c-addr u -- <none> | <noreturn> ) : ?FAIL ( flag c-addr u -- <none> | <noreturn> )
ROT IF FAIL ELSE 2DROP THEN ; ROT IF FAIL ELSE 2DROP THEN ;
>>LINUX
\ x86 system call numbers
1 CONSTANT SYS_EXIT
2 CONSTANT SYS_FORK
3 CONSTANT SYS_READ
4 CONSTANT SYS_WRITE
6 CONSTANT SYS_CLOSE
7 CONSTANT SYS_WAITPID
12 CONSTANT SYS_CHDIR
13 CONSTANT SYS_TIME
15 CONSTANT SYS_CHMOD
19 CONSTANT SYS_LSEEK
20 CONSTANT SYS_GETPID
21 CONSTANT SYS_MOUNT
25 CONSTANT SYS_STIME
26 CONSTANT SYS_PTRACE
27 CONSTANT SYS_ALARM
29 CONSTANT SYS_PAUSE
30 CONSTANT SYS_UTIME
33 CONSTANT SYS_ACCESS
34 CONSTANT SYS_NICE
36 CONSTANT SYS_SYNC
37 CONSTANT SYS_KILL
40 CONSTANT SYS_RMDIR
41 CONSTANT SYS_DUP
43 CONSTANT SYS_TIMES
45 CONSTANT SYS_BRK
48 CONSTANT SYS_SIGNAL
52 CONSTANT SYS_UMOUNT2
54 CONSTANT SYS_IOCTL
57 CONSTANT SYS_SETPGID
60 CONSTANT SYS_UMASK
61 CONSTANT SYS_CHROOT
62 CONSTANT SYS_USTAT
64 CONSTANT SYS_GETPPID
65 CONSTANT SYS_GETPGRP
66 CONSTANT SYS_SETSID
68 CONSTANT SYS_SGETMASK
69 CONSTANT SYS_SSETMASK
74 CONSTANT SYS_SETHOSTNAME
75 CONSTANT SYS_SETRLIMIT
76 CONSTANT SYS_GETRLIMIT
77 CONSTANT SYS_GETRUSAGE
78 CONSTANT SYS_GETTIMEOFDAY
79 CONSTANT SYS_SETTIMEOFDAY
82 CONSTANT SYS_SELECT
87 CONSTANT SYS_SWAPON
88 CONSTANT SYS_REBOOT
89 CONSTANT SYS_READDIR
91 CONSTANT SYS_MUNMAP
96 CONSTANT SYS_GETPRIORITY
97 CONSTANT SYS_SETPRIORITY
101 CONSTANT SYS_IOPERM
103 CONSTANT SYS_SYSLOG
104 CONSTANT SYS_SETITIMER
105 CONSTANT SYS_GETITIMER
110 CONSTANT SYS_IOPL
111 CONSTANT SYS_VHANGUP
112 CONSTANT SYS_IDLE
114 CONSTANT SYS_WAIT4
115 CONSTANT SYS_SWAPOFF
116 CONSTANT SYS_SYSINFO
117 CONSTANT SYS_IPC
118 CONSTANT SYS_FSYNC
121 CONSTANT SYS_SETDOMAINNAME
122 CONSTANT SYS_UNAME
123 CONSTANT SYS_MODIFY_LDT
124 CONSTANT SYS_ADJTIMEX
125 CONSTANT SYS_MPROTECT
128 CONSTANT SYS_INIT_MODULE
129 CONSTANT SYS_DELETE_MODULE
131 CONSTANT SYS_QUOTACTL
132 CONSTANT SYS_GETPGID
133 CONSTANT SYS_FCHDIR
135 CONSTANT SYS_SYSFS
136 CONSTANT SYS_PERSONALITY
140 CONSTANT SYS__LLSEEK
142 CONSTANT SYS__NEWSELECT
143 CONSTANT SYS_FLOCK
144 CONSTANT SYS_MSYNC
145 CONSTANT SYS_READV
146 CONSTANT SYS_WRITEV
147 CONSTANT SYS_GETSID
148 CONSTANT SYS_FDATASYNC
149 CONSTANT SYS__SYSCTL
151 CONSTANT SYS_MUNLOCK
152 CONSTANT SYS_MLOCKALL
153 CONSTANT SYS_MUNLOCKALL
154 CONSTANT SYS_SCHED_SETPARAM
155 CONSTANT SYS_SCHED_GETPARAM
156 CONSTANT SYS_SCHED_SETSCHEDULER
157 CONSTANT SYS_SCHED_GETSCHEDULER
158 CONSTANT SYS_SCHED_YIELD
159 CONSTANT SYS_SCHED_GET_PRIORITY_MAX
160 CONSTANT SYS_SCHED_GET_PRIORITY_MIN
162 CONSTANT SYS_NANOSLEEP
163 CONSTANT SYS_MREMAP
166 CONSTANT SYS_VM86
168 CONSTANT SYS_POLL
172 CONSTANT SYS_PRCTL
173 CONSTANT SYS_RT_SIGRETURN
174 CONSTANT SYS_RT_SIGACTION
175 CONSTANT SYS_RT_SIGPROCMASK
176 CONSTANT SYS_RT_SIGPENDING
178 CONSTANT SYS_RT_SIGQUEUEINFO
179 CONSTANT SYS_RT_SIGSUSPEND
180 CONSTANT SYS_PREAD64
181 CONSTANT SYS_PWRITE64
183 CONSTANT SYS_GETCWD
184 CONSTANT SYS_CAPGET
185 CONSTANT SYS_CAPSET
186 CONSTANT SYS_SIGALTSTACK
190 CONSTANT SYS_VFORK
192 CONSTANT SYS_MMAP2
193 CONSTANT SYS_TRUNCATE64
194 CONSTANT SYS_FTRUNCATE64
195 CONSTANT SYS_STAT64
196 CONSTANT SYS_LSTAT64
198 CONSTANT SYS_LCHOWN32
199 CONSTANT SYS_GETUID32
200 CONSTANT SYS_GETGID32
201 CONSTANT SYS_GETEUID32
202 CONSTANT SYS_GETEGID32
203 CONSTANT SYS_SETREUID32
204 CONSTANT SYS_SETREGID32
205 CONSTANT SYS_GETGROUPS32
206 CONSTANT SYS_SETGROUPS32
208 CONSTANT SYS_SETRESUID32
209 CONSTANT SYS_GETRESUID32
210 CONSTANT SYS_SETRESGID32
211 CONSTANT SYS_GETRESGID32
212 CONSTANT SYS_CHOWN32
213 CONSTANT SYS_SETUID32
214 CONSTANT SYS_SETGID32
215 CONSTANT SYS_SETFSUID32
216 CONSTANT SYS_SETFSGID32
217 CONSTANT SYS_PIVOT_ROOT
218 CONSTANT SYS_MINCORE
219 CONSTANT SYS_MADVISE
220 CONSTANT SYS_GETDENTS64
221 CONSTANT SYS_FCNTL64
224 CONSTANT SYS_GETTID
225 CONSTANT SYS_READAHEAD
226 CONSTANT SYS_SETXATTR
227 CONSTANT SYS_LSETXATTR
228 CONSTANT SYS_FSETXATTR
229 CONSTANT SYS_GETXATTR
230 CONSTANT SYS_LGETXATTR
231 CONSTANT SYS_FGETXATTR
232 CONSTANT SYS_LISTXATTR
233 CONSTANT SYS_LLISTXATTR
234 CONSTANT SYS_FLISTXATTR
235 CONSTANT SYS_REMOVEXATTR
236 CONSTANT SYS_LREMOVEXATTR
237 CONSTANT SYS_FREMOVEXATTR
239 CONSTANT SYS_SENDFILE64
241 CONSTANT SYS_SCHED_SETAFFINITY
242 CONSTANT SYS_SCHED_GETAFFINITY
243 CONSTANT SYS_SET_THREAD_AREA
244 CONSTANT SYS_GET_THREAD_AREA
245 CONSTANT SYS_IO_SETUP
246 CONSTANT SYS_IO_DESTROY
247 CONSTANT SYS_IO_GETEVENTS
248 CONSTANT SYS_IO_SUBMIT
249 CONSTANT SYS_IO_CANCEL
252 CONSTANT SYS_EXIT_GROUP
253 CONSTANT SYS_LOOKUP_DCOOKIE
255 CONSTANT SYS_EPOLL_CTL
256 CONSTANT SYS_EPOLL_WAIT
257 CONSTANT SYS_REMAP_FILE_PAGES
258 CONSTANT SYS_SET_TID_ADDRESS
259 CONSTANT SYS_TIMER_CREATE
262 CONSTANT SYS_TIMER_GETOVERRUN
263 CONSTANT SYS_TIMER_DELETE
268 CONSTANT SYS_STATFS64
269 CONSTANT SYS_FSTATFS64
270 CONSTANT SYS_TGKILL
271 CONSTANT SYS_UTIMES
272 CONSTANT SYS_FADVISE64_64
274 CONSTANT SYS_MBIND
275 CONSTANT SYS_GET_MEMPOLICY
276 CONSTANT SYS_SET_MEMPOLICY
277 CONSTANT SYS_MQ_OPEN
278 CONSTANT SYS_MQ_UNLINK
281 CONSTANT SYS_MQ_NOTIFY
282 CONSTANT SYS_MQ_GETSETATTR
283 CONSTANT SYS_KEXEC_LOAD
284 CONSTANT SYS_WAITID
286 CONSTANT SYS_ADD_KEY
287 CONSTANT SYS_REQUEST_KEY
288 CONSTANT SYS_KEYCTL
289 CONSTANT SYS_IOPRIO_SET
290 CONSTANT SYS_IOPRIO_GET
292 CONSTANT SYS_INOTIFY_ADD_WATCH
293 CONSTANT SYS_INOTIFY_RM_WATCH
294 CONSTANT SYS_MIGRATE_PAGES
296 CONSTANT SYS_MKDIRAT
297 CONSTANT SYS_MKNODAT
298 CONSTANT SYS_FCHOWNAT
299 CONSTANT SYS_FUTIMESAT
300 CONSTANT SYS_FSTATAT64
301 CONSTANT SYS_UNLINKAT
303 CONSTANT SYS_LINKAT
304 CONSTANT SYS_SYMLINKAT
305 CONSTANT SYS_READLINKAT
306 CONSTANT SYS_FCHMODAT
310 CONSTANT SYS_UNSHARE
311 CONSTANT SYS_SET_ROBUST_LIST
312 CONSTANT SYS_GET_ROBUST_LIST
313 CONSTANT SYS_SPLICE
314 CONSTANT SYS_SYNC_FILE_RANGE
315 CONSTANT SYS_TEE
316 CONSTANT SYS_VMSPLICE
317 CONSTANT SYS_MOVE_PAGES
318 CONSTANT SYS_GETCPU
319 CONSTANT SYS_EPOLL_PWAIT
322 CONSTANT SYS_TIMERFD_CREATE
324 CONSTANT SYS_FALLOCATE
327 CONSTANT SYS_SIGNALFD4
328 CONSTANT SYS_EVENTFD2
329 CONSTANT SYS_EPOLL_CREATE1
330 CONSTANT SYS_DUP3
331 CONSTANT SYS_PIPE2
332 CONSTANT SYS_INOTIFY_INIT1
335 CONSTANT SYS_RT_TGSIGQUEUEINFO
336 CONSTANT SYS_PERF_EVENT_OPEN
338 CONSTANT SYS_FANOTIFY_INIT
339 CONSTANT SYS_FANOTIFY_MARK
340 CONSTANT SYS_PRLIMIT64
341 CONSTANT SYS_NAME_TO_HANDLE_AT
342 CONSTANT SYS_OPEN_BY_HANDLE_AT
344 CONSTANT SYS_SYNCFS
345 CONSTANT SYS_SENDMMSG
346 CONSTANT SYS_SETNS
347 CONSTANT SYS_PROCESS_VM_READV
348 CONSTANT SYS_PROCESS_VM_WRITEV
349 CONSTANT SYS_KCMP
350 CONSTANT SYS_FINIT_MODULE
351 CONSTANT SYS_SCHED_SETATTR
352 CONSTANT SYS_SCHED_GETATTR
353 CONSTANT SYS_RENAMEAT2
354 CONSTANT SYS_SECCOMP
355 CONSTANT SYS_GETRANDOM
356 CONSTANT SYS_MEMFD_CREATE
357 CONSTANT SYS_BPF
358 CONSTANT SYS_EXECVEAT
359 CONSTANT SYS_SOCKET
360 CONSTANT SYS_SOCKETPAIR
361 CONSTANT SYS_BIND
362 CONSTANT SYS_CONNECT
363 CONSTANT SYS_LISTEN
364 CONSTANT SYS_ACCEPT4
365 CONSTANT SYS_GETSOCKOPT
366 CONSTANT SYS_SETSOCKOPT
367 CONSTANT SYS_GETSOCKNAME
368 CONSTANT SYS_GETPEERNAME
369 CONSTANT SYS_SENDTO
370 CONSTANT SYS_SENDMSG
371 CONSTANT SYS_RECVFROM
372 CONSTANT SYS_RECVMSG
373 CONSTANT SYS_SHUTDOWN
374 CONSTANT SYS_USERFAULTFD
375 CONSTANT SYS_MEMBARRIER
376 CONSTANT SYS_MLOCK2
377 CONSTANT SYS_COPY_FILE_RANGE
378 CONSTANT SYS_PREADV2
379 CONSTANT SYS_PWRITEV2
380 CONSTANT SYS_PKEY_MPROTECT
381 CONSTANT SYS_PKEY_ALLOC
382 CONSTANT SYS_PKEY_FREE
383 CONSTANT SYS_STATX
384 CONSTANT SYS_ARCH_PRCTL
386 CONSTANT SYS_RSEQ
393 CONSTANT SYS_SEMGET
394 CONSTANT SYS_SEMCTL
395 CONSTANT SYS_SHMGET
396 CONSTANT SYS_SHMCTL
397 CONSTANT SYS_SHMAT
398 CONSTANT SYS_SHMDT
399 CONSTANT SYS_MSGGET
400 CONSTANT SYS_MSGSND
401 CONSTANT SYS_MSGRCV
402 CONSTANT SYS_MSGCTL
403 CONSTANT SYS_CLOCK_GETTIME64
404 CONSTANT SYS_CLOCK_SETTIME64
405 CONSTANT SYS_CLOCK_ADJTIME64
406 CONSTANT SYS_CLOCK_GETRES_TIME64
407 CONSTANT SYS_CLOCK_NANOSLEEP_TIME64
408 CONSTANT SYS_TIMER_GETTIME64
409 CONSTANT SYS_TIMER_SETTIME64
410 CONSTANT SYS_TIMERFD_GETTIME64
411 CONSTANT SYS_TIMERFD_SETTIME64
412 CONSTANT SYS_UTIMENSAT_TIME64
413 CONSTANT SYS_PSELECT6_TIME64
414 CONSTANT SYS_PPOLL_TIME64
416 CONSTANT SYS_IO_PGETEVENTS_TIME64
417 CONSTANT SYS_RECVMMSG_TIME64
418 CONSTANT SYS_MQ_TIMEDSEND_TIME64
419 CONSTANT SYS_MQ_TIMEDRECEIVE_TIME64
420 CONSTANT SYS_SEMTIMEDOP_TIME64
421 CONSTANT SYS_RT_SIGTIMEDWAIT_TIME64
422 CONSTANT SYS_FUTEX_TIME64
423 CONSTANT SYS_SCHED_RR_GET_INTERVAL_TIME64
424 CONSTANT SYS_PIDFD_SEND_SIGNAL
425 CONSTANT SYS_IO_URING_SETUP
426 CONSTANT SYS_IO_URING_ENTER
427 CONSTANT SYS_IO_URING_REGISTER
428 CONSTANT SYS_OPEN_TREE
429 CONSTANT SYS_MOVE_MOUNT
430 CONSTANT SYS_FSOPEN
431 CONSTANT SYS_FSCONFIG
432 CONSTANT SYS_FSMOUNT
433 CONSTANT SYS_FSPICK
434 CONSTANT SYS_PIDFD_OPEN
435 CONSTANT SYS_CLONE3
437 CONSTANT SYS_OPENAT2
438 CONSTANT SYS_PIDFD_GETFD
439 CONSTANT SYS_FACCESSAT2
\ Special dirfd for *at syscalls to resolve path relative to current directory
-100 CONSTANT AT_FDCWD
\ errno values
\ System calls return -errno in the range [-4095, -1]
1 CONSTANT ERRNO_EPERM
2 CONSTANT ERRNO_ENOENT
3 CONSTANT ERRNO_ESRCH
4 CONSTANT ERRNO_EINTR
5 CONSTANT ERRNO_EIO
6 CONSTANT ERRNO_ENXIO
7 CONSTANT ERRNO_E2BIG
8 CONSTANT ERRNO_ENOEXEC
9 CONSTANT ERRNO_EBADF
10 CONSTANT ERRNO_ECHILD
11 CONSTANT ERRNO_EAGAIN
12 CONSTANT ERRNO_ENOMEM
13 CONSTANT ERRNO_EACCES
14 CONSTANT ERRNO_EFAULT
15 CONSTANT ERRNO_ENOTBLK
16 CONSTANT ERRNO_EBUSY
17 CONSTANT ERRNO_EEXIST
18 CONSTANT ERRNO_EXDEV
19 CONSTANT ERRNO_ENODEV
20 CONSTANT ERRNO_ENOTDIR
21 CONSTANT ERRNO_EISDIR
22 CONSTANT ERRNO_EINVAL
23 CONSTANT ERRNO_ENFILE
24 CONSTANT ERRNO_EMFILE
25 CONSTANT ERRNO_ENOTTY
26 CONSTANT ERRNO_ETXTBSY
27 CONSTANT ERRNO_EFBIG
28 CONSTANT ERRNO_ENOSPC
29 CONSTANT ERRNO_ESPIPE
30 CONSTANT ERRNO_EROFS
31 CONSTANT ERRNO_EMLINK
32 CONSTANT ERRNO_EPIPE
33 CONSTANT ERRNO_EDOM
34 CONSTANT ERRNO_ERANGE
\ signal numbers
1 CONSTANT SIGHUP
2 CONSTANT SIGINT
3 CONSTANT SIGQUIT
4 CONSTANT SIGILL
5 CONSTANT SIGTRAP
6 CONSTANT SIGABRT
6 CONSTANT SIGIOT
7 CONSTANT SIGBUS
8 CONSTANT SIGFPE
9 CONSTANT SIGKILL
10 CONSTANT SIGUSR1
11 CONSTANT SIGSEGV
12 CONSTANT SIGUSR2
13 CONSTANT SIGPIPE
14 CONSTANT SIGALRM
15 CONSTANT SIGTERM
16 CONSTANT SIGSTKFLT
17 CONSTANT SIGCHLD
18 CONSTANT SIGCONT
19 CONSTANT SIGSTOP
20 CONSTANT SIGTSTP
21 CONSTANT SIGTTIN
22 CONSTANT SIGTTOU
23 CONSTANT SIGURG
24 CONSTANT SIGXCPU
25 CONSTANT SIGXFSZ
26 CONSTANT SIGVTALRM
27 CONSTANT SIGPROF
28 CONSTANT SIGWINCH
29 CONSTANT SIGIO
29 CONSTANT SIGPOLL
30 CONSTANT SIGPWR
31 CONSTANT SIGSYS
\ openat2() access modes
0 CONSTANT O_RDONLY
1 CONSTANT O_WRONLY
2 CONSTANT O_RDWR
\ openat2() flags
1 6 LSHIFT CONSTANT O_CREAT
1 7 LSHIFT CONSTANT O_EXCL
1 9 LSHIFT CONSTANT O_TRUNC
1 10 LSHIFT CONSTANT O_APPEND
1 11 LSHIFT CONSTANT O_NONBLOCK
\ Names for the standard file descriptor numbers \ Names for the standard file descriptor numbers
0 CONSTANT STDIN 0 CONSTANT STDIN
1 CONSTANT STDOUT 1 CONSTANT STDOUT
2 CONSTANT STDERR 2 CONSTANT STDERR
>>FORTH
\ Write one character to FD 1 (stdout) \ Write one character to FD 1 (stdout)
: EMIT ( c -- "c" ) : EMIT ( c -- "c" )
SP@ 2DUP C! STDOUT SWAP 1 SYS_WRITE SYSCALL3 2DROP ; SP@ 2DUP C! STDOUT SWAP 1 SYS_WRITE SYSCALL3 2DROP ;
@ -126,15 +576,12 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
: TYPE ( c-addr u -- "ccc" ) STDOUT TYPE-FD ; : TYPE ( c-addr u -- "ccc" ) STDOUT TYPE-FD ;
: TYPE-ERR ( c-addr u -- "ccc" ) STDERR TYPE-FD ; : TYPE-ERR ( c-addr u -- "ccc" ) STDERR TYPE-FD ;
\ Get and set the current compilation word list
: GET-CURRENT ( -- wid ) CURRENT @ ;
: SET-CURRENT ( wid -- ) CURRENT ! ;
' CURRENT (HIDE)
\ Get the execution token of the most recent word in the compilation word list \ Get the execution token of the most recent word in the compilation word list
\ If the word list is empty the result will be zero \ If the word list is empty the result will be zero
: LATEST ( -- xt | 0 ) GET-CURRENT @ ; : LATEST ( -- xt | 0 ) GET-CURRENT @ ;
>>SYSTEM
: LATEST! ( xt -- ) GET-CURRENT ! ; : LATEST! ( xt -- ) GET-CURRENT ! ;
>>FORTH
\ Set the latest defined word as immediate \ Set the latest defined word as immediate
\ Note that IMMEDIATE is itself an immediate word \ Note that IMMEDIATE is itself an immediate word
@ -212,6 +659,8 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
: BYE ( -- <noreturn> ) : BYE ( -- <noreturn> )
BEGIN 0 SYS_EXIT SYSCALL1 DROP AGAIN ; BEGIN 0 SYS_EXIT SYSCALL1 DROP AGAIN ;
>>SYSTEM
\ With 32-bit cells, a double-cell number has 64 bits \ With 32-bit cells, a double-cell number has 64 bits
\ Space is reserved for binary output with a leading minus sign and a trailing space \ Space is reserved for binary output with a leading minus sign and a trailing space
\ The minimum pictured numeric output buffer size is thus 66 bytes \ The minimum pictured numeric output buffer size is thus 66 bytes
@ -222,12 +671,12 @@ CREATE PNO-BUFFER PNO-BUFFER-BYTES ALLOT
PNO-BUFFER PNO-BUFFER-BYTES + CONSTANT PNO-BUFFER-END PNO-BUFFER PNO-BUFFER-BYTES + CONSTANT PNO-BUFFER-END
CREATE PNO-POINTER PNO-BUFFER-END , CREATE PNO-POINTER PNO-BUFFER-END ,
>>FORTH
: <# ( -- ) PNO-BUFFER-END PNO-POINTER ! ; : <# ( -- ) PNO-BUFFER-END PNO-POINTER ! ;
: HOLD ( char -- ) PNO-POINTER 1 OVER -! @ C! ; : HOLD ( char -- ) PNO-POINTER 1 OVER -! @ C! ;
: #> ( xd -- c-addr u ) 2DROP PNO-BUFFER-END PNO-POINTER @ TUCK - ; : #> ( xd -- c-addr u ) 2DROP PNO-BUFFER-END PNO-POINTER @ TUCK - ;
' PNO-POINTER (HIDE)
: SIGN ( n -- ) 0< IF [CHAR] - HOLD THEN ; : SIGN ( n -- ) 0< IF [CHAR] - HOLD THEN ;
: #B ( ud1 u -- ud2 ) : #B ( ud1 u -- ud2 )
@ -272,9 +721,13 @@ CREATE DISPLAY-ITEM-LIMIT 6 ,
\ Return the next address in the compilation/data area \ Return the next address in the compilation/data area
: HERE ( -- addr ) CP @ ; : HERE ( -- addr ) CP @ ;
>>SYSTEM
\ When growing the data area, round the end address up to a multiple of this size \ When growing the data area, round the end address up to a multiple of this size
65536 CONSTANT DATA-SEGMENT-ALIGNMENT 65536 CONSTANT DATA-SEGMENT-ALIGNMENT
>>FORTH
\ Allocate n consecutive bytes from the end of the data area \ Allocate n consecutive bytes from the end of the data area
\ If necessary use the brk system call to grow the data area \ If necessary use the brk system call to grow the data area
\ The value n can be negative to release the most recently allocated space \ The value n can be negative to release the most recently allocated space
@ -496,6 +949,8 @@ CREATE CURRENT-SOURCE-ID -1 ,
DEFER QUIT ( -- <noreturn> ) DEFER QUIT ( -- <noreturn> )
' BAILOUT ' QUIT DEFER! ' BAILOUT ' QUIT DEFER!
>>SYSTEM
\ This function defines what happens when THROW is used outside of any CATCH \ This function defines what happens when THROW is used outside of any CATCH
: DEFAULT-UNWIND ( k*x n -- i*x <noreturn> ) : DEFAULT-UNWIND ( k*x n -- i*x <noreturn> )
CASE CASE
@ -518,7 +973,6 @@ DEFER QUIT ( -- <noreturn> )
S0 SP! QUIT ; S0 SP! QUIT ;
' DEFAULT-UNWIND ' THROW-UNWIND DEFER! ' DEFAULT-UNWIND ' THROW-UNWIND DEFER!
' DEFAULT-UNWIND (HIDE)
CREATE EXCEPTION-STACK 0 , CREATE EXCEPTION-STACK 0 ,
@ -535,6 +989,8 @@ CREATE EXCEPTION-STACK 0 ,
NR> RESTORE-INPUT DROP NR> RESTORE-INPUT DROP
R> SWAP >R SP! R> ; R> SWAP >R SP! R> ;
>>FORTH
\ Run xt while trapping calls to THROW, ABORT, FAIL, etc. \ Run xt while trapping calls to THROW, ABORT, FAIL, etc.
\ On success has the effect of xt and also leaves the value 0 on top of the stack \ On success has the effect of xt and also leaves the value 0 on top of the stack
\ On failure the stacks and input source are reverted and the THROW code is pushed \ On failure the stacks and input source are reverted and the THROW code is pushed
@ -566,12 +1022,10 @@ CREATE EXCEPTION-STACK 0 ,
\ We don't need the rest so just reset the RSP to where it was on entering CATCH \ We don't need the rest so just reset the RSP to where it was on entering CATCH
RSP! ; RSP! ;
' EXCEPTION-STACK (HIDE)
' CATCH-UNWIND (HIDE)
' THROW-UNWIND (HIDE)
: PARSE-AREA ( -- c-addr u ) SOURCE >IN @ /STRING ; : PARSE-AREA ( -- c-addr u ) SOURCE >IN @ /STRING ;
>>SYSTEM
: PARSE-EMPTY? ( -- flag ) SOURCE NIP >IN @ = ; : PARSE-EMPTY? ( -- flag ) SOURCE NIP >IN @ = ;
: PEEK-CHAR ( -- c ) : PEEK-CHAR ( -- c )
@ -584,6 +1038,8 @@ CREATE EXCEPTION-STACK 0 ,
: SKIP-SPACES ( "<spaces?>" -- ) : SKIP-SPACES ( "<spaces?>" -- )
BEGIN PARSE-EMPTY? OR-ELSE PEEK-CHAR SPACE? DUP IF SKIP-CHAR THEN 0= THEN UNTIL ; BEGIN PARSE-EMPTY? OR-ELSE PEEK-CHAR SPACE? DUP IF SKIP-CHAR THEN 0= THEN UNTIL ;
>>FORTH
\ Comments; ignore all characters until the next EOL or ) character, respectively \ Comments; ignore all characters until the next EOL or ) character, respectively
: \ ( "ccc<eol>" -- ) IMMEDIATE BEGIN NEXT-CHAR LF = UNTIL ; : \ ( "ccc<eol>" -- ) IMMEDIATE BEGIN NEXT-CHAR LF = UNTIL ;
: ( ( "ccc<closeparen>" -- ) IMMEDIATE BEGIN NEXT-CHAR [CHAR] ) = UNTIL ; : ( ( "ccc<closeparen>" -- ) IMMEDIATE BEGIN NEXT-CHAR [CHAR] ) = UNTIL ;
@ -609,13 +1065,17 @@ DEFER REFILL
REPEAT REPEAT
PARSE-AREA DROP OVER - ; PARSE-AREA DROP OVER - ;
: CREATE ( "<spaces>ccc" -- ) \ Use to create words programmatically without reading the name from the input
: (CREATE) ( c-addr u -- )
ALIGN HERE ALIGN HERE
DODATA , 0 , LATEST , DODATA , 0 , LATEST ,
WORD DUP C, HERE SWAP DUP ALLOT CMOVE -ROT DUP C, HERE SWAP DUP ALLOT CMOVE
ALIGN HERE OVER >DFA ! ALIGN HERE OVER >DFA !
LATEST! ; LATEST! ;
: CREATE ( "<spaces>ccc" -- )
WORD (CREATE) ;
\ Called when a word using DOES> is executed (not compiled) to set \ Called when a word using DOES> is executed (not compiled) to set
\ the runtime behavior of the most recently defined word \ the runtime behavior of the most recently defined word
: (DOES) ( dfa -- ) LATEST DODOES OVER >CFA ! >DFA ! ; : (DOES) ( dfa -- ) LATEST DODOES OVER >CFA ! >DFA ! ;
@ -629,6 +1089,7 @@ DEFER REFILL
' (DOES) (HIDE) ' (DOES) (HIDE)
\ Debugging aid; shows a label and the contents of the stacks at runtime
: (MARK) "-- " TYPE TYPE " --\n" TYPE .S R> .RS >R ; : (MARK) "-- " TYPE TYPE " --\n" TYPE .S R> .RS >R ;
: MARK IMMEDIATE WORD POSTPONE SLITERAL POSTPONE (MARK) ; : MARK IMMEDIATE WORD POSTPONE SLITERAL POSTPONE (MARK) ;
' (MARK) (HIDE) ' (MARK) (HIDE)
@ -681,7 +1142,7 @@ DEFER REFILL
\ Define an array of n double-cell elements \ Define an array of n double-cell elements
\ name Runtime: ( n -- a-addr ) Return the address of the double-cell at index n \ name Runtime: ( n -- a-addr ) Return the address of the double-cell at index n
: 2ARRAY ( n "<spaces>name" -- ) : 2ARRAY ( n "<spaces>name" -- )
CREATE CELLS 2* ALLOT DOES> SWAP [ 2 CELLS ] LITERAL * + ; CREATE 2* CELLS ALLOT DOES> SWAP [ 2 CELLS ] LITERAL * + ;
\ Define a threaded word which also displays its name and the data stack when called \ Define a threaded word which also displays its name and the data stack when called
: (TRACE) >NAME TYPE SPACE .S ; : (TRACE) >NAME TYPE SPACE .S ;
@ -757,7 +1218,7 @@ DEFER REFILL
\ Conditional compilation \ Conditional compilation
\ No effect if flag is true, otherwise skips words until matching [ELSE] or [THEN] \ No effect if flag is true, otherwise skips words until matching [ELSE] or [THEN]
\ Skips over nested [IF] … [THEN] or [IF] … [ELSE] … [THEN] structures \ Skips over nested [IF] … [THEN] or [IF] … [ELSE] … [THEN] structures
: [IF] IMMEDIATE RECURSIVE : [IF] IMMEDIATE
0= IF 0= IF
0 BEGIN 0 BEGIN
WORD 2>R WORD 2>R
@ -796,17 +1257,18 @@ DEFER REFILL
: [CHAR] ( Compilation: "<spaces>ccc" -- ) ( Runtime: -- c ) IMMEDIATE : [CHAR] ( Compilation: "<spaces>ccc" -- ) ( Runtime: -- c ) IMMEDIATE
CHAR POSTPONE LITERAL ; CHAR POSTPONE LITERAL ;
>>SYSTEM
\ Orders 0 ... 17 with sizes 32 bytes ... 4 MiB
32 CONSTANT BUDDY-MIN-BYTES 32 CONSTANT BUDDY-MIN-BYTES
18 CONSTANT BUDDY-ORDERS 18 CONSTANT BUDDY-ORDERS
: BUDDY-ORDER-BYTES ( order -- n-bytes ) BUDDY-MIN-BYTES SWAP LSHIFT ; : BUDDY-ORDER-BYTES ( order -- n-bytes ) BUDDY-MIN-BYTES SWAP LSHIFT ;
BUDDY-ORDERS 1- BUDDY-ORDER-BYTES CONSTANT BUDDY-MAX-BYTES BUDDY-ORDERS 1- BUDDY-ORDER-BYTES CONSTANT BUDDY-MAX-BYTES
BUDDY-ORDERS ARRAY BUDDY-HEADS BUDDY-ORDERS ARRAY BUDDY-HEADS
{ BUDDY-ORDERS 0 ?DO 0 I BUDDY-HEADS ! LOOP } EXECUTE
: INIT-BUDDY-HEADS ( -- )
BUDDY-ORDERS 0 ?DO 0 I BUDDY-HEADS ! LOOP ;
INIT-BUDDY-HEADS
: BUDDY-FREE ( order a-addr -- ) : BUDDY-FREE ( order a-addr -- )
OVER BUDDY-ORDERS U>= "order out of bounds" ?FAIL OVER BUDDY-ORDERS U>= "order out of bounds" ?FAIL
@ -864,10 +1326,7 @@ VARIABLE TOTAL
LOOP "total " TYPE TOTAL @ . EOL ; LOOP "total " TYPE TOTAL @ . EOL ;
' TOTAL (HIDE) ' TOTAL (HIDE)
0 CONSTANT NULL >>LINUX
: KB 10 LSHIFT ;
: MB 20 LSHIFT ;
4 KB CONSTANT PAGESIZE 4 KB CONSTANT PAGESIZE
@ -879,6 +1338,8 @@ VARIABLE TOTAL
2 CONSTANT MAP_PRIVATE 2 CONSTANT MAP_PRIVATE
32 CONSTANT MAP_ANONYMOUS 32 CONSTANT MAP_ANONYMOUS
>>SYSTEM
: MMAP-ALLOCATE ( size -- a-addr ) : MMAP-ALLOCATE ( size -- a-addr )
BEGIN BEGIN
NULL OVER PROT_READ PROT_WRITE OR NULL OVER PROT_READ PROT_WRITE OR
@ -902,6 +1363,8 @@ VARIABLE TOTAL
R@ OVER R@ - MUNMAP R@ OVER R@ - MUNMAP
DUP R> R@ 2* + SWAP R> + TUCK - MUNMAP ; DUP R> R@ 2* + SWAP R> + TUCK - MUNMAP ;
>>FORTH
: ALLOCATE ( size -- obj-addr ) : ALLOCATE ( size -- obj-addr )
CELL+ DUP BUDDY-MAX-BYTES U> IF CELL+ DUP BUDDY-MAX-BYTES U> IF
PAGESIZE ALIGNED-TO DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT PAGESIZE ALIGNED-TO DUP MMAP-ALLOCATE TUCK ! CELL+ EXIT
@ -922,9 +1385,13 @@ VARIABLE TOTAL
NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL NEGATE ERRNO_EINTR <> "munmap failed" ?FAIL
AGAIN ; AGAIN ;
>>SYSTEM
: OBJECT-SIZE ( obj-addr -- size ) : OBJECT-SIZE ( obj-addr -- size )
CELL- @ DUP BUDDY-ORDERS U< IF BUDDY-ORDER-BYTES THEN CELL- ; CELL- @ DUP BUDDY-ORDERS U< IF BUDDY-ORDER-BYTES THEN CELL- ;
>>FORTH
: RESIZE ( obj-addr1 size -- obj-addr1 | obj-addr2 ) : RESIZE ( obj-addr1 size -- obj-addr1 | obj-addr2 )
OVER OBJECT-SIZE CELL+ OVER CELL+ BUDDY-MIN-BYTES UMAX 2DUP U>= IF OVER OBJECT-SIZE CELL+ OVER CELL+ BUDDY-MIN-BYTES UMAX 2DUP U>= IF
\ Allocated space is larger than requested size, shrink if <= 50% used \ Allocated space is larger than requested size, shrink if <= 50% used
@ -942,14 +1409,43 @@ VARIABLE TOTAL
( S: obj-addr1 obj-addr2 copy-size R: obj-addr1 obj-addr2 ) ( S: obj-addr1 obj-addr2 copy-size R: obj-addr1 obj-addr2 )
CMOVE R> R> FREE ; CMOVE R> R> FREE ;
\ Field accessors for the search order linked list \ Basic type descriptors giving alignment and size for each type
: ORDER>LINK ( a-addr1 -- a-addr2 ) ; 1 1 2CONSTANT CHAR%
: ORDER>WID ( a-addr1 -- a-addr2 ) CELL+ ; 1 ALIGNED 1 CELLS 2CONSTANT CELL%
2 CELLS CONSTANT ORDER-ENTRY-BYTES 1 ALIGNED 2 CELLS 2CONSTANT 2CELL%
\ Structures begin with byte alignment and an offset of zero
1 0 2CONSTANT STRUCT
\ Within STRUCT … ENDSTRUCT, define a field with the given alignment and size
\ Each field word has runtime effect ( struct-addr -- field-addr)
\ If field offset is zero then the word is marked as immediate and generates no code
: FIELD ( align1 offset1 field-align field-bytes -- align2 offset2 )
-ROT NATURALLY-ALIGNED DUP >R ALIGNED-TO
DUP : ?DUP IF POSTPONE LITERAL POSTPONE + ELSE POSTPONE IMMEDIATE THEN POSTPONE ;
+ SWAP R> UMAX SWAP ;
\ Consume the final alignment and offset and define a type descriptor for the struct
: ENDSTRUCT ( align offset "<spaces?>name" -- )
OVER ALIGNED-TO 2CONSTANT ;
\ Reserve data or heap space for a data structure given alignment and size
: %ALLOT ( align bytes -- a-addr ) SWAP ALIGN-TO ALLOT ;
: %ALLOCATE ( align bytes -- a-addr ) NIP ALLOCATE ;
>>SYSTEM
\ This structure describes one entry in the search order linked list
STRUCT
CELL% FIELD ORDER>LINK
CELL% FIELD ORDER>WID
ENDSTRUCT ORDER%
VARIABLE CURRENT-ORDER VARIABLE CURRENT-ORDER
0 CURRENT-ORDER ! 0 CURRENT-ORDER !
>>FORTH
\ Return the current search order \ Return the current search order
: GET-ORDER ( -- widn ... wid1 n ) : GET-ORDER ( -- widn ... wid1 n )
0 CURRENT-ORDER @ 0 CURRENT-ORDER @
@ -958,8 +1454,29 @@ VARIABLE CURRENT-ORDER
( S: n ) ( R: wid1 ... widn ) ( S: n ) ( R: wid1 ... widn )
\ Shift the search order list from the return stack back to the data stack \ Shift the search order list from the return stack back to the data stack
DUP BEGIN ?DUP WHILE 1- R> -ROT REPEAT DUP BEGIN ?DUP WHILE 1- R> -ROT REPEAT
( S: widn ... wid1 n ) ( S: widn ... wid1 n ) ;
;
\ Add the word list wid as the first word list in the search order
\ Semantically equivalent to:
\ : PUSH-ORDER ( wid -- ) >R GET-ORDER R> SWAP 1+ SET-ORDER ;
: PUSH-ORDER ( wid -- )
ORDER% %ALLOCATE
TUCK ORDER>WID !
CURRENT-ORDER @ OVER ORDER>LINK !
CURRENT-ORDER ! ;
\ Remove and return the first word list in the search order
\ Semantically equivalent to:
\ : POP-ORDER ( -- wid ) GET-ORDER 1- SWAP >R SET-ORDER R> ;
: POP-ORDER ( -- wid | 0 )
CURRENT-ORDER @ DUP IF
DUP ORDER>LINK @ CURRENT-ORDER !
DUP ORDER>WID @ SWAP FREE
THEN ;
\ Return the first word list in the search order
: PEEK-ORDER ( -- wid | 0 )
CURRENT-ORDER @ DUP IF ORDER>WID @ THEN ;
\ Set the current search order \ Set the current search order
: SET-ORDER ( widn ... wid1 n | -n -- ) : SET-ORDER ( widn ... wid1 n | -n -- )
@ -967,29 +1484,13 @@ VARIABLE CURRENT-ORDER
\ Free the previous search order linked list \ Free the previous search order linked list
0 CURRENT-ORDER XCHG BEGIN ?DUP WHILE DUP ORDER>LINK @ SWAP FREE REPEAT 0 CURRENT-ORDER XCHG BEGIN ?DUP WHILE DUP ORDER>LINK @ SWAP FREE REPEAT
\ Build the new search order linked list \ Build the new search order linked list
CURRENT-ORDER SWAP 0 OVER ?DO I PICK PUSH-ORDER -1 +LOOP NDROP ;
BEGIN
( S: widn ... wid1 tail n )
?DUP
WHILE
1- -ROT
( S: widn ... wid1 n wid0 tail )
ORDER-ENTRY-BYTES ALLOCATE
DUP ROT ! \ Update the tail pointer with the address of this entry
TUCK ORDER>WID ! \ Store the word list identifier
ORDER>LINK SWAP \ Leave link field address under n for next iteration
REPEAT
\ Terminate the linked list
0 SWAP ! ;
\ Prepare the initial search order \ Prepare the initial search order
FORTH-WORDLIST 1 SET-ORDER BOOTSTRAP-GET-ORDER SET-ORDER
\ Abstract away the internals of the search order implementation \ Use the real search order as the bootstrap search order from now on
' CURRENT-ORDER (HIDE) ' GET-ORDER ' BOOTSTRAP-GET-ORDER DEFER!
' ORDER-ENTRY-BYTES (HIDE)
' ORDER>WID (HIDE)
' ORDER>LINK (HIDE)
\ Create a new wordlist \ Create a new wordlist
\ In this implementation a word list is just a pointer to the most recent word \ In this implementation a word list is just a pointer to the most recent word
@ -997,7 +1498,7 @@ FORTH-WORDLIST 1 SET-ORDER
ALIGN HERE 0 , ; ALIGN HERE 0 , ;
\ Make the first list in the search order the current compilation word list \ Make the first list in the search order the current compilation word list
: DEFINITIONS ( -- ) GET-ORDER SWAP SET-CURRENT 1- NDROP ; : DEFINITIONS ( -- ) PEEK-ORDER SET-CURRENT ;
\ Run a function for each word in the given wordlist \ Run a function for each word in the given wordlist
\ xt Execution: ( i*x word-xt -- stop-flag j*x ) \ xt Execution: ( i*x word-xt -- stop-flag j*x )
@ -1039,16 +1540,22 @@ FORTH-WORDLIST 1 SET-ORDER
} WITH-VISIBLE ; } WITH-VISIBLE ;
\ Search-Order extension words \ Search-Order extension words
: ALSO ( -- ) GET-ORDER >R DUP R> 1+ SET-ORDER ; : ALSO ( -- ) PEEK-ORDER PUSH-ORDER ;
: FORTH ( -- ) GET-ORDER NIP FORTH-WORDLIST SWAP SET-ORDER ;
: ONLY ( -- ) -1 SET-ORDER ; : ONLY ( -- ) -1 SET-ORDER ;
: ORDER ( -- ) : ORDER ( -- )
"ORDER:" TYPE GET-ORDER 0 ?DO SPACE U. LOOP EOL "ORDER:" TYPE GET-ORDER 0 ?DO SPACE U. LOOP EOL
"CURRENT: " TYPE GET-CURRENT U. EOL ; "CURRENT: " TYPE GET-CURRENT U. EOL ;
: PREVIOUS ( -- ) GET-ORDER ?DUP IF NIP 1- SET-ORDER THEN ; : PREVIOUS ( -- ) POP-ORDER DROP ;
\ Add the word list wid as the first word list in the search order \ Define a new named wordlist
: PUSH-ORDER ( wid -- ) >R GET-ORDER R> SWAP 1+ SET-ORDER ; \ Executing the word will replace the first item in the search order
: VOCABULARY WORDLIST CREATE , DOES> @ POP-ORDER DROP PUSH-ORDER ;
\ Names to select the predefined word lists
\ FORTH is a Search-Order extension word
\ SYSTEM-WORDLIST has been deliberately omitted here
: FORTH ( -- ) FORTH-WORDLIST POP-ORDER DROP PUSH-ORDER ;
: LINUX ( -- ) LINUX-WORDLIST POP-ORDER DROP PUSH-ORDER ;
\ Apply SEARCH-WORDLIST to each word list in the current search order \ Apply SEARCH-WORDLIST to each word list in the current search order
: FIND ( c-addr u -- c-addr u 0 | xt 1 | xt -1 ) : FIND ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
@ -1063,10 +1570,14 @@ FORTH-WORDLIST 1 SET-ORDER
REPEAT REPEAT
2R> 0 ; 2R> 0 ;
>>SYSTEM
\ Same as FIND except that unknown words are reported and result in a call to THROW \ Same as FIND except that unknown words are reported and result in a call to THROW
: FIND-OR-THROW ( c-addr u -- xt 1 | xt -1 ) : FIND-OR-THROW ( c-addr u -- xt 1 | xt -1 )
FIND ?DUP 0= IF EXCP-UNDEFINED-WORD -ROT THROW-STRING THEN ; FIND ?DUP 0= IF EXCP-UNDEFINED-WORD -ROT THROW-STRING THEN ;
>>FORTH
\ Read a word from the input (during runtime) and return its execution token \ Read a word from the input (during runtime) and return its execution token
\ Aborts if the word is not found in the current (runtime) search order list \ Aborts if the word is not found in the current (runtime) search order list
: ' ( "<spaces>ccc" -- xt ) WORD FIND-OR-THROW DROP ; : ' ( "<spaces>ccc" -- xt ) WORD FIND-OR-THROW DROP ;
@ -1105,6 +1616,8 @@ FORTH-WORDLIST 1 SET-ORDER
: :REPLACE ( "<spaces>ccc" -- ) : :REPLACE ( "<spaces>ccc" -- )
: LATEST DUP >NAME FIND-OR-THROW DROP DUP (HIDE) DEFER! ; : LATEST DUP >NAME FIND-OR-THROW DROP DUP (HIDE) DEFER! ;
>>SYSTEM
\ The size of this buffer will determine the maximum line length \ The size of this buffer will determine the maximum line length
4096 CONSTANT TERMINAL-BUFFER-BYTES 4096 CONSTANT TERMINAL-BUFFER-BYTES
TERMINAL-BUFFER-BYTES ALLOCATE CONSTANT TERMINAL-BUFFER TERMINAL-BUFFER-BYTES ALLOCATE CONSTANT TERMINAL-BUFFER
@ -1113,6 +1626,8 @@ TERMINAL-BUFFER-BYTES ALLOCATE CONSTANT TERMINAL-BUFFER
CREATE TIB-LEFTOVER 0 , CREATE TIB-LEFTOVER 0 ,
CREATE TIB-LEFTOVER-BYTES 0 , CREATE TIB-LEFTOVER-BYTES 0 ,
>>FORTH
\ Attempt to replace the parse area with the next line from the current source \ Attempt to replace the parse area with the next line from the current source
\ Return TRUE if the parse area was refilled, or FALSE otherwise \ Return TRUE if the parse area was refilled, or FALSE otherwise
\ REFILL always fails if the current source is a string (from EVALUATE) \ REFILL always fails if the current source is a string (from EVALUATE)
@ -1158,9 +1673,7 @@ CREATE TIB-LEFTOVER-BYTES 0 ,
DUP IF 0 >IN ! THEN DUP IF 0 >IN ! THEN
0<> ; 0<> ;
HIDE TIB-LEFTOVER >>SYSTEM
HIDE TIB-LEFTOVER-BYTES
HIDE TERMINAL-BUFFER
: ESCAPED-CHAR ( "<escapeseq>" | "c" -- c ) : ESCAPED-CHAR ( "<escapeseq>" | "c" -- c )
NEXT-CHAR DUP [CHAR] \ = IF NEXT-CHAR DUP [CHAR] \ = IF
@ -1244,6 +1757,8 @@ HIDE TERMINAL-BUFFER
THEN THEN
REPEAT ; REPEAT ;
>>FORTH
: EVALUATE ( i*x c-addr u -- j*x ) : EVALUATE ( i*x c-addr u -- j*x )
SAVE-INPUT N>R SAVE-INPUT N>R
SOURCE 2>R SOURCE 2>R
@ -1256,12 +1771,40 @@ HIDE TERMINAL-BUFFER
2R> INPUT-BUFFER 2! 2R> INPUT-BUFFER 2!
NR> RESTORE-INPUT DROP ; NR> RESTORE-INPUT DROP ;
36 CONSTANT STRUCT-TERMIOS-BYTES >>LINUX
: TYPEDEF 2CONSTANT ;
CHAR% TYPEDEF unsigned-char%
CHAR% TYPEDEF signed-char%
CELL% TYPEDEF unsigned-int%
CELL% TYPEDEF signed-int%
unsigned-char% TYPEDEF cc_t%
unsigned-int% TYPEDEF speed_t%
unsigned-int% TYPEDEF tcflag_t%
19 CONSTANT NCCS
STRUCT
tcflag_t% FIELD termios-c_iflag
tcflag_t% FIELD termios-c_oflag
tcflag_t% FIELD termios-c_cflag
tcflag_t% FIELD termios-c_lflag
cc_t% FIELD termios-c_line
cc_t% NCCS * FIELD termios-c_cc
ENDSTRUCT termios%
21505 CONSTANT IOCTL_TCGETS 21505 CONSTANT IOCTL_TCGETS
CREATE TERMIOS STRUCT-TERMIOS-BYTES ALLOT ALIGN
>>SYSTEM
CREATE SCRATCH-TERMIOS termios% %ALLOT
>>FORTH
: TTY? ( fd -- flag ) : TTY? ( fd -- flag )
IOCTL_TCGETS TERMIOS SYS_IOCTL SYSCALL3 0= ; IOCTL_TCGETS SCRATCH-TERMIOS SYS_IOCTL SYSCALL3 0= ;
STDIN TTY? CONSTANT INTERACTIVE? STDIN TTY? CONSTANT INTERACTIVE?
@ -1282,17 +1825,6 @@ STDIN TTY? CONSTANT INTERACTIVE?
HIDE BOOTSTRAP-WORDLIST HIDE BOOTSTRAP-WORDLIST
HIDE PNO-BUFFER
HIDE PNO-BUFFER-END
HIDE CURRENT-SOURCE-ID
HIDE INPUT-BUFFER
HIDE ESCAPED-CHAR
HIDE READSTRING
HIDE PARSENUMBER
HIDE INTERPRET
\ Switch to the interpreter defined in this startup file \ Switch to the interpreter defined in this startup file
\ Process the rest of the startup file and then switch to terminal input \ Process the rest of the startup file and then switch to terminal input
{ PARSE-AREA EVALUATE QUIT } EXECUTE { PARSE-AREA EVALUATE QUIT } EXECUTE
@ -1400,7 +1932,7 @@ HIDE INTERPRET
@(+) DUP WORD? IF "['] " TYPE .W ELSE . THEN SPACE @(+) DUP WORD? IF "['] " TYPE .W ELSE . THEN SPACE
ENDOF ENDOF
['] 2LIT OF ['] 2LIT OF
"[ " TYPE @(+) U. SPACE @(+) . " ] 2LITERAL " TYPE "[ " TYPE @(+) >R @(+) U. SPACE R> . " ] 2LITERAL " TYPE
ENDOF ENDOF
['] LITSTRING OF ['] LITSTRING OF
DUP 1+ SWAP C@ 2DUP "\"" TYPE TYPE-ESCAPED "\" " TYPE + ALIGNED DUP 1+ SWAP C@ 2DUP "\"" TYPE TYPE-ESCAPED "\" " TYPE + ALIGNED