Initial revision
This commit is contained in:
Martin Baulig
195
guile/make-header.scm
Normal file
195
guile/make-header.scm
Normal file
@@ -0,0 +1,195 @@
|
||||
(define cpu-type '(("name" . "cpu")
|
||||
("label" . "CPU Usage")
|
||||
("fields" . (("unsigned long" ("total" "Total CPU Usage")
|
||||
("user") ("nice") ("sys") ("idle"))
|
||||
("const char" ("name"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; computes constant for struct field (eg. GLIBTOP_CPU_TOTAL)
|
||||
|
||||
(define field-name-constant
|
||||
(lambda (name field)
|
||||
(string "GLIBTOP_"
|
||||
(string-upcase! (string name))
|
||||
"_"
|
||||
(string-upcase! (string field)))
|
||||
)
|
||||
)
|
||||
|
||||
;; computes structure name (eg. glibtop_cpu)
|
||||
|
||||
(define make-struct-name
|
||||
(lambda (type)
|
||||
(string "glibtop_" (assoc-ref type "name"))
|
||||
)
|
||||
)
|
||||
|
||||
(define tab-pad-string
|
||||
(lambda (string tabs)
|
||||
(string-append string (make-string (- (* tabs 8) (string-length string)) #\space))
|
||||
)
|
||||
)
|
||||
|
||||
(define make-field-list
|
||||
(lambda (name type fields)
|
||||
(let* ((output (string)) (pos 1))
|
||||
(map
|
||||
(lambda (x)
|
||||
(let* ((sep (if (= pos (length fields)) ";" ","))
|
||||
(start (if (= pos 1)
|
||||
(string "\t"
|
||||
(tab-pad-string (string type) 2))
|
||||
(string "\t\t"))
|
||||
)
|
||||
(comment (string (if (= pos 1) "" "\t") "/* "
|
||||
(tab-pad-string (field-name-constant name (car x)) 3)
|
||||
" */"))
|
||||
(field (tab-pad-string (string-append (string (car x)) sep) 2))
|
||||
)
|
||||
(set! pos (+ pos 1))
|
||||
(string-append start field comment "\n")
|
||||
)
|
||||
)
|
||||
fields)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define make-struct-body
|
||||
(lambda (type)
|
||||
(let* ((name (assoc-ref type "name"))
|
||||
(data (assoc-ref type "fields"))
|
||||
(output (string))
|
||||
)
|
||||
(for-each
|
||||
(lambda (y)
|
||||
(for-each
|
||||
(lambda (z)
|
||||
(set! output (string-append output z))
|
||||
)
|
||||
y)
|
||||
)
|
||||
(map
|
||||
(lambda (x) (make-field-list name (car x) (cdr x)))
|
||||
data)
|
||||
)
|
||||
output)
|
||||
)
|
||||
)
|
||||
|
||||
(define make-struct
|
||||
(lambda (type)
|
||||
(let* ((name (assoc-ref type "name"))
|
||||
(data (assoc-ref type "fields"))
|
||||
(output (string-append
|
||||
(tab-pad-string
|
||||
(string "typedef struct _glibtop_" name)
|
||||
5)
|
||||
(string "glibtop_" name ";\n\n"
|
||||
"struct glibtop_" name "\n{\n\t"
|
||||
"unsigned long\tflags;\n")
|
||||
)
|
||||
)
|
||||
)
|
||||
(string-append output (make-struct-body type) "};\n")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define make-field-name-list
|
||||
(lambda (type)
|
||||
(let* ((name (assoc-ref type "name"))
|
||||
(data (assoc-ref type "fields"))
|
||||
(return (list))
|
||||
)
|
||||
(map
|
||||
(lambda (x)
|
||||
(map
|
||||
(lambda (y) (set! return (append return (list (car y)))))
|
||||
(cdr x)
|
||||
)
|
||||
)
|
||||
data)
|
||||
return)
|
||||
)
|
||||
)
|
||||
|
||||
(define make-field-constants
|
||||
(lambda (type)
|
||||
(let* ((name (assoc-ref type "name"))
|
||||
(data (make-field-name-list type))
|
||||
(output (string
|
||||
(tab-pad-string
|
||||
(string "#define GLIBTOP_MAX_"
|
||||
(string-upcase! (string name))
|
||||
) 5)
|
||||
(number->string (length data))
|
||||
"\n\n"
|
||||
)
|
||||
)
|
||||
(pos 0)
|
||||
)
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(set! output (string-append output (string
|
||||
(tab-pad-string
|
||||
(string "#define GLIBTOP_"
|
||||
(string-upcase! (string name))
|
||||
"_"
|
||||
(string-upcase! (string x))
|
||||
) 5)
|
||||
(number->string pos)
|
||||
"\n"
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! pos (+ pos 1))
|
||||
)
|
||||
data)
|
||||
output)
|
||||
)
|
||||
)
|
||||
|
||||
(define make-extern-defs
|
||||
(lambda (type)
|
||||
(let* ((name (assoc-ref type "name"))
|
||||
)
|
||||
(string
|
||||
(tab-pad-string (string "extern void glibtop_get_" name) 6)
|
||||
"__P(glibtop *, glibtop_" name " *);\n\n"
|
||||
"#ifdef HAVE_GUILE\n\n"
|
||||
"/* You need to link with -lgtop_guile to get this stuff here. */\n\n"
|
||||
(tab-pad-string (string "extern SCM glibtop_get_" name) 6)
|
||||
"__P(void);\n\n"
|
||||
"#endif /* HAVE_GUILE */\n\n"
|
||||
"#ifdef GLIBTOP_GUILE_NAMES\n\n"
|
||||
"/* You need to link with -lgtop_guile_names to get this stuff here. */\n\n"
|
||||
(tab-pad-string (string "extern SCM glibtop_guile_names_" name) 6)
|
||||
"__P(void);\n"
|
||||
(tab-pad-string (string "extern SCM glibtop_guile_labels_" name) 6)
|
||||
"__P(void);\n"
|
||||
(tab-pad-string (string "extern SCM glibtop_guile_descriptions_" name) 6)
|
||||
"__P(void);\n\n"
|
||||
"#endif /* GLIBTOP_GUILE_NAMES */\n\n"
|
||||
"#ifdef GLIBTOP_NAMES\n\n"
|
||||
"/* You need to link with -lgtop_names to get this stuff here. */\n\n"
|
||||
(tab-pad-string (string "extern const char *glibtop_names_" name) 6)
|
||||
"[];\n"
|
||||
(tab-pad-string (string "extern const char *glibtop_labels_" name) 6)
|
||||
"[];\n"
|
||||
(tab-pad-string (string "extern const char *glibtop_descriptions_" name) 6)
|
||||
"[];\n\n"
|
||||
"#endif /* GLIBTOP_NAMES */\n\n")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(begin
|
||||
(display (make-field-constants cpu-type)) (newline)
|
||||
(display (make-struct cpu-type)) (newline)
|
||||
(display (make-extern-defs cpu-type)) (newline)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user