├── .gitignore ├── LICENSE ├── Makefile ├── OPCODE.md ├── README.md ├── bin ├── .gitignore ├── chine └── chine_pack ├── c_src ├── .gitignore ├── Chine │ ├── Chine.ino │ ├── blink.h │ ├── chine.c │ ├── chine.h │ └── chine_sys_arduino.cpp ├── Makefile ├── Makefile.arduino ├── chine.c ├── chine_bench.c ├── chine_exec.c ├── chine_sys_unix.c ├── chine_test.c ├── chine_test3.c └── test │ ├── .gitignore │ ├── arith.ch │ ├── bench.ch │ ├── blink.ch │ ├── crc32.ch │ ├── fail_divzero.ch │ ├── fail_invalid_address.ch │ ├── fail_overflow.ch │ ├── fail_underflow.ch │ ├── frame.ch │ ├── hello.ch │ ├── print.ch │ └── write_file.ch ├── ebin └── .gitignore ├── include ├── chine.h └── chine.hrl ├── priv ├── .gitignore ├── chine_exec.Darwin-x86_64 ├── chine_exec.Linux-armv7l ├── chine_exec.Linux-x86_64 └── chine_exec.Windows-x86_64 ├── rebar.config └── src ├── Makefile ├── chine.app.src ├── chine.erl ├── chine_disasm.erl ├── chine_opt.erl └── chine_pack.erl /.gitignore: -------------------------------------------------------------------------------- 1 | .*.d 2 | *.o 3 | *~ 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (C) 2007 - 2017, Rogvall Invest AB, 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | this software and associated documentation files (the "Software"), to deal in 5 | the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | 21 | Except as contained in this notice, the name(s) of the above copyright holders 22 | shall not be used in advertising or otherwise to promote the sale, use or other 23 | dealings in this Software without prior written authorization. 24 | 25 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | #@BEGIN-DIR-DEFAULT-RULES@ 2 | all: 3 | @if [ -d "src" -a -f "src/Makefile" ]; then (cd src && $(MAKE) all); fi 4 | @if [ -d "c_src" -a -f "c_src/Makefile" ]; then (cd c_src && $(MAKE) all); fi 5 | @if [ -d "test" -a -f "test/Makefile" ]; then (cd test && $(MAKE) all); fi 6 | 7 | clean: 8 | @if [ -d "src" -a -f "src/Makefile" ]; then (cd src && $(MAKE) clean); fi 9 | @if [ -d "c_src" -a -f "c_src/Makefile" ]; then (cd c_src && $(MAKE) clean); fi 10 | @if [ -d "test" -a -f "test/Makefile" ]; then (cd test && $(MAKE) clean); fi 11 | #@END-DIR-DEFAULT-RULES@ 12 | -------------------------------------------------------------------------------- /OPCODE.md: -------------------------------------------------------------------------------- 1 | # Chine opcode table 2 | 3 | ## opcode 00xxxxxx 4 | 5 | dup 0 6 | rot 1 7 | over 2 8 | drop 3 9 | swap 4 10 | - 5 11 | + 6 12 | * 7 13 | nop 8 14 | and 9 15 | or 10 16 | xor 11 17 | 0= 12 18 | 0< 13 19 | not 14 20 | U/A 15 unassigned 21 | negate 16 22 | / 17 integer division 23 | shift 18 24 | ! 19 25 | @ 20 26 | >r 21 27 | r> 22 28 | r@ 23 29 | exit 24 30 | sys 25 31 | yield 26 32 | [] 27 33 | execute 28 34 | fp@ 29 35 | fp! 30 36 | sp@ 31 37 | sp! 32 38 | 39 | ## opcode 11xxxyyy 40 | 41 | Two of the first 0..7 opcodes can be packed into one byte. 42 | 43 | dup 0 44 | rot 1 45 | over 2 46 | drop 3 47 | swap 4 48 | - 5 49 | + 6 50 | * 7 51 | 52 | ## opcode 01eejjjj 53 | 54 | This group uses the two middle bits ee as a binary exponent 55 | to code number of bytes that follow the code code. 56 | 57 | ee 0 1 byte signed argument length 58 | ee 1 2 bytes signed argument (big endian) 59 | ee 2 4 bytes signed argument (big endian) 60 | ee 3 unassigned 61 | 62 | The jjjj (jump) opcodes are 63 | 64 | jmpz 0 65 | jmpnz 1 66 | next 2 67 | jmplz 3 68 | jmp 4 69 | call 5 70 | literal 6 71 | array 7 .. 72 | arg 8 73 | 74 | 75 | ## opcode 10aaajjj 76 | 77 | This group uses the three middle bits "aaa" as a 78 | signed 3 bit integer 79 | 80 | aaa 0 argument 0 81 | aaa 1 argument 1 82 | aaa 2 argument 2 83 | aaa 3 argument 3 84 | aaa -4 argument 4 85 | aaa -3 argument 5 86 | aaa -2 argument 6 87 | aaa -1 argument 7 88 | 89 | The jjj (jump) opcodes are the same as in 01eejjjj but for 90 | only the first 8 opcodes. 91 | 92 | # Examples 93 | 94 | To push constant 0 we use literal and the immediate tiny constant coding 95 | 96 | 2 0 6=literal 97 | 10|000|110 98 | 99 | To push constant 1000 we use literal with 2 bytes encoding 100 | 101 | 01|01|0110 00000011 11101000 102 | 103 | To 2dup the stack over over can be used 104 | 105 | ( a b -- a b a b ) 106 | 107 | 11|010|010 108 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CHINE, a pretty compact opcode scheme 2 | 3 | Chine is a byte code machine. The chine 4 | machine and its byte code is easy to port to a number 5 | of architectures. 6 | 7 | ## INSTRUCTIONS op3/op6 8 | 9 | | opname | stack effect | comment | 10 | |-----------|----------------------|---------------| 11 | | dup | ( a -- a a ) | 12 | | rot | ( a b c -- b c a ) | rotate down | 13 | | over | ( a b -- a b a ) | 14 | | drop | ( a -- ) | 15 | | swap | ( a b -- b a ) | 16 | | - | ( a b -- [ a-b ] ) | 17 | | + | ( x1 x2 -- [ x1+x2 ] ) | 18 | | * | ( x1 x2 -- [ x1*x2 ] ) | 19 | | nop | ( -- ) | 20 | | and | ( a b -- [ a&b ] ) 21 | | or | ( a b -- [ a\|b ] ) 22 | | xor | ( a b -- [ a^b ] ) 23 | | 0= | ( a -- [ a==0 ] ) | true = -1 24 | | 0< | ( a -- [ a<0 ] ) | true = -1 25 | | not | ( a -- [ ~a ] ) 26 | | negate | ( a -- [ -a ] ) | 27 | | / | ( a b -- [ a/b ] ) | 28 | | shift | ( a n -- [ (uint)a << n OR (int)a >> -n ] ) | 29 | | ! | ( n i -- ) | mem[i] = n | 30 | | @ | ( i -- n ) | n = mem[i] | 31 | | >r | ( n -- ) R: ( -- n ) 32 | | r> | R: ( n -- ) ( -- n ) 33 | | r@ | R: ( n -- n ) ( -- n ) 34 | | sys u:8 | ( x1 .. xn -- v f ) | 35 | | exit | ; ( -- ) R: ( addr -- ) | 36 | | yield | ( -- ) | 37 | | [] | ( caddr i -- n ) | data access via index 38 | | execute | ( caddr -- ) | 39 | | fp@ | ( -- fp ) | fetch frame pointer 40 | | fp! | ( fp -- ) | set frame pointer 41 | | sp@ | ( -- sp ) | fetch stack pointer 42 | | sp! | ( sp -- ) | set stack pointer 43 | 44 | ## INSTRUCTIONS jop 45 | 46 | | opname | stack effect | comment | 47 | |-----------|---------------------|--------------------| 48 | | jmpz | ( f -- ) | top==0 | 49 | | jmpnz | ( f -- ) | top!=0 | 50 | | next | ( -- ) | rtop>=0 | 51 | | jmplz | ( f -- ) | top<0 | 52 | | jmp | ( -- ) | | 53 | | call | ( -- ) | | 54 | | literal | ( -- n ) | | 55 | | array | ( -- caddr ) | | 56 | 57 | Extended instructions 58 | 59 | | opname | stack effect | comment | 60 | |-----------|---------------------|---------------------| 61 | | arg | ( -- ai ) | push relative fp | 62 | 63 | ## compiler built-ins min,max,abs ... 64 | 65 | : 1+ 1 + ; 66 | : 1- 1 - ; 67 | : lshift shift ; 68 | : rshift negate shift ; 69 | : < - 0< ; 70 | : > swap - 0< ; 71 | : <= - 0<= ; 72 | : >= swap - 0<= ; 73 | : = - 0= ; 74 | : 2dup over over ; 75 | : 2drop drop drop ; 76 | : u< 2dup xor 0< 77 | if swap drop 0< else - 0< then ; 78 | : u<= 2dup xor 0< 79 | if swap drop 0< else - 0<= then ; 80 | : u> swap u< ; 81 | : u>= swap u<= ; 82 | : 0<> 0= not ; 83 | : 0> 0 > ; 84 | : 0<= 1- 0< ; 85 | : abs ( a -- [ |a| ] ) 86 | dup 0< if negate then ; 87 | : min ( a b -- [ min(a,b) ] ) 88 | 2dup < if drop else swap drop then ; 89 | : max ( a b -- [ max(a,b) ] 90 | 2dup < if swap drop else drop then ; 91 | : nip swap drop ; 92 | : tuck swap over ; 93 | : -rot rot rot ; 94 | : arshift dup 32 swap - 95 | -1 swap shift -rot negate shift or ; 96 | : 2* dup + ; 97 | : 2/ 1 arshift ; 98 | : sqr dup * ; 99 | : mod 2dup / * - ; 100 | 101 | : jmp* >r exit ; 102 | : SEMI exit ; 103 | : setbit ( fld n -- [ fld or (1 << n) ] ) 104 | 1 swap lshift or ; 105 | : clrbit ( fld n -- [ fld and ~(1 << n) ] ) 106 | 1 swap lshift invert and ; 107 | : togglebit ( fld n -- [ fld xor (1 << n) ] ) 108 | 1 swap lshift xor ; 109 | : tstbit ( fld n -- [ fld and (1 << n) ] ) 110 | 1 swap lshift and ; 111 | : setclrbit ( fld n f -- [ if (f) setbit els clrbit ] ) 112 | if setbit else clrbit then ; 113 | 114 | : jmp* ( caddr -- ) >r exit ; 115 | 116 | : fenter ( -- ) fp@ >r sp@ fp! ; 117 | : fleave ( -- ) fp@ r> fp! sp! ; 118 | 119 | ## non branch alternatives ( mostly for fun ) 120 | 121 | : min ( a b -- [ min(a,b) ] 122 | over over over over ( a b -- a b a b a b ) 123 | - 0< ( a b a b [ sign(a - b) ] ) 124 | -rot ( a b [ sign(a - b) ] a b ) 125 | xor ( a b [ sign(a - b) ] [ a xor b ] ) 126 | and ( a b [ sign(a - b) and (a xor b) ] ) 127 | xor ( a [ b xor ( sign(a-b) and (a xor b) ) ] ) 128 | swap drop ; ( [ b xor ( sign(a-b) and (a xor b) ) ] ) 129 | 130 | : abs ( a -- [ |a| ] ) 131 | dup 0< ( a f ) 132 | dup ( a f f ) 133 | rot swap ( f a f ) 134 | negate xor ( f [ a xor -f ] ) 135 | + ( [ f + (a xor -f) ] ) 136 | ; 137 | 138 | : setclrbit ( w n f -- [ if (f) w |= m; else w &= ~m end ] ) 139 | negate ( w n -f ) 140 | swap 1 swap lshift ( w -f m ) 141 | rot ( -f m w ) 142 | rot ( m w -f ) 143 | over ( m w -f w ) 144 | xor ( m w [-f xor w] ) 145 | rot ( w [-f xor w] m ) 146 | and ( w [ ((-f xor w) and m ) ] ) 147 | xor ( [ w xor ((-f xor w) and m ) ] ) 148 | ; 149 | 150 | ## System calls 151 | 152 | Stack effects are written as ( before -- after ) where 153 | stacks are describes as " last ... 2nd top " that is 154 | top is to the right, the order it is typed in. 155 | 156 | | Name | Stack effect |Comment| 157 | |-----------------|------------------|-------| 158 | | now | ( -- u ) | ms sinc system start | 159 | | emit | ( c -- ) | | 160 | | recv | ( -- c ) | | 161 | | avail | ( -- f ) | | 162 | | param@ | ( i si -- v ) | | 163 | | param! | ( i si v -- ) | | 164 | | timer\_init | ( i -- ) | | 165 | | timer\_start | ( i -- ) | | 166 | | timer\_stop | ( i -- ) | | 167 | | timer\_timeout | ( i -- ) | | 168 | | timer\_running | ( i -- flag ) | | 169 | | input@ | ( i k -- v ) | | 170 | | select\_timer | ( i -- ) | | 171 | | deselect\_timer | ( i -- ) | | 172 | | select\_input | ( i -- ) | | 173 | | dselect\_input | ( i -- ) | | 174 | | deselect\_all | ( -- ) | | 175 | | gpio\_input | ( i -- ) | | 176 | | gpio\_output | ( i -- ) | | 177 | | gpio\_set | ( i -- ) | | 178 | | gpio\_clr | ( i -- ) | | 179 | | gpio\_get | ( i -- n ) | | 180 | | analog\_send | ( i u16 -- ) | | 181 | | analog\_recv | ( i -- u16 ) | | 182 | | uart\_connect | ( baud mode tty -- fd t | err f ) | | 183 | | uart\_send | ( fd u8 -- t | err f ) | | 184 | | uart\_recv | ( fd -- u8 t | err f ) | | 185 | | uart\_avail | ( fd -- flag ) | | 186 | | can\_disconnect | ( fd -- t | err f ) | | 187 | | can\_connect | ( bitrate mode dev -- fd t | err f ) 188 | | can\_send | ( fd fid len A B -- t | err f ) 189 | | can\_recv | ( fd -- A B len fid t | 0 fid t | err f ) 190 | | can\_avail | ( fd -- flag ) 191 | | can\_disconnect | ( fd -- t | err f ) 192 | | file\_open | ( name flags -- fd t | fd f ) | | 193 | | file\_write | ( fd buf n -- n t | err f ) | | 194 | | file\_read | ( fd buf n -- n t | err f ) | | 195 | | file\_close | ( fd -- t | err f ) | | 196 | | file\_seek | ( fd offset whence -- offs t | err f ) | | 197 | 198 | # Source format 199 | 200 | The source format for chine code is currently in form of 201 | the Erlang term format. A program consists of terms of 202 | lists or straight terms terminated with dots. 203 | 204 | Constants are written like 205 | 206 | {const, Integer} 207 | {const, Symbol} 208 | Integer suger for {const,Integer} 209 | {string, String} suger for {array,[{const,C1},...{const,Cn}]} ) 210 | 211 | Symbols may be introduced with 212 | 213 | {enum, ["Sym1", "Sym2" ... "SymN" ]} 214 | 215 | This enumerates the symbols to values 0 ... N-1, later use 216 | of {const,"Sym1"} will have the same effect as enter {const,0}. 217 | 218 | {label, L} 219 | 220 | Is a way of marking a position in the code, it may be 221 | used for relative or absolute addressing. 222 | 223 | {caddr,L} 224 | 225 | Is used to create an absolute (actually relative from start of code) 226 | value of a label address. 227 | 228 | If a Label must be access from outside the code an export directive 229 | will place the label symbol and it's value in the symbol table. 230 | 231 | {export, L} 232 | 233 | 234 | Comments may be inserted as 235 | 236 | {comment, "Text"} 237 | 238 | Or comments may be given in the source file with Erlangs % comments. 239 | There are a number of helpful constructs for structured programming 240 | constructs such as loops and if statemensts 241 | 242 | ## Control 243 | 244 | {'if', Then} 245 | {'if', Then, Else} 246 | 247 | Note that if MUST be quoted since 'if' is a keyword in Erlang 248 | 249 | {'again', Loop} 250 | {'until', Loop} 251 | {'repeat', While, Loop} 252 | 253 | In the above loops 'again' is an infine loop and 'until' evaluate the 254 | Loop body until the result of the Loop body is a none 255 | zero value. Note that the 'again' Loop body should not produce any 256 | stack values since none are popped in the loop by it self. 257 | 'repeat' evaluate the code in the While part and if the 258 | result is none zero the Loop is executed and the loop restarts. 259 | 260 | {'for',Loop} 261 | 262 | For implements a finte loop where the loop count is expeced on the 263 | stack on entry. The loop index is counted downward towards zero and 264 | may be fetched during the loop with 'r@'. 265 | 266 | ## Arrays 267 | 268 | Arrays can be used to access data more efficent, like 269 | 270 | {array, [{const,5},{const,7},{const,11},{const,13},{const,17}]} 271 | 272 | Is a small array of prime numbers. The array construct compiles inline 273 | and push the array pointer onto the stack, there is no penalty to 274 | loop over a array construct, just a pointer being pushed and 275 | the array data being skipped. So a loop over an array construct is 276 | perfectly ok. 277 | To access an item in the array the '[]' operation is used. Note that 278 | the '[]' operation use a zero based index. 279 | 280 | [5, {for, [{array,[$o,$l,$l,$e,$H]},'r@','1-','[]',emit]}] 281 | 282 | Arrays are also used for jump tables 283 | 284 | {array, [{caddr,L1}, {caddr,L2}, ..., {caddr,Ln}]} 285 | 286 | To jump to the code and the label Li 287 | 288 | i-1, '[]', 'jmp*' 289 | 290 | On the other hand if the array is an array of labels to functions 291 | then the 'execute' operation is used and control is being return after 292 | function is done executing. 293 | 294 | i-1, '[]', execute 295 | 296 | 297 | ## Binary format 298 | 299 | The Source code is transformed compiled/assembled into a binary 300 | form that is divided into a couple of sections. 301 | 302 | 'C','H','I','N' 303 | 304 | is the magic 32 bit word that is used to recognise chine binary code. 305 | Following the magic word is a small header 306 | 307 | Version:32 file version 308 | Crc:32 crc-32 over all data (while Crc was set to zero) 309 | Length:32 content length in number of bytes 310 | 311 | Length cover the rest of the sections including the crc-32. 312 | The Crc is calculated over all data with Crc field set to zero. 313 | 314 | symbol table section 315 | 316 | 'S','Y','M','B', 317 | Length:32, 318 | 319 | Each entry in the symbol sections, looks like 320 | 321 | Len:8, Sym:Len/binary, N:8, Value:N/binary 322 | 323 | The code follows the SYMB section in a section called CODE 324 | 325 | 'C','O','D','E', 326 | Length:32 327 | -------------------------------------------------------------------------------- /bin/.gitignore: -------------------------------------------------------------------------------- 1 | chine_exec 2 | chine_trace 3 | -------------------------------------------------------------------------------- /bin/chine: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %%% @author Tony Rogvall 4 | %%% @copyright (C) 2017, Tony Rogvall 5 | %%% @doc 6 | %%% Start chine compiler 7 | %%% @end 8 | 9 | main(Args) -> 10 | chine:start(Args). 11 | -------------------------------------------------------------------------------- /bin/chine_pack: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %%% @author Tony Rogvall 4 | %%% @copyright (C) 2021, Tony Rogvall 5 | %%% @doc 6 | %%% pack chine program as script/executable 7 | %%% @end 8 | 9 | main(Args) -> 10 | chine_pack:start(Args). 11 | -------------------------------------------------------------------------------- /c_src/.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | build-uno 3 | *.x 4 | -------------------------------------------------------------------------------- /c_src/Chine/Chine.ino: -------------------------------------------------------------------------------- 1 | 2 | #include "chine.h" 3 | 4 | // #if defined(ARDUINO) 5 | // #include 6 | // #else 7 | // #define pgm_read_byte(ptr) *((byte*)ptr) 8 | // #endif 9 | 10 | chine_t m; 11 | 12 | #include "blink.h" 13 | 14 | extern int chine_arduino_sys(chine_t* mp, 15 | cell_t sysop, cell_t* revarg, 16 | cell_t* npop, cell_t* value); 17 | 18 | void setup() 19 | { 20 | chine_init(&m, prog, chine_arduino_sys); 21 | chine_set_ip(&m, SYM_init); 22 | chine_run(&m); 23 | chine_set_ip(&m, SYM_run); 24 | } 25 | 26 | void loop() 27 | { 28 | uint8_t imask[NUM_IBYTES]; // input mask 29 | timeout_t tmo; 30 | 31 | chine_run(&m); 32 | 33 | tmo = 0xffffffff; 34 | memset(&imask, 0, sizeof(imask)); 35 | if (chine_next(&m, &tmo, imask)) { // wait for input or timer 36 | if (tmo < 0xffffffff) { 37 | delay(tmo); 38 | } 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /c_src/Chine/blink.h: -------------------------------------------------------------------------------- 1 | #define SYM_run 32 2 | #define SYM_init 0 3 | // program size=107, sha=af782a1e03afa0148b44f3b63ddf07269e5a4768 4 | unsigned char prog[] = { 5 | 0x46,0x0d,0x19,0x1a,0x8e,0x19,0x08,0x96,0x19,0x08,0x56,0x27, 6 | 0x10,0x8e,0x56,0x01,0xf4,0x19,0x07,0x56,0x27,0x10,0x96,0x56, 7 | 0x02,0xee,0x19,0x07,0x86,0x86,0x13,0x18,0x57,0x03,0x00,0x59, 8 | 0x00,0x2d,0x00,0x4c,0x86,0x14,0x1b,0x15,0x18,0x8e,0x19,0x0b, 9 | 0x0e,0x40,0x04,0x8e,0x19,0x0f,0x18,0x8e,0x19,0x10,0x46,0x0d, 10 | 0x19,0x1c,0x46,0x30,0x19,0x03,0x86,0x19,0x09,0x86,0x19,0x0f, 11 | 0x96,0x86,0x13,0x18,0x86,0x19,0x0b,0x0e,0x40,0x04,0x86,0x19, 12 | 0x0f,0x18,0x86,0x19,0x10,0x46,0x0d,0x19,0x1b,0x46,0x31,0x19, 13 | 0x03,0x8e,0x19,0x09,0x8e,0x19,0x0f,0x8e,0x86,0x13,0x18 }; 14 | -------------------------------------------------------------------------------- /c_src/Chine/chine.c: -------------------------------------------------------------------------------- 1 | ../chine.c -------------------------------------------------------------------------------- /c_src/Chine/chine.h: -------------------------------------------------------------------------------- 1 | ../../include/chine.h -------------------------------------------------------------------------------- /c_src/Chine/chine_sys_arduino.cpp: -------------------------------------------------------------------------------- 1 | // 2 | // Test implmentation of sys callback for unix 3 | // 4 | 5 | #include "Arduino.h" 6 | #include "HardwareSerial.h" 7 | 8 | #include "chine.h" 9 | 10 | #define INDEX_TYPE 0x2701 // UNSIGNED8 - type code 11 | #define INDEX_DELAY 0x2710 // UNSIGNED32 - time 12 | #define INDEX_WAIT 0x2712 // UNSIGNED32 - time 13 | #define INDEX_RAMPUP 0x2715 // UNSIGNED32 - time 14 | #define INDEX_RAMPDOWN 0x2716 // UNSIGNED32 - time 15 | 16 | uint8_t param_type[MAX_TIMERS]; 17 | uint32_t param_delay[MAX_TIMERS] = 18 | { 500, 1000, 2000, 3000, 4000, 5000, 6000, 7000 }; 19 | uint32_t param_wait[MAX_TIMERS]; 20 | uint32_t param_rampup[MAX_TIMERS]; 21 | uint32_t param_rampdown[MAX_TIMERS]; 22 | 23 | // time since program started in ms 24 | uint32_t chine_micros(void) 25 | { 26 | return micros(); 27 | } 28 | 29 | uint32_t chine_millis(void) 30 | { 31 | return millis(); 32 | } 33 | 34 | static int fetch(uint16_t index, uint8_t si, int32_t* value) 35 | { 36 | if (si >= MAX_TIMERS) return FAIL_INVALID_ARGUMENT; 37 | switch(index) { 38 | case INDEX_TYPE: *value = param_type[si]; break; 39 | case INDEX_DELAY: *value = param_delay[si]; break; 40 | case INDEX_WAIT: *value = param_wait[si]; break; 41 | case INDEX_RAMPUP: *value = param_rampup[si]; break; 42 | case INDEX_RAMPDOWN: *value = param_rampdown[si]; break; 43 | default: return FAIL_INVALID_ARGUMENT; 44 | } 45 | return 0; 46 | } 47 | 48 | static int store(uint16_t index, uint8_t si, int32_t value) 49 | { 50 | if (si >= MAX_TIMERS) return FAIL_INVALID_ARGUMENT; 51 | switch(index) { 52 | case INDEX_TYPE: param_type[si]=value; break; 53 | case INDEX_DELAY: param_delay[si]=value; break; 54 | case INDEX_WAIT: param_wait[si]=value; break; 55 | case INDEX_RAMPUP: param_rampup[si]=value; break; 56 | case INDEX_RAMPDOWN: param_rampdown[si]=value; break; 57 | default: return FAIL_INVALID_ARGUMENT; 58 | } 59 | return 0; 60 | } 61 | 62 | // 63 | // return: < 0 FAIL_xyz 64 | // == 0 return no value 65 | // > 0 return value in *value 66 | // number of arguments to pop is return in npop 67 | // 68 | int chine_arduino_sys(chine_t* mp, 69 | cell_t sysop, cell_t* revarg, 70 | cell_t* npop, cell_t* value) 71 | { 72 | switch(sysop) { 73 | case SYS_INIT: { 74 | Serial.begin(9600); 75 | return 0; 76 | } 77 | 78 | case SYS_TERMINATE: { 79 | *npop = 0; 80 | return FAIL_TERMINATE; 81 | } 82 | 83 | case SYS_NOW: { 84 | *npop = 0; 85 | *value = chine_millis(); 86 | return 1; 87 | } 88 | 89 | case SYS_EMIT: { 90 | *npop = 1; 91 | Serial.write(revarg[0]); 92 | return 0; 93 | } 94 | 95 | case SYS_AVAIL: { 96 | *npop = 0; 97 | *value = Serial.available(); 98 | return 1; 99 | } 100 | 101 | case SYS_RECV: { 102 | *npop = 0; 103 | *value = Serial.read(); 104 | return 1; 105 | } 106 | 107 | case SYS_PARAM_FETCH: { 108 | *npop = 2; 109 | return fetch(revarg[1], revarg[0], value); 110 | } 111 | 112 | case SYS_PARAM_STORE: { 113 | *npop = 3; 114 | return store(revarg[2], revarg[1], revarg[0]); 115 | } 116 | 117 | case SYS_TIMER_STOP: // same as init 118 | case SYS_TIMER_INIT: { 119 | cell_t i = revarg[0]; 120 | *npop = 1; 121 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 122 | CLRBIT(mp->tbits, i); 123 | mp->timer[i] = 0; 124 | return 0; 125 | } 126 | 127 | case SYS_TIMER_START: { 128 | cell_t i = revarg[0]; 129 | *npop = 1; 130 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 131 | SETBIT(mp->tbits, i); 132 | mp->timer[i] = chine_millis()+param_delay[i]; 133 | return 0; 134 | } 135 | 136 | case SYS_TIMER_TIMEOUT: { 137 | cell_t i = revarg[0]; 138 | *npop = 1; 139 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 140 | if (!TSTBIT(mp->tbits,i)) 141 | *value = CHINE_FALSE; 142 | else 143 | *value = CHINE_TEST(chine_millis() >= mp->timer[i]); 144 | return 1; 145 | } 146 | 147 | case SYS_TIMER_RUNNING: { 148 | cell_t i = revarg[0]; 149 | *npop = 1; 150 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 151 | *value = CHINE_TEST(TSTBIT(mp->tbits, i) != 0); 152 | return 1; 153 | } 154 | 155 | case SYS_INPUT_FETCH: { // ( i k -- v ) 156 | cell_t k = revarg[0]; 157 | cell_t i = revarg[1]; 158 | *npop = 2; 159 | if ((i < 0) || (i >= 32)) return FAIL_INVALID_ARGUMENT; 160 | // add more input possiblilties 161 | switch(k) { 162 | case INPUT_BOOLEAN: *value = digitalRead(i); break; 163 | case INPUT_ANALOG: *value = analogRead(i)<<6; break; 164 | case INPUT_ENCODER: *value = 0; break; 165 | default: return FAIL_INVALID_ARGUMENT; 166 | } 167 | return 1; 168 | } 169 | case SYS_OUTPUT_STORE: { // ( n i k -- ) 170 | cell_t k = revarg[0]; 171 | cell_t i = revarg[1]; 172 | cell_t n = revarg[2]; 173 | *npop = 3; 174 | if ((i < 0) || (i >= 32)) return FAIL_INVALID_ARGUMENT; 175 | switch(k) { 176 | case INPUT_BOOLEAN: digitalWrite(i, n ? HIGH : LOW); break; 177 | case INPUT_ANALOG: analogWrite(i, n>>8); break; 178 | case INPUT_ENCODER: break; 179 | default: return FAIL_INVALID_ARGUMENT; 180 | } 181 | return 1; 182 | } 183 | case SYS_DESELECT_ALL: { // ( -- ) 184 | memset(mp->imask, 0, sizeof(mp->imask)); 185 | memset(mp->tmask, 0, sizeof(mp->tmask)); 186 | return 0; 187 | } 188 | case SYS_SELECT_INPUT: { // ( i -- ) 189 | cell_t i = revarg[0]; 190 | *npop = 1; 191 | if ((i < 0) || (i >= MAX_INPUT)) return FAIL_INVALID_ARGUMENT; 192 | SETBIT(mp->imask, i); 193 | return 0; 194 | } 195 | case SYS_DESELECT_INPUT: { // ( i -- ) 196 | cell_t i = revarg[0]; 197 | *npop = 1; 198 | if ((i < 0) || (i >= MAX_INPUT)) return FAIL_INVALID_ARGUMENT; 199 | CLRBIT(mp->imask, i); 200 | return 0; 201 | } 202 | case SYS_SELECT_TIMER: { // ( i -- ) 203 | cell_t i = revarg[0]; 204 | *npop = 1; 205 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 206 | SETBIT(mp->tmask, i); 207 | return 0; 208 | } 209 | case SYS_DESELECT_TIMER: { // ( i -- ) 210 | cell_t i = revarg[0]; 211 | *npop = 1; 212 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 213 | CLRBIT(mp->tmask, i); 214 | return 0; 215 | } 216 | 217 | case SYS_GPIO_INPUT: { 218 | *npop = 1; 219 | pinMode(revarg[0], INPUT); 220 | return 0; 221 | } 222 | 223 | case SYS_GPIO_OUTPUT: { 224 | *npop = 1; 225 | pinMode(revarg[0], OUTPUT); 226 | return 0; 227 | } 228 | case SYS_GPIO_SET: { 229 | *npop = 1; 230 | digitalWrite(revarg[0], HIGH); 231 | return 0; 232 | } 233 | case SYS_GPIO_CLR: { 234 | *npop = 1; 235 | digitalWrite(revarg[0], LOW); 236 | return 0; 237 | } 238 | case SYS_GPIO_GET: { 239 | *npop = 1; 240 | *value = digitalRead(revarg[0]); 241 | return 1; 242 | } 243 | 244 | case SYS_ANALOG_SEND: { 245 | *npop = 2; 246 | analogWrite(revarg[1],revarg[0]>>8); 247 | return 0; 248 | } 249 | 250 | case SYS_ANALOG_RECV: { 251 | *npop = 1; 252 | *value = analogRead(revarg[0])<<6; 253 | return 1; 254 | } 255 | 256 | case SYS_UART_CONNECT: { 257 | char* tty = "tty1"; 258 | int baud = revarg[1]; 259 | int mode = revarg[2]; 260 | return 0; 261 | } 262 | 263 | case SYS_UART_SEND: { 264 | int fd = revarg[1]; 265 | uint8_t val = revarg[0]; 266 | *npop = 2; 267 | if (fd == 0) 268 | Serial.write(revarg[0]); 269 | return 0; 270 | } 271 | 272 | case SYS_UART_RECV: { 273 | int fd = revarg[0]; 274 | *npop = 0; 275 | if (fd == 0) { 276 | revarg[0] = Serial.read(); 277 | *value = CHINE_TRUE; 278 | } 279 | else { 280 | revarg[0] = 666; 281 | *value = CHINE_FALSE; 282 | } 283 | return 1; 284 | } 285 | 286 | case SYS_UART_AVAIL: { 287 | int fd = revarg[0]; 288 | *npop = 1; 289 | if (fd == 0) 290 | *value = CHINE_TEST(Serial.available()); 291 | else 292 | *value = CHINE_FALSE; 293 | return 1; 294 | } 295 | 296 | case SYS_UART_DISCONNECT: { 297 | int fd = revarg[0]; 298 | (void) fd; 299 | *npop = 1; 300 | *value = CHINE_TRUE; 301 | return 1; 302 | } 303 | 304 | // SYS_CAN_CONNECT 305 | // SYS_CAN_SEND 306 | // SYS_CAN_RECV 307 | // SYS_CAN_DISCONNECT 308 | 309 | 310 | // SYS_FILE_OPEN 311 | // SYS_FILE_WRITE 312 | // SYS_FILE_READ 313 | // SYS_FILE_CLOSE 314 | // SYS_FILE_SEEK 315 | 316 | default: 317 | *npop = 0; 318 | return FAIL_INVALID_ARGUMENT; 319 | } 320 | } 321 | -------------------------------------------------------------------------------- /c_src/Makefile: -------------------------------------------------------------------------------- 1 | # Build chine interpreter for unix and some debug/test programs 2 | CC=gcc 3 | LD=gcc 4 | BIN = ../bin 5 | CFLAGS=-MMD -MP -MF .$<.d 6 | CFLAGS += -Wno-unused-result -I../include # -std=c99 7 | CFLAGS += -Wall -O3 -static 8 | 9 | LDFLAGS += # -nostdlib 10 | LIBS= #-lc 11 | 12 | CHINE_OBJS = chine.o chine_sys_unix.o 13 | CHINE_EXEC_OBJS = chine_exec.o $(CHINE_OBJS) 14 | CHINE_TEST = chine_test chine_test3 15 | CHINE_BENCH = chine_bench 16 | CHINE_ALL = $(BIN)/chine_exec $(BIN)/chine_trace $(CHINE_TEST) $(CHINE_BENCH) 17 | 18 | all: $(BIN)/chine_exec 19 | 20 | chine_exec: $(BIN)/chine_exec 21 | 22 | chine_trace: $(BIN)/chine_trace 23 | 24 | test: $(CHINE_TEST) 25 | 26 | bench: $(CHINE_BENCH) 27 | 28 | tutti: $(CHINE_ALL) 29 | 30 | $(BIN)/chine_exec: $(CHINE_EXEC_OBJS) 31 | $(LD) $(LDFLAGS) -o $@ $(CHINE_EXEC_OBJS) $(LIBS) 32 | 33 | $(BIN)/chine_trace: $(CHINE_EXEC_OBJS) 34 | $(LD) $(LDFLAGS) -o $@ $(CHINE_EXEC_OBJS) $(LIBS) 35 | 36 | chine_test: $(CHINE_OBJS) chine_test.o 37 | $(LD) $(LDFLAGS) -o $@ $(CHINE_OBJS) chine_test.o $(LIBS) 38 | 39 | chine_test3: $(CHINE_OBJS) chine_test3.o 40 | $(LD) $(LDFLAGS) -o $@ $(CHINE_OBJS) chine_test3.o $(LIBS) 41 | 42 | chine_bench: $(CHINE_OBJS) chine_bench.o 43 | $(LD) $(LDFLAGS) -o $@ $(CHINE_OBJS) chine_bench.o $(LIBS) 44 | 45 | %.o: %.c 46 | $(CC) $(CFLAGS) -c $< 47 | 48 | .%.d: ; 49 | 50 | -include .*.d 51 | -------------------------------------------------------------------------------- /c_src/Makefile.arduino: -------------------------------------------------------------------------------- 1 | BOARD_TAG=uno 2 | MONITOR_PORT=/dev/tty.usbmodem1431 3 | #CC_NAME=avr-g++ 4 | include /usr/share/Arduino-Makefile/Arduino.mk 5 | -------------------------------------------------------------------------------- /c_src/chine.c: -------------------------------------------------------------------------------- 1 | // Virtual machine for state machine processing 2 | 3 | #include 4 | #include 5 | 6 | #if !defined(ARDUINO) 7 | #include 8 | #endif 9 | 10 | #include "chine.h" 11 | 12 | // Initialize machine 13 | void chine_init(chine_t* mp, uint8_t* prog, 14 | int (*sys)(chine_t* mp, 15 | cell_t sysop, cell_t* revarg, 16 | cell_t* npop, cell_t* reason)) 17 | { 18 | mp->prog = prog; 19 | mp->sys = sys; 20 | mp->cIP = NULL; 21 | mp->cSP = mp->stack+MAX_STACK; // towards low address 22 | mp->cRP = mp->stack; // towards high address 23 | mp->cFP = mp->cSP; 24 | memset(mp->tbits, 0, sizeof(mp->tbits)); 25 | memset(mp->tmask, 0, sizeof(mp->tmask)); 26 | memset(mp->imask, 0, sizeof(mp->imask)); 27 | (*sys)(mp, SYS_INIT, NULL, NULL, NULL); 28 | } 29 | 30 | // Set execution pointer 31 | void chine_set_ip(chine_t* mp, int offset) 32 | { 33 | mp->cIP = mp->prog + offset; 34 | } 35 | 36 | // Chine is on toplevel 37 | int chine_is_top_level(chine_t* mp) 38 | { 39 | return (mp->cRP == mp->stack); 40 | } 41 | 42 | // calculcuate next timeout, 43 | // return 1 and the the update timeout value in tmop (if != NULL) 44 | // return 0 otherwise 45 | int chine_timeout(chine_t* mp, timeout_t* tmop) 46 | { 47 | int i = 0; 48 | int r = 0; 49 | timeout_t tmo; 50 | 51 | if (tmop) 52 | tmo = *tmop; // refine 53 | else 54 | tmo = 0xffffffff; 55 | 56 | while(i < NUM_TBYTES) { 57 | uint8_t tm; 58 | // only check timers that are selected and running 59 | if ((tm = (mp->tmask[i] & mp->tbits[i])) != 0) { 60 | int t = 0; 61 | while(tm && (t < 8)) { 62 | if (tm & (1 << t)) { 63 | int32_t remain = mp->timer[i*8+t] - chine_millis(); 64 | if (remain < 0) remain = 0; 65 | if ((timeout_t)remain < tmo) 66 | tmo = remain; 67 | r = 1; 68 | } 69 | tm &= ~(1 << t); 70 | t++; 71 | } 72 | } 73 | i++; 74 | } 75 | if (tmop) *tmop = tmo; 76 | return r; 77 | } 78 | 79 | // check if any input is selected and update imask (if != NULL) 80 | // return 1 any input is selected 81 | // return 0 otherwise 82 | int chine_input_mask(chine_t* mp, uint8_t* imask) 83 | { 84 | int r = 0; 85 | int i = 0; 86 | 87 | while(!r && (i < NUM_IBYTES)) { 88 | if (mp->imask[i]) r = 1; 89 | if (imask) imask[i] |= mp->imask[i]; 90 | i++; 91 | } 92 | return r; 93 | } 94 | 95 | // calculcuate next timeout or input(s) 96 | // return 1 if a chine is waiting on a timer or is waiting for input, 97 | // an updated timeout time is stored in tmop if not NULL. 98 | // return 0 otherwise 99 | int chine_next(chine_t* mp, timeout_t* tmop, uint8_t* imask) 100 | { 101 | int r; 102 | // NOTE! must calculate both! || is not correct. 103 | r = chine_input_mask(mp, imask); 104 | r |= chine_timeout(mp, tmop); 105 | return r; 106 | } 107 | 108 | 109 | // check vector of machines for input poll and timeout 110 | // return 1 if any of the machines in mpv is waiting for input/timer 111 | int chine_nextv(chine_t** mpv, size_t n, timeout_t* tmop, uint8_t* imask) 112 | { 113 | int i, r = 0; 114 | for (i = 0; i < n; i++) 115 | r |= chine_next(mpv[i], tmop, imask); 116 | return r; 117 | } 118 | 119 | #ifdef TRACE 120 | #include 121 | #include 122 | 123 | typedef struct { 124 | char* name; 125 | int before; 126 | int after; 127 | } instr_info_t; 128 | 129 | static const instr_info_t op_name[] = { 130 | [DUP] = { "dup", 1, 2 }, 131 | [ROT] = { "rot", 3, 3 }, 132 | [OVER] = { "over", 2, 3 }, 133 | [DROP] = { "drop", 1, 0 }, 134 | [SWAP] = { "swap", 2, 2 }, 135 | [SUB] = { "-", 2, 1 }, 136 | [ADD] = { "+", 2, 1 }, 137 | [MUL] = { "*", 2, 1 }, 138 | [NOP] = { "nop", 0, 0 }, 139 | [AND] = { "and", 2, 1 }, 140 | [OR] = { "or", 2, 1 }, 141 | [XOR] = { "xor", 2, 1 }, 142 | [ZEQ] = { "0=", 1, 1 }, 143 | [ZLT] = { "0<", 1, 1, }, 144 | [NOT] = { "not", 1, 1 }, 145 | [NEGATE] = { "negate", 1, 1 }, 146 | [DIV] = { "/", 2, 1 }, 147 | [SHFT] = { "shift", 2, 1 }, 148 | [STORE] = { "!", 2, 0 }, 149 | [FETCH] = { "@", 1, 1 }, 150 | [TOR] = { ">r", 1, 0 }, 151 | [FROMR] = { "r>", 0, 1 }, 152 | [RFETCH] = { "r@", 0, 1 }, 153 | [EXIT] = { "exit", 0, 0 }, 154 | [SYS] = { "sys", 0, 0 }, 155 | [YIELD] = { "yield", 0, 0 }, 156 | [ELEM] = { "[]", 2, 1 }, 157 | [EXEC] = { "execute", 1, 0 }, 158 | [FPFETCH] = { "fp@", 0, 1 }, 159 | [FPSTORE] = { "fp!", 1, 0 }, 160 | [SPFETCH] = { "sp@", 0, 1 }, 161 | [SPSTORE] = { "sp!", 1, 0 }, 162 | 163 | [JMPZ+(OP0MASK+1)] = { "jmpz", 1, 0 }, 164 | [JMPNZ+(OP0MASK+1)] = { "jmpnz", 1, 0 }, 165 | [JNEXT+(OP0MASK+1)] = { "next", 0, 0}, 166 | [JMPLZ+(OP0MASK+1)] = { "jmplz", 1, 0 }, 167 | [JMP+(OP0MASK+1)] = { "jmp", 0, 0 }, 168 | [CALL+(OP0MASK+1)] = { "call", 0, 0 }, 169 | [LITERAL+(OP0MASK+1)] = { "literal", 0, 1 }, 170 | [ARRAY+(OP0MASK+1)] = { "array", 0, 1 }, 171 | [ARG+(OP0MASK+1)] = { "arg", 0, 1 }, 172 | }; 173 | 174 | void static trace_begin(int j, cell_t* sp) 175 | { 176 | int i; 177 | int size = op_name[j].before; 178 | 179 | printf("%s ", op_name[j].name); 180 | 181 | printf("%d (", size); 182 | for (i = size-1; i >= 0; i--) 183 | printf(" %d", sp[i]); 184 | printf(" -- "); 185 | if (j == YIELD) 186 | printf(")\n"); 187 | } 188 | 189 | void static trace_end(int j, cell_t* sp, cell_t* sp0) 190 | { 191 | int i; 192 | int size = op_name[j].after; 193 | int size0 = op_name[j].before; 194 | 195 | for (i = size-1; i >= 0; i--) 196 | printf("%d ", sp[i]); 197 | printf(")\n"); 198 | if (j != SYS) { 199 | if ((sp0 - sp) != (size - size0)) { 200 | printf("operation moved stack pointer\n"); 201 | exit(1); 202 | } 203 | } 204 | } 205 | 206 | // print instruction in binary format 207 | static const char* trace_ins(uint8_t ins) 208 | { 209 | static char insbuf[32]; 210 | 211 | switch (ins >> 6) { 212 | case 0: sprintf(insbuf,"|0|-|%d|",(ins & OP0MASK)); break; 213 | case 1: sprintf(insbuf,"|1|%d|%d|",OP1VAL(ins),(ins&OP1MASK)); break; 214 | case 2: sprintf(insbuf,"|2|%d|%d|",OP2VAL(ins),(ins&OP2MASK)); break; 215 | case 3: sprintf(insbuf,"|3|%d|%d|",OP3MASK&(ins>>3),OP3MASK&ins); break; 216 | default: return "?"; 217 | } 218 | return insbuf; 219 | } 220 | 221 | #define TRACEF(...) printf(__VA_ARGS__) 222 | 223 | #define BEGIN { cell_t* _s_SP=cSP; trace_begin(J,cSP); { 224 | #define XEND } trace_end(J,cSP,_s_SP); } 225 | #define TEND trace_end(J,cSP,_s_SP); 226 | #define END } trace_end(J,cSP,_s_SP); NEXT; } 227 | #define END0 } trace_end(J,cSP,_s_SP); NEXT0; } 228 | 229 | #else 230 | 231 | #define TRACEF(...) 232 | 233 | #define BEGIN 234 | #define XEND 235 | #define TEND 236 | #define END NEXT 237 | #define END0 NEXT0 238 | 239 | #endif 240 | 241 | #define SWAP_IN(mp) \ 242 | cIP = (mp)->cIP; \ 243 | cSP = (mp)->cSP; \ 244 | cRP = (mp)->cRP; \ 245 | cFP = (mp)->cFP 246 | 247 | #define SWAP_OUT(mp) \ 248 | (mp)->cIP = cIP; \ 249 | (mp)->cSP = cSP; \ 250 | (mp)->cRP = cRP; \ 251 | (mp)->cFP = cFP 252 | 253 | 254 | #define CASE(mnem) case mnem 255 | #define JCASE(mnem) case mnem+(OP0MASK+1) 256 | #define NEXT goto next 257 | #define NEXT0 if ((I >> OPSHFT)==OP3) { J=(I>>OP3SHFT)&OP3MASK; I=0; goto next1; } goto next 258 | 259 | 260 | int chine_run(chine_t* mp) 261 | { 262 | uint8_t* cIP; // instruction pointer 263 | cell_t* cSP; // stack pointer 264 | cell_t* cRP; // return stack 265 | cell_t* cFP; // frame pointer 266 | uint8_t I; // instruction 267 | cell_t A; // argument 268 | int J = 0; // opcode 269 | 270 | #define fail(e) do { mp->cErr=(e); goto L_fail; } while(0) 271 | // check that at least N elements exist on stack 272 | 273 | #define check_stack_size(N) do { \ 274 | if (cSP + ((N) - MAX_STACK) > mp->stack) \ 275 | goto L_FAIL_STACK_UNDERFLOW; \ 276 | } while(0) 277 | 278 | #define check_return_size(N) do { \ 279 | if (cRP-(N) < mp->stack) \ 280 | goto L_FAIL_STACK_UNDERFLOW; \ 281 | } while(0) 282 | 283 | #define stack_need(N) do { \ 284 | if (cRP+(N) >= cSP) \ 285 | goto L_FAIL_STACK_OVERFLOW; \ 286 | } while(0) 287 | 288 | SWAP_IN(mp); 289 | 290 | next: 291 | TRACEF("%04u: %s ", (int)(cIP - mp->prog), trace_ins(*cIP)); 292 | I = *cIP++; // load instruction I 293 | switch(I>>OPSHFT) { // extract opcode J 294 | case 0: J = (I & OP0MASK); break; 295 | case 1: J = (I & OP1MASK)+(OP0MASK+1); break; 296 | case 2: J = (I & OP2MASK)+(OP0MASK+1); break; 297 | case 3: J = (I & OP3MASK); break; 298 | } 299 | 300 | next1: 301 | switch(J) { 302 | default: goto L_FAIL_INVALID_OPCODE; 303 | JCASE(JMPZ): { 304 | BEGIN; 305 | check_stack_size(1); 306 | if (*cSP++ == 0) 307 | cIP = cIP + load_arg(I,cIP); 308 | cIP = cIP + get_arg_len(I); 309 | END; 310 | } 311 | 312 | JCASE(JMPNZ): { 313 | BEGIN; 314 | check_stack_size(1); 315 | if (*cSP++ != 0) 316 | cIP = cIP + load_arg(I,cIP); 317 | cIP = cIP + get_arg_len(I); 318 | END; 319 | } 320 | 321 | JCASE(JNEXT): { 322 | BEGIN; 323 | check_return_size(1); 324 | if (--(cRP[-1])>0) 325 | cIP = cIP + load_arg(I,cIP); 326 | else 327 | cRP--; 328 | cIP = cIP + get_arg_len(I); 329 | END; 330 | } 331 | 332 | JCASE(JMPLZ): { 333 | BEGIN; 334 | check_stack_size(1); 335 | if (*cSP++ < 0) 336 | cIP = cIP + load_arg(I,cIP); 337 | cIP = cIP + get_arg_len(I); 338 | END; 339 | } 340 | 341 | JCASE(JMP): { 342 | BEGIN; 343 | cIP = cIP + load_arg(I,cIP); 344 | cIP = cIP + get_arg_len(I); 345 | END; 346 | } 347 | 348 | JCASE(CALL): { 349 | BEGIN; 350 | stack_need(1); 351 | A = load_arg(I,cIP); 352 | cIP = cIP + get_arg_len(I); 353 | *cRP++ = (cIP - mp->prog); 354 | cIP += A; 355 | END; 356 | } 357 | 358 | JCASE(LITERAL): { 359 | BEGIN; 360 | stack_need(1); 361 | *--cSP = load_arg(I,cIP); 362 | cIP = cIP + get_arg_len(I); 363 | END; 364 | } 365 | 366 | JCASE(ARRAY): { 367 | // push array pointer on stack and skip 368 | BEGIN; 369 | stack_need(1); 370 | *--cSP = ((cIP-1) - mp->prog); 371 | cIP = cIP + get_array_len(I,cIP,&A); 372 | cIP += (get_element_len(I)*A); 373 | END; 374 | } 375 | 376 | JCASE(ARG): { 377 | BEGIN; 378 | stack_need(1); 379 | A = load_arg(I,cIP); 380 | cIP = cIP + get_arg_len(I); 381 | cSP--; 382 | cSP[0] = cFP[A]; 383 | END; 384 | } 385 | 386 | CASE(DUP): { 387 | BEGIN; 388 | check_stack_size(1); 389 | stack_need(1); 390 | cSP--; 391 | cSP[0] = cSP[1]; 392 | END0; 393 | } 394 | 395 | CASE(ROT): { 396 | BEGIN; 397 | check_stack_size(3); 398 | cell_t r = cSP[2]; 399 | cSP[2] = cSP[1]; 400 | cSP[1] = cSP[0]; 401 | cSP[0] = r; 402 | END0; 403 | } 404 | 405 | CASE(SWAP): { 406 | BEGIN; 407 | check_stack_size(2); 408 | cell_t r = cSP[1]; 409 | cSP[1] = cSP[0]; 410 | cSP[0] = r; 411 | END0; 412 | } 413 | 414 | CASE(OVER): { 415 | BEGIN; 416 | check_stack_size(2); 417 | stack_need(1); 418 | cSP--; 419 | cSP[0] = cSP[2]; 420 | END0; 421 | } 422 | 423 | CASE(SUB): { 424 | BEGIN; 425 | check_stack_size(2); 426 | cSP[1] -= cSP[0]; 427 | cSP++; 428 | END0; 429 | } 430 | 431 | CASE(DROP): { 432 | BEGIN; 433 | check_stack_size(1); 434 | cSP++; 435 | END0; 436 | } 437 | 438 | CASE(ADD): { 439 | BEGIN; 440 | check_stack_size(2); 441 | cSP[1] += cSP[0]; 442 | cSP++; 443 | END0; 444 | } 445 | 446 | CASE(MUL): { 447 | BEGIN; 448 | check_stack_size(2); 449 | cSP[1] *= cSP[0]; 450 | cSP++; 451 | END0; 452 | } 453 | 454 | CASE(NEGATE): { 455 | BEGIN; 456 | check_stack_size(1); 457 | cSP[0] = -cSP[0]; 458 | END; 459 | } 460 | 461 | CASE(AND): { 462 | BEGIN; 463 | check_stack_size(2); 464 | cSP[1] &= cSP[0]; 465 | cSP++; 466 | END; 467 | } 468 | 469 | CASE(OR): { 470 | BEGIN; 471 | check_stack_size(2); 472 | cSP[1] |= cSP[0]; 473 | cSP++; 474 | END; 475 | } 476 | 477 | CASE(ZEQ): { 478 | BEGIN; 479 | check_stack_size(1); 480 | cSP[0] = CHINE_TEST(cSP[0] == 0); 481 | END; 482 | } 483 | 484 | CASE(ZLT): { 485 | BEGIN; 486 | check_stack_size(1); 487 | cSP[0] = CHINE_TEST(cSP[0] < 0); 488 | END; 489 | } 490 | 491 | CASE(NOT): { 492 | BEGIN; 493 | check_stack_size(1); 494 | cSP[0] = ~cSP[0]; 495 | END; 496 | } 497 | 498 | CASE(NOP): { 499 | BEGIN; 500 | END; 501 | } 502 | 503 | CASE(XOR): { 504 | BEGIN; 505 | check_stack_size(2); 506 | cSP[1] ^= cSP[0]; 507 | cSP++; 508 | END; 509 | } 510 | 511 | CASE(DIV): { 512 | BEGIN; 513 | check_stack_size(2); 514 | if (cSP[0] == 0) { cSP += 2; goto L_FAIL_DIV_ZERO; } 515 | cSP[1] /= cSP[0]; 516 | cSP++; 517 | END; 518 | } 519 | 520 | CASE(SHFT): { // shift left (or right) 521 | BEGIN; 522 | check_stack_size(2); 523 | if (cSP[0] >= 0) 524 | cSP[1] = ((ucell_t)cSP[1]) << cSP[0]; 525 | else 526 | cSP[1] = ((ucell_t)cSP[1]) >> -cSP[0]; 527 | cSP++; 528 | END; 529 | } 530 | 531 | CASE(STORE): { 532 | BEGIN; 533 | cell_t i; 534 | check_stack_size(2); 535 | i = cSP[0]; 536 | if ((i < 0) || (i >= MAX_MEM)) goto L_FAIL_INVALID_MEMORY_ADDRESS; 537 | mp->mem[i] = cSP[1]; 538 | cSP += 2; 539 | END; 540 | } 541 | 542 | CASE(FETCH): { 543 | BEGIN; 544 | cell_t i; 545 | check_stack_size(1); 546 | i = cSP[0]; 547 | if ((i < 0) || (i >= MAX_MEM)) goto L_FAIL_INVALID_MEMORY_ADDRESS; 548 | cSP[0] = mp->mem[i]; 549 | END; 550 | } 551 | 552 | CASE(TOR): { 553 | BEGIN; 554 | check_stack_size(1); 555 | A = *cSP++; 556 | *cRP++ = A; 557 | END; 558 | } 559 | 560 | CASE(FROMR): { 561 | BEGIN; 562 | check_return_size(1); 563 | A = *--cRP; 564 | *--cSP = A; 565 | END; 566 | } 567 | 568 | CASE(RFETCH): { 569 | BEGIN; 570 | check_return_size(1); 571 | stack_need(1); 572 | *--cSP = cRP[-1]; 573 | END; 574 | } 575 | 576 | CASE(EXIT): { 577 | BEGIN; 578 | if (cRP == mp->stack) { 579 | SWAP_OUT(mp); 580 | TEND; 581 | goto L_FAIL_TERMINATE; 582 | } 583 | cIP = mp->prog + *--cRP; 584 | END; 585 | } 586 | 587 | CASE(YIELD): { 588 | BEGIN; 589 | SWAP_OUT(mp); 590 | XEND; 591 | return 0; 592 | } 593 | 594 | CASE(SYS): { 595 | BEGIN; 596 | cell_t sysop = UINT8(cIP); 597 | cell_t ret; 598 | cell_t npop; 599 | cell_t value; 600 | 601 | cIP++; 602 | if ((ret = (*mp->sys)(mp, sysop, cSP, &npop, &value)) < 0) { 603 | TEND; 604 | fail(ret); 605 | } 606 | cSP += npop; // pop arguments 607 | if (ret > 0) { 608 | *--cSP = value; 609 | } 610 | END; 611 | } 612 | 613 | CASE(ELEM): { 614 | BEGIN; 615 | uint8_t* aptr; 616 | int i, j, n; 617 | // check that top of element is an array pointer, 618 | // and that index on second element is an index into 619 | // that array, push the element onto stack 620 | check_stack_size(2); 621 | i = cSP[0]; // get index 622 | aptr = mp->prog + cSP[1]; // get array address 623 | if ((*aptr & OP2MASK) != ARRAY) goto L_FAIL_INVALID_ARGUMENT; 624 | j = get_array_len(*aptr, aptr+1, &A); 625 | if ((i < 0) || (i > A)) goto L_FAIL_INVALID_ARGUMENT; 626 | n = get_element_len(*aptr); 627 | aptr += (j+1); 628 | switch(n) { 629 | case 1: cSP[1] = INT8(aptr + i*n); break; 630 | case 2: cSP[1] = INT16(aptr + i*n); break; 631 | case 4: cSP[1] = INT32(aptr + i*n); break; 632 | default: goto L_FAIL_INVALID_ARGUMENT; 633 | } 634 | cSP++; 635 | END; 636 | } 637 | 638 | CASE(EXEC): { 639 | BEGIN; 640 | // place a call to the location given by addr on top of stack 641 | // the address is a location relative to program start 642 | check_stack_size(1); 643 | A = (cIP - mp->prog); // save return address 644 | cIP = mp->prog + *cSP++; 645 | *cRP++ = A; 646 | END; 647 | } 648 | 649 | CASE(SPFETCH): { 650 | BEGIN; 651 | stack_need(1); 652 | cSP--; 653 | cSP[0] = (cSP+1 - mp->stack); 654 | END; 655 | } 656 | 657 | CASE(SPSTORE): { 658 | BEGIN; 659 | check_stack_size(1); 660 | cSP = (mp->stack + cSP[0]); 661 | END; 662 | } 663 | 664 | CASE(FPFETCH): { // fp@ ( -- fp ) 665 | BEGIN; 666 | stack_need(1); 667 | *--cSP = (cFP - mp->stack); 668 | END; 669 | } 670 | 671 | CASE(FPSTORE): { // fp! ( fp -- ) 672 | BEGIN; 673 | check_stack_size(1); 674 | cFP = *cSP++ + mp->stack; 675 | END; 676 | } 677 | 678 | } 679 | 680 | L_FAIL_STACK_UNDERFLOW: 681 | fail(FAIL_STACK_UNDERFLOW); 682 | L_FAIL_STACK_OVERFLOW: 683 | fail(FAIL_STACK_OVERFLOW); 684 | L_FAIL_INVALID_OPCODE: 685 | fail(FAIL_INVALID_OPCODE); 686 | L_FAIL_DIV_ZERO: 687 | fail(FAIL_DIV_ZERO); 688 | L_FAIL_INVALID_MEMORY_ADDRESS: 689 | fail(FAIL_INVALID_MEMORY_ADDRESS); 690 | L_FAIL_INVALID_ARGUMENT: 691 | fail(FAIL_INVALID_ARGUMENT); 692 | L_FAIL_TERMINATE: 693 | fail(FAIL_TERMINATE); 694 | 695 | L_fail: 696 | SWAP_OUT(mp); 697 | return -1; 698 | } 699 | -------------------------------------------------------------------------------- /c_src/chine_bench.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "../include/chine.h" 6 | 7 | chine_t m; 8 | 9 | extern int32_t chine_unix_sys(chine_t* mp, 10 | int32_t sysop, int32_t* revarg, 11 | int32_t* npop, int32_t* value); 12 | // program that computes factorial(12) 1000 times 13 | // and the prints the time in ms 14 | 15 | // JUMP_TABLE 16 | // -O0 = 1414 ms 17 | // -O1 = 1003 ms 18 | // -O2 = 885 ms 19 | // -O3 = 886 ms 20 | // SWITCH 21 | // -O0 = 1611 22 | // -O1 = 833 23 | // -O2 = 545 24 | // -O3 = 530 25 | // 26 | 27 | 28 | // program size=74, sha=26205b5a507aba3aa6b4048cb4ffa6887cd0c67c 29 | uint8_t prog1[] = { 30 | 0x19,0x0f,0x56,0x00,0x0f,0x42,0x40,0x45,0x06,0x19,0x0f,0xec, 31 | 0x45,0x17,0x1a,0x46,0x0c,0x45,0x07,0x03,0x8e,0xc5,0x41,0xf7, 32 | 0x03,0x18,0x00,0x8e,0xc5,0x40,0x04,0xc8,0xe7,0x44,0xf8,0x03, 33 | 0x18,0x45,0x05,0x46,0x0a,0x19,0x0c,0x18,0x00,0x40,0x02,0x44, 34 | 0x06,0x46,0x30,0x19,0x0c,0x03,0x18,0x00,0x46,0x0a,0xd2,0x11, 35 | 0xef,0x46,0x30,0x06,0x19,0x0c,0x46,0x0a,0x11,0x00,0x41,0xef, 36 | 0x03,0x18 }; 37 | 38 | 39 | void init() 40 | { 41 | chine_init(&m, prog1, chine_unix_sys); 42 | } 43 | 44 | int main() 45 | { 46 | uint8_t imask[NUM_IBYTES]; // input mask 47 | timeout_t tmo; 48 | 49 | init(); 50 | again: 51 | chine_run(&m); 52 | tmo = 0xffffffff; 53 | memset(&imask, 0, sizeof(imask)); 54 | 55 | if (chine_next(&m, &tmo, imask)) { // wait for input or timer 56 | if (tmo < 0xffffffff) { 57 | usleep(tmo*1000); 58 | goto again; 59 | } 60 | } 61 | exit(0); 62 | } 63 | -------------------------------------------------------------------------------- /c_src/chine_exec.c: -------------------------------------------------------------------------------- 1 | // 2 | // chine executive 3 | // 4 | // usage: 5 | // chine_exec packed.script (or $0 from script) 6 | // chine_exec prog.x run chine code from file 7 | // chine_exec run chine code from stdin 8 | // 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "chine.h" 15 | 16 | //#define DEBUG(...) printf(__VA_ARGS__) 17 | #define DEBUG(...) 18 | 19 | #ifdef TRACE 20 | #define TRACEF(...) printf(__VA_ARGS__) 21 | #else 22 | #define TRACEF(...) 23 | #endif 24 | 25 | #define HERE "50F645CD7C7209972B48C3220959677A" 26 | 27 | chine_t m; 28 | 29 | extern int32_t chine_unix_sys(chine_t* mp, 30 | int32_t sysop, int32_t* revarg, 31 | int32_t* npop, int32_t* value); 32 | 33 | // FIXME dynamic!? optional? 34 | char data[65537]; 35 | 36 | // format signed integer into buf 37 | char* format_int(int val, char* buf, int size) 38 | { 39 | char* ptr = buf+size; 40 | int sign = 0; 41 | *--ptr = '\0'; 42 | if (val == 0) 43 | *--ptr = '0'; 44 | else if (val < 0) { 45 | val = -val; 46 | sign = 1; 47 | } 48 | while(val != 0) { 49 | *--ptr = ((val % 10) + '0'); 50 | val /= 10; 51 | } 52 | if (sign) 53 | *--ptr = '-'; 54 | return ptr; 55 | } 56 | 57 | int str_len(const char* str) 58 | { 59 | int len = 0; 60 | while(*str++) len++; 61 | return len; 62 | } 63 | 64 | void mem_zero(void* ptr, size_t n) 65 | { 66 | unsigned char* uptr = (unsigned char*) ptr; 67 | while(n--) *uptr++ = 0; 68 | } 69 | 70 | int str_cmp(const char *s1, const char *s2, register size_t n) 71 | { 72 | register unsigned char u1, u2; 73 | while (n-- > 0) { 74 | u1 = (unsigned char) *s1++; 75 | u2 = (unsigned char) *s2++; 76 | if (u1 != u2) 77 | return u1 - u2; 78 | if (u1 == '\0') 79 | return 0; 80 | } 81 | return 0; 82 | } 83 | 84 | void error(const char* str1, const char* str2) 85 | { 86 | const char* str0 = "chine_exec: "; 87 | write(2, str0, str_len(str0)); 88 | write(2, str1, str_len(str1)); 89 | write(2, str2, str_len(str2)); 90 | write(2, "\n", 1); 91 | exit(1); 92 | } 93 | 94 | int to_hex(char x) 95 | { 96 | int c = x-'0'; 97 | if (c < 0) return -1; 98 | if (c > 9) c -= 7; 99 | if (c > 15) return -1; 100 | return c; 101 | } 102 | 103 | // Standard CRC-32 104 | #define CRC32_POLY 0xEDB88320 105 | 106 | typedef struct { 107 | uint32_t crc; 108 | } crc_32_ctx_t; 109 | 110 | void crc32_init(crc_32_ctx_t* p) 111 | { 112 | p->crc = (uint32_t) -1; 113 | } 114 | 115 | uint32_t crc32_final(crc_32_ctx_t* p) 116 | { 117 | return ~p->crc; 118 | } 119 | 120 | void crc32_update(crc_32_ctx_t* p, uint8_t* data, size_t len) 121 | { 122 | uint32_t crc = p->crc; 123 | 124 | while (len--) { 125 | uint32_t byte = *data++; 126 | int j; 127 | crc = crc ^ byte; 128 | for (j = 7; j >= 0; j--) { // Do eight times. 129 | uint32_t mask = -(crc & 1); 130 | crc = (crc >> 1) ^ (CRC32_POLY & mask); 131 | } 132 | } 133 | p->crc = crc; 134 | } 135 | 136 | uint32_t crc32(uint8_t* data, size_t len) 137 | { 138 | crc_32_ctx_t param; 139 | 140 | crc32_init(¶m); 141 | crc32_update(¶m, data, len); 142 | return crc32_final(¶m); 143 | } 144 | 145 | // return pointer to symbol table 146 | uint8_t* file_header(uint8_t* ptr, uint8_t** symb_end) 147 | { 148 | uint32_t length; 149 | uint32_t symblen; 150 | uint32_t crc, crc2; 151 | uint32_t zero = 0; 152 | crc_32_ctx_t ctx; 153 | uint8_t* ptr0 = ptr; 154 | 155 | if (str_cmp((const char*)ptr, "CHIN", 4) != 0) 156 | return NULL; 157 | ptr += 4; 158 | if ((ptr[0] != FILE_VERSION_MAJOR) || (ptr[1] != FILE_VERSION_MINOR) ) 159 | return NULL; 160 | ptr += 4; 161 | crc = UINT32(ptr); 162 | ptr += 4; 163 | length = UINT32(ptr); 164 | ptr += 4; 165 | 166 | // printf("crc=%u, length=%d\n", crc, length); 167 | 168 | crc32_init(&ctx); 169 | crc32_update(&ctx, (uint8_t*)ptr0, 8); // magic + version 170 | crc32_update(&ctx, (uint8_t*)&zero, sizeof(zero)); // crc=0 171 | crc32_update(&ctx, ptr-4, length + 4); 172 | crc2 = crc32_final(&ctx); 173 | if (crc2 != crc) { 174 | char buf[10]; 175 | error("bad_crc, computed = %u\n", format_int(crc2, buf, sizeof(buf))); 176 | return NULL; 177 | } 178 | 179 | if (str_cmp((const char*) ptr, "SYMB", 4) != 0) 180 | return NULL; 181 | ptr += 4; 182 | symblen = UINT32(ptr); 183 | ptr += 4; 184 | *symb_end = (ptr + symblen); 185 | return ptr; 186 | } 187 | 188 | // return pointer code section 189 | uint8_t* code_section(uint8_t* symb_end, uint8_t** code_end) 190 | { 191 | uint8_t* ptr = symb_end; 192 | uint32_t code_len; 193 | 194 | if (str_cmp((const char *)ptr, "CODE", 4) != 0) 195 | return NULL; 196 | ptr += 4; 197 | code_len = UINT32(ptr); 198 | ptr += 4; 199 | *code_end = ptr + code_len; 200 | return ptr; 201 | } 202 | 203 | int lookup(uint8_t* symb_start, uint8_t* symb_end, char* symbol) 204 | { 205 | uint8_t* ptr = symb_start; 206 | int symlen = str_len(symbol); 207 | 208 | DEBUG("lookup: [%d] %s\n", symlen, symbol); 209 | 210 | while(ptr < symb_end) { 211 | uint8_t sn = ptr[0]; 212 | uint8_t vn; 213 | uint8_t* sptr = ptr+1; 214 | uint8_t* vptr; 215 | ptr = sptr + sn; 216 | vn = ptr[0]; 217 | vptr = ptr+1; 218 | DEBUG("search: vn=%d [%d] %.*s\n", vn, sn, sn, sptr); 219 | if ((symlen == sn) && (str_cmp((const char*)symbol, 220 | (const char*) sptr, sn) == 0)) { 221 | int offset; 222 | switch(vn) { 223 | case 1: offset = INT8(vptr); break; 224 | case 2: offset = INT16(vptr); break; 225 | case 4: offset = INT32(vptr); break; 226 | default: return -1; 227 | } 228 | TRACEF("symbol %.*s offset %d\n", sn, sptr, offset); 229 | DEBUG("found offst = %d\n", offset); 230 | return offset; 231 | } 232 | ptr = vptr+vn; 233 | } 234 | return -1; 235 | } 236 | 237 | // 238 | // execute pack files 239 | // size of the binary program is located as the last line in ascii 240 | // the size in hex is twice that size not counting new lines 241 | // FIXME: 242 | // restore the patched script? 243 | // 244 | 245 | // scan 8-digit hex number 246 | // last line in file looks like 247 | // ": xxxxxxxx\n" 248 | // this is an offset to start of hex encoded program area 249 | // from end of file (including the hex offset and final newline) 250 | 251 | off_t scan_program_offset(int fd) 252 | { 253 | char buf[11]; 254 | off_t offset = 0; 255 | int i; 256 | 257 | if (lseek(fd, -11, SEEK_END) < 0) 258 | return -1; 259 | if (read(fd, buf, 11) != 11) 260 | return -1; 261 | if ((buf[0] != ':') || (buf[1] != ' ')) 262 | return -1; 263 | for (i = 0; i < 8; i++) { 264 | int c; 265 | if ((c = to_hex(buf[i+2])) < 0) return -1; 266 | offset = (offset << 4) + c; 267 | } 268 | return offset; 269 | } 270 | 271 | int load_program(int fd, char* data, size_t max_data) 272 | { 273 | char* ptr = data; 274 | char* data_end = data + max_data; 275 | char buf[78]; 276 | int len; 277 | int i; 278 | next: 279 | if (data >= data_end) return -1; 280 | if ((len = read(fd, buf, 77)) < 0) return -1; 281 | if ((str_cmp(buf, HERE, 32)) == 0) return ptr - data; 282 | buf[len] = 0; 283 | DEBUG("loaded line %s\n", buf); 284 | i = 0; 285 | while(i < len) { 286 | int c1, c0; 287 | if ((c1 = to_hex(buf[i])) < 0) { 288 | if (buf[i] == '\n') goto next; 289 | } 290 | if ((c0 = to_hex(buf[i+1])) < 0) return -1; 291 | *ptr++ = (c1 << 4)+c0; 292 | i += 2; 293 | } 294 | return -1; 295 | } 296 | 297 | int main(int argc, char** argv) 298 | { 299 | uint8_t imask[NUM_IBYTES]; // input mask 300 | timeout_t tmo; 301 | int fd = 0; 302 | const char* input_file = NULL; 303 | uint8_t* symb_start; 304 | uint8_t* symb_end; 305 | uint8_t* code_start; 306 | uint8_t* code_end; 307 | off_t offset; 308 | 309 | if (argc == 1) { 310 | if (isatty(0)) // otherwise (for now) it a piped chine program 311 | input_file = argv[0]; 312 | } 313 | else if (argc > 1) { 314 | if (str_cmp((const char*)argv[1], "--", 3) == 0) 315 | input_file = NULL; 316 | else 317 | input_file = argv[1]; 318 | } 319 | 320 | if (input_file != NULL) { 321 | if ((fd = open(input_file, O_RDONLY)) < 0) 322 | error("unable to open file ", input_file); 323 | if (read(fd, data, 4) != 4) 324 | error("unable to read file ", input_file); 325 | if (str_cmp((const char*)data, "CHIN", 4) != 0) { 326 | if (lseek(fd, 0, SEEK_SET) < 0) 327 | error("unable to open seek file ", input_file); 328 | if ((offset = scan_program_offset(fd)) < 0) 329 | error("unable to read offset ", input_file); 330 | 331 | DEBUG("offset = %ld\n", offset); 332 | 333 | if (lseek(fd, -offset, SEEK_END) < 0) 334 | error("unable to open seek file ", input_file); 335 | if (load_program(fd, data, sizeof(data)) < 0) 336 | error("unable to open load program ", input_file); 337 | close(fd); 338 | } 339 | else { 340 | if (read(fd, data+4, sizeof(data)-4) < 0) 341 | error("unable to open load program ", input_file); 342 | close(fd); 343 | } 344 | } 345 | else { 346 | if (read(0, data, sizeof(data)) < 0) 347 | error("unable to open load program ", "*stdin*"); 348 | } 349 | 350 | if ((symb_start = file_header((uint8_t*)data, &symb_end)) == NULL) 351 | error("file format error", ""); 352 | if ((code_start = code_section(symb_end, &code_end)) == NULL) 353 | error("code section not found", ""); 354 | 355 | chine_init(&m, (uint8_t*)code_start, chine_unix_sys); 356 | 357 | if ((offset = lookup(symb_start, symb_end, "init")) >= 0) { 358 | chine_set_ip(&m, offset); 359 | if (chine_run(&m) < 0) goto fail; 360 | } 361 | 362 | if ((offset = lookup(symb_start, symb_end, "run")) < 0) 363 | error("node code found in ", argv[1]); 364 | 365 | chine_set_ip(&m, offset); 366 | 367 | again: 368 | if (chine_is_top_level(&m)) 369 | chine_set_ip(&m, offset); 370 | 371 | if (chine_run(&m) < 0) goto final; 372 | 373 | tmo = 0xffffffff; 374 | mem_zero(&imask, sizeof(imask)); 375 | 376 | if (chine_next(&m, &tmo, imask)) { // wait for input or timer 377 | if (tmo < 0xffffffff) { 378 | usleep(tmo*1000); 379 | goto again; 380 | } 381 | } 382 | goto again; 383 | 384 | final: 385 | if ((offset = lookup(symb_start, symb_end, "final")) >= 0) { 386 | int prev_fail = m.cErr; 387 | chine_set_ip(&m, offset); 388 | if (chine_run(&m) < 0) { 389 | m.cErr = prev_fail; 390 | goto fail; 391 | } 392 | } 393 | fail: 394 | if (m.cErr != FAIL_TERMINATE) { 395 | char* errstr = "unknown"; 396 | switch(m.cErr) { 397 | case FAIL_INVALID_ARGUMENT: 398 | errstr = "invalid argument"; break; 399 | case FAIL_INVALID_OPCODE: 400 | errstr = "invalid opcode"; break; 401 | case FAIL_STACK_OVERFLOW: 402 | errstr = "stack overflow"; break; 403 | case FAIL_STACK_UNDERFLOW: 404 | errstr = "stack underflow"; break; 405 | case FAIL_INVALID_MEMORY_ADDRESS: 406 | errstr = "invalid address"; break; 407 | case FAIL_DIV_ZERO: 408 | errstr = "division by zero"; break; 409 | case FAIL_TIMER_OVERFLOW: 410 | errstr = "timer overflow"; break; 411 | default: { 412 | char buf[8]; 413 | char* ptr = format_int((int)m.cErr, buf, sizeof(buf)); 414 | error("execution error: code=", ptr); 415 | } 416 | } 417 | error("execution error: ", errstr); 418 | } 419 | exit(0); 420 | } 421 | -------------------------------------------------------------------------------- /c_src/chine_sys_unix.c: -------------------------------------------------------------------------------- 1 | // 2 | // Test implmentation of sys callback for unix 3 | // 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | #include "chine.h" 16 | 17 | #ifdef TRACE 18 | #define TRACEF(...) printf(__VA_ARGS__) 19 | #else 20 | #define TRACEF(...) 21 | #endif 22 | 23 | #if defined(WIRINGPI) 24 | #include 25 | #include 26 | #endif 27 | 28 | #define INDEX_TYPE 0x2701 // UNSIGNED8 - type code 29 | #define INDEX_DELAY 0x2710 // UNSIGNED32 - time 30 | #define INDEX_WAIT 0x2712 // UNSIGNED32 - time 31 | #define INDEX_RAMPUP 0x2715 // UNSIGNED32 - time 32 | #define INDEX_RAMPDOWN 0x2716 // UNSIGNED32 - time 33 | 34 | uint8_t param_type[MAX_TIMERS]; 35 | uint32_t param_delay[MAX_TIMERS] = 36 | { 500, 1000, 2000, 3000, 4000, 5000, 6000, 7000 }; 37 | uint32_t param_wait[MAX_TIMERS]; 38 | uint32_t param_rampup[MAX_TIMERS]; 39 | uint32_t param_rampdown[MAX_TIMERS]; 40 | 41 | struct _input_t { 42 | uint8_t digital; 43 | uint16_t analog; 44 | int16_t encoder; 45 | } input[32]; 46 | 47 | struct _output_t { 48 | uint8_t digital; 49 | uint16_t analog; 50 | int16_t encoder; 51 | } output[32]; 52 | 53 | struct timeval boot_time; 54 | 55 | #define PTR(x) ((void*)((intptr_t)(x))) 56 | 57 | // time since program started in ms 58 | uint32_t chine_micros(void) 59 | { 60 | struct timeval now; 61 | struct timeval t; 62 | gettimeofday(&now, 0); 63 | timersub(&now, &boot_time, &t); 64 | return t.tv_sec*1000000 + t.tv_usec; 65 | } 66 | 67 | uint32_t chine_millis(void) 68 | { 69 | struct timeval now; 70 | struct timeval t; 71 | gettimeofday(&now, 0); 72 | timersub(&now, &boot_time, &t); 73 | return t.tv_sec*1000 + t.tv_usec/1000; 74 | } 75 | 76 | static int fetch(uint16_t index, uint8_t si, int32_t* value) 77 | { 78 | if (si >= MAX_TIMERS) return FAIL_INVALID_ARGUMENT; 79 | switch(index) { 80 | case INDEX_TYPE: *value = param_type[si]; break; 81 | case INDEX_DELAY: *value = param_delay[si]; break; 82 | case INDEX_WAIT: *value = param_wait[si]; break; 83 | case INDEX_RAMPUP: *value = param_rampup[si]; break; 84 | case INDEX_RAMPDOWN: *value = param_rampdown[si]; break; 85 | default: return FAIL_INVALID_ARGUMENT; 86 | } 87 | return 0; 88 | } 89 | 90 | static int store(uint16_t index, uint8_t si,int32_t value) 91 | { 92 | if (si >= MAX_TIMERS) return FAIL_INVALID_ARGUMENT; 93 | switch(index) { 94 | case INDEX_TYPE: param_type[si]=value; break; 95 | case INDEX_DELAY: param_delay[si]=value; break; 96 | case INDEX_WAIT: param_wait[si]=value; break; 97 | case INDEX_RAMPUP: param_rampup[si]=value; break; 98 | case INDEX_RAMPDOWN: param_rampdown[si]=value; break; 99 | default: return FAIL_INVALID_ARGUMENT; 100 | } 101 | return 0; 102 | } 103 | 104 | 105 | void* get_const_array(chine_t* mp, cell_t offs) 106 | { 107 | uint8_t* aptr = mp->prog + offs; // get array address 108 | if ((*aptr & 7) != ARRAY) return NULL; 109 | return (void*)(aptr+get_array_hlen(*aptr)+1); 110 | } 111 | 112 | // 113 | // return: < 0 FAIL_xyz 114 | // == 0 return no value 115 | // > 0 return value in *value 116 | // number of arguments to pop is return in npop 117 | // 118 | int chine_unix_sys(chine_t* mp, 119 | cell_t sysop, cell_t* revarg, 120 | cell_t* npop, cell_t* value) 121 | { 122 | switch(sysop) { 123 | case SYS_INIT: { 124 | TRACEF("init\n"); 125 | gettimeofday(&boot_time, 0); 126 | #if defined(WIRINGPI) 127 | // maybe the simple solution (bit slow) 128 | // it uses native pin numbers! 129 | wiringPiSetupSys(); 130 | #endif 131 | return 0; 132 | } 133 | 134 | case SYS_TERMINATE: { 135 | *npop = 0; 136 | return FAIL_TERMINATE; 137 | } 138 | 139 | case SYS_NOW: { 140 | TRACEF("now"); 141 | *npop = 0; 142 | *value = chine_millis(); 143 | return 1; 144 | } 145 | 146 | case SYS_EMIT: { 147 | uint8_t c = revarg[0]; 148 | TRACEF("emit(%d)", c); 149 | *npop = 1; 150 | if (write(1, &c, 1) < 0) 151 | return FAIL_INVALID_ARGUMENT; 152 | return 0; 153 | } 154 | 155 | case SYS_AVAIL: { 156 | struct timeval poll = { 0, 0 }; 157 | fd_set iset; 158 | FD_ZERO(&iset); 159 | FD_SET(0, &iset); 160 | *npop = 0; 161 | TRACEF("avail()"); 162 | if (select(1, &iset, NULL, NULL, &poll) == 1) 163 | *value = CHINE_TRUE; 164 | else 165 | *value = CHINE_FALSE; 166 | return 1; 167 | } 168 | 169 | case SYS_RECV: { 170 | uint8_t c; 171 | TRACEF("recv()"); 172 | if (read(0, &c, 1) == 1) 173 | *value = c; 174 | else 175 | *value = -1; 176 | return 1; 177 | } 178 | 179 | case SYS_PARAM_FETCH: { 180 | TRACEF("param@(param=%04x,index=%d)", revarg[1], revarg[0]); 181 | *npop = 2; 182 | return fetch(revarg[1], revarg[0], value); 183 | } 184 | 185 | case SYS_PARAM_STORE: { 186 | TRACEF("param!(param=%04x,index=%d,value=%d)", 187 | revarg[2], revarg[1], revarg[0]); 188 | *npop = 3; 189 | return store(revarg[2], revarg[1], revarg[0]); 190 | } 191 | 192 | case SYS_TIMER_INIT: { // ( i -- ) 193 | cell_t i = revarg[0]; 194 | TRACEF("timer-init(%d)", i); 195 | *npop = 1; 196 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 197 | CLRBIT(mp->tbits, i); 198 | mp->timer[i] = 0; 199 | return 0; 200 | } 201 | 202 | case SYS_TIMER_STOP: { // ( i -- ) 203 | cell_t i = revarg[0]; 204 | TRACEF("timer-stop(%d)", i); 205 | *npop = 1; 206 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 207 | CLRBIT(mp->tbits, i); 208 | return 0; 209 | } 210 | 211 | case SYS_TIMER_START: { // ( i -- ) 212 | cell_t i = revarg[0]; 213 | TRACEF("timer-start(%d)", i); 214 | *npop = 1; 215 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 216 | SETBIT(mp->tbits, i); 217 | mp->timer[i] = chine_millis()+param_delay[i]; 218 | return 0; 219 | } 220 | 221 | case SYS_TIMER_TIMEOUT: { // ( i -- f ) 222 | cell_t i = revarg[0]; 223 | TRACEF("timer-timeout(%d)", i); 224 | *npop = 1; 225 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 226 | if (!TSTBIT(mp->tbits,i)) 227 | *value = CHINE_FALSE; 228 | else 229 | *value = CHINE_TEST(chine_millis() >= mp->timer[i]); 230 | return 1; 231 | } 232 | 233 | case SYS_TIMER_RUNNING: { // ( i -- f ) 234 | cell_t i = revarg[0]; 235 | TRACEF("timer-running(%d)", i); 236 | *npop = 1; 237 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 238 | *value = CHINE_TEST(TSTBIT(mp->tbits, i) != 0); 239 | return 1; 240 | } 241 | 242 | case SYS_INPUT_FETCH: { // ( i k -- v ) 243 | cell_t k = revarg[0]; 244 | cell_t i = revarg[1]; 245 | TRACEF("input@(%d.%d)", k, i); 246 | *npop = 2; 247 | if ((i < 0) || (i >= 32)) return FAIL_INVALID_ARGUMENT; 248 | switch(k) { 249 | case INPUT_BOOLEAN: *value = input[i].digital; break; 250 | case INPUT_ANALOG: *value = input[i].analog; break; 251 | case INPUT_ENCODER: *value = input[i].encoder; break; 252 | default: return FAIL_INVALID_ARGUMENT; 253 | } 254 | return 1; 255 | } 256 | 257 | case SYS_OUTPUT_STORE: { // ( i k n -- ) 258 | cell_t n = revarg[0]; 259 | cell_t k = revarg[1]; 260 | cell_t i = revarg[2]; 261 | TRACEF("output!([%d].%d,%d)", k, i, n); 262 | *npop = 3; 263 | if ((i < 0) || (i >= 32)) return FAIL_INVALID_ARGUMENT; 264 | switch(k) { 265 | case INPUT_BOOLEAN: output[i].digital = n; break; 266 | case INPUT_ANALOG: output[i].analog = n; break; 267 | case INPUT_ENCODER: output[i].encoder = n; break; 268 | default: return FAIL_INVALID_ARGUMENT; 269 | } 270 | return 1; 271 | } 272 | 273 | case SYS_DESELECT_ALL: { // ( -- ) 274 | TRACEF("deselect-all"); 275 | memset(mp->imask, 0, sizeof(mp->imask)); 276 | memset(mp->tmask, 0, sizeof(mp->tmask)); 277 | return 0; 278 | } 279 | 280 | case SYS_SELECT_INPUT: { // ( i -- ) 281 | cell_t i = revarg[0]; 282 | TRACEF("select-input(%d)", i); 283 | *npop = 1; 284 | if ((i < 0) || (i >= MAX_INPUT)) return FAIL_INVALID_ARGUMENT; 285 | SETBIT(mp->imask, i); 286 | return 0; 287 | } 288 | 289 | case SYS_DESELECT_INPUT: { // ( i -- ) 290 | cell_t i = revarg[0]; 291 | TRACEF("deselect-input(%d)", i); 292 | *npop = 1; 293 | if ((i < 0) || (i >= MAX_INPUT)) return FAIL_INVALID_ARGUMENT; 294 | CLRBIT(mp->imask, i); 295 | return 0; 296 | } 297 | 298 | case SYS_SELECT_TIMER: { // ( i -- ) 299 | cell_t i = revarg[0]; 300 | TRACEF("select-timer(%d)", i); 301 | *npop = 1; 302 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 303 | SETBIT(mp->tmask, i); 304 | return 0; 305 | } 306 | 307 | case SYS_DESELECT_TIMER: { // ( i -- ) 308 | cell_t i = revarg[0]; 309 | TRACEF("deselect-timer(%d)", i); 310 | *npop = 1; 311 | if ((i < 0) || (i>=MAX_TIMERS)) return FAIL_TIMER_OVERFLOW; 312 | CLRBIT(mp->tmask, i); 313 | return 0; 314 | } 315 | 316 | case SYS_GPIO_INPUT: { 317 | TRACEF("gpio_input(%d)", revarg[0]); 318 | *npop = 1; 319 | #if defined(WIRINGPI) 320 | pinMode(revarg[0], INPUT); 321 | #endif 322 | return 0; 323 | } 324 | case SYS_GPIO_OUTPUT: { 325 | TRACEF("gpio_output(%d)",revarg[0]); 326 | *npop = 1; 327 | #if defined(WIRINGPI) 328 | pinMode(revarg[0], OUTPUT); 329 | #endif 330 | return 0; 331 | } 332 | case SYS_GPIO_SET: { 333 | TRACEF("gpio_set(%d)",revarg[0]); 334 | *npop = 1; 335 | #if defined(WIRINGPI) 336 | digitalWrite(revarg[0], HIGH); 337 | #endif 338 | return 0; 339 | } 340 | case SYS_GPIO_CLR: { 341 | TRACEF("gpio_clr(%d)",revarg[0]); 342 | *npop = 1; 343 | #if defined(WIRINGPI) 344 | digitalWrite(revarg[0], LOW); 345 | #endif 346 | return 0; 347 | } 348 | case SYS_GPIO_GET: { 349 | TRACEF("gpio_get(%d)",revarg[0]); 350 | *npop = 1; 351 | #if defined(WIRINGPI) 352 | *value = digitalRead(revarg[0]); 353 | #else 354 | *value = 0; 355 | #endif 356 | return 1; 357 | } 358 | 359 | case SYS_ANALOG_SEND: { 360 | *npop = 2; 361 | TRACEF("analog_send(%d,%u)",revarg[1],revarg[0]); 362 | #if defined(WIRINGPI) 363 | analogWrite(revarg[1],revarg[0]>>8); 364 | #endif 365 | return 0; 366 | } 367 | 368 | case SYS_ANALOG_RECV: { 369 | *npop = 1; 370 | TRACEF("analog_recv(%d)",revarg[0]); 371 | #if defined(WIRINGPI) 372 | *value = analogRead(revarg[0])<<6; 373 | #else 374 | *value = 0; 375 | #endif 376 | return 1; 377 | } 378 | 379 | case SYS_UART_CONNECT: { 380 | char* tty = (char*)get_const_array(mp, revarg[0]); 381 | int baud = revarg[1]; 382 | int mode = revarg[2]; 383 | int fd; 384 | TRACEF("uart_connect(tty=%s,baud=%d,mode=%d)",tty,baud,mode); 385 | *npop = 2; 386 | #if defined(WIRINGPI) 387 | if ((fd = serialOpen(tty, baud)) < 0) { 388 | revarg[2] = errno; 389 | *value = CHINE_FALSE; 390 | } 391 | else { 392 | revarg[2] = fd; 393 | *value = CHINE_TRUE; 394 | } 395 | #else 396 | (void) mode; 397 | (void) baud; 398 | if ((fd = open(tty, O_RDWR)) < 0) { 399 | revarg[2] = errno; 400 | *value = CHINE_FALSE; 401 | } 402 | else { 403 | revarg[2] = fd; 404 | *value = CHINE_TRUE; 405 | } 406 | #endif 407 | return 1; 408 | } 409 | 410 | case SYS_UART_SEND: { 411 | int fd = revarg[1]; 412 | uint8_t val = revarg[0]; 413 | (void)fd; 414 | (void)val; 415 | TRACEF("uart_send(fd=%d,val=%c)", fd, (char)val); 416 | #if defined(WIRINGPI) 417 | serialPutchar(fd, val); 418 | *npop = 2; 419 | *value = CHINE_TRUE; 420 | #else 421 | switch(write(fd, &val, 1)) { 422 | case 1: 423 | *npop = 2; 424 | *value = CHINE_TRUE; 425 | default: 426 | *npop = 1; 427 | revarg[1] = errno; 428 | *value = CHINE_FALSE; 429 | } 430 | #endif 431 | return 1; 432 | } 433 | 434 | case SYS_UART_RECV: { // ( fd -- char t | err f ) 435 | int fd = revarg[0]; 436 | uint8_t c; 437 | TRACEF("uart_recv(fd=%d)", fd); 438 | *npop = 0; 439 | #if defined(WIRINGPI) 440 | revarg[0] = serialGetchar(fd); 441 | *value = CHINE_TRUE; 442 | #else 443 | switch(read(fd, &c, 1)) { 444 | case 1: 445 | revarg[0] = c; 446 | *value = CHINE_TRUE; 447 | break; 448 | default: 449 | revarg[0] = errno; 450 | *value = CHINE_FALSE; 451 | } 452 | return 1; 453 | } 454 | #endif 455 | 456 | case SYS_UART_AVAIL: { // ( fd -- flag ) 457 | int fd = revarg[0]; 458 | TRACEF("uart_avail(fd=%d)", fd); 459 | *npop = 1; 460 | #if defined(WIRINGPI) 461 | *value = CHINE_TEST(serialDataAvil(fd)); 462 | #else 463 | (void)fd; 464 | *value = CHINE_TRUE; 465 | #endif 466 | return 1; 467 | } 468 | 469 | case SYS_UART_DISCONNECT: { 470 | int fd = revarg[0]; 471 | *npop = 1; 472 | #if defined(WIRINGPI) 473 | serialClosee(fd); 474 | *value = CHINE_TRUE; 475 | return 1; 476 | #else 477 | if (close(fd) < 0) { 478 | *npop = 0; 479 | revarg[0] = errno; 480 | *value = CHINE_FALSE; 481 | } 482 | else { 483 | *value = CHINE_TRUE; 484 | } 485 | return 1; 486 | #endif 487 | } 488 | 489 | case SYS_CAN_CONNECT: { 490 | char* dev = (char*)PTR(revarg[0]); 491 | int bitrate = revarg[1]; 492 | int mode = revarg[2]; 493 | (void) dev; 494 | (void) bitrate; 495 | (void) mode; 496 | TRACEF("can_connect(%s,%d,%d)",dev,bitrate,mode); 497 | revarg[2] = 12; 498 | *value = CHINE_TRUE; 499 | *npop = 1; 500 | return 0; 501 | } 502 | 503 | case SYS_CAN_SEND: { 504 | uint32_t B = revarg[0]; 505 | uint32_t A = revarg[1]; 506 | uint32_t len = revarg[2]; 507 | uint32_t fid = revarg[3]; 508 | int fd = revarg[4]; 509 | (void) B; 510 | (void) A; 511 | (void) len; 512 | (void) fid; 513 | (void) fd; 514 | TRACEF("can_send(fd=%d,fid=%x,len=%d,A=%x,B=%x)", fd, fid, len, A, B); 515 | *npop = 5; 516 | *value = CHINE_TRUE; 517 | return 1; 518 | } 519 | 520 | case SYS_CAN_RECV: { 521 | int fd = revarg[0]; 522 | uint32_t A = 0xFEEDBABE; 523 | uint32_t B = 0xC0FFE000; 524 | uint32_t fid = 0x123; 525 | (void)fd; 526 | TRACEF("can_recv(fd=%d)", fd); 527 | revarg[0] = fid; 528 | revarg[-1] = 7; 529 | revarg[-2] = B; 530 | revarg[-3] = A; 531 | *npop = -3; 532 | *value = CHINE_TRUE; 533 | return 1; 534 | } 535 | 536 | case SYS_CAN_DISCONNECT: { 537 | int fd = revarg[0]; 538 | (void)fd; 539 | *npop = 1; 540 | *value = CHINE_TRUE; 541 | return 1; 542 | } 543 | 544 | case SYS_FILE_OPEN: { 545 | char* name = (char*)get_const_array(mp,revarg[1]); 546 | int flags = revarg[0]; 547 | int fd; 548 | TRACEF("file_open(%s,%d)", name, flags); 549 | if ((fd=open(name, flags, 0666)) < 0) { 550 | *npop = 1; 551 | revarg[1] = errno; 552 | *value = CHINE_FALSE; 553 | } 554 | else { 555 | *npop = 1; 556 | revarg[1] = fd; 557 | *value = CHINE_TRUE; 558 | } 559 | return 1; 560 | } 561 | 562 | case SYS_FILE_WRITE: { 563 | int fd = revarg[2]; 564 | void* buf = get_const_array(mp, revarg[1]); 565 | size_t count = revarg[0]; 566 | ssize_t n; 567 | TRACEF("file_write(%d,%p,%lu)", fd, buf, count); 568 | if ((n=write(fd,buf,count)) < 0) { 569 | *npop = 2; 570 | revarg[2] = errno; 571 | *value = CHINE_FALSE; 572 | } 573 | else { 574 | *npop = 2; 575 | revarg[2] = n; 576 | *value = CHINE_TRUE; 577 | } 578 | return 1; 579 | } 580 | 581 | case SYS_FILE_READ: { 582 | int fd = revarg[2]; 583 | void* buf = get_const_array(mp, revarg[1]); 584 | size_t count = revarg[0]; 585 | ssize_t n; 586 | TRACEF("file_read(%d,%p,%lu)", fd, buf, count); 587 | if ((n=read(fd,buf,count)) < 0) { 588 | *npop = 2; 589 | revarg[2] = errno; 590 | *value = CHINE_FALSE; 591 | } 592 | else { 593 | *npop = 2; 594 | revarg[2] = n; 595 | *value = CHINE_TRUE; 596 | } 597 | return 1; 598 | } 599 | 600 | case SYS_FILE_CLOSE: { 601 | int fd = revarg[0]; 602 | TRACEF("file_close(%d)", fd); 603 | if (close(fd) < 0) { 604 | *npop = 0; 605 | revarg[0] = errno; 606 | *value = CHINE_FALSE; 607 | } 608 | else { 609 | *npop = 1; 610 | *value = CHINE_TRUE; 611 | } 612 | return 1; 613 | } 614 | 615 | case SYS_FILE_SEEK: { 616 | int fd = revarg[2]; 617 | off_t offset = revarg[1]; 618 | int whence = revarg[0]; 619 | TRACEF("file_seek(%d,%d,%d)", fd, offset, whence); 620 | offset = lseek(fd,offset,whence); 621 | if ((int)offset == -1) { 622 | *npop = 2; 623 | revarg[2] = errno; 624 | *value = CHINE_FALSE; 625 | } 626 | else { 627 | *npop = 2; 628 | revarg[2] = offset; 629 | *value = CHINE_TRUE; 630 | } 631 | return 1; 632 | } 633 | 634 | default: 635 | TRACEF("????"); 636 | *npop = 0; 637 | return FAIL_INVALID_ARGUMENT; 638 | } 639 | } 640 | -------------------------------------------------------------------------------- /c_src/chine_test.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "../include/chine.h" 9 | 10 | extern int32_t chine_unix_sys(chine_t* mp, 11 | int32_t sysop, int32_t* revarg, 12 | int32_t* npop, int32_t* value); 13 | 14 | int32_t test_code_pop(uint8_t* prog, size_t len) 15 | { 16 | chine_t m; 17 | int r; 18 | uint8_t imask[NUM_IBYTES]; // input mask 19 | timeout_t tmo = 0xffffffff; 20 | 21 | memset(m.stack, 0xff, sizeof(m.stack)); 22 | chine_init(&m, prog, chine_unix_sys); 23 | chine_set_ip(&m, 0); 24 | 25 | again: 26 | chine_run(&m); 27 | memset(imask, 0, sizeof(imask)); 28 | tmo = 0xffffffff; 29 | r = chine_next(&m, &tmo, imask); 30 | if (r) { 31 | if (tmo < 0xffffffff) { 32 | usleep(tmo*1000); 33 | goto again; 34 | } 35 | } 36 | return m.cSP[0]; 37 | } 38 | 39 | void test_integer_macros() 40 | { 41 | uint8_t data1[] = {189}; 42 | uint8_t data2[] = {229,135}; 43 | uint8_t data3[] = {255,67,158,178}; 44 | 45 | assert(INT8(data1) == -67); 46 | assert(UINT8(data1) == 189); 47 | assert(INT16(data2) == -6777); 48 | assert(UINT16(data2) == 58759); 49 | assert(INT32(data3) == -12345678); 50 | assert(UINT32(data3) == 4282621618); 51 | } 52 | 53 | void test_arithmetic() 54 | { 55 | uint8_t prog1[] = { PUSH8(105), PUSH8(34), ADD, YIELD }; 56 | uint8_t prog2[] = { PUSH8(105), PUSH8(34), SUB, YIELD }; 57 | uint8_t prog3[] = { PUSH8(105), PUSH8(34), MUL, YIELD }; 58 | uint8_t prog4[] = { PUSH8(105), PUSH8(34), DIV, YIELD }; 59 | uint8_t prog5[] = { PUSH8(105), PUSH8(34), S_MOD, YIELD }; 60 | uint8_t prog6[] = { PUSH8(105), PUSH8(34), AND, YIELD }; 61 | uint8_t prog7[] = { PUSH8(105), PUSH8(34), OR, YIELD }; 62 | uint8_t prog8[] = { PUSH8(105), PUSH8(34), XOR, YIELD }; 63 | uint8_t prog9[] = { PUSH8(105), NEGATE, YIELD }; 64 | uint8_t prog10[] = { PUSH8(105), NOT, YIELD }; 65 | uint8_t prog11[] = { PUSH8(105), PUSHi(2), SHFT, YIELD }; 66 | uint8_t prog12[] = { PUSH8(-105), PUSHi(2), NEGATE, SHFT, YIELD }; 67 | uint8_t prog13[] = { PUSH8(-105), PUSHi(2), S_ASR, YIELD }; 68 | 69 | assert(test_code_pop(prog1, sizeof(prog1)) == 139); 70 | assert(test_code_pop(prog2, sizeof(prog2)) == 71); 71 | assert(test_code_pop(prog3, sizeof(prog3)) == 3570); 72 | assert(test_code_pop(prog4, sizeof(prog4)) == 3); 73 | assert(test_code_pop(prog5, sizeof(prog5)) == 3); 74 | assert(test_code_pop(prog6, sizeof(prog6)) == 32); 75 | assert(test_code_pop(prog7, sizeof(prog7)) == 107); 76 | assert(test_code_pop(prog8, sizeof(prog8)) == 75); 77 | assert(test_code_pop(prog9, sizeof(prog9)) == -105); 78 | assert(test_code_pop(prog10, sizeof(prog10)) == -106); 79 | 80 | assert(test_code_pop(prog11, sizeof(prog11)) == 420); 81 | assert(test_code_pop(prog12, sizeof(prog12)) == 1073741797); 82 | assert(test_code_pop(prog13, sizeof(prog13)) == -27); 83 | } 84 | 85 | // test logic operators 86 | void test_logic() 87 | { 88 | uint8_t prog11[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_TRUE), AND, YIELD }; 89 | uint8_t prog12[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_TRUE), AND, YIELD }; 90 | uint8_t prog13[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_FALSE), AND, YIELD }; 91 | uint8_t prog14[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_FALSE), AND, YIELD }; 92 | 93 | uint8_t prog21[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_TRUE), OR, YIELD }; 94 | uint8_t prog22[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_TRUE), OR, YIELD }; 95 | uint8_t prog23[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_FALSE), OR, YIELD }; 96 | uint8_t prog24[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_FALSE), OR, YIELD }; 97 | 98 | uint8_t prog31[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_TRUE), XOR, YIELD }; 99 | uint8_t prog32[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_TRUE), XOR, YIELD }; 100 | uint8_t prog33[] = { PUSH8(CHINE_TRUE), PUSH8(CHINE_FALSE), XOR, YIELD }; 101 | uint8_t prog34[] = { PUSH8(CHINE_FALSE), PUSH8(CHINE_FALSE), XOR, YIELD }; 102 | 103 | uint8_t prog41[] = { PUSH8(CHINE_TRUE), NOT, YIELD }; 104 | uint8_t prog42[] = { PUSH8(CHINE_FALSE), NOT, YIELD }; 105 | 106 | assert(test_code_pop(prog11, sizeof(prog11)) == CHINE_TRUE); 107 | assert(test_code_pop(prog12, sizeof(prog12)) == CHINE_FALSE); 108 | assert(test_code_pop(prog13, sizeof(prog13)) == CHINE_FALSE); 109 | assert(test_code_pop(prog14, sizeof(prog14)) == CHINE_FALSE); 110 | 111 | assert(test_code_pop(prog21, sizeof(prog21)) == CHINE_TRUE); 112 | assert(test_code_pop(prog22, sizeof(prog22)) == CHINE_TRUE); 113 | assert(test_code_pop(prog23, sizeof(prog23)) == CHINE_TRUE); 114 | assert(test_code_pop(prog24, sizeof(prog24)) == CHINE_FALSE); 115 | 116 | assert(test_code_pop(prog31, sizeof(prog31)) == CHINE_FALSE); 117 | assert(test_code_pop(prog32, sizeof(prog32)) == CHINE_TRUE); 118 | assert(test_code_pop(prog33, sizeof(prog33)) == CHINE_TRUE); 119 | assert(test_code_pop(prog34, sizeof(prog34)) == CHINE_FALSE); 120 | 121 | assert(test_code_pop(prog41, sizeof(prog41)) == CHINE_FALSE); 122 | assert(test_code_pop(prog42, sizeof(prog42)) == CHINE_TRUE); 123 | } 124 | 125 | 126 | void test_comp() 127 | { 128 | uint8_t prog1[] = { PUSH8(105), ZEQ, YIELD }; 129 | uint8_t prog2[] = { PUSHi(0), ZEQ, YIELD }; 130 | uint8_t prog3[] = { PUSH8(-105), ZLT, YIELD }; 131 | uint8_t prog4[] = { PUSH8(105), ZLT, YIELD }; 132 | uint8_t prog5[] = { PUSH8(105), PUSH8(34), S_LT, YIELD }; 133 | uint8_t prog6[] = { PUSH32(0xffff0001), PUSH32(0xffff0002), S_ULT, YIELD }; 134 | uint8_t prog7[] = { PUSH32(0xffff0002), PUSH32(0xffff0001), S_ULT, YIELD }; 135 | uint8_t prog8[] = { PUSH32(0xffff0002), PUSH32(0xffff0002), S_ULE, YIELD }; 136 | 137 | assert(test_code_pop(prog1, sizeof(prog1)) == CHINE_FALSE); 138 | assert(test_code_pop(prog2, sizeof(prog2)) == CHINE_TRUE); 139 | assert(test_code_pop(prog3, sizeof(prog3)) == CHINE_TRUE); 140 | assert(test_code_pop(prog4, sizeof(prog4)) == CHINE_FALSE); 141 | assert(test_code_pop(prog5, sizeof(prog5)) == CHINE_FALSE); 142 | assert(test_code_pop(prog6, sizeof(prog6)) == CHINE_TRUE); 143 | assert(test_code_pop(prog7, sizeof(prog7)) == CHINE_FALSE); 144 | assert(test_code_pop(prog8, sizeof(prog8)) == CHINE_TRUE); 145 | } 146 | 147 | void test_misc() 148 | { 149 | uint8_t prog1[] = { PUSH8(105), S_INC, YIELD }; 150 | uint8_t prog2[] = { PUSH8(105), S_DEC, YIELD }; 151 | uint8_t prog3[] = { PUSH8(-105), S_ABS, YIELD }; 152 | uint8_t prog4[] = { PUSH8(105), PUSH8(34), S_MIN, YIELD }; 153 | uint8_t prog5[] = { PUSH8(105), PUSH8(34), S_MAX, YIELD }; 154 | uint8_t prog6[] = { PUSH8(34), DUP, MUL, YIELD }; 155 | uint8_t prog7[] = { PUSH8(34), PUSH8(105), SWAP, YIELD }; 156 | 157 | assert(test_code_pop(prog1, sizeof(prog1)) == 106); 158 | assert(test_code_pop(prog2, sizeof(prog2)) == 104); 159 | assert(test_code_pop(prog3, sizeof(prog3)) == 105); 160 | assert(test_code_pop(prog4, sizeof(prog4)) == 34); 161 | assert(test_code_pop(prog5, sizeof(prog5)) == 105); 162 | assert(test_code_pop(prog6, sizeof(prog6)) == 1156); 163 | assert(test_code_pop(prog7, sizeof(prog7)) == 34); 164 | } 165 | 166 | void test_mem() 167 | { 168 | uint8_t prog1[] = { PUSH8(105), PUSHi(1), STORE, 169 | PUSHi(1), FETCH, YIELD }; 170 | uint8_t prog2[] = { PUSH8(-34), PUSHi(0), STORE, 171 | PUSHi(0), FETCH, YIELD }; 172 | 173 | assert(test_code_pop(prog1, sizeof(prog1)) == 105); 174 | assert(test_code_pop(prog2, sizeof(prog2)) == -34); 175 | } 176 | 177 | void test_branch() 178 | { 179 | uint8_t prog1[] = { JOP8(JMP,2), PUSH8(10), PUSH8(20), YIELD }; 180 | uint8_t prog2[] = { JOP16(JMP,2), PUSH8(10), PUSH8(20), YIELD }; 181 | uint8_t prog3[] = { JOP8(JMP,3), PUSH8(20), YIELD, JOP8(JMP,-5), YIELD }; 182 | uint8_t prog4[] = { JOP16(JMP,3), PUSH8(20), YIELD, JOP8(JMP,-5), YIELD }; 183 | uint8_t prog5[] = { PUSHi(0), JOP8(JMPZ,2), PUSH8(10), PUSH8(20), YIELD }; 184 | uint8_t prog6[] = { PUSHi(0), JOP16(JMPZ,2), PUSH8(10), PUSH8(20), YIELD }; 185 | uint8_t prog7[] = { ARRAY8_8(4), 186 | ARG8(10), ARG8(14), ARG8(18), ARG8(22), 187 | PUSHi(2), 188 | ELEM, TOR, EXIT, 189 | PUSH8(10), JOP8(JMP,12), 190 | PUSH8(20), JOP8(JMP,8), 191 | PUSH8(30), JOP8(JMP,4), 192 | PUSH8(40), JOP8(JMP,0), 193 | YIELD }; 194 | uint8_t prog8[] = { ARRAY8_16(4), 195 | ARG16(14), ARG16(18), ARG16(22), ARG16(26), 196 | PUSHi(3), 197 | ELEM, TOR, EXIT, 198 | PUSH8(10), JOP8(JMP,12), 199 | PUSH8(20), JOP8(JMP,8), 200 | PUSH8(30), JOP8(JMP,4), 201 | PUSH8(40), JOP8(JMP,0), 202 | YIELD }; 203 | 204 | assert(test_code_pop(prog1, sizeof(prog1)) == 20); 205 | assert(test_code_pop(prog2, sizeof(prog2)) == 20); 206 | assert(test_code_pop(prog3, sizeof(prog3)) == 20); 207 | assert(test_code_pop(prog4, sizeof(prog4)) == 20); 208 | assert(test_code_pop(prog5, sizeof(prog5)) == 20); 209 | assert(test_code_pop(prog6, sizeof(prog6)) == 20); 210 | assert(test_code_pop(prog7, sizeof(prog7)) == 30); 211 | assert(test_code_pop(prog8, sizeof(prog8)) == 40); 212 | } 213 | 214 | void test_call() 215 | { 216 | uint8_t prog1[] = { JOP8(CALL,1), YIELD, PUSH8(10), EXIT }; 217 | uint8_t prog2[] = { PUSH8(5), PUSH8(15), JOP8(CALL,1), YIELD, ADD, EXIT }; 218 | uint8_t prog3[] = { PUSH8(5), JOP8(CALL,1), YIELD, 219 | // FACT 220 | DUP, // ( n -- r n ) 221 | // LOOP 222 | PUSHi(1), SUB, // ( r n -- r n-1 ) = DEC 223 | DUP, PUSHi(1), S_EQ, JOPi(JMPZ,2), 224 | DROP, EXIT, 225 | // DUP, // ( r n -- r n n ) 226 | // ROT, // ( r n n -- n r n ) 227 | OPOP(DUP,ROT), 228 | MUL, // ( n r n -- n r*n ) 229 | SWAP, // ( n r - r n ) 230 | JOP8(JMP,-14) }; 231 | 232 | assert(test_code_pop(prog1, sizeof(prog1)) == 10); 233 | assert(test_code_pop(prog2, sizeof(prog2)) == 20); 234 | assert(test_code_pop(prog3, sizeof(prog3)) == 120); 235 | } 236 | 237 | void test_syscall() 238 | { 239 | uint8_t prog0[] = { PUSH8('w'), SYS, SYS_EMIT, 240 | PUSH8('a'), SYS, SYS_EMIT, 241 | PUSH8('i'), SYS, SYS_EMIT, 242 | PUSH8('t'), SYS, SYS_EMIT, 243 | PUSH8('\n'), SYS, SYS_EMIT, 244 | PUSH8(5), 245 | YIELD}; 246 | 247 | uint8_t prog1[] = { PUSH8(1), SYS, SYS_TIMER_INIT, 248 | PUSH8(1), SYS, SYS_TIMER_START, 249 | PUSH8(1), SYS, SYS_SELECT_TIMER, 250 | PUSH8(1), SYS, SYS_TIMER_TIMEOUT, 251 | JOP8(JMPZ,9), 252 | PUSH8(1), SYS, SYS_TIMER_STOP, 253 | PUSH8(100), 254 | YIELD, JOP8(JMP,-3), 255 | YIELD, 256 | JOP8(JMP,-18) }; 257 | 258 | uint8_t prog9[] = { PUSH8('>'), SYS, SYS_EMIT, 259 | PUSH8(' '), SYS, SYS_EMIT, 260 | // LABEL L1 261 | SYS, SYS_RECV, 262 | DUP, SYS, SYS_EMIT, 263 | PUSH8('\n'), S_EQ, 264 | JOP8(JMPZ,-10), 265 | PUSHi(1), 266 | YIELD}; 267 | 268 | uint8_t prog10[] = { PUSH8('o'), SYS, SYS_EMIT, 269 | PUSH8('k'), SYS, SYS_EMIT, 270 | PUSH8('\n'), SYS, SYS_EMIT, 271 | PUSH8(3), 272 | YIELD}; 273 | assert(test_code_pop(prog0, sizeof(prog0)) == 5); 274 | assert(test_code_pop(prog1, sizeof(prog1)) == 100); 275 | assert(test_code_pop(prog9, sizeof(prog9)) == 1); 276 | assert(test_code_pop(prog10, sizeof(prog10)) == 3); 277 | } 278 | 279 | void test_loop() 280 | { 281 | uint8_t prog0[] = { PUSH8(10), 282 | TOR, 283 | RFETCH,PUSH8(64),ADD,SYS,SYS_EMIT, 284 | JOP8(JNEXT,-8), 285 | PUSH8(10),SYS,SYS_EMIT, 286 | PUSH8(10), 287 | YIELD }; 288 | assert(test_code_pop(prog0, sizeof(prog0)) == 10); 289 | } 290 | 291 | int main() 292 | { 293 | printf("test_integer_macros\n"); 294 | test_integer_macros(); 295 | printf("test_arithmetic\n"); 296 | test_arithmetic(); 297 | printf("test_comp\n"); 298 | test_logic(); 299 | printf("test_logic\n"); 300 | test_comp(); 301 | printf("test_misc\n"); 302 | test_misc(); 303 | printf("test_mem\n"); 304 | test_mem(); 305 | printf("test_branch\n"); 306 | test_branch(); 307 | printf("test_call\n"); 308 | test_call(); 309 | printf("test_loop\n"); 310 | test_loop(); 311 | // printf("test_syscall\n"); 312 | // test_syscall(); 313 | exit(0); 314 | } 315 | -------------------------------------------------------------------------------- /c_src/chine_test3.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "../include/chine.h" 5 | 6 | chine_t m1; 7 | chine_t m2; 8 | chine_t m3; 9 | 10 | // 1 use timer number 1, (default 1s) 11 | uint8_t prog1[] = { PUSH8(1), SYS, SYS_TIMER_INIT, 12 | // L1: 13 | PUSH8(1), SYS, SYS_TIMER_START, 14 | PUSH8(1), SYS, SYS_SELECT_TIMER, 15 | // L2: 16 | PUSH8(1), SYS, SYS_TIMER_TIMEOUT, 17 | JOP8(JMPZ,6), 18 | PUSH8('1'), SYS, SYS_EMIT, 19 | JOP8(JMP,-20), 20 | YIELD, 21 | JOP8(JMP,-15) }; 22 | 23 | // 2 use second timer (default 2s) 24 | uint8_t prog2[] = { PUSH8(2), SYS, SYS_TIMER_INIT, 25 | PUSH8(2), SYS, SYS_TIMER_START, 26 | PUSH8(2), SYS, SYS_SELECT_TIMER, 27 | PUSH8(2), SYS, SYS_TIMER_TIMEOUT, 28 | JOP8(JMPZ,6), 29 | PUSH8('2'), SYS, SYS_EMIT, 30 | JOP8(JMP,-20), 31 | YIELD, 32 | JOP8(JMP,-15) }; 33 | 34 | // 3 use third timer (default 3s) 35 | uint8_t prog3[] = { PUSH8(3), SYS, SYS_TIMER_INIT, 36 | PUSH8(3), SYS, SYS_TIMER_START, 37 | PUSH8(3), SYS, SYS_SELECT_TIMER, 38 | PUSH8(3), SYS, SYS_TIMER_TIMEOUT, 39 | JOP8(JMPZ,6), 40 | PUSH8('3'), SYS, SYS_EMIT, 41 | JOP8(JMP,-20), 42 | YIELD, 43 | JOP8(JMP,-15) }; 44 | 45 | extern int chine_unix_sys(chine_t* mp, 46 | cell_t sysop, cell_t* revarg, 47 | cell_t* npop, cell_t* value); 48 | 49 | void setup() 50 | { 51 | chine_init(&m1, prog1, chine_unix_sys); 52 | chine_set_ip(&m1, 0); 53 | chine_init(&m2, prog2, chine_unix_sys); 54 | chine_set_ip(&m2, 0); 55 | chine_init(&m3, prog3, chine_unix_sys); 56 | chine_set_ip(&m3, 0); 57 | } 58 | 59 | void loop() 60 | { 61 | int i, r=0; 62 | chine_t* mv[3] = { &m1, &m2, &m3 }; 63 | uint8_t imask[NUM_IBYTES]; // input mask 64 | timeout_t tmo = 0xffffffff; 65 | 66 | memset(&imask, 0, sizeof(imask)); 67 | for (i = 0; i < 3; i++) { 68 | chine_run(mv[i]); 69 | r |= chine_next(mv[i], &tmo, imask); 70 | } 71 | if (r) { 72 | if (tmo < 0xffffffff) { 73 | usleep(tmo*1000); 74 | } 75 | } 76 | } 77 | 78 | int main() 79 | { 80 | setup(); 81 | 82 | while(1) 83 | loop(); 84 | } 85 | -------------------------------------------------------------------------------- /c_src/test/.gitignore: -------------------------------------------------------------------------------- 1 | chine_bench 2 | chine_test 3 | chine_test3 4 | *.bin 5 | -------------------------------------------------------------------------------- /c_src/test/arith.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% Test arithmetic 3 | 4 | {export,run}. 5 | 6 | [ 7 | {label,run}, 8 | 5, 3, '+', 8, '=', drop, 9 | 5, 3, '-', 2, '=', drop, 10 | 5, 3, '*', 15, '=', drop, 11 | 5, 3, '/', 0, '=', drop, 12 | 5, 4, 2, '*', '+', drop, 13 | 5, 4, 2, '+', '*', drop, 14 | exit 15 | ]. 16 | -------------------------------------------------------------------------------- /c_src/test/bench.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% 3 | %% BENCHMARK calculate 12! 1000000 times 4 | %% 5 | {export,run}. 6 | 7 | [ 8 | {label,run}, 9 | 10 | now, 11 | 1000000, 12 | {call, bench}, 13 | now, 14 | swap, '-', 15 | {call, println}, 16 | terminate 17 | ]. 18 | 19 | [ 20 | %% BENCH : ( n -- ) 21 | {label,bench}, 22 | {label,bench_loop}, 23 | 12, 24 | {call, factorial}, 25 | drop, 26 | '1-', 27 | dup, {jmpnz, bench_loop}, 28 | drop, 29 | exit 30 | ]. 31 | 32 | 33 | [ 34 | %% FACTORIAL: ( n -- n! ) 35 | {label,factorial}, 36 | dup, %% ( r n ) 37 | {label,fact_loop}, 38 | '1-', %% ( r n ) 39 | dup, {jmpz,fact_done}, 40 | dup, rot, %% ( n r n ) 41 | '*', swap, %% ( r*n n ) 42 | {jmp, fact_loop}, 43 | 44 | {label,fact_done}, 45 | drop, exit 46 | ]. 47 | 48 | 49 | %% PRINTLN: ( n -- ) 50 | [ 51 | {label,println}, 52 | {call,print}, 53 | $\n,emit, 54 | exit 55 | ]. 56 | 57 | %% PRINT: ( n -- ) 58 | [ 59 | {label,print}, 60 | dup, '0=', 61 | {'if', [$0,emit,drop,exit]}, 62 | dup, '0<', 63 | {'if', [$-,emit,negate]}, 64 | {call,uprint}, 65 | exit 66 | ]. 67 | 68 | %% UPRINT: ( n -- ) n>=0 69 | [ 70 | {label,uprint}, 71 | dup, '0=', 72 | {'if', [drop,exit]}, 73 | dup, 10,'/',{call,uprint}, %% print(n/10) 74 | 10,mod,$0,'+',emit, 75 | exit 76 | ]. 77 | -------------------------------------------------------------------------------- /c_src/test/blink.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | %% blink with arduino leds 4 | 5 | {enum, ["state_mem"]}. 6 | {enum, ["init", "on", "off"]}. 7 | 8 | [ 9 | {export,init}, 10 | {label, init}, 11 | 13,gpio_output, 12 | 1,timer_init, 13 | 2,timer_init, 14 | 16#2710, 1, 500, 'param!', 15 | 16#2710, 2, 750, 'param!', 16 | {const,"init"},{const,"state_mem"},'!', 17 | exit 18 | ]. 19 | 20 | [ 21 | {export,run}, 22 | {label,run}, 23 | 24 | {array, [{caddr,"state_init"},{caddr,"state_on"},{caddr,"state_off"}]}, 25 | {const, "state_mem"}, '@', '[]', 'jmp*', 26 | 27 | {label,"state_on"}, 28 | 1, timer_timeout, 'not', {'if', [1, select_timer, exit]}, 29 | 1, deselect_timer, 30 | 13, gpio_clr, 31 | $0, emit, 32 | 0, timer_start, 33 | 0, select_timer, 34 | {const,"off"},{const,"state_mem"},'!', 35 | exit, 36 | 37 | {label,"state_off"}, 38 | 0, timer_timeout, 'not', {'if', [0, select_timer, exit]}, 39 | 0, deselect_timer, 40 | 41 | {label,"state_init"}, 42 | 13, gpio_set, 43 | $1, emit, 44 | 1, timer_start, 45 | 1, select_timer, 46 | {const,"on"},{const,"state_mem"},'!', 47 | exit 48 | 49 | ]. 50 | -------------------------------------------------------------------------------- /c_src/test/crc32.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | {export,'crc/'}. 4 | %%{export,'crcfill'}. 5 | %%{export,'crctbl'}. 6 | %%{export,'crc+'}. 7 | %%{export,'crcbuf'}. 8 | 9 | %%: crc/ ( n -- n ) 8 0 do dup 1 rshift swap 1 and if $edb88320 xor then loop ; 10 | [ 11 | {label,'crc/'}, %% ( n -- n ) 12 | 8, {for, 13 | [ 14 | dup, 1, rshift, swap, 1, 'and', {'if',[16#edb88320, 'xor']} 15 | ]} 16 | ]. 17 | 18 | %%: crcfill 256 0 do i crc/ , loop ; 19 | %% 20 | %%create crctbl crcfill 21 | %% 22 | %%: crc+ ( crc n -- crc' ) over xor $ff and cells crctbl + @ swap 8 rshift xor ; 23 | %% 24 | %%: crcbuf ( crc str len -- crc ) bounds ?do i c@ crc+ loop ; 25 | %% 26 | %%$ffffffff s" The quick brown fox jumps over the lazy dog" crcbuf $ffffffff xor hex. bye \ $414FA339 27 | -------------------------------------------------------------------------------- /c_src/test/fail_divzero.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% Test overflow 3 | 4 | {export,run}. 5 | 6 | [ 7 | {label,run}, 8 | 12, 0, '/' 9 | ]. 10 | -------------------------------------------------------------------------------- /c_src/test/fail_invalid_address.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% Test invalid address 3 | 4 | {export,run}. 5 | 6 | [ 7 | {label,run}, 8 | 1000, '@' 9 | ]. 10 | -------------------------------------------------------------------------------- /c_src/test/fail_overflow.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% Test overflow 3 | 4 | {export,run}. 5 | 6 | [ 7 | {label,run}, 8 | 1000, {'for', [1]} 9 | ]. 10 | -------------------------------------------------------------------------------- /c_src/test/fail_underflow.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% Test underflow 3 | 4 | {export,run}. 5 | 6 | [ 7 | {label,run}, 8 | 3, '+' 9 | ]. 10 | -------------------------------------------------------------------------------- /c_src/test/frame.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | {export,run}. 4 | 5 | [ 6 | {label,run}, 7 | {const,2}, {const,3}, {const,5}, {call, func}, 8 | {call, println}, 9 | terminate 10 | ]. 11 | 12 | [ 13 | {label, func}, 14 | fenter, 15 | {arg,0},{arg,1},'*',{arg,2},'*', 16 | {call, println}, 17 | fleave, 18 | exit 19 | ]. 20 | 21 | %% PRINTLN: ( n -- ) 22 | [ 23 | {label,println}, 24 | {call,print}, 25 | $\n,emit, 26 | exit 27 | ]. 28 | 29 | %% PRINT: ( n -- ) 30 | [ 31 | {label,print}, 32 | dup, '0=', 33 | {'if', [$0,emit,drop,exit]}, 34 | dup, '0<', 35 | {'if', [$-,emit,negate]}, 36 | {call,uprint}, 37 | exit 38 | ]. 39 | 40 | %% UPRINT: ( n -- ) n>=0 41 | [ 42 | {label,uprint}, 43 | dup, '0=', 44 | {'if', [drop,exit]}, 45 | dup, 10,'/',{call,uprint}, %% print(n/10) 46 | 10,mod,$0,'+',emit, 47 | exit 48 | ]. 49 | -------------------------------------------------------------------------------- /c_src/test/hello.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | {export,run}. 4 | 5 | [ 6 | %% this is the literal string 7 | {label,run}, 8 | {string,"Hello world\r\n"}, 9 | {const,13}, 10 | {for, [dup, {const,13}, 'r@', '-', '[]', emit]}, 11 | terminate 12 | ]. 13 | -------------------------------------------------------------------------------- /c_src/test/print.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | %% print a string 4 | {export,run}. 5 | %% {export,init}. 6 | %% {export,final}. 7 | 8 | [ 9 | %% this is the literal string 10 | {label,run}, 11 | {string,"Hello world\n"}, 12 | {const,12}, 13 | {for, [dup, {const,12}, 'r@', '-', '[]', emit]}, 14 | 15 | 1234, {call,println}, 16 | 17, {call,print},$\s,emit, -17, {call,print}, $\n, emit, 17 | 1, {call,print},$\s,emit, -1, {call,print}, $\n, emit, 18 | 19 | 20 | {again, yield}, 21 | {label,init}, 22 | exit, 23 | {label,final}, 24 | exit 25 | ]. 26 | 27 | %% PRINTLN: ( n -- ) 28 | [ 29 | {label,println}, 30 | {call,print}, 31 | $\n,emit, 32 | exit 33 | ]. 34 | 35 | %% PRINT: ( n -- ) 36 | [ 37 | {label,print}, 38 | dup, '0=', 39 | {'if', [$0,emit,drop,exit]}, 40 | dup, '0<', 41 | {'if', [$-,emit,negate]}, 42 | {call,uprint}, 43 | exit 44 | ]. 45 | 46 | %% UPRINT: ( n -- ) n>=0 47 | [ 48 | {label,uprint}, 49 | dup, '0=', 50 | {'if', [drop,exit]}, 51 | dup, 10,'/',{call,uprint}, %% print(n/10) 52 | 10,mod,$0,'+',emit, 53 | exit 54 | ]. 55 | -------------------------------------------------------------------------------- /c_src/test/write_file.ch: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% write "Hello world!\n" to a file "hello.txt" 3 | %% 4 | {enum, ["O_READ", "O_WRITE", "O_RDWR"]}. 5 | %% {define, "O_CREAT", 8#100}. 6 | 7 | [ 8 | {export,run}, 9 | {label,run}, 10 | {string, "hello.txt\0"}, {const,"O_WRITE"}, {const,8#100}, '+', file_open, 11 | {'if', [ {string, "Hello world!\n\0"}, {const, 13}, file_write ], 12 | [ drop, {const,2}, {string, "open error\n\0"}, {const, 11}, file_write ]}, 13 | terminate 14 | ]. 15 | 16 | -------------------------------------------------------------------------------- /ebin/.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | *.app 3 | -------------------------------------------------------------------------------- /include/chine.h: -------------------------------------------------------------------------------- 1 | // 2 | // chine 3 | // 4 | 5 | #ifndef __CHINE_H__ 6 | #define __CHINE_H__ 7 | 8 | #include 9 | 10 | #ifdef __cplusplus 11 | extern "C" { 12 | #endif 13 | 14 | #ifdef __GNUC__ 15 | # define UNUSED(x) UNUSED_ ## x __attribute__((__unused__)) 16 | #else 17 | # define UNUSED(x) UNUSED_ ## x 18 | #endif 19 | 20 | #ifdef __GNUC__ 21 | # define UNUSED_FUNCTION(x) __attribute__((__unused__)) UNUSED_ ## x 22 | #else 23 | # define UNUSED_FUNCTION(x) UNUSED_ ## x 24 | #endif 25 | 26 | #if defined(ARDUINO) 27 | #include "Arduino.h" 28 | #define CHINE_INLINE 29 | #else 30 | #define CHINE_INLINE inline 31 | #endif 32 | 33 | #define FILE_VERSION_MAJOR 1 34 | #define FILE_VERSION_MINOR 1 35 | #define FILE_VERSION_PATCH 0 36 | 37 | #define MAX_INPUT 32 38 | #define MAX_STACK 16 // stack + return stack 39 | #define MAX_MEM 16 40 | #define MAX_TIMERS 16 41 | #define NUM_TBYTES ((MAX_TIMERS+7)>>3) 42 | #define NUM_IBYTES ((MAX_INPUT+7)>>3) 43 | 44 | typedef int32_t cell_t; 45 | typedef uint32_t ucell_t; 46 | typedef uint32_t timeout_t; 47 | 48 | #define SETBIT(v,i) (v)[(i)>>3] |= (1 << ((i) & 7)) 49 | #define CLRBIT(v,i) (v)[(i)>>3] &= ~(1 << ((i) & 7)) 50 | #define TSTBIT(v,i) ((v)[(i)>>3] & (1 << ((i) & 7))) 51 | 52 | #define U32(x) ((uint32_t)(x)) 53 | #define U16(x) ((uint16_t)(x)) 54 | #define U8(x) ((uint8_t)(x)) 55 | 56 | #define CHINE_TRUE -1 57 | #define CHINE_FALSE 0 58 | #define CHINE_TEST(x) (-(!!(x))) 59 | 60 | // chine test table 61 | // x = 123 -1 0 62 | // !x = 0 0 1 63 | // !!x = 1 1 0 64 | // -!!x = -1 -1 0 65 | 66 | static inline uint8_t unpack_u8(uint8_t* ptr) 67 | { 68 | return U8(ptr[0]); 69 | } 70 | 71 | static inline uint16_t unpack_u16(uint8_t* ptr) 72 | { 73 | return (U16(ptr[0])<<8) | U16(ptr[1]); 74 | } 75 | 76 | static inline uint32_t unpack_u32(uint8_t* ptr) 77 | { 78 | return (U32(ptr[0])<<24) | (U32(ptr[1])<<16) | 79 | (U32(ptr[2])<<8) | U32(ptr[3]); 80 | } 81 | 82 | static inline int8_t unpack_i8(uint8_t* ptr) 83 | { 84 | return (int8_t) unpack_u8(ptr); 85 | } 86 | 87 | static inline int16_t unpack_i16(uint8_t* ptr) 88 | { 89 | return (int16_t) unpack_u16(ptr); 90 | } 91 | 92 | static inline int32_t unpack_i32(uint8_t* ptr) 93 | { 94 | return (int32_t) unpack_u32(ptr); 95 | } 96 | 97 | #define UINT8(ptr) unpack_u8((ptr)) 98 | #define UINT16(ptr) unpack_u16((ptr)) 99 | #define UINT32(ptr) unpack_u32((ptr)) 100 | #define INT8(ptr) unpack_i8((ptr)) 101 | #define INT16(ptr) unpack_i16((ptr)) 102 | #define INT32(ptr) unpack_i32((ptr)) 103 | 104 | // OPCODE yyxxxxxx 105 | #define OP0 0 106 | #define OP1 1 107 | #define OP2 2 108 | #define OP3 3 109 | #define OPMASK 0xC0 110 | #define OPSHFT 6 111 | 112 | // OPCODE0 00iiiiii 64 instruction opcode 113 | #define OP0MASK 0x3f 114 | #define OPCODE0(op) (0x00 | ((op)&OP0MASK)) 115 | 116 | // OPCODE1 01lljjjj 16 "jump" instructions with 2 bit length indicator 117 | // 0=8 bit, 1=16 bit, 2=32 bit (3 = yet unassigned) 118 | #define OP1MASK 0x0f 119 | #define VAL1MASK 0x03 120 | #define VAL1SHFT 4 121 | #define OP1VAL(x) (((x)>>VAL1SHFT)&VAL1MASK) 122 | #define OPCODE1(jop,l) (0x40|((jop)&OP1MASK)|(((l)&VAL1MASK)<>(8-VAL2SHFT)) 129 | #define OPCODE2(jop,a) (0x80|((jop)&OP2MASK)|(((a)&VAL2MASK)<=0) goto L; else RP--; 140 | JMPLZ = 3, // if (TOP < 0) goto L 141 | JMP = 4, // goto L 142 | CALL = 5, // call(L) 143 | LITERAL = 6, // constant N 144 | ARRAY = 7, // Array+String (of constants) 145 | // OPCODE1 only 146 | ARG = 8, 147 | JOP_9 = 9, 148 | JOP_10 = 10, 149 | JOP_11 = 11, 150 | JOP_12 = 12, 151 | JOP_13 = 13, 152 | JOP_14 = 14, 153 | JOP_15 = 15, 154 | } opcode1_t; 155 | 156 | typedef enum { 157 | // opcode0 and opcode3 158 | DUP = 0, // dup: ( a -- a a ) 159 | ROT = 1, // rot: ( a b c -- b c a ) ( down ) 160 | OVER = 2, // over: ( a b -- b a ) 161 | DROP = 3, // drop: ( a -- ) 162 | SWAP = 4, // swap: ( a b -- b a ) 163 | SUB = 5, // -: ( a b -- [ a-b ] ) 164 | ADD = 6, // +: ( x1 x2 -- (x1+x2) ) 165 | MUL = 7, // *: ( x1 x2 -- (x1*x2) ) 166 | // opcode0 167 | NOP = 8, // nop: ( -- ) 168 | AND = 9, // and: ( a b -- (a&b) ) 169 | OR = 10, // or: ( a b -- (a|b) ) 170 | XOR = 11, // ^: ( a b -- (a^b) ) 171 | ZEQ = 12, // 0=: ( a -- (a==0) ) 172 | ZLT = 13, // 0<: ( a -- (a<0) ) 173 | NOT = 14, // not: ( a -- (~a) ) 174 | OP_15 = 15, // unassigned 175 | NEGATE = 16, // negate: ( a -- (-a) ) 176 | DIV = 17, // / ( a b -- (a/b) ) 177 | SHFT = 18, // shift ( a n -- ( a << n, n>=0 ) | ( a >> -n, n<0) ) 178 | STORE = 19, // ! ( a i -- ) 179 | FETCH = 20, // @ ( i -- a ) 180 | TOR = 21, // >r ( n -- ) R: ( -- n ) 181 | FROMR = 22, // r> R: ( n -- ) ( -- n ) 182 | RFETCH = 23, // r@: R: ( n -- n ) ( -- n ) 183 | EXIT = 24, // exit/; ( -- ) R: ( addr -- ) 184 | SYS = 25, // sys ( x1 .. xn -- y1 ) 185 | YIELD = 26, // ( -- ) 186 | ELEM = 27, // [] ( a* i -- n ) 187 | EXEC = 28, // execute ( a* i -- ) 188 | FPFETCH = 29, // fp@ ( -- fp ) 189 | FPSTORE = 30, // fp! ( fp -- ) 190 | SPFETCH = 31, // sp@ ( -- sp ) 191 | SPSTORE = 32, // sp! ( sp -- ) 192 | OP_33 = 33, 193 | //... 194 | OP_63 = 63 195 | } opcode_t; 196 | 197 | #define ARG8(x) U8((x)) 198 | #define ARG16(x) U8((x)>>8), U8((x)) 199 | #define ARG32(x) U8((x)>>24), U8((x)>>16), U8((x)>>8), U8((x)) 200 | 201 | #define JOPi(jop,y) OPCODE2((jop),(y)) // jump -4 .. 3 202 | #define JOP8(jop,y) OPCODE1((jop),0), ARG8((y)) 203 | #define JOP16(jop,y) OPCODE1((jop),1), ARG16((y)) 204 | 205 | #define PUSHi(x) OPCODE2(LITERAL,(x)) // push -4 .. 3 206 | #define PUSH8(x) OPCODE1(LITERAL,0), ARG8((x)) 207 | #define PUSH16(x) OPCODE1(LITERAL,1), ARG16((x)) 208 | #define PUSH32(x) OPCODE1(LITERAL,2), ARG32((x)) 209 | 210 | #define ARRAY8i(n) OPCODE2(ARRAY,(n)) 211 | #define ARRAY8_8(n) OPCODE1(ARRAY,0), ARG8((n)) 212 | #define ARRAY8_16(n) OPCODE1(ARRAY,1), ARG8((n)) 213 | #define ARRAY8_32(n) OPCODE1(ARRAY,2), ARG8((n)) 214 | #define ARRAY16_8(n) OPCODE1(ARRAY,4), ARG16((n)) 215 | #define ARRAY16_16(n) OPCODE1(ARRAY,5), ARG16((n)) 216 | #define ARRAY16_32(n) OPCODE1(ARRAY,6), ARG16((n)) 217 | 218 | #define OPOP(x,y) OPCODE3((x),(y)) 219 | 220 | // : 1+ 221 | #define S_INC PUSHi(1), ADD 222 | // : 1- 223 | #define S_DEC PUSHi(1), SUB 224 | // : < 225 | #define S_LT SUB, ZLT 226 | // : abs 227 | #define S_ABS DUP, ZLT, JOP8(JMPZ,1), NEGATE 228 | // : max 229 | #define S_MIN OPOP(OVER,OVER),SUB,ZLT,JOP8(JMPZ,3),DROP, \ 230 | JOP8(JMP,1),OPOP(SWAP,DROP) 231 | // : max 232 | #define S_MAX OPOP(OVER,OVER),SUB,ZLT,JOP8(JMPZ,3), \ 233 | OPOP(SWAP,DROP),JOP8(JMP,1),DROP 234 | // : = 235 | #define S_EQ SUB, ZEQ 236 | // : mod 237 | #define S_MOD OPOP(OVER,OVER), DIV, OPOP(MUL,SUB) 238 | // : arshift 239 | #define S_ASR DUP,PUSH8(32),OPOP(SWAP,SUB), \ 240 | PUSHi(-1),SWAP,SHFT,ROT,ROT,NEGATE,SHFT,OR 241 | // : 0<= 1- 0< ; 242 | #define S_ZLE PUSHi(1),SUB,ZLT 243 | // : 2dup 244 | #define S_2DUP OPOP(OVER,OVER) 245 | // : u< ( u u -- t ) 2dup xor 0< if swap drop 0< else - 0< then ; 246 | #define S_ULT S_2DUP, XOR, ZLT, JOP8(JMPZ,4), \ 247 | OPOP(SWAP,DROP), ZLT, JOP8(JMP,2), SUB, ZLT 248 | // : u<= 2dup xor 0< if swap drop 0< else - 0<= then ; 249 | #define S_ULE S_2DUP, XOR, ZLT, JOP8(JMPZ,4), \ 250 | OPOP(SWAP,DROP), ZLT, JOP8(JMP,6), SUB, S_ZLE 251 | 252 | #define FENTER FPFETCH, TOR, SPFETCH, FPSTORE 253 | #define FLEAVE FPFETCH, FROMR, FPSTORE, SPSTORE 254 | 255 | // Failure codes 256 | #define FAIL_INVALID_ARGUMENT -1 257 | #define FAIL_INVALID_OPCODE -2 258 | #define FAIL_STACK_OVERFLOW -3 259 | #define FAIL_STACK_UNDERFLOW -4 260 | #define FAIL_INVALID_MEMORY_ADDRESS -9 261 | #define FAIL_DIV_ZERO -10 262 | #define FAIL_TIMER_OVERFLOW -11 263 | #define FAIL_TERMINATE -128 264 | 265 | // SYSTEM CALLS 266 | typedef enum { 267 | SYS_INIT = 0, // ( -- ) called at init 268 | SYS_TERMINATE, // ( -- ) terminate the program 269 | SYS_NOW, // ( -- u ) milliseconds since start 270 | SYS_EMIT, // ( c -- ) transmit on default output 271 | SYS_RECV, // ( -- c ) receive from default input 272 | SYS_AVAIL, // ( -- f ) check if default input is available 273 | SYS_PARAM_FETCH, // ( s i -- n ) 274 | SYS_PARAM_STORE, // ( s i v -- ) 275 | SYS_TIMER_INIT, // ( i -- ) 276 | SYS_TIMER_START, // ( i -- ) 277 | SYS_TIMER_STOP, // ( i -- ) 278 | SYS_TIMER_TIMEOUT, // ( i -- f ) 279 | SYS_TIMER_RUNNING, // ( i -- f ) 280 | SYS_INPUT_FETCH, // ( i k -- n ) 281 | SYS_OUTPUT_STORE, // ( i k n -- ) 282 | SYS_SELECT_TIMER, // ( i -- ) 283 | SYS_DESELECT_TIMER, // ( i -- ) 284 | SYS_SELECT_INPUT, // ( i -- ) 285 | SYS_DESELECT_INPUT, // ( i -- ) 286 | SYS_DESELECT_ALL, // ( -- ) 287 | SYS_UART_CONNECT, // ( mode baud str -- 1 fd | 0 err ) 288 | SYS_UART_SEND, // ( fd tty -- 1 | 0 ) tx character on uart 289 | SYS_UART_RECV, // ( fd -- c ) rx character from uart or -1 290 | SYS_UART_AVAIL, // ( fd -- f ) 1 if char is read 0 otherwise 291 | SYS_UART_DISCONNECT,// ( fd -- f ) disconnet uart 292 | SYS_GPIO_INPUT, // ( i -- ) 293 | SYS_GPIO_OUTPUT, // ( i -- ) 294 | SYS_GPIO_SET, // ( i -- ) 295 | SYS_GPIO_CLR, // ( i -- ) 296 | SYS_GPIO_GET, // ( i -- n ) 297 | SYS_ANALOG_SEND, // ( i u16 -- ) 298 | SYS_ANALOG_RECV, // ( i -- u16 ) 299 | SYS_CAN_CONNECT, // ( mode bitrate dev -- 1 fd | 0 err ) 300 | SYS_CAN_SEND, // ( n fd buf -- 1 n | 0 err ) 301 | SYS_CAN_RECV, // ( fd buf -- 1 n | 0 err ) 302 | SYS_CAN_AVAIL, // ( fd -- f ) 303 | SYS_CAN_DISCONNECT, // ( fd -- 1 | 0 err ) 304 | SYS_FILE_OPEN, // ( mode str -- 1 fd | 0 err ) 305 | SYS_FILE_WRITE, // ( n fd buf -- 1 n | 0 err ) 306 | SYS_FILE_READ, // ( n fd buf -- 1 n | 0 err ) 307 | SYS_FILE_CLOSE, // ( fd -- 1 | 0 err ) 308 | SYS_FILE_SEEK, // ( fd offs whence -- 1 offs | 0 err ) 309 | } syscall_t; 310 | 311 | // LED interface set_led / clr_led 312 | // CAN interface send message 313 | 314 | // INPUT kind (k) 315 | #define INPUT_BOOLEAN 0 316 | #define INPUT_ANALOG 1 317 | #define INPUT_ENCODER 2 318 | 319 | typedef struct _chine_t 320 | { 321 | uint8_t* cIP; 322 | cell_t* cSP; 323 | cell_t* cRP; 324 | cell_t* cFP; // frame pointer 325 | cell_t cErr; // last system error 326 | int (*sys)(struct _chine_t* mp, 327 | cell_t sysop, cell_t* revarg, 328 | cell_t* npop, cell_t* reason); 329 | uint8_t* prog; // program area 330 | cell_t stack[MAX_STACK]; // stack 331 | cell_t mem[MAX_MEM]; // local store 332 | uint8_t imask[NUM_IBYTES]; // input mask 333 | uint8_t tbits[NUM_TBYTES]; // timer running bits 334 | uint8_t tmask[NUM_TBYTES]; // selected timers 335 | timeout_t timer[MAX_TIMERS]; // timers 336 | } chine_t; 337 | 338 | // get argument 339 | // opcode1: I = 01llxxxx 340 | // opcode2: I = 10aaaxxx aaa is signed 3-bit argument 341 | // 342 | static CHINE_INLINE int get_arg_len(uint8_t I) 343 | { 344 | if ((I >> OPSHFT) == OP2) 345 | return 0; 346 | else 347 | return (1 << OP1VAL(I)); 348 | } 349 | 350 | static CHINE_INLINE cell_t load_arg(uint8_t I, uint8_t* ptr) 351 | { 352 | if ((I >> OPSHFT) == OP2) 353 | return OP2VAL(I); 354 | switch(OP1VAL(I)) { 355 | case 0: return INT8(ptr); 356 | case 1: return INT16(ptr); 357 | case 2: return INT32(ptr); 358 | default: return 0; 359 | } 360 | } 361 | 362 | static CHINE_INLINE int get_arg(uint8_t I, uint8_t* ptr, cell_t* argp) 363 | { 364 | if ((I >> OPSHFT) == OP2) { // extract 3 bit signed number 365 | *argp = OP2VAL(I); 366 | return 0; 367 | } 368 | else { // opcode1 369 | switch(OP1VAL(I)) { 370 | case 0: *argp=INT8(ptr); return 1; 371 | case 1: *argp=INT16(ptr); return 2; 372 | case 2: *argp=INT32(ptr); return 4; 373 | default: *argp=0; return 0; 374 | } 375 | } 376 | } 377 | 378 | // Get number of bytes of of array length 379 | // opcode2: I = 10|lll|111 => 0 380 | // opcode1: I = 01|0-|0111 => 1 381 | // opcode1: I = 01|1-|0111 => 2 382 | static CHINE_INLINE int get_array_hlen(uint8_t I) 383 | { 384 | uint8_t H = (I >> 5) & 3; 385 | return H ? (H-1) : 0; 386 | } 387 | 388 | static CHINE_INLINE int get_array_len(uint8_t I, uint8_t* ptr, cell_t* argp) 389 | { 390 | switch(get_array_hlen(I)) { 391 | case 0: *argp = (I>>VAL2SHFT) & VAL2MASK; return 0; 392 | case 1: *argp = UINT8(ptr); return 1; 393 | case 2: *argp = UINT16(ptr); return 2; 394 | default: return 0; 395 | } 396 | } 397 | 398 | // Get number of bytes per array element 399 | // 10|lll|111 => 1 400 | // 01|00|0111 => 1 401 | // 01|01|0111 => 2 402 | // 01|10|0111 => 4 403 | // 01|11|0111 => 8 but is undefined right now! 404 | 405 | static CHINE_INLINE int get_element_len(uint8_t I) 406 | { 407 | if ((I >> OPSHFT) == OP2) 408 | return 1; 409 | else 410 | return (1 << ((I>>VAL1SHFT) & VAL1MASK)); 411 | } 412 | 413 | extern void chine_init(chine_t* mp, uint8_t* prog, 414 | int (*sys)(chine_t* mp, 415 | cell_t sysop, cell_t* revarg, 416 | cell_t* npop, cell_t* reason)); 417 | extern int chine_final(chine_t* mp); 418 | extern int chine_run(chine_t* mp); 419 | 420 | extern void chine_set_ip(chine_t* mp, int offset); 421 | extern int chine_is_top_level(chine_t* mp); 422 | 423 | extern timeout_t chine_millis(void); 424 | extern timeout_t chine_micros(void); 425 | extern int chine_next(chine_t* mp, timeout_t* tmop, uint8_t* imask); 426 | extern int chine_nextv(chine_t** mpv, size_t n, 427 | timeout_t* tmop, uint8_t* imask); 428 | 429 | #ifdef __cplusplus 430 | } 431 | #endif 432 | 433 | #endif 434 | -------------------------------------------------------------------------------- /include/chine.hrl: -------------------------------------------------------------------------------- 1 | -ifndef(__CHINE_HRL__). 2 | -define(__CHINE_HRL__, true). 3 | 4 | -define(FILE_VERSION, 16#01010000). 5 | 6 | -define(OPCODE0(OP), <<0:2, (OP):6>>). 7 | %% L = 0 (1 byte arg) 1 = (2 byte arg) 2 = (4 bytes arg) 8 | -define(OPCODE1(JOP,L), <<1:2, (L):2, (JOP):4>>). 9 | %% A is a 3 bit signed integer 10 | -define(OPCODE2(JOP,A), <<2:2, (A):3, (JOP):3>>). 11 | %% Combine opcode1 and opcode2 (in range 0..7) into one byte 12 | -define(OPCODE3(OP1,OP2), <<3:2, (OP2):3, (OP1):3>>). 13 | 14 | -define(CHINE_TRUE, -1). 15 | -define(CHINE_FALSE, 0). 16 | 17 | -record(jopcode, 18 | { 19 | %% OPCODE1 and OPCODE2 20 | jmpz, %% (TOP == 0) 21 | jmpnz, %% (TOP != 0) 22 | next, %% (--RP[0]<0) 23 | jmplz, %% (TOP < 0) 24 | jmp, 25 | call, 26 | literal, 27 | array, 28 | %% OPCODE1 only 29 | arg 30 | }). 31 | 32 | -define(JOP(X), (#jopcode.X-2)). 33 | -define(JENUM(X), X => (#jopcode.X-2)). 34 | 35 | -record(opcode, 36 | { 37 | dup, 38 | rot, 39 | over, 40 | drop, 41 | swap, 42 | '-', 43 | '+', 44 | '*', 45 | %% op6 46 | 'nop', 47 | 'and', 48 | 'or', 49 | 'xor', 50 | '0=', 51 | '0<', 52 | 'not', 53 | '_op_15', 54 | negate, 55 | '/', 56 | shift, 57 | '!', 58 | '@', 59 | '>r', 60 | 'r>', 61 | 'r@', 62 | exit, 63 | sys, 64 | yield, 65 | '[]', 66 | execute, 67 | 'fp@', 68 | 'fp!', 69 | 'sp@', 70 | 'sp!' 71 | }). 72 | -define(OP(X), ((#opcode.X)-2)). 73 | -define(ENUM(X), X => ((#opcode.X)-2)). 74 | 75 | 76 | %% Failure codes 77 | -define(FAIL_STACK_OVERFLOW, -1). 78 | -define(FAIL_STACK_UNDERFLOW, -2). 79 | -define(FAIL_RSTACK_OVERFLOW, -3). 80 | -define(FAIL_RSTACK_UNDERFLOW, -4). 81 | -define(FAIL_DIV_ZERO, -5). 82 | -define(FAIL_TIMER_OVERFLOW, -6). 83 | -define(FAIL_MEMORY_OVERFLOW, -7). 84 | 85 | -record(sys, 86 | { 87 | sys_init, 88 | sys_terminate, 89 | sys_now, 90 | sys_emit, 91 | sys_recv, 92 | sys_avail, 93 | sys_param_fetch, 94 | sys_param_store, 95 | sys_timer_init, 96 | sys_timer_start, 97 | sys_timer_stop, 98 | sys_timer_timeout, 99 | sys_timer_running, 100 | sys_input_fetch, 101 | sys_output_store, 102 | sys_select_timer, 103 | sys_deselect_timer, 104 | sys_select_input, 105 | sys_deselect_input, 106 | sys_deselect_all, 107 | sys_uart_connect, 108 | sys_uart_send, 109 | sys_uart_recv, 110 | sys_uart_avail, 111 | sys_uart_disconnect, 112 | sys_gpio_input, 113 | sys_gpio_output, 114 | sys_gpio_set, 115 | sys_gpio_clr, 116 | sys_gpio_get, 117 | sys_analog_send, 118 | sys_analog_recv, 119 | sys_can_connect, 120 | sys_can_send, 121 | sys_can_recv, 122 | sys_can_avail, 123 | sys_can_disconnect, 124 | sys_file_open, 125 | sys_file_write, 126 | sys_file_read, 127 | sys_file_close, 128 | sys_file_seek 129 | }). 130 | -define(SYS(N), (#sys.X-2)). 131 | -define(SENUM(X), X => (#sys.X-2)). 132 | 133 | %% INPUT kind (k) 134 | -define(INPUT_BOOLEAN, 0). 135 | -define(INPUT_ANALOG, 1). 136 | -define(INPUT_ENCODER, 2). 137 | 138 | -endif. 139 | -------------------------------------------------------------------------------- /priv/.gitignore: -------------------------------------------------------------------------------- 1 | *.so 2 | -------------------------------------------------------------------------------- /priv/chine_exec.Darwin-x86_64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tonyrog/chine/9ac2a1ec4dba9b215cb7e5335a10135d940fa9e9/priv/chine_exec.Darwin-x86_64 -------------------------------------------------------------------------------- /priv/chine_exec.Linux-armv7l: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tonyrog/chine/9ac2a1ec4dba9b215cb7e5335a10135d940fa9e9/priv/chine_exec.Linux-armv7l -------------------------------------------------------------------------------- /priv/chine_exec.Linux-x86_64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tonyrog/chine/9ac2a1ec4dba9b215cb7e5335a10135d940fa9e9/priv/chine_exec.Linux-x86_64 -------------------------------------------------------------------------------- /priv/chine_exec.Windows-x86_64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tonyrog/chine/9ac2a1ec4dba9b215cb7e5335a10135d940fa9e9/priv/chine_exec.Windows-x86_64 -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tonyrog/chine/9ac2a1ec4dba9b215cb7e5335a10135d940fa9e9/rebar.config -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | #@BEGIN-APP-DEFAULT-RULES@ 2 | APP=$(shell basename `cd ..; pwd`) 3 | ERLC="$(shell which erlc)" 4 | ERLC_FLAGS=-MMD -MP -MF .$<.d -I ../.. +debug_info 5 | YRL_SRC=$(wildcard *.yrl) 6 | XRL_SRC=$(wildcard *.xrl) 7 | ERL_SOURCES=$(wildcard *.erl) $(YRL_SRC:%.yrl=%.erl) $(XRL_SRC:%.xrl=%.erl) 8 | ERL_OBJECTS=$(ERL_SOURCES:%.erl=../ebin/%.beam) 9 | ALL_OBJECTS=$(ERL_OBJECTS) 10 | ERL_MODULES=$(ERL_SOURCES:%.erl=%) 11 | comma=, 12 | empty= 13 | space = $(empty) $(empty) 14 | MODULES=$(subst $(space),$(comma),$(ERL_MODULES)) 15 | VERSION=$(shell git describe --always --tags) 16 | APP_SRC=$(APP).app.src 17 | APP_TARGET=../ebin/$(APP).app 18 | 19 | .PRECIOUS: $(YRL_SRC:%.yrl=%.erl) $(XRL_SRC:%.xrl=%.erl) 20 | 21 | all: $(APP_TARGET) $(ALL_OBJECTS) 22 | 23 | clean: 24 | rm -f $(ALL_OBJECTS) *.core .*.d 25 | 26 | ../ebin/%.beam: %.erl 27 | $(ERLC) $(ERLC_FLAGS) -o ../ebin $< 28 | 29 | %.erl: %.yrl 30 | $(ERLC) $< 31 | 32 | %.erl: %.xrl 33 | $(ERLC) $< 34 | 35 | $(APP_TARGET): $(APP_SRC) 36 | sed -e 's;{vsn,.*git};{vsn,"$(VERSION)"};' -e 's;"@@MODULES@@";$(MODULES);' $(APP_SRC) > $(APP_TARGET) 37 | 38 | .%.d: ; 39 | 40 | -include .*.d 41 | #@END-APP-DEFAULT-RULES@ 42 | -------------------------------------------------------------------------------- /src/chine.app.src: -------------------------------------------------------------------------------- 1 | {application, chine, 2 | [{description, "Tiny stack machine assembler"}, 3 | {vsn, git}, 4 | {modules, ["@@MODULES@@"]}, 5 | {registered, []}, 6 | {env, []}, 7 | {applications,[kernel,stdlib,getopt]} 8 | ]}. 9 | -------------------------------------------------------------------------------- /src/chine.erl: -------------------------------------------------------------------------------- 1 | %%% @author Tony Rogvall 2 | %%% @copyright (C) 2016, Tony Rogvall 3 | %%% @doc 4 | %%% Compile & Assemble chine code 5 | %%% @end 6 | %%% Created : 25 Dec 2016 by Tony Rogvall 7 | 8 | -module(chine). 9 | 10 | -export([start/0, start/1]). 11 | 12 | -export([effect/1, minmax_depth/1]). 13 | -export([print_stack_effect/2]). 14 | -export([opcodes/0, syscalls/0]). 15 | 16 | -include("../include/chine.hrl"). 17 | 18 | -ifdef(OTP_RELEASE). %% this implies 21 or higher 19 | -define(EXCEPTION(Class, Reason, Stacktrace), Class:Reason:Stacktrace). 20 | -define(GET_STACK(Stacktrace), Stacktrace). 21 | -else. 22 | -define(EXCEPTION(Class, Reason, _), Class:Reason). 23 | -define(GET_STACK(_), erlang:get_stacktrace()). 24 | -endif. 25 | 26 | -define(PROG, "chine"). 27 | 28 | options() -> 29 | [ 30 | #{ 31 | key => format, 32 | long => "format", 33 | short => "f", 34 | type => atom, %% binary or c 35 | default => binary, 36 | description => "Output file format" 37 | }, 38 | 39 | #{ key => debug, 40 | long => "debug", 41 | short => "d", 42 | type => boolean, 43 | default => false, 44 | description => "Show debug information"}, 45 | 46 | #{ key => execute, 47 | long => "execute", 48 | short => "x", 49 | type => boolean, 50 | default => false, 51 | description => "Execute compile code" 52 | }, 53 | 54 | #{ key => output, 55 | long => "output-file", 56 | short => "o", 57 | type => string, 58 | default => "", 59 | description => "Output file name" 60 | }, 61 | 62 | #{ key => version, 63 | long => "version", 64 | short => "v", 65 | type => boolean, 66 | default => false, 67 | description => "Display application version" 68 | }, 69 | 70 | #{ key => help, 71 | long => "help", 72 | short => "h", 73 | type => boolean, 74 | default => false, 75 | description => "This help" 76 | } 77 | ]. 78 | 79 | start() -> 80 | start([]). 81 | 82 | start(Args) -> 83 | application:load(chine), 84 | case chine_opt:parse(options(),Args) of 85 | {ok,{Opts,Files}} -> 86 | case chine_opt:value(version, Opts) of 87 | true -> 88 | do_version(), 89 | halt(0); 90 | false -> 91 | ok 92 | end, 93 | case chine_opt:value(help,Opts) of 94 | true -> 95 | chine_opt:usage(options(),?PROG), 96 | halt(0); 97 | false -> 98 | do_input(Files, Opts) 99 | end; 100 | {error,Error} -> 101 | io:format(standard_error, "~s\n", 102 | [chine_opt:format_error(options(),?PROG,Error)]), 103 | chine_opt:usage(options(), ?PROG), 104 | halt(1) 105 | end. 106 | 107 | do_version() -> 108 | case application:get_key(?MODULE, vsn) of 109 | {ok,Vsn} -> 110 | io:format("~s version ~s\n", [?MODULE, Vsn]); 111 | _ -> 112 | io:format("no version available\n", []) 113 | end. 114 | 115 | do_input([File], Opts) -> 116 | case file:consult(File) of 117 | {ok,Ls0} -> 118 | Ls = lists:flatten(Ls0), 119 | try asm_list(Ls,Opts) of 120 | AsmResult -> 121 | do_emit(AsmResult, Opts) 122 | catch 123 | ?EXCEPTION(error,Reason,StackTrace) -> 124 | io:format(standard_error, "~s:error: ~p\n~p", 125 | [?PROG, Reason, 126 | ?GET_STACK(StackTrace) 127 | ]), 128 | halt(1) 129 | end; 130 | {error,Reason} -> 131 | io:format(standard_error, 132 | "~s:error: ~p\n", 133 | [?PROG, Reason]), 134 | halt(1) 135 | end; 136 | do_input([], _Opts) -> 137 | io:format("~s:error: missing input file\n", [?PROG]), 138 | halt(1). 139 | 140 | do_emit({Bin,Symbols,Labels}, Opts) -> 141 | Format = chine_opt:value(format,Opts), 142 | SymTab = symbol_table(Symbols,Labels), 143 | %% io:format("SymTab = ~p\n", [SymTab]), 144 | Output = 145 | case Format of 146 | binary -> 147 | SymbolEntries = 148 | [begin 149 | BinValue = encode_symbol_value(Value), 150 | LenValue = byte_size(BinValue), 151 | [length(Sym),Sym,LenValue,BinValue] 152 | end || {Sym,Value} <- SymTab], 153 | SymbolTableBin = list_to_binary(SymbolEntries), 154 | {File0,_Length} = file_sections(SymbolTableBin,0,Bin), 155 | CRC = erlang:crc32(File0), 156 | %% io:format("CRC = ~w, Len=~w\n", [CRC,Length]), 157 | {File1,_} = file_sections(SymbolTableBin,CRC,Bin), 158 | File1; 159 | c -> 160 | [[begin 161 | ["#define SYM_",Sym," ",integer_to_list(Value),"\n"] 162 | end || {Sym,Value} <- SymTab], 163 | io_lib:format("// program size=~w, sha=~s\n", 164 | [byte_size(Bin),hex(crypto:hash(sha,Bin))]), 165 | io_lib:format("unsigned char prog[] = {\n ~s };\n", 166 | [cformat(Bin,1)])] 167 | end, 168 | case chine_opt:value(output, Opts) of 169 | "" -> 170 | file:write(user,Output), 171 | halt(0); 172 | File -> 173 | case file:write_file(File, Output) of 174 | ok -> 175 | case chine_opt:value(execute, Opts) of 176 | true -> 177 | Exec = filename:join([code:lib_dir(chine), 178 | "bin","chine_exec"]), 179 | Res = os:cmd(Exec ++ " " ++ File), 180 | io:format("~s", [Res]), 181 | halt(0); 182 | false -> 183 | halt(0) 184 | end; 185 | {error,Reason} -> 186 | io:format(standard_error, "~s:error: ~p\n", 187 | [?PROG, Reason]), 188 | halt(1) 189 | end 190 | end. 191 | 192 | 193 | cformat(<<>>,_I) -> 194 | []; 195 | cformat(<>,_I) -> 196 | [io_lib:format("0x~2.16.0b",[C])]; 197 | cformat(<>,I) -> 198 | [io_lib:format("0x~2.16.0b,",[C]), 199 | if I rem 12 =:= 0 -> "\n "; true -> "" end | cformat(Cs,I+1)]. 200 | 201 | hex(Bin) -> 202 | [ element(I+1,{$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$a,$b,$c,$d,$e,$f}) 203 | || <> <= Bin]. 204 | 205 | file_sections(SymbolTable,CRC,Content) -> 206 | SymbolTableLen = byte_size(SymbolTable), 207 | ContentLen = byte_size(Content), 208 | Length = 4 + 4 + SymbolTableLen + 4 + 4 + ContentLen, 209 | {[$C,$H,$I,$N, 210 | <>, 211 | <>, 212 | <>, 213 | $S,$Y,$M,$B, 214 | <>, 215 | SymbolTable, 216 | $C,$O,$D,$E, 217 | <>, 218 | Content], Length}. 219 | 220 | symbol_table(Symbols, Labels) -> 221 | %% io:format("Symbols = ~p, labels = ~p\n",[Symbols, Labels]), 222 | lists:foldl( 223 | fun(L, Acc) -> 224 | case maps:find(L, Labels) of 225 | error -> 226 | io:format(standard_error, 227 | "warning: exported label ~s not found\n", [L]), 228 | Acc; 229 | {ok,[Addr]} -> 230 | [{encode_symbol_name(L), Addr}|Acc] 231 | end 232 | end, [], [L || {{export,L},_} <- maps:to_list(Symbols)]). 233 | 234 | encode_symbol_value(Value) when Value >= 0 -> 235 | if Value < -16#8000; Value > 16#7fff -> <>; 236 | Value < -16#80; Value > 16#7f -> <>; 237 | true -> <> 238 | end. 239 | 240 | encode_symbol_name(Name) -> 241 | binary_to_list(iolist_to_binary(Name)). 242 | 243 | asm_list(Code,Opts) -> 244 | {Code1,Symbols} = expand_synthetic(Code,Opts), 245 | debugf(Opts, "pass: synthetic ~p\n", [Code1]), 246 | Code2 = encode_const(Code1,Opts), 247 | debugf(Opts, "pass: const ~p\n", [Code2]), 248 | Code3 = collect_blocks(Code2,Opts), 249 | debugf(Opts, "pass: collect ~p\n", [Code3]), 250 | {Code4,Labels} = resolve_labels(Code3,Opts), 251 | debugf(Opts, "pass: resolved ~p\n", [Code4]), 252 | Code5 = disperse_blocks(Code4,Opts), 253 | debugf(Opts, "pass: disperse ~p\n", [Code5]), 254 | Code6 = encode_opcodes(Code5,Opts), 255 | {Code6,Symbols,Labels}. 256 | 257 | debugf(Opts,Fmt,As) -> 258 | case chine_opt:value(debug, Opts) of 259 | true -> 260 | io:format(standard_error, Fmt, As); 261 | false -> 262 | ok 263 | end. 264 | 265 | %% on input a jump should look like {jmp,L} where L is a label 266 | %% first pass transform all jumps into generic form {{jop,jmp},L} 267 | %% later pass will determin the jump offset size K {{jop,jmp,K},L} 268 | %% where K=0,1,2,4 269 | 270 | jopcodes() -> 271 | #{ 272 | ?JENUM(jmpz), 273 | ?JENUM(jmpnz), 274 | ?JENUM(next), 275 | ?JENUM(jmplz), 276 | ?JENUM(jmp), 277 | ?JENUM(call), 278 | ?JENUM(literal), 279 | ?JENUM(array), 280 | %% opcode1 281 | ?JENUM(arg) 282 | }. 283 | 284 | opcodes() -> 285 | #{ 286 | ?ENUM(dup), 287 | ?ENUM(rot), 288 | ?ENUM(over), 289 | ?ENUM(drop), 290 | ?ENUM(swap), 291 | ?ENUM('-'), 292 | ?ENUM('+'), 293 | ?ENUM('*'), 294 | %% op6 295 | ?ENUM('nop'), 296 | ?ENUM('and'), 297 | ?ENUM('or'), 298 | ?ENUM('xor'), 299 | ?ENUM('0='), 300 | ?ENUM('0<'), 301 | ?ENUM('not'), 302 | ?ENUM(negate), 303 | ?ENUM('/'), 304 | ?ENUM(shift), 305 | ?ENUM('!'), 306 | ?ENUM('@'), 307 | ?ENUM('>r'), 308 | ?ENUM('r>'), 309 | ?ENUM('r@'), 310 | ?ENUM(exit), 311 | ?ENUM(sys), 312 | ?ENUM(yield), 313 | ?ENUM('[]'), 314 | ?ENUM('execute'), 315 | ?ENUM('fp@'), 316 | ?ENUM('fp!'), 317 | ?ENUM('sp@'), 318 | ?ENUM('sp!') 319 | }. 320 | 321 | syscalls() -> 322 | #{ 323 | ?SENUM(sys_init), 324 | ?SENUM(sys_terminate), 325 | ?SENUM(sys_now), 326 | ?SENUM(sys_emit), 327 | ?SENUM(sys_recv), 328 | ?SENUM(sys_avail), 329 | ?SENUM(sys_param_fetch), 330 | ?SENUM(sys_param_store), 331 | ?SENUM(sys_timer_init), 332 | ?SENUM(sys_timer_start), 333 | ?SENUM(sys_timer_stop), 334 | ?SENUM(sys_timer_timeout), 335 | ?SENUM(sys_timer_running), 336 | ?SENUM(sys_input_fetch), 337 | ?SENUM(sys_output_store), 338 | ?SENUM(sys_select_timer), 339 | ?SENUM(sys_deselect_timer), 340 | ?SENUM(sys_select_input), 341 | ?SENUM(sys_deselect_input), 342 | ?SENUM(sys_deselect_all), 343 | ?SENUM(sys_uart_connect), 344 | ?SENUM(sys_uart_send), 345 | ?SENUM(sys_uart_recv), 346 | ?SENUM(sys_uart_avail), 347 | ?SENUM(sys_uart_disconnect), 348 | ?SENUM(sys_gpio_input), 349 | ?SENUM(sys_gpio_output), 350 | ?SENUM(sys_gpio_set), 351 | ?SENUM(sys_gpio_clr), 352 | ?SENUM(sys_analog_send), 353 | ?SENUM(sys_analog_recv), 354 | ?SENUM(sys_can_connect), 355 | ?SENUM(sys_can_send), 356 | ?SENUM(sys_can_recv), 357 | ?SENUM(sys_can_avail), 358 | ?SENUM(sys_can_disconnect), 359 | ?SENUM(sys_file_open), 360 | ?SENUM(sys_file_write), 361 | ?SENUM(sys_file_read), 362 | ?SENUM(sys_file_close), 363 | ?SENUM(sys_file_seek) 364 | }. 365 | 366 | %% not real opcodes, they are expanded like macros 367 | %% some may be expanded like calls instead?! 368 | synthetic_opcodes() -> 369 | #{ 370 | '1+' => [{const,1},'+'], 371 | '1-' => [{const,1},'-'], 372 | 'lshift' => [shift], 373 | 'rshift' => [negate,shift], 374 | '<' => ['-', '0<'], 375 | '>' => [swap, '-', '0<'], 376 | '<=' => ['-', '0<='], 377 | '>=' => [swap,'-', '0<='], 378 | '=' => ['-', '0='], 379 | '<>' => ['-', 'not'], 380 | 'u<' => ['2dup','xor','0<', 381 | {'if',[swap,drop,'0<'],['-','0<']}], 382 | 'u<=' => ['2dup','xor','0<', 383 | {'if',[swap,drop,'0<'],['-','0<=']}], 384 | 'u>' => [swap, 'u<'], 385 | 'u>=' => [swap, 'u<='], 386 | '0<>' => ['0=', 'not'], 387 | '0>' => [{const,0},'>'], 388 | '0<=' => [{const,1},'-','0<'], 389 | 'abs' => [dup,'0<',{'if',[negate]}], 390 | 'min' => [over,over,'<',{'if',[drop],[swap,drop]}], 391 | 'max' => [over,over,'<',{'if',[swap,drop],[drop]}], 392 | 'nip' => [swap,drop], 393 | 'tuck' => [swap,over], 394 | '-rot' => [rot,rot], 395 | '2drop' => [drop,drop], 396 | '2dup' => [over,over], 397 | '2*' => [dup,'+'], 398 | 'arshift' => [dup,{const,32},swap,'-', 399 | {const,-1},swap,shift, 400 | '-rot', negate,shift, 'or'], 401 | '2/' => [{const,1},arshift], 402 | 'sqr' => [dup,'*'], 403 | 'mod' => ['2dup','/','*','-'], 404 | 'jmp*' => ['>r', exit], %% ( caddr -- ) 405 | ';' => [exit], 406 | 407 | 'fenter' => ['fp@','>r','sp@','fp!'], 408 | 'fleave' => ['fp@','r>','fp!','sp!'], 409 | 410 | %% utils 411 | 'setbit' => [{const,1},swap,shift,'or'], 412 | 'clrbit' => [{const,1},swap,shift,'not','and'], 413 | 'togglebit' => [{const,1},swap,shift,'xor'], 414 | 'tstbit' => [{const,1},swap,shift,'and'], 415 | 'setclrbit' => [{'if',[setbit],[clrbit]}], 416 | 417 | %% sys interface 418 | terminate => [{sys,sys_terminate}], 419 | now => [{sys,sys_now}], 420 | emit => [{sys,sys_emit}], 421 | key => [{sys,sys_recv}], 422 | '?key' => [{sys,sys_avail}], 423 | 'param@' => [{sys,sys_param_fetch}], 424 | 'param!' => [{sys,sys_param_store}], 425 | %% TIMERS 426 | timer_init => [{sys,sys_timer_init}], 427 | timer_start => [{sys,sys_timer_start}], 428 | timer_stop => [{sys,sys_timer_stop}], 429 | timer_timeout => [{sys,sys_timer_timeout}], 430 | timer_running => [{sys,sys_timer_running}], 431 | 'input@' => [{sys,sys_input_fetch}], 432 | 'output!' => [{sys,sys_output_store}], 433 | select_timer => [{sys,sys_select_timer}], 434 | deselect_timer => [{sys,sys_deselect_timer}], 435 | %% INPUT 436 | select_input => [{sys,sys_select_input}], 437 | deselect_input => [{sys,sys_deselect_input}], 438 | deselect_all => [{sys,sys_deselect_all}], 439 | %% UART 440 | uart_connect => [{sys,sys_uart_connect}], 441 | uart_send => [{sys,sys_uart_send}], 442 | uart_recv => [{sys,sys_uart_recv}], 443 | uart_avail => [{sys,sys_uart_avail}], 444 | uart_disconnect => [{sys,sys_uart_disconnect}], 445 | %% GPIO 446 | gpio_input => [{sys,sys_gpio_input}], 447 | gpio_output => [{sys,sys_gpio_output}], 448 | gpio_set => [{sys,sys_gpio_set}], 449 | gpio_clr => [{sys,sys_gpio_clr}], 450 | gpio_get => [{sys,sys_gpio_get}], 451 | gpio_mask => [{sys,sys_gpio_mask}], 452 | %% ANALOG 453 | analog_set => [{sys,sys_analog_set}], 454 | analog_clr => [{sys,sys_analog_clr}], 455 | %% CAN 456 | can_connect => [{sys,sys_can_connect}], 457 | can_send => [{sys,sys_can_send}], 458 | can_recv => [{sys,sys_can_recv}], 459 | can_avail => [{sys,sys_can_avail}], 460 | can_disconnect => [{sys,sys_can_disconnect}], 461 | %% FILE 462 | file_open => [{sys,sys_file_open}], 463 | file_write => [{sys,sys_file_write}], 464 | file_read => [{sys,sys_file_read}], 465 | file_close => [{sys,sys_file_close}], 466 | file_seek => [{sys,sys_file_seek}] 467 | }. 468 | 469 | expand_synthetic(Code,_Opts) -> 470 | expand_synth_(Code,[],#{}). 471 | 472 | expand_synth_([{'if',Then}|Code],Acc,Sym) -> 473 | L = new_label(), 474 | Block = [{{jop,jmpz},L},Then,{label,L}], 475 | expand_synth_(Block ++ Code,Acc,Sym); 476 | expand_synth_([{'if',Then,Else}|Code],Acc,Sym) -> 477 | L0 = new_label(), 478 | L1 = new_label(), 479 | Block = [{{jop,jmpz},L0},Then,{{jop,jmp},L1}, 480 | {label,L0},Else,{label,L1}], 481 | expand_synth_(Block++Code,Acc,Sym); 482 | expand_synth_([{'again',Loop}|Code],Acc,Sym) -> 483 | L0 = new_label(), 484 | Block = [{label,L0},Loop,{{jop,jmp},L0}], 485 | expand_synth_(Block++Code,Acc,Sym); 486 | expand_synth_([{'until',Loop}|Code],Acc,Sym) -> 487 | L0 = new_label(), 488 | Block = [{label,L0},Loop,{{jop,jmpz},L0}], 489 | expand_synth_(Block++Code,Acc,Sym); 490 | expand_synth_([{'repeat',While,Loop}|Code],Acc,Sym) -> 491 | L0 = new_label(), 492 | L1 = new_label(), 493 | Block = [{label,L0},While,{{jop,jmpz},L1}, 494 | Loop,{{jop,jmp},L0},{label,L1}], 495 | expand_synth_(Block++Code,Acc,Sym); 496 | expand_synth_([{'for',Loop}|Code],Acc,Sym) -> 497 | L0 = new_label(), 498 | Block = ['>r', {label,L0},Loop,{{jop,next},L0}], 499 | expand_synth_(Block++Code,Acc,Sym); 500 | expand_synth_([{enum,Ls}|Code],Acc,Sym) -> 501 | Sym1 = add_enums_(Ls, 0, Sym), 502 | expand_synth_(Code,Acc,Sym1); 503 | expand_synth_([{define,Name,Value}|Code],Acc,Sym) -> 504 | Sym1 = maps:put({symbol,Name},Value,Sym), 505 | expand_synth_(Code, Acc, Sym1); 506 | expand_synth_([{comment,_Comment}|Code],Acc,Sym) -> 507 | %% just a comment ignore it 508 | expand_synth_(Code,Acc,Sym); 509 | expand_synth_([{Jop,L}|Code],Acc,Sym) when 510 | Jop =:= jmpz; Jop =:= jmpnz; 511 | Jop =:= next; Jop =:= jmplz; 512 | Jop =:= jmp; Jop =:= call -> 513 | L1 = normalize_label(L), 514 | expand_synth_(Code,[{{jop,Jop},L1}|Acc], Sym); 515 | expand_synth_([Op={const,C}|Code],Acc,Sym) when is_integer(C) -> 516 | expand_synth_(Code,[Op|Acc],Sym); 517 | expand_synth_([{const,Name}|Code],Acc,Sym) -> 518 | case maps:find({symbol,Name}, Sym) of 519 | {ok,C} -> 520 | expand_synth_(Code,[{const,C}|Acc],Sym); 521 | error -> 522 | io:format(standard_error, "error: symbol ~p not defined\n",[Name]), 523 | expand_synth_(Code,[{const,Name} | Acc],Sym) 524 | end; 525 | expand_synth_([Op={arg,I}|Code],Acc,Sym) when is_integer(I) -> 526 | expand_synth_(Code,[Op|Acc],Sym); 527 | expand_synth_([{arg,Name}|Code],Acc,Sym) -> 528 | case maps:find({symbol,Name}, Sym) of 529 | {ok,I} -> 530 | expand_synth_(Code,[{arg,I}|Acc],Sym); 531 | error -> 532 | io:format(standard_error, "error: symbol ~p not defined\n",[Name]), 533 | expand_synth_(Code,[{arg,Name} | Acc],Sym) 534 | end; 535 | expand_synth_([{export,L}|Code],Acc,Sym) -> 536 | L1 = normalize_label(L), 537 | Sym1 = maps:put({export,L1}, 0, Sym), 538 | expand_synth_(Code,Acc,Sym1); 539 | expand_synth_([{label,L}|Code],Acc,Sym) -> 540 | L1 = normalize_label(L), 541 | expand_synth_(Code,[{label,L1}|Acc],Sym); 542 | expand_synth_([Op|Code],Acc,Sym) when is_tuple(Op) -> 543 | expand_synth_(Code,[Op|Acc],Sym); 544 | expand_synth_([Op|Code],Acc,Sym) when is_atom(Op) -> 545 | Map = synthetic_opcodes(), 546 | case maps:find(Op,Map) of 547 | error -> 548 | expand_synth_(Code,[Op|Acc],Sym); 549 | {ok,Ops} when is_list(Ops) -> 550 | expand_synth_(Ops++Code,Acc,Sym) 551 | end; 552 | expand_synth_([Op|Code],Acc,Sym) when is_integer(Op) -> 553 | expand_synth_(Code,[{const,Op}|Acc],Sym); 554 | expand_synth_([[]|Code],Acc,Sym) -> 555 | expand_synth_(Code,Acc,Sym); 556 | expand_synth_([Ops|Code],Acc,Sym) when is_list(Ops) -> 557 | try erlang:iolist_to_binary(Ops) of 558 | Bin -> 559 | expand_synth_(Code,[{string,binary_to_list(Bin)}|Acc],Sym) 560 | catch 561 | error:_ -> 562 | expand_synth_(Ops++Code,Acc,Sym) 563 | end; 564 | expand_synth_([],Acc,Sym) -> 565 | {lists:reverse(Acc),Sym}. 566 | 567 | add_enums_([E|Es], I, Sym) -> 568 | Sym1 = maps:put({symbol,E}, I, Sym), 569 | add_enums_(Es, I+1, Sym1); 570 | add_enums_([], _I, Sym) -> 571 | Sym. 572 | 573 | normalize_label(L) when is_atom(L) -> 574 | atom_to_list(L); 575 | normalize_label(L) when is_list(L) -> 576 | try iolist_size(L) of 577 | Len when Len < 256 -> L; 578 | _ -> 579 | io:format(standard_error, "label name too long ~s\n", [L]), 580 | erlang:error({label_too_loong, L}) 581 | catch 582 | error:_ -> 583 | io:format(standard_error, "label name not string ~p\n", [L]), 584 | erlang:error({label_not_string, L}) 585 | end. 586 | 587 | %% 588 | %% Replace branch labels with offsets 589 | %% iterate until all labels are resolved 590 | %% 591 | resolve_labels(Code,Opts) -> 592 | debugf(Opts,"RESOLVE = ~w\n", [Code]), 593 | {AddrMap,Code1} = map_labels(Code), 594 | case resolve_3_addr(Code1,AddrMap) of 595 | {true,Code2} -> 596 | resolve_labels(Code2,Opts); 597 | {false,Code2} -> 598 | case resolve_8_addr(Code2,AddrMap) of 599 | {true,Code3} -> 600 | resolve_labels(Code3,Opts); 601 | {false,Code3} -> 602 | case resolve_16_addr(Code3,AddrMap) of 603 | {true,Code4} -> 604 | resolve_labels(Code4,Opts); 605 | {false,Code4} -> 606 | Code5 = resolve_32_addr(Code4), 607 | debugf(Opts, "RESOLVE FAR = ~w\n", [Code5]), 608 | {AddrMap1,Code6} = map_labels(Code5), 609 | resolve_labels_(Code6, [], AddrMap1, 0) 610 | end 611 | end 612 | end. 613 | 614 | %% 615 | %% Set the correct offsets when all jumps are determined 616 | %% 617 | resolve_labels_([{{jop,JOP,Kv},L}|Code], Acc, Map, Addr) -> 618 | K = variant_length(Kv), 619 | [Target] = maps:get(L, Map), 620 | Offset = Target - (Addr+K+1), 621 | resolve_labels_(Code, [{{jop,JOP,Kv},Offset}|Acc], Map, Addr+K+1); 622 | resolve_labels_([{label,_L}|Code], Acc, Map, Addr) -> 623 | %% drop label, it is not used any more 624 | resolve_labels_(Code, Acc, Map, Addr); 625 | resolve_labels_([{block,N,Block}|Code], Acc, Map, Addr) -> 626 | Block1 = resolve_caddr(Block, [], Map), 627 | resolve_labels_(Code, [{block,N,Block1}|Acc], Map, Addr+N); 628 | resolve_labels_([], Acc, Map, _Addr) -> 629 | {lists:reverse(Acc), Map}. 630 | 631 | %% resolve absolute addresses 632 | resolve_caddr([{caddr,K,L}|Code], Acc, Map) -> 633 | [Target] = maps:get(L, Map), 634 | resolve_caddr(Code, [{literal,K,Target}|Acc], Map); 635 | 636 | resolve_caddr([{array,Ka,Es}|Code], Acc, Map) -> 637 | Es1 = [ case E of 638 | {literal,_,_} -> E; 639 | {caddr,K,L} -> 640 | [Target] = maps:get(L, Map), 641 | {literal,K,Target} 642 | end || E <- Es], 643 | resolve_caddr(Code, [{array,Ka,Es1}|Acc], Map); 644 | resolve_caddr([Op|Code], Acc, Map) -> 645 | resolve_caddr(Code, [Op|Acc], Map); 646 | resolve_caddr([], Acc, _Map) -> 647 | lists:reverse(Acc). 648 | 649 | %% 650 | %% Locate guaranteed tiny jumps 651 | %% 652 | resolve_3_addr(Code,Map) -> 653 | resolve_3_addr_(Code, [], Map, [0], false). 654 | 655 | resolve_3_addr_([Op={{jop,Jop},L}|Code],Acc,Map,Addr,Res) -> 656 | Addr1 = add_addr([1,2,3,5], Addr), 657 | Target = maps:get(L, Map), 658 | Offset = sub_addr(Target, Addr1), 659 | %% if all offsets are short then we select short 660 | case is_3_addr(Offset) of 661 | true -> 662 | resolve_3_addr_(Code, [{{jop,Jop,int3},L}|Acc],Map, 663 | add_addr(1,Addr),true); 664 | false -> 665 | resolve_3_addr_(Code, [Op|Acc],Map,Addr1,Res) 666 | end; 667 | resolve_3_addr_([Op={block,N,_Block}|Code], Acc, LabelMap, Addr,Res) -> 668 | resolve_3_addr_(Code, [Op|Acc], LabelMap, add_addr(N,Addr),Res); 669 | resolve_3_addr_([Op={label,_}|Code], Acc, Map, Addr, Res) -> 670 | resolve_3_addr_(Code, [Op|Acc], Map, Addr, Res); 671 | resolve_3_addr_([Op|Code],Acc,Map,Addr,Res) -> 672 | Len = opcode_length(Op), 673 | resolve_3_addr_(Code, [Op|Acc], Map, add_addr(Len, Addr),Res); 674 | resolve_3_addr_([], Acc, _LabelMap, _Addr,Res) -> 675 | {Res,lists:reverse(Acc)}. 676 | 677 | %% 678 | %% Locate guaranteed near (8-bit) jumps 679 | %% 680 | resolve_8_addr(Code,Map) -> 681 | resolve_8_addr_(Code, [], Map, [0], false). 682 | 683 | resolve_8_addr_([Op={{jop,Jop},L}|Code],Acc,Map,Addr,Res) -> 684 | Addr1 = add_addr([2,3,5], Addr), 685 | Target = maps:get(L, Map), 686 | Offset = sub_addr(Target, Addr1), 687 | case is_8_addr(Offset) of 688 | true -> 689 | resolve_8_addr_(Code, [{{jop,Jop,int8},L}|Acc],Map, 690 | add_addr(2,Addr),true); 691 | false -> 692 | resolve_8_addr_(Code, [Op|Acc],Map,Addr1,Res) 693 | end; 694 | resolve_8_addr_([Op={block,N,_Block}|Code], Acc, LabelMap, Addr,Res) -> 695 | resolve_8_addr_(Code, [Op|Acc], LabelMap, add_addr(N,Addr),Res); 696 | resolve_8_addr_([Op={label,_}|Code],Acc, LabelMap, Addr, Res) -> 697 | resolve_8_addr_(Code, [Op|Acc], LabelMap, Addr, Res); 698 | resolve_8_addr_([Op|Code],Acc,Map,Addr,Res) -> 699 | Len = opcode_length(Op), 700 | resolve_8_addr_(Code, [Op|Acc], Map, add_addr(Len, Addr),Res); 701 | resolve_8_addr_([], Acc, _Map, _Addr,Res) -> 702 | {Res,lists:reverse(Acc)}. 703 | 704 | %% 705 | %% Locate guaranteed near (16-bit) jumps 706 | %% 707 | resolve_16_addr(Code,Map) -> 708 | resolve_16_addr_(Code, [], Map, [0], false). 709 | 710 | resolve_16_addr_([Op={{jop,Jop},L}|Code],Acc,Map,Addr,Res) -> 711 | Addr1 = add_addr([2,3,5], Addr), 712 | Target = maps:get(L, Map), 713 | Offset = sub_addr(Target, Addr1), 714 | case is_16_addr(Offset) of 715 | true -> 716 | resolve_16_addr_(Code, [{{jop,Jop,int16},L}|Acc],Map, 717 | add_addr(2,Addr),true); 718 | false -> 719 | resolve_16_addr_(Code, [Op|Acc],Map,Addr1,Res) 720 | end; 721 | resolve_16_addr_([Op={block,N,_Block}|Code], Acc, LabelMap, Addr,Res) -> 722 | resolve_16_addr_(Code,[Op|Acc], LabelMap, add_addr(N,Addr),Res); 723 | resolve_16_addr_([Op={label,_}|Code], Acc, LabelMap, Addr, Res) -> 724 | resolve_16_addr_(Code,[Op|Acc], LabelMap, Addr, Res); 725 | resolve_16_addr_([Op|Code],Acc,Map,Addr,Res) -> 726 | Len = opcode_length(Op), 727 | resolve_16_addr_(Code,[Op|Acc], Map, add_addr(Len, Addr),Res); 728 | resolve_16_addr_([], Acc, _Map, _Addr,Res) -> 729 | {Res,lists:reverse(Acc)}. 730 | 731 | %% replace all branch/zbranch/ibranch with far offset version 732 | resolve_32_addr([{{jop,Jop},L}|Code]) -> 733 | [{{jop,Jop,int32},L}|resolve_32_addr(Code)]; 734 | resolve_32_addr([Op|Code]) -> 735 | [Op|resolve_32_addr(Code)]; 736 | resolve_32_addr([]) -> 737 | []. 738 | 739 | %% 740 | %% Calculate address table map and remove labels 741 | %% 742 | map_labels(Code) -> 743 | map_labels_(Code, [], #{}, [0]). 744 | 745 | map_labels_([Op={label,L}|Code], Acc, Map, Addr) -> 746 | case maps:find(L, Map) of 747 | error -> 748 | map_labels_(Code, [Op|Acc], Map#{ L => Addr }, Addr); 749 | {ok,_} -> 750 | erlang:error({label_exist,L}) 751 | end; 752 | map_labels_([Op={block,N,_Block}|Code], Acc, Map, Addr) -> 753 | map_labels_(Code, [Op|Acc], Map, add_addr(N,Addr)); 754 | map_labels_([Op={{jop,_Jop,Kv},_}|Code], Acc, Map, Addr) -> 755 | K = variant_length(Kv), 756 | map_labels_(Code, [Op|Acc], Map, add_addr(K+1,Addr)); 757 | map_labels_([Op={{jop,_Jop},_L}|Code], Acc, Map, Addr) -> 758 | map_labels_(Code, [Op|Acc], Map, add_addr([2,3,5],Addr)); 759 | map_labels_([], Acc, Map, _Addr) -> 760 | {Map, lists:reverse(Acc)}. 761 | 762 | %% list of alternative addresses 763 | add_addr(A, B) when is_list(A), is_list(B) -> 764 | lists:usort([ X + Y || X <- A, Y <- B ]); 765 | add_addr(A, B) when is_list(A), is_integer(B) -> 766 | [ X + B || X <- A]; 767 | add_addr(A, B) when is_integer(A), is_list(B) -> 768 | [ A + Y || Y <- B]; 769 | add_addr(A, B) when is_integer(A), is_integer(B) -> 770 | [ A + B ]. 771 | 772 | sub_addr(A, B) when is_list(A), is_list(B) -> 773 | lists:usort([ X - Y || X <- A, Y <- B ]); 774 | sub_addr(A, B) when is_list(A), is_integer(B) -> 775 | [ X - B || X <- A]; 776 | sub_addr(A, B) when is_integer(A), is_list(B) -> 777 | [ A - Y || Y <- B]; 778 | sub_addr(A, B) when is_integer(A), is_integer(B) -> 779 | [ A - B ]. 780 | 781 | is_3_addr([A|_]) when A < -4; A > 3 -> false; 782 | is_3_addr([_|As]) -> is_3_addr(As); 783 | is_3_addr([]) -> true. 784 | 785 | is_8_addr([A|_]) when A < -16#80; A > 16#7f -> false; 786 | is_8_addr([_|As]) -> is_8_addr(As); 787 | is_8_addr([]) -> true. 788 | 789 | is_16_addr([A|_]) when A < -16#8000; A > 16#7fff -> false; 790 | is_16_addr([_|As]) -> is_16_addr(As); 791 | is_16_addr([]) -> true. 792 | 793 | %% 794 | %% Collect code blocks 795 | %% Fixme: move combine opcodes? 796 | %% move optimisation of jmpz? 797 | %% 798 | collect_blocks(Code,Opts) -> 799 | {Code1,Z} = collect_blocks_(Code, [], [], 0), 800 | debugf(Opts,"compressed ~w bytes\n", [Z]), 801 | Code1. 802 | 803 | collect_blocks_(['0=',{{jop,jmpz},L}|Code], Block, Acc, Z) -> 804 | %% (!X=0) == (X != 0) 805 | collect_blocks_([{{jop,jmpnz},L}|Code], Block, Acc, Z); 806 | collect_blocks_([Op={{jop,_Jop},_L}|Code], Block, Acc,Z) -> 807 | collect_blocks_(Code, [], [Op | add_block(Block,Acc)],Z); 808 | collect_blocks_([Op={label,_L}|Code], Block, Acc,Z) -> 809 | collect_blocks_(Code, [], [Op | add_block(Block,Acc)],Z); 810 | collect_blocks_([Op1|Code1=[Op2|Code2]], Block, Acc,Z) 811 | when is_atom(Op1),is_atom(Op2) -> 812 | Map = opcodes(), 813 | N1 = maps:get(Op1, Map), 814 | N2 = maps:get(Op2, Map), 815 | if N1 < 8, N2 < 8 -> 816 | collect_blocks_(Code2,[{Op1,Op2}|Block], Acc,Z+1); 817 | true -> 818 | collect_blocks_(Code1, [Op1|Block], Acc,Z) 819 | end; 820 | collect_blocks_([Opcode|Code], Block, Acc, Z) -> 821 | collect_blocks_(Code, [Opcode|Block], Acc, Z); 822 | collect_blocks_([], Block, Acc, Z) -> 823 | {lists:reverse(add_block(Block,Acc)),Z}. 824 | 825 | 826 | add_block([],Code) -> Code; 827 | add_block(Block,Code) -> 828 | Basic = lists:reverse(Block), 829 | N = block_length(Basic), 830 | [{block,N,Basic}|Code]. 831 | 832 | %% 833 | %% flatten blocks and generate instruction list 834 | %% 835 | disperse_blocks(Code,_Opts) -> 836 | disperse_blocks_(Code, []). 837 | 838 | disperse_blocks_([{block,_N,Block}|Code], Acc) -> 839 | disperse_blocks_(Code, [Block|Acc]); 840 | disperse_blocks_([Op|Code], Acc) -> 841 | disperse_blocks_(Code, [Op|Acc]); 842 | disperse_blocks_([], Acc) -> 843 | lists:flatten(lists:reverse(Acc)). 844 | 845 | %% 846 | %% Encode integer constants 0, 1 encode to instructions 847 | %% while other constants encode into 2,3 or 5 byte instructions 848 | %% 849 | encode_const(Code,_Opts) -> 850 | encode_const_(Code,[]). 851 | 852 | encode_const_([{const,C}|Code], Acc) -> 853 | L = encode_literal(C), 854 | encode_const_(Code, [L|Acc]); 855 | encode_const_([{arg,I}|Code], Acc) -> 856 | Type = case type_integer(I) of 857 | int3 -> int8; %% int3 is not available for opcode1 858 | T -> T 859 | end, 860 | encode_const_(Code, [{arg,Type,I}|Acc]); 861 | encode_const_([{caddr,L}|Code], Acc) -> 862 | %% caddr is an offset from program start, can only 863 | %% be calculated when all labels have been calculated 864 | %% but is now assumed to fit in a 16 bit integer FIXME 865 | encode_const_(Code, [{caddr,uint16,L}|Acc]); 866 | encode_const_([{string,S}|Code], Acc) when is_list(S) -> 867 | encode_const_([{array,[{const,uint8,C} || C <- S]}|Code], Acc); 868 | encode_const_([{string,S}|Code], Acc) when is_binary(S) -> 869 | encode_const_([{array,[{const,uint8,C} || <> <= S]}|Code], Acc); 870 | encode_const_([{array,Es}|Code], Acc) -> 871 | N = length(Es), 872 | Es1 = [case E of 873 | {const,C} -> encode_literal(C); 874 | {const,Type,Value} -> {literal,Type,Value}; 875 | {caddr,L} -> {caddr,uint16,L} %% FIXME 876 | end || E <- Es], 877 | K = if N =:= 0 -> 1; 878 | true -> lists:max([opcode_length(Op) || Op <- Es1]) 879 | end, 880 | A = if N < 8, K=:=1 -> {array,uint3x8,Es1}; 881 | N < 8, K=:=2 -> {array,uint3x8,Es1}; 882 | N < 256, K=:=2 -> {array,uint8x8,Es1}; 883 | N < 256, K=:=3 -> {array,uint8x16,Es1}; 884 | N < 256, K=:=5 -> {array,uint8x32,Es1}; 885 | N < 65536, K =:= 2 -> {array,uint16x8,Es1}; 886 | N < 65536, K =:= 3 -> {array,uint16x16,Es1}; 887 | N < 65536, K =:= 5 -> {array,uint16x32,Es1} 888 | end, 889 | encode_const_(Code, [A|Acc]); 890 | encode_const_([{sys, SysOp}|Code], Acc) -> 891 | Sys = maps:get(SysOp, syscalls()), 892 | encode_const_(Code, [{sys,Sys}|Acc]); 893 | encode_const_([C|Code],Acc) -> 894 | encode_const_(Code, [C|Acc]); 895 | encode_const_([],Acc) -> 896 | lists:reverse(Acc). 897 | 898 | %% encode some integer constants 899 | encode_literal(true) -> encode_literal(?CHINE_TRUE); 900 | encode_literal(false) -> encode_literal(?CHINE_FALSE); 901 | encode_literal(boolean) -> encode_literal(?INPUT_BOOLEAN); 902 | encode_literal(analog) -> encode_literal(?INPUT_ANALOG); 903 | encode_literal(encoder) -> encode_literal(?INPUT_ENCODER); 904 | encode_literal(I) when is_integer(I) -> 905 | {literal,type_integer(I), I}. 906 | 907 | type_integer(I) when is_integer(I) -> 908 | if I >= -4, I =< 3 -> int3; 909 | I >= -16#80, I =< 16#7f -> int8; 910 | I >= -16#8000, I =< 16#7fff -> int16; 911 | I >= -16#80000000, I =< 16#7fffffff -> int32; 912 | I =< 16#ffffffff -> uint32 913 | end. 914 | 915 | %% 916 | %% Length of basic block in bytes 917 | %% 918 | block_length(Code) -> 919 | block_length(Code,0). 920 | 921 | block_length([Op|Code],N) -> 922 | block_length(Code, opcode_length(Op)+N); 923 | block_length([],N) -> 924 | N. 925 | 926 | %% 927 | %% Size of opcode 928 | %% 929 | opcode_length({literal,int3,_X}) -> 1; 930 | opcode_length({literal,int8,_X}) -> 2; 931 | opcode_length({literal,int16,_X}) -> 3; 932 | opcode_length({literal,int32,_X}) -> 5; 933 | opcode_length({literal,uint3,_X}) -> 1; 934 | opcode_length({literal,uint8,_X}) -> 2; 935 | opcode_length({literal,uint16,_X}) -> 3; 936 | opcode_length({literal,uint32,_X}) -> 5; 937 | 938 | %% opcode1 only no int3 encoding 939 | opcode_length({arg,int8,_X}) -> 2; 940 | opcode_length({arg,int16,_X}) -> 3; 941 | opcode_length({arg,int32,_X}) -> 5; 942 | 943 | opcode_length({caddr,uint3,_L}) -> 1; 944 | opcode_length({caddr,uint8,_L}) -> 2; 945 | opcode_length({caddr,uint16,_L}) -> 3; 946 | opcode_length({caddr,uint32,_L}) -> 5; 947 | 948 | opcode_length({array,uint3x8,Ls}) -> 1+length(Ls); 949 | opcode_length({array,uint8x8,Ls}) -> 1+1+length(Ls); 950 | opcode_length({array,uint8x16,Ls}) -> 1+1+2*length(Ls); 951 | opcode_length({array,uint8x32,Ls}) -> 1+1+4*length(Ls); 952 | opcode_length({array,uint16x8,Ls}) -> 1+2+length(Ls); 953 | opcode_length({array,uint16x16,Ls}) -> 1+2+2*length(Ls); 954 | opcode_length({array,uint16x32,Ls}) -> 1+2+4*length(Ls); 955 | 956 | opcode_length({{jop,_,int3},_}) -> 1; 957 | opcode_length({{jop,_,int8},_}) -> 2; 958 | opcode_length({{jop,_,int16},_}) -> 3; 959 | opcode_length({{jop,_,int32},_}) -> 5; 960 | opcode_length({sys,_}) -> 2; 961 | opcode_length({Op1,Op2}) -> 962 | Map = opcodes(), 963 | N1 = maps:get(Op1, Map), 964 | N2 = maps:get(Op2, Map), 965 | if N1 < 8, N2 < 8 -> 1 end; 966 | opcode_length(Op) -> 967 | Map = opcodes(), 968 | N7 = maps:get(Op, Map), 969 | if N7 < 64 -> 1 end. 970 | 971 | %% 972 | %% Encode all opcodes into bytes 973 | %% 974 | encode_opcodes(Code,_Opts) -> 975 | encode_opcodes_(Code, [], maps:merge(jopcodes(),opcodes())). 976 | 977 | encode_opcodes_([{literal,int3,I}|Code], Acc, Map) -> 978 | OP = ?OPCODE2(?JOP(literal),I), 979 | encode_opcodes_(Code,[OP|Acc],Map); 980 | encode_opcodes_([{literal,Kv,I}|Code], Acc, Map) -> 981 | K = variant_length(Kv), 982 | Kc = variant_code(Kv), 983 | Is = encode_integer(I,K), 984 | OP = ?OPCODE1(?JOP(literal),Kc), 985 | encode_opcodes_(Code,cat(Is,[OP|Acc]),Map); 986 | 987 | %% arg must is OPCODE1 only! 988 | encode_opcodes_([{arg,int3,I}|Code], Acc, Map) -> 989 | OP = ?OPCODE1(?JOP(arg),I), 990 | encode_opcodes_(Code,[OP|Acc],Map); 991 | encode_opcodes_([{arg,Kv,I}|Code], Acc, Map) -> 992 | K = variant_length(Kv), 993 | Kc = variant_code(Kv), 994 | Is = encode_integer(I,K), 995 | OP = ?OPCODE1(?JOP(arg),Kc), 996 | encode_opcodes_(Code,cat(Is,[OP|Acc]),Map); 997 | 998 | encode_opcodes_([{{jop,Jmp,int3},I}|Code], Acc, Map) -> 999 | N = maps:get(Jmp,Map), 1000 | if N < 8 -> true end, 1001 | OP = ?OPCODE2(N,I), 1002 | encode_opcodes_(Code,[OP|Acc],Map); 1003 | encode_opcodes_([{{jop,Jmp,Kv},Offset}|Code], Acc, Map) -> 1004 | K = variant_length(Kv), 1005 | Kc = variant_code(Kv), 1006 | N = maps:get(Jmp,Map), 1007 | true = N < 8, 1008 | Is = encode_integer(Offset,K), 1009 | OP = ?OPCODE1(N,Kc), 1010 | encode_opcodes_(Code,cat(Is,[OP|Acc]),Map); 1011 | %% ARRAY 1012 | encode_opcodes_([{array,uint3x8,Es}|Code],Acc,Map) -> 1013 | N = length(Es), 1014 | Is = [encode_integer(X,1) || {literal,_,X} <- Es], 1015 | Ls = lists:append(Is), 1016 | OP = ?OPCODE2(?JOP(array),N), 1017 | encode_opcodes_(Code,cat(Ls,[OP|Acc]),Map); 1018 | encode_opcodes_([{array,Kv,Es}|Code],Acc,Map) -> 1019 | N = length(Es), 1020 | K = variant_length(Kv), 1021 | Kc = variant_code(Kv), 1022 | Ke = element_length(Kv), 1023 | Ns = encode_integer(N,K), 1024 | Is = [encode_integer(X,Ke) || {literal,_,X} <- Es], 1025 | Ls = Ns ++ lists:append(Is), 1026 | OP = ?OPCODE1(?JOP(array),Kc), 1027 | encode_opcodes_(Code,cat(Ls,[OP|Acc]),Map); 1028 | %% SYS 1029 | encode_opcodes_([{sys,Sys}|Code],Acc,Map) -> 1030 | OP = ?OPCODE0(?OP(sys)), 1031 | encode_opcodes_(Code, [Sys,OP|Acc],Map); 1032 | encode_opcodes_([{Op1,Op2}|Code],Acc,Map) -> 1033 | N1 = maps:get(Op1,Map), 1034 | N2 = maps:get(Op2,Map), 1035 | if N1 < 8, N2 < 8 -> true end, 1036 | OP = ?OPCODE3(N1,N2), 1037 | encode_opcodes_(Code,[OP|Acc],Map); 1038 | encode_opcodes_([Op|Code], Acc, Map) -> 1039 | N = maps:get(Op,Map), 1040 | if N < 64 -> true end, 1041 | OP = ?OPCODE0(N), 1042 | encode_opcodes_(Code,[OP|Acc],Map); 1043 | encode_opcodes_([], Acc, _Map) -> 1044 | list_to_binary(lists:reverse(Acc)). 1045 | 1046 | %% 1047 | %%variant_length(int3) -> 0; 1048 | variant_length(int8) -> 1; 1049 | variant_length(int16) -> 2; 1050 | variant_length(int32) -> 4; 1051 | variant_length(int64) -> 8; 1052 | %%variant_length(uint3) -> 0; 1053 | variant_length(uint8) -> 1; 1054 | variant_length(uint16) -> 2; 1055 | variant_length(uint32) -> 4; 1056 | variant_length(uint64) -> 8; 1057 | %%variant_length(uint3x8) -> 0; 1058 | variant_length(uint8x8) -> 1; 1059 | variant_length(uint8x16) -> 1; 1060 | variant_length(uint8x32) -> 1; 1061 | variant_length(uint16x8) -> 2; 1062 | variant_length(uint16x16) -> 2; 1063 | variant_length(uint16x32) -> 2. 1064 | 1065 | element_length(uint3x8) -> 1; 1066 | element_length(uint8x8) -> 1; 1067 | element_length(uint8x16) -> 2; 1068 | element_length(uint8x32) -> 4; 1069 | element_length(uint16x8) -> 1; 1070 | element_length(uint16x16) -> 2; 1071 | element_length(uint16x32) -> 4. 1072 | 1073 | variant_code(int8) -> 0; 1074 | variant_code(int16) -> 1; 1075 | variant_code(int32) -> 2; 1076 | variant_code(uint8) -> 0; 1077 | variant_code(uint16) -> 1; 1078 | variant_code(uint32) -> 2; 1079 | variant_code(uint8x8) -> 0; 1080 | variant_code(uint8x16) -> 1; 1081 | variant_code(uint8x32) -> 2; 1082 | variant_code(uint16x8) -> 4; 1083 | variant_code(uint16x16) -> 5; 1084 | variant_code(uint16x32) -> 6. 1085 | 1086 | %% encode offset of K bytes as byte list 1087 | encode_integer(X,1) -> binary_to_list(<>); 1088 | encode_integer(X,2) -> binary_to_list(<>); 1089 | encode_integer(X,4) -> binary_to_list(<>); 1090 | encode_integer(X,8) -> binary_to_list(<>). 1091 | 1092 | %% cat a list 1093 | cat([I|Is], Acc) -> 1094 | cat(Is, [I|Acc]); 1095 | cat([], Acc) -> 1096 | Acc. 1097 | 1098 | new_label() -> 1099 | case get(next_label) of 1100 | undefined -> 1101 | put(next_label, 1), 1102 | "L0"; 1103 | I -> 1104 | put(next_label, I+1), 1105 | [$L|integer_to_list(I)] 1106 | end. 1107 | 1108 | effect_all() -> 1109 | Ls = 1110 | [ begin Is=[A,B], 1111 | {Is,effect_(Is)} 1112 | end || A <- [dup,rot,over,drop,swap,'-','+','*'], 1113 | B <- [dup,rot,over,drop,swap,'-','+','*']], 1114 | effect_filter(Ls). 1115 | 1116 | effect_filter(Ls) -> 1117 | effect_filter(Ls, sets:new()). 1118 | 1119 | effect_filter([{Is,{S,S}}|Tail], Set) -> 1120 | io:format("~w = id\n", [Is]), 1121 | effect_filter(Tail,Set); 1122 | effect_filter([{Is,{S1,S2}}|Tail], Set) -> 1123 | case sets:is_element({S1,S2},Set) of 1124 | true -> 1125 | io:format("~w ( multiple ) ", [Is]), 1126 | print_stack_effect(S1,S2), 1127 | effect_filter(Tail,Set); 1128 | false -> 1129 | io:format("~w : ", [Is]), 1130 | print_stack_effect(S1,S2), 1131 | effect_filter(Tail,sets:add_element({S1,S2},Set)) 1132 | end; 1133 | effect_filter([],_) -> 1134 | ok. 1135 | 1136 | effect(Is) -> 1137 | {Stack,Stack2} = effect_(Is), 1138 | print_stack_effect(Stack, Stack2), 1139 | Stack2. 1140 | 1141 | print_stack_effect(Before,After) -> 1142 | io:format("( ~w -- ~w )\n", [lists:reverse(Before), 1143 | lists:reverse(After)]). 1144 | 1145 | effect_(Is) -> 1146 | {N,_,_} = minmax_depth(Is), 1147 | Stack = generate_stack(-N), 1148 | Stack2 = exec(Is, Stack), 1149 | {Stack, Stack2}. 1150 | 1151 | 1152 | generate_stack(N) -> 1153 | generate_stack($a,N,[]). 1154 | 1155 | generate_stack(_C,0,Acc) -> 1156 | Acc; 1157 | generate_stack(C, I,Acc) when I > 0 -> 1158 | generate_stack(C+1,I-1,[list_to_atom([C]) | Acc]). 1159 | 1160 | 1161 | exec([I|Is],Stack) -> 1162 | exec(Is,exec_(I,Stack)); 1163 | exec([],Stack) -> 1164 | Stack. 1165 | 1166 | exec_(dup, [A|Xs]) -> [A,A|Xs]; 1167 | exec_(rot, [C,B,A|Xs]) -> [A,C,B|Xs]; 1168 | exec_(over, [B,A|Xs]) -> [A,B,A|Xs]; 1169 | exec_(drop, [_A|Xs]) -> Xs; 1170 | exec_(swap, [B,A|Xs]) -> [A,B|Xs]; 1171 | exec_('-',[A,A|Xs]) -> [{const,0}|Xs]; 1172 | exec_('-',[B,A|Xs]) -> [{'-',A,B}|Xs]; 1173 | exec_('+',[B,A|Xs]) -> [{'+',A,B}|Xs]; 1174 | exec_('*',[B,A|Xs]) -> [{'*',A,B}|Xs]; 1175 | exec_('=',[A,A|Xs]) -> [{const,1}|Xs]; 1176 | exec_('=',[B,A|Xs]) -> [{'=',A,B}|Xs]; 1177 | exec_('and',[A,A|Xs]) -> [A|Xs]; 1178 | exec_('and',[B,A|Xs]) -> [{'and',A,B}|Xs]; 1179 | exec_('or',[A,A|Xs]) -> [A|Xs]; 1180 | exec_('or',[B,A|Xs]) -> [{'or',A,B}|Xs]; 1181 | exec_('xor',[A,A|Xs]) -> [{const,0}|Xs]; 1182 | exec_('xor',[B,A|Xs]) -> [{'xor',A,B}|Xs]; 1183 | exec_('0=',[A|Xs]) -> [{'0=',A}|Xs]; 1184 | exec_('0<',[A|Xs]) -> [{'0<',A}|Xs]; 1185 | exec_('not',[A|Xs]) -> [{'not',A}|Xs]; 1186 | exec_('/',[B,A|Xs]) -> [{'/',A,B}|Xs]; 1187 | exec_('negate',[A|Xs]) -> [{'negate',A}|Xs]; 1188 | exec_('shift',[B,A|Xs]) -> [{'<<',A,B}|Xs]; 1189 | exec_(nop, Xs) -> Xs; 1190 | exec_({const,C},Xs) -> [C|Xs]. 1191 | 1192 | 1193 | %% depth calculate stack effect depth 1194 | %% depth(Instruction) -> {Min depth before, Min depth after} 1195 | %% 1196 | minmax_depth(Is) -> 1197 | Min0 = 3*length(Is), 1198 | minmax_depth(Is, Min0, 0, 0). 1199 | 1200 | minmax_depth([I|Is], Min, Max, Level) -> 1201 | {Before,After} = min_depth_(I), 1202 | Effect = After - Before, 1203 | LevelBefore = Level - Before, 1204 | LevelAfter = Level - After, 1205 | Level1 = Level + Effect, 1206 | minmax_depth(Is, 1207 | erlang:min(Min,LevelBefore), 1208 | erlang:max(Max,LevelAfter), 1209 | Level1); 1210 | minmax_depth([], Min, Max, Depth) -> 1211 | {Min,Max,Depth}. 1212 | 1213 | min_depth_(dup) -> {1,2}; 1214 | min_depth_(rot) -> {3,3}; 1215 | min_depth_(over) -> {2,3}; 1216 | min_depth_(drop) -> {1,0}; 1217 | min_depth_(swap) -> {2,2}; 1218 | min_depth_('-') -> {2,1}; 1219 | min_depth_('+') -> {2,1}; 1220 | min_depth_('*') -> {2,1}; 1221 | min_depth_('=') -> {2,1}; 1222 | min_depth_('and') -> {2,1}; 1223 | min_depth_('or') -> {2,1}; 1224 | min_depth_('0=') -> {1,1}; 1225 | min_depth_('0<') -> {1,1}; 1226 | min_depth_('not') -> {1,1}; 1227 | min_depth_('/') -> {2,1}; 1228 | min_depth_('xor') -> {2,1}; 1229 | min_depth_('negate') -> {1,1}; 1230 | min_depth_('shift') -> {2,1}; 1231 | min_depth_('1+') -> {1,1}; 1232 | min_depth_('1-') -> {1,1}; 1233 | min_depth_('u<') -> {2,1}; 1234 | min_depth_('<') -> {2,1}; 1235 | min_depth_('!') -> {2,0}; 1236 | min_depth_('@') -> {1,1}; 1237 | min_depth_('nop') -> {0,0}; 1238 | min_depth_('<=') -> {2,1}; 1239 | min_depth_('u<=') -> {2,1}; 1240 | min_depth_('ret') -> {0,0}; 1241 | min_depth_({const,_C}) -> {0,1}. 1242 | -------------------------------------------------------------------------------- /src/chine_disasm.erl: -------------------------------------------------------------------------------- 1 | %%% @author Tony Rogvall 2 | %%% @copyright (C) 2021, Tony Rogvall 3 | %%% @doc 4 | %%% Disassembler 5 | %%% @end 6 | %%% Created : 11 Mar 2021 by Tony Rogvall 7 | 8 | -module(chine_disasm). 9 | 10 | -export([file/1]). 11 | 12 | -include("../include/chine.hrl"). 13 | 14 | file(File) -> 15 | case file:read_file(File) of 16 | {ok,Bin} -> 17 | dis(Bin); 18 | Error -> 19 | Error 20 | end. 21 | 22 | dis(<<"CHIN", FileVersion:32, FileCRC:32, 23 | SectionsLength:32, Sections:SectionsLength/binary, _Trail/binary>>) -> 24 | File0 = <<"CHIN", FileVersion:32, 0:32, 25 | SectionsLength:32, Sections/binary>>, 26 | case erlang:crc32(File0) of 27 | FileCRC -> 28 | Ls = [{Name,Data} || 29 | <> <= Sections], 30 | dis_sections(Ls); 31 | _ -> 32 | {error, badcrc} 33 | end. 34 | 35 | dis_sections(Sections) -> 36 | SymTab = dis_symb(Sections, #{}), 37 | dis_code(Sections, 0, SymTab, []). 38 | 39 | dis_code([{<<"CODE">>, Content} | Sections], Addr, SymTab, Code0) -> 40 | {Addr1,Code1} = dis_opcodes(Content, Addr, SymTab, Code0), 41 | dis_code(Sections, Addr1, SymTab, Code1); 42 | dis_code([_|Sections], Addr1, SymTab, Code1) -> 43 | dis_code(Sections, Addr1, SymTab, Code1); 44 | dis_code([], Addr1, SymTab, Code) -> 45 | {Addr1,lists:reverse(Code),SymTab}. 46 | 47 | -define(ARRAY, 7). 48 | -define(SYS, 25). 49 | 50 | 51 | dis_opcodes(<<>>, Addr, _SymTab, Code) -> 52 | {Addr, Code}; 53 | dis_opcodes(<<0:2, ?SYS:6, Sys:8, Content/binary>>, Addr, SymTab, Code) -> 54 | OpA = 55 | case Sys+2 of 56 | #sys.sys_init -> {sys,init}; 57 | #sys.sys_terminate -> {sys, terminate}; 58 | #sys.sys_now -> {sys, now}; 59 | #sys.sys_emit -> {sys, emit}; 60 | #sys.sys_recv -> {sys, recv}; 61 | #sys.sys_avail -> {sys, avail}; 62 | #sys.sys_param_fetch -> {sys, param_fetch}; 63 | #sys.sys_param_store -> {sys, param_store}; 64 | #sys.sys_timer_init -> {sys, timer_init}; 65 | #sys.sys_timer_start -> {sys, timer_start}; 66 | #sys.sys_timer_stop -> {sys, timer_stop}; 67 | #sys.sys_timer_timeout -> {sys, timer_timeout}; 68 | #sys.sys_timer_running -> {sys, timer_running}; 69 | #sys.sys_input_fetch -> {sys, input_fetch}; 70 | #sys.sys_output_store -> {sys, output_store}; 71 | #sys.sys_select_timer -> {sys, select_timer}; 72 | #sys.sys_deselect_timer -> {sys, deselect_timer}; 73 | #sys.sys_select_input -> {sys, select_input}; 74 | #sys.sys_deselect_input -> {sys, deselect_input}; 75 | #sys.sys_deselect_all -> {sys, deselect_all}; 76 | #sys.sys_uart_connect -> {sys, uart_connect}; 77 | #sys.sys_uart_send -> {sys, uart_send}; 78 | #sys.sys_uart_recv -> {sys, uart_recv}; 79 | #sys.sys_uart_avail -> {sys, uart_avail}; 80 | #sys.sys_uart_disconnect -> {sys, uart_disconnect}; 81 | #sys.sys_gpio_input -> {sys, gpio_input}; 82 | #sys.sys_gpio_output -> {sys, gpio_output}; 83 | #sys.sys_gpio_set -> {sys, gpio_set}; 84 | #sys.sys_gpio_clr -> {sys, gpio_clr}; 85 | #sys.sys_gpio_get -> {sys, gpio_get}; 86 | #sys.sys_analog_send -> {sys, analog_send}; 87 | #sys.sys_analog_recv -> {sys, analog_recv}; 88 | #sys.sys_can_connect -> {sys, can_connect}; 89 | #sys.sys_can_send -> {sys, can_send}; 90 | #sys.sys_can_recv -> {sys, can_recv}; 91 | #sys.sys_can_avail -> {sys, can_avail}; 92 | #sys.sys_can_disconnect -> {sys, can_disconnect}; 93 | #sys.sys_file_open -> {sys, file_open}; 94 | #sys.sys_file_write -> {sys, file_write}; 95 | #sys.sys_file_read -> {sys, file_read}; 96 | #sys.sys_file_close -> {sys, file_close}; 97 | _ -> {sys,{unknown, Sys}} 98 | end, 99 | dis_opcodes(Content, Addr+2, SymTab, [OpA|Code]); 100 | dis_opcodes(<<0:2, OP:6, Content/binary>>, Addr, SymTab, Code) -> 101 | OpA = case OP+2 of 102 | #opcode.dup -> dup; 103 | #opcode.rot -> rot; 104 | #opcode.over -> over; 105 | #opcode.drop -> drop; 106 | #opcode.swap -> swap; 107 | #opcode.'-' -> '-'; 108 | #opcode.'+' -> '+'; 109 | #opcode.'*' -> '*'; 110 | %% op6 111 | #opcode.'nop' -> 'nop'; 112 | #opcode.'and' -> 'and'; 113 | #opcode.'or' -> 'or'; 114 | #opcode.'xor' -> 'xor'; 115 | #opcode.'0=' -> '0='; 116 | #opcode.'0<' -> '0<'; 117 | #opcode.'not' -> 'not'; 118 | #opcode.negate -> negate; 119 | #opcode.'/' -> '/'; 120 | #opcode.shift -> shift; 121 | #opcode.'!' -> '!'; 122 | #opcode.'@' -> '@'; 123 | #opcode.'>r' -> '>r'; 124 | #opcode.'r>' -> 'r>'; 125 | #opcode.'r@' -> 'r@'; 126 | #opcode.exit -> exit; 127 | #opcode.sys -> sys; 128 | #opcode.yield -> yield; 129 | #opcode.'[]' -> '[]'; 130 | #opcode.execute -> execute; 131 | #opcode.'fp@' -> 'fp@'; 132 | #opcode.'fp!' -> 'fp!'; 133 | #opcode.'sp@' -> 'sp@'; 134 | #opcode.'sp!' -> 'sp!'; 135 | _ -> {{unknown,OP}} 136 | end, 137 | dis_opcodes(Content, Addr+1, SymTab, [OpA|Code]); 138 | 139 | dis_opcodes(<<1:2, L:2, ?ARRAY:4, Content/binary>>, Addr, SymTab, Code) -> 140 | {M,E,Variant} = 141 | case L of 142 | 0 -> {3, 3, uint8x8}; 143 | 1 -> {3, 4, uint8x16}; 144 | 2 -> {4, 5, uint16x32}; 145 | 3 -> {4, 6, uint16x64} 146 | end, 147 | EL = (1 bsl E), %% 8,16,32,64 148 | LL = (1 bsl M), %% 8,8,16,16 149 | <> = Content, 150 | Array = [Ei || <> <= Data], 151 | Op = {array,{Variant,Len},Array}, 152 | dis_opcodes(Content1, Addr+1+L+Len*LL, SymTab, [Op|Code]); 153 | 154 | dis_opcodes(<<1:2, L:2, JOP:4, A:(1 bsl L)/signed-unit:8, Content/binary>>, 155 | Addr, SymTab, Code) -> 156 | {Int,UInt} = case L of 157 | 0 -> {int8,uint8}; 158 | 1 -> {int16,uint16}; 159 | 2 -> {int32,uint32}; 160 | 3 -> {int64,uint64} 161 | end, 162 | OpA = case JOP+2 of 163 | #jopcode.jmpz -> {jmpz,{Int,A}}; 164 | #jopcode.jmpnz -> {jmpnz,{Int,A}}; 165 | #jopcode.next -> {next,{Int,A}}; 166 | #jopcode.jmplz -> {jmplz,{Int,A}}; 167 | #jopcode.jmp -> {jmp,{Int,A}}; 168 | #jopcode.call -> {call,{Int,A}}; 169 | #jopcode.literal -> {literal,{Int,A}}; 170 | #jopcode.array -> {array,{UInt,unsigned(UInt,A)}}; 171 | #jopcode.arg -> {arg,{Int,A}}; 172 | _ -> {{unknown,JOP},{Int,A}} 173 | end, 174 | dis_opcodes(Content, Addr+1+(1 bsl L), SymTab, [OpA|Code]); 175 | 176 | dis_opcodes(<<2:2, L:3, ?ARRAY:3, String:L/binary, Content/binary>>, 177 | Addr, SymTab, Code) -> 178 | %% uint3x8 0-7 8 bit characters 179 | Op = {array,{uint3x8,L},String}, 180 | dis_opcodes(Content, Addr+1+L, SymTab, [Op|Code]); 181 | 182 | dis_opcodes(<<2:2, A:3/signed, JOP:3, Content/binary>>, 183 | Addr, SymTab, Code) -> 184 | OpA = case JOP+2 of 185 | #jopcode.jmpz -> {jmpz,{int3,A}}; 186 | #jopcode.jmpnz -> {jmpnz,{int3,A}}; 187 | #jopcode.next -> {next,{int3,A}}; 188 | #jopcode.jmplz -> {jmplz,{int3,A}}; 189 | #jopcode.jmp -> {jmp,{int3,A}}; 190 | #jopcode.call -> {call,{int3,A}}; 191 | #jopcode.literal -> {literal,{int3,A}} 192 | %%#jopcode.array -> {array,{uint3,unsigned(uint3,A)}} 193 | end, 194 | dis_opcodes(Content, Addr+1, SymTab, [OpA|Code]); 195 | 196 | dis_opcodes(<<3:2, OP2:3, OP1:3, Content/binary>>, Addr, SymTab, Code) -> 197 | OpA = case OP1+2 of 198 | #opcode.dup -> dup; 199 | #opcode.rot -> rot; 200 | #opcode.over -> over; 201 | #opcode.drop -> drop; 202 | #opcode.swap -> swap; 203 | #opcode.'-' -> '-'; 204 | #opcode.'+' -> '+'; 205 | #opcode.'*' -> '*' 206 | end, 207 | OpB = case OP2+2 of 208 | #opcode.dup -> dup; 209 | #opcode.rot -> rot; 210 | #opcode.over -> over; 211 | #opcode.drop -> drop; 212 | #opcode.swap -> swap; 213 | #opcode.'-' -> '-'; 214 | #opcode.'+' -> '+'; 215 | #opcode.'*' -> '*' 216 | end, 217 | dis_opcodes(Content, Addr+1, SymTab, [{OpA,OpB}|Code]). 218 | 219 | unsigned(uint3, V) when V < 0 -> V+(1 bsl 3); 220 | unsigned(uint8, V) when V < 0 -> V+(1 bsl 8); 221 | unsigned(uint16, V) when V < 0 -> V+(1 bsl 16); 222 | unsigned(uint32, V) when V < 0 -> V+(1 bsl 32); 223 | unsigned(_, V) when V >= 0 -> V. 224 | 225 | %% collect all symbols (and merge) 226 | dis_symb([{<<"SYMB">>, Table} | Sections], Symb0) -> 227 | Symb1 = maps:from_list( 228 | [{Sym,Value} || 229 | <> <= Table]), 231 | dis_symb(Sections, maps:merge(Symb0, Symb1)); 232 | dis_symb([_ | Sections], Symb) -> 233 | dis_symb(Sections, Symb); 234 | dis_symb([], Symb) -> 235 | Symb. 236 | 237 | 238 | 239 | 240 | -------------------------------------------------------------------------------- /src/chine_opt.erl: -------------------------------------------------------------------------------- 1 | %%% @author Tony Rogvall 2 | %%% @copyright (C) 2021, Tony Rogvall 3 | %%% @doc 4 | %%% getopt 5 | %%% @end 6 | %%% Created : 18 Mar 2021 by Tony Rogvall 7 | 8 | -module(chine_opt). 9 | 10 | -export([parse/2]). 11 | -export([value/2, value/3]). 12 | -export([usage/2, short_usage/2]). 13 | -export([format_usage/2]). 14 | -export([format_short_usage/1]). 15 | -export([format_error/3]). 16 | 17 | %% create default from option list 18 | -export([create/1]). 19 | 20 | value(Key, Opts) -> 21 | maps:get(Key, Opts). 22 | 23 | value(Key, Opts, Default) -> 24 | maps:get(Key, Opts, Default). 25 | 26 | parse(SpecList, Args) -> 27 | parse_options(Args, SpecList, [], create(SpecList)). 28 | 29 | parse_options([[$-,$-|String]|Args], SpecList, Acc, Opts) -> 30 | parse_long_option(String, Args, SpecList, Acc, Opts); 31 | parse_options([[$-|String]|Args], SpecList, Acc, Opts) -> 32 | parse_short_option(String, Args, SpecList, Acc, Opts); 33 | parse_options([Arg|Args], SpecList, Acc, Opts) -> 34 | parse_options(Args, SpecList, [Arg|Acc], Opts); 35 | parse_options([], _SpecList, Acc, Opts) -> 36 | {ok, {Opts, lists:reverse(Acc)}}. 37 | 38 | %% long option 39 | %% --key=value 40 | %% --key value 41 | parse_long_option(String, Args, SpecList, Acc, Opts) -> 42 | case string:chr(String, $=) of 43 | 0 -> 44 | parse_long_option_(String, Args, SpecList, Acc, Opts); 45 | I -> 46 | Name=string:substr(String,1,I-1), 47 | Value=string:substr(String,I+1), 48 | parse_long_option_(Name, [Value|Args], SpecList, Acc, Opts) 49 | end. 50 | 51 | parse_long_option_(Long, Args, SpecList, Acc, Opts) -> 52 | case find_long(Long, SpecList) of 53 | false -> 54 | {error, ["unknown option --",Long]}; 55 | #{ key := Key, type := Type } -> 56 | if Args =:= [], type =:= boolean -> 57 | parse_options(Args, SpecList, Acc, Opts#{ Key => true }); 58 | Args =:= [] -> 59 | {error, ["value range ", [Long]]}; 60 | true -> 61 | Args1 = tl(Args), 62 | case parse_option_value(Type, hd(Args)) of 63 | false when Type =:= boolean -> 64 | parse_options(Args1, SpecList, Acc, 65 | Opts#{ Key => true }); 66 | false -> 67 | {error, ["value range ", [Long]]}; 68 | {true,Value} -> 69 | parse_options(Args1, SpecList, Acc, 70 | Opts#{ Key => Value }) 71 | end 72 | end 73 | end. 74 | 75 | %% short option 76 | %% -k value 77 | %% -kvalue 78 | %% -k[lmn] (boolean) 79 | parse_short_option([Short|StrValue], Args, SpecList, Acc, Opts) -> 80 | case find_short([Short], SpecList) of 81 | false -> 82 | {error, ["unknown option ",[$-,Short]]}; 83 | Spec when StrValue =:= "" -> 84 | parse_short_value(Spec, Args, SpecList, Acc, Opts); 85 | #{ key := Key, type := Type } -> 86 | case parse_option_value(Type, StrValue) of 87 | false when Type =:= boolean -> 88 | parse_short_option(StrValue,Args,SpecList,Acc, 89 | Opts#{ Key => true }); 90 | false -> 91 | {error, ["value range ", [Short]]}; 92 | {true, Value} -> 93 | parse_options(Args, SpecList, Acc, Opts#{ Key => Value }) 94 | end 95 | end. 96 | 97 | parse_short_value(#{ key := Key, short := Short, type := Type}, 98 | Args0=[StrValue|Args], SpecList, Acc, Opts) -> 99 | case parse_option_value(Type, StrValue) of 100 | false when Type =:= boolean -> 101 | parse_options(Args0, SpecList, Acc, Opts#{ Key => true }); 102 | false -> 103 | {error, ["value range ", [Short]]}; 104 | {true, Value} -> 105 | parse_options(Args, SpecList, Acc, Opts#{ Key => Value }) 106 | end; 107 | parse_short_value(#{ key := Key, short := Short, type := Type}, 108 | [], SpecList, Acc, Opts) -> 109 | if Type =:= boolean -> 110 | parse_options([], SpecList, Acc, Opts#{ Key => true }); 111 | true -> 112 | {error, ["value range ", [Short]]} 113 | end. 114 | 115 | find_long(Name, [Spec=#{ long := Name} | _]) -> 116 | Spec; 117 | find_long(Name, [_|SpecList]) -> 118 | find_long(Name, SpecList); 119 | find_long(_Name, []) -> 120 | false. 121 | 122 | find_short(Name, [Spec=#{ short := Name} | _]) -> 123 | Spec; 124 | find_short(Name, [_|SpecList]) -> 125 | find_short(Name, SpecList); 126 | find_short(_Name, []) -> 127 | false. 128 | 129 | parse_option_value(boolean, "1") -> {true,true}; 130 | parse_option_value(boolean, "0") -> {true,false}; 131 | parse_option_value(integer, Value) -> 132 | case string:to_integer(Value) of 133 | {Int,[]} -> {true, Int}; 134 | _ -> false 135 | end; 136 | parse_option_value(float, Value) -> 137 | case string:to_integer(Value) of 138 | {Float,[]} -> {true,Float}; 139 | _ -> false 140 | end; 141 | parse_option_value(_Type, [$-|_]) -> false; 142 | parse_option_value(string, Value) -> {true,Value}; 143 | parse_option_value(atom, Value) -> {true,list_to_atom(Value)}; 144 | parse_option_value(_, _) -> false. 145 | 146 | %% Setup default values 147 | create(SpecList) -> 148 | create(SpecList, #{}). 149 | create([Spec = #{ key := Key} |SpecList], Opts) -> 150 | create(SpecList, 151 | Opts#{ Key => maps:get(default, Spec, undefined)}); 152 | create([], Opts) -> 153 | Opts. 154 | 155 | format_error(_SpecList,Prog,Error) -> 156 | [Prog,":","error ", Error]. 157 | 158 | usage(SpecList, Prog) -> 159 | io:put_chars(format_usage(SpecList, Prog)). 160 | 161 | short_usage(SpecList, Prog) -> 162 | io:put_chars(["Usage: ",Prog," ", format_short_usage(SpecList), "\n"]). 163 | 164 | format_usage(SpecList, Prog) -> 165 | ["Usage: ", Prog, " ", format_short_usage(SpecList), "\n", 166 | [begin 167 | Short = maps:get(short, Spec), 168 | Long = maps:get(long, Spec), 169 | Description = maps:get(description, Spec, ""), 170 | [" -",Short,", --",Long, fill(length(Long),15), " ", 171 | Description,"\n"] 172 | end || Spec <- SpecList]]. 173 | 174 | %% FIXME? collect boolean in one group? 175 | format_short_usage([Spec|SpecList]) -> 176 | Short = maps:get(short, Spec), 177 | Key = maps:get(key, Spec), 178 | case maps:get(type, Spec) of 179 | boolean -> 180 | [["[",[$-|Short],"] "] | 181 | format_short_usage(SpecList)]; 182 | _ -> 183 | [["[",[$-|Short]," <",atom_to_list(Key),">] "] | 184 | format_short_usage(SpecList)] 185 | end; 186 | format_short_usage([]) -> 187 | []. 188 | 189 | fill(N, W) when N < W -> 190 | lists:duplicate(W-N, $\s); 191 | fill(_, _) -> 192 | "". 193 | 194 | 195 | 196 | -------------------------------------------------------------------------------- /src/chine_pack.erl: -------------------------------------------------------------------------------- 1 | %%% @author Tony Rogvall 2 | %%% @copyright (C) 2021, Tony Rogvall 3 | %%% @doc 4 | %%% Pack chine into executable script 5 | %%% @end 6 | %%% Created : 15 Mar 2021 by Tony Rogvall 7 | 8 | -module(chine_pack). 9 | 10 | -export([start/1, exe_type/1]). 11 | -export([pack/2]). 12 | 13 | -define(NL, "\n"). 14 | %% -define(NL, "\r\n"). 15 | 16 | -define(HERE, "50F645CD7C7209972B48C3220959677A"). 17 | -define(LINE_LENGTH, 76). 18 | 19 | %% 20 | %% Usage: chine_pack code.x code 21 | %% 22 | 23 | start([ChineFile]) -> 24 | pack(ChineFile, standard_io), 25 | halt(0); 26 | start([ChineFile,OutFile]) -> 27 | pack(ChineFile,OutFile), 28 | halt(0); 29 | start(_) -> 30 | io:format("usage: chine_pack file.x [command.sh]\n"). 31 | 32 | pack(ChineFile,standard_io) -> 33 | pack_(ChineFile,standard_io); 34 | pack(ChineFile,OutFile) -> 35 | case file:open(OutFile, [write]) of 36 | {ok,Fd} -> 37 | try pack_(ChineFile,Fd) of 38 | Res -> Res 39 | after 40 | file:close(Fd) 41 | end; 42 | {error,Reason} -> 43 | io:format("file error: unable to open output file ~p : ~p\n", 44 | [OutFile, Reason]), 45 | halt(1) 46 | end. 47 | 48 | pack_(ChineFile,Fd) -> 49 | Dir = code:priv_dir(chine), 50 | {ok,DirList} = file:list_dir(Dir), 51 | ExeList = 52 | lists:foldl( 53 | fun(File="chine_exec."++_, Acc) -> 54 | ExeFile = filename:join(Dir, File), 55 | %% io:format("Added ~s\n", [ExeFile]), 56 | case read_exe(ExeFile) of 57 | {ok,Exe} -> 58 | [Exe|Acc]; 59 | Error = {error,_} -> 60 | io:format("unable to read ~s: ~p\n", [ExeFile,Error]) 61 | end; 62 | (_, Acc) -> Acc %% ignore other files 63 | end, [], DirList), 64 | %% Darwin 17 do not have uname -o use uname -s instead 65 | %% Emit machine detection 66 | io:put_chars(Fd, 67 | ["#!/bin/bash", ?NL, 68 | "KERNEL=`uname -s`", ?NL, 69 | "MACHINE=`uname -m`", ?NL, 70 | "if [ \"$KERNEL\" = \"Darwin\" ]; then", ?NL, 71 | "OPERATING_SYSTEM=$KERNEL",?NL, 72 | "else",?NL, 73 | "OPERATING_SYSTEM=`uname -o`",?NL, 74 | "fi",?NL, 75 | "OM=\"$OPERATING_SYSTEM-$MACHINE\"",?NL, 76 | "chmod -f +wx $0",?NL 77 | ]), 78 | ZeroSize = lists:max([byte_size(Bin) || {_TypeMap,Bin} <- ExeList]), 79 | LineBytes = ?LINE_LENGTH + length(?NL), 80 | NZBytes = ((ZeroSize + LineBytes - 1) div LineBytes)*?LINE_LENGTH, 81 | Zs = erlang:iolist_to_binary(lists:duplicate(NZBytes,$0)), 82 | ZData = make_rows(Zs, ?LINE_LENGTH), 83 | %% Outout Zero Area 84 | io:put_chars(Fd, 85 | ["if [ -n \"\" ]; then", ?NL, 86 | "true <<", ?HERE, ?NL, 87 | ZData, 88 | ?HERE, ?NL 89 | ]), 90 | %% Output executables 91 | lists:foreach( 92 | fun({TypeMap,Bin}) -> 93 | Data = format_exe(TypeMap,Bin), 94 | io:put_chars(Fd, Data) 95 | end, ExeList), 96 | %% Output chine code 97 | {ok,Chine} = file:read_file(ChineFile), 98 | Chine1 = zeropad(Chine, 38), 99 | ChineData = format_hex(Chine1), %% store chine code as hex data 100 | %% io:format("Chine code size = ~w padded to ~w\n", 101 | %% [byte_size(Chine), byte_size(Chine1)]), 102 | %% 8 hex characters for as offset to program start 103 | Tail = erlang:iolist_to_binary( 104 | [ChineData, 105 | ?HERE, ?NL, 106 | "fi", ?NL, 107 | ": "]), 108 | TailLen = tl(integer_to_list(16#100000000+byte_size(Tail)+9,16)), 109 | io:put_chars(Fd, 110 | ["else", ?NL, 111 | "true <<", ?HERE, ?NL, 112 | Tail, TailLen, ?NL]). 113 | 114 | zeropad(Bin, M) -> 115 | Size = byte_size(Bin), 116 | Pad = (M - (Size rem M)) rem M, 117 | <>. 118 | 119 | read_exe(File) -> 120 | case exe_type(File) of 121 | {ok, TypeMap} -> 122 | {ok,Bin} = file:read_file(File), 123 | {ok,{TypeMap,Bin}}; 124 | Error -> 125 | Error 126 | end. 127 | 128 | format_exe(TypeMap, Bin) -> 129 | Data = format_gzip_base64(Bin), 130 | UName = make_uname(TypeMap), 131 | %% oflag=seek_bytes (not needed, not avail on Darwin 17.7) 132 | DD = "dd of=$0 conv=notrunc seek=0 2>/dev/null", 133 | Base64 = "base64 --decode", 134 | UnZip = "gunzip", 135 | [["elif [ \"$OM\" = \"",UName,"\" ]; then", ?NL], 136 | "( ", Base64, " | ", UnZip, " | ", DD, ") <<", ?HERE, ?NL, 137 | Data, 138 | ?HERE, ?NL, 139 | "exec $0 $0", ?NL 140 | ]. 141 | 142 | format_hex(Bin) -> 143 | make_rows(hex_encode(Bin), ?LINE_LENGTH). 144 | 145 | format_gzip_base64(Bin) -> 146 | Bin1 = zlib:gzip(Bin), 147 | make_rows(base64:encode(Bin1), ?LINE_LENGTH). 148 | 149 | hex_encode(Binary) -> 150 | erlang:iolist_to_binary(hex_encode_(Binary)). 151 | 152 | hex_encode_(<>) -> 153 | Hex = {$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$A,$B,$C,$D,$E,$F}, 154 | [element(H+1,Hex),element(L+1,Hex)|hex_encode_(Bin)]; 155 | hex_encode_(<<>>) -> 156 | []. 157 | 158 | exe_type(File) -> 159 | case read_header(File, 256) of 160 | {ok, Header} -> 161 | case elf(Header) of 162 | {true, TypeMap} -> 163 | {ok, TypeMap}; 164 | false -> 165 | case macho(Header) of 166 | {true, TypeMap} -> 167 | {ok, TypeMap}; 168 | false -> 169 | case coff(Header) of 170 | {true, TypeMap} -> 171 | {ok, TypeMap}; 172 | false -> 173 | {error, unknown_type} 174 | end 175 | end 176 | end; 177 | Error -> 178 | Error 179 | end. 180 | 181 | make_rows(Data, LineLength) -> 182 | case Data of 183 | <> -> 184 | [Line, ?NL | make_rows(Data1, LineLength)]; 185 | <<>> -> 186 | []; 187 | <> -> 188 | [Line, ?NL] 189 | end. 190 | 191 | make_uname(#{ operating_system := O, machine := M }) -> 192 | O ++ "-" ++ M. 193 | 194 | -define(MH_MAGIC, 16#feedface). %% the mach magic number 195 | -define(MH_CIGAM, 16#cefaedfe). %% NXSwapInt(MH_MAGIC) 196 | -define(MH_MAGIC_64, 16#feedfacf). %% the 64-bit mach magic number 197 | -define(MH_CIGAM_64, 16#cffaedfe). %% NXSwapInt(MH_MAGIC_64) 198 | -define(FAT_MAGIC, 16#cafebabe). 199 | -define(FAT_CIGAM, 16#bebafeca). 200 | 201 | -define(CPU_ARCH_MASK, 16#ff000000). %% mask for architecture bits 202 | -define(CPU_ARCH_ABI64, 16#01000000). %% 64 bit ABI 203 | 204 | -define(CPU_TYPE_X86, (7)). 205 | -define(CPU_TYPE_I386, ?CPU_TYPE_X86). %% compatibility 206 | -define(CPU_TYPE_X86_64, (?CPU_TYPE_X86 bor ?CPU_ARCH_ABI64)). 207 | -define(CPU_TYPE_ARM, (12)). 208 | -define(CPU_TYPE_POWERPC, (18)). 209 | -define(CPU_TYPE_POWERPC64, (?CPU_TYPE_POWERPC bor ?CPU_ARCH_ABI64)). 210 | 211 | macho(Header) -> 212 | {W,E,C} = case Header of 213 | <> -> 214 | {32,big,CPU}; 215 | <> -> 216 | {32,little,CPU}; 217 | <> -> 218 | {64,big,CPU}; 219 | <> -> 220 | {64,little,CPU}; 221 | <> -> 222 | {fat,big,CPU}; 223 | <> -> 224 | {fat,little,CPU}; 225 | _ -> {0, unknown,0} 226 | end, 227 | %% io:format("macho w=~w, e=~w, c=~w\n", [W,E,C]), 228 | M = case C of 229 | ?CPU_TYPE_I386 -> "i386"; 230 | ?CPU_TYPE_X86_64 -> "x86_64"; 231 | ?CPU_TYPE_ARM -> "arm"; 232 | ?CPU_TYPE_POWERPC -> "powerpc"; 233 | ?CPU_TYPE_POWERPC64 -> "powerpc64"; 234 | _ -> "" 235 | end, 236 | if M =:= "" -> 237 | false; 238 | true -> 239 | {true, 240 | #{ operating_system => "Darwin", 241 | machine => M, 242 | type => exe, 243 | word_size => W, 244 | endian => E }} 245 | end. 246 | 247 | -define(SHORT(X), X:16/signed-little). 248 | -define(USHORT(X), X:16/unsigned-little). 249 | -define(DWORD(X), X:32/unsigned-little). 250 | -define(ULONG(X), X:32/unsigned-little). 251 | -define(LONG(X), X:32/signed-little). 252 | 253 | -define(USHORT_(N), _:N/unit:16). 254 | -define(ULONG_(N), _:N/unit:32). 255 | 256 | %% e_magic 257 | -define(IMAGE_DOS_SIGNATURE, 16#5A4D). %% MZ 258 | -define(IMAGE_OS2_SIGNATURE, 16#454E). %% NE 259 | -define(IMAGE_OS2_SIGNATURE_LE, 16#454C). %% LE 260 | -define(IMAGE_NT_SIGNATURE, 16#00004550). %% PE00 261 | 262 | -define(SIZE_OF_NT_SIGNATURE, 4). %% sizeof (DWORD) - 32 bit 263 | 264 | -define(IMAGE_DOS_HEADER, 265 | ?USHORT(E_magic), %% Magic number 266 | ?USHORT(E_cblp), %% Bytes on last page of file 267 | ?USHORT(E_cp), %% Pages in file 268 | ?USHORT(E_crlc), %% Relocations 269 | ?USHORT(E_cparhdr), %% Size of header in paragraphs 270 | ?USHORT(E_minalloc), %% Minimum extra paragraphs needed 271 | ?USHORT(E_maxalloc), %% Maximum extra paragraphs needed 272 | ?USHORT(E_ss), %% Initial (relative) SS value 273 | ?USHORT(E_sp), %% Initial SP value 274 | ?USHORT(E_csum), %% Checksum 275 | ?USHORT(E_ip), %% Initial IP value 276 | ?USHORT(E_cs), %% Initial (relative) CS value 277 | ?USHORT(E_lfarlc), %% File address of relocation table 278 | ?USHORT(E_ovno), %% Overlay number 279 | ?USHORT_(4), %% E_res[4] Reserved words 280 | ?USHORT(E_oemid), %% OEM identifier (for e_oeminfo) 281 | ?USHORT(E_oeminfo), %% OEM information; e_oemid specific 282 | ?USHORT_(10), %% e_res2[10] Reserved words 283 | ?LONG(E_lfanew) %% File address of new exe header 284 | ). 285 | 286 | -define(IMAGE_FILE_HEADER, 287 | ?USHORT(Machine), 288 | ?USHORT(NumberOfSections), 289 | ?ULONG(TimeDateStamp), 290 | ?ULONG(PointerToSymbolTable), 291 | ?ULONG(NumberOfSymbols), 292 | ?USHORT(SizeOfOptionalHeader), 293 | ?USHORT(Characteristics) 294 | ). 295 | 296 | %% Windows object code format 297 | coff(Header) -> 298 | case Header of 299 | <> when E_magic =:= ?IMAGE_DOS_SIGNATURE -> 300 | %% io:format("e_lfanew: ~w\n", [E_lfanew]), 301 | case Header of 302 | <<_:E_lfanew/binary, 303 | ?USHORT(?IMAGE_OS2_SIGNATURE),_/binary>> -> 304 | {true, 305 | #{ operating_system => "OS/2", 306 | machine => "x86", 307 | type => exe, 308 | word_size => 16, 309 | endian => big }}; 310 | <<_:E_lfanew/binary, 311 | ?USHORT(?IMAGE_OS2_SIGNATURE_LE),_/binary>> -> 312 | {true, 313 | #{ operating_system => "OS/2", 314 | machine => "x86", 315 | type => exe, 316 | word_size => 16, 317 | endian => little }}; 318 | <<_:E_lfanew/binary, ?DWORD(?IMAGE_NT_SIGNATURE), 319 | ?IMAGE_FILE_HEADER, _/binary>> -> 320 | {M,W,E} = 321 | case Machine of 322 | 16#14c -> {"i386", 32, little}; 323 | 16#8664 -> {"x86_64", 64, little}; 324 | 16#1c0 -> {"arm", 32, little}; 325 | 16#aa64 -> {"arm64", 64, little}; 326 | 16#1c2 -> {"thumb", 16,little}; 327 | 16#1c4 -> {"thumb2", 16,little}; 328 | 16#5032 -> {"riscv32", 32, little}; 329 | 16#5064 -> {"riscv64", 64, little}; 330 | 16#50128-> {"riscv128", 128, little}; 331 | _ -> {"", 0, unknown} 332 | end, 333 | if M =:= "" -> 334 | false; 335 | true -> 336 | {true, 337 | #{ %% operating_system => "Windows", 338 | %% FIXME 339 | operating_system => "Cygwin", 340 | machine => M, 341 | type => exe, 342 | word_size => W, 343 | endian => E }} 344 | end; 345 | _ -> 346 | {true, 347 | #{ operating_system => "Dos", 348 | machine => "x86", 349 | type => exe, 350 | word_size => 16, 351 | endian => little }} 352 | end; 353 | _ -> 354 | false 355 | end. 356 | 357 | -define(EV_CURRENT, 1). %% Current version 358 | 359 | -define(ET_EXEC, 2). %% Executable file 360 | -define(ET_DYN, 3). %% Shared object file 361 | 362 | -define(EI_VERSION, 6). 363 | 364 | -define(ELFDATANONE, 0). %% Invalid data encoding 365 | -define(ELFDATA2LSB, 1). %% 2's complement, little endian 366 | -define(ELFDATA2MSB, 2). %% 2's complement, big endian 367 | 368 | -define(ELFCLASSNONE, 0). %% Invalid class 369 | -define(ELFCLASS32, 1). %% 32-bit objects 370 | -define(ELFCLASS64, 2). %% 64-bit objects 371 | 372 | -define(EM_386, 3). %% Intel 80386 373 | -define(EM_X86_64, 62). %% AMD x86-64 architecture 374 | -define(EM_ARM, 40). %% ARM 375 | -define(EM_RISCV, 243). %% RISC-V 376 | 377 | elf(Header) -> 378 | case Header of 379 | <<"\177ELF", 380 | EI_CLASS, EI_DATA, ?EV_CURRENT, _EI_OSABI, 381 | _EI_ABIVERSION, _EI_PAD, _, _, _, _, _, _, 382 | TypeMachine:4/binary, _/binary>> -> 383 | Endian = if EI_DATA == ?ELFDATA2LSB -> little; 384 | EI_DATA == ?ELFDATA2MSB -> big; 385 | EI_DATA == ?ELFDATANONE -> none 386 | end, 387 | WSize = if EI_CLASS == ?ELFCLASS32 -> 32; 388 | EI_CLASS == ?ELFCLASS64 -> 64; 389 | EI_CLASS == ?ELFCLASSNONE -> 0 390 | end, 391 | if Endian =:= little -> 392 | <> = TypeMachine; 393 | Endian =:= big -> 394 | <> = TypeMachine 395 | end, 396 | {true, 397 | #{ operating_system => "GNU/Linux", 398 | machine => 399 | case Machine of 400 | ?EM_386 -> "i386"; 401 | ?EM_X86_64 -> "x86_64"; 402 | ?EM_ARM -> "armv7l"; %% fixme subtype! 403 | ?EM_RISCV -> "riscv"; 404 | _ -> Machine 405 | end, 406 | type => 407 | case Type of 408 | ?ET_EXEC -> exe; 409 | ?ET_DYN -> dyn; 410 | _ -> Type 411 | end, 412 | word_size => WSize, 413 | endian => Endian 414 | }}; 415 | _ -> 416 | false 417 | end. 418 | 419 | read_header(File, N) -> 420 | case file:open(File, [binary]) of 421 | {ok,Fd} -> 422 | Res = file:read(Fd, N), 423 | file:close(Fd), 424 | Res; 425 | Error -> 426 | Error 427 | end. 428 | --------------------------------------------------------------------------------