Merge git://factorcode.org/git/erg
commit
fbf83639d6
6
Makefile
6
Makefile
|
@ -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 $@ $<
|
||||||
|
|
|
@ -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? ;
|
||||||
|
|
||||||
|
|
|
@ -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 ) ;
|
||||||
|
|
|
@ -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) ;
|
|
@ -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,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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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" ] }
|
||||||
|
|
|
@ -1,6 +0,0 @@
|
||||||
IN: hardware-info.windows.backend
|
|
||||||
|
|
||||||
TUPLE: wince ;
|
|
||||||
TUPLE: winnt ;
|
|
||||||
UNION: windows wince winnt ;
|
|
||||||
|
|
|
@ -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>
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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* >>
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
|
||||||
} } ;
|
|
|
@ -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* ;
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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,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"
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
#define ESP Esp
|
||||||
|
#define EIP Eip
|
|
@ -0,0 +1,2 @@
|
||||||
|
#define ESP Rsp
|
||||||
|
#define EIP Rip
|
|
@ -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;
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue