steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/erg

db4
Slava Pestov 2008-02-06 00:12:44 -06:00
parent 95651daef0 537d945660
commit fbf83639d6
28 changed files with 228 additions and 309 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile
View File

@ -65,6 +65,7 @@ default:
@echo "solaris-x86-64" @echo "solaris-x86-64"
@echo "wince-arm" @echo "wince-arm"
@echo "winnt-x86-32" @echo "winnt-x86-32"
@echo "winnt-x86-64"
@echo "" @echo ""
@echo "Additional modifiers:" @echo "Additional modifiers:"
@echo "" @echo ""
@ -125,6 +126,9 @@ solaris-x86-64:
winnt-x86-32: winnt-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
winnt-x86-64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
wince-arm: wince-arm:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
@ -151,7 +155,7 @@ clean:
rm -f factor*.dll libfactor*.* rm -f factor*.dll libfactor*.*
vm/resources.o: vm/resources.o:
windres vm/factor.rs vm/resources.o $(WINDRES) vm/factor.rs vm/resources.o
.c.o: .c.o:
$(CC) -c $(CFLAGS) -o $@ $< $(CC) -c $(CFLAGS) -o $@ $<

1
extra/db/db.factor
View File

@ -10,7 +10,6 @@ C: <db> db ( handle -- obj )
! HOOK: db-create db ( str -- ) ! HOOK: db-create db ( str -- )
! HOOK: db-drop db ( str -- ) ! HOOK: db-drop db ( str -- )
GENERIC: db-open ( db -- ) GENERIC: db-open ( db -- )
GENERIC: db-close ( db -- )
TUPLE: statement sql params handle bound? ; TUPLE: statement sql params handle bound? ;

22
unmaintained/mysql/libmysql.factor → extra/db/mysql/ffi/ffi.factor
View File

@ -1,27 +1,18 @@
! See http://factorcode.org/license.txt ! Copyright (C) 2007 Berlin Brown, 2008 Doug Coleman.
! Copyright (C) 2007 Berlin Brown ! See http://factorcode.org/license.txt for BSD license.
! Date: 1/17/2007
!
! libs/mysql/libmysql.factor
!
! Adapted from mysql.h and mysql.c ! Adapted from mysql.h and mysql.c
! Tested with MySQL version - 5.0.24a ! Tested with MySQL version - 5.0.24a
USING: alien alien.syntax combinators kernel system ;
IN: db.mysql.ffi
IN: mysql << "mysql" {
USING: alien kernel ;
"mysql" {
{ [ win32? ] [ "libmySQL.dll" "stdcall" ] } { [ win32? ] [ "libmySQL.dll" "stdcall" ] }
{ [ macosx? ] [ "libmysqlclient.14.dylib" "cdecl" ] } { [ macosx? ] [ "libmysqlclient.14.dylib" "cdecl" ] }
{ [ unix? ] [ "libmysqlclient.so.14" "cdecl" ] } { [ unix? ] [ "libmysqlclient.so.14" "cdecl" ] }
} cond add-library } cond add-library >>
LIBRARY: mysql LIBRARY: mysql
! ===============================================
! mysql.c
! ===============================================
FUNCTION: void* mysql_init ( void* mysql ) ; FUNCTION: void* mysql_init ( void* mysql ) ;
FUNCTION: char* mysql_error ( void* mysql ) ; FUNCTION: char* mysql_error ( void* mysql ) ;
FUNCTION: void* mysql_real_connect ( void* mysql, char* host, char* user, char* passwd, char* db, int port, char* unixsocket, long clientflag ) ; FUNCTION: void* mysql_real_connect ( void* mysql, char* host, char* user, char* passwd, char* db, int port, char* unixsocket, long clientflag ) ;
@ -32,4 +23,3 @@ FUNCTION: void mysql_free_result ( void* result ) ;
FUNCTION: char** mysql_fetch_row ( void* result ) ; FUNCTION: char** mysql_fetch_row ( void* result ) ;
FUNCTION: int mysql_num_fields ( void* result ) ; FUNCTION: int mysql_num_fields ( void* result ) ;
FUNCTION: ulong mysql_affected_rows ( void* mysql ) ; FUNCTION: ulong mysql_affected_rows ( void* mysql ) ;

