Merge branch 'master' of git://factorcode.org/git/factor
commit
abf65f92d8
|
@ -26,8 +26,7 @@ HELP: memcpy
|
|||
|
||||
HELP: check-ptr
|
||||
{ $values { "c-ptr" "an alien address, byte array, or " { $link f } } { "checked" "an alien address or byte array with non-zero address" } }
|
||||
{ $description "Throws an error if the input is " { $link f } ". Otherwise the object remains on the data stack. This word should be used to check the return values of " { $link malloc } " and " { $link realloc } " before use." }
|
||||
{ $error-description "Callers of " { $link malloc } " and " { $link realloc } " should use " { $link check-ptr } " to throw an error in the case of a memory allocation failure." } ;
|
||||
{ $description "Throws an error if the input is " { $link f } ". Otherwise the object remains on the data stack." } ;
|
||||
|
||||
HELP: free
|
||||
{ $values { "alien" c-ptr } }
|
||||
|
|
|
@ -84,4 +84,4 @@ PRIVATE>
|
|||
"void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
|
||||
|
||||
: with-malloc ( size quot -- )
|
||||
swap 1 calloc check-ptr swap keep free ; inline
|
||||
swap 1 calloc swap keep free ; inline
|
||||
|
|
|
@ -79,7 +79,7 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ;
|
|||
buffer-fill zero? ;
|
||||
|
||||
: extend-buffer ( n buffer -- )
|
||||
2dup buffer-ptr swap realloc check-ptr
|
||||
2dup buffer-ptr swap realloc
|
||||
over set-buffer-ptr set-buffer-size ;
|
||||
|
||||
: check-overflow ( n buffer -- )
|
||||
|
|
|
@ -1,12 +1,37 @@
|
|||
IN: io.unix.launcher
|
||||
|
||||
USING: io io.launcher io.unix.backend io.nonblocking
|
||||
sequences kernel namespaces math system alien.c-types
|
||||
debugger continuations ;
|
||||
debugger continuations combinators.lib threads ;
|
||||
|
||||
IN: io.unix.launcher
|
||||
|
||||
! Search unix first
|
||||
USE: unix
|
||||
|
||||
: with-fork ( quot -- pid )
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Factor friendly versions of the exec functions
|
||||
|
||||
: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ;
|
||||
|
||||
: execv* ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ;
|
||||
: execvp* ( filename argv -- int ) [ malloc-char-string ] [ >argv ] bi* execvp ;
|
||||
|
||||
: execve* ( pathname argv envp -- int )
|
||||
[ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Wait for a pid to finish without freezing up all the Factor threads.
|
||||
! Need to find a less kludgy way to do this.
|
||||
|
||||
: wait-for-pid ( pid -- )
|
||||
dup "int" <c-object> WNOHANG waitpid
|
||||
0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: with-fork ( child parent -- pid )
|
||||
fork [ zero? -rot if ] keep ; inline
|
||||
|
||||
: prepare-execvp ( args -- cmd args )
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien alien.c-types byte-arrays continuations destructors
|
||||
io.nonblocking io io.sockets io.sockets.impl
|
||||
io.nonblocking io io.sockets io.sockets.impl namespaces
|
||||
io.streams.duplex io.windows io.windows.nt io.windows.nt.backend
|
||||
windows.winsock kernel libc math sequences threads tuples.lib ;
|
||||
IN: io.windows.nt.sockets
|
||||
|
|
|
@ -0,0 +1,98 @@
|
|||
|
||||
USING: alien.syntax ;
|
||||
|
||||
IN: unix.linux.if
|
||||
|
||||
: IFNAMSIZ 16 ;
|
||||
: IF_NAMESIZE 16 ;
|
||||
: IFHWADDRLEN 6 ;
|
||||
|
||||
! Standard interface flags (netdevice->flags)
|
||||
|
||||
: IFF_UP HEX: 1 ; ! interface is up
|
||||
: IFF_BROADCAST HEX: 2 ; ! broadcast address valid
|
||||
: IFF_DEBUG HEX: 4 ; ! turn on debugging
|
||||
: IFF_LOOPBACK HEX: 8 ; ! is a loopback net
|
||||
: IFF_POINTOPOINT HEX: 10 ; ! interface is has p-p link
|
||||
: IFF_NOTRAILERS HEX: 20 ; ! avoid use of trailers
|
||||
: IFF_RUNNING HEX: 40 ; ! interface running and carrier ok
|
||||
: IFF_NOARP HEX: 80 ; ! no ARP protocol
|
||||
: IFF_PROMISC HEX: 100 ; ! receive all packets
|
||||
: IFF_ALLMULTI HEX: 200 ; ! receive all multicast packets
|
||||
|
||||
: IFF_MASTER HEX: 400 ; ! master of a load balancer
|
||||
: IFF_SLAVE HEX: 800 ; ! slave of a load balancer
|
||||
|
||||
: IFF_MULTICAST HEX: 1000 ; ! Supports multicast
|
||||
|
||||
! #define IFF_VOLATILE
|
||||
! (IFF_LOOPBACK|IFF_POINTOPOINT|IFF_BROADCAST|IFF_MASTER|IFF_SLAVE|IFF_RUNNING)
|
||||
|
||||
: IFF_PORTSEL HEX: 2000 ; ! can set media type
|
||||
: IFF_AUTOMEDIA HEX: 4000 ; ! auto media select active
|
||||
: IFF_DYNAMIC HEX: 8000 ; ! dialup device with changing addresses
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
C-STRUCT: struct-ifmap
|
||||
{ "ulong" "mem-start" }
|
||||
{ "ulong" "mem-end" }
|
||||
{ "ushort" "base-addr" }
|
||||
{ "uchar" "irq" }
|
||||
{ "uchar" "dma" }
|
||||
{ "uchar" "port" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Hmm... the generic sockaddr type isn't defined anywhere.
|
||||
! Put it here for now.
|
||||
|
||||
TYPEDEF: ushort sa_family_t
|
||||
|
||||
C-STRUCT: struct-sockaddr
|
||||
{ "sa_family_t" "sa_family" }
|
||||
{ { "char" 14 } "sa_data" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! C-UNION: union-ifr-ifrn { "char" IFNAMSIZ } ;
|
||||
|
||||
C-UNION: union-ifr-ifrn { "char" 16 } ;
|
||||
|
||||
C-UNION: union-ifr-ifru
|
||||
"struct-sockaddr"
|
||||
! "sockaddr"
|
||||
"short"
|
||||
"int"
|
||||
"struct-ifmap"
|
||||
! { "char" IFNAMSIZ }
|
||||
{ "char" 16 }
|
||||
"caddr_t" ;
|
||||
|
||||
C-STRUCT: struct-ifreq
|
||||
{ "union-ifr-ifrn" "ifr-ifrn" }
|
||||
{ "union-ifr-ifru" "ifr-ifru" } ;
|
||||
|
||||
: ifr-name ( struct-ifreq -- value ) struct-ifreq-ifr-ifrn ;
|
||||
|
||||
: ifr-hwaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
: ifr-addr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
: ifr-dstaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
: ifr-broadaddr ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
: ifr-netmask ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
: ifr-flags ( struct-ifreq -- value ) struct-ifreq-ifr-ifru ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
C-UNION: union-ifc-ifcu "caddr_t" "struct-ifreq*" ;
|
||||
|
||||
C-STRUCT: struct-ifconf
|
||||
{ "int" "ifc-len" }
|
||||
{ "union-ifc-ifcu" "ifc-ifcu" } ;
|
||||
|
||||
: ifc-len ( struct-ifconf -- value ) struct-ifconf-ifc-len ;
|
||||
|
||||
: ifc-buf ( struct-ifconf -- value ) struct-ifconf-ifc-ifcu ;
|
||||
: ifc-req ( struct-ifconf -- value ) struct-ifconf-ifc-ifcu ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
@ -0,0 +1,59 @@
|
|||
|
||||
IN: unix.linux.sockios
|
||||
|
||||
! Imported from linux-headers-2.6.15-28-686 on Ubuntu 6.06
|
||||
|
||||
! Socket configuration controls
|
||||
|
||||
: SIOCGIFNAME HEX: 8910 ; ! get iface name
|
||||
: SIOCSIFLINK HEX: 8911 ; ! set iface channel
|
||||
: SIOCGIFCONF HEX: 8912 ; ! get iface list
|
||||
: SIOCGIFFLAGS HEX: 8913 ; ! get flags
|
||||
: SIOCSIFFLAGS HEX: 8914 ; ! set flags
|
||||
: SIOCGIFADDR HEX: 8915 ; ! get PA address
|
||||
: SIOCSIFADDR HEX: 8916 ; ! set PA address
|
||||
: SIOCGIFDSTADDR HEX: 8917 ; ! get remote PA address
|
||||
: SIOCSIFDSTADDR HEX: 8918 ; ! set remote PA address
|
||||
: SIOCGIFBRDADDR HEX: 8919 ; ! get broadcast PA address
|
||||
: SIOCSIFBRDADDR HEX: 891a ; ! set broadcast PA address
|
||||
: SIOCGIFNETMASK HEX: 891b ; ! get network PA mask
|
||||
: SIOCSIFNETMASK HEX: 891c ; ! set network PA mask
|
||||
: SIOCGIFMETRIC HEX: 891d ; ! get metric
|
||||
: SIOCSIFMETRIC HEX: 891e ; ! set metric
|
||||
: SIOCGIFMEM HEX: 891f ; ! get memory address (BSD)
|
||||
: SIOCSIFMEM HEX: 8920 ; ! set memory address (BSD)
|
||||
: SIOCGIFMTU HEX: 8921 ; ! get MTU size
|
||||
: SIOCSIFMTU HEX: 8922 ; ! set MTU size
|
||||
: SIOCSIFNAME HEX: 8923 ; ! set interface name
|
||||
: SIOCSIFHWADDR HEX: 8924 ; ! set hardware address
|
||||
: SIOCGIFENCAP HEX: 8925 ; ! get/set encapsulations
|
||||
: SIOCSIFENCAP HEX: 8926 ;
|
||||
: SIOCGIFHWADDR HEX: 8927 ; ! Get hardware address
|
||||
: SIOCGIFSLAVE HEX: 8929 ; ! Driver slaving support
|
||||
: SIOCSIFSLAVE HEX: 8930 ;
|
||||
: SIOCADDMULTI HEX: 8931 ; ! Multicast address lists
|
||||
: SIOCDELMULTI HEX: 8932 ;
|
||||
: SIOCGIFINDEX HEX: 8933 ; ! name -> if_index mapping
|
||||
: SIOGIFINDEX SIOCGIFINDEX ; ! misprint compatibility :-)
|
||||
: SIOCSIFPFLAGS HEX: 8934 ; ! set/get extended flags set
|
||||
: SIOCGIFPFLAGS HEX: 8935 ;
|
||||
: SIOCDIFADDR HEX: 8936 ; ! delete PA address
|
||||
: SIOCSIFHWBROADCAST HEX: 8937 ; ! set hardware broadcast addr
|
||||
: SIOCGIFCOUNT HEX: 8938 ; ! get number of devices
|
||||
|
||||
: SIOCGIFBR HEX: 8940 ; ! Bridging support
|
||||
: SIOCSIFBR HEX: 8941 ; ! Set bridging options
|
||||
|
||||
: SIOCGIFTXQLEN HEX: 8942 ; ! Get the tx queue length
|
||||
: SIOCSIFTXQLEN HEX: 8943 ; ! Set the tx queue length
|
||||
|
||||
: SIOCGIFDIVERT HEX: 8944 ; ! Frame diversion support
|
||||
: SIOCSIFDIVERT HEX: 8945 ; ! Set frame diversion options
|
||||
|
||||
: SIOCETHTOOL HEX: 8946 ; ! Ethtool interface
|
||||
|
||||
: SIOCGMIIPHY HEX: 8947 ; ! Get address of MII PHY in use
|
||||
: SIOCGMIIREG HEX: 8948 ; ! Read MII PHY register.
|
||||
: SIOCSMIIREG HEX: 8949 ; ! Write MII PHY register.
|
||||
|
||||
: SIOCWANDEV HEX: 894A ; ! get/set netdev parameters
|
|
@ -86,7 +86,8 @@
|
|||
"IN:" "USING:" "TUPLE:" "^C:" "^M:" "USE:" "REQUIRE:" "PROVIDE:"
|
||||
"REQUIRES:"
|
||||
"GENERIC:" "GENERIC#" "SYMBOL:" "PREDICATE:" "VAR:" "VARS:"
|
||||
"UNION:" "<PRIVATE" "PRIVATE>" "MACRO:" "MACRO::" "DEFER:"))
|
||||
"C-STRUCT:"
|
||||
"C-UNION:" "<PRIVATE" "PRIVATE>" "MACRO:" "MACRO::" "DEFER:" "TYPEDEF:"))
|
||||
|
||||
(defun factor-mode ()
|
||||
"A mode for editing programs written in the Factor programming language."
|
||||
|
|
Loading…
Reference in New Issue