diff options
Diffstat (limited to 'contrib/bearssl/T0/kern.t0')
| -rw-r--r-- | contrib/bearssl/T0/kern.t0 | 309 |
1 files changed, 309 insertions, 0 deletions
diff --git a/contrib/bearssl/T0/kern.t0 b/contrib/bearssl/T0/kern.t0 new file mode 100644 index 000000000000..9fce4f84d301 --- /dev/null +++ b/contrib/bearssl/T0/kern.t0 @@ -0,0 +1,309 @@ +: \ `\n parse drop ; immediate + +\ This file defines the core non-native functions (mainly used for +\ parsing words, i.e. not part of the generated output). The line above +\ defines the syntax for comments. + +\ Define parenthesis comments. +\ : ( `) parse drop ; immediate + +: else postpone ahead 1 cs-roll postpone then ; immediate +: while postpone if 1 cs-roll ; immediate +: repeat postpone again postpone then ; immediate + +: ['] ' ; immediate +: [compile] compile ; immediate + +: 2drop drop drop ; +: dup2 over over ; + +\ Local variables are defined with the native word '(local)'. We define +\ a helper construction that mimics what is found in Apple's Open Firmware +\ implementation. The syntax is: { a b ... ; c d ... } +\ I.e. there is an opening brace, then some names. Names appearing before +\ the semicolon are locals that are both defined and then filled with the +\ values on stack (in stack order: { a b } fills 'b' with the top-of-stack, +\ and 'a' with the value immediately below). Names appearing after the +\ semicolon are not initialized. +: __deflocal ( from_stack name -- ) + dup (local) swap if + compile-local-write + else + drop + then ; +: __deflocals ( from_stack -- ) + next-word + dup "}" eqstr if + 2drop ret + then + dup ";" eqstr if + 2drop 0 __deflocals ret + then + over __deflocals + __deflocal ; +: { + -1 __deflocals ; immediate + +\ Data building words. +: data: + new-data-block next-word define-data-word ; +: hexb| + 0 0 { acc z } + begin + char + dup `| = if + z if "Truncated hexadecimal byte" puts cr exitvm then + ret + then + dup 0x20 > if + hexval + z if acc 4 << + data-add8 else >acc then + z not >z + then + again ; + +\ Convert hexadecimal character to number. Complain loudly if conversion +\ is not possible. +: hexval ( char -- x ) + hexval-nf dup 0 < if "Not an hex digit: " puts . cr exitvm then ; + +\ Convert hexadecimal character to number. If not an hexadecimal digit, +\ return -1. +: hexval-nf ( char -- x ) + dup dup `0 >= swap `9 <= and if `0 - ret then + dup dup `A >= swap `F <= and if `A - 10 + ret then + dup dup `a >= swap `f <= and if `a - 10 + ret then + drop -1 ; + +\ Convert decimal character to number. Complain loudly if conversion +\ is not possible. +: decval ( char -- x ) + decval-nf dup 0 < if "Not a decimal digit: " puts . cr exitvm then ; + +\ Convert decimal character to number. If not a decimal digit, +\ return -1. +: decval-nf ( char -- x ) + dup dup `0 >= swap `9 <= and if `0 - ret then + drop -1 ; + +\ Commonly used shorthands. +: 1+ 1 + ; +: 2+ 2 + ; +: 1- 1 - ; +: 2- 2 - ; +: 0= 0 = ; +: 0<> 0 <> ; +: 0< 0 < ; +: 0> 0 > ; + +\ Get a 16-bit value from the constant data block. This uses big-endian +\ encoding. +: data-get16 ( addr -- x ) + dup data-get8 8 << swap 1+ data-get8 + ; + +\ The case..endcase construction is the equivalent of 'switch' is C. +\ Usage: +\ case +\ E1 of C1 endof +\ E2 of C2 endof +\ ... +\ CN +\ endcase +\ +\ Upon entry, it considers the TOS (let's call it X). It will then evaluate +\ E1, which should yield a single value Y1; at that point, the X value is +\ still on the stack, just below Y1, and must remain untouched. The 'of' +\ word compares X with Y1; if they are equal, C1 is executed, and then +\ control jumps to after the 'endcase'. The X value is popped from the +\ stack immediately before evaluating C1. +\ +\ If X and Y1 are not equal, flow proceeds to E2, to obtain a value Y2 to +\ compare with X. And so on. +\ +\ If none of the 'of' clauses found a match, then CN is evaluated. When CN +\ is evaluated, the X value is on the TOS, and CN must either leave it on +\ the stack, or replace it with exactly one value; the 'endcase' word +\ expects (and drops) one value. +\ +\ Implementation: this is mostly copied from ANS Forth specification, +\ although simplified a bit because we know that our control-flow stack +\ is independent of the data stack. During compilation, the number of +\ clauses is maintained on the stack; each of..endof clause really is +\ an 'if..else' that must be terminated with a matching 'then' in 'endcase'. + +: case 0 ; immediate +: of 1+ postpone over postpone = postpone if postpone drop ; immediate +: endof postpone else ; immediate +: endcase + postpone drop + begin dup while 1- postpone then repeat drop ; immediate + +\ A simpler and more generic "case": there is no management for a value +\ on the stack, and each test is supposed to come up with its own boolean +\ value. +: choice 0 ; immediate +: uf 1+ postpone if ; immediate +: ufnot 1+ postpone ifnot ; immediate +: enduf postpone else ; immediate +: endchoice begin dup while 1- postpone then repeat drop ; immediate + +\ C implementations for native words that can be used in generated code. +add-cc: co { T0_CO(); } +add-cc: execute { T0_ENTER(ip, rp, T0_POP()); } +add-cc: drop { (void)T0_POP(); } +add-cc: dup { T0_PUSH(T0_PEEK(0)); } +add-cc: swap { T0_SWAP(); } +add-cc: over { T0_PUSH(T0_PEEK(1)); } +add-cc: rot { T0_ROT(); } +add-cc: -rot { T0_NROT(); } +add-cc: roll { T0_ROLL(T0_POP()); } +add-cc: pick { T0_PICK(T0_POP()); } +add-cc: + { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a + b); +} +add-cc: - { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a - b); +} +add-cc: neg { + uint32_t a = T0_POP(); + T0_PUSH(-a); +} +add-cc: * { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a * b); +} +add-cc: / { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSHi(a / b); +} +add-cc: u/ { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a / b); +} +add-cc: % { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSHi(a % b); +} +add-cc: u% { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a % b); +} +add-cc: < { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSH(-(uint32_t)(a < b)); +} +add-cc: <= { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSH(-(uint32_t)(a <= b)); +} +add-cc: > { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSH(-(uint32_t)(a > b)); +} +add-cc: >= { + int32_t b = T0_POPi(); + int32_t a = T0_POPi(); + T0_PUSH(-(uint32_t)(a >= b)); +} +add-cc: = { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a == b)); +} +add-cc: <> { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a != b)); +} +add-cc: u< { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a < b)); +} +add-cc: u<= { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a <= b)); +} +add-cc: u> { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a > b)); +} +add-cc: u>= { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(-(uint32_t)(a >= b)); +} +add-cc: and { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a & b); +} +add-cc: or { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a | b); +} +add-cc: xor { + uint32_t b = T0_POP(); + uint32_t a = T0_POP(); + T0_PUSH(a ^ b); +} +add-cc: not { + uint32_t a = T0_POP(); + T0_PUSH(~a); +} +add-cc: << { + int c = (int)T0_POPi(); + uint32_t x = T0_POP(); + T0_PUSH(x << c); +} +add-cc: >> { + int c = (int)T0_POPi(); + int32_t x = T0_POPi(); + T0_PUSHi(x >> c); +} +add-cc: u>> { + int c = (int)T0_POPi(); + uint32_t x = T0_POP(); + T0_PUSH(x >> c); +} +add-cc: data-get8 { + size_t addr = T0_POP(); + T0_PUSH(t0_datablock[addr]); +} + +add-cc: . { + extern int printf(const char *fmt, ...); + printf(" %ld", (long)T0_POPi()); +} +add-cc: putc { + extern int printf(const char *fmt, ...); + printf("%c", (char)T0_POPi()); +} +add-cc: puts { + extern int printf(const char *fmt, ...); + printf("%s", &t0_datablock[T0_POPi()]); +} +add-cc: cr { + extern int printf(const char *fmt, ...); + printf("\n"); +} +add-cc: eqstr { + const void *b = &t0_datablock[T0_POPi()]; + const void *a = &t0_datablock[T0_POPi()]; + T0_PUSH(-(int32_t)(strcmp(a, b) == 0)); +} |