78
extra/db/mysql/lib/lib.factor Normal file
View File

@ -0,0 +1,78 @@
! Copyright (C) 2007 Berlin Brown, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for license.
! Adapted from mysql.h and mysql.c
! Tested with MySQL version - 5.0.24a
USING: kernel alien io prettyprint sequences
namespaces arrays math db.mysql.ffi system ;
IN: db.mysql.lib
SYMBOL: my-conn
TUPLE: mysql-db handle host user password db port ;
TUPLE: mysql-statement ;
TUPLE: mysql-result-set ;
: new-mysql ( -- conn )
f mysql_init ;
: mysql-error ( mysql -- )
[ mysql_error throw ] when* ;
: mysql-connect ( mysql-connection -- )
new-mysql over set-mysql-db-handle
dup {
mysql-db-handle
mysql-db-host
mysql-db-user
mysql-db-password
mysql-db-db
mysql-db-port
} get-slots f 0 mysql_real_connect mysql-error ;
! =========================================================
! Low level mysql utility definitions
! =========================================================
: (mysql-query) ( mysql-connection query -- ret )
>r mysql-db-handle r> mysql_query ;
! : (mysql-result) ( mysql-connection -- ret )
! [ mysql-db-handle mysql_use_result ] keep
! [ set-mysql-connection-resulthandle ] keep ;
! : (mysql-affected-rows) ( mysql-connection -- n )
! mysql-connection-mysqlconn mysql_affected_rows ;
! : (mysql-free-result) ( mysql-connection -- )
! mysql-connection-resulthandle drop ;
! : (mysql-row) ( mysql-connection -- row )
! mysql-connection-resulthandle mysql_fetch_row ;
! : (mysql-num-cols) ( mysql-connection -- n )
! mysql-connection-resulthandle mysql_num_fields ;
! : mysql-char*-nth ( index object -- str )
! #! Utility based on 'char*-nth' to perform an additional sanity check on the value
! #! extracted from the array of strings.
! void*-nth [ alien>char-string ] [ "" ] if* ;
! : mysql-row>seq ( object n -- seq )
! [ swap mysql-char*-nth ] map-with ;
! : (mysql-result>seq) ( seq -- seq )
! my-conn get (mysql-row) dup [
! my-conn get (mysql-num-cols) mysql-row>seq
! over push
! (mysql-result>seq)
! ] [ drop ] if
! ! Perform needed cleanup on fetched results
! my-conn get (mysql-free-result) ;
! : mysql-query ( query -- ret )
! >r my-conn get r> (mysql-query) drop
! my-conn get (mysql-result) ;
! : mysql-command ( query -- n )
! mysql-query drop
! my-conn get (mysql-affected-rows) ;

58
extra/db/mysql/mysql.factor Normal file
View File

@ -0,0 +1,58 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for license.
USING: alien continuations io kernel prettyprint sequences
db db.mysql.ffi ;
IN: db.mysql
TUPLE: mysql-db handle host user password db port ;
TUPLE: mysql-statement ;
TUPLE: mysql-result-set ;
M: mysql-db db-open ( mysql-db -- )
;
M: mysql-db dispose ( mysql-db -- )
mysql-db-handle mysql_close ;
M: mysql-db <simple-statement> ( str -- statement )
;
M: mysql-db <prepared-statement> ( str -- statement )
;
M: mysql-statement prepare-statement ( statement -- )
;
M: mysql-statement bind-statement* ( statement -- )
;
M: mysql-statement rebind-statement ( statement -- )
;
M: mysql-statement execute-statement ( statement -- )
;
M: mysql-statement query-results ( query -- result-set )
;
M: mysql-result-set #rows ( result-set -- n )
;
M: mysql-result-set #columns ( result-set -- n )
;
M: mysql-result-set row-column ( result-set n -- obj )
;
M: mysql-result-set advance-row ( result-set -- ? )
;
M: mysql-db begin-transaction ( -- )
;
M: mysql-db commit-transaction ( -- )
;
M: mysql-db rollback-transaction ( -- )
;

1
extra/db/postgresql/ffi/ffi.factor
View File

@ -1,6 +1,5 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! adapted from libpq-fe.h version 7.4.7
! tested on debian linux with postgresql 8.1 ! tested on debian linux with postgresql 8.1
USING: alien alien.syntax combinators system ; USING: alien alien.syntax combinators system ;

47
extra/db/sqlite/sqlite-tests.factor
View File

@ -1,42 +1,28 @@
USING: io io.files io.launcher kernel namespaces USING: io io.files io.launcher kernel namespaces
prettyprint tools.test db.sqlite db db.sql sequences prettyprint tools.test db.sqlite db sequences
continuations ; continuations ;
IN: temporary IN: temporary
! "sqlite3 -init test.txt test.db"
IN: scratchpad
: test.db "extra/db/sqlite/test.db" resource-path ; : test.db "extra/db/sqlite/test.db" resource-path ;
IN: temporary [ ] [ [ test.db delete-file ] catch drop ] unit-test
: (create-db) ( -- str )
[
"sqlite3 -init " %
test.db %
" " %
test.db %
] "" make ;
: create-db ( -- ) (create-db) run-process drop ; [ ] [
test.db [
"create table person (name varchar(30), country varchar(30))" sql-command
"insert into person values('John', 'America')" sql-command
"insert into person values('Jane', 'New Zealand')" sql-command
] with-sqlite
] unit-test
[ ] [ test.db delete-file ] unit-test
[ ] [ create-db ] unit-test [ { { "John" "America" } { "Jane" "New Zealand" } } ] [
[
{
{ "John" "America" }
{ "Jane" "New Zealand" }
}
] [
test.db [ test.db [
"select * from person" sql-query "select * from person" sql-query
] with-sqlite ] with-sqlite
] unit-test ] unit-test
[ [ { { "John" "America" } } ] [
{ { "John" "America" } }
] [
test.db [ test.db [
"select * from person where name = :name and country = :country" "select * from person where name = :name and country = :country"
<simple-statement> [ <simple-statement> [
@ -52,15 +38,10 @@ IN: temporary
] with-sqlite ] with-sqlite
] unit-test ] unit-test
[ [ { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } ]
{ [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test
{ "1" "John" "America" }
{ "2" "Jane" "New Zealand" }
}
] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test
[ [ ] [
] [
test.db [ test.db [
"insert into person(name, country) values('Jimmy', 'Canada')" "insert into person(name, country) values('Jimmy', 'Canada')"
sql-command sql-command

2
extra/db/sqlite/sqlite.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2008 Chris Double, Doug Coleman. ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays assocs classes compiler db db.sql USING: alien arrays assocs classes compiler db
hashtables io.files kernel math math.parser namespaces hashtables io.files kernel math math.parser namespaces
prettyprint sequences strings tuples alien.c-types prettyprint sequences strings tuples alien.c-types
continuations db.sqlite.lib db.sqlite.ffi ; continuations db.sqlite.lib db.sqlite.ffi ;

7
extra/hardware-info/hardware-info.factor
View File

@ -1,12 +1,13 @@
USING: alien.syntax kernel math prettyprint system USING: alien.syntax kernel math prettyprint
combinators vocabs.loader hardware-info.backend ; combinators vocabs.loader hardware-info.backend system ;
IN: hardware-info IN: hardware-info
: kb. ( x -- ) 10 2^ /f . ; : kb. ( x -- ) 10 2^ /f . ;
: megs. ( x -- ) 20 2^ /f . ; : megs. ( x -- ) 20 2^ /f . ;
: gigs. ( x -- ) 30 2^ /f . ; : gigs. ( x -- ) 30 2^ /f . ;
<< { <<
{
{ [ windows? ] [ "hardware-info.windows" ] } { [ windows? ] [ "hardware-info.windows" ] }
{ [ linux? ] [ "hardware-info.linux" ] } { [ linux? ] [ "hardware-info.linux" ] }
{ [ macosx? ] [ "hardware-info.macosx" ] } { [ macosx? ] [ "hardware-info.macosx" ] }

6
extra/hardware-info/windows/backend/backend.factor
View File

@ -1,6 +0,0 @@
IN: hardware-info.windows.backend
TUPLE: wince ;
TUPLE: winnt ;
UNION: windows wince winnt ;

4
extra/hardware-info/windows/ce/ce.factor
View File

@ -2,8 +2,8 @@ USING: alien.c-types hardware-info kernel math namespaces
windows windows.kernel32 hardware-info.backend ; windows windows.kernel32 hardware-info.backend ;
IN: hardware-info.windows.ce IN: hardware-info.windows.ce
TUPLE: wince ; TUPLE: wince-os ;
T{ wince } os set-global T{ wince-os } os set-global
: memory-status ( -- MEMORYSTATUS ) : memory-status ( -- MEMORYSTATUS )
"MEMORYSTATUS" <c-object> "MEMORYSTATUS" <c-object>

24
extra/hardware-info/windows/nt/nt.factor
View File

@ -1,16 +1,15 @@
USING: alien alien.c-types hardware-info.windows.backend USING: alien alien.c-types
kernel libc math namespaces hardware-info.backend kernel libc math namespaces hardware-info.backend
windows windows.advapi32 windows.kernel32 ; windows windows.advapi32 windows.kernel32 ;
IN: hardware-info.windows.nt IN: hardware-info.windows.nt
TUPLE: winnt ; TUPLE: winnt-os ;
T{ winnt-os } os set-global
T{ winnt } os set-global
: system-info ( -- SYSTEM_INFO ) : system-info ( -- SYSTEM_INFO )
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ; "SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
M: winnt cpus ( -- n ) M: winnt-os cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ; system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX ) : memory-status ( -- MEMORYSTATUSEX )
@ -18,25 +17,25 @@ M: winnt cpus ( -- n )
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength "MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
[ GlobalMemoryStatusEx ] keep swap zero? [ win32-error ] when ; [ GlobalMemoryStatusEx ] keep swap zero? [ win32-error ] when ;
M: winnt memory-load ( -- n ) M: winnt-os memory-load ( -- n )
memory-status MEMORYSTATUSEX-dwMemoryLoad ; memory-status MEMORYSTATUSEX-dwMemoryLoad ;
M: winnt physical-mem ( -- n ) M: winnt-os physical-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPhys ; memory-status MEMORYSTATUSEX-ullTotalPhys ;
M: winnt available-mem ( -- n ) M: winnt-os available-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPhys ; memory-status MEMORYSTATUSEX-ullAvailPhys ;
M: winnt total-page-file ( -- n ) M: winnt-os total-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPageFile ; memory-status MEMORYSTATUSEX-ullTotalPageFile ;
M: winnt available-page-file ( -- n ) M: winnt-os available-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPageFile ; memory-status MEMORYSTATUSEX-ullAvailPageFile ;
M: winnt total-virtual-mem ( -- n ) M: winnt-os total-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalVirtual ; memory-status MEMORYSTATUSEX-ullTotalVirtual ;
M: winnt available-virtual-mem ( -- n ) M: winnt-os available-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailVirtual ; memory-status MEMORYSTATUSEX-ullAvailVirtual ;
: computer-name ( -- string ) : computer-name ( -- string )
@ -54,4 +53,3 @@ M: winnt available-virtual-mem ( -- n )
] [ ] [
[ alien>u16-string ] keep free [ alien>u16-string ] keep free
] if ; ] if ;

7
extra/hardware-info/windows/windows.factor
View File

@ -1,7 +1,7 @@
USING: alien alien.c-types kernel libc math namespaces USING: alien alien.c-types kernel libc math namespaces
windows windows.kernel32 windows.advapi32 windows windows.kernel32 windows.advapi32
hardware-info.windows.backend words combinators vocabs.loader hardware-info.backend
words combinators vocabs.loader hardware-info.backend ; system ;
IN: hardware-info.windows IN: hardware-info.windows
: system-info ( -- SYSTEM_INFO ) : system-info ( -- SYSTEM_INFO )
@ -63,7 +63,8 @@ IN: hardware-info.windows
: system-windows-directory ( -- str ) : system-windows-directory ( -- str )
\ GetSystemWindowsDirectory get-directory ; \ GetSystemWindowsDirectory get-directory ;
<<
{ {
{ [ wince? ] [ "hardware-info.windows.ce" ] } { [ wince? ] [ "hardware-info.windows.ce" ] }
{ [ winnt? ] [ "hardware-info.windows.nt" ] } { [ winnt? ] [ "hardware-info.windows.nt" ] }
} cond [ require ] when* } cond [ require ] when* >>

4
extra/io/unix/files/files.factor
View File

@ -6,8 +6,8 @@ alien ;
IN: io.unix.files IN: io.unix.files
M: unix-io cwd M: unix-io cwd
MAXPATHLEN dup <byte-array> getcwd MAXPATHLEN dup <byte-array> swap
[ alien>char-string ] [ (io-error) ] if* ; getcwd [ (io-error) ] unless* ;
M: unix-io cd M: unix-io cd
chdir io-error ; chdir io-error ;

2
extra/ogg/theora/theora.factor
View File

@ -6,7 +6,7 @@ IN: ogg.theora
<< <<
"theora" { "theora" {
{ [ win32? ] [ "libtheora.dll" ] } { [ win32? ] [ "theora.dll" ] }
{ [ macosx? ] [ "libtheora.0.dylib" ] } { [ macosx? ] [ "libtheora.0.dylib" ] }
{ [ unix? ] [ "libtheora.so" ] } { [ unix? ] [ "libtheora.so" ] }
} cond "cdecl" add-library } cond "cdecl" add-library

2
extra/ogg/vorbis/vorbis.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: kernel system combinators alien alien.syntax ; USING: kernel system combinators alien alien.syntax ogg ;
IN: ogg.vorbis IN: ogg.vorbis
<< <<

1
extra/x/widgets/wm/frame/frame.factor
View File

@ -4,6 +4,7 @@ USING: kernel io combinators namespaces quotations arrays sequences
x11.xlib x11.constants x11.xlib x11.constants
mortar mortar.sugar slot-accessors mortar mortar.sugar slot-accessors
geom.rect geom.rect
math.bitfields
x x.gc x.widgets x x.gc x.widgets
x.widgets.button x.widgets.button
x.widgets.wm.child x.widgets.wm.child

26
misc/factor.sh
View File

@ -45,7 +45,6 @@ check_gcc_version() {
} }
check_installed_programs() { check_installed_programs() {
ensure_program_installed sudo
ensure_program_installed chmod ensure_program_installed chmod
ensure_program_installed uname ensure_program_installed uname
ensure_program_installed git ensure_program_installed git
@ -100,9 +99,9 @@ find_os() {
uname_s=`uname -s` uname_s=`uname -s`
check_ret uname check_ret uname
case $uname_s in case $uname_s in
CYGWIN_NT-5.2-WOW64) OS=windows-nt;; CYGWIN_NT-5.2-WOW64) OS=winnt;;
*CYGWIN_NT*) OS=windows-nt;; *CYGWIN_NT*) OS=winnt;;
*CYGWIN*) OS=windows-nt;; *CYGWIN*) OS=winnt;;
*darwin*) OS=macosx;; *darwin*) OS=macosx;;
*Darwin*) OS=macosx;; *Darwin*) OS=macosx;;
*linux*) OS=linux;; *linux*) OS=linux;;
@ -140,7 +139,7 @@ find_word_size() {
set_factor_binary() { set_factor_binary() {
case $OS in case $OS in
windows-nt) FACTOR_BINARY=factor-nt;; winnt) FACTOR_BINARY=factor-nt;;
macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;; macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;;
*) FACTOR_BINARY=factor;; *) FACTOR_BINARY=factor;;
esac esac
@ -197,7 +196,7 @@ git_clone() {
git_pull_factorcode() { git_pull_factorcode() {
echo "Updating the git repository from factorcode.org..." echo "Updating the git repository from factorcode.org..."
git pull git://factorcode.org/git/factor.git git pull git://factorcode.org/git/factor.git master
check_ret git check_ret git
} }
@ -220,6 +219,7 @@ delete_boot_images() {
echo "Deleting old images..." echo "Deleting old images..."
rm $BOOT_IMAGE > /dev/null 2>&1 rm $BOOT_IMAGE > /dev/null 2>&1
rm $BOOT_IMAGE.* > /dev/null 2>&1 rm $BOOT_IMAGE.* > /dev/null 2>&1
rm staging.*.image > /dev/null 2>&1
} }
get_boot_image() { get_boot_image() {
@ -228,11 +228,23 @@ get_boot_image() {
} }
maybe_download_dlls() { maybe_download_dlls() {
if [[ $OS == windows-nt ]] ; then if [[ $OS == winnt ]] ; then
wget http://factorcode.org/dlls/freetype6.dll wget http://factorcode.org/dlls/freetype6.dll
check_ret wget check_ret wget
wget http://factorcode.org/dlls/zlib1.dll wget http://factorcode.org/dlls/zlib1.dll
check_ret wget check_ret wget
wget http://factorcode.org/dlls/OpenAL32.dll
check_ret wget
wget http://factorcode.org/dlls/alut.dll
check_ret wget
wget http://factorcode.org/dlls/ogg.dll
check_ret wget
wget http://factorcode.org/dlls/theora.dll
check_ret wget
wget http://factorcode.org/dlls/vorbis.dll
check_ret wget
wget http://factorcode.org/dlls/sqlite3.dll
check_ret wget
chmod 777 *.dll chmod 777 *.dll
check_ret chmod check_ret chmod
fi fi

11
unmaintained/mysql/load.factor
View File

@ -1,11 +0,0 @@
! License: See http://factor.sf.net/license.txt for BSD license.
! Berlin Brown
! Date: 1/17/2007
!
! Adapted from mysql.h and mysql.c
! Tested with MySQL version - 5.0.24a
PROVIDE: libs/mysql
{ +files+ {
"libmysql.factor"
"mysql.factor"
} } ;

124
unmaintained/mysql/mysql.factor
View File

@ -1,124 +0,0 @@
! See http://factorcode.org/license.txt for license.
! Copyright (C) 2007 Berlin Brown
! Date: 1/17/2007
!
! libs/mysql/mysql.factor
!
! Adapted from mysql.h and mysql.c
! Tested with MySQL version - 5.0.24a
IN: mysql
USING: kernel alien errors io prettyprint
sequences namespaces arrays math tools generic ;
SYMBOL: my-conn
TUPLE: mysql-connection mysqlconn host user password db port handle resulthandle ;
: init-mysql ( -- conn )
f mysql_init ;
C: mysql-connection ( host user password db port -- mysql-connection )
[ set-mysql-connection-port ] keep
[ set-mysql-connection-db ] keep
[ set-mysql-connection-password ] keep
[ set-mysql-connection-user ] keep
[ set-mysql-connection-host ] keep ;
: (mysql-error) ( mysql-connection -- str )
mysql-connection-mysqlconn mysql_error ;
: connect-error-msg ( mysql-connection -- s )
mysql-connection-mysqlconn mysql_error
[
"Couldn't connect to mysql database.\n" %
"Message: " % %
] "" make ;
: mysql-connect ( mysql-connection -- )
init-mysql swap
[ set-mysql-connection-mysqlconn ] 2keep
[ mysql-connection-host ] keep
[ mysql-connection-user ] keep
[ mysql-connection-password ] keep
[ mysql-connection-db ] keep
[ mysql-connection-port f 0 mysql_real_connect ] keep
[ set-mysql-connection-handle ] keep
dup mysql-connection-handle
[ connect-error-msg throw ] unless ;
! =========================================================
! Low level mysql utility definitions
! =========================================================
: (mysql-query) ( mysql-connection query -- ret )
>r mysql-connection-mysqlconn r> mysql_query ;
: (mysql-result) ( mysql-connection -- ret )
[ mysql-connection-mysqlconn mysql_use_result ] keep
[ set-mysql-connection-resulthandle ] keep ;
: (mysql-affected-rows) ( mysql-connection -- n )
mysql-connection-mysqlconn mysql_affected_rows ;
: (mysql-free-result) ( mysql-connection -- )
mysql-connection-resulthandle drop ;
: (mysql-row) ( mysql-connection -- row )
mysql-connection-resulthandle mysql_fetch_row ;
: (mysql-num-cols) ( mysql-connection -- n )
mysql-connection-resulthandle mysql_num_fields ;
: mysql-char*-nth ( index object -- str )
#! Utility based on 'char*-nth' to perform an additional sanity check on the value
#! extracted from the array of strings.
void*-nth [ alien>char-string ] [ "" ] if* ;
: mysql-row>seq ( object n -- seq )
[ swap mysql-char*-nth ] map-with ;
: (mysql-result>seq) ( seq -- seq )
my-conn get (mysql-row) dup [
my-conn get (mysql-num-cols) mysql-row>seq
over push
(mysql-result>seq)
] [ drop ] if
! Perform needed cleanup on fetched results
my-conn get (mysql-free-result) ;
! =========================================================
! Public Word Definitions
! =========================================================
: mysql-close ( mysql-connection -- )
mysql-connection-mysqlconn mysql_close ;
: mysql-print-table ( seq -- )
[ [ write bl ] each "\n" write ] each ;
: mysql-query ( query -- ret )
>r my-conn get r> (mysql-query) drop
my-conn get (mysql-result) ;
: mysql-command ( query -- n )
mysql-query drop
my-conn get (mysql-affected-rows) ;
: mysql-error ( -- s )
#! Get the last mysql error
my-conn get (mysql-error) ;
: mysql-result>seq ( -- seq )
V{ } clone (mysql-result>seq) ;
: with-mysql ( host user password db port quot -- )
[
>r <mysql-connection> my-conn set
my-conn get mysql-connect drop r>
[ my-conn get mysql-close ] cleanup
] with-scope ; inline
: with-mysql-catch ( host user password db port quot -- )
[ with-mysql ] catch [ "Caught: " write print ] when* ;

17
unmaintained/mysql/test/create_database.sql
View File

@ -1,17 +0,0 @@
--
-- Create three databases (development / test / production)
-- with prefix 'factordb_'
create database factordb_development;
create database factordb_test;
create database factordb_production;
grant all on factordb_development.* to 'factoruser'@'localhost' identified by 'mysqlfactor';
grant all on factordb_test.* to 'factoruser'@'localhost' identified by 'mysqlfactor';
grant all on factordb_production.* to 'factoruser'@'localhost' identified by 'mysqlfactor';
grant all on factordb_development.* to 'factoruser'@'*' identified by 'mysqlfactor';
grant all on factordb_test.* to 'factoruser'@'*' identified by 'mysqlfactor';
grant all on factordb_production.* to 'factoruser'@'*' identified by 'mysqlfactor';
-- End of the Script

57
unmaintained/mysql/test/mysql-example.factor
View File

@ -1,57 +0,0 @@
! See http://factorcode.org/license.txt for license.
! Simple test for mysql library
! libs/mysql/test/mysql-example.factor
IN: mysql-example
REQUIRES: libs/mysql ;
USING: sequences mysql modules prettyprint kernel io math tools namespaces test ;
"Testing..." print nl
: get-drop-table ( -- s )
"DROP TABLE if exists DISCUSSION_FORUM" ;
: get-insert-table ( -- s )
{
"INSERT INTO DISCUSSION_FORUM(category, full_name, email, title, main_url, keywords, message) "
"VALUES('none', 'John Doe', 'johndoe@test.com', 'The Message', NULL, NULL, 'Testing')"
} "" join ;
: get-update-table ( -- s )
"UPDATE DISCUSSION_FORUM set category = 'my-new-category'" ;
: get-delete-table ( -- s )
"DELETE FROM DISCUSSION_FORUM where id = 2" ;
: get-create-table ( -- s )
{
"create table DISCUSSION_FORUM("
"id int(11) NOT NULL auto_increment,"
"category varchar(128),"
"full_name varchar(128) NOT NULL,"
"email varchar(128) NOT NULL,"
"title varchar(255) NOT NULL,"
"main_url varchar(255),"
"keywords varchar(255),"
"message text NOT NULL,"
"created_on DATETIME NOT NULL DEFAULT '0000-00-0000:00:00',"
"PRIMARY KEY (id));"
} "" join ;
[ "localhost" "factoruser" "mysqlfactor" "factordb_development" 0 [
get-drop-table mysql-command drop
get-create-table mysql-command drop
get-update-table mysql-command drop
get-delete-table mysql-command drop
! Insert multiple records
20 [
get-insert-table mysql-command 2drop
] each
"select * from discussion_forum order by created_on" mysql-query drop
mysql-result>seq mysql-print-table
] with-mysql ] time
"Done" print

1
vm/Config.windows.nt.x86.32
View File

@ -1,3 +1,4 @@
WINDRES=windres WINDRES=windres
include vm/Config.windows.nt include vm/Config.windows.nt
include vm/Config.x86.32 include vm/Config.x86.32
#error "lolllll"

6
vm/Config.windows.nt.x86.64
View File

@ -1,4 +1,6 @@
CC=/k/target/bin/x86_64-pc-mingw32-gcc #WIN64_PATH=/k/MinGW/win64/bin
WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
CC=$(WIN64_PATH)-gcc.exe
WINDRES=$(WIN64_PATH)-windres.exe
include vm/Config.windows.nt include vm/Config.windows.nt
include vm/Config.x86.64 include vm/Config.x86.64
WINDRES = /k/target/bin/windres

2
vm/os-windows-nt.32.h Normal file
View File

@ -0,0 +1,2 @@
#define ESP Esp
#define EIP Eip

2
vm/os-windows-nt.64.h Normal file
View File

@ -0,0 +1,2 @@
#define ESP Rsp
#define EIP Rip

10
vm/os-windows-nt.c
View File

@ -42,26 +42,26 @@ long exception_handler(PEXCEPTION_POINTERS pe)
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord; PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord; CONTEXT *c = (CONTEXT*)pe->ContextRecord;
if(in_code_heap_p(c->Eip)) if(in_code_heap_p(c->EIP))
signal_callstack_top = (void *)c->Esp; signal_callstack_top = (void *)c->ESP;
else else
signal_callstack_top = NULL; signal_callstack_top = NULL;
if(e->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) if(e->ExceptionCode == EXCEPTION_ACCESS_VIOLATION)
{ {
signal_fault_addr = e->ExceptionInformation[1]; signal_fault_addr = e->ExceptionInformation[1];
c->Eip = (CELL)memory_signal_handler_impl; c->EIP = (CELL)memory_signal_handler_impl;
} }
else if(e->ExceptionCode == EXCEPTION_FLT_DIVIDE_BY_ZERO else if(e->ExceptionCode == EXCEPTION_FLT_DIVIDE_BY_ZERO
|| e->ExceptionCode == EXCEPTION_INT_DIVIDE_BY_ZERO) || e->ExceptionCode == EXCEPTION_INT_DIVIDE_BY_ZERO)
{ {
signal_number = ERROR_DIVIDE_BY_ZERO; signal_number = ERROR_DIVIDE_BY_ZERO;
c->Eip = (CELL)divide_by_zero_signal_handler_impl; c->EIP = (CELL)divide_by_zero_signal_handler_impl;
} }
else else
{ {
signal_number = 11; signal_number = 11;
c->Eip = (CELL)misc_signal_handler_impl; c->EIP = (CELL)misc_signal_handler_impl;
} }
return EXCEPTION_CONTINUE_EXECUTION; return EXCEPTION_CONTINUE_EXECUTION;

9
vm/platform.h
View File

@ -1,11 +1,11 @@
#if defined(__arm__) #if defined(__arm__)
#define FACTOR_ARM #define FACTOR_ARM
#elif defined(__amd64__) || defined(__x86_64__)
#define FACTOR_AMD64
#elif defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32) #elif defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32)
#define FACTOR_X86 #define FACTOR_X86
#elif defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC) #elif defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC)
#define FACTOR_PPC #define FACTOR_PPC
#elif defined(__amd64__) || defined(__x86_64__)
#define FACTOR_AMD64
#else #else
#error "Unsupported architecture" #error "Unsupported architecture"
#endif #endif
@ -18,6 +18,11 @@
#endif #endif
#include "os-windows.h" #include "os-windows.h"
#if defined(FACTOR_AMD64)
#include "os-windows-nt.64.h"
#elif defined(FACTOR_X86)
#include "os-windows-nt.32.h"
#endif
#else #else
#include "os-unix.h" #include "os-unix.h"