1 /* 2 Ypsilon Scheme System 3 Copyright (c) 2004-2008 Y.FUJITA / LittleWing Company Limited. 4 See license.txt for terms and conditions of use 5 */ 6 7 #ifndef FASL_H_INCLUDED 8 #define FASL_H_INCLUDED 9 10 #include "core.h" 11 #include "hash.h" 12 #include "port.h" 13 14 #define FASL_DEBUG 0 15 16 #define FASL_EOF 0 17 #define FASL_TAG_LOOKUP 1 18 #define FASL_TAG_FIXNUM32 2 19 #define FASL_TAG_PLIST 3 20 #define FASL_TAG_DLIST 4 21 #define FASL_TAG_VECTOR 5 22 #define FASL_TAG_RATIONAL 6 23 #define FASL_TAG_COMPLEX 7 24 #define FASL_TAG_FLONUM 8 25 #define FASL_TAG_BIGNUM 9 26 #define FASL_TAG_BVECTOR 10 27 #define FASL_TAG_CHAR 11 28 #define FASL_TAG_NIL 12 29 #define FASL_TAG_T 13 30 #define FASL_TAG_F 14 31 #define FASL_TAG_SYMBOL 15 32 #define FASL_TAG_STRING 16 33 #define FASL_TAG_UNINTERNED_SYMBOL 17 34 #define FASL_TAG_FIXNUM64 18 35 #define FASL_TAG_INT0 19 36 #define FASL_TAG_INT1 20 37 #define FASL_TAG_INT2 21 38 #define FASL_TAG_INT3 22 39 40 class fasl_printer_t { 41 VM* m_vm; 42 scm_port_t m_port; 43 scm_hashtable_t m_lites; 44 scm_obj_t* m_stack; 45 scm_obj_t* m_stack_limit; 46 scm_obj_t* m_sp; 47 scm_obj_t m_bad; 48 49 void scan(scm_obj_t obj); 50 void put_lites(); 51 void put_list(scm_obj_t obj); 52 void put_datum(scm_obj_t obj); 53 emit_u8(uint8_t octet)54 void emit_u8(uint8_t octet) { 55 port_put_byte(m_port, octet); 56 } 57 emit_u32(uint32_t n)58 void emit_u32(uint32_t n) { 59 for (int i = 0; i < 5; i++) { 60 int code = n & 0x7f; 61 n = n >> 7; 62 if (n == 0) { 63 emit_u8(code | 0x80); 64 break; 65 } else { 66 emit_u8(code); 67 } 68 } 69 } 70 emit_u64(uint64_t n)71 void emit_u64(uint64_t n) { 72 for (int i = 0; i < 8; i++) { 73 emit_u8(n & 0xff); 74 n = n >> 8; 75 } 76 } 77 emit_bytes(const char * s,int n)78 void emit_bytes(const char* s, int n) { 79 for (int i = 0; i < n; i++) emit_u8(s[i]); 80 } 81 push(scm_obj_t obj)82 void push(scm_obj_t obj) { 83 if (m_sp == m_stack_limit) { 84 int n = m_sp - m_stack; 85 int depth = (m_stack_limit - m_stack) * 2; 86 m_stack = (scm_obj_t*)realloc(m_stack, sizeof(scm_obj_t) * depth); 87 if (m_stack == NULL) fatal("%s:%u memory overflow on realloc fasl stack", __FILE__, __LINE__); 88 m_stack_limit = m_stack + depth; 89 m_sp = m_stack + n; 90 } 91 m_sp[0] = obj; 92 m_sp++; 93 } 94 pop()95 scm_obj_t pop() { 96 if (m_sp == m_stack) return NULL; 97 m_sp--; 98 return m_sp[0]; 99 } 100 101 public: 102 fasl_printer_t(VM* vm, scm_port_t port); 103 ~fasl_printer_t(); 104 scm_obj_t put(scm_obj_t obj); 105 }; 106 107 class fasl_reader_t { 108 VM* m_vm; 109 scm_port_t m_port; 110 scm_obj_t* m_lites; 111 fetch_u8()112 uint8_t fetch_u8() { 113 return port_get_byte(m_port); 114 } 115 fetch_u32()116 uint32_t fetch_u32() { 117 uint32_t value = 0; 118 int shift = 0; 119 while (true) { 120 uint8_t octet = port_get_byte(m_port); 121 value = value + ((uint32_t)(octet & 0x7f) << shift); 122 if (octet & 0x80) return value; 123 shift = shift + 7; 124 } 125 } 126 fetch_u64()127 uint64_t fetch_u64() { 128 uint64_t value = 0; 129 int shift = 0; 130 for (int i = 0; i < 8; i++) { 131 value = value + ((uint64_t)port_get_byte(m_port) << shift); 132 shift = shift + 8; 133 } 134 return value; 135 } 136 137 bool get_lites(); 138 scm_obj_t get_datum(); 139 140 public: fasl_reader_t(VM * vm,scm_port_t port)141 fasl_reader_t(VM* vm, scm_port_t port) { 142 m_vm = vm; 143 m_port = port; 144 m_lites = NULL; 145 } ~fasl_reader_t()146 ~fasl_reader_t() { 147 if (m_lites) free(m_lites); 148 } 149 150 scm_obj_t get(); 151 }; 152 153 #endif 154