Add chibi-scheme for filetype parsers.

5 files changed, 255 insertions, 219 deletions

diff --git a/Makefile b/Makefile
index 4eaa45b..4d7d348 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,10 @@
-CFLAGS = -Wall -std=c11 -ggdb -D_POSIX_C_SOURCE=200809L
-LDLIBS = -lncurses
+libs = ncurses chibi-scheme
+
+PKG_CONFIG=env PKG_CONFIG_PATH=/usr/local/lib/pkgconfig pkg-config
+
+CFLAGS = -Wall -std=c11 -ggdb -D_POSIX_C_SOURCE=200809L \
+		 $(shell $(PKG_CONFIG) -cflags $(libs))
+LDLIBS = $(shell $(PKG_CONFIG) -libs $(libs))
 
 .PHONY: all
 all: analyze_gz ui
@@ -7,13 +12,12 @@ all: analyze_gz ui
 analyze_gz: analyze_gz.o hexdump_pretty.o
 	$(CC) $^ -o $@ $(LDLIBS)
 
-ui: ui.o format.o
+ui: ui.o
 	$(CC) $^ -o $@ $(LDLIBS)
 
 analyze_gz.o: analyze_gz.c hexdump_pretty.h gzip.h
 hexdump_pretty.o: hexdump_pretty.c hexdump_pretty.h
-format.o: format.c format.h gzip.h
-ui.o: ui.c format.h
+ui.o: ui.c
 
 clean:
 	-rm *.o
diff --git a/format.c b/format.c
deleted file mode 100644
index ec40eff..0000000
--- a/format.c
+++ /dev/null
@@ -1,188 +0,0 @@
-#include "format.h"
-#include "gzip.h"
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <inttypes.h>
-
-struct segment empty_segment = {
-	.start = -1,
-	.end = -1,
-	.description = "No segment selected",
-};
-
-struct segment get_segment(void *mem, size_t len, ssize_t addr) {
-
-	if (addr < 0 || addr >= len) {
-		return empty_segment;
-	}
-
-
-	static char *buf = NULL;
-	if (buf != NULL) {
-		free(buf);
-		buf = NULL;
-	}
-	struct member *header = (struct member*) mem;
-
-	if (addr == 0) {
-		return (struct segment) {
-			.start = 0,
-			.end = 1,
-			.description = "ID1 = 31"
-		};
-	}
-	if (addr == 1) {
-		return (struct segment) {
-			.start = 1,
-			.end = 2,
-			.description = "ID2 = 139",
-		};
-	}
-	if (addr == 2) {
-		return (struct segment) {
-			.start = 2,
-			.end = 3,
-			.description = "CM (Compression Method)\n"
-				"CM = 8 is defalte",
-		};
-	}
-	if (addr == 3) {
-		buf = malloc(1000);
-		buf[0] = '\0';
-		for (int i = 0; i < 5; i++) {
-			if (header->flg & (1 << i)) {
-				strcat(buf, "- ");
-				strcat(buf, flag_str(1<<i));
-				strcat(buf, "\n");
-			}
-		}
-		return (struct segment) {
-			.start = 3,
-			.end = 4,
-			.description = buf,
-		};
-	}
-	if (addr >= 4 && addr < 8) {
-		buf = malloc(1000);
-		sprintf(buf, "Mtime=%i", header->mtime);
-		return (struct segment) {
-			.start = 4,
-			.end = 8,
-			.description = buf,
-		};
-	}
-	if (addr == 8) {
-		return (struct segment) {
-			.start = 8,
-			.end = 9,
-			.description = "XFL",
-		};
-	}
-	if (addr == 9) {
-		buf = malloc(1000);
-		sprintf(buf, "OS: %s\n", os_str(header->os));
-		return (struct segment) {
-			.start = 9,
-			.end = 10,
-			.description = buf,
-		};
-	}
-
-	void *ptr = ((struct member*) mem) + 1;
-
-	if (header->flg & FEXTRA) {
-		uint16_t xlen = *((uint16_t*) ptr);
-		if (mem + addr == ptr || mem + addr == ptr + 1) {
-			return (struct segment) {
-				.start = ptr - mem,
-				.end = ptr - mem + 1,
-				.description = "XLEN",
-			};
-		}
-		ptr = ((uint16_t*) ptr) + 1;
-		// if (mem + addr >= ptr && mem + addr < xlen) {
-		if (ptr - mem + addr < 2) {
-			return (struct segment) {
-				.start = ptr - mem,
-				.end = ptr - mem + xlen,
-				.description = "XLEN bytes of extra data",
-			};
-		}
-		ptr = ((uint8_t*) ptr) + 1 + xlen;
-	}
-
-	if (header->flg & FNAME) {
-		void *c = memchr(ptr, '\0', (ptr - mem) + len);
-		size_t start = ptr - mem;
-		size_t end = c - mem;
-		ptr = ((uint8_t*) c) + 1;
-		if (addr < c - mem + 1) {
-			return (struct segment) {
-				.start = start,
-				.end = end + 1,
-				.description = "Original filename",
-			};
-		}
-	}
-
-	if (header->flg & FCOMMENT) {
-		void *c = memchr(ptr, '\0', (ptr - mem) + len);
-		ptr = ((uint8_t*) c) + 1;
-		if (addr < c - mem + 1) {
-			size_t start = ptr - mem;
-			size_t end = c - mem;
-			return (struct segment) {
-				.start = start,
-				.end = end + 1,
-				.description = "File comment",
-			};
-		}
-	}
-
-	if (header->flg & FHCRC) {
-		if (addr < ptr - mem + 2) {
-			buf = malloc(1000);
-			sprintf(buf, "CRC16=%" PRIu16, *((uint16_t*) ptr));
-			return (struct segment) {
-				.start = ptr - mem,
-				.end = ptr - mem + 2,
-				.description = buf,
-			};
-		}
-		ptr = (uint16_t*) ptr + 1;
-	}
-
-	if (len - addr < 4) {
-		buf = malloc(1000);
-		sprintf(buf, "ISIZE=%" PRIu32, *(((uint32_t*) ((uint8_t*) (mem + len))) - 1));
-		return (struct segment) {
-			.start = len - 4,
-			.end = len,
-			.description = buf,
-		};
-	}
-
-	if (len - addr - 4 < 4) {
-		buf = malloc(1000);
-		sprintf(buf, "CRC32=%" PRIu32, *(((uint32_t*) ((uint8_t*) (mem + len))) - 2));
-		return (struct segment) {
-			.start = len - 8,
-			.end = len - 4,
-			.description = buf,
-		};
-	}
-
-	if (ptr - mem <= addr && addr < ptr - mem + len - 8) {
-		return (struct segment) {
-			.start = ptr - mem,
-				.end = len - 8,
-				.description = "ZLIB compressed payload",
-		};
-	}
-
-
-	return empty_segment;
-
-}
diff --git a/format.h b/format.h
deleted file mode 100644
index b09cb2f..0000000
--- a/format.h
+++ /dev/null
@@ -1,13 +0,0 @@
-#ifndef FILE_FORMAT_H
-#define FILE_FORMAT_H
-
-#include <sys/types.h>
-
-struct segment {
-	size_t start, end;
-	const char *description;
-};
-
-struct segment get_segment(void *mem, size_t len, ssize_t addr);
-
-#endif /* FILE_FORMAT_H */
diff --git a/gz.scm b/gz.scm
new file mode 100644
index 0000000..789c25d
--- /dev/null
+++ b/gz.scm
@@ -0,0 +1,155 @@
+(import (scheme base)
+        (chibi bytevector)
+        ;; (srfi 1)
+        (srfi 33))
+
+(define FTEXT 0)
+(define FHCRC 1)
+(define FEXTRA 2)
+(define FNAME 3)
+(define FCOMMENT 4)
+
+(define (bit-description bit)
+  (cond ((= bit FTEXT) "File is probably text")
+        ((= bit FHCRC) "CRC16 Checksum is present")
+        ((= bit FEXTRA) "Extra Field is present")
+        ((= bit FNAME) "Filename is present")
+        ((= bit FCOMMENT) "A Comment is present")
+        (else "Unknown Bit")))
+
+(define (filter proc lst)
+  (cond ((null? lst) '())
+        ((proc (car lst)) (cons (car lst)
+                                (filter proc (cdr lst))))
+        (else (filter proc (cdr lst)))))
+
+(define (parse-flags int)
+  (filter string?
+          (map (lambda (bit)
+                 (if (bit-set? bit int)
+                     (string-append (bit-description bit) "\n")
+                     #f))
+               (list FTEXT FHCRC FEXTRA FNAME FCOMMENT))))
+
+(define (os-name i)
+  (case i
+    ((0) "Fat filesystem (MS-DOS, OS/2, NT/Win32)")
+    ((1) "Amiga")
+    ((2) "VMS (or OpenVMS)")
+    ((3) "Unix")
+    ((4) "VM/CMS")
+    ((5) "Atari TOS")
+    ((6) "HPFS fileesystem (OS/2, NT)")
+    ((7) "Macintosh")
+    ((8) "Z-System")
+    ((9) "CP/M")
+    ((10) "TOPS-20")
+    ((11) "NTFS filesystem (NT)")
+    ((12) "QDOS")
+    ((13) "Acorn RISCOS")
+    (else "unknown")))
+
+(define (bytevector-search bv el idx)
+  (cond ((>= idx (bytevector-length bv)) #f)
+        ((equal? el (bytevector-u8-ref bv idx)) idx)
+        (else (bytevector-search bv el (+ idx 1)))))
+
+(define make-segment vector)
+
+(define (get-segment bv addr)
+  (call/cc
+    (lambda (return)
+      (when (> 10 (bytevector-length bv))
+        (return (make-segment 0 (bytevector-length bv)
+                              "Not a GZIP file")))
+
+      (let ()
+        (define ptr 0)
+
+        (define id1 (bytevector-u8-ref bv 0))
+        (define id2 (bytevector-u8-ref bv 1))
+        (define cm (bytevector-u8-ref bv 2))
+        (define flg (bytevector-u8-ref bv 3))
+        (define mtime (bytevector-u32-ref-le bv 4))
+        (define xfl (bytevector-u8-ref bv 8))
+        (define os (bytevector-u8-ref bv 9))
+
+        (cond ((= addr 0) (return (make-segment 0 1 "ID1 = 31")))
+              ((= addr 1) (return (make-segment 1 2 "ID2 = 139")))
+              ((= addr 2) (return (make-segment
+                                   2 3
+                                   "CM (Compression Method)\nCM = 8 is deflate")))
+              ((= addr 3) (return (make-segment 3 4
+                                                (apply string-append (parse-flags (bytevector-u8-ref bv addr))))))
+              ((<= 4 addr 7) (return (make-segment
+                                     4 8 (string-append "mtime="
+                                                        (number->string mtime)))))
+              ((= addr 8) (return (make-segment 8 9 "XFL")))
+              ((= addr 9) (return (make-segment 9 10 (string-append "OS: " (os-name os)))))
+              (else 'continue))
+
+        (set! ptr (+ ptr 10))
+
+        (when (bit-set? FEXTRA flg)
+          (let ((xlen ((bytevector-u16-ref-le bv ptr))))
+            (when (<= addr ptr (+ 1 addr))
+              (return (make-segment ptr (+ 1 ptr) "XLEN")))
+            (set! ptr (+ ptr 2))
+            (when (< addr (+ ptr xlen))
+              (return (make-segment ptr (+ ptr xlen) "XLEN bytes of extra data")))
+            (set! ptr (+ ptr xlen 1))))
+
+
+        ;; utf8->string exists in R7RS,
+        ;; But we want latin1->string
+        (when (bit-set? FNAME flg)
+          (cond ((bytevector-search bv 0 ptr)
+                 => (lambda (idx)
+                      (let ((old ptr))
+                        (set! ptr (+ idx 1))
+                        (when (< addr ptr)
+                          (return (make-segment old ptr "Filename"))))))
+                (else (return (make-segment ptr (bytevector-length bv)
+                                            "Unterminated Filename")))))
+
+        (when (bit-set? FCOMMENT flg)
+          (cond ((bytevector-search bv 0 ptr)
+                 => (lambda (idx)
+                      (let ((old ptr))
+                        (set! ptr (+ idx 1))
+                        (when (< addr ptr)
+                          (return (make-segment old ptr "Comment"))))))
+                (else (return (make-segment ptr (bytevector-length bv)
+                                            "Unterminated Comment")))))
+
+        (when (bit-set? FHCRC flg)
+          (when (< addr (+ ptr 2))
+            (return
+             (make-segment ptr (+ ptr 2)
+                           (string-append
+                            "CRC16="
+                            (number->string
+                             (bytevector-u16-ref-le bv ptr))))))
+          (set! ptr (+ ptr 2)))
+
+        (cond ((>= 4 (- (bytevector-length bv) addr))
+               (return (make-segment (- (bytevector-length bv) 4)
+                                     (bytevector-length bv)
+                                     (string-append "ISIZE="
+                                                    (number->string
+                                                     (bytevector-u32-ref-le
+                                                      bv (- (bytevector-length bv) 4)))))))
+              ((>= 4 (- (bytevector-length bv) addr 4))
+               (return (make-segment (- (bytevector-length bv) 8)
+                                     (- (bytevector-length bv) 4)
+                                     (string-append "CRC32="
+                                                    (number->string
+                                                     (bytevector-u32-ref-le
+                                                      bv (- (bytevector-length bv) 8)))))))
+              ((<= ptr addr (+ ptr (bytevector-length bv) -8))
+               (return (make-segment ptr
+                                     (- (bytevector-length bv) 8)
+                                     "ZLIB compressed payload"))))
+
+        (return (make-segment -1 -1 "No Segment"))
+        ))))
diff --git a/ui.c b/ui.c
index 25e6d5a..16589da 100644
--- a/ui.c
+++ b/ui.c
@@ -1,3 +1,5 @@
+#include <chibi/sexp.h>
+#include <string.h>
 #define _POSIX_C_SOURCE 200809L
 
 #include <ctype.h>
@@ -11,7 +13,12 @@
 
 #include <ncurses.h>
 
-#include "format.h"
+#include <chibi/eval.h>
+
+struct segment {
+	size_t start, end;
+	const char *description;
+};
 
 #define LINE_LEN 0x10 /* Number of bytes in a line */
 
@@ -51,7 +58,7 @@ void draw_hex(struct segment *current) {
 			if (screen.hy == y && screen.hx == x) {
 				wattron(screen.hex, A_REVERSE);
 			}
-			mvwprintw(screen.hex, y, x * 2 + (x/2), "%02x", 
+			mvwprintw(screen.hex, y, x * 2 + (x/2), "%02x",
 					0xFF & ((char*) screen.mem)[addr]);
 			if (screen.hy == y && screen.hx == x) {
 				wattroff(screen.hex, A_REVERSE);
@@ -100,24 +107,72 @@ void draw_info(struct segment *current) {
 	wrefresh(screen.info);
 }
 
-void draw_screen() {
-	struct segment current = get_segment(
-			screen.mem, 
-			screen.mem_len, 
-			screen.top_address + screen.hy * LINE_LEN + screen.hx);
+void draw_screen(sexp ctx, sexp bv) {
+
+	sexp_gc_var3(proc_name, addr, ret);
+	sexp_gc_preserve3(ctx, proc_name, addr, ret);
+	proc_name = sexp_intern(ctx, "get-segment", -1);
+	size_t c_addr = screen.top_address + screen.hy * LINE_LEN + screen.hx;
+	addr = sexp_make_fixnum(c_addr);
+	struct segment current;
+	if (c_addr < 0 || c_addr >= screen.mem_len) {
+		current = (struct segment) {
+			.start = -1,
+			.end = -1,
+			.description = "No Segment",
+		};
+	} else {
+		ret = sexp_eval(ctx, sexp_list3(ctx, proc_name, bv, addr), NULL);
+
+		if (! sexp_vectorp(ret)) {
+			endwin();
+			fprintf(stderr, "get-segment[%lu] failed\n", c_addr);
+			sexp_debug(ctx, "addr = ", addr);
+			if (sexp_exceptionp(ret)) {
+				printf("An exception was thrown\n");
+				sexp_print_exception(ctx, ret, sexp_current_output_port(ctx));
+			} else {
+				sexp_debug(ctx, "Unexpecetd return value: ", ret);
+			}
+			exit(1);
+		}
+
+		current = (struct segment) {
+			.start = sexp_unbox_fixnum(sexp_vector_ref(ret, SEXP_ZERO)),
+			.end = sexp_unbox_fixnum(sexp_vector_ref(ret, SEXP_ONE)),
+			.description = sexp_string_data(sexp_vector_ref(ret, SEXP_TWO))
+		};
+	}
 
 	draw_lines();
 	draw_hex(&current);
 	draw_chr(&current);
 	draw_info(&current);
 	/* TODO end at end of file */
+
+	sexp_gc_release3(ctx);
 }
 
 int main(int argc, char *argv[]) {
 
+	char *errmsg = NULL;
+	int errcode = 0;
+
 	/* Terminal supporting mouse movements */
 	setenv("TERM", "xterm-1003", true);
 
+	sexp_scheme_init();
+	sexp ctx = sexp_make_eval_context(NULL, NULL, NULL, 0, 0);
+	sexp_load_standard_env(ctx, NULL, SEXP_SEVEN);
+	sexp_load_standard_ports(ctx, NULL, NULL, stdout, stderr, 1);
+
+	sexp_gc_var2(obj1, bv);
+	sexp_gc_preserve2(ctx, obj1, bv);
+	obj1 = sexp_c_string(ctx, "gz.scm", -1);
+	sexp_load(ctx, obj1, NULL);
+
+	// sexp_eval_string(ctx, "(display \"Hello, from Scheme!\n\")", -1, NULL);
+
 	initscr();
 	clear();
 	noecho();
@@ -147,19 +202,37 @@ int main(int argc, char *argv[]) {
 	}
 
 	int fd = open(filename, O_RDONLY);
+	if (fd == -1) {
+		errmsg = "Failed to open file";
+		errcode = errno;
+		goto end;
+	}
 	struct stat statbuf;
 	if (fstat(fd, &statbuf) == -1) {
+		errmsg = "Failed to stat file";
+		errcode = errno;
 		goto end;
 	}
-	screen.mem_len = statbuf.st_size;
-	screen.mem = mmap(NULL, statbuf.st_size, PROT_READ, MAP_SHARED, fd, 0);
+
+
+	uint8_t *mem = mmap(NULL, statbuf.st_size, PROT_READ, MAP_SHARED, fd, 0);
 	close(fd);
 
+	screen.mem_len = statbuf.st_size;
+	screen.mem = mem;
+
+	bv = sexp_make_bytes(ctx, sexp_make_fixnum(statbuf.st_size), SEXP_ZERO);
+	for (int i = 0; i < statbuf.st_size; i++) {
+		sexp_bytes_set(bv,
+				sexp_make_fixnum(i),
+				sexp_make_fixnum(mem[i]));
+	}
+
 	mousemask(ALL_MOUSE_EVENTS|REPORT_MOUSE_POSITION, NULL);
 
 	refresh();
 
-	draw_screen();
+	draw_screen(ctx, bv);
 
 	int ch;
 	MEVENT event;
@@ -193,21 +266,21 @@ int main(int argc, char *argv[]) {
 							screen.hy = -1;
 						}
 
-						draw_screen();
+						draw_screen(ctx, bv);
 						break;
 					case ERR:
 						// wprintw(win, "err");
 						break;
 				}
 
-				draw_screen();
+				draw_screen(ctx, bv);
 				refresh();
 				break;
 			case KEY_RESIZE:
 				wresize(screen.lineno, LINES - INFO_HEIGHT, 0);
 				wresize(screen.hex, LINES - INFO_HEIGHT, 0);
 				wresize(screen.chr, LINES - INFO_HEIGHT, 0);
-				draw_screen();
+				draw_screen(ctx, bv);
 				// mvprintw(0, 0, "%ix%i", COLS, LINES);
 				// refresh();
 				break;
@@ -223,5 +296,10 @@ end:
 	delwin(screen.chr);
 	delwin(screen.info);
 	endwin();
+
+	if (errcode) {
+		printf("%s: %s\n", errmsg, strerror(errcode));
+	}
+
 	return 0;
 }