Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
Guile Log
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gule-log
Guile Log
Commits
07610add
Commit
07610add
authored
Sep 15, 2014
by
Stefan Israelsson Tampe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Cons fixed attributed variables is strated to be coded
parent
1d79f358
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
159 additions
and
92 deletions
+159
-92
Makefile
logic/guile-log/src/Makefile
+1
-1
state.c
logic/guile-log/src/state.c
+65
-23
unify-undo-redo.c
logic/guile-log/src/unify-undo-redo.c
+2
-2
unify.c
logic/guile-log/src/unify.c
+62
-35
variable.c
logic/guile-log/src/variable.c
+29
-31
No files found.
logic/guile-log/src/Makefile
View file @
07610add
...
...
@@ -257,7 +257,7 @@ mandir = ${datarootdir}/man
mkdir_p
=
/bin/mkdir
-p
oldincludedir
=
/usr/include
pdfdir
=
${
docdir
}
prefix
=
/usr
/local
prefix
=
/usr
program_transform_name
=
s,x,x,
psdir
=
${
docdir
}
sbindir
=
${
exec_prefix
}
/sbin
...
...
logic/guile-log/src/state.c
View file @
07610add
...
...
@@ -50,6 +50,8 @@ struct gp_stack
#define GP_TEST_CSTACK if(gp->gp_ci > gp->gp_nnc) scm_out_of_range(NULL, SCM_I_MAKINUM(gp->gp_nc))
#define GP_TEST_CCSTACK if(gp->gp_cs > gp->gp_nncs) scm_out_of_range(NULL, SCM_I_MAKINUM(gp->gp_ncs))
#define GP_TEST_STACK if(gp->gp_si > gp->gp_nns) scm_out_of_range(NULL, SCM_I_MAKINUM(gp->gp_ns))
#define GET_GP(scm) ((struct gp_stack *) GP_GETREF(scm)[1])
...
...
@@ -66,7 +68,7 @@ static inline struct gp_stack *get_gp()
static
inline
void
init_gp_var
(
SCM
*
cand
)
{
cand
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_
EQ
(
gp_type
));
cand
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_
UNBD
(
gp_type
));
cand
[
1
]
=
SCM_UNBOUND
;
}
...
...
@@ -85,34 +87,44 @@ static inline SCM *get_gp_var(struct gp_stack *gp)
return
GP_GETREF
(
cand
);
}
static
inline
init_gp_cons
(
SCM
*
cand
,
struct
gp_stack
*
gp
)
static
inline
void
init_gp_cons
(
SCM
*
cand
)
{
gp_debug0
(
"init_gp_cons
\n
"
);
if
(
!
GP_CONS
(
cand
))
cand
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_CONS
(
gp_type
));
{
gp_debug0
(
"get_gp_cons no cons
\n
"
);
cand
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_CONS
(
gp_type
));
}
SCM
car
=
cand
[
1
];
if
(
GP
(
car
))
{
if
(
!
(
GP_VAR
(
car
)))
gp_debug0
(
"get_gp_cons gp(car)
\n
"
);
if
(
!
(
GP_UNBOUND
(
GP_GETREF
(
car
))))
{
gp_debug0
(
"get_gp_cons car not unbound
\n
"
);
init_gp_var
(
GP_GETREF
(
car
));
}
}
else
{
gp_debug0
(
"get_gp_cons car bound
\n
"
);
cand
[
1
]
=
gp_make_variable
();
}
SCM
cdr
=
cand
[
2
];
if
(
GP
(
cdr
))
{
if
(
!
(
GP_VAR
(
cdr
)))
gp_debug0
(
"get_gp_cons GP(cdr)
\n
"
);
if
(
!
(
GP_UNBOUND
(
GP_GETREF
(
cdr
))))
{
gp_debug0
(
"get_gp_cons cdr not unbound
\n
"
);
init_gp_var
(
GP_GETREF
(
cdr
));
}
}
else
{
gp_debug0
(
"get_gp_cons cdr unbound
\n
"
);
cand
[
2
]
=
gp_make_variable
();
}
}
...
...
@@ -120,7 +132,8 @@ static inline init_gp_cons(SCM *cand, struct gp_stack *gp)
static
inline
SCM
*
get_gp_cons
(
struct
gp_stack
*
gp
)
{
SCM
cand
;
GP_TEST_STACK
;
gp_debug0
(
"get_gp_cons
\n
"
);
GP_TEST_CCSTACK
;
cand
=
*
(
gp
->
gp_cs
);
if
(
scm_is_false
(
cand
)
||
scm_is_eq
(
cand
,
SCM_BOOL_T
))
{
...
...
@@ -306,16 +319,13 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, s
gp
->
n
=
0
;
SCM
ret
;
#ifdef HAS_GP_GC
ret
=
PTR2SCM
(
GC_generic_malloc
(
2
*
sizeof
(
scm_t_cell
),
gp_variable_gc_kind
));
#else
ret
=
scm_new_smob
(
gp_stack_type
,
(
scm_t_bits
)
0
);
#endif
GP_GETREF
(
ret
)[
0
]
=
SCM_PACK
(
gp_stack_type
);
GP_GETREF
(
ret
)[
1
]
=
GP_UNREF
((
SCM
*
)
gp
);
for
(
i
=
0
;
i
<
gp
->
gp_ncs
;
i
++
)
{
gp
->
gp_cs
[
i
]
=
SCM_BOOL_F
;
...
...
@@ -323,7 +333,18 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, s
for
(
i
=
0
;
i
<
gp
->
gp_ncs
&&
i
<
10000
;
i
++
)
{
gp
->
gp_cs
[
i
]
=
scm_cons
(
SCM_BOOL_F
,
SCM_BOOL_F
);
gp
->
gp_cs
[
i
]
=
gp_make_cons
(
gp
);
}
for
(
i
=
0
;
i
<
gp
->
gp_ns
;
i
++
)
{
gp
->
gp_si
[
i
]
=
SCM_BOOL_F
;
}
for
(
i
=
0
;
i
<
gp
->
gp_ns
&&
i
<
10000
;
i
++
)
{
gp
->
gp_si
[
i
]
=
gp_make_variable
(
gp
);
}
scm_gc_unprotect_object
(
GP_UNREF
(
gp
->
gp_cstack
));
...
...
@@ -696,7 +717,7 @@ void gp_clear_marks(SCM in, int isBefore)
struct
gp_stack
*
gp
=
GET_GP
(
in
);
SCM
*
pt
;
//printf("clear\n");
//
printf("clear\n");
// Search for the first newframe stored
for
(
pt
=
gp
->
gp_ci
-
1
;
pt
>=
gp
->
gp_cstack
+
4
;
pt
--
)
{
...
...
@@ -878,12 +899,22 @@ void gp_sweep_handle(SCM in)
}
}
}
if
(
vn
>
100
&&
vrem
*
2
-
vn
>
nrem
*
2
-
n
)
{
nrem
=
vrem
;
n
=
vn
;
}
vn
=
0
;
vrem
=
0
;
for
(
pt
=
gp
->
gp_cons_stack
;
pt
<
gp
->
gp_cs
;
pt
++
)
{
vn
++
;
if
(
GP
(
*
pt
))
{
SCM
tc
=
SCM_PACK
(
GP_MK_FRAME_CONS
(
gp_type
));
SCM
*
f
=
GP_GETREF
(
*
pt
);
scm_t_bits
head
=
SCM_UNPACK
(
f
[
0
]);
if
(
!
GP_GC_ISMARKED
(
head
)
&&
GP_GC_ISCAND
(
head
))
...
...
@@ -899,13 +930,13 @@ void gp_sweep_handle(SCM in)
}
}
//Trigger cleanup code
if
(
vn
>
100
&&
vrem
*
2
-
vn
>
nrem
*
2
-
n
)
{
nrem
=
vrem
;
n
=
vn
;
}
//printf("sweep2 %d %d\n",vn,vrem);
}
...
...
@@ -923,17 +954,24 @@ struct GC_ms_entry *gp_stack_mark(SCM pt,
{
struct
GC_ms_entry
*
ret
;
pthread_mutex_lock
(
&
gp_gc_lock
);
if
(
gp_gc_p
)
#ifdef HAS_GP_GC
{
ret
=
gp_stack_mark0
(
pt
,
0
,
ptr
,
limit
);
pthread_mutex_lock
(
&
gp_gc_lock
);
if
(
gp_gc_p
)
{
ret
=
gp_stack_mark0
(
pt
,
0
,
ptr
,
limit
);
pthread_mutex_unlock
(
&
gp_gc_lock
);
return
ret
;
}
ret
=
gp_stack_mark0
(
pt
,
1
,
ptr
,
limit
);
pthread_mutex_unlock
(
&
gp_gc_lock
);
return
ret
;
}
ret
=
gp_stack_mark0
(
pt
,
1
,
ptr
,
limit
);
pthread_mutex_unlock
(
&
gp_gc_lock
);
#else
ret
=
gp_stack_mark0
(
pt
,
0
,
ptr
,
limit
);
return
ret
;
#endif
}
static
void
gp_module_stack_init
()
...
...
@@ -955,7 +993,9 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
#ifdef HAS_GP_GC
int
mute
=
0
;
struct
gp_stack
*
gp
=
get_gp
();
gp_no_gc
();
pthread_mutex_lock
(
&
gp_gc_lock
);
if
(
!
gp_gc_p
)
{
//printf("gc0: %d %d\n",gp->n, gp->nrem);
if
(
gp
->
n
>
100
&&
gp
->
nrem
*
4
>
gp
->
n
)
{
...
...
@@ -1094,7 +1134,7 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
} \
\
} \
while(pt3 <
si
) \
while(pt3 <
cs
) \
{ \
if(!mute && scm_is_false(*pt3)) \
{ \
...
...
@@ -1146,6 +1186,7 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
{
SCM
*
si
=
gp
->
gp_si
;
SCM
*
cs
=
gp
->
gp_cs
;
macro
;
gp
->
gp_si
=
pt2_insert
;
gp
->
gp_cs
=
pt3_insert
;
...
...
@@ -1157,7 +1198,8 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
gp
->
n
=
0
;
gp
->
nrem
=
0
;
gp_do_gc
();
}
pthread_mutex_unlock
(
&
gp_gc_lock
);
#endif
return
SCM_UNSPECIFIED
;
...
...
logic/guile-log/src/unify-undo-redo.c
View file @
07610add
...
...
@@ -558,8 +558,8 @@ static inline void gp_unwind0(SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
else
gp
->
gp_cs
=
cs
;
/
/
*s part
int
cs_store
=
0
;
/*s part
cs_store = 0;
gp_debug0("cs handling\n");
for(i = gp->gp_cs - 1; i >= cs; i--)
...
...
logic/guile-log/src/unify.c
View file @
07610add
...
...
@@ -20,7 +20,7 @@
#include<stdio.h>
#include "../../../config.h"
#include "unify.h"
#include "libguile/smob.h"
#define VECTOR_HEADER_SIZE 2
SCM
tester
=
SCM_BOOL_F
;
...
...
@@ -218,8 +218,8 @@ scm_t_bits gp_smob_t;
#define PTR2NUM(x) SCM_PACK((((scm_t_bits) x) | 2))
#define NUM2PTR(x) ((SCM *) (SCM_UNPACK(x) & ~2))
#define GP_CAR(id)
((id) + 1
)
#define GP_CDR(id)
((id) + 2
)
#define GP_CAR(id)
GP_GETREF((*((id) + 1))
)
#define GP_CDR(id)
GP_GETREF((*((id) + 2))
)
#define GP_GETREF(x) ((SCM *) (x))
...
...
@@ -825,8 +825,11 @@ static inline SCM gp_newframe(SCM s)
l
=
scm_is_false
(
l
)
?
SCM_EOL
:
l
;
ci
[
-
4
]
=
gp
->
handlers
;
ci
[
-
3
]
=
SCM_PACK
(
gp
->
dynstack_length
);
gp_debug0
(
"newframe 2
\n
"
);
f
=
set_ci
(
ci
,
gp
);
gp_debug0
(
"newframe 3
\n
"
);
set_cs_si
(
ci
,
gp
);
gp_debug0
(
"newframe4
\n
"
);
ret
=
scm_cons
(
GP_UNREF
(
f
),
l
);
gp
->
gp_ci
=
ci
;
gp_debug0
(
"return
\n
"
);
...
...
@@ -895,10 +898,9 @@ static inline SCM* gp_mk_var(SCM s)
static
inline
SCM
gp_mk_cons
(
SCM
s
)
{
SCM
*
ret
;
scm_t_bits
fi
;
struct
gp_stack
*
gp
;
gp
=
get_gp
();
gp_debug0
(
"gp_mk_cons
\n
"
);
if
(
gp
->
_logical_
)
{
SCM
x
=
make_logical
();
...
...
@@ -1362,6 +1364,54 @@ static SCM gp_unify(SCM *id1, SCM *id2, int raw, int gp_plus_unify, SCM *l, stru
// u11 Has unbounded variables
gp_debug0
(
"unify> looked up with u11
\n
"
);
if
(
GP_ATTR
(
id1
)
&&
SCM_CONSP
(
id1
[
1
]))
{
retry_attr
:
{
SCM
scm_raw
,
scm_plus
;
if
(
raw
)
scm_raw
=
SCM_BOOL_T
;
else
scm_raw
=
SCM_BOOL_F
;
if
(
gp_plus_unify
)
scm_plus
=
SCM_BOOL_T
;
else
scm_plus
=
SCM_BOOL_F
;
SCM
s
=
gp_make_s
(
ci
,
l
);
SCM
l
=
id1
[
1
];
while
(
SCM_CONSP
(
l
))
{
s
=
scm_call_5
(
SCM_CAAR
(
l
),
SCM_CDAR
(
l
),
*
id2
,
scmraw
,
scm_plus
,
s
);
l
=
SCM_CDR
(
l
);
}
if
(
scm_is_false
(
s
))
return
(
SCM
)
0
;
{
SCM
ll
=
SCM_CDR
(
s
);
if
(
vlist_p
(
ll
))
{
l
[
1
]
=
GP_UNREF
((
SCM_I_VECTOR_WELTS
(
S
(
ll
,
0
))));
l
[
2
]
=
SCM_PACK
(
my_scm_to_int
(
S
(
ll
,
1
)));
}
else
l
[
0
]
=
ll
;
}
}
}
else
if
(
GP_ATTR
(
id2
)
&&
SCM_CONSP
(
id2
[
1
]))
{
SCM
*
temp
=
id1
;
id1
=
id2
;
id2
=
temp
;
goto
retry_attr
;
}
if
(
GP_UNBOUND
(
id1
))
{
if
(
id1
==
id2
)
...
...
@@ -2352,6 +2402,10 @@ SCM_DEFINE(gp_print_stack, "gp-print-stack", 1, 0, 0, (SCM s),
{
printf
(
"%ld v %lx
\n
"
,
i
-
gp
->
gp_stack
,
SCM_UNPACK
(
*
i
));
}
for
(
i
=
gp
->
gp_cons_stack
;
i
<
gp
->
gp_cs
;
i
++
)
{
printf
(
"%ld v %lx
\n
"
,
i
-
gp
->
gp_cons_stack
,
SCM_UNPACK
(
*
i
));
}
return
SCM_UNSPECIFIED
;
}
#undef FUNC_NAME
...
...
@@ -2467,6 +2521,7 @@ SCM_DEFINE(gp_pair_bang, "gp-pair!?", 2, 0, 0, (SCM x, SCM s),
if
(
GP_UNBOUND
(
y
))
{
SCM
*
cons
=
GP_GETREF
(
gp_mk_cons
(
s
));
gp_debus0
(
"gp-pair!?> unbd mk cons
\n
"
);
ret
=
gp_set_ref
(
y
,
GP_UNREF
(
cons
),
l
,
gp
);
PACK_ALL
(
ci
,
l
,
ret
,
ggp
,
s
);
return
s
;
...
...
@@ -2891,31 +2946,6 @@ SCM gp_save_mark_sym;
#include "unify-undo-redo.c"
#ifndef GP_USE_GC_MOCK
static
size_t
gp_type_free
(
SCM
obj
)
{
SCM
*
v
=
GP_GETREF
(
obj
);
scm_t_bits
head
=
SCM_UNPACK
(
v
[
0
]);
if
(
!
GP_GC_ISQAND
(
head
))
{
scm_gc_free
(
GP_GETREF
(
obj
),
2
*
sizeof
(
SCM
),
"gp-variable-free"
);
}
return
0
;
}
#endif
static
SCM
gp_type_mark
(
SCM
obj
)
{
SCM
*
v
=
GP_GETREF
(
obj
);
scm_t_bits
head
=
SCM_UNPACK
(
v
[
0
]);
GP_GC_MARK
(
head
);
v
[
0
]
=
SCM_PACK
(
head
);
scm_gc_mark
(
v
[
1
]);
return
SCM_BOOL_T
;
}
SCM
unify_env_smob
;
scm_t_bits
unify_env_smob_t
;
...
...
@@ -2946,10 +2976,10 @@ SCM_DEFINE(gp_make_fluid, "gp-make-var", 0, 0, 0, (),
{
SCM
ret
,
l
=
SCM_BOOL_F
;
struct
gp_stack
*
gp
=
get_gp
();
int
old
=
gp
->
_logical_
;
gp
->
_logical_
=
0
;
ret
=
gp_make_variable
();
//printf("%p %p\n", (SCM_UNPACK(*(GP_GETREF(ret)))), gp_type);fflush(stdout);
gp_set_unbound_bang
(
GP_GETREF
(
ret
),
l
,
gp
);
gp
->
_logical_
=
old
;
return
ret
;
...
...
@@ -3192,10 +3222,7 @@ void gp_init()
gp_type
=
scm_make_smob_type
(
"unify-variable"
,
0
);
scm_set_smob_print
(
gp_type
,
gp_printer
);
scm_set_smob_mark
(
gp_type
,
gp_type_mark
);
#ifndef GP_USE_GC_MOCK
scm_set_smob_free
(
gp_type
,
gp_type_free
);
#endif
gp_current_stack
=
scm_make_fluid
();
gp_module_stack_init
();
...
...
logic/guile-log/src/variable.c
View file @
07610add
...
...
@@ -3,7 +3,7 @@
/*
We need a special variable
*/
#ifdef HAS_GP_GC
static
int
gp_variable_gc_kind
;
static
struct
GC_ms_entry
*
...
...
@@ -26,6 +26,7 @@ gp_mark_variable (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
else
{
SCM
x
=
SCM_CELL_OBJECT_1
(
cell
);
#ifdef HAS_GP_GC
if
(
GP_GC_ISMARKED
(
SCM_UNPACK
(
SCM_CELL_OBJECT_0
(
cell
))));
{
mark_stack_ptr
=
GC_MARK_AND_PUSH
(
SCM2PTR
(
x
),
...
...
@@ -40,16 +41,28 @@ gp_mark_variable (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
}
}
}
#else
mark_stack_ptr
=
GC_MARK_AND_PUSH
(
SCM2PTR
(
x
),
mark_stack_ptr
,
mark_stack_limit
,
NULL
);
if
(
GP_CONS
(
GP_GETREF
(
cell
)))
{
mark_stack_ptr
=
GC_MARK_AND_PUSH
(
SCM2PTR
(
SCM_CELL_OBJECT_2
(
cell
)),
mark_stack_ptr
,
mark_stack_limit
,
NULL
);
}
#endif
}
return
mark_stack_ptr
;
}
#endif
SCM
gp_make_variable
()
{
#ifdef HAS_GP_GC
gp_debug0
(
"make variable
\n
"
);
SCM
ret
=
PTR2SCM
(
GC_generic_malloc
(
2
*
sizeof
(
scm_t_cell
),
gp_variable_gc_kind
));
SCM
tc
=
SCM_PACK
(
GP_MK_FRAME_UNBD
(
gp_type
));
...
...
@@ -57,51 +70,36 @@ SCM gp_make_variable()
SCM_SET_CELL_WORD_0
(
ret
,
tc
);
return
ret
;
#else
SCM
ret
=
scm_new_smob
(
gp_type
,
(
scm_t_bits
)
0
);
SCM
*
v
=
GP_GETREF
(
ret
);
v
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_UNBD
(
gp_type
));
v
[
1
]
=
SCM_UNBOUND
;
return
ret
;
#endif
}
SCM
gp_make_cons
()
{
gp_debug0
(
"make cons
\n
"
);
SCM
x1
=
gp_make_variable
();
SCM
x2
=
gp_make_variable
();
#ifdef HAS_GP_GC
SCM
ret
=
PTR2SCM
(
GC_generic_malloc
(
3
*
sizeof
(
scm_t_cell
),
gp_variable_gc_kind
));
SCM
tc
=
SCM_PACK
(
GP_MK_FRAME_CONS
(
gp_type
));
SCM_SET_CELL_WORD_2
(
ret
,
x
1
);
SCM_SET_CELL_WORD_1
(
ret
,
x
2
);
SCM_SET_CELL_WORD_2
(
ret
,
x
2
);
SCM_SET_CELL_WORD_1
(
ret
,
x
1
);
SCM_SET_CELL_WORD_0
(
ret
,
tc
);
return
ret
;
#else
SCM
ret
=
scm_new_double_smob
(
gp_type
,
(
scm_t_bits
)
0
,
(
scm_t_bits
)
0
,
(
scm_t_bits
)
0
);
SCM
*
v
=
GP_GETREF
(
ret
);
v
[
0
]
=
SCM_PACK
(
GP_MK_FRAME_CONS
(
gp_type
));
v
[
1
]
=
x1
;
v
[
2
]
=
x2
;
v
[
3
]
=
SCM_UNBOUND
;
return
ret
;
#endif
}
void
init_variables
()
{
#ifdef HAS_GP_GC
gp_variable_gc_kind
=
GC_new_kind_adv
(
GC_new_free_list
(),
GC_MAKE_PROC
(
GC_new_proc
(
gp_mark_variable
),
0
),
0
,
1
,(
GC_word
)
GPI_SCM_M
);
#else
gp_variable_gc_kind
=
GC_new_kind
(
GC_new_free_list
(),
GC_MAKE_PROC
(
GC_new_proc
(
gp_mark_variable
),
0
),
0
,
1
);
#endif
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment