commit e575b4380deb1343f5c31cefff55ebc3af3c7621
parent 828510d689df411a0e7f64ce02d7afc1b74793f3
Author: Tomas Hlavaty <tom@logand.com>
Date: Wed, 28 Aug 2019 07:55:34 +0200
content added
Diffstat:
92 files changed, 25453 insertions(+), 0 deletions(-)
diff --git a/doc/structures b/doc/structures
@@ -0,0 +1,96 @@
+
+ Primary data types:
+ num xxxxxx10
+ sym xxxxx100
+ cell xxxxx000
+
+ Raw data:
+ bin xxxxxxxx
+ txt xxxxxxx1
+
+
+ num
+
+ (30 bit) -536,870,912 .. +536,870,911
+
+ (62 bit) -2,305,843,009,213,693,952 .. +2,305,843,009,213,693,951
+ | | | | | |
+ | | | | | Kilo
+ | | | | Mega
+ | | | Giga
+ | | Tera
+ | Peta
+ Exa
+
+
+ cell
+ |
+ V
+ +-----+-----+
+ | car | cdr |
+ +-----+-----+
+
+
+
+ sym sym
+ | |
+ V V
+ +-----+-----+ +-----+-----+
+ | | | val | | txt | val |
+ +--+--+-----+ +-----+-----+
+ | tail
+ V
+ +-----+-----+ +-----+-----+
+ | | | ---+---> | val | key |
+ +--+--+-----+ +-----+-----+
+ |
+ V
+ +-----+-----+
+ | | | key |
+ +--+--+-----+
+ |
+ V
+ +-----+-----+ +-----+-----+
+ | | | ---+---> | val | key |
+ +--+--+-----+ +-----+-----+
+ | name
+ V
+ +-----+-----+
+ | bin | | |
+ +-----+--+--+
+ |
+ V
+ +-----+-----+
+ | bin | | |
+ +-----+--+--+
+ |
+ V
+ +-----+-----+
+ | bin | num |
+ +-----+-----+
+
+
+
+ NIL: /
+ |
+ V
+ +-----+-----+-----+-----+
+ |'NIL'| / | / | / |
+ +-----+-----+-----+-----+
+
+
+ ASCII-6/7 -> 96 characters:
+ xxxxx0 NUL sp ./<> a-z
+ xxxxxx1 !"#$%&'()*+,- 0-9 :;=?@ A-Z [\]^_`{|}~
+
+
+ Assumptions:
+
+ - 8 bits per byte
+ - word: sizeof(void*) == sizeof(unsigned long)
+ - gcc
+ Functions aligned to 4-byte boundaries
+ Conditionals with Omitted Operands
+ Zero- or variable-length arrays
+ Unused argument attributes
+ Noreturn attributes
diff --git a/lib.l b/lib.l
@@ -0,0 +1,287 @@
+# 12sep07abu
+# (c) Software Lab. Alexander Burger
+
+(de macro "Prg"
+ (run (fill "Prg")) )
+
+(de recur recurse
+ (run (cdr recurse)) )
+
+(de curry "Z"
+ (let ("X" (pop '"Z") "Y" (pop '"Z") "P" (filter pat? "X"))
+ (if2 "P" (diff "X" "P")
+ (list "Y" (cons 'job (lit (env @)) (fill "Z" "P")))
+ (cons "Y" (fill "Z" "P"))
+ (list "Y" (cons 'job (lit (env @)) "Z"))
+ (cons "Y" "Z") ) ) )
+
+(====)
+
+(de getd ("X")
+ (and
+ (sym? "X")
+ (fun? (val "X"))
+ (val "X") ) )
+
+(de expr ("F")
+ (set "F"
+ (list '@ (list 'pass (box (getd "F")))) ) )
+
+(de subr ("F")
+ (set "F"
+ (getd (cadr (cadr (getd "F")))) ) )
+
+(de undef ("X" "C")
+ (when (pair "X")
+ (setq "C" (cdr "X") "X" (car "X")) )
+ (ifn "C"
+ (prog1 (val "X") (set "X"))
+ (prog1
+ (cdr (asoq "X" (val "C")))
+ (set "C"
+ (delq (asoq "X" (val "C")) (val "C")) ) ) ) )
+
+(de redef "Lst"
+ (let ("Old" (car "Lst") "New" (name "Old"))
+ (set
+ "New" (val "Old")
+ "Old" "New"
+ "Old" (fill (cdr "Lst") "Old") )
+ "New" ) )
+
+(de daemon ("X" . Prg)
+ (prog1
+ (if (pair "X")
+ (method (car "X") (cdr "X"))
+ (or (pair (getd "X")) (expr "X")) )
+ (con @ (append Prg (cdr @))) ) )
+
+(de patch ("Lst" "Pat" . "Prg")
+ (bind (fish pat? "Pat")
+ (recur ("Lst")
+ (loop
+ (cond
+ ((match "Pat" (car "Lst"))
+ (set "Lst" (run "Prg")) )
+ ((pair (car "Lst"))
+ (recurse @) ) )
+ (NIL (cdr "Lst"))
+ (T (atom (cdr "Lst"))
+ (when (match "Pat" (cdr "Lst"))
+ (con "Lst" (run "Prg")) ) )
+ (setq "Lst" (cdr "Lst")) ) ) ) )
+
+(====)
+
+(de cache ("Var" "Str" . Prg)
+ (cond
+ ((not (setq "Var" (car (idx "Var" "Str" T))))
+ (set "Str" "Str" "Str" (run Prg 1)) )
+ ((== "Var" (val "Var"))
+ (set "Var" (run Prg 1)) )
+ (T (val "Var")) ) )
+
+(====)
+
+(de scl (*Scl . "Prg")
+ (run "Prg") )
+
+(====)
+
+### I/O ###
+(de tab (Lst . @)
+ (for N Lst
+ (let V (next)
+ (and (gt0 N) (space (- N (length V))))
+ (prin V)
+ (and (lt0 N) (space (- 0 N (length V)))) ) )
+ (prinl) )
+
+(de beep ()
+ (prin "^G") )
+
+(de msg (X . @)
+ (out NIL
+ (print X)
+ (pass prinl)
+ (flush) )
+ X )
+
+### List ###
+(de insert (N Lst X)
+ (conc
+ (cut (dec N) 'Lst)
+ (cons X)
+ Lst ) )
+
+(de remove (N Lst)
+ (conc
+ (cut (dec N) 'Lst)
+ (cdr Lst) ) )
+
+(de place (N Lst X)
+ (conc
+ (cut (dec N) 'Lst)
+ (cons X)
+ (cdr Lst) ) )
+
+(de uniq (Lst)
+ (let R NIL
+ (filter
+ '((X) (not (idx 'R X T)))
+ Lst ) ) )
+
+(de group (Lst)
+ (make
+ (while Lst
+ (if (assoc (caar Lst) (made))
+ (conc @ (cons (cdr (pop 'Lst))))
+ (link
+ (cons (caar Lst) (cons (cdr (pop 'Lst)))) ) ) ) ) )
+
+### Symbol ###
+(de loc (S X)
+ (if (and (str? X) (= S X))
+ X
+ (and
+ (pair X)
+ (or
+ (loc S (car X))
+ (loc S (cdr X)) ) ) ) )
+
+### OOP ###
+(de class Lst
+ (let L (val (setq *Class (car Lst)))
+ (def *Class
+ (recur (L)
+ (if (atom (car L))
+ (cdr Lst)
+ (cons (car L) (recurse (cdr L))) ) ) ) ) )
+
+(de object ("Sym" "Typ" . @)
+ (def "Sym" "Typ")
+ (putl "Sym")
+ (while (args)
+ (put "Sym" (next) (next)) )
+ "Sym" )
+
+(de extend X
+ (setq *Class (car X)) )
+
+# Class variables
+(de var X
+ (put *Class (car X) (cdr X)) )
+
+(de var: X
+ (apply meta X This) )
+
+### Pretty Printing ###
+(de "*PP"
+ T NIL if if2 ifn when unless while until do case state for
+ with catch finally ! setq default push job use let let?
+ prog1 recur redef =: in out tab new )
+(de "*PP1" if2 let let? for redef)
+(de "*PP2" setq default)
+
+(de pretty (X N . @)
+ (setq N (abs (space (or N 0))))
+ (while (args)
+ (printsp (next)) )
+ (if (or (atom X) (>= 12 (size X)))
+ (print X)
+ (while (== 'quote (car X))
+ (prin "'")
+ (pop 'X) )
+ (let Z X
+ (prin "(")
+ (when (memq (print (pop 'X)) "*PP")
+ (cond
+ ((memq (car Z) "*PP1")
+ (if (and (pair (car X)) (pair (cdar X)))
+ (when (>= 12 (size (car X)))
+ (space)
+ (print (pop 'X)) )
+ (space)
+ (print (pop 'X))
+ (when (or (atom (car X)) (>= 12 (size (car X))))
+ (space)
+ (print (pop 'X)) ) ) )
+ ((memq (car Z) "*PP2")
+ (inc 'N 3)
+ (loop
+ (prinl)
+ (pretty (cadr X) N (car X))
+ (NIL (setq X (cddr X))) ) )
+ ((or (atom (car X)) (>= 12 (size (car X))))
+ (space)
+ (print (pop 'X)) ) ) )
+ (when X
+ (loop
+ (T (== Z X) (prin " ."))
+ (T (atom X) (prin " . ") (print X))
+ (prinl)
+ (pretty (pop 'X) (+ 3 N))
+ (NIL X) )
+ (space) )
+ (prin ")") ) ) )
+
+(de pp ("X" C)
+ (let *Dbg NIL
+ (when (pair "X")
+ (setq C (cdr "X")) )
+ (prin "(")
+ (printsp (if C 'dm 'de))
+ (prog1
+ (printsp "X")
+ (setq "X"
+ (if C
+ (method (if (pair "X") (car "X") "X") C)
+ (val "X") ) )
+ (cond
+ ((atom "X") (print '. "X"))
+ ((atom (cdr "X"))
+ (if (cdr "X")
+ (print (car "X") '. @)
+ (print (car "X")) ) )
+ (T (print (pop '"X"))
+ (while (pair "X")
+ (prinl)
+ (pretty (pop '"X") 3) )
+ (when "X"
+ (prin " . ")
+ (print "X") )
+ (space) ) )
+ (prinl ")") ) ) )
+
+(de show ("X" . @)
+ (let *Dbg NIL
+ (setq "X" (apply get (rest) "X"))
+ (when (sym? "X")
+ (print "X" (val "X"))
+ (prinl)
+ (maps
+ '((X)
+ (space 3)
+ (if (atom X)
+ (println X)
+ (println (cdr X) (car X)) ) )
+ "X" ) )
+ "X" ) )
+
+(de view (X L)
+ (let (Z X *Dbg)
+ (loop
+ (T (atom X) (println X))
+ (if (atom (car X))
+ (println '+-- (pop 'X))
+ (print '+---)
+ (view
+ (pop 'X)
+ (append L (cons (if X "| " " "))) ) )
+ (NIL X)
+ (mapc prin L)
+ (T (== Z X) (println '*))
+ (println '|)
+ (mapc prin L) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/debug.l b/lib/debug.l
@@ -0,0 +1,284 @@
+# 26mar08abu
+# (c) Software Lab. Alexander Burger
+
+# Browsing
+(de more ("M" "Foo")
+ (let *Dbg NIL
+ (default "Foo" print)
+ (if (pair "M")
+ ("Foo" (pop '"M"))
+ ("Foo" (type "M"))
+ (setq
+ "Foo" (list '(X) (list 'pp 'X (lit "M")))
+ "M" (mapcar car (filter pair (val "M"))) ) )
+ (loop
+ (T (atom "M") (prinl))
+ (T (line) T)
+ ("Foo" (pop '"M")) ) ) )
+
+(de depth (Idx)
+ (if (atom Idx)
+ 0
+ (inc
+ (max
+ (depth (cadr Idx))
+ (depth (cddr Idx)) ) ) ) )
+
+(de what (S)
+ (let *Dbg NIL
+ (ifn S
+ (all)
+ (setq S (chop S))
+ (filter
+ '(("X") (match S (chop "X")))
+ (all) ) ) ) )
+
+
+(de who ("X" . "*Prg")
+ (let (*Dbg NIL "Who" '("Who" @ @@ @@@))
+ (make (mapc "who" (all))) ) )
+
+(de "who" ("Y")
+ (unless (memq "Y" "Who")
+ (push '"Who" "Y")
+ (ifn (= `(char "+") (char "Y"))
+ (and (pair (val "Y")) ("nest" @) (link "Y"))
+ (for "Z" (val "Y")
+ (if (atom "Z")
+ (and ("match" "Z") (link "Y"))
+ (when ("nest" (cdr "Z"))
+ (link (cons (car "Z") "Y")) ) ) )
+ (maps
+ '(("Z")
+ (if (atom "Z")
+ (and ("match" "Z") (link "Y"))
+ (when ("nest" (car "Z"))
+ (link (cons (cdr "Z") "Y")) ) ) )
+ "Y" ) ) ) )
+
+(de "nest" ("Y")
+ ("nst1" "Y")
+ ("nst2" "Y") )
+
+(de "nst1" ("Y")
+ (let "Z" (setq "Y" (strip "Y"))
+ (loop
+ (T (atom "Y") (and (sym? "Y") ("who" "Y")))
+ (and (sym? (car "Y")) ("who" (car "Y")))
+ (and (pair (car "Y")) ("nst1" @))
+ (T (== "Z" (setq "Y" (cdr "Y")))) ) ) )
+
+(de "nst2" ("Y")
+ (let "Z" (setq "Y" (strip "Y"))
+ (loop
+ (T (atom "Y") ("match" "Y"))
+ (T (or ("match" (car "Y")) ("nst2" (car "Y")))
+ T )
+ (T (== "Z" (setq "Y" (cdr "Y")))) ) ) )
+
+(de "match" ("D")
+ (and
+ (cond
+ ((str? "X") (and (str? "D") (= "X" "D")))
+ ((sym? "X") (== "X" "D"))
+ (T (match "X" "D")) )
+ (or (not "*Prg") (run "*Prg")) ) )
+
+
+(de can (X)
+ (let *Dbg NIL
+ (mapcan
+ '(("Y")
+ (and
+ (= `(char "+") (char "Y"))
+ (asoq X (val "Y"))
+ (cons (cons X "Y")) ) )
+ (all) ) ) )
+
+
+# Class dependencies
+(de dep ("C")
+ (let *Dbg NIL
+ (dep1 0 "C")
+ (dep2 3 "C")
+ "C" ) )
+
+(de dep1 (N "C")
+ (for "X" (type "C")
+ (dep1 (+ 3 N) "X") )
+ (space N)
+ (println "C") )
+
+(de dep2 (N "C")
+ (for "X" (all)
+ (when
+ (and
+ (= `(char "+") (char "X"))
+ (memq "C" (type "X")) )
+ (space N)
+ (println "X")
+ (dep2 (+ 3 N) "X") ) ) )
+
+# Single-Stepping
+(de _dbg (Lst)
+ (or
+ (atom (car Lst))
+ (num? (caar Lst))
+ (flg? (caar Lst))
+ (== '! (caar Lst))
+ (set Lst (cons '! (car Lst))) ) )
+
+(de _dbg2 (Lst)
+ (map
+ '((L)
+ (if (and (pair (car L)) (flg? (caar L)))
+ (map _dbg (cdar L))
+ (_dbg L) ) )
+ Lst ) )
+
+(de dbg (Lst)
+ (when (pair Lst)
+ (case (pop 'Lst)
+ (case
+ (_dbg Lst)
+ (for L (cdr Lst)
+ (map _dbg (cdr L)) ) )
+ (state
+ (_dbg Lst)
+ (for L (cdr Lst)
+ (map _dbg (cddar L))
+ (map _dbg (cdr L)) ) )
+ ((cond nond)
+ (for L Lst
+ (map _dbg L) ) )
+ (quote
+ (when (fun? Lst)
+ (map _dbg (cdr Lst)) ) )
+ ((job use let let? recur)
+ (map _dbg (cdr Lst)) )
+ (loop
+ (_dbg2 Lst) )
+ ((bind do)
+ (_dbg Lst)
+ (_dbg2 (cdr Lst)) )
+ (for
+ (and (pair (car Lst)) (map _dbg (cdar Lst)))
+ (_dbg2 (cdr Lst)) )
+ (T (map _dbg Lst)) )
+ T ) )
+
+(de d () (let *Dbg NIL (dbg ^)))
+
+(de debug ("X" C)
+ (ifn (traced? "X" C)
+ (let *Dbg NIL
+ (when (pair "X")
+ (setq C (cdr "X") "X" (car "X")) )
+ (or
+ (dbg (if C (method "X" C) (getd "X")))
+ (quit "Can't debug" "X") ) )
+ (untrace "X" C)
+ (debug "X" C)
+ (trace "X" C) ) )
+
+(de ubg (Lst)
+ (when (pair Lst)
+ (map
+ '((L)
+ (when (pair (car L))
+ (when (== '! (caar L))
+ (set L (cdar L)) )
+ (ubg (car L)) ) )
+ Lst )
+ T ) )
+
+(de u () (let *Dbg NIL (ubg ^)))
+
+(de unbug ("X" C)
+ (let *Dbg NIL
+ (when (pair "X")
+ (setq C (cdr "X") "X" (car "X")) )
+ (or
+ (ubg (if C (method "X" C) (getd "X")))
+ (quit "Can't unbug" "X") ) ) )
+
+# Tracing
+(de traced? ("X" C)
+ (setq "X"
+ (if C
+ (method "X" C)
+ (getd "X") ) )
+ (and
+ (pair "X")
+ (pair (cadr "X"))
+ (== '$ (caadr "X")) ) )
+
+# Convert ((X Y) A B) --> ((X Y) ($ foo (X Y) A B))
+(de trace ("X" C)
+ (let *Dbg NIL
+ (when (pair "X")
+ (setq C (cdr "X") "X" (car "X")) )
+ (if C
+ (unless (traced? "X" C)
+ (or (method "X" C) (quit "Can't trace" "X"))
+ (con @
+ (cons
+ (conc
+ (list '$ (cons "X" C) (car @))
+ (cdr @) ) ) ) )
+ (unless (traced? "X")
+ (and (sym? (getd "X")) (quit "Can't trace" "X"))
+ (and (num? (getd "X")) (expr "X"))
+ (set "X"
+ (list
+ (car (getd "X"))
+ (conc (list '$ "X") (getd "X")) ) ) ) )
+ "X" ) )
+
+# Convert ((X Y) ($ foo (X Y) A B)) --> ((X Y) A B)
+(de untrace ("X" C)
+ (let *Dbg NIL
+ (when (pair "X")
+ (setq C (cdr "X") "X" (car "X")) )
+ (if C
+ (when (traced? "X" C)
+ (con
+ (method "X" C)
+ (cdddr (cadr (method "X" C))) ) )
+ (when (traced? "X")
+ (let X (set "X" (cddr (cadr (getd "X"))))
+ (and
+ (== '@ (pop 'X))
+ (= 1 (length X))
+ (= 2 (length (car X)))
+ (== 'pass (caar X))
+ (sym? (cdadr X))
+ (subr "X") ) ) ) )
+ "X" ) )
+
+(de *NoTrace
+ @ @@ @@@
+ pp show more led
+ what who can dep d e debug u unbug trace untrace )
+
+(de traceAll (Excl)
+ (let *Dbg NIL
+ (for "X" (all)
+ (or
+ (memq "X" Excl)
+ (memq "X" *NoTrace)
+ (= `(char "*") (char "X"))
+ (cond
+ ((= `(char "+") (char "X"))
+ (mapc trace
+ (mapcan
+ '(("Y")
+ (and
+ (pair "Y")
+ (fun? (cdr "Y"))
+ (list (cons (car "Y") "X")) ) )
+ (val "X") ) ) )
+ ((pair (getd "X"))
+ (trace "X") ) ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/misc.l b/lib/misc.l
@@ -0,0 +1,81 @@
+# 16oct07abu
+# (c) Software Lab. Alexander Burger
+
+### Math ###
+(de accu (Var Key Val)
+ (when Val
+ (if (assoc Key (val Var))
+ (con @ (+ Val (cdr @)))
+ (push Var (cons Key Val)) ) ) )
+
+### String ###
+(de align (X . @)
+ (pack
+ (if (pair X)
+ (mapcar
+ '((X) (need X (chop (next)) " "))
+ X )
+ (need X (chop (next)) " ") ) ) )
+
+### Number ###
+(de pad (N Val)
+ (pack (need N (chop Val) "0")) )
+
+(de hex (X)
+ (if (num? X)
+ (let L (_hex X)
+ (until (=0 (setq X (>> 4 X)))
+ (push 'L (_hex X)) )
+ (pack L) )
+ (let N 0
+ (for C (chop X)
+ (setq C (- (char C) `(char "0")))
+ (and (> C 9) (dec 'C 7))
+ (setq N (+ C (>> -4 N))) )
+ N ) ) )
+
+(de _hex (N)
+ (let C (& 15 N)
+ (and (> C 9) (inc 'C 7))
+ (char (+ C `(char "0"))) ) )
+
+### Tree ###
+(de balance ("Var" "Lst" "Flg")
+ (unless "Flg" (set "Var"))
+ (let "Len" (length "Lst")
+ (recur ("Lst" "Len")
+ (unless (=0 "Len")
+ (let ("N" (>> 1 (inc "Len")) "L" (nth "Lst" "N"))
+ (idx "Var" (car "L") T)
+ (recurse "Lst" (dec "N"))
+ (recurse (cdr "L") (- "Len" "N")) ) ) ) ) )
+
+### Date ###
+(de dat$ (Dat C)
+ (when (date Dat)
+ (pack (car @) C (pad 2 (cadr @)) C (pad 2 (caddr @))) ) )
+
+(de $dat (S C)
+ (if C
+ (and
+ (= 3
+ (length (setq S (split (chop S) C))) )
+ (date
+ (format (pack (car S))) # Year
+ (or (format (pack (cadr S))) 0) # Month
+ (or (format (pack (caddr S))) 0) ) ) # Day
+ (and
+ (setq S (format S))
+ (date
+ (/ S 10000) # Year
+ (% (/ S 100) 100) # Month
+ (% S 100) ) ) ) )
+
+### System ###
+(de test (Pat . Prg)
+ (bind (fish pat? Pat)
+ (unless (match Pat (run Prg 1))
+ (msg Prg)
+ (quit 'fail Pat) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/pilog.l b/lib/pilog.l
@@ -0,0 +1,203 @@
+# 25jun07abu
+# (c) Software Lab. Alexander Burger
+
+# *Rule
+
+(de be CL
+ (with (car CL)
+ (if (== *Rule This)
+ (=: T (conc (: T) (cons (cdr CL))))
+ (=: T (cons (cdr CL)))
+ (setq *Rule This) )
+ This ) )
+
+(de repeat ()
+ (conc (get *Rule T) (get *Rule T)) )
+
+(de asserta (CL)
+ (with (car CL)
+ (=: T (cons (cdr CL) (: T))) ) )
+
+(de assertz (CL)
+ (with (car CL)
+ (=: T (conc (: T) (cons (cdr CL)))) ) )
+
+(de retract (X)
+ (if (sym? X)
+ (put X T)
+ (put (car X) T
+ (delete (cdr X) (get (car X) T)) ) ) )
+
+(de rules @
+ (while (args)
+ (let S (next)
+ (for ((N . L) (get S T) L)
+ (prin N " (be ")
+ (print S)
+ (for X (pop 'L)
+ (space)
+ (print X) )
+ (prinl ")")
+ (T (== L (get S T))
+ (println '(repeat)) ) )
+ S ) ) )
+
+
+### Pilog Interpreter ###
+(de goal ("CL" . @)
+ (let Env '(T)
+ (while (args)
+ (push 'Env
+ (cons (cons 0 (next)) 1 (next)) ) )
+ (while (and "CL" (pat? (car "CL")))
+ (push 'Env
+ (cons
+ (cons 0 (pop '"CL"))
+ (cons 1 (eval (pop '"CL"))) ) ) )
+ (cons
+ (cons
+ (conc (list 1 (0) NIL "CL" NIL) Env) ) ) ) )
+
+(de fail ()
+ (goal '((NIL))) )
+
+(de pilog ("CL" . "Prg")
+ (for ("Q" (goal "CL") (prove "Q"))
+ (bind @ (run "Prg")) ) )
+
+(de solve ("CL" . "Prg")
+ (make
+ (if "Prg"
+ (for ("Q" (goal "CL") (prove "Q"))
+ (link (bind @ (run "Prg"))) )
+ (for ("Q" (goal "CL") (prove "Q"))
+ (link @) ) ) ) )
+
+(de query ("Q" "Dbg")
+ (use "R"
+ (loop
+ (NIL (prove "Q" "Dbg"))
+ (T (=T (setq "R" @)) T)
+ (for X "R"
+ (space)
+ (print (car X))
+ (print '=)
+ (print (cdr X)) )
+ (T (line)) ) ) )
+
+(de ? "CL"
+ (let "L"
+ (make
+ (while (nor (pat? (car "CL")) (lst? (car "CL")))
+ (link (pop '"CL")) ) )
+ (query (goal "CL") "L") ) )
+
+### Basic Rules ###
+(be repeat)
+(repeat)
+
+(be true)
+
+(be not @P (1 -> @P) T (fail))
+(be not @P)
+
+(be call (@P . @L)
+ (2 cons (cons (-> @P) (-> @L))) )
+
+(be or @L (@C box (-> @L)) (_or @C))
+(be _or (@C) (3 pop (-> @C)))
+(be _or (@C) (@ not (val (-> @C))) T (fail))
+(repeat)
+
+(be nil (@X) (@ not (-> @X)))
+(be equal (@X @X))
+
+(be different (@X @X) T (fail))
+(be different (@ @))
+
+(be append (NIL @X @X))
+(be append ((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))
+
+(be member (@X (@X . @)))
+(be member (@X (@ . @Y)) (member @X @Y))
+
+(be delete (@A (@A . @Z) @Z))
+(be delete (@A (@X . @Y) (@X . @Z))
+ (delete @A @Y @Z) )
+
+(be permute ((@X) (@X)))
+(be permute (@L (@X . @Y))
+ (delete @X @L @D)
+ (permute @D @Y) )
+
+(be uniq (@B @X)
+ (@ not (idx (-> @B) (-> @X) T)) )
+
+(be asserta (@C) (@ asserta (-> @C)))
+(be assertz (@C) (@ assertz (-> @C)))
+
+(be clause ("@H" "@B")
+ ("@A" get (-> "@H") T)
+ (member "@B" "@A") )
+
+(be show (@X) (@ show (-> @X)))
+
+### idx ###
+(be idx (@Idx @Str @Sym)
+ (@Q box
+ (let (Node (val (-> @Idx)) Str (-> @Str) Q)
+ (while Node
+ (if (> Str (car Node))
+ (setq Node (cddr Node))
+ (when (pre? Str (car Node))
+ (push 'Q Node) )
+ (setq Node (cadr Node)) ) )
+ (cons Str Q) ) )
+ (_idx @Sym @Q) )
+
+(be _idx (@Sym @Q)
+ (@ not
+ (setq "R"
+ (let (Q (val (-> @Q)) Val (cadr Q) Node (cddr Val))
+ (con Q (cddr Q))
+ (when Node
+ (loop
+ (T (> (car Q) (car Node)))
+ (when (pre? (car Q) (car Node))
+ (con Q (cons Node (cdr Q))) )
+ (NIL (setq Node (cadr Node))) ) )
+ (car Val) ) ) )
+ T
+ (fail) )
+
+(be _idx (@Sym @Q) (@Sym . "R"))
+
+(repeat)
+
+
+(be val (@V . @L)
+ (@V let L (-> @L)
+ (apply get (cdr L) (car L)) )
+ T )
+
+(be lst (@V . @L)
+ (@Lst box
+ (let L (-> @L)
+ (apply get (cdr L) (car L)) ) )
+ (_lst @V @Lst) )
+
+(be _lst (@Val @Lst) (@ not (val (-> @Lst))) T (fail))
+(be _lst (@Val @Lst) (@Val pop (-> @Lst)))
+(repeat)
+
+(be map (@V . @L)
+ (@Lst box
+ (let L (-> @L)
+ (apply get (cdr L) (car L)) ) )
+ (_map @V @Lst) )
+
+(be _map (@Val @Lst) (@ not (val (-> @Lst))) T (fail))
+(be _map (@Val @Lst) (@Val prog1 (val (-> @Lst)) (pop (-> @Lst))))
+(repeat)
+
+# vi:et:ts=3:sw=3
diff --git a/p b/p
@@ -0,0 +1 @@
+exec ${0%/*}/bin/picolisp -'on *Dbg' ${0%/*}/lib.l @lib/misc.l @lib/pilog.l @lib/debug.l "$@"
diff --git a/simul/gl/cube.l b/simul/gl/cube.l
@@ -0,0 +1,73 @@
+# 03mar08jk
+
+# Based on cube.io by Mike Austin
+
+(load "@simul/gl/lib.l")
+
+(setq *AngleX -26.0 *AngleY 74.0)
+(setq *LastX 0 *LastY 0)
+
+(glut:Init)
+(glut:InitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH))
+(glut:InitWindowSize 512 512)
+(glut:InitWindowPosition 10 50)
+(glut:CreateWindow "Pico Lisp Cube")
+
+(gl:ClearColor 1.0 1.0 1.0 1.0) # the background color
+(gl:Enable GL_DEPTH_TEST)
+(gl:Enable GL_LIGHTING)
+(gl:Enable GL_LIGHT0)
+(gl:Disable GL_CULL_FACE)
+
+(gl:Enable GL_BLEND)
+(gl:BlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
+(gl:Enable GL_LINE_SMOOTH)
+(gl:Hint GL_LINE_SMOOTH_HINT GL_NICEST)
+(gl:LineWidth 2.0)
+
+(de myMouse (Btn State X Y)
+ #(println "myMouse" Btn State X Y)
+ (setq *LastX X *LastY Y) )
+
+(de myMotion (X Y)
+ #(println "myMotion" X Y)
+ (inc '*AngleX (* (- Y *LastY) 1.0))
+ (inc '*AngleY (* (- X *LastX) 1.0))
+ (setq *LastX X *LastY Y)
+ (glut:PostRedisplay) )
+
+(de myReshape (Width Height)
+ #(println "myReshape" Width Height)
+ (gl:MatrixMode GL_PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 45.0 (*/ Width 1.0 Height) 1.0 10.0)
+ (gl:MatrixMode GL_MODELVIEW)
+ (gl:Viewport 0 0 Width Height) )
+
+(displayFunc ()
+ #(println "displayFunc")
+ (gl:Clear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+ (gl:LoadIdentity)
+ (gl:Translatef 0.0 0.0 -3.0)
+ (gl:Rotatef *AngleX 1 0 0)
+ (gl:Rotatef *AngleY 0 1 0)
+ (glut:SolidCube 1.0)
+
+ (gl:Disable GL_LIGHTING)
+ (gl:Color4f 0.4 0.4 0.4 1.0)
+ (glut:WireCube 1.002)
+ (gl:Enable GL_LIGHTING)
+
+ (gl:Flush)
+ (glut:SwapBuffers) )
+
+(mouseFunc (Btn State X Y)
+ (myMouse Btn State X Y) )
+
+(motionFunc (X Y)
+ (myMotion X Y) )
+
+(reshapeFunc (Width Height)
+ (myReshape Width Height) )
+
+(glut:MainLoop)
diff --git a/simul/gl/font-menu.l b/simul/gl/font-menu.l
@@ -0,0 +1,55 @@
+# 03apr08jk
+
+(load "@simul/gl/lib.l")
+
+(setq *FontNum 5)
+(setq *Message "Right-click to activate menu")
+(setq *MenuItems (list
+ "9 by 15" "8 by 13" "Times Roman 10" "Times Roman 24"
+ "Helvetica 10" "Helvetica 12" "Helvetica 18") )
+
+(de drawBitmapString (FontNum String)
+ (gl:RasterPos2f 0 0)
+ (for Chr (chop String)
+ (glut:BitmapCharacter FontNum (char Chr)) ) )
+
+(glut:Init)
+(glut:InitDisplayMode (| GLUT_DOUBLE GLUT_RGBA))
+(glut:InitWindowSize 350 150)
+(glut:CreateWindow "Bitmap Font Menu")
+
+(displayFunc ()
+ #(println "displayFunc" *Message)
+ (gl:Clear GL_COLOR_BUFFER_BIT)
+ (gl:LoadIdentity)
+ (gl:Color3f 0.75 0.0 0.0)
+ (gl:Translatef 20.0 80.0 0)
+ (drawBitmapString *FontNum *Message)
+ (gl:Translatef 0.0 -40.0 0)
+ (drawBitmapString *FontNum "Sample: æøå ÆØÅ äö ÄÖ éè")
+ (gl:Flush)
+ (glut:SwapBuffers) )
+
+(reshapeFunc (Width Height)
+ (gl:Viewport 0 0 Width Height)
+ (gl:MatrixMode GL_PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Ortho2D 0 (* Width 1.0) 0 (* Height 1.0))
+ (gl:MatrixMode GL_MODELVIEW)
+ (gl:LoadIdentity)
+ (gl:ClearColor 0.8 0.9 0.8 1.0) )
+
+(createMenu (ItemNo)
+ (setq *FontNum (inc ItemNo))
+ (setq *Message (pack (inc ItemNo) ": " (get *MenuItems ItemNo)))
+ (glut:PostRedisplay) )
+
+(for (N . Item) *MenuItems
+ (glut:AddMenuEntry Item N) )
+
+(glut:AttachMenu GLUT_RIGHT_BUTTON)
+
+(gl:Enable GL_LINE_SMOOTH)
+(gl:Enable GL_BLEND)
+(gl:BlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
+(glut:MainLoop)
diff --git a/simul/gl/lib.l b/simul/gl/lib.l
@@ -0,0 +1,159 @@
+# 18sep07abu
+# 01apr08jk
+# (c) Software Lab. Alexander Burger
+
+(setq *Scl 4)
+
+# Primitives
+(def 'GL_POINTS (hex "0000"))
+(def 'GL_LINES (hex "0001"))
+(def 'GL_LINE_LOOP (hex "0002"))
+(def 'GL_LINE_STRIP (hex "0003"))
+(def 'GL_TRIANGLES (hex "0004"))
+(def 'GL_TRIANGLE_STRIP (hex "0005"))
+(def 'GL_TRIANGLE_FAN (hex "0006"))
+(def 'GL_QUADS (hex "0007"))
+(def 'GL_QUAD_STRIP (hex "0008"))
+(def 'GL_POLYGON (hex "0009"))
+
+# Matrix Mode
+(def 'GL_MATRIX_MODE (hex "0BA0"))
+(def 'GL_MODELVIEW (hex "1700"))
+(def 'GL_PROJECTION (hex "1701"))
+(def 'GL_TEXTURE (hex "1702"))
+
+# glPush/PopAttrib bits
+(def 'GL_CURRENT_BIT (hex "00000001"))
+(def 'GL_POINT_BIT (hex "00000002"))
+(def 'GL_LINE_BIT (hex "00000004"))
+(def 'GL_POLYGON_BIT (hex "00000008"))
+(def 'GL_POLYGON_STIPPLE_BIT (hex "00000010"))
+(def 'GL_PIXEL_MODE_BIT (hex "00000020"))
+(def 'GL_LIGHTING_BIT (hex "00000040"))
+(def 'GL_FOG_BIT (hex "00000080"))
+(def 'GL_DEPTH_BUFFER_BIT (hex "00000100"))
+(def 'GL_ACCUM_BUFFER_BIT (hex "00000200"))
+(def 'GL_STENCIL_BUFFER_BIT (hex "00000400"))
+(def 'GL_VIEWPORT_BIT (hex "00000800"))
+(def 'GL_TRANSFORM_BIT (hex "00001000"))
+(def 'GL_ENABLE_BIT (hex "00002000"))
+(def 'GL_COLOR_BUFFER_BIT (hex "00004000"))
+(def 'GL_HINT_BIT (hex "00008000"))
+(def 'GL_EVAL_BIT (hex "00010000"))
+(def 'GL_LIST_BIT (hex "00020000"))
+(def 'GL_TEXTURE_BIT (hex "00040000"))
+(def 'GL_SCISSOR_BIT (hex "00080000"))
+(def 'GL_ALL_ATTRIB_BITS (hex "000FFFFF"))
+
+# AlphaFunction
+(def 'GL_LESS (hex "00000201"))
+
+# BlendingFactorDest
+(def 'GL_SRC_ALPHA (hex "00000302"))
+(def 'GL_ONE_MINUS_SRC_ALPHA (hex "00000303"))
+
+# DrawBufferMode
+(def 'GL_FRONT_AND_BACK (hex "00000408"))
+
+# GetTarget
+(def 'GL_BLEND (hex "00000BE2"))
+(def 'GL_COLOR_MATERIAL (hex "00000B57"))
+(def 'GL_CULL_FACE (hex "00000B44"))
+(def 'GL_DEPTH_TEST (hex "00000B71"))
+(def 'GL_LIGHTING (hex "00000B50"))
+(def 'GL_LINE_SMOOTH (hex "00000B20"))
+(def 'GL_LINE_SMOOTH_HINT (hex "00000C52"))
+
+# HintMode
+(def 'GL_NICEST (hex "00001102"))
+
+# LightName
+(def 'GL_LIGHT0 (hex "00004000"))
+
+# MaterialParameter
+(def 'GL_AMBIENT_AND_DIFFUSE (hex "00001602"))
+
+# ShadingModel
+(def 'GL_FLAT (hex "00001D00"))
+(def 'GL_SMOOTH (hex "00001D01"))
+
+
+# GLUT API macro definitions -- the display mode definitions
+(def 'GLUT_RGB (hex "0000"))
+(def 'GLUT_RGBA (hex "0000"))
+(def 'GLUT_INDEX (hex "0001"))
+(def 'GLUT_SINGLE (hex "0000"))
+(def 'GLUT_DOUBLE (hex "0002"))
+(def 'GLUT_ACCUM (hex "0004"))
+(def 'GLUT_ALPHA (hex "0008"))
+(def 'GLUT_DEPTH (hex "0010"))
+(def 'GLUT_STENCIL (hex "0020"))
+(def 'GLUT_MULTISAMPLE (hex "0080"))
+(def 'GLUT_STEREO (hex "0100"))
+(def 'GLUT_LUMINANCE (hex "0200"))
+
+# Function keys
+(def 'GLUT_KEY_F1 1)
+(def 'GLUT_KEY_F2 2)
+(def 'GLUT_KEY_F3 3)
+(def 'GLUT_KEY_F4 4)
+(def 'GLUT_KEY_F5 5)
+(def 'GLUT_KEY_F6 6)
+(def 'GLUT_KEY_F7 7)
+(def 'GLUT_KEY_F8 8)
+(def 'GLUT_KEY_F9 9)
+(def 'GLUT_KEY_F10 10)
+(def 'GLUT_KEY_F11 11)
+(def 'GLUT_KEY_F12 12)
+# Directional keys
+(def 'GLUT_KEY_LEFT 100)
+(def 'GLUT_KEY_UP 101)
+(def 'GLUT_KEY_RIGHT 102)
+(def 'GLUT_KEY_DOWN 103)
+(def 'GLUT_KEY_PAGE_UP 104)
+(def 'GLUT_KEY_PAGE_DOWN 105)
+(def 'GLUT_KEY_HOME 106)
+(def 'GLUT_KEY_END 107)
+(def 'GLUT_KEY_INSERT 108)
+
+# Mouse state definitions
+(def 'GLUT_LEFT_BUTTON 0)
+(def 'GLUT_MIDDLE_BUTTON 1)
+(def 'GLUT_RIGHT_BUTTON 2)
+
+# Callback Functions
+# Keep references in global symbols, to protect from garbage collection
+
+# Display Function
+(de displayFunc Prg
+ (glut:DisplayFunc (setq *GlutDisplayFunc (cdr Prg))) )
+
+# CreateMenu Function
+(de createMenu Prg
+ (glut:CreateMenu (setq *CreateMenu Prg)) )
+
+# Keyboard Function
+(de keyboardFunc Prg
+ (glut:KeyboardFunc (setq *GlutKeyboardFunc Prg)) )
+
+# Motion Function
+(de motionFunc Prg
+ (glut:MotionFunc (setq *GlutMotionFunc Prg)) )
+
+# Mouse Function
+(de mouseFunc Prg
+ (glut:MouseFunc (setq *GlutMouseFunc Prg)) )
+
+# Reshape Function
+(de reshapeFunc Prg
+ (glut:ReshapeFunc (setq *GlutReshapeFunc Prg)) )
+
+# Special Function
+(de specialFunc Prg
+ (glut:SpecialFunc (setq *GlutSpecialFunc Prg)) )
+
+# Timer Function
+(de timerFunc (Msec Fun Val)
+ (glut:TimerFunc Msec (setq *GlutTimerFunc Fun) Val) )
+
+# vi:et:ts=3:sw=3
diff --git a/simul/gl/pyramids.l b/simul/gl/pyramids.l
@@ -0,0 +1,169 @@
+# 03mar08jk
+# (c) Jon Kleiser
+
+# An OpenGL demo showing twelve pyramids chained together.
+# The chain folds and unfolds. When completely folded, it is the shape of a cube.
+
+(load "@simul/gl/lib.l")
+
+(setq *WinWidth 1024 *WinHeight 680)
+(setq *AngleX 0.0 *AngleY 0.0)
+(setq *LastX 0 *LastY 0)
+(setq *Sin45 0.70710678)
+(setq *FoldTime 0.0)
+
+(de initGL (Width Height)
+ (gl:ClearColor 0.6 0.8 0.9 0) # the background color
+ (gl:ClearDepth 1.0)
+ (gl:DepthFunc GL_LESS)
+ (gl:Enable GL_DEPTH_TEST)
+ (gl:ShadeModel GL_FLAT)
+
+ (gl:Enable GL_LIGHTING)
+ (gl:Enable GL_LIGHT0)
+ (gl:Disable GL_CULL_FACE)
+ (gl:Enable GL_BLEND)
+ (gl:BlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
+ (gl:ColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE)
+ (gl:Enable GL_COLOR_MATERIAL)
+
+ (gl:MatrixMode GL_PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 45.0 (*/ Width 1.0 Height) 0.1 100.0)
+ (gl:MatrixMode GL_MODELVIEW) )
+
+(glut:Init)
+# Set display mode: RGBA color, Double buffer, Alpha support, Depth buffer
+(glut:InitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_ALPHA GLUT_DEPTH))
+(glut:InitWindowSize *WinWidth *WinHeight)
+(glut:InitWindowPosition 10 50)
+(glut:CreateWindow "Folding Pyramids")
+
+(initGL *WinWidth *WinHeight)
+
+(de drawPyramid ()
+ (gl:Begin GL_TRIANGLES)
+ (gl:Normal3f (- *Sin45) 0.0 *Sin45)
+ (gl:Vertex3f 1.0 1.0 1.0) # 0
+ (gl:Vertex3f 0.0 2.0 0.0) # 1
+ (gl:Vertex3f 0.0 0.0 0.0) # 2
+
+ (gl:Normal3f 0.0 (- *Sin45) *Sin45)
+ (gl:Vertex3f 1.0 1.0 1.0) # 0
+ (gl:Vertex3f 0.0 0.0 0.0) # 2
+ (gl:Vertex3f 2.0 0.0 0.0) # 3
+
+ (gl:Normal3f *Sin45 *Sin45 0.0)
+ (gl:Vertex3f 1.0 1.0 1.0) # 0
+ (gl:Vertex3f 2.0 0.0 0.0) # 3
+ (gl:Vertex3f 0.0 2.0 0.0) # 1
+
+ (gl:Normal3f 0.0 0.0 -1.0)
+ (gl:Vertex3f 2.0 0.0 0.0) # 3
+ (gl:Vertex3f 0.0 0.0 0.0) # 2
+ (gl:Vertex3f 0.0 2.0 0.0) # 1
+ (gl:End) )
+
+(displayFunc ()
+ (setq PyrRot (+ (ext:Cos *FoldTime 45.0) 45.0))
+ (gl:Clear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+ (gl:LoadIdentity)
+ (gl:Translatef 0.0 -0.4 -11.0)
+ (gl:Rotatef *AngleX 1 0 0)
+ (gl:Rotatef *AngleY 0 1 0)
+ (gl:Rotatef (- (/ PyrRot 2)) 0 1 0)
+ (gl:PushMatrix)
+
+ (gl:Color4f 1.0 0.7 0.0 1.0) # yellow
+ (drawPyramid) # 1
+
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 90.0 0 0 1)
+ (gl:Color4f 0.4 0.0 0.6 1.0) # violet
+ (drawPyramid) # 2
+
+ (gl:Translatef 0.0 2.0 0.0)
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 1.0 0.2 0.0 1.0) # red
+ (drawPyramid) # 3
+
+ (gl:Rotatef (- PyrRot) 1 0 0)
+ (gl:Rotatef -90.0 0 0 1)
+ (gl:Color4f 1.0 0.7 0.0 1.0) # yellow
+ (drawPyramid) # 4
+
+ (gl:Translatef 2.0 0.0 0.0)
+ (gl:Rotatef (- PyrRot) 1 0 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 0.4 0.0 0.6 1.0) # violet
+ (drawPyramid) # 5
+
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 90.0 0 0 1)
+ (gl:Color4f 1.0 0.2 0.0 1.0) # red
+ (drawPyramid) # 6
+
+ (gl:Translatef 0.0 2.0 0.0)
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 1.0 0.7 0.0 1.0) # yellow
+ (drawPyramid) # 7
+
+ (gl:PopMatrix)
+
+ (gl:Translatef 2.0 0.0 0.0)
+ (gl:Rotatef (- PyrRot) 1 0 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 1.0 0.2 0.0 1.0) # red
+ (drawPyramid) # 12
+
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 90.0 0 0 1)
+ (gl:Color4f 0.4 0.0 0.6 1.0) # violet
+ (drawPyramid) # 11
+
+ (gl:Translatef 0.0 2.0 0.0)
+ (gl:Rotatef PyrRot 0 1 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 1.0 0.7 0.0 1.0) # yellow
+ (drawPyramid) # 10
+
+ (gl:Rotatef (- PyrRot) 1 0 0)
+ (gl:Rotatef -90.0 0 0 1)
+ (gl:Color4f 1.0 0.2 0.0 1.0) # red
+ (drawPyramid) # 9
+
+ (gl:Translatef 2.0 0.0 0.0)
+ (gl:Rotatef (- PyrRot) 1 0 0)
+ (gl:Rotatef 180.0 0 0 1)
+ (gl:Color4f 0.4 0.0 0.6 1.0) # violet
+ (drawPyramid) # 8
+
+ (gl:Flush)
+ (glut:SwapBuffers) )
+
+(reshapeFunc (Width Height)
+ (gl:Viewport 0 0 Width Height)
+ (gl:MatrixMode GL_PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 45.0 (*/ Width 1.0 Height) 0.1 100.0)
+ (gl:MatrixMode GL_MODELVIEW) )
+
+(mouseFunc (Btn State X Y)
+ (setq *LastX X *LastY Y) )
+
+(motionFunc (X Y)
+ (inc '*AngleX (* (- Y *LastY) 1.0))
+ (inc '*AngleY (* (- X *LastX) 1.0))
+ (setq *LastX X *LastY Y)
+ (glut:PostRedisplay) )
+
+(de myTimer (Val)
+ (inc '*FoldTime 0.2)
+ (glut:PostRedisplay)
+ (timerFunc 20 myTimer 0) )
+
+(timerFunc 20 myTimer 0)
+
+(glut:MainLoop)
diff --git a/simul/gl/stereo-view.l b/simul/gl/stereo-view.l
@@ -0,0 +1,142 @@
+# 03mar08jk
+# 21oct07abu
+
+# To get a stereoscopic view, you must either cross your eyes so
+# the left and right scenes blend into one. This may take a little
+# training. Alternatively, you can use some optical stereo viewer,
+# but then you'll have to negate EyeAngle to swap the left and right
+# scenes on the screen.
+
+(load "@simul/gl/lib.l")
+
+(setq *WinWidth 1024 *WinHeight 720)
+(setq *AngleX 0.0 *AngleY 0.0)
+(setq *LastX 0 *LastY 0)
+(setq *EyeAngle 2.0) # positive for x-eye, negative for viewer
+(setq *CameraDist -11.0)
+(setq *ObjectRotation 0.0)
+
+(de setViewPerspective (Width Height)
+ #(println "setViewPerspective" Width Height)
+ (gl:MatrixMode GL_PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 45.0 (*/ Width 1.0 Height) 0.1 100.0)
+ (gl:MatrixMode GL_MODELVIEW) )
+
+(de initGL (Width Height)
+ # Set the OpenGL attributes to use with gl:Clear ...
+ (gl:ClearColor 0.6 0.8 0.9 0) # the background color
+ (gl:ClearDepth 1.0)
+
+ # Set up the depth buffer ...
+ (gl:DepthFunc GL_LESS)
+ (gl:Enable GL_DEPTH_TEST)
+
+ # Set up antialiasing ...
+
+ # Enable blending ...
+ (gl:Enable GL_BLEND)
+ (gl:BlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
+ (gl:Enable GL_LINE_SMOOTH)
+
+ # Enable materials and the default OpenGL light ...
+ (gl:Enable GL_COLOR_MATERIAL)
+
+ (gl:Enable GL_LIGHTING)
+ (gl:Enable GL_LIGHT0)
+
+ (setViewPerspective Width Height) )
+
+(de drawView (X Y W H ViewAngle)
+ #(println "drawView" X Y W H ViewAngle)
+ (gl:Viewport X Y W H)
+ (setViewPerspective W H)
+
+ (gl:LoadIdentity)
+ (gl:Translatef 0.0 0.0 *CameraDist)
+ (gl:Rotatef (+ *AngleY ViewAngle) 0 1 0)
+ (gl:Rotatef *AngleX 1 0 0)
+
+ # Brown teapot in front
+ (gl:PushMatrix)
+ (gl:Translatef 0.0 -0.6 1.6)
+ (gl:Rotatef (- *ObjectRotation) 0 1 0)
+ (gl:Color3f 0.8 0.2 0.0)
+ (glut:SolidTeapot 1.5)
+ (gl:PopMatrix)
+
+ # Green teapot behind
+ (gl:PushMatrix)
+ (gl:Translatef -0.8 0.8 -1.6)
+ (gl:Rotatef *ObjectRotation 1 0 0)
+ (gl:Color3f 0.2 0.6 0.0)
+ (glut:SolidTeapot 1.5)
+ (gl:PopMatrix)
+)
+
+(de myMouse (Btn State X Y)
+ #(println "myMouse" Btn State X Y)
+ (setq *LastX X *LastY Y) )
+
+(de myMotion (X Y)
+ #(println "myMotion" X Y)
+ (inc '*AngleX (* (- Y *LastY) 1.0))
+ (inc '*AngleY (* (- X *LastX) 1.0))
+ (setq *LastX X *LastY Y)
+ (glut:PostRedisplay) )
+
+(de myReshape (Width Height)
+ #(println "myReshape" Width Height)
+ (setq *WinWidth Width *WinHeight Height)
+ # Reset the current viewport and perspective transformation
+ (gl:Viewport 0 0 Width Height)
+ (setViewPerspective Width Height) )
+
+(de mySpecial (Key X Y)
+ #(println "mySpecial" Key X Y)
+ (cond
+ ((= Key GLUT_KEY_UP) (inc '*CameraDist -1.0))
+ ((= Key GLUT_KEY_DOWN) (inc '*CameraDist 1.0))
+ ((= Key GLUT_KEY_LEFT) (inc '*EyeAngle -2.0) (println "*EyeAngle" *EyeAngle))
+ ((= Key GLUT_KEY_RIGHT) (inc '*EyeAngle 2.0) (println "*EyeAngle" *EyeAngle)) ) )
+
+(de myTimer (Val)
+ #(println "myTimer")
+ (inc '*ObjectRotation 1.0)
+ (glut:PostRedisplay)
+ (timerFunc 500 myTimer 0) )
+
+(glut:Init)
+# Set display mode: RGBA color, Double buffer, Alpha support, Depth buffer
+(glut:InitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_ALPHA GLUT_DEPTH))
+(glut:InitWindowSize *WinWidth *WinHeight)
+(glut:InitWindowPosition 10 50)
+(glut:CreateWindow "Stereo View")
+
+(initGL *WinWidth *WinHeight)
+
+
+(displayFunc ()
+ #(println "myDisplay")
+ (gl:Clear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+ (drawView 0 0 (/ *WinWidth 2) *WinHeight (- *EyeAngle))
+ (drawView (/ *WinWidth 2) 0 (/ *WinWidth 2) *WinHeight *EyeAngle)
+ (gl:Flush)
+ # Since this is double buffered, swap the buffers to display what just got drawn.
+ (glut:SwapBuffers) )
+
+(mouseFunc (Btn State X Y)
+ (myMouse Btn State X Y) )
+
+(motionFunc (X Y)
+ (myMotion X Y) )
+
+(reshapeFunc (Width Height)
+ (myReshape Width Height) )
+
+(specialFunc (Key X Y)
+ (mySpecial Key X Y) )
+
+(timerFunc 500 myTimer 0)
+
+(glut:MainLoop)
diff --git a/simul/gl/tst.l b/simul/gl/tst.l
@@ -0,0 +1,29 @@
+# 21oct07abu
+# (c) Software Lab. Alexander Burger
+
+(load "@simul/gl/lib.l")
+
+(glut:Init)
+(glut:InitDisplayMode (| GLUT_SINGLE GLUT_RGB))
+(glut:InitWindowSize 250 250)
+(glut:CreateWindow "Test Window")
+
+(gl:ClearColor 0.0 0.0 0.0 0.0)
+(gl:MatrixMode GL_PROJECTION)
+(gl:LoadIdentity)
+(gl:Ortho 0.0 1.0 0.0 1.0 -1.0 1.0)
+
+(displayFunc ()
+ (gl:Clear GL_COLOR_BUFFER_BIT)
+ (gl:Color3f 1.0 1.0 1.0)
+ (gl:Begin GL_POLYGON)
+ (gl:Vertex3f 0.25 0.25 0.0)
+ (gl:Vertex3f 0.75 0.25 0.0)
+ (gl:Vertex3f 0.75 0.75 0.0)
+ (gl:Vertex3f 0.25 0.75 0.0)
+ (gl:End)
+ (gl:Flush) )
+
+(glut:MainLoop)
+
+# vi:et:ts=3:sw=3
diff --git a/simul/lib.l b/simul/lib.l
@@ -0,0 +1,90 @@
+# 15dec04abu
+# (c) Software Lab. Alexander Burger
+
+(setq *Scl 6) # Keep in sync with `SCL' in "src/z3d.c"
+
+(load "lib/simul.l")
+(load "simul/rgb.l")
+
+# Unity Matrix
+(setq
+ *UMat (1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)
+ PI 3.1415927
+ PI/2 1.5707963 )
+
+# Mirror in y-direction
+(de y-mirror (Lst)
+ (make
+ (while (sym? (car Lst))
+ (link (pop 'Lst)) )
+ (link
+ (pop 'Lst) # pos-x
+ (- (pop 'Lst)) # pos-y
+ (pop 'Lst) ) # pos-z
+ (for L Lst
+ (link
+ (if (sym? (car L))
+ (y-mirror L)
+ (make
+ (link (cadr L) (car L))
+ (when (sym? (car (setq L (cddr L))))
+ (link (pop 'L)) )
+ (while L
+ (link (pop 'L) (- (pop 'L)) (pop 'L)) ) ) ) ) ) ) )
+
+# Create model
+(de model (Obj Lst)
+ (let X Obj
+ (while (sym? (cadr Lst))
+ (setq X (get X (pop 'Lst))) )
+ (unless X
+ (quit "Can't attach (sub)model" (car Lst)) )
+ (prog1
+ (put X (pop 'Lst) (new (ext? Obj)))
+ (set @
+ (make
+ (link (pop 'Lst) (pop 'Lst) (pop 'Lst))
+ (mapc link *UMat)
+ (for M Lst
+ (link
+ (if (and (car M) (sym? (car M)))
+ (model Obj M)
+ M ) ) ) ) ) ) ) )
+
+# Duplicate position and orientation
+(de placement (Sym)
+ (prog1
+ (new (ext? Sym))
+ (set @
+ (conc
+ (head 12 (val Sym))
+ (mapcan
+ '((X)
+ (and
+ (sym? X)
+ (list (placement X)) ) )
+ (nth (val Sym) 13) ) ) ) ) )
+
+# Reset orientation
+(de straight (M)
+ (touch M)
+ (map
+ '((V L) (set L (car V)))
+ *UMat
+ (cdddr (val M)) ) )
+
+# Movements
+(de z3d:dx (X M)
+ (touch M)
+ (set (val M)
+ (+ X (car (val M))) ) )
+
+(de z3d:dy (Y M)
+ (touch M)
+ (set (cdr (val M))
+ (+ Y (cadr (val M))) ) )
+
+(de z3d:dz (Z M)
+ (touch M)
+ (set (cddr (val M))
+ (+ Z (caddr (val M))) ) )
diff --git a/simul/rgb.l b/simul/rgb.l
@@ -0,0 +1,29 @@
+# 02sep99abu
+# (c) Software Lab. Alexander Burger
+
+(de rgb (R G B . S)
+ (def S (+ B (* G 256) (* R 65536))) )
+
+# Color Constant Definitions from "/usr/lib/X11/rgb.txt"
+(rgb 0 0 0 . Black)
+(rgb 0 0 255 . Blue)
+(rgb 165 42 42 . Brown)
+(rgb 0 100 0 . DarkGreen)
+(rgb 169 169 169 . DarkGrey)
+(rgb 190 190 190 . Grey)
+(rgb 173 216 230 . LightBlue)
+(rgb 211 211 211 . LightGrey)
+(rgb 255 0 0 . Red)
+(rgb 46 139 87 . SeaGreen)
+(rgb 255 255 0 . Yellow)
+
+(rgb 255 193 193 . RosyBrown1)
+(rgb 238 180 180 . RosyBrown2)
+(rgb 205 155 155 . RosyBrown3)
+(rgb 139 105 105 . RosyBrown4)
+
+(rgb 221 160 221 . Plum)
+(rgb 135 206 250 . LightSkyBlue)
+(rgb 245 222 179 . Wheat)
+(rgb 255 255 255 . White)
+(rgb 139 0 0 . DarkRed)
diff --git a/src/Makefile b/src/Makefile
@@ -0,0 +1,33 @@
+# 25jun07abu
+# (c) Software Lab. Alexander Burger
+
+.SILENT:
+
+bin = ../bin
+picoFiles = main.c gc.c apply.c flow.c sym.c subr.c math.c io.c tab.c mod/buddy.ffi.c mod/queens.c mod/queens.ffi.c mod/gl.ffi.c mod/glu.ffi.c mod/glut.ffi.c mod/glut.c mod/gtk.ffi.c mod/gmpx.c mod/gmp.ffi.c
+
+CFLAGS = -I~/sw/buddy-2.4/src `pkg-config --cflags libglade-2.0`
+LDFLAGS = -L~/sw/buddy-2.4/src/.libs -lbdd -lglut `pkg-config --libs libglade-2.0` -lgmp
+
+picolisp: $(bin)/picolisp
+
+.c.o:
+ echo $*.c:
+ gcc -c -O -falign-functions -fomit-frame-pointer \
+ -W -Wimplicit -Wreturn-type -Wunused -Wformat \
+ -Wuninitialized -Wstrict-prototypes \
+ -pipe -D_GNU_SOURCE $(CFLAGS) -o $*.o $*.c
+
+$(picoFiles:.c=.o): pico.h
+
+$(bin)/picolisp: $(picoFiles:.c=.o)
+ mkdir -p $(bin)
+ echo " " link picolisp:
+ gcc -o $(bin)/picolisp $(picoFiles:.c=.o) -lc -lm $(LDFLAGS)
+ strip $(bin)/picolisp
+
+# Clean up
+clean:
+ rm -f *.o mod/*.o
+
+# vi:noet:ts=4:sw=4
diff --git a/src/apply.c b/src/apply.c
@@ -0,0 +1,629 @@
+/* 10dec07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+any apply(any ex, any foo, bool cf, int n, cell *p) {
+ while (!isNum(foo)) {
+ if (isCell(foo)) {
+ int i;
+ any x = car(foo);
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(x)+2];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = 0;
+ f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
+ while (isCell(x)) {
+ f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+ val(f.bnd[f.cnt].sym) = --n<0? Nil : cf? car(data(p[f.cnt-1])) : data(p[f.cnt-1]);
+ ++f.cnt, x = cdr(x);
+ }
+ if (isNil(x))
+ x = prog(cdr(foo));
+ else if (x != At) {
+ f.bnd[f.cnt].sym = x, f.bnd[f.cnt++].val = val(x), val(x) = Nil;
+ x = prog(cdr(foo));
+ }
+ else {
+ int cnt = n;
+ int next = Env.next;
+ cell *arg = Env.arg;
+ cell c[Env.next = n];
+
+ Env.arg = c;
+ for (i = f.cnt-1; --n >= 0; ++i)
+ Push(c[n], cf? car(data(p[i])) : data(p[i]));
+ x = prog(cdr(foo));
+ if (cnt)
+ drop(c[cnt-1]);
+ Env.arg = arg, Env.next = next;
+ }
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ return x;
+ }
+ if (val(foo) == val(Meth)) {
+ any expr, o, x;
+
+ o = cf? car(data(p[0])) : data(p[0]);
+ NeedSymb(ex,o);
+ TheKey = foo, TheCls = Nil;
+ if (expr = method(o)) {
+ int i;
+ methFrame m;
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(x = car(expr))+3];
+ } f;
+
+ m.link = Env.meth;
+ m.key = TheKey;
+ m.cls = TheCls;
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = 0;
+ f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
+ --n, ++p;
+ while (isCell(x)) {
+ f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+ val(f.bnd[f.cnt].sym) = --n<0? Nil : cf? car(data(p[f.cnt-1])) : data(p[f.cnt-1]);
+ ++f.cnt, x = cdr(x);
+ }
+ if (isNil(x)) {
+ f.bnd[f.cnt].sym = This;
+ f.bnd[f.cnt++].val = val(This);
+ val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ }
+ else if (x != At) {
+ f.bnd[f.cnt].sym = x, f.bnd[f.cnt++].val = val(x), val(x) = Nil;
+ f.bnd[f.cnt].sym = This;
+ f.bnd[f.cnt++].val = val(This);
+ val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ }
+ else {
+ int cnt = n;
+ int next = Env.next;
+ cell *arg = Env.arg;
+ cell c[Env.next = n];
+
+ Env.arg = c;
+ for (i = f.cnt-1; --n >= 0; ++i)
+ Push(c[n], cf? car(data(p[i])) : data(p[i]));
+ f.bnd[f.cnt].sym = This;
+ f.bnd[f.cnt++].val = val(This);
+ val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ if (cnt)
+ drop(c[cnt-1]);
+ Env.arg = arg, Env.next = next;
+ }
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ Env.meth = Env.meth->link;
+ return x;
+ }
+ err(ex, o, "Bad object");
+ }
+ if (isNil(val(foo)) || foo == val(foo))
+ undefined(foo,ex);
+ foo = val(foo);
+ }
+ if (--n < 0)
+ cdr(ApplyBody) = Nil;
+ else {
+ any x = ApplyArgs;
+ val(caar(x)) = cf? car(data(p[n])) : data(p[n]);
+ while (--n >= 0) {
+ if (!isCell(cdr(x)))
+ cdr(x) = cons(cons(consSym(Nil,0), car(x)), Nil);
+ x = cdr(x);
+ val(caar(x)) = cf? car(data(p[n])) : data(p[n]);
+ }
+ cdr(ApplyBody) = car(x);
+ }
+ return evSubr(foo, ApplyBody);
+}
+
+// (apply 'fun 'lst ['any ..]) -> any
+any doApply(any ex) {
+ any x, y;
+ int i, n;
+ cell foo;
+
+ x = cdr(ex), Push(foo, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ {
+ cell c[(n = length(cdr(x))) + length(y)];
+
+ while (isCell(y))
+ Push(c[n], car(y)), y = cdr(y), ++n;
+ for (i = 0; isCell(x = cdr(x)); ++i)
+ Push(c[i], EVAL(car(x)));
+ x = apply(ex, data(foo), NO, n, c);
+ }
+ drop(foo);
+ return x;
+}
+
+// (pass 'fun ['any ..]) -> any
+any doPass(any ex) {
+ any x;
+ int n, i;
+ cell foo, c[length(cdr(x = cdr(ex))) + (Env.next>0? Env.next : 0)];
+
+ Push(foo, EVAL(car(x)));
+ for (n = 0; isCell(x = cdr(x)); ++n)
+ Push(c[n], EVAL(car(x)));
+ for (i = Env.next; --i >= 0; ++n)
+ Push(c[n], data(Env.arg[i]));
+ x = apply(ex, data(foo), NO, n, c);
+ drop(foo);
+ return x;
+}
+
+// (maps 'fun 'sym ['lst ..]) -> any
+any doMaps(any ex) {
+ any x, y;
+ int i, n;
+ cell foo, sym, val, c[length(cdr(x = cdr(ex)))];
+
+ Push(foo, EVAL(car(x)));
+ x = cdr(x), Push(sym, EVAL(car(x)));
+ NeedSymb(ex, data(sym));
+ for (n = 1; isCell(x = cdr(x)); ++n)
+ Push(c[n], EVAL(car(x)));
+ data(c[0]) = &val;
+ for (y = tail(data(sym)); isCell(y); y = car(y)) {
+ data(val) = cdr(y);
+ x = apply(ex, data(foo), YES, n, c);
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ drop(foo);
+ return x;
+}
+
+// (map 'fun 'lst ..) -> lst
+any doMap(any ex) {
+ any x = cdr(ex);
+ cell foo;
+
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ x = apply(ex, data(foo), NO, n, c);
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return x;
+}
+
+// (mapc 'fun 'lst ..) -> any
+any doMapc(any ex) {
+ any x = cdr(ex);
+ cell foo;
+
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ x = apply(ex, data(foo), YES, n, c);
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return x;
+}
+
+// (maplist 'fun 'lst ..) -> lst
+any doMaplist(any ex) {
+ any x = cdr(ex);
+ cell res, foo;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ data(res) = x = cons(apply(ex, data(foo), NO, n, c), Nil);
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ cdr(x) = cons(apply(ex, data(foo), NO, n, c), Nil);
+ x = cdr(x);
+ }
+ }
+ return Pop(res);
+}
+
+// (mapcar 'fun 'lst ..) -> lst
+any doMapcar(any ex) {
+ any x = cdr(ex);
+ cell res, foo;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ data(res) = x = cons(apply(ex, data(foo), YES, n, c), Nil);
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ cdr(x) = cons(apply(ex, data(foo), YES, n, c), Nil);
+ x = cdr(x);
+ }
+ }
+ return Pop(res);
+}
+
+// (mapcon 'fun 'lst ..) -> lst
+any doMapcon(any ex) {
+ any x = cdr(ex);
+ cell res, foo;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ while (!isCell(x = apply(ex, data(foo), NO, n, c))) {
+ if (!isCell(data(c[0]) = cdr(data(c[0]))))
+ return Pop(res);
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ data(res) = x;
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ while (isCell(cdr(x)))
+ x = cdr(x);
+ cdr(x) = apply(ex, data(foo), NO, n, c);
+ }
+ }
+ return Pop(res);
+}
+
+// (mapcan 'fun 'lst ..) -> lst
+any doMapcan(any ex) {
+ any x = cdr(ex);
+ cell res, foo;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ while (!isCell(x = apply(ex, data(foo), YES, n, c))) {
+ if (!isCell(data(c[0]) = cdr(data(c[0]))))
+ return Pop(res);
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ data(res) = x;
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ while (isCell(cdr(x)))
+ x = cdr(x);
+ cdr(x) = apply(ex, data(foo), YES, n, c);
+ }
+ }
+ return Pop(res);
+}
+
+// (filter 'fun 'lst ..) -> lst
+any doFilter(any ex) {
+ any x = cdr(ex);
+ cell res, foo;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ while (isNil(apply(ex, data(foo), YES, n, c))) {
+ if (!isCell(data(c[0]) = cdr(data(c[0]))))
+ return Pop(res);
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ data(res) = x = cons(car(data(c[0])), Nil);
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ if (!isNil(apply(ex, data(foo), YES, n, c)))
+ x = cdr(x) = cons(car(data(c[0])), Nil);
+ }
+ }
+ return Pop(res);
+}
+
+// (seek 'fun 'lst ..) -> lst
+any doSeek(any ex) {
+ any x = cdr(ex);
+ cell foo;
+
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (!isNil(apply(ex, data(foo), NO, n, c))) {
+ drop(foo);
+ return data(c[0]);
+ }
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return Nil;
+}
+
+// (find 'fun 'lst ..) -> any
+any doFind(any ex) {
+ any x = cdr(ex);
+ cell foo;
+
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (!isNil(apply(ex, data(foo), YES, n, c))) {
+ drop(foo);
+ return car(data(c[0]));
+ }
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return Nil;
+}
+
+// (pick 'fun 'lst ..) -> any
+any doPick(any ex) {
+ any x = cdr(ex);
+ cell foo;
+
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (!isNil(x = apply(ex, data(foo), YES, n, c))) {
+ drop(foo);
+ return x;
+ }
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return Nil;
+}
+
+// (cnt 'fun 'lst ..) -> num
+any doCnt(any ex) {
+ any x = cdr(ex);
+ int res;
+ cell foo;
+
+ res = 0;
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (!isNil(apply(ex, data(foo), YES, n, c)))
+ ++res;
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return box(res);
+}
+
+// (sum 'fun 'lst ..) -> num
+any doSum(any ex) {
+ any x = cdr(ex);
+ int res;
+ cell foo;
+
+ res = 0;
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (isNum(x = apply(ex, data(foo), YES, n, c)))
+ res += unBox(x);
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ drop(foo);
+ return box(res);
+}
+
+// (maxi 'fun 'lst ..) -> any
+any doMaxi(any ex) {
+ any x = cdr(ex);
+ cell res, val, foo;
+
+ Push(res, Nil);
+ Push(val, Nil);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (compare(x = apply(ex, data(foo), YES, n, c), data(val)) > 0)
+ data(res) = car(data(c[0])), data(val) = x;
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ return Pop(res);
+}
+
+// (mini 'fun 'lst ..) -> any
+any doMini(any ex) {
+ any x = cdr(ex);
+ cell res, val, foo;
+
+ Push(res, Nil);
+ Push(val, T);
+ Push(foo, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ while (isCell(data(c[0]))) {
+ if (compare(x = apply(ex, data(foo), YES, n, c), data(val)) < 0)
+ data(res) = car(data(c[0])), data(val) = x;
+ for (i = 0; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ }
+ }
+ return Pop(res);
+}
+
+static void fish(any ex, any foo, any x, cell *r) {
+ if (!isNil(apply(ex, foo, NO, 1, (cell*)&x)))
+ data(*r) = cons(x, data(*r));
+ else if (isCell(x)) {
+ if (!isNil(cdr(x)))
+ fish(ex, foo, cdr(x), r);
+ fish(ex, foo, car(x), r);
+ }
+}
+
+// (fish 'fun 'any) -> lst
+any doFish(any ex) {
+ any x = cdr(ex);
+ cell res, foo, c1;
+
+ Push(res, Nil);
+ Push(foo, EVAL(car(x)));
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ fish(ex, data(foo), data(c1), &res);
+ return Pop(res);
+}
+
+// (by 'fun1 'fun2 'lst ..) -> lst
+any doBy(any ex) {
+ any x = cdr(ex);
+ cell res, foo1, foo2;
+
+ Push(res, Nil);
+ Push(foo1, EVAL(car(x))), x = cdr(x), Push(foo2, EVAL(car(x)));
+ if (isCell(x = cdr(x))) {
+ int i, n = 0;
+ cell c[length(x)];
+
+ do
+ Push(c[n], EVAL(car(x))), ++n;
+ while (isCell(x = cdr(x)));
+ if (!isCell(data(c[0])))
+ return Pop(res);
+ data(res) = x = cons(cons(apply(ex, data(foo1), YES, n, c), car(data(c[0]))), Nil);
+ while (isCell(data(c[0]) = cdr(data(c[0])))) {
+ for (i = 1; i < n; ++i)
+ data(c[i]) = cdr(data(c[i]));
+ cdr(x) = cons(cons(apply(ex, data(foo1), YES, n, c), car(data(c[0]))), Nil);
+ x = cdr(x);
+ }
+ data(res) = apply(ex, data(foo2), NO, 1, &res);
+ for (x = data(res); isCell(x); x = cdr(x))
+ car(x) = cdar(x);
+ }
+ return Pop(res);
+}
diff --git a/src/flow.c b/src/flow.c
@@ -0,0 +1,1374 @@
+/* 30oct07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static void redefMsg(any x, any y) {
+ FILE *oSave = OutFile;
+
+ OutFile = stderr;
+ outString("# ");
+ print(x);
+ if (y)
+ space(), print(y);
+ outString(" redefined\n");
+ OutFile = oSave;
+}
+
+static void redefine(any ex, any s, any x) {
+ NeedSymb(ex,s);
+ CheckVar(ex,s);
+ if (!isNil(val(s)) && s != val(s) && !equal(x,val(s)))
+ redefMsg(s,NULL);
+ val(s) = x;
+}
+
+// (quote . any) -> any
+any doQuote(any x) {return cdr(x);}
+
+// (as 'any1 . any2) -> any2 | NIL
+any doAs(any x) {
+ x = cdr(x);
+ if (isNil(EVAL(car(x))))
+ return Nil;
+ return cdr(x);
+}
+
+// (lit 'any) -> any
+any doLit(any x) {
+ x = cadr(x);
+ if (isNum(x = EVAL(x)) || isSym(x) && x==val(x) || isCell(x) && isNum(car(x)))
+ return x;
+ return cons(Quote, x);
+}
+
+// (eval 'any ['cnt]) -> any
+any doEval(any x) {
+ cell c1;
+ bindFrame *p;
+
+ x = cdr(x), Push(c1, EVAL(car(x))), x = cdr(x);
+ if (!isNum(x = EVAL(car(x))) || !(p = Env.bind))
+ data(c1) = EVAL(data(c1));
+ else {
+ int cnt, n, i;
+ bindFrame *q;
+
+ for (cnt = (int)unBox(x), n = 0;;) {
+ ++n;
+ if (p->i <= 0) {
+ if (p->i-- == 0) {
+ for (i = 0; i < p->cnt; ++i) {
+ x = val(p->bnd[i].sym);
+ val(p->bnd[i].sym) = p->bnd[i].val;
+ p->bnd[i].val = x;
+ }
+ if (p->cnt && p->bnd[0].sym == At && !--cnt)
+ break;
+ }
+ }
+ if (!(q = Env.bind->link))
+ break;
+ Env.bind->link = q->link, q->link = p, p = q;
+ }
+ Env.bind = p;
+ data(c1) = EVAL(data(c1));
+ for (;;) {
+ if (p->i < 0) {
+ if (++p->i == 0)
+ for (i = p->cnt; --i >= 0;) {
+ x = val(p->bnd[i].sym);
+ val(p->bnd[i].sym) = p->bnd[i].val;
+ p->bnd[i].val = x;
+ }
+ }
+ if (!--n)
+ break;
+ q = Env.bind->link, Env.bind->link = q->link, q->link = p, p = q;
+ }
+ Env.bind = p;
+ }
+ return Pop(c1);
+}
+
+// (run 'any ['cnt]) -> any
+any doRun(any x) {
+ cell c1;
+ bindFrame *p;
+
+ x = cdr(x), data(c1) = EVAL(car(x)), x = cdr(x);
+ if (!isNum(data(c1))) {
+ Save(c1);
+ if (!isNum(x = EVAL(car(x))) || !(p = Env.bind))
+ data(c1) = isSym(data(c1))? val(data(c1)) : run(data(c1));
+ else {
+ int cnt, n, i;
+ bindFrame *q;
+
+ for (cnt = (int)unBox(x), n = 0;;) {
+ ++n;
+ if (p->i <= 0) {
+ if (p->i-- == 0) {
+ for (i = 0; i < p->cnt; ++i) {
+ x = val(p->bnd[i].sym);
+ val(p->bnd[i].sym) = p->bnd[i].val;
+ p->bnd[i].val = x;
+ }
+ if (p->cnt && p->bnd[0].sym==At && !--cnt)
+ break;
+ }
+ }
+ if (!(q = Env.bind->link))
+ break;
+ Env.bind->link = q->link, q->link = p, p = q;
+ }
+ Env.bind = p;
+ data(c1) = isSym(data(c1))? val(data(c1)) : prog(data(c1));
+ for (;;) {
+ if (p->i < 0) {
+ if (++p->i == 0)
+ for (i = p->cnt; --i >= 0;) {
+ x = val(p->bnd[i].sym);
+ val(p->bnd[i].sym) = p->bnd[i].val;
+ p->bnd[i].val = x;
+ }
+ }
+ if (!--n)
+ break;
+ q = Env.bind->link, Env.bind->link = q->link, q->link = p, p = q;
+ }
+ Env.bind = p;
+ }
+ drop(c1);
+ }
+ return data(c1);
+}
+
+// (def 'sym 'any) -> sym
+// (def 'sym 'sym 'any) -> sym
+any doDef(any ex) {
+ any x, y;
+ cell c1, c2, c3;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedSymb(ex,data(c1));
+ CheckVar(ex,data(c1));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ if (!isCell(cdr(x))) {
+ if (!equal(data(c2), y = val(data(c1)))) {
+ if (!isNil(y) && data(c1) != y)
+ redefMsg(data(c1),NULL);
+ val(data(c1)) = data(c2);
+ }
+ }
+ else {
+ x = cdr(x), Push(c3, EVAL(car(x)));
+ if (!equal(data(c3), y = get(data(c1), data(c2)))) {
+ if (!isNil(y))
+ redefMsg(data(c1), data(c2));
+ put(data(c1), data(c2), data(c3));
+ }
+ }
+ return Pop(c1);
+}
+
+// (de sym . any) -> sym
+any doDe(any ex) {
+ redefine(ex, cadr(ex), cddr(ex));
+ return cadr(ex);
+}
+
+// (dm sym . fun) -> sym
+// (dm (sym . cls) . fun) -> sym
+// (dm (sym sym [. cls]) . fun) -> sym
+any doDm(any ex) {
+ any x, y, msg, cls;
+
+ x = cdr(ex);
+ if (!isCell(car(x)))
+ msg = car(x), cls = val(Class);
+ else {
+ msg = caar(x);
+ cls = !isCell(cdar(x))? cdar(x) :
+ get(isNil(cddar(x))? val(Class) : cddar(x), cadar(x));
+ }
+ if (msg != T)
+ redefine(ex, msg, val(Meth));
+ if (isSymb(cdr(x))) {
+ y = val(cdr(x));
+ for (;;) {
+ if (!isCell(y) || !isCell(car(y)))
+ err(ex, msg, "Bad message");
+ if (caar(y) == msg) {
+ x = car(y);
+ break;
+ }
+ y = cdr(y);
+ }
+ }
+ for (y = val(cls); isCell(y) && isCell(car(y)); y = cdr(y))
+ if (caar(y) == msg) {
+ if (!equal(cdr(x), cdar(y)))
+ redefMsg(msg,cls);
+ cdar(y) = cdr(x);
+ return msg;
+ }
+ if (!isCell(car(x)))
+ val(cls) = cons(x, val(cls));
+ else
+ val(cls) = cons(cons(caar(x), cdr(x)), val(cls));
+ return msg;
+}
+
+/* Evaluate method invocation */
+static any evMethod(any o, any expr, any x) {
+ any y = car(expr);
+ methFrame m;
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(y)+3];
+ } f;
+
+ m.link = Env.meth;
+ m.key = TheKey;
+ m.cls = TheCls;
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2;
+ f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
+ while (isCell(y)) {
+ f.bnd[f.cnt].sym = car(y);
+ f.bnd[f.cnt].val = EVAL(car(x));
+ ++f.cnt, x = cdr(x), y = cdr(y);
+ }
+ if (isNil(y)) {
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ f.bnd[f.cnt].sym = This;
+ f.bnd[f.cnt++].val = val(This);
+ val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ }
+ else if (y != At) {
+ f.bnd[f.cnt].sym = y, f.bnd[f.cnt++].val = val(y), val(y) = x;
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ }
+ else {
+ int n, cnt;
+ cell *arg;
+ cell c[n = cnt = length(x)];
+
+ while (--n >= 0)
+ Push(c[n], EVAL(car(x))), x = cdr(x);
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ n = Env.next, Env.next = cnt;
+ arg = Env.arg, Env.arg = c;
+ f.bnd[f.cnt].sym = This;
+ f.bnd[f.cnt++].val = val(This);
+ val(This) = o;
+ Env.meth = &m;
+ x = prog(cdr(expr));
+ if (cnt)
+ drop(c[cnt-1]);
+ Env.arg = arg, Env.next = n;
+ }
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ Env.meth = Env.meth->link;
+ return x;
+}
+
+any method(any x) {
+ any y, z;
+
+ if (isCell(y = val(x))) {
+ if (isCell(car(y))) {
+ if (caar(y) == TheKey)
+ return cdar(y);
+ for (;;) {
+ z = y;
+ if (!isCell(y = cdr(y)))
+ return NULL;
+ if (!isCell(car(y)))
+ break;
+ if (caar(y) == TheKey) {
+ cdr(z) = cdr(y), cdr(y) = val(x), val(x) = y;
+ return cdar(y);
+ }
+ }
+ }
+ do
+ if (x = method(car(TheCls = y)))
+ return x;
+ while (isCell(y = cdr(y)));
+ }
+ return NULL;
+}
+
+// (box 'any) -> sym
+any doBox(any x) {
+ x = cdr(x);
+ return consSym(EVAL(car(x)),0);
+}
+
+// (new ['typ ['any ..]]) -> obj
+any doNew(any ex) {
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex);
+ Push(c1, consSym(EVAL(car(x)),0));
+ TheKey = T, TheCls = Nil;
+ if (y = method(data(c1)))
+ evMethod(data(c1), y, cdr(x));
+ else {
+ Save(c2);
+ while (isCell(x = cdr(x))) {
+ data(c2) = EVAL(car(x)), x = cdr(x);
+ put(data(c1), data(c2), EVAL(car(x)));
+ }
+ }
+ return Pop(c1);
+}
+
+// (type 'any) -> lst
+any doType(any ex) {
+ any x, y, z;
+
+ x = cdr(ex), x = EVAL(car(x));
+ if (isSymb(x)) {
+ z = x = val(x);
+ while (isCell(x)) {
+ if (!isCell(car(x))) {
+ y = x;
+ while (isSymb(car(x))) {
+ if (!isCell(x = cdr(x)))
+ return isNil(x)? y : Nil;
+ if (z == x)
+ return Nil;
+ }
+ return Nil;
+ }
+ if (z == (x = cdr(x)))
+ return Nil;
+ }
+ }
+ return Nil;
+}
+
+static bool isa(any ex, any cls, any x) {
+ any z;
+
+ z = x = val(x);
+ while (isCell(x)) {
+ if (!isCell(car(x))) {
+ while (isSymb(car(x))) {
+ if (cls == car(x) || isa(ex, cls, car(x)))
+ return YES;
+ if (!isCell(x = cdr(x)) || z == x)
+ return NO;
+ }
+ return NO;
+ }
+ if (z == (x = cdr(x)))
+ return NO;
+ }
+ return NO;
+}
+
+// (isa 'cls|typ 'any) -> obj | NIL
+any doIsa(any ex) {
+ any x;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), x = EVAL(car(x));
+ drop(c1);
+ if (isSymb(x)) {
+ if (isSymb(data(c1)))
+ return isa(ex, data(c1), x)? x : Nil;
+ while (isCell(data(c1))) {
+ if (!isa(ex, car(data(c1)), x))
+ return Nil;
+ data(c1) = cdr(data(c1));
+ }
+ return x;
+ }
+ return Nil;
+}
+
+// (method 'msg 'obj) -> fun
+any doMethod(any ex) {
+ any x, y;
+
+ x = cdr(ex), y = EVAL(car(x));
+ x = cdr(x), x = EVAL(car(x));
+ TheKey = y;
+ return method(x)? : Nil;
+}
+
+// (meth 'obj ..) -> any
+any doMeth(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedSymb(ex,data(c1));
+ for (TheKey = car(ex); ; TheKey = val(TheKey)) {
+ if (!isSymb(TheKey))
+ err(ex, car(ex), "Bad message");
+ if (isNum(val(TheKey))) {
+ TheCls = Nil;
+ if (y = method(data(c1))) {
+ x = evMethod(data(c1), y, cdr(x));
+ drop(c1);
+ return x;
+ }
+ err(ex, TheKey, "Bad message");
+ }
+ }
+}
+
+// (send 'msg 'obj ['any ..]) -> any
+any doSend(any ex) {
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedSymb(ex,data(c1));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ NeedSymb(ex,data(c2));
+ TheKey = data(c1), TheCls = Nil;
+ if (y = method(data(c2))) {
+ x = evMethod(data(c2), y, cdr(x));
+ drop(c1);
+ return x;
+ }
+ err(ex, TheKey, "Bad message");
+}
+
+// (try 'msg 'obj ['any ..]) -> any
+any doTry(any ex) {
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedSymb(ex,data(c1));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ if (isSymb(data(c2))) {
+ TheKey = data(c1), TheCls = Nil;
+ if (y = method(data(c2))) {
+ x = evMethod(data(c2), y, cdr(x));
+ drop(c1);
+ return x;
+ }
+ }
+ drop(c1);
+ return Nil;
+}
+
+// (super ['any ..]) -> any
+any doSuper(any ex) {
+ any x, y;
+ methFrame m;
+
+ m.key = TheKey = Env.meth->key;
+ x = val(isNil(Env.meth->cls)? val(This) : car(Env.meth->cls));
+ while (isCell(car(x)))
+ x = cdr(x);
+ while (isCell(x)) {
+ if (y = method(car(TheCls = x))) {
+ m.cls = TheCls;
+ m.link = Env.meth, Env.meth = &m;
+ x = evExpr(y, cdr(ex));
+ Env.meth = Env.meth->link;
+ return x;
+ }
+ x = cdr(x);
+ }
+ err(ex, TheKey, "Bad super");
+}
+
+static any extra(any x) {
+ any y;
+
+ for (x = val(x); isCell(car(x)); x = cdr(x));
+ while (isCell(x)) {
+ if (x == Env.meth->cls || !(y = extra(car(x)))) {
+ while (isCell(x = cdr(x)))
+ if (y = method(car(TheCls = x)))
+ return y;
+ return NULL;
+ }
+ if (y && y != Zero)
+ return y;
+ x = cdr(x);
+ }
+ return Zero;
+}
+
+// (extra ['any ..]) -> any
+any doExtra(any ex) {
+ any x, y;
+ methFrame m;
+
+ m.key = TheKey = Env.meth->key;
+ if ((y = extra(val(This))) && y != Zero) {
+ m.cls = TheCls;
+ m.link = Env.meth, Env.meth = &m;
+ x = evExpr(y, cdr(ex));
+ Env.meth = Env.meth->link;
+ return x;
+ }
+ err(ex, TheKey, "Bad extra");
+}
+
+// (with 'sym . prg) -> any
+any doWith(any ex) {
+ any x;
+ bindFrame f;
+
+ x = cdr(ex);
+ if (isNil(x = EVAL(car(x))))
+ return Nil;
+ NeedSymb(ex,x);
+ Bind(This,f), val(This) = x;
+ x = prog(cddr(ex));
+ Unbind(f);
+ return x;
+}
+
+// (bind 'sym|lst . prg) -> any
+any doBind(any ex) {
+ any x, y;
+
+ x = cdr(ex);
+ if (isNum(y = EVAL(car(x))))
+ argError(ex, y);
+ if (isNil(y))
+ return prog(cdr(x));
+ if (isSym(y)) {
+ bindFrame f;
+
+ Bind(y,f);
+ x = prog(cdr(x));
+ Unbind(f);
+ return x;
+ }
+ {
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(y)];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = f.cnt = 0;
+ while (isCell(y)) {
+ if (isNum(car(y)))
+ argError(ex, car(y));
+ if (isSym(car(y))) {
+ f.bnd[f.cnt].sym = car(y);
+ f.bnd[f.cnt].val = val(car(y));
+ }
+ else {
+ f.bnd[f.cnt].sym = caar(y);
+ f.bnd[f.cnt].val = val(caar(y));
+ val(caar(y)) = cdar(y);
+ }
+ ++f.cnt, y = cdr(y);
+ }
+ x = prog(cdr(x));
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ return x;
+ }
+}
+
+// (job 'lst . prg) -> any
+any doJob(any ex) {
+ any x = cdr(ex);
+ any y = EVAL(car(x));
+ any z;
+ cell c1;
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(y)];
+ } f;
+
+ Push(c1,y);
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = f.cnt = 0;
+ while (isCell(y)) {
+ f.bnd[f.cnt].sym = caar(y);
+ f.bnd[f.cnt].val = val(caar(y));
+ val(caar(y)) = cdar(y);
+ ++f.cnt, y = cdr(y);
+ }
+ z = prog(cdr(x));
+ for (f.cnt = 0, y = Pop(c1); isCell(y); ++f.cnt, y = cdr(y)) {
+ cdar(y) = val(caar(y));
+ val(caar(y)) = f.bnd[f.cnt].val;
+ }
+ Env.bind = f.link;
+ return z;
+}
+
+// (let sym 'any . prg) -> any
+// (let (sym 'any ..) . prg) -> any
+any doLet(any x) {
+ any y;
+
+ x = cdr(x);
+ if (!isCell(y = car(x))) {
+ bindFrame f;
+
+ x = cdr(x), Bind(y,f), val(y) = EVAL(car(x));
+ x = prog(cdr(x));
+ Unbind(f);
+ }
+ else {
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[(length(y)+1)/2];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = f.cnt = 0;
+ do {
+ f.bnd[f.cnt].sym = car(y);
+ f.bnd[f.cnt].val = val(car(y));
+ val(car(y)) = EVAL(cadr(y));
+ ++f.cnt;
+ } while (isCell(y = cddr(y)));
+ x = prog(cdr(x));
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ }
+ return x;
+}
+
+// (let? sym 'any . prg) -> any
+any doLetQ(any ex) {
+ any x, y, z;
+ bindFrame f;
+
+ x = cdr(ex), y = car(x), x = cdr(x);
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ Bind(y,f), val(y) = z;
+ x = prog(cdr(x));
+ Unbind(f);
+ return x;
+}
+
+// (use sym . prg) -> any
+// (use (sym ..) . prg) -> any
+any doUse(any x) {
+ any y;
+
+ x = cdr(x);
+ if (!isCell(y = car(x))) {
+ bindFrame f;
+
+ Bind(y,f);
+ x = prog(cdr(x));
+ Unbind(f);
+ }
+ else {
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(y)];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = f.cnt = 0;
+ do {
+ f.bnd[f.cnt].sym = car(y);
+ f.bnd[f.cnt].val = val(car(y));
+ ++f.cnt;
+ } while (isCell(y = cdr(y)));
+ x = prog(cdr(x));
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ }
+ return x;
+}
+
+// (and 'any ..) -> any
+any doAnd(any x) {
+ any a;
+
+ x = cdr(x);
+ do {
+ if (isNil(a = EVAL(car(x))))
+ return Nil;
+ val(At) = a;
+ }
+ while (isCell(x = cdr(x)));
+ return a;
+}
+
+// (or 'any ..) -> any
+any doOr(any x) {
+ any a;
+
+ x = cdr(x);
+ do
+ if (!isNil(a = EVAL(car(x))))
+ return val(At) = a;
+ while (isCell(x = cdr(x)));
+ return Nil;
+}
+
+// (nand 'any ..) -> flg
+any doNand(any x) {
+ any a;
+
+ x = cdr(x);
+ do {
+ if (isNil(a = EVAL(car(x))))
+ return T;
+ val(At) = a;
+ }
+ while (isCell(x = cdr(x)));
+ return Nil;
+}
+
+// (nor 'any ..) -> flg
+any doNor(any x) {
+ any a;
+
+ x = cdr(x);
+ do {
+ if (!isNil(a = EVAL(car(x)))) {
+ val(At) = a;
+ return Nil;
+ }
+ } while (isCell(x = cdr(x)));
+ return T;
+}
+
+// (xor 'any 'any) -> flg
+any doXor(any x) {
+ bool f;
+
+ x = cdr(x), f = isNil(EVAL(car(x))), x = cdr(x);
+ return f ^ isNil(EVAL(car(x)))? T : Nil;
+}
+
+// (bool 'any) -> flg
+any doBool(any x) {return isNil(EVAL(cadr(x)))? Nil : T;}
+
+// (not 'any) -> flg
+any doNot(any x) {return isNil(EVAL(cadr(x)))? T : Nil;}
+
+// (nil . prg) -> NIL
+any doNil(any x) {
+ while (isCell(x = cdr(x)))
+ if (isCell(car(x)))
+ evList(car(x));
+ return Nil;
+}
+
+// (t . prg) -> T
+any doT(any x) {
+ while (isCell(x = cdr(x)))
+ if (isCell(car(x)))
+ evList(car(x));
+ return T;
+}
+
+// (prog . prg) -> any
+any doProg(any x) {return prog(cdr(x));}
+
+// (prog1 'any1 . prg) -> any1
+any doProg1(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, val(At) = EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (isCell(car(x)))
+ evList(car(x));
+ return Pop(c1);
+}
+
+// (prog2 'any1 'any2 . prg) -> any2
+any doProg2(any x) {
+ cell c1;
+
+ x = cdr(x), EVAL(car(x));
+ x = cdr(x), Push(c1, val(At) = EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (isCell(car(x)))
+ evList(car(x));
+ return Pop(c1);
+}
+
+// (if 'any1 'any2 . prg) -> any
+any doIf(any x) {
+ any a;
+
+ x = cdr(x);
+ if (isNil(a = EVAL(car(x))))
+ return prog(cddr(x));
+ val(At) = a;
+ x = cdr(x);
+ return EVAL(car(x));
+}
+
+// (if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any
+any doIf2(any x) {
+ any a;
+
+ x = cdr(x);
+ if (isNil(a = EVAL(car(x)))) {
+ x = cdr(x);
+ if (isNil(a = EVAL(car(x))))
+ return prog(cddddr(x));
+ val(At) = a;
+ x = cdddr(x);
+ return EVAL(car(x));
+ }
+ val(At) = a;
+ x = cdr(x);
+ if (isNil(a = EVAL(car(x)))) {
+ x = cddr(x);
+ return EVAL(car(x));
+ }
+ val(At) = a;
+ x = cdr(x);
+ return EVAL(car(x));
+}
+
+// (ifn 'any1 'any2 . prg) -> any
+any doIfn(any x) {
+ any a;
+
+ x = cdr(x);
+ if (!isNil(a = EVAL(car(x)))) {
+ val(At) = a;
+ return prog(cddr(x));
+ }
+ x = cdr(x);
+ return EVAL(car(x));
+}
+
+// (when 'any . prg) -> any
+any doWhen(any x) {
+ any a;
+
+ x = cdr(x);
+ if (isNil(a = EVAL(car(x))))
+ return Nil;
+ val(At) = a;
+ return prog(cdr(x));
+}
+
+// (unless 'any . prg) -> any
+any doUnless(any x) {
+ any a;
+
+ x = cdr(x);
+ if (!isNil(a = EVAL(car(x)))) {
+ val(At) = a;
+ return Nil;
+ }
+ return prog(cdr(x));
+}
+
+// (cond ('any1 . prg1) ('any2 . prg2) ..) -> any
+any doCond(any x) {
+ any a;
+
+ while (isCell(x = cdr(x))) {
+ if (!isNil(a = EVAL(caar(x)))) {
+ val(At) = a;
+ return prog(cdar(x));
+ }
+ }
+ return Nil;
+}
+
+// (nond ('any1 . prg1) ('any2 . prg2) ..) -> any
+any doNond(any x) {
+ any a;
+
+ while (isCell(x = cdr(x))) {
+ if (isNil(a = EVAL(caar(x))))
+ return prog(cdar(x));
+ val(At) = a;
+ }
+ return Nil;
+}
+
+// (case 'any (any1 . prg1) (any2 . prg2) ..) -> any
+any doCase(any x) {
+ any y, z;
+
+ x = cdr(x), val(At) = EVAL(car(x));
+ while (isCell(x = cdr(x))) {
+ y = car(x), z = car(y);
+ if (z == T || equal(val(At), z))
+ return prog(cdr(y));
+ if (isCell(z)) {
+ do
+ if (equal(val(At), car(z)))
+ return prog(cdr(y));
+ while (isCell(z = cdr(z)));
+ }
+ }
+ return Nil;
+}
+
+// (state 'var ((sym|lst sym [. prg]) . prg) ..) -> any
+any doState(any ex) {
+ any x, y, z, a;
+ cell c1;
+
+ x = cdr(ex);
+ Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ while (isCell(x = cdr(x))) {
+ y = caar(x), z = car(y);
+ if (z==T || z==val(data(c1)) || isCell(z) && memq(val(data(c1)),z)) {
+ y = cdr(y);
+ if (!isCell(cdr(y)))
+ goto st1;
+ if (!isNil(a = prog(cdr(y)))) {
+ val(At) = a;
+ st1:
+ val(data(c1)) = car(y);
+ drop(c1);
+ return prog(cdar(x));
+ }
+ }
+ }
+ drop(c1);
+ return Nil;
+}
+
+// (while 'any . prg) -> any
+any doWhile(any x) {
+ any cond, a;
+ cell c1;
+
+ cond = car(x = cdr(x)), x = cdr(x);
+ Push(c1, Nil);
+ while (!isNil(a = EVAL(cond))) {
+ val(At) = a;
+ data(c1) = prog(x);
+ }
+ return Pop(c1);
+}
+
+// (until 'any . prg) -> any
+any doUntil(any x) {
+ any cond, a;
+ cell c1;
+
+ cond = car(x = cdr(x)), x = cdr(x);
+ Push(c1, Nil);
+ while (isNil(a = EVAL(cond)))
+ data(c1) = prog(x);
+ val(At) = a;
+ return Pop(c1);
+}
+
+// (loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doLoop(any ex) {
+ any x, y, a;
+
+ for (;;) {
+ x = cdr(ex);
+ do {
+ if (isCell(y = car(x))) {
+ if (isNil(car(y))) {
+ y = cdr(y);
+ if (isNil(a = EVAL(car(y))))
+ return prog(cdr(y));
+ val(At) = a;
+ }
+ else if (car(y) == T) {
+ y = cdr(y);
+ if (!isNil(a = EVAL(car(y)))) {
+ val(At) = a;
+ return prog(cdr(y));
+ }
+ }
+ else
+ evList(y);
+ }
+ } while (isCell(x = cdr(x)));
+ }
+}
+
+// (do 'flg|num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doDo(any x) {
+ any f, y, z, a;
+
+ x = cdr(x);
+ if (isNil(f = EVAL(car(x))))
+ return Nil;
+ if (isNum(f) && num(f) < 0)
+ return Nil;
+ x = cdr(x), z = Nil;
+ for (;;) {
+ if (isNum(f)) {
+ if (f == Zero)
+ return z;
+ f = (any)(num(f) - 4);
+ }
+ y = x;
+ do {
+ if (!isNum(z = car(y))) {
+ if (isSym(z))
+ z = val(z);
+ else if (isNil(car(z))) {
+ z = cdr(z);
+ if (isNil(a = EVAL(car(z))))
+ return prog(cdr(z));
+ val(At) = a;
+ z = Nil;
+ }
+ else if (car(z) == T) {
+ z = cdr(z);
+ if (!isNil(a = EVAL(car(z)))) {
+ val(At) = a;
+ return prog(cdr(z));
+ }
+ z = Nil;
+ }
+ else
+ z = evList(z);
+ }
+ } while (isCell(y = cdr(y)));
+ }
+}
+
+// (at '(cnt1 . cnt2) . prg) -> any
+any doAt(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedCell(ex,x);
+ NeedNum(ex,car(x));
+ NeedNum(ex,cdr(x));
+ if (num(car(x) += 4) < num(cdr(x)))
+ return Nil;
+ car(x) = Zero;
+ return prog(cddr(ex));
+}
+
+// (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+// (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doFor(any ex) {
+ any x, y, body, cond, a;
+ cell c1;
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[2];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = 0;
+ if (!isCell(y = car(x = cdr(ex))) || !isCell(cdr(y))) {
+ if (!isCell(y)) {
+ f.cnt = 1;
+ f.bnd[0].sym = y;
+ f.bnd[0].val = val(y);
+ }
+ else {
+ f.cnt = 2;
+ f.bnd[0].sym = cdr(y);
+ f.bnd[0].val = val(cdr(y));
+ f.bnd[1].sym = car(y);
+ f.bnd[1].val = val(car(y));
+ val(f.bnd[1].sym) = Zero;
+ }
+ y = Nil;
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ body = x = cdr(x);
+ while (isCell(data(c1))) {
+ val(f.bnd[0].sym) = car(data(c1)), data(c1) = cdr(data(c1));
+ if (f.cnt == 2)
+ val(f.bnd[1].sym) = (any)(num(val(f.bnd[1].sym)) + 4);
+ do {
+ if (!isNum(y = car(x))) {
+ if (isSym(y))
+ y = val(y);
+ else if (isNil(car(y))) {
+ y = cdr(y);
+ if (isNil(a = EVAL(car(y)))) {
+ y = prog(cdr(y));
+ goto for1;
+ }
+ val(At) = a;
+ y = Nil;
+ }
+ else if (car(y) == T) {
+ y = cdr(y);
+ if (!isNil(a = EVAL(car(y)))) {
+ val(At) = a;
+ y = prog(cdr(y));
+ goto for1;
+ }
+ y = Nil;
+ }
+ else
+ y = evList(y);
+ }
+ } while (isCell(x = cdr(x)));
+ x = body;
+ }
+ for1:
+ drop(c1);
+ if (f.cnt == 2)
+ val(f.bnd[1].sym) = f.bnd[1].val;
+ val(f.bnd[0].sym) = f.bnd[0].val;
+ Env.bind = f.link;
+ return y;
+ }
+ if (!isCell(car(y))) {
+ f.cnt = 1;
+ f.bnd[0].sym = car(y);
+ f.bnd[0].val = val(car(y));
+ }
+ else {
+ f.cnt = 2;
+ f.bnd[0].sym = cdar(y);
+ f.bnd[0].val = val(cdar(y));
+ f.bnd[1].sym = caar(y);
+ f.bnd[1].val = val(caar(y));
+ val(f.bnd[1].sym) = Zero;
+ }
+ y = cdr(y);
+ val(f.bnd[0].sym) = EVAL(car(y));
+ y = cdr(y), cond = car(y), y = cdr(y);
+ Push(c1,Nil);
+ body = x = cdr(x);
+ while (!isNil(a = EVAL(cond))) {
+ val(At) = a;
+ if (f.cnt == 2)
+ val(f.bnd[1].sym) = (any)(num(val(f.bnd[1].sym)) + 4);
+ do {
+ if (!isNum(data(c1) = car(x))) {
+ if (isSym(data(c1)))
+ data(c1) = val(data(c1));
+ else if (isNil(car(data(c1)))) {
+ data(c1) = cdr(data(c1));
+ if (isNil(a = EVAL(car(data(c1))))) {
+ data(c1) = prog(cdr(data(c1)));
+ goto for2;
+ }
+ val(At) = a;
+ data(c1) = Nil;
+ }
+ else if (car(data(c1)) == T) {
+ data(c1) = cdr(data(c1));
+ if (!isNil(a = EVAL(car(data(c1))))) {
+ val(At) = a;
+ data(c1) = prog(cdr(data(c1)));
+ goto for2;
+ }
+ data(c1) = Nil;
+ }
+ else
+ data(c1) = evList(data(c1));
+ }
+ } while (isCell(x = cdr(x)));
+ if (isCell(y))
+ val(f.bnd[0].sym) = prog(y);
+ x = body;
+ }
+for2:
+ if (f.cnt == 2)
+ val(f.bnd[1].sym) = f.bnd[1].val;
+ val(f.bnd[0].sym) = f.bnd[0].val;
+ Env.bind = f.link;
+ return Pop(c1);
+}
+
+static any Thrown;
+
+// (catch 'sym . prg) -> any
+any doCatch(any ex) {
+ any x, y;
+ catchFrame f;
+
+ x = cdr(ex), f.tag = EVAL(car(x));
+ NeedSymb(ex,f.tag);
+ f.link = CatchPtr, CatchPtr = &f;
+ f.env = Env;
+ y = setjmp(f.rst)? Thrown : prog(cdr(x));
+ CatchPtr = f.link;
+ return y;
+}
+
+// (throw 'sym 'any)
+any doThrow(any ex) {
+ any x, tag;
+ catchFrame *p;
+
+ x = cdr(ex), tag = EVAL(car(x));
+ x = cdr(x), Thrown = EVAL(car(x));
+ for (p = CatchPtr; p; p = p->link)
+ if (p->tag == T || tag == p->tag) {
+ unwind(p);
+ longjmp(p->rst, 1);
+ }
+ err(ex, tag, "Tag not found");
+}
+
+// (finally exe . prg) -> any
+any doFinally(any x) {
+ catchFrame f;
+ cell c1;
+
+ x = cdr(x);
+ f.tag = car(x);
+ f.link = CatchPtr, CatchPtr = &f;
+ f.env = Env;
+ Push(c1, prog(cdr(x)));
+ EVAL(f.tag);
+ CatchPtr = f.link;
+ return Pop(c1);
+}
+
+static outFrame Out;
+static struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[2]; // for 'Up' and 'At'
+} Brk;
+
+void brkLoad(any x) {
+ if (!isNil(val(Dbg)) && !Env.brk) {
+ Env.brk = YES;
+ Brk.cnt = 2;
+ Brk.bnd[0].sym = Up, Brk.bnd[0].val = val(Up), val(Up) = x;
+ Brk.bnd[1].sym = At, Brk.bnd[1].val = val(At);
+ Brk.link = Env.bind, Env.bind = (bindFrame*)&Brk;
+ Out.fp = stdout, pushOutFiles(&Out);
+ print(x), crlf();
+ load(NULL, '!', Nil);
+ popOutFiles();
+ val(At) = Brk.bnd[1].val;
+ val(Up) = Brk.bnd[0].val;
+ Env.bind = Brk.link;
+ Env.brk = NO;
+ }
+}
+
+// (! . prg) -> any
+any doBreak(any ex) {
+ brkLoad(cdr(ex));
+ return EVAL(cdr(ex));
+}
+
+// (e . prg) -> any
+any doE(any ex) {
+ any x;
+ cell c1, at;
+
+ if (!Env.brk)
+ err(ex, NULL, "No Break");
+ Push(c1,val(Dbg)), val(Dbg) = Nil;
+ Push(at, val(At)), val(At) = Brk.bnd[1].val;
+ if (Env.inFiles && Env.inFiles->link)
+ Chr = Env.inFiles->next, Env.get = Env.inFiles->get, InFile = Env.inFiles->link->fp;
+ popOutFiles();
+ x = isCell(cdr(ex))? prog(cdr(ex)) : EVAL(val(Up));
+ pushOutFiles(&Out);
+ if (Env.inFiles && Env.inFiles->link)
+ Env.inFiles->next = Chr, Chr = 0;
+ InFile = stdin, OutFile = stdout;
+ val(At) = data(at);
+ val(Dbg) = Pop(c1);
+ return x;
+}
+
+static void traceIndent(int i, any x, char *s) {
+ if (i > 64)
+ i = 64;
+ while (--i >= 0)
+ Env.put(' ');
+ if (!isCell(x))
+ print(x);
+ else
+ print(car(x)), space(), print(cdr(x)), space(), print(val(This));
+ outString(s);
+}
+
+static void traceSym(any x) {
+ if (x != At)
+ space(), print(val(x));
+ else {
+ int i = Env.next;
+
+ while (--i >= 0)
+ space(), print(data(Env.arg[i]));
+ }
+}
+
+// ($ sym|lst lst . prg) -> any
+any doTrace(any x) {
+ any foo, body;
+ FILE *oSave;
+ void (*putSave)(int);
+ cell c1;
+
+ if (isNil(val(Dbg)))
+ return prog(cdddr(x));
+ oSave = OutFile, OutFile = stderr;
+ putSave = Env.put, Env.put = putStdout;
+ x = cdr(x), foo = car(x);
+ x = cdr(x), body = cdr(x);
+ traceIndent(++Trace, foo, " :");
+ for (x = car(x); isCell(x); x = cdr(x))
+ traceSym(car(x));
+ if (!isNil(x) && !isNum(x))
+ traceSym(x);
+ crlf();
+ Env.put = putSave;
+ OutFile = oSave;
+ Push(c1, prog(body));
+ OutFile = stderr;
+ Env.put = putStdout;
+ traceIndent(Trace--, foo, " = "), print(data(c1)), crlf();
+ Env.put = putSave;
+ OutFile = oSave;
+ return Pop(c1);
+}
+
+// (bye 'num|NIL)
+any doBye(any ex) {
+ any x = EVAL(cadr(ex));
+
+ bye(isNil(x)? 0 : xNum(ex,x));
+}
diff --git a/src/gc.c b/src/gc.c
@@ -0,0 +1,163 @@
+/* 15nov07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/* Mark data */
+static void mark(any x) {
+ while (isCell(x)) {
+ if (!(num(cdr(x)) & 1))
+ return;
+ *(long*)&cdr(x) &= ~1;
+ mark(car(x)), x = cdr(x);
+ }
+ if (!isNum(x) && num(val(x)) & 1) {
+ *(long*)&val(x) &= ~1;
+ mark(val(x)), x = tail(x);
+ while (isCell(x)) {
+ if (!(num(cdr(x)) & 1))
+ return;
+ *(long*)&cdr(x) &= ~1;
+ mark(cdr(x)), x = car(x);
+ }
+ if (!isTxt(x))
+ do {
+ if (!(num(val(x)) & 1))
+ return;
+ *(long*)&val(x) &= ~1;
+ } while (!isNum(x = val(x)));
+ }
+}
+
+/* Garbage collector */
+static void gc(long c) {
+ any p;
+ heap *h;
+ int i;
+
+ h = Heaps;
+ do {
+ p = h->cells + CELLS-1;
+ do
+ *(long*)&cdr(p) |= 1;
+ while (--p >= h->cells);
+ } while (h = h->next);
+ /* Mark */
+ mark(Nil+1);
+ mark(Intern[0]), mark(Intern[1]);
+ mark(Transient[0]), mark(Transient[1]);
+ mark(ApplyArgs), mark(ApplyBody);
+ mark(Reloc);
+ for (p = Env.stack; p; p = cdr(p))
+ mark(car(p));
+ for (p = (any)Env.bind; p; p = (any)((bindFrame*)p)->link)
+ for (i = ((bindFrame*)p)->cnt; --i >= 0;) {
+ mark(((bindFrame*)p)->bnd[i].sym);
+ mark(((bindFrame*)p)->bnd[i].val);
+ }
+ for (p = (any)CatchPtr; p; p = (any)((catchFrame*)p)->link)
+ mark(((catchFrame*)p)->tag);
+ for (p = (any)Env.meth; p; p = (any)((methFrame*)p)->link)
+ mark(((methFrame*)p)->key), mark(((methFrame*)p)->cls);
+ if (Env.make)
+ mark(car(Env.make));
+ if (Env.parser)
+ mark(Env.parser->sym);
+ /* Sweep */
+ Avail = NULL;
+ h = Heaps;
+ if (c) {
+ do {
+ p = h->cells + CELLS-1;
+ do
+ if (num(p->cdr) & 1)
+ Free(p), --c;
+ while (--p >= h->cells);
+ } while (h = h->next);
+ while (c >= 0)
+ heapAlloc(), c -= CELLS;
+ }
+ else {
+ heap **hp = &Heaps;
+ cell *av;
+
+ do {
+ c = CELLS;
+ av = Avail;
+ p = h->cells + CELLS-1;
+ do
+ if (num(p->cdr) & 1)
+ Free(p), --c;
+ while (--p >= h->cells);
+ if (c)
+ hp = &h->next, h = h->next;
+ else
+ Avail = av, h = h->next, free(*hp), *hp = h;
+ } while (h);
+ }
+}
+
+// (gc ['num]) -> num | NIL
+any doGc(any x) {
+ x = cdr(x);
+ gc(isNum(x = EVAL(car(x)))? CELLS*unBox(x) : CELLS);
+ return x;
+}
+
+/* Construct a cell */
+any cons(any x, any y) {
+ cell *p;
+
+ if (!(p = Avail)) {
+ cell c1, c2;
+
+ Push(c1,x);
+ Push(c2,y);
+ gc(CELLS);
+ drop(c1);
+ p = Avail;
+ }
+ Avail = p->car;
+ p->car = x;
+ p->cdr = y;
+ return p;
+}
+
+/* Construct a symbol */
+any consSym(any val, word w) {
+ cell *p;
+
+ if (!(p = Avail)) {
+ cell c1;
+
+ if (!val)
+ gc(CELLS);
+ else {
+ Push(c1,val);
+ gc(CELLS);
+ drop(c1);
+ }
+ p = Avail;
+ }
+ Avail = p->car;
+ p = symPtr(p);
+ val(p) = val ?: p;
+ tail(p) = txt(w);
+ return p;
+}
+
+/* Construct a name cell */
+any consName(word w, any n) {
+ cell *p;
+
+ if (!(p = Avail)) {
+ gc(CELLS);
+ p = Avail;
+ }
+ Avail = p->car;
+ p = symPtr(p);
+ val(p) = n;
+ tail(p) = (any)w;
+ return p;
+}
diff --git a/src/io.c b/src/io.c
@@ -0,0 +1,1110 @@
+/* 01apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static any read0(bool);
+
+static int StrI;
+static cell StrCell, *StrP;
+static word StrW;
+static void (*PutSave)(int);
+static char Delim[] = " \t\n\r\"'()[]`~";
+
+static void openErr(any ex, char *s) {err(ex, NULL, "%s open: %s", s, strerror(errno));}
+static void eofErr(void) {err(NULL, NULL, "EOF Overrun");}
+
+/* Buffer size */
+int bufSize(any x) {return symBytes(x) + 1;}
+
+int pathSize(any x) {
+ int c = firstByte(x);
+
+ if (c != '@' && (c != '+' || secondByte(x) != '@'))
+ return bufSize(x);
+ if (!Home)
+ return symBytes(x);
+ return strlen(Home) + symBytes(x);
+}
+
+void bufString(any x, char *p) {
+ int c, i;
+ word w;
+
+ if (!isNil(x)) {
+ for (x = name(x), c = getByte1(&i, &w, &x); c; c = getByte(&i, &w, &x)) {
+ if (c == '^') {
+ if ((c = getByte(&i, &w, &x)) == '?')
+ c = 127;
+ else
+ c &= 0x1F;
+ }
+ *p++ = c;
+ }
+ }
+ *p = '\0';
+}
+
+void pathString(any x, char *p) {
+ int c, i;
+ word w;
+ char *h;
+
+ x = name(x);
+ if ((c = getByte1(&i, &w, &x)) == '+')
+ *p++ = c, c = getByte(&i, &w, &x);
+ if (c != '@')
+ while (*p++ = c)
+ c = getByte(&i, &w, &x);
+ else {
+ if (h = Home)
+ do
+ *p++ = *h++;
+ while (*h);
+ while (*p++ = getByte(&i, &w, &x));
+ }
+}
+
+// (path 'sym) -> sym
+any doPath(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedSym(ex,x);
+ {
+ char nm[pathSize(x)];
+
+ pathString(x,nm);
+ return mkStr(nm);
+ }
+}
+
+void rdOpen(any ex, any x, inFrame *f) {
+ NeedSymb(ex,x);
+ if (isNil(x))
+ f->fp = stdin;
+ else {
+ char nm[pathSize(x)];
+
+ pathString(x,nm);
+ if (nm[0] == '+') {
+ if (!(f->fp = fopen(nm+1, "a+")))
+ openErr(ex, nm);
+ fseek(f->fp, 0L, SEEK_SET);
+ }
+ else if (!(f->fp = fopen(nm, "r")))
+ openErr(ex, nm);
+ }
+}
+
+void wrOpen(any ex, any x, outFrame *f) {
+ NeedSymb(ex,x);
+ if (isNil(x))
+ f->fp = stdout;
+ else {
+ char nm[pathSize(x)];
+
+ pathString(x,nm);
+ if (nm[0] == '+') {
+ if (!(f->fp = fopen(nm+1, "a")))
+ openErr(ex, nm);
+ }
+ else if (!(f->fp = fopen(nm, "w")))
+ openErr(ex, nm);
+ }
+}
+
+/*** Reading ***/
+void getStdin(void) {Chr = getc(InFile);}
+
+static void getParse(void) {
+ if ((Chr = getByte(&Env.parser->i, &Env.parser->w, &Env.parser->nm)) == 0)
+ Chr = ']';
+}
+
+void pushInFiles(inFrame *f) {
+ f->next = Chr, Chr = 0;
+ InFile = f->fp;
+ f->get = Env.get, Env.get = getStdin;
+ f->link = Env.inFiles, Env.inFiles = f;
+}
+
+void pushOutFiles(outFrame *f) {
+ OutFile = f->fp;
+ f->put = Env.put, Env.put = putStdout;
+ f->link = Env.outFiles, Env.outFiles = f;
+}
+
+void popInFiles(void) {
+ if (InFile != stdin)
+ fclose(InFile);
+ Chr = Env.inFiles->next;
+ Env.get = Env.inFiles->get;
+ InFile = (Env.inFiles = Env.inFiles->link)? Env.inFiles->fp : stdin;
+}
+
+void popOutFiles(void) {
+ if (OutFile != stdout)
+ fclose(OutFile);
+ Env.put = Env.outFiles->put;
+ OutFile = (Env.outFiles = Env.outFiles->link)? Env.outFiles->fp : stdout;
+}
+
+/* Skip White Space and Comments */
+static int skip(int c) {
+ for (;;) {
+ if (Chr < 0)
+ return Chr;
+ while (Chr <= ' ') {
+ Env.get();
+ if (Chr < 0)
+ return Chr;
+ }
+ if (Chr != c)
+ return Chr;
+ while (Env.get(), Chr != '\n')
+ if (Chr < 0)
+ return Chr;
+ Env.get();
+ }
+}
+
+/* Test for escaped characters */
+static bool testEsc(void) {
+ for (;;) {
+ if (Chr < 0)
+ return NO;
+ if (Chr != '\\')
+ return YES;
+ if (Env.get(), Chr != '\n')
+ return YES;
+ do
+ Env.get();
+ while (Chr == ' ' || Chr == '\t');
+ }
+}
+
+/* Read a list */
+static any rdList(void) {
+ any x;
+ cell c1, c2;
+
+ if (skip('#') == ')') {
+ Env.get();
+ return Nil;
+ }
+ if (Chr == ']')
+ return Nil;
+ for (;;) {
+ if (Chr != '~') {
+ Push(c1, x = cons(read0(NO),Nil));
+ break;
+ }
+ Env.get();
+ Push(c1, read0(NO));
+ if (isCell(x = data(c1) = EVAL(data(c1)))) {
+ do
+ x = cdr(x);
+ while (isCell(cdr(x)));
+ break;
+ }
+ drop(c1);
+ }
+ for (;;) {
+ if (skip('#') == ')') {
+ Env.get();
+ break;
+ }
+ if (Chr == ']')
+ break;
+ if (Chr == '.') {
+ Env.get();
+ cdr(x) = skip('#')==')' || Chr==']'? data(c1) : read0(NO);
+ if (skip('#') == ')')
+ Env.get();
+ else if (Chr != ']')
+ err(NULL, x, "Bad dotted pair");
+ break;
+ }
+ if (Chr != '~')
+ x = cdr(x) = cons(read0(NO),Nil);
+ else {
+ Env.get();
+ Push(c2, read0(NO));
+ data(c2) = EVAL(data(c2));
+ if (isCell(cdr(x) = Pop(c2)))
+ do
+ x = cdr(x);
+ while (isCell(cdr(x)));
+ }
+ }
+ return Pop(c1);
+}
+
+/* Try for anonymous symbol */
+static any anonymous(any s) {
+ int c, i;
+ word w;
+ unsigned long n;
+ heap *h;
+
+ if ((c = getByte1(&i, &w, &s)) != '$')
+ return NULL;
+ n = 0;
+ while (c = getByte(&i, &w, &s)) {
+ if (c < '0' || c > '9')
+ return NULL;
+ n = n * 10 + c - '0';
+ }
+ n *= sizeof(cell);
+ h = Heaps;
+ do
+ if ((any)n > h->cells && (any)n < h->cells + CELLS)
+ return symPtr((any)n);
+ while (h = h->next);
+ return NULL;
+}
+
+/* Relocate anonymous symbol */
+static any reloc(any key) {
+ any x, y;
+ int n;
+
+ if (!isCell(x = Reloc)) {
+ Reloc = cons(cons(key, y = consSym(Nil,0)), Nil);
+ return y;
+ }
+ for (;;) {
+ if ((n = num(key) - num(caar(x))) == 0)
+ return cdar(x);
+ if (!isCell(cdr(x))) {
+ key = cons(cons(key, y = consSym(Nil,0)), Nil);
+ cdr(x) = n<0? cons(key,Nil) : cons(Nil,key);
+ return y;
+ }
+ if (n < 0) {
+ if (!isCell(cadr(x))) {
+ cadr(x) = cons(cons(key, y = consSym(Nil,0)), Nil);
+ return y;
+ }
+ x = cadr(x);
+ }
+ else {
+ if (!isCell(cddr(x))) {
+ cddr(x) = cons(cons(key, y = consSym(Nil,0)), Nil);
+ return y;
+ }
+ x = cddr(x);
+ }
+ }
+}
+
+/* Read one expression */
+static any read0(bool top) {
+ int i;
+ word w;
+ any x, y;
+ cell c1, *p;
+
+ if (skip('#') < 0) {
+ if (top)
+ return Nil;
+ eofErr();
+ }
+ if (Chr == '(') {
+ Env.get();
+ x = rdList();
+ if (top && Chr == ']')
+ Env.get();
+ return x;
+ }
+ if (Chr == '[') {
+ Env.get();
+ x = rdList();
+ if (Chr != ']')
+ err(NULL, x, "Super parentheses mismatch");
+ Env.get();
+ return x;
+ }
+ if (Chr == '\'') {
+ Env.get();
+ return cons(Quote, read0(NO));
+ }
+ if (Chr == '`') {
+ Env.get();
+ Push(c1, read0(NO));
+ x = EVAL(data(c1));
+ drop(c1);
+ return x;
+ }
+ if (Chr == '\\') {
+ Env.get();
+ Push(c1, read0(NO));
+ if (isNum(x = data(c1)))
+ x = reloc(x);
+ else if (isCell(x)) {
+ Transient[0] = Transient[1] = Nil;
+ if (isNum(x = car(y = x)))
+ x = car(y) = reloc(x);
+ if (isCell(y = cdr(y))) {
+ val(x) = car(y);
+ p = (any)&tail(x);
+ while (isCell(car(p)))
+ car(p) = caar(p);
+ while (isCell(y = cdr(y)))
+ car(p) = cons(car(p),car(y)), p = car(p);
+ }
+ }
+ drop(c1);
+ return x;
+ }
+ if (Chr == '"') {
+ Env.get();
+ if (Chr == '"') {
+ Env.get();
+ return Nil;
+ }
+ if (!testEsc())
+ eofErr();
+ putByte1(Chr, &i, &w, &p);
+ while (Env.get(), Chr != '"') {
+ if (!testEsc())
+ eofErr();
+ putByte(Chr, &i, &w, &p, &c1);
+ }
+ y = popSym(i, w, p, &c1), Env.get();
+ if (x = isIntern(tail(y), Transient))
+ return x;
+ if (Env.get == getStdin)
+ intern(y, Transient);
+ return y;
+ }
+ if (strchr(Delim, Chr))
+ err(NULL, NULL, "Bad input '%c' (%d)", isprint(Chr)? Chr:'?', Chr);
+ if (Chr == '\\')
+ Env.get();
+ putByte1(Chr, &i, &w, &p);
+ for (;;) {
+ Env.get();
+ if (strchr(Delim, Chr))
+ break;
+ if (Chr == '\\')
+ Env.get();
+ putByte(Chr, &i, &w, &p, &c1);
+ }
+ y = popSym(i, w, p, &c1);
+ if (x = symToNum(tail(y), (int)unBox(val(Scl)), '.', 0))
+ return x;
+ if (x = isIntern(tail(y), Intern))
+ return x;
+ if (x = anonymous(name(y)))
+ return x;
+ intern(y, Intern);
+ val(y) = Nil;
+ return y;
+}
+
+any read1(int end) {
+ any x;
+
+ if (!Chr)
+ Env.get();
+ if (Chr == end)
+ return Nil;
+ x = read0(YES);
+ while (Chr && strchr(" \t)]", Chr))
+ Env.get();
+ return x;
+}
+
+/* Read one token */
+any token(any x, int c) {
+ int i;
+ word w;
+ any y;
+ cell c1, *p;
+
+ if (!Chr)
+ Env.get();
+ if (skip(c) < 0)
+ return Nil;
+ if (Chr == '"') {
+ Env.get();
+ if (Chr == '"') {
+ Env.get();
+ return Nil;
+ }
+ testEsc();
+ putByte1(Chr, &i, &w, &p);
+ while (Env.get(), Chr != '"' && testEsc())
+ putByte(Chr, &i, &w, &p, &c1);
+ Env.get();
+ return popSym(i, w, p, &c1);
+ }
+ if (Chr >= '0' && Chr <= '9') {
+ putByte1(Chr, &i, &w, &p);
+ while (Env.get(), Chr >= '0' && Chr <= '9' || Chr == '.')
+ putByte(Chr, &i, &w, &p, &c1);
+ return symToNum(tail(popSym(i, w, p, &c1)), (int)unBox(val(Scl)), '.', 0);
+ }
+ {
+ char nm[bufSize(x)];
+
+ bufString(x, nm);
+ if (Chr >= 'A' && Chr <= 'Z' || Chr == '\\' || Chr >= 'a' && Chr <= 'z' || strchr(nm,Chr)) {
+ if (Chr == '\\')
+ Env.get();
+ putByte1(Chr, &i, &w, &p);
+ while (Env.get(),
+ Chr >= '0' && Chr <= '9' || Chr >= 'A' && Chr <= 'Z' ||
+ Chr == '\\' || Chr >= 'a' && Chr <= 'z' || strchr(nm,Chr) ) {
+ if (Chr == '\\')
+ Env.get();
+ putByte(Chr, &i, &w, &p, &c1);
+ }
+ y = popSym(i, w, p, &c1);
+ if (x = isIntern(tail(y), Intern))
+ return x;
+ intern(y, Intern);
+ val(y) = Nil;
+ return y;
+ }
+ }
+ y = mkTxt(c = Chr);
+ Env.get();
+ if (x = isIntern(y, Intern))
+ return x;
+ return mkChar(c);
+}
+
+// (read ['sym1 ['sym2]]) -> any
+any doRead(any ex) {
+ any x, y;
+
+ if (!isCell(x = cdr(ex)))
+ x = read1(0), Reloc = Nil;
+ else {
+ y = EVAL(car(x));
+ NeedSym(ex,y);
+ x = cdr(x), x = EVAL(car(x));
+ NeedSym(ex,x);
+ x = token(y, firstByte(x));
+ }
+ if (InFile == stdin && Chr == '\n')
+ Chr = 0;
+ return x;
+}
+
+// (peek) -> sym
+any doPeek(any ex __attribute__((unused))) {
+ if (!Chr)
+ Env.get();
+ return Chr<0? Nil : mkChar(Chr);
+}
+
+// (char) -> sym
+// (char 'num) -> sym
+// (char 'sym) -> num
+any doChar(any ex) {
+ any x = cdr(ex);
+
+ if (!isCell(x)) {
+ if (!Chr)
+ Env.get();
+ x = Chr<0? Nil : mkChar(Chr);
+ Env.get();
+ return x;
+ }
+ if (isNum(x = EVAL(car(x)))) {
+ int c = (int)unBox(x);
+
+ if (c == 127)
+ return mkChar2('^','?');
+ if (c < ' ')
+ return mkChar2('^', c + 0x40);
+ return mkChar(c);
+ }
+ if (isSym(x)) {
+ int c;
+
+ if ((c = firstByte(x)) != '^')
+ return box(c);
+ return box((c = secondByte(x)) == '?'? 127 : c & 0x1F);
+ }
+ atomError(ex,x);
+}
+
+// (skip ['sym]) -> sym
+any doSkip(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedSymb(ex,x);
+ return skip(firstByte(x))<0? Nil : mkChar(Chr);
+}
+
+// (eol) -> flg
+any doEol(any ex __attribute__((unused))) {
+ return InFile && Chr=='\n' || Chr<=0? T : Nil;
+}
+
+// (eof ['flg]) -> flg
+any doEof(any x) {
+ x = cdr(x);
+ if (!isNil(EVAL(car(x)))) {
+ Chr = -1;
+ return T;
+ }
+ if (!Chr)
+ Env.get();
+ return Chr < 0? T : Nil;
+}
+
+// (from 'any ..) -> sym
+any doFrom(any ex) {
+ any x;
+ int res, i, j, ac = length(x = cdr(ex)), p[ac];
+ cell c[ac];
+ char *av[ac];
+
+ if (ac == 0)
+ return Nil;
+ for (i = 0;;) {
+ Push(c[i], evSym(x));
+ av[i] = alloc(NULL, bufSize(data(c[i]))), bufString(data(c[i]), av[i]);
+ p[i] = 0;
+ if (++i == ac)
+ break;
+ x = cdr(x);
+ }
+ res = -1;
+ if (!Chr)
+ Env.get();
+ while (Chr >= 0) {
+ for (i = 0; i < ac; ++i) {
+ for (;;) {
+ if (av[i][p[i]] == (byte)Chr) {
+ if (av[i][++p[i]])
+ break;
+ Env.get();
+ res = i;
+ goto done;
+ }
+ if (!p[i])
+ break;
+ for (j = 1; --p[i]; ++j)
+ if (memcmp(av[i], av[i]+j, p[i]) == 0)
+ break;
+ }
+ }
+ Env.get();
+ }
+done:
+ i = 0; do
+ free(av[i]);
+ while (++i < ac);
+ drop(c[0]);
+ return res < 0? Nil : data(c[res]);
+}
+
+// (till 'any ['flg]) -> lst|sym
+any doTill(any ex) {
+ any x;
+ int i;
+ word w;
+ cell c1;
+
+ x = evSym(cdr(ex));
+ {
+ char buf[bufSize(x)];
+
+ bufString(x, buf);
+ if (!Chr)
+ Env.get();
+ if (Chr < 0 || strchr(buf,Chr))
+ return Nil;
+ x = cddr(ex);
+ if (isNil(EVAL(car(x)))) {
+ Push(c1, x = cons(mkChar(Chr), Nil));
+ while (Env.get(), Chr > 0 && !strchr(buf,Chr))
+ x = cdr(x) = cons(mkChar(Chr), Nil);
+ return Pop(c1);
+ }
+ putByte1(Chr, &i, &w, &x);
+ while (Env.get(), Chr > 0 && !strchr(buf,Chr))
+ putByte(Chr, &i, &w, &x, &c1);
+ return popSym(i, w, x, &c1);
+ }
+}
+
+static inline bool eol(void) {
+ if (Chr < 0)
+ return YES;
+ if (Chr == '\n') {
+ Chr = 0;
+ return YES;
+ }
+ if (Chr == '\r') {
+ Env.get();
+ if (Chr == '\n')
+ Chr = 0;
+ return YES;
+ }
+ return NO;
+}
+
+// (line 'flg) -> lst|sym
+any doLine(any x) {
+ any y;
+ int i;
+ word w;
+ cell c1;
+
+ if (!Chr)
+ Env.get();
+ if (eol())
+ return Nil;
+ x = cdr(x);
+ if (isNil(EVAL(car(x)))) {
+ Push(c1, cons(mkChar(Chr), Nil));
+ y = data(c1);
+ for (;;) {
+ if (Env.get(), eol())
+ return Pop(c1);
+ y = cdr(y) = cons(mkChar(Chr), Nil);
+ }
+ }
+ else {
+ putByte1(Chr, &i, &w, &y);
+ for (;;) {
+ if (Env.get(), eol())
+ return popSym(i, w, y, &c1);
+ putByte(Chr, &i, &w, &y, &c1);
+ }
+ }
+}
+
+static any parse(any x, bool skp) {
+ int c;
+ parseFrame *save, parser;
+ void (*getSave)(void);
+ cell c1;
+
+ if (save = Env.parser)
+ Push(c1, Env.parser->sym);
+ Env.parser = &parser;
+ parser.nm = name(parser.sym = x);
+ getSave = Env.get, Env.get = getParse, c = Chr;
+ Chr = getByte1(&parser.i, &parser.w, &parser.nm);
+ if (skp)
+ getParse();
+ x = rdList();
+ Chr = c, Env.get = getSave;
+ if (Env.parser = save)
+ drop(c1);
+ return x;
+}
+
+static void putString(int c) {
+ putByte(c, &StrI, &StrW, &StrP, &StrCell);
+}
+
+void begString(void) {
+ putByte0(&StrI, &StrW, &StrP);
+ PutSave = Env.put, Env.put = putString;
+}
+
+any endString(void) {
+ Env.put = PutSave;
+ StrP = popSym(StrI, StrW, StrP, &StrCell);
+ return StrI? StrP : Nil;
+}
+
+// (any 'sym) -> any
+any doAny(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedSymb(ex,x);
+ if (!isNil(x)) {
+ int c;
+ parseFrame *save, parser;
+ void (*getSave)(void);
+ cell c1;
+
+ if (save = Env.parser)
+ Push(c1, Env.parser->sym);
+ Env.parser = &parser;
+ parser.nm = name(parser.sym = x);
+ getSave = Env.get, Env.get = getParse, c = Chr;
+ Chr = getByte1(&parser.i, &parser.w, &parser.nm);
+ x = read0(YES);
+ Chr = c, Env.get = getSave;
+ if (Env.parser = save)
+ drop(c1);
+ }
+ return x;
+}
+
+// (sym 'any) -> sym
+any doSym(any x) {
+ cell c1;
+
+ x = EVAL(cadr(x));
+ begString();
+ Push(c1,x);
+ print(data(c1));
+ drop(c1);
+ return endString();
+}
+
+// (str 'sym) -> lst
+// (str 'lst) -> sym
+any doStr(any ex) {
+ any x;
+ cell c1;
+
+ x = cdr(ex);
+ if (isSymb(x = EVAL(car(x))))
+ return isNil(x)? Nil : parse(x,NO);
+ NeedCell(ex,x);
+ begString();
+ Push(c1,x);
+ print(car(x));
+ while (isCell(x = cdr(x)))
+ space(), print(car(x));
+ drop(c1);
+ return endString();
+}
+
+any load(any ex, int pr, any x) {
+ cell c1;
+ inFrame f;
+
+ if (isSymb(x) && firstByte(x) == '-') {
+ Push(c1, parse(x,YES));
+ x = evList(data(c1));
+ drop(c1);
+ return x;
+ }
+ rdOpen(ex, x, &f);
+ doHide(Nil);
+ pushInFiles(&f);
+ x = Nil;
+ for (;;) {
+ if (InFile != stdin)
+ data(c1) = read1(0);
+ else {
+ if (pr && !Chr)
+ Env.put(pr), space(), fflush(OutFile);
+ data(c1) = read1('\n');
+ if (Chr == '\n')
+ Chr = 0;
+ }
+ if (isNil(data(c1)))
+ break;
+ Save(c1), x = EVAL(data(c1)), drop(c1);
+ if (InFile == stdin && !Chr) {
+ val(At3) = val(At2), val(At2) = val(At), val(At) = x;
+ outString("-> "), fflush(OutFile), print(x), crlf();
+ }
+ }
+ popInFiles();
+ doHide(Nil);
+ return x;
+}
+
+// (load 'any ..) -> any
+any doLoad(any ex) {
+ any x, y;
+
+ x = cdr(ex);
+ do {
+ if ((y = EVAL(car(x))) != T)
+ y = load(ex, '>', y);
+ else
+ while (*AV && strcmp(*AV,"-") != 0)
+ y = load(ex, '>', mkStr(*AV++));
+ } while (isCell(x = cdr(x)));
+ return y;
+}
+
+// (in 'any . prg) -> any
+any doIn(any ex) {
+ any x;
+ inFrame f;
+
+ x = cdr(ex), x = EVAL(car(x));
+ rdOpen(ex,x,&f);
+ pushInFiles(&f);
+ x = prog(cddr(ex));
+ popInFiles();
+ return x;
+}
+
+// (out 'any . prg) -> any
+any doOut(any ex) {
+ any x;
+ outFrame f;
+
+ x = cdr(ex), x = EVAL(car(x));
+ wrOpen(ex,x,&f);
+ pushOutFiles(&f);
+ x = prog(cddr(ex));
+ popOutFiles();
+ return x;
+}
+
+/*** Prining ***/
+void putStdout(int c) {putc(c, OutFile);}
+
+void crlf(void) {Env.put('\n');}
+void space(void) {Env.put(' ');}
+
+void outString(char *s) {
+ while (*s)
+ Env.put(*s++);
+}
+
+int bufNum(char buf[BITS/2], long n) {
+ return sprintf(buf, "%ld", n);
+}
+
+void outNum(long n) {
+ char buf[BITS/2];
+
+ bufNum(buf, n);
+ outString(buf);
+}
+
+void prIntern(any nm) {
+ int i, c;
+ word w;
+
+ c = getByte1(&i, &w, &nm);
+ if (strchr(Delim, c))
+ Env.put('\\');
+ Env.put(c);
+ while (c = getByte(&i, &w, &nm)) {
+ if (strchr(Delim, c))
+ Env.put('\\');
+ Env.put(c);
+ }
+}
+
+void prTransient(any nm) {
+ int i, c;
+ word w;
+
+ Env.put('"');
+ c = getByte1(&i, &w, &nm);
+ do {
+ if (c == '"' || c == '\\')
+ Env.put('\\');
+ Env.put(c);
+ } while (c = getByte(&i, &w, &nm));
+ Env.put('"');
+}
+
+/* Print one expression */
+void print(any x) {
+ if (isNum(x))
+ outNum(unBox(x));
+ else if (isSym(x)) {
+ any nm = name(x);
+
+ if (nm == txt(0))
+ Env.put('$'), outNum((word)x/sizeof(cell));
+ else if (x == isIntern(nm, Intern))
+ prIntern(nm);
+ else
+ prTransient(nm);
+ }
+ else if (car(x) == Quote && x != cdr(x))
+ Env.put('\''), print(cdr(x));
+ else {
+ any y = x;
+ Env.put('(');
+ while (print(car(x)), !isNil(x = cdr(x))) {
+ if (x == y) {
+ outString(" .");
+ break;
+ }
+ if (!isCell(x)) {
+ outString(" . ");
+ print(x);
+ break;
+ }
+ space();
+ }
+ Env.put(')');
+ }
+}
+
+void prin(any x) {
+ if (!isNil(x)) {
+ if (isNum(x))
+ outNum(unBox(x));
+ else if (isSym(x)) {
+ int i, c;
+ word w;
+
+ for (x = name(x), c = getByte1(&i, &w, &x); c; c = getByte(&i, &w, &x)) {
+ if (c != '^')
+ Env.put(c);
+ else if (!(c = getByte(&i, &w, &x)))
+ Env.put('^');
+ else if (c == '?')
+ Env.put(127);
+ else
+ Env.put(c &= 0x1F);
+ }
+ }
+ else {
+ while (prin(car(x)), !isNil(x = cdr(x))) {
+ if (!isCell(x)) {
+ prin(x);
+ break;
+ }
+ }
+ }
+ }
+}
+
+// (prin 'any ..) -> any
+any doPrin(any x) {
+ any y = Nil;
+
+ while (isCell(x = cdr(x)))
+ prin(y = EVAL(car(x)));
+ return y;
+}
+
+// (prinl 'any ..) -> any
+any doPrinl(any x) {
+ any y = Nil;
+
+ while (isCell(x = cdr(x)))
+ prin(y = EVAL(car(x)));
+ crlf();
+ return y;
+}
+
+// (space ['num]) -> num
+any doSpace(any ex) {
+ any x;
+ int n;
+
+ if (isNil(x = EVAL(cadr(ex)))) {
+ Env.put(' ');
+ return One;
+ }
+ for (n = xNum(ex,x); n > 0; --n)
+ Env.put(' ');
+ return x;
+}
+
+// (print 'any ..) -> any
+any doPrint(any x) {
+ any y;
+
+ x = cdr(x), print(y = EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ space(), print(y = EVAL(car(x)));
+ return y;
+}
+
+// (printsp 'any ..) -> any
+any doPrintsp(any x) {
+ any y;
+
+ x = cdr(x);
+ do
+ print(y = EVAL(car(x))), space();
+ while (isCell(x = cdr(x)));
+ return y;
+}
+
+// (println 'any ..) -> any
+any doPrintln(any x) {
+ any y;
+
+ x = cdr(x), print(y = EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ space(), print(y = EVAL(car(x)));
+ crlf();
+ return y;
+}
+
+/* Save one expression */
+static void save(any x) {
+ any y, nm;
+
+ if (isNum(x))
+ outNum(unBox(x));
+ else if (isSym(x)) {
+ if (x == isIntern(nm = name(x), Intern))
+ prIntern(nm);
+ else if (num(y = val(x)) & 1) {
+ if (nm == txt(0))
+ Env.put('\\'), outNum((word)x/sizeof(cell));
+ else
+ prTransient(nm);
+ }
+ else {
+ *(long*)&val(x) |= 1;
+ if (x == y && nm != txt(0))
+ prTransient(nm);
+ else {
+ outString("\\(");
+ if (nm == txt(0))
+ outNum((word)x/sizeof(cell));
+ else
+ prTransient(nm);
+ space(), save(y);
+ for (y = tail(x); isCell(y); y = car(y))
+ space(), save(cdr(y));
+ Env.put(')');
+ }
+ }
+ }
+ else {
+ y = x;
+ Env.put('(');
+ while (save(car(x)), !isNil(x = cdr(x))) {
+ if (x == y) {
+ outString(" .");
+ break;
+ }
+ if (!isCell(x)) {
+ outString(" . ");
+ save(x);
+ break;
+ }
+ space();
+ }
+ Env.put(')');
+ }
+}
+
+// (save 'any) -> any
+any doSave(any x) {
+ any p;
+ heap *h;
+
+ x = cdr(x), save(x = EVAL(car(x))), crlf();
+ h = Heaps;
+ do {
+ p = h->cells + CELLS-1;
+ do
+ *(long*)&cdr(p) &= ~1;
+ while (--p >= h->cells);
+ } while (h = h->next);
+ return x;
+}
+
+// (flush) -> flg
+any doFlush(any ex __attribute__((unused))) {
+ return fflush(OutFile)? Nil : T;
+}
diff --git a/src/main.c b/src/main.c
@@ -0,0 +1,646 @@
+/* 15nov07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/* Globals */
+int Chr, Trace;
+char **AV, *Home;
+heap *Heaps;
+cell *Avail;
+stkEnv Env;
+catchFrame *CatchPtr;
+FILE *InFile, *OutFile;
+any TheKey, TheCls;
+any Intern[2], Transient[2], Reloc;
+any ApplyArgs, ApplyBody;
+any Nil, Meth, Quote, T, At, At2, At3, This;
+any Dbg, Scl, Class, Up, Err, Rst, Msg, Adr, Bye;
+
+static bool Jam;
+static jmp_buf ErrRst;
+
+
+/*** System ***/
+void giveup(char *msg) {
+ fprintf(stderr, "%s\n", msg);
+ exit(1);
+}
+
+void bye(int n) {
+ static bool b;
+
+ if (!b) {
+ b = YES;
+ unwind(NULL);
+ prog(val(Bye));
+ }
+ exit(n);
+}
+
+void execError(char *s) {
+ fprintf(stderr, "%s: can't exec\n", s);
+ exit(127);
+}
+
+/* Allocate memory */
+void *alloc(void *p, size_t siz) {
+ if (!(p = realloc(p,siz)))
+ giveup("No memory");
+ return p;
+}
+
+/* Allocate cell heap */
+void heapAlloc(void) {
+ heap *h;
+ cell *p;
+
+ h = (heap*)((long)alloc(NULL,
+ sizeof(heap) + sizeof(cell)) + (sizeof(cell)-1) & ~(sizeof(cell)-1) );
+ h->next = Heaps, Heaps = h;
+ p = h->cells + CELLS-1;
+ do
+ Free(p);
+ while (--p >= h->cells);
+}
+
+// (heap 'flg) -> num
+any doHeap(any x) {
+ long n = 0;
+
+ x = cdr(x);
+ if (isNil(EVAL(car(x)))) {
+ heap *h = Heaps;
+ do
+ ++n;
+ while (h = h->next);
+ return box(n);
+ }
+ for (x = Avail; x; x = car(x))
+ ++n;
+ return box(n / CELLS);
+}
+
+// (env ['lst] | ['sym 'val] ..) -> lst
+any doEnv(any x) {
+ int i;
+ bindFrame *p;
+ cell c1, c2;
+
+ Push(c1,Nil);
+ if (!isCell(x = cdr(x))) {
+ for (p = Env.bind; p; p = p->link) {
+ if (p->i == 0) {
+ for (i = p->cnt; --i >= 0;) {
+ for (x = data(c1); ; x = cdr(x)) {
+ if (!isCell(x)) {
+ data(c1) = cons(cons(p->bnd[i].sym, val(p->bnd[i].sym)), data(c1));
+ break;
+ }
+ if (caar(x) == p->bnd[i].sym)
+ break;
+ }
+ }
+ }
+ }
+ }
+ else {
+ do {
+ Push(c2, EVAL(car(x)));
+ if (isCell(data(c2))) {
+ do
+ data(c1) = cons(cons(car(data(c2)), val(car(data(c2)))), data(c1));
+ while (isCell(data(c2) = cdr(data(c2))));
+ }
+ else if (!isNil(data(c2))) {
+ x = cdr(x);
+ data(c1) = cons(cons(data(c2), EVAL(car(x))), data(c1));
+ }
+ drop(c2);
+ }
+ while (isCell(x = cdr(x)));
+ }
+ return Pop(c1);
+}
+
+// (up [cnt] sym ['val]) -> any
+any doUp(any x) {
+ any y, *val;
+ int cnt, i;
+ bindFrame *p;
+
+ x = cdr(x);
+ if (!isNum(y = car(x)))
+ cnt = 1;
+ else
+ cnt = (int)unBox(y), x = cdr(x), y = car(x);
+ for (p = Env.bind, val = &val(y); p; p = p->link) {
+ if (p->i <= 0) {
+ for (i = 0; i < p->cnt; ++i)
+ if (p->bnd[i].sym == y) {
+ if (!--cnt) {
+ if (isCell(x = cdr(x)))
+ return p->bnd[i].val = EVAL(car(x));
+ return p->bnd[i].val;
+ }
+ val = &p->bnd[i].val;
+ break;
+ }
+ }
+ }
+ if (isCell(x = cdr(x)))
+ return *val = EVAL(car(x));
+ return *val;
+}
+
+// (stk any ..) -> T
+any doStk(any x) {
+ any p;
+ FILE *oSave = OutFile;
+
+ OutFile = stderr;
+ print(cdr(x)), crlf();
+ for (p = Env.stack; p; p = cdr(p)) {
+ printf("%lX ", (word)p), fflush(stderr);
+ print(car(p)), crlf();
+ }
+ crlf();
+ OutFile = oSave;
+ return T;
+}
+
+/*** Primitives ***/
+/* Comparisons */
+bool equal(any x, any y) {
+ any a, b;
+
+ for (;;) {
+ if (x == y)
+ return YES;
+ if (isNum(x))
+ return NO;
+ if (isSym(x)) {
+ if (!isSymb(y))
+ return NO;
+ if ((x = name(x)) == (y = name(y)))
+ return x != txt(0);
+ if (isTxt(x) || isTxt(y))
+ return NO;
+ do {
+ if (num(tail(x)) != num(tail(y)))
+ return NO;
+ x = val(x), y = val(y);
+ } while (!isNum(x) && !isNum(y));
+ return x == y;
+ }
+ if (!isCell(y))
+ return NO;
+ while (car(x) == Quote) {
+ if (car(y) != Quote)
+ return NO;
+ if (x == cdr(x))
+ return y == cdr(y);
+ if (y == cdr(y))
+ return NO;
+ if (!isCell(x = cdr(x)))
+ return equal(x, cdr(y));
+ if (!isCell(y = cdr(y)))
+ return NO;
+ }
+ a = x, b = y;
+ for (;;) {
+ if (!equal(car(x), car(y)))
+ return NO;
+ if (!isCell(x = cdr(x)))
+ return equal(x, cdr(y));
+ if (!isCell(y = cdr(y)))
+ return NO;
+ if (x == a && y == b)
+ return YES;
+ }
+ }
+}
+
+int compare(any x, any y) {
+ any a, b;
+
+ if (x == y)
+ return 0;
+ if (isNil(x))
+ return -1;
+ if (x == T)
+ return +1;
+ if (isNum(x)) {
+ if (!isNum(y))
+ return isNil(y)? +1 : -1;
+ return num(x) - num(y);
+ }
+ if (isSym(x)) {
+ int c, d, i, j;
+ word w, v;
+
+ if (isNum(y) || isNil(y))
+ return +1;
+ if (isCell(y) || y == T)
+ return -1;
+ a = name(x), b = name(y);
+ if (a == txt(0) && b == txt(0))
+ return 1664525*(int32_t)(long)x - 1664525*(int32_t)(long)y;
+ if ((c = getByte1(&i, &w, &a)) == (d = getByte1(&j, &v, &b)))
+ do
+ if (c == 0)
+ return 0;
+ while ((c = getByte(&i, &w, &a)) == (d = getByte(&j, &v, &b)));
+ return c - d;
+ }
+ if (!isCell(y))
+ return y == T? -1 : +1;
+ a = x, b = y;
+ for (;;) {
+ int n;
+
+ if (n = compare(car(x),car(y)))
+ return n;
+ if (!isCell(x = cdr(x)))
+ return compare(x, cdr(y));
+ if (!isCell(y = cdr(y)))
+ return y == T? -1 : +1;
+ if (x == a && y == b)
+ return 0;
+ }
+}
+
+/*** Error handling ***/
+static void reset(void) {
+ unwind(NULL);
+ Env.stack = NULL;
+ Env.meth = NULL;
+ Env.next = -1;
+ Env.make = NULL;
+ Env.parser = NULL;
+ Trace = 0;
+}
+
+void err(any ex, any x, char *fmt, ...) {
+ va_list ap;
+ char msg[240];
+ outFrame f;
+
+ Chr = 0;
+ Reloc = Nil;
+ Env.brk = NO;
+ f.fp = stderr;
+ pushOutFiles(&f);
+ while (*AV && strcmp(*AV,"-") != 0)
+ ++AV;
+ if (ex)
+ outString("!? "), print(val(Up) = ex), crlf();
+ if (x)
+ print(x), outString(" -- ");
+ va_start(ap,fmt);
+ vsnprintf(msg, sizeof(msg), fmt, ap);
+ va_end(ap);
+ if (msg[0]) {
+ outString(msg), crlf();
+ val(Msg) = mkStr(msg);
+ if (!isNil(val(Err)) && !Jam)
+ Jam = YES, prog(val(Err)), Jam = NO;
+ if (!isNil(val(Rst)))
+ reset(), longjmp(ErrRst, -1);
+ load(NULL, '?', Nil);
+ }
+ reset();
+ longjmp(ErrRst, +1);
+}
+
+// (quit ['any ['any]])
+any doQuit(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, evSym(x));
+ x = isCell(x = cdr(x))? EVAL(car(x)) : NULL;
+ {
+ char msg[bufSize(data(c1))];
+
+ bufString(data(c1), msg);
+ drop(c1);
+ err(NULL, x, "%s", msg);
+ }
+}
+
+void argError(any ex, any x) {err(ex, x, "Bad argument");}
+void numError(any ex, any x) {err(ex, x, "Number expected");}
+void symError(any ex, any x) {err(ex, x, "Symbol expected");}
+void cellError(any ex, any x) {err(ex, x, "Cell expected");}
+void atomError(any ex, any x) {err(ex, x, "Atom expected");}
+void lstError(any ex, any x) {err(ex, x, "List expected");}
+void varError(any ex, any x) {err(ex, x, "Variable expected");}
+void protError(any ex, any x) {err(ex, x, "Protected symbol");}
+
+void unwind(catchFrame *p) {
+ int i;
+ catchFrame *q;
+ cell c1;
+
+ while (CatchPtr) {
+ q = CatchPtr, CatchPtr = CatchPtr->link;
+ while (Env.bind != q->env.bind) {
+ if (Env.bind->i == 0)
+ for (i = Env.bind->cnt; --i >= 0;)
+ val(Env.bind->bnd[i].sym) = Env.bind->bnd[i].val;
+ Env.bind = Env.bind->link;
+ }
+ while (Env.inFiles != q->env.inFiles)
+ popInFiles();
+ while (Env.outFiles != q->env.outFiles)
+ popOutFiles();
+ Env = q->env;
+ if (q == p)
+ return;
+ if (!isSym(q->tag)) {
+ Push(c1, q->tag);
+ EVAL(data(c1));
+ drop(c1);
+ }
+ }
+ while (Env.bind) {
+ if (Env.bind->i == 0)
+ for (i = Env.bind->cnt; --i >= 0;)
+ val(Env.bind->bnd[i].sym) = Env.bind->bnd[i].val;
+ Env.bind = Env.bind->link;
+ }
+ while (Env.inFiles)
+ popInFiles();
+ while (Env.outFiles)
+ popOutFiles();
+}
+
+/*** Evaluation ***/
+any evExpr(any expr, any x) {
+ any y = car(expr);
+ struct { // bindFrame
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[length(y)+2];
+ } f;
+
+ f.link = Env.bind, Env.bind = (bindFrame*)&f;
+ f.i = sizeof(f.bnd) / (2*sizeof(any)) - 1;
+ f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
+ while (isCell(y)) {
+ f.bnd[f.cnt].sym = car(y);
+ f.bnd[f.cnt].val = EVAL(car(x));
+ ++f.cnt, x = cdr(x), y = cdr(y);
+ }
+ if (isNil(y)) {
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ x = prog(cdr(expr));
+ }
+ else if (y != At) {
+ f.bnd[f.cnt].sym = y, f.bnd[f.cnt++].val = val(y), val(y) = x;
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ x = prog(cdr(expr));
+ }
+ else {
+ int n, cnt;
+ cell *arg;
+ cell c[n = cnt = length(x)];
+
+ while (--n >= 0)
+ Push(c[n], EVAL(car(x))), x = cdr(x);
+ while (--f.i > 0) {
+ x = val(f.bnd[f.i].sym);
+ val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+ f.bnd[f.i].val = x;
+ }
+ n = Env.next, Env.next = cnt;
+ arg = Env.arg, Env.arg = c;
+ x = prog(cdr(expr));
+ if (cnt)
+ drop(c[cnt-1]);
+ Env.arg = arg, Env.next = n;
+ }
+ while (--f.cnt >= 0)
+ val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+ Env.bind = f.link;
+ return x;
+}
+
+void undefined(any x, any ex) {err(ex, x, "Undefined");}
+
+/* Evaluate a list */
+any evList(any ex) {
+ any foo;
+
+ if (isNum(foo = car(ex)))
+ return ex;
+ if (isCell(foo)) {
+ if (isNum(foo = evList(foo)))
+ return evSubr(foo,ex);
+ if (isCell(foo))
+ return evExpr(foo, cdr(ex));
+ }
+ for (;;) {
+ if (isNil(val(foo)))
+ undefined(foo,ex);
+ if (isNum(foo = val(foo)))
+ return evSubr(foo,ex);
+ if (isCell(foo))
+ return evExpr(foo, cdr(ex));
+ }
+}
+
+/* Evaluate number */
+long evNum(any ex, any x) {return xNum(ex, EVAL(car(x)));}
+
+long xNum(any ex, any x) {
+ NeedNum(ex,x);
+ return unBox(x);
+}
+
+/* Evaluate any to sym */
+any evSym(any x) {return xSym(EVAL(car(x)));}
+
+any xSym(any x) {
+ int i;
+ word w;
+ any y;
+ cell c1, c2;
+
+ if (isSymb(x))
+ return x;
+ Push(c1,x);
+ putByte0(&i, &w, &y);
+ i = 0, pack(x, &i, &w, &y, &c2);
+ y = popSym(i, w, y, &c2);
+ drop(c1);
+ return i? y : Nil;
+}
+
+any boxSubr(fun f) {
+ if (num(f) & 3)
+ giveup("Unaligned Function");
+ return (any)(num(f) | 2);
+}
+
+// (args) -> flg
+any doArgs(any ex __attribute__((unused))) {
+ return Env.next > 0? T : Nil;
+}
+
+// (next) -> any
+any doNext(any ex __attribute__((unused))) {
+ if (Env.next > 0)
+ return data(Env.arg[--Env.next]);
+ if (Env.next == 0)
+ Env.next = -1;
+ return Nil;
+}
+
+// (arg ['cnt]) -> any
+any doArg(any ex) {
+ long n;
+
+ if (Env.next < 0)
+ return Nil;
+ if (!isCell(cdr(ex)))
+ return data(Env.arg[Env.next]);
+ if ((n = evNum(ex,cdr(ex))) > 0 && n <= Env.next)
+ return data(Env.arg[Env.next - n]);
+ return Nil;
+}
+
+// (rest) -> lst
+any doRest(any x) {
+ int i;
+ cell c1;
+
+ if ((i = Env.next) <= 0)
+ return Nil;
+ Push(c1, x = cons(data(Env.arg[--i]), Nil));
+ while (i)
+ x = cdr(x) = cons(data(Env.arg[--i]), Nil);
+ return Pop(c1);
+}
+
+any mkDat(int y, int m, int d) {
+ int n;
+ static char mon[13] = {31,31,28,31,30,31,30,31,31,30,31,30,31};
+
+ if (m<1 || m>12 || d<1 || d>mon[m] && (m!=2 || d!=29 || y%4 || !(y%100) && y%400))
+ return Nil;
+ n = (12*y + m - 3) / 12;
+ return box((4404*y+367*m-1094)/12 - 2*n + n/4 - n/100 + n/400 + d);
+}
+
+// (date 'dat) -> (y m d)
+// (date 'y 'm 'd) -> dat | NIL
+// (date '(y m d)) -> dat | NIL
+any doDate(any ex) {
+ any x, z;
+ int y, m, d, n;
+ cell c1;
+
+ x = cdr(ex);
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ if (isNum(z) && !isCell(x = cdr(x))) {
+ n = xNum(ex,z);
+ y = (100*n - 20) / 3652425;
+ n += (y - y/4);
+ y = (100*n - 20) / 36525;
+ n -= 36525*y / 100;
+ m = (10*n - 5) / 306;
+ d = (10*n - 306*m + 5) / 10;
+ if (m < 10)
+ m += 3;
+ else
+ ++y, m -= 9;
+ Push(c1, cons(box(d), Nil));
+ data(c1) = cons(box(m), data(c1));
+ data(c1) = cons(box(y), data(c1));
+ return Pop(c1);
+ }
+ if (!isCell(z))
+ return mkDat(xNum(ex,z), evNum(ex,x), evNum(ex,cdr(x)));
+ return mkDat(xNum(ex, car(z)), xNum(ex, cadr(z)), xNum(ex, caddr(z)));
+}
+
+// (argv [sym ..] [. sym]) -> lst|sym
+any doArgv(any ex) {
+ any x, y;
+ char **p;
+ cell c1;
+
+ if (*(p = AV) && strcmp(*p,"-") == 0)
+ ++p;
+ if (isNil(x = cdr(ex))) {
+ if (!*p)
+ return Nil;
+ Push(c1, x = cons(mkStr(*p++), Nil));
+ while (*p)
+ x = cdr(x) = cons(mkStr(*p++), Nil);
+ return Pop(c1);
+ }
+ do {
+ if (!isCell(x)) {
+ NeedSymb(ex,x);
+ if (!*p)
+ return val(x) = Nil;
+ Push(c1, y = cons(mkStr(*p++), Nil));
+ while (*p)
+ y = cdr(y) = cons(mkStr(*p++), Nil);
+ return val(x) = Pop(c1);
+ }
+ y = car(x);
+ NeedSymb(ex,y);
+ val(y) = *p? mkStr(*p++) : Nil;
+ } while (!isNil(x = cdr(x)));
+ return val(y);
+}
+
+// (opt) -> sym
+any doOpt(any ex __attribute__((unused))) {
+ return *AV && strcmp(*AV,"-")? mkStr(*AV++) : Nil;
+}
+
+/*** Main ***/
+int main(int ac, char *av[]) {
+ int i;
+ char *p;
+
+ for (i = 1; i < ac; ++i)
+ if (*av[i] != '-') {
+ if ((p = strrchr(av[i], '/')) && !(p == av[i]+1 && *av[i] == '.')) {
+ Home = malloc(p - av[i] + 2);
+ memcpy(Home, av[i], p - av[i] + 1);
+ Home[p - av[i] + 1] = '\0';
+ }
+ break;
+ }
+ AV = av+1;
+ heapAlloc();
+ initSymbols();
+ Reloc = Nil;
+ InFile = stdin, Env.get = getStdin;
+ OutFile = stdout, Env.put = putStdout;
+ ApplyArgs = cons(cons(consSym(Nil,0), Nil), Nil);
+ ApplyBody = cons(Nil,Nil);
+ if (setjmp(ErrRst) < 0)
+ prog(val(Rst));
+ else {
+ while (*AV && strcmp(*AV,"-") != 0)
+ load(NULL, 0, mkStr(*AV++));
+ load(NULL, ':', Nil);
+ }
+ bye(0);
+}
diff --git a/src/math.c b/src/math.c
@@ -0,0 +1,484 @@
+/* 01apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static void divErr(any ex) {err(ex,NULL,"Div/0");}
+
+/* Number of bytes */
+int numBytes(any x) {
+ int n = 4;
+ word w = (word)x >> 2;
+
+ if ((w & 0xFF000000) == 0) {
+ --n;
+ if ((w & 0xFF0000) == 0) {
+ --n;
+ if ((w & 0xFF00) == 0)
+ --n;
+ }
+ }
+ return n;
+}
+
+/* Make number from symbol */
+any symToNum(any s, int scl, int sep, int ign) {
+ unsigned c;
+ int i;
+ word w;
+ bool sign, frac;
+ long n;
+
+ if (!(c = getByte1(&i, &w, &s)))
+ return NULL;
+ while (c <= ' ') /* Skip white space */
+ if (!(c = getByte(&i, &w, &s)))
+ return NULL;
+ sign = NO;
+ if (c == '+' || c == '-' && (sign = YES))
+ if (!(c = getByte(&i, &w, &s)))
+ return NULL;
+ if ((c -= '0') > 9)
+ return NULL;
+ frac = NO;
+ n = c;
+ while ((c = getByte(&i, &w, &s)) && (!frac || scl)) {
+ if ((int)c == sep) {
+ if (frac)
+ return NULL;
+ frac = YES;
+ }
+ else if ((int)c != ign) {
+ if ((c -= '0') > 9)
+ return NULL;
+ n = n * 10 + c;
+ if (frac)
+ --scl;
+ }
+ }
+ if (c) {
+ if ((c -= '0') > 9)
+ return NULL;
+ if (c >= 5)
+ n += 1;
+ while (c = getByte(&i, &w, &s)) {
+ if ((c -= '0') > 9)
+ return NULL;
+ }
+ }
+ if (frac)
+ while (--scl >= 0)
+ n *= 10;
+ return box(sign? -n : n);
+}
+
+/* Make symbol from number */
+any numToSym(any x, int scl, int sep, int ign) {
+ int i;
+ word w;
+ cell c1;
+ long n;
+ byte *p, buf[BITS/2];
+
+ n = unBox(x);
+ putByte0(&i, &w, &x);
+ if (n < 0) {
+ n = -n;
+ putByte('-', &i, &w, &x, &c1);
+ }
+ for (p = buf;;) {
+ *p = n % 10;
+ if ((n /= 10) == 0)
+ break;
+ ++p;
+ }
+ if ((scl = p - buf - scl) < 0) {
+ putByte('0', &i, &w, &x, &c1);
+ putByte(sep, &i, &w, &x, &c1);
+ while (scl < -1)
+ putByte('0', &i, &w, &x, &c1), ++scl;
+ }
+ for (;;) {
+ putByte(*p + '0', &i, &w, &x, &c1);
+ if (--p < buf)
+ return popSym(i, w, x, &c1);
+ if (scl == 0)
+ putByte(sep, &i, &w, &x, &c1);
+ else if (ign && scl > 0 && scl % 3 == 0)
+ putByte(ign, &i, &w, &x, &c1);
+ --scl;
+ }
+}
+
+// (format 'num ['num ['sym1 ['sym2]]]) -> sym
+// (format 'sym ['num ['sym1 ['sym2]]]) -> num
+any doFormat(any ex) {
+ int scl, sep, ign;
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedAtom(ex,data(c1));
+ x = cdr(x), y = EVAL(car(x));
+ scl = isNil(y)? 0 : xNum(ex, y);
+ sep = '.';
+ ign = 0;
+ if (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ NeedSymb(ex,y);
+ sep = firstByte(y);
+ if (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ NeedSymb(ex,y);
+ ign = firstByte(y);
+ }
+ }
+ data(c1) = isNum(data(c1))?
+ numToSym(data(c1), scl, sep, ign) :
+ symToNum(name(data(c1)), scl, sep, ign) ?: Nil;
+ return Pop(c1);
+}
+
+// (+ 'num ..) -> num
+any doAdd(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n += unBox(y);
+ }
+ return box(n);
+}
+
+// (- 'num ..) -> num
+any doSub(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ if (!isCell(x = cdr(x)))
+ return box(-n);
+ do {
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n -= unBox(y);
+ } while (isCell(x = cdr(x)));
+ return box(n);
+}
+
+// (inc 'num) -> num
+// (inc 'var ['num]) -> num
+any doInc(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex);
+ if (isNil(data(c1) = EVAL(car(x))))
+ return Nil;
+ if (isNum(data(c1)))
+ return (any)(num(data(c1)) + 4);
+ CheckVar(ex,data(c1));
+ if (!isCell(x = cdr(x))) {
+ if (isNil(val(data(c1))))
+ return Nil;
+ NeedNum(ex,val(data(c1)));
+ val(data(c1)) = (any)(num(val(data(c1))) + 4);
+ }
+ else {
+ Save(c1);
+ y = EVAL(car(x));
+ drop(c1);
+ if (isNil(val(data(c1))) || isNil(y))
+ return Nil;
+ NeedNum(ex,val(data(c1)));
+ NeedNum(ex,y);
+ val(data(c1)) = box(unBox(val(data(c1))) + unBox(y));
+ }
+ return val(data(c1));
+}
+
+// (dec 'num) -> num
+// (dec 'var ['num]) -> num
+any doDec(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex);
+ if (isNil(data(c1) = EVAL(car(x))))
+ return Nil;
+ if (isNum(data(c1)))
+ return (any)(num(data(c1)) - 4);
+ CheckVar(ex,data(c1));
+ if (!isCell(x = cdr(x))) {
+ if (isNil(val(data(c1))))
+ return Nil;
+ NeedNum(ex,val(data(c1)));
+ val(data(c1)) = (any)(num(val(data(c1))) - 4);
+ }
+ else {
+ Save(c1);
+ y = EVAL(car(x));
+ drop(c1);
+ if (isNil(val(data(c1))) || isNil(y))
+ return Nil;
+ NeedNum(ex,val(data(c1)));
+ NeedNum(ex,y);
+ val(data(c1)) = box(unBox(val(data(c1))) - unBox(y));
+ }
+ return val(data(c1));
+}
+
+// (* 'num ..) -> num
+any doMul(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n *= unBox(y);
+ }
+ return box(n);
+}
+
+// (*/ 'num1 ['num2 ..] 'num3) -> num
+any doMulDiv(any ex) {
+ any x, y;
+ long long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ for (;;) {
+ x = cdr(x);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ if (!isCell(cdr(x)))
+ break;
+ n *= unBox(y);
+ }
+ if (y == Zero)
+ divErr(ex);
+ return box((long)((n + unBox(y)/2) / unBox(y)));
+}
+
+// (/ 'num ..) -> num
+any doDiv(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ if (y == Zero)
+ divErr(ex);
+ n /= unBox(y);
+ }
+ return box(n);
+}
+
+// (% 'num ..) -> num
+any doRem(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ n = unBox(y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ if (y == Zero)
+ divErr(ex);
+ n %= unBox(y);
+ }
+ return box(n);
+}
+
+// (>> 'num 'num) -> num
+any doShift(any ex) {
+ any x, y;
+ long n;
+
+ x = cdr(ex), n = evNum(ex,x);
+ x = cdr(x);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ if (n > 0)
+ return box(unBox(y) >> n);
+ return box(unBox(y) << -n);
+}
+
+// (lt0 'any) -> num | NIL
+any doLt0(any x) {
+ x = cdr(x);
+ return isNum(x = EVAL(car(x))) && num(x)<0? x : Nil;
+}
+
+// (ge0 'any) -> num | NIL
+any doGe0(any x) {
+ x = cdr(x);
+ return isNum(x = EVAL(car(x))) && num(x)>=0? x : Nil;
+}
+
+// (gt0 'any) -> num | NIL
+any doGt0(any x) {
+ x = cdr(x);
+ return isNum(x = EVAL(car(x))) && num(x)>num(Zero)? x : Nil;
+}
+
+// (abs 'num) -> num
+any doAbs(any ex) {
+ any x;
+
+ x = cdr(ex);
+ if (isNil(x = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,x);
+ return num(x)<0? box(-unBox(x)) : x;
+}
+
+// (bit? 'num ..) -> num | NIL
+any doBitQ(any ex) {
+ any x, y, z;
+
+ x = cdr(ex), y = EVAL(car(x));
+ NeedNum(ex,y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,z);
+ if ((unBox(y) & unBox(z)) != unBox(y))
+ return Nil;
+ }
+ return y;
+}
+
+// (& 'num ..) -> num
+any doBitAnd(any ex) {
+ any x, y, z;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,z);
+ y = box(unBox(y) & unBox(z));
+ }
+ return y;
+}
+
+// (| 'num ..) -> num
+any doBitOr(any ex) {
+ any x, y, z;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,z);
+ y = box(unBox(y) | unBox(z));
+ }
+ return y;
+}
+
+// (x| 'num ..) -> num
+any doBitXor(any ex) {
+ any x, y, z;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,y);
+ while (isCell(x = cdr(x))) {
+ if (isNil(z = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,z);
+ y = box(unBox(y) ^ unBox(z));
+ }
+ return y;
+}
+
+// (sqrt 'num) -> num
+any doSqrt(any ex) {
+ any x;
+ long a, b, n, r;
+
+ x = cdr(ex);
+ if (isNil(x = EVAL(car(x))))
+ return Nil;
+ NeedNum(ex,x);
+ if ((n = unBox(x)) < 0)
+ err(ex, x, "Bad argument");
+ r = 0;
+ a = 1L << 28;
+ do {
+ b = r + a;
+ r >>= 1;
+ if (b <= n)
+ n -= b, r += a;
+ } while (a >>= 2);
+ return box(r);
+}
+
+static u_int64_t Seed;
+#define hi(t) (word)((t) >> 32)
+
+// (seed 'num) -> num
+any doSeed(any ex) {
+ return box(hi(Seed = evNum(ex,cdr(ex)) * 6364136223846793005LL + 1));
+}
+
+// (rand ['num1 'num2] | ['T]) -> num | flg
+any doRand(any ex) {
+ any x;
+ long n;
+
+ x = cdr(ex);
+ Seed = Seed * 6364136223846793005LL + 1;
+ if (isNil(x = EVAL(car(x))))
+ return box(hi(Seed));
+ if (x == T)
+ return hi(Seed) & 1 ? T : Nil;
+ n = xNum(ex,x);
+ return box(n + hi(Seed) % (evNum(ex,cddr(ex)) + 1 - n));
+}
diff --git a/src/mod.fn b/src/mod.fn
@@ -0,0 +1,9 @@
+#include "mod/buddy.ffi.fn"
+#include "mod/queens.ffi.fn"
+#include "mod/gtk.ffi.fn"
+#include "mod/gl.ffi.fn"
+#include "mod/glu.ffi.fn"
+#include "mod/glut.ffi.fn"
+#include "mod/glut.fn"
+#include "mod/gmpx.fn"
+#include "mod/gmp.ffi.fn"
diff --git a/src/mod.h b/src/mod.h
@@ -0,0 +1,9 @@
+#include "mod/buddy.ffi.h"
+#include "mod/queens.ffi.h"
+#include "mod/gtk.ffi.h"
+#include "mod/gl.ffi.h"
+#include "mod/glu.ffi.h"
+#include "mod/glut.ffi.h"
+#include "mod/glut.h"
+#include "mod/gmpx.h"
+#include "mod/gmp.ffi.h"
diff --git a/src/mod/buddy-test.l b/src/mod/buddy-test.l
@@ -0,0 +1,8 @@
+(de and-graph (filename)
+ (bdd_init 1000 1000)
+ (bdd_setvarnum 2)
+ (bdd_and (bdd_ithvar 0) (bdd_ithvar 1))
+ (bdd_fnprintdot filename (bdd_and (bdd_ithvar 0) (bdd_ithvar 1)))
+ (bdd_done))
+
+(and-graph "/tmp/and.dot")
diff --git a/src/mod/buddy.ffi b/src/mod/buddy.ffi
@@ -0,0 +1,142 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'buddy)
+#(module 'buddy '((X) (pack "buddy:" (cddddr (chop X)))))
+
+(include "bdd.h")
+
+(put 'cwrap 'BDD (get 'cwrap 'int))
+(put 'cwrap 'bddPair* (get 'cwrap 'void*))
+
+(put 'cbody 'BDD (get 'cbody 'int))
+(put 'cbody 'bddPair* (get 'cbody 'void*))
+
+#typedef void (*bddinthandler)(int);
+#typedef void (*bddgbchandler)(int,bddGbcStat*);
+#typedef void (*bdd2inthandler)(int,int);
+#typedef int (*bddsizehandler)(void);
+#typedef void (*bddfilehandler)(FILE *, int);
+#typedef void (*bddallsathandler)(char*, int);
+
+#extern bddinthandler bdd_error_hook(bddinthandler);
+#extern bddgbchandler bdd_gbc_hook(bddgbchandler);
+#extern bdd2inthandler bdd_resize_hook(bdd2inthandler);
+#extern bddinthandler bdd_reorder_hook(bddinthandler);
+#extern bddfilehandler bdd_file_hook(bddfilehandler);
+
+(cfun int bdd_init int int)
+(cfun void bdd_done)
+(cfun int bdd_setvarnum int)
+(cfun int bdd_extvarnum int)
+(cfun int bdd_isrunning)
+(cfun int bdd_setmaxnodenum int)
+(cfun int bdd_setmaxincrease int)
+(cfun int bdd_setminfreenodes int)
+(cfun int bdd_getnodenum)
+(cfun int bdd_getallocnum)
+(cfun cstr bdd_versionstr)
+(cfun int bdd_versionnum)
+#(cfun void bdd_stats(bddStat*)
+#(cfun void bdd_cachestats(bddCacheStat*)
+#(cfun void bdd_fprintstat(FILE*)
+(cfun void bdd_printstat)
+#(cfun void bdd_default_gbchandler int bddGbcStat*)
+(cfun void bdd_default_errhandler int)
+(cfun cstr bdd_errstring int)
+(cfun void bdd_clear_error)
+(cfun int bdd_true)
+(cfun int bdd_false)
+(cfun int bdd_varnum)
+(cfun BDD bdd_ithvar int)
+(cfun BDD bdd_nithvar int)
+(cfun int bdd_var BDD)
+(cfun BDD bdd_low BDD)
+(cfun BDD bdd_high BDD)
+(cfun BDD bdd_addref BDD)
+(cfun BDD bdd_delref BDD)
+(cfun void bdd_gbc)
+#(cfun int bdd_scanset BDD int** int*)
+#(cfun BDD bdd_makeset int* int)
+(cfun bddPair* bdd_newpair)
+(cfun int bdd_setpair bddPair* int int)
+#(cfun int bdd_setpairs(bddPair* int* int* int)
+(cfun int bdd_setbddpair bddPair* int BDD)
+#(cfun int bdd_setbddpairs(bddPair* int* BDD* int)
+(cfun void bdd_resetpair bddPair*)
+(cfun void bdd_freepair bddPair*)
+
+(cfun int bdd_setcacheratio int)
+#(cfun BDD bdd_buildcube int int BDD*)
+#(cfun BDD bdd_ibuildcube int int int*)
+(cfun BDD bdd_not BDD)
+(cfun BDD bdd_apply BDD BDD int)
+(cfun BDD bdd_and BDD BDD)
+(cfun BDD bdd_or BDD BDD)
+(cfun BDD bdd_xor BDD BDD)
+(cfun BDD bdd_imp BDD BDD)
+(cfun BDD bdd_biimp BDD BDD)
+(cfun BDD bdd_ite BDD BDD BDD)
+(cfun BDD bdd_restrict BDD BDD)
+(cfun BDD bdd_constrain BDD BDD)
+(cfun BDD bdd_replace BDD bddPair*)
+(cfun BDD bdd_compose BDD BDD BDD)
+(cfun BDD bdd_veccompose BDD bddPair*)
+(cfun BDD bdd_simplify BDD BDD)
+(cfun BDD bdd_exist BDD BDD)
+(cfun BDD bdd_forall BDD BDD)
+(cfun BDD bdd_unique BDD BDD)
+(cfun BDD bdd_appex BDD BDD int BDD)
+(cfun BDD bdd_appall BDD BDD int BDD)
+(cfun BDD bdd_appuni BDD BDD int BDD)
+(cfun BDD bdd_support BDD)
+(cfun BDD bdd_satone BDD)
+(cfun BDD bdd_satoneset BDD BDD BDD)
+(cfun BDD bdd_fullsatone BDD)
+#(cfun void bdd_allsat BDD r bddallsathandler handler)
+#(cfun double bdd_satcount BDD)
+#(cfun double bdd_satcountset BDD BDD)
+#(cfun double bdd_satcountln BDD)
+#(cfun double bdd_satcountlnset BDD BDD)
+(cfun int bdd_nodecount BDD)
+#(cfun int bdd_anodecount BDD* int)
+#(cfun int* bdd_varprofile BDD)
+#(cfun double bdd_pathcount BDD)
+
+(cfun void bdd_printall)
+#(cfun void bdd_fprintall(FILE*)
+#(cfun void bdd_fprinttable(FILE*, BDD)
+(cfun void bdd_printtable BDD)
+#(cfun void bdd_fprintset(FILE*, BDD)
+(cfun void bdd_printset BDD)
+(cfun int bdd_fnprintdot cstr BDD)
+#(cfun void bdd_fprintdot(FILE*, BDD)
+(cfun void bdd_printdot BDD)
+(cfun int bdd_fnsave cstr BDD)
+#(cfun int bdd_save(FILE*, BDD)
+#(cfun int bdd_fnload cstr BDD*)
+#(cfun int bdd_load(FILE*ifile, BDD*)
+
+(cfun int bdd_swapvar int int)
+(cfun void bdd_default_reohandler int)
+(cfun void bdd_reorder int)
+(cfun int bdd_reorder_gain)
+#cfun bddsizehandler bdd_reorder_probe(bddsizehandler)
+(cfun void bdd_clrvarblocks)
+(cfun int bdd_addvarblock BDD int)
+(cfun int bdd_intaddvarblock int int int)
+(cfun void bdd_varblockall)
+#cfun bddfilehandler bdd_blockfile_hook(bddfilehandler)
+(cfun int bdd_autoreorder int)
+(cfun int bdd_autoreorder_times int int)
+(cfun int bdd_var2level int)
+(cfun int bdd_level2var int)
+(cfun int bdd_getreorder_times)
+(cfun int bdd_getreorder_method)
+(cfun void bdd_enable_reorder)
+(cfun void bdd_disable_reorder)
+(cfun int bdd_reorder_verbose int)
+#(cfun void bdd_setvarorder int*)
+(cfun void bdd_printorder)
+#(cfun void bdd_fprintorder(FILE*)
diff --git a/src/mod/buddy.ffi.c b/src/mod/buddy.ffi.c
@@ -0,0 +1,885 @@
+/* Generated from buddy.ffi */
+
+#include "../pico.h"
+
+#include "bdd.h"
+
+any cfun_bdd_init(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ int z = bdd_init(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_done(any ex __attribute__((unused))) {
+ bdd_done();
+ return Nil;
+}
+
+any cfun_bdd_setvarnum(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_setvarnum(b1);
+ return box(z);
+}
+
+any cfun_bdd_extvarnum(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_extvarnum(b1);
+ return box(z);
+}
+
+any cfun_bdd_isrunning(any ex __attribute__((unused))) {
+ int z = bdd_isrunning();
+ return box(z);
+}
+
+any cfun_bdd_setmaxnodenum(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_setmaxnodenum(b1);
+ return box(z);
+}
+
+any cfun_bdd_setmaxincrease(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_setmaxincrease(b1);
+ return box(z);
+}
+
+any cfun_bdd_setminfreenodes(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_setminfreenodes(b1);
+ return box(z);
+}
+
+any cfun_bdd_getnodenum(any ex __attribute__((unused))) {
+ int z = bdd_getnodenum();
+ return box(z);
+}
+
+any cfun_bdd_getallocnum(any ex __attribute__((unused))) {
+ int z = bdd_getallocnum();
+ return box(z);
+}
+
+any cfun_bdd_versionstr(any ex __attribute__((unused))) {
+ char* z = bdd_versionstr();
+ return mkStr(z);
+}
+
+any cfun_bdd_versionnum(any ex __attribute__((unused))) {
+ int z = bdd_versionnum();
+ return box(z);
+}
+
+any cfun_bdd_printstat(any ex __attribute__((unused))) {
+ bdd_printstat();
+ return Nil;
+}
+
+any cfun_bdd_default_errhandler(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ bdd_default_errhandler(b1);
+ return Nil;
+}
+
+any cfun_bdd_errstring(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ char* z = bdd_errstring(b1);
+ return mkStr(z);
+}
+
+any cfun_bdd_clear_error(any ex __attribute__((unused))) {
+ bdd_clear_error();
+ return Nil;
+}
+
+any cfun_bdd_true(any ex __attribute__((unused))) {
+ int z = bdd_true();
+ return box(z);
+}
+
+any cfun_bdd_false(any ex __attribute__((unused))) {
+ int z = bdd_false();
+ return box(z);
+}
+
+any cfun_bdd_varnum(any ex __attribute__((unused))) {
+ int z = bdd_varnum();
+ return box(z);
+}
+
+any cfun_bdd_ithvar(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ BDD z = bdd_ithvar(b1);
+ return box(z);
+}
+
+any cfun_bdd_nithvar(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ BDD z = bdd_nithvar(b1);
+ return box(z);
+}
+
+any cfun_bdd_var(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ int z = bdd_var(b1);
+ return box(z);
+}
+
+any cfun_bdd_low(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_low(b1);
+ return box(z);
+}
+
+any cfun_bdd_high(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_high(b1);
+ return box(z);
+}
+
+any cfun_bdd_addref(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_addref(b1);
+ return box(z);
+}
+
+any cfun_bdd_delref(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_delref(b1);
+ return box(z);
+}
+
+any cfun_bdd_gbc(any ex __attribute__((unused))) {
+ bdd_gbc();
+ return Nil;
+}
+
+any cfun_bdd_newpair(any ex __attribute__((unused))) {
+ bddPair* z = bdd_newpair();
+ return box(z);
+}
+
+any cfun_bdd_setpair(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b1 = (bddPair*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ int z = bdd_setpair(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_setbddpair(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b1 = (bddPair*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b3 = (BDD) unBox(y);
+ int z = bdd_setbddpair(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_resetpair(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b1 = (bddPair*) unBox(y);
+ bdd_resetpair(b1);
+ return Nil;
+}
+
+any cfun_bdd_freepair(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b1 = (bddPair*) unBox(y);
+ bdd_freepair(b1);
+ return Nil;
+}
+
+any cfun_bdd_setcacheratio(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_setcacheratio(b1);
+ return box(z);
+}
+
+any cfun_bdd_not(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_not(b1);
+ return box(z);
+}
+
+any cfun_bdd_apply(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ BDD z = bdd_apply(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_and(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_and(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_or(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_or(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_xor(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_xor(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_imp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_imp(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_biimp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_biimp(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_ite(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b3 = (BDD) unBox(y);
+ BDD z = bdd_ite(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_restrict(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_restrict(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_constrain(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_constrain(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_replace(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b2 = (bddPair*) unBox(y);
+ BDD z = bdd_replace(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_compose(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b3 = (BDD) unBox(y);
+ BDD z = bdd_compose(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_veccompose(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ bddPair* b2 = (bddPair*) unBox(y);
+ BDD z = bdd_veccompose(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_simplify(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_simplify(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_exist(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_exist(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_forall(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_forall(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_unique(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ BDD z = bdd_unique(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_appex(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b4 = (BDD) unBox(y);
+ BDD z = bdd_appex(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_bdd_appall(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b4 = (BDD) unBox(y);
+ BDD z = bdd_appall(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_bdd_appuni(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b4 = (BDD) unBox(y);
+ BDD z = bdd_appuni(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_bdd_support(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_support(b1);
+ return box(z);
+}
+
+any cfun_bdd_satone(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_satone(b1);
+ return box(z);
+}
+
+any cfun_bdd_satoneset(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b3 = (BDD) unBox(y);
+ BDD z = bdd_satoneset(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_fullsatone(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ BDD z = bdd_fullsatone(b1);
+ return box(z);
+}
+
+any cfun_bdd_nodecount(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ int z = bdd_nodecount(b1);
+ return box(z);
+}
+
+any cfun_bdd_printall(any ex __attribute__((unused))) {
+ bdd_printall();
+ return Nil;
+}
+
+any cfun_bdd_printtable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ bdd_printtable(b1);
+ return Nil;
+}
+
+any cfun_bdd_printset(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ bdd_printset(b1);
+ return Nil;
+}
+
+any cfun_bdd_fnprintdot(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ int z = bdd_fnprintdot(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_printdot(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ bdd_printdot(b1);
+ return Nil;
+}
+
+any cfun_bdd_fnsave(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b2 = (BDD) unBox(y);
+ int z = bdd_fnsave(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_swapvar(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ int z = bdd_swapvar(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_default_reohandler(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ bdd_default_reohandler(b1);
+ return Nil;
+}
+
+any cfun_bdd_reorder(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ bdd_reorder(b1);
+ return Nil;
+}
+
+any cfun_bdd_reorder_gain(any ex __attribute__((unused))) {
+ int z = bdd_reorder_gain();
+ return box(z);
+}
+
+any cfun_bdd_clrvarblocks(any ex __attribute__((unused))) {
+ bdd_clrvarblocks();
+ return Nil;
+}
+
+any cfun_bdd_addvarblock(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ BDD b1 = (BDD) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ int z = bdd_addvarblock(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_intaddvarblock(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ int z = bdd_intaddvarblock(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_bdd_varblockall(any ex __attribute__((unused))) {
+ bdd_varblockall();
+ return Nil;
+}
+
+any cfun_bdd_autoreorder(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_autoreorder(b1);
+ return box(z);
+}
+
+any cfun_bdd_autoreorder_times(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ int z = bdd_autoreorder_times(b1, b2);
+ return box(z);
+}
+
+any cfun_bdd_var2level(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_var2level(b1);
+ return box(z);
+}
+
+any cfun_bdd_level2var(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_level2var(b1);
+ return box(z);
+}
+
+any cfun_bdd_getreorder_times(any ex __attribute__((unused))) {
+ int z = bdd_getreorder_times();
+ return box(z);
+}
+
+any cfun_bdd_getreorder_method(any ex __attribute__((unused))) {
+ int z = bdd_getreorder_method();
+ return box(z);
+}
+
+any cfun_bdd_enable_reorder(any ex __attribute__((unused))) {
+ bdd_enable_reorder();
+ return Nil;
+}
+
+any cfun_bdd_disable_reorder(any ex __attribute__((unused))) {
+ bdd_disable_reorder();
+ return Nil;
+}
+
+any cfun_bdd_reorder_verbose(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = bdd_reorder_verbose(b1);
+ return box(z);
+}
+
+any cfun_bdd_printorder(any ex __attribute__((unused))) {
+ bdd_printorder();
+ return Nil;
+}
diff --git a/src/mod/buddy.ffi.fn b/src/mod/buddy.ffi.fn
@@ -0,0 +1,82 @@
+ {cfun_bdd_init, "bdd_init"},
+ {cfun_bdd_done, "bdd_done"},
+ {cfun_bdd_setvarnum, "bdd_setvarnum"},
+ {cfun_bdd_extvarnum, "bdd_extvarnum"},
+ {cfun_bdd_isrunning, "bdd_isrunning"},
+ {cfun_bdd_setmaxnodenum, "bdd_setmaxnodenum"},
+ {cfun_bdd_setmaxincrease, "bdd_setmaxincrease"},
+ {cfun_bdd_setminfreenodes, "bdd_setminfreenodes"},
+ {cfun_bdd_getnodenum, "bdd_getnodenum"},
+ {cfun_bdd_getallocnum, "bdd_getallocnum"},
+ {cfun_bdd_versionstr, "bdd_versionstr"},
+ {cfun_bdd_versionnum, "bdd_versionnum"},
+ {cfun_bdd_printstat, "bdd_printstat"},
+ {cfun_bdd_default_errhandler, "bdd_default_errhandler"},
+ {cfun_bdd_errstring, "bdd_errstring"},
+ {cfun_bdd_clear_error, "bdd_clear_error"},
+ {cfun_bdd_true, "bdd_true"},
+ {cfun_bdd_false, "bdd_false"},
+ {cfun_bdd_varnum, "bdd_varnum"},
+ {cfun_bdd_ithvar, "bdd_ithvar"},
+ {cfun_bdd_nithvar, "bdd_nithvar"},
+ {cfun_bdd_var, "bdd_var"},
+ {cfun_bdd_low, "bdd_low"},
+ {cfun_bdd_high, "bdd_high"},
+ {cfun_bdd_addref, "bdd_addref"},
+ {cfun_bdd_delref, "bdd_delref"},
+ {cfun_bdd_gbc, "bdd_gbc"},
+ {cfun_bdd_newpair, "bdd_newpair"},
+ {cfun_bdd_setpair, "bdd_setpair"},
+ {cfun_bdd_setbddpair, "bdd_setbddpair"},
+ {cfun_bdd_resetpair, "bdd_resetpair"},
+ {cfun_bdd_freepair, "bdd_freepair"},
+ {cfun_bdd_setcacheratio, "bdd_setcacheratio"},
+ {cfun_bdd_not, "bdd_not"},
+ {cfun_bdd_apply, "bdd_apply"},
+ {cfun_bdd_and, "bdd_and"},
+ {cfun_bdd_or, "bdd_or"},
+ {cfun_bdd_xor, "bdd_xor"},
+ {cfun_bdd_imp, "bdd_imp"},
+ {cfun_bdd_biimp, "bdd_biimp"},
+ {cfun_bdd_ite, "bdd_ite"},
+ {cfun_bdd_restrict, "bdd_restrict"},
+ {cfun_bdd_constrain, "bdd_constrain"},
+ {cfun_bdd_replace, "bdd_replace"},
+ {cfun_bdd_compose, "bdd_compose"},
+ {cfun_bdd_veccompose, "bdd_veccompose"},
+ {cfun_bdd_simplify, "bdd_simplify"},
+ {cfun_bdd_exist, "bdd_exist"},
+ {cfun_bdd_forall, "bdd_forall"},
+ {cfun_bdd_unique, "bdd_unique"},
+ {cfun_bdd_appex, "bdd_appex"},
+ {cfun_bdd_appall, "bdd_appall"},
+ {cfun_bdd_appuni, "bdd_appuni"},
+ {cfun_bdd_support, "bdd_support"},
+ {cfun_bdd_satone, "bdd_satone"},
+ {cfun_bdd_satoneset, "bdd_satoneset"},
+ {cfun_bdd_fullsatone, "bdd_fullsatone"},
+ {cfun_bdd_nodecount, "bdd_nodecount"},
+ {cfun_bdd_printall, "bdd_printall"},
+ {cfun_bdd_printtable, "bdd_printtable"},
+ {cfun_bdd_printset, "bdd_printset"},
+ {cfun_bdd_fnprintdot, "bdd_fnprintdot"},
+ {cfun_bdd_printdot, "bdd_printdot"},
+ {cfun_bdd_fnsave, "bdd_fnsave"},
+ {cfun_bdd_swapvar, "bdd_swapvar"},
+ {cfun_bdd_default_reohandler, "bdd_default_reohandler"},
+ {cfun_bdd_reorder, "bdd_reorder"},
+ {cfun_bdd_reorder_gain, "bdd_reorder_gain"},
+ {cfun_bdd_clrvarblocks, "bdd_clrvarblocks"},
+ {cfun_bdd_addvarblock, "bdd_addvarblock"},
+ {cfun_bdd_intaddvarblock, "bdd_intaddvarblock"},
+ {cfun_bdd_varblockall, "bdd_varblockall"},
+ {cfun_bdd_autoreorder, "bdd_autoreorder"},
+ {cfun_bdd_autoreorder_times, "bdd_autoreorder_times"},
+ {cfun_bdd_var2level, "bdd_var2level"},
+ {cfun_bdd_level2var, "bdd_level2var"},
+ {cfun_bdd_getreorder_times, "bdd_getreorder_times"},
+ {cfun_bdd_getreorder_method, "bdd_getreorder_method"},
+ {cfun_bdd_enable_reorder, "bdd_enable_reorder"},
+ {cfun_bdd_disable_reorder, "bdd_disable_reorder"},
+ {cfun_bdd_reorder_verbose, "bdd_reorder_verbose"},
+ {cfun_bdd_printorder, "bdd_printorder"},
diff --git a/src/mod/buddy.ffi.h b/src/mod/buddy.ffi.h
@@ -0,0 +1,82 @@
+any cfun_bdd_init(any ex);
+any cfun_bdd_done(any ex);
+any cfun_bdd_setvarnum(any ex);
+any cfun_bdd_extvarnum(any ex);
+any cfun_bdd_isrunning(any ex);
+any cfun_bdd_setmaxnodenum(any ex);
+any cfun_bdd_setmaxincrease(any ex);
+any cfun_bdd_setminfreenodes(any ex);
+any cfun_bdd_getnodenum(any ex);
+any cfun_bdd_getallocnum(any ex);
+any cfun_bdd_versionstr(any ex);
+any cfun_bdd_versionnum(any ex);
+any cfun_bdd_printstat(any ex);
+any cfun_bdd_default_errhandler(any ex);
+any cfun_bdd_errstring(any ex);
+any cfun_bdd_clear_error(any ex);
+any cfun_bdd_true(any ex);
+any cfun_bdd_false(any ex);
+any cfun_bdd_varnum(any ex);
+any cfun_bdd_ithvar(any ex);
+any cfun_bdd_nithvar(any ex);
+any cfun_bdd_var(any ex);
+any cfun_bdd_low(any ex);
+any cfun_bdd_high(any ex);
+any cfun_bdd_addref(any ex);
+any cfun_bdd_delref(any ex);
+any cfun_bdd_gbc(any ex);
+any cfun_bdd_newpair(any ex);
+any cfun_bdd_setpair(any ex);
+any cfun_bdd_setbddpair(any ex);
+any cfun_bdd_resetpair(any ex);
+any cfun_bdd_freepair(any ex);
+any cfun_bdd_setcacheratio(any ex);
+any cfun_bdd_not(any ex);
+any cfun_bdd_apply(any ex);
+any cfun_bdd_and(any ex);
+any cfun_bdd_or(any ex);
+any cfun_bdd_xor(any ex);
+any cfun_bdd_imp(any ex);
+any cfun_bdd_biimp(any ex);
+any cfun_bdd_ite(any ex);
+any cfun_bdd_restrict(any ex);
+any cfun_bdd_constrain(any ex);
+any cfun_bdd_replace(any ex);
+any cfun_bdd_compose(any ex);
+any cfun_bdd_veccompose(any ex);
+any cfun_bdd_simplify(any ex);
+any cfun_bdd_exist(any ex);
+any cfun_bdd_forall(any ex);
+any cfun_bdd_unique(any ex);
+any cfun_bdd_appex(any ex);
+any cfun_bdd_appall(any ex);
+any cfun_bdd_appuni(any ex);
+any cfun_bdd_support(any ex);
+any cfun_bdd_satone(any ex);
+any cfun_bdd_satoneset(any ex);
+any cfun_bdd_fullsatone(any ex);
+any cfun_bdd_nodecount(any ex);
+any cfun_bdd_printall(any ex);
+any cfun_bdd_printtable(any ex);
+any cfun_bdd_printset(any ex);
+any cfun_bdd_fnprintdot(any ex);
+any cfun_bdd_printdot(any ex);
+any cfun_bdd_fnsave(any ex);
+any cfun_bdd_swapvar(any ex);
+any cfun_bdd_default_reohandler(any ex);
+any cfun_bdd_reorder(any ex);
+any cfun_bdd_reorder_gain(any ex);
+any cfun_bdd_clrvarblocks(any ex);
+any cfun_bdd_addvarblock(any ex);
+any cfun_bdd_intaddvarblock(any ex);
+any cfun_bdd_varblockall(any ex);
+any cfun_bdd_autoreorder(any ex);
+any cfun_bdd_autoreorder_times(any ex);
+any cfun_bdd_var2level(any ex);
+any cfun_bdd_level2var(any ex);
+any cfun_bdd_getreorder_times(any ex);
+any cfun_bdd_getreorder_method(any ex);
+any cfun_bdd_enable_reorder(any ex);
+any cfun_bdd_disable_reorder(any ex);
+any cfun_bdd_reorder_verbose(any ex);
+any cfun_bdd_printorder(any ex);
diff --git a/src/mod/buddy.l b/src/mod/buddy.l
@@ -0,0 +1,48 @@
+(def 'bddop_and 0)
+(def 'bddop_xor 1)
+(def 'bddop_or 2)
+(def 'bddop_nand 3)
+(def 'bddop_nor 4)
+(def 'bddop_imp 5)
+(def 'bddop_biimp 6)
+(def 'bddop_diff 7)
+(def 'bddop_less 8)
+(def 'bddop_invimp 9)
+(def 'bddop_not 10)
+(def 'bddop_simplify 11)
+
+(def 'BDD_REORDER_NONE 0)
+(def 'BDD_REORDER_WIN2 1)
+(def 'BDD_REORDER_WIN2ITE 2)
+(def 'BDD_REORDER_SIFT 3)
+(def 'BDD_REORDER_SIFTITE 4)
+(def 'BDD_REORDER_WIN3 5)
+(def 'BDD_REORDER_WIN3ITE 6)
+(def 'BDD_REORDER_RANDOM 7)
+
+(def 'BDD_REORDER_FREE 0)
+(def 'BDD_REORDER_FIXED 1)
+
+(def 'BDD_MEMORY -1)
+(def 'BDD_VAR -2)
+(def 'BDD_RANGE -3)
+(def 'BDD_DEREF -4)
+(def 'BDD_RUNNING -5)
+(def 'BDD_FILE -6)
+(def 'BDD_FORMAT -7)
+(def 'BDD_ORDER -8)
+(def 'BDD_BREAK -9)
+(def 'BDD_VARNUM -10)
+(def 'BDD_NODES -11)
+(def 'BDD_OP -12)
+(def 'BDD_VARSET -13)
+(def 'BDD_VARBLK -14)
+(def 'BDD_DECVNUM -15)
+(def 'BDD_REPLACE -16)
+(def 'BDD_NODENUM -17)
+(def 'BDD_ILLBDD -18)
+(def 'BDD_SIZE -19)
+(def 'BVEC_SIZE -20)
+(def 'BVEC_SHIFT -21)
+(def 'BVEC_DIVZERO -22)
+(def 'BDD_ERRNUM 24)
diff --git a/src/mod/ffi.l b/src/mod/ffi.l
@@ -0,0 +1,153 @@
+# TODO double & float
+
+# *Mod *ModFn
+
+(put 'ctype 'cstr 'char*)
+(put 'ctype 'bool 'int)
+(put 'ctype 'null 'void*)
+(put 'ctype 'uchar "unsigned char")
+
+(de ctype (Type)
+ (or (get 'ctype Type) Type))
+
+(put 'cwrap 'void '((Name) "Nil"))
+(put 'cwrap 'int '((Name) (pack "box(" Name ")")))
+(put 'cwrap 'cstr '((Name) (pack "mkStr(" Name ")")))
+(put 'cwrap 'bool '((Name) (pack Name " == 0 ? T : Nil")))
+(put 'cwrap 'null '((Name) "(void*) 0"))
+(put 'cwrap 'double '((Name) (pack "box(" Name " * 10000)")))
+
+(put 'cwrap 'uchar (get 'cwrap 'int))
+(put 'cwrap 'uint (get 'cwrap 'int))
+(put 'cwrap 'long (get 'cwrap 'int))
+(put 'cwrap 'ulong (get 'cwrap 'int))
+(put 'cwrap 'void* (get 'cwrap 'int))
+(put 'cwrap 'float (get 'cwrap 'double))
+
+(de cwrap (Type Name)
+ (if (get 'cwrap Type)
+ (apply @ (list Name))
+ Name))
+
+(put 'cbody 'int
+ '((N Type)
+ (prinl " NeedNum(ex, y);")
+ (prinl " " (ctype Type) " b" N " = (" (ctype Type) ") unBox(y);")))
+(put 'cbody 'cstr
+ '((N Type)
+ (prinl " any y" N "s = xSym(y);")
+ (prinl " char b" N "[bufSize(y" N "s)];")
+ (prinl " bufString(y" N "s, b" N ");")))
+(put 'cbody 'bool
+ '((N Type)
+ (prinl " " (ctype Type) " b" N " = y == Nil ? 0 : 1;")))
+(put 'cbody 'null
+ '((N Type)
+ (prinl " " (ctype Type) " b" N " = (" (ctype Type) ") 0;")))
+(put 'cbody 'double
+ '((N Type)
+ (prinl " NeedNum(ex, y);")
+ (prinl " " (ctype Type) " b" N " = (" (ctype Type) ") unBox(y) / 10000;")))
+# (double
+# (prinl " NeedDouble(ex, y);")
+# (prinl " " (ctype Type) " b" N " = (" (ctype Type) ") unBox(y);"))
+(put 'cbody 'lfun
+ '((N Type Name)
+ (prinl " lcb_" Name " = y;")
+ (prinl " void* b" N " = (void*) lfun_" Name ";")))
+
+(put 'cbody 'uchar (get 'cbody 'int))
+(put 'cbody 'uint (get 'cbody 'int))
+(put 'cbody 'long (get 'cbody 'int))
+(put 'cbody 'ulong (get 'cbody 'int))
+(put 'cbody 'void* (get 'cbody 'int))
+(put 'cbody 'float (get 'cbody 'double))
+(put 'cbody 'lprg (get 'cbody 'lfun))
+
+(de cbody (N Type Name)
+ (apply (get 'cbody Type) (list N Type Name)))
+
+(de module (Name Fn)
+ (setq *Mod Name)
+ (setq *ModFn (or Fn '((X) X)))
+ (out (pack *Mod ".ffi.c")
+ (prinl "/* Generated from " (pack *Mod ".ffi") " */")
+ (prinl)
+ (prinl "#include \"../pico.h\""))
+ (out (pack *Mod ".ffi.h"))
+ (out (pack *Mod ".ffi.fn")))
+
+(de include @
+ (out (pack "+" *Mod ".ffi.c")
+ (prinl)
+ (while (args)
+ (prinl "#include \"" (next) "\""))))
+
+(de cscale (scale)
+ (out (pack "+" *Mod ".ffi.c")
+ (prinl)
+ (prinl "#define SCL " scale ".0")))
+
+(de cfun Lst
+ (let (Fn (cadr Lst) Ret (car Lst) Args (cddr Lst))
+ (out (pack "+" *Mod ".ffi.c")
+ (prinl)
+ (prin "any cfun_" Fn "(any ex")
+ (unless Args
+ (prin " __attribute__((unused))"))
+ (prinl ") {")
+ (when Args
+ (prinl " any x = ex, y;")
+ (for (N . I) Args
+ (prinl " x = cdr(x);")
+ (prinl " y = EVAL(car(x));")
+ (if (atom I)
+ (cbody N I)
+ (cbody N (car I) (cadr I)))))
+ (if (= 'void (ctype Ret))
+ (prin " " Fn "(")
+ (prin " " (ctype Ret) " z = " Fn "("))
+ (for (N . I) Args
+ (when (< 1 N)
+ (prin ", "))
+ (prin "b" N))
+ (prinl ");")
+ (prinl " return " (cwrap Ret "z") ";")
+ (prinl "}"))
+ (out (pack "+" *Mod ".ffi.h")
+ (prinl "any cfun_" Fn "(any ex);"))
+ (out (pack "+" *Mod ".ffi.fn")
+ (prinl " {cfun_" Fn ", \"" (apply *ModFn (list Fn)) "\"},"))))
+
+(de lfun Lst
+ (let (Fn (cadr Lst) Ret (car Lst) Args (cddr Lst) NArgs (length Args))
+ (out (pack "+" *Mod ".ffi.c")
+ (prinl)
+ (prinl "static any lcb_" Fn ";")
+ (prinl)
+ (prin "static any lfun_" Fn "(")
+ (for (N . I) Args
+ (when (< 1 N)
+ (prin ", "))
+ (if (atom I)
+ (prin I " arg" N)
+ (prin (ctype (car I)) " " (cadr I))))
+ (prinl ") {")
+ (prinl " cell c[" NArgs "];")
+ (for (N . I) Args
+ (prinl " Push(c[" (- N 1) "], " (cwrap (car I) (cadr I)) ");"))
+ (prinl " apply(NULL, lcb_" Fn ", NO, " NArgs ", c);")
+ (prinl " drop(c[0]);")
+ (prinl " return Nil;") # TODO return value
+ (prinl "}"))))
+
+(de lprg Lst
+ (let (Fn (cadr Lst) Ret (car Lst))
+ (out (pack "+" *Mod ".ffi.c")
+ (prinl)
+ (prinl "static any lcb_" Fn ";")
+ (prinl)
+ (prinl "static any lfun_" Fn "() {")
+ (prinl " prog(lcb_" Fn ");")
+ (prinl " return Nil;") # TODO return value
+ (prinl "}"))))
diff --git a/src/mod/gl.ffi b/src/mod/gl.ffi
@@ -0,0 +1,49 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'gl '((X) (pack "gl:" (cddr (chop X)))))
+
+(if (= *OS "Darwin")
+ (include "GLUT/glut.h" "OpenGL/glu.h" "OpenGL/gl.h")
+ (include "GL/glut.h" "GL/glu.h" "GL/gl.h"))
+
+(put 'cwrap 'GLenum (get 'cwrap 'int))
+(put 'cwrap 'GLbitfield (get 'cwrap 'int))
+
+(put 'cbody 'GLenum (get 'cbody 'int))
+(put 'cbody 'GLbitfield (get 'cbody 'int))
+
+#(cscale 10000)
+
+(cfun void glBegin (GLenum mode))
+(cfun void glBlendFunc (GLenum sfactor) (GLenum dfactor))
+(cfun void glClear GLbitfield)
+(cfun void glClearColor (double red) (double green) (double blue) (double alpha))
+(cfun void glClearDepth (double depth))
+(cfun void glColor3f (double red) (double green) (double blue))
+(cfun void glColor4f (double red) (double green) (double blue) (double alpha))
+(cfun void glColorMaterial (GLenum face) (GLenum mode))
+(cfun void glDepthFunc GLenum)
+(cfun void glDisable GLenum)
+(cfun void glEnable GLenum)
+(cfun void glEnd)
+(cfun void glFlush)
+(cfun void glHint (GLenum target) (GLenum mode))
+(cfun void glLineWidth double)
+(cfun void glLoadIdentity)
+(cfun void glMatrixMode GLenum)
+(cfun void glNormal3f (double x) (double y) (double z))
+(cfun void glOrtho (double left) (double right) (double bottom) (double top) (double near) (double far))
+(cfun void glPixelZoom (double xfactor) (double yfactor))
+(cfun void glPopMatrix)
+(cfun void glPushMatrix)
+(cfun void glRasterPos2f (double x) (double y))
+(cfun void glRasterPos3f (double x) (double y) (double z))
+(cfun void glRotatef (double angle) (double x) (double y) (double z))
+(cfun void glScalef (double x) (double y) (double z))
+(cfun void glShadeModel GLenum)
+(cfun void glTranslatef (double x) (double y) (double z))
+(cfun void glVertex2f (double x) (double y))
+(cfun void glVertex3f (double x) (double y) (double z))
+(cfun void glViewport (int x) (int y) (int w) (int h))
diff --git a/src/mod/gl.ffi.c b/src/mod/gl.ffi.c
@@ -0,0 +1,432 @@
+/* Generated from gl.ffi */
+
+#include "../pico.h"
+
+#include "GL/glut.h"
+#include "GL/glu.h"
+#include "GL/gl.h"
+
+any cfun_glBegin(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glBegin(b1);
+ return Nil;
+}
+
+any cfun_glBlendFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b2 = (GLenum) unBox(y);
+ glBlendFunc(b1, b2);
+ return Nil;
+}
+
+any cfun_glClear(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLbitfield b1 = (GLbitfield) unBox(y);
+ glClear(b1);
+ return Nil;
+}
+
+any cfun_glClearColor(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ glClearColor(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_glClearDepth(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ glClearDepth(b1);
+ return Nil;
+}
+
+any cfun_glColor3f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glColor3f(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glColor4f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ glColor4f(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_glColorMaterial(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b2 = (GLenum) unBox(y);
+ glColorMaterial(b1, b2);
+ return Nil;
+}
+
+any cfun_glDepthFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glDepthFunc(b1);
+ return Nil;
+}
+
+any cfun_glDisable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glDisable(b1);
+ return Nil;
+}
+
+any cfun_glEnable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glEnable(b1);
+ return Nil;
+}
+
+any cfun_glEnd(any ex __attribute__((unused))) {
+ glEnd();
+ return Nil;
+}
+
+any cfun_glFlush(any ex __attribute__((unused))) {
+ glFlush();
+ return Nil;
+}
+
+any cfun_glHint(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b2 = (GLenum) unBox(y);
+ glHint(b1, b2);
+ return Nil;
+}
+
+any cfun_glLineWidth(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ glLineWidth(b1);
+ return Nil;
+}
+
+any cfun_glLoadIdentity(any ex __attribute__((unused))) {
+ glLoadIdentity();
+ return Nil;
+}
+
+any cfun_glMatrixMode(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glMatrixMode(b1);
+ return Nil;
+}
+
+any cfun_glNormal3f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glNormal3f(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glOrtho(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b5 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b6 = (double) unBox(y) / 10000;
+ glOrtho(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_glPixelZoom(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ glPixelZoom(b1, b2);
+ return Nil;
+}
+
+any cfun_glPopMatrix(any ex __attribute__((unused))) {
+ glPopMatrix();
+ return Nil;
+}
+
+any cfun_glPushMatrix(any ex __attribute__((unused))) {
+ glPushMatrix();
+ return Nil;
+}
+
+any cfun_glRasterPos2f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ glRasterPos2f(b1, b2);
+ return Nil;
+}
+
+any cfun_glRasterPos3f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glRasterPos3f(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glRotatef(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ glRotatef(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_glScalef(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glScalef(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glShadeModel(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLenum b1 = (GLenum) unBox(y);
+ glShadeModel(b1);
+ return Nil;
+}
+
+any cfun_glTranslatef(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glTranslatef(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glVertex2f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ glVertex2f(b1, b2);
+ return Nil;
+}
+
+any cfun_glVertex3f(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ glVertex3f(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glViewport(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b4 = (int) unBox(y);
+ glViewport(b1, b2, b3, b4);
+ return Nil;
+}
diff --git a/src/mod/gl.ffi.fn b/src/mod/gl.ffi.fn
@@ -0,0 +1,31 @@
+ {cfun_glBegin, "gl:Begin"},
+ {cfun_glBlendFunc, "gl:BlendFunc"},
+ {cfun_glClear, "gl:Clear"},
+ {cfun_glClearColor, "gl:ClearColor"},
+ {cfun_glClearDepth, "gl:ClearDepth"},
+ {cfun_glColor3f, "gl:Color3f"},
+ {cfun_glColor4f, "gl:Color4f"},
+ {cfun_glColorMaterial, "gl:ColorMaterial"},
+ {cfun_glDepthFunc, "gl:DepthFunc"},
+ {cfun_glDisable, "gl:Disable"},
+ {cfun_glEnable, "gl:Enable"},
+ {cfun_glEnd, "gl:End"},
+ {cfun_glFlush, "gl:Flush"},
+ {cfun_glHint, "gl:Hint"},
+ {cfun_glLineWidth, "gl:LineWidth"},
+ {cfun_glLoadIdentity, "gl:LoadIdentity"},
+ {cfun_glMatrixMode, "gl:MatrixMode"},
+ {cfun_glNormal3f, "gl:Normal3f"},
+ {cfun_glOrtho, "gl:Ortho"},
+ {cfun_glPixelZoom, "gl:PixelZoom"},
+ {cfun_glPopMatrix, "gl:PopMatrix"},
+ {cfun_glPushMatrix, "gl:PushMatrix"},
+ {cfun_glRasterPos2f, "gl:RasterPos2f"},
+ {cfun_glRasterPos3f, "gl:RasterPos3f"},
+ {cfun_glRotatef, "gl:Rotatef"},
+ {cfun_glScalef, "gl:Scalef"},
+ {cfun_glShadeModel, "gl:ShadeModel"},
+ {cfun_glTranslatef, "gl:Translatef"},
+ {cfun_glVertex2f, "gl:Vertex2f"},
+ {cfun_glVertex3f, "gl:Vertex3f"},
+ {cfun_glViewport, "gl:Viewport"},
diff --git a/src/mod/gl.ffi.h b/src/mod/gl.ffi.h
@@ -0,0 +1,31 @@
+any cfun_glBegin(any ex);
+any cfun_glBlendFunc(any ex);
+any cfun_glClear(any ex);
+any cfun_glClearColor(any ex);
+any cfun_glClearDepth(any ex);
+any cfun_glColor3f(any ex);
+any cfun_glColor4f(any ex);
+any cfun_glColorMaterial(any ex);
+any cfun_glDepthFunc(any ex);
+any cfun_glDisable(any ex);
+any cfun_glEnable(any ex);
+any cfun_glEnd(any ex);
+any cfun_glFlush(any ex);
+any cfun_glHint(any ex);
+any cfun_glLineWidth(any ex);
+any cfun_glLoadIdentity(any ex);
+any cfun_glMatrixMode(any ex);
+any cfun_glNormal3f(any ex);
+any cfun_glOrtho(any ex);
+any cfun_glPixelZoom(any ex);
+any cfun_glPopMatrix(any ex);
+any cfun_glPushMatrix(any ex);
+any cfun_glRasterPos2f(any ex);
+any cfun_glRasterPos3f(any ex);
+any cfun_glRotatef(any ex);
+any cfun_glScalef(any ex);
+any cfun_glShadeModel(any ex);
+any cfun_glTranslatef(any ex);
+any cfun_glVertex2f(any ex);
+any cfun_glVertex3f(any ex);
+any cfun_glViewport(any ex);
diff --git a/src/mod/glu.ffi b/src/mod/glu.ffi
@@ -0,0 +1,21 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'glu '((X) (pack "glu:" (cdddr (chop X)))))
+
+(if (= *OS "Darwin")
+ (include "GLUT/glut.h" "OpenGL/glu.h" "OpenGL/gl.h")
+ (include "GL/glut.h" "GL/glu.h" "GL/gl.h"))
+
+(put 'cwrap 'GLUquadric* (get 'cwrap 'void*))
+
+(put 'cbody 'GLUquadric* (get 'cbody 'void*))
+
+# define SCL 10000.0
+
+(cfun void gluDeleteQuadric GLUquadric*)
+(cfun void gluDisk GLUquadric* (double inner) (double outer) (int slices) (int loops))
+(cfun GLUquadric* gluNewQuadric)
+(cfun void gluOrtho2D (double left) (double right) (double bottom) (double top))
+(cfun void gluPerspective (double fovy) (double aspect) (double zNear) (double zFar))
diff --git a/src/mod/glu.ffi.c b/src/mod/glu.ffi.c
@@ -0,0 +1,92 @@
+/* Generated from glu.ffi */
+
+#include "../pico.h"
+
+#include "GL/glut.h"
+#include "GL/glu.h"
+#include "GL/gl.h"
+
+any cfun_gluDeleteQuadric(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLUquadric* b1 = (GLUquadric*) unBox(y);
+ gluDeleteQuadric(b1);
+ return Nil;
+}
+
+any cfun_gluDisk(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ GLUquadric* b1 = (GLUquadric*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b4 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b5 = (int) unBox(y);
+ gluDisk(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gluNewQuadric(any ex __attribute__((unused))) {
+ GLUquadric* z = gluNewQuadric();
+ return box(z);
+}
+
+any cfun_gluOrtho2D(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ gluOrtho2D(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gluPerspective(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ gluPerspective(b1, b2, b3, b4);
+ return Nil;
+}
diff --git a/src/mod/glu.ffi.fn b/src/mod/glu.ffi.fn
@@ -0,0 +1,5 @@
+ {cfun_gluDeleteQuadric, "glu:DeleteQuadric"},
+ {cfun_gluDisk, "glu:Disk"},
+ {cfun_gluNewQuadric, "glu:NewQuadric"},
+ {cfun_gluOrtho2D, "glu:Ortho2D"},
+ {cfun_gluPerspective, "glu:Perspective"},
diff --git a/src/mod/glu.ffi.h b/src/mod/glu.ffi.h
@@ -0,0 +1,5 @@
+any cfun_gluDeleteQuadric(any ex);
+any cfun_gluDisk(any ex);
+any cfun_gluNewQuadric(any ex);
+any cfun_gluOrtho2D(any ex);
+any cfun_gluPerspective(any ex);
diff --git a/src/mod/glut.c b/src/mod/glut.c
@@ -0,0 +1,80 @@
+/* 21oct07abu
+ * 03apr08jk
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "../../src/pico.h"
+
+#if defined(__APPLE__) || defined(MACOSX)
+ #include <GLUT/glut.h>
+ #include <OpenGL/glu.h>
+ #include <OpenGL/gl.h>
+#else
+ #include <GL/glut.h>
+ #include <GL/glu.h>
+ #include <GL/gl.h>
+#endif
+
+#define SCL 10000.0
+
+#define boxCnt box
+
+int evCnt(any ex, any x) {
+ any y = EVAL(car(x));
+ NeedNum(ex, y);
+ return unBox(y);
+}
+
+// (glut:Init 'arg ..) -> T
+any Init(any ex) {
+ any x, y;
+ int i, ac = length(x = cdr(ex));
+ char *av[ac+1];
+
+ for (i = 0; i < ac; ++i) {
+ y = evSym(x), x = cdr(x);
+ av[i] = alloc(NULL, bufSize(y)), bufString(y, av[i]);
+ }
+ av[ac] = NULL;
+ glutInit(&ac, av);
+ for (i = 0; i < ac; ++i)
+ free(av[i]);
+ return T;
+}
+
+// (glut:BitmapCharacter 'fontNum 'character) -> T
+any BitmapCharacter(any ex) {
+ void* font;
+ int fontNum;
+ int character;
+
+ fontNum = (int)evCnt(ex, cdr(ex));
+ character = (int)evCnt(ex, cddr(ex));
+ switch (fontNum) {
+ // These GLUT_BITMAP values are system dependent.
+ case 2: font = GLUT_BITMAP_9_BY_15; break;
+ case 3: font = GLUT_BITMAP_8_BY_13; break;
+ case 4: font = GLUT_BITMAP_TIMES_ROMAN_10; break;
+ case 5: font = GLUT_BITMAP_TIMES_ROMAN_24; break;
+ case 6: font = GLUT_BITMAP_HELVETICA_10; break;
+ case 7: font = GLUT_BITMAP_HELVETICA_12; break;
+ case 8: font = GLUT_BITMAP_HELVETICA_18; break;
+ default: font = GLUT_BITMAP_TIMES_ROMAN_24; break;
+ }
+ //printf("BitmapCharacter, font = %10p\n", font);
+ glutBitmapCharacter(font, character);
+ return T;
+}
+
+// (glut:StrokeCharacter 'mono 'character) -> T
+any StrokeCharacter(any ex) {
+ void* font = GLUT_STROKE_ROMAN;
+ int mono;
+ int character;
+
+ mono = (int)evCnt(ex, cdr(ex)); // correct? - jk
+ character = (int)evCnt(ex, cddr(ex));
+ if (mono) font = GLUT_STROKE_MONO_ROMAN;
+ glutStrokeCharacter(font, character);
+ return T;
+}
diff --git a/src/mod/glut.ffi b/src/mod/glut.ffi
@@ -0,0 +1,43 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'glut '((X) (pack "glut:" (cddddr (chop X)))))
+
+(if (= *OS "Darwin")
+ (include "GLUT/glut.h" "OpenGL/glu.h" "OpenGL/gl.h")
+ (include "GL/glut.h" "GL/glu.h" "GL/gl.h"))
+
+# define SCL 10000.0
+
+#(glut:Init 'arg ..) -> T
+(cfun void glutInitDisplayMode int)
+(cfun void glutInitWindowSize (int width) (int height))
+(cfun void glutInitWindowPosition (int width) (int height))
+(cfun int glutCreateWindow cstr)
+#(glut:BitmapCharacter 'fontNum 'character) -> T
+#(glut:StrokeCharacter 'mono 'character) -> T
+(cfun void glutSwapBuffers)
+(lprg void display)
+(cfun void glutDisplayFunc (lprg display))
+(cfun void glutSolidCube (double size))
+(cfun void glutWireCube (double size))
+(cfun void glutSolidTeapot (double size))
+(cfun void glutPostRedisplay)
+(lfun void menu (int value))
+(cfun int glutCreateMenu (lfun menu))
+(cfun void glutAddMenuEntry (cstr name) (int value))
+(cfun void glutAttachMenu (int button))
+(lfun void keyboard (uchar key) (int xv) (int yv))
+(cfun void glutKeyboardFunc (lfun keyboard))
+(lfun void motion (int xv) (int yv))
+(cfun void glutMotionFunc (lfun motion))
+(lfun void mouse (int button) (int state) (int xv) (int yv))
+(cfun void glutMouseFunc (lfun mouse))
+(lfun void reshape (int width) (int height))
+(cfun void glutReshapeFunc (lfun reshape))
+(lfun void special (int key) (int xv) (int yv))
+(cfun void glutSpecialFunc (lfun special))
+(lfun void timer (int val))
+(cfun void glutTimerFunc (int msec) (lfun timer) (int val))
+(cfun void glutMainLoop)
diff --git a/src/mod/glut.ffi.c b/src/mod/glut.ffi.c
@@ -0,0 +1,300 @@
+/* Generated from glut.ffi */
+
+#include "../pico.h"
+
+#include "GL/glut.h"
+#include "GL/glu.h"
+#include "GL/gl.h"
+
+any cfun_glutInitDisplayMode(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ glutInitDisplayMode(b1);
+ return Nil;
+}
+
+any cfun_glutInitWindowSize(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ glutInitWindowSize(b1, b2);
+ return Nil;
+}
+
+any cfun_glutInitWindowPosition(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ glutInitWindowPosition(b1, b2);
+ return Nil;
+}
+
+any cfun_glutCreateWindow(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ int z = glutCreateWindow(b1);
+ return box(z);
+}
+
+any cfun_glutSwapBuffers(any ex __attribute__((unused))) {
+ glutSwapBuffers();
+ return Nil;
+}
+
+static any lcb_display;
+
+static any lfun_display() {
+ prog(lcb_display);
+ return Nil;
+}
+
+any cfun_glutDisplayFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_display = y;
+ void* b1 = (void*) lfun_display;
+ glutDisplayFunc(b1);
+ return Nil;
+}
+
+any cfun_glutSolidCube(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ glutSolidCube(b1);
+ return Nil;
+}
+
+any cfun_glutWireCube(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ glutWireCube(b1);
+ return Nil;
+}
+
+any cfun_glutSolidTeapot(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ glutSolidTeapot(b1);
+ return Nil;
+}
+
+any cfun_glutPostRedisplay(any ex __attribute__((unused))) {
+ glutPostRedisplay();
+ return Nil;
+}
+
+static any lcb_menu;
+
+static any lfun_menu(int value) {
+ cell c[1];
+ Push(c[0], box(value));
+ apply(NULL, lcb_menu, NO, 1, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutCreateMenu(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_menu = y;
+ void* b1 = (void*) lfun_menu;
+ int z = glutCreateMenu(b1);
+ return box(z);
+}
+
+any cfun_glutAddMenuEntry(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ glutAddMenuEntry(b1, b2);
+ return Nil;
+}
+
+any cfun_glutAttachMenu(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ glutAttachMenu(b1);
+ return Nil;
+}
+
+static any lcb_keyboard;
+
+static any lfun_keyboard(unsigned char key, int xv, int yv) {
+ cell c[3];
+ Push(c[0], box(key));
+ Push(c[1], box(xv));
+ Push(c[2], box(yv));
+ apply(NULL, lcb_keyboard, NO, 3, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutKeyboardFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_keyboard = y;
+ void* b1 = (void*) lfun_keyboard;
+ glutKeyboardFunc(b1);
+ return Nil;
+}
+
+static any lcb_motion;
+
+static any lfun_motion(int xv, int yv) {
+ cell c[2];
+ Push(c[0], box(xv));
+ Push(c[1], box(yv));
+ apply(NULL, lcb_motion, NO, 2, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutMotionFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_motion = y;
+ void* b1 = (void*) lfun_motion;
+ glutMotionFunc(b1);
+ return Nil;
+}
+
+static any lcb_mouse;
+
+static any lfun_mouse(int button, int state, int xv, int yv) {
+ cell c[4];
+ Push(c[0], box(button));
+ Push(c[1], box(state));
+ Push(c[2], box(xv));
+ Push(c[3], box(yv));
+ apply(NULL, lcb_mouse, NO, 4, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutMouseFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_mouse = y;
+ void* b1 = (void*) lfun_mouse;
+ glutMouseFunc(b1);
+ return Nil;
+}
+
+static any lcb_reshape;
+
+static any lfun_reshape(int width, int height) {
+ cell c[2];
+ Push(c[0], box(width));
+ Push(c[1], box(height));
+ apply(NULL, lcb_reshape, NO, 2, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutReshapeFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_reshape = y;
+ void* b1 = (void*) lfun_reshape;
+ glutReshapeFunc(b1);
+ return Nil;
+}
+
+static any lcb_special;
+
+static any lfun_special(int key, int xv, int yv) {
+ cell c[3];
+ Push(c[0], box(key));
+ Push(c[1], box(xv));
+ Push(c[2], box(yv));
+ apply(NULL, lcb_special, NO, 3, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutSpecialFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_special = y;
+ void* b1 = (void*) lfun_special;
+ glutSpecialFunc(b1);
+ return Nil;
+}
+
+static any lcb_timer;
+
+static any lfun_timer(int val) {
+ cell c[1];
+ Push(c[0], box(val));
+ apply(NULL, lcb_timer, NO, 1, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glutTimerFunc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_timer = y;
+ void* b2 = (void*) lfun_timer;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b3 = (int) unBox(y);
+ glutTimerFunc(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glutMainLoop(any ex __attribute__((unused))) {
+ glutMainLoop();
+ return Nil;
+}
diff --git a/src/mod/glut.ffi.fn b/src/mod/glut.ffi.fn
@@ -0,0 +1,20 @@
+ {cfun_glutInitDisplayMode, "glut:InitDisplayMode"},
+ {cfun_glutInitWindowSize, "glut:InitWindowSize"},
+ {cfun_glutInitWindowPosition, "glut:InitWindowPosition"},
+ {cfun_glutCreateWindow, "glut:CreateWindow"},
+ {cfun_glutSwapBuffers, "glut:SwapBuffers"},
+ {cfun_glutDisplayFunc, "glut:DisplayFunc"},
+ {cfun_glutSolidCube, "glut:SolidCube"},
+ {cfun_glutWireCube, "glut:WireCube"},
+ {cfun_glutSolidTeapot, "glut:SolidTeapot"},
+ {cfun_glutPostRedisplay, "glut:PostRedisplay"},
+ {cfun_glutCreateMenu, "glut:CreateMenu"},
+ {cfun_glutAddMenuEntry, "glut:AddMenuEntry"},
+ {cfun_glutAttachMenu, "glut:AttachMenu"},
+ {cfun_glutKeyboardFunc, "glut:KeyboardFunc"},
+ {cfun_glutMotionFunc, "glut:MotionFunc"},
+ {cfun_glutMouseFunc, "glut:MouseFunc"},
+ {cfun_glutReshapeFunc, "glut:ReshapeFunc"},
+ {cfun_glutSpecialFunc, "glut:SpecialFunc"},
+ {cfun_glutTimerFunc, "glut:TimerFunc"},
+ {cfun_glutMainLoop, "glut:MainLoop"},
diff --git a/src/mod/glut.ffi.h b/src/mod/glut.ffi.h
@@ -0,0 +1,20 @@
+any cfun_glutInitDisplayMode(any ex);
+any cfun_glutInitWindowSize(any ex);
+any cfun_glutInitWindowPosition(any ex);
+any cfun_glutCreateWindow(any ex);
+any cfun_glutSwapBuffers(any ex);
+any cfun_glutDisplayFunc(any ex);
+any cfun_glutSolidCube(any ex);
+any cfun_glutWireCube(any ex);
+any cfun_glutSolidTeapot(any ex);
+any cfun_glutPostRedisplay(any ex);
+any cfun_glutCreateMenu(any ex);
+any cfun_glutAddMenuEntry(any ex);
+any cfun_glutAttachMenu(any ex);
+any cfun_glutKeyboardFunc(any ex);
+any cfun_glutMotionFunc(any ex);
+any cfun_glutMouseFunc(any ex);
+any cfun_glutReshapeFunc(any ex);
+any cfun_glutSpecialFunc(any ex);
+any cfun_glutTimerFunc(any ex);
+any cfun_glutMainLoop(any ex);
diff --git a/src/mod/glut.fn b/src/mod/glut.fn
@@ -0,0 +1,3 @@
+ {Init, "glut:Init"},
+ {BitmapCharacter, "glut:BitmapCharacter"},
+ {StrokeCharacter, "glut:StrokeCharacter"},
diff --git a/src/mod/glut.h b/src/mod/glut.h
@@ -0,0 +1,3 @@
+any Init(any ex);
+any BitmapCharacter(any ex);
+any StrokeCharacter(any ex);
diff --git a/src/mod/gmp-test.l b/src/mod/gmp-test.l
@@ -0,0 +1,22 @@
+# http://paste.lisp.org/display/15116
+
+(setq X (mpz_new))
+(setq Y (mpz_new))
+
+(mpz_init X)
+(mpz_init Y)
+
+(mpz_set_ui X 0)
+(mpz_set_ui Y 1)
+
+(setq Z (mpz_new))
+
+(for (N 2 (<= N 1000000) (inc N))
+ (mpz_init Z)
+ (mpz_add Z X Y)
+ (mpz_set X Y)
+ (mpz_set Y Z)
+ (mpz_clear Z))
+
+(mpz_print Y)
+(prinl)
diff --git a/src/mod/gmp-test2.l b/src/mod/gmp-test2.l
@@ -0,0 +1,9 @@
+# http://paste.lisp.org/display/15116
+
+(setq X 0)
+(setq Y 1)
+(for (N 2 (<= N 1000000) (inc N))
+ (let Z (+ X Y)
+ (setq X Y)
+ (setq Y Z)))
+(prinl Y)
diff --git a/src/mod/gmp.ffi b/src/mod/gmp.ffi
@@ -0,0 +1,139 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'gmp)
+
+(include "gmp.h")
+
+(put 'cwrap 'mpz_ptr (get 'cwrap 'void*))
+
+(put 'cbody 'mpz_ptr (get 'cbody 'void*))
+
+(cfun void mpz_init mpz_ptr)
+(cfun void mpz_init2 mpz_ptr ulong)
+(cfun void mpz_clear mpz_ptr)
+(cfun void mpz_realloc2 mpz_ptr ulong)
+(cfun void mpz_set mpz_ptr mpz_ptr)
+(cfun void mpz_set_ui mpz_ptr ulong)
+(cfun void mpz_set_si mpz_ptr long)
+#(cfun void mpz_set_d mpz_ptr double)
+#(cfun void mpz_set_q mpz_ptr mpq_ptr)
+#(cfun void mpz_set_f mpz_ptr mpf_ptr)
+#(cfun int mpz_set_str mpz_ptr char* int)
+(cfun void mpz_swap mpz_ptr mpz_ptr)
+(cfun void mpz_init_set mpz_ptr mpz_ptr)
+(cfun void mpz_init_set_ui mpz_ptr ulong)
+(cfun void mpz_init_set_si mpz_ptr long)
+#(cfun void mpz_init_set_d mpz_ptr double)
+#(cfun int mpz_init_set_str mpz_ptr char* int)
+(cfun ulong mpz_get_ui mpz_ptr)
+(cfun long mpz_get_si mpz_ptr)
+#(cfun double mpz_get_d mpz_ptr)
+#double mpz_get_d_2exp (signed long int *exp, mpz_ptr op )
+#(cfun char* mpz_get_str char* int mpz_ptr)
+(cfun void mpz_add mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_add_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_sub mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_sub_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_ui_sub mpz_ptr ulong mpz_ptr)
+(cfun void mpz_mul mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_mul_si mpz_ptr mpz_ptr long)
+(cfun void mpz_mul_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_addmul mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_addmul_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_submul mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_submul_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_mul_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_neg mpz_ptr mpz_ptr)
+(cfun void mpz_abs mpz_ptr mpz_ptr)
+#(cfun void mpz_cdiv_q (mpz_ptr q, mpz_ptr n, mpz_ptr d )
+(cfun void mpz_cdiv_r mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_cdiv_qr mpz_ptr mpz_ptr mpz_ptr mpz_ptr)
+(cfun ulong mpz_cdiv_q_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_cdiv_r_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_cdiv_qr_ui mpz_ptr mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_cdiv_ui mpz_ptr ulong)
+(cfun void mpz_cdiv_q_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_cdiv_r_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_fdiv_q mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_fdiv_r mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_fdiv_qr mpz_ptr mpz_ptr mpz_ptr mpz_ptr)
+(cfun ulong mpz_fdiv_q_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_fdiv_r_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_fdiv_qr_ui mpz_ptr mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_fdiv_ui mpz_ptr ulong)
+(cfun void mpz_fdiv_q_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_fdiv_r_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_tdiv_q mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_tdiv_r mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_tdiv_qr mpz_ptr mpz_ptr mpz_ptr mpz_ptr)
+(cfun ulong mpz_tdiv_q_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_tdiv_r_ui mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_tdiv_qr_ui mpz_ptr mpz_ptr mpz_ptr ulong)
+(cfun ulong mpz_tdiv_ui mpz_ptr ulong)
+(cfun void mpz_tdiv_q_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_tdiv_r_2exp mpz_ptr mpz_ptr ulong)
+(cfun void mpz_mod mpz_ptr mpz_ptr mpz_ptr)
+(cfun ulong mpz_mod_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_divexact mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_divexact_ui mpz_ptr mpz_ptr ulong)
+(cfun int mpz_divisible_p mpz_ptr mpz_ptr)
+(cfun int mpz_divisible_ui_p mpz_ptr ulong)
+(cfun int mpz_divisible_2exp_p mpz_ptr ulong)
+(cfun int mpz_congruent_p mpz_ptr mpz_ptr mpz_ptr)
+(cfun int mpz_congruent_ui_p mpz_ptr ulong ulong)
+(cfun int mpz_congruent_2exp_p mpz_ptr mpz_ptr ulong)
+(cfun void mpz_powm mpz_ptr mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_powm_ui mpz_ptr mpz_ptr ulong mpz_ptr)
+(cfun void mpz_pow_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_ui_pow_ui mpz_ptr ulong ulong)
+(cfun int mpz_root mpz_ptr mpz_ptr ulong)
+(cfun void mpz_rootrem mpz_ptr mpz_ptr mpz_ptr ulong)
+(cfun void mpz_sqrt mpz_ptr mpz_ptr)
+(cfun void mpz_sqrtrem mpz_ptr mpz_ptr mpz_ptr)
+(cfun int mpz_perfect_power_p mpz_ptr)
+(cfun int mpz_perfect_square_p mpz_ptr)
+(cfun int mpz_probab_prime_p mpz_ptr int)
+(cfun void mpz_nextprime mpz_ptr mpz_ptr)
+(cfun void mpz_gcd mpz_ptr mpz_ptr mpz_ptr)
+(cfun ulong mpz_gcd_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_gcdext mpz_ptr mpz_ptr mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_lcm mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_lcm_ui mpz_ptr mpz_ptr ulong)
+(cfun int mpz_invert mpz_ptr mpz_ptr mpz_ptr)
+(cfun int mpz_jacobi mpz_ptr mpz_ptr)
+(cfun int mpz_legendre mpz_ptr mpz_ptr)
+(cfun int mpz_kronecker mpz_ptr mpz_ptr)
+(cfun int mpz_kronecker_si mpz_ptr long)
+(cfun int mpz_kronecker_ui mpz_ptr ulong)
+(cfun int mpz_si_kronecker long mpz_ptr)
+(cfun int mpz_ui_kronecker ulong mpz_ptr)
+(cfun ulong mpz_remove mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_fac_ui mpz_ptr ulong)
+(cfun void mpz_bin_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_bin_uiui mpz_ptr ulong ulong)
+(cfun void mpz_fib_ui mpz_ptr ulong)
+(cfun void mpz_fib2_ui mpz_ptr mpz_ptr ulong)
+(cfun void mpz_lucnum_ui mpz_ptr ulong)
+(cfun void mpz_lucnum2_ui mpz_ptr mpz_ptr ulong)
+(cfun int mpz_cmp mpz_ptr mpz_ptr)
+#(cfun int mpz_cmp_d mpz_ptr double)
+(cfun int mpz_cmp_si mpz_ptr long)
+(cfun int mpz_cmp_ui mpz_ptr ulong)
+(cfun int mpz_cmpabs mpz_ptr mpz_ptr)
+#(cfun int mpz_cmpabs_d mpz_ptr double)
+(cfun int mpz_cmpabs_ui mpz_ptr ulong)
+(cfun int mpz_sgn mpz_ptr)
+(cfun void mpz_and mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_ior mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_xor mpz_ptr mpz_ptr mpz_ptr)
+(cfun void mpz_com mpz_ptr mpz_ptr)
+(cfun ulong mpz_popcount mpz_ptr)
+(cfun ulong mpz_hamdist mpz_ptr mpz_ptr)
+(cfun ulong mpz_scan0 mpz_ptr ulong)
+(cfun ulong mpz_scan1 mpz_ptr ulong)
+(cfun void mpz_setbit mpz_ptr ulong)
+(cfun void mpz_clrbit mpz_ptr ulong)
+(cfun void mpz_combit mpz_ptr ulong)
+(cfun int mpz_tstbit mpz_ptr ulong)
diff --git a/src/mod/gmp.ffi.c b/src/mod/gmp.ffi.c
@@ -0,0 +1,1883 @@
+/* Generated from gmp.ffi */
+
+#include "../pico.h"
+
+#include "gmp.h"
+
+any cfun_mpz_init(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ mpz_init(b1);
+ return Nil;
+}
+
+any cfun_mpz_init2(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_init2(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_clear(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ mpz_clear(b1);
+ return Nil;
+}
+
+any cfun_mpz_realloc2(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_realloc2(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_set(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_set_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_set_ui(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_set_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ mpz_set_si(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_swap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_swap(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_init_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_init_set(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_init_set_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_init_set_ui(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_init_set_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ mpz_init_set_si(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_get_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ ulong z = mpz_get_ui(b1);
+ return box(z);
+}
+
+any cfun_mpz_get_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ long z = mpz_get_si(b1);
+ return box(z);
+}
+
+any cfun_mpz_add(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_add(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_add_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_add_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_sub(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_sub(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_sub_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_sub_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_ui_sub(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_ui_sub(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mul(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_mul(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mul_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ mpz_mul_si(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mul_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_mul_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_addmul(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_addmul(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_addmul_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_addmul_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_submul(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_submul(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_submul_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_submul_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mul_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_mul_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_neg(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_neg(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_abs(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_abs(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_cdiv_r(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_cdiv_r(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_cdiv_qr(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ mpz_cdiv_qr(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_cdiv_q_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_cdiv_q_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_cdiv_r_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_cdiv_r_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_cdiv_qr_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b4 = (ulong) unBox(y);
+ ulong z = mpz_cdiv_qr_ui(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_mpz_cdiv_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ ulong z = mpz_cdiv_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_cdiv_q_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_cdiv_q_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_cdiv_r_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_cdiv_r_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_fdiv_q(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_fdiv_q(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_fdiv_r(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_fdiv_r(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_fdiv_qr(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ mpz_fdiv_qr(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_fdiv_q_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_fdiv_q_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_fdiv_r_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_fdiv_r_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_fdiv_qr_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b4 = (ulong) unBox(y);
+ ulong z = mpz_fdiv_qr_ui(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_mpz_fdiv_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ ulong z = mpz_fdiv_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_fdiv_q_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_fdiv_q_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_fdiv_r_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_fdiv_r_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_tdiv_q(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_tdiv_q(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_tdiv_r(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_tdiv_r(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_tdiv_qr(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ mpz_tdiv_qr(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_tdiv_q_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_tdiv_q_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_tdiv_r_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_tdiv_r_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_tdiv_qr_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b4 = (ulong) unBox(y);
+ ulong z = mpz_tdiv_qr_ui(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_mpz_tdiv_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ ulong z = mpz_tdiv_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_tdiv_q_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_tdiv_q_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_tdiv_r_2exp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_tdiv_r_2exp(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mod(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_mod(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_mod_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_mod_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_divexact(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_divexact(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_divexact_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_divexact_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_divisible_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_divisible_p(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_divisible_ui_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_divisible_ui_p(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_divisible_2exp_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_divisible_2exp_p(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_congruent_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ int z = mpz_congruent_p(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_congruent_ui_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ int z = mpz_congruent_ui_p(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_congruent_2exp_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ int z = mpz_congruent_2exp_p(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_powm(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ mpz_powm(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_powm_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ mpz_powm_ui(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_pow_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_pow_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_ui_pow_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_ui_pow_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_root(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ int z = mpz_root(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_rootrem(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b4 = (ulong) unBox(y);
+ mpz_rootrem(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_mpz_sqrt(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_sqrt(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_sqrtrem(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_sqrtrem(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_perfect_power_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ int z = mpz_perfect_power_p(b1);
+ return box(z);
+}
+
+any cfun_mpz_perfect_square_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ int z = mpz_perfect_square_p(b1);
+ return box(z);
+}
+
+any cfun_mpz_probab_prime_p(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ int z = mpz_probab_prime_p(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_nextprime(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_nextprime(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_gcd(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_gcd(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_gcd_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ ulong z = mpz_gcd_ui(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_gcdext(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b4 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b5 = (mpz_ptr) unBox(y);
+ mpz_gcdext(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_mpz_lcm(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_lcm(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_lcm_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_lcm_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_invert(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ int z = mpz_invert(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_jacobi(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_jacobi(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_legendre(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_legendre(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_kronecker(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_kronecker(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_kronecker_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ int z = mpz_kronecker_si(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_kronecker_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_kronecker_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_si_kronecker(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_si_kronecker(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_ui_kronecker(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b1 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_ui_kronecker(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_remove(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ ulong z = mpz_remove(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_mpz_fac_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_fac_ui(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_bin_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_bin_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_bin_uiui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_bin_uiui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_fib_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_fib_ui(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_fib2_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_fib2_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_lucnum_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_lucnum_ui(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_lucnum2_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b3 = (ulong) unBox(y);
+ mpz_lucnum2_ui(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_cmp(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_cmp(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_cmp_si(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ int z = mpz_cmp_si(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_cmp_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_cmp_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_cmpabs(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ int z = mpz_cmpabs(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_cmpabs_ui(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_cmpabs_ui(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_sgn(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ int z = mpz_sgn(b1);
+ return box(z);
+}
+
+any cfun_mpz_and(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_and(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_ior(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_ior(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_xor(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b3 = (mpz_ptr) unBox(y);
+ mpz_xor(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_mpz_com(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ mpz_com(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_popcount(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ ulong z = mpz_popcount(b1);
+ return box(z);
+}
+
+any cfun_mpz_hamdist(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b2 = (mpz_ptr) unBox(y);
+ ulong z = mpz_hamdist(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_scan0(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ ulong z = mpz_scan0(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_scan1(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ ulong z = mpz_scan1(b1, b2);
+ return box(z);
+}
+
+any cfun_mpz_setbit(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_setbit(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_clrbit(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_clrbit(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_combit(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ mpz_combit(b1, b2);
+ return Nil;
+}
+
+any cfun_mpz_tstbit(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ ulong b2 = (ulong) unBox(y);
+ int z = mpz_tstbit(b1, b2);
+ return box(z);
+}
diff --git a/src/mod/gmp.ffi.fn b/src/mod/gmp.ffi.fn
@@ -0,0 +1,115 @@
+ {cfun_mpz_init, "mpz_init"},
+ {cfun_mpz_init2, "mpz_init2"},
+ {cfun_mpz_clear, "mpz_clear"},
+ {cfun_mpz_realloc2, "mpz_realloc2"},
+ {cfun_mpz_set, "mpz_set"},
+ {cfun_mpz_set_ui, "mpz_set_ui"},
+ {cfun_mpz_set_si, "mpz_set_si"},
+ {cfun_mpz_swap, "mpz_swap"},
+ {cfun_mpz_init_set, "mpz_init_set"},
+ {cfun_mpz_init_set_ui, "mpz_init_set_ui"},
+ {cfun_mpz_init_set_si, "mpz_init_set_si"},
+ {cfun_mpz_get_ui, "mpz_get_ui"},
+ {cfun_mpz_get_si, "mpz_get_si"},
+ {cfun_mpz_add, "mpz_add"},
+ {cfun_mpz_add_ui, "mpz_add_ui"},
+ {cfun_mpz_sub, "mpz_sub"},
+ {cfun_mpz_sub_ui, "mpz_sub_ui"},
+ {cfun_mpz_ui_sub, "mpz_ui_sub"},
+ {cfun_mpz_mul, "mpz_mul"},
+ {cfun_mpz_mul_si, "mpz_mul_si"},
+ {cfun_mpz_mul_ui, "mpz_mul_ui"},
+ {cfun_mpz_addmul, "mpz_addmul"},
+ {cfun_mpz_addmul_ui, "mpz_addmul_ui"},
+ {cfun_mpz_submul, "mpz_submul"},
+ {cfun_mpz_submul_ui, "mpz_submul_ui"},
+ {cfun_mpz_mul_2exp, "mpz_mul_2exp"},
+ {cfun_mpz_neg, "mpz_neg"},
+ {cfun_mpz_abs, "mpz_abs"},
+ {cfun_mpz_cdiv_r, "mpz_cdiv_r"},
+ {cfun_mpz_cdiv_qr, "mpz_cdiv_qr"},
+ {cfun_mpz_cdiv_q_ui, "mpz_cdiv_q_ui"},
+ {cfun_mpz_cdiv_r_ui, "mpz_cdiv_r_ui"},
+ {cfun_mpz_cdiv_qr_ui, "mpz_cdiv_qr_ui"},
+ {cfun_mpz_cdiv_ui, "mpz_cdiv_ui"},
+ {cfun_mpz_cdiv_q_2exp, "mpz_cdiv_q_2exp"},
+ {cfun_mpz_cdiv_r_2exp, "mpz_cdiv_r_2exp"},
+ {cfun_mpz_fdiv_q, "mpz_fdiv_q"},
+ {cfun_mpz_fdiv_r, "mpz_fdiv_r"},
+ {cfun_mpz_fdiv_qr, "mpz_fdiv_qr"},
+ {cfun_mpz_fdiv_q_ui, "mpz_fdiv_q_ui"},
+ {cfun_mpz_fdiv_r_ui, "mpz_fdiv_r_ui"},
+ {cfun_mpz_fdiv_qr_ui, "mpz_fdiv_qr_ui"},
+ {cfun_mpz_fdiv_ui, "mpz_fdiv_ui"},
+ {cfun_mpz_fdiv_q_2exp, "mpz_fdiv_q_2exp"},
+ {cfun_mpz_fdiv_r_2exp, "mpz_fdiv_r_2exp"},
+ {cfun_mpz_tdiv_q, "mpz_tdiv_q"},
+ {cfun_mpz_tdiv_r, "mpz_tdiv_r"},
+ {cfun_mpz_tdiv_qr, "mpz_tdiv_qr"},
+ {cfun_mpz_tdiv_q_ui, "mpz_tdiv_q_ui"},
+ {cfun_mpz_tdiv_r_ui, "mpz_tdiv_r_ui"},
+ {cfun_mpz_tdiv_qr_ui, "mpz_tdiv_qr_ui"},
+ {cfun_mpz_tdiv_ui, "mpz_tdiv_ui"},
+ {cfun_mpz_tdiv_q_2exp, "mpz_tdiv_q_2exp"},
+ {cfun_mpz_tdiv_r_2exp, "mpz_tdiv_r_2exp"},
+ {cfun_mpz_mod, "mpz_mod"},
+ {cfun_mpz_mod_ui, "mpz_mod_ui"},
+ {cfun_mpz_divexact, "mpz_divexact"},
+ {cfun_mpz_divexact_ui, "mpz_divexact_ui"},
+ {cfun_mpz_divisible_p, "mpz_divisible_p"},
+ {cfun_mpz_divisible_ui_p, "mpz_divisible_ui_p"},
+ {cfun_mpz_divisible_2exp_p, "mpz_divisible_2exp_p"},
+ {cfun_mpz_congruent_p, "mpz_congruent_p"},
+ {cfun_mpz_congruent_ui_p, "mpz_congruent_ui_p"},
+ {cfun_mpz_congruent_2exp_p, "mpz_congruent_2exp_p"},
+ {cfun_mpz_powm, "mpz_powm"},
+ {cfun_mpz_powm_ui, "mpz_powm_ui"},
+ {cfun_mpz_pow_ui, "mpz_pow_ui"},
+ {cfun_mpz_ui_pow_ui, "mpz_ui_pow_ui"},
+ {cfun_mpz_root, "mpz_root"},
+ {cfun_mpz_rootrem, "mpz_rootrem"},
+ {cfun_mpz_sqrt, "mpz_sqrt"},
+ {cfun_mpz_sqrtrem, "mpz_sqrtrem"},
+ {cfun_mpz_perfect_power_p, "mpz_perfect_power_p"},
+ {cfun_mpz_perfect_square_p, "mpz_perfect_square_p"},
+ {cfun_mpz_probab_prime_p, "mpz_probab_prime_p"},
+ {cfun_mpz_nextprime, "mpz_nextprime"},
+ {cfun_mpz_gcd, "mpz_gcd"},
+ {cfun_mpz_gcd_ui, "mpz_gcd_ui"},
+ {cfun_mpz_gcdext, "mpz_gcdext"},
+ {cfun_mpz_lcm, "mpz_lcm"},
+ {cfun_mpz_lcm_ui, "mpz_lcm_ui"},
+ {cfun_mpz_invert, "mpz_invert"},
+ {cfun_mpz_jacobi, "mpz_jacobi"},
+ {cfun_mpz_legendre, "mpz_legendre"},
+ {cfun_mpz_kronecker, "mpz_kronecker"},
+ {cfun_mpz_kronecker_si, "mpz_kronecker_si"},
+ {cfun_mpz_kronecker_ui, "mpz_kronecker_ui"},
+ {cfun_mpz_si_kronecker, "mpz_si_kronecker"},
+ {cfun_mpz_ui_kronecker, "mpz_ui_kronecker"},
+ {cfun_mpz_remove, "mpz_remove"},
+ {cfun_mpz_fac_ui, "mpz_fac_ui"},
+ {cfun_mpz_bin_ui, "mpz_bin_ui"},
+ {cfun_mpz_bin_uiui, "mpz_bin_uiui"},
+ {cfun_mpz_fib_ui, "mpz_fib_ui"},
+ {cfun_mpz_fib2_ui, "mpz_fib2_ui"},
+ {cfun_mpz_lucnum_ui, "mpz_lucnum_ui"},
+ {cfun_mpz_lucnum2_ui, "mpz_lucnum2_ui"},
+ {cfun_mpz_cmp, "mpz_cmp"},
+ {cfun_mpz_cmp_si, "mpz_cmp_si"},
+ {cfun_mpz_cmp_ui, "mpz_cmp_ui"},
+ {cfun_mpz_cmpabs, "mpz_cmpabs"},
+ {cfun_mpz_cmpabs_ui, "mpz_cmpabs_ui"},
+ {cfun_mpz_sgn, "mpz_sgn"},
+ {cfun_mpz_and, "mpz_and"},
+ {cfun_mpz_ior, "mpz_ior"},
+ {cfun_mpz_xor, "mpz_xor"},
+ {cfun_mpz_com, "mpz_com"},
+ {cfun_mpz_popcount, "mpz_popcount"},
+ {cfun_mpz_hamdist, "mpz_hamdist"},
+ {cfun_mpz_scan0, "mpz_scan0"},
+ {cfun_mpz_scan1, "mpz_scan1"},
+ {cfun_mpz_setbit, "mpz_setbit"},
+ {cfun_mpz_clrbit, "mpz_clrbit"},
+ {cfun_mpz_combit, "mpz_combit"},
+ {cfun_mpz_tstbit, "mpz_tstbit"},
diff --git a/src/mod/gmp.ffi.h b/src/mod/gmp.ffi.h
@@ -0,0 +1,115 @@
+any cfun_mpz_init(any ex);
+any cfun_mpz_init2(any ex);
+any cfun_mpz_clear(any ex);
+any cfun_mpz_realloc2(any ex);
+any cfun_mpz_set(any ex);
+any cfun_mpz_set_ui(any ex);
+any cfun_mpz_set_si(any ex);
+any cfun_mpz_swap(any ex);
+any cfun_mpz_init_set(any ex);
+any cfun_mpz_init_set_ui(any ex);
+any cfun_mpz_init_set_si(any ex);
+any cfun_mpz_get_ui(any ex);
+any cfun_mpz_get_si(any ex);
+any cfun_mpz_add(any ex);
+any cfun_mpz_add_ui(any ex);
+any cfun_mpz_sub(any ex);
+any cfun_mpz_sub_ui(any ex);
+any cfun_mpz_ui_sub(any ex);
+any cfun_mpz_mul(any ex);
+any cfun_mpz_mul_si(any ex);
+any cfun_mpz_mul_ui(any ex);
+any cfun_mpz_addmul(any ex);
+any cfun_mpz_addmul_ui(any ex);
+any cfun_mpz_submul(any ex);
+any cfun_mpz_submul_ui(any ex);
+any cfun_mpz_mul_2exp(any ex);
+any cfun_mpz_neg(any ex);
+any cfun_mpz_abs(any ex);
+any cfun_mpz_cdiv_r(any ex);
+any cfun_mpz_cdiv_qr(any ex);
+any cfun_mpz_cdiv_q_ui(any ex);
+any cfun_mpz_cdiv_r_ui(any ex);
+any cfun_mpz_cdiv_qr_ui(any ex);
+any cfun_mpz_cdiv_ui(any ex);
+any cfun_mpz_cdiv_q_2exp(any ex);
+any cfun_mpz_cdiv_r_2exp(any ex);
+any cfun_mpz_fdiv_q(any ex);
+any cfun_mpz_fdiv_r(any ex);
+any cfun_mpz_fdiv_qr(any ex);
+any cfun_mpz_fdiv_q_ui(any ex);
+any cfun_mpz_fdiv_r_ui(any ex);
+any cfun_mpz_fdiv_qr_ui(any ex);
+any cfun_mpz_fdiv_ui(any ex);
+any cfun_mpz_fdiv_q_2exp(any ex);
+any cfun_mpz_fdiv_r_2exp(any ex);
+any cfun_mpz_tdiv_q(any ex);
+any cfun_mpz_tdiv_r(any ex);
+any cfun_mpz_tdiv_qr(any ex);
+any cfun_mpz_tdiv_q_ui(any ex);
+any cfun_mpz_tdiv_r_ui(any ex);
+any cfun_mpz_tdiv_qr_ui(any ex);
+any cfun_mpz_tdiv_ui(any ex);
+any cfun_mpz_tdiv_q_2exp(any ex);
+any cfun_mpz_tdiv_r_2exp(any ex);
+any cfun_mpz_mod(any ex);
+any cfun_mpz_mod_ui(any ex);
+any cfun_mpz_divexact(any ex);
+any cfun_mpz_divexact_ui(any ex);
+any cfun_mpz_divisible_p(any ex);
+any cfun_mpz_divisible_ui_p(any ex);
+any cfun_mpz_divisible_2exp_p(any ex);
+any cfun_mpz_congruent_p(any ex);
+any cfun_mpz_congruent_ui_p(any ex);
+any cfun_mpz_congruent_2exp_p(any ex);
+any cfun_mpz_powm(any ex);
+any cfun_mpz_powm_ui(any ex);
+any cfun_mpz_pow_ui(any ex);
+any cfun_mpz_ui_pow_ui(any ex);
+any cfun_mpz_root(any ex);
+any cfun_mpz_rootrem(any ex);
+any cfun_mpz_sqrt(any ex);
+any cfun_mpz_sqrtrem(any ex);
+any cfun_mpz_perfect_power_p(any ex);
+any cfun_mpz_perfect_square_p(any ex);
+any cfun_mpz_probab_prime_p(any ex);
+any cfun_mpz_nextprime(any ex);
+any cfun_mpz_gcd(any ex);
+any cfun_mpz_gcd_ui(any ex);
+any cfun_mpz_gcdext(any ex);
+any cfun_mpz_lcm(any ex);
+any cfun_mpz_lcm_ui(any ex);
+any cfun_mpz_invert(any ex);
+any cfun_mpz_jacobi(any ex);
+any cfun_mpz_legendre(any ex);
+any cfun_mpz_kronecker(any ex);
+any cfun_mpz_kronecker_si(any ex);
+any cfun_mpz_kronecker_ui(any ex);
+any cfun_mpz_si_kronecker(any ex);
+any cfun_mpz_ui_kronecker(any ex);
+any cfun_mpz_remove(any ex);
+any cfun_mpz_fac_ui(any ex);
+any cfun_mpz_bin_ui(any ex);
+any cfun_mpz_bin_uiui(any ex);
+any cfun_mpz_fib_ui(any ex);
+any cfun_mpz_fib2_ui(any ex);
+any cfun_mpz_lucnum_ui(any ex);
+any cfun_mpz_lucnum2_ui(any ex);
+any cfun_mpz_cmp(any ex);
+any cfun_mpz_cmp_si(any ex);
+any cfun_mpz_cmp_ui(any ex);
+any cfun_mpz_cmpabs(any ex);
+any cfun_mpz_cmpabs_ui(any ex);
+any cfun_mpz_sgn(any ex);
+any cfun_mpz_and(any ex);
+any cfun_mpz_ior(any ex);
+any cfun_mpz_xor(any ex);
+any cfun_mpz_com(any ex);
+any cfun_mpz_popcount(any ex);
+any cfun_mpz_hamdist(any ex);
+any cfun_mpz_scan0(any ex);
+any cfun_mpz_scan1(any ex);
+any cfun_mpz_setbit(any ex);
+any cfun_mpz_clrbit(any ex);
+any cfun_mpz_combit(any ex);
+any cfun_mpz_tstbit(any ex);
diff --git a/src/mod/gmpx.c b/src/mod/gmpx.c
@@ -0,0 +1,27 @@
+#include "../pico.h"
+#include "gmp.h"
+
+any cfun_mpz_new(any ex __attribute__((unused))) {
+ mpz_ptr z = malloc(sizeof(__mpz_struct));
+ return box(z);
+}
+
+any cfun_mpz_free(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ free(b1);
+ return Nil;
+}
+
+any cfun_mpz_print(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ mpz_ptr b1 = (mpz_ptr) unBox(y);
+ gmp_printf("%Zd", b1);
+ return Nil;
+}
diff --git a/src/mod/gmpx.fn b/src/mod/gmpx.fn
@@ -0,0 +1,3 @@
+ {cfun_mpz_new, "mpz_new"},
+ {cfun_mpz_free, "mpz_free"},
+ {cfun_mpz_print, "mpz_print"},
diff --git a/src/mod/gmpx.h b/src/mod/gmpx.h
@@ -0,0 +1,3 @@
+any cfun_mpz_new(any ex);
+any cfun_mpz_free(any ex);
+any cfun_mpz_print(any ex);
diff --git a/src/mod/gtk-demo1.l b/src/mod/gtk-demo1.l
@@ -0,0 +1,24 @@
+(gtk_init 'NULL 'NULL)
+(setq win (gtk_window_new 0))
+(gtk_window_set_title win "'This is a title'")
+(gtk_window_set_default_size win 100 100)
+(gtk_window_set_position win 1)
+(setq table (gtk_table_new 30 30 1))
+(gtk_container_add win table)
+(setq button1 (gtk_button_new_with_label "'Exit'"))
+(gtk_table_attach_defaults table button1 17 28 20 25)
+(setq button2 (gtk_button_new_with_label "'Print text'"))
+(gtk_table_attach_defaults table button2 2 13 20 25)
+(setq entry (gtk_entry_new))
+(gtk_table_attach_defaults table entry 2 28 5 15)
+(gtk_widget_show_all win)
+
+#(let event 0
+# (until (prog
+# (setq event (gtk_server_callback 'wait))
+# (or (= event button1) (= event win)))
+# (when (= event button2)
+# (prinl "Contents: " (gtk_entry_get_text entry)))))
+(gtk_main)
+
+(gtk_exit 0)
diff --git a/src/mod/gtk-demo2.glade b/src/mod/gtk-demo2.glade
@@ -0,0 +1,485 @@
+<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
+<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
+
+<glade-interface>
+
+<widget class="GtkWindow" id="clisp-gui-main">
+ <property name="visible">True</property>
+ <property name="title" translatable="yes">CLISP GUI</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="default_width">600</property>
+ <property name="default_height">400</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="icon">clisp.ico</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="urgency_hint">False</property>
+ <signal name="delete_event" handler="(gtk:gui-quit)" last_modification_time="Wed, 18 Oct 2006 20:13:05 GMT"/>
+ <signal name="destroy_event" handler="(gtk:gui-quit)" last_modification_time="Thu, 19 Oct 2006 04:52:39 GMT"/>
+
+ <child>
+ <widget class="GtkVBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkMenuBar" id="menubar1">
+ <property name="visible">True</property>
+ <property name="pack_direction">GTK_PACK_DIRECTION_LTR</property>
+ <property name="child_pack_direction">GTK_PACK_DIRECTION_LTR</property>
+
+ <child>
+ <widget class="GtkMenuItem" id="menuitem4">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_File</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="menuitem4_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="new1">
+ <property name="visible">True</property>
+ <property name="label">gtk-new</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_new1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="open1">
+ <property name="visible">True</property>
+ <property name="label">gtk-open</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_open1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="save1">
+ <property name="visible">True</property>
+ <property name="label">gtk-save</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_save1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="save_as1">
+ <property name="visible">True</property>
+ <property name="label">gtk-save-as</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_save_as1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separatormenuitem1">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="quit1">
+ <property name="visible">True</property>
+ <property name="label">gtk-quit</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(gtk:gui-quit)" last_modification_time="Wed, 18 Oct 2006 20:13:27 GMT"/>
+ <signal name="activate_item" handler="(gtk:gui-quit)" last_modification_time="Thu, 19 Oct 2006 04:54:18 GMT"/>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="menuitem5">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Edit</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="menuitem5_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="cut1">
+ <property name="visible">True</property>
+ <property name="label">gtk-cut</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_cut1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="copy1">
+ <property name="visible">True</property>
+ <property name="label">gtk-copy</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_copy1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="paste1">
+ <property name="visible">True</property>
+ <property name="label">gtk-paste</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_paste1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="delete1">
+ <property name="visible">True</property>
+ <property name="label">gtk-delete</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(print 'on_delete1_activate)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="menuitem6">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_View</property>
+ <property name="use_underline">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="menuitem7">
+ <property name="visible">True</property>
+ <property name="label">gtk-help</property>
+ <property name="use_stock">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="menuitem7_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="about1">
+ <property name="visible">True</property>
+ <property name="label">gtk-about</property>
+ <property name="use_stock">True</property>
+ <signal name="activate" handler="(gtk:gui-about-do)" last_modification_time="Wed, 18 Oct 2006 19:10:08 GMT"/>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkToolbar" id="toolbar1">
+ <property name="width_request">0</property>
+ <property name="visible">True</property>
+ <property name="orientation">GTK_ORIENTATION_HORIZONTAL</property>
+ <property name="toolbar_style">GTK_TOOLBAR_BOTH</property>
+ <property name="tooltips">True</property>
+ <property name="show_arrow">True</property>
+
+ <child>
+ <widget class="GtkToolButton" id="toolbutton_clear">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">clear</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-clear</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+ <signal name="clicked" handler="(gtk:gui-clear-do)" last_modification_time="Thu, 26 Oct 2006 18:58:08 GMT"/>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolButton" id="toolbutton_eval">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">eval</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-execute</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">True</property>
+ <signal name="clicked" handler="(gtk:gui-eval-do)" last_modification_time="Thu, 26 Oct 2006 18:58:08 GMT"/>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolButton" id="toolbutton_describe">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">describe</property>
+ <property name="use_underline">True</property>
+ <property name="stock_id">gtk-info</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+ <signal name="clicked" handler="(gtk:gui-describe-do)" last_modification_time="Thu, 26 Oct 2006 18:58:08 GMT"/>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVSeparator" id="vseparator1">
+ <property name="visible">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="vbox2">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkLabel" id="label1_apropos">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">apropos:</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="mnemonic_widget">entry1_apropos</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_END</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">True</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="entry1_apropos">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">•</property>
+ <property name="activates_default">False</property>
+ <signal name="editing_done" handler="(gtk:gui-apropos-do)" last_modification_time="Thu, 26 Oct 2006 18:53:16 GMT"/>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTextView" id="textview_repl">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="overwrite">False</property>
+ <property name="accepts_tab">True</property>
+ <property name="justification">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap_mode">GTK_WRAP_NONE</property>
+ <property name="cursor_visible">True</property>
+ <property name="pixels_above_lines">0</property>
+ <property name="pixels_below_lines">0</property>
+ <property name="pixels_inside_wrap">0</property>
+ <property name="left_margin">0</property>
+ <property name="right_margin">0</property>
+ <property name="indent">0</property>
+ <property name="text" translatable="yes"></property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkStatusbar" id="statusbar1">
+ <property name="visible">True</property>
+ <property name="has_resize_grip">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="dialog1_about">
+ <property name="visible">True</property>
+ <property name="title" translatable="yes">dialog1</property>
+ <property name="type">GTK_WINDOW_POPUP</property>
+ <property name="window_position">GTK_WIN_POS_MOUSE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">True</property>
+ <property name="icon_name">gtk-dialog-info</property>
+ <property name="decorated">False</property>
+ <property name="skip_taskbar_hint">True</property>
+ <property name="skip_pager_hint">True</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="urgency_hint">False</property>
+ <property name="has_separator">True</property>
+ <signal name="close" handler="(gtk:gui-about-done)" last_modification_time="Thu, 26 Oct 2006 18:47:07 GMT"/>
+ <signal name="delete_event" handler="(gtk:gui-about-done)" last_modification_time="Thu, 26 Oct 2006 18:47:53 GMT"/>
+ <signal name="destroy_event" handler="(gtk:gui-about-done)" last_modification_time="Thu, 26 Oct 2006 18:48:22 GMT"/>
+ <accelerator key="F4" modifiers="GDK_MOD1_MASK" signal="close"/>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="dialog-vbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialog-action_area1">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="okbutton1">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-ok</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-5</property>
+ <signal name="clicked" handler="(gtk:gui-about-done)" last_modification_time="Thu, 26 Oct 2006 18:46:19 GMT"/>-
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTextView" id="textview_about">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="overwrite">False</property>
+ <property name="accepts_tab">True</property>
+ <property name="justification">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap_mode">GTK_WRAP_NONE</property>
+ <property name="cursor_visible">True</property>
+ <property name="pixels_above_lines">0</property>
+ <property name="pixels_below_lines">0</property>
+ <property name="pixels_inside_wrap">0</property>
+ <property name="left_margin">0</property>
+ <property name="right_margin">0</property>
+ <property name="indent">0</property>
+ <property name="text" translatable="yes"></property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+</glade-interface>
diff --git a/src/mod/gtk-demo2.l b/src/mod/gtk-demo2.l
@@ -0,0 +1,29 @@
+(gtk_init 'NULL 'NULL) # ??? NIL instead of NULL???
+(glade_init)
+#(setq xml (glade_xml_new "glade.glade" 'NULL 'NULL))
+(setq xml (glade_xml_new "src/mod/gtk-demo2.glade" 'NULL 'NULL))
+
+(de handler (handlerName object signalName signalData connectObject after userData)
+ (println (list handlerName object signalName signalData connectObject after userData))
+ #(gtk_connect object signalName)
+ )
+
+(glade_xml_signal_autoconnect_full xml 'handler 0)
+#(glade_xml_signal_autoconnect xml)
+#(setq win (glade_xml_get_widget xml 'window))
+#(gtk_server_connect win 'delete-event 'window)
+#(setq ebtn (glade_xml_get_widget xml 'exit_button))
+#(gtk_server_connect ebtn 'clicked 'exit_button)
+#(setq pbtn (glade_xml_get_widget xml 'print_button))
+#(gtk_server_connect pbtn 'clicked 'print_button)
+#(setq entry (glade_xml_get_widget xml 'entry))
+
+#(let event 0
+# (until (prog
+# (setq event (gtk_server_callback 'wait))
+# (or (= event 'exit_button) (= event 'window)))
+# (when (= event 'print_button)
+# (prinl (gtk_entry_get_text entry)))))
+(gtk_main)
+
+(gtk_exit 0)
diff --git a/src/mod/gtk-server.TODO b/src/mod/gtk-server.TODO
@@ -0,0 +1,515 @@
+
+
+
+
+
+
+
+
+
+(ctype GtkWidget* c-pointer)
+
+;;;
+;;; callback handling
+;;;
+
+;; this is complicated as each callback can have a different number of
+;; arguments and it is the last that is most interesting (a gpointer to
+;; some data we manage)
+;; in order to call lisp functions (and thus support closures) rather
+;; than being limited to a primitive data type, the data parameter is
+;; used by this module, as an index into a global vector of callback
+;; functions. so, a call is made to gtk_connect, with an object, the
+;; event name and a callback function the callback is put in the global
+;; vector, and its index is given as the data argument to
+;; g_signal_connect_data. This module's callback function performs the
+;; lookup (it gets the index as its last parameter), and calls it.
+;; this could be handled directly by the ffi (passing in a lisp function
+;; as the callback would work) but this causes memory leaks.
+
+;;;
+;;; make the connect functions, taking from 0-4 arguments as well as the object
+;;;
+
+(defmacro make-connect-funcs (param-count)
+ (let* ((c-name (intern (format nil "g_signal_connect_data-~a" param-count)))
+ (cb-name (intern (format nil "gtk-callback-~a" param-count)))
+ (args (loop :for i :from 1 :upto param-count
+ :collect (intern (format nil "ARG-~a" i))))
+ (arg-types (mapcar (lambda (x) `(,x c-pointer)) args)))
+ `(progn
+ (def-call-out ,c-name (:name "g_signal_connect_data")
+ (:return-type int)
+ (:arguments (widget GtkWidget*)
+ (name c-string)
+ (callback
+ (c-function (:arguments (object c-pointer)
+ ,@arg-types
+ (data int))
+ (:return-type int)))
+ (data int)
+ (clean-up
+ (c-function (:arguments (data int))
+ (:return-type nil)))
+ (b int)))
+ (def-call-in ,cb-name (:return-type ffi:int)
+ (:arguments (object c-pointer)
+ ,@arg-types
+ (data ffi:c-string)))
+ (defun ,cb-name (object ,@args data)
+ (funcall (aref *callback-funcs* data) object ,@args))
+ (setf (aref *connect-funcs* ,param-count) (cons #',c-name #',cb-name)))))
+
+(defvar *connect-funcs* (make-array 5))
+(defvar *callback-funcs* (make-array 0 :adjustable t :fill-pointer 0))
+(make-connect-funcs 0)
+(make-connect-funcs 1)
+(make-connect-funcs 2)
+(make-connect-funcs 3)
+(make-connect-funcs 4)
+
+;;;
+;;; our cleanup function just has to discard the entry in *callback-funcs*
+;;;
+
+(def-call-in gtk-cleanup (:arguments (data int)) (:return-type nil))
+
+(defun gtk-cleanup (data)
+ (format t "~S(~D): discarded ~S~%" 'gtk-cleanup data
+ (aref *callback-funcs* data))
+ (setf (aref *callback-funcs* data) nil)
+ nil)
+
+
+
+
+
+
+ ;;;
+;;; These struct definitions allow us to get the itype from an object
+;;;
+
+(def-c-type GType ulong)
+(def-c-struct GTypeClass (g_type GType))
+(def-c-struct GTypeInstance (g_class (c-ptr GTypeClass)))
+(def-c-struct GSignalQuery
+ (signal_id int)
+ (signal_name c-string)
+ (itype int)
+ (signal_flags int)
+ (return_type int)
+ (n_params int)
+ (param_types c-pointer))
+
+(def-call-out g_signal_handler_disconnect (:return-type nil)
+ (:arguments (obj GtkWidget*) (id int)))
+(def-call-out g_signal_lookup (:return-type int)
+ (:arguments (name c-string) (itype int)))
+(def-call-out g_signal_query (:return-type nil)
+ (:arguments (id int) (query c-pointer)))
+(def-call-out g_type_from_name (:return-type int) (:arguments (name c-string)))
+
+(defun get_type_from_instance (widget)
+ "Returns the type from an instance instance->g_class->g_type"
+ (with-c-var (_widget 'c-pointer widget)
+ (slot (deref (slot (deref (cast _widget '(c-ptr GTypeInstance)))
+ 'g_class))
+ 'g_type)))
+
+(defun gtk_connect (widget signal func)
+ "The exported function, gtk_connect, taking a gobject, a
+signal name (e.g `delete_event') and a callback function.
+The callback function will be passed the gobject, and any other
+signal specific parameters, but not a data parameter."
+ (let* ((n_params
+ (with-c-var (query 'GSignalQuery)
+ (g_signal_query (g_signal_lookup signal
+ (get_type_from_instance widget))
+ (c-var-address query))
+ (slot query 'n_params)))
+ (funcs (aref *connect-funcs* n_params))
+ (idx (or (position nil *callback-funcs*)
+ (vector-push-extend func *callback-funcs*))))
+ (funcall (car funcs)
+ widget
+ signal
+ (cdr funcs)
+ idx
+ #'gtk-cleanup
+ 0)))
+
+
+;;;
+;;; the actual imports
+;;;
+
+;; rather than coding these in by hand, they are read from gtk-server.cfg
+;; this file is part of the (excellent) http://www.gtk-server.org project,
+;; and defines lots of gtk functions in a simple-enough-to-parse form.
+;;
+;; the scanning is done in a macro, so it is performed at compile time.
+;; there is no need to ship gtk-server.cfg with your project.
+
+(defmacro read-gtk-server-cfg (filename)
+ (labels ((convert-type (typ)
+ (let ((sym (read-from-string typ)))
+ (case sym
+ (NONE 'nil)
+ (LONG 'long)
+ (BOOL 'boolean)
+ (STRING 'c-string)
+ (FLOAT 'single-float)
+ (DOUBLE 'double-float)
+ (NULL 'c-pointer)
+ (WIDGET 'GtkWidget*)
+ (otherwise sym))))
+ (proc-line (string start)
+ (let* ((parts (loop :for i = start :then (1+ j)
+ :as j = (position #\, string :start i)
+ :collect (string-trim " " (subseq string i j))
+ :while j))
+ ;; parts are: API name, callback signal type, return value,
+ ;; number of arguments, arg1, arg2...
+ (name (intern (pop parts)))
+ (callback-sig-type (pop parts))
+ (ret-type (pop parts))
+ (num-arg (parse-integer (pop parts))))
+ (declare (ignore callback-sig-type))
+ (unless (= num-arg (length parts))
+ (warn "~S: argument count ~D does not match argument list ~S"
+ name num-arg parts))
+ `(def-call-out ,name (:return-type ,(convert-type ret-type))
+ (:arguments ,@(loop :for arg :in parts
+ :collect `(arg ,(convert-type arg))))))))
+ `(progn
+ ,@(with-open-file (cfg filename)
+ (format t "~&;; Reading ~A~%" (truename cfg))
+ (loop :with forms = nil
+ :finally (format t "~&;; Defined ~:D function~:P~%"
+ (length forms))
+ :finally (return forms)
+ :for line = (read-line cfg nil)
+ :while line
+ :do
+ (setq line (string-trim #.(coerce '(#\space #\tab) 'string) line))
+ ;; check that it starts with "FUNCTION_NAME = "
+ (when (and (> (length line) #1=#.(length #2="FUNCTION_NAME = "))
+ (string= line #2# :end1 #1#))
+ (push (proc-line line #1#) forms)))))))
+
+(read-gtk-server-cfg "gtk-server.cfg")
+
+(def-c-struct GtkTreeIter
+ (stamp int)
+ (user_data c-pointer)
+ (user_data2 c-pointer)
+ (user_data3 c-pointer))
+
+(def-c-struct GValue
+ (g_type int)
+ (unknown1 double-float)
+ (unknown2 double-float)
+ (unknown3 double-float)
+ (unknown4 double-float))
+
+(def-call-out g_type_fundamental (:return-type int) (:arguments (val int)))
+(def-call-out g_value_init (:return-type nil)
+ (:arguments (val c-pointer) (gtype int)))
+(def-call-out g_value_set_string (:return-type nil)
+ (:arguments (val c-pointer) (str c-string)))
+(def-call-out g_object_set_data (:return-type nil)
+ (:arguments (obj c-pointer) (key c-string) (data c-pointer)))
+(def-call-out g_object_get_data (:return-type c-pointer)
+ (:arguments (obj c-pointer) (key c-string)))
+
+(def-call-out gtk_tree_view_set_model (:return-type nil)
+ (:arguments (widget GtkWidget*) (model c-pointer)))
+
+(def-call-out gtk_tree_view_column_set_title (:return-type nil)
+ (:arguments (view GtkWidget*) (title c-string)))
+(def-call-out gtk_tree_view_column_set_attributes (:return-type nil)
+ (:arguments (column c-pointer) (renderer c-pointer) (name c-string)
+ (value int) (terminator nil)))
+(def-call-out gtk_tree_view_column_add_attribute (:return-type nil)
+ (:arguments (column c-pointer) (renderer c-pointer) (name c-string)
+ (value int)))
+
+;;;
+;; memory leak test
+;;;
+
+#+nil
+(defun ml-test ()
+ (gtk_init 0 0)
+ (let ((w (gtk_window_new 0)))
+ (gtk_widget_show_all w)
+ (loop :for id = (gtk_connect w "delete_event"
+ (lambda (&rest args)
+ (declare (ignore args))
+ (print "destroyed") (ext:quit)))
+ :do (g_signal_handler_disconnect w id)
+ (ext:gc)
+ (print (room))
+ (sleep 0.1))
+ (gtk_main)))
+
+;;;
+;;; === GLADE ===
+;;;
+
+(c-lines "#include <glade/glade-xml.h>~%")
+
+(def-c-type GladeXML* c-pointer)
+(def-c-type GCallback
+ (c-pointer (c-function (:return-type nil) (:arguments))))
+(def-c-type GObject* c-pointer)
+
+(cfun glade_xml_new GladeXML* (cstr fname) (cstr root) (cstr domain)))
+
+(def-call-out glade_xml_new_from_buffer (:return-type GladeXML*)
+ (:arguments (buffer c-string)
+ (size int) ; pass (length buffer)
+ (root c-string)
+ (domain c-string)))
+(def-call-out glade_xml_construct (:return-type boolean)
+ (:arguments (self GladeXML*)
+ (fname c-string)
+ (root c-string)
+ (domain c-string)))
+(def-call-out glade_xml_signal_connect (:return-type nil)
+ (:arguments (self GladeXML*)
+ (handlername c-string)
+ (func GCallback)))
+(def-call-out glade_xml_signal_connect_data (:return-type nil)
+ (:arguments (self GladeXML*)
+ (handlername c-string)
+ (func GCallback)
+ (user_data c-pointer)))
+(def-call-out glade_xml_signal_autoconnect (:return-type nil)
+ (:arguments (self GladeXML*)))
+(def-call-out glade_xml_get_widget (:return-type GtkWidget*)
+ (:arguments (self GladeXML*)
+ (name c-string)))
+(def-c-type GList* c-pointer)
+(def-call-out glade_xml_get_widget_prefix (:return-type GList*)
+ (:arguments (self GladeXML*)
+ (name c-string)))
+(def-call-out glade_get_widget_name (:return-type c-string)
+ (:arguments (widget GtkWidget*)))
+(def-call-out glade_get_widget_tree (:return-type GladeXML*)
+ (:arguments (widget GtkWidget*)))
+(def-c-type GladeXMLConnectFunc
+ (c-function (:return-type nil)
+ (:arguments (handler_name c-string)
+ (object GObject*)
+ (signal_name c-string)
+ (signal_data c-string)
+ (connect_object GObject*)
+ (after boolean)
+ (user_data c-pointer))))
+(def-call-out glade_xml_signal_connect_full (:return-type nil)
+ (:arguments (self GladeXML*)
+ (handler_name c-string)
+ (func GladeXMLConnectFunc)
+ (user_data c-pointer)))
+(def-call-out glade_xml_signal_autoconnect_full (:return-type nil)
+ (:arguments (self GladeXML*)
+ (func GladeXMLConnectFunc)
+ (user_data c-pointer)))
+(def-c-type GladeXMLCustomWidgetHandler
+ (c-function (:return-type GtkWidget*)
+ (:arguments (xml GladeXML*)
+ (func_name c-string)
+ (name c-string)
+ (string1 c-string)
+ (string2 c-string)
+ (int1 int)
+ (int2 int)
+ (user_data c-pointer))))
+(def-call-out glade_set_custom_handler (:return-type nil)
+ (:arguments (handler GladeXMLCustomWidgetHandler)
+ (user_data c-pointer)))
+
+(include "glade/glade.h" "glade/glade-build.h")
+
+(def-c-type GladeWidgetInfo* c-pointer)
+
+(def-c-type GladeNewFunc
+ (c-function (:return-type GtkWidget*)
+ (:arguments (xml GladeXML*)
+ (widget_type GType)
+ (info c-pointer))))
+(def-c-type GladeBuildChildrenFunc
+ (c-function (:return-type nil)
+ (:arguments (xml GladeXML*)
+ (parent GtkWidget*)
+ (info c-pointer))))
+(def-c-type GladeFindInternalChildFunc
+ (c-function (:return-type GtkWidget*)
+ (:arguments (xml GladeXML*)
+ (parent GtkWidget*)
+ (childname c-string))))
+
+(def-c-type GladeChildInfo* c-pointer)
+
+(def-call-out glade_xml_build_widget (:return-type GtkWidget*)
+ (:arguments (self GladeXML*)
+ (info c-pointer)))
+(def-call-out glade_xml_handle_internal_child (:return-type nil)
+ (:arguments (self GladeXML*)
+ (parent GtkWidget*)
+ (child_info GladeChildInfo*)))
+(def-call-out glade_xml_set_common_params (:return-type nil)
+ (:arguments (self GladeXML*)
+ (widget GtkWidget*)
+ (info c-pointer)))
+(def-call-out glade_register_widget (:return-type nil)
+ (:arguments (type GType)
+ (new_func GladeNewFunc)
+ (build_children GladeBuildChildrenFunc)
+ (find_internal_child GladeFindInternalChildFunc)))
+(def-call-out glade_standard_build_widget (:return-type GtkWidget*)
+ (:arguments (xml GladeXML*)
+ (widget_type GType)
+ (info c-pointer)))
+(def-call-out glade_xml_handle_widget_prop (:return-type nil)
+ (:arguments (self GladeXML*)
+ (widget GtkWidget*)
+ (prop_name c-string)
+ (value_name c-string)))
+(def-call-out glade_standard_build_children (:return-type nil)
+ (:arguments (self GladeXML*)
+ (parent GtkWidget*)
+ (info c-pointer)))
+(def-call-out glade_xml_set_packing_property (:return-type nil)
+ (:arguments (self GladeXML*)
+ (parent GtkWidget*)
+ (child GtkWidget*)
+ (name c-string)
+ (value c-string)))
+(def-c-type GladeApplyCustomPropFunc
+ (c-function (:return-type nil)
+ (:arguments (xml GladeXML*)
+ (widget GtkWidget*)
+ (propname c-string)
+ (value c-string))))
+(def-call-out glade_register_custom_prop (:return-type nil)
+ (:arguments (type GType)
+ (prop_name c-string)
+ (apply_prop GladeApplyCustomPropFunc)))
+(def-call-out glade_xml_relative_file (:return-type c-string)
+ (:arguments (self GladeXML*)
+ (filename c-string)))
+(def-call-out glade_enum_from_string (:return-type int)
+ (:arguments (type GType)
+ (string c-string)))
+(def-call-out glade_flags_from_string (:return-type uint)
+ (:arguments (type GType)
+ (string c-string)))
+(def-c-type GParamSpec* c-pointer)
+(def-call-out glade_xml_set_value_from_string (:return-type boolean)
+ (:arguments (xml GladeXML*)
+ (pspec GParamSpec*)
+ (string c-string)
+ (value (c-ptr GValue) :out :alloca)))
+(def-c-type GtkWindow* c-pointer)
+(def-call-out glade_xml_set_toplevel (:return-type nil)
+ (:arguments (xml GladeXML*)
+ (window GtkWindow*)))
+(def-c-type GtkAccelGroup* c-pointer)
+(def-call-out glade_xml_ensure_accel (:return-type GtkAccelGroup*)
+ (:arguments (xml GladeXML*)))
+
+
+;;;
+;;; High-level UI
+;;;
+
+(defun glade-load (file)
+ (let ((xml (or (glade_xml_new (namestring (absolute-pathname file)) nil nil)
+ (error "~S(~S): ~S failed" 'glade-load file 'glade_xml_new))))
+ (glade_xml_signal_autoconnect_full
+ xml
+ (lambda (handler_name object signal_name signal_data connect_object
+ after user_data)
+ (declare (ignore signal_data connect_object after user_data))
+ (gtk_connect object signal_name
+ (let ((code (read-from-string handler_name)))
+ (compile
+ (make-symbol (princ-to-string code))
+ `(lambda (&rest args)
+ (format t "~&calling ~S with arguments ~S~%"
+ ',code args)
+ ,code
+ 0))))) ; return an integer
+ nil)
+ xml))
+
+(defun run-glade-file (file widget-name)
+ (gtk_init nil nil)
+ (gtk_widget_show_all (glade_xml_get_widget (glade-load file) widget-name))
+ (gtk_main))
+
+;;;
+;;; clisp gui
+;;;
+
+(defstruct gui main repl apropos status about-window about-text)
+(defvar *gui*)
+(defun gui-from-file (file)
+ (let ((xml (glade-load file)))
+ (flet ((widget (name)
+ (let ((w (or (glade_xml_get_widget xml name)
+ (error "~S(~S): not found ~S" 'gui-from-file
+ file name))))
+ (format t "~&~A == ~S~%" name w)
+ w)))
+ (make-gui :main (widget "clisp-gui-main")
+ :repl (widget "textview_repl")
+ :apropos (widget "entry1_apropos")
+ :status (widget "statusbar1")
+ :about-window (widget "dialog1_about")
+ :about-text (widget "textview_about")))))
+
+(defun gui-status-show (string &optional (*gui* *gui*))
+ (gtk_statusbar_push (gui-status *gui*) (length string) string))
+
+(defun gui-apropos-do (&optional (*gui* *gui*))
+ (apropos (gtk_entry_get_text (gui-apropos *gui*))))
+
+(defun gui-about-do (&optional (*gui* *gui*))
+ (let ((about-text
+ (format nil "This is a gtk2 demo.~%~A ~A~%"
+ (lisp-implementation-type) (lisp-implementation-version))))
+ (gtk_text_buffer_set_text
+ (gtk_text_view_get_buffer (gui-about-text *gui*))
+ about-text (length about-text)))
+ (gtk_widget_show (gui-about-window *gui*))
+ (gui-status-show (SYS::TEXT "Displaying ABOUT")))
+
+(defun gui-about-done (&optional (*gui* *gui*))
+ (gtk_widget_hide (gui-about-window *gui*))
+ (gui-status-show (SYS::TEXT "Closed ABOUT")))
+
+(defun gui-clear-do (&optional (*gui* *gui*))
+ (gui-status-show (SYS::TEXT "Clear CLISP output")))
+
+(defun gui-eval-do (&optional (*gui* *gui*))
+ (gui-status-show (SYS::TEXT "Call EVAL on the current selection")))
+
+(defun gui-describe-do (&optional (*gui* *gui*))
+ (gui-status-show (SYS::TEXT "Call DESCRIBE on the current selection")))
+
+(defun gui-quit (&optional (*gui* *gui*))
+ (gui-status-show (SYS::TEXT "Bye!"))
+ (gtk_main_quit)
+ (throw 'gui-quit 0))
+
+(defun gui (file)
+ (gtk_init nil nil)
+ (let ((*gui* (gui-from-file file)))
+ (gui-status-show (SYS::TEXT "Welcome to CLISP!"))
+ (gtk_widget_show (gui-main *gui*))
+ (gtk_widget_hide (gui-about-window *gui*))
+ (catch 'gui-quit (gtk_main))
+ (format t (SYS::TEXT "Exited gui~%"))))
diff --git a/src/mod/gtk-server.cfg b/src/mod/gtk-server.cfg
@@ -0,0 +1,599 @@
+### sds: this file is taken from gtk-server-2.1.1.tar.gz
+#
+# This is an EXAMPLE config file containing API calls used by the GTK-server.
+#
+# When developing your own application, feel free to change any of the
+# definitions below to your needs. Per application you can use an individual
+# configfile. Just put the GTK-server configfile in the same directory as your
+# client script, as the GTK-server will look there first.
+#
+# Do you want to add more GTK functions? Please consult the GTK documentation
+# at http://www.gtk.org/api/.
+#
+# The layout of this file is explained in the man-page:
+#
+# man gtk-server.cfg
+#
+#
+# Happy GUIfying!
+# Peter van Eerten
+#
+#---------------------------------------------------------------------------
+#
+# Only when the gtk-server binary does not contain the GTK libs, these
+# settings must be activated.
+#
+# Linux
+#
+# GTK1 backend:
+# GTK_LIB_NAME = libgtk.so
+# GDK_LIB_NAME = libgdk.so
+# GLIB_LIB_NAME = libglib.so
+#
+# GTK2 backend:
+GTK_LIB_NAME = libgtk-x11-2.0.so
+GDK_LIB_NAME = libgdk-x11-2.0.so
+GLIB_LIB_NAME = libglib-2.0.so
+GOBJECT_LIB_NAME = libgobject-2.0.so
+ATK_LIB_NAME = libatk-1.0.so
+PANGO_LIB_NAME = libpango-1.0.so
+PIXBUF_LIB_NAME = libgdk_pixbuf_xlib-2.0.so
+#
+# XForms backend:
+# FORMS_LIB_NAME = libforms.so
+# FLIMAGE_LIB_NAME = libflimage.so
+# FORMSGL_LIB_NAME = libformsGL.so
+#
+#---------------------------------------------------------------------------
+#
+# Windows
+#
+# GTK1 backend:
+# GTK_LIB_NAME = libgtk-0.dll
+# GDK_LIB_NAME = libgdk-0.dll
+# GLIB_LIB_NAME = libglib-2.0-0.dll
+#
+# GTK2 backend:
+# GTK_LIB_NAME = libgtk-win32-2.0-0.dll
+# GDK_LIB_NAME = libgdk-win32-2.0-0.dll
+# GLIB_LIB_NAME = libglib-2.0-0.dll
+# GOBJECT_LIB_NAME = libgobject-2.0-0.dll
+# ATK_LIB_NAME = libatk-1.0-0.dll
+# PANGO_LIB_NAME = libpango-1.0-0.dll
+# PIXBUF_LIB_NAME = libgdk_pixbuf-2.0-0.dll
+#
+#---------------------------------------------------------------------------
+#
+# Directory where to put the logfile if logging is enabled.
+# In Windows, also use a slash forward (/) to separate directory's!
+#
+# Linux:
+LOG_FILE = /tmp
+#
+# Windows:
+# LOG_FILE = c:
+#
+#---------------------------------------------------------------------------
+#
+# API name, callback signal type, return value, amount of arguments, arg1, arg2...
+#
+# GTK_WINDOW
+#
+FUNCTION_NAME = gtk_window_new, delete-event, WIDGET, 1, LONG
+FUNCTION_NAME = gtk_window_set_title, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_window_get_title, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_window_set_default_size, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_window_set_position, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_window_set_resizable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_window_set_transient_for, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_window_maximize, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_message_dialog_new, response, WIDGET, 5, WIDGET, LONG, LONG, LONG, STRING
+FUNCTION_NAME = gtk_window_set_icon_from_file, NONE, BOOL, 3, WIDGET, STRING, NULL
+FUNCTION_NAME = gtk_window_set_keep_above, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_window_set_keep_below, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_about_dialog_set_version, NONE, NONE, 2, WIDGET, STRING
+#
+# Containers
+#
+FUNCTION_NAME = gtk_table_new, NONE, WIDGET, 3, LONG, LONG, BOOL
+FUNCTION_NAME = gtk_table_attach_defaults, NONE, NONE, 6, WIDGET, WIDGET, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gtk_container_add, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_container_remove, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_container_set_border_width, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_hbox_new, NONE, WIDGET, 2, BOOL, LONG
+FUNCTION_NAME = gtk_vbox_new, NONE, WIDGET, 2, BOOL, LONG
+FUNCTION_NAME = gtk_box_pack_start, NONE, NONE, 5, WIDGET, WIDGET, BOOL, BOOL, LONG
+FUNCTION_NAME = gtk_box_pack_end, NONE, NONE, 5, WIDGET, WIDGET, BOOL, BOOL, LONG
+FUNCTION_NAME = gtk_box_pack_start_defaults, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_box_pack_end_defaults, NONE, NONE, 2, WIDGET, WIDGET
+#
+# GTK_BUTTON
+#
+FUNCTION_NAME = gtk_button_new, clicked, WIDGET, 0
+FUNCTION_NAME = gtk_button_new_with_label, clicked, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_button_new_from_stock, clicked, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_button_new_with_mnemonic, clicked, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_button_set_use_stock, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_button_set_label, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_button_set_relief, NONE, NONE, 2, WIDGET, LONG
+#
+# GTK_TOGGLE
+#
+FUNCTION_NAME = gtk_toggle_button_new, clicked, WIDGET, 0
+FUNCTION_NAME = gtk_toggle_button_new_with_label, clicked, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_toggle_button_get_active, NONE, BOOL, 1, WIDGET
+FUNCTION_NAME = gtk_toggle_button_set_active, NONE, NONE, 2, WIDGET, BOOL
+#
+# GTK_CHECK_BUTTON
+#
+FUNCTION_NAME = gtk_check_button_new_with_label, clicked, WIDGET, 1, STRING
+#
+# GTK_ENTRY
+#
+FUNCTION_NAME = gtk_entry_new, activate, WIDGET, 0
+FUNCTION_NAME = gtk_entry_get_text, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_entry_set_text, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_entry_set_visibility, NONE, NONE, 2, WIDGET, BOOL
+#
+# GTK_EDITABLE
+#
+FUNCTION_NAME = gtk_editable_delete_text, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_editable_get_chars, NONE, STRING, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_editable_set_editable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_editable_select_region, NONE, NONE, 3, WIDGET, LONG, LONG
+#
+# GTK_TEXT_VIEW related(GTK2.x)
+#
+FUNCTION_NAME = gtk_text_buffer_new, NONE, WIDGET, 1, NULL
+FUNCTION_NAME = gtk_text_buffer_set_text, NONE, NONE, 3, WIDGET, STRING, LONG
+FUNCTION_NAME = gtk_text_buffer_insert_at_cursor, NONE, NONE, 3, WIDGET, STRING, LONG
+FUNCTION_NAME = gtk_text_buffer_get_insert, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_start_iter, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_end_iter, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_bounds, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_selection_bounds, NONE, BOOL, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_iter_at_offset, NONE, NONE, 3, WIDGET, WIDGET, LONG
+FUNCTION_NAME = gtk_text_buffer_get_text, NONE, STRING, 4, WIDGET, WIDGET, WIDGET, BOOL
+FUNCTION_NAME = gtk_text_buffer_insert, NONE, NONE, 4, WIDGET, WIDGET, STRING, LONG
+FUNCTION_NAME = gtk_text_buffer_create_tag, NONE, WIDGET, 5, WIDGET, STRING, STRING, LONG, NULL
+FUNCTION_NAME = gtk_text_buffer_insert_with_tags_by_name, NONE, NONE, 8, WIDGET, WIDGET, STRING, LONG, STRING, STRING, STRING, NULL
+FUNCTION_NAME = gtk_text_buffer_apply_tag_by_name, NONE, NONE, 4, WIDGET, STRING, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_remove_tag_by_name, NONE, NONE, 4, WIDGET, STRING, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_remove_all_tags, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_tag_table, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_text_buffer_select_range, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_selection_bound, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_line_count, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_text_buffer_create_mark, NONE, WIDGET, 4, WIDGET, STRING, WIDGET, BOOL
+FUNCTION_NAME = gtk_text_buffer_get_iter_at_mark, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_get_iter_at_line, NONE, NONE, 3, WIDGET, WIDGET, LONG
+FUNCTION_NAME = gtk_text_buffer_delete, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_delete_mark, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_delete_mark_by_name, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_text_buffer_place_cursor, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_copy_clipboard, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_buffer_cut_clipboard, NONE, NONE, 3, WIDGET, WIDGET, BOOL
+FUNCTION_NAME = gtk_text_buffer_paste_clipboard, NONE, NONE, 4, WIDGET, WIDGET, NULL, BOOL
+FUNCTION_NAME = gtk_scrolled_window_new, NONE, WIDGET, 2, NULL, NULL
+FUNCTION_NAME = gtk_scrolled_window_set_policy, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_scrolled_window_set_shadow_type, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_scrolled_window_add_with_viewport, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_view_new_with_buffer, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_text_view_set_wrap_mode, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_view_set_editable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_text_view_set_border_window_size, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_text_view_move_mark_onscreen, NONE, BOOL, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_view_scroll_to_mark, NONE, NONE, 6, WIDGET, WIDGET, DOUBLE, BOOL, DOUBLE, DOUBLE
+FUNCTION_NAME = gtk_text_view_scroll_mark_onscreen, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_view_set_pixels_inside_wrap, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_view_get_pixels_inside_wrap, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_text_view_set_pixels_above_lines, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_view_get_pixels_above_lines, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_text_view_set_cursor_visible, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_text_view_window_to_buffer_coords, NONE, NONE, 6, WIDGET, LONG, LONG, LONG, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_iter_forward_search, NONE, BOOL, 6, WIDGET, STRING, LONG, WIDGET, WIDGET, NULL
+FUNCTION_NAME = gtk_text_iter_forward_visible_cursor_position, NONE, BOOL, 1, WIDGET
+FUNCTION_NAME = gtk_text_iter_forward_to_line_end, NONE, BOOL, 1, WIDGET
+FUNCTION_NAME = gtk_text_iter_set_line, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_iter_set_line_offset, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_iter_set_line_index, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_text_iter_get_text, NONE, STRING, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_text_iter_get_line, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_text_view_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_text_view_get_buffer, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_text_tag_table_remove, NONE, NONE, 2, WIDGET, WIDGET
+#
+# GTK_TEXT --- sds commented out
+#
+# FUNCTION_NAME = gtk_text_new, NONE, WIDGET, 2, NULL, NULL
+# FUNCTION_NAME = gtk_text_set_editable, NONE, NONE, 2, WIDGET, LONG
+# FUNCTION_NAME = gtk_text_insert, NONE, NONE, 6, WIDGET, NULL, NULL, NULL, STRING, LONG
+# FUNCTION_NAME = gtk_text_set_adjustments, NONE, NONE, 3, WIDGET, NULL, WIDGET
+# FUNCTION_NAME = gtk_text_get_length, NONE, LONG, 1, WIDGET
+# FUNCTION_NAME = gtk_text_set_word_wrap, NONE, NONE, 2, WIDGET, LONG
+# FUNCTION_NAME = gtk_text_backward_delete, NONE, BOOL, 2, WIDGET, LONG
+# FUNCTION_NAME = gtk_text_forward_delete, NONE, BOOL, 2, WIDGET, LONG
+# FUNCTION_NAME = gtk_text_set_point, NONE, NONE, 2, WIDGET, LONG
+#
+# GDK functions and drawing stuff
+#
+FUNCTION_NAME = gdk_font_load, NONE, WIDGET, 1, STRING
+FUNCTION_NAME = gdk_pixmap_new, NONE, WIDGET, 4, WIDGET, LONG, LONG, LONG
+FUNCTION_NAME = gdk_pixmap_unref, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gdk_pixmap_create_from_xpm, NONE, WIDGET, 4, WIDGET, NULL, NULL, STRING
+FUNCTION_NAME = gdk_pixmap_colormap_create_from_xpm, NONE, WIDGET, 5, NULL, WIDGET, NULL, NULL, STRING
+FUNCTION_NAME = gdk_draw_rectangle, NONE, NONE, 7, WIDGET, WIDGET, BOOL, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gdk_draw_arc, NONE, NONE, 9, WIDGET, WIDGET, BOOL, LONG, LONG, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gdk_draw_line, NONE, NONE, 6, WIDGET, WIDGET, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gdk_draw_point, NONE, NONE, 4, WIDGET, WIDGET, LONG, LONG
+FUNCTION_NAME = gdk_draw_layout, NONE, NONE, 5, WIDGET, WIDGET, LONG, LONG, WIDGET
+FUNCTION_NAME = gdk_draw_drawable, NONE, NONE, 9, WIDGET, WIDGET, WIDGET, LONG, LONG, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gdk_gc_new, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gdk_gc_set_rgb_fg_color, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_gc_set_rgb_bg_color, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_gc_set_foreground, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_gc_set_background, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_gc_set_colormap, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_color_alloc, NONE, LONG, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_color_parse, NONE, LONG, 2, STRING, WIDGET
+FUNCTION_NAME = gdk_colormap_get_system, NONE, WIDGET, 0
+FUNCTION_NAME = gdk_colormap_alloc_color, NONE, BOOL, 4, WIDGET, WIDGET, BOOL, BOOL
+FUNCTION_NAME = gdk_get_default_root_window, NONE, WIDGET, 0
+FUNCTION_NAME = gdk_rgb_find_color, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_drawable_set_colormap, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gdk_drawable_get_size, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gdk_keymap_translate_keyboard_state, NONE, BOOL, 8, NULL, LONG, LONG, LONG, WIDGET, NULL, NULL, NULL
+FUNCTION_NAME = gdk_window_process_all_updates, NONE, NONE, 0
+FUNCTION_NAME = gdk_window_get_geometry, NONE, NONE, 6, WIDGET, NULL, NULL, WIDGET, STRING, NULL
+FUNCTION_NAME = gdk_screen_get_default, NONE, WIDGET, 0
+FUNCTION_NAME = gdk_screen_get_width, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gdk_screen_get_height, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gdk_screen_width, NONE, LONG, 0
+FUNCTION_NAME = gdk_screen_height, NONE, LONG, 0
+FUNCTION_NAME = gdk_flush, NONE, NONE, 0
+FUNCTION_NAME = gdk_init, NONE, NONE, 2, NULL, NULL
+FUNCTION_NAME = gdk_display_get_default, NONE, WIDGET, 0
+FUNCTION_NAME = gdk_display_get_pointer, NONE, NONE, 5, WIDGET, NULL, WIDGET, WIDGET, NULL
+#
+# GTK functions for drawings
+#
+FUNCTION_NAME = gtk_image_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_image_new_from_pixmap, NONE, WIDGET, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_image_set_from_pixbuf, NONE, WIDGET, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_image_set_from_pixmap, NONE, NONE, 3, WIDGET, WIDGET, NULL
+FUNCTION_NAME = gtk_image_set, NONE, NONE, 3, WIDGET, WIDGET, NULL
+FUNCTION_NAME = gtk_image_set_from_file, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_image_new_from_file, NONE, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_pixmap_new, NONE, WIDGET, 2, WIDGET, NULL
+FUNCTION_NAME = gtk_drawing_area_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_widget_queue_draw, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_get_colormap, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_widget_get_parent_window, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_widget_create_pango_layout, NONE, WIDGET, 2, WIDGET, STRING
+#
+# GTK_SCROLLBARS
+#
+FUNCTION_NAME = gtk_vscrollbar_new, NONE, WIDGET, 1, WIDGET
+#
+# GTK_LABEL
+#
+FUNCTION_NAME = gtk_label_new, NONE, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_label_set_text, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_label_get_text, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_label_set_line_wrap, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_label_set_selectable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_label_set_use_markup, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_label_set_justify, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_label_get_width_chars, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_label_get_max_width_chars, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_label_set_markup_with_mnemonic, NONE, NONE, 2, WIDGET, STRING
+#
+# GTK_FRAME
+#
+FUNCTION_NAME = gtk_frame_new, NONE, WIDGET, 1, NULL
+FUNCTION_NAME = gtk_frame_set_label_align, NONE, NONE, 3, WIDGET, FLOAT, FLOAT
+FUNCTION_NAME = gtk_frame_set_label, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_frame_get_label, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_aspect_frame_new, NONE, WIDGET, 5, STRING, FLOAT, FLOAT, FLOAT, BOOL
+FUNCTION_NAME = gtk_aspect_frame_set, NONE, NONE, 5, WIDGET, FLOAT, FLOAT, FLOAT, BOOL
+#
+# GTK_RADIO_BUTTON
+#
+FUNCTION_NAME = gtk_radio_button_new, clicked, WIDGET, 1, NULL
+FUNCTION_NAME = gtk_radio_button_new_with_label, clicked, WIDGET, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_radio_button_new_from_widget, clicked, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_radio_button_new_with_label_from_widget, clicked, WIDGET, 2, WIDGET, STRING
+#
+# GTK_NOTEBOOK
+#
+FUNCTION_NAME = gtk_notebook_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_notebook_set_tab_pos, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_notebook_popup_enable, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_notebook_insert_page, NONE, NONE, 4, WIDGET, WIDGET, WIDGET, LONG
+FUNCTION_NAME = gtk_notebook_remove_page, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_notebook_get_current_page, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_notebook_set_page, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_notebook_set_tab_label_text, NONE, NONE, 3, WIDGET, WIDGET, STRING
+#
+# GTK_ADJUSTMENT
+#
+FUNCTION_NAME = gtk_adjustment_new, NONE, WIDGET, 6, DOUBLE, DOUBLE, DOUBLE, DOUBLE, DOUBLE, DOUBLE
+FUNCTION_NAME = gtk_adjustment_get_value, NONE, FLOAT, 1, WIDGET
+#
+# GTK_RANGE
+#
+FUNCTION_NAME = gtk_range_get_adjustment, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_range_get_value, NONE, FLOAT, 1, WIDGET
+FUNCTION_NAME = gtk_range_set_value, NONE, NONE, 2, WIDGET, DOUBLE
+#
+# GTK_SCALE
+#
+FUNCTION_NAME = gtk_scale_set_draw_value, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_scale_set_value_pos, NONE, NONE, 2, WIDGET, LONG
+#
+# GTK_HSCALE
+#
+FUNCTION_NAME = gtk_hscale_new, value-changed, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_hscale_new_with_range, value-changed, WIDGET, 3, DOUBLE, DOUBLE, DOUBLE
+#
+# GTK_VSCALE
+#
+FUNCTION_NAME = gtk_vscale_new_with_range, value-changed, WIDGET, 3, DOUBLE, DOUBLE, DOUBLE
+#
+# GTK_SPIN
+#
+FUNCTION_NAME = gtk_spin_button_new, NONE, WIDGET, 3, WIDGET, DOUBLE, LONG
+FUNCTION_NAME = gtk_spin_button_get_value_as_int, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_spin_button_get_value, NONE, FLOAT, 1, WIDGET
+FUNCTION_NAME = gtk_spin_button_set_wrap, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_spin_button_set_value, NONE, NONE, 2, WIDGET, DOUBLE
+#
+# GTK_ARROW
+#
+FUNCTION_NAME = gtk_arrow_new, NONE, WIDGET, 2, LONG, LONG
+#
+# File selector
+#
+FUNCTION_NAME = gtk_file_chooser_dialog_new, NONE, WIDGET, 8, STRING, WIDGET, LONG, STRING, LONG, STRING, LONG, NULL
+FUNCTION_NAME = gtk_file_chooser_widget_new, NONE, WIDGET, 1, LONG
+FUNCTION_NAME = gtk_dialog_run, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_file_chooser_get_filename, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_file_chooser_set_filename, NONE, BOOL, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_file_filter_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_file_filter_add_pattern, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_file_filter_set_name, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_file_chooser_add_filter, NONE, NONE, 2, WIDGET, WIDGET
+#
+# FONT selector
+#
+FUNCTION_NAME = gtk_font_selection_dialog_new, button-press-event, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_font_selection_dialog_get_font_name, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_font_selection_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_font_selection_get_font_name, NONE, STRING, 1, WIDGET
+FUNCTION_NAME = gtk_font_selection_set_font_name, NONE, BOOL, 2, WIDGET, STRING
+#
+# Color selections
+#
+FUNCTION_NAME = gtk_color_selection_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_color_selection_set_has_opacity_control, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_color_selection_set_current_color, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_color_selection_get_current_color, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_color_selection_set_color, NONE, NONE, 2, WIDGET, STRING
+#
+# Menubar
+#
+FUNCTION_NAME = gtk_menu_bar_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_menu_shell_append, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_menu_item_new, activate, WIDGET, 0
+FUNCTION_NAME = gtk_menu_item_new_with_label, activate, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_menu_item_new_with_mnemonic, activate, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_menu_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_menu_item_set_right_justified, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_menu_item_set_submenu, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_check_menu_item_new_with_label, activate, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_check_menu_item_new_with_mnemonic, activate, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_check_menu_item_get_active, NONE, BOOL, 1, WIDGET
+FUNCTION_NAME = gtk_check_menu_item_set_active, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_menu_popup, NONE, NONE, 7, WIDGET, NULL, NULL, NULL, NULL, LONG, LONG
+#
+# GTK_PROGRESS_BAR
+#
+FUNCTION_NAME = gtk_progress_bar_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_progress_bar_set_text, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_progress_bar_set_fraction, NONE, NONE, 2, WIDGET, DOUBLE
+FUNCTION_NAME = gtk_progress_bar_pulse, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_progress_bar_set_pulse_step, NONE, NONE, 2, WIDGET, DOUBLE
+#
+# GTK_STATUS_BAR
+#
+FUNCTION_NAME = gtk_statusbar_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_statusbar_get_context_id, NONE, LONG, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_statusbar_push, NONE, LONG, 3, WIDGET, LONG, STRING
+FUNCTION_NAME = gtk_statusbar_pop, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_statusbar_remove, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_statusbar_set_has_resize_grip, NONE, NONE, 2, WIDGET, BOOL
+#
+# EVENT_BOX
+#
+FUNCTION_NAME = gtk_event_box_new, NONE, WIDGET, 0
+#
+# COMBO BOX - only with GTK 2.4.x or higher
+#
+FUNCTION_NAME = gtk_combo_box_new_text, changed, WIDGET, 0
+FUNCTION_NAME = gtk_combo_box_append_text, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_combo_box_insert_text, NONE, NONE, 3, WIDGET, LONG, STRING
+FUNCTION_NAME = gtk_combo_box_prepend_text, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_combo_box_remove_text, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_combo_box_get_active, NONE, LONG, 1, WIDGET
+FUNCTION_NAME = gtk_combo_box_set_active, NONE, NONE, 2, WIDGET, LONG
+FUNCTION_NAME = gtk_combo_box_get_active_text, NONE, STRING, 1, WIDGET
+#
+# SEPARATORS
+#
+FUNCTION_NAME = gtk_vseparator_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_hseparator_new, NONE, WIDGET, 0
+#
+# Clipboards
+#
+FUNCTION_NAME = gtk_editable_copy_clipboard, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_editable_cut_clipboard, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_editable_paste_clipboard, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gdk_atom_intern, NONE, WIDGET, 2, STRING, LONG
+FUNCTION_NAME = gtk_clipboard_get, NONE, WIDGET, 1, LONG
+FUNCTION_NAME = gtk_clipboard_set_text, NONE, NONE, 3, WIDGET, STRING, LONG
+FUNCTION_NAME = gtk_clipboard_wait_for_text, NONE, STRING, 1, WIDGET
+#
+# CLists (GTK 1.x, obsolete in GTK2)
+#
+FUNCTION_NAME = gtk_clist_new, select-row, WIDGET, 1, LONG
+FUNCTION_NAME = gtk_clist_set_column_title, NONE, NONE, 3, WIDGET, LONG, STRING
+FUNCTION_NAME = gtk_clist_column_titles_show, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_clist_append, NONE, LONG, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_clist_set_text, NONE, NONE, 4, WIDGET, LONG, LONG, STRING
+#
+# GTK fixed
+#
+FUNCTION_NAME = gtk_fixed_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_fixed_put, NONE, NONE, 4, WIDGET, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_fixed_move, NONE, NONE, 4, WIDGET, WIDGET, LONG, LONG
+#
+# Lists (GTK2.x) defined for 1 column with strings
+# Redefine with 'gtk_server_redefine' if necessary
+#
+FUNCTION_NAME = gtk_list_store_new, NONE, WIDGET, 2, LONG, LONG
+FUNCTION_NAME = gtk_list_store_append, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_list_store_set, NONE, NONE, 5, WIDGET, WIDGET, LONG, STRING, LONG
+FUNCTION_NAME = gtk_list_store_set_value, NONE, NONE, 4, WIDGET, WIDGET, LONG, STRING
+FUNCTION_NAME = gtk_list_store_clear, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_list_store_remove, NONE, BOOL, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_cell_renderer_text_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_tree_view_new_with_model, row-activated, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_tree_view_column_new, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_tree_view_column_new_with_attributes, clicked, WIDGET, 5, STRING, WIDGET, STRING, LONG, NULL
+FUNCTION_NAME = gtk_tree_view_column_pack_start, NONE, NONE, 3, WIDGET, WIDGET, BOOL
+FUNCTION_NAME = gtk_tree_view_append_column, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_tree_view_set_headers_visible, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_tree_view_set_headers_clickable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_tree_view_get_selection, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_tree_view_column_set_resizable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_tree_view_column_set_clickable, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_tree_selection_get_selected, NONE, BOOL, 3, WIDGET, NULL, WIDGET
+FUNCTION_NAME = gtk_tree_selection_select_iter, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_tree_selection_select_path, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_tree_model_get, NONE, NONE, 5, WIDGET, WIDGET, LONG, STRING, LONG
+FUNCTION_NAME = gtk_tree_model_get_string_from_iter, NONE, STRING, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_tree_path_new_from_string, NONE, WIDGET, 1, STRING
+FUNCTION_NAME = gtk_tree_path_free, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_tree_sortable_set_sort_column_id, NONE, NONE, 3, WIDGET, LONG, LONG
+#
+# General GTK routines
+#
+FUNCTION_NAME = gtk_init, NONE, NONE, 2, NULL, NULL
+FUNCTION_NAME = gtk_widget_show, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_show_all, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_realize, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_unrealize, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_hide, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_destroy, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_grab_focus, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_widget_set_size_request, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_widget_size_request, NONE, NONE, 2, WIDGET, WIDGET
+FUNCTION_NAME = gtk_widget_set_usize, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_widget_modify_base, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_widget_modify_bg, NONE, NONE, 3, WIDGET, LONG, LONG
+FUNCTION_NAME = gtk_widget_set_sensitive, NONE, NONE, 2, WIDGET, BOOL
+FUNCTION_NAME = gtk_settings_get_default, NONE, WIDGET, 0
+FUNCTION_NAME = gtk_widget_get_parent, NONE, WIDGET, 1, WIDGET
+FUNCTION_NAME = gtk_misc_set_alignment, NONE, NONE, 3, WIDGET, FLOAT, FLOAT
+FUNCTION_NAME = gtk_main, NONE, NONE, 0
+FUNCTION_NAME = gtk_main_iteration, NONE, BOOL, 0
+FUNCTION_NAME = gtk_main_iteration_do, NONE, BOOL, 1, BOOL
+FUNCTION_NAME = gtk_events_pending, NONE, BOOL, 0
+FUNCTION_NAME = gtk_exit, NONE, NONE, 1, LONG
+FUNCTION_NAME = gtk_main_quit, NONE, NONE, 0
+FUNCTION_NAME = gtk_rc_parse, NONE, NONE, 1, STRING
+FUNCTION_NAME = gtk_rc_parse_string, NONE, NONE, 1, STRING
+FUNCTION_NAME = gtk_rc_reparse_all, NONE, BOOL, 0
+FUNCTION_NAME = gtk_rc_reset_styles, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = gtk_rc_add_default_file, NONE, NONE, 1, STRING
+FUNCTION_NAME = gtk_widget_set_name, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_check_version, NONE, STRING, 3, LONG, LONG, LONG
+FUNCTION_NAME = gtk_drag_source_set, NONE, NONE, 5, WIDGET, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gtk_drag_dest_set, NONE, NONE, 5, WIDGET, LONG, LONG, LONG, LONG
+FUNCTION_NAME = gtk_drag_finish, NONE, NONE, 4, WIDGET, BOOL, BOOL, LONG
+FUNCTION_NAME = gtk_get_current_event_time, NONE, LONG, 0
+FUNCTION_NAME = gtk_widget_get_size_request, NONE, NONE, 3, WIDGET, WIDGET, WIDGET
+FUNCTION_NAME = gtk_signal_emit_by_name, NONE, NONE, 2, WIDGET, STRING
+FUNCTION_NAME = gtk_invisible_new, NONE, WIDGET, 0
+#
+# Some GDK_PIXBUF functions
+# Put GTK_LIB_EXTRA to 'libgdk_pixbuf_xlib.so'
+#
+FUNCTION_NAME = gdk_pixbuf_new_from_file, NONE, WIDGET, 2, STRING, NULL
+FUNCTION_NAME = gdk_pixbuf_new_from_file_at_size, NONE, WIDGET, 4, STRING, LONG, LONG, NULL
+FUNCTION_NAME = gdk_pixbuf_rotate_simple, NONE, WIDGET, 2, WIDGET, LONG
+FUNCTION_NAME = g_object_unref, NONE, NONE, 1, WIDGET
+FUNCTION_NAME = g_locale_to_utf8, NONE, STRING, 5, STRING, LONG, NULL, NULL, NULL
+FUNCTION_NAME = g_locale_from_utf8, NONE, STRING, 5, STRING, LONG, NULL, NULL, NULL
+FUNCTION_NAME = g_free, NONE, NONE, 1, WIDGET
+#[sds]FUNCTION_NAME = g_printf, NONE, NONE, 2, STRING, WIDGET
+#
+# The internal functions (not necessary but sometimes handy for language bindings like newLisp) --- sds commented out
+#
+# FUNCTION_NAME = gtk_server_version, NONE, STRING, 0
+# FUNCTION_NAME = gtk_server_callback, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_callback_value, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_connect, NONE, STRING, 3, STRING, STRING, STRING
+# FUNCTION_NAME = gtk_server_connect_after, NONE, STRING, 3, STRING, STRING, STRING
+# FUNCTION_NAME = gtk_server_disconnect, NONE, STRING, 0
+# FUNCTION_NAME = gtk_server_enable_c_string_escaping, NONE, STRING, 0
+# FUNCTION_NAME = gtk_server_disable_c_string_escaping, NONE, STRING, 0
+# FUNCTION_NAME = gtk_server_mouse, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_redefine, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_timeout, NONE, STRING, 3, STRING, STRING, STRING
+# FUNCTION_NAME = gtk_server_echo, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_glade_file, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_glade_string, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_glade_widget, NONE, STRING, 1, STRING
+# FUNCTION_NAME = gtk_server_cfg, NONE, STRING, 1, STRING
+#
+#---------------------------------------------------------------------------
+#
+# XForms calls --- sds commented out
+#
+# FUNCTION_NAME = fl_bgn_form, NONE, WIDGET, 3, LONG, LONG, LONG
+# FUNCTION_NAME = fl_end_form, NONE, NONE, 0
+# #
+# FUNCTION_NAME = fl_add_box, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# #
+# FUNCTION_NAME = fl_add_button, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# FUNCTION_NAME = fl_set_button, NONE, NONE, 2, WIDGET, LONG
+# FUNCTION_NAME = fl_get_button, NONE, LONG, 1, WIDGET
+# #
+# FUNCTION_NAME = fl_add_slider, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# FUNCTION_NAME = fl_set_slider_value, NONE, NONE, 2, WIDGET, DOUBLE
+# FUNCTION_NAME = fl_set_slider_bounds, NONE, NONE, 3, WIDGET, DOUBLE, DOUBLE
+# FUNCTION_NAME = fl_get_slider_value, NONE, FLOAT, 1, WIDGET
+# FUNCTION_NAME = fl_add_valslider, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# #
+# FUNCTION_NAME = fl_add_text, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# #
+# FUNCTION_NAME = fl_add_input, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# FUNCTION_NAME = fl_set_input, NONE, NONE, 2, WIDGET, STRING
+# FUNCTION_NAME = fl_set_input_color, NONE, NONE, 3, WIDGET, LONG, LONG
+# FUNCTION_NAME = fl_get_input, NONE, STRING, 1, WIDGET
+# #
+# FUNCTION_NAME = fl_add_frame, NONE, WIDGET, 6, LONG, LONG, LONG, LONG, LONG, STRING
+# #
+# FUNCTION_NAME = fl_show_form, NONE, NONE, 4, WIDGET, LONG, LONG, STRING
+# FUNCTION_NAME = fl_hide_object, NONE, NONE, 1, WIDGET
+# FUNCTION_NAME = fl_show_object, NONE, NONE, 1, WIDGET
+# FUNCTION_NAME = fl_deactivate_object, NONE, NONE, 1, WIDGET
+# FUNCTION_NAME = fl_activate_object, NONE, NONE, 1, WIDGET
+# FUNCTION_NAME = fl_set_object_color, NONE, NONE, 3, WIDGET, LONG, LONG
+# FUNCTION_NAME = fl_set_icm_color, NONE, NONE, 4, LONG, LONG, LONG, LONG
+# FUNCTION_NAME = fl_set_focus_object, NONE, NONE, 2, WIDGET, WIDGET
+# FUNCTION_NAME = fl_get_focus_object, NONE, WIDGET, 1, WIDGET
+# FUNCTION_NAME = fl_bgn_group, NONE, WIDGET, 0
+# FUNCTION_NAME = fl_end_group, NONE, WIDGET, 0
+# FUNCTION_NAME = fl_addto_group, NONE, NONE, 1, WIDGET
diff --git a/src/mod/gtk-server.l b/src/mod/gtk-server.l
@@ -0,0 +1,38 @@
+# line: fname, callback signal type, retval, nargs, arg1, arg2...
+
+(de fixType (Type)
+ (case Type
+ (NONE 'void)
+ (LONG 'long)
+ (BOOL 'bool)
+ (STRING 'cstr)
+ (FLOAT 'float)
+ (DOUBLE 'double)
+ (NULL 'null)
+ (WIDGET 'GtkWidget*)
+ (T Type)))
+
+(out "gtk.ffi"
+ (prinl "# -*- picolisp -*-")
+ (prinl)
+ (prinl "(load \"@src/mod/ffi.l\")")
+ (prinl)
+ (prinl "(module gtk)")
+ (prinl)
+ (prinl "(include \"gtk/gtk.h\")")
+ (prinl)
+ (prinl "(put 'cwrap 'GtkWidget* (get 'cwrap 'void*))")
+ (prinl)
+ (prinl "(put 'cbody 'GtkWidget* (get 'cbody 'void*))")
+ (prinl)
+ (in "gtk-server.cfg"
+ (until (eof)
+ (let Line (line)
+ (unless (= "#" (car Line))
+ (when (match
+ '("FUNCTION_NAME" "=" @Fn @Cb @Rv @Na . @Args)
+ (mapcar pack (split (filter '((X) (<> X ",")) Line) " ")))
+ (println (append (list 'cfun
+ (fixType (intern (car @Rv)))
+ (intern (car @Fn)))
+ (mapcar fixType @Args)))))))))
diff --git a/src/mod/gtk.ffi b/src/mod/gtk.ffi
@@ -0,0 +1,366 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'gtk)
+#(module 'gtk '((X) (pack "gtk:" (cddddr (chop X)))))
+
+(include "gtk/gtk.h" "glade/glade.h")
+
+(cfun void* gtk_window_new long)
+(cfun void gtk_window_set_title void* cstr)
+(cfun cstr gtk_window_get_title void*)
+(cfun void gtk_window_set_default_size void* long long)
+(cfun void gtk_window_set_position void* long)
+(cfun void gtk_window_set_resizable void* bool)
+(cfun void gtk_window_set_transient_for void* void*)
+(cfun void gtk_window_maximize void*)
+(cfun void* gtk_message_dialog_new void* long long long cstr)
+(cfun bool gtk_window_set_icon_from_file void* cstr null)
+(cfun void gtk_window_set_keep_above void* bool)
+(cfun void gtk_window_set_keep_below void* bool)
+(cfun void gtk_about_dialog_set_version void* cstr)
+(cfun void* gtk_table_new long long bool)
+(cfun void gtk_table_attach_defaults void* void* long long long long)
+(cfun void gtk_container_add void* void*)
+(cfun void gtk_container_remove void* void*)
+(cfun void gtk_container_set_border_width void* long)
+(cfun void* gtk_hbox_new bool long)
+(cfun void* gtk_vbox_new bool long)
+(cfun void gtk_box_pack_start void* void* bool bool long)
+(cfun void gtk_box_pack_end void* void* bool bool long)
+(cfun void gtk_box_pack_start_defaults void* void*)
+(cfun void gtk_box_pack_end_defaults void* void*)
+(cfun void* gtk_button_new)
+(cfun void* gtk_button_new_with_label cstr)
+(cfun void* gtk_button_new_from_stock cstr)
+(cfun void* gtk_button_new_with_mnemonic cstr)
+(cfun void gtk_button_set_use_stock void* bool)
+(cfun void gtk_button_set_label void* cstr)
+(cfun void gtk_button_set_relief void* long)
+(cfun void* gtk_toggle_button_new)
+(cfun void* gtk_toggle_button_new_with_label cstr)
+(cfun bool gtk_toggle_button_get_active void*)
+(cfun void gtk_toggle_button_set_active void* bool)
+(cfun void* gtk_check_button_new_with_label cstr)
+(cfun void* gtk_entry_new)
+(cfun cstr gtk_entry_get_text void*)
+(cfun void gtk_entry_set_text void* cstr)
+(cfun void gtk_entry_set_visibility void* bool)
+(cfun void gtk_editable_delete_text void* long long)
+(cfun cstr gtk_editable_get_chars void* long long)
+(cfun void gtk_editable_set_editable void* bool)
+(cfun void gtk_editable_select_region void* long long)
+(cfun void* gtk_text_buffer_new null)
+(cfun void gtk_text_buffer_set_text void* cstr long)
+(cfun void gtk_text_buffer_insert_at_cursor void* cstr long)
+(cfun void* gtk_text_buffer_get_insert void*)
+(cfun void gtk_text_buffer_get_start_iter void* void*)
+(cfun void gtk_text_buffer_get_end_iter void* void*)
+(cfun void gtk_text_buffer_get_bounds void* void* void*)
+(cfun bool gtk_text_buffer_get_selection_bounds void* void* void*)
+(cfun void gtk_text_buffer_get_iter_at_offset void* void* long)
+(cfun cstr gtk_text_buffer_get_text void* void* void* bool)
+(cfun void gtk_text_buffer_insert void* void* cstr long)
+(cfun void* gtk_text_buffer_create_tag void* cstr cstr long null)
+(cfun void gtk_text_buffer_insert_with_tags_by_name void* void* cstr long cstr cstr cstr null)
+(cfun void gtk_text_buffer_apply_tag_by_name void* cstr void* void*)
+(cfun void gtk_text_buffer_remove_tag_by_name void* cstr void* void*)
+(cfun void gtk_text_buffer_remove_all_tags void* void* void*)
+(cfun void* gtk_text_buffer_get_tag_table void*)
+(cfun void gtk_text_buffer_select_range void* void* void*)
+(cfun void* gtk_text_buffer_get_selection_bound void*)
+(cfun long gtk_text_buffer_get_line_count void*)
+(cfun void* gtk_text_buffer_create_mark void* cstr void* bool)
+(cfun void gtk_text_buffer_get_iter_at_mark void* void* void*)
+(cfun void gtk_text_buffer_get_iter_at_line void* void* long)
+(cfun void gtk_text_buffer_delete void* void* void*)
+(cfun void gtk_text_buffer_delete_mark void* void*)
+(cfun void gtk_text_buffer_delete_mark_by_name void* cstr)
+(cfun void gtk_text_buffer_place_cursor void* void*)
+(cfun void gtk_text_buffer_copy_clipboard void* void*)
+(cfun void gtk_text_buffer_cut_clipboard void* void* bool)
+(cfun void gtk_text_buffer_paste_clipboard void* void* null bool)
+(cfun void* gtk_scrolled_window_new null null)
+(cfun void gtk_scrolled_window_set_policy void* long long)
+(cfun void gtk_scrolled_window_set_shadow_type void* long)
+(cfun void gtk_scrolled_window_add_with_viewport void* void*)
+(cfun void* gtk_text_view_new_with_buffer void*)
+(cfun void gtk_text_view_set_wrap_mode void* long)
+(cfun void gtk_text_view_set_editable void* bool)
+(cfun void gtk_text_view_set_border_window_size void* long long)
+(cfun bool gtk_text_view_move_mark_onscreen void* void*)
+(cfun void gtk_text_view_scroll_to_mark void* void* double bool double double)
+(cfun void gtk_text_view_scroll_mark_onscreen void* void*)
+(cfun void gtk_text_view_set_pixels_inside_wrap void* long)
+(cfun long gtk_text_view_get_pixels_inside_wrap void*)
+(cfun void gtk_text_view_set_pixels_above_lines void* long)
+(cfun long gtk_text_view_get_pixels_above_lines void*)
+(cfun void gtk_text_view_set_cursor_visible void* bool)
+(cfun void gtk_text_view_window_to_buffer_coords void* long long long void* void*)
+(cfun bool gtk_text_iter_forward_search void* cstr long void* void* null)
+(cfun bool gtk_text_iter_forward_visible_cursor_position void*)
+(cfun bool gtk_text_iter_forward_to_line_end void*)
+(cfun void gtk_text_iter_set_line void* long)
+(cfun void gtk_text_iter_set_line_offset void* long)
+(cfun void gtk_text_iter_set_line_index void* long)
+(cfun cstr gtk_text_iter_get_text void* void*)
+(cfun long gtk_text_iter_get_line void*)
+(cfun void* gtk_text_view_new)
+(cfun void* gtk_text_view_get_buffer void*)
+(cfun void gtk_text_tag_table_remove void* void*)
+(cfun void* gdk_font_load cstr)
+(cfun void* gdk_pixmap_new void* long long long)
+(cfun void gdk_pixmap_unref void*)
+(cfun void* gdk_pixmap_create_from_xpm void* null null cstr)
+(cfun void* gdk_pixmap_colormap_create_from_xpm null void* null null cstr)
+(cfun void gdk_draw_rectangle void* void* bool long long long long)
+(cfun void gdk_draw_arc void* void* bool long long long long long long)
+(cfun void gdk_draw_line void* void* long long long long)
+(cfun void gdk_draw_point void* void* long long)
+(cfun void gdk_draw_layout void* void* long long void*)
+(cfun void gdk_draw_drawable void* void* void* long long long long long long)
+(cfun void* gdk_gc_new void*)
+(cfun void gdk_gc_set_rgb_fg_color void* void*)
+(cfun void gdk_gc_set_rgb_bg_color void* void*)
+(cfun void gdk_gc_set_foreground void* void*)
+(cfun void gdk_gc_set_background void* void*)
+(cfun void gdk_gc_set_colormap void* void*)
+(cfun long gdk_color_alloc void* void*)
+(cfun long gdk_color_parse cstr void*)
+(cfun void* gdk_colormap_get_system)
+(cfun bool gdk_colormap_alloc_color void* void* bool bool)
+(cfun void* gdk_get_default_root_window)
+(cfun void gdk_rgb_find_color void* void*)
+(cfun void gdk_drawable_set_colormap void* void*)
+(cfun void gdk_drawable_get_size void* void* void*)
+(cfun bool gdk_keymap_translate_keyboard_state null long long long void* null null null)
+(cfun void gdk_window_process_all_updates)
+(cfun void gdk_window_get_geometry void* null null void* cstr null)
+(cfun void* gdk_screen_get_default)
+(cfun long gdk_screen_get_width void*)
+(cfun long gdk_screen_get_height void*)
+(cfun long gdk_screen_width)
+(cfun long gdk_screen_height)
+(cfun void gdk_flush)
+(cfun void gdk_init null null)
+(cfun void* gdk_display_get_default)
+(cfun void gdk_display_get_pointer void* null void* void* null)
+(cfun void* gtk_image_new)
+(cfun void* gtk_image_new_from_pixmap void* void*)
+(cfun void gtk_image_set_from_pixbuf void* void*)
+(cfun void gtk_image_set_from_pixmap void* void* null)
+(cfun void gtk_image_set void* void* null)
+(cfun void gtk_image_set_from_file void* cstr)
+(cfun void* gtk_image_new_from_file cstr)
+(cfun void* gtk_pixmap_new void* null)
+(cfun void* gtk_drawing_area_new)
+(cfun void gtk_widget_queue_draw void*)
+(cfun void* gtk_widget_get_colormap void*)
+(cfun void* gtk_widget_get_parent_window void*)
+(cfun void* gtk_widget_create_pango_layout void* cstr)
+(cfun void* gtk_vscrollbar_new void*)
+(cfun void* gtk_label_new cstr)
+(cfun void gtk_label_set_text void* cstr)
+(cfun cstr gtk_label_get_text void*)
+(cfun void gtk_label_set_line_wrap void* bool)
+(cfun void gtk_label_set_selectable void* bool)
+(cfun void gtk_label_set_use_markup void* bool)
+(cfun void gtk_label_set_justify void* long)
+(cfun long gtk_label_get_width_chars void*)
+(cfun long gtk_label_get_max_width_chars void*)
+(cfun void gtk_label_set_markup_with_mnemonic void* cstr)
+(cfun void* gtk_frame_new null)
+(cfun void gtk_frame_set_label_align void* float float)
+(cfun void gtk_frame_set_label void* cstr)
+(cfun cstr gtk_frame_get_label void*)
+(cfun void* gtk_aspect_frame_new cstr float float float bool)
+(cfun void gtk_aspect_frame_set void* float float float bool)
+(cfun void* gtk_radio_button_new null)
+(cfun void* gtk_radio_button_new_with_label void* cstr)
+(cfun void* gtk_radio_button_new_from_widget void*)
+(cfun void* gtk_radio_button_new_with_label_from_widget void* cstr)
+(cfun void* gtk_notebook_new)
+(cfun void gtk_notebook_set_tab_pos void* long)
+(cfun void gtk_notebook_popup_enable void*)
+(cfun void gtk_notebook_insert_page void* void* void* long)
+(cfun void gtk_notebook_remove_page void* long)
+(cfun void gtk_notebook_get_current_page void*)
+(cfun void gtk_notebook_set_page void* long)
+(cfun void gtk_notebook_set_tab_label_text void* void* cstr)
+(cfun void* gtk_adjustment_new double double double double double double)
+(cfun float gtk_adjustment_get_value void*)
+(cfun void* gtk_range_get_adjustment void*)
+(cfun float gtk_range_get_value void*)
+(cfun void gtk_range_set_value void* double)
+(cfun void gtk_scale_set_draw_value void* bool)
+(cfun void gtk_scale_set_value_pos void* long)
+(cfun void* gtk_hscale_new void*)
+(cfun void* gtk_hscale_new_with_range double double double)
+(cfun void* gtk_vscale_new_with_range double double double)
+(cfun void* gtk_spin_button_new void* double long)
+(cfun long gtk_spin_button_get_value_as_int void*)
+(cfun float gtk_spin_button_get_value void*)
+(cfun void gtk_spin_button_set_wrap void* bool)
+(cfun void gtk_spin_button_set_value void* double)
+(cfun void* gtk_arrow_new long long)
+(cfun void* gtk_file_chooser_dialog_new cstr void* long cstr long cstr long null)
+(cfun void* gtk_file_chooser_widget_new long)
+(cfun long gtk_dialog_run void*)
+(cfun cstr gtk_file_chooser_get_filename void*)
+(cfun bool gtk_file_chooser_set_filename void* cstr)
+(cfun void* gtk_file_filter_new)
+(cfun void gtk_file_filter_add_pattern void* cstr)
+(cfun void gtk_file_filter_set_name void* cstr)
+(cfun void gtk_file_chooser_add_filter void* void*)
+(cfun void* gtk_font_selection_dialog_new cstr)
+(cfun cstr gtk_font_selection_dialog_get_font_name void*)
+(cfun void* gtk_font_selection_new)
+(cfun cstr gtk_font_selection_get_font_name void*)
+(cfun bool gtk_font_selection_set_font_name void* cstr)
+(cfun void* gtk_color_selection_new)
+(cfun void gtk_color_selection_set_has_opacity_control void* bool)
+(cfun void gtk_color_selection_set_current_color void* cstr)
+(cfun void gtk_color_selection_get_current_color void* void*)
+(cfun void gtk_color_selection_set_color void* cstr)
+(cfun void* gtk_menu_bar_new)
+(cfun void gtk_menu_shell_append void* void*)
+(cfun void* gtk_menu_item_new)
+(cfun void* gtk_menu_item_new_with_label cstr)
+(cfun void* gtk_menu_item_new_with_mnemonic cstr)
+(cfun void* gtk_menu_new)
+(cfun void gtk_menu_item_set_right_justified void* bool)
+(cfun void gtk_menu_item_set_submenu void* void*)
+(cfun void* gtk_check_menu_item_new_with_label cstr)
+(cfun void* gtk_check_menu_item_new_with_mnemonic cstr)
+(cfun bool gtk_check_menu_item_get_active void*)
+(cfun void gtk_check_menu_item_set_active void* bool)
+(cfun void gtk_menu_popup void* null null null null long long)
+(cfun void* gtk_progress_bar_new)
+(cfun void gtk_progress_bar_set_text void* cstr)
+(cfun void gtk_progress_bar_set_fraction void* double)
+(cfun void gtk_progress_bar_pulse void*)
+(cfun void gtk_progress_bar_set_pulse_step void* double)
+(cfun void* gtk_statusbar_new)
+(cfun long gtk_statusbar_get_context_id void* cstr)
+(cfun long gtk_statusbar_push void* long cstr)
+(cfun void gtk_statusbar_pop void* long)
+(cfun void gtk_statusbar_remove void* long long)
+(cfun void gtk_statusbar_set_has_resize_grip void* bool)
+(cfun void* gtk_event_box_new)
+(cfun void* gtk_combo_box_new_text)
+(cfun void gtk_combo_box_append_text void* cstr)
+(cfun void gtk_combo_box_insert_text void* long cstr)
+(cfun void gtk_combo_box_prepend_text void* cstr)
+(cfun void gtk_combo_box_remove_text void* long)
+(cfun long gtk_combo_box_get_active void*)
+(cfun void gtk_combo_box_set_active void* long)
+(cfun cstr gtk_combo_box_get_active_text void*)
+(cfun void* gtk_vseparator_new)
+(cfun void* gtk_hseparator_new)
+(cfun void gtk_editable_copy_clipboard void*)
+(cfun void gtk_editable_cut_clipboard void*)
+(cfun void gtk_editable_paste_clipboard void*)
+(cfun void* gdk_atom_intern cstr long)
+(cfun void* gtk_clipboard_get long)
+(cfun void gtk_clipboard_set_text void* cstr long)
+(cfun cstr gtk_clipboard_wait_for_text void*)
+(cfun void* gtk_clist_new long)
+(cfun void gtk_clist_set_column_title void* long cstr)
+(cfun void gtk_clist_column_titles_show void*)
+(cfun long gtk_clist_append void* void*)
+(cfun void gtk_clist_set_text void* long long cstr)
+(cfun void* gtk_fixed_new)
+(cfun void gtk_fixed_put void* void* long long)
+(cfun void gtk_fixed_move void* void* long long)
+(cfun void* gtk_list_store_new long long)
+(cfun void gtk_list_store_append void* void*)
+(cfun void gtk_list_store_set void* void* long cstr long)
+(cfun void gtk_list_store_set_value void* void* long cstr)
+(cfun void gtk_list_store_clear void*)
+(cfun bool gtk_list_store_remove void* void*)
+(cfun void* gtk_cell_renderer_text_new)
+(cfun void* gtk_tree_view_new_with_model void*)
+(cfun void* gtk_tree_view_column_new)
+(cfun void* gtk_tree_view_column_new_with_attributes cstr void* cstr long null)
+(cfun void gtk_tree_view_column_pack_start void* void* bool)
+(cfun void gtk_tree_view_append_column void* void*)
+(cfun void gtk_tree_view_set_headers_visible void* bool)
+(cfun void gtk_tree_view_set_headers_clickable void* bool)
+(cfun void* gtk_tree_view_get_selection void*)
+(cfun void gtk_tree_view_column_set_resizable void* bool)
+(cfun void gtk_tree_view_column_set_clickable void* bool)
+(cfun bool gtk_tree_selection_get_selected void* null void*)
+(cfun void gtk_tree_selection_select_iter void* void*)
+(cfun void gtk_tree_selection_select_path void* void*)
+(cfun void gtk_tree_model_get void* void* long cstr long)
+(cfun cstr gtk_tree_model_get_string_from_iter void* void*)
+(cfun void* gtk_tree_path_new_from_string cstr)
+(cfun void gtk_tree_path_free void*)
+(cfun void gtk_tree_sortable_set_sort_column_id void* long long)
+(cfun void gtk_init null null)
+(cfun void gtk_widget_show void*)
+(cfun void gtk_widget_show_all void*)
+(cfun void gtk_widget_realize void*)
+(cfun void gtk_widget_unrealize void*)
+(cfun void gtk_widget_hide void*)
+(cfun void gtk_widget_destroy void*)
+(cfun void gtk_widget_grab_focus void*)
+(cfun void gtk_widget_set_size_request void* long long)
+(cfun void gtk_widget_size_request void* void*)
+(cfun void gtk_widget_set_usize void* long long)
+(cfun void gtk_widget_modify_base void* long long)
+(cfun void gtk_widget_modify_bg void* long long)
+(cfun void gtk_widget_set_sensitive void* bool)
+(cfun void* gtk_settings_get_default)
+(cfun void* gtk_widget_get_parent void*)
+(cfun void gtk_misc_set_alignment void* float float)
+(cfun void gtk_main)
+(cfun bool gtk_main_iteration)
+(cfun bool gtk_main_iteration_do bool)
+(cfun bool gtk_events_pending)
+(cfun void gtk_exit long)
+(cfun void gtk_main_quit)
+(cfun void gtk_rc_parse cstr)
+(cfun void gtk_rc_parse_string cstr)
+(cfun bool gtk_rc_reparse_all)
+(cfun void gtk_rc_reset_styles void*)
+(cfun void gtk_rc_add_default_file cstr)
+(cfun void gtk_widget_set_name void* cstr)
+(cfun cstr gtk_check_version long long long)
+(cfun void gtk_drag_source_set void* long long long long)
+(cfun void gtk_drag_dest_set void* long long long long)
+(cfun void gtk_drag_finish void* bool bool long)
+(cfun long gtk_get_current_event_time)
+(cfun void gtk_widget_get_size_request void* void* void*)
+(cfun void gtk_signal_emit_by_name void* cstr)
+(cfun void* gtk_invisible_new)
+(cfun void* gdk_pixbuf_new_from_file cstr null)
+(cfun void* gdk_pixbuf_new_from_file_at_size cstr long long null)
+(cfun void* gdk_pixbuf_rotate_simple void* long)
+(cfun void g_object_unref void*)
+(cfun cstr g_locale_to_utf8 cstr long null null null)
+(cfun cstr g_locale_from_utf8 cstr long null null null)
+(cfun void g_free void*)
+
+(cfun void glade_init)
+(cfun void* glade_xml_new (cstr filename) null null)
+#(cfun void glade_xml_signal_autoconnect (void* xml))
+(cfun void* glade_xml_get_widget (void* xml) (cstr name))
+#(cfun void glade_xml_signal_connect (void* xml) (cstr name) (lfun handler))
+#(cfun void glade_xml_signal_connect_data (void* xml) (cstr name) (lfun handler) (void* data))
+#(cfun void glade_xml_signal_connect_full (void* xml) (cstr name) (lfun handler) (void* data))
+(lfun void handler (cstr handlerName) (void* object) (cstr signalName) (cstr signalData) (void* connectObject) (bool after) (void* userData))
+(cfun void glade_xml_signal_autoconnect_full (void* xml) (lfun handler) (void* data))
+
+(cfun cstr glade_get_widget_name (void* widget))
+(cfun void* glade_get_widget_tree (void* widget))
+
+(lfun void signal)
+#(lfun void callbackMarshal (void* object) (void* data) (uint nargs) (void* args))
+(lfun void destroyNotify)
+#(cfun ulong gtk_signal_connect_full (void* object) (cstr name) (lfun signal) (lfun callbackMarshal) (void* data) (lfun destroyNotify) (int objectSignal) (int after))
+(cfun ulong gtk_signal_connect_full (void* object) (cstr name) (lfun signal) null (void* data) (lfun destroyNotify) (int objectSignal) (int after))
+
+(lfun void signal2 (void* data))
+(cfun void g_signal_connect (void* object) (cstr name) (lfun signal2) (void* data))
diff --git a/src/mod/gtk.ffi.c b/src/mod/gtk.ffi.c
@@ -0,0 +1,4939 @@
+/* Generated from gtk.ffi */
+
+#include "../pico.h"
+
+#include "gtk/gtk.h"
+#include "glade/glade.h"
+
+any cfun_gtk_window_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ void* z = gtk_window_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_window_set_title(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_window_set_title(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_window_get_title(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_window_get_title(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_window_set_default_size(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_window_set_default_size(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_window_set_position(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_window_set_position(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_window_set_resizable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_window_set_resizable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_window_set_transient_for(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_window_set_transient_for(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_window_maximize(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_window_maximize(b1);
+ return Nil;
+}
+
+any cfun_gtk_message_dialog_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y5s = xSym(y);
+ char b5[bufSize(y5s)];
+ bufString(y5s, b5);
+ void* z = gtk_message_dialog_new(b1, b2, b3, b4, b5);
+ return box(z);
+}
+
+any cfun_gtk_window_set_icon_from_file(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ int z = gtk_window_set_icon_from_file(b1, b2, b3);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_window_set_keep_above(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_window_set_keep_above(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_window_set_keep_below(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_window_set_keep_below(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_about_dialog_set_version(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_about_dialog_set_version(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_table_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ void* z = gtk_table_new(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_gtk_table_attach_defaults(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ gtk_table_attach_defaults(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_gtk_container_add(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_container_add(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_container_remove(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_container_remove(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_container_set_border_width(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_container_set_border_width(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_hbox_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b1 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gtk_hbox_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_vbox_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b1 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gtk_vbox_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_box_pack_start(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_box_pack_start(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_box_pack_end(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_box_pack_end(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_box_pack_start_defaults(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_box_pack_start_defaults(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_box_pack_end_defaults(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_box_pack_end_defaults(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_button_new(any ex __attribute__((unused))) {
+ void* z = gtk_button_new();
+ return box(z);
+}
+
+any cfun_gtk_button_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_button_new_with_label(b1);
+ return box(z);
+}
+
+any cfun_gtk_button_new_from_stock(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_button_new_from_stock(b1);
+ return box(z);
+}
+
+any cfun_gtk_button_new_with_mnemonic(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_button_new_with_mnemonic(b1);
+ return box(z);
+}
+
+any cfun_gtk_button_set_use_stock(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_button_set_use_stock(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_button_set_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_button_set_label(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_button_set_relief(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_button_set_relief(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_toggle_button_new(any ex __attribute__((unused))) {
+ void* z = gtk_toggle_button_new();
+ return box(z);
+}
+
+any cfun_gtk_toggle_button_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_toggle_button_new_with_label(b1);
+ return box(z);
+}
+
+any cfun_gtk_toggle_button_get_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ int z = gtk_toggle_button_get_active(b1);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_toggle_button_set_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_toggle_button_set_active(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_check_button_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_check_button_new_with_label(b1);
+ return box(z);
+}
+
+any cfun_gtk_entry_new(any ex __attribute__((unused))) {
+ void* z = gtk_entry_new();
+ return box(z);
+}
+
+any cfun_gtk_entry_get_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_entry_get_text(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_entry_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_entry_set_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_entry_set_visibility(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_entry_set_visibility(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_editable_delete_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_editable_delete_text(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_editable_get_chars(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ char* z = gtk_editable_get_chars(b1, b2, b3);
+ return mkStr(z);
+}
+
+any cfun_gtk_editable_set_editable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_editable_set_editable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_editable_select_region(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_editable_select_region(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ void* z = gtk_text_buffer_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_text_buffer_set_text(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_insert_at_cursor(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_text_buffer_insert_at_cursor(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_insert(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_text_buffer_get_insert(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_get_start_iter(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_buffer_get_start_iter(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_end_iter(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_buffer_get_end_iter(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_bounds(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_text_buffer_get_bounds(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_selection_bounds(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ int z = gtk_text_buffer_get_selection_bounds(b1, b2, b3);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_text_buffer_get_iter_at_offset(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_text_buffer_get_iter_at_offset(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ char* z = gtk_text_buffer_get_text(b1, b2, b3, b4);
+ return mkStr(z);
+}
+
+any cfun_gtk_text_buffer_insert(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gtk_text_buffer_insert(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_create_tag(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ void* z = gtk_text_buffer_create_tag(b1, b2, b3, b4, b5);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_insert_with_tags_by_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y5s = xSym(y);
+ char b5[bufSize(y5s)];
+ bufString(y5s, b5);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y6s = xSym(y);
+ char b6[bufSize(y6s)];
+ bufString(y6s, b6);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y7s = xSym(y);
+ char b7[bufSize(y7s)];
+ bufString(y7s, b7);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b8 = (void*) 0;
+ gtk_text_buffer_insert_with_tags_by_name(b1, b2, b3, b4, b5, b6, b7, b8);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_apply_tag_by_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ gtk_text_buffer_apply_tag_by_name(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_remove_tag_by_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ gtk_text_buffer_remove_tag_by_name(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_remove_all_tags(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_text_buffer_remove_all_tags(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_tag_table(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_text_buffer_get_tag_table(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_select_range(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_text_buffer_select_range(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_selection_bound(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_text_buffer_get_selection_bound(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_get_line_count(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_text_buffer_get_line_count(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_create_mark(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ void* z = gtk_text_buffer_create_mark(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_gtk_text_buffer_get_iter_at_mark(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_text_buffer_get_iter_at_mark(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_get_iter_at_line(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_text_buffer_get_iter_at_line(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_delete(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_text_buffer_delete(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_delete_mark(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_buffer_delete_mark(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_delete_mark_by_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_text_buffer_delete_mark_by_name(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_place_cursor(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_buffer_place_cursor(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_copy_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_buffer_copy_clipboard(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_cut_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ gtk_text_buffer_cut_clipboard(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_buffer_paste_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ gtk_text_buffer_paste_clipboard(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_scrolled_window_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ void* z = gtk_scrolled_window_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_scrolled_window_set_policy(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_scrolled_window_set_policy(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_scrolled_window_set_shadow_type(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_scrolled_window_set_shadow_type(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_scrolled_window_add_with_viewport(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_scrolled_window_add_with_viewport(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_new_with_buffer(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_text_view_new_with_buffer(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_view_set_wrap_mode(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_view_set_wrap_mode(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_set_editable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_text_view_set_editable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_set_border_window_size(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_text_view_set_border_window_size(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_text_view_move_mark_onscreen(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ int z = gtk_text_view_move_mark_onscreen(b1, b2);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_text_view_scroll_to_mark(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b5 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b6 = (double) unBox(y) / 10000;
+ gtk_text_view_scroll_to_mark(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_gtk_text_view_scroll_mark_onscreen(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_view_scroll_mark_onscreen(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_set_pixels_inside_wrap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_view_set_pixels_inside_wrap(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_get_pixels_inside_wrap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_text_view_get_pixels_inside_wrap(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_view_set_pixels_above_lines(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_view_set_pixels_above_lines(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_get_pixels_above_lines(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_text_view_get_pixels_above_lines(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_view_set_cursor_visible(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_text_view_set_cursor_visible(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_view_window_to_buffer_coords(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b5 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b6 = (void*) unBox(y);
+ gtk_text_view_window_to_buffer_coords(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_gtk_text_iter_forward_search(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b5 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b6 = (void*) 0;
+ int z = gtk_text_iter_forward_search(b1, b2, b3, b4, b5, b6);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_text_iter_forward_visible_cursor_position(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ int z = gtk_text_iter_forward_visible_cursor_position(b1);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_text_iter_forward_to_line_end(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ int z = gtk_text_iter_forward_to_line_end(b1);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_text_iter_set_line(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_iter_set_line(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_iter_set_line_offset(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_iter_set_line_offset(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_iter_set_line_index(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_text_iter_set_line_index(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_text_iter_get_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ char* z = gtk_text_iter_get_text(b1, b2);
+ return mkStr(z);
+}
+
+any cfun_gtk_text_iter_get_line(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_text_iter_get_line(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_view_new(any ex __attribute__((unused))) {
+ void* z = gtk_text_view_new();
+ return box(z);
+}
+
+any cfun_gtk_text_view_get_buffer(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_text_view_get_buffer(b1);
+ return box(z);
+}
+
+any cfun_gtk_text_tag_table_remove(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_text_tag_table_remove(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_font_load(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gdk_font_load(b1);
+ return box(z);
+}
+
+any cfun_gdk_pixmap_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ void* z = gdk_pixmap_new(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_gdk_pixmap_unref(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gdk_pixmap_unref(b1);
+ return Nil;
+}
+
+any cfun_gdk_pixmap_create_from_xpm(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ void* z = gdk_pixmap_create_from_xpm(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_gdk_pixmap_colormap_create_from_xpm(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y5s = xSym(y);
+ char b5[bufSize(y5s)];
+ bufString(y5s, b5);
+ void* z = gdk_pixmap_colormap_create_from_xpm(b1, b2, b3, b4, b5);
+ return box(z);
+}
+
+any cfun_gdk_draw_rectangle(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b7 = (long) unBox(y);
+ gdk_draw_rectangle(b1, b2, b3, b4, b5, b6, b7);
+ return Nil;
+}
+
+any cfun_gdk_draw_arc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b7 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b8 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b9 = (long) unBox(y);
+ gdk_draw_arc(b1, b2, b3, b4, b5, b6, b7, b8, b9);
+ return Nil;
+}
+
+any cfun_gdk_draw_line(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ gdk_draw_line(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_gdk_draw_point(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gdk_draw_point(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gdk_draw_layout(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b5 = (void*) unBox(y);
+ gdk_draw_layout(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gdk_draw_drawable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b7 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b8 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b9 = (long) unBox(y);
+ gdk_draw_drawable(b1, b2, b3, b4, b5, b6, b7, b8, b9);
+ return Nil;
+}
+
+any cfun_gdk_gc_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gdk_gc_new(b1);
+ return box(z);
+}
+
+any cfun_gdk_gc_set_rgb_fg_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_gc_set_rgb_fg_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_gc_set_rgb_bg_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_gc_set_rgb_bg_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_gc_set_foreground(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_gc_set_foreground(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_gc_set_background(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_gc_set_background(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_gc_set_colormap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_gc_set_colormap(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_color_alloc(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ long z = gdk_color_alloc(b1, b2);
+ return box(z);
+}
+
+any cfun_gdk_color_parse(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ long z = gdk_color_parse(b1, b2);
+ return box(z);
+}
+
+any cfun_gdk_colormap_get_system(any ex __attribute__((unused))) {
+ void* z = gdk_colormap_get_system();
+ return box(z);
+}
+
+any cfun_gdk_colormap_alloc_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b4 = y == Nil ? 0 : 1;
+ int z = gdk_colormap_alloc_color(b1, b2, b3, b4);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gdk_get_default_root_window(any ex __attribute__((unused))) {
+ void* z = gdk_get_default_root_window();
+ return box(z);
+}
+
+any cfun_gdk_rgb_find_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_rgb_find_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_drawable_set_colormap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gdk_drawable_set_colormap(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_drawable_get_size(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gdk_drawable_get_size(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gdk_keymap_translate_keyboard_state(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b5 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b6 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b7 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b8 = (void*) 0;
+ int z = gdk_keymap_translate_keyboard_state(b1, b2, b3, b4, b5, b6, b7, b8);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gdk_window_process_all_updates(any ex __attribute__((unused))) {
+ gdk_window_process_all_updates();
+ return Nil;
+}
+
+any cfun_gdk_window_get_geometry(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y5s = xSym(y);
+ char b5[bufSize(y5s)];
+ bufString(y5s, b5);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b6 = (void*) 0;
+ gdk_window_get_geometry(b1, b2, b3, b4, b5, b6);
+ return Nil;
+}
+
+any cfun_gdk_screen_get_default(any ex __attribute__((unused))) {
+ void* z = gdk_screen_get_default();
+ return box(z);
+}
+
+any cfun_gdk_screen_get_width(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gdk_screen_get_width(b1);
+ return box(z);
+}
+
+any cfun_gdk_screen_get_height(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gdk_screen_get_height(b1);
+ return box(z);
+}
+
+any cfun_gdk_screen_width(any ex __attribute__((unused))) {
+ long z = gdk_screen_width();
+ return box(z);
+}
+
+any cfun_gdk_screen_height(any ex __attribute__((unused))) {
+ long z = gdk_screen_height();
+ return box(z);
+}
+
+any cfun_gdk_flush(any ex __attribute__((unused))) {
+ gdk_flush();
+ return Nil;
+}
+
+any cfun_gdk_init(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ gdk_init(b1, b2);
+ return Nil;
+}
+
+any cfun_gdk_display_get_default(any ex __attribute__((unused))) {
+ void* z = gdk_display_get_default();
+ return box(z);
+}
+
+any cfun_gdk_display_get_pointer(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ gdk_display_get_pointer(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_image_new(any ex __attribute__((unused))) {
+ void* z = gtk_image_new();
+ return box(z);
+}
+
+any cfun_gtk_image_new_from_pixmap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ void* z = gtk_image_new_from_pixmap(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_image_set_from_pixbuf(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_image_set_from_pixbuf(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_image_set_from_pixmap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ gtk_image_set_from_pixmap(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_image_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ gtk_image_set(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_image_set_from_file(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_image_set_from_file(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_image_new_from_file(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_image_new_from_file(b1);
+ return box(z);
+}
+
+any cfun_gtk_pixmap_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ void* z = gtk_pixmap_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_drawing_area_new(any ex __attribute__((unused))) {
+ void* z = gtk_drawing_area_new();
+ return box(z);
+}
+
+any cfun_gtk_widget_queue_draw(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_queue_draw(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_get_colormap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_widget_get_colormap(b1);
+ return box(z);
+}
+
+any cfun_gtk_widget_get_parent_window(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_widget_get_parent_window(b1);
+ return box(z);
+}
+
+any cfun_gtk_widget_create_pango_layout(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ void* z = gtk_widget_create_pango_layout(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_vscrollbar_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_vscrollbar_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_label_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_label_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_label_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_label_set_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_label_get_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_label_get_text(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_label_set_line_wrap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_label_set_line_wrap(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_label_set_selectable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_label_set_selectable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_label_set_use_markup(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_label_set_use_markup(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_label_set_justify(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_label_set_justify(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_label_get_width_chars(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_label_get_width_chars(b1);
+ return box(z);
+}
+
+any cfun_gtk_label_get_max_width_chars(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_label_get_max_width_chars(b1);
+ return box(z);
+}
+
+any cfun_gtk_label_set_markup_with_mnemonic(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_label_set_markup_with_mnemonic(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_frame_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ void* z = gtk_frame_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_frame_set_label_align(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b2 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b3 = (float) unBox(y) / 10000;
+ gtk_frame_set_label_align(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_frame_set_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_frame_set_label(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_frame_get_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_frame_get_label(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_aspect_frame_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b2 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b3 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b4 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b5 = y == Nil ? 0 : 1;
+ void* z = gtk_aspect_frame_new(b1, b2, b3, b4, b5);
+ return box(z);
+}
+
+any cfun_gtk_aspect_frame_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b2 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b3 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b4 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b5 = y == Nil ? 0 : 1;
+ gtk_aspect_frame_set(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_radio_button_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ void* z = gtk_radio_button_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_radio_button_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ void* z = gtk_radio_button_new_with_label(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_radio_button_new_from_widget(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_radio_button_new_from_widget(b1);
+ return box(z);
+}
+
+any cfun_gtk_radio_button_new_with_label_from_widget(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ void* z = gtk_radio_button_new_with_label_from_widget(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_notebook_new(any ex __attribute__((unused))) {
+ void* z = gtk_notebook_new();
+ return box(z);
+}
+
+any cfun_gtk_notebook_set_tab_pos(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_notebook_set_tab_pos(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_notebook_popup_enable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_notebook_popup_enable(b1);
+ return Nil;
+}
+
+any cfun_gtk_notebook_insert_page(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gtk_notebook_insert_page(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_notebook_remove_page(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_notebook_remove_page(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_notebook_get_current_page(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_notebook_get_current_page(b1);
+ return Nil;
+}
+
+any cfun_gtk_notebook_set_page(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_notebook_set_page(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_notebook_set_tab_label_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ gtk_notebook_set_tab_label_text(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_adjustment_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b4 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b5 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b6 = (double) unBox(y) / 10000;
+ void* z = gtk_adjustment_new(b1, b2, b3, b4, b5, b6);
+ return box(z);
+}
+
+any cfun_gtk_adjustment_get_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ float z = gtk_adjustment_get_value(b1);
+ return box(z * 10000);
+}
+
+any cfun_gtk_range_get_adjustment(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_range_get_adjustment(b1);
+ return box(z);
+}
+
+any cfun_gtk_range_get_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ float z = gtk_range_get_value(b1);
+ return box(z * 10000);
+}
+
+any cfun_gtk_range_set_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ gtk_range_set_value(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_scale_set_draw_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_scale_set_draw_value(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_scale_set_value_pos(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_scale_set_value_pos(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_hscale_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_hscale_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_hscale_new_with_range(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ void* z = gtk_hscale_new_with_range(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_gtk_vscale_new_with_range(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b1 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b3 = (double) unBox(y) / 10000;
+ void* z = gtk_vscale_new_with_range(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_gtk_spin_button_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ void* z = gtk_spin_button_new(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_gtk_spin_button_get_value_as_int(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_spin_button_get_value_as_int(b1);
+ return box(z);
+}
+
+any cfun_gtk_spin_button_get_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ float z = gtk_spin_button_get_value(b1);
+ return box(z * 10000);
+}
+
+any cfun_gtk_spin_button_set_wrap(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_spin_button_set_wrap(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_spin_button_set_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ gtk_spin_button_set_value(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_arrow_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gtk_arrow_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_file_chooser_dialog_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y6s = xSym(y);
+ char b6[bufSize(y6s)];
+ bufString(y6s, b6);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b7 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b8 = (void*) 0;
+ void* z = gtk_file_chooser_dialog_new(b1, b2, b3, b4, b5, b6, b7, b8);
+ return box(z);
+}
+
+any cfun_gtk_file_chooser_widget_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ void* z = gtk_file_chooser_widget_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_dialog_run(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_dialog_run(b1);
+ return box(z);
+}
+
+any cfun_gtk_file_chooser_get_filename(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_file_chooser_get_filename(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_file_chooser_set_filename(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ int z = gtk_file_chooser_set_filename(b1, b2);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_file_filter_new(any ex __attribute__((unused))) {
+ void* z = gtk_file_filter_new();
+ return box(z);
+}
+
+any cfun_gtk_file_filter_add_pattern(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_file_filter_add_pattern(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_file_filter_set_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_file_filter_set_name(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_file_chooser_add_filter(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_file_chooser_add_filter(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_font_selection_dialog_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_font_selection_dialog_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_font_selection_dialog_get_font_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_font_selection_dialog_get_font_name(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_font_selection_new(any ex __attribute__((unused))) {
+ void* z = gtk_font_selection_new();
+ return box(z);
+}
+
+any cfun_gtk_font_selection_get_font_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_font_selection_get_font_name(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_font_selection_set_font_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ int z = gtk_font_selection_set_font_name(b1, b2);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_color_selection_new(any ex __attribute__((unused))) {
+ void* z = gtk_color_selection_new();
+ return box(z);
+}
+
+any cfun_gtk_color_selection_set_has_opacity_control(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_color_selection_set_has_opacity_control(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_color_selection_set_current_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_color_selection_set_current_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_color_selection_get_current_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_color_selection_get_current_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_color_selection_set_color(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_color_selection_set_color(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_menu_bar_new(any ex __attribute__((unused))) {
+ void* z = gtk_menu_bar_new();
+ return box(z);
+}
+
+any cfun_gtk_menu_shell_append(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_menu_shell_append(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_menu_item_new(any ex __attribute__((unused))) {
+ void* z = gtk_menu_item_new();
+ return box(z);
+}
+
+any cfun_gtk_menu_item_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_menu_item_new_with_label(b1);
+ return box(z);
+}
+
+any cfun_gtk_menu_item_new_with_mnemonic(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_menu_item_new_with_mnemonic(b1);
+ return box(z);
+}
+
+any cfun_gtk_menu_new(any ex __attribute__((unused))) {
+ void* z = gtk_menu_new();
+ return box(z);
+}
+
+any cfun_gtk_menu_item_set_right_justified(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_menu_item_set_right_justified(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_menu_item_set_submenu(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_menu_item_set_submenu(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_check_menu_item_new_with_label(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_check_menu_item_new_with_label(b1);
+ return box(z);
+}
+
+any cfun_gtk_check_menu_item_new_with_mnemonic(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_check_menu_item_new_with_mnemonic(b1);
+ return box(z);
+}
+
+any cfun_gtk_check_menu_item_get_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ int z = gtk_check_menu_item_get_active(b1);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_check_menu_item_set_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_check_menu_item_set_active(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_menu_popup(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b6 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b7 = (long) unBox(y);
+ gtk_menu_popup(b1, b2, b3, b4, b5, b6, b7);
+ return Nil;
+}
+
+any cfun_gtk_progress_bar_new(any ex __attribute__((unused))) {
+ void* z = gtk_progress_bar_new();
+ return box(z);
+}
+
+any cfun_gtk_progress_bar_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_progress_bar_set_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_progress_bar_set_fraction(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ gtk_progress_bar_set_fraction(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_progress_bar_pulse(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_progress_bar_pulse(b1);
+ return Nil;
+}
+
+any cfun_gtk_progress_bar_set_pulse_step(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ double b2 = (double) unBox(y) / 10000;
+ gtk_progress_bar_set_pulse_step(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_statusbar_new(any ex __attribute__((unused))) {
+ void* z = gtk_statusbar_new();
+ return box(z);
+}
+
+any cfun_gtk_statusbar_get_context_id(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ long z = gtk_statusbar_get_context_id(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_statusbar_push(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ long z = gtk_statusbar_push(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_gtk_statusbar_pop(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_statusbar_pop(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_statusbar_remove(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_statusbar_remove(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_statusbar_set_has_resize_grip(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_statusbar_set_has_resize_grip(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_event_box_new(any ex __attribute__((unused))) {
+ void* z = gtk_event_box_new();
+ return box(z);
+}
+
+any cfun_gtk_combo_box_new_text(any ex __attribute__((unused))) {
+ void* z = gtk_combo_box_new_text();
+ return box(z);
+}
+
+any cfun_gtk_combo_box_append_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_combo_box_append_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_combo_box_insert_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ gtk_combo_box_insert_text(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_combo_box_prepend_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_combo_box_prepend_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_combo_box_remove_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_combo_box_remove_text(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_combo_box_get_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ long z = gtk_combo_box_get_active(b1);
+ return box(z);
+}
+
+any cfun_gtk_combo_box_set_active(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ gtk_combo_box_set_active(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_combo_box_get_active_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_combo_box_get_active_text(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_vseparator_new(any ex __attribute__((unused))) {
+ void* z = gtk_vseparator_new();
+ return box(z);
+}
+
+any cfun_gtk_hseparator_new(any ex __attribute__((unused))) {
+ void* z = gtk_hseparator_new();
+ return box(z);
+}
+
+any cfun_gtk_editable_copy_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_editable_copy_clipboard(b1);
+ return Nil;
+}
+
+any cfun_gtk_editable_cut_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_editable_cut_clipboard(b1);
+ return Nil;
+}
+
+any cfun_gtk_editable_paste_clipboard(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_editable_paste_clipboard(b1);
+ return Nil;
+}
+
+any cfun_gdk_atom_intern(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gdk_atom_intern(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_clipboard_get(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ void* z = gtk_clipboard_get(b1);
+ return box(z);
+}
+
+any cfun_gtk_clipboard_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_clipboard_set_text(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_clipboard_wait_for_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = gtk_clipboard_wait_for_text(b1);
+ return mkStr(z);
+}
+
+any cfun_gtk_clist_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ void* z = gtk_clist_new(b1);
+ return box(z);
+}
+
+any cfun_gtk_clist_set_column_title(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ gtk_clist_set_column_title(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_clist_column_titles_show(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_clist_column_titles_show(b1);
+ return Nil;
+}
+
+any cfun_gtk_clist_append(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ long z = gtk_clist_append(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_clist_set_text(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ gtk_clist_set_text(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_fixed_new(any ex __attribute__((unused))) {
+ void* z = gtk_fixed_new();
+ return box(z);
+}
+
+any cfun_gtk_fixed_put(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gtk_fixed_put(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_fixed_move(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gtk_fixed_move(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_list_store_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gtk_list_store_new(b1, b2);
+ return box(z);
+}
+
+any cfun_gtk_list_store_append(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_list_store_append(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_list_store_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_list_store_set(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_list_store_set_value(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ gtk_list_store_set_value(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_list_store_clear(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_list_store_clear(b1);
+ return Nil;
+}
+
+any cfun_gtk_list_store_remove(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ int z = gtk_list_store_remove(b1, b2);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_cell_renderer_text_new(any ex __attribute__((unused))) {
+ void* z = gtk_cell_renderer_text_new();
+ return box(z);
+}
+
+any cfun_gtk_tree_view_new_with_model(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_tree_view_new_with_model(b1);
+ return box(z);
+}
+
+any cfun_gtk_tree_view_column_new(any ex __attribute__((unused))) {
+ void* z = gtk_tree_view_column_new();
+ return box(z);
+}
+
+any cfun_gtk_tree_view_column_new_with_attributes(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y3s = xSym(y);
+ char b3[bufSize(y3s)];
+ bufString(y3s, b3);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ void* z = gtk_tree_view_column_new_with_attributes(b1, b2, b3, b4, b5);
+ return box(z);
+}
+
+any cfun_gtk_tree_view_column_pack_start(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ gtk_tree_view_column_pack_start(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_tree_view_append_column(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_tree_view_append_column(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_view_set_headers_visible(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_tree_view_set_headers_visible(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_view_set_headers_clickable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_tree_view_set_headers_clickable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_view_get_selection(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_tree_view_get_selection(b1);
+ return box(z);
+}
+
+any cfun_gtk_tree_view_column_set_resizable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_tree_view_column_set_resizable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_view_column_set_clickable(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_tree_view_column_set_clickable(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_selection_get_selected(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ int z = gtk_tree_selection_get_selected(b1, b2, b3);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_tree_selection_select_iter(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_tree_selection_select_iter(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_selection_select_path(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_tree_selection_select_path(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_tree_model_get(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y4s = xSym(y);
+ char b4[bufSize(y4s)];
+ bufString(y4s, b4);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_tree_model_get(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_tree_model_get_string_from_iter(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ char* z = gtk_tree_model_get_string_from_iter(b1, b2);
+ return mkStr(z);
+}
+
+any cfun_gtk_tree_path_new_from_string(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ void* z = gtk_tree_path_new_from_string(b1);
+ return box(z);
+}
+
+any cfun_gtk_tree_path_free(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_tree_path_free(b1);
+ return Nil;
+}
+
+any cfun_gtk_tree_sortable_set_sort_column_id(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_tree_sortable_set_sort_column_id(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_init(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b1 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ gtk_init(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_widget_show(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_show(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_show_all(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_show_all(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_realize(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_realize(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_unrealize(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_unrealize(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_hide(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_hide(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_destroy(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_destroy(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_grab_focus(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_widget_grab_focus(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_set_size_request(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_widget_set_size_request(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_widget_size_request(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ gtk_widget_size_request(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_widget_set_usize(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_widget_set_usize(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_widget_modify_base(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_widget_modify_base(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_widget_modify_bg(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ gtk_widget_modify_bg(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_widget_set_sensitive(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ gtk_widget_set_sensitive(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_settings_get_default(any ex __attribute__((unused))) {
+ void* z = gtk_settings_get_default();
+ return box(z);
+}
+
+any cfun_gtk_widget_get_parent(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = gtk_widget_get_parent(b1);
+ return box(z);
+}
+
+any cfun_gtk_misc_set_alignment(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b2 = (float) unBox(y) / 10000;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ float b3 = (float) unBox(y) / 10000;
+ gtk_misc_set_alignment(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_main(any ex __attribute__((unused))) {
+ gtk_main();
+ return Nil;
+}
+
+any cfun_gtk_main_iteration(any ex __attribute__((unused))) {
+ int z = gtk_main_iteration();
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_main_iteration_do(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b1 = y == Nil ? 0 : 1;
+ int z = gtk_main_iteration_do(b1);
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_events_pending(any ex __attribute__((unused))) {
+ int z = gtk_events_pending();
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_exit(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ gtk_exit(b1);
+ return Nil;
+}
+
+any cfun_gtk_main_quit(any ex __attribute__((unused))) {
+ gtk_main_quit();
+ return Nil;
+}
+
+any cfun_gtk_rc_parse(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ gtk_rc_parse(b1);
+ return Nil;
+}
+
+any cfun_gtk_rc_parse_string(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ gtk_rc_parse_string(b1);
+ return Nil;
+}
+
+any cfun_gtk_rc_reparse_all(any ex __attribute__((unused))) {
+ int z = gtk_rc_reparse_all();
+ return z == 0 ? T : Nil;
+}
+
+any cfun_gtk_rc_reset_styles(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ gtk_rc_reset_styles(b1);
+ return Nil;
+}
+
+any cfun_gtk_rc_add_default_file(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ gtk_rc_add_default_file(b1);
+ return Nil;
+}
+
+any cfun_gtk_widget_set_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_widget_set_name(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_check_version(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b1 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ char* z = gtk_check_version(b1, b2, b3);
+ return mkStr(z);
+}
+
+any cfun_gtk_drag_source_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_drag_source_set(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_drag_dest_set(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b5 = (long) unBox(y);
+ gtk_drag_dest_set(b1, b2, b3, b4, b5);
+ return Nil;
+}
+
+any cfun_gtk_drag_finish(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b2 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ int b3 = y == Nil ? 0 : 1;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b4 = (long) unBox(y);
+ gtk_drag_finish(b1, b2, b3, b4);
+ return Nil;
+}
+
+any cfun_gtk_get_current_event_time(any ex __attribute__((unused))) {
+ long z = gtk_get_current_event_time();
+ return box(z);
+}
+
+any cfun_gtk_widget_get_size_request(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b2 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ gtk_widget_get_size_request(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_gtk_signal_emit_by_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ gtk_signal_emit_by_name(b1, b2);
+ return Nil;
+}
+
+any cfun_gtk_invisible_new(any ex __attribute__((unused))) {
+ void* z = gtk_invisible_new();
+ return box(z);
+}
+
+any cfun_gdk_pixbuf_new_from_file(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ void* z = gdk_pixbuf_new_from_file(b1, b2);
+ return box(z);
+}
+
+any cfun_gdk_pixbuf_new_from_file_at_size(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b3 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ void* z = gdk_pixbuf_new_from_file_at_size(b1, b2, b3, b4);
+ return box(z);
+}
+
+any cfun_gdk_pixbuf_rotate_simple(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ void* z = gdk_pixbuf_rotate_simple(b1, b2);
+ return box(z);
+}
+
+any cfun_g_object_unref(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ g_object_unref(b1);
+ return Nil;
+}
+
+any cfun_g_locale_to_utf8(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ char* z = g_locale_to_utf8(b1, b2, b3, b4, b5);
+ return mkStr(z);
+}
+
+any cfun_g_locale_from_utf8(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ long b2 = (long) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b5 = (void*) 0;
+ char* z = g_locale_from_utf8(b1, b2, b3, b4, b5);
+ return mkStr(z);
+}
+
+any cfun_g_free(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ g_free(b1);
+ return Nil;
+}
+
+any cfun_glade_init(any ex __attribute__((unused))) {
+ glade_init();
+ return Nil;
+}
+
+any cfun_glade_xml_new(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1s = xSym(y);
+ char b1[bufSize(y1s)];
+ bufString(y1s, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b2 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b3 = (void*) 0;
+ void* z = glade_xml_new(b1, b2, b3);
+ return box(z);
+}
+
+any cfun_glade_xml_get_widget(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ void* z = glade_xml_get_widget(b1, b2);
+ return box(z);
+}
+
+static any lcb_handler;
+
+static any lfun_handler(char* handlerName, void* object, char* signalName, char* signalData, void* connectObject, int after, void* userData) {
+ cell c[7];
+ Push(c[0], mkStr(handlerName));
+ Push(c[1], box(object));
+ Push(c[2], mkStr(signalName));
+ Push(c[3], mkStr(signalData));
+ Push(c[4], box(connectObject));
+ Push(c[5], after == 0 ? T : Nil);
+ Push(c[6], box(userData));
+ apply(NULL, lcb_handler, NO, 7, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_glade_xml_signal_autoconnect_full(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_handler = y;
+ void* b2 = (void*) lfun_handler;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b3 = (void*) unBox(y);
+ glade_xml_signal_autoconnect_full(b1, b2, b3);
+ return Nil;
+}
+
+any cfun_glade_get_widget_name(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ char* z = glade_get_widget_name(b1);
+ return mkStr(z);
+}
+
+any cfun_glade_get_widget_tree(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ void* z = glade_get_widget_tree(b1);
+ return box(z);
+}
+
+static any lcb_signal;
+
+static any lfun_signal() {
+ cell c[0];
+ apply(NULL, lcb_signal, NO, 0, c);
+ drop(c[0]);
+ return Nil;
+}
+
+static any lcb_destroyNotify;
+
+static any lfun_destroyNotify() {
+ cell c[0];
+ apply(NULL, lcb_destroyNotify, NO, 0, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_gtk_signal_connect_full(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_signal = y;
+ void* b3 = (void*) lfun_signal;
+ x = cdr(x);
+ y = EVAL(car(x));
+ void* b4 = (void*) 0;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b5 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_destroyNotify = y;
+ void* b6 = (void*) lfun_destroyNotify;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b7 = (int) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b8 = (int) unBox(y);
+ ulong z = gtk_signal_connect_full(b1, b2, b3, b4, b5, b6, b7, b8);
+ return box(z);
+}
+
+static any lcb_signal2;
+
+static any lfun_signal2(void* data) {
+ cell c[1];
+ Push(c[0], box(data));
+ apply(NULL, lcb_signal2, NO, 1, c);
+ drop(c[0]);
+ return Nil;
+}
+
+any cfun_g_signal_connect(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y2s = xSym(y);
+ char b2[bufSize(y2s)];
+ bufString(y2s, b2);
+ x = cdr(x);
+ y = EVAL(car(x));
+ lcb_signal2 = y;
+ void* b3 = (void*) lfun_signal2;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b4 = (void*) unBox(y);
+ g_signal_connect(b1, b2, b3, b4);
+ return Nil;
+}
diff --git a/src/mod/gtk.ffi.fn b/src/mod/gtk.ffi.fn
@@ -0,0 +1,343 @@
+ {cfun_gtk_window_new, "gtk_window_new"},
+ {cfun_gtk_window_set_title, "gtk_window_set_title"},
+ {cfun_gtk_window_get_title, "gtk_window_get_title"},
+ {cfun_gtk_window_set_default_size, "gtk_window_set_default_size"},
+ {cfun_gtk_window_set_position, "gtk_window_set_position"},
+ {cfun_gtk_window_set_resizable, "gtk_window_set_resizable"},
+ {cfun_gtk_window_set_transient_for, "gtk_window_set_transient_for"},
+ {cfun_gtk_window_maximize, "gtk_window_maximize"},
+ {cfun_gtk_message_dialog_new, "gtk_message_dialog_new"},
+ {cfun_gtk_window_set_icon_from_file, "gtk_window_set_icon_from_file"},
+ {cfun_gtk_window_set_keep_above, "gtk_window_set_keep_above"},
+ {cfun_gtk_window_set_keep_below, "gtk_window_set_keep_below"},
+ {cfun_gtk_about_dialog_set_version, "gtk_about_dialog_set_version"},
+ {cfun_gtk_table_new, "gtk_table_new"},
+ {cfun_gtk_table_attach_defaults, "gtk_table_attach_defaults"},
+ {cfun_gtk_container_add, "gtk_container_add"},
+ {cfun_gtk_container_remove, "gtk_container_remove"},
+ {cfun_gtk_container_set_border_width, "gtk_container_set_border_width"},
+ {cfun_gtk_hbox_new, "gtk_hbox_new"},
+ {cfun_gtk_vbox_new, "gtk_vbox_new"},
+ {cfun_gtk_box_pack_start, "gtk_box_pack_start"},
+ {cfun_gtk_box_pack_end, "gtk_box_pack_end"},
+ {cfun_gtk_box_pack_start_defaults, "gtk_box_pack_start_defaults"},
+ {cfun_gtk_box_pack_end_defaults, "gtk_box_pack_end_defaults"},
+ {cfun_gtk_button_new, "gtk_button_new"},
+ {cfun_gtk_button_new_with_label, "gtk_button_new_with_label"},
+ {cfun_gtk_button_new_from_stock, "gtk_button_new_from_stock"},
+ {cfun_gtk_button_new_with_mnemonic, "gtk_button_new_with_mnemonic"},
+ {cfun_gtk_button_set_use_stock, "gtk_button_set_use_stock"},
+ {cfun_gtk_button_set_label, "gtk_button_set_label"},
+ {cfun_gtk_button_set_relief, "gtk_button_set_relief"},
+ {cfun_gtk_toggle_button_new, "gtk_toggle_button_new"},
+ {cfun_gtk_toggle_button_new_with_label, "gtk_toggle_button_new_with_label"},
+ {cfun_gtk_toggle_button_get_active, "gtk_toggle_button_get_active"},
+ {cfun_gtk_toggle_button_set_active, "gtk_toggle_button_set_active"},
+ {cfun_gtk_check_button_new_with_label, "gtk_check_button_new_with_label"},
+ {cfun_gtk_entry_new, "gtk_entry_new"},
+ {cfun_gtk_entry_get_text, "gtk_entry_get_text"},
+ {cfun_gtk_entry_set_text, "gtk_entry_set_text"},
+ {cfun_gtk_entry_set_visibility, "gtk_entry_set_visibility"},
+ {cfun_gtk_editable_delete_text, "gtk_editable_delete_text"},
+ {cfun_gtk_editable_get_chars, "gtk_editable_get_chars"},
+ {cfun_gtk_editable_set_editable, "gtk_editable_set_editable"},
+ {cfun_gtk_editable_select_region, "gtk_editable_select_region"},
+ {cfun_gtk_text_buffer_new, "gtk_text_buffer_new"},
+ {cfun_gtk_text_buffer_set_text, "gtk_text_buffer_set_text"},
+ {cfun_gtk_text_buffer_insert_at_cursor, "gtk_text_buffer_insert_at_cursor"},
+ {cfun_gtk_text_buffer_get_insert, "gtk_text_buffer_get_insert"},
+ {cfun_gtk_text_buffer_get_start_iter, "gtk_text_buffer_get_start_iter"},
+ {cfun_gtk_text_buffer_get_end_iter, "gtk_text_buffer_get_end_iter"},
+ {cfun_gtk_text_buffer_get_bounds, "gtk_text_buffer_get_bounds"},
+ {cfun_gtk_text_buffer_get_selection_bounds, "gtk_text_buffer_get_selection_bounds"},
+ {cfun_gtk_text_buffer_get_iter_at_offset, "gtk_text_buffer_get_iter_at_offset"},
+ {cfun_gtk_text_buffer_get_text, "gtk_text_buffer_get_text"},
+ {cfun_gtk_text_buffer_insert, "gtk_text_buffer_insert"},
+ {cfun_gtk_text_buffer_create_tag, "gtk_text_buffer_create_tag"},
+ {cfun_gtk_text_buffer_insert_with_tags_by_name, "gtk_text_buffer_insert_with_tags_by_name"},
+ {cfun_gtk_text_buffer_apply_tag_by_name, "gtk_text_buffer_apply_tag_by_name"},
+ {cfun_gtk_text_buffer_remove_tag_by_name, "gtk_text_buffer_remove_tag_by_name"},
+ {cfun_gtk_text_buffer_remove_all_tags, "gtk_text_buffer_remove_all_tags"},
+ {cfun_gtk_text_buffer_get_tag_table, "gtk_text_buffer_get_tag_table"},
+ {cfun_gtk_text_buffer_select_range, "gtk_text_buffer_select_range"},
+ {cfun_gtk_text_buffer_get_selection_bound, "gtk_text_buffer_get_selection_bound"},
+ {cfun_gtk_text_buffer_get_line_count, "gtk_text_buffer_get_line_count"},
+ {cfun_gtk_text_buffer_create_mark, "gtk_text_buffer_create_mark"},
+ {cfun_gtk_text_buffer_get_iter_at_mark, "gtk_text_buffer_get_iter_at_mark"},
+ {cfun_gtk_text_buffer_get_iter_at_line, "gtk_text_buffer_get_iter_at_line"},
+ {cfun_gtk_text_buffer_delete, "gtk_text_buffer_delete"},
+ {cfun_gtk_text_buffer_delete_mark, "gtk_text_buffer_delete_mark"},
+ {cfun_gtk_text_buffer_delete_mark_by_name, "gtk_text_buffer_delete_mark_by_name"},
+ {cfun_gtk_text_buffer_place_cursor, "gtk_text_buffer_place_cursor"},
+ {cfun_gtk_text_buffer_copy_clipboard, "gtk_text_buffer_copy_clipboard"},
+ {cfun_gtk_text_buffer_cut_clipboard, "gtk_text_buffer_cut_clipboard"},
+ {cfun_gtk_text_buffer_paste_clipboard, "gtk_text_buffer_paste_clipboard"},
+ {cfun_gtk_scrolled_window_new, "gtk_scrolled_window_new"},
+ {cfun_gtk_scrolled_window_set_policy, "gtk_scrolled_window_set_policy"},
+ {cfun_gtk_scrolled_window_set_shadow_type, "gtk_scrolled_window_set_shadow_type"},
+ {cfun_gtk_scrolled_window_add_with_viewport, "gtk_scrolled_window_add_with_viewport"},
+ {cfun_gtk_text_view_new_with_buffer, "gtk_text_view_new_with_buffer"},
+ {cfun_gtk_text_view_set_wrap_mode, "gtk_text_view_set_wrap_mode"},
+ {cfun_gtk_text_view_set_editable, "gtk_text_view_set_editable"},
+ {cfun_gtk_text_view_set_border_window_size, "gtk_text_view_set_border_window_size"},
+ {cfun_gtk_text_view_move_mark_onscreen, "gtk_text_view_move_mark_onscreen"},
+ {cfun_gtk_text_view_scroll_to_mark, "gtk_text_view_scroll_to_mark"},
+ {cfun_gtk_text_view_scroll_mark_onscreen, "gtk_text_view_scroll_mark_onscreen"},
+ {cfun_gtk_text_view_set_pixels_inside_wrap, "gtk_text_view_set_pixels_inside_wrap"},
+ {cfun_gtk_text_view_get_pixels_inside_wrap, "gtk_text_view_get_pixels_inside_wrap"},
+ {cfun_gtk_text_view_set_pixels_above_lines, "gtk_text_view_set_pixels_above_lines"},
+ {cfun_gtk_text_view_get_pixels_above_lines, "gtk_text_view_get_pixels_above_lines"},
+ {cfun_gtk_text_view_set_cursor_visible, "gtk_text_view_set_cursor_visible"},
+ {cfun_gtk_text_view_window_to_buffer_coords, "gtk_text_view_window_to_buffer_coords"},
+ {cfun_gtk_text_iter_forward_search, "gtk_text_iter_forward_search"},
+ {cfun_gtk_text_iter_forward_visible_cursor_position, "gtk_text_iter_forward_visible_cursor_position"},
+ {cfun_gtk_text_iter_forward_to_line_end, "gtk_text_iter_forward_to_line_end"},
+ {cfun_gtk_text_iter_set_line, "gtk_text_iter_set_line"},
+ {cfun_gtk_text_iter_set_line_offset, "gtk_text_iter_set_line_offset"},
+ {cfun_gtk_text_iter_set_line_index, "gtk_text_iter_set_line_index"},
+ {cfun_gtk_text_iter_get_text, "gtk_text_iter_get_text"},
+ {cfun_gtk_text_iter_get_line, "gtk_text_iter_get_line"},
+ {cfun_gtk_text_view_new, "gtk_text_view_new"},
+ {cfun_gtk_text_view_get_buffer, "gtk_text_view_get_buffer"},
+ {cfun_gtk_text_tag_table_remove, "gtk_text_tag_table_remove"},
+ {cfun_gdk_font_load, "gdk_font_load"},
+ {cfun_gdk_pixmap_new, "gdk_pixmap_new"},
+ {cfun_gdk_pixmap_unref, "gdk_pixmap_unref"},
+ {cfun_gdk_pixmap_create_from_xpm, "gdk_pixmap_create_from_xpm"},
+ {cfun_gdk_pixmap_colormap_create_from_xpm, "gdk_pixmap_colormap_create_from_xpm"},
+ {cfun_gdk_draw_rectangle, "gdk_draw_rectangle"},
+ {cfun_gdk_draw_arc, "gdk_draw_arc"},
+ {cfun_gdk_draw_line, "gdk_draw_line"},
+ {cfun_gdk_draw_point, "gdk_draw_point"},
+ {cfun_gdk_draw_layout, "gdk_draw_layout"},
+ {cfun_gdk_draw_drawable, "gdk_draw_drawable"},
+ {cfun_gdk_gc_new, "gdk_gc_new"},
+ {cfun_gdk_gc_set_rgb_fg_color, "gdk_gc_set_rgb_fg_color"},
+ {cfun_gdk_gc_set_rgb_bg_color, "gdk_gc_set_rgb_bg_color"},
+ {cfun_gdk_gc_set_foreground, "gdk_gc_set_foreground"},
+ {cfun_gdk_gc_set_background, "gdk_gc_set_background"},
+ {cfun_gdk_gc_set_colormap, "gdk_gc_set_colormap"},
+ {cfun_gdk_color_alloc, "gdk_color_alloc"},
+ {cfun_gdk_color_parse, "gdk_color_parse"},
+ {cfun_gdk_colormap_get_system, "gdk_colormap_get_system"},
+ {cfun_gdk_colormap_alloc_color, "gdk_colormap_alloc_color"},
+ {cfun_gdk_get_default_root_window, "gdk_get_default_root_window"},
+ {cfun_gdk_rgb_find_color, "gdk_rgb_find_color"},
+ {cfun_gdk_drawable_set_colormap, "gdk_drawable_set_colormap"},
+ {cfun_gdk_drawable_get_size, "gdk_drawable_get_size"},
+ {cfun_gdk_keymap_translate_keyboard_state, "gdk_keymap_translate_keyboard_state"},
+ {cfun_gdk_window_process_all_updates, "gdk_window_process_all_updates"},
+ {cfun_gdk_window_get_geometry, "gdk_window_get_geometry"},
+ {cfun_gdk_screen_get_default, "gdk_screen_get_default"},
+ {cfun_gdk_screen_get_width, "gdk_screen_get_width"},
+ {cfun_gdk_screen_get_height, "gdk_screen_get_height"},
+ {cfun_gdk_screen_width, "gdk_screen_width"},
+ {cfun_gdk_screen_height, "gdk_screen_height"},
+ {cfun_gdk_flush, "gdk_flush"},
+ {cfun_gdk_init, "gdk_init"},
+ {cfun_gdk_display_get_default, "gdk_display_get_default"},
+ {cfun_gdk_display_get_pointer, "gdk_display_get_pointer"},
+ {cfun_gtk_image_new, "gtk_image_new"},
+ {cfun_gtk_image_new_from_pixmap, "gtk_image_new_from_pixmap"},
+ {cfun_gtk_image_set_from_pixbuf, "gtk_image_set_from_pixbuf"},
+ {cfun_gtk_image_set_from_pixmap, "gtk_image_set_from_pixmap"},
+ {cfun_gtk_image_set, "gtk_image_set"},
+ {cfun_gtk_image_set_from_file, "gtk_image_set_from_file"},
+ {cfun_gtk_image_new_from_file, "gtk_image_new_from_file"},
+ {cfun_gtk_pixmap_new, "gtk_pixmap_new"},
+ {cfun_gtk_drawing_area_new, "gtk_drawing_area_new"},
+ {cfun_gtk_widget_queue_draw, "gtk_widget_queue_draw"},
+ {cfun_gtk_widget_get_colormap, "gtk_widget_get_colormap"},
+ {cfun_gtk_widget_get_parent_window, "gtk_widget_get_parent_window"},
+ {cfun_gtk_widget_create_pango_layout, "gtk_widget_create_pango_layout"},
+ {cfun_gtk_vscrollbar_new, "gtk_vscrollbar_new"},
+ {cfun_gtk_label_new, "gtk_label_new"},
+ {cfun_gtk_label_set_text, "gtk_label_set_text"},
+ {cfun_gtk_label_get_text, "gtk_label_get_text"},
+ {cfun_gtk_label_set_line_wrap, "gtk_label_set_line_wrap"},
+ {cfun_gtk_label_set_selectable, "gtk_label_set_selectable"},
+ {cfun_gtk_label_set_use_markup, "gtk_label_set_use_markup"},
+ {cfun_gtk_label_set_justify, "gtk_label_set_justify"},
+ {cfun_gtk_label_get_width_chars, "gtk_label_get_width_chars"},
+ {cfun_gtk_label_get_max_width_chars, "gtk_label_get_max_width_chars"},
+ {cfun_gtk_label_set_markup_with_mnemonic, "gtk_label_set_markup_with_mnemonic"},
+ {cfun_gtk_frame_new, "gtk_frame_new"},
+ {cfun_gtk_frame_set_label_align, "gtk_frame_set_label_align"},
+ {cfun_gtk_frame_set_label, "gtk_frame_set_label"},
+ {cfun_gtk_frame_get_label, "gtk_frame_get_label"},
+ {cfun_gtk_aspect_frame_new, "gtk_aspect_frame_new"},
+ {cfun_gtk_aspect_frame_set, "gtk_aspect_frame_set"},
+ {cfun_gtk_radio_button_new, "gtk_radio_button_new"},
+ {cfun_gtk_radio_button_new_with_label, "gtk_radio_button_new_with_label"},
+ {cfun_gtk_radio_button_new_from_widget, "gtk_radio_button_new_from_widget"},
+ {cfun_gtk_radio_button_new_with_label_from_widget, "gtk_radio_button_new_with_label_from_widget"},
+ {cfun_gtk_notebook_new, "gtk_notebook_new"},
+ {cfun_gtk_notebook_set_tab_pos, "gtk_notebook_set_tab_pos"},
+ {cfun_gtk_notebook_popup_enable, "gtk_notebook_popup_enable"},
+ {cfun_gtk_notebook_insert_page, "gtk_notebook_insert_page"},
+ {cfun_gtk_notebook_remove_page, "gtk_notebook_remove_page"},
+ {cfun_gtk_notebook_get_current_page, "gtk_notebook_get_current_page"},
+ {cfun_gtk_notebook_set_page, "gtk_notebook_set_page"},
+ {cfun_gtk_notebook_set_tab_label_text, "gtk_notebook_set_tab_label_text"},
+ {cfun_gtk_adjustment_new, "gtk_adjustment_new"},
+ {cfun_gtk_adjustment_get_value, "gtk_adjustment_get_value"},
+ {cfun_gtk_range_get_adjustment, "gtk_range_get_adjustment"},
+ {cfun_gtk_range_get_value, "gtk_range_get_value"},
+ {cfun_gtk_range_set_value, "gtk_range_set_value"},
+ {cfun_gtk_scale_set_draw_value, "gtk_scale_set_draw_value"},
+ {cfun_gtk_scale_set_value_pos, "gtk_scale_set_value_pos"},
+ {cfun_gtk_hscale_new, "gtk_hscale_new"},
+ {cfun_gtk_hscale_new_with_range, "gtk_hscale_new_with_range"},
+ {cfun_gtk_vscale_new_with_range, "gtk_vscale_new_with_range"},
+ {cfun_gtk_spin_button_new, "gtk_spin_button_new"},
+ {cfun_gtk_spin_button_get_value_as_int, "gtk_spin_button_get_value_as_int"},
+ {cfun_gtk_spin_button_get_value, "gtk_spin_button_get_value"},
+ {cfun_gtk_spin_button_set_wrap, "gtk_spin_button_set_wrap"},
+ {cfun_gtk_spin_button_set_value, "gtk_spin_button_set_value"},
+ {cfun_gtk_arrow_new, "gtk_arrow_new"},
+ {cfun_gtk_file_chooser_dialog_new, "gtk_file_chooser_dialog_new"},
+ {cfun_gtk_file_chooser_widget_new, "gtk_file_chooser_widget_new"},
+ {cfun_gtk_dialog_run, "gtk_dialog_run"},
+ {cfun_gtk_file_chooser_get_filename, "gtk_file_chooser_get_filename"},
+ {cfun_gtk_file_chooser_set_filename, "gtk_file_chooser_set_filename"},
+ {cfun_gtk_file_filter_new, "gtk_file_filter_new"},
+ {cfun_gtk_file_filter_add_pattern, "gtk_file_filter_add_pattern"},
+ {cfun_gtk_file_filter_set_name, "gtk_file_filter_set_name"},
+ {cfun_gtk_file_chooser_add_filter, "gtk_file_chooser_add_filter"},
+ {cfun_gtk_font_selection_dialog_new, "gtk_font_selection_dialog_new"},
+ {cfun_gtk_font_selection_dialog_get_font_name, "gtk_font_selection_dialog_get_font_name"},
+ {cfun_gtk_font_selection_new, "gtk_font_selection_new"},
+ {cfun_gtk_font_selection_get_font_name, "gtk_font_selection_get_font_name"},
+ {cfun_gtk_font_selection_set_font_name, "gtk_font_selection_set_font_name"},
+ {cfun_gtk_color_selection_new, "gtk_color_selection_new"},
+ {cfun_gtk_color_selection_set_has_opacity_control, "gtk_color_selection_set_has_opacity_control"},
+ {cfun_gtk_color_selection_set_current_color, "gtk_color_selection_set_current_color"},
+ {cfun_gtk_color_selection_get_current_color, "gtk_color_selection_get_current_color"},
+ {cfun_gtk_color_selection_set_color, "gtk_color_selection_set_color"},
+ {cfun_gtk_menu_bar_new, "gtk_menu_bar_new"},
+ {cfun_gtk_menu_shell_append, "gtk_menu_shell_append"},
+ {cfun_gtk_menu_item_new, "gtk_menu_item_new"},
+ {cfun_gtk_menu_item_new_with_label, "gtk_menu_item_new_with_label"},
+ {cfun_gtk_menu_item_new_with_mnemonic, "gtk_menu_item_new_with_mnemonic"},
+ {cfun_gtk_menu_new, "gtk_menu_new"},
+ {cfun_gtk_menu_item_set_right_justified, "gtk_menu_item_set_right_justified"},
+ {cfun_gtk_menu_item_set_submenu, "gtk_menu_item_set_submenu"},
+ {cfun_gtk_check_menu_item_new_with_label, "gtk_check_menu_item_new_with_label"},
+ {cfun_gtk_check_menu_item_new_with_mnemonic, "gtk_check_menu_item_new_with_mnemonic"},
+ {cfun_gtk_check_menu_item_get_active, "gtk_check_menu_item_get_active"},
+ {cfun_gtk_check_menu_item_set_active, "gtk_check_menu_item_set_active"},
+ {cfun_gtk_menu_popup, "gtk_menu_popup"},
+ {cfun_gtk_progress_bar_new, "gtk_progress_bar_new"},
+ {cfun_gtk_progress_bar_set_text, "gtk_progress_bar_set_text"},
+ {cfun_gtk_progress_bar_set_fraction, "gtk_progress_bar_set_fraction"},
+ {cfun_gtk_progress_bar_pulse, "gtk_progress_bar_pulse"},
+ {cfun_gtk_progress_bar_set_pulse_step, "gtk_progress_bar_set_pulse_step"},
+ {cfun_gtk_statusbar_new, "gtk_statusbar_new"},
+ {cfun_gtk_statusbar_get_context_id, "gtk_statusbar_get_context_id"},
+ {cfun_gtk_statusbar_push, "gtk_statusbar_push"},
+ {cfun_gtk_statusbar_pop, "gtk_statusbar_pop"},
+ {cfun_gtk_statusbar_remove, "gtk_statusbar_remove"},
+ {cfun_gtk_statusbar_set_has_resize_grip, "gtk_statusbar_set_has_resize_grip"},
+ {cfun_gtk_event_box_new, "gtk_event_box_new"},
+ {cfun_gtk_combo_box_new_text, "gtk_combo_box_new_text"},
+ {cfun_gtk_combo_box_append_text, "gtk_combo_box_append_text"},
+ {cfun_gtk_combo_box_insert_text, "gtk_combo_box_insert_text"},
+ {cfun_gtk_combo_box_prepend_text, "gtk_combo_box_prepend_text"},
+ {cfun_gtk_combo_box_remove_text, "gtk_combo_box_remove_text"},
+ {cfun_gtk_combo_box_get_active, "gtk_combo_box_get_active"},
+ {cfun_gtk_combo_box_set_active, "gtk_combo_box_set_active"},
+ {cfun_gtk_combo_box_get_active_text, "gtk_combo_box_get_active_text"},
+ {cfun_gtk_vseparator_new, "gtk_vseparator_new"},
+ {cfun_gtk_hseparator_new, "gtk_hseparator_new"},
+ {cfun_gtk_editable_copy_clipboard, "gtk_editable_copy_clipboard"},
+ {cfun_gtk_editable_cut_clipboard, "gtk_editable_cut_clipboard"},
+ {cfun_gtk_editable_paste_clipboard, "gtk_editable_paste_clipboard"},
+ {cfun_gdk_atom_intern, "gdk_atom_intern"},
+ {cfun_gtk_clipboard_get, "gtk_clipboard_get"},
+ {cfun_gtk_clipboard_set_text, "gtk_clipboard_set_text"},
+ {cfun_gtk_clipboard_wait_for_text, "gtk_clipboard_wait_for_text"},
+ {cfun_gtk_clist_new, "gtk_clist_new"},
+ {cfun_gtk_clist_set_column_title, "gtk_clist_set_column_title"},
+ {cfun_gtk_clist_column_titles_show, "gtk_clist_column_titles_show"},
+ {cfun_gtk_clist_append, "gtk_clist_append"},
+ {cfun_gtk_clist_set_text, "gtk_clist_set_text"},
+ {cfun_gtk_fixed_new, "gtk_fixed_new"},
+ {cfun_gtk_fixed_put, "gtk_fixed_put"},
+ {cfun_gtk_fixed_move, "gtk_fixed_move"},
+ {cfun_gtk_list_store_new, "gtk_list_store_new"},
+ {cfun_gtk_list_store_append, "gtk_list_store_append"},
+ {cfun_gtk_list_store_set, "gtk_list_store_set"},
+ {cfun_gtk_list_store_set_value, "gtk_list_store_set_value"},
+ {cfun_gtk_list_store_clear, "gtk_list_store_clear"},
+ {cfun_gtk_list_store_remove, "gtk_list_store_remove"},
+ {cfun_gtk_cell_renderer_text_new, "gtk_cell_renderer_text_new"},
+ {cfun_gtk_tree_view_new_with_model, "gtk_tree_view_new_with_model"},
+ {cfun_gtk_tree_view_column_new, "gtk_tree_view_column_new"},
+ {cfun_gtk_tree_view_column_new_with_attributes, "gtk_tree_view_column_new_with_attributes"},
+ {cfun_gtk_tree_view_column_pack_start, "gtk_tree_view_column_pack_start"},
+ {cfun_gtk_tree_view_append_column, "gtk_tree_view_append_column"},
+ {cfun_gtk_tree_view_set_headers_visible, "gtk_tree_view_set_headers_visible"},
+ {cfun_gtk_tree_view_set_headers_clickable, "gtk_tree_view_set_headers_clickable"},
+ {cfun_gtk_tree_view_get_selection, "gtk_tree_view_get_selection"},
+ {cfun_gtk_tree_view_column_set_resizable, "gtk_tree_view_column_set_resizable"},
+ {cfun_gtk_tree_view_column_set_clickable, "gtk_tree_view_column_set_clickable"},
+ {cfun_gtk_tree_selection_get_selected, "gtk_tree_selection_get_selected"},
+ {cfun_gtk_tree_selection_select_iter, "gtk_tree_selection_select_iter"},
+ {cfun_gtk_tree_selection_select_path, "gtk_tree_selection_select_path"},
+ {cfun_gtk_tree_model_get, "gtk_tree_model_get"},
+ {cfun_gtk_tree_model_get_string_from_iter, "gtk_tree_model_get_string_from_iter"},
+ {cfun_gtk_tree_path_new_from_string, "gtk_tree_path_new_from_string"},
+ {cfun_gtk_tree_path_free, "gtk_tree_path_free"},
+ {cfun_gtk_tree_sortable_set_sort_column_id, "gtk_tree_sortable_set_sort_column_id"},
+ {cfun_gtk_init, "gtk_init"},
+ {cfun_gtk_widget_show, "gtk_widget_show"},
+ {cfun_gtk_widget_show_all, "gtk_widget_show_all"},
+ {cfun_gtk_widget_realize, "gtk_widget_realize"},
+ {cfun_gtk_widget_unrealize, "gtk_widget_unrealize"},
+ {cfun_gtk_widget_hide, "gtk_widget_hide"},
+ {cfun_gtk_widget_destroy, "gtk_widget_destroy"},
+ {cfun_gtk_widget_grab_focus, "gtk_widget_grab_focus"},
+ {cfun_gtk_widget_set_size_request, "gtk_widget_set_size_request"},
+ {cfun_gtk_widget_size_request, "gtk_widget_size_request"},
+ {cfun_gtk_widget_set_usize, "gtk_widget_set_usize"},
+ {cfun_gtk_widget_modify_base, "gtk_widget_modify_base"},
+ {cfun_gtk_widget_modify_bg, "gtk_widget_modify_bg"},
+ {cfun_gtk_widget_set_sensitive, "gtk_widget_set_sensitive"},
+ {cfun_gtk_settings_get_default, "gtk_settings_get_default"},
+ {cfun_gtk_widget_get_parent, "gtk_widget_get_parent"},
+ {cfun_gtk_misc_set_alignment, "gtk_misc_set_alignment"},
+ {cfun_gtk_main, "gtk_main"},
+ {cfun_gtk_main_iteration, "gtk_main_iteration"},
+ {cfun_gtk_main_iteration_do, "gtk_main_iteration_do"},
+ {cfun_gtk_events_pending, "gtk_events_pending"},
+ {cfun_gtk_exit, "gtk_exit"},
+ {cfun_gtk_main_quit, "gtk_main_quit"},
+ {cfun_gtk_rc_parse, "gtk_rc_parse"},
+ {cfun_gtk_rc_parse_string, "gtk_rc_parse_string"},
+ {cfun_gtk_rc_reparse_all, "gtk_rc_reparse_all"},
+ {cfun_gtk_rc_reset_styles, "gtk_rc_reset_styles"},
+ {cfun_gtk_rc_add_default_file, "gtk_rc_add_default_file"},
+ {cfun_gtk_widget_set_name, "gtk_widget_set_name"},
+ {cfun_gtk_check_version, "gtk_check_version"},
+ {cfun_gtk_drag_source_set, "gtk_drag_source_set"},
+ {cfun_gtk_drag_dest_set, "gtk_drag_dest_set"},
+ {cfun_gtk_drag_finish, "gtk_drag_finish"},
+ {cfun_gtk_get_current_event_time, "gtk_get_current_event_time"},
+ {cfun_gtk_widget_get_size_request, "gtk_widget_get_size_request"},
+ {cfun_gtk_signal_emit_by_name, "gtk_signal_emit_by_name"},
+ {cfun_gtk_invisible_new, "gtk_invisible_new"},
+ {cfun_gdk_pixbuf_new_from_file, "gdk_pixbuf_new_from_file"},
+ {cfun_gdk_pixbuf_new_from_file_at_size, "gdk_pixbuf_new_from_file_at_size"},
+ {cfun_gdk_pixbuf_rotate_simple, "gdk_pixbuf_rotate_simple"},
+ {cfun_g_object_unref, "g_object_unref"},
+ {cfun_g_locale_to_utf8, "g_locale_to_utf8"},
+ {cfun_g_locale_from_utf8, "g_locale_from_utf8"},
+ {cfun_g_free, "g_free"},
+ {cfun_glade_init, "glade_init"},
+ {cfun_glade_xml_new, "glade_xml_new"},
+ {cfun_glade_xml_get_widget, "glade_xml_get_widget"},
+ {cfun_glade_xml_signal_autoconnect_full, "glade_xml_signal_autoconnect_full"},
+ {cfun_glade_get_widget_name, "glade_get_widget_name"},
+ {cfun_glade_get_widget_tree, "glade_get_widget_tree"},
+ {cfun_gtk_signal_connect_full, "gtk_signal_connect_full"},
+ {cfun_g_signal_connect, "g_signal_connect"},
diff --git a/src/mod/gtk.ffi.h b/src/mod/gtk.ffi.h
@@ -0,0 +1,343 @@
+any cfun_gtk_window_new(any ex);
+any cfun_gtk_window_set_title(any ex);
+any cfun_gtk_window_get_title(any ex);
+any cfun_gtk_window_set_default_size(any ex);
+any cfun_gtk_window_set_position(any ex);
+any cfun_gtk_window_set_resizable(any ex);
+any cfun_gtk_window_set_transient_for(any ex);
+any cfun_gtk_window_maximize(any ex);
+any cfun_gtk_message_dialog_new(any ex);
+any cfun_gtk_window_set_icon_from_file(any ex);
+any cfun_gtk_window_set_keep_above(any ex);
+any cfun_gtk_window_set_keep_below(any ex);
+any cfun_gtk_about_dialog_set_version(any ex);
+any cfun_gtk_table_new(any ex);
+any cfun_gtk_table_attach_defaults(any ex);
+any cfun_gtk_container_add(any ex);
+any cfun_gtk_container_remove(any ex);
+any cfun_gtk_container_set_border_width(any ex);
+any cfun_gtk_hbox_new(any ex);
+any cfun_gtk_vbox_new(any ex);
+any cfun_gtk_box_pack_start(any ex);
+any cfun_gtk_box_pack_end(any ex);
+any cfun_gtk_box_pack_start_defaults(any ex);
+any cfun_gtk_box_pack_end_defaults(any ex);
+any cfun_gtk_button_new(any ex);
+any cfun_gtk_button_new_with_label(any ex);
+any cfun_gtk_button_new_from_stock(any ex);
+any cfun_gtk_button_new_with_mnemonic(any ex);
+any cfun_gtk_button_set_use_stock(any ex);
+any cfun_gtk_button_set_label(any ex);
+any cfun_gtk_button_set_relief(any ex);
+any cfun_gtk_toggle_button_new(any ex);
+any cfun_gtk_toggle_button_new_with_label(any ex);
+any cfun_gtk_toggle_button_get_active(any ex);
+any cfun_gtk_toggle_button_set_active(any ex);
+any cfun_gtk_check_button_new_with_label(any ex);
+any cfun_gtk_entry_new(any ex);
+any cfun_gtk_entry_get_text(any ex);
+any cfun_gtk_entry_set_text(any ex);
+any cfun_gtk_entry_set_visibility(any ex);
+any cfun_gtk_editable_delete_text(any ex);
+any cfun_gtk_editable_get_chars(any ex);
+any cfun_gtk_editable_set_editable(any ex);
+any cfun_gtk_editable_select_region(any ex);
+any cfun_gtk_text_buffer_new(any ex);
+any cfun_gtk_text_buffer_set_text(any ex);
+any cfun_gtk_text_buffer_insert_at_cursor(any ex);
+any cfun_gtk_text_buffer_get_insert(any ex);
+any cfun_gtk_text_buffer_get_start_iter(any ex);
+any cfun_gtk_text_buffer_get_end_iter(any ex);
+any cfun_gtk_text_buffer_get_bounds(any ex);
+any cfun_gtk_text_buffer_get_selection_bounds(any ex);
+any cfun_gtk_text_buffer_get_iter_at_offset(any ex);
+any cfun_gtk_text_buffer_get_text(any ex);
+any cfun_gtk_text_buffer_insert(any ex);
+any cfun_gtk_text_buffer_create_tag(any ex);
+any cfun_gtk_text_buffer_insert_with_tags_by_name(any ex);
+any cfun_gtk_text_buffer_apply_tag_by_name(any ex);
+any cfun_gtk_text_buffer_remove_tag_by_name(any ex);
+any cfun_gtk_text_buffer_remove_all_tags(any ex);
+any cfun_gtk_text_buffer_get_tag_table(any ex);
+any cfun_gtk_text_buffer_select_range(any ex);
+any cfun_gtk_text_buffer_get_selection_bound(any ex);
+any cfun_gtk_text_buffer_get_line_count(any ex);
+any cfun_gtk_text_buffer_create_mark(any ex);
+any cfun_gtk_text_buffer_get_iter_at_mark(any ex);
+any cfun_gtk_text_buffer_get_iter_at_line(any ex);
+any cfun_gtk_text_buffer_delete(any ex);
+any cfun_gtk_text_buffer_delete_mark(any ex);
+any cfun_gtk_text_buffer_delete_mark_by_name(any ex);
+any cfun_gtk_text_buffer_place_cursor(any ex);
+any cfun_gtk_text_buffer_copy_clipboard(any ex);
+any cfun_gtk_text_buffer_cut_clipboard(any ex);
+any cfun_gtk_text_buffer_paste_clipboard(any ex);
+any cfun_gtk_scrolled_window_new(any ex);
+any cfun_gtk_scrolled_window_set_policy(any ex);
+any cfun_gtk_scrolled_window_set_shadow_type(any ex);
+any cfun_gtk_scrolled_window_add_with_viewport(any ex);
+any cfun_gtk_text_view_new_with_buffer(any ex);
+any cfun_gtk_text_view_set_wrap_mode(any ex);
+any cfun_gtk_text_view_set_editable(any ex);
+any cfun_gtk_text_view_set_border_window_size(any ex);
+any cfun_gtk_text_view_move_mark_onscreen(any ex);
+any cfun_gtk_text_view_scroll_to_mark(any ex);
+any cfun_gtk_text_view_scroll_mark_onscreen(any ex);
+any cfun_gtk_text_view_set_pixels_inside_wrap(any ex);
+any cfun_gtk_text_view_get_pixels_inside_wrap(any ex);
+any cfun_gtk_text_view_set_pixels_above_lines(any ex);
+any cfun_gtk_text_view_get_pixels_above_lines(any ex);
+any cfun_gtk_text_view_set_cursor_visible(any ex);
+any cfun_gtk_text_view_window_to_buffer_coords(any ex);
+any cfun_gtk_text_iter_forward_search(any ex);
+any cfun_gtk_text_iter_forward_visible_cursor_position(any ex);
+any cfun_gtk_text_iter_forward_to_line_end(any ex);
+any cfun_gtk_text_iter_set_line(any ex);
+any cfun_gtk_text_iter_set_line_offset(any ex);
+any cfun_gtk_text_iter_set_line_index(any ex);
+any cfun_gtk_text_iter_get_text(any ex);
+any cfun_gtk_text_iter_get_line(any ex);
+any cfun_gtk_text_view_new(any ex);
+any cfun_gtk_text_view_get_buffer(any ex);
+any cfun_gtk_text_tag_table_remove(any ex);
+any cfun_gdk_font_load(any ex);
+any cfun_gdk_pixmap_new(any ex);
+any cfun_gdk_pixmap_unref(any ex);
+any cfun_gdk_pixmap_create_from_xpm(any ex);
+any cfun_gdk_pixmap_colormap_create_from_xpm(any ex);
+any cfun_gdk_draw_rectangle(any ex);
+any cfun_gdk_draw_arc(any ex);
+any cfun_gdk_draw_line(any ex);
+any cfun_gdk_draw_point(any ex);
+any cfun_gdk_draw_layout(any ex);
+any cfun_gdk_draw_drawable(any ex);
+any cfun_gdk_gc_new(any ex);
+any cfun_gdk_gc_set_rgb_fg_color(any ex);
+any cfun_gdk_gc_set_rgb_bg_color(any ex);
+any cfun_gdk_gc_set_foreground(any ex);
+any cfun_gdk_gc_set_background(any ex);
+any cfun_gdk_gc_set_colormap(any ex);
+any cfun_gdk_color_alloc(any ex);
+any cfun_gdk_color_parse(any ex);
+any cfun_gdk_colormap_get_system(any ex);
+any cfun_gdk_colormap_alloc_color(any ex);
+any cfun_gdk_get_default_root_window(any ex);
+any cfun_gdk_rgb_find_color(any ex);
+any cfun_gdk_drawable_set_colormap(any ex);
+any cfun_gdk_drawable_get_size(any ex);
+any cfun_gdk_keymap_translate_keyboard_state(any ex);
+any cfun_gdk_window_process_all_updates(any ex);
+any cfun_gdk_window_get_geometry(any ex);
+any cfun_gdk_screen_get_default(any ex);
+any cfun_gdk_screen_get_width(any ex);
+any cfun_gdk_screen_get_height(any ex);
+any cfun_gdk_screen_width(any ex);
+any cfun_gdk_screen_height(any ex);
+any cfun_gdk_flush(any ex);
+any cfun_gdk_init(any ex);
+any cfun_gdk_display_get_default(any ex);
+any cfun_gdk_display_get_pointer(any ex);
+any cfun_gtk_image_new(any ex);
+any cfun_gtk_image_new_from_pixmap(any ex);
+any cfun_gtk_image_set_from_pixbuf(any ex);
+any cfun_gtk_image_set_from_pixmap(any ex);
+any cfun_gtk_image_set(any ex);
+any cfun_gtk_image_set_from_file(any ex);
+any cfun_gtk_image_new_from_file(any ex);
+any cfun_gtk_pixmap_new(any ex);
+any cfun_gtk_drawing_area_new(any ex);
+any cfun_gtk_widget_queue_draw(any ex);
+any cfun_gtk_widget_get_colormap(any ex);
+any cfun_gtk_widget_get_parent_window(any ex);
+any cfun_gtk_widget_create_pango_layout(any ex);
+any cfun_gtk_vscrollbar_new(any ex);
+any cfun_gtk_label_new(any ex);
+any cfun_gtk_label_set_text(any ex);
+any cfun_gtk_label_get_text(any ex);
+any cfun_gtk_label_set_line_wrap(any ex);
+any cfun_gtk_label_set_selectable(any ex);
+any cfun_gtk_label_set_use_markup(any ex);
+any cfun_gtk_label_set_justify(any ex);
+any cfun_gtk_label_get_width_chars(any ex);
+any cfun_gtk_label_get_max_width_chars(any ex);
+any cfun_gtk_label_set_markup_with_mnemonic(any ex);
+any cfun_gtk_frame_new(any ex);
+any cfun_gtk_frame_set_label_align(any ex);
+any cfun_gtk_frame_set_label(any ex);
+any cfun_gtk_frame_get_label(any ex);
+any cfun_gtk_aspect_frame_new(any ex);
+any cfun_gtk_aspect_frame_set(any ex);
+any cfun_gtk_radio_button_new(any ex);
+any cfun_gtk_radio_button_new_with_label(any ex);
+any cfun_gtk_radio_button_new_from_widget(any ex);
+any cfun_gtk_radio_button_new_with_label_from_widget(any ex);
+any cfun_gtk_notebook_new(any ex);
+any cfun_gtk_notebook_set_tab_pos(any ex);
+any cfun_gtk_notebook_popup_enable(any ex);
+any cfun_gtk_notebook_insert_page(any ex);
+any cfun_gtk_notebook_remove_page(any ex);
+any cfun_gtk_notebook_get_current_page(any ex);
+any cfun_gtk_notebook_set_page(any ex);
+any cfun_gtk_notebook_set_tab_label_text(any ex);
+any cfun_gtk_adjustment_new(any ex);
+any cfun_gtk_adjustment_get_value(any ex);
+any cfun_gtk_range_get_adjustment(any ex);
+any cfun_gtk_range_get_value(any ex);
+any cfun_gtk_range_set_value(any ex);
+any cfun_gtk_scale_set_draw_value(any ex);
+any cfun_gtk_scale_set_value_pos(any ex);
+any cfun_gtk_hscale_new(any ex);
+any cfun_gtk_hscale_new_with_range(any ex);
+any cfun_gtk_vscale_new_with_range(any ex);
+any cfun_gtk_spin_button_new(any ex);
+any cfun_gtk_spin_button_get_value_as_int(any ex);
+any cfun_gtk_spin_button_get_value(any ex);
+any cfun_gtk_spin_button_set_wrap(any ex);
+any cfun_gtk_spin_button_set_value(any ex);
+any cfun_gtk_arrow_new(any ex);
+any cfun_gtk_file_chooser_dialog_new(any ex);
+any cfun_gtk_file_chooser_widget_new(any ex);
+any cfun_gtk_dialog_run(any ex);
+any cfun_gtk_file_chooser_get_filename(any ex);
+any cfun_gtk_file_chooser_set_filename(any ex);
+any cfun_gtk_file_filter_new(any ex);
+any cfun_gtk_file_filter_add_pattern(any ex);
+any cfun_gtk_file_filter_set_name(any ex);
+any cfun_gtk_file_chooser_add_filter(any ex);
+any cfun_gtk_font_selection_dialog_new(any ex);
+any cfun_gtk_font_selection_dialog_get_font_name(any ex);
+any cfun_gtk_font_selection_new(any ex);
+any cfun_gtk_font_selection_get_font_name(any ex);
+any cfun_gtk_font_selection_set_font_name(any ex);
+any cfun_gtk_color_selection_new(any ex);
+any cfun_gtk_color_selection_set_has_opacity_control(any ex);
+any cfun_gtk_color_selection_set_current_color(any ex);
+any cfun_gtk_color_selection_get_current_color(any ex);
+any cfun_gtk_color_selection_set_color(any ex);
+any cfun_gtk_menu_bar_new(any ex);
+any cfun_gtk_menu_shell_append(any ex);
+any cfun_gtk_menu_item_new(any ex);
+any cfun_gtk_menu_item_new_with_label(any ex);
+any cfun_gtk_menu_item_new_with_mnemonic(any ex);
+any cfun_gtk_menu_new(any ex);
+any cfun_gtk_menu_item_set_right_justified(any ex);
+any cfun_gtk_menu_item_set_submenu(any ex);
+any cfun_gtk_check_menu_item_new_with_label(any ex);
+any cfun_gtk_check_menu_item_new_with_mnemonic(any ex);
+any cfun_gtk_check_menu_item_get_active(any ex);
+any cfun_gtk_check_menu_item_set_active(any ex);
+any cfun_gtk_menu_popup(any ex);
+any cfun_gtk_progress_bar_new(any ex);
+any cfun_gtk_progress_bar_set_text(any ex);
+any cfun_gtk_progress_bar_set_fraction(any ex);
+any cfun_gtk_progress_bar_pulse(any ex);
+any cfun_gtk_progress_bar_set_pulse_step(any ex);
+any cfun_gtk_statusbar_new(any ex);
+any cfun_gtk_statusbar_get_context_id(any ex);
+any cfun_gtk_statusbar_push(any ex);
+any cfun_gtk_statusbar_pop(any ex);
+any cfun_gtk_statusbar_remove(any ex);
+any cfun_gtk_statusbar_set_has_resize_grip(any ex);
+any cfun_gtk_event_box_new(any ex);
+any cfun_gtk_combo_box_new_text(any ex);
+any cfun_gtk_combo_box_append_text(any ex);
+any cfun_gtk_combo_box_insert_text(any ex);
+any cfun_gtk_combo_box_prepend_text(any ex);
+any cfun_gtk_combo_box_remove_text(any ex);
+any cfun_gtk_combo_box_get_active(any ex);
+any cfun_gtk_combo_box_set_active(any ex);
+any cfun_gtk_combo_box_get_active_text(any ex);
+any cfun_gtk_vseparator_new(any ex);
+any cfun_gtk_hseparator_new(any ex);
+any cfun_gtk_editable_copy_clipboard(any ex);
+any cfun_gtk_editable_cut_clipboard(any ex);
+any cfun_gtk_editable_paste_clipboard(any ex);
+any cfun_gdk_atom_intern(any ex);
+any cfun_gtk_clipboard_get(any ex);
+any cfun_gtk_clipboard_set_text(any ex);
+any cfun_gtk_clipboard_wait_for_text(any ex);
+any cfun_gtk_clist_new(any ex);
+any cfun_gtk_clist_set_column_title(any ex);
+any cfun_gtk_clist_column_titles_show(any ex);
+any cfun_gtk_clist_append(any ex);
+any cfun_gtk_clist_set_text(any ex);
+any cfun_gtk_fixed_new(any ex);
+any cfun_gtk_fixed_put(any ex);
+any cfun_gtk_fixed_move(any ex);
+any cfun_gtk_list_store_new(any ex);
+any cfun_gtk_list_store_append(any ex);
+any cfun_gtk_list_store_set(any ex);
+any cfun_gtk_list_store_set_value(any ex);
+any cfun_gtk_list_store_clear(any ex);
+any cfun_gtk_list_store_remove(any ex);
+any cfun_gtk_cell_renderer_text_new(any ex);
+any cfun_gtk_tree_view_new_with_model(any ex);
+any cfun_gtk_tree_view_column_new(any ex);
+any cfun_gtk_tree_view_column_new_with_attributes(any ex);
+any cfun_gtk_tree_view_column_pack_start(any ex);
+any cfun_gtk_tree_view_append_column(any ex);
+any cfun_gtk_tree_view_set_headers_visible(any ex);
+any cfun_gtk_tree_view_set_headers_clickable(any ex);
+any cfun_gtk_tree_view_get_selection(any ex);
+any cfun_gtk_tree_view_column_set_resizable(any ex);
+any cfun_gtk_tree_view_column_set_clickable(any ex);
+any cfun_gtk_tree_selection_get_selected(any ex);
+any cfun_gtk_tree_selection_select_iter(any ex);
+any cfun_gtk_tree_selection_select_path(any ex);
+any cfun_gtk_tree_model_get(any ex);
+any cfun_gtk_tree_model_get_string_from_iter(any ex);
+any cfun_gtk_tree_path_new_from_string(any ex);
+any cfun_gtk_tree_path_free(any ex);
+any cfun_gtk_tree_sortable_set_sort_column_id(any ex);
+any cfun_gtk_init(any ex);
+any cfun_gtk_widget_show(any ex);
+any cfun_gtk_widget_show_all(any ex);
+any cfun_gtk_widget_realize(any ex);
+any cfun_gtk_widget_unrealize(any ex);
+any cfun_gtk_widget_hide(any ex);
+any cfun_gtk_widget_destroy(any ex);
+any cfun_gtk_widget_grab_focus(any ex);
+any cfun_gtk_widget_set_size_request(any ex);
+any cfun_gtk_widget_size_request(any ex);
+any cfun_gtk_widget_set_usize(any ex);
+any cfun_gtk_widget_modify_base(any ex);
+any cfun_gtk_widget_modify_bg(any ex);
+any cfun_gtk_widget_set_sensitive(any ex);
+any cfun_gtk_settings_get_default(any ex);
+any cfun_gtk_widget_get_parent(any ex);
+any cfun_gtk_misc_set_alignment(any ex);
+any cfun_gtk_main(any ex);
+any cfun_gtk_main_iteration(any ex);
+any cfun_gtk_main_iteration_do(any ex);
+any cfun_gtk_events_pending(any ex);
+any cfun_gtk_exit(any ex);
+any cfun_gtk_main_quit(any ex);
+any cfun_gtk_rc_parse(any ex);
+any cfun_gtk_rc_parse_string(any ex);
+any cfun_gtk_rc_reparse_all(any ex);
+any cfun_gtk_rc_reset_styles(any ex);
+any cfun_gtk_rc_add_default_file(any ex);
+any cfun_gtk_widget_set_name(any ex);
+any cfun_gtk_check_version(any ex);
+any cfun_gtk_drag_source_set(any ex);
+any cfun_gtk_drag_dest_set(any ex);
+any cfun_gtk_drag_finish(any ex);
+any cfun_gtk_get_current_event_time(any ex);
+any cfun_gtk_widget_get_size_request(any ex);
+any cfun_gtk_signal_emit_by_name(any ex);
+any cfun_gtk_invisible_new(any ex);
+any cfun_gdk_pixbuf_new_from_file(any ex);
+any cfun_gdk_pixbuf_new_from_file_at_size(any ex);
+any cfun_gdk_pixbuf_rotate_simple(any ex);
+any cfun_g_object_unref(any ex);
+any cfun_g_locale_to_utf8(any ex);
+any cfun_g_locale_from_utf8(any ex);
+any cfun_g_free(any ex);
+any cfun_glade_init(any ex);
+any cfun_glade_xml_new(any ex);
+any cfun_glade_xml_get_widget(any ex);
+any cfun_glade_xml_signal_autoconnect_full(any ex);
+any cfun_glade_get_widget_name(any ex);
+any cfun_glade_get_widget_tree(any ex);
+any cfun_gtk_signal_connect_full(any ex);
+any cfun_g_signal_connect(any ex);
diff --git a/src/mod/junk/dl.ffi b/src/mod/junk/dl.ffi
@@ -0,0 +1,12 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module dl)
+
+(include "dlfcn.h")
+
+(cfun void* dlopen (cstr filename) (int flag))
+(cfun cstr dlerror)
+(cfun void* dlsym (void* handle) (cstr symbol))
+(cfun int dlclose (void* handle))
diff --git a/src/mod/junk/dl.ffi.c b/src/mod/junk/dl.ffi.c
@@ -0,0 +1,50 @@
+/* Generated from dl.ffi using ffi.l */
+
+#include "../pico.h"
+
+#include "dlfcn.h"
+
+any ffi_dlopen(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1 = xSym(y);
+ char b1[bufSize(y1)];
+ bufString(y1, b1);
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b2 = (int) unBox(y);
+ void* z = dlopen(b1, b2);
+ return box(z);
+}
+
+any ffi_dlerror(any ex __attribute__((unused))) {
+ char* z = dlerror();
+ return mkStr(z);
+}
+
+any ffi_dlsym(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ x = cdr(x);
+ y = EVAL(car(x));
+ any y1 = xSym(y);
+ char b2[bufSize(y1)];
+ bufString(y1, b2);
+ void* z = dlsym(b1, b2);
+ return box(z);
+}
+
+any ffi_dlclose(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ void* b1 = (void*) unBox(y);
+ int z = dlclose(b1);
+ return box(z);
+}
diff --git a/src/mod/junk/dl.ffi.fn b/src/mod/junk/dl.ffi.fn
@@ -0,0 +1,4 @@
+ {ffi_dlopen, "dlopen"},
+ {ffi_dlerror, "dlerror"},
+ {ffi_dlsym, "dlsym"},
+ {ffi_dlclose, "dlclose"},
diff --git a/src/mod/junk/dl.ffi.h b/src/mod/junk/dl.ffi.h
@@ -0,0 +1,4 @@
+any ffi_dlopen(any ex);
+any ffi_dlerror(any ex);
+any ffi_dlsym(any ex);
+any ffi_dlclose(any ex);
diff --git a/src/mod/junk/dl.l b/src/mod/junk/dl.l
@@ -0,0 +1,10 @@
+(def 'RTLD_LOCAL (hex "0000"))
+(def 'RTLD_LAZY (hex "0001"))
+(def 'RTLD_NOW (hex "0002"))
+(def 'RTLD_NOLOAD (hex "0004"))
+(def 'RTLD_DEEPBIND (hex "0008"))
+(def 'RTLD_GLOBAL (hex "0100"))
+(def 'RTLD_NODELETE (hex "1000"))
+
+# RTLD_DEFAULT 0
+# RTLD_NEXT -1
diff --git a/src/mod/queens.c b/src/mod/queens.c
@@ -0,0 +1,48 @@
+/* From CLisp */
+
+/* Compute the number of solutions to the n-queens problem on a nxn
+ checkboard. */
+
+/* dynamic data structures are not needed for such a simple problem */
+#define nmax 100
+
+int queens (int n) /* function definition in ISO/ANSI C style */
+{ /* Compute the solutions of the n-queens problem. Assume n>0, n<=nmax.
+ We look for a function D:{1,...,n} -> {1,...,n} such that
+ D, D+id, D-id are injective. We use backtracking on D(1),...,D(n).
+ We use three arrays which contain information about which values
+ are still available for D(i) resp. D(i)+i resp. D(i)-i. */
+ int dtab[nmax]; /* values D(1),...D(n) */
+ int freetab1[nmax+1]; /* contains 0 if available for D(i) in {1,...,n} */
+ int freetab2[2*nmax+1]; /* contains 0 if available for D(i)+i in {2,...,2n} */
+ int freetab3a[2*nmax-1]; /* contains 0 if available for D(i)-i in {-(n-1),...,n-1} */
+#define freetab3 (&freetab3a[nmax-1])
+ /* clear tables */
+ { int i; for (i=1; i<=n; i++) { freetab1[i] = 0; } }
+ { int i; for (i=2; i<=2*n; i++) { freetab2[i] = 0; } }
+ { int i; for (i=-(n-1); i<n; i++) { freetab3[i] = 0; } }
+ {int counter = 0;
+ int i = 0; /* recursion depth */
+ int* Dptr = &dtab[0]; /* points to next free D(i) */
+ entry: /* enter recursion */
+ i++;
+ if (i > n) {
+ counter++;
+ } else {
+ int j;
+ for (j = 1; j <= n; j++) {
+ if (freetab1[j]==0 && freetab2[j+i]==0 && freetab3[j-i]==0) {
+ freetab1[j]=1; freetab2[j+i]=1; freetab3[j-i]=1;
+ *Dptr++ = j;
+ goto entry;
+ comeback:
+ j = *--Dptr;
+ freetab1[j]=0; freetab2[j+i]=0; freetab3[j-i]=0;
+ }
+ }
+ }
+ i--;
+ if (i>0) goto comeback;
+ return counter;
+}}
+
diff --git a/src/mod/queens.ffi b/src/mod/queens.ffi
@@ -0,0 +1,9 @@
+# -*- picolisp -*-
+
+(load "@src/mod/ffi.l")
+
+(module 'queens)
+
+(include "queens.h")
+
+(cfun int queens int)
diff --git a/src/mod/queens.ffi.c b/src/mod/queens.ffi.c
@@ -0,0 +1,15 @@
+/* Generated from queens.ffi */
+
+#include "../pico.h"
+
+#include "queens.h"
+
+any cfun_queens(any ex) {
+ any x = ex, y;
+ x = cdr(x);
+ y = EVAL(car(x));
+ NeedNum(ex, y);
+ int b1 = (int) unBox(y);
+ int z = queens(b1);
+ return box(z);
+}
diff --git a/src/mod/queens.ffi.fn b/src/mod/queens.ffi.fn
@@ -0,0 +1 @@
+ {cfun_queens, "queens"},
diff --git a/src/mod/queens.ffi.h b/src/mod/queens.ffi.h
@@ -0,0 +1 @@
+any cfun_queens(any ex);
diff --git a/src/mod/queens.h b/src/mod/queens.h
@@ -0,0 +1 @@
+int queens (int n);
diff --git a/src/mod/todo/ext.c b/src/mod/todo/ext.c
@@ -0,0 +1,193 @@
+/* 02dec06abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "../pico.h"
+
+/*** Soundex Algorithm ***/
+static int SnxTab[] = {
+ '0', '1', '2', '3', '4', '5', '6', '7', // 48
+ '8', '9', 0, 0, 0, 0, 0, 0,
+ 0, 0, 'F', 'S', 'T', 0, 'F', 'S', // 64
+ 0, 0, 'S', 'S', 'L', 'N', 'N', 0,
+ 'F', 'S', 'R', 'S', 'T', 0, 'F', 'F',
+ 'S', 0, 'S', 0, 0, 0, 0, 0,
+ 0, 0, 'F', 'S', 'T', 0, 'F', 'S', // 96
+ 0, 0, 'S', 'S', 'L', 'N', 'N', 0,
+ 'F', 'S', 'R', 'S', 'T', 0, 'F', 'F',
+ 'S', 0, 'S', 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, // 128
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, // 160
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 'S', // 192
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 'T', 'N', 0, 0, 0, 0, 0, 'S',
+ 0, 0, 0, 0, 0, 0, 0, 'S',
+ 0, 0, 0, 0, 0, 0, 0, 'S', // 224
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 'N'
+ // ...
+};
+
+#define SNXBASE 48
+#define SNXSIZE ((int)(sizeof(SnxTab) / sizeof(int)))
+
+
+// (ext:Snx 'any ['cnt]) -> sym
+any Snx(any ex) {
+ int n, c, i, last;
+ any x, nm;
+ cell c1, c2;
+
+ x = cdr(ex);
+ if (!isSym(x = EVAL(car(x))) || !(c = symChar(name(x))))
+ return Nil;
+ while (c < SNXBASE)
+ if (!(c = symChar(NULL)))
+ return Nil;
+ Push(c1, x);
+ n = isCell(x = cddr(ex))? evCnt(ex,x) : 24;
+ if (c >= 'a' && c <= 'z' || c == 128 || c >= 224 && c < 255)
+ c &= ~0x20;
+ Push(c2, boxChar(last = c, &i, &nm));
+ while (c = symChar(NULL))
+ if (c > ' ') {
+ if ((c -= SNXBASE) < 0 || c >= SNXSIZE || !(c = SnxTab[c]))
+ last = 0;
+ else if (c != last) {
+ if (!--n)
+ break;
+ charSym(last = c, &i, &nm);
+ }
+ }
+ drop(c1);
+ return consStr(data(c2));
+}
+
+
+/*** Math ***/
+// (ext:Sin 'angle 'scale) -> num
+any Sin(any ex) {
+ any x;
+ double a, n;
+
+ a = evDouble(ex, x = cdr(ex));
+ n = evDouble(ex, cdr(x));
+ return doubleToNum(n * sin(a / n));
+}
+
+// (ext:Cos 'angle 'scale) -> num
+any Cos(any ex) {
+ any x;
+ double a, n;
+
+ a = evDouble(ex, x = cdr(ex));
+ n = evDouble(ex, cdr(x));
+ return doubleToNum(n * cos(a / n));
+}
+
+// (ext:Tan 'angle 'scale) -> num
+any Tan(any ex) {
+ any x;
+ double a, n;
+
+ a = evDouble(ex, x = cdr(ex));
+ n = evDouble(ex, cdr(x));
+ return doubleToNum(n * tan(a / n));
+}
+
+// (ext:Atan 'x 'y 'scale) -> num
+any Atan(any ex) {
+ double x, y, n;
+
+ x = evDouble(ex, cdr(ex));
+ y = evDouble(ex, cddr(ex));
+ n = evDouble(ex, cdddr(ex));
+ return doubleToNum(n * atan2(x / n, y / n));
+}
+
+// (ext:Dist 'h 'v ['h1 'h2 ['h2 'v2]]) -> num
+any Dist(any ex) {
+ any x;
+ double h, v, h1, v1, h2, v2, a, ca, sa;
+
+ h = evDouble(ex, x = cdr(ex));
+ v = evDouble(ex, x = cdr(x));
+ if (!isCell(x = cdr(x)))
+ return doubleToNum(sqrt(h*h + v*v));
+ h1 = evDouble(ex, x);
+ v1 = evDouble(ex, x = cdr(x));
+ if (!isCell(x = cdr(x))) {
+ h -= h1, v -= v1;
+ return doubleToNum(sqrt(h*h + v*v));
+ }
+ h2 = evDouble(ex, x);
+ v2 = evDouble(ex, cdr(x));
+ h -= h2, h1 -= h2;
+ v -= v2, v1 -= v2;
+ a = atan2(h1,v1), ca = cos(a), sa = sin(a);
+ a = h * ca - v * sa, v = v * ca + h * sa, h = a;
+ v1 = v1 * ca + h1 * sa;
+ if (v >= 0.0 && v <= v1)
+ return doubleToNum(fabs(h));
+ if (v > 0.0)
+ v -= v1;
+ return doubleToNum(sqrt(h*h + v*v));
+}
+
+
+/*** U-Law Encoding ***/
+#define BIAS 132
+#define CLIP (32767-BIAS)
+
+// (ext:Ulaw 'cnt) -> cnt # SEEEMMMM
+any Ulaw(any ex) {
+ int val, sign, tmp, exp;
+
+ val = (int)evCnt(ex,cdr(ex));
+ sign = 0;
+ if (val < 0)
+ val = -val, sign = 0x80;
+ if (val > CLIP)
+ val = CLIP;
+ tmp = (val += BIAS) << 1;
+ for (exp = 7; exp > 0 && !(tmp & 0x8000); --exp, tmp <<= 1);
+ return boxCnt(~(sign | exp<<4 | val >> exp+3 & 0x000F) & 0xFF);
+}
+
+
+/*** Base64 Encoding ***/
+static unsigned char Chr64[] =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+// (ext:Base64 'num1|NIL ['num2|NIL ['num3|NIL]]) -> flg
+any Base64(any x) {
+ int c, d;
+ any y;
+
+ x = cdr(x);
+ if (isNil(y = EVAL(car(x))))
+ return Nil;
+ c = unDig(y) / 2;
+ Env.put(Chr64[c >> 2]);
+ x = cdr(x);
+ if (isNil(y = EVAL(car(x)))) {
+ Env.put(Chr64[(c & 3) << 4]), Env.put('='), Env.put('=');
+ return Nil;
+ }
+ d = unDig(y) / 2;
+ Env.put(Chr64[(c & 3) << 4 | d >> 4]);
+ x = cdr(x);
+ if (isNil(y = EVAL(car(x)))) {
+ Env.put(Chr64[(d & 15) << 2]), Env.put('=');
+ return Nil;
+ }
+ c = unDig(y) / 2;
+ Env.put(Chr64[(d & 15) << 2 | c >> 6]), Env.put(Chr64[c & 63]);
+ return T;
+}
diff --git a/src/mod/todo/ext.fn b/src/mod/todo/ext.fn
@@ -0,0 +1,8 @@
+ {Snx, "ext:Snx"},
+ {Sin, "ext:Sin"},
+ {Cos, "ext:Cos"},
+ {Tan, "ext:Tan"},
+ {Atan, "ext:Atan"},
+ {Dist, "ext:Dist"},
+ {Ulaw, "ext:Ulaw"},
+ {Base64, "ext:Base64"},
diff --git a/src/mod/todo/ext.h b/src/mod/todo/ext.h
@@ -0,0 +1,8 @@
+any Snx(any ex);
+any Sin(any ex);
+any Cos(any ex);
+any Tan(any ex);
+any Atan(any ex);
+any Dist(any ex);
+any Ulaw(any ex);
+any Base64(any x);
diff --git a/src/mod/todo/ht.c b/src/mod/todo/ht.c
@@ -0,0 +1,288 @@
+/* 20sep07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static char *HtOK[] = {
+ "<b>", "</b>",
+ "<i>", "</i>",
+ "<u>", "</u>",
+ "<p>", "</p>",
+ "<pre>", "</pre>",
+ "<div ", "</div>",
+ "<font ", "</font>",
+ "<img ", "</img>",
+ "<br>", "<hr>", NULL
+};
+
+static bool findHtOK(char *s) {
+ char **p, *q, *t;
+
+ for (p = HtOK; *p; ++p)
+ for (q = *p, t = s;;) {
+ if (*q != *t)
+ break;
+ if (*++q == '\0')
+ return YES;
+ if (*++t == '\0')
+ break;
+ }
+ return NO;
+}
+
+// (ht:Prin 'sym ..) -> T
+any Prin(any x) {
+ any y;
+
+ while (isCell(x = cdr(x))) {
+ if (isNum(y = EVAL(car(x))) || isCell(y) || isExt(y))
+ prin(y);
+ else {
+ int c;
+ char *p, *q, nm[bufSize(y)];
+
+ bufString(y, nm);
+ for (p = nm; *p;) {
+ if (findHtOK(p) && (q = strchr(p,'>')))
+ do
+ Env.put(*p++);
+ while (p <= q);
+ else {
+ switch (*(byte*)p) {
+ case '<':
+ outString("<");
+ break;
+ case '>':
+ outString(">");
+ break;
+ case '&':
+ outString("&");
+ break;
+ case '"':
+ outString(""");
+ break;
+ case 0xFF:
+ Env.put(0xEF);
+ Env.put(0xBF);
+ Env.put(0xBF);
+ break;
+ default:
+ Env.put(c = *p);
+ if ((c & 0x80) != 0) {
+ Env.put(*++p);
+ if ((c & 0x20) != 0)
+ Env.put(*++p);
+ }
+ }
+ ++p;
+ }
+ }
+ }
+ }
+ return T;
+}
+
+static void putHex(int c) {
+ int n;
+
+ if ((n = c >> 4 & 0xF) > 9)
+ n += 7;
+ Env.put(n + '0');
+ if ((n = c & 0xF) > 9)
+ n += 7;
+ Env.put(n + '0');
+}
+
+static int getHex(any *p) {
+ int n, m;
+
+ n = firstByte(car(*p)), *p = cdr(*p);
+ if ((n -= '0') > 9)
+ n -= 7;
+ m = firstByte(car(*p)), *p = cdr(*p);
+ if ((m -= '0') > 9)
+ m -= 7;
+ return n << 4 | m;
+}
+
+static void htEncode(char *p) {
+ int c;
+
+ while (c = *p++) {
+ if (strchr(" \"#%&:;<=>?_", c))
+ Env.put('%'), putHex(c);
+ else {
+ Env.put(c);
+ if ((c & 0x80) != 0) {
+ Env.put(*p++);
+ if ((c & 0x20) != 0)
+ Env.put(*p++);
+ }
+ }
+ }
+}
+
+static void htFmt(any x) {
+ any y;
+
+ if (isNum(x))
+ Env.put('+'), prin(x);
+ else if (isCell(x))
+ do
+ Env.put('_'), htFmt(car(x));
+ while (isCell(x = cdr(x)));
+ else if (isNum(y = name(x))) {
+ char nm[bufSize(x)];
+
+ bufString(x, nm);
+ if (isExt(x))
+ Env.put('-'), htEncode(nm);
+ else if (hashed(x, hash(y), Intern))
+ Env.put('$'), htEncode(nm);
+ else if (strchr("$+.", *nm)) {
+ Env.put('%'), putHex(*nm);
+ htEncode(nm+1);
+ }
+ else
+ htEncode(nm);
+ }
+}
+
+// (ht:Fmt 'any ..) -> sym
+any Fmt(any x) {
+ int n, i;
+ cell c[length(x = cdr(x))];
+
+ for (n = 0; isCell(x); ++n, x = cdr(x))
+ Push(c[n], EVAL(car(x)));
+ begString();
+ for (i = 0; i < n;) {
+ htFmt(data(c[i]));
+ if (++i != n)
+ Env.put('&');
+ }
+ x = endString();
+ if (n)
+ drop(c[0]);
+ return x;
+}
+
+// (ht:Pack 'lst) -> sym
+any Pack(any x) {
+ int c;
+ cell c1;
+
+ x = EVAL(cadr(x));
+ begString();
+ Push(c1,x);
+ while (isCell(x)) {
+ if ((c = symChar(name(car(x)))) == '%')
+ x = cdr(x), Env.put(getHex(&x));
+ else
+ outName(car(x)), x = cdr(x);
+ }
+ return endString();
+}
+
+/*** Chunked Encoding ***/
+#define CHUNK 4000
+static int Cnt;
+static void (*Get)(void);
+static void (*Put)(int);
+static char Chunk[CHUNK];
+
+static int chrHex(void) {
+ if (Chr >= '0' && Chr <= '9')
+ return Chr - 48;
+ else if (Chr >= 'A' && Chr <= 'F')
+ return Chr - 55;
+ else if (Chr >= 'a' && Chr <= 'f')
+ return Chr - 87;
+ else
+ return -1;
+}
+
+static void chunkSize(void) {
+ int n;
+
+ if (!Chr)
+ Get();
+ if ((Cnt = chrHex()) >= 0) {
+ while (Get(), (n = chrHex()) >= 0)
+ Cnt = Cnt << 4 | n;
+ while (Chr != '\n') {
+ if (Chr < 0)
+ return;
+ Get();
+ }
+ Get();
+ if (Cnt == 0) {
+ Get(); // Skip '\r' of empty line
+ Chr = 0; // Discard '\n'
+ }
+ }
+}
+
+static void getChunked(void) {
+ if (Cnt <= 0)
+ Chr = -1;
+ else {
+ Get();
+ if (--Cnt == 0) {
+ Get(), Get(); // Skip '\n', '\r'
+ chunkSize();
+ }
+ }
+}
+
+// (ht:In 'flg . prg) -> any
+any In(any x) {
+ x = cdr(x);
+ if (isNil(EVAL(car(x))))
+ return prog(cdr(x));
+ Get = Env.get, Env.get = getChunked;
+ chunkSize();
+ x = prog(cdr(x));
+ Env.get = Get;
+ Chr = 0;
+ return x;
+}
+
+static void wrChunk(void) {
+ int i;
+ char buf[16];
+
+ sprintf(buf, "%x\r\n", Cnt);
+ i = 0;
+ do
+ Put(buf[i]);
+ while (buf[++i]);
+ for (i = 0; i < Cnt; ++i)
+ Put(Chunk[i]);
+ Put('\r'), Put('\n');
+}
+
+static void putChunked(int c) {
+ Chunk[Cnt++] = c;
+ if (Cnt == CHUNK)
+ wrChunk(), Cnt = 0;
+}
+
+// (ht:Out 'flg . prg) -> any
+any Out(any x) {
+ x = cdr(x);
+ if (isNil(EVAL(car(x))))
+ x = prog(cdr(x));
+ else {
+ Cnt = 0;
+ Put = Env.put, Env.put = putChunked;
+ x = prog(cdr(x));
+ if (Cnt)
+ wrChunk();
+ Env.put = Put;
+ outString("0\r\n\r\n");
+ }
+ flush(OutFile);
+ return x;
+}
diff --git a/src/mod/todo/net.c b/src/mod/todo/net.c
@@ -0,0 +1,226 @@
+/* 20nov07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#include <netdb.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+
+static void ipErr(any ex, char *s) {
+ err(ex, NULL, "IP %s error: %s", s, strerror(errno));
+}
+
+static int ipSocket(any ex, int type) {
+ int sd;
+
+ if ((sd = socket(AF_INET, type, 0)) < 0)
+ ipErr(ex, "socket");
+ return sd;
+}
+
+static any tcpAccept(any ex, int sd) {
+ int i, sd2;
+ struct sockaddr_in addr;
+ struct timespec tv = {0,100000000}; // 100 ms
+
+ blocking(NO, ex, sd);
+ i = 200; do {
+ socklen_t len = sizeof(addr);
+ if ((sd2 = accept(sd, (struct sockaddr*)&addr, &len)) >= 0) {
+ blocking(YES, ex, sd2);
+ val(Adr) = mkStr(inet_ntoa(addr.sin_addr));
+ initInFile(sd2,NULL), initOutFile(sd2);
+ return boxCnt(sd2);
+ }
+ nanosleep(&tv,NULL);
+ } while (errno == EAGAIN && --i >= 0);
+ blocking(YES, ex, sd);
+ return NULL;
+}
+
+// (port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt
+any doPort(any ex) {
+ any x, y;
+ int type, n, sd;
+ unsigned short port;
+ cell c1;
+ struct sockaddr_in addr;
+
+ memset(&addr, 0, sizeof(addr));
+ addr.sin_family = AF_INET;
+ addr.sin_addr.s_addr = htonl(INADDR_ANY);
+ x = cdr(ex);
+ type = SOCK_STREAM;
+ if ((y = EVAL(car(x))) == T)
+ type = SOCK_DGRAM, x = cdr(x), y = EVAL(car(x));
+ sd = ipSocket(ex, type);
+ if (isNum(y)) {
+ if ((port = (unsigned short)xCnt(ex,y)) != 0) {
+ n = 1;
+ if (setsockopt(sd, SOL_SOCKET, SO_REUSEADDR, &n, sizeof(n)) < 0)
+ ipErr(ex, "setsockopt");
+ }
+ }
+ else if (isCell(y))
+ port = (unsigned short)xCnt(ex,car(y));
+ else
+ argError(ex,y);
+ for (;;) {
+ addr.sin_port = htons(port);
+ if (bind(sd, (struct sockaddr*)&addr, sizeof(addr)) >= 0)
+ break;
+ if (!isCell(y) || ++port > xCnt(ex,cdr(y)))
+ close(sd), ipErr(ex, "bind");
+ }
+ if (type == SOCK_STREAM && listen(sd,5) < 0)
+ close(sd), ipErr(ex, "listen");
+ if (!isNil(data(c1) = EVAL(cadr(x)))) {
+ socklen_t len = sizeof(addr);
+ if (getsockname(sd, (struct sockaddr*)&addr, &len) < 0)
+ close(sd), ipErr(ex, "getsockname");
+ Save(c1);
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ if (isSym(data(c1)))
+ Touch(ex,data(c1));
+ val(data(c1)) = boxCnt(ntohs(addr.sin_port));
+ drop(c1);
+ }
+ return boxCnt(sd);
+}
+
+// (listen 'cnt1 ['cnt2]) -> cnt | NIL
+any doListen(any ex) {
+ any x;
+ int sd;
+ long ms;
+
+ sd = (int)evCnt(ex, x = cdr(ex));
+ x = cdr(x);
+ ms = isNil(x = EVAL(car(x)))? -1 : xCnt(ex,x);
+ for (;;) {
+ if (!waitFd(ex, sd, ms))
+ return Nil;
+ if (x = tcpAccept(ex,sd))
+ return x;
+ }
+}
+
+// (accept 'cnt) -> cnt | NIL
+any doAccept(any ex) {
+ return tcpAccept(ex, (int)evCnt(ex, cdr(ex))) ?: Nil;
+}
+
+// (host 'any) -> sym
+any doHost(any x) {
+ struct in_addr in;
+ struct hostent *p;
+
+ x = evSym(cdr(x));
+ {
+ char nm[bufSize(x)];
+
+ bufString(x, nm);
+ if (inet_aton(nm, &in) && (p = gethostbyaddr((char*)&in, sizeof(in), AF_INET)))
+ return mkStr(p->h_name);
+ return Nil;
+ }
+}
+
+static bool server(any host, unsigned short port, struct sockaddr_in *addr) {
+ struct hostent *p;
+ char nm[bufSize(host)];
+
+ bufString(host, nm);
+ memset(addr, 0, sizeof(struct sockaddr_in));
+ if (!inet_aton(nm, &addr->sin_addr)) {
+ if (!(p = gethostbyname(nm)) || p->h_length == 0)
+ return NO;
+ addr->sin_addr.s_addr = ((struct in_addr*)p->h_addr_list[0])->s_addr;
+ }
+ addr->sin_port = htons(port);
+ addr->sin_family = AF_INET;
+ return YES;
+}
+
+// (connect 'any 'cnt) -> cnt | NIL
+any doConnect(any ex) {
+ int sd, port;
+ cell c1;
+ struct sockaddr_in addr;
+
+ Push(c1, evSym(cdr(ex)));
+ port = evCnt(ex, cddr(ex));
+ if (!server(Pop(c1), (unsigned short)port, &addr))
+ return Nil;
+ sd = ipSocket(ex, SOCK_STREAM);
+ if (connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0) {
+ close(sd);
+ return Nil;
+ }
+ initInFile(sd,NULL), initOutFile(sd);
+ return boxCnt(sd);
+}
+
+// (nagle 'cnt 'flg) -> cnt
+any doNagle(any ex) {
+ any x, y;
+ int sd, opt;
+
+ x = cdr(ex), y = EVAL(car(x));
+ sd = (int)xCnt(ex,y);
+ x = cdr(x), opt = isNil(EVAL(car(x)))? 1 : 0;
+ if (setsockopt(sd, IPPROTO_TCP, TCP_NODELAY, (char*)&opt, sizeof(int)) < 0)
+ ipErr(ex, "setsockopt");
+ return y;
+}
+
+/*** UDP send/receive ***/
+#define UDPMAX 4096
+static byte *UdpBuf, *UdpPtr;
+
+static void putUdp(int c) {
+ *UdpPtr++ = c;
+ if (UdpPtr == UdpBuf + UDPMAX)
+ err(NULL, NULL, "UDP overflow");
+}
+
+static int getUdp(void) {
+ if (UdpPtr == UdpBuf + UDPMAX)
+ return -1;
+ return *UdpPtr++;
+}
+
+// (udp 'any1 'cnt 'any2) -> any
+// (udp 'cnt) -> any
+any doUdp(any ex) {
+ any x;
+ int sd;
+ cell c1;
+ struct sockaddr_in addr;
+ byte buf[UDPMAX];
+
+ x = cdr(ex), data(c1) = EVAL(car(x));
+ if (!isCell(x = cdr(x))) {
+ if (recv((int)xCnt(ex, data(c1)), buf, UDPMAX, 0) < 0)
+ return Nil;
+ getBin = getUdp, UdpPtr = UdpBuf = buf;
+ return binRead() ?: Nil;
+ }
+ Save(c1);
+ if (!server(xSym(data(c1)), (unsigned short)evCnt(ex,x), &addr))
+ x = Nil;
+ else {
+ x = cdr(x), x = EVAL(car(x));
+ sd = ipSocket(ex, SOCK_DGRAM);
+ putBin = putUdp, UdpPtr = UdpBuf = buf, binPrint(x);
+ sendto(sd, buf, UdpPtr-buf, 0, (struct sockaddr*)&addr, sizeof(struct sockaddr_in));
+ close(sd);
+ }
+ drop(c1);
+ return x;
+}
diff --git a/src/mod/todo/z3d.c b/src/mod/todo/z3d.c
@@ -0,0 +1,468 @@
+/* 18aug04abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#define SCL 1000000.0
+
+typedef struct {double x, y, z;} vector;
+typedef struct {vector a, b, c;} matrix;
+
+static bool Snap;
+static int SnapD, Snap1h, Snap1v, Snap2h, Snap2v;
+static double FocLen, PosX, PosY, PosZ, Pos6, Pos9, SnapX, SnapY, SnapZ;
+static double Coeff1, Coeff2, Coeff4, Coeff5, Coeff6, Coeff7, Coeff8, Coeff9;
+
+
+static any getVector(any lst, vector *dst) {
+ dst->x = numToDouble(car(lst)) / SCL, lst = cdr(lst);
+ dst->y = numToDouble(car(lst)) / SCL, lst = cdr(lst);
+ dst->z = numToDouble(car(lst)) / SCL;
+ return cdr(lst);
+}
+
+static any putVector(vector *src, any lst) {
+ car(lst) = doubleToNum(src->x * SCL), lst = cdr(lst);
+ car(lst) = doubleToNum(src->y * SCL), lst = cdr(lst);
+ car(lst) = doubleToNum(src->z * SCL);
+ return cdr(lst);
+}
+
+static any getMatrix(any lst, matrix *dst) {
+ return getVector(getVector(getVector(lst, &dst->a), &dst->b), &dst->c);
+}
+
+static any putMatrix(matrix *src, any lst) {
+ return putVector(&src->c, putVector(&src->b, putVector(&src->a, lst)));
+}
+
+static void xrot(matrix *p, double ca, double sa) {
+ matrix m = *p;
+
+ p->b.x = ca * m.b.x - sa * m.c.x;
+ p->b.y = ca * m.b.y - sa * m.c.y;
+ p->b.z = ca * m.b.z - sa * m.c.z;
+ p->c.x = sa * m.b.x + ca * m.c.x;
+ p->c.y = sa * m.b.y + ca * m.c.y;
+ p->c.z = sa * m.b.z + ca * m.c.z;
+}
+
+// (z3d:Xrot 'angle 'model) -> T
+any Xrot(any ex) {
+ any x;
+ double a;
+ matrix m;
+
+ a = evDouble(ex, x = cdr(ex)) / SCL;
+ x = EVAL(cadr(x));
+ Touch(ex,x);
+ x = cdddr(val(x));
+ getMatrix(x, &m), xrot(&m, cos(a), sin(a)), putMatrix(&m, x);
+ return T;
+}
+
+static void yrot(matrix *p, double ca, double sa) {
+ matrix m = *p;
+
+ p->a.x = ca * m.a.x + sa * m.c.x;
+ p->a.y = ca * m.a.y + sa * m.c.y;
+ p->a.z = ca * m.a.z + sa * m.c.z;
+ p->c.x = ca * m.c.x - sa * m.a.x;
+ p->c.y = ca * m.c.y - sa * m.a.y;
+ p->c.z = ca * m.c.z - sa * m.a.z;
+}
+
+// (z3d:Yrot 'angle 'model) -> T
+any Yrot(any ex) {
+ any x;
+ double a;
+ matrix m;
+
+ a = evDouble(ex, x = cdr(ex)) / SCL;
+ x = EVAL(cadr(x));
+ Touch(ex,x);
+ x = cdddr(val(x));
+ getMatrix(x, &m), yrot(&m, cos(a), sin(a)), putMatrix(&m, x);
+ return T;
+}
+
+static void zrot(matrix *p, double ca, double sa) {
+ matrix m = *p;
+
+ p->a.x = ca * m.a.x + sa * m.b.x;
+ p->a.y = ca * m.a.y + sa * m.b.y;
+ p->a.z = ca * m.a.z + sa * m.b.z;
+ p->b.x = ca * m.b.x - sa * m.a.x;
+ p->b.y = ca * m.b.y - sa * m.a.y;
+ p->b.z = ca * m.b.z - sa * m.a.z;
+}
+
+// (z3d:Zrot 'angle 'model) -> T
+any Zrot(any ex) {
+ any x;
+ double a;
+ matrix m;
+
+ a = evDouble(ex, x = cdr(ex)) / SCL;
+ x = EVAL(cadr(x));
+ Touch(ex,x);
+ x = cdddr(val(x));
+ getMatrix(x, &m), zrot(&m, cos(a), sin(a)), putMatrix(&m, x);
+ return T;
+}
+
+// (z3d:Arot 'angle 'model) -> T
+any Arot(any ex) {
+ any x;
+ double a, n;
+ matrix m;
+ vector pt;
+
+ a = evDouble(ex, x = cdr(ex)) / SCL;
+ x = EVAL(cadr(x));
+ Touch(ex,x);
+ x = cdddr(val(x));
+ getVector(cddar(getMatrix(x, &m)), &pt);
+ n = sqrt(pt.x*pt.x + pt.y*pt.y + pt.z*pt.z);
+ pt.x /= n, pt.y /= n, pt.z /= n; // Axis unit vector
+ if ((n = sqrt(pt.y*pt.y + pt.z*pt.z)) == 0.0) // Axis parallel to x-axis
+ a *= pt.x, xrot(&m, cos(a), sin(a));
+ else {
+ xrot(&m, pt.z/n, -pt.y/n);
+ yrot(&m, n, pt.x);
+ zrot(&m, cos(a), sin(a));
+ yrot(&m, n, -pt.x);
+ xrot(&m, pt.z/n, pt.y/n);
+ }
+ putMatrix(&m, x);
+ return T;
+}
+
+// (z3d:Rotate 'X 'Y 'Z 'model 'varX 'varY 'varZ ['flg]) -> T
+any Rotate(any ex) {
+ any x;
+ double vx, vy, vz;
+ matrix m;
+ cell c1, c2, c3;
+
+ vx = evDouble(ex, x = cdr(ex)) / SCL;
+ vy = evDouble(ex, x = cdr(x)) / SCL;
+ vz = evDouble(ex, x = cdr(x)) / SCL;
+ x = cdr(x), getMatrix(cdddr(val(EVAL(car(x)))), &m);
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ NeedVar(ex,data(c2));
+ x = cdr(x), Push(c3, EVAL(car(x)));
+ NeedVar(ex,data(c3));
+ if (isNil(EVAL(cadr(x)))) {
+ if (!isNil(data(c1)))
+ val(data(c1)) = doubleToNum((vx * m.a.x + vy * m.b.x + vz * m.c.x) * SCL);
+ if (!isNil(data(c2)))
+ val(data(c2)) = doubleToNum((vx * m.a.y + vy * m.b.y + vz * m.c.y) * SCL);
+ if (!isNil(data(c3)))
+ val(data(c3)) = doubleToNum((vx * m.a.z + vy * m.b.z + vz * m.c.z) * SCL);
+ }
+ else {
+ if (!isNil(data(c1)))
+ val(data(c1)) = doubleToNum((vx * m.a.x + vy * m.a.y + vz * m.a.z) * SCL);
+ if (!isNil(data(c2)))
+ val(data(c2)) = doubleToNum((vx * m.b.x + vy * m.b.y + vz * m.b.z) * SCL);
+ if (!isNil(data(c3)))
+ val(data(c3)) = doubleToNum((vx * m.c.x + vy * m.c.y + vz * m.c.z) * SCL);
+ }
+ drop(c1);
+ return T;
+}
+
+static void _approach(any ex, double d, any dst, any src) {
+ any l1, l2;
+ int i;
+ double n;
+
+ Touch(ex,dst);
+ l1 = val(dst);
+ Fetch(ex,src);
+ l2 = val(src);
+ for (i = 0; i < 12; ++i) {
+ n = numToDouble(car(l1)) / SCL;
+ car(l1) = doubleToNum((n + d * (numToDouble(car(l2)) / SCL - n)) * SCL);
+ l1 = cdr(l1), l2 = cdr(l2);
+ }
+ do {
+ while (!isSym(car(l1)))
+ if (!isCell(l1 = cdr(l1)))
+ return;
+ while (!isSym(car(l2)))
+ if (!isCell(l2 = cdr(l2)))
+ return;
+ _approach(ex, d, car(l1), car(l2));
+ } while (isCell(l1 = cdr(l1)) && isCell(l2 = cdr(l2)));
+}
+
+// (z3d:Approach 'num 'model 'model) -> T
+any Approach(any ex) {
+ any x;
+ long n;
+ cell c1, c2;
+
+ n = evCnt(ex, x = cdr(ex));
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ _approach(ex, 1.0 / (double)n, data(c1), data(c2));
+ drop(c1);
+ return T;
+}
+
+// (z3d:Spot 'dx 'dy 'dz ['x 'y 'z]) -> (yaw . pitch)
+any Spot(any ex) {
+ any x;
+ double dx, dy, dz;
+ cell c1;
+
+ dx = evDouble(ex, x = cdr(ex)) / SCL;
+ dy = evDouble(ex, x = cdr(x)) / SCL;
+ dz = evDouble(ex, x = cdr(x)) / SCL;
+
+ if (isCell(x = cdr(x))) {
+ dx -= evDouble(ex, x) / SCL;
+ dy -= evDouble(ex, x = cdr(x)) / SCL;
+ dz -= evDouble(ex, x = cdr(x)) / SCL;
+ }
+
+ Push(c1, doubleToNum(atan2(dy,dx) * SCL));
+ dx = sqrt(dx*dx + dy*dy + dz*dz);
+ data(c1) = cons(data(c1), doubleToNum(dx==0.0? 0.0 : asin(dz/dx)*SCL));
+ return Pop(c1);
+}
+
+static void rotate(vector *src, matrix *p, vector *dst) {
+ dst->x = src->x * p->a.x + src->y * p->b.x + src->z * p->c.x;
+ dst->y = src->x * p->a.y + src->y * p->b.y + src->z * p->c.y;
+ dst->z = src->x * p->a.z + src->y * p->b.z + src->z * p->c.z;
+}
+
+#if 0
+/* (lst -- x y z) */
+void Locate(void) {
+ any lst;
+ vector pos, v, w;
+ matrix rot, r;
+
+ lst = Tos;
+ getMatrix(getVector(car(lst), &pos), &rot);
+ while (isCell(lst = cdr(lst))) {
+ getMatrix(getVector(car(lst), &v), &r);
+ rotate(&v, &rot, &w);
+ pos.x += w.x, pos.y += w.y, pos.z += w.z;
+ v = r.a, rotate(&v, &rot, &r.a);
+ v = r.b, rotate(&v, &rot, &r.b);
+ v = r.c, rotate(&v, &rot, &r.c);
+ rot = r;
+ }
+ Tos = doubleToNum(pos.x) * SCL;
+ push(doubleToNum(pos.y)) * SCL;
+ push(doubleToNum(pos.z)) * SCL;
+}
+#endif
+
+static void shadowPt(double vx, double vy) {
+ double z;
+
+ z = Coeff7 * vx + Coeff8 * vy - Pos9;
+ prn((int)(FocLen * (Coeff1 * vx + Coeff2 * vy) / z));
+ prn((int)(FocLen * (Coeff4 * vx + Coeff5 * vy - Pos6) / z));
+ prn(num(1000.0 * z));
+}
+
+static void transPt(double vx, double vy, double vz) {
+ double x, y, z;
+ int h, v, dh, dv, d;
+
+ x = Coeff1 * vx + Coeff2 * vy;
+ y = Coeff4 * vx + Coeff5 * vy + Coeff6 * vz;
+ z = Coeff7 * vx + Coeff8 * vy + Coeff9 * vz;
+ prn(h = (int)(FocLen * x/z));
+ prn(v = (int)(FocLen * y/z));
+ prn(num(1000.0 * z));
+ if (Snap) {
+ if ((dh = h - Snap1h) < 0)
+ dh = -dh;
+ if ((dv = v - Snap1v) < 0)
+ dv = -dv;
+ if ((d = dh>dv? dh+dv*41/100-dh/24 : dv+dh*41/100-dv/24) < SnapD) {
+ SnapD = d;
+ Snap2h = h; Snap2v = v;
+ SnapX = vx; SnapY = vy; SnapZ = vz;
+ }
+ }
+}
+
+static void doDraw(any ex, any mdl, matrix *r, double x, double y, double z) {
+ any face, c1, c2, txt;
+ long n, pix;
+ double dx, dy, dz;
+ vector pos, pt1, pt2, pt3, v, w, nv;
+ matrix rot;
+
+ Fetch(ex,mdl);
+ mdl = getMatrix(getVector(val(mdl), &pos), &rot);
+ if (!r)
+ r = &rot;
+ else {
+ v = pos, rotate(&v, r, &pos);
+ pos.x += x, pos.y += y, pos.z += z;
+ v = rot.a, rotate(&v, r, &rot.a);
+ v = rot.b, rotate(&v, r, &rot.b);
+ v = rot.c, rotate(&v, r, &rot.c);
+ }
+ dx = pos.x - PosX;
+ dy = pos.y - PosY;
+ dz = pos.z - PosZ;
+
+ if ((z = Coeff7*dx + Coeff8*dy + Coeff9*dz) < 0.1)
+ return;
+ if (z < fabs(Coeff1*dx + Coeff2*dy))
+ return;
+ if (z < fabs(Coeff4*dx + Coeff5*dy + Coeff6*dz))
+ return;
+
+ while (isCell(mdl)) {
+ face = car(mdl), mdl = cdr(mdl);
+ if (isSym(face))
+ doDraw(ex, face, &rot, pos.x, pos.y, pos.z);
+ else {
+ c1 = car(face), face = cdr(face);
+ c2 = car(face), face = cdr(face);
+ if (!isSym(car(face)))
+ txt = Nil;
+ else
+ txt = car(face), face = cdr(face);
+ face = getVector(getVector(face, &v), &w);
+ if ((v.x || v.y || v.z) && (w.x || w.y || w.z))
+ r = &rot, rotate(&v, r, &pt1), rotate(&w, r, &pt2);
+ else
+ rotate(&v, r, &pt1), rotate(&w, r, &pt2), r = &rot;
+ face = getVector(face, &v), rotate(&v, r, &pt3);
+ if (c2 == T) {
+ n = length(face) / 3;
+ prn(n+2);
+ shadowPt(pt1.x + dx + pt1.z + pos.z, pt1.y + dy);
+ pr(txt);
+ shadowPt(pt2.x + dx + pt2.z + pos.z, pt2.y + dy);
+ shadowPt(pt3.x + dx + pt3.z + pos.z, pt3.y + dy);
+ while (--n >= 0) {
+ face = getVector(face, &v), rotate(&v, r, &pt1);
+ shadowPt(pt1.x + dx + pt1.z + pos.z, pt1.y + dy);
+ }
+ prn(0);
+ }
+ else {
+ v.x = pt1.x - pt2.x;
+ v.y = pt1.y - pt2.y;
+ v.z = pt1.z - pt2.z;
+ w.x = pt3.x - pt2.x;
+ w.y = pt3.y - pt2.y;
+ w.z = pt3.z - pt2.z;
+ nv.x = v.y * w.z - v.z * w.y;
+ nv.y = v.z * w.x - v.x * w.z;
+ nv.z = v.x * w.y - v.y * w.x;
+ pt1.x += dx, pt1.y += dy, pt1.z += dz;
+ if (isNil(c1) && isNil(c2))
+ pix = -1; // Transparent
+ else {
+ if (pt1.x * nv.x + pt1.y * nv.y + pt1.z * nv.z >= 0.0) {
+ if (isNil(c1))
+ continue; // Backface culling
+ pix = unDig(c1) / 2;
+ n = 80 - num(14.14 * (nv.z-nv.x) / sqrt(nv.x*nv.x + nv.y*nv.y + nv.z*nv.z));
+ }
+ else {
+ if (isNil(c2))
+ continue; // Backface culling
+ pix = unDig(c2) / 2;
+ n = 80 + num(14.14 * (nv.z-nv.x) / sqrt(nv.x*nv.x + nv.y*nv.y + nv.z*nv.z));
+ }
+ pix = ((pix >> 16) & 255) * n / 100 << 16 |
+ ((pix >> 8) & 255) * n / 100 << 8 | (pix & 255) * n / 100;
+ }
+ n = length(face) / 3;
+ prn(n+2);
+ transPt(pt1.x, pt1.y, pt1.z);
+ pr(txt);
+ transPt(pt2.x + dx, pt2.y + dy, pt2.z + dz);
+ transPt(pt3.x + dx, pt3.y + dy, pt3.z + dz);
+ while (--n >= 0) {
+ face = getVector(face, &v), rotate(&v, r, &pt1);
+ transPt(pt1.x + dx, pt1.y + dy, pt1.z + dz);
+ }
+ prn(pix);
+ }
+ }
+ }
+}
+
+// (z3d:Draw 'foc 'yaw 'pitch 'x 'y 'z 'sky 'gnd ['h 'v]) -> NIL
+// (z3d:Draw 'sym) -> NIL
+// (z3d:Draw 'NIL) -> lst
+any Draw(any ex) {
+ any x, y;
+ double a, sinY, cosY, sinP, cosP;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x)))) {
+ cell c1;
+
+ prn(0);
+ if (!Snap) {
+ prn(32767);
+ return Nil;
+ }
+ prn(Snap2h), prn(Snap2v);
+ Push(c1, doubleToNum(SnapZ * SCL));
+ data(c1) = cons(doubleToNum(SnapY * SCL), data(c1));
+ data(c1) = cons(doubleToNum(SnapX * SCL), data(c1));
+ return Pop(c1);
+ }
+ if (isSym(y)) {
+ doDraw(ex, y, NULL, 0.0, 0.0, 0.0);
+ return Nil;
+ }
+ FocLen = numToDouble(y) / SCL;
+ a = evDouble(ex, x = cdr(x)) / SCL, sinY = sin(a), cosY = cos(a);
+ a = evDouble(ex, x = cdr(x)) / SCL, sinP = sin(a), cosP = cos(a);
+ PosX = evDouble(ex, x = cdr(x)) / SCL;
+ PosY = evDouble(ex, x = cdr(x)) / SCL;
+ PosZ = evDouble(ex, x = cdr(x)) / SCL;
+
+ Coeff1 = -sinY;
+ Coeff2 = cosY;
+ Coeff4 = cosY * sinP;
+ Coeff5 = sinY * sinP;
+ Coeff6 = -cosP;
+ Coeff7 = cosY * cosP;
+ Coeff8 = sinY * cosP;
+ Coeff9 = sinP;
+
+ Pos6 = Coeff6 * PosZ;
+ Pos9 = Coeff9 * PosZ;
+
+ if (cosP == 0.0)
+ prn(sinP > 0.0? +16383 : -16384);
+ else if ((a = FocLen * sinP/cosP) > +16383.0)
+ prn(+16383);
+ else if (a < -16384.0)
+ prn(-16384);
+ else
+ prn(num(a));
+ prn(evCnt(ex, x = cdr(x)));
+ prn(evCnt(ex, x = cdr(x)));
+ x = cdr(x);
+ if (Snap = !isNil(y = EVAL(car(x)))) {
+ SnapD = 32767;
+ Snap1h = (int)xCnt(ex,y);
+ Snap1v = (int)evCnt(ex,cdr(x));
+ }
+ return Nil;
+}
diff --git a/src/pico.h b/src/pico.h
@@ -0,0 +1,622 @@
+/* 01apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <ctype.h>
+#include <string.h>
+#include <errno.h>
+#include <setjmp.h>
+
+#define WORD ((int)sizeof(long))
+#define BITS (8*WORD)
+#define CELLS (1024*1024/sizeof(cell))
+
+typedef unsigned long word;
+typedef unsigned char byte;
+typedef unsigned char *ptr;
+
+#undef bool
+typedef enum {NO,YES} bool;
+
+typedef struct cell { // Pico primary data type
+ struct cell *car;
+ struct cell *cdr;
+} cell, *any;
+
+typedef any (*fun)(any);
+
+typedef struct heap {
+ cell cells[CELLS];
+ struct heap *next;
+} heap;
+
+typedef struct bindFrame {
+ struct bindFrame *link;
+ int i, cnt;
+ struct {any sym; any val;} bnd[1];
+} bindFrame;
+
+typedef struct methFrame {
+ struct methFrame *link;
+ any key, cls;
+} methFrame;
+
+typedef struct inFrame {
+ struct inFrame *link;
+ void (*get)(void);
+ FILE *fp;
+ int next;
+} inFrame;
+
+typedef struct outFrame {
+ struct outFrame *link;
+ void (*put)(int);
+ FILE *fp;
+} outFrame;
+
+typedef struct parseFrame {
+ int i;
+ word w;
+ any sym, nm;
+} parseFrame;
+
+typedef struct stkEnv {
+ cell *stack, *arg;
+ bindFrame *bind;
+ methFrame *meth;
+ int next;
+ any make;
+ inFrame *inFiles;
+ outFrame *outFiles;
+ parseFrame *parser;
+ void (*get)(void);
+ void (*put)(int);
+ bool brk;
+} stkEnv;
+
+typedef struct catchFrame {
+ struct catchFrame *link;
+ any tag;
+ stkEnv env;
+ jmp_buf rst;
+} catchFrame;
+
+/*** Macros ***/
+#define Free(p) ((p)->car=Avail, Avail=(p))
+
+/* Number access */
+#define num(x) ((long)(x))
+#define txt(n) ((any)(num(n)<<1|1))
+#define box(n) ((any)(num(n)<<2|2))
+#define unBox(n) (num(n)>>2)
+#define Zero ((any)2)
+#define One ((any)6)
+
+/* Symbol access */
+#define symPtr(x) ((any)&(x)->cdr)
+#define val(x) ((x)->car)
+#define tail(x) (((x)-1)->cdr)
+
+/* Cell access */
+#define car(x) ((x)->car)
+#define cdr(x) ((x)->cdr)
+#define caar(x) (car(car(x)))
+#define cadr(x) (car(cdr(x)))
+#define cdar(x) (cdr(car(x)))
+#define cddr(x) (cdr(cdr(x)))
+#define caaar(x) (car(car(car(x))))
+#define caadr(x) (car(car(cdr(x))))
+#define cadar(x) (car(cdr(car(x))))
+#define caddr(x) (car(cdr(cdr(x))))
+#define cdaar(x) (cdr(car(car(x))))
+#define cdadr(x) (cdr(car(cdr(x))))
+#define cddar(x) (cdr(cdr(car(x))))
+#define cdddr(x) (cdr(cdr(cdr(x))))
+#define cadddr(x) (car(cdr(cdr(cdr(x)))))
+#define cddddr(x) (cdr(cdr(cdr(cdr(x)))))
+
+#define data(c) ((c).car)
+#define Save(c) ((c).cdr=Env.stack, Env.stack=&(c))
+#define drop(c) (Env.stack=(c).cdr)
+#define Push(c,x) (data(c)=(x), Save(c))
+#define Pop(c) (drop(c), data(c))
+
+#define Bind(s,f) ((f).i=0, (f).cnt=1, (f).bnd[0].sym=(s), (f).bnd[0].val=val(s), (f).link=Env.bind, Env.bind=&(f))
+#define Unbind(f) (val((f).bnd[0].sym)=(f).bnd[0].val, Env.bind=(f).link)
+
+/* Predicates */
+#define isNil(x) ((x)==Nil)
+#define isTxt(x) (num(x)&1)
+#define isNum(x) (num(x)&2)
+#define isSym(x) (num(x)&WORD)
+#define isSymb(x) ((num(x)&(WORD+2))==WORD)
+#define isCell(x) (!(num(x)&(2*WORD-1)))
+
+/* Evaluation */
+#define EVAL(x) (isNum(x)? x : isSym(x)? val(x) : evList(x))
+#define evSubr(f,x) (*(fun)(num(f) & ~2))(x)
+
+/* Error checking */
+#define NeedNum(ex,x) if (!isNum(x)) numError(ex,x)
+#define NeedSym(ex,x) if (!isSym(x)) symError(ex,x)
+#define NeedSymb(ex,x) if (!isSymb(x)) symError(ex,x)
+#define NeedCell(ex,x) if (!isCell(x)) cellError(ex,x)
+#define NeedAtom(ex,x) if (isCell(x)) atomError(ex,x)
+#define NeedLst(ex,x) if (!isCell(x) && !isNil(x)) lstError(ex,x)
+#define NeedVar(ex,x) if (isNum(x)) varError(ex,x)
+#define CheckVar(ex,x) if ((x)>=Nil && (x)<=T) protError(ex,x)
+
+/* Globals */
+extern int Chr, Trace;
+extern char **AV, *Home;
+extern heap *Heaps;
+extern cell *Avail;
+extern stkEnv Env;
+extern catchFrame *CatchPtr;
+extern FILE *InFile, *OutFile;
+extern any TheKey, TheCls;
+extern any Intern[2], Transient[2], Reloc;
+extern any ApplyArgs, ApplyBody;
+extern any Nil, Meth, Quote, T, At, At2, At3, This;
+extern any Dbg, Scl, Class, Up, Err, Rst, Msg, Bye;
+
+/* Prototypes */
+void *alloc(void*,size_t);
+any apply(any,any,bool,int,cell*);
+void argError(any,any) __attribute__ ((noreturn));
+void atomError(any,any) __attribute__ ((noreturn));
+void begString(void);
+any boxSubr(fun);
+void brkLoad(any);
+int bufNum(char[BITS/2],long);
+int bufSize(any);
+void bufString(any,char*);
+void bye(int) __attribute__ ((noreturn));
+void cellError(any,any) __attribute__ ((noreturn));
+int compare(any,any);
+any cons(any,any);
+any consName(word,any);
+any consSym(any,word);
+void crlf(void);
+any endString(void);
+bool equal(any,any);
+void err(any,any,char*,...) __attribute__ ((noreturn));
+any evExpr(any,any);
+any evList(any);
+long evNum(any,any);
+any evSym(any);
+void execError(char*) __attribute__ ((noreturn));
+int firstByte(any);
+any get(any,any);
+int getByte(int*,word*,any*);
+int getByte1(int*,word*,any*);
+void getStdin(void);
+void giveup(char*) __attribute__ ((noreturn));
+void heapAlloc(void);
+void initSymbols(void);
+any intern(any,any[2]);
+bool isBlank(any);
+any isIntern(any,any[2]);
+void lstError(any,any) __attribute__ ((noreturn));
+any load(any,int,any);
+any method(any);
+any mkChar(int);
+any mkChar2(int,int);
+any mkSym(byte*);
+any mkStr(char*);
+any mkTxt(int);
+any name(any);
+int numBytes(any);
+void numError(any,any) __attribute__ ((noreturn));
+any numToSym(any,int,int,int);
+void outName(any);
+void outNum(long);
+void outString(char*);
+void pack(any,int*,word*,any*,cell*);
+int pathSize(any);
+void pathString(any,char*);
+void popInFiles(void);
+void popOutFiles(void);
+any popSym(int,word,any,cell*);
+void prin(any);
+void print(any);
+void protError(any,any) __attribute__ ((noreturn));
+void pushInFiles(inFrame*);
+void pushOutFiles(outFrame*);
+any put(any,any,any);
+void putByte(int,int*,word*,any*,cell*);
+void putByte0(int*,word*,any*);
+void putByte1(int,int*,word*,any*);
+void putStdout(int);
+void rdOpen(any,any,inFrame*);
+any read1(int);
+int secondByte(any);
+void space(void);
+int symBytes(any);
+void symError(any,any) __attribute__ ((noreturn));
+any symToNum(any,int,int,int);
+void undefined(any,any);
+void unintern(any,any[2]);
+void unwind (catchFrame*);
+void varError(any,any) __attribute__ ((noreturn));
+void wrOpen(any,any,outFrame*);
+long xNum(any,any);
+any xSym(any);
+
+any doAbs(any);
+any doAdd(any);
+any doAll(any);
+any doAnd(any);
+any doAny(any);
+any doAppend(any);
+any doApply(any);
+any doArg(any);
+any doArgs(any);
+any doArgv(any);
+any doAsoq(any);
+any doAs(any);
+any doAssoc(any);
+any doAt(any);
+any doAtom(any);
+any doBind(any);
+any doBitAnd(any);
+any doBitOr(any);
+any doBitQ(any);
+any doBitXor(any);
+any doBool(any);
+any doBox(any);
+any doBoxQ(any);
+any doBreak(any);
+any doBy(any);
+any doBye(any) __attribute__ ((noreturn));
+any doCaaar(any);
+any doCaadr(any);
+any doCaar(any);
+any doCadar(any);
+any doCadddr(any);
+any doCaddr(any);
+any doCadr(any);
+any doCar(any);
+any doCase(any);
+any doCatch(any);
+any doCdaar(any);
+any doCdadr(any);
+any doCdar(any);
+any doCddar(any);
+any doCddddr(any);
+any doCdddr(any);
+any doCddr(any);
+any doCdr(any);
+any doChain(any);
+any doChar(any);
+any doChop(any);
+any doCirc(any);
+any doClip(any);
+any doCnt(any);
+any doCol(any);
+any doCon(any);
+any doConc(any);
+any doCond(any);
+any doCons(any);
+any doCopy(any);
+any doCut(any);
+any doDate(any);
+any doDe(any);
+any doDec(any);
+any doDef(any);
+any doDefault(any);
+any doDel(any);
+any doDelete(any);
+any doDelq(any);
+any doDiff(any);
+any doDiv(any);
+any doDm(any);
+any doDo(any);
+any doE(any);
+any doEnv(any);
+any doEof(any);
+any doEol(any);
+any doEq(any);
+any doEqual(any);
+any doEqual0(any);
+any doEqualT(any);
+any doEval(any);
+any doExtra(any);
+any doFifo(any);
+any doFill(any);
+any doFilter(any);
+any doFin(any);
+any doFinally(any);
+any doFind(any);
+any doFish(any);
+any doFlgQ(any);
+any doFlip(any);
+any doFlush(any);
+any doFold(any);
+any doFor(any);
+any doFormat(any);
+any doFrom(any);
+any doFull(any);
+any doFunQ(any);
+any doGc(any);
+any doGe(any);
+any doGe0(any);
+any doGet(any);
+any doGetl(any);
+any doGlue(any);
+any doGt(any);
+any doGt0(any);
+any doHead(any);
+any doHeap(any);
+any doHide(any);
+any doIdx(any);
+any doIf(any);
+any doIf2(any);
+any doIfn(any);
+any doIn(any);
+any doInc(any);
+any doIndex(any);
+any doIntern(any);
+any doIsa(any);
+any doJob(any);
+any doLast(any);
+any doLe(any);
+any doLength(any);
+any doLet(any);
+any doLetQ(any);
+any doLine(any);
+any doLink(any);
+any doList(any);
+any doLit(any);
+any doLstQ(any);
+any doLoad(any);
+any doLookup(any);
+any doLoop(any);
+any doLowQ(any);
+any doLowc(any);
+any doLt(any);
+any doLt0(any);
+any doLup(any);
+any doMade(any);
+any doMake(any);
+any doMap(any);
+any doMapc(any);
+any doMapcan(any);
+any doMapcar(any);
+any doMapcon(any);
+any doMaplist(any);
+any doMaps(any);
+any doMatch(any);
+any doMax(any);
+any doMaxi(any);
+any doMember(any);
+any doMemq(any);
+any doMeta(any);
+any doMeth(any);
+any doMethod(any);
+any doMin(any);
+any doMini(any);
+any doMix(any);
+any doMmeq(any);
+any doMul(any);
+any doMulDiv(any);
+any doName(any);
+any doNand(any);
+any doNEq(any);
+any doNEq0(any);
+any doNEqT(any);
+any doNEqual(any);
+any doNeed(any);
+any doNew(any);
+any doNext(any);
+any doNil(any);
+any doNond(any);
+any doNor(any);
+any doNot(any);
+any doNth(any);
+any doNumQ(any);
+any doOff(any);
+any doOffset(any);
+any doOn(any);
+any doOne(any);
+any doOnOff(any);
+any doOpt(any);
+any doOr(any);
+any doOut(any);
+any doPack(any);
+any doPair(any);
+any doPass(any);
+any doPath(any);
+any doPatQ(any);
+any doPeek(any);
+any doPick(any);
+any doPop(any);
+any doPreQ(any);
+any doPrin(any);
+any doPrinl(any);
+any doPrint(any);
+any doPrintln(any);
+any doPrintsp(any);
+any doProg(any);
+any doProg1(any);
+any doProg2(any);
+any doProp(any);
+any doPropCol(any);
+any doProve(any);
+any doPush(any);
+any doPush1(any);
+any doPut(any);
+any doPutl(any);
+any doQueue(any);
+any doQuit(any);
+any doQuote(any);
+any doRand(any);
+any doRank(any);
+any doRead(any);
+any doRem(any);
+any doReplace(any);
+any doRest(any);
+any doReverse(any);
+any doRot(any);
+any doRun(any);
+any doSave(any);
+any doSect(any);
+any doSeed(any);
+any doSeek(any);
+any doSemicol(any);
+any doSend(any);
+any doSet(any);
+any doSetCol(any);
+any doSetq(any);
+any doShift(any);
+any doSize(any);
+any doSkip(any);
+any doSort(any);
+any doSpace(any);
+any doSplit(any);
+any doSpQ(any);
+any doSqrt(any);
+any doState(any);
+any doStem(any);
+any doStk(any);
+any doStr(any);
+any doStrip(any);
+any doStrQ(any);
+any doSub(any);
+any doSum(any);
+any doSuper(any);
+any doSym(any);
+any doSymQ(any);
+any doT(any);
+any doTail(any);
+any doText(any);
+any doThrow(any);
+any doTill(any);
+any doTrace(any);
+any doTrim(any);
+any doTry(any);
+any doType(any);
+any doUnify(any);
+any doUnless(any);
+any doUntil(any);
+any doUp(any);
+any doUppQ(any);
+any doUppc(any);
+any doUse(any);
+any doVal(any);
+any doWhen(any);
+any doWhile(any);
+any doWith(any);
+any doXchg(any);
+any doXor(any);
+any doYoke(any);
+any doZap(any);
+any doZero(any);
+
+/* List element access */
+static inline any nCdr(int n, any x) {
+ while (--n >= 0)
+ x = cdr(x);
+ return x;
+}
+
+static inline any nth(int n, any x) {
+ if (--n < 0)
+ return Nil;
+ return nCdr(n,x);
+}
+
+static inline any getn(any x, any y) {
+ if (isNum(x)) {
+ long n = unBox(x);
+
+ if (n < 0) {
+ while (++n)
+ y = cdr(y);
+ return cdr(y);
+ }
+ if (n == 0)
+ return Nil;
+ while (--n)
+ y = cdr(y);
+ return car(y);
+ }
+ do
+ if (isCell(car(y)) && x == caar(y))
+ return cdar(y);
+ while (isCell(y = cdr(y)));
+ return Nil;
+}
+
+/* List length calculation */
+static inline int length(any x) {
+ int n;
+
+ for (n = 0; isCell(x); x = cdr(x))
+ ++n;
+ return n;
+}
+
+/* Membership */
+static inline any member(any x, any y) {
+ any z = y;
+
+ while (isCell(y)) {
+ if (equal(x, car(y)))
+ return y;
+ if (z == (y = cdr(y)))
+ return NULL;
+ }
+ return isNil(y) || !equal(x,y)? NULL : y;
+}
+
+static inline any memq(any x, any y) {
+ any z = y;
+
+ while (isCell(y)) {
+ if (x == car(y))
+ return y;
+ if (z == (y = cdr(y)))
+ return NULL;
+ }
+ return isNil(y) || x != y? NULL : y;
+}
+
+static inline int indx(any x, any y) {
+ int n = 1;
+ any z = y;
+
+ while (isCell(y)) {
+ if (equal(x, car(y)))
+ return n;
+ ++n;
+ if (z == (y = cdr(y)))
+ return 0;
+ }
+ return 0;
+}
+
+/* List interpreter */
+static inline any prog(any x) {
+ any y;
+
+ do
+ y = EVAL(car(x));
+ while (isCell(x = cdr(x)));
+ return y;
+}
+
+static inline any run(any x) {
+ any y;
+ cell at;
+
+ Push(at,val(At));
+ do
+ y = EVAL(car(x));
+ while (isCell(x = cdr(x)));
+ val(At) = Pop(at);
+ return y;
+}
diff --git a/src/subr.c b/src/subr.c
@@ -0,0 +1,1519 @@
+/* 01apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+// (c...r 'lst) -> any
+any doCar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return car(x);
+}
+
+any doCdr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cdr(x);
+}
+
+any doCaar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return caar(x);
+}
+
+any doCadr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cadr(x);
+}
+
+any doCdar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cdar(x);
+}
+
+any doCddr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cddr(x);
+}
+
+any doCaaar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return caaar(x);
+}
+
+any doCaadr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return caadr(x);
+}
+
+any doCadar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cadar(x);
+}
+
+any doCaddr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return caddr(x);
+}
+
+any doCdaar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cdaar(x);
+}
+
+any doCdadr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cdadr(x);
+}
+
+any doCddar(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cddar(x);
+}
+
+any doCdddr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cdddr(x);
+}
+
+any doCadddr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cadddr(x);
+}
+
+any doCddddr(any ex) {
+ any x = cdr(ex);
+ x = EVAL(car(x));
+ NeedLst(ex,x);
+ return cddddr(x);
+}
+
+// (nth 'lst 'num ..) -> lst
+any doNth(any ex) {
+ any x;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x))), x = cdr(x);
+ for (;;) {
+ if (!isCell(data(c1)))
+ return Pop(c1);
+ data(c1) = nth((int)evNum(ex,x), data(c1));
+ if (!isCell(x = cdr(x)))
+ return Pop(c1);
+ data(c1) = car(data(c1));
+ }
+}
+
+// (con 'lst 'any) -> any
+any doCon(any ex) {
+ any x;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedCell(ex,data(c1));
+ x = cdr(x), x = cdr(data(c1)) = EVAL(car(x));
+ drop(c1);
+ return x;
+}
+
+// (cons 'any ['any ..]) -> lst
+any doCons(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x);
+ Push(c1, y = cons(EVAL(car(x)),Nil));
+ while (isCell(cdr(x = cdr(x))))
+ y = cdr(y) = cons(EVAL(car(x)),Nil);
+ cdr(y) = EVAL(car(x));
+ return Pop(c1);
+}
+
+// (conc 'lst ..) -> lst
+any doConc(any x) {
+ any y, z;
+ cell c1;
+
+ x = cdr(x), Push(c1, y = EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ z = EVAL(car(x));
+ if (!isCell(y))
+ y = data(c1) = z;
+ else {
+ while (isCell(cdr(y)))
+ y = cdr(y);
+ cdr(y) = z;
+ }
+ }
+ return Pop(c1);
+}
+
+// (circ 'any ..) -> lst
+any doCirc(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x);
+ Push(c1, y = cons(EVAL(car(x)),Nil));
+ while (isCell(x = cdr(x)))
+ y = cdr(y) = cons(EVAL(car(x)),Nil);
+ cdr(y) = data(c1);
+ return Pop(c1);
+}
+
+// (rot 'lst ['num]) -> lst
+any doRot(any ex) {
+ any x, y, z;
+ int n;
+ cell c1;
+
+ x = cdr(ex), Push(c1, y = EVAL(car(x)));
+ if (isCell(y)) {
+ n = isCell(x = cdr(x))? evNum(ex,x) : 0;
+ x = car(y);
+ while (--n && isCell(y = cdr(y)) && y != data(c1))
+ z = car(y), car(y) = x, x = z;
+ car(data(c1)) = x;
+ }
+ return Pop(c1);
+}
+
+// (list 'any ['any ..]) -> lst
+any doList(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x);
+ Push(c1, y = cons(EVAL(car(x)),Nil));
+ while (isCell(x = cdr(x)))
+ y = cdr(y) = cons(EVAL(car(x)),Nil);
+ return Pop(c1);
+}
+
+// (need 'num ['lst ['any]]) -> lst
+any doNeed(any ex) {
+ int n;
+ any x;
+ cell c1, c2;
+
+ n = (int)evNum(ex, x = cdr(ex));
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ Push(c2, EVAL(cadr(x)));
+ x = data(c1);
+ if (n > 0)
+ for (n -= length(x); n > 0; --n)
+ data(c1) = cons(data(c2), data(c1));
+ else if (n) {
+ if (!isCell(x))
+ data(c1) = x = cons(data(c2),Nil);
+ else
+ while (isCell(cdr(x)))
+ ++n, x = cdr(x);
+ while (++n < 0)
+ x = cdr(x) = cons(data(c2),Nil);
+ }
+ return Pop(c1);
+}
+
+// (full 'any) -> bool
+any doFull(any x) {
+ x = cdr(x);
+ for (x = EVAL(car(x)); isCell(x); x = cdr(x))
+ if (isNil(car(x)))
+ return Nil;
+ return T;
+}
+
+// (make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any
+any doMake(any x) {
+ any make;
+ cell c1, c2;
+
+ if (make = Env.make)
+ Push(c1, car(make));
+ Env.make = &c2, c2.car = Nil;
+ while (isCell(x = cdr(x)))
+ if (isCell(car(x)))
+ evList(car(x));
+ if (Env.make = make)
+ drop(c1);
+ return c2.car;
+}
+
+static void makeError(any ex) {err(ex, NULL, "Not making");}
+
+// (made ['lst1 ['lst2]]) -> lst
+any doMade(any x) {
+ if (!Env.make)
+ makeError(x);
+ if (isCell(x = cdr(x))) {
+ car(Env.make) = EVAL(car(x));
+ if (x = cdr(x), !isCell(x = EVAL(car(x))))
+ for (x = car(Env.make); isCell(cdr(x)); x = cdr(x));
+ cdr(Env.make) = x;
+ }
+ return car(Env.make);
+}
+
+// (chain 'lst ..) -> lst
+any doChain(any x) {
+ any y;
+
+ if (!Env.make)
+ makeError(x);
+ x = cdr(x);
+ do {
+ if (isCell(y = EVAL(car(x)))) {
+ if (isCell(car(Env.make)))
+ cddr(Env.make) = y;
+ else
+ car(Env.make) = y;
+ cdr(Env.make) = y;
+ while (isCell(cddr(Env.make)))
+ cdr(Env.make) = cddr(Env.make);
+ }
+ } while (isCell(x = cdr(x)));
+ return y;
+}
+
+// (link 'any ..) -> any
+any doLink(any x) {
+ any y, z;
+
+ if (!Env.make)
+ makeError(x);
+ x = cdr(x);
+ do {
+ y = cons(z = EVAL(car(x)), Nil);
+ if (isCell(car(Env.make)))
+ cddr(Env.make) = y;
+ else
+ car(Env.make) = y;
+ cdr(Env.make) = y;
+ } while (isCell(x = cdr(x)));
+ return z;
+}
+
+// (yoke 'any ..) -> any
+any doYoke(any x) {
+ any y;
+
+ if (!Env.make)
+ makeError(x);
+ x = cdr(x);
+ do {
+ if (isCell(car(Env.make)))
+ car(Env.make) = cons(y = EVAL(car(x)), car(Env.make));
+ else
+ car(Env.make) = cdr(Env.make) = cons(y = EVAL(car(x)), Nil);
+ } while (isCell(x = cdr(x)));
+ return y;
+}
+
+// (copy 'any) -> any
+any doCopy(any x) {
+ any y, z;
+ cell c1;
+
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x))))
+ return x;
+ Push(c1, y = cons(car(x), cdr(z = x)));
+ while (isCell(x = cdr(x))) {
+ if (x == z) {
+ cdr(y) = data(c1);
+ break;
+ }
+ y = cdr(y) = cons(car(x),cdr(x));
+ }
+ return Pop(c1);
+}
+
+// (mix 'lst num|'any ..) -> lst
+any doMix(any x) {
+ any y;
+ cell c1, c2;
+
+ x = cdr(x);
+ if (!isCell(data(c1) = EVAL(car(x))) && !isNil(data(c1)))
+ return data(c1);
+ if (!isCell(x = cdr(x)))
+ return Nil;
+ Save(c1);
+ Push(c2,
+ y = cons(
+ isNum(car(x))? car(nth((int)unBox(car(x)),data(c1))) : EVAL(car(x)),
+ Nil ) );
+ while (isCell(x = cdr(x)))
+ y = cdr(y) = cons(
+ isNum(car(x))? car(nth((int)unBox(car(x)),data(c1))) : EVAL(car(x)),
+ Nil );
+ drop(c1);
+ return data(c2);
+}
+
+// (append 'lst ..) -> lst
+any doAppend(any x) {
+ any y;
+ cell c1, c2;
+
+ while (isCell(cdr(x = cdr(x)))) {
+ if (isCell(data(c1) = EVAL(car(x)))) {
+ Save(c1);
+ Push(c2, y = cons(car(data(c1)),cdr(data(c1))));
+ while (isCell(data(c1) = cdr(data(c1))))
+ y = cdr(y) = cons(car(data(c1)),cdr(data(c1)));
+ while (isCell(cdr(x = cdr(x)))) {
+ data(c1) = EVAL(car(x));
+ while (isCell(data(c1))) {
+ y = cdr(y) = cons(car(data(c1)),cdr(data(c1)));
+ data(c1) = cdr(data(c1));
+ }
+ cdr(y) = data(c1);
+ }
+ cdr(y) = EVAL(car(x));
+ drop(c1);
+ return data(c2);
+ }
+ }
+ return EVAL(car(x));
+}
+
+// (delete 'any 'lst) -> lst
+any doDelete(any x) {
+ any y, z;
+ cell c1, c2, c3;
+
+ x = cdr(x), Push(c1, y = EVAL(car(x)));
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x)))) {
+ drop(c1);
+ return x;
+ }
+ if (equal(y, car(x))) {
+ drop(c1);
+ return cdr(x);
+ }
+ Push(c2, x);
+ Push(c3, z = cons(car(x), Nil));
+ while (isCell(x = cdr(x))) {
+ if (equal(y, car(x))) {
+ cdr(z) = cdr(x);
+ drop(c1);
+ return data(c3);
+ }
+ z = cdr(z) = cons(car(x), Nil);
+ }
+ cdr(z) = x;
+ drop(c1);
+ return data(c3);
+}
+
+// (delq 'any 'lst) -> lst
+any doDelq(any x) {
+ any y, z;
+ cell c1, c2, c3;
+
+ x = cdr(x), Push(c1, y = EVAL(car(x)));
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x)))) {
+ drop(c1);
+ return x;
+ }
+ if (y == car(x)) {
+ drop(c1);
+ return cdr(x);
+ }
+ Push(c2, x);
+ Push(c3, z = cons(car(x), Nil));
+ while (isCell(x = cdr(x))) {
+ if (y == car(x)) {
+ cdr(z) = cdr(x);
+ drop(c1);
+ return data(c3);
+ }
+ z = cdr(z) = cons(car(x), Nil);
+ }
+ cdr(z) = x;
+ drop(c1);
+ return data(c3);
+}
+
+// (replace 'lst 'any1 'any2 ..) -> lst
+any doReplace(any x) {
+ any y;
+ int i, n = length(cdr(x = cdr(x))) + 1 & ~1;
+ cell c1, c2, c[n];
+
+ if (!isCell(data(c1) = EVAL(car(x))))
+ return data(c1);
+ Save(c1);
+ for (i = 0; i < n; ++i)
+ x = cdr(x), Push(c[i], EVAL(car(x)));
+ for (i = 0; i < n; i += 2)
+ if (equal(car(data(c1)), data(c[i]))) {
+ x = data(c[i+1]);
+ goto rpl1;
+ }
+ x = car(data(c1));
+rpl1:
+ Push(c2, y = cons(x,Nil));
+ while (isCell(data(c1) = cdr(data(c1)))) {
+ for (i = 0; i < n; i += 2)
+ if (equal(car(data(c1)), data(c[i]))) {
+ x = data(c[i+1]);
+ goto rpl2;
+ }
+ x = car(data(c1));
+ rpl2:
+ y = cdr(y) = cons(x, Nil);
+ }
+ cdr(y) = data(c1);
+ drop(c1);
+ return data(c2);
+}
+
+// (strip 'any) -> any
+any doStrip(any x) {
+ x = cdr(x), x = EVAL(car(x));
+ while (isCell(x) && car(x) == Quote && x != cdr(x))
+ x = cdr(x);
+ return x;
+}
+
+// (split 'lst 'any ..) -> lst
+any doSplit(any x) {
+ any y;
+ int i, n = length(cdr(x = cdr(x)));
+ cell c1, c[n], res, sub;
+
+ if (!isCell(data(c1) = EVAL(car(x))))
+ return data(c1);
+ Save(c1);
+ for (i = 0; i < n; ++i)
+ x = cdr(x), Push(c[i], EVAL(car(x)));
+ Push(res, x = Nil);
+ Push(sub, y = Nil);
+ do {
+ for (i = 0; i < n; ++i) {
+ if (equal(car(data(c1)), data(c[i]))) {
+ if (isNil(x))
+ x = data(res) = cons(data(sub), Nil);
+ else
+ x = cdr(x) = cons(data(sub), Nil);
+ y = data(sub) = Nil;
+ goto spl1;
+ }
+ }
+ if (isNil(y))
+ y = data(sub) = cons(car(data(c1)), Nil);
+ else
+ y = cdr(y) = cons(car(data(c1)), Nil);
+ spl1: ;
+ } while (isCell(data(c1) = cdr(data(c1))));
+ y = cons(data(sub), Nil);
+ drop(c1);
+ if (isNil(x))
+ return y;
+ cdr(x) = y;
+ return data(res);
+}
+
+// (reverse 'lst) -> lst
+any doReverse(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, x = EVAL(car(x)));
+ for (y = Nil; isCell(x); x = cdr(x))
+ y = cons(car(x), y);
+ drop(c1);
+ return y;
+}
+
+// (flip 'lst) -> lst
+any doFlip(any x) {
+ any y, z;
+
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x))) || !isCell(y = cdr(x)))
+ return x;
+ cdr(x) = Nil;
+ for (;;) {
+ z = cdr(y), cdr(y) = x;
+ if (!isCell(z))
+ return y;
+ x = y, y = z;
+ }
+}
+
+static any trim(any x) {
+ any y;
+
+ if (!isCell(x))
+ return x;
+ if (isNil(y = trim(cdr(x))) && isBlank(car(x)))
+ return Nil;
+ return cons(car(x),y);
+}
+
+// (trim 'lst) -> lst
+any doTrim(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = trim(data(c1));
+ drop(c1);
+ return x;
+}
+
+// (clip 'lst) -> lst
+any doClip(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(data(c1)) && isBlank(car(data(c1))))
+ data(c1) = cdr(data(c1));
+ x = trim(data(c1));
+ drop(c1);
+ return x;
+}
+
+// (head 'num|lst 'lst) -> lst
+any doHead(any ex) {
+ long n;
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex);
+ if (isNil(data(c1) = EVAL(car(x))))
+ return Nil;
+ if (isCell(data(c1))) {
+ Save(c1);
+ x = cdr(x);
+ if (isCell(x = EVAL(car(x)))) {
+ for (y = data(c1); equal(car(y), car(x)); x = cdr(x))
+ if (!isCell(y = cdr(y)))
+ return Pop(c1);
+ }
+ drop(c1);
+ return Nil;
+ }
+ if ((n = xNum(ex,data(c1))) == 0)
+ return Nil;
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x))))
+ return x;
+ if (n < 0 && (n += length(x)) <= 0)
+ return Nil;
+ Push(c1,x);
+ Push(c2, x = cons(car(data(c1)), Nil));
+ while (--n && isCell(data(c1) = cdr(data(c1))))
+ x = cdr(x) = cons(car(data(c1)), Nil);
+ drop(c1);
+ return data(c2);
+}
+
+// (tail 'num|lst 'lst) -> lst
+any doTail(any ex) {
+ long n;
+ any x, y;
+ cell c1;
+
+ x = cdr(ex);
+ if (isNil(data(c1) = EVAL(car(x))))
+ return Nil;
+ if (isCell(data(c1))) {
+ Save(c1);
+ x = cdr(x);
+ if (isCell(x = EVAL(car(x)))) {
+ do
+ if (equal(x,data(c1)))
+ return Pop(c1);
+ while (isCell(x = cdr(x)));
+ }
+ drop(c1);
+ return Nil;
+ }
+ if ((n = xNum(ex,data(c1))) == 0)
+ return Nil;
+ x = cdr(x);
+ if (!isCell(x = EVAL(car(x))))
+ return x;
+ if (n < 0)
+ return nth(1 - n, x);
+ for (y = cdr(x); --n; y = cdr(y))
+ if (!isCell(y))
+ return x;
+ while (isCell(y))
+ x = cdr(x), y = cdr(y);
+ return x;
+}
+
+// (stem 'lst 'any ..) -> lst
+any doStem(any x) {
+ int i, n = length(cdr(x = cdr(x)));
+ cell c1, c[n];
+
+ Push(c1, EVAL(car(x)));
+ for (i = 0; i < n; ++i)
+ x = cdr(x), Push(c[i], EVAL(car(x)));
+ for (x = data(c1); isCell(x); x = cdr(x)) {
+ for (i = 0; i < n; ++i)
+ if (equal(car(x), data(c[i])))
+ data(c1) = cdr(x);
+ }
+ return Pop(c1);
+}
+
+// (fin 'any) -> num|sym
+any doFin(any x) {
+ x = cdr(x), x = EVAL(car(x));
+ while (isCell(x))
+ x = cdr(x);
+ return x;
+}
+
+// (last 'lst) -> any
+any doLast(any x) {
+ x = cdr(x), x = EVAL(car(x));
+ if (!isCell(x))
+ return x;
+ while (isCell(cdr(x)))
+ x = cdr(x);
+ return car(x);
+}
+
+// (== 'any ..) -> flg
+any doEq(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (data(c1) != EVAL(car(x))) {
+ drop(c1);
+ return Nil;
+ }
+ drop(c1);
+ return T;
+}
+
+// (n== 'any ..) -> flg
+any doNEq(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (data(c1) != EVAL(car(x))) {
+ drop(c1);
+ return T;
+ }
+ drop(c1);
+ return Nil;
+}
+
+// (= 'any ..) -> flg
+any doEqual(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (!equal(data(c1), EVAL(car(x)))) {
+ drop(c1);
+ return Nil;
+ }
+ drop(c1);
+ return T;
+}
+
+// (<> 'any ..) -> flg
+any doNEqual(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x)))
+ if (!equal(data(c1), EVAL(car(x)))) {
+ drop(c1);
+ return T;
+ }
+ drop(c1);
+ return Nil;
+}
+
+// (=0 'any) -> num | NIL
+any doEqual0(any x) {
+ x = cdr(x);
+ return (x = EVAL(car(x))) == Zero? x : Nil;
+}
+
+// (=T 'any) -> flg
+any doEqualT(any x) {
+ x = cdr(x);
+ return T == EVAL(car(x))? T : Nil;
+}
+
+// (n0 'any) -> flg
+any doNEq0(any x) {
+ x = cdr(x);
+ return (x = EVAL(car(x))) == Zero? Nil : T;
+}
+
+// (nT 'any) -> flg
+any doNEqT(any x) {
+ x = cdr(x);
+ return T == EVAL(car(x))? Nil : T;
+}
+
+// (< 'any ..) -> flg
+any doLt(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(data(c1), y) >= 0) {
+ drop(c1);
+ return Nil;
+ }
+ data(c1) = y;
+ }
+ drop(c1);
+ return T;
+}
+
+// (<= 'any ..) -> flg
+any doLe(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(data(c1), y) > 0) {
+ drop(c1);
+ return Nil;
+ }
+ data(c1) = y;
+ }
+ drop(c1);
+ return T;
+}
+
+// (> 'any ..) -> flg
+any doGt(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(data(c1), y) <= 0) {
+ drop(c1);
+ return Nil;
+ }
+ data(c1) = y;
+ }
+ drop(c1);
+ return T;
+}
+
+// (>= 'any ..) -> flg
+any doGe(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(data(c1), y) < 0) {
+ drop(c1);
+ return Nil;
+ }
+ data(c1) = y;
+ }
+ drop(c1);
+ return T;
+}
+
+// (max 'any ..) -> any
+any doMax(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(y, data(c1)) > 0)
+ data(c1) = y;
+ }
+ return Pop(c1);
+}
+
+// (min 'any ..) -> any
+any doMin(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (compare(y, data(c1)) < 0)
+ data(c1) = y;
+ }
+ return Pop(c1);
+}
+
+// (atom 'any) -> flg
+any doAtom(any x) {
+ x = cdr(x);
+ return !isCell(EVAL(car(x)))? T : Nil;
+}
+
+// (pair 'any) -> any
+any doPair(any x) {
+ x = cdr(x);
+ return isCell(x = EVAL(car(x)))? x : Nil;
+}
+
+// (lst? 'any) -> flg
+any doLstQ(any x) {
+ x = cdr(x);
+ return isCell(x = EVAL(car(x))) || isNil(x)? T : Nil;
+}
+
+// (num? 'any) -> num | NIL
+any doNumQ(any x) {
+ x = cdr(x);
+ return isNum(x = EVAL(car(x)))? x : Nil;
+}
+
+// (sym? 'any) -> flg
+any doSymQ(any x) {
+ x = cdr(x);
+ return isSymb(EVAL(car(x)))? T : Nil;
+}
+
+// (flg? 'any) -> flg
+any doFlgQ(any x) {
+ x = cdr(x);
+ return isNil(x = EVAL(car(x))) || x==T? T : Nil;
+}
+
+// (member 'any 'lst) -> any
+any doMember(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), x = EVAL(car(x));
+ return member(Pop(c1), x) ?: Nil;
+}
+
+// (memq 'any 'lst) -> any
+any doMemq(any x) {
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), x = EVAL(car(x));
+ return memq(Pop(c1), x) ?: Nil;
+}
+
+// (mmeq 'lst 'lst) -> any
+any doMmeq(any x) {
+ any y, z;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ for (x = Pop(c1); isCell(x); x = cdr(x))
+ if (z = memq(car(x), y))
+ return z;
+ return Nil;
+}
+
+// (sect 'lst 'lst) -> lst
+any doSect(any x) {
+ cell c1, c2, c3;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ Push(c3, x = Nil);
+ while (isCell(data(c1))) {
+ if (member(car(data(c1)), data(c2)))
+ if (isNil(x))
+ x = data(c3) = cons(car(data(c1)), Nil);
+ else
+ x = cdr(x) = cons(car(data(c1)), Nil);
+ data(c1) = cdr(data(c1));
+ }
+ drop(c1);
+ return data(c3);
+}
+
+// (diff 'lst 'lst) -> lst
+any doDiff(any x) {
+ cell c1, c2, c3;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ Push(c3, x = Nil);
+ while (isCell(data(c1))) {
+ if (!member(car(data(c1)), data(c2)))
+ if (isNil(x))
+ x = data(c3) = cons(car(data(c1)), Nil);
+ else
+ x = cdr(x) = cons(car(data(c1)), Nil);
+ data(c1) = cdr(data(c1));
+ }
+ drop(c1);
+ return data(c3);
+}
+
+// (index 'any 'lst) -> num | NIL
+any doIndex(any x) {
+ int n;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), x = EVAL(car(x));
+ if (n = indx(Pop(c1), x))
+ return box(n);
+ return Nil;
+}
+
+// (offset 'lst1 'lst2) -> num | NIL
+any doOffset(any x) {
+ int n;
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ for (n = 1, x = Pop(c1); isCell(y); ++n, y = cdr(y))
+ if (equal(x,y))
+ return box(n);
+ return Nil;
+}
+
+// (length 'any) -> num | T
+any doLength(any x) {
+ int n, i, c;
+ word w;
+ any y;
+
+ if (isNum(x = EVAL(cadr(x)))) {
+ char buf[BITS/2];
+ return box(bufNum(buf, unBox(x)));
+ }
+ if (isSym(x)) {
+ if (isNil(x))
+ return Zero;
+ x = name(x);
+ for (n = 0, c = getByte1(&i, &w, &x); c; ++n, c = getByte(&i, &w, &x));
+ return box(n);
+ }
+ n = 1;
+ while (car(x) == Quote) {
+ if (x == cdr(x))
+ return T;
+ if (!isCell(x = cdr(x)))
+ return box(n);
+ ++n;
+ }
+ y = x;
+ while (isCell(x = cdr(x))) {
+ if (x == y)
+ return T;
+ ++n;
+ }
+ return box(n);
+}
+
+static int size(any x) {
+ int n;
+ any y;
+
+ n = 1;
+ while (car(x) == Quote) {
+ if (x == cdr(x) || !isCell(x = cdr(x)))
+ return n;
+ ++n;
+ }
+ y = x;
+ if (isCell(car(x)))
+ n += size(car(x));
+ while (isCell(x = cdr(x)) && x != y) {
+ ++n;
+ if (isCell(car(x)))
+ n += size(car(x));
+ }
+ return n;
+}
+
+// (size 'any) -> num
+any doSize(any x) {
+ if (isNum(x = EVAL(cadr(x))))
+ return box(numBytes(x));
+ if (isSym(x))
+ return box(symBytes(x));
+ return box(size(x));
+}
+
+// (assoc 'any 'lst) -> lst
+any doAssoc(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ for (x = Pop(c1); isCell(y); y = cdr(y))
+ if (isCell(car(y)) && equal(x,caar(y)))
+ return car(y);
+ return Nil;
+}
+
+// (asoq 'any 'lst) -> lst
+any doAsoq(any x) {
+ any y;
+ cell c1;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ for (x = Pop(c1); isCell(y); y = cdr(y))
+ if (isCell(car(y)) && x == caar(y))
+ return car(y);
+ return Nil;
+}
+
+static any Rank;
+
+any rank1(any lst, int n) {
+ int i;
+
+ if (isCell(car(lst)) && compare(caar(lst), Rank) > 0)
+ return NULL;
+ if (n == 1)
+ return car(lst);
+ i = n / 2;
+ return rank1(nCdr(i,lst), n-i) ?: rank1(lst, i);
+}
+
+any rank2(any lst, int n) {
+ int i;
+
+ if (isCell(car(lst)) && compare(Rank, caar(lst)) > 0)
+ return NULL;
+ if (n == 1)
+ return car(lst);
+ i = n / 2;
+ return rank2(nCdr(i,lst), n-i) ?: rank2(lst, i);
+}
+
+// (rank 'any 'lst ['flg]) -> lst
+any doRank(any x) {
+ any y;
+ cell c1, c2;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, y = EVAL(car(x)));
+ x = cdr(x), x = EVAL(car(x));
+ Rank = Pop(c1);
+ if (!isCell(y))
+ return Nil;
+ if (isNil(x))
+ return rank1(y, length(y)) ?: Nil;
+ return rank2(y, length(y)) ?: Nil;
+}
+
+/* Pattern matching */
+bool match(any p, any d) {
+ any x;
+
+ for (;;) {
+ if (!isCell(p)) {
+ if (isSymb(p) && firstByte(p) == '@') {
+ val(p) = d;
+ return YES;
+ }
+ return !isCell(d) && equal(p,d);
+ }
+ if (isSymb(x = car(p)) && firstByte(x) == '@') {
+ if (!isCell(d)) {
+ if (equal(d, cdr(p))) {
+ val(x) = Nil;
+ return YES;
+ }
+ return NO;
+ }
+ if (match(cdr(p), cdr(d))) {
+ val(x) = cons(car(d), Nil);
+ return YES;
+ }
+ if (match(cdr(p), d)) {
+ val(x) = Nil;
+ return YES;
+ }
+ if (match(p, cdr(d))) {
+ val(x) = cons(car(d), val(x));
+ return YES;
+ }
+ }
+ if (!isCell(d) || !(match(x, car(d))))
+ return NO;
+ p = cdr(p);
+ d = cdr(d);
+ }
+}
+
+// (match 'lst1 'lst2) -> flg
+any doMatch(any x) {
+ cell c1, c2;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ x = match(data(c1), data(c2))? T : Nil;
+ drop(c1);
+ return x;
+}
+
+// Fill template structure
+static any fill(any x, any s) {
+ any y;
+ cell c1;
+
+ if (isNum(x))
+ return NULL;
+ if (isSym(x))
+ return
+ (isNil(s)? x!=At && firstByte(x)=='@' : memq(x,s)!=NULL)?
+ val(x) : NULL;
+ if (y = fill(car(x),s)) {
+ Push(c1,y);
+ y = fill(cdr(x),s);
+ return cons(Pop(c1), y ?: cdr(x));
+ }
+ if (y = fill(cdr(x),s))
+ return cons(car(x), y);
+ return NULL;
+}
+
+// (fill 'any ['sym|lst]) -> any
+any doFill(any x) {
+ cell c1, c2;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ if (x = fill(data(c1),data(c2))) {
+ drop(c1);
+ return x;
+ }
+ return Pop(c1);
+}
+
+/* Declarative Programming */
+cell *Penv, *Pnl;
+
+static bool unify(any n1, any x1, any n2, any x2) {
+ any x, env;
+
+ lookup1:
+ if (isSymb(x1) && firstByte(x1) == '@')
+ for (x = data(*Penv); isCell(car(x)); x = cdr(x))
+ if (n1 == caaar(x) && x1 == cdaar(x)) {
+ n1 = cadar(x);
+ x1 = cddar(x);
+ goto lookup1;
+ }
+ lookup2:
+ if (isSymb(x2) && firstByte(x2) == '@')
+ for (x = data(*Penv); isCell(car(x)); x = cdr(x))
+ if (n2 == caaar(x) && x2 == cdaar(x)) {
+ n2 = cadar(x);
+ x2 = cddar(x);
+ goto lookup2;
+ }
+ if (n1 == n2 && equal(x1, x2))
+ return YES;
+ if (isSymb(x1) && firstByte(x1) == '@') {
+ if (x1 != At) {
+ data(*Penv) = cons(cons(cons(n1,x1), Nil), data(*Penv));
+ cdar(data(*Penv)) = cons(n2,x2);
+ }
+ return YES;
+ }
+ if (isSymb(x2) && firstByte(x2) == '@') {
+ if (x2 != At) {
+ data(*Penv) = cons(cons(cons(n2,x2), Nil), data(*Penv));
+ cdar(data(*Penv)) = cons(n1,x1);
+ }
+ return YES;
+ }
+ if (!isCell(x1) || !isCell(x2))
+ return equal(x1, x2);
+ env = data(*Penv);
+ if (unify(n1, car(x1), n2, car(x2)) && unify(n1, cdr(x1), n2, cdr(x2)))
+ return YES;
+ data(*Penv) = env;
+ return NO;
+}
+
+static any lup(any n, any x) {
+ any y;
+ cell c1;
+
+ lup:
+ if (isSymb(x) && firstByte(x) == '@')
+ for (y = data(*Penv); isCell(car(y)); y = cdr(y))
+ if (n == caaar(y) && x == cdaar(y)) {
+ n = cadar(y);
+ x = cddar(y);
+ goto lup;
+ }
+ if (!isCell(x))
+ return x;
+ Push(c1, lup(n, car(x)));
+ x = lup(n, cdr(x));
+ return cons(Pop(c1), x);
+}
+
+static any lookup(any n, any x) {
+ return isSymb(x = lup(n,x)) && firstByte(x)=='@'? Nil : x;
+}
+
+static any uniFill(any x) {
+ cell c1;
+
+ if (isNum(x))
+ return x;
+ if (isSym(x))
+ return lup(car(data(*Pnl)), x);
+ Push(c1, uniFill(car(x)));
+ x = uniFill(cdr(x));
+ return cons(Pop(c1), x);
+}
+
+// (prove 'lst ['lst]) -> lst
+any doProve(any x) {
+ int i;
+ cell *envSave, *nlSave, q, dbg, env, n, nl, alt, tp1, tp2, e;
+
+ x = cdr(x);
+ if (!isCell(data(q) = EVAL(car(x))))
+ return Nil;
+ Save(q);
+ envSave = Penv, Penv = &env, nlSave = Pnl, Pnl = &nl;
+ if (x = cdr(x), isNil(x = EVAL(car(x))))
+ data(dbg) = NULL;
+ else
+ Push(dbg, x);
+ Push(env, caar(data(q))), car(data(q)) = cdar(data(q));
+ Push(n, car(data(env))), data(env) = cdr(data(env));
+ Push(nl, car(data(env))), data(env) = cdr(data(env));
+ Push(alt, car(data(env))), data(env) = cdr(data(env));
+ Push(tp1, car(data(env))), data(env) = cdr(data(env));
+ Push(tp2, car(data(env))), data(env) = cdr(data(env));
+ Push(e,Nil);
+ while (isCell(data(tp1)) || isCell(data(tp2))) {
+ if (isCell(data(alt))) {
+ data(e) = data(env);
+ if (!unify(car(data(nl)), cdar(data(tp1)), data(n), caar(data(alt)))) {
+ if (!isCell(data(alt) = cdr(data(alt)))) {
+ data(env) = caar(data(q)), car(data(q)) = cdar(data(q));
+ data(n) = car(data(env)), data(env) = cdr(data(env));
+ data(nl) = car(data(env)), data(env) = cdr(data(env));
+ data(alt) = car(data(env)), data(env) = cdr(data(env));
+ data(tp1) = car(data(env)), data(env) = cdr(data(env));
+ data(tp2) = car(data(env)), data(env) = cdr(data(env));
+ }
+ }
+ else {
+ if (data(dbg) && memq(caar(data(tp1)), data(dbg))) {
+ outNum(indx(car(data(alt)), get(caar(data(tp1)), T)));
+ space();
+ print(uniFill(car(data(tp1)))), crlf();
+ }
+ if (isCell(cdr(data(alt))))
+ car(data(q)) =
+ cons(
+ cons(data(n),
+ cons(data(nl),
+ cons(cdr(data(alt)),
+ cons(data(tp1), cons(data(tp2),data(e))) ) ) ),
+ car(data(q)) );
+ data(nl) = cons(data(n), data(nl));
+ data(n) = (any)(num(data(n)) + 4);
+ data(tp2) = cons(cdr(data(tp1)), data(tp2));
+ data(tp1) = cdar(data(alt));
+ data(alt) = Nil;
+ }
+ }
+ else if (!isCell(x = data(tp1))) {
+ data(tp1) = car(data(tp2)), data(tp2) = cdr(data(tp2));
+ data(nl) = cdr(data(nl));
+ }
+ else if (car(x) == T) {
+ while (isCell(car(data(q))) && num(caaar(data(q))) >= num(car(data(nl))))
+ car(data(q)) = cdar(data(q));
+ data(tp1) = cdr(x);
+ }
+ else if (isNum(caar(x))) {
+ data(e) = EVAL(cdar(x));
+ for (i = unBox(caar(x)), x = data(nl); --i > 0;)
+ x = cdr(x);
+ data(nl) = cons(car(x), data(nl));
+ data(tp2) = cons(cdr(data(tp1)), data(tp2));
+ data(tp1) = data(e);
+ }
+ else if (isSym(caar(x)) && firstByte(caar(x)) == '@') {
+ if (!isNil(data(e) = EVAL(cdar(x))) &&
+ unify(car(data(nl)), caar(x), car(data(nl)), data(e)) )
+ data(tp1) = cdr(x);
+ else {
+ data(env) = caar(data(q)), car(data(q)) = cdar(data(q));
+ data(n) = car(data(env)), data(env) = cdr(data(env));
+ data(nl) = car(data(env)), data(env) = cdr(data(env));
+ data(alt) = car(data(env)), data(env) = cdr(data(env));
+ data(tp1) = car(data(env)), data(env) = cdr(data(env));
+ data(tp2) = car(data(env)), data(env) = cdr(data(env));
+ }
+ }
+ else if (!isCell(data(alt) = get(caar(x), T))) {
+ data(env) = caar(data(q)), car(data(q)) = cdar(data(q));
+ data(n) = car(data(env)), data(env) = cdr(data(env));
+ data(nl) = car(data(env)), data(env) = cdr(data(env));
+ data(alt) = car(data(env)), data(env) = cdr(data(env));
+ data(tp1) = car(data(env)), data(env) = cdr(data(env));
+ data(tp2) = car(data(env)), data(env) = cdr(data(env));
+ }
+ }
+ for (data(e) = Nil, x = data(env); isCell(cdr(x)); x = cdr(x))
+ if (caaar(x) == Zero)
+ data(e) = cons(cons(cdaar(x), lookup(Zero, cdaar(x))), data(e));
+ drop(q);
+ Penv = envSave, Pnl = nlSave;
+ return isCell(data(e))? data(e) : isCell(data(env))? T : Nil;
+}
+
+// (-> sym [num]) -> any
+any doLookup(any x) {
+ int i;
+ any y;
+
+ if (!isNum(caddr(x)))
+ return lookup(car(data(*Pnl)), cadr(x));
+ for (i = unBox(caddr(x)), y = data(*Pnl); --i > 0;)
+ y = cdr(y);
+ return lookup(car(y), cadr(x));
+}
+
+// (unify 'any) -> lst
+any doUnify(any x) {
+ cell c1;
+
+ Push(c1, EVAL(cadr(x)));
+ if (unify(cadr(data(*Pnl)), data(c1), car(data(*Pnl)), data(c1))) {
+ drop(c1);
+ return data(*Penv);
+ }
+ drop(c1);
+ return Nil;
+}
+
+/* List Merge Sort: Bill McDaniel, DDJ Jun99 */
+// (sort 'lst) -> lst
+any doSort(any x) {
+ int i;
+ any p, in[2], out[2], last;
+ any *tail[2];
+
+ x = cdr(x);
+ if (!isCell(out[0] = EVAL(car(x))))
+ return out[0];
+
+ out[1] = Nil;
+
+ do {
+ in[0] = out[0];
+ in[1] = out[1];
+
+ i = isCell(in[1]) && compare(in[0], in[1]) >= 0;
+ if (isCell(p = in[i]))
+ in[i] = cdr(in[i]);
+ out[0] = p;
+ tail[0] = &cdr(p);
+ last = out[0];
+ cdr(p) = Nil;
+ i = 0;
+ out[1] = Nil;
+ tail[1] = &out[1];
+
+ while (isCell(in[0]) || isCell(in[1])) {
+ if (!isCell(in[1])) {
+ if (isCell(p = in[0]))
+ in[0] = cdr(in[0]);
+ if (compare(p,last) < 0)
+ i = 1-i;
+ }
+ else if (!isCell(in[0])) {
+ p = in[1], in[1] = cdr(in[1]);
+ if (compare(p,last) < 0)
+ i = 1-i;
+ }
+ else if (compare(in[0],last) < 0) {
+ if (compare(in[1],last) >= 0)
+ p = in[1], in[1] = cdr(in[1]);
+ else {
+ if (compare(in[0],in[1]) < 0)
+ p = in[0], in[0] = cdr(in[0]);
+ else
+ p = in[1], in[1] = cdr(in[1]);
+ i = 1-i;
+ }
+ }
+ else {
+ if (compare(in[1],last) < 0)
+ p = in[0], in[0] = cdr(in[0]);
+ else {
+ if (compare(in[0],in[1]) < 0)
+ p = in[0], in[0] = cdr(in[0]);
+ else
+ p = in[1], in[1] = cdr(in[1]);
+ }
+ }
+ *tail[i] = p;
+ tail[i] = &cdr(p);
+ cdr(p) = Nil;
+ last = p;
+ }
+ } while (isCell(out[1]));
+ return out[0];
+}
diff --git a/src/sym.c b/src/sym.c
@@ -0,0 +1,1570 @@
+/* 01apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static byte Ascii6[] = {
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 4, 6,
+ 27, 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 8, 51, 10, 53,
+ 55, 57, 59, 61, 63, 65, 67, 69, 71, 73, 75, 77, 79, 81, 83, 85,
+ 87, 89, 91, 93, 95, 97, 99, 101, 103, 105, 107, 109, 111, 113, 115, 117,
+ 119, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40,
+ 42, 44, 46, 48, 50, 52, 54, 56, 58, 60, 62, 121, 123, 125, 127, 0
+};
+
+static byte Ascii7[] = {
+ 0, 33, 32, 34, 46, 35, 47, 36, 60, 37, 62, 38, 97, 39, 98, 40,
+ 99, 41, 100, 42, 101, 43, 102, 44, 103, 45, 104, 48, 105, 49, 106, 50,
+ 107, 51, 108, 52, 109, 53, 110, 54, 111, 55, 112, 56, 113, 57, 114, 58,
+ 115, 59, 116, 61, 117, 63, 118, 64, 119, 65, 120, 66, 121, 67, 122, 68,
+ 0, 69, 0, 70, 0, 71, 0, 72, 0, 73, 0, 74, 0, 75, 0, 76,
+ 0, 77, 0, 78, 0, 79, 0, 80, 0, 81, 0, 82, 0, 83, 0, 84,
+ 0, 85, 0, 86, 0, 87, 0, 88, 0, 89, 0, 90, 0, 91, 0, 92,
+ 0, 93, 0, 94, 0, 95, 0, 96, 0, 123, 0, 124, 0, 125, 0, 126
+};
+
+
+int firstByte(any s) {
+ int c;
+
+ if (isNil(s))
+ return 0;
+ c = (int)(isTxt(s = name(s))? (word)s >> 1 : (word)tail(s));
+ return Ascii7[c & (c & 1? 127 : 63)];
+}
+
+int secondByte(any s) {
+ int c;
+
+ if (isNil(s))
+ return 0;
+ c = (int)(isTxt(s = name(s))? (word)s >> 1 : (word)tail(s));
+ c >>= c & 1? 7 : 6;
+ return Ascii7[c & (c & 1? 127 : 63)];
+}
+
+int getByte1(int *i, word *p, any *q) {
+ int c;
+
+ if (isTxt(*q))
+ *i = BITS-1, *p = (word)*q >> 1, *q = NULL;
+ else
+ *i = BITS, *p = (word)tail(*q), *q = val(*q);
+ if (*p & 1)
+ c = Ascii7[*p & 127], *p >>= 7, *i -= 7;
+ else
+ c = Ascii7[*p & 63], *p >>= 6, *i -= 6;
+ return c;
+}
+
+int getByte(int *i, word *p, any *q) {
+ int c;
+
+ if (*i == 0) {
+ if (!*q)
+ return 0;
+ if (isNum(*q))
+ *i = BITS-2, *p = (word)*q >> 2, *q = NULL;
+ else
+ *i = BITS, *p = (word)tail(*q), *q = val(*q);
+ }
+ if (*p & 1) {
+ c = *p & 127, *p >>= 7;
+ if (*i >= 7)
+ *i -= 7;
+ else if (isNum(*q)) {
+ *p = (word)*q >> 2, *q = NULL;
+ c |= *p << *i;
+ *p >>= 7 - *i;
+ *i += BITS-9;
+ }
+ else {
+ *p = (word)tail(*q), *q = val(*q);
+ c |= *p << *i;
+ *p >>= 7 - *i;
+ *i += BITS-7;
+ }
+ c &= 127;
+ }
+ else {
+ c = *p & 63, *p >>= 6;
+ if (*i >= 6)
+ *i -= 6;
+ else if (!*q)
+ return 0;
+ else if (isNum(*q)) {
+ *p = (word)*q >> 2, *q = NULL;
+ c |= *p << *i;
+ *p >>= 6 - *i;
+ *i += BITS-8;
+ }
+ else {
+ *p = (word)tail(*q), *q = val(*q);
+ c |= *p << *i;
+ *p >>= 6 - *i;
+ *i += BITS-6;
+ }
+ c &= 63;
+ }
+ return Ascii7[c];
+}
+
+any mkTxt(int c) {return txt(Ascii6[c & 127]);}
+
+any mkChar(int c) {
+ return consSym(NULL, Ascii6[c & 127]);
+}
+
+any mkChar2(int c, int d) {
+ c = Ascii6[c & 127];
+ d = Ascii6[d & 127];
+ return consSym(NULL, d << (c & 1? 7 : 6) | c);
+}
+
+void putByte0(int *i, word *p, any *q) {
+ *i = 0, *p = 0, *q = NULL;
+}
+
+void putByte1(int c, int *i, word *p, any *q) {
+ *i = (*p = Ascii6[c & 127]) & 1? 7 : 6;
+ *q = NULL;
+}
+
+void putByte(int c, int *i, word *p, any *q, cell *cp) {
+ int d = (c = Ascii6[c & 127]) & 1? 7 : 6;
+
+ if (*i != BITS)
+ *p |= (word)c << *i;
+ if (*i + d > BITS) {
+ if (*q)
+ *q = val(*q) = consName(*p, Zero);
+ else {
+ Push(*cp, consSym(NULL,0));
+ tail(data(*cp)) = *q = consName(*p, Zero);
+ }
+ *p = c >> BITS - *i;
+ *i -= BITS;
+ }
+ *i += d;
+}
+
+any popSym(int i, word n, any q, cell *cp) {
+ if (q) {
+ val(q) = i <= (BITS-2)? box(n) : consName(n, Zero);
+ return Pop(*cp);
+ }
+ if (i > BITS-1) {
+ Push(*cp, consSym(NULL,0));
+ tail(data(*cp)) = consName(n, Zero);
+ return Pop(*cp);
+ }
+ return consSym(NULL,n);
+}
+
+int symBytes(any x) {
+ int cnt = 0;
+ word w;
+
+ if (isNil(x))
+ return 0;
+ x = name(x);
+ if (isTxt(x)) {
+ w = (word)x >> 1;
+ while (w)
+ ++cnt, w >>= w & 1? 7 : 6;
+ }
+ else {
+ do {
+ w = (word)tail(x);
+ do
+ ++cnt;
+ while (w >>= w & 1? 7 : 6);
+ } while (!isNum(x = val(x)));
+ w = (word)x >> 2;
+ while (w)
+ ++cnt, w >>= w & 1? 7 : 6;
+ }
+ return cnt;
+}
+
+any isIntern(any nm, any tree[2]) {
+ any x, y, z;
+ long n;
+
+ if (isTxt(nm)) {
+ for (x = tree[0]; isCell(x);) {
+ if ((n = (word)nm - (word)name(car(x))) == 0)
+ return car(x);
+ x = n<0? cadr(x) : cddr(x);
+ }
+ }
+ else {
+ for (x = tree[1]; isCell(x);) {
+ y = nm, z = name(car(x));
+ for (;;) {
+ if ((n = (word)tail(y) - (word)tail(z)) != 0) {
+ x = n<0? cadr(x) : cddr(x);
+ break;
+ }
+ y = val(y), z = val(z);
+ if (isNum(y)) {
+ if (y == z)
+ return car(x);
+ x = isNum(z) && y>z? cddr(x) : cadr(x);
+ break;
+ }
+ if (isNum(z)) {
+ x = cddr(x);
+ break;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+any intern(any sym, any tree[2]) {
+ any nm, x, y, z;
+ long n;
+
+ if ((nm = name(sym)) == txt(0))
+ return sym;
+ if (isTxt(nm)) {
+ if (!isCell(x = tree[0])) {
+ tree[0] = cons(sym, Nil);
+ return sym;
+ }
+ for (;;) {
+ if ((n = (word)nm - (word)name(car(x))) == 0)
+ return car(x);
+ if (!isCell(cdr(x))) {
+ cdr(x) = n<0? cons(cons(sym,Nil), Nil) : cons(Nil, cons(sym,Nil));
+ return sym;
+ }
+ if (n < 0) {
+ if (isCell(cadr(x)))
+ x = cadr(x);
+ else {
+ cadr(x) = cons(sym, Nil);
+ return sym;
+ }
+ }
+ else {
+ if (isCell(cddr(x)))
+ x = cddr(x);
+ else {
+ cddr(x) = cons(sym, Nil);
+ return sym;
+ }
+ }
+ }
+ }
+ else {
+ if (!isCell(x = tree[1])) {
+ tree[1] = cons(sym, Nil);
+ return sym;
+ }
+ for (;;) {
+ y = nm, z = name(car(x));
+ while ((n = (word)tail(y) - (word)tail(z)) == 0) {
+ y = val(y), z = val(z);
+ if (isNum(y)) {
+ if (y == z)
+ return car(x);
+ n = isNum(z)? y-z : -1;
+ break;
+ }
+ if (isNum(z)) {
+ n = +1;
+ break;
+ }
+ }
+ if (!isCell(cdr(x))) {
+ cdr(x) = n<0? cons(cons(sym,Nil), Nil) : cons(Nil, cons(sym,Nil));
+ return sym;
+ }
+ if (n < 0) {
+ if (isCell(cadr(x)))
+ x = cadr(x);
+ else {
+ cadr(x) = cons(sym, Nil);
+ return sym;
+ }
+ }
+ else {
+ if (isCell(cddr(x)))
+ x = cddr(x);
+ else {
+ cddr(x) = cons(sym, Nil);
+ return sym;
+ }
+ }
+ }
+ }
+}
+
+void unintern(any sym, any tree[2]) {
+ any nm, x, y, z, *p;
+ long n;
+
+ if ((nm = name(sym)) == txt(0))
+ return;
+ if (isTxt(nm)) {
+ if (!isCell(x = tree[0]))
+ return;
+ p = &tree[0];
+ for (;;) {
+ if ((n = (word)nm - (word)name(car(x))) == 0) {
+ if (!isCell(cadr(x)))
+ *p = cddr(x);
+ else if (!isCell(y = cddr(x)))
+ *p = cadr(x);
+ else if (!isCell(z = cadr(y)))
+ car(x) = car(y), cddr(x) = cddr(y);
+ else {
+ while (isCell(cadr(z)))
+ z = cadr(y = z);
+ car(x) = car(z), cadr(y) = cddr(z);
+ }
+ return;
+ }
+ if (!isCell(cdr(x)))
+ return;
+ if (n < 0) {
+ if (!isCell(cadr(x)))
+ return;
+ x = *(p = &cadr(x));
+ }
+ else {
+ if (!isCell(cddr(x)))
+ return;
+ x = *(p = &cddr(x));
+ }
+ }
+ }
+ else {
+ if (!isCell(x = tree[1]))
+ return;
+ p = &tree[1];
+ for (;;) {
+ y = nm, z = name(car(x));
+ while ((n = (word)tail(y) - (word)tail(z)) == 0) {
+ y = val(y), z = val(z);
+ if (isNum(y)) {
+ if (y == z) {
+ if (!isCell(cadr(x)))
+ *p = cddr(x);
+ else if (!isCell(y = cddr(x)))
+ *p = cadr(x);
+ else if (!isCell(z = cadr(y)))
+ car(x) = car(y), cddr(x) = cddr(y);
+ else {
+ while (isCell(cadr(z)))
+ z = cadr(y = z);
+ car(x) = car(z), cadr(y) = cddr(z);
+ }
+ return;
+ }
+ n = isNum(z)? y-z : -1;
+ break;
+ }
+ if (isNum(z)) {
+ n = +1;
+ break;
+ }
+ }
+ if (!isCell(cdr(x)))
+ return;
+ if (n < 0) {
+ if (!isCell(cadr(x)))
+ return;
+ x = *(p = &cadr(x));
+ }
+ else {
+ if (!isCell(cddr(x)))
+ return;
+ x = *(p = &cddr(x));
+ }
+ }
+ }
+}
+
+/* Get symbol name */
+any name(any s) {
+ for (s = tail(s); isCell(s); s = car(s));
+ return s;
+}
+
+// (name 'sym ['sym2]) -> sym
+any doName(any ex) {
+ any x, y, *p;
+ cell c1;
+
+ x = cdr(ex), data(c1) = EVAL(car(x));
+ NeedSymb(ex,data(c1));
+ y = isNil(data(c1))? txt(0) : name(data(c1));
+ if (!isCell(x = cdr(x))) {
+ if (y == txt(0))
+ return Nil;
+ Save(c1);
+ tail(x = consSym(NULL,0)) = y;
+ drop(c1);
+ return x;
+ }
+ if (isNil(data(c1)) || data(c1) == isIntern(y, Intern))
+ err(ex, data(c1), "Can't rename");
+ Save(c1);
+ x = EVAL(car(x));
+ NeedSymb(ex,x);
+ for (p = &tail(data(c1)); isCell(*p); p = &car(*p));
+ *p = name(x);
+ return Pop(c1);
+}
+
+/* Make name */
+any mkSym(byte *s) {
+ int i;
+ word w;
+ cell c1, *p;
+
+ putByte1(*s++, &i, &w, &p);
+ while (*s)
+ putByte(*s++, &i, &w, &p, &c1);
+ return popSym(i, w, p, &c1);
+}
+
+/* Make string */
+any mkStr(char *s) {return s && *s? mkSym((byte*)s) : Nil;}
+
+bool isBlank(any x) {
+ int i, c;
+ word w;
+
+ if (!isSymb(x))
+ return NO;
+ if (isNil(x))
+ return YES;
+ x = name(x);
+ for (c = getByte1(&i, &w, &x); c; c = getByte(&i, &w, &x))
+ if (c > ' ')
+ return NO;
+ return YES;
+}
+
+// (sp? 'any) -> flg
+any doSpQ(any x) {
+ x = cdr(x);
+ return isBlank(EVAL(car(x)))? T : Nil;
+}
+
+// (pat? 'any) -> sym | NIL
+any doPatQ(any x) {
+ x = cdr(x);
+ return isSymb(x = EVAL(car(x))) && firstByte(x) == '@'? x : Nil;
+}
+
+// (fun? 'any) -> any
+any doFunQ(any x) {
+ any y;
+
+ x = cdr(x);
+ if (isNum(x = EVAL(car(x))))
+ return x;
+ if (isSym(x))
+ return Nil;
+ for (y = cdr(x); isCell(y) && y != x; y = cdr(y)) {
+ if (isCell(car(y))) {
+ if (isCell(cdr(y)) && isNum(caar(y)))
+ return Nil;
+ if (isNil(caar(y)) || caar(y) == T)
+ return Nil;
+ }
+ else if (!isNil(cdr(y)))
+ return Nil;
+ }
+ if (!isNil(y))
+ return Nil;
+ if (isNil(x = car(x)))
+ return T;
+ for (y = x; isCell(y);)
+ if (isNum(car(y)) || isCell(car(y)) || isNil(car(y)) || car(y)==T || x==(y=cdr(y)))
+ return Nil;
+ return isNum(y) || y==T? Nil : x;
+}
+
+// (all ['T]) -> lst
+static void all(any x, cell *p) {
+ if (isCell(cddr(x)))
+ all(cddr(x), p);
+ data(*p) = cons(car(x), data(*p));
+ if (isCell(cadr(x)))
+ all(cadr(x), p);
+}
+
+any doAll(any x) {
+ any *p;
+ cell c1;
+
+ x = cdr(x);
+ p = isNil(EVAL(car(x)))? Intern : Transient;
+ Push(c1, Nil);
+ if (isCell(p[1]))
+ all(p[1], &c1);
+ if (isCell(p[0]))
+ all(p[0], &c1);
+ return Pop(c1);
+}
+
+// (intern 'sym) -> sym
+any doIntern(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedSymb(ex,x);
+ return intern(x, Intern);
+}
+
+// (==== ['sym ..]) -> NIL
+any doHide(any ex) {
+ any x, y;
+
+ Transient[0] = Transient[1] = Nil;
+ for (x = cdr(ex); isCell(x); x = cdr(x)) {
+ y = EVAL(car(x));
+ NeedSymb(ex,y);
+ intern(y, Transient);
+ }
+ return Nil;
+}
+
+// (box? 'any) -> sym | NIL
+any doBoxQ(any x) {
+ x = cdr(x);
+ return isSymb(x = EVAL(car(x))) && name(x) == txt(0)? x : Nil;
+}
+
+// (str? 'any) -> sym | NIL
+any doStrQ(any x) {
+ any y;
+
+ x = cdr(x);
+ return isSymb(x = EVAL(car(x))) &&
+ (y = name(x)) != txt(0) &&
+ x != isIntern(y, Intern)? x : Nil;
+}
+
+// (zap 'sym) -> sym
+any doZap(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedSymb(ex,x);
+ if (x >= Nil && x <= Bye)
+ protError(ex,x);
+ unintern(x, Intern);
+ return x;
+}
+
+// (chop 'any) -> lst
+any doChop(any x) {
+ any y;
+ int i, c;
+ word w;
+ cell c1, c2;
+
+ if (isCell(x = EVAL(cadr(x))) || isNil(x))
+ return x;
+ x = name(data(c1) = xSym(x));
+ if (!(c = getByte1(&i, &w, &x)))
+ return Nil;
+ Save(c1);
+ Push(c2, y = cons(mkChar(c), Nil));
+ while (c = getByte(&i, &w, &x))
+ y = cdr(y) = cons(mkChar(c), Nil);
+ drop(c1);
+ return data(c2);
+}
+
+void pack(any x, int *i, word *p, any *q, cell *cp) {
+ int c, j;
+ word w;
+
+ if (isCell(x))
+ do
+ pack(car(x), i, p, q, cp);
+ while (isCell(x = cdr(x)));
+ if (isNum(x)) {
+ char buf[BITS/2], *b = buf;
+
+ bufNum(buf, unBox(x));
+ do
+ putByte(*b++, i, p, q, cp);
+ while (*b);
+ }
+ else if (!isNil(x))
+ for (x = name(x), c = getByte1(&j, &w, &x); c; c = getByte(&j, &w, &x))
+ putByte(c, i, p, q, cp);
+}
+
+// (pack 'any ..) -> sym
+any doPack(any x) {
+ int i;
+ word w;
+ any y;
+ cell c1, c2;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ putByte0(&i, &w, &y);
+ pack(data(c1), &i, &w, &y, &c2);
+ while (isCell(x = cdr(x)))
+ pack(data(c1) = EVAL(car(x)), &i, &w, &y, &c2);
+ y = popSym(i, w, y, &c2);
+ drop(c1);
+ return i? y : Nil;
+}
+
+// (glue 'any 'lst) -> sym
+any doGlue(any x) {
+ int i;
+ word w;
+ any y;
+ cell c1, c2, c3;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, x = EVAL(car(x)));
+ if (!isCell(x)) {
+ drop(c1);
+ return x;
+ }
+ putByte0(&i, &w, &y);
+ pack(car(x), &i, &w, &y, &c3);
+ while (isCell(x = cdr(x))) {
+ pack(data(c1), &i, &w, &y, &c3);
+ pack(car(x), &i, &w, &y, &c3);
+ }
+ y = popSym(i, w, y, &c3);
+ drop(c1);
+ return i? y : Nil;
+}
+
+// (text 'sym 'any ..) -> sym
+any doText(any x) {
+ int c, n, i1, i2;
+ word w1, w2;
+ any nm1, nm2;
+ cell c1, c2;
+
+ nm1 = name(data(c1) = evSym(x = cdr(x)));
+ if (!(c = getByte1(&i1, &w1, &nm1)))
+ return Nil;
+ Save(c1);
+ {
+ cell arg[length(x = cdr(x))];
+
+ for (n = 0; isCell(x); ++n, x = cdr(x))
+ Push(arg[n], EVAL(car(x)));
+
+ putByte0(&i2, &w2, &nm2);
+ do {
+ if (c != '@')
+ putByte(c, &i2, &w2, &nm2, &c2);
+ else if (!(c = getByte(&i1, &w1, &nm1)))
+ break;
+ else if (c == '@')
+ putByte('@', &i2, &w2, &nm2, &c2);
+ else if (c >= '1') {
+ if ((c -= '1') > 8)
+ c -= 7;
+ if (n > c)
+ pack(data(arg[c]), &i2, &w2, &nm2, &c2);
+ }
+ } while (c = getByte(&i1, &w1, &nm1));
+ nm2 = popSym(i2, w2, nm2, &c2);
+ drop(c1);
+ return nm2;
+ }
+}
+
+// (pre? 'sym1 'sym2) -> flg
+any doPreQ(any ex) {
+ int c, i1, i2;
+ word w1, w2;
+ any x, y;
+ cell c1;
+
+ x = cdr(ex);
+ if (isNil(y = EVAL(car(x))))
+ return T;
+ NeedSymb(ex,y);
+ Push(c1, y);
+ x = cdr(x), x = EVAL(car(x));
+ drop(c1);
+ if (isNil(x))
+ return Nil;
+ NeedSymb(ex,x);
+ y = name(y);
+ if (!(c = getByte1(&i1, &w1, &y)))
+ return T;
+ x = name(x);
+ if (c != getByte1(&i2, &w2, &x))
+ return Nil;
+ for (;;) {
+ if (!(c = getByte(&i1, &w1, &y)))
+ return T;
+ if (c != getByte(&i2, &w2, &x))
+ return Nil;
+ }
+}
+
+// (val 'var) -> any
+any doVal(any ex) {
+ any x;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedVar(ex,x);
+ return val(x);
+}
+
+// (set 'var 'any ..) -> any
+any doSet(any ex) {
+ any x;
+ cell c1;
+
+ x = cdr(ex);
+ do {
+ Push(c1, EVAL(car(x))), x = cdr(x);
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ val(data(c1)) = EVAL(car(x)), x = cdr(x);
+ drop(c1);
+ } while (isCell(x));
+ return val(data(c1));
+}
+
+// (setq var 'any ..) -> any
+any doSetq(any ex) {
+ any x, y;
+
+ x = cdr(ex);
+ do {
+ y = car(x), x = cdr(x);
+ NeedVar(ex,y);
+ CheckVar(ex,y);
+ val(y) = EVAL(car(x));
+ } while (isCell(x = cdr(x)));
+ return val(y);
+}
+
+// (xchg 'var 'var ..) -> any
+any doXchg(any ex) {
+ any x, y, z;
+ cell c1;
+
+ x = cdr(ex);
+ do {
+ Push(c1, EVAL(car(x))), x = cdr(x);
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ y = EVAL(car(x)), x = cdr(x);
+ NeedVar(ex,y);
+ CheckVar(ex,y);
+ z = val(data(c1)), val(data(c1)) = val(y), val(y) = z;
+ drop(c1);
+ } while (isCell(x));
+ return z;
+}
+
+// (on sym ..) -> T
+any doOn(any ex) {
+ any x = cdr(ex);
+ do {
+ NeedSymb(ex,car(x));
+ val(car(x)) = T;
+ } while (isCell(x = cdr(x)));
+ return T;
+}
+
+// (off sym ..) -> NIL
+any doOff(any ex) {
+ any x = cdr(ex);
+ do {
+ NeedSymb(ex,car(x));
+ val(car(x)) = Nil;
+ } while (isCell(x = cdr(x)));
+ return Nil;
+}
+
+// (onOff sym ..) -> flg
+any doOnOff(any ex) {
+ any x = cdr(ex);
+ any y;
+
+ do {
+ NeedSymb(ex,car(x));
+ y = val(car(x)) = isNil(val(car(x)))? T : Nil;
+ } while (isCell(x = cdr(x)));
+ return y;
+}
+
+// (zero sym ..) -> 0
+any doZero(any ex) {
+ any x = cdr(ex);
+ do {
+ NeedSymb(ex,car(x));
+ val(car(x)) = Zero;
+ } while (isCell(x = cdr(x)));
+ return Zero;
+}
+
+// (one sym ..) -> 1
+any doOne(any ex) {
+ any x = cdr(ex);
+ do {
+ NeedSymb(ex,car(x));
+ val(car(x)) = One;
+ } while (isCell(x = cdr(x)));
+ return One;
+}
+
+// (default sym 'any ..) -> any
+any doDefault(any ex) {
+ any x, y;
+
+ x = cdr(ex);
+ do {
+ y = car(x), x = cdr(x);
+ NeedSymb(ex,y);
+ if (isNil(val(y)))
+ val(y) = EVAL(car(x));
+ } while (isCell(x = cdr(x)));
+ return val(y);
+}
+
+// (push 'var 'any ..) -> any
+any doPush(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ x = cdr(x);
+ val(data(c1)) = cons(y = EVAL(car(x)), val(data(c1)));
+ while (isCell(x = cdr(x)))
+ val(data(c1)) = cons(y = EVAL(car(x)), val(data(c1)));
+ drop(c1);
+ return y;
+}
+
+// (push1 'var 'any ..) -> any
+any doPush1(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ x = cdr(x);
+ if (!member(y = EVAL(car(x)), val(data(c1))))
+ val(data(c1)) = cons(y, val(data(c1)));
+ while (isCell(x = cdr(x)))
+ if (!member(y = EVAL(car(x)), val(data(c1))))
+ val(data(c1)) = cons(y, val(data(c1)));
+ drop(c1);
+ return y;
+}
+
+// (pop 'var) -> any
+any doPop(any ex) {
+ any x, y;
+
+ x = cdr(ex), x = EVAL(car(x));
+ NeedVar(ex,x);
+ CheckVar(ex,x);
+ if (!isCell(y = val(x)))
+ return y;
+ val(x) = cdr(y);
+ return car(y);
+}
+
+// (cut 'num 'var) -> lst
+any doCut(any ex) {
+ long n;
+ any x, y;
+ cell c1, c2;
+
+ if ((n = evNum(ex, x = cdr(ex))) <= 0)
+ return Nil;
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ if (isCell(val(data(c1)))) {
+ Push(c2, y = cons(car(val(data(c1))), Nil));
+ while (isCell(val(data(c1)) = cdr(val(data(c1)))) && --n)
+ y = cdr(y) = cons(car(val(data(c1))), Nil);
+ drop(c1);
+ return data(c2);
+ }
+ return val(Pop(c1));
+}
+
+// (del 'any 'var) -> lst
+any doDel(any ex) {
+ any x, y;
+ cell c1, c2, c3;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ NeedVar(ex,data(c2));
+ CheckVar(ex,data(c2));
+ if (isCell(x = val(data(c2)))) {
+ if (equal(data(c1), car(x))) {
+ drop(c1);
+ return val(data(c2)) = cdr(x);
+ }
+ Push(c3, y = cons(car(x), Nil));
+ while (isCell(x = cdr(x))) {
+ if (equal(data(c1), car(x))) {
+ cdr(y) = cdr(x);
+ drop(c1);
+ return val(data(c2)) = data(c3);
+ }
+ y = cdr(y) = cons(car(x), Nil);
+ }
+ }
+ drop(c1);
+ return val(data(c2));
+}
+
+// (queue 'var 'any) -> any
+any doQueue(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ x = cdr(x), x = EVAL(car(x));
+ if (!isCell(y = val(data(c1))))
+ val(data(c1)) = cons(x,Nil);
+ else {
+ while (isCell(cdr(y)))
+ y = cdr(y);
+ cdr(y) = cons(x,Nil);
+ }
+ drop(c1);
+ return x;
+}
+
+// (fifo 'var ['any ..]) -> any
+any doFifo(any ex) {
+ any x, y, z;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ if (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (isCell(z = val(data(c1))))
+ val(data(c1)) = z = cdr(z) = cons(y,cdr(z));
+ else
+ cdr(z) = z = val(data(c1)) = cons(y,Nil);
+ while (isCell(x = cdr(x)))
+ val(data(c1)) = z = cdr(z) = cons(y = EVAL(car(x)), cdr(z));
+ }
+ else if (!isCell(z = val(data(c1))))
+ y = Nil;
+ else {
+ if (z == cdr(z)) {
+ y = car(z);
+ val(data(c1)) = Nil;
+ }
+ else {
+ y = cadr(z);
+ cdr(z) = cddr(z);
+ }
+ }
+ drop(c1);
+ return y;
+}
+
+static void idx(any x, cell *p) {
+ if (isCell(cddr(x)))
+ idx(cddr(x), p);
+ data(*p) = cons(car(x), data(*p));
+ if (isCell(cadr(x)))
+ idx(cadr(x), p);
+}
+
+// (idx 'var 'any 'flg) -> lst
+// (idx 'var 'any) -> lst
+// (idx 'var) -> lst
+any doIdx(any ex) {
+ any x, y, z, *p;
+ int flg, n;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ NeedVar(ex,data(c1));
+ CheckVar(ex,data(c1));
+ if (!isCell(x = cdr(x))) {
+ Push(c2, Nil);
+ if (isCell(val(data(c1))))
+ idx(val(data(c1)), &c2);
+ drop(c1);
+ return data(c2);
+ }
+ Push(c2, EVAL(car(x)));
+ flg = !isCell(cdr(x))? 0 : isNil(EVAL(cadr(x)))? -1 : +1;
+ if (!isCell(x = val(data(c1)))) {
+ if (flg > 0)
+ val(data(c1)) = cons(data(c2),Nil);
+ drop(c1);
+ return Nil;
+ }
+ p = (any*)data(c1);
+ for (;;) {
+ if ((n = compare(data(c2), car(x))) == 0) {
+ if (flg < 0) {
+ if (!isCell(cadr(x)))
+ *p = cddr(x);
+ else if (!isCell(y = cddr(x)))
+ *p = cadr(x);
+ else if (!isCell(z = cadr(y)))
+ car(x) = car(y), cddr(x) = cddr(y);
+ else {
+ while (isCell(cadr(z)))
+ z = cadr(y = z);
+ car(x) = car(z), cadr(y) = cddr(z);
+ }
+ }
+ drop(c1);
+ return x;
+ }
+ if (!isCell(cdr(x))) {
+ if (flg > 0)
+ cdr(x) = n < 0?
+ cons(cons(data(c2),Nil), Nil) : cons(Nil, cons(data(c2),Nil));
+ drop(c1);
+ return Nil;
+ }
+ if (n < 0) {
+ if (!isCell(cadr(x))) {
+ if (flg > 0)
+ cadr(x) = cons(data(c2),Nil);
+ drop(c1);
+ return Nil;
+ }
+ x = *(p = &cadr(x));
+ }
+ else {
+ if (!isCell(cddr(x))) {
+ if (flg > 0)
+ cddr(x) = cons(data(c2),Nil);
+ drop(c1);
+ return Nil;
+ }
+ x = *(p = &cddr(x));
+ }
+ }
+}
+
+static any From, To;
+static cell LupCell;
+
+static void lup(any x) {
+ if (isCell(x)) {
+ if (car(x) == T)
+ lup(cadr(x));
+ else if (!isCell(car(x)))
+ lup(cddr(x));
+ else if (compare(To, caar(x)) >= 0) {
+ lup(cddr(x));
+ if (compare(From, caar(x)) <= 0) {
+ data(LupCell) = cons(car(x), data(LupCell));
+ lup(cadr(x));
+ }
+ }
+ else if (compare(From, caar(x)) <= 0)
+ lup(cadr(x));
+ }
+}
+
+// (lup 'lst 'any) -> lst
+// (lup 'lst 'any 'any2) -> lst
+any doLup(any x) {
+ int n;
+ cell c1, c2;
+
+ x = cdr(x), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ x = cdr(x);
+ if (!isNil(To = EVAL(car(x)))) {
+ From = data(c2);
+ Push(LupCell, Nil);
+ lup(data(c1));
+ drop(c1);
+ return data(LupCell);
+ }
+ while (isCell(data(c1))) {
+ if (car(data(c1)) == T)
+ data(c1) = cadr(data(c1));
+ else if (!isCell(car(data(c1))))
+ data(c1) = cddr(data(c1));
+ else if (n = compare(data(c2), caar(data(c1))))
+ data(c1) = n < 0? cadr(data(c1)) : cddr(data(c1));
+ else {
+ drop(c1);
+ return car(data(c1));
+ }
+ }
+ drop(c1);
+ return Nil;
+}
+
+any put(any x, any key, any val) {
+ any y, z;
+
+ if (isCell(y = tail(x))) {
+ if (isCell(cdr(y))) {
+ if (key == cddr(y)) {
+ if (isNil(val))
+ tail(x) = car(y);
+ else if (val == T)
+ cdr(y) = key;
+ else
+ cadr(y) = val;
+ return val;
+ }
+ }
+ else if (key == cdr(y)) {
+ if (isNil(val))
+ tail(x) = car(y);
+ else if (val != T)
+ cdr(y) = cons(val,key);
+ return val;
+ }
+ while (isCell(z = car(y))) {
+ if (isCell(cdr(z))) {
+ if (key == cddr(z)) {
+ if (isNil(val))
+ car(y) = car(z);
+ else {
+ if (val == T)
+ cdr(z) = key;
+ else
+ cadr(z) = val;
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ }
+ return val;
+ }
+ }
+ else if (key == cdr(z)) {
+ if (isNil(val))
+ car(y) = car(z);
+ else {
+ if (val != T)
+ cdr(z) = cons(val,key);
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ }
+ return val;
+ }
+ y = z;
+ }
+ }
+ if (!isNil(val)) {
+ y = cons(Nil, val==T? key : cons(val,key));
+ car(y) = tail(x);
+ tail(x) = y;
+ }
+ return val;
+}
+
+any get(any x, any key) {
+ any y, z;
+
+ if (!isCell(y = tail(x)))
+ return Nil;
+ if (!isCell(cdr(y))) {
+ if (key == cdr(y))
+ return T;
+ }
+ else if (key == cddr(y))
+ return cadr(y);
+ while (isCell(z = car(y))) {
+ if (!isCell(cdr(z))) {
+ if (key == cdr(z)) {
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ return T;
+ }
+ }
+ else if (key == cddr(z)) {
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ return cadr(z);
+ }
+ y = z;
+ }
+ return Nil;
+}
+
+any prop(any x, any key) {
+ any y, z;
+
+ if (!isCell(y = tail(x)))
+ return Nil;
+ if (!isCell(cdr(y))) {
+ if (key == cdr(y))
+ return key;
+ }
+ else if (key == cddr(y))
+ return cdr(y);
+ while (isCell(z = car(y))) {
+ if (!isCell(cdr(z))) {
+ if (key == cdr(z)) {
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ return key;
+ }
+ }
+ else if (key == cddr(z)) {
+ car(y) = car(z), car(z) = tail(x), tail(x) = z;
+ return cdr(z);
+ }
+ y = z;
+ }
+ return Nil;
+}
+
+// (put 'sym1|lst ['sym2|num ..] 'sym|num 'any) -> any
+any doPut(any ex) {
+ any x;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ while (isCell(cdr(x = cdr(x)))) {
+ if (isCell(data(c1)))
+ data(c1) = getn(data(c2), data(c1));
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = data(c2)==Zero? val(data(c1)) : get(data(c1), data(c2));
+ }
+ data(c2) = EVAL(car(x));
+ }
+ NeedSymb(ex,data(c1));
+ x = put(data(c1), data(c2), EVAL(car(x)));
+ drop(c1);
+ return x;
+}
+
+// (get 'sym1|lst ['sym2|num ..]) -> any
+any doGet(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), data(c1) = EVAL(car(x));
+ if (!isCell(x = cdr(x)))
+ return data(c1);
+ Save(c1);
+ do {
+ y = EVAL(car(x));
+ if (isCell(data(c1)))
+ data(c1) = getn(y, data(c1));
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = y==Zero? val(data(c1)) : get(data(c1), y);
+ }
+ } while (isCell(x = cdr(x)));
+ return Pop(c1);
+}
+
+// (prop 'sym1|lst ['sym2|num ..] 'sym) -> lst|sym
+any doProp(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ while (isCell(x = cdr(x))) {
+ if (isCell(data(c1)))
+ data(c1) = getn(y, data(c1));
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = y==Zero? val(data(c1)) : get(data(c1), y);
+ }
+ y = EVAL(car(x));
+ }
+ NeedSymb(ex,data(c1));
+ return prop(Pop(c1), y);
+}
+
+// (; 'sym1|lst [sym2|num ..]) -> any
+any doSemicol(any ex) {
+ any x, y;
+
+ x = cdr(ex), y = EVAL(car(x));
+ while (isCell(x = cdr(x))) {
+ if (isCell(y))
+ y = getn(car(x), y);
+ else {
+ NeedSymb(ex,y);
+ y = car(x)==Zero? val(y) : get(y, car(x));
+ }
+ }
+ return y;
+}
+
+// (=: sym|0 [sym1|num .. sym2] 'any) -> any
+any doSetCol(any ex) {
+ any x, y, z;
+
+ x = cdr(ex);
+ y = val(This);
+ if (z = car(x), isCell(cdr(x = cdr(x)))) {
+ y = z==Zero? val(y) : get(y,z);
+ while (z = car(x), isCell(cdr(x = cdr(x)))) {
+ if (isCell(y))
+ y = getn(z,y);
+ else {
+ NeedSymb(ex,y);
+ y = z==Zero? val(y) : get(y,z);
+ }
+ }
+ }
+ NeedSymb(ex,y);
+ x = put(y, z, EVAL(car(x)));
+ return x;
+}
+
+// (: sym|0 [sym1|num ..]) -> any
+any doCol(any ex) {
+ any x, y;
+
+ x = cdr(ex), y = val(This);
+ y = car(x)==Zero? val(y) : get(y, car(x));
+ while (isCell(x = cdr(x))) {
+ if (isCell(y))
+ y = getn(car(x), y);
+ else {
+ NeedSymb(ex,y);
+ y = car(x)==Zero? val(y) : get(y,car(x));
+ }
+ }
+ return y;
+}
+
+// (:: sym|0 [sym1|num .. sym2]) -> lst|sym
+any doPropCol(any ex) {
+ any x, y;
+
+ x = cdr(ex), y = val(This);
+ if (!isCell(cdr(x)))
+ return prop(y, car(x));
+ y = car(x)==Zero? val(y) : get(y, car(x));
+ while (isCell(cdr(x = cdr(x)))) {
+ if (isCell(y))
+ y = getn(car(x), y);
+ else {
+ NeedSymb(ex,y);
+ y = car(x)==Zero? val(y) : get(y,car(x));
+ }
+ }
+ return prop(y,car(x));
+}
+
+// (putl 'sym1|lst1 ['sym2|num ..] 'lst) -> lst
+any doPutl(any ex) {
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), Push(c2, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ if (isCell(data(c1)))
+ data(c1) = getn(data(c2), data(c1));
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = data(c2)==Zero? val(data(c1)) : get(data(c1), data(c2));
+ }
+ data(c2) = EVAL(car(x));
+ }
+ NeedSymb(ex,data(c1));
+ NeedLst(ex,data(c2));
+ x = (any)&tail(data(c1));
+ while (isCell(car(x)))
+ car(x) = caar(x);
+ for (y = data(c2); isCell(y); y = cdr(y))
+ if (!isCell(car(y)))
+ car(x) = cons(car(x),car(y));
+ else if (!isNil(caar(y)))
+ car(x) = cons(car(x), caar(y)==T? cdar(y) : car(y));
+ drop(c1);
+ return data(c2);
+}
+
+// (getl 'sym1|lst1 ['sym2|num ..]) -> lst
+any doGetl(any ex) {
+ any x, y;
+ cell c1, c2;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (isCell(data(c1)))
+ data(c1) = getn(y, data(c1));
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = y==Zero? val(data(c1)) : get(data(c1), y);
+ }
+ }
+ NeedSymb(ex,data(c1));
+ if (!isCell(x = tail(data(c1))))
+ data(c2) = Nil;
+ else {
+ Push(c2, y = cons(cdr(x),Nil));
+ while (isCell(x = car(x)))
+ y = cdr(y) = cons(cdr(x),Nil);
+ }
+ drop(c1);
+ return data(c2);
+}
+
+static any meta(any x, any y) {
+ any z;
+
+ while (isCell(x)) {
+ if (isSymb(car(x)))
+ if (!isNil(z = get(car(x),y)) || !isNil(z = meta(val(car(x)), y)))
+ return z;
+ x = cdr(x);
+ }
+ return Nil;
+}
+
+// (meta 'obj|typ 'sym ['sym2|num ..]) -> any
+any doMeta(any ex) {
+ any x, y;
+ cell c1;
+
+ x = cdr(ex), Push(c1, EVAL(car(x)));
+ x = cdr(x), y = EVAL(car(x));
+ if (isSymb(data(c1)))
+ data(c1) = val(data(c1));
+ data(c1) = meta(data(c1), y);
+ while (isCell(x = cdr(x))) {
+ y = EVAL(car(x));
+ if (isCell(data(c1))) {
+ NeedNum(ex,y);
+ data(c1) = car(nth(unBox(y), data(c1)));
+ }
+ else {
+ NeedSymb(ex,data(c1));
+ data(c1) = get(data(c1), y);
+ }
+ }
+ return Pop(c1);
+}
+
+#define isLowc(c) ((c) >= 'a' && (c) <= 'z')
+#define isUppc(c) ((c) >= 'A' && (c) <= 'Z')
+
+static inline bool isLetterOrDigit(int c) {
+ return isLowc(c) || isUppc(c) || (c) >= '0' && (c) <= '9';
+}
+
+static int toUpperCase(int c) {
+ return isLowc(c)? c - 32 : c;
+}
+
+static int toLowerCase(int c) {
+ return isUppc(c)? c + 32 : c;
+}
+
+// (low? 'any) -> sym | NIL
+any doLowQ(any x) {
+ x = cdr(x);
+ return isSymb(x = EVAL(car(x))) && isLowc(firstByte(x))? x : Nil;
+}
+
+// (upp? 'any) -> sym | NIL
+any doUppQ(any x) {
+ x = cdr(x);
+ return isSymb(x = EVAL(car(x))) && isUppc(firstByte(x))? x : Nil;
+}
+
+// (lowc 'any) -> any
+any doLowc(any x) {
+ int c, i1, i2;
+ word w1, w2;
+ any nm;
+ cell c1, c2;
+
+ x = cdr(x);
+ if (!isSymb(x = EVAL(car(x))) || isNil(x))
+ return x;
+ x = name(data(c1) = x);
+ if (!(c = getByte1(&i1, &w1, &x)))
+ return data(c1);
+ Save(c1);
+ putByte1(toLowerCase(c), &i2, &w2, &nm);
+ while (c = getByte(&i1, &w1, &x))
+ putByte(toLowerCase(c), &i2, &w2, &nm, &c2);
+ nm = popSym(i2, w2, nm, &c2);
+ drop(c1);
+ return nm;
+}
+
+// (uppc 'any) -> any
+any doUppc(any x) {
+ int c, i1, i2;
+ word w1, w2;
+ any nm;
+ cell c1, c2;
+
+ x = cdr(x);
+ if (!isSymb(x = EVAL(car(x))) || isNil(x))
+ return x;
+ x = name(data(c1) = x);
+ if (!(c = getByte1(&i1, &w1, &x)))
+ return data(c1);
+ Save(c1);
+ putByte1(toUpperCase(c), &i2, &w2, &nm);
+ while (c = getByte(&i1, &w1, &x))
+ putByte(toUpperCase(c), &i2, &w2, &nm, &c2);
+ nm = popSym(i2, w2, nm, &c2);
+ drop(c1);
+ return nm;
+}
+
+// (fold 'any ['num]) -> sym
+any doFold(any ex) {
+ int n, c, i1, i2;
+ word w1, w2;
+ any x, nm;
+ cell c1, c2;
+
+ x = cdr(ex);
+ if (!isSymb(x = EVAL(car(x))) || isNil(x))
+ return Nil;
+ x = name(data(c1) = x);
+ if (!(c = getByte1(&i1, &w1, &x)))
+ return Nil;
+ while (!isLetterOrDigit(c))
+ if (!(c = getByte(&i1, &w1, &x)))
+ return Nil;
+ Save(c1);
+ n = isCell(x = cddr(ex))? evNum(ex,x) : 24;
+ putByte1(toLowerCase(c), &i2, &w2, &nm);
+ while (c = getByte(&i1, &w1, &x))
+ if (isLetterOrDigit(c)) {
+ if (!--n)
+ break;
+ putByte(toLowerCase(c), &i2, &w2, &nm, &c2);
+ }
+ nm = popSym(i2, w2, nm, &c2);
+ drop(c1);
+ return nm;
+}
diff --git a/src/tab.c b/src/tab.c
@@ -0,0 +1,316 @@
+/* 23feb08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+typedef struct symInit {fun code; char *name;} symInit;
+
+#include "mod.h"
+
+static symInit Symbols[] = {
+#include "mod.fn"
+ {doAbs, "abs"},
+ {doAdd, "+"},
+ {doAll, "all"},
+ {doAnd, "and"},
+ {doAny, "any"},
+ {doAppend, "append"},
+ {doApply, "apply"},
+ {doArg, "arg"},
+ {doArgs, "args"},
+ {doArgv, "argv"},
+ {doAs, "as"},
+ {doAsoq, "asoq"},
+ {doAssoc, "assoc"},
+ {doAt, "at"},
+ {doAtom, "atom"},
+ {doBind, "bind"},
+ {doBitAnd, "&"},
+ {doBitOr, "|"},
+ {doBitQ, "bit?"},
+ {doBitXor, "x|"},
+ {doBool, "bool"},
+ {doBox, "box"},
+ {doBoxQ, "box?"},
+ {doBreak, "!"},
+ {doBy, "by"},
+ {doBye, "bye"},
+ {doCaaar, "caaar"},
+ {doCaadr, "caadr"},
+ {doCaar, "caar"},
+ {doCadar, "cadar"},
+ {doCadddr, "cadddr"},
+ {doCaddr, "caddr"},
+ {doCadr, "cadr"},
+ {doCar, "car"},
+ {doCase, "case"},
+ {doCatch, "catch"},
+ {doCdaar, "cdaar"},
+ {doCdadr, "cdadr"},
+ {doCdar, "cdar"},
+ {doCddar, "cddar"},
+ {doCddddr, "cddddr"},
+ {doCdddr, "cdddr"},
+ {doCddr, "cddr"},
+ {doCdr, "cdr"},
+ {doChar, "char"},
+ {doChain, "chain"},
+ {doChop, "chop"},
+ {doCirc, "circ"},
+ {doClip, "clip"},
+ {doCnt, "cnt"},
+ {doCol, ":"},
+ {doCon, "con"},
+ {doConc, "conc"},
+ {doCond, "cond"},
+ {doCons, "cons"},
+ {doCopy, "copy"},
+ {doCut, "cut"},
+ {doDate, "date"},
+ {doDe, "de"},
+ {doDec, "dec"},
+ {doDef, "def"},
+ {doDefault, "default"},
+ {doDel, "del"},
+ {doDelete, "delete"},
+ {doDelq, "delq"},
+ {doDiff, "diff"},
+ {doDiv, "/"},
+ {doDm, "dm"},
+ {doDo, "do"},
+ {doE, "e"},
+ {doEnv, "env"},
+ {doEof, "eof"},
+ {doEol, "eol"},
+ {doEq, "=="},
+ {doEqual, "="},
+ {doEqual0, "=0"},
+ {doEqualT, "=T"},
+ {doEval, "eval"},
+ {doExtra, "extra"},
+ {doFifo, "fifo"},
+ {doFill, "fill"},
+ {doFilter, "filter"},
+ {doFin, "fin"},
+ {doFinally, "finally"},
+ {doFind, "find"},
+ {doFish, "fish"},
+ {doFlgQ, "flg?"},
+ {doFlip, "flip"},
+ {doFlush, "flush"},
+ {doFold, "fold"},
+ {doFor, "for"},
+ {doFormat, "format"},
+ {doFrom, "from"},
+ {doFull, "full"},
+ {doFunQ, "fun?"},
+ {doGc, "gc"},
+ {doGe, ">="},
+ {doGe0, "ge0"},
+ {doGet, "get"},
+ {doGetl, "getl"},
+ {doGlue, "glue"},
+ {doGt, ">"},
+ {doGt0, "gt0"},
+ {doHead, "head"},
+ {doHeap, "heap"},
+ {doHide, "===="},
+ {doIdx, "idx"},
+ {doIf, "if"},
+ {doIf2, "if2"},
+ {doIfn, "ifn"},
+ {doIn, "in"},
+ {doInc, "inc"},
+ {doIndex, "index"},
+ {doIntern, "intern"},
+ {doIsa, "isa"},
+ {doJob, "job"},
+ {doLast, "last"},
+ {doLe, "<="},
+ {doLength, "length"},
+ {doLet, "let"},
+ {doLetQ, "let?"},
+ {doLine, "line"},
+ {doLink, "link"},
+ {doList, "list"},
+ {doLit, "lit"},
+ {doLstQ, "lst?"},
+ {doLoad, "load"},
+ {doLookup, "->"},
+ {doLoop, "loop"},
+ {doLowQ, "low?"},
+ {doLowc, "lowc"},
+ {doLt, "<"},
+ {doLt0, "lt0"},
+ {doLup, "lup"},
+ {doMade, "made"},
+ {doMake, "make"},
+ {doMap, "map"},
+ {doMapc, "mapc"},
+ {doMapcan, "mapcan"},
+ {doMapcar, "mapcar"},
+ {doMapcon, "mapcon"},
+ {doMaplist, "maplist"},
+ {doMaps, "maps"},
+ {doMatch, "match"},
+ {doMax, "max"},
+ {doMaxi, "maxi"},
+ {doMember, "member"},
+ {doMemq, "memq"},
+ {doMeta, "meta"},
+ {doMethod, "method"},
+ {doMin, "min"},
+ {doMini, "mini"},
+ {doMix, "mix"},
+ {doMmeq, "mmeq"},
+ {doMul, "*"},
+ {doMulDiv, "*/"},
+ {doName, "name"},
+ {doNand, "nand"},
+ {doNEq, "n=="},
+ {doNEq0, "n0"},
+ {doNEqT, "nT"},
+ {doNEqual, "<>"},
+ {doNeed, "need"},
+ {doNew, "new"},
+ {doNext, "next"},
+ {doNil, "nil"},
+ {doNond, "nond"},
+ {doNor, "nor"},
+ {doNot, "not"},
+ {doNth, "nth"},
+ {doNumQ, "num?"},
+ {doOff, "off"},
+ {doOffset, "offset"},
+ {doOn, "on"},
+ {doOne, "one"},
+ {doOnOff, "onOff"},
+ {doOpt, "opt"},
+ {doOr, "or"},
+ {doOut, "out"},
+ {doPack, "pack"},
+ {doPair, "pair"},
+ {doPass, "pass"},
+ {doPath, "path"},
+ {doPatQ, "pat?"},
+ {doPeek, "peek"},
+ {doPick, "pick"},
+ {doPop, "pop"},
+ {doPreQ, "pre?"},
+ {doPrin, "prin"},
+ {doPrinl, "prinl"},
+ {doPrint, "print"},
+ {doPrintln, "println"},
+ {doPrintsp, "printsp"},
+ {doProg, "prog"},
+ {doProg1, "prog1"},
+ {doProg2, "prog2"},
+ {doProp, "prop"},
+ {doPropCol, "::"},
+ {doProve, "prove"},
+ {doPush, "push"},
+ {doPush1, "push1"},
+ {doPut, "put"},
+ {doPutl, "putl"},
+ {doQueue, "queue"},
+ {doQuit, "quit"},
+ {doRand, "rand"},
+ {doRank, "rank"},
+ {doRead, "read"},
+ {doRem, "%"},
+ {doReplace, "replace"},
+ {doRest, "rest"},
+ {doReverse, "reverse"},
+ {doRot, "rot"},
+ {doRun, "run"},
+ {doSave, "save"},
+ {doSect, "sect"},
+ {doSeed, "seed"},
+ {doSeek, "seek"},
+ {doSemicol, ";"},
+ {doSend, "send"},
+ {doSet, "set"},
+ {doSetCol, "=:"},
+ {doSetq, "setq"},
+ {doShift, ">>"},
+ {doSize, "size"},
+ {doSkip, "skip"},
+ {doSort, "sort"},
+ {doSpace, "space"},
+ {doSplit, "split"},
+ {doSpQ, "sp?"},
+ {doSqrt, "sqrt"},
+ {doState, "state"},
+ {doStem, "stem"},
+ {doStk, "stk"},
+ {doStr, "str"},
+ {doStrip, "strip"},
+ {doStrQ, "str?"},
+ {doSub, "-"},
+ {doSum, "sum"},
+ {doSuper, "super"},
+ {doSym, "sym"},
+ {doSymQ, "sym?"},
+ {doT, "t"},
+ {doTail, "tail"},
+ {doText, "text"},
+ {doThrow, "throw"},
+ {doTill, "till"},
+ {doTrace, "$"},
+ {doTrim, "trim"},
+ {doTry, "try"},
+ {doType, "type"},
+ {doUnify, "unify"},
+ {doUnless, "unless"},
+ {doUntil, "until"},
+ {doUp, "up"},
+ {doUppQ, "upp?"},
+ {doUppc, "uppc"},
+ {doUse, "use"},
+ {doVal, "val"},
+ {doWhen, "when"},
+ {doWhile, "while"},
+ {doWith, "with"},
+ {doXchg, "xchg"},
+ {doXor, "xor"},
+ {doYoke, "yoke"},
+ {doZap, "zap"},
+ {doZero, "zero"},
+};
+
+static any initSym(any v, char *s) {
+ any x;
+
+ val(x = intern(mkSym((byte*)s), Intern)) = v;
+ return x;
+}
+
+void initSymbols(void) {
+ int i;
+
+ Nil = symPtr(Avail), Avail = Avail->car->car; // Allocate 2 cells for NIL
+ tail(Nil) = txt(83 | 73<<7 | 79<<14);
+ val(Nil) = tail(Nil+1) = val(Nil+1) = Nil;
+ Intern[0] = Intern[1] = Transient[0] = Transient[1] = Nil;
+ intern(Nil, Intern);
+ Meth = initSym(boxSubr(doMeth), "meth");
+ Quote = initSym(boxSubr(doQuote), "quote");
+ T = initSym(Nil, "T"), val(T) = T; // Last protected symbol
+
+ At = initSym(Nil, "@");
+ At2 = initSym(Nil, "@@");
+ At3 = initSym(Nil, "@@@");
+ This = initSym(Nil, "This");
+ Dbg = initSym(Nil, "*Dbg");
+ Scl = initSym(Zero, "*Scl");
+ Class = initSym(Nil, "*Class");
+ Up = initSym(Nil, "^");
+ Err = initSym(Nil, "*Err");
+ Rst = initSym(Nil, "*Rst");
+ Msg = initSym(Nil, "*Msg");
+ Bye = initSym(Nil, "*Bye"); // Last unremovable symbol
+
+ for (i = 0; i < (int)(sizeof(Symbols)/sizeof(symInit)); ++i)
+ initSym(boxSubr(Symbols[i].code), Symbols[i].name);
+}
diff --git a/src/tools/Makefile b/src/tools/Makefile
@@ -0,0 +1,27 @@
+bin = ../../bin
+lib = ../../lib
+exe =
+
+CFLAGS := -O2 -Wall -pipe -falign-functions -fomit-frame-pointer -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64
+
+TARGETS = $(bin)/lat1 $(bin)/utf2 $(bin)/balance $(bin)/ssl $(bin)/httpGate $(bin)/z3dClient
+
+all: $(TARGETS)
+
+$(bin)/lat1: lat1.c
+ gcc $(CFLAGS) -o $(bin)/lat1$(exe) lat1.c
+
+$(bin)/utf2: utf2.c
+ gcc $(CFLAGS) -o $(bin)/utf2$(exe) utf2.c
+
+$(bin)/balance: balance.c
+ gcc $(CFLAGS) -o $(bin)/balance$(exe) balance.c
+
+$(bin)/ssl: ssl.c
+ gcc $(CFLAGS) -o $(bin)/ssl$(exe) ssl.c -lssl -lcrypto
+
+$(bin)/httpGate: httpGate.c
+ gcc $(CFLAGS) -o $(bin)/httpGate$(exe) httpGate.c -lssl -lcrypto
+
+$(bin)/z3dClient: z3dClient.c
+ gcc $(CFLAGS) -o $(bin)/z3dClient$(exe) z3dClient.c -lXext -lX11
diff --git a/src/tools/balance.c b/src/tools/balance.c
@@ -0,0 +1,94 @@
+/* balance.c
+ * 06jul05abu
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+int Len, Siz;
+char *Line, **Data;
+
+static void giveup(char *msg) {
+ fprintf(stderr, "balance: %s\n", msg);
+ exit(1);
+}
+
+static char *getLine(FILE *fp) {
+ int i, c;
+ char *s;
+
+ i = 0;
+ while ((c = getc_unlocked(fp)) != '\n') {
+ if (c == EOF)
+ return NULL;
+ Line[i] = c;
+ if (++i == Len && !(Line = realloc(Line, Len *= 2)))
+ giveup("No memory");
+ }
+ Line[i] = '\0';
+ if (!(s = strdup(Line)))
+ giveup("No memory");
+ return s;
+}
+
+static void balance(char **data, int len) {
+ if (len) {
+ int n = (len + 1) / 2;
+ char **p = data + n - 1;
+
+ printf("%s\n", *p);
+ balance(data, n - 1);
+ balance(p + 1, len - n);
+ }
+}
+
+// balance [-<cmd> [<arg> ..]]
+// balance [<file>]
+int main(int ac, char *av[]) {
+ int cnt;
+ char *s;
+ pid_t pid = 0;
+ FILE *fp = stdin;
+
+ if (ac > 1) {
+ if (*av[1] == '-') {
+ int pfd[2];
+
+ if (pipe(pfd) < 0)
+ giveup("Pipe error\n");
+ if ((pid = fork()) == 0) {
+ close(pfd[0]);
+ if (pfd[1] != STDOUT_FILENO)
+ dup2(pfd[1], STDOUT_FILENO), close(pfd[1]);
+ execvp(av[1]+1, av+1);
+ }
+ if (pid < 0)
+ giveup("Fork error\n");
+ close(pfd[1]);
+ if (!(fp = fdopen(pfd[0], "r")))
+ giveup("Pipe open error\n");
+ }
+ else if (!(fp = fopen(av[1], "r")))
+ giveup("File open error\n");
+ }
+ Line = malloc(Len = 4096);
+ Data = malloc((Siz = 4096) * sizeof(char*));
+ for (cnt = 0; s = getLine(fp); ++cnt) {
+ if (cnt == Siz && !(Data = realloc(Data, (Siz *= 2) * sizeof(char*))))
+ giveup("No memory");
+ Data[cnt] = s;
+ }
+ if (pid) {
+ fclose(fp);
+ while (waitpid(pid, NULL, 0) < 0)
+ if (errno != EINTR)
+ giveup("Pipe close error\n");
+ }
+ balance(Data, cnt);
+ return 0;
+}
diff --git a/src/tools/httpGate.c b/src/tools/httpGate.c
@@ -0,0 +1,347 @@
+/* 14feb08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <ctype.h>
+#include <string.h>
+#include <signal.h>
+#include <netdb.h>
+#include <time.h>
+#include <sys/time.h>
+#include <sys/stat.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+#include <syslog.h>
+
+#include <openssl/pem.h>
+#include <openssl/ssl.h>
+#include <openssl/err.h>
+
+typedef enum {NO,YES} bool;
+
+static bool Bin;
+static int Http1, Timeout;
+
+static char Head_200[] =
+ "HTTP/1.0 200 OK\r\n"
+ "Server: PicoLisp\r\n"
+ "Content-Type: text/html; charset=utf-8\r\n"
+ "\r\n";
+
+static void logger(char *fmt, ...) {
+ va_list ap;
+
+ va_start(ap,fmt);
+ vsyslog(LOG_ERR, fmt, ap);
+ va_end(ap);
+}
+
+static void giveup(char *msg) {
+ fprintf(stderr, "httpGate: %s\n", msg);
+ exit(2);
+}
+
+static inline bool pre(char *p, char *s) {
+ while (*s)
+ if (*p++ != *s++)
+ return NO;
+ return YES;
+}
+
+static char *ses(char *buf, int port, int *len) {
+ int np;
+ char *p, *q;
+
+ if (Bin || Http1 == 0)
+ return buf;
+ if (pre(buf, "GET /")) {
+ np = (int)strtol(buf+5, &q, 10);
+ if (q == buf+5 || *q != '/' || np < 1024 || np > 65535)
+ return buf;
+ p = q++ - 4;
+ do
+ if (*q < '0' || *q > '9')
+ return buf;
+ while (*++q != '~');
+ if (np == port) {
+ p[0] = 'G', p[1] = 'E', p[2] = 'T', p[3] = ' ';
+ *len -= p - buf;
+ return p;
+ }
+ return NULL;
+ }
+ if (pre(buf, "POST /")) {
+ np = (int)strtol(buf+6, &q, 10);
+ if (q == buf+6 || *q != '/' || np < 1024 || np > 65535)
+ return buf;
+ p = q++ - 5;
+ do
+ if (*q < '0' || *q > '9')
+ return buf;
+ while (*++q != '~');
+ if (np == port) {
+ p[0] = 'P', p[1] = 'O', p[2] = 'S', p[3] = 'T', p[4] = ' ';
+ *len -= p - buf;
+ return p;
+ }
+ return NULL;
+ }
+ return buf;
+}
+
+static int slow(SSL *ssl, int fd, char *p, int cnt) {
+ int n;
+
+ while ((n = ssl? SSL_read(ssl, p, cnt) : read(fd, p, cnt)) < 0)
+ if (errno != EINTR)
+ return 0;
+ return n;
+}
+
+static void wrBytes(int fd, char *p, int cnt) {
+ int n;
+
+ do
+ if ((n = write(fd, p, cnt)) >= 0)
+ p += n, cnt -= n;
+ else if (errno != EINTR) {
+ logger("%d wrBytes error", fd);
+ exit(1);
+ }
+ while (cnt);
+}
+
+static void sslWrite(SSL *ssl, void *p, int cnt) {
+ if (SSL_write(ssl, p, cnt) <= 0) {
+ logger("SSL_write error");
+ exit(1);
+ }
+}
+
+static int gateSocket(void) {
+ int sd;
+
+ if ((sd = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+ logger("socket error");
+ exit(1);
+ }
+ return sd;
+}
+
+static int gatePort(int port) {
+ int n, sd;
+ struct sockaddr_in addr;
+
+ memset(&addr, 0, sizeof(addr));
+ addr.sin_family = AF_INET;
+ addr.sin_addr.s_addr = htonl(INADDR_ANY);
+ addr.sin_port = htons((unsigned short)port);
+ n = 1, setsockopt(sd = gateSocket(), SOL_SOCKET, SO_REUSEADDR, &n, sizeof(n));
+ if (bind(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0) {
+ logger("%d bind error", sd);
+ exit(1);
+ }
+ if (listen(sd,5) < 0) {
+ logger("%d listen error", sd);
+ exit(1);
+ }
+ return sd;
+}
+
+static int gateConnect(unsigned short port) {
+ int sd;
+ struct sockaddr_in addr;
+
+ memset(&addr, 0, sizeof(addr));
+ addr.sin_addr.s_addr = inet_addr("127.0.0.1");
+ sd = gateSocket();
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons(port);
+ return connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0? -1 : sd;
+}
+
+
+static pid_t Buddy;
+
+static void doSigAlarm(int n __attribute__((unused))) {
+ logger("Timeout %d", Timeout);
+ kill(Buddy, SIGTERM);
+ exit(0);
+}
+
+static void doSigUsr1(int n __attribute__((unused))) {
+ alarm(Timeout);
+}
+
+int main(int ac, char *av[]) {
+ int cnt = ac>4? ac-3 : 1, ports[cnt], n, sd, cli, srv;
+ struct sockaddr_in addr;
+ char *gate;
+ SSL_CTX *ctx;
+ SSL *ssl;
+
+ if (ac < 3)
+ giveup("port dflt [pem [alt ..]]");
+
+ sd = gatePort(atoi(av[1])); // e.g. 80 or 443
+ ports[0] = atoi(av[2]); // e.g. 8080
+ if (ac == 3 || *av[3] == '\0')
+ ssl = NULL, gate = "Gate: http %s\r\n";
+ else {
+ SSL_library_init();
+ SSL_load_error_strings();
+ if (!(ctx = SSL_CTX_new(SSLv23_server_method())) ||
+ !SSL_CTX_use_certificate_file(ctx, av[3], SSL_FILETYPE_PEM) ||
+ !SSL_CTX_use_PrivateKey_file(ctx, av[3], SSL_FILETYPE_PEM) ||
+ !SSL_CTX_check_private_key(ctx) ) {
+ ERR_print_errors_fp(stderr);
+ giveup("SSL init");
+ }
+ ssl = SSL_new(ctx), gate = "Gate: https %s\r\n";
+ }
+ for (n = 1; n < cnt; ++n)
+ ports[n] = atoi(av[n+3]);
+
+ signal(SIGCHLD,SIG_IGN); /* Prevent zombies */
+ if ((n = fork()) < 0)
+ giveup("detach");
+ if (n)
+ return 0;
+ setsid();
+
+ openlog("httpGate", LOG_CONS|LOG_PID, 0);
+ for (;;) {
+ socklen_t len = sizeof(addr);
+ if ((cli = accept(sd, (struct sockaddr*)&addr, &len)) >= 0 && (n = fork()) >= 0) {
+ if (!n) {
+ int fd, port;
+ char *p, *q, buf[4096], buf2[64];
+
+ close(sd);
+
+ alarm(Timeout = 420);
+ if (ssl) {
+ SSL_set_fd(ssl, cli);
+ if (SSL_accept(ssl) < 0)
+ return 1;
+ n = SSL_read(ssl, buf, sizeof(buf));
+ }
+ else
+ n = read(cli, buf, sizeof(buf));
+ alarm(0);
+ if (n < 6)
+ return 1;
+
+ /* "@8080 "
+ * "GET /url HTTP/1.x"
+ * "GET /8080/url HTTP/1.x"
+ * "POST /url HTTP/1.x"
+ * "POST /8080/url HTTP/1.x"
+ */
+ Bin = NO;
+ if (buf[0] == '@')
+ p = buf + 1, Bin = YES, Timeout = 3600;
+ else if (pre(buf, "GET /"))
+ p = buf + 5;
+ else if (pre(buf, "POST /"))
+ p = buf + 6;
+ else
+ return 1;
+
+ port = (int)strtol(p, &q, 10);
+ if (q == p || *q != ' ' && *q != '/')
+ port = ports[0], q = p;
+ else if (port < cnt)
+ port = ports[port];
+ else if (port < 1024)
+ return 1;
+
+ if ((srv = gateConnect((unsigned short)port)) < 0) {
+ logger("Can't connect to %d", port);
+ if (!memchr(q,'~', buf + n - q)) {
+ buf[n] = '\0';
+ logger("Bad request: %s", buf);
+ return 1;
+ }
+ if ((fd = open("void", O_RDONLY)) < 0)
+ return 1;
+ alarm(Timeout);
+ if (ssl)
+ sslWrite(ssl, Head_200, strlen(Head_200));
+ else
+ wrBytes(cli, Head_200, strlen(Head_200));
+ alarm(0);
+ while ((n = read(fd, buf, sizeof(buf))) > 0) {
+ alarm(Timeout);
+ if (ssl)
+ sslWrite(ssl, buf, n);
+ else
+ wrBytes(cli, buf, n);
+ alarm(0);
+ }
+ return 0;
+ }
+
+ Http1 = 0;
+ if (buf[0] == '@')
+ p = q + 1;
+ else {
+ wrBytes(srv, buf, p - buf);
+ if (*q == '/')
+ ++q;
+ p = q;
+ while (*p++ != '\n')
+ if (p >= buf + n) {
+ buf[n] = '\0';
+ logger("Bad header: %s", buf);
+ return 1;
+ }
+ wrBytes(srv, q, p - q);
+ if (pre(p-10, "HTTP/1."))
+ Http1 = *(p-3) - '0';
+ wrBytes(srv, buf2, sprintf(buf2, gate, inet_ntoa(addr.sin_addr)));
+ }
+ wrBytes(srv, p, buf + n - p);
+
+ signal(SIGALRM, doSigAlarm);
+ signal(SIGUSR1, doSigUsr1);
+ if (Buddy = fork()) {
+ for (;;) {
+ alarm(Timeout);
+ n = slow(ssl, cli, buf, sizeof(buf));
+ alarm(0);
+ if (!n || !(p = ses(buf, port, &n)))
+ break;
+ wrBytes(srv, p, n);
+ }
+ shutdown(cli, SHUT_RD);
+ shutdown(srv, SHUT_WR);
+ }
+ else {
+ Buddy = getppid();
+ while ((n = read(srv, buf, sizeof(buf))) > 0) {
+ kill(Buddy, SIGUSR1);
+ alarm(Timeout);
+ if (ssl)
+ sslWrite(ssl, buf, n);
+ else
+ wrBytes(cli, buf, n);
+ alarm(0);
+ }
+ shutdown(srv, SHUT_RD);
+ shutdown(cli, SHUT_WR);
+ }
+ return 0;
+ }
+ close(cli);
+ }
+ }
+}
diff --git a/src/tools/lat1.c b/src/tools/lat1.c
@@ -0,0 +1,75 @@
+/* lat1.c
+ * 31mar05abu
+ * Convert stdin (UTF-8, 2-Byte) to process or file (ISO-8859-15)
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+// lat1 [-<cmd> [<arg> ..]]
+// lat1 [[+]<Outfile/ISO-8859-15>]
+int main(int ac, char *av[]) {
+ int c;
+ pid_t pid = 0;
+ FILE *fp = stdout;
+
+ if (ac > 1) {
+ char *mode = "w";
+
+ if (*av[1] == '-') {
+ int pfd[2];
+
+ if (pipe(pfd) < 0) {
+ fprintf(stderr, "lat1: Pipe error\n");
+ return 1;
+ }
+ if ((pid = fork()) == 0) {
+ close(pfd[1]);
+ if (pfd[0] != STDIN_FILENO)
+ dup2(pfd[0], STDIN_FILENO), close(pfd[0]);
+ execvp(av[1]+1, av+1);
+ }
+ if (pid < 0) {
+ fprintf(stderr, "lat1: Fork error\n");
+ return 1;
+ }
+ close(pfd[0]);
+ if (!(fp = fdopen(pfd[1], mode))) {
+ fprintf(stderr, "lat1: Pipe open error\n");
+ return 1;
+ }
+ }
+ else {
+ if (*av[1] == '+')
+ mode = "a", ++av[1];
+ if (!(fp = fopen(av[1], mode))) {
+ fprintf(stderr, "lat1: '%s' open error\n", av[1]);
+ return 1;
+ }
+ }
+ }
+ while ((c = getchar_unlocked()) != EOF) {
+ if ((c & 0x80) == 0)
+ putc_unlocked(c,fp);
+ else if ((c & 0x20) == 0)
+ putc_unlocked((c & 0x1F) << 6 | getchar_unlocked() & 0x3F, fp);
+ else {
+ getchar_unlocked(); // 0x82
+ getchar_unlocked(); // 0xAC
+ putc_unlocked(0xA4, fp);
+ }
+ }
+ if (pid) {
+ fclose(fp);
+ while (waitpid(pid, NULL, 0) < 0)
+ if (errno != EINTR) {
+ fprintf(stderr, "lat1: Pipe close error\n");
+ return 1;
+ }
+ }
+ return 0;
+}
diff --git a/src/tools/ssl.c b/src/tools/ssl.c
@@ -0,0 +1,250 @@
+/* 06sep07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <dirent.h>
+#include <errno.h>
+#include <string.h>
+#include <signal.h>
+#include <netdb.h>
+#include <sys/stat.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+#include <syslog.h>
+
+#include <openssl/pem.h>
+#include <openssl/ssl.h>
+#include <openssl/err.h>
+
+typedef enum {NO,YES} bool;
+
+static char *File, *Dir, *Data;
+static off_t Size;
+static bool Log;
+
+static char Get[] =
+ "GET /%s HTTP/1.0\r\n"
+ "User-Agent: PicoLisp\r\n"
+ "Host: %s:%s\r\n"
+ "Accept-Charset: utf-8\r\n\r\n";
+
+static void logger(char *msg) {
+ if (Log)
+ syslog(LOG_ERR, "%s", msg);
+ else
+ fprintf(stderr, "ssl: %s\n", msg);
+}
+
+static void giveup(char *msg) {
+ logger(msg);
+ exit(1);
+}
+
+static void sslChk(int n) {
+ if (n < 0) {
+ ERR_print_errors_fp(stderr);
+ exit(1);
+ }
+}
+
+static int sslConnect(SSL *ssl, char *host, int port) {
+ struct sockaddr_in addr;
+ struct hostent *p;
+ int sd;
+
+ memset(&addr, 0, sizeof(addr));
+ if ((long)(addr.sin_addr.s_addr = inet_addr(host)) == -1) {
+ if (!(p = gethostbyname(host)) || p->h_length == 0)
+ return -1;
+ addr.sin_addr.s_addr = ((struct in_addr*)p->h_addr_list[0])->s_addr;
+ }
+
+ if ((sd = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+ logger("No socket");
+ return -1;
+ }
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons((unsigned short)port);
+ if (connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0) {
+ close(sd);
+ return -1;
+ }
+
+ SSL_set_fd(ssl,sd);
+ if (SSL_connect(ssl) >= 0)
+ return sd;
+ close(sd);
+ return -1;
+}
+
+static void sslClose(SSL *ssl, int sd) {
+ SSL_shutdown(ssl);
+ close(sd);
+}
+
+static bool sslFile(SSL *ssl, char *file) {
+ int fd, n;
+ char buf[BUFSIZ];
+
+ if (file[0] == '-')
+ return SSL_write(ssl, file+1, strlen(file)-1) >= 0;
+ if ((fd = open(file, O_RDONLY)) < 0)
+ return NO;
+ while ((n = read(fd, buf, sizeof(buf))) > 0)
+ if (SSL_write(ssl, buf, n) < 0) {
+ close(fd);
+ return NO;
+ }
+ close(fd);
+ return n == 0;
+}
+
+static void doSigTerm(int n __attribute__((unused))) {
+ int fd1, fd2, cnt;
+ char buf[BUFSIZ];
+
+ if (Data && (fd1 = open(File, O_RDWR)) >= 0) {
+ if (unlink(File) < 0)
+ giveup("Can't unlink back");
+ if ((fd2 = open(File, O_CREAT|O_WRONLY|O_TRUNC, 0666)) < 0)
+ giveup("Can't create back");
+ if (write(fd2, Data, Size) != Size)
+ giveup("Can't write back");
+ while ((cnt = read(fd1, buf, sizeof(buf))) > 0)
+ write(fd2, buf, cnt);
+ }
+ exit(0);
+}
+
+// ssl host port url
+// ssl host port url file
+// ssl host port url key file
+// ssl host port url key file dir sec
+int main(int ac, char *av[]) {
+ SSL_CTX *ctx;
+ SSL *ssl;
+ bool bin;
+ int n, sec, getLen, lenLen, fd, sd;
+ DIR *dp;
+ struct dirent *p;
+ struct stat st;
+ struct flock fl;
+ char get[1024], buf[4096], nm[4096], len[64];
+
+ if (!(ac >= 4 && ac <= 6 || ac == 8))
+ giveup("host port url [[key] file] | host port url key file dir sec");
+ if (strlen(Get)+strlen(av[1])+strlen(av[2])+strlen(av[3]) >= sizeof(get))
+ giveup("Names too long");
+ if (strchr(av[3],'/'))
+ bin = NO, getLen = sprintf(get, Get, av[3], av[1], av[2]);
+ else
+ bin = YES, getLen = sprintf(get, "@%s ", av[3]);
+
+ SSL_library_init();
+ SSL_load_error_strings();
+ if (!(ctx = SSL_CTX_new(SSLv23_client_method()))) {
+ ERR_print_errors_fp(stderr);
+ giveup("SSL init");
+ }
+ ssl = SSL_new(ctx);
+
+ if (ac <= 6) {
+ if (sslConnect(ssl, av[1], atoi(av[2])) < 0) {
+ logger("Can't connect");
+ return 1;
+ }
+ sslChk(SSL_write(ssl, get, getLen));
+ if (ac > 4) {
+ if (*av[4] && !sslFile(ssl,av[4]))
+ giveup(av[4]);
+ if (ac > 5 && *av[5] && !sslFile(ssl,av[5]))
+ giveup(av[5]);
+ }
+ while ((n = SSL_read(ssl, buf, sizeof(buf))) > 0)
+ write(STDOUT_FILENO, buf, n);
+ return 0;
+ }
+
+ signal(SIGCHLD,SIG_IGN); /* Prevent zombies */
+ if ((n = fork()) < 0)
+ giveup("detach");
+ if (n)
+ return 0;
+ setsid();
+
+ openlog("ssl", LOG_CONS|LOG_PID, 0);
+ Log = YES;
+ File = av[5];
+ Dir = av[6];
+ sec = atoi(av[7]);
+ signal(SIGINT, doSigTerm);
+ signal(SIGTERM, doSigTerm);
+ signal(SIGPIPE, SIG_IGN);
+ for (;;) {
+ if (*File && (fd = open(File, O_RDWR)) >= 0) {
+ if (fstat(fd,&st) < 0 || st.st_size == 0)
+ close(fd);
+ else {
+ fl.l_type = F_WRLCK;
+ fl.l_whence = SEEK_SET;
+ fl.l_start = 0;
+ fl.l_len = 0;
+ if (fcntl(fd, F_SETLKW, &fl) < 0)
+ giveup("Can't lock");
+ if (fstat(fd,&st) < 0 || (Size = st.st_size) == 0)
+ giveup("Can't access");
+ lenLen = sprintf(len, "%lld\n", Size);
+ if ((Data = malloc(Size)) == NULL)
+ giveup("Can't alloc");
+ if (read(fd, Data, Size) != Size)
+ giveup("Can't read");
+ if (ftruncate(fd,0) < 0)
+ logger("Can't truncate");
+ close(fd);
+ for (;;) {
+ if ((sd = sslConnect(ssl, av[1], atoi(av[2]))) >= 0) {
+ if (SSL_write(ssl, get, getLen) == getLen &&
+ (!*av[4] || sslFile(ssl,av[4])) && // key
+ (bin || SSL_write(ssl, len, lenLen) == lenLen) && // length
+ SSL_write(ssl, Data, Size) == Size && // data
+ SSL_write(ssl, bin? "\0" : "T", 1) == 1 && // ack
+ SSL_read(ssl, buf, 1) == 1 && buf[0] == 'T' ) {
+ sslClose(ssl,sd);
+ break;
+ }
+ sslClose(ssl,sd);
+ logger("Transmit failed");
+ }
+ sleep(sec);
+ logger("Try to retransmit");
+ }
+ free(Data), Data = NULL;
+ }
+ }
+ if (*Dir && (dp = opendir(Dir))) {
+ while (p = readdir(dp)) {
+ if (p->d_name[0] != '.') {
+ snprintf(nm, sizeof(nm), "%s%s", Dir, p->d_name);
+ if ((n = readlink(nm, buf, sizeof(buf))) > 0 &&
+ (sd = sslConnect(ssl, av[1], atoi(av[2]))) >= 0 ) {
+ if (SSL_write(ssl, get, getLen) == getLen &&
+ (!*av[4] || sslFile(ssl,av[4])) && // key
+ (bin || SSL_write(ssl, buf, n) == n) && // path
+ (bin || SSL_write(ssl, "\n", 1) == 1) && // nl
+ sslFile(ssl, nm) ) // file
+ unlink(nm);
+ sslClose(ssl,sd);
+ }
+ }
+ }
+ closedir(dp);
+ }
+ sleep(sec);
+ }
+}
diff --git a/src/tools/utf2.c b/src/tools/utf2.c
@@ -0,0 +1,68 @@
+/* utf2.c
+ * 31mar05abu
+ * Convert process or file (ISO-8859-15) to stdout (UTF-8, 2-Byte)
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+// utf2 [-<cmd> [<arg> ..]]
+// utf2 [<Infile/ISO-8859-15>]
+int main(int ac, char *av[]) {
+ int c;
+ pid_t pid = 0;
+ FILE *fp = stdin;
+
+ if (ac > 1) {
+ if (*av[1] == '-') {
+ int pfd[2];
+
+ if (pipe(pfd) < 0) {
+ fprintf(stderr, "utf2: Pipe error\n");
+ return 1;
+ }
+ if ((pid = fork()) == 0) {
+ close(pfd[0]);
+ if (pfd[1] != STDOUT_FILENO)
+ dup2(pfd[1], STDOUT_FILENO), close(pfd[1]);
+ execvp(av[1]+1, av+1);
+ }
+ if (pid < 0) {
+ fprintf(stderr, "utf2: Fork error\n");
+ return 1;
+ }
+ close(pfd[1]);
+ if (!(fp = fdopen(pfd[0], "r"))) {
+ fprintf(stderr, "utf2: Pipe open error\n");
+ return 1;
+ }
+ }
+ else if (!(fp = fopen(av[1], "r"))) {
+ fprintf(stderr, "utf2: '%s' open error\n", av[1]);
+ return 1;
+ }
+ }
+ while ((c = getc_unlocked(fp)) != EOF) {
+ if (c == 0xA4)
+ putchar_unlocked(0xE2), putchar_unlocked(0x82), putchar_unlocked(0xAC);
+ else if (c >= 0x80) {
+ putchar_unlocked(0xC0 | c>>6 & 0x1F);
+ putchar_unlocked(0x80 | c & 0x3F);
+ }
+ else
+ putchar_unlocked(c);
+ }
+ if (pid) {
+ fclose(fp);
+ while (waitpid(pid, NULL, 0) < 0)
+ if (errno != EINTR) {
+ fprintf(stderr, "utf2: Pipe close error\n");
+ return 1;
+ }
+ }
+ return 0;
+}
diff --git a/src/tools/z3dClient.c b/src/tools/z3dClient.c
@@ -0,0 +1,532 @@
+/* 17sep05abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+
+#include <netdb.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <sys/shm.h>
+#include <X11/extensions/XShm.h>
+
+
+typedef unsigned char byte;
+typedef struct {long h[2]; unsigned long z[2];} edge;
+
+/* Globals */
+static int Socket;
+static Display *Disp;
+static int Scrn;
+static int Dpth;
+static int PixSize;
+static Colormap Cmap;
+static GC Gc;
+static Window Win;
+static long long Tim;
+
+/* 3D-Environment */
+static int SizX, SizY, OrgX, OrgY, SnapX, SnapY;
+static unsigned long *Zbuff;
+static edge *Edges;
+static XImage *Img;
+static XShmSegmentInfo Info;
+
+
+/* Error exit */
+static void giveup(char *msg) {
+ fprintf(stderr, "z3dClient: %s\r\n", msg);
+ exit(1);
+}
+
+/* Memory allocation */
+void *alloc(long siz) {
+ void *p;
+
+ if (!(p = malloc(siz)))
+ giveup("No memory");
+ return p;
+}
+
+static void paint(void) {
+ XEvent ev;
+
+ while (XCheckTypedEvent(Disp, Expose, &ev));
+ XShmPutImage(Disp, Win, Gc, Img, 0, 0, 0, 0, SizX, SizY, False);
+ if (SnapX != 32767) {
+ XSetFunction(Disp, Gc, GXinvert);
+ XFillRectangle(Disp, Win, Gc, OrgX+SnapX-3, OrgY+SnapY-3, 6, 6);
+ XSetFunction(Disp, Gc, GXcopy);
+ }
+ XSync(Disp,False);
+}
+
+static void prLong(long n) {
+ int i;
+ char buf[8];
+
+ n = n >= 0? n * 2 : -n * 2 + 1;
+ if ((n & 0xFFFFFF00) == 0)
+ i = 2, buf[0] = 1*4, buf[1] = n;
+ else if ((n & 0xFFFF0000) == 0)
+ i = 3, buf[0] = 2*4, buf[1] = n, buf[2] = n>>8;
+ else if ((n & 0xFF000000) == 0)
+ i = 4, buf[0] = 3*4, buf[1] = n, buf[2] = n>>8, buf[3] = n>>16;
+ else
+ i = 5, buf[0] = 4*4, buf[1] = n, buf[2] = n>>8, buf[3] = n>>16, buf[4] = n>>24;
+ if (write(Socket, buf, i) <= 0)
+ giveup("Socket write error");
+}
+
+
+static byte get1(void) {
+ static int n, cnt;
+ static byte buf[1024];
+
+ while (n == cnt) {
+ int fd;
+ fd_set fdSet;
+
+ fd = ConnectionNumber(Disp);
+ FD_ZERO(&fdSet);
+ FD_SET(fd, &fdSet);
+ FD_SET(Socket, &fdSet);
+ while (select((fd > Socket? fd : Socket) + 1, &fdSet, NULL,NULL,NULL) < 0)
+ if (errno != EINTR)
+ giveup("Select error");
+ if (FD_ISSET(fd, &fdSet)) {
+ XEvent ev;
+
+ XNextEvent(Disp, &ev);
+ switch (ev.type) {
+ case Expose:
+ paint();
+ break;
+ case KeyPress:
+ if (((XKeyEvent*)&ev)->state == 37) // Ctrl-Key
+ printf("Ok\n"); //#?
+ break;
+ case KeyRelease:
+ break;
+ case ButtonPress:
+ prLong('c'); // clk
+ prLong(((XButtonEvent*)&ev)->x - OrgX);
+ prLong(((XButtonEvent*)&ev)->y - OrgY);
+ break;
+ case MotionNotify: //#?
+ break;
+ }
+ }
+ if (FD_ISSET(Socket, &fdSet)) {
+ while ((cnt = read(Socket, buf, sizeof(buf))) < 0)
+ if (errno != EINTR)
+ giveup("Socket read error");
+ if (cnt == 0)
+ exit(0);
+ n = 0;
+ }
+ }
+ return buf[n++];
+}
+
+static long getNum(void) {
+ int cnt = get1() / 4;
+ long n = get1();
+ int i = 0;
+
+ while (--cnt)
+ n |= get1() << (i += 8);
+ if (n & 1)
+ n = -n;
+ return n / 2;
+}
+
+static void skipStr(void) {
+ int cnt = get1() / 4;
+ while (--cnt >= 0)
+ get1();
+}
+
+static long getColor(long c) {
+ XColor col;
+
+ col.red = c >> 8 & 0xFF00;
+ col.green = c & 0xFF00;
+ col.blue = (c & 0xFF) << 8;
+ col.flags = DoRed | DoGreen | DoBlue;
+ if (!XAllocColor(Disp, Cmap, &col))
+ giveup("Can't allocate color");
+ return col.pixel;
+}
+
+static void mkEdge(int x1, int y1, int z1, int x2, int y2, int z2) {
+ int a, dx, dy, dz, sx, xd, xe, sz, zd, ze;
+ edge *p;
+
+ if (y2 < y1) {
+ a = x1, x1 = x2, x2 = a;
+ a = y1, y1 = y2, y2 = a;
+ a = z1, z1 = z2, z2 = a;
+ }
+ if (y1 > OrgY || ((y2 += OrgY) <= 0))
+ return;
+ if ((dy = y2 - (y1 += OrgY)) == 0)
+ return;
+ dx = x2 - x1, dz = z2 - z1;
+ if (y1 < 0) {
+ x1 += -y1 * dx / dy;
+ z1 += -y1 * dz / dy;
+ y1 = 0;
+ if ((dy = y2) == 0)
+ return;
+ dx = x2 - x1, dz = z2 - z1;
+ }
+ if (y2 > SizY) {
+ x2 += (SizY - y2) * dx / dy;
+ z2 += (SizY - y2) * dz / dy;
+ y2 = SizY;
+ if ((dy = y2 - y1) == 0)
+ return;
+ dx = x2 - x1, dz = z2 - z1;
+ }
+ sx = 0;
+ if (dx > 0)
+ sx = 1;
+ else if (dx < 0)
+ dx = -dx, sx = -1;
+ xd = 0;
+ if (dx > dy)
+ xd = dx/dy, dx -= xd*dy, xd *= sx;
+ xe = (dx *= 2) - dy;
+ sz = 0;
+ if (dz > 0)
+ sz = 1;
+ else if (dz < 0)
+ dz = -dz, sz = -1;
+ zd = 0;
+ if (dz > dy)
+ zd = dz/dy, dz -= zd*dy, zd *= sz;
+ ze = (dz *= 2) - dy;
+ dy *= 2;
+ x1 += OrgX;
+ p = Edges + y1;
+ do {
+ if ((a = x1) < 0)
+ a = 0;
+ else if (a > SizX)
+ a = SizX;
+ if (a < p->h[1]) {
+ p->h[0] = a;
+ p->z[0] = z1;
+ }
+ else {
+ p->h[0] = p->h[1];
+ p->z[0] = p->z[1];
+ p->h[1] = a;
+ p->z[1] = z1;
+ }
+ ++p;
+ x1 += xd;
+ if (xe >= 0)
+ x1 += sx, xe -= dy;
+ xe += dx;
+ z1 += zd;
+ if (ze >= 0)
+ z1 += sz, ze -= dy;
+ ze += dz;
+ } while (++y1 < y2);
+}
+
+static void zDots(long i, long h, long h2, unsigned long z, unsigned long z2) {
+ char *frame;
+ unsigned long *zbuff;
+
+ i = i * SizX + h;
+ frame = Img->data + i * PixSize;
+ zbuff = Zbuff + i;
+ i = h2 - h;
+ switch (PixSize) {
+ case 1:
+ if (z < *zbuff)
+ *zbuff = z, *frame = 0;
+ if (z2 < *(zbuff += i))
+ *zbuff = z2, *(frame + i) = 0;
+ break;
+ case 2:
+ if (z < *zbuff)
+ *zbuff = z, *(short*)frame = (short)0;
+ if (z2 < *(zbuff += i))
+ *zbuff = z2, *(short*)(frame + 2 * i) = (short)0;
+ break;
+ case 3:
+ if (z < *zbuff) {
+ *zbuff = z;
+ frame[0] = 0;
+ frame[1] = 0;
+ frame[2] = 0;
+ }
+ if (z2 < *(zbuff += i)) {
+ *zbuff = z2;
+ frame += 3 * i;
+ frame[0] = 0;
+ frame[1] = 0;
+ frame[2] = 0;
+ }
+ break;
+ case 4:
+ if (z < *zbuff)
+ *zbuff = z, *(long*)frame = (long)0;
+ if (z2 < *(zbuff += i))
+ *zbuff = z2, *(long*)(frame + 4 * i) = (long)0;
+ break;
+ }
+}
+
+static void zLine(long pix, long v, long h, long h2,
+ unsigned long z, unsigned long z2) {
+ char *frame;
+ unsigned long *zbuff;
+ long d, e, dh, dz, sz;
+
+ if (dh = h2 - h) {
+ v = v * SizX + h;
+ frame = Img->data + v * PixSize;
+ zbuff = Zbuff + v;
+ sz = 0;
+ if ((dz = z2 - z) > 0)
+ sz = 1;
+ else if (dz < 0)
+ dz = -dz, sz = -1;
+ d = 0;
+ if (dz > dh)
+ d = dz/dh, dz -= d*dh, d *= sz;
+ e = (dz *= 2) - dh;
+ dh *= 2;
+ switch (PixSize) {
+ case 1:
+ do {
+ if (z < *zbuff)
+ *zbuff = z, *frame = pix;
+ z += d;
+ if (e >= 0)
+ z += sz, e -= dh;
+ ++zbuff, ++frame;
+ e += dz;
+ } while (++h < h2);
+ break;
+ case 2:
+ do {
+ if (z < *zbuff)
+ *zbuff = z, *(short*)frame = (short)pix;
+ z += d;
+ if (e >= 0)
+ z += sz, e -= dh;
+ ++zbuff, frame += 2;
+ e += dz;
+ } while (++h < h2);
+ break;
+ case 3:
+ do {
+ if (z < *zbuff) {
+ *zbuff = z;
+ frame[0] = pix;
+ frame[1] = (pix >> 8);
+ frame[2] = (pix >> 16);
+ }
+ z += d;
+ if (e >= 0)
+ z += sz, e -= dh;
+ ++zbuff, frame += 3;
+ e += dz;
+ } while (++h < h2);
+ break;
+ case 4:
+ do {
+ if (z < *zbuff)
+ *zbuff = z, *(long*)frame = pix;
+ z += d;
+ if (e >= 0)
+ z += sz, e -= dh;
+ ++zbuff, frame += 4;
+ e += dz;
+ } while (++h < h2);
+ break;
+ }
+ }
+}
+
+/*** Main entry point ***/
+int main(int ac, char *av[]) {
+ struct sockaddr_in addr;
+ struct hostent *hp;
+ XPixmapFormatValues *pmFormat;
+ long hor, sky, gnd, pix, v;
+ int n, i, x0, y0, z0, x1, y1, z1, x2, y2, z2;
+ char *frame;
+ edge *e;
+ long long t;
+ struct timeval tv;
+
+ if (ac != 3)
+ giveup("Use: <host> <port>");
+
+ /* Open Connection */
+ memset(&addr, 0, sizeof(addr));
+ if ((long)(addr.sin_addr.s_addr = inet_addr(av[1])) == -1) {
+ if (!(hp = gethostbyname(av[1])) || hp->h_length == 0)
+ giveup("Can't get host");
+ addr.sin_addr.s_addr = ((struct in_addr*)hp->h_addr_list[0])->s_addr;
+ }
+ if ((Socket = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+ giveup("Can't create socket");
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons(atol(av[2]));
+ if (connect(Socket, (struct sockaddr*)&addr, sizeof(addr)) < 0)
+ giveup("Can't connect");
+
+ /* Open Display */
+ if ((Disp = XOpenDisplay(NULL)) == NULL)
+ giveup("Can't open Display");
+ Scrn = DefaultScreen(Disp);
+ Cmap = DefaultColormap(Disp,Scrn);
+ Dpth = PixSize = 0;
+ pmFormat = XListPixmapFormats(Disp, &n);
+ for (i = 0; i < n; i++) {
+ if (pmFormat[i].depth == 24) {
+ Dpth = 24;
+ if (PixSize != 4)
+ PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+ }
+ else if (pmFormat[i].depth == 16 && (PixSize < 3 || PixSize > 4)) {
+ Dpth = 16;
+ PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+ }
+ else if (pmFormat[i].depth == 8 && (PixSize < 2 || PixSize > 4)) {
+ Dpth = 8;
+ PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+ }
+ }
+ if (!Dpth)
+ giveup("Bad Display Depth");
+ Gc = XCreateGC(Disp,RootWindow(Disp,Scrn), 0, NULL);
+
+ OrgX = (SizX = getNum()) / 2;
+ OrgY = (SizY = getNum()) / 2;
+
+ /* Create Window */
+ Win = XCreateSimpleWindow(Disp, RootWindow(Disp,Scrn), 0, 0, SizX, SizY,
+ 1, BlackPixel(Disp,Scrn), WhitePixel(Disp,Scrn) );
+ XStoreName(Disp, Win, "Pico Lisp z3d");
+ XSelectInput(Disp, Win,
+ ExposureMask |
+ KeyPressMask | KeyReleaseMask |
+ ButtonPressMask |
+ PointerMotionMask );
+ XMapWindow(Disp, Win);
+
+ /* Create Image */
+ SizX = SizX + 3 & ~3;
+ SizY = SizY + 3 & ~3;
+ Zbuff = alloc(SizX * SizY * sizeof(unsigned long));
+ Edges = alloc(SizY * sizeof(edge));
+ if (!XShmQueryExtension(Disp) ||
+ !(Img = XShmCreateImage(Disp, DefaultVisual(Disp, Scrn),
+ Dpth, ZPixmap, NULL, &Info, SizX, SizY )) ||
+ (Info.shmid = shmget(IPC_PRIVATE,
+ SizX * SizY * PixSize, IPC_CREAT | 0777 )) < 0 ||
+ (Info.shmaddr = Img->data =
+ shmat(Info.shmid, 0, 0) ) == (char*)-1 ||
+ !XShmAttach(Disp, &Info) )
+ giveup("Can't create XImage");
+
+ /* Main loop */
+ for (;;) {
+ prLong('o'); // ok
+ hor = getNum() + OrgY;
+ sky = getColor(getNum());
+ gnd = getColor(getNum());
+ for (v = 0; v < SizY; ++v) {
+ pix = v < hor? sky : gnd;
+ frame = Img->data + v * SizX * PixSize;
+ switch (PixSize) {
+ case 1:
+ memset(frame, pix, SizX);
+ break;
+ case 2:
+ pix |= pix<<16;
+ i = 0;
+ do
+ *(long*)frame = pix, frame += 4;
+ while ((i+=2) < SizX);
+ break;
+ case 3:
+ i = 0;
+ do {
+ frame[0] = pix;
+ frame[1] = (pix >> 8);
+ frame[2] = (pix >> 16);
+ frame += 3;
+ } while (++i < SizX);
+ break;
+ case 4:
+ i = 0;
+ do
+ *(long*)frame = pix, frame += 4;
+ while (++i < SizX);
+ break;
+ }
+ }
+ memset(Zbuff, 0xFF, SizX * SizY * sizeof(unsigned long));
+
+ while (n = getNum()) {
+ memset(Edges, 0, SizY * sizeof(edge));
+ x0 = x1 = getNum();
+ y0 = y1 = getNum();
+ z0 = z1 = getNum();
+ skipStr();
+ for (;;) {
+ x2 = getNum();
+ y2 = getNum();
+ z2 = getNum();
+ mkEdge(x1, y1, z1, x2, y2, z2);
+ if (--n == 0)
+ break;
+ x1 = x2, y1 = y2, z1 = z2;
+ }
+ mkEdge(x2, y2, z2, x0, y0, z0);
+ i = 0, e = Edges;
+ if ((pix = getNum()) < 0) {
+ do // Transparent
+ if (e->h[1])
+ zDots(i, e->h[0], e->h[1], e->z[0], e->z[1]);
+ while (++e, ++i < SizY);
+ }
+ else {
+ pix = getColor(pix); // Face color
+ do
+ if (e->h[1])
+ zLine(pix, i, e->h[0], e->h[1], e->z[0], e->z[1]);
+ while (++e, ++i < SizY);
+ }
+ }
+ if ((SnapX = getNum()) != 32767)
+ SnapY = getNum();
+ paint();
+ gettimeofday(&tv,NULL), t = tv.tv_sec * 1000LL + tv.tv_usec / 1000;
+ if (Tim > t) {
+ tv.tv_sec = 0, tv.tv_usec = (Tim - t) * 1000;
+ select(0, NULL, NULL, NULL, &tv);
+ t = Tim;
+ }
+ Tim = t + 40;
+ }
+}
