diff --git a/BASE/LIB.BIN b/BASE/LIB.BIN new file mode 100644 index 0000000..815871e Binary files /dev/null and b/BASE/LIB.BIN differ diff --git a/BASE/MKLIB.COM b/BASE/MKLIB.COM new file mode 100755 index 0000000..df35512 Binary files /dev/null and b/BASE/MKLIB.COM differ diff --git a/BASE/S86.COM b/BASE/S86.COM new file mode 100755 index 0000000..8f784eb Binary files /dev/null and b/BASE/S86.COM differ diff --git a/BASE/T.COM b/BASE/T.COM new file mode 100755 index 0000000..fa689ee Binary files /dev/null and b/BASE/T.COM differ diff --git a/BIN/DOSFILE.COM b/BIN/DOSFILE.COM new file mode 100755 index 0000000..5e7d4fd Binary files /dev/null and b/BIN/DOSFILE.COM differ diff --git a/BIN/LIB.BIN b/BIN/LIB.BIN new file mode 100644 index 0000000..8c1d4bf Binary files /dev/null and b/BIN/LIB.BIN differ diff --git a/BIN/MKLIB.COM b/BIN/MKLIB.COM new file mode 100755 index 0000000..371d0e6 Binary files /dev/null and b/BIN/MKLIB.COM differ diff --git a/BIN/S86.COM b/BIN/S86.COM new file mode 100755 index 0000000..808483c Binary files /dev/null and b/BIN/S86.COM differ diff --git a/BIN/T.COM b/BIN/T.COM new file mode 100755 index 0000000..585578b Binary files /dev/null and b/BIN/T.COM differ diff --git a/CHANGES.TXT b/CHANGES.TXT new file mode 100644 index 0000000..3903757 --- /dev/null +++ b/CHANGES.TXT @@ -0,0 +1,34 @@ + 2022-10-08 @humbertocsjr + + - Added low level functions on library + + + 2022-09-09 + + - Fix: frame allocation sometimes failed in the main program. + Huh. How did this one survive so long? + + 2022-09-08 + + - Fix: below fix did not cover the main program body. + + 2022-09-07 + + - Fix: compound statements now deallocate local storage when + exiting via LEAVE or LOOP. + + 2022-08-31 + + - Fixed MOD operator (should be unsigned) + + 2021-05-01 + + - moved normalizing comparison operations to library + to save space + - Added T3X.OAPPND mode to T.OPEN + - Added S86 assembler (for compiling LIB.S86) + + 2021-04-29 + + - Rewrote T3X/Z (CP/M-Z80 version) to generate DOS/8086 code. + diff --git a/DOCS/S86.TXT b/DOCS/S86.TXT new file mode 100644 index 0000000..8fa9245 --- /dev/null +++ b/DOCS/S86.TXT @@ -0,0 +1,199 @@ + + S86 -- An Assembler for an 8086 Subset + Nils M Holm, 1998-2021 + Public domain / 0BSD license + + + USAGE + + S86 [input-file [output-file]] + + + SUMMARY + + S86 reads an 8086 assembly language program in S86 format and + writes a pure text image file. Any errors found in the input + program will be reported on SYSERR. + + When both an input file and an output file are specified, it + reads the given input file and writes to the given output file. + When only an input file is given, it will append a '.S86' suffix + to the input file and a '.COM' suffix to the output file. When + neither is given, it will read from SYSIN and write to SYSOUT. + + + PROGRAM FORMAT + + S86 accepts input programs in its own format which is similar + to the MASM source format, although some mnemonics and + conventions are different. Generally, statements are written in + the form + + INSTRUCTION DESTINATION,SOURCE ; OPTIONAL COMMENT + + A semicolon may be used to introduce a comment which extends up + to the end of the current line. All labels must be delimited + with a colon -- even in data definitions: + + xyz: dw 0 + + The following mnemonics will be accepted by S86: + + aaa aad aam aas adc add and call cbw clc cld cli cmc cmp + cmpsb cmpsw cseg cwd daa das dec div dseg eseg hlt idiv + imul inb inc int into inw iret ja jae jb jbe jc jcxz je jg + jge jl jle jmp jmps jnc jne jno jnp jns jnz jo jp js jz + lahf lock lodsb lodsw loop loopnz loopz mov movsb movsw mul + neg nop not or outb outw pop popf push pushf rcl rcr rep + repnz repz ret rol ror sahf sal sar sbb scasb scasw shl shr + sseg stc std sti stosb stosw sub test wait xchg xlat xor + + All mnemonics must be written in lower case. + + S86 does not use instruction prefixes. Therefore, instructions + like cseg, repz, etc must always be placed in a separate line. + + Operands may be prefixed with the modifiers 'byte', 'word', or + 'offset'. 'offset' computes the address of an object. E.g., + + mov ax,offset obj + + loads the address of 'obj' into the 'ax' register rather then + the value stored at location 'obj'. 'byte' and 'word' are used + to specify the size of an operand explicitly. If not specified, + S86 attempts to find out the size by checking the registers + involved. If no registers are used, it defaults to word size. + + Some instructions like 'outw', 'stosb', etc have an implicit + operand size which is indicated by the last character in their + name. No modifiers may be applied to such instructions. There + is no MASM-style 'short' modifier in the S86 syntax. Instead, + the 'jmps' instruction is used to code unconditional short + jumps. + + Numeric literals may be written in decimal notation with an + optional leading minus sign or in hexa-decimal notation + with a leading dollar sign ($). The hex digits 10 through 15 + are represented by 'A'...'F'. Lower case characters will not + be accepted in hex numbers. ASCII characters may be used in + the place of numeric values when enclosing them in apostrophes. + For example, 'A' is the same as 65 or $41. + + Registers are written in all lower case characters. They may + not be used as symbolic names. The following names are reserved + for registers. + + 16-bit registers: ax, bx, cx, dx, si, di, bp, sp + 8-bit registers: al, bl, cl, dl, ah, bh, ch, dh + segment registers: cs, ds, es, ss + + The following indirect addressing modes are recognized: + + [si], [di], [bx], [bx+si], [bx+di], [bp+si], [bp+di], + [bp], [bp+disp], [bx+disp], [si+disp], [di+disp] + + 'disp' denotes either an 8-bit or a 16-bit displacement. + Displacements may be negative, too. + + Offsets can also be used in combination with indirect addressing + by prefixing a symbol with the '@' operator. For instance, + + [si+@foo] + + would address the si'th byte (or word) after the address of + the symbol 'foo'. In this case '@foo' is a 16-bit displacement. + + + COMMANDS + + S86 understands the following commands (pseudo instructions): + + .text [origin] + + Specify the origin of the emitted code, i.e. the address of + the first instruction being emitted. If no origin is specified, + it defaults to 0. The origin is the address at which the output + program will be loaded at run time. For DOS COM files, the + origin must be $100. + + [name:] db item , ... + [name:] dw item , ... + + Emit the specified list of data items. An item may have one out + of the following formats: + + Number -- Numeric literals are included as the values they + represent. In 'db' commands, their range is limited to the + range -128...255. + + String -- A string is written as a sequence of characters + enclosed by double quotes ("). Each character is compiled + literally. In dw instructions, each character is placed in the + low byte of a separate word. + + Offset -- The notation 'offset symbol' compiles the address of + the specified symbol. + + name: equ value + + Assign 'value' to the address field of the label 'name'. Equ + allows to access the absolute memory location with the address + 'value' using the label 'name'. When defining + + there: equ 1024 + + for example, the statement + + mov al,there + + would load al with the content of memory location ds:1024. + + + OUTPUT FILE FORMAT + + The output format of S86 is pure text with no header and no + data segment. Therefore, a '.data' or '.bss' command is not + recognized. All program data must be placed in the text segment. + + When placing data in the text segment, segments must be set up + such that cs = ds. Otherwise access to data must be prefixed + with a 'cseg' instruction: + + .text + cseg + mov ax,data + ... + data: dw 0 + + When DOS loads a COM file, all segments will be aligned with + the text segment, i.e. cs = ds = es = ss, so no xseg prefixes + are needed. + + The default entry point of S86 programs is cs:0, for COM files, + it must be changed to cs:$100. + + + SKELETON PROGRAM + + This program skeleton illustrates how to write COM-style DOS + programs using S86: + + .text $100 ; the same as ORG 100H + jmp code + data: dw 0 + code: + ; + ; Insert your code here + ; + ; Segments will be set up as follows: ds = es = ss = cs + ; + ; 'data' will be located at ds:$103 + ; ($100 + size of jmp instruction) + + + BUGS AND LIMITATIONS + + Not all 8086 addressing modes are recognized. + + The output program size is limited to 16KB. + diff --git a/DOCS/T3X86.TXT b/DOCS/T3X86.TXT new file mode 100644 index 0000000..380aabd --- /dev/null +++ b/DOCS/T3X86.TXT @@ -0,0 +1,995 @@ + + + ################ ############ ###### ###### + ## ## ## ## ## ## ## ## + ###### ###### ####### ## ## ### ## + ## ## ## ## ## ## + ## ## ####### ## ## ### ## + ## ## ## ## ## ## ## ## + ######## ############ ###### ###### + + ----==[ A MINIMAL PROCEDURAL LANGUAGE ]==---- + ----------==[ LOW LEVEL EDITION ]==---------- + + + PROGRAM + *-------* + + A program is a set of declarations followed by a compound + statement. Here is the minimal T3X program: + + DO END + + + COMMENTS + *--------* + + A comment is started with an exclamation point (!) and extends + up to the end of the current line. Example: + + DO END ! Do nothing + + + DECLARATIONS + *------------* + + + -----[ CONST name = cvalue, ... ; ]----------------------------- + + Assign names to constant values. + + Example: CONST FALSE = 0, TRUE = %1; + + + VAR name, ... ; + -----[ VAR name[cvalue], ... ; ]-------------------------------- + VAR name::cvalue, ... ; + + Define variables, vectors, and byte vectors, respectively. + Different definitions may be mixed. Vector elements start at + an index of 0. + + Example: VAR stack[STACK_LEN], ptr; + + + -----[ STRUCT name = name_1, ..., name_N; ]--------------------- + + Shorthand for + + CONST name_1 = 0, ..., name_N = N-1, name = N; + + Used to impose structure on vectors and byte vectors. + + Example: STRUCT POINT = PX, PY, PCOLOR; + VAR p[POINT]; + + + -----[ DECL name(cvalue), ... ; ]------------------------------- + + Forward-declare functions whose declarations follow later, where + the cvalue is the number of arguments. Used to implement mutual + recursion. + + Example: DECL odd(1); + even(x) RETURN x=0-> 1: odd(x-1); + odd(x) RETURN x=0-> 0: even(x-1); + + + -----[ name(name_1, ...) statement ]---------------------------- + + Declare function "name" with arguments "name_1", ... and a + statement as its body. The number of arguments must match + any previous forward declaration (DECL) of the same function. + + The arguments of a function are only visible inside of the + statement of the function. + + Example: hello(s, x) DO VAR i; + FOR (i=0, x) DO + writes(s); + writes("\r\n"); + END + END + + (WRITES() writes a string; it is defined later in this text.) + + + -----[ MODULE name(T3X); ]-------------------------------------- + OBJECT T[T3X]; + + These are optional boiler-plate definitions in T3X/Z which, when + used, must appear in exactly this form at the beginning of a + program. The only variable part in these declarations is the + "name" part, which may be any T3X symbol name. + + In the full T3X language, these declarations import the T3X base + class and instantiate it as the object "t". This is required in + order to send message like OPEN or MEMCOPY to the base class. + + In the T3X/Z language, all runtime functions are intrinsic and + need not be instantiated, so the above statements are basically + null operations. + + By including these declarations, a T3X/Z program can often be + compiled using full T3X without modification. + + + STATEMENTS + *----------* + + + -----[ name := expression; ]------------------------------------ + + Assign the value of an expression to a variable. + + Example: DO VAR x; x := 123; END + + + -----[ name[value]... := value; ]------------------------------- + name::value := value; + + Assign the value of an expression to an element of a vector + or a byte vector. Multiple subscripts may be applied to to a + vector: + + vec[i][j]... := i*j; + + In general, vec[i][j] denotes the J'th element of the I'th + element of vec. + + Note that the :: operator is right-associative, so v::x::i + equals v::(x::i). This is particularly important when mixing + subscripts, so that + + vec[i]::j[k] := 0; + + would assign 0 to the j[k]'th element of vec[i]. (This makes + sense, because vec[i]::j would not deliver a valid address.) + + + -----[ name(); ]------------------------------- + name(expression_1, ...); + + Call the function with the given name, passing the values of the + expressions to the function. An empty set of parentheses is used + to pass zero arguments. The result of the function is discarded. + + For further details see the description of function calls in the + expression section. + + + -----[ CALL pp(); ]---------------------------- + CALL pp(expression_1, ...); + + Call the procedure whose address is stored in the variable PP (a + procedure pointer). No arity checking is performed, the user is + responsible for passing the proper number of arguments to the + procedure. A procedure pointer is retrieved by applying the + address operator @ to a procedure (this works even in tables). + + Example: p(s, k) t.write(T3X.SYSOUT, s, k); + DO VAR pp; + pp := @p; + CALL pp("Test\r\n", 6); + END + + + -----[ IF (condition) statement_1 ]------------ + IE (condition) statement_1 ELSE statement_2 + + Both of these statements run statement_1, if the given + condition is true. + + In addition, IE/ELSE runs statement_2, if the conditions is + false. IF just passes control to the subsequent statement in + this case. + + Example: IE (0) + IF (1) RETURN 1; + ELSE + RETURN 2; + + The example always returns 2, because only an IE statement can + have an ELSE branch. There is no "dangling else" problem. + + + -----[ WHILE (condition) statement ]---------------------------- + + Repeat the statement while the condition is true. When the + condition is not true initially, never run the statement. + + Example: ! Count from 0 to 9 + DO VAR i; + i := 0; + WHILE (i < 10) + i := i+1; + END + + + ---[ FOR (c = expression_1, expression_2, cvalue) statement ]--- + FOR (c = expression_1, expression_2) statement + + Assign the value of expression_1 to the counter variable C, then + compare C to expression_2. If the given cvalue is not negative, + repeat the statement while C < expression_2. Otherwise repeat the + statement while C > expression_2. After running the statement, + add the cvalue to C. Formally: + + c := expression_1; + WHILE ( cvalue > 0 /\ c < expression \/ + cvalue < 0 /\ c > expression ) + DO + statement + c := c + cvalue; + END + + When the cvalue is omitted, it defaults to 1. + + Example: DO VAR i; + FOR (i=1, 11); ! count from 1 to 10 + FOR (i=10, 0, %1); ! count from 10 to 1 + END + + + -----[ LEAVE; ]------------------------------------------------- + + Leave the innermost WHILE or FOR loop, passing control to the + first statement following the loop. + + Example: DO VAR i; + ! Count from 1 to 50 + FOR (i=1, 100) IF (i=50) LEAVE; + END + + + -----[ LOOP; ]-------------------------------------------------- + + Re-enter the innermost WHILE or FOR loop. WHILE loops are + re-entered at the point where the condition is tested, and + FOR loops are re-entered at the point where the counter is + incremented. + + Example: DO VAR i; + ! This loop never prints X + FOR (i=1, 10) DO + LOOP; + T.WRITE(1, "x", 1); + END + END + + + -----[ RETURN expression; ]------------------------------------- + RETURN; + + Return a value from a function. For further details see the + description of function calls in the expression section. When + no return value is specified, return 0. + + Example: increment(x) RETURN x+1; + + + -----[ HALT cvalue; ]------------------------------------------- + HALT; + + Halt the program and return the given exit code to the operating + system. When no value is given, return 0. + + Example: HALT; + + + -----[ DO statement ... END ]------------------- + DO declaration ... statement ... END + + Compound statements of the form DO ... END are used to place + multiple statements in a context where only a single statement + is expected, like selections, loops, and function bodies. + + A compound statement may declare its own local variables, + constants, and structures (using VAR, CONST, or STRUCT). A + local variable of a compound statement is created and + allocated at the beginning of the statement and it ceases to + exist at the end of the statement. + + Note that the form + + DO declaration ... END + + also exists, but is essentially an empty statement. + + Example: DO var i, x; ! Compute 10 factorial + x := 1; + for (i=1, 10) + x := x*i; + END + + + -----[ DO END ]------------------------------------------------- + ; + + These are both empty statements or null statements. They do not + do anything when run and may be used as placeholders where a + statement would be expected. They are also used to show that + nothing is to be done in a specific situation, like in + + IE (x = 0) + ; + ELSE IE (x < 0) + statement; + ELSE + statement; + + Example: FOR (i=0, 10000) DO END ! waste some time + + + EXPRESSIONS + *-----------* + + An expression is a variable or a literal or a function call or + a set of operators applied to combinations of these. There are + unary, binary, and ternary operators. Indirect function calls + using CALL are also valid operands. + + Examples: -a ! negate a + b*c ! product of b and c + x->y:z ! if x then y else z + + In the following, the symbols X, Y, and Z denote variables or + literals. + + These operators exist (P denotes precedence, A associativity): + + +-----------------------------------------------------------+ + | OPERATOR | P | A | DESCRIPTION | + |===========+===============================================| + | X[Y] | 9 | L | the Y'th element of the vector X | + | X::Y | 9 | R | the Y'th byte of the byte vector X | + |-----------+---+---+---------------------------------------| + | -X | 8 | - | the negative value of X | + | ~X | 8 | - | the bitwise inverse of X | + | \X | 8 | - | logical NOT of X (X->0:%1) | + | @X | 8 | - | the address of X (1) | + |-----------+---+---+---------------------------------------| + | X*Y | 7 | L | the product of X and Y | + | Y/Y | 7 | L | the integer quotient of X and Y | + | X mod Y | 7 | L | the division remainder of X and Y (2) | + |-----------+---+---+---------------------------------------| + | X+Y | 6 | L | the sum of X and Y | + | X-Y | 6 | L | the difference between X and Y | + |-----------+---+---+---------------------------------------| + | X&Y | 5 | L | the bitwise AND of X and Y | + | X|Y | 5 | L | the bitwise OR of X and Y | + | X^Y | 5 | L | the bitwise XOR of X and Y | + | X<>Y | 5 | L | X shifted to the right by Y bits (3) | + |-----------+---+---+---------------------------------------| + | XY | 4 | L | %1, if X is greater than Y, else 0 | + | X<=Y | 4 | L | %1, if X is less/equal Y, else 0 | + | X>=Y | 4 | L | %1, if X is greater/equal Y, else 0 | + |-----------+---+---+---------------------------------------| + | X=Y | 3 | L | %1, if X equals Y, else 0 | + | X\=Y | 3 | L | %1, if X does not equal Y, else 0 | + |-----------+---+---+---------------------------------------| + | X/\Y | 2 | L | if X then Y else 0 | + | | | | (short-circuit logical AND) | + |-----------+---+---+---------------------------------------| + | X\/Y | 1 | L | if X then X else Y | + | | | | (short-circuit logical OR) | + |-----------+---+---+---------------------------------------| + | X->Y:Z | 0 | - | if X then Y else Z | + +-----------------------------------------------------------+ + + Higher precedence means that an operator binds stronger, e.g. + -X::Y actually means -(X::Y). + + Left-associativity (L) means that x+y+z = (x+y)+z and + right-associativity (R) means that x::y::z = x::(y::z). + + (1) @X is undefined for vectors! Use @X[0] or @X::0. + + (2) the MOD operator is unsigned, i.e. %1 MOD X = 65535 MOD X. + + (3) The >> operator performs a logical right shift, not an + arithmetic right shift (the sign bit is not copied). + + + CONDITIONS + *----------* + + A condition is an expression appearing in a condition context, + like the condition of an IF or WHILE statement or the first + operand of the X->Y:Z operator. + + In an expression context, the value 0 is considered to be + "false", and any other value is considered to be true. For + example: + + X=X is true + 1=2 is false + "x" is true + 5>7 is false + + The canonical truth value, as returned by 1=1, is %1. + + + FUNCTION CALLS + *--------------* + + When a function call appears in an expression, the result of + the function, as returned by RETURN is used as an operand. + + A function call is performed as follows: + + The value of aach actual argument in the call + + function(argument_1, ...) + + is passed to the function and bound to the corresponding formal + argument ("argument") of the receiving function. The function + then runs its statement, which may produce a value via RETURN. + When no RETURN statement exists in the statement, 0 is returned. + + Function arguments evaluate from the left to the right, so in + + f(a,b,c); + + A is guaranteed to evaluate before B and C and B is guaranteed + to evaluate before C. + + Example: pow(x, y) DO VAR a; + a := 1; + WHILE (y) DO + a := a*x; + y := y-1; + END + RETURN a; + END + + DO VAR x; + x := pow(2,10); + END + + + LITERALS + *--------* + + INTEGERS + + An integer is a number representing its own value. Note that + negative numbers have a leading '%' sign rather than a '-' sign. + While the latter also works, it is, strictly speaking, the + application of the '-' operator to a positive number, so it may + not appear in cvalue contexts. + + Integers may have a '0x' prefix (after the '%' prefix, if + that also exists). In this case, the subsequent digits will + be interpreted as a hexa-decimal number. + + In T3X/Z, like in most T3X variants (except for T3Xr8 and T3X9), + integers are limited to the 16-bit range (-32767..32767). + -32768 is undefined, but the literal 0x8000 may be used. + + Examples: 0 + 12345 + %1 + 0xfff + %0xA5 + + + CHARACTERS + + Characters are integers internally. They are represented by + single characters enclosed in single quotes. In addition, the + same escape sequences as in strings may be used. + + Examples: 'x' + '\\' ! literal backslash + ''' + '\e' ! ESC character + + + STRINGS + + A string is a byte vector filled with characters. Strings are + delimited by '"' characters and NUL-terminated internally. All + characters between the delimiting double quotes represent + themselves. In addition, the following escape sequences may be + used to include some special characters: + + \a BEL Bell + \b BS Backspace + \e ESC Escape + \f FF Form Feed + \n LF Line Feed + \q " Quote + \r CR Carriage Return + \s Space + \t HT Horizontal Tabulator + \v VT Vertical Tabulator + \\ \ Backslash + + Examples: "" + "hello, world!\n" + "\qhi!\q, she said" + + + PACKED TABLES + + A packed table is a byte vector literal. It is a set of cvalues + delimited by square brackets and separated by commas. Note that + string notation is a short and portable, but also limited, + notation for byte vectors. For instance, the byte vectors + + "HELLO" + PACKED [ 'H', 'E', 'L', 'L', 'O', 0 ] + + are identical. Byte vectors can contain any values in the range + from 0 to 255. + + Examples: PACKED [ 1 ] + PACKED [ 1, 2, 3 ] + PACKED [ 14, 'H', 'i', 15 ] + + + TABLES + + A table is a vector literal, i.e. a sequence of values. It is + delimited by square brackets and elements are separated by + commas. Table elements can be cvalues, strings, tables, and + addresses of functions. The maximum nesting level for tables + is three. + + Examples: [1, 2, 3] + ["5 times -7", %35] + [[1,0,0],[0,1,0],[0,0,1]] + [["+", @plus], ["-", @minus]] + + + DYNAMIC TABLES + + The dynamic table is a special case of the table in which one + or multiple elements are computed at program run time. Dynamic + table elements are enclosed in parentheses. E.g. in the table + + ["x times 7", (x*7)] + + the value of the second element would be computed and filled + in when the table is being evaluated. Note that dynamic table + elements are being replaced in situ, and remain the same until + they are replaced again. + + Multiple dynamic elements may be enclosed by a single pair of + parentheses. For instance, the following tables are the same: + + [(x), (y), (z)] + [(x, y, z)] + + + CVALUES + *-------* + + A cvalue (constant value) is an expression whose value is known + at compile time. In full T3X, this is a large subset of full + expressions, but in T3X/Z, it it limited to the following: + + * integers + * characters + * constants + + as well as (given that X and Y are one of the above): + + * X+Y + * X*Y + + + NAMING CONVENTIONS + *------------------* + + Symbolic names for variables, constants, structures, and + functions are constructed from the following alphabet: + + * the characters a-z + * the digits 0-9 + * the special characters '_' and '.' + + The first character of a name must be non-numeric, the remaining + characters may be any of the above. + + (Note that '.' is the message passing operator in full T3X, so + the dot should only be used to mimic message passing in T3X/Z.) + + Upper and lower case is not distinguished, the symbolic names + + FOO, Foo, foo + + are all considered to be equal. + + By convention, + + * CONST names are all upper-case + * STRUCT names are all upper-case + * global VAR names are capitalized + * local VAR names are all lower-case + * function names are all lower-case + + Keywords, like VAR, IF, DO, etc, are sometimes printed in upper + case in documentation, but are usually lower case in actual + programs. + + + SHADOWING + *---------* + + There is a single name space without any shadowing in T3X: + + * all global names must be different + * no local name may have the same name as a global name + * all local names in the same scope must be different + + Local names may be re-used in subsequent scopes, e.g.: + + f(x) RETURN x; + g(x) RETURN x; + + would be a valid program. However, + + f(x) DO VAR x; END !!! WRONG !!! + + would not be a valid program, because VAR x; redefines the + argument of F. + + + BUILT-IN FUNCTIONS + *------------------* + + The following built-in functions exist in T3X/Z. They resemble + the functions of the T3X core module of the full language, i.e. + a T3X/Z program can be compiled by a T3X compiler by adding the + following code to the top of the program: + + MODULE name(t3x); + OBJECT t[t3x]; + + Note that T3X/Z also accepts the above statements (and treats + them as null operations), thereby allowing many T3X/Z programs + to be compiled by a full T3x compiler without modification. + + The following functions are directly built into the T3X/Z + compiler. No classes specified in MODULE will be loaded. The '.' + in the function names is part of the name in T3X/Z. In the full + T3X language, it is a message passing operator. + + + MEMORY FUNCTIONS + *----------------* + + -----[ T.BPW() ]------------------------------------------------ + + Return the number of bytes per machine word on the target system. + + -----[ T.LOCAL() ]---------------------------------------------- + + Return the code segment (8086 CS). + + -----[ T.MEMCOMP(b1, b2, len) ]--------------------------------- + + Compare the first LEN bytes of the byte vectors B1 and B2. + Return the difference of the first pair of mismatching bytes. + A return code of 0 means that the compared regions are equal. + + Example: t.memcomp("aaa", "aba", 3) ! gives 'b'-'a' = %1 + + + -----[ T.FARCOMP(seg1, b1, seg2, b2, len) ]--------------------- + + Compare the first LEN bytes of the byte vectors SEG1:B1 and + SEG2:B2. + Return the difference of the first pair of mismatching bytes. + A return code of 0 means that the compared regions are equal. + + Example: t.farcomp(t.local(), "aaa", t.local() "aba", 3) + ! gives 'b'-'a' = %1 + + + -----[ T.MEMCOPY(bd, bs, len) ]--------------------------------- + + Copy LEN bytes from the byte vector BS (source) to the byte + vector BD (destination). Return 0. + + Like in the full T3X language (but unlike in T3X9), BS and BD + may overlap. + + Example: DO VAR b::100; t.memcopy(b, "hello", 5); END + + + -----[ T.FARCOPY(segd, bd, segs, bs, len) ]--------------------- + + Copy LEN bytes from the byte vector SEGS:BS (source) to the byte + vector SEGD:BD (destination). Return 0. + + Like in the full T3X language (but unlike in T3X9), BS and BD + may overlap. + + Example: + DO VAR b::100; + t.farcopy(t.local(), b, t.local(), "hello", 5); + END + + + -----[ T.MEMFILL(bv, b, len) ]---------------------------------- + + Fill the first LEN bytes of the byte vector BV with the byte + value B. Return 0. + + Example: DO VAR b::100; t.memfill(b, 0, 100); END + + + -----[ T.FARFILL(seg, bv, b, len) ]----------------------------- + + Fill the first LEN bytes of the byte vector SEG:BV with the byte + value B. Return 0. + + Example: DO VAR b::100; t.farfill(t.local(), b, 0, 100); END + + + -----[ T.MEMSCAN(bv, b, len) ]---------------------------------- + + Locate the first occurrence of the byte value B in the first LEN + bytes of the byte vector BV and return its offset in the vector. + When B does not exist in the given region, return %1. + + Example: t.memscan("aaab", 'b', 4) ! returns 3 + + + -----[ T.FARSCAN(seg, bv, b, len) ]----------------------------- + + Locate the first occurrence of the byte value B in the first LEN + bytes of the byte vector SEG:BV and return its offset in the + vector. + When B does not exist in the given region, return %1. + + Example: t.farscan(t.local(), "aaab", 'b', 4) ! returns 3 + + + ----[ T.FARGETB(SEG, PTR) ]------------------------------------- + + Read one byte on position SET:PTR. + + Example: t.fargetb(t.local(), "a") ! returns 'a' + + + ----[ T.FARSETB(SEG, PTR, VALUE) ]------------------------------ + + Write VALUE byte on position SET:PTR. + + Example: t.farsetb(t.local(), " ", 0x41) ! write 'a' on string + + + ----[ T.FARGETW(SEG, PTR) ]------------------------------------- + + Read one word on position SET:PTR. + + Example: t.fargetw(t.local(), "a") ! returns 'a' + + + ----[ T.FARSETW(SEG, PTR, VALUE) ]------------------------------ + + Write VALUE word on position SET:PTR. + + Example: t.farsetw(t.local(), " ", 0x0041) + ! write 0x0041 on string + + + LOW LEVEL FUNCTIONS + *-------------------* + + -----[ T.INB(PORT) ]-------------------------------------------- + + Read one byte from PORT of 8088/8086. + + Example: t.inb(0x70) ! Returns byte on 0x70 port + + + -----[ T.OUTB(PORT, VALUE) ]------------------------------------ + + Read one byte from PORT of 8088/8086. + + Example: t.outw(0x70, 0) + + + -----[ T.INW(PORT) ]-------------------------------------------- + + Read one word from PORT of 8088/8086. + + Example: t.inb(0x70) ! Returns byte on 0x70 port + + + -----[ T.OUTW(PORT, VALUE) ]------------------------------------ + + Read one word from PORT of 8088/8086. + + Example: t.outw(0x70, 0) + + + -----[ T.INT86C(INT, AX, BX, CX, DX, SI, DI) ]------------------ + + Call interrupt on INT, with AX,BX,CX,DX,SI,DI registers. + This call returns the value on CF. + + Example: t.int86c(0x10, 0xe41, 0, 0, 0, 0, 0) + ! Write 'A' on screen, return CF value (0 or 1) + + + -----[ T.INT86AX(INT, AX, BX, CX, DX, SI, DI) ]----------------- + + Call interrupt on INT, with AX,BX,CX,DX,SI,DI registers. + This call returns the value on AX. + + Example: t.int86ax(0x10, 0xe41, 0, 0, 0, 0, 0) + ! Write 'A' on screen, return AX value + + + -----[ T.INT86Z(INT, AX, BX, CX, DX, SI, DI) ]------------------ + + Call interrupt on INT, with AX,BX,CX,DX,SI,DI registers. + This call returns the value on ZF. + + Example: t.int86z(0x10, 0xe41, 0, 0, 0, 0, 0) + ! Write 'A' on screen, return ZF value (0 or 1) + + + INPUT/OUTPUT FUNCTIONS + *----------------------* + + T3X.SYSIN + -----[ T3X.SYSOUT ]-------------------------------------------- + T3X.SYSERR + + These pre-defined file descriptors can be used in the T.READ + and T.WRITE functions. They are connected to the console device. + + + -----[ T.OPEN(path, mode) ]------------------------------------- + + Open file PATH in the given MODE, where MODE=T3X.OREAD opens an + existing file in read-only mode and MODE=T3X.OWRITE creates a + new file in write-only mode. MODE=T3X.OWRITE also truncates an + existing file to zero length. %1 is returned in case of an error. + + Examples: t.open("existing", T3X.OREAD); + t.open("new-file", T3X.OWRITE); + + + -----[ T.CLOSE(fd) ]-------------------------------------------- + + Close the file descriptor FD. Return 0 for success and %1 in + case of an error. + + Example: DO var fd; + fd := t.create("file"); + if (fd >= 0) t.close(); + END + + + -----[ T.READ(fd, buf, len) ]----------------------------------- + + Read up to LEN bytes from the file descriptor FD into the buffer + BUF. Return the number of characters actually read. Return %1 in + case of an error. + + Example: DO b::100; t.read(0, b, 100); END + + + -----[ T.WRITE(fd, buf, len) ]---------------------------------- + + Write LEN bytes from the buffer BUF to the file descriptor FD. + Return the number of characters actually written. Return %1 in + case of an error. + + NOTE: The T3X/Z T.WRITE function will return %1 when a write + succeeded partially (i.e. less than LEN bytes were written). + + Example: t.write(1, "hello, world!\r\n", 15); + + + -----[ T.RENAME(name, new) ]------------------------------------ + + Rename the file named NAME to NEW. Return 0 for success and %1 + in case of an error. + + Example: t.rename("old-name", "new-name"); + + + -----[ T.REMOVE(name) ]----------------------------------------- + + Erase the file with the given name. Return 0 for success and %1 + in case of an error. + + Example: t.remove("tempfile"); + + + VARIADIC FUNCTIONS + *------------------* + + T3X implements variadic functions (i.e. functions of a variable + number of arguments) using dynamic tables. For instance, the + following function returns the sum of a vector of arguments: + + sum(k, v) DO var i, n; + n := 0; + FOR (i=0, k) + n := n+v[i]; + RETURN n; + END + + Its is an ordinary function returning the sum of a vector, but + it can also be considered to be a variadic function, because a + dynamic table may be passed to it in the V argument: + + sum(5, [(a,b,c,d,e)]) + + + EXAMPLE PROGRAM + *---------------* + + ! Print the Fibonacci Sequence from FIB(1) to FIB(10). + + var ntoa_buf::100; ! Global buffer for NTOA + + ! Format X as a string representing a signed decimal number + ! and return a pointer to that string. + + ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; + end + + ! Find length of string S by scanning for NUL + + str.length(s) return t.memscan(s, 0, 32767); + + ! Write string to console + + writes(s) t.write(T3X.SYSOUT, s, str.length(s)); + + ! Compute fibonacci(n) + + fib(n) do var r1, r2, i, t; + r1 := 0; + r2 := 1; + for (i=1, n) do + t := r2; + r2 := r2 + r1; + r1 := t; + end + return r2; + end + + ! Main program + + do var i, b::3; + for (i=1, 11) do + writes(ntoa(fib(i))); + writes(t.newline(b)); + end + end + diff --git a/EXTRA/FED.SYN b/EXTRA/FED.SYN new file mode 100644 index 0000000..b32e770 --- /dev/null +++ b/EXTRA/FED.SYN @@ -0,0 +1,384 @@ +# syntax highlighting data for FED + +# ---------------- T3X ---------------- +Files=t +EOLComment1=! +HexMarker=0x +Symbols=:=<>[]()./\+-*&|^@~ +String='" +Escape=\ +Case=0 +Keywords=const,module,object,struct,var,do,end,mod,if,else,ie,while,return +Keywords=for,halt,leave,decl,packed,call,loop,callfar,far,farint +Keywords=t.bpw,t.newline,t.memcomp,t.memcopy,t.memfill,t.memscan,t.getarg +Keywords=t.open,t.close,t.read,t.write,t.rename,t.remove,t.farcomp,t.farcopy +Keywords=t.farfill,t.farscan,t.fargetb,t.farsetb,t.fargetw,t.farsetw,t.local +Keywords=t.outb,t.inb,t.outw,t.inw,t.int86c,t.int86ax,t.int86z,t.setptr +Keywords=t.getseg,t.getoff +End + +# ---------------- C/C++ ---------------- +Files=c,cpp,cxx,cc,h,hpp,inl +OpenComment1=/* +CloseComment1=*/ +EOLComment1=// +HexMarker=0x +Symbols=!&()*+,-./:;<=>?[]^{|}~ +String='" +Escape=\ +Case=1 +Indents=/* +Keywords=asm,auto,break,case,catch,char,class,const,continue,default,delete +Keywords=do,double,else,enum,except,extern,far,finally,float,for,friend,goto +Keywords=huge,if,inline,int,bool,long,fixed,near,new,operator,private,mutable +Keywords=protected,typename,false,iterator,const_iterator,signals,slots +Keywords=public,register,return,short,signed,sizeof,static,struct,switch +Keywords=template,this,throw,try,typedef,union,unsigned,virtual,void,volatile +Keywords=while,#define,#elif,#else,#endif,#error,#ifdef,#ifndef,#if,#include +Keywords=#line,#pragma,#undef,#warning,using,namespace,true,emit +Keywords=s8,u8,s16,u16,s32,u32,s64,u64,s128,u128,f32,defined,explicit +End + +# ---------------- Pascal ---------------- +Files=pas,inc +OpenComment1={ +CloseComment1=} +OpenComment2=(* +CloseComment2=*) +EOLComment1=// +HexMarker=$ +Symbols=#()*+,-./:;<=>@[] +String=' +Keywords=abs,absolute,and,arctan,array,asm,assembler,array,begin,boolean +Keywords=byte,bytebool,case,char,chr,const,constructor,cos,destructor +Keywords=dispose,div,do,downto,else,end,eof,eoln,exp,export,exports,external +Keywords=far,forward,file,for,function,get,goto,if,implementation,in,index +Keywords=inherited,inline,integer,interface,interrupt,label,library,ln +Keywords=longbool,longint,mod,near,new,nil,not,object,odd,of,or,ord,ordinal +Keywords=pack,packed,page,pred,private,pointer,procedure,program,public,put +Keywords=readln,read,real,record,repeat,reset,resident,rewrite,round,set,shl +Keywords=shortint,shr,sin,sqrt,string,succ,then,to,trunc,type,unit,unpack +Keywords=until,uses,var,virtual,while,with,word,wordbool,write,writeln,xor +End + +# ---------------- BASIC ---------------- +Files=bas +EOLComment1=rem +EOLComment2=' +Symbols=!#()*+-/<=>^ +String=" +Keywords=abs,and,any,as,asc,atn,base,call,case,cdbl,chdir,chr$,cint,circle +Keywords=clear,clng,close,cls,color,com,const,cos,csng,csrlin,cvdmbf,cvsmbf +Keywords=data,declare,def,defint,dim,do,else,end,eof,erase,erdev,erdev$,erl +Keywords=err,error,exit,exp,fileattr,for,fre,freefile,function,get,gosub,goto +Keywords=hex$,if,inkey$,inp,input,input$,instr,int,integer,key,kill,lcase$ +Keywords=left$,len,line,loc,locate,lock,lof,log,loop,lpos,lprint,lset,ltrim$ +Keywords=mid$,mkdir,name,next,not,oct$,on,open,option,or,out,paint,palette +Keywords=pcopy,peek,pen,play,pmap,point,poke,pos,preset,print,pset,put +Keywords=randomize,read,redim,repeat,restore,resume,return,right$,rmdir,rnd +Keywords=rset,rtrim$,run,screen,seek,seg,select,sgn,shared,shell,sin,space$ +Keywords=spc,sqr,static,step,stop,str$,strig,string$,sub,swap,system,tab,tan +Keywords=then,time$,timer,to,type,ucase$,unlock,until,using,val,view,wait +Keywords=width,window,write +End + +# ---------------- 4DOS batch files ---------------- +Files=bat,btm +EOLComment1=rem +Symbols=%&(),<=>@[]^| +String=` +Escape= +Keywords=alias,and,attrib,beep,break,by,call,cancel,cd,cdd,chcp,chdir,cls +Keywords=color,copy,ctty,date,delay,del,describe,dirs,dir,do,drawbox +Keywords=drawhline,drawvline,,echos,echo,else,elseiff,enddo,endiff,endlocal +Keywords=erase,errorlevel,eset,except,exist,exit,fc,find,format,for,free +Keywords=global,gosub,goto,history,iff,if,inkey,input,iterate,keybd,leave +Keywords=lh,list,loadbtm,loadhigh,log,md,memory,mem,mkdir,mode,more,move +Keywords=not,on,or,path,pause,popd,print,prompt,pushd,quit,rd,reboot,rename +Keywords=ren,replace,return,rmdir,screen,scrput,select,setdos,setlocal +Keywords=setver,set,shift,sort,start,subst,sys,tee,text,then,timer,time,to +Keywords=tree,type,unalias,undelete,unset,until,verify,ver,vol,vscrput,while +Keywords=window,xcopy,xor +End + +# ---------------- 80x86 asm (AT&T syntax) ---------------- +Files=s,inc,s86 +OpenComment1=/* +CloseComment1=*/ +EOLComment1=# +EOLComment2=// +HexMarker=0x +Symbols=!$%&(),-./:;<>?[] +String='" +Keywords=aaa,aad,aam,aas,adc,adcb,adcw,adcl,add,addb,addw,addl,and,andb,andw +Keywords=andl,arpl,bound,bsf,bsr,bswap,bt,btc,btr,bts,lcall,call,cbw,cbtw,cdq +Keywords=cltd,clc,cld,cli,clts,cmc,cmp,cmpb,cmpw,cmpl,cmps,cmpsb,cmpsw,cmpsl +Keywords=cmpxchg,cwd,cwtd,cwde,cwtl,daa,das,dec,decb,decw,decl,div,divw,divl +Keywords=enter,esc,hlt,idiv,idivw,idivl,imul,imulw,imull,in,inb,inw,inl,inc +Keywords=incb,incw,incl,ins,insb,insw,insl,int,into,invd,invlpg,iret,iretd,ja +Keywords=jae,jb,jbe,jc,je,jg,jge,jl,jle,jmp,jna,jnae,jnb,jnbe,jnc,jne,jng +Keywords=jnge,jnl,jnle,jno,jnp,jns,jnz,jo,jp,jpe,jpo,js,jz,jcxz,jecxz,jmp +Keywords=ljmp,lahf,lar,lds,lea,leaw,leal,leave,les,lfs,lgdt,lidt,lgs,lldt +Keywords=lmsw,lock,lods,lodsb,lodsw,lodsl,loop,loope,loopz,loopnz,loopne,lsl +Keywords=lss,ltr,mov,movb,movw,movl,movs,movsb,movsw,movsl,movsx,movsbl +Keywords=movsbw,movswl,movzx,movzbl,movzbw,movzwl,mul,mulw,mull,neg,negb,negw +Keywords=negl,nop,not,notb,notw,notl,or,orb,orw,orl,out,outb,outw,outl,outs +Keywords=outsb,outsw,outsl,pop,popb,popw,popl,popa,popal,popf,popfd,push +Keywords=pushb,pushw,pushl,pusha,pushal,pushf,pushfd,rcl,rclb,rclw,rcll,rcr +Keywords=rcrb,rcrw,rcrl,rep,repe,repz,repne,repnz,ret,retf,rol,rolb,rolw,roll +Keywords=ror,rorb,rorw,rorl,sahf,sal,salb,salw,sall,shl,shlb,shlw,shll,sar +Keywords=sarb,sarw,sarl,sbb,sbbb,sbbw,sbbl,scas,scasb,scasw,scasl,setae,setnb +Keywords=setb,setnae,setbe,setna,sete,setz,setne,setnz,setl,setnge,setge +Keywords=setnl,setle,setng,setg,setnle,sets,setns,setc,setnc,seto,setno,setp +Keywords=setpe,setnp,setpo,sgdt,sidt,shl,shlb,shlw,shll,shr,shrb,shrw,shrl +Keywords=shld,shldb,shldw,shldl,shrd,shrdb,shrdw,shrdl,sldt,smsw,stc,std,sti +Keywords=stos,stosb,stosw,stosl,str,sub,subb,subw,subl,test,testb,testw,testl +Keywords=verr,verw,wait,fwait,wbinvd,xchg,xchgb,xchgw,xchgl,xlat,xlatb,xor +Keywords=xorb,xorw,xorl,ax,eax,ah,al,bx,ebx,bh,bl,cx,ecx,ch,cl,dx,edx,dh,dl +Keywords=si,esi,di,edi,sp,esp,bp,ebp,cs,ds,ss,es,fs,gs +End + +# ---------------- 80x86 asm (Intel syntax) ---------------- +Files=asm +OpenComment1=/* +CloseComment1=*/ +EOLComment1=; +EOLComment2=// +HexMarker=0x +Symbols=!$%&(),-./:<>?[] +String='" +Keywords=aaa,aad,aam,aas,adc,add,and,arpl,bound,bsf,bsr,bswap,bt,btc,btr,bts +Keywords=byte,call,cbw,cdq,clc,cld,cli,clts,cmc,cmp,cmps,cmpsb,cmpsw,cmpsl +Keywords=cmpxchg,cwd,cwde,daa,das,dec,div,enter,esc,hlt,idiv,imul,in,inb,inw +Keywords=inl,inc,ins,insb,insw,insl,int,into,invd,invlpg,iret,ja,jae,jb,jbe +Keywords=jc,je,jg,jge,jl,jle,jmp,jna,jnae,jnb,jnbe,jnc,jne,jng,jnge,jnl,jnle +Keywords=jno,jnp,jns,jnz,jo,jp,jpe,jpo,js,jz,jcxz,jecxz,jmp,lahf,lar,lds,lea +Keywords=leave,les,lfs,lgdt,lidt,lgs,lldt,lmsw,lock,lods,lodsb,lodsw,lodsl +Keywords=long,loop,loope,loopz,loopnz,loopne,lsl,lss,ltr,mov,movs,movsb,movsw +Keywords=movsl,movsx,movzx,mul,neg,nop,not,or,out,outb,outw,outl,outs,outsb +Keywords=outsw,outsl,pop,popa,popad,popf,popfd,ptr,push,pusha,pushad,pushf +Keywords=pushfd,rcl,rcr,rep,repe,repz,repne,repnz,ret,retf,rol,ror,sahf,sal +Keywords=shl,sar,sbb,scas,setae,setnb,setb,setnae,setbe,setna,sete,setz,setne +Keywords=setnz,setl,setnge,setge,setnl,setle,setng,setg,setnle,sets,setns +Keywords=setc,setnc,seto,setno,setp,setpe,setnp,setpo,sgdt,sidt,shl,shr,shld +Keywords=shrd,sldt,smsw,stc,std,sti,stos,stosb,stosw,stosl,str,sub,test,verr +Keywords=verw,wait,fwait,wbinvd,word,xchg,xlat,xlatb,xor,ax,eax,ah,al,bx,ebx +Keywords=bh,bl,cx,ecx,ch,cl,dx,edx,dh,dl,si,esi,di,edi,sp,esp,bp,ebp,cs,ds,ss +Keywords=es,fs,gs +End + +# ---------------- HTML ---------------- +Files=htm,html,xml +OpenComment1=< +CloseComment1=> +Keywords=<,> +End + +# ---------------- Allegro Documentation ---------------- +Files=_tx +OpenComment1=< +CloseComment1=> +EOLComment1=@ +End + +# ---------------- EGG scripts ---------------- +Files=egg +EOLComment1=# +End + +# ---------------- Shell scripts ---------------- +Files=sh,bash,cmd +EOLComment1=# +String='" +Escape=\ +End + +# ---------------- Perl ---------------- +Files=pl,pm,perl +EOLComment1=# +String='" +Escape=\ +End + +# ---------------- Makefiles ---------------- +Files=mak,make +EOLComment1=# +String='" +End + +# ---------------- Email messages ---------------- +Files=msg +EOLComment1=> +Numbers=0 +IndentC=0 +Indents=> +Wrappers= abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,.;?! +End + +# ---------------- MAXScript ---------------- +Files=ms +EOLComment1=-- +String='" +Escape=\ +End + +# ---------------- PS2 vector unit code ---------------- +Files=vsm +OpenComment1=/* +CloseComment1=*/ +EOLComment1=// +EOLComment2=; +HexMarker=0x +Symbols=!$%&(),-./:;<>?[] +String='" +Case=0 +TabSize=16 +Keywords=abs +Keywords=add,addi,addq,addx,addy,addz,addw,adda,addai,addaq +Keywords=addax,adday,addaz,addaw +Keywords=clipw,ftoi0,ftoi4,ftoi12,ftoi15,itof0,itof4,itof12,itof15 +Keywords=madd,maddi,maddq,maddx,maddy,maddz,maddw,madda,maddai,maddaq +Keywords=maddax,madday,maddaz,maddaw +Keywords=max,maxi,maxx,maxy,maxz,maxw,mini,minii,minix,miniy,miniz,miniw +Keywords=msub,msubi,msubq,msubx,msuby,msubz,msubw,msuba,msubai,msubaq +Keywords=msubax,msubay,msubaz,msubaw +Keywords=mul,muli,mulq,mulx,muly,mulz,mulw,mula,mulai,mulaq +Keywords=mulax,mulay,mulaz,mulaw +Keywords=nop,opmula,opmsub +Keywords=sub,subi,subq,subx,suby,subz,subw,suba,subai,subaq +Keywords=subax,subay,subaz,subaw +Keywords=b,bal,div,eatan,eatanxy,eatanxz,eexp,eleng,ercpr,erleng,ersadd +Keywords=ersqrt,esadd,esin,esqrt,esum +Keywords=fcand,fceq,fcget,fcor,fcset,fmand,fmeq,fmor,fsand,fseq,fsor,fsset +Keywords=iadd,iaddi,iaddiu,iand +Keywords=ibeq,ibgez,ibgtz,iblez,ibltz,ibne +Keywords=ilw,ilwr,ior,isub,isubiu,isw,iswr,jalr,jr,loi,lq,lqd,lqi +Keywords=mfir,mfp,move,mr32,mtir,rget,rinit,rnext,rsqrt,rxor +Keywords=sq,sqd,sqi,sqrt,waitp,waitq,xgkick,xitop,xtop +Keywords=x,y,z,w,xy,xz,xw,yz,yw,zw,xyz,xyw,xzw,yzw,xyzw +End + +# ---------------- arbitrary config files ---------------- +Files=cfg +EOLComment1=# +End + +# ---------------- vertex shaders ---------------- +Files=vsh,vsi +EOLComment1=; +EOLComment2=// +OpenComment1=/* +CloseComment1=*/ +String='" +Keywords=add,dp3,dp4,dst,expp,lit,logp,mad,max,min,mov,mul,rcp,rsq,sge,slt,sub +Keywords=def,vs,#include,#define,#ifdef,#ifndef,#endif,#else,#undef +Keywords=dph,rcc,xvs,xvss,xvsw,#pragma,screenspace +End + +# ---------------- pixel shaders ---------------- +Files=psh,psi +EOLComment1=; +EOLComment2=// +OpenComment1=/* +CloseComment1=*/ +String='" +Keywords=add,cnd,dp3,lrp,mad,mov,mul,sub +Keywords=add_x2,cnd_x2,dp3_x2,lrp_x2,mad_x2,mov_x2,mul_x2,sub_x2 +Keywords=add_x4,cnd_x4,dp3_x4,lrp_x4,mad_x4,mov_x4,mul_x4,sub_x4 +Keywords=add_d2,cnd_d2,dp3_d2,lrp_d2,mad_d2,mov_d2,mul_d2,sub_d2 +Keywords=add_sat,cnd_sat,dp3_sat,lrp_sat,mad_sat,mov_sat,mul_sat,sub_sat +Keywords=add_x2_sat,cnd_x2_sat,dp3_x2_sat,lrp_x2_sat +Keywords=mad_x2_sat,mov_x2_sat,mul_x2_sat,sub_x2_sat +Keywords=add_x4_sat,cnd_x4_sat,dp3_x4_sat,lrp_x4_sat +Keywords=mad_x4_sat,mov_x4_sat,mul_x4_sat,sub_x4_sat +Keywords=add_d2_sat,cnd_d2_sat,dp3_d2_sat,lrp_d2_sat +Keywords=mad_d2_sat,mov_d2_sat,mul_d2_sat,sub_d2_sat +#Keywords=r0,r1,r2,r3,t0,t1,t2,t3,v0,v1 +#Keywords=a,rgb,rgba +Keywords=tex,texbem,texbeml,texcoord,texkill,texm3x2pad,texm3x2tex,texm3x3pad +Keywords=texm3x3spec,texm3x3tex,texm3x3vspec,texreg2ar,texreg2gb +Keywords=def,ps,#include,#define,#ifdef,#ifndef,#endif,#else,#undef +Keywords=xmma,xmmc,xdm,xdd,xfc,xps +Keywords=texld,texcrd +End + +# ---------------- Covenant scripts ---------------- +Files=cov +EOLComment1=# +Keywords=lzss,lzhuf + +# ---------------- Inno Setup scripts ---------------- +Files=iss +OpenComment1=[ +CloseComment1=] +OpenComment2=< +CloseComment2=> +Keywords=demo +String='" + +# ---------------- Python ---------------- +Files=py +OpenComment1= +CloseComment1= +OpenComment2= +CloseComment2= +EOLComment1=# +Symbols=!&()*+,-./:;<=>?[]^{|}~ +String='" +Escape=\ +Tabsize=4 +RealTabs=0 +Case=1 +End + +# ---------------- Jehova argument files ---------------- +Files=tes,testament,testicle +EOLComment1=# +EOLComment2=// +String='" +Keywords=true,false,yes,no,y,n,on,off +End + +# ---------------- HLSL shader files ---------------- +Files=hlsl,fx,shader,sink +OpenComment1=/* +CloseComment1=*/ +EOLComment2=// +String='" +Case=1 +Keywords=interface,true,false,vs,ps,1_1,1_3,1_4,2_0,3_0 +Keywords=D3DCOLORtoUBYTE4,abs,acos,all,any,asin,atan,atan2,ceil,clamp,clip,const +Keywords=cos,cosh,cross,ddx,ddy,degrees,determinant,distance,do,dot,exp,exp2 +Keywords=extern,faceforward,float,float2,float3,float4,floor,fmod,for,frac,frc +Keywords=frexp,fwidth,if,in,inline,inout,int,isfinite,isinf,isnan,ldexp,len +Keywords=length,lerp,lit,log,log10,log2,matrix,max,min,modf,mul,noise,normalize +Keywords=out,pow,radians,reflect,refract,return,round,rsqrt,sampler,saturate +Keywords=shared,sign,sin,sincos,sinh,smoothstep,sqrt,static,step,string,struct +Keywords=tan,tanh,target,tex1D,tex1Dbias,tex1Dproj,tex2D,tex2Dbias,tex2Dproj +Keywords=tex3D,tex3Dbias,tex3Dproj,texCUBE,texCUBEbias,texCUBEproj,transpose +Keywords=typedef,uniform,vector,volatile,while,void,INPUT,OUTPUT,else +Keywords=#define,#if,#ifdef,#ifndef,#else,#elif,#endif,#error,#undef,include +End + +# ---------------- C# ---------------- +Files=cs +OpenComment1=/* +CloseComment1=*/ +EOLComment1=// +HexMarker=0x +Symbols=!&()*+,-./:;<=>?[]^{|}~ +String='" +Escape=\ +Case=1 +Indents=/* +Keywords= +Keywords=abstract,event,new,struct,as,explicit,null,switch,base,extern,object +Keywords=this,bool,false,operator,throw,break,finally,out,true,byte,fixed +Keywords=override,try,case,float,params,typeof,catch,for,private,uint,char +Keywords=foreach,protected,ulong,checked,goto,public,unchecked,class,if,readonly +Keywords=unsafe,const,implicit,ref,ushort,continue,in,return,using,decimal,int +Keywords=sbyte,virtual,default,interface,sealed,volatile,delegate,internal,short +Keywords=void,do,is,sizeof,while,double,lock,stackalloc,else,long,static,enum +Keywords=namespace,string,#if,#else,#elif,#endif,#define,#undef,#warning,#error +Keywords=#line,#region,#endregion +End diff --git a/LIB/LIB.S86 b/LIB/LIB.S86 new file mode 100644 index 0000000..9d84912 --- /dev/null +++ b/LIB/LIB.S86 @@ -0,0 +1,889 @@ +; T3X86 runtime library +; Nils M Holm, 2000,2019,2021 +; Humberto Costa dos Santos Junior, 2022 +; Public Domain / 0BSD license + + .text $100 + + jmp start + + ; The following definitions MUST start at 0103h + ; and MUST be kept in this order! + +rtlen: dw offset end ; 0x0103 module length for mklib.t + db "T3X" ; 0x0105 + + jmp t_bpw ; 0x0108 + jmp t_newline ; 0x010b + jmp t_memcomp ; 0x010e + jmp t_memcopy ; 0x0111 + jmp t_memfill ; 0x0114 + jmp t_memscan ; 0x0117 + jmp t_getarg ; 0x011a + jmp t_open ; 0x011d + jmp t_close ; 0x0120 + jmp t_read ; 0x0123 + jmp t_write ; 0x0126 + jmp t_rename ; 0x0129 + jmp t_remove ; 0x012c + jmp cmp_eq ; 0x012f + jmp cmp_ne ; 0x0132 + jmp cmp_lt ; 0x0135 + jmp cmp_gt ; 0x0138 + jmp cmp_le ; 0x013b + jmp cmp_ge ; 0x013e + jmp t_seek ; 0x0141 + jmp cmp_ult ; 0x0144 + jmp cmp_ugt ; 0x0147 + jmp cmp_ule ; 0x014a + jmp cmp_uge ; 0x014d + jmp t_farcomp ; 0x0150 + jmp t_farcopy ; 0x0153 + jmp t_farfill ; 0x0156 + jmp t_farscan ; 0x0159 + jmp t_fargetb ; 0x015c + jmp t_farsetb ; 0x015f + jmp t_fargetw ; 0x0162 + jmp t_farsetw ; 0x0165 + jmp t_local ; 0x0168 + jmp t_outb ; 0x016b + jmp t_inb ; 0x016e + jmp t_outw ; 0x0171 + jmp t_inw ; 0x0174 + jmp t_int86c ; 0x0177 + jmp t_int86ax ; 0x017a + jmp t_int86z ; 0x017d + jmp t_setptr ; 0x0180 + jmp t_getseg ; 0x0183 + jmp t_getoff ; 0x0186 + + +; Call frame layout +; +; +-----------------+ +; | argument 1 | <-- BP+2+2N +; +-----------------+ +; | ... | +; +-----------------+ +; | argument N | <-- BP+4 +; +-----------------+ +; | saved frame | +; +-----------------+ +; | return address | <-- BP, SP +; +-----------------+ + +; T.BPW() +; Return bytes per word on target machine. + +t_bpw: + mov ax,2 + ret + +; T.SETPTR(PTR, SEG, OFFSET) +; Set pointer on PTR[4] + +t_setptr: + push bp + mov bp,sp + mov si,[bp+8] + mov ax,[bp+4] + mov [si],ax + mov ax,[bp+6] + mov [si+2],ax + xor ax,ax + pop bp + ret + +; T.GETSEG(PTR) +; Get segment from PTR[4] + +t_getseg: + push bp + mov bp,sp + mov si,[bp+4] + mov ax,[si+2] + pop bp + ret + +; T.GETOFF(PTR) +; Get offset from PTR[4] + +t_getoff: + push bp + mov bp,sp + mov si,[bp+4] + mov ax,[si] + pop bp + ret + +; T.INT86C(INT, AX, BX, CX, DX, SI, DI) +; Call interrupt and return CF + +t_int86c: + push bp + mov bp,sp + mov ax,[bp+16] + mov si,@intcptr + cseg + mov [si],al + mov ax,[bp+14] + mov bx,[bp+12] + mov cx,[bp+10] + mov dx,[bp+8] + mov si,[bp+6] + mov di,[bp+4] + db $CD +intcptr: + db 0 + jc intcyes + xor ax,ax + jmp intcend +intcyes: + mov ax,1 +intcend: + pop bp + ret + +; T.INT86AX(INT, AX, BX, CX, DX, SI, DI) +; Call interrupt and return AX + +t_int86ax: + push bp + mov bp,sp + mov ax,[bp+16] + mov si,@intaxptr + cseg + mov [si],al + mov ax,[bp+14] + mov bx,[bp+12] + mov cx,[bp+10] + mov dx,[bp+8] + mov si,[bp+6] + mov di,[bp+4] + db $CD +intaxptr: + db 0 + pop bp + ret + +; T.INT86Z(INT, AX, BX, CX, DX, SI, DI) +; Call interrupt and return ZF + +t_int86z: + push bp + mov bp,sp + mov ax,[bp+16] + mov si,@intzptr + cseg + mov [si],al + mov ax,[bp+14] + mov bx,[bp+12] + mov cx,[bp+10] + mov dx,[bp+8] + mov si,[bp+6] + mov di,[bp+4] + db $CD +intzptr: + db 0 + jz intzyes + xor ax,ax + jmp intzend +intzyes: + mov ax,1 +intzend: + pop bp + ret + +; T.OUTB(PORT, VALUE) +; Write VALUE in PORT + +t_outb: + push bp + mov bp,sp + mov dx,[bp+6] + mov al,[bp+4] + outb + pop bp + ret + +; T.INB(PORT) +; Return value from PORT + +t_inb: + push bp + mov bp,sp + mov dx,[bp+4] + xor ax,ax + inb + pop bp + ret + +; T.OUTW(PORT, VALUE) +; Write VALUE in PORT + +t_outw: + push bp + mov bp,sp + mov dx,[bp+6] + mov ax,[bp+4] + outw + pop bp + ret + +; T.INW(PORT) +; Return value from PORT + +t_inw: + push bp + mov bp,sp + mov dx,[bp+4] + inw + pop bp + ret + +; T.FARGETB(SEG, P) +; Return byte in SEG:P position + +t_fargetb: + push bp + mov bp,sp + push ds + mov ax,[bp+6] + mov ds,ax + mov bx,[bp+4] + xor ax,ax + mov al,[bx] + pop ds + pop bp + ret + +; T.FARSETB(SEG, P, VALUE) +; Set byte in SEG:P position + +t_farsetb: + push bp + mov bp,sp + push ds + mov ax,[bp+8] + mov ds,ax + mov bx,[bp+6] + mov al,[bp+4] + mov [bx],al + xor ax,ax + pop ds + pop bp + ret + +; T.FARGETW(SEG, P) +; Return word in SEG:P position + +t_fargetw: + push bp + mov bp,sp + push ds + mov ax,[bp+6] + mov ds,ax + mov bx,[bp+4] + mov ax,[bx] + pop ds + pop bp + ret + +; T.FARSETW(SEG, P, VALUE) +; Set word in SEG:P position + +t_farsetw: + push bp + mov bp,sp + push ds + mov ax,[bp+8] + mov ds,ax + mov bx,[bp+6] + mov ax,[bp+4] + mov [bx],ax + xor ax,ax + pop ds + pop bp + ret + +; T.LOCAL() +; Return local segment + +t_local: + mov ax, cs + ret + +; T.NEWLINE(B) +; Fill B with newline sequence. + +t_newline: + push bp + mov bp,sp + mov di,[bp+4] + cld + mov al,$0D + stosb + mov al,$0A + stosb + xor al,al + stosb + mov ax,[bp+4] + pop bp + ret + +; T.FARCOMP(SEG1, R1, SEG2, R2, N) +; Compare regions SEG1:R1 and SEG2:R2 of size N, +; return difference between first differing +; pair of bytes; return 0 if SEG1:R1=SEG2:R2 + +t_farcomp: + push bp + mov bp,sp + push ds + push es + mov ax,[bp+12] ; seg1 + mov ds,ax + mov ax,[bp+10] ; r1 + push ax + mov ax,[bp+8] ; seg2 + mov es,ax + mov ax,[bp+6] ; r2 + push ax + mov ax,[bp+4] ; n + push ax + call t_memcomp + add sp,6 + pop es + pop ds + pop bp + ret + +; T.MEMCOMP(R1, R2, N) +; Compare regions R1 and R2 of size N, +; return difference between first differing +; pair of bytes; return 0 if R1=R2 + +t_memcomp: + push bp + mov bp,sp + mov di,[bp+8] ; r1 + mov si,[bp+6] ; r2 + mov cx,[bp+4] ; len + cmp si,di + jnz docmp + xor ax,ax + jmps cmpret +docmp: inc cx + cld + repz + cmpsb + or cx,cx + jnz notequ + xor ax,ax + jmps cmpret +notequ: mov al,[di-1] + sub al,[si-1] + cbw +cmpret: pop bp + ret + +; T.MEMCOPY(SEGD, DEST, SEGS, SRC, N) +; Copy N bytes from SEGS:SRC to SEGD:DEST; +; regions may overlap. + +t_farcopy: + push bp + mov bp,sp + push ds + push es + mov ax,[bp+12] ; segd + mov ds,ax + mov ax,[bp+10] ; dest + push ax + mov ax,[bp+8] ; segs + mov es,ax + mov ax,[bp+6] ; src + push ax + mov ax,[bp+4] ; n + push ax + call t_memcopy + add sp,6 + pop es + pop ds + pop bp + ret + +; T.MEMCOPY(DEST, SRC, N) +; Copy N bytes from SRC to DEST; +; regions may overlap. + +t_memcopy: + push bp + mov bp,sp + mov di,[bp+8] ; dest + mov si,[bp+6] ; src + mov cx,[bp+4] ; len + cld + cmp di,si + jz endmove ; src == dest +domove: jb nmove ; src < dest ==> normal move + std + add si,cx ; start at the end + add di,cx ; for reverse copy + dec si + dec di +nmove: rep + movsb ; doit +endmove:pop bp + xor ax,ax + ret + +; T.FARFILL(SEG, R, C, N) +; Fill N bytes starting at SEG:R with C. + +t_farfill: + push bp + mov bp,sp + push es + mov ax,[bp+10] ; seg + mov es, ax + mov di,[bp+8] ; r + mov ax,[bp+6] ; c + mov cx,[bp+4] ; n + cld + rep + stosb + pop es + pop bp + xor ax,ax + ret + +; T.MEMFILL(R, C, N) +; Fill N bytes starting at R with C. + +t_memfill: + push bp + mov bp,sp + mov di,[bp+8] ; r + mov ax,[bp+6] ; c + mov cx,[bp+4] ; n + cld + rep + stosb + pop bp + xor ax,ax + ret + +; T.FARSCAN(SEG, R, C, N) +; Find first byte C in region SEG:R of size N; +; return offset of the byte or -1, if C is not in R. + +t_farscan: + push bp + mov bp,sp + push ds + mov ax,[bp+10] ; seg + mov ds, ax + mov di,[bp+8] ; r + mov dx,di + mov ax,[bp+6] ; c + mov cx,[bp+4] ; n + inc cx + cld + repnz + scasb + or cx,cx + jz fnotfnd + mov ax,di + sub ax,dx + dec ax + jmps fscnret +fnotfnd:mov ax,-1 +fscnret:pop ds + pop bp + ret + +; T.MEMSCAN(R, C, N) +; Find first byte C in region R of size N; +; return offset of the byte or -1, if C is not in R. + +t_memscan: + push bp + mov bp,sp + mov di,[bp+8] ; r + mov dx,di + mov ax,[bp+6] ; c + mov cx,[bp+4] ; n + inc cx + cld + repnz + scasb + or cx,cx + jz notfnd + mov ax,di + sub ax,dx + dec ax + jmps scnret +notfnd: mov ax,-1 +scnret: pop bp + ret + +; T.GETARG(A, BUF, N) +; Extract up to N-1 characters from A'th command line argument, +; store the characters in BUF and append a delimiting NUL char. +; Return the number of characters extracted (excluding the NUL). + +t_getarg: + push bp + mov bp,sp + mov cx,[bp+8] ; n + dec cx + mov si,$82 ; ptr to command line + 1 + cld +nskas: dec si ; skip over next argument spaces +skas: lodsb ; skip over argument spaces + cmp al,$20 + jz skas + cmp al,$09 + jz skas + cmp al,$0D ; end of command line + jnz gtarg2 + mov ax,-1 + jmps endgetarg +gtarg2: or cx,cx ; extract this argument? + jz gtarg3 + dec cx +ska: lodsb ; skip over argument + cmp al,$20 + jz nskas + cmp al,$09 + jz nskas + cmp al,$0D + jz nskas + jmps ska +gtarg3: mov di,[bp+6] ; buf + mov cx,[bp+4] ; len + xor bx,bx +tra: inc bx + cmp bx,cx + jae endtra + stosb ; transfer argument + lodsb + cmp al,$20 + jz endtra + cmp al,$09 + jz endtra + cmp al,$0D + jz endtra + jmps tra +endtra: xor ax,ax + stosb + mov ax,bx +endgetarg: + pop bp + ret + +; T.OPEN(NAME, MODE) +; Open file NAME. +; If MODE=0 open existing file for reading. +; If MODE=1 erase and create file. +; MODE=2 unsupported +; MODE=3 = MODE=0 and move to EOF. + +t_open: + push bp + mov bp,sp + mov ax,[bp+4] ;; mode + cmp ax,1 + jnz mode023 + mov ax,$3C00 ; DOS: create file + mov dx,[bp+6] ; file + xor cx,cx + int $21 + jnc opened + mov ax,-1 + jmps endopen +mode023: + cmp ax,0 + jz doopen + cmp ax,3 + jz doopen3 + mov ax,-1 + jmps endopen +doopen3: + mov ax,2 +doopen: + or ax,$3D00 ; DOS: open file + mov dx,[bp+6] ; file + int $21 + jnc opened + mov ax,-1 + jmps endopen +opened: cmp ax,0 + jge opened2 + mov ax,-1 + jmps endopen +opened2: + mov bx,[bp+4] ; mode + cmp bx,3 + jnz endopen + push ax + mov bx,ax + mov ax,$4202 ; DOS: move file ptr from EOF + xor cx,cx + xor dx,dx + int $21 + pop ax + jnc endopen + mov ax,-1 +endopen: + pop bp + ret + +; T.CLOSE(FD) +; Close file descriptor. + +t_close: + push bp + mov bp,sp + mov bx,[bp+4] ;; fd + mov ax,$3E00 ; DOS: close file + int $21 + jnc closeok + mov ax,-1 + jmps endclose +closeok: + xor ax,ax +endclose: + pop bp + ret + +; T.READ(FD, BUF, N) +; Read up to N bytes from FD into BUF. + +t_read: + push bp + mov bp,sp + mov ax,$3F00 ; DOS: read block + mov bx,[bp+8] ; fd + mov dx,[bp+6] ; buf + mov cx,[bp+4] ; len + int $21 + jnc endread + mov ax,-1 +endread: + pop bp + ret + + +; T.WRITE(FD, BUF, N) +; WRITE N bytes from BUF to FD. + +t_write: + push bp + mov bp,sp + mov ax,$4000 ; DOS: read block + mov bx,[bp+8] ; fd + mov dx,[bp+6] ; buf + mov cx,[bp+4] ; len + int $21 + jnc endwrite + mov ax,-1 +endwrite: + pop bp + ret + + +; T.SEEK(FD, WHERE, HOW) +; Seek to position WHERE in file FD. +; HOW=0, absolute from beginning +; HOW=1, relative from beginning +; HOW=2, absolute from end +; HOW=3, relative from end +; Return 0=success or -1=failure. + +t_seek: + push bp + mov bp,sp + mov dx,[bp+6] ; where + xor cx,cx + mov ax,[bp+4] ; how + or ax,ax ; T3X.SEEK_SET + jnz seek1 + mov ax,$4200 ; DOS: move file pointer, absolute + jmps goseek +seek1: cmp ax,1 ; T3X.SEEK_FWD + jnz seek2 + mov ax,$4201 ; DOS: move file pointer, relative + jmp goseek +seek2: cmp ax,2 ; T3X.SEEK_END + jnz seek3 + mov ax,$4202 ; DOS: move file pointer, from EOF + neg dx ; negative offset + dec cx + jmps goseek +seek3: cmp ax,3 ; T3X.SEEK_BCK + jnz skfail + mov ax,$4201 ; DOS: move file pointer, relative + neg dx ; negative offset + dec cx +goseek: + mov bx,[bp+8] ; fd + int $21 + jc skfail + xor ax,ax + jmps skok +skfail: mov ax,-1 +skok: pop bp + ret + + +; T.RENAME(OLD, NEW) +; Rename file OLD as NEW. +; Fail if OLD does not exist or NEW does exist. +; Return 0=success or -1=failure. + +t_rename: + push bp + mov bp,sp + mov ax,$5600 ; DOS: rename + mov dx,[bp+6] ;; old + mov di,[bp+4] ;; new + int $21 + jnc renok + mov ax,-1 + jmps endrename +renok: + xor ax,ax +endrename: + pop bp + ret + + +; T.REMOVE(NAME) +; Delete file. +; Return 0=success or -1=failure. + +t_remove: + push bp + mov bp,sp + mov ax,$4100 ; DOS: delete + mov dx,[bp+4] ;; file + int $21 + jnc rmok + mov ax,-1 + jmps endremove +rmok: + xor ax,ax +endremove: + pop bp + ret + +cmp_eq: + pop si + pop bx + xor dx,dx + cmp bx,ax + jnz eq1 + dec dx +eq1: mov ax,dx + jmp si + +cmp_ne: + pop si + pop bx + xor dx,dx + cmp bx,ax + jz ne1 + dec dx +ne1: mov ax,dx + jmp si + +cmp_lt: + pop si + pop bx + xor dx,dx + cmp bx,ax + jge lt1 + dec dx +lt1: mov ax,dx + jmp si + +cmp_gt: + pop si + pop bx + xor dx,dx + cmp bx,ax + jle gt1 + dec dx +gt1: mov ax,dx + jmp si + +cmp_le: + pop si + pop bx + xor dx,dx + cmp bx,ax + jg le1 + dec dx +le1: mov ax,dx + jmp si + + +cmp_ge: + pop si + pop bx + xor dx,dx + cmp bx,ax + jl ge1 + dec dx +ge1: mov ax,dx + jmp si + +cmp_ult: + pop si + pop bx + xor dx,dx + cmp bx,ax + jae ult1 + dec dx +ult1: mov ax,dx + jmp si + +cmp_ugt: + pop si + pop bx + xor dx,dx + cmp bx,ax + jbe ugt1 + dec dx +ugt1: mov ax,dx + jmp si + +cmp_ule: + pop si + pop bx + xor dx,dx + cmp bx,ax + ja ule1 + dec dx +ule1: mov ax,dx + jmp si + + +cmp_uge: + pop si + pop bx + xor dx,dx + cmp bx,ax + jb uge1 + dec dx +uge1: mov ax,dx + jmp si + +start: + mov ax,$FFFE + mov sp,ax + + ; T3X code starts here ... +end: diff --git a/LIB/MAKE.BAT b/LIB/MAKE.BAT new file mode 100755 index 0000000..47e855c --- /dev/null +++ b/LIB/MAKE.BAT @@ -0,0 +1,2 @@ +..\bin\s86 lib.s86 lib.bin +move lib.bin ..\bin\lib.bin >NUL \ No newline at end of file diff --git a/MAKE.BAT b/MAKE.BAT new file mode 100755 index 0000000..905097b --- /dev/null +++ b/MAKE.BAT @@ -0,0 +1,52 @@ +@echo off +echo Remove current build +cd bin +if exist *.bin del *.bin +if exist *.com del *.com +cd .. +echo Building S86 Assembler (Temporary) +cd s86 +call prepare.bat +cd .. +echo Building LIB (Temporary) +cd lib +call make.bat +cd .. +echo Building T3X Compiler (Temporary) +cd src +call prepare.bat +cd .. +echo Building T3X Compiler (Intermediary) +cd src +call make.bat +cd .. +echo Building S86 Assembler +cd s86 +call make.bat +cd .. +echo Building Tools (Temporary) +cd tools +call make.bat +cd .. +echo Building LIB (Final) +cd lib +call make.bat +cd .. +echo Building T3X Compiler (Final) +cd src +call make.bat +cd .. +echo Building S86 Assembler (Final) +cd s86 +call make.bat +cd .. +echo Building Tools (Final) +cd tools +call make.bat +cd .. +echo Building Samples +cd samples +call make.bat +cd .. +del bin\t0.com +del bin\t1.com diff --git a/README.TXT b/README.TXT new file mode 100644 index 0000000..f890503 --- /dev/null +++ b/README.TXT @@ -0,0 +1,265 @@ + + ################ ############ ###### ###### + ## ## ## ## ## ## ## ## + ###### ###### ####### ## ## ### ## + ## ## ## ## ## ## + ## ## ####### ## ## ### ## + ## ## ## ## ## ## ## ## + ######## ############ ###### ###### + + ----==[ A MINIMAL PROCEDURAL LANGUAGE ]==---- + ----------==[ LOW LEVEL EDITION ]==---------- + + + T3X/86 - A T3X compiler for 8086-based computers running DOS + + For a summary of the T3X language, see http://t3x.org/t3x/ + + T3X/86 is a single-stage two-pass compiler for a superset of + version 9 of the T3X programming language (T3X9). It cross- + compiles in 0.1s on modern hardware and self-compiles in about + 20 seconds on an emulated 50MHz PC/XT. it is packaged in a + single 25KB COM file and needs no additional programs or + libraries. It compiles directly from T3X to 8086 machine code + and should work on any x86-based DOS machine. Of course + T3X/86 can be set up as a cross compiler to DOS on any system + providing a pre-existing T3X implementation. + + The source code of T3X/86 is based on T3X9, but makes some + improvements, like better T3X compatibility and slightly more + efficient code generation. It consists of ~1750 lines of T3X + plus ~450 lines of 8086 assembly language for the runtime + library. It triple-tests successfully. + + A simple 8086 assembler for compiling the runtime library is + contained in this archive. It is written in T3X and can be + recompiled with the T3X/86 compiler. + + + FED HIGHLIGHT SYNTAX + ==================== + + Replace FED.SYN file of Folding Text Editor with + EXTRA\FED.SYN. + + Tested on: FreeDOS/Win3.1, Ubuntu Linux, Windows 10(32bit) + + + INSTALLING THE T3X/86 COMPILER + ============================== + + Copy the contents of BIN folder to destination. + + + COMPILING THE COMPILER + ====================== + + This step requires the T3X/86 source code. If you downloaded a + binary package, fetch it at the T3X homepage (see top of file). + + You need an existing T3X compiler in order to compile T3X/86. + The provided binary (T.BIN) will do fine. + + The following instructions are for cross-compiling T3X/86 on + Unix. + + First compile the S86 assembler and compile the runtime library: + + tx -ml s86.t + ./s86 lib.s86 lib.bin + + Then generate a version of the compiler source code that contains + an image of the library: + + tx -ml mklib.t + ./mklib + + Finally, compile the compiler: + + tx -ml t.t + + and self-compile the compiler: + + ./t t + + This last step will generate the final "t.com" file. + + + RE-BUILDING THE COMPILER UNDER DOS + ================================== + + The easiest way is to just extract the archive and run the + MAKE.BAT file. + + To compile T3X/86 manually, you need the following files on your + DOS machine: + + DOSFILE.COM (renamed DOSFILE.BIN) + T.COM (renamed T.BIN) + T.SRC + MKLIB.T + S86.T + LIB.S86 + + The source files need to be in DOS text format, so you will have + to convert them first (note: lower-case /r): + + DOSFILE T.SRC /r dos + DOSFILE MKLIB.T /r dos + DOSFILE S86.T /r dos + DOSFILE LIB.S86 /r dos + + (Actually this step is not necessary, because the compiler will + happily process Unix text files. However, if you want to edit + these files on DOS, it may be helpful.) + + Next, compile the S86 assembler and assemble the runtime library: + + T S86 /v + S86 LIB.S86 LIB.BIN + + Then, generate the actual compiler source code. This step will + merge the files T.SRC and LIB.BIN and generate the file T.T: + + T MKLIB + MKLIB + + The compiler is now ready to self-compile, but do rename it + before bootstrapping, because it will erase the file T.COM in + case of an error: + + COPY T.COM T0.COM + T0 T /v + + This may take a moment, so the /v option will entertain you + while you stand by. :) + + + TESTING THE COMPILER + ==================== + + There is a simple test suite in the file TEST.T. To test the + compiler, compile and run that file. (Do not forget to convert + TEST.T to DOS text format first!): + + T TEST + TEST + + + TRIPLE-TESTING THE COMPILER + =========================== + + In order to triple-test the compiler, first install it on a DOS + machine or emulator. If you did not generate the file T.T on DOS, + you will also need the DOSFILE command (which is included in the + T3X/86 archive) to convert the source code to DOS text format: + + DOSFILE T.T /r dos + + You can then run the triple test: + + COPY T.COM T0.COM + T0 T /v + COPY T.COM T1.COM + T1 T /v + + At this point the files T1.COM and T.COM should be identical. + + + USAGE + ===== + + T FILE will compile FILE.T to FILE.COM. + + T FILE /v will print function names while compiling; this is + intended as a progress indicator. + + + GETTING STARTED + =============== + + The file T3X.TXT contains a very brief introduction to the T3X9 + language. There are some example programs and utilities in this + archive. Then, there is the compiler source code in the file + T.SRC. A lot of additional information can be found on the T3X + homepage, mentioned at the top of this file. + + + THE T3X/86 LANGUAGE AND COMPILER + ================================ + + The T3X/86 compiler is derived from the T3X9 compiler, but + implements a larger subset of the full T3X language. However, + T3X/86 is still not a full T3X compiler. This is a summary of + its limitations: + + * The only runtime class available is T3X, the core class. + + * Generated code is less efficient than that of the full T3X + optimizing compiler. + + With these differences in mind, the T3X documentation also + applies to T3X/86. See, for instance, the T3X 7.x package at + the T3X home page or, for a more scenic view, have a look at + the T3X book: t3x.org/t3x/t3x.html + + + LOW LEVEL EXTENSIONS + ==================== + + * t.int86ax(int,ax,bx,cx,dx,si,di) + Call 8088 interrupt returning AX + * t.int86z(int,ax,bx,cx,dx,si,di) + Call 8088 interrupt returning ZF + * t.int86c(int,ax,bx,cx,dx,si,di) + Call 8088 interrupt returning CF + * t.fargetw(segment,offset) + Return 16-bit value from far pointer + * t.farsetw(segment,offser,value) + Set 16-bit value on far pointer + * t.fargetb(segment,offset) + Return 8-bit value from far pointer + * t.farsetb(segment,offser,value) + Set 8-bit value on far pointer + * t.farcopy(segd, dest, sego, orig, len) + Copy LEN bytes from sego:orig to segd:dest + * t.farcomp(seg1, ptr1, seg2, ptr2, len) + Compares LEN bytes from seg1:ptr1 with seg2:ptr2 + * t.farscan(segment,offset,value,len) + Scan VALUE in LEN bytes of far pointer + * t.local() + Get local segment + * var ptr[T3X.PTRSIZE] + Create new var with far pointer size + * t.setptr(ptr,segment,offset) + Set far pointer. + Example: t.setptr(ptr,t.local(),@example); + * callfar ptr() + Call far function on far pointer + * example() far do end + Create far function + * example_int(ax,bx,cx,dx,ds,si,es,si,ss,sp) farint do end + Create interrupt handler with direct manipulation of + returning registers. + Example: + my_int(ax,bx,cx,dx,ds,si,es,si,ss,sp) farint do + ax := 123; + cx := ax * 2; + end + + do var old79, old79seg, ret; + ! Store old int 0x79 + old79 := t.fargetw(0, 0x79*4); + old79seg := t.fargetw(0, 0x79*4+2); + ! Set new int 0x79 + t.farsetw(0, 0x79*4, @my_int); + t.farsetw(0, 0x79*4+2, t.local()); + ! Call int 0x79 + ret := t.int86ax(0x79, 0,0,0,0, 0,0); ! ret=123 + ! Restore old int 0x79 + t.farsetw(0, 0x79*4, old79); + t.farsetw(0, 0x79*4+2, old79seg); + end + + + diff --git a/S86/MAKE.BAT b/S86/MAKE.BAT new file mode 100755 index 0000000..ddb31ae --- /dev/null +++ b/S86/MAKE.BAT @@ -0,0 +1,3 @@ +if exist ..\bin\s86.com del ..\bin\s86.com +..\bin\t s86 +move s86.com ..\bin\ >NUL \ No newline at end of file diff --git a/S86/PREPARE.BAT b/S86/PREPARE.BAT new file mode 100755 index 0000000..22512a4 --- /dev/null +++ b/S86/PREPARE.BAT @@ -0,0 +1,2 @@ +..\base\t s86 +move s86.com ..\bin\ >NUL \ No newline at end of file diff --git a/S86/S86.T b/S86/S86.T new file mode 100644 index 0000000..bfcb2e4 --- /dev/null +++ b/S86/S86.T @@ -0,0 +1,1301 @@ +! S86 -- A simple one-pass assembler for an 8086 subset +! Nils M Holm, 1998,2000,2002,2021 +! Public domain / 0BSD license + +module s86(t3x); + +object t[t3x]; + +const DEBUG = 0; + +const BUFSIZE= 1026, ! Must be <= 2050 ! + OBUFL= 1024, ! Must be <= 1024 ! + SYMBSPACE= 8192, ! symbol table size + NSPACE= 4096, ! name pool size + IMKSPACE= 512, ! mark table size + TEXTLEN= 129, ! max. token length + CSPACE= 16384; ! code buffer size + +const META = 256; + +! tokens ... + +const ENDOFLINE = 1, ENDOFFILE = %1; + +const SYMBOL = 20, STRING = 22, MNEMO = 23; + +const COMMA = 30, COLON = 31, PLUS = 37; + +const K_BYTE = 100, K_DB = 101, K_DW = 102, K_EQU = 103, + K_WORD = 104, K_OFFSET = 105, K_TEXT = 106; + +struct MNEMONIC = ! mnemonic/opcode mapping + MNAME, ! text + MCODE, ! opcode + MTYPE; ! type, see assemble() + +struct SYMENT = ! symbol table entry + SNAME, ! symbol name + SADDR, ! address + SFLGS; ! flags (FUNDEFD) + +struct MARKENT = ! mark entry + MADDR, ! address + MCLSS, ! class (MRELATIVE, MSHORT, %1) + MNEXT; ! pointer to next mark + +const MRELATIVE = 256, ! mark is PC-relative + MSHORT = 512; ! mark is short (8-bit displacement) + +! symbol classes +const TCODE='T', TNONE='X'; + +! symbols flags +const FUNDEFD=1; ! not yet defined + +var Infile; ! input file +var Outfile; ! output file +var Symbols[SYMBSPACE], St; ! symbol table +var Names::NSPACE, Nt; ! name pool +var Imarks[IMKSPACE], It, Ni; ! mark pool +var Code::CSPACE, Ctop; ! code buffer +var Origin; ! beginning of text segment +var Line; ! input line +var Errcount; ! error counter +var Token; ! curr. token +var Text, Textbuf::TEXTLEN, Tp; ! curr. token text +var Op; ! curr. instruction +var Buffer::BUFSIZE, Cp, Ep, Lowp, Nomore; ! input buffer, etc +var Mlist; ! mnemonics +var Nmn; ! # of mnemonics +var Segment; ! curr. output segment +var Wop, ! word operation flag (0=byte) + IsOffset, ! operand uses OFFSET + Off1, Off2; ! operand1/2 +offset value +var Oper1, Oper2; ! literal text of 1st/2nd operand + +init() do var i; + Tp := 0; + St := SYMBSPACE; + Nt := 0; + Line := 1; + Errcount := 0; + Cp := 0; + Ep := 0; + Lowp := 0; + Nomore := 0; + Segment := K_TEXT; + Ctop := 0; + Origin := 0; + It := 0; + Ni := 0; + for (i=0, IMKSPACE-MARKENT, MARKENT) Imarks[i+MCLSS] := %1; + Mlist := [ + [ "", 0, 0 ], + [ "aaa", "37", 'b' ], + [ "aad", "0AD5", 'w' ], + [ "aam", "0AD4", 'w' ], + [ "aas", "3F", 'b' ], + [ "adc", "8010", 1 ], + [ "add", "8000", 1 ], + [ "and", "8020", 1 ], + [ "call", "E8FF10",4 ], + [ "cbw", "98", 'b' ], + [ "clc", "F8", 'b' ], + [ "cld", "FC", 'b' ], + [ "cli", "FA", 'b' ], + [ "cmc", "F5", 'b' ], + [ "cmp", "8038", 1 ], + [ "cmpsb", "A6", 'b' ], + [ "cmpsw", "A7", 'b' ], + [ "cseg", "2E", 'b' ], + [ "cwd", "99", 'b' ], + [ "daa", "27", 'b' ], + [ "das", "2F", 'b' ], + [ "dec", "FE08", 2 ], + [ "div", "F630", 2 ], + [ "dseg", "3E", 'b' ], + [ "eseg", "26", 'b' ], + [ "hlt", "F4", 'b' ], + [ "idiv", "F638", 2 ], + [ "imul", "F628", 2 ], + [ "inb", "EC", 'b' ], + [ "inc", "FE00", 2 ], + [ "int", "CCCD", 6 ], + [ "into", "CE", 'b' ], + [ "inw", "ED", 'b' ], + [ "iret", "CF", 'b' ], + [ "ja", "77", 4 ], + [ "jae", "73", 4 ], + [ "jb", "72", 4 ], + [ "jbe", "76", 4 ], + [ "jc", "72", 4 ], + [ "jcxz", "E3", 4 ], + [ "je", "74", 4 ], + [ "jg", "7F", 4 ], + [ "jge", "7D", 4 ], + [ "jl", "7C", 4 ], + [ "jle", "7E", 4 ], + [ "jmp", "E9FF20",4 ], + [ "jmps", "EB", 4 ], + [ "jnc", "73", 4 ], + [ "jne", "75", 4 ], + [ "jno", "71", 4 ], + [ "jnp", "7B", 4 ], + [ "jns", "79", 4 ], + [ "jnz", "75", 4 ], + [ "jo", "70", 4 ], + [ "jp", "7A", 4 ], + [ "js", "78", 4 ], + [ "jz", "74", 4 ], + [ "lahf", "9F", 'b' ], + [ "lock", "F0", 'b' ], + [ "lodsb", "AC", 'b' ], + [ "lodsw", "AD", 'b' ], + [ "loop", "E2", 4 ], + [ "loopnz", "E0", 4 ], + [ "loopz", "E1", 4 ], + [ "mov", "C688", 1 ], + [ "movsb", "A4", 'b' ], + [ "movsw", "A5", 'b' ], + [ "mul", "F620", 2 ], + [ "neg", "F618", 2 ], + [ "nop", "90", 'b' ], + [ "not", "F610", 2 ], + [ "or", "8008", 1 ], + [ "outb", "EE", 'b' ], + [ "outw", "EF", 'b' ], + [ "pop", "5807", 5 ], + [ "popf", "9D", 'b' ], + [ "push", "5006", 5 ], + [ "pushf", "9C", 'b' ], + [ "rcl", "D010", 3 ], + [ "rcr", "D018", 3 ], + [ "rep", "F3", 'b' ], + [ "repnz", "F2", 'b' ], + [ "repz", "F3", 'b' ], + [ "ret", "C3", 'b' ], + [ "retf", "CB", 'b' ], + [ "rol", "D000", 3 ], + [ "ror", "D008", 3 ], + [ "sahf", "9E", 'b' ], + [ "sal", "D020", 3 ], + [ "sar", "D038", 3 ], + [ "sbb", "8018", 1 ], + [ "scasb", "AE", 'b' ], + [ "scasw", "AF", 'b' ], + [ "shl", "D020", 3 ], + [ "shr", "D028", 3 ], + [ "sseg", "36", 'b' ], + [ "stc", "F9", 'b' ], + [ "std", "FD", 'b' ], + [ "sti", "FB", 'b' ], + [ "stosb", "AA", 'b' ], + [ "stosw", "AB", 'b' ], + [ "sub", "8028", 1 ], + [ "test", "F684", 1 ], + [ "wait", "9B", 'b' ], + [ "xchg", "9086", 1 ], + [ "xlat", "D7", 'b' ], + [ "xor", "8030", 1 ], + %1 + ]; + Nmn := 0; + while (Mlist[Nmn] \= %1) Nmn := Nmn+1; +end + +length(a) return t.memscan(a, 0, 32767); + +report(s) t.write(T3X.SYSERR, s, length(s)); + +reptnl() do var b::3; + report(t.newline(b)); +end + +! convert number to string +var ntoa_buf::32; +ntoa(v) do var g, i; + g := 0; + if (v < 0) do + g := 1; + v := -v; + end + ntoa_buf::31:= 0; + i := 30; + while (v \/ i = 30) do + ntoa_buf::i := v mod 10 + '0'; + i := i - 1; + v := v / 10; + end + if (g) do + ntoa_buf::i := '-'; + i := i-1; + end + return @ntoa_buf::(i+1); +end + +issym(x) return 'a' <= x /\ x <= 'z' \/ 'A' <= x /\ x <= 'Z' \/ x = '_'; + +isdigit(x) return '0' <= x /\ x <= '9' \/ x = '$'; + +error(m, s) do var o; + report("TS86: "); + report(ntoa(Line)); + report(": "); + report(m); + if (s) do + report(": "); + report(s); + end + reptnl(); + Errcount := Errcount +1; +end + +fatal(m, s) do + error(m, s); + report("terminating."); + reptnl(); + halt 1; +end + +bigval() error("value too big", Text); + +badops() error("bad operand(s)", 0); + +fillbuf() do var k; + if (Nomore) return; + ! move remaining input to start of buffer + ie (Ep > Cp) do + t.memcopy(Buffer, @Buffer::Cp, Ep-Cp); + Ep := Ep-Cp; + end + else do + Ep := 0; + end + Cp := 0; + k := t.read(Infile, @Buffer::Ep, BUFSIZE/2-1); + ie (k < 1) + Nomore := 1; + else + Ep := Ep + k; + Lowp := Ep-TEXTLEN; +end + +eof() return Nomore /\ Cp >= Ep; + +getce() do var c; + c := Buffer::Cp; + Cp := Cp+1; + if (c \= '\\') return c; + c := Buffer::Cp; + Cp := Cp+1; + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = '"') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +findkw(s) do + if (s::0 = '.' /\ \t.memcomp(s, ".text", 6)) return K_TEXT; + if (s::0 = 'b' /\ \t.memcomp(s, "byte", 5)) return K_BYTE; + if (s::0 = 'd' /\ \t.memcomp(s, "db", 3)) return K_DB; + if (s::0 = 'd' /\ \t.memcomp(s, "dw", 3)) return K_DW; + if (s::0 = 'e' /\ \t.memcomp(s, "equ", 4)) return K_EQU; + if (s::0 = 'o' /\ \t.memcomp(s, "offset", 7)) return K_OFFSET; + if (s::0 = 'w' /\ \t.memcomp(s, "word", 5)) return K_WORD; + return 0; +end + +! find mnemonic using binary tree search +findmnemo(s) do var p, d, r, k; + p := 64; + d := 32; + k := length(s)+1; + while (d) do + ie (p < 0) do + p := p+d; + end + else ie (p >= Nmn) do + p := p-d; + end + else do + r := t.memcomp(s, Mlist[p][MNAME], k); + ie (\r) return p; + else ie (r > 0) p := p + d; + else p := p - d; + end + d := d >> 1; + ! adjust for uneven (non 2^n sized) mnemonic array + if (p & 1 /\ \d) d := 1; + end + return 0; +end + +scan() do var c, i, bc[3]; + if (Cp >= Lowp) fillbuf(); + c := Buffer::Cp; + Cp := Cp+1; + ! skip over white space and comments + while (1) do + while ( c = '\s' \/ c = '\t' \/ + c = '\r' \/ c = '\f' + ) do + c := Buffer::Cp; + Cp := Cp+1; + end + if (c \= ';') leave; + while (c \= '\n') do + c := Buffer::Cp; + Cp := Cp+1; + end + if (Cp >= Lowp) fillbuf(); + end + if (c = '\n') do + Line := Line+1; + Tp := 0; + return ENDOFLINE; + end + Text := @Textbuf::Tp; + if (eof()) return ENDOFFILE; + if (c = ',') return COMMA; + if (c = ':') return COLON; + if (c = '+') return PLUS; + if (c = '@') return K_OFFSET; + if (issym(c) \/ c = '.') do + while (1) do + if (\(issym(c) \/ '0' <= c /\ c <= '9' \/ c = '.')) + leave; + if (Tp >= TEXTLEN-1) fatal("line too long", 0); + Textbuf::Tp := c; + Tp := Tp+1; + c := Buffer::Cp; + Cp := Cp+1; + end + Textbuf::Tp := 0; + Tp := Tp+1; + Cp := Cp-1; + c := findkw(Text); + if (c) return c; + Op := findmnemo(Text); + if (Op) return MNEMO; + return SYMBOL; + end + if (c = '[') do ! indirection, like [bp+4] + i := 0; + while (c \= ']') do + if (Tp >= TEXTLEN-1) fatal("line too long", 0); + Textbuf::Tp := c; + Tp := Tp+1; + c := Buffer::Cp; + Cp := Cp+1; + end + Textbuf::Tp := ']'; + Textbuf::(Tp+1) := 0; + Tp := Tp+2; + return SYMBOL; + end + if ('0' <= c /\ c <= '9' \/ c = '-') do + i := 0; + while ('0' <= c /\ c <= '9' \/ c = '-') do + if (Tp >= TEXTLEN-1) fatal("line too long", 0); + Textbuf::Tp := c; + Tp := Tp+1; + c := Buffer::Cp; + Cp := Cp+1; + end + Textbuf::Tp := 0; + Tp := Tp+1; + Cp := Cp-1; + return SYMBOL; + end + if (c = '$') do + i := 0; + while ( '0' <= c /\ c <= '9' \/ + 'A' <= c /\ c <= 'F' \/ c = '$' + ) do + if (Tp >= TEXTLEN-1) fatal("line too long", 0); + Textbuf::Tp := c; + Tp := Tp+1; + c := Buffer::Cp; + Cp := Cp+1; + end + Textbuf::Tp := 0; + Tp := Tp+1; + Cp := Cp-1; + return SYMBOL; + end + if (c = '\'') do + Textbuf::Tp := '\''; + Textbuf::(Tp+1) := getce(); + Textbuf::(Tp+2) := '\''; + Textbuf::(Tp+3) := 0; + Tp := Tp+4; + ie (c \= '\'') + error("missing `''", 0); + else + Cp := Cp+1; + return SYMBOL; + end + if (c = '"') do + i := 0; + c := getce(); + while (c \= '"') do + if (Tp >= TEXTLEN-2) fatal("line too long", 0); + Textbuf::Tp := c & ~META; + Tp := Tp+1; + c := getce(); + if (eof()) fatal("unexpected EOF", 0); + end + Textbuf::Tp := 0; + Tp := Tp+1; + return STRING; + end + bc::0 := c/16 + (c/16 > 9-> 'A'-10: '0'); + bc::1 := c mod 16 + (c mod 16 > 9-> 'A'-10: '0'); + bc::2 := 0; + fatal("bad input character", bc); +end + +match(tok, s) do + ie (tok = Token) + Token := scan(); + else + error(s, 0); +end + +synch() do + while (Token \= ENDOFLINE /\ Token \= ENDOFFILE) + Token := scan(); +end + +xnl() do + ie (Token = ENDOFLINE) do + Token := scan(); + end + else do + error("end of line expected", 0); + synch(); + end +end + +byte(s) do var l, h; + h := s::0; + l := s::1; + return (('0'<=h /\ h<='9' -> h-'0': h-'A'+10) << 4) + + ('0'<=l /\ l<='9' -> l-'0': l-'A'+10); +end + +word(s) do var v, i, d; + v := 0; + i := 0; + while(s::i) do + d := s::i; + ie ('0' <= d /\ d <= '9') + d := d-'0'; + else ie ('A' <= d /\ d <= 'F') + d := d-'A'+10; + else + leave; + v := (v<<4) + d; + i := i+1; + end + return v; +end + +decl findsym(2); + +! convert anything that has a value (or address) +! to a machine word +xtoi(s) do var v, d, i, g, y; + i := 0; + g := 0; + ie (s::i = '-') do + g := 1; i := 1; + end + else if (s::i = '+') do + i := 1; + end + if (s::i = '\'') return g-> -s::(i+1): s::(i+1); + if (s::i = '$') return g-> -word(@s::(i+1)): word(@s::(i+1)); + if (s::i = '@') do + v := length(s); + ie (s::(v-1) = ']') + s::(v-1) := 0; + else + v := 0; + y := findsym(@s::(i+1), 0); + if (y = %1) error("undefined symbol", @s::(i+1)); + if (v) s::(v-1) := ']'; + return y = %1-> %1: y[SADDR]; + end + v := 0; + while (s::i) do + d := s::i; + ie ('0' <= d /\ d <= '9') + d := d-'0'; + else + leave; + v := v*10 + d; + i := i+1; + end + return g-> -v: v; +end + +emit(n) do + if (Ctop >= CSPACE) fatal("text segment overflow", 0); + Code::Ctop := n; + Ctop := Ctop+1; +end + +emitword(n) do + emit(n); + emit(n>>8); +end + +decl newsym(3); + +findsym(name, add) do var i, s, k; + k := length(name); + for (i=St, SYMBSPACE, SYMENT) do + s := @Symbols[i]; + if (s[SNAME]::0 = k /\ \t.memcomp(@s[SNAME]::1, name, k)) + return s; + end + if (add) return newsym(name, FUNDEFD, 0); + return %1; +end + +intmark(sym, rel, shrt) do var m, here; + ! search a free entry, treating the table as a ring + here := It >= IMKSPACE-MARKENT-> 0: It; + while (1) do + It := It+MARKENT; + if (It >= IMKSPACE-MARKENT) It := 0; + if (Imarks[It+MCLSS] = %1) leave; + if (It = here) fatal("ouf of free imarks", 0); + end + m := @Imarks[It]; + m[MADDR] := Ctop; + m[MCLSS] := (rel-> MRELATIVE: 0) | (shrt-> MSHORT: 0); + m[MNEXT] := sym[SADDR]; + sym[SADDR] := m; + Ni := Ni+1; +end + +! Find the address of a symbol. +! If the symbol does not (yet) exist, +! add a mark for the current address +findaddr(name, rel, rloc, shrt) do var s, a; + s := findsym(name, 1); + a := s[SADDR]; + if (s[SFLGS] & FUNDEFD) do + intmark(s, rel, shrt); + a := Ctop+Origin; + end + return a; +end + +! resolve all marks connected to the symbol S +iresolve(s) do + var a, m, n, i; + var seg, dest, clss, disp; + + m := s[SADDR]; + a := Ctop+Origin; + s[SADDR] := a; + while (m \= %1) do + clss := m[MCLSS]; + seg := Code; + dest := m[MADDR]; + ie (clss & MRELATIVE) do + ie (clss & MSHORT) do + disp := a - (dest+Origin) - 1; + if (disp < %128 \/ disp > 127) + error("short branch out of range", 0); + seg::dest := disp; + end + else do + disp := a - (dest+Origin) - 2; + seg::dest := disp; + seg::(dest+1) := disp>>8; + end + end + else do + seg::dest := a; + seg::(dest+1) := a>>8; + end + n := m; + m := m[MNEXT]; + n[MCLSS] := %1; + Ni := Ni-1; + end +end + +newsym(name, flags, check) do + var s, k, redef, c; + var pname[TEXTLEN]; + + redef := 0; + if (check) do + s := findsym(name, 0); + if (s \= %1) do + if (\(s[SFLGS] & FUNDEFD) \/ flags) do + error("duplicate symbol", name); + return 0; + end + redef := 1; + end + end + ie (redef) do + s[SFLGS] := s[SFLGS] & ~FUNDEFD; + if (\flags) iresolve(s); + end + else do + k := length(name); + if (St - SYMENT < 0) + fatal("symbol table overflow", name); + St := St-SYMENT; + s := @Symbols[St]; + s[SNAME] := @Names::Nt; + if (Nt + k+1 >= NSPACE) + fatal("out of name space", name); + Names::Nt := k; + t.memcopy(@Names::(Nt+1), name, k); + Nt := Nt + k+1; + s[SFLGS] := flags; + end + ie (flags & FUNDEFD) + s[SADDR] := %1; + else + s[SADDR] := Ctop+Origin; + return s; +end + +emitdef(n, w) ie (w) + emitword(n); +else + emit(n); + +defdata() do var w, v, r, i; + w := Token = K_DW; + Token := scan(); + while (1) do + ie (Token = SYMBOL) do + ie ( isdigit(Text::0) \/ Text::0 = '-' \/ + Text::0 = '\'' + ) do + v := xtoi(Text); + if ((v > 255 \/ v < %128) /\ \w) bigval(); + emitdef(v, w); + end + else do + error("invalid number", Text); + end + r := 1; + end + else ie (Token = STRING) do + r := 0; + i := 0; + while (Text::i) do + emitdef(Text::i, w); i := i+1; + end + end + else ie (Token = K_OFFSET) do + Token := scan(); + ie (Token = SYMBOL) + emitword(findaddr(Text, 0, 1, 0)); + else + error("symbol expected", Text); + r := 0; + end + else do + error("initializer expected", Text); + synch(); + leave; + end + Token := scan(); + if (Token \= COMMA) leave; + Token := scan(); + end + xnl(); +end + +defequ() do + Token := scan(); + if (St = SYMBSPACE) error("missing label", 0); + ie ( isdigit(Text::0) \/ Text::0 = '-' \/ + Text::0 = '\'' + ) do + Symbols[St+SADDR] := xtoi(Text); + end + else do + error("invalid number", Text); + end + Token := scan(); + xnl(); +end + +defseg() do + Segment := Token; + Token := scan(); + if (Segment = K_TEXT) do + if (Token \= ENDOFLINE) do + ie ( isdigit(Text::0) \/ Text::0 = '-' \/ + Text::0 = '\'' + ) do + Origin := xtoi(Text); + end + else do + error("invalid number", Text); + end + Token := scan(); + end + end + xnl(); +end + +reg(s) do + var owop, p; + var regs; + + if (\(s::0 /\ s::1) \/ s::2) return %1; + owop := Wop; + Wop := 1; + regs := "axcxdxbxspbpsidi"; ! order is important ! + for (p=0, 16, 2) do + if (s::0 = regs::p /\ s::1 = regs::(p+1)) + return p>>1; + end + Wop := 0; + regs := "alcldlblahchdhbh"; ! order is important ! + for (p=0, 16, 2) do + if (s::0 = regs::p /\ s::1 = regs::(p+1)) + return p>>1; + end + Wop := owop; + return %1; +end + +sreg(s) do + var owop; + + owop := Wop; + Wop := 1; + if (\t.memcomp(s, "cs", 3)) return 1; + if (\t.memcomp(s, "ds", 3)) return 3; + if (\t.memcomp(s, "es", 3)) return 0; + if (\t.memcomp(s, "ss", 3)) return 2; + Wop := owop; + return %1; +end + +indirect(s) do + if (s::0 \= '[') return %1; + if (\t.memcomp(s, "[si]", 5)) return 4; + if (\t.memcomp(s, "[di]", 5)) return 5; + if (\t.memcomp(s, "[bx]", 5)) return 7; + if (\t.memcomp(s, "[bx+si]", 8)) return 0; + if (\t.memcomp(s, "[bx+di]", 8)) return 1; + if (\t.memcomp(s, "[bp+si]", 8)) return 2; + if (\t.memcomp(s, "[bp+di]", 8)) return 3; + return %1; +end + +inddisp(s) do + if (s::0 \= '[') return %1; + if (\t.memcomp(s, "[bp]", 4)) return 6; ! is really [bp+disp] + if ( \('0' <= s::4 /\ s::4 <= '9') /\ + \('A' <= s::4 /\ s::4 <= 'F') /\ + s::4 \= '$' /\ s::4 \= '@' + ) + return %1; + if (s::3 \= '+' /\ s::3 \= '-') return %1; + if (\t.memcomp(s, "[bx", 3)) return 7; + if (\t.memcomp(s, "[bp", 3)) return 6; + if (\t.memcomp(s, "[di", 3)) return 5; + if (\t.memcomp(s, "[si", 3)) return 4; + return %1; +end + +rrasm(o1, o2, m1, m2) do ! Register, Register + emit(o1 | Wop); + emit(o2 | 0xC0 | m1 | (m2<<3)); +end + +riasm(o1, o2, m1, m2) do ! Register, Indirect + emit(o1 | 2 | Wop); + emit(o2 | m2 | (m1<<3)); +end + +rmasm(o1, o2, m1, m2, sym) do ! Register, Memory + emit(o1 | 2 | Wop); + emit(o2 | m2 | (m1<<3)); + emitword(findaddr(sym, 0, 1, 0) + Off2); +end + +rnasm(o1, o2, m1, val) do ! Register, Immediate + ie (o1 = 0xC6) do + emit(0xB0 | (Wop<<3) | m1); + end + else do + if (o2 & 128) o2 := 0; ! patch TEST, XCHG + emit(o1 | Wop); + emit(o2 | 0xC0 | m1); + end + ie (Wop) + emitword(val); + else ie (val > 255 \/ val < %127) + bigval(); + else + emit(val); +end + +roasm(o1, o2, m1, sym) do ! Register, Offset + ie (o1 = 198) do ! 0cx6 + emit(0xB0| (Wop<<3) | m1); + end + else do + emit(o1 | Wop); + emit(o2 | 0xC0 | m1); + end + emitword(findaddr(sym, 0, 1, 0) + Off2); +end + +irasm(o1, o2, m1, m2) do ! Indirect, Register + emit(o1 | Wop); + emit(o2 | m1 | (m2<<3)); +end + +mrasm(o1, o2, m1, m2, sym) do ! Memory, Register + emit(o1 | Wop); + emit(o2 | m1 | (m2<<3)); + emitword(findaddr(sym, 0, 1, 0) + Off1); +end + +mnasm(o1, o2, m1, sym, val) do ! Memory, Immediate + emit(o1 | Wop); + emit(o2 | m1); + emitword(findaddr(sym, 0, 1, 0) + Off1); + ie (Wop) + emitword(val); + else ie (val > 255 \/ val < %127) + bigval(); + else + emit(val); +end + +inasm(o1, o2, m1, val) do ! Indirect, Immediate + emit(o1 | Wop); + emit(o2 | m1); + ie (Wop) + emitword(val); + else ie (val > 255 \/ val < %127) + bigval(); + else + emit(val); +end + +rdasm(o1, o2, m1, m2, val) do ! Register, Register+Displacement + emit(o1 | 2 | Wop); + ie (val > 127 \/ val < %128) do + emit(o2 | 0x80 | (m1<<3) | m2); + emitword(val); + end + else do + emit(o2 | 0x40 | (m1<<3) | m2); + emit(val); + end +end + +drasm(o1, o2, m1, m2, val) do ! Register+Displacement, Register + emit(o1 | Wop); + ie (val > 127 \/ val < %128) do + emit(o2 | 0x80 | m1 | (m2<<3)); + emitword(val); + end + else do + emit(o2 | 0x40 | m1 | (m2<<3)); + emit(val); + end +end + +dnasm(o1, o2, m, disp, val) do ! Register+Displacement, Immediate + emit(o1 | Wop); + ie (disp > 127 \/ disp < %128) do + emit(o2 | 0x80 | m); + emitword(disp); + end + else do + emit(o2 | 0x40 | m); + emit(disp); + end + ie (Wop) + emitword(val); + else + emit(val); +end + +asm1(immed, op1, op2) do ! Group 1 (Binary) Instructions + var m1, m2, x; + + m1 := reg(Oper1); + if (op1 = 0x84) do ! TEST + if (m1 < 0 /\ \(issym(Oper1::0) /\ isdigit(Oper2::0))) do + badops(); + return; + end + if (\isdigit(Oper2::0)) do + x := Oper1; + Oper1 := Oper2; + Oper2 := x; + m1 := reg(Oper1); + end + end + ie (m1 >= 0) do + if (immed = 0xC6) do + m2 := sreg(Oper2); + if (m2 >= 0) do + emit(0x8C); + emit(0xC0| m1 | (m2<<3)); + return 0; + end + end + m2 := reg(Oper2); + ie (m2 >= 0) do + rrasm(op1, op2, m1, m2); + end + else ie (issym(Oper2::0)) do + ie (IsOffset) do + roasm(immed, op1, m1, Oper2); + end + else do + rmasm(op1, op2, m1, 6, Oper2); + end + end + else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/ + Oper2::0 = '-' + ) do + rnasm(immed, op1, m1, xtoi(Oper2)); + end + else ie (indirect(Oper2) >= 0) + riasm(op1, op2, m1, indirect(Oper2)); + else ie (inddisp(Oper2) >= 0) + rdasm(op1, op2, m1, inddisp(Oper2), xtoi(@Oper2::3)); + else + badops(); + end + else ie (immed = 0xC6 /\ sreg(Oper1) >= 0) do + m2 := reg(Oper2); + if (m2 < 0) badops(); + emit(0x8E); + emit(0xC0| (sreg(Oper1)<<3) | m2); + end + else ie (issym(Oper1::0)) do + ie (reg(Oper2) >= 0) do + mrasm(op1, op2, 6, reg(Oper2), Oper1); + end + else ie ((isdigit(Oper2::0) \/ Oper2::0 = '\'' \/ + Oper2::0 = '-') /\ + immed = 0xC6 \/ op1 = 0x00 \/ op1 = 0x38 \/ op1 = 0x84 + ) do + mnasm(immed, op2, 6, Oper1, xtoi(Oper2)); + end + else do + badops(); + end + end + else ie (indirect(Oper1) >= 0) do + m1 := indirect(Oper1); + m2 := reg(Oper2); + ie (m2 >= 0) + irasm(op1, op2, m1, m2); + else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/ + Oper2::0 = '-' + ) + ! inasm(immed, immed=0xC6-> 0: op1, m1, xtoi(Oper2)); + inasm(immed, 0, m1, xtoi(Oper2)); + else + badops(); + end + else ie (inddisp(Oper1) >= 0) do + m2 := reg(Oper2); + ie (m2 >= 0) + drasm(op1, op2, inddisp(Oper1), m2, xtoi(@Oper1::3)); + else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/ + Oper2::0 = '-' + ) do + dnasm(immed, op2, inddisp(Oper1), xtoi(@Oper1::3), + xtoi(Oper2)); + end + else do + badops(); + end + end + else do + badops(); + end +end + +rasm(o1, o2, m1) do ! Register + emit(o1 | Wop); + emit(o2 | 0xC0 | m1); +end + +iasm(o1, o2, m1) do ! Indirect + emit(o1 | Wop); + emit(o2 | m1); +end + +masm(o1, o2, m1, sym) do ! Memory + emit(o1 | Wop); + emit(o2 | m1); + emitword(findaddr(sym, 0, 1, 0) + Off1); +end + +asm2(op1, op2) do ! Group 2 (Unary) Instructions + var m1; + + m1 := reg(Oper1); + if (m1 >= 0) do + rasm(op1, op2, m1); + return 0; + end + m1 := indirect(Oper1); + if (m1 >= 0) do + iasm(op1, op2, m1); + return 0; + end + if (issym(Oper1::0)) do + masm(op1, op2, 6, Oper1); + return 0; + end + badops(); +end + +asm3(op1, op2) do ! Group 3 (Shift,Rotate) Instructions + ie (Oper2::0 = '1' /\ Oper2::1 = 0) + asm2(op1, op2); + else ie (\t.memcomp(Oper2, "cl", 3)) + asm2(op1|2, op2); + else + badops(); +end + +asm4(op1, a1, a2, jlong) do ! Group 4 (Jump,Call) Instructions + var dest, disp; + + if (\issym(Oper1::0) \/ reg(Oper1) >= 0) do + if (\jlong) error("invalid indirect branch", 0); + asm2(a1, a2); + return 0; + end + emit(op1); + dest := findaddr(Oper1, 1, 0, \jlong) + Off1; + disp := dest - ((Ctop+Origin)+(jlong-> 2: 1)); + ie (jlong) + emitword(disp); + else ie (dest \= %1 /\ (disp < %128 \/ disp > 127)) + error("short branch out of range", 0); + else + emit(disp); +end + +asm5(op1, ops) do ! Group 5 (Push,Pop) Instructions + var m1; + + m1 := Reg(Oper1); + if (m1 >= 0) do + emit(op1 | m1); + return 0; + end + m1 := sreg(Oper1); + if (m1 >= 0) do + emit(ops | (m1<<3)); + return 0; + end + badops(); +end + +asm6(op1, op2) do ! Group 6: INT instruction + var n; + + if (\isdigit(Oper1::0)) badops(); + n := xtoi(Oper1); + if (n > 255) bigval(); + ie (n = 3) do + emit(op1); + end + else do + emit(op2); + emit(n); + end +end + +! accept +offset +plusoff(offp) do + if (Token \= PLUS) return 0; + Token := scan(); + ie (Token \= SYMBOL \/ \isdigit(Text::0)) do + error("bad offset", Text); + end + else do + offp[0] := xtoi(Text); + end + Token := scan(); +end + +assemble() do var m, c; + m := Mlist[Op][MTYPE]; + c := Mlist[Op][MCODE]; + Token := scan(); + Wop := 1; + Off1 := 0; + Off2 := 0; + ie (Token = K_WORD) do + Wop := 1; + Token := scan(); + end + else if (Token = K_BYTE) do + Wop := 0; + Token := scan(); + end + if (m = 'b') do + emit(byte(c)); + xnl(); + return 0; + end + if (m = 'w') do + emitword(word(c)); + xnl(); + return 0; + end + if (m = 2 \/ m = 4 \/ m = 5 \/ m = 6) do + if (Token \= SYMBOL) error("operand expected", Text); + Oper1 := Text; + Token := scan(); + plusoff(@Off1); + ie (m = 2) do + asm2(byte(c), byte(@c::2)); + end + else ie (m = 4) do + ie (c::2) + asm4(byte(c), byte(@c::2), byte(@c::4), 1); + else + asm4(byte(c), 0, 0, 0); + end + else ie (m = 5) do + asm5(byte(c), byte(@c::2)); + end + else if (m = 6) do + asm6(byte(c), byte(@c::2)); + end + xnl(); + return 0; + end + if (m = 1 \/ m = 3) do + if (Token \= SYMBOL) error("operand expected", Text); + Oper1 := Text; + Token := scan(); + plusoff(@Off1); + match(COMMA, "',' expected"); + ie (Token = K_OFFSET) do + IsOffset := 1; + Token := scan(); + end + else do + IsOffset := 0; + end + if (Token \= SYMBOL) error("operand expected", Text); + Oper2 := Text; + Token := scan(); + plusoff(@Off2); + ie (m = 1) asm1(byte(c), byte(@c::2), 0); + else if (m = 3) asm3(byte(c), byte(@c::2)); + xnl(); + return 0; + end +end + +statement() do + if (Token = SYMBOL) do + if (\issym(Text::0)) error("bad label", Text); + newsym(Text, 0, 1); + Token := scan(); + match(COLON, "missing ':'"); + end + ie (Token = K_DB \/ Token = K_DW) do + defdata(); + end + else ie (Token = K_EQU) do + defequ(); + end + else ie (Token = K_TEXT) do + defseg(); + end + else ie (Token = MNEMO) do + assemble(); + end + else ie (Token = ENDOFLINE) do + Token := scan(); + end + else do + error("bad statement", 0); + synch(); + end +end + +! report declared but undefined symbols +report_undefd() do var i, name::256; + for (i=St, SYMBSPACE, SYMENT) do + if (Symbols[i+SFLGS] & FUNDEFD) do + t.memcopy(name, @Symbols[i+SNAME]::1, + Symbols[i+SNAME]::0); + name::(Symbols[i+SNAME]::0) := 0; + error("undefined symbol", name); + end + end +end + +pass() do var out; + Token := scan(); + while (Token \= ENDOFFILE) statement(); + report_undefd(); + if (Errcount) return; + if (t.write(Outfile, Code, Ctop) \= Ctop) + fatal("failed to write text segment", 0); + if (Infile \= T3X.SYSIN) t.close(Infile); + if (Outfile \= T3X.SYSOUT) t.close(Outfile); +end + +do var in::14, out::14, ki, ko; + ki := t.getarg(1, in, 12); + ko := t.getarg(2, out, 12); + ie (ki > 0) do + if (ko < 1) do + if (ki > 8) ki := 8; + ko := ki; + t.memcopy(out, in, ki+1); + t.memcopy(@in::ki, ".s86", 5); + t.memcopy(@out::ko, ".com", 5); + end + Infile := t.open(in, T3X.OREAD); + if (Infile < 0) fatal("no such file", in); + Outfile := t.open(out, T3X.OWRITE); + if (Outfile < 0) fatal("cannot create file", out); + end + else do + Infile := T3X.SYSIN; + Outfile := T3X.SYSOUT; + end + init(); + pass(); + if (Errcount) halt 1; +end diff --git a/SAMPLES/FIB.COM b/SAMPLES/FIB.COM new file mode 100755 index 0000000..e63d682 Binary files /dev/null and b/SAMPLES/FIB.COM differ diff --git a/SAMPLES/FIB.T b/SAMPLES/FIB.T new file mode 100644 index 0000000..7cc471b --- /dev/null +++ b/SAMPLES/FIB.T @@ -0,0 +1,54 @@ +module test(t3x); + +object t[t3x]; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +writes(s) t.write(T3X.SYSOUT, s, str_length(s)); + +fib(n) do var r1, r2, i, x; + r1 := 0; + r2 := 1; + for (i=1, n) do + x := r2; + r2 := r2 + r1; + r1 := x; + end + return r2; +end + +do var i, b::3; + for (i=1, 11) do + writes("fib("); + writes(ntoa(i)); + writes(") = "); + writes(ntoa(fib(i))); + writes(t.newline(b)); + end +end diff --git a/SAMPLES/HELLO.COM b/SAMPLES/HELLO.COM new file mode 100755 index 0000000..96b9fdf Binary files /dev/null and b/SAMPLES/HELLO.COM differ diff --git a/SAMPLES/HELLO.T b/SAMPLES/HELLO.T new file mode 100644 index 0000000..78fedd8 --- /dev/null +++ b/SAMPLES/HELLO.T @@ -0,0 +1,62 @@ + +localexample() do + ! Call Video BIOS, writing 'B\r\n' on screen + t.int86c(0x10, 0xe42,0,0,0,0,0); + t.int86c(0x10, 0xe0d,0,0,0,0,0); + t.int86c(0x10, 0xe0a,0,0,0,0,0); +end + +farexample() far do + ! Call Video BIOS, writing 'C\r\n' on screen + t.int86c(0x10, 0xe43,0,0,0,0,0); + t.int86c(0x10, 0xe0d,0,0,0,0,0); + t.int86c(0x10, 0xe0a,0,0,0,0,0); +end + +int79(ax,bx,cx,dx,ds,si,es,di,ss,sp) farint do + ! CS,DS,SS,SP is from caller + ! Return ax = %5 + ax := %5; + ! Call Video BIOS, writing 'D\r\n' on screen + t.int86c(0x10, 0xe44,0,0,0,0,0); + t.int86c(0x10, 0xe0d,0,0,0,0,0); + t.int86c(0x10, 0xe0a,0,0,0,0,0); +end + +do var k, buf::20, old79, old79seg, ptr[T3X.PTRSIZE]; + ! Call Video BIOS, writing 'A\r\n' on screen + t.int86c(0x10, 0xe41,0,0,0,0,0); + t.int86c(0x10, 0xe0d,0,0,0,0,0); + t.int86c(0x10, 0xe0a,0,0,0,0,0); + ! Call local function + localexample(); + ! Call far function + t.setptr(ptr, t.local(), @farexample); + callfar ptr(); + ! Store old 0x79 + old79 := t.fargetw(0, 0x79*4); + old79seg := t.fargetw(0, 0x79*4+2); + ! Set new int 0x79 + t.farsetw(0, 0x79*4, @int79); + t.farsetw(0, 0x79*4+2, t.local()); + ! Call new int 0x79 + t.int86ax(0x79, 0,0,0,0, 0,0); + ! Restore old 0x79 + t.farsetw(0, 0x79*4, old79); + t.farsetw(0, 0x79*4+2, old79seg); + ! Write a green 'AAA' on 3rd line of screen + t.farsetw(0xb800, 320, 0xa41); + t.farsetw(0xb800, 322, 0xa41); + t.farsetw(0xb800, 324, 0xa41); + ! Use Library calls to write on screen + t.write(T3X.SYSOUT, "Enter your name: ", 17); + k := t.read(T3X.SYSIN, buf, 20); + ie (k < 3) do + t.write(T3X.SYSOUT, "Goodbye!\r\n", 10); + end + else do + t.write(T3X.SYSOUT, "Hello, ", 7); + t.write(T3X.SYSOUT, buf, k-2); + t.write(T3X.SYSOUT, "!\r\n", 3); + end +end diff --git a/SAMPLES/MAKE.BAT b/SAMPLES/MAKE.BAT new file mode 100755 index 0000000..d1592e7 --- /dev/null +++ b/SAMPLES/MAKE.BAT @@ -0,0 +1,3 @@ +..\bin\t test +..\bin\t fib +..\bin\t hello \ No newline at end of file diff --git a/SAMPLES/TEST.COM b/SAMPLES/TEST.COM new file mode 100755 index 0000000..c503b5a Binary files /dev/null and b/SAMPLES/TEST.COM differ diff --git a/SAMPLES/TEST.T b/SAMPLES/TEST.T new file mode 100644 index 0000000..201ae49 --- /dev/null +++ b/SAMPLES/TEST.T @@ -0,0 +1,671 @@ +! TODO: +! const/struct declarations +! string/char escape sequences +! compound statements + +module test(t3x); + +object t[t3x]; + +var Errors; +var Verbose; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + if (x = 0x8000) return "NAN"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +str_equal(a, b) return 0 = t.memcomp(a, b, str_length(a)+1); + +writes(s) t.write(T3X.SYSOUT, s, str_length(s)); + +nl() do var b::3; + writes(t.newline(b)); +end + +log(s) if (Verbose) do + writes(s); + nl(); + end + +test(s, r, x) do + log(s); + if (r \= x) do + Errors := Errors + 1; + writes(s); + writes(" FAILED, got "); + writes(ntoa(r)); + writes(", expected "); + writes(ntoa(x)); + nl(); + end +end + +testge(s, r, x) do + ie (r < x) + test(s, r, x); + else + log(s); +end + +stest(s, r, x) do + log(s); + if (\str_equal(r, x)) do + Errors := Errors + 1; + writes(s); + writes(" FAILED, got \q"); + writes(r); + writes("\q, expected \q"); + writes(x); + writes("\q"); + nl(); + end +end + +addr() do var x[1]; + test("@x[0]", @x[0], x); + test("@x[1]", @x[1], x+t.bpw()); + test("@x[5]", @x[5], x+5*t.bpw()); + test("@x[127]", @x[127], x+127*t.bpw()); + test("@x[128]", @x[128], x+128*t.bpw()); + test("@x[129]", @x[129], x+129*t.bpw()); + test("@x[1234]", @x[1234], x+1234*t.bpw()); + test("@x0]", @x[0], x); + test("@x::1", @x::1, x+1); + test("@x::5", @x::5, x+5); + test("@x::127", @x::127, x+127); + test("@x::128", @x::128, x+128); + test("@x::129", @x::129, x+129); + test("@x::1234", @x::1234, x+1234); +end + +unop() do + test("-1", -1, %1); + test("-0", -0, %0); + test("-12345", -12345, %12345); + + test("~0xffff", ~0xffff, 0x0000); + test("~0xa5a5", ~0xa5a5, 0x5a5a); + + test("\1", \1, 0); + test("\12345", \12345, 0); + test("\12345", \12345, 0); + test("\%12345", \%12345, 0); + test("\%12345", \%12345, 0); + test("\'x'", \'x', 0); + test("\\qfoo\q", \"foo", 0); + test("\[1,2,3]", \[1,2,3], 0); +end + +mulop() do + test(" 123 * 99", 123 * 99, 12177); + test(" 123 * %99", 123 * %99, %12177); + test("%123 * 99", %123 * 99, %12177); + test("%123 * %99", %123 * %99, 12177); + + test(" 12345 / 99", 12345 / 99, 124); + test(" 12345 / %99", 12345 / %99, %124); + test("%12345 / 99", %12345 / 99, %124); + test("%12345 / %99", %12345 / %99, 124); + + test(" 12345 mod 99", 12345 mod 99, 69); + test(" 12345 mod %99", 12345 mod %99, 12345); + test("%12345 mod 99", %12345 mod 99, 28); + test("%12345 mod %99", %12345 mod %99, %12345); +end + +addop() do + test(" 12345 + 9999", 12345 + 9999, 22344); + test(" 12345 + %9999", 12345 + %9999, 2346); + test("%12345 + 9999", %12345 + 9999, -2346); + test("%12345 + %9999", %12345 + %9999, -22344); + + test(" 12345 - 9999", 12345 - 9999, 2346); + test(" 12345 - %9999", 12345 - %9999, 22344); + test("%12345 - 9999", %12345 - 9999, -22344); + test("%12345 - %9999", %12345 - %9999, -2346); + + test(" 12345 + 0", 12345 + 0, 12345); + test(" 0 + 9999", 0 + 9999, 9999); + test(" 12345 - 0", 12345 - 0, 12345); + test(" 0 - 9999", 0 - 9999, %9999); +end + +bitop() do + test("0x0c & 0x05", 0x0c & 0x05, 0x04); + test("0x0c | 0x05", 0x0c | 0x05, 0x0d); + test("0x0c ^ 0x05", 0x0c ^ 0x05, 0x09); + test("0x0c << 1", 0x0c << 1, 0x18); + test("0x0c << 2", 0x0c << 2, 0x30); + test("0x0c >> 1", 0x0c >> 1, 0x06); + test("0x0c >> 2", 0x0c >> 2, 0x03); + + test("0xff00 & 0xf0f0", 0xff00 & 0xf0f0, 0xf000); + test("0xff00 | 0xf0f0", 0xff00 | 0xf0f0, 0xfff0); + test("0xffff ^ 0xf0f0", 0xffff ^ 0xf0f0, 0x0f0f); + test("0xffff << 8", 0xffff << 8, 0xff00); + test("0xffff >> 8", 0xffff >> 8, 0x00ff); +end + +relop() do + test(" 5 < 7", 5 < 7, %1); + test(" 5 < %7", 5 < %7, 0); + test("%5 < 7", %5 < 7, %1); + test("%5 < %7", %5 < %7, 0); + test(" 7 < 5", 7 < 5, 0); + test(" 7 < %5", 7 < %5, 0); + test("%7 < 5", %7 < 5, %1); + test("%7 < %5", %7 < %5, %1); + test(" 5 < 5", 5 < 5, 0); + test("%5 < %5", %5 < %5, 0); + + test(" 5 > 7", 5 > 7, 0); + test(" 5 > %7", 5 > %7, %1); + test("%5 > 7", %5 > 7, 0); + test("%5 > %7", %5 > %7, %1); + test(" 7 > 5", 7 > 5, %1); + test(" 7 > %5", 7 > %5, %1); + test("%7 > 5", %7 > 5, 0); + test("%7 > %5", %7 > %5, 0); + test(" 5 > 5", 5 > 5, 0); + test("%5 > %5", %5 > %5, 0); + + test(" 5 <= 7", 5 <= 7, %1); + test(" 5 <= %7", 5 <= %7, 0); + test("%5 <= 7", %5 <= 7, %1); + test("%5 <= %7", %5 <= %7, 0); + test(" 7 <= 5", 7 <= 5, 0); + test(" 7 <= %5", 7 <= %5, 0); + test("%7 <= 5", %7 <= 5, %1); + test("%7 <= %5", %7 <= %5, %1); + test(" 5 <= 5", 5 <= 5, %1); + test("%5 <= %5", %5 <= %5, %1); + + test(" 5 >= 7", 5 >= 7, 0); + test(" 5 >= %7", 5 >= %7, %1); + test("%5 >= 7", %5 >= 7, 0); + test("%5 >= %7", %5 >= %7, %1); + test(" 7 >= 5", 7 >= 5, %1); + test(" 7 >= %5", 7 >= %5, %1); + test("%7 >= 5", %7 >= 5, 0); + test("%7 >= %5", %7 >= %5, 0); + test(" 5 >= 5", 5 >= 5, %1); + test("%5 >= %5", %5 >= %5, %1); + + test(" 5 = 7", 5 = 7, 0); + test(" 5 = %7", 5 = %7, 0); + test("%5 = 7", %5 = 7, 0); + test("%5 = %7", %5 = %7, 0); + test(" 7 = 5", 7 = 5, 0); + test(" 7 = %5", 7 = %5, 0); + test("%7 = 5", %7 = 5, 0); + test("%7 = %5", %7 = %5, 0); + test(" 5 = 5", 5 = 5, %1); + test("%5 = %5", %5 = %5, %1); + + test(" 5 \\= 7", 5 \= 7, %1); + test(" 5 \\= %7", 5 \= %7, %1); + test("%5 \\= 7", %5 \= 7, %1); + test("%5 \\= %7", %5 \= %7, %1); + test(" 7 \\= 5", 7 \= 5, %1); + test(" 7 \\= %5", 7 \= %5, %1); + test("%7 \\= 5", %7 \= 5, %1); + test("%7 \\= %5", %7 \= %5, %1); + test(" 5 \\= 5", 5 \= 5, 0); + test("%5 \\= %5", %5 \= %5, 0); +end + +var E; + +S() E:= 1; + +logop() do + test(" 0 /\ 0", 0 /\ 0, 0); + test(" 0 /\ %1", 0 /\ %1, 0); + test("%1 /\ 0", %1 /\ 0, 0); + test("%1 /\ %1", %1 /\ %1, %1); + + test(" 0 \/ 0", 0 \/ 0, 0); + test(" 0 \/ %1", 0 \/ %1, %1); + test("%1 \/ 0", %1 \/ 0, %1); + test("%1 \/ %1", %1 \/ %1, %1); + + E := 0; if ( 0 /\ S()); test(" 0 /\ S()", E, 0); + E := 0; if (%1 \/ S()); test("%1 \/ S()", E, 0); + + test(" 0-> 1: 2", 0-> 1: 2, 2); + test("%1-> 1: 2", %1-> 1: 2, 1); + E := 0; if ( 0-> S(): 1); test(" 0-> S(): 1", E, 0); + E := 0; if (%1-> 1: S()); test("%1-> 1: S()", E, 0); +end + +prec() do var v; + test("203 mod 89 mod 13", 203 mod 89 mod 13, 12); + + test(" 18 / 3 / 2", 18 / 3 / 2, 3); + test(" 2 - 3 - 4", 2 - 3 - 4, %5); + + test("%1 = 2 < 3", %1 = 2 < 3, %1); + test("%1 = 2 <= 3", %1 = 2 <= 3, %1); + test(" 0 = 2 > 3", 0 = 2 > 3, %1); + test(" 0 = 2 >= 3", 0 = 2 >= 3, %1); + test("5 \= 2 < 3", 5 \= 2 < 3, %1); + test("5 \= 2 <= 3", 5 \= 2 <= 3, %1); + test("5 \= 2 > 3", 5 \= 2 > 3, %1); + test("5 \= 2 >= 3", 5 \= 2 >= 3, %1); + + test("0 < 2 | 3", 0 < 2 | 3, %1); + test("0 < 2 & 3", 0 < 2 & 3, %1); + test("0 < 2 ^ 3", 0 < 2 ^ 3, %1); + test("0 < 2 << 3", 0 < 2 << 3, %1); + test("0 < 8 >> 2", 0 < 8 >> 2, %1); + + test("0 <= 2 | 3", 0 <= 2 | 3, %1); + test("0 <= 2 & 3", 0 <= 2 & 3, %1); + test("0 <= 2 ^ 3", 0 <= 2 ^ 3, %1); + test("0 <= 2 << 3", 0 <= 2 << 3, %1); + test("0 <= 8 >> 2", 0 <= 8 >> 2, %1); + + test("2 | 3 > 0", 2 | 3 > 0, %1); + test("2 & 3 > 0", 2 & 3 > 0, %1); + test("2 ^ 3 > 0", 2 ^ 3 > 0, %1); + test("2 << 3 > 0", 2 << 3 > 0, %1); + test("8 >> 2 > 0", 8 >> 2 > 0, %1); + + test("2 | 3 >= 0", 2 | 3 >= 0, %1); + test("2 & 3 >= 0", 2 & 3 >= 0, %1); + test("2 ^ 3 >= 0", 2 ^ 3 >= 0, %1); + test("2 << 3 >= 0", 2 << 3 >= 0, %1); + test("8 >> 2 >= 0", 8 >> 2 >= 0, %1); + + test("2 | 3 + 5", 2 | 3 + 5, 10); + test("2 & 3 + 5", 2 | 3 + 5, 10); + test("2 ^ 3 + 5", 2 ^ 3 + 5, 10); + + test(" 2 << 3 + 5", 2 << 3 + 5, 512); + test("1024 >> 3 + 5", 1024 >> 3 + 5, 4); + + test(" 2 + 3 * 4", 2 + 3 * 4, 14); + test(" 2 - 3 * 4", 2 - 3 * 4, %10); + test("10 + 12 / 3", 10 + 12 / 3, 14); + test("10 - 12 / 3", 10 - 12 / 3, 6); + + v := packed [2,3,5,7,11]; + test("v :: 2 = 1", v :: 2 = 1, 0); + test("v :: 2 \= 1", v :: 2 \= 1, %1); + test("v :: 2 < 1", v :: 2 < 1, 0); + test("v :: 2 <= 1", v :: 2 <= 1, 0); + test("v :: 2 > 1", v :: 2 > 1, %1); + test("v :: 2 >= 1", v :: 2 >= 1, %1); + test("v :: 2 | 1", v :: 2 | 1, 5); + test("v :: 2 & 1", v :: 2 & 1, 1); + test("v :: 2 ^ 1", v :: 2 ^ 1, 4); + test("v :: 2 << 1", v :: 2 << 1, 10); + test("v :: 2 >> 1", v :: 2 >> 1, 2); + test("v :: 2 + 1", v :: 2 + 1, 6); + test("v :: 2 - 1", v :: 2 - 1, 4); + test("v :: 2 * 2", v :: 2 * 2, 10); + test("v :: 2 / 2", v :: 2 / 2, 2); +end + +tables() do var v, i, j, k; + v := [123, 456, 789]; + test("v[0]", v[0], 123); + test("v[1]", v[1], 456); + test("v[2]", v[2], 789); + + v := [[1, 2, 3], + [4, 5, 6], + [7, 8, 9]]; + test("v[0][0]", v[0][0], 1); + test("v[0][1]", v[0][1], 2); + test("v[0][2]", v[0][2], 3); + test("v[1][0]", v[1][0], 4); + test("v[1][1]", v[1][1], 5); + test("v[1][2]", v[1][2], 6); + test("v[2][0]", v[2][0], 7); + test("v[2][1]", v[2][1], 8); + test("v[2][2]", v[2][2], 9); + + v := [[[ 1, 2, 3], + [ 4, 5, 6], + [ 7, 8, 9]], + [[11, 12, 13], + [14, 15, 16], + [17, 18, 19]], + [[21, 22, 23], + [24, 25, 26], + [27, 28, 29]]]; + test("v[0][0][0]", v[0][0][0], 1); + test("v[0][0][1]", v[0][0][1], 2); + test("v[0][0][2]", v[0][0][2], 3); + test("v[0][1][0]", v[0][1][0], 4); + test("v[0][1][1]", v[0][1][1], 5); + test("v[0][1][2]", v[0][1][2], 6); + test("v[0][2][0]", v[0][2][0], 7); + test("v[0][2][1]", v[0][2][1], 8); + test("v[0][2][2]", v[0][2][2], 9); + test("v[1][0][0]", v[1][0][0], 11); + test("v[1][0][1]", v[1][0][1], 12); + test("v[1][0][2]", v[1][0][2], 13); + test("v[1][1][0]", v[1][1][0], 14); + test("v[1][1][1]", v[1][1][1], 15); + test("v[1][1][2]", v[1][1][2], 16); + test("v[1][2][0]", v[1][2][0], 17); + test("v[1][2][1]", v[1][2][1], 18); + test("v[1][2][2]", v[1][2][2], 19); + test("v[2][0][0]", v[2][0][0], 21); + test("v[2][0][1]", v[2][0][1], 22); + test("v[2][0][2]", v[2][0][2], 23); + test("v[2][1][0]", v[2][1][0], 24); + test("v[2][1][1]", v[2][1][1], 25); + test("v[2][1][2]", v[2][1][2], 26); + test("v[2][2][0]", v[2][2][0], 27); + test("v[2][2][1]", v[2][2][1], 28); + test("v[2][2][2]", v[2][2][2], 29); + + for (i=0, 3) + for (j=0, 3) + for (k=0, 3) do + v[i][j][k] := 123; + test("v[i][j][k]", v[i][j][k], 123); + end + + v := packed [11, 22, 33, 44, 55]; + test("v::0", v::0, 11); + test("v::1", v::1, 22); + test("v::2", v::2, 33); + test("v::3", v::3, 44); + test("v::4", v::4, 55); + + v := "abcde"; + test("v::0", v::0, 'a'); + test("v::1", v::1, 'b'); + test("v::2", v::2, 'c'); + test("v::3", v::3, 'd'); + test("v::4", v::4, 'e'); + test("v::4", v::5, 0); + + v := ["abc", "def", "ghi"]; + test("v[0]::0", v[0]::0, 'a'); + test("v[0]::1", v[0]::1, 'b'); + test("v[0]::2", v[0]::2, 'c'); + test("v[1]::0", v[1]::0, 'd'); + test("v[1]::1", v[1]::1, 'e'); + test("v[1]::2", v[1]::2, 'f'); + test("v[2]::0", v[2]::0, 'g'); + test("v[2]::1", v[2]::1, 'h'); + test("v[2]::2", v[2]::2, 'i'); + + for (i=0, 3) + for (j=0, 3) do + v[i]::j := 'x'; + test("v[i]::j", v[i]::j, 'x'); + end + +end + +cond() do var x, i; + x := 0; if (1) x := 1; test("if (1) ...", x, 1); + x := 0; if (0) x := 1; test("if (0) ...", x, 0); + + x := 0; if (\1) x := 1; test("if (\1) ...", x, 0); + x := 0; if (\0) x := 1; test("if (\0) ...", x, 1); + + x := 0; ie (1) x := 1; else x := 2; test("ie (1) ...", x, 1); + x := 0; ie (0) x := 1; else x := 2; test("ie (0) ...", x, 2); + + x := 0; for (i=0, 10) x := x+1; + test("for (i=0, 10) ...", x, 10); + x := 0; for (i=10, 0, %1) x := x+1; + test("for (i=10, 0, %1) ...", x, 10); + + for (i=0, 100, 7); test("for (i=0, 100, 7);", i, 105); + for (i=100, 0, %7); test("for (i=100, 0, %7);", i, %5); + + x := 0; while (x<10) x := x+1; + test("while (x<10) ...", x, 10); + + x := 0; + for (i=0, 10) do + if (i < 5) loop; + x := x+1; + end + test("for (i=0, 10) ... loop", x, 5); + x := 0; + for (i=0, 10) do + if (i = 7) leave; + x := x+1; + end + test("for (i=0, 10) ... leave", x, 7); + + x := 0; + i := 0; while (i < 10) do + i := i+1; + if (i <= 5) loop; + x := x+1; + end + test("while (i < 10) ... loop", x, 5); + i := 0; while (i < 10) do + if (i = 7) leave; + i := i+1; + end + test("while (i < 10) ... leave", i, 7); +end + +a0() return; + +a1(x) return x; + +a2(x, y) return x+y; + +a3(x, y, z) return x+y+z; + +ack(x, y) + ie (x = 0) return y+1; + else ie (x > 0 /\ y = 0) return ack(x-1, 1); + else return ack(x-1, ack(x, y-1)); + +r() return E; +s2(a, b) return b; + +fa1() do var x; x := 5; return x; end + +fa2(x) do var y; y := 7; return y; end + +fa3() do var y; y := 11; return y; end + +fa4() do var y; end + +fa5() do end + +fa6() do return; end + +fa7() return; + +sum(k, v) do var i, n; + n := 0; + for (i=0, k) n := n + v[i]; + return n; +end + +proc() do var p, q; + test("a0()", a0(), 0); + test("a1(12345)", a1(12345), 12345); + test("a2(123, 456)", a2(123, 456), 579); + test("a3(123, 456, 789)", a3(123, 456, 789), 1368); + + test("a2(a1(5), a1(7))", a2(a1(5), a1(7)), 12); + + test("ack(3,3)", ack(3,3), 61); + + E := 0; test("s2(s(), r())", s2(s(), r()), 1); + + test("sum(0, [0])", sum(0, [0]), 0); + test("sum(1, [1])", sum(1, [1]), 1); + test("sum(5, [1,2,3,4,5])", sum(5, [1,2,3,4,5]), 15); + + test("call a0()", call a0(), 0); + call test("call a0()", call a0(), 0); + + p := @a0; test("call p()", call p(), 0); + p := @a1; test("call p(12345)", call p(12345), 12345); + p := @a2; test("call p(123, 456)", call p(123, 456), 579); + p := @a3; test("call p(123, 456, 789)", call p(123, 456, 789), 1368); + + p := @a1; q := @a2; + test("call q(call p(5), call p(7))", + call q(call p(5), call p(7)), 12); + + p := @s2; q := @r; + E := 0; test("call p(s(), call q())", call p(s(), call q()), 1); + + p := @sum; + test("call p(0, [0])", call p(0, [0]), 0); + test("call p(1, [1])", call p(1, [1]), 1); + test("call p(5, [1,2,3,4,5])", call p(5, [1,2,3,4,5]), 15); + + test("fa1()", fa1(), 5); + test("fa2(0)", fa2(0), 7); + test("fa3()", fa3(), 11); + test("fa4()", fa4(), 0); + test("fa5()", fa5(), 0); + test("fa6()", fa6(), 0); + test("fa7()", fa7(), 0); +end + +memory() do var v; + test("t.bpw()", t.bpw(), 2); + test("t.memcomp(\qabc\q,\qabc\q,3)", t.memcomp("abc","abc",3), 0); + test("t.memcomp(\qabd\q,\qabc\q,3)", t.memcomp("abd","abc",3), 1); + test("t.memcomp(\qabc\q,\qabd\q,3)", t.memcomp("abc","abd",3), %1); + test("t.memcomp(\qabc\q,\qabd\q,2)", t.memcomp("abc","abd",2), 0); + v := "0123456789"; + t.memcopy(@v::2, @v::1, 5); + stest("t.memcopy(@v::2, @v::1, 5)", v, "0112345789"); + v := "0123456789"; + t.memcopy(@v::1, @v::2, 5); + stest("t.memcopy(@v::2, @v::1, 5)", v, "0234566789"); + v := "0123456789"; + t.memcopy(@v::2, @v::2, 5); + stest("t.memcopy(@v::2, @v::2, 5)", v, "0123456789"); + v := "0123456789"; + t.memcopy(@v::2, @v::2, 0); + stest("t.memcopy(@v::1, @v::2, 0)", v, "0123456789"); + v := "0123456789"; + t.memfill(@v::2, '_', 5); + stest("t.memfill(@v::2, '_', 5)", v, "01_____789"); + v := "0123456789"; + test("t.memscan(v, '5', 10)", t.memscan(v, '5', 10), 5); + test("t.memscan(v, 'X', 10)", t.memscan(v, 'X', 10), %1); + test("t.memscan(v, '9', 10)", t.memscan(v, '9', 10), 9); + test("t.memscan(v, '9', 9)", t.memscan(v, '9', 9), %1); +end + +var Buf::128; + +files() do var fd, i, alpha; + alpha := "abcdefghijklmnopqrstuvwxyz\r\n"; + fd := t.open("test.tmp", T3X.OWRITE); + testge("t.open(\qtest.tmp\q, OWRITE)", fd, 3); + for (i=0, 20) + test("t.write(fd, alpha, 28)", + t.write(fd, alpha, 28), 28); + test("t.close(fd)", t.close(fd), 0); + + fd := t.open("test.tmp", T3X.OREAD); + testge("t.open(\qtest.tmp\q, OREAD)", fd, 3); + for (i=0, 20) do + test("t.read(fd, Buf, 28)", + t.read(fd, Buf, 28), 28); + test("memcomp(buf, alpha)", + t.memcomp(Buf, alpha, 28), 0); + end + test("t.close(fd)", t.close(fd), 0); + + t.remove("test2.tmp"); + + test("t.rename(...)", t.rename("test.tmp", "test2.tmp"), 0); + test("t.remove(...)", t.remove("test2.tmp"), 0); + test("t.remove(...)", t.remove("test2.tmp"), %1); + + fd := t.open("test2.tmp", T3X.OWRITE); + test("t.write(fd, Buf, 0)", t.write(fd, Buf, 0), 0); + t.close(fd); + fd := t.open("test2.tmp", T3X.OREAD); + testge("t.open(\qtest2.tmp\q, OREAD)", fd, 3); + test("t.read(fd, Buf, 0)", t.read(fd, Buf, 0), 0); + test("t.read(fd, Buf, 1)", t.read(fd, Buf, 1), 0); + t.close(fd); + t.remove("test2.tmp"); +end + +var abuf::128; + +argtest() do var i, k; + for (i=1, 64) do + k := t.getarg(i, abuf, 128); + if (k < 1) leave; + writes("Argument #"); + writes(ntoa(i)); + writes(" is \q"); + writes(abuf); + writes("\q, length "); + writes(ntoa(k)); + nl(); + end +end + +do + Errors := 0; + Verbose := 0; + if (t.getarg(1, abuf, 3) > 0 /\ \t.memcomp(abuf, "/V", 3)) + Verbose := 1; + addr(); + unop(); + mulop(); + addop(); + bitop(); + relop(); + logop(); + prec(); + tables(); + cond(); + proc(); + memory(); + files(); + argtest(); + ie (Errors) do + writes(ntoa(Errors)); + writes(" errors"); + end + else do + writes("Looks good!"); + end + nl(); + halt; +end diff --git a/SCREEN.BMP b/SCREEN.BMP new file mode 100644 index 0000000..fbf4419 Binary files /dev/null and b/SCREEN.BMP differ diff --git a/SRC/MAKE.BAT b/SRC/MAKE.BAT new file mode 100755 index 0000000..4a61322 --- /dev/null +++ b/SRC/MAKE.BAT @@ -0,0 +1,5 @@ +if exist ..\bin\t1.com del ..\bin\t1.com +if exist ..\bin\t0.com move ..\bin\t0.com ..\bin\t1.com >NUL +move ..\bin\t.com ..\bin\t0.com >NUL +..\bin\t0 t +move t.com ..\bin\t.com >NUL diff --git a/SRC/PREPARE.BAT b/SRC/PREPARE.BAT new file mode 100755 index 0000000..3b90938 --- /dev/null +++ b/SRC/PREPARE.BAT @@ -0,0 +1,5 @@ +copy ..\bin\lib.bin lib.bin >NUL +..\base\mklib +..\base\t t +del lib.bin +move t.com ..\bin\t.com >NUL \ No newline at end of file diff --git a/SRC/T.T b/SRC/T.T new file mode 100644 index 0000000..3af5e30 --- /dev/null +++ b/SRC/T.T @@ -0,0 +1,2033 @@ +!! DO NOT EDIT THIS FILE, EDIT TSOURCE.T INSTEAD !! + +! T3X -> DOS/8086 compiler +! Nils M Holm, 2017,2019,2020,2021,2022 +! Humberto Costa dos Santos Junior, 2022 +! Public Domain / 0BSD license + +module t3x86(t3x); + +object t[t3x]; + +const BPW = 2; + +const GPOOL_SIZE = 7; + +const BUFLEN = 512; + +const SYMTBL_SIZE = 2048; +const LABEL_SIZE = 2048; +const NLIST_SIZE = 6144; +const FWDCL_SIZE = 128; + +var Outname::80; + +var Line; + +var Verbose; + +const ENDFILE = %1; +const EOFCHAR = 0x1a; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +str_copy(sd, ss) t.memcopy(sd, ss, str_length(ss)+1); + +str_append(sd, ss) t.memcopy(@sd::str_length(sd), ss, str_length(ss)+1); + +str_equal(s1, s2) return t.memcomp(s1, s2, str_length(s1)+1) = 0; + +writes(s) t.write(1, s, str_length(s)); + +nl() do var b::3; + writes(t.newline(b)); +end + +aw(m, s) do + writes("Error: "); + writes(ntoa(Line)); + writes(": "); + writes(m); + if (s \= 0) do + writes(": "); + writes(s); + end + nl(); + if (Outname::0) t.remove(Outname); + halt 1; +end + +oops(m, s) do + writes("Internal error"); + nl(); + aw(m, s); +end + +numeric(c) return '0' <= c /\ c <= '9'; + +alphabetic(c) return 'a' <= c /\ c <= 'z' \/ + 'A' <= c /\ c <= 'Z'; + +! +! Symbol tables +! + +struct SYM = SNAME, SFLAGS, SVALUE; + +const GLOB = 1; +const CNST = 2; +const VECT = 4; +const FORW = 8; +const FUNC = 16; +const FUNCF = 32; +const FUNCI = 64; + +var Syms[SYM*SYMTBL_SIZE]; +var Labels[LABEL_SIZE]; +Var Lab; +var Nlist::NLIST_SIZE; + +var Yp, Np; + +var Fwlab[FWDCL_SIZE], + Fwaddr[FWDCL_SIZE]; +var Fwp; + +find(s) do var i; + i := Yp-SYM; + while (i >= 0) do + if (str_equal(Syms[i+SNAME], s)) + return @Syms[i]; + i := i - SYM; + end + return 0; +end + +lookup(s, f) do var y; + y := find(s); + if (y = 0) aw("undefined", s); + if (y[SFLAGS] & f \= f) + aw("unexpected type", s); + return y; +end + +newname(s) do var k, new; + k := str_length(s)+1; + if (Np+k >= NLIST_SIZE) + aw("name pool overflow", s); + new := @Nlist::Np; + t.memcopy(new, s, k); + Np := Np+k; + return new; +end + +add(s, f, v) do var y; + y := find(s); + if (y \= 0) do + ie (y[SFLAGS] & FORW /\ f & FUNC) + return y; + else + aw("redefined", s); + end + if (Yp+SYM >= SYMTBL_SIZE*SYM) + aw("too many symbols", 0); + y := @Syms[Yp]; + Yp := Yp+SYM; + y[SNAME] := newname(s); + y[SFLAGS] := f; + y[SVALUE] := v; + return y; +end + +addfwd(l, a) do + if (Fwp >= FWDCL_SIZE) + aw("too many forward declarations", 0); + Fwlab[Fwp] := l; + Fwaddr[Fwp] := a; + Fwp := Fwp+1; +end + +! +! Emitter +! + +var Pass; + +var Outfile; +var Outbuf::BUFLEN; +var Outp; + +var Gp, Gtop; + +var Tp, Dp, Lp, Ls, Lp0, Lbp0; + +var Acc; + +var Codetbl; + +struct OPT = OINST1, OARG, OINST2, OREPL; + +var Opttbl; + +struct CG = CG_NULL, + CG_PUSH, CG_CLEAR, CG_DROP, + CG_LDVAL, CG_LDADDR, CG_LDLREF, CG_LDGLOB, + CG_LDLOCL, + CG_STGLOB, CG_STLOCL, CG_STINDR, CG_STINDB, + CG_INCGLOB, CG_INCLOCL, CG_INCR, + CG_STACK, CG_UNSTACK, CG_LOCLVEC, CG_GLOBVEC, + CG_INDEX, CG_DEREF, CG_INDXB, CG_DREFB, + CG_CALL, CG_CALR, CG_CALRF, CG_JUMP, CG_RJUMP, CG_JMPFALSE, + CG_JMPTRUE, CG_FOR, CG_FORDOWN, CG_MKFRAME, + CG_DELFRAME, CG_RET, CG_RETF, CG_IRET, CG_HALT, + CG_NEG, CG_INV, CG_LOGNOT, CG_ADD, CG_SUB, + CG_MUL, CG_DIV, CG_MOD, CG_AND, CG_OR, CG_XOR, + CG_SHL, CG_SHR, CG_EQ, CG_NE, CG_LT, CG_GT, + CG_LE, CG_GE, CG_JMPEQ, CG_JMPNE, CG_JMPLT, + CG_JMPGT, CG_JMPLE, CG_JMPGE, CG_PUSHA, CG_POPA; + +findlab(id) return Labels[id]; + +newlab() do + if (Lab >= LABEL_SIZE) aw("too many labels", 0); + Lab := Lab+1; + return Lab-1; +end + +decl commit(0); + +resolve(id) do + commit(); + Labels[id] := Tp; +end + +resolve_fwd(a) do var i; + i := 0; + while (i < Fwp) do + if (Fwaddr[i] = a) do + resolve(Fwlab[i]); + return; + end + i := i+1; + end + oops("unknown forward reference", 0); +end + +flush() do + if (\Outp) return; + if (t.write(Outfile, Outbuf, Outp) \= Outp) + aw("file write error", 0); + Outp := 0; +end + +emit(x) do + Tp := Tp+1; + if (Pass = 0) return; + if (Outp >= BUFLEN) flush(); + Outbuf::Outp := x; + Outp := Outp + 1; +end + +emitw(x) do + emit(255 & x); + emit(255 & (x>>8)); +end + +hex(c) ie (numeric(c)) + return c-'0'; + else + return c-'a'+10; + +byte(s) return 16*hex(s::0) + hex(s::1); + +rgen(s, v) do var n; + while (s::0) do + ie (s::0 = ',') do + ie (s::1 = 'w') + emitw(v); + else ie (s::1 = 'l') + emit(v); + else ie (s::1 = 'h') + emit(v+1); + else ie (s::1 = 'r') + emitw(v-Tp-2); + else ie (s::1 = 'R') do + n := byte(s+4) << 8 | byte(s+2); + emitw(n-Tp-2); + s := s+4; + end + else ie (s::1 = 'b') + emit(v); + else + oops("bad code", 0); + end + else do + emit(byte(s)); + end + s := s+2; + end +end + +var Qi, Qa; + +commit() do + rgen(Codetbl[Qi][1], Qa); + Qi := CG_NULL; +end + +gen(id, a) do var i, skiparg; + skiparg := %1; + i := 0; + while (Opttbl[i] \= %1) do + ie (Opttbl[i][OINST1] = %1) + skiparg := 0; + else if (Qi = Opttbl[i][OINST1] /\ + id = Opttbl[i][OINST2] /\ + (skiparg \/ Qa = Opttbl[i][OARG])) + do + Qi := Opttbl[i][OREPL]; + Qa := a; + return; + end + i := i+1; + end + if (Qi \= CG_NULL) commit(); + Qi := id; + Qa := a; +end + +spill() ie (Acc) + gen(CG_PUSH, 0); + else + Acc := 1; + +active() return Acc; + +clear() Acc := 0; + +activate() Acc := 1; + +builtin(name, arity, a) + add(name, GLOB|FUNC | (arity << 8), a); + +globaddr() do var l, i, g; + if (Gp >= Gtop) do + gen(CG_RJUMP, GPOOL_SIZE*2); + commit(); + Gp := Tp; + for (i=0, GPOOL_SIZE) emitw(0); + Gtop := Tp; + end + g := Gp; + Gp := Gp+2; + return g; +end + +align(x, a) return (x+a) & ~(a-1); + +! +! Scanner +! + +const META = 256; + +const TOKEN_LEN = 128; + +var Infile; +var Inbuf::BUFLEN; +var Ip, Ep; +var Rejected; +var Tk; +var Str::TOKEN_LEN; +var Val; +var Oid; + +var Equal_op, Minus_op, Mul_op, Add_op; + +struct OPER = OPREC, OLEN, ONAME, OTOK, OCODE; + +var Ops; + +struct TOKENS = + SYMBOL, INTEGER, STRING, + ADDROF, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCALL, KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, + KIF, KLEAVE, KLOOP, KMODULE, KOBJECT, KPACKED, KRETURN, + KSTRUCT, KVAR, KWHILE, KFAR, KFINT, KCALLFAR; + +readrc() do var c; + if (Rejected) do + c := Rejected; + Rejected := 0; + return c; + end + if (Ip >= Ep) do + Ep := t.read(Infile, Inbuf, BUFLEN); + Ip := 0; + end + if (Ip >= Ep) return ENDFILE; + c := Inbuf::Ip; + Ip := Ip+1; + return c; +end + +readc() do var c; + c := readrc(); + return 'A' <= c /\ c <= 'Z'-> c-'A'+'a': c; +end + +readec() do var c; + c := readrc(); + if (c \= '\\') return c; + c := readrc(); + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +reject(c) Rejected := c; + +skip() do var c; + c := readc(); + while (1) do + while (c = ' ' \/ c = '\t' \/ c = '\n' \/ c = '\r') do + if (c = '\n') Line := Line+1; + c := readc(); + end + if (c \= '!') + return c; + while (c \= '\n' /\ c \= ENDFILE) + c := readc(); + end +end + +findkw(s) do + if (s::0 = 'c') do + if (str_equal(s, "callfar")) return KCALLFAR; + if (str_equal(s, "call")) return KCALL; + if (str_equal(s, "const")) return KCONST; + return 0; + end + if (s::0 = 'd') do + if (str_equal(s, "do")) return KDO; + if (str_equal(s, "decl")) return KDECL; + return 0; + end + if (s::0 = 'e') do + if (str_equal(s, "else")) return KELSE; + if (str_equal(s, "end")) return KEND; + return 0; + end + if (s::0 = 'f') do + if (str_equal(s, "for")) return KFOR; + if (str_equal(s, "farint")) return KFINT; + if (str_equal(s, "far")) return KFAR; + return 0; + end + if (s::0 = 'h') do + if (str_equal(s, "halt")) return KHALT; + return 0; + end + if (s::0 = 'i') do + if (str_equal(s, "if")) return KIF; + if (str_equal(s, "ie")) return KIE; + return 0; + end + if (s::0 = 'l') do + if (str_equal(s, "leave")) return KLEAVE; + if (str_equal(s, "loop")) return KLOOP; + return 0; + end + if (s::0 = 'm') do + if (str_equal(s, "mod")) return BINOP; + if (str_equal(s, "module")) return KMODULE; + return 0; + end + if (s::0 = 'o') do + if (str_equal(s, "object")) return KOBJECT; + return 0; + end + if (s::0 = 'p') do + if (str_equal(s, "packed")) return KPACKED; + return 0; + end + if (s::0 = 'r') do + if (str_equal(s, "return")) return KRETURN; + return 0; + end + if (s::0 = 's') do + if (str_equal(s, "struct")) return KSTRUCT; + return 0; + end + if (s::0 = 'v') do + if (str_equal(s, "var")) return KVAR; + return 0; + end + if (s::0 = 'w') do + if (str_equal(s, "while")) return KWHILE; + return 0; + end + return 0; +end + +scanop(c) do var i, j; + i := 0; + j := 0; + Oid := %1; + while (Ops[i][OLEN] > 0) do + ie (Ops[i][OLEN] > j) do + if (Ops[i][ONAME]::j = c) do + Oid := i; + Str::j := c; + c := readc(); + j := j+1; + end + end + else do + leave; + end + i := i+1; + end + if (Oid = %1) do + Str::j := c; + j := j+1; + Str::j := 0; + aw("unknown operator", Str); + end + Str::j := 0; + reject(c); + return Ops[Oid][OTOK]; +end + +findop(s) do var i; + i := 0; + while (Ops[i][OLEN] > 0) do + if (str_equal(s, Ops[i][ONAME])) do + Oid := i; + return Oid; + end + i := i+1; + end + oops("operator not found", s); +end + +symbolic(c) return alphabetic(c) \/ c = '_' \/ c = '.'; + +scan() do var c, i, k, sgn, base; + c := skip(); + if (c = ENDFILE \/ c = EOFCHAR) do + str_copy(Str, "end of file"); + return ENDFILE; + end + if (symbolic(c)) do + i := 0; + while (symbolic(c) \/ numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("symbol too long", Str); + end + Str::i := c; + i := i+1; + c := readc(); + end + Str::i := 0; + reject(c); + k := findkw(Str); + if (k \= 0) do + if (k = BINOP) findop(Str); + return k; + end + return SYMBOL; + end + if (numeric(c) \/ c = '%') do + sgn := 1; + i := 0; + if (c = '%') do + sgn := %1; + c := readc(); + Str::i := c; + i := i+1; + if (\numeric(c)) + aw("missing digits after '%'", 0); + end + base := 10; + if (c = '0') do + c := readc(); + if (c = 'x') do + base := 16; + c := readc(); + if (\numeric(c) /\ (c < 'a' \/ c > 'f')) + aw("missing digits after '0x'", 0); + end + end + Val := 0; + while ( numeric(c) \/ + base = 16 /\ 'a' <= c /\ c <= 'f' + ) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("integer too long", Str); + end + Str::i := c; + i := i+1; + c := c >= 'a'-> c-'a'+10: c-'0'; + Val := Val * base + c; + c := readc(); + end + Str::i := 0; + reject(c); + Val := Val * sgn; + return INTEGER; + end + if (c = '\'') do + Val := readec(); + if (readc() \= '\'') + aw("missing ''' in character", 0); + return INTEGER; + end + if (c = '"') do + i := 0; + c := readec(); + while (c \= '"' /\ c \= ENDFILE) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("string too long", Str); + end + Str::i := c & (META-1); + i := i+1; + c := readec(); + end + Str::i := 0; + return STRING; + end + return scanop(c); +end + +! +! Parser +! + +const MAXTBL = 128; +const MAXLOOP = 100; + +var Retlab; +var Rettype; +var Frame; +var Loop0; +var Leaves[MAXLOOP], Lvp; +var Loops[MAXLOOP], Llp; + +expect(tok, s) do var b::100; + if (tok = Tk) return; + str_copy(b, s); + str_append(b, " expected"); + aw(b, Str); +end + +xeqsign() do + if (Tk \= BINOP \/ Oid \= Equal_op) + expect(BINOP, "'='"); + Tk := scan(); +end + +xsemi() do + expect(SEMI, "';'"); + Tk := scan(); +end + +xlparen() do + expect(LPAREN, "'('"); + Tk := scan(); +end + +xrparen() do + expect(RPAREN, "')'"); + Tk := scan(); +end + +xsymbol() expect(SYMBOL, "symbol"); + +constfac() do var v, y; + if (Tk = INTEGER) do + v := Val; + Tk := scan(); + return v; + end + if (Tk = SYMBOL) do + y := lookup(Str, CNST); + Tk := scan(); + return y[SVALUE]; + end + aw("constant value expected", Str); +end + +constval() do var v; + v := constfac(); + ie (Tk = BINOP /\ Oid = Mul_op) do + Tk := scan(); + v := v * constfac(); + end + else if (Tk = BINOP /\ Oid = Add_op) do + Tk := scan(); + v := v + constfac(); + end + return v; +end + +checklocal(y) + if (y[SVALUE] > 126 \/ y[SVALUE] < -126) + aw("local storage exceeded", y[SNAME]); + +vardecl(glb) do var y, size, a; + Tk := scan(); + while (1) do + xsymbol(); + ie (glb & GLOB) do + a := globaddr(); + y := add(Str, glb, a); + end + else do + y := add(Str, 0, Lp); + end + Tk := scan(); + size := 1; + ie (Tk = LBRACK) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + y[SFLAGS] := y[SFLAGS] | VECT; + expect(RBRACK, "']'"); + Tk := scan(); + end + else if (Tk = BYTEOP) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + size := (size + BPW-1) / BPW; + y[SFLAGS] := y[SFLAGS] | VECT; + end + ie (glb & GLOB) do + if (y[SFLAGS] & VECT) do + gen(CG_STACK, -(size*BPW)); + Dp := Dp + size*BPW; + gen(CG_GLOBVEC, a); + end + end + else do + ie (y[SFLAGS] & VECT) do + gen(CG_STACK, -((Ls+size)*BPW)); + Lp := Lp - size*BPW; + Ls := 0; + gen(CG_LOCLVEC, 0); + end + else do + Ls := Ls + 1; + end + Lp := Lp - BPW; + y[SVALUE] := Lp; + ! checklocal(y); + end + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +constdecl(glb) do var y; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, glb|CNST, 0); + Tk := scan(); + xeqsign(); + y[SVALUE] := constval(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +stcdecl(glb) do var y, i; + Tk := scan(); + xsymbol(); + y := add(Str, glb|CNST, 0); + Tk := scan(); + xeqsign(); + i := 0; + while (1) do + xsymbol(); + add(Str, glb|CNST, i); + i := i+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + y[SVALUE] := i; + xsemi(); +end + +fwddecl() do var y, n, l1, l2; + Tk := scan(); + l1 := newlab(); + gen(CG_JUMP, findlab(l1)); + while (1) do + xsymbol(); + l2 := newlab(); + commit(); + addfwd(l2, Tp); + y := add(Str, GLOB|FORW, Tp); + gen(CG_JUMP, findlab(l2)); + Tk := scan(); + xlparen(); + n := constval(); + if (n < 0) aw("invalid arity", 0); + y[SFLAGS] := y[SFLAGS] | (n << 8); + xrparen(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + resolve(l1); + xsemi(); +end + +decl stmt(1); + +fundecl() do + var l_base, l_addr; + var i, na, oyp, onp; + var y, l; + + if (Verbose) do + writes(Str); + nl(); + end + l_addr := 2*BPW; + na := 0; + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + y := add(Str, GLOB|FUNC, Tp); + Tk := scan(); + oyp := Yp; + onp := Np; + l_base := Yp; + xlparen(); + while (Tk = SYMBOL) do + add(Str, 0, l_addr); + l_addr := l_addr + BPW; + na := na+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xrparen(); + Rettype := KEND; + if (Tk = KFAR) do + y[SFLAGS] := y[SFLAGS] | FUNCF; + Rettype := KFAR; + Tk := scan(); + end + if (Tk = KFINT) do + y[SFLAGS] := y[SFLAGS] | FUNCI; + Rettype := KFINT; + Tk := scan(); + end + for (i = l_base, Yp, SYM) do + ie (Rettype = KFAR) + Syms[i+SVALUE] := 8+na*BPW - Syms[i+SVALUE]; + else ie (Rettype = KFINT) + Syms[i+SVALUE] := 2 - Syms[i+SVALUE]; + else + Syms[i+SVALUE] := 6+na*BPW - Syms[i+SVALUE]; + end + if (y[SFLAGS] & FORW) do + if (na \= y[SFLAGS] >> 8) + aw("function does not match DECL", y[SNAME]); + y[SFLAGS] := y[SFLAGS] & ~FORW | FUNC; + resolve_fwd(y[SVALUE]); + y[SVALUE] := Tp; + end + y[SFLAGS] := y[SFLAGS] | (na << 8); + if (na) gen(CG_MKFRAME, 0); + Frame := na; + Retlab := newlab(); + if (Rettype = KFINT) do + gen(CG_PUSHA, 0); + Lp := Lp - 20; + end + stmt(1); + ie (Rettype = KFAR) do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) gen(CG_DELFRAME, 0); + Frame := 0; + gen(CG_RETF, 0); + end + else ie (Rettype = KFINT) do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) do + gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + end + Frame := 0; + gen(CG_IRET, 0); + end + else do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) gen(CG_DELFRAME, 0); + Frame := 0; + gen(CG_RET, 0); + end + resolve(l); + Yp := oyp; + Np := onp; + Lp := 0; +end + +declaration(glb) + ie (Tk = KVAR) + vardecl(glb); + else ie (Tk = KCONST) + constdecl(glb); + else ie (Tk = KSTRUCT) + stcdecl(glb); + else ie (Tk = KDECL) + fwddecl(); + else + fundecl(); + +decl expr(1); + +load(y) ie (y[SFLAGS] & GLOB) + gen(CG_LDGLOB, y[SVALUE]); + else + gen(CG_LDLOCL, y[SVALUE]); + +store(y) + ie (y[SFLAGS] & GLOB) + gen(CG_STGLOB, y[SVALUE]); + else + gen(CG_STLOCL, y[SVALUE]); + +fncall(fn, ind) do var i , msg; + msg := "call of non-function"; + Tk := scan(); + if (fn = 0) aw(msg, 0); + if (\ind /\ fn[SFLAGS] & (FUNC|FORW) = 0) aw(msg, fn[SNAME]); + i := 0; + while (Tk \= RPAREN) do + expr(0); + i := i+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RPAREN) + aw("syntax error", Str); + end + if (\ind /\ i \= fn[SFLAGS] >> 8) + aw("wrong number of arguments", fn[SNAME]); + expect(RPAREN, "')'"); + if (fn[SFLAGS] & (FUNCI)) + aw("wrong function type", fn[SNAME]); + Tk := scan(); + if (active()) spill(); + ie (ind = 2) do + if (fn[SFLAGS] & FUNC) + aw("wrong variable type", fn[SNAME]); + load(fn); + gen(CG_CALRF, 0); + end + else do + if (fn[SFLAGS] & FUNCF) + aw("wrong function type", fn[SNAME]); + ie (fn[SFLAGS] & (FUNC|FORW)) + gen(CG_CALL, fn[SVALUE]); + else do + load(fn); + gen(CG_CALR, 0); + end + end + if (i \= 0) gen(CG_UNSTACK, i*BPW); + activate(); +end + +mkstring(s) do var i, a, k, l; + k := str_length(s); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + for (i=0, k+1) emit(s::i); + resolve(l); + return a; +end + +mkbytevec() do var a, l, k; + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + while (1) do + k := constval(); + if (k > 255 \/ k < 0) + aw("byte vector member out of range", Str); + emit(k); + if (Tk \= COMMA) leave; + Tk := scan(); + end + expect(RBRACK, "']'"); + Tk := scan(); + resolve(l); + return a; +end + +var gtbl[MAXTBL*3], gaf[MAXTBL*3]; + +mktable2(depth) do + var n, i, a, l, y; + var tbl, af; + var dynamic; + + if (depth > 2) aw("table nesting too deep", 0); + tbl := @gtbl[depth*128]; + af := @gaf[depth*128]; + Tk := scan(); + dynamic := 0; + n := 0; + while (Tk \= RBRACK) do + if (n >= MAXTBL) + aw("table too big", 0); + ie (Tk = LPAREN /\ \dynamic) do + Tk := scan(); + dynamic := 1; + loop; + end + else ie (dynamic) do + expr(1); + l := newlab(); + gen(CG_STGLOB, findlab(l)); + tbl[n] := 0; + af[n] := l; + if (Tk = RPAREN) do + Tk := scan(); + dynamic := 0; + end + end + else ie (Tk = INTEGER \/ Tk = SYMBOL) do + tbl[n] := constval(); + af[n] := 0; + end + else ie (Tk = STRING) do + tbl[n] := mkstring(Str); + af[n] := 0; + Tk := scan(); + end + else ie (Tk = LBRACK) do + tbl[n] := mktable2(depth+1); + af[n] := 0; + end + else ie (Tk = KPACKED) do + tbl[n] := mkbytevec(); + af[n] := 0; + end + else ie (Tk = ADDROF) do + Tk := scan(); + xsymbol(); + y := lookup(Str, FUNC); + tbl[n] := y[SVALUE]; + af[n] := 0; + Tk := scan(); + end + else do + aw("invalid table element", Str); + end + n := n+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RBRACK) + aw("syntax error", Str); + end + if (dynamic) + aw("missing ')' in dynamic table", 0); + expect(RBRACK, "']'"); + if (n = 0) aw("empty table", 0); + Tk := scan(); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + for (i=0, n) do + if (af[i]) resolve(af[i]); + emitw(tbl[i]); + end + resolve(l); + return a; +end + +mktable() return mktable2(0); + +decl factor(0); + +address(lv, bp) do var y; + y := lookup(Str, 0); + Tk := scan(); + ie (y[SFLAGS] & CNST) do + if (lv > 0) aw("invalid location", y[SNAME]); + spill(); + gen(CG_LDVAL, y[SVALUE]); + end + else ie (y[SFLAGS] & (FUNC|FORW)) do + ! Don't load + end + else if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) do + spill(); + load(y); + end + if (Tk = LBRACK \/ Tk = BYTEOP) + if (y[SFLAGS] & (FUNC|FORW|CNST)) + aw("bad subscript", y[SNAME]); + while (Tk = LBRACK) do + Tk := scan(); + bp[0] := 0; + expr(0); + expect(RBRACK, "']'"); + Tk := scan(); + y := 0; + gen(CG_INDEX, 0); + if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) + gen(CG_DEREF, 0); + end + if (Tk = BYTEOP) do + Tk := scan(); + bp[0] := 1; + factor(); + y := 0; + gen(CG_INDXB, 0); + if (lv = 0) gen(CG_DREFB, 0); + end + return y; +end + +factor() do var y, op, b; + ie (Tk = INTEGER) do + spill(); + gen(CG_LDVAL, Val); + Tk := scan(); + end + else ie (Tk = SYMBOL) do + y := address(0, @b); + if (Tk = LPAREN) fncall(y, 0); + end + else ie (Tk = STRING) do + spill(); + gen(CG_LDADDR, mkstring(Str)); + Tk := scan(); + end + else ie (Tk = LBRACK) do + spill(); + gen(CG_LDADDR, mktable()); + end + else ie (Tk = KPACKED) do + spill(); + gen(CG_LDADDR, mkbytevec()); + end + else ie (Tk = ADDROF) do + Tk := scan(); + y := address(2, @b); + ie (y = 0) do + ; + end + else ie (y[SFLAGS] & GLOB) do + spill(); + gen(CG_LDADDR, y[SVALUE]); + end + else do + spill(); + gen(CG_LDLREF, y[SVALUE]); + end + end + else ie (Tk = BINOP) do + if (Oid \= Minus_op) + aw("syntax error", Str); + Tk := scan(); + factor(); + gen(CG_NEG, 0); + end + else ie (Tk = UNOP) do + op := Oid; + Tk := scan(); + factor(); + gen(Ops[op][OCODE], 0); + end + else ie (Tk = LPAREN) do + Tk := scan(); + expr(0); + xrparen(); + end + else ie (Tk = KCALL) do + Tk := scan(); + xsymbol(); + y := lookup(Str, 0); + Tk := scan(); + if (Tk \= LPAREN) aw("incomplete CALL", 0); + fncall(y, 1); + end + else ie (Tk = KCALLFAR) do + Tk := scan(); + xsymbol(); + y := lookup(Str, 0); + Tk := scan(); + if (Tk \= LPAREN) aw("incomplete CALLFAR", 0); + fncall(y, 2); + end + else do + aw("syntax error", Str); + end +end + +emitop(stk, p) do + gen(Ops[stk[p-1]][OCODE], 0); + return p-1; +end + +arith() do var stk[10], p; + factor(); + p := 0; + while (Tk = BINOP) do + while (p /\ Ops[Oid][OPREC] <= Ops[stk[p-1]][OPREC]) + p := emitop(stk, p); + stk[p] := Oid; + p := p+1; + Tk := scan(); + factor(); + end + while (p > 0) + p := emitop(stk, p); +end + +logop(conop) do var l; + ie (conop) + arith(); + else + logop(%1); + l := 0; + while (Tk = (conop-> CONJ: DISJ)) do + Tk := scan(); + if (\l) l := newlab(); + commit(); + gen(conop-> CG_JMPFALSE: CG_JMPTRUE, findlab(l)); + clear(); + ie (conop) + arith(); + else + logop(%1); + end + if (l) resolve(l); +end + +expr(clr) do var l1, l2; + if (clr) clear(); + logop(0); + if (Tk = COND) do + Tk := scan(); + l1 := newlab(); + l2 := newlab(); + gen(CG_JMPFALSE, findlab(l1)); + expr(1); + expect(COLON, "':'"); + Tk := scan(); + gen(CG_JUMP, findlab(l2)); + resolve(l1); + expr(1); + resolve(l2); + end +end + +halt_stmt() do var r; + Tk := scan(); + r := Tk = SEMI-> 0: constval(); + gen(CG_HALT, r); + xsemi(); +end + +return_stmt() do + Tk := scan(); + if (Retlab = 0) + aw("cannot return from main body", 0); + ie (Tk = SEMI) + gen(CG_CLEAR, 0); + else + expr(1); + ie (Frame /\ Lp /\ Lp0 = Lp) do + gen(CG_JUMP, findlab(Retlab)); + end + else do + if (Lp \= 0) gen(CG_UNSTACK, -Lp); + ie (Rettype = KFAR) do + if (Frame) gen(CG_DELFRAME, 0); + gen(CG_RETF, 0); + end + else ie (Rettype = KFINT) do + if (Frame) do + gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + end + gen(CG_IRET, 0); + end + else do + if (Frame) gen(CG_DELFRAME, 0); + gen(CG_RET, 0); + end + end + xsemi(); +end + +if_stmt(alt) do var l1, l2; + Tk := scan(); + xlparen(); + expr(1); + l1 := newlab(); + gen(CG_JMPFALSE, findlab(l1)); + xrparen(); + stmt(0); + if (alt) do + l2 := newlab(); + gen(CG_JUMP, findlab(l2)); + resolve(l1); + l1 := l2; + expect(KELSE, "ELSE"); + Tk := scan(); + stmt(0); + end + resolve(l1); +end + +while_stmt() do var olp, olv, l, a0; + Tk := scan(); + commit(); + olp := Loop0; + olv := Lvp; + a0 := Tp; + Loop0 := Tp; + xlparen(); + expr(1); + xrparen(); + l := newlab(); + gen(CG_JMPFALSE, findlab(l)); + stmt(0); + gen(CG_JUMP, a0); + resolve(l); + while (Lvp > olv) do + resolve(Leaves[Lvp-1]); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +for_stmt() do + var y, l, a0; + var step; + var oll, olp, olv; + var test; + + Tk := scan(); + oll := Llp; + olv := Lvp; + olp := Loop0; + Loop0 := 0; + xlparen(); + xsymbol(); + y := lookup(Str, 0); + if (y[SFLAGS] & (CNST|FUNC|FORW)) + aw("unexpected type", y[SNAME]); + Tk := scan(); + xeqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + Tk := scan(); + commit(); + a0 := Tp; + test := Tp; + load(y); + expr(0); + ie (Tk = COMMA) do + Tk := scan(); + step := constval(); + end + else do + step := 1; + end + l := newlab(); + gen(step<0-> CG_FORDOWN: CG_FOR, findlab(l)); + xrparen(); + stmt(0); + while (Llp > oll) do + resolve(Loops[Llp-1]); + Llp := Llp-1; + end + ie (y[SFLAGS] & GLOB) do + ie (step = 1) do + gen(CG_INCGLOB, y[SVALUE]); + end + else do + gen(CG_LDGLOB, y[SVALUE]); + gen(CG_INCR, step); + gen(CG_STGLOB, y[SVALUE]); + end + end + else do + ie (step = 1) do + gen(CG_INCLOCL, y[SVALUE]); + end + else do + gen(CG_LDLOCL, y[SVALUE]); + gen(CG_INCR, step); + gen(CG_STLOCL, y[SVALUE]); + end + end + gen(CG_JUMP, a0); + resolve(l); + while (Lvp > olv) do + resolve(Leaves[Lvp-1]); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +leave_stmt() do var l; + Tk := scan(); + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + xsemi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", 0); + l := newlab(); + Leaves[Lvp] := l; + if (Lbp0 \= Lp) gen(CG_UNSTACK, Lbp0-Lp); + gen(CG_JUMP, findlab(l)); + Lvp := Lvp+1; +end + +loop_stmt() do var l; + Tk := scan(); + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + xsemi(); + ie (Loop0 > 0) do + gen(CG_JUMP, Loop0); + end + else do + if (Llp >= MAXLOOP) + aw("too many LOOPs", 0); + l := newlab(); + Loops[Llp] := l; + if (Lbp0 \= Lp) gen(CG_UNSTACK, Lbp0-Lp); + gen(CG_JUMP, findlab(l)); + Llp := Llp+1; + end +end + +asg_or_call() do var y, b; + clear(); + y := address(1, @b); + ie (Tk = LPAREN) do + fncall(y, 0); + end + else ie (Tk = ASSIGN) do + Tk := scan(); + expr(0); + ie (y = 0) + gen(b-> CG_STINDB: CG_STINDR, 0); + else ie (y[SFLAGS] & (FUNC|FORW|CNST|VECT)) + aw("bad location", y[SNAME]); + else + store(y); + end + else do + aw("syntax error", Str); + end + xsemi(); +end + +decl compound(2); + +stmt(body) ie (Tk = KFOR) + for_stmt(); + else ie (Tk = KHALT) + halt_stmt(); + else ie (Tk = KIE) + if_stmt(1); + else ie (Tk = KIF) + if_stmt(0); + else ie (Tk = KELSE) + aw("ELSE without IE", 0); + else ie (Tk = KLEAVE) + leave_stmt(); + else ie (Tk = KLOOP) + loop_stmt(); + else ie (Tk = KRETURN) + return_stmt(); + else ie (Tk = KWHILE) + while_stmt(); + else ie (Tk = KDO) + compound(body, 0); + else ie (Tk = SYMBOL) + asg_or_call(); + else ie (Tk = KCALL) do + clear(); + factor(); + end + else ie (Tk = KCALLFAR) do + clear(); + factor(); + end + else ie (Tk = SEMI) + Tk := scan(); + else + expect(%1, "statement"); + +compound(body, main) do var oyp, olp, olbp, onp, ols, msg; + msg := "unexpected end of compound statement"; + Tk := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + ols := Ls; + olbp := Lbp0; + Ls := 0; + Lbp0 := Lp; + while (Tk = KVAR \/ Tk = KCONST \/ Tk = KSTRUCT) do + if (Tk = KVAR /\ \Frame) do + gen(CG_MKFRAME, 0); + Frame := 1; + end + declaration(0); + end + if (Ls) gen(CG_STACK, -(Ls*BPW)); + if (body) Lp0 := Lp; + if (main) Lbp0 := Lp; + while (Tk \= KEND) do + if (Tk = ENDFILE) aw(msg, 0); + stmt(0); + end + Tk := scan(); + if (body) do + gen(CG_CLEAR, 0); + resolve(Retlab); + Retlab := 0; + end + if (olp \= Lp) gen(CG_UNSTACK, olp-Lp); + if (body /\ Frame) do + if (Rettype = KFINT) gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + Frame := 0; + end + Yp := oyp; + Np := onp; + Lp := olp; + Ls := ols; + Lbp0 := olbp; +end + +checkclass() + if (\str_equal(Str, "t3x")) + aw("class name must be T3X", Str); + +module_decl() do + Tk := scan(); + xsymbol(); + Tk := scan(); + xlparen(); + xsymbol(); + checkclass(); + Tk := scan(); + xrparen(); + xsemi(); +end + +object_decl() do + Tk := scan(); + xsymbol(); + if (\str_equal(Str, "t")) + aw("object name must be T", Str); + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + expect(SYMBOL, "symbol"); + checkclass(); + Tk := scan(); + expect(RBRACK, "']'"); + Tk := scan(); + xsemi(); +end + +program() do var i; + Tk := scan(); + if (Tk = KMODULE) module_decl(); + if (Tk = KOBJECT) object_decl(); + while ( Tk = KVAR \/ Tk = KCONST \/ Tk = SYMBOL \/ + Tk = KDECL \/ Tk = KSTRUCT + ) + declaration(GLOB); + if (Tk \= KDO) + aw("DO or declaration expected", 0); + compound(0, 1); + if (Tk \= ENDFILE) + aw("trailing characters", Str); + gen(CG_HALT, 0); + for (i=0, Yp, SYM) + if (Syms[i+SFLAGS] & FORW /\ Syms[i+SVALUE]) + aw("undefined function", Syms[i+SNAME]); +end + +! +! Main +! + +emitlib() do var i, j, k, lib; + lib := + !LIBRARY! + [ 0x0080, + packed [ + 0xe9,0xef,0x04,0xf7,0x05,0x54,0x33,0x58,0xe9,0x7e,0x00,0xe9, + 0xa2,0x01,0xe9,0xda,0x01,0xe9,0x27,0x02,0xe9,0x60,0x02,0xe9, + 0x9b,0x02,0xe9,0xbc,0x02,0xe9,0x1c,0x03,0xe9,0x82,0x03,0xe9, + 0x95,0x03,0xe9,0xaa,0x03,0xe9,0x0b,0x04,0xe9,0x21,0x04,0xe9, + 0x34,0x04,0xe9,0x3f,0x04,0xe9,0x4a,0x04,0xe9,0x55,0x04,0xe9, + 0x60,0x04,0xe9,0x6b,0x04,0xe9,0xa7,0x03,0xe9,0x73,0x04,0xe9, + 0x7e,0x04,0xe9,0x89,0x04,0xe9,0x94,0x04,0xe9,0x72,0x01,0xe9, + 0xbf,0x01,0xe9,0x04,0x02,0xe9,0x2e,0x02,0xe9,0xfe,0x00,0xe9, + 0x0e,0x01,0xe9,0x21,0x01,0xe9,0x2f,0x01,0xe9,0x42,0x01,0xe9, + 0xc3,0x00,0xe9,0xcc,0x00,0xe9,0xd4,0x00,0xe9,0xdd,0x00,0xe9, + 0x3d,0x00,0xe9,0x66,0x00,0xe9,0x85,0x00 ], + 0x0080, + packed [ + 0xe9,0x0a,0x00,0xe9,0x1c,0x00,0xe9,0x24,0x00,0xb8,0x02,0x00, + 0xc3,0x55,0x89,0xe5,0x8b,0x76,0x08,0x8b,0x46,0x04,0x89,0x04, + 0x8b,0x46,0x06,0x89,0x44,0x02,0x31,0xc0,0x5d,0xc3,0x55,0x89, + 0xe5,0x8b,0x76,0x04,0x8b,0x44,0x02,0x5d,0xc3,0x55,0x89,0xe5, + 0x8b,0x76,0x04,0x8b,0x04,0x5d,0xc3,0x55,0x89,0xe5,0x8b,0x46, + 0x10,0xbe,0xd6,0x01,0x2e,0x88,0x04,0x8b,0x46,0x0e,0x8b,0x5e, + 0x0c,0x8b,0x4e,0x0a,0x8b,0x56,0x08,0x8b,0x76,0x06,0x8b,0x7e, + 0x04,0xcd,0x00,0x72,0x05,0x31,0xc0,0xe9,0x03,0x00,0xb8,0x01, + 0x00,0x5d,0xc3,0x55,0x89,0xe5,0x8b,0x46,0x10,0xbe,0x02,0x02, + 0x2e,0x88,0x04,0x8b,0x46,0x0e,0x8b,0x5e,0x0c,0x8b,0x4e,0x0a, + 0x8b,0x56,0x08,0x8b,0x76,0x06,0x8b,0x7e ], + 0x0080, + packed [ + 0x04,0xcd,0x00,0x5d,0xc3,0x55,0x89,0xe5,0x8b,0x46,0x10,0xbe, + 0x24,0x02,0x2e,0x88,0x04,0x8b,0x46,0x0e,0x8b,0x5e,0x0c,0x8b, + 0x4e,0x0a,0x8b,0x56,0x08,0x8b,0x76,0x06,0x8b,0x7e,0x04,0xcd, + 0x00,0x74,0x05,0x31,0xc0,0xe9,0x03,0x00,0xb8,0x01,0x00,0x5d, + 0xc3,0x55,0x89,0xe5,0x8b,0x56,0x06,0x8a,0x46,0x04,0xee,0x5d, + 0xc3,0x55,0x89,0xe5,0x8b,0x56,0x04,0x31,0xc0,0xec,0x5d,0xc3, + 0x55,0x89,0xe5,0x8b,0x56,0x06,0x8b,0x46,0x04,0xef,0x5d,0xc3, + 0x55,0x89,0xe5,0x8b,0x56,0x04,0xed,0x5d,0xc3,0x55,0x89,0xe5, + 0x1e,0x8b,0x46,0x06,0x8e,0xd8,0x8b,0x5e,0x04,0x31,0xc0,0x8a, + 0x07,0x1f,0x5d,0xc3,0x55,0x89,0xe5,0x1e,0x8b,0x46,0x08,0x8e, + 0xd8,0x8b,0x5e,0x06,0x8a,0x46,0x04,0x88 ], + 0x0080, + packed [ + 0x07,0x31,0xc0,0x1f,0x5d,0xc3,0x55,0x89,0xe5,0x1e,0x8b,0x46, + 0x06,0x8e,0xd8,0x8b,0x5e,0x04,0x8b,0x07,0x1f,0x5d,0xc3,0x55, + 0x89,0xe5,0x1e,0x8b,0x46,0x08,0x8e,0xd8,0x8b,0x5e,0x06,0x8b, + 0x46,0x04,0x89,0x07,0x31,0xc0,0x1f,0x5d,0xc3,0x8c,0xc8,0xc3, + 0x55,0x89,0xe5,0x8b,0x7e,0x04,0xfc,0xb0,0x0d,0xaa,0xb0,0x0a, + 0xaa,0x30,0xc0,0xaa,0x8b,0x46,0x04,0x5d,0xc3,0x55,0x89,0xe5, + 0x1e,0x06,0x8b,0x46,0x0c,0x8e,0xd8,0x8b,0x46,0x0a,0x50,0x8b, + 0x46,0x08,0x8e,0xc0,0x8b,0x46,0x06,0x50,0x8b,0x46,0x04,0x50, + 0xe8,0x08,0x00,0x81,0xc4,0x06,0x00,0x07,0x1f,0x5d,0xc3,0x55, + 0x89,0xe5,0x8b,0x7e,0x08,0x8b,0x76,0x06,0x8b,0x4e,0x04,0x39, + 0xfe,0x75,0x04,0x31,0xc0,0xeb,0x14,0xff ], + 0x0080, + packed [ + 0xc1,0xfc,0xf3,0xa6,0x09,0xc9,0x75,0x04,0x31,0xc0,0xeb,0x07, + 0x8a,0x45,0xff,0x2a,0x44,0xff,0x98,0x5d,0xc3,0x55,0x89,0xe5, + 0x1e,0x06,0x8b,0x46,0x0c,0x8e,0xd8,0x8b,0x46,0x0a,0x50,0x8b, + 0x46,0x08,0x8e,0xc0,0x8b,0x46,0x06,0x50,0x8b,0x46,0x04,0x50, + 0xe8,0x08,0x00,0x81,0xc4,0x06,0x00,0x07,0x1f,0x5d,0xc3,0x55, + 0x89,0xe5,0x8b,0x7e,0x08,0x8b,0x76,0x06,0x8b,0x4e,0x04,0xfc, + 0x39,0xf7,0x74,0x0d,0x72,0x09,0xfd,0x01,0xce,0x01,0xcf,0xff, + 0xce,0xff,0xcf,0xf3,0xa4,0x5d,0x31,0xc0,0xc3,0x55,0x89,0xe5, + 0x06,0x8b,0x46,0x0a,0x8e,0xc0,0x8b,0x7e,0x08,0x8b,0x46,0x06, + 0x8b,0x4e,0x04,0xfc,0xf3,0xaa,0x07,0x5d,0x31,0xc0,0xc3,0x55, + 0x89,0xe5,0x8b,0x7e,0x08,0x8b,0x46,0x06 ], + 0x0080, + packed [ + 0x8b,0x4e,0x04,0xfc,0xf3,0xaa,0x5d,0x31,0xc0,0xc3,0x55,0x89, + 0xe5,0x1e,0x8b,0x46,0x0a,0x8e,0xd8,0x8b,0x7e,0x08,0x89,0xfa, + 0x8b,0x46,0x06,0x8b,0x4e,0x04,0xff,0xc1,0xfc,0xf2,0xae,0x09, + 0xc9,0x74,0x08,0x89,0xf8,0x29,0xd0,0xff,0xc8,0xeb,0x03,0xb8, + 0xff,0xff,0x1f,0x5d,0xc3,0x55,0x89,0xe5,0x8b,0x7e,0x08,0x89, + 0xfa,0x8b,0x46,0x06,0x8b,0x4e,0x04,0xff,0xc1,0xfc,0xf2,0xae, + 0x09,0xc9,0x74,0x08,0x89,0xf8,0x29,0xd0,0xff,0xc8,0xeb,0x03, + 0xb8,0xff,0xff,0x5d,0xc3,0x55,0x89,0xe5,0x8b,0x4e,0x08,0xff, + 0xc9,0xbe,0x82,0x00,0xfc,0xff,0xce,0xac,0x80,0xf8,0x20,0x74, + 0xfa,0x80,0xf8,0x09,0x74,0xf5,0x80,0xf8,0x0d,0x75,0x05,0xb8, + 0xff,0xff,0xeb,0x3e,0x09,0xc9,0x74,0x14 ], + 0x0080, + packed [ + 0xff,0xc9,0xac,0x80,0xf8,0x20,0x74,0xdd,0x80,0xf8,0x09,0x74, + 0xd8,0x80,0xf8,0x0d,0x74,0xd3,0xeb,0xee,0x8b,0x7e,0x06,0x8b, + 0x4e,0x04,0x31,0xdb,0xff,0xc3,0x39,0xcb,0x73,0x13,0xaa,0xac, + 0x80,0xf8,0x20,0x74,0x0c,0x80,0xf8,0x09,0x74,0x07,0x80,0xf8, + 0x0d,0x74,0x02,0xeb,0xe7,0x31,0xc0,0xaa,0x89,0xd8,0x5d,0xc3, + 0x55,0x89,0xe5,0x8b,0x46,0x04,0x81,0xf8,0x01,0x00,0x75,0x11, + 0xb8,0x00,0x3c,0x8b,0x56,0x06,0x31,0xc9,0xcd,0x21,0x73,0x29, + 0xb8,0xff,0xff,0xeb,0x4a,0x81,0xf8,0x00,0x00,0x74,0x0e,0x81, + 0xf8,0x03,0x00,0x74,0x05,0xb8,0xff,0xff,0xeb,0x39,0xb8,0x02, + 0x00,0x81,0xc8,0x00,0x3d,0x8b,0x56,0x06,0xcd,0x21,0x73,0x05, + 0xb8,0xff,0xff,0xeb,0x26,0x81,0xf8,0x00 ], + 0x0080, + packed [ + 0x00,0x7d,0x05,0xb8,0xff,0xff,0xeb,0x1b,0x8b,0x5e,0x04,0x81, + 0xfb,0x03,0x00,0x75,0x12,0x50,0x89,0xc3,0xb8,0x02,0x42,0x31, + 0xc9,0x31,0xd2,0xcd,0x21,0x58,0x73,0x03,0xb8,0xff,0xff,0x5d, + 0xc3,0x55,0x89,0xe5,0x8b,0x5e,0x04,0xb8,0x00,0x3e,0xcd,0x21, + 0x73,0x05,0xb8,0xff,0xff,0xeb,0x02,0x31,0xc0,0x5d,0xc3,0x55, + 0x89,0xe5,0xb8,0x00,0x3f,0x8b,0x5e,0x08,0x8b,0x56,0x06,0x8b, + 0x4e,0x04,0xcd,0x21,0x73,0x03,0xb8,0xff,0xff,0x5d,0xc3,0x55, + 0x89,0xe5,0xb8,0x00,0x40,0x8b,0x5e,0x08,0x8b,0x56,0x06,0x8b, + 0x4e,0x04,0xcd,0x21,0x73,0x03,0xb8,0xff,0xff,0x5d,0xc3,0x55, + 0x89,0xe5,0x8b,0x56,0x06,0x31,0xc9,0x8b,0x46,0x04,0x09,0xc0, + 0x75,0x05,0xb8,0x00,0x42,0xeb,0x28,0x81 ], + 0x0080, + packed [ + 0xf8,0x01,0x00,0x75,0x06,0xb8,0x01,0x42,0xe9,0x1c,0x00,0x81, + 0xf8,0x02,0x00,0x75,0x09,0xb8,0x02,0x42,0xf7,0xda,0xff,0xc9, + 0xeb,0x0d,0x81,0xf8,0x03,0x00,0x75,0x12,0xb8,0x01,0x42,0xf7, + 0xda,0xff,0xc9,0x8b,0x5e,0x08,0xcd,0x21,0x72,0x04,0x31,0xc0, + 0xeb,0x03,0xb8,0xff,0xff,0x5d,0xc3,0x55,0x89,0xe5,0xb8,0x00, + 0x56,0x8b,0x56,0x06,0x8b,0x7e,0x04,0xcd,0x21,0x73,0x05,0xb8, + 0xff,0xff,0xeb,0x02,0x31,0xc0,0x5d,0xc3,0x55,0x89,0xe5,0xb8, + 0x00,0x41,0x8b,0x56,0x04,0xcd,0x21,0x73,0x05,0xb8,0xff,0xff, + 0xeb,0x02,0x31,0xc0,0x5d,0xc3,0x5e,0x5b,0x31,0xd2,0x39,0xc3, + 0x75,0x02,0xff,0xca,0x89,0xd0,0xff,0xe6,0x5e,0x5b,0x31,0xd2, + 0x39,0xc3,0x74,0x02,0xff,0xca,0x89,0xd0 ], + 0x0077, + packed [ + 0xff,0xe6,0x5e,0x5b,0x31,0xd2,0x39,0xc3,0x7d,0x02,0xff,0xca, + 0x89,0xd0,0xff,0xe6,0x5e,0x5b,0x31,0xd2,0x39,0xc3,0x7e,0x02, + 0xff,0xca,0x89,0xd0,0xff,0xe6,0x5e,0x5b,0x31,0xd2,0x39,0xc3, + 0x7f,0x02,0xff,0xca,0x89,0xd0,0xff,0xe6,0x5e,0x5b,0x31,0xd2, + 0x39,0xc3,0x7c,0x02,0xff,0xca,0x89,0xd0,0xff,0xe6,0x5e,0x5b, + 0x31,0xd2,0x39,0xc3,0x73,0x02,0xff,0xca,0x89,0xd0,0xff,0xe6, + 0x5e,0x5b,0x31,0xd2,0x39,0xc3,0x76,0x02,0xff,0xca,0x89,0xd0, + 0xff,0xe6,0x5e,0x5b,0x31,0xd2,0x39,0xc3,0x77,0x02,0xff,0xca, + 0x89,0xd0,0xff,0xe6,0x5e,0x5b,0x31,0xd2,0x39,0xc3,0x72,0x02, + 0xff,0xca,0x89,0xd0,0xff,0xe6,0xb8,0xfe,0xff,0x89,0xc4 ], + 0 ]; + !LIBRARY! + i := 0; + while (lib[i]) do + k := lib[i]; + i := i+1; + for (j=0, k) emit(lib[i]::j); + i := i+1; + end +end + +init(p) do var i, b::10; + Pass := p; + Rejected := 0; + Ip := 0; + Ep := 0; + Gp := 0; + Gtop := 0; + Outp := 0; + Tp := 0x100; + Dp := 0; + Lp := 0; + Yp := 0; + Np := 0; + Fwp := 0; + Lab := 0; + Line := 1; + Acc := 0; + Retlab := 0; + Frame := 0; + Loop0 := %1; + Lvp := 0; + Llp := 0; + Qi := CG_NULL; + Codetbl := [ + [ CG_NULL, "" ], + [ CG_PUSH, "50" ], ! push ax + [ CG_CLEAR, "31c0" ], ! xor ax,ax + [ CG_DROP, "5b" ], ! pop bx + [ CG_LDVAL, "b8,w" ], ! mov ax,W + [ CG_LDADDR, "b8,w" ], ! mov ax,W + [ CG_LDLREF, "8d86,w" ], ! lea ax,[bp+W] + [ CG_LDGLOB, "a1,w" ], ! mov ax,[W] + [ CG_LDLOCL, "8b86,w" ], ! mov ax,[bp+W] + [ CG_STGLOB, "a3,w" ], ! mov [W],ax + [ CG_STLOCL, "8986,w" ], ! mov [bp+W],ax + [ CG_STINDR, "5b8907" ], ! pop bx; mov [bx],ax + [ CG_STINDB, "5b8807" ], ! pop bx; mov [bx],al + [ CG_INCGLOB, "ff06,w" ], ! inc word [W] + [ CG_INCLOCL, "ff86,w" ], ! inc word [bp+W] + [ CG_INCR, "05,w" ], ! add ax,W + [ CG_STACK, "81c4,w" ], ! add sp,W + [ CG_UNSTACK, "81c4,w" ], ! add sp,W + [ CG_LOCLVEC, "89e050" ], ! mov ax,sp; push ax + [ CG_GLOBVEC, "8926,w" ], ! mov [W],sp + [ CG_INDEX, "d1e05b01d8" ], ! shl ax,1;pop bx;add ax,bx + [ CG_DEREF, "89c38b07" ], ! mov bx,ax; mov ax,[bx] + [ CG_INDXB, "5b01d8" ], ! pop bx; add ax,bx + [ CG_DREFB, "89c331c08a07" ], ! mov bx,ax; xor ax,ax + ! mov ax,[bx] + [ CG_CALL, "e8,r" ], ! call R + [ CG_CALR, "ffd0" ], ! call ax + [ CG_CALRF, "89c3ff1f" ], ! mov bx,ax; call far [bx] + [ CG_JUMP, "e9,r" ], ! jmp R + [ CG_RJUMP, "eb,b" ], ! jmps R + [ CG_JMPFALSE, "09c07503e9,r" ], ! or ax,ax; jne +3; jmp R + [ CG_JMPTRUE, "09c07403e9,r" ], ! or ax,ax; je +3; jmp R + [ CG_FOR, "5b39c37c03e9,r"], ! pop bx; cmp bx,ax; jl +3 + ! jmp R + [ CG_FORDOWN, "5b39c37f03e9,r"], ! pop bx; cmp bx,ax; jg +3 + ! jmp R + [ CG_MKFRAME, "5589e5" ], ! push bp; mov bp,sp + [ CG_DELFRAME, "5d" ], ! pop bp + [ CG_RET, "c3" ], ! ret + [ CG_RETF, "cb" ], ! retf + [ CG_IRET, "cf" ], ! iret + [ CG_HALT, "b8004ccd21" ], ! mov ax,4c00h; int 21H + [ CG_NEG, "f7d8" ], ! neg ax + [ CG_INV, "f7d0" ], ! not ax + [ CG_LOGNOT, "f7d819c0f7d0" ], ! neg ax; sbb ax,ax; not ax + [ CG_ADD, "5b01d8" ], ! pop bx; add ax,bx + [ CG_SUB, "89c35829d8" ], ! mov bx,ax;pop ax;sub ax,bx + [ CG_MUL, "59f7e9" ], ! pop cx; imul cx + [ CG_DIV, "89c15899f7f9" ], ! mov cx,ax; pop ax; cwd; + ! idiv cx + [ CG_MOD, "89c15831d2f7f189d0"], ! mov ax,cx; pop ax + ! xor dx,dx; div cx + ! mov ax,dx + [ CG_AND, "5b21d8" ], ! pop bx; and ax,bx + [ CG_OR, "5b09d8" ], ! pop bx; or ax,bx + [ CG_XOR, "5b31d8" ], ! pop bx; xor ax,bx + [ CG_SHL, "89c158d3e0" ], ! mov cx,ax;pop ax;shl ax,cl + [ CG_SHR, "89c158d3e8" ], ! mov cx,ax;pop ax;shr ax,cl +! [ CG_EQ, "31d25b39c375014a89d0" ], ! xor dx,dx; pop bx +! [ CG_NE, "31d25b39c374014a89d0" ], ! cmp bx,ax; j?? +3 +! [ CG_LT, "31d25b39c37d014a89d0" ], ! dec dx; mov ax,dx +! [ CG_GT, "31d25b39c37e014a89d0" ], ! ??=ne,e,ge,le,g,l +! [ CG_LE, "31d25b39c37f014a89d0" ], +! [ CG_GE, "31d25b39c37c014a89d0" ], + [ CG_EQ, "e8,R2f01" ], ! call $12f + [ CG_NE, "e8,R3201" ], ! call $132 + [ CG_LT, "e8,R3501" ], ! call $135 + [ CG_GT, "e8,R3801" ], ! call $138 + [ CG_LE, "e8,R3b01" ], ! call $13b + [ CG_GE, "e8,R3e01" ], ! call $13e + [ CG_JMPEQ, "5b39c37503e9,r"], ! pop bx; cmp bx,ax; jne +3 + ! jmp R + [ CG_JMPNE, "5b39c37403e9,r"], ! ... je +3 ... + [ CG_JMPLT, "5b39c37d03e9,r"], ! ... jge +3 ... + [ CG_JMPGT, "5b39c37e03e9,r"], ! ... jle +3 ... + [ CG_JMPLE, "5b39c37f03e9,r"], ! ... jg +3 ... + [ CG_JMPGE, "5b39c37c03e9,r"], ! ... jl +3 ... + [ CG_PUSHA,"505351521e5606571689e0404050"], + ! push ax,bx,cx,dx,ds,si,es + ! push di,ss;mov ax,sp; + ! inc ax;inc ax;push ax + [ CG_POPA,"5b58fa8ed089dcfb5f075e1f5a595b58"], + ! pop ax,bx;cli;mov ss,ax + ! mov sp,bx;sti;pop di,es + ! pop si,ds,dx,cx,bx,ax + [ %1, "" ] ]; + Opttbl := [ + [ CG_EQ, 0, CG_JMPFALSE, CG_JMPNE ], + [ CG_NE, 0, CG_JMPFALSE, CG_JMPEQ ], + [ CG_LT, 0, CG_JMPFALSE, CG_JMPGE ], + [ CG_GT, 0, CG_JMPFALSE, CG_JMPLE ], + [ CG_LE, 0, CG_JMPFALSE, CG_JMPGT ], + [ CG_GE, 0, CG_JMPFALSE, CG_JMPLT ], + [ CG_LOGNOT, 0, CG_JMPFALSE, CG_JMPTRUE ], + [ %1, %1, %1, %1 ], + [ CG_LDVAL, 0, CG_ADD, CG_DROP ], + %1 ]; + Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], + [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], + [ 0, 1, ")", RPAREN, 0 ], + [ 0, 1, "[", LBRACK, 0 ], + [ 0, 1, "]", RBRACK, 0 ], + [ 3, 1, "=", BINOP, CG_EQ ], + [ 5, 1, "&", BINOP, CG_AND ], + [ 5, 1, "|", BINOP, CG_OR ], + [ 5, 1, "^", BINOP, CG_XOR ], + [ 0, 1, "@", ADDROF, 0 ], + [ 0, 1, "~", UNOP, CG_INV ], + [ 0, 1, ":", COLON, 0 ], + [ 0, 2, "::", BYTEOP, 0 ], + [ 0, 2, ":=", ASSIGN, 0 ], + [ 0, 1, "\\", UNOP, CG_LOGNOT ], + [ 1, 2, "\\/", DISJ, 0 ], + [ 3, 2, "\\=", BINOP, CG_NE ], + [ 4, 1, "<", BINOP, CG_LT ], + [ 4, 2, "<=", BINOP, CG_LE ], + [ 5, 2, "<<", BINOP, CG_SHL ], + [ 4, 1, ">", BINOP, CG_GT ], + [ 4, 2, ">=", BINOP, CG_GE ], + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], + [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); + Minus_op := findop("-"); + Mul_op := findop("*"); + Add_op := findop("+"); + i := 0; + while (Codetbl[i][0] \= %1) do + if (Codetbl[i][0] \= i) do + str_copy(b, ntoa(i)); + oops("bad code table entry", b); + end + i := i+1; + end + add("t3x.sysin", GLOB|CNST, 0); + add("t3x.sysout", GLOB|CNST, 1); + add("t3x.syserr", GLOB|CNST, 2); + add("t3x.oread", GLOB|CNST, 0); + add("t3x.owrite", GLOB|CNST, 1); + add("t3x.oappnd", GLOB|CNST, 3); + add("t3x.ptrsize", GLOB|CNST, 4); + builtin("t.bpw", 0, 0x0108); + builtin("t.newline", 1, 0x010b); + builtin("t.memcomp", 3, 0x010e); + builtin("t.memcopy", 3, 0x0111); + builtin("t.memfill", 3, 0x0114); + builtin("t.memscan", 3, 0x0117); + builtin("t.getarg", 3, 0x011a); + builtin("t.open", 2, 0x011d); + builtin("t.close", 1, 0x0120); + builtin("t.read", 3, 0x0123); + builtin("t.write", 3, 0x0126); + builtin("t.rename", 2, 0x0129); + builtin("t.remove", 1, 0x012c); + builtin("t.farcomp", 5, 0x0150); + builtin("t.farcopy", 5, 0x0153); + builtin("t.farfill", 4, 0x0156); + builtin("t.farscan", 4, 0x0159); + builtin("t.fargetb", 2, 0x015c); + builtin("t.farsetb", 3, 0x015f); + builtin("t.fargetw", 2, 0x0162); + builtin("t.farsetw", 3, 0x0165); + builtin("t.local", 0, 0x0168); + builtin("t.outb", 2, 0x016b); + builtin("t.inb", 1, 0x016e); + builtin("t.outw", 2, 0x0171); + builtin("t.inw", 1, 0x0174); + builtin("t.int86c", 7, 0x0177); + builtin("t.int86ax", 7, 0x017a); + builtin("t.int86z", 7, 0x017d); + builtin("t.setptr", 3, 0x0180); + builtin("t.getseg", 1, 0x0183); + builtin("t.getoff", 1, 0x0186); + emitlib(); +end + +info() do + writes("Text = "); + writes(ntoa(Tp - 0x100)); + writes(", Data = "); + writes(ntoa(Dp+622)); + writes(", Symbols = "); + writes(ntoa(Yp/SYM)); + writes(", Nlist = "); + writes(ntoa(Np)); + writes(", Labels = "); + writes(ntoa(Lab)); + nl(); +end + +phase(in, n) do + if (Verbose) do + writes(n-> "Pass 2:": "Pass 1:"); + nl(); + end + Infile := t.open(in, T3X.OREAD); + if (Infile < 0) aw("no such file", in); + Outfile := t.open(Outname, T3X.OWRITE); + if (Outfile < 0) aw("cannot create", Outname); + init(n); + program(); + commit(); + t.close(Infile); + flush(); + t.close(Outfile); +end + +upcase(s) do var i; + i := 0; + while (s::i) do + if ('a' <= s::i /\ s::i <= 'z') + s::i := s::i-'a'+'A'; + i := i+1; + end + return s; +end + +do var in::75, k; + Outname::0 := 0; + Verbose := 0; + if (t.getarg(2, in, 4) \= %1 /\ str_equal(upcase(in), "/V")) + Verbose := 1; + k := t.getarg(1, in, 72); + if (k < 0) aw("missing file name", 0); + t.memcopy(@in::k, ".t", 3); + str_copy(Outname, in); + t.memcopy(@Outname::k, ".com", 5); + phase(in, 0); + phase(in, 1); + info(); +end diff --git a/SRC/TSOURCE.T b/SRC/TSOURCE.T new file mode 100644 index 0000000..c7b2698 --- /dev/null +++ b/SRC/TSOURCE.T @@ -0,0 +1,1900 @@ +! T3X -> DOS/8086 compiler +! Nils M Holm, 2017,2019,2020,2021,2022 +! Humberto Costa dos Santos Junior, 2022 +! Public Domain / 0BSD license + +module t3x86(t3x); + +object t[t3x]; + +const BPW = 2; + +const GPOOL_SIZE = 7; + +const BUFLEN = 512; + +const SYMTBL_SIZE = 2048; +const LABEL_SIZE = 2048; +const NLIST_SIZE = 6144; +const FWDCL_SIZE = 128; + +var Outname::80; + +var Line; + +var Verbose; + +const ENDFILE = %1; +const EOFCHAR = 0x1a; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +str_copy(sd, ss) t.memcopy(sd, ss, str_length(ss)+1); + +str_append(sd, ss) t.memcopy(@sd::str_length(sd), ss, str_length(ss)+1); + +str_equal(s1, s2) return t.memcomp(s1, s2, str_length(s1)+1) = 0; + +writes(s) t.write(1, s, str_length(s)); + +nl() do var b::3; + writes(t.newline(b)); +end + +aw(m, s) do + writes("Error: "); + writes(ntoa(Line)); + writes(": "); + writes(m); + if (s \= 0) do + writes(": "); + writes(s); + end + nl(); + if (Outname::0) t.remove(Outname); + halt 1; +end + +oops(m, s) do + writes("Internal error"); + nl(); + aw(m, s); +end + +numeric(c) return '0' <= c /\ c <= '9'; + +alphabetic(c) return 'a' <= c /\ c <= 'z' \/ + 'A' <= c /\ c <= 'Z'; + +! +! Symbol tables +! + +struct SYM = SNAME, SFLAGS, SVALUE; + +const GLOB = 1; +const CNST = 2; +const VECT = 4; +const FORW = 8; +const FUNC = 16; +const FUNCF = 32; +const FUNCI = 64; + +var Syms[SYM*SYMTBL_SIZE]; +var Labels[LABEL_SIZE]; +Var Lab; +var Nlist::NLIST_SIZE; + +var Yp, Np; + +var Fwlab[FWDCL_SIZE], + Fwaddr[FWDCL_SIZE]; +var Fwp; + +find(s) do var i; + i := Yp-SYM; + while (i >= 0) do + if (str_equal(Syms[i+SNAME], s)) + return @Syms[i]; + i := i - SYM; + end + return 0; +end + +lookup(s, f) do var y; + y := find(s); + if (y = 0) aw("undefined", s); + if (y[SFLAGS] & f \= f) + aw("unexpected type", s); + return y; +end + +newname(s) do var k, new; + k := str_length(s)+1; + if (Np+k >= NLIST_SIZE) + aw("name pool overflow", s); + new := @Nlist::Np; + t.memcopy(new, s, k); + Np := Np+k; + return new; +end + +add(s, f, v) do var y; + y := find(s); + if (y \= 0) do + ie (y[SFLAGS] & FORW /\ f & FUNC) + return y; + else + aw("redefined", s); + end + if (Yp+SYM >= SYMTBL_SIZE*SYM) + aw("too many symbols", 0); + y := @Syms[Yp]; + Yp := Yp+SYM; + y[SNAME] := newname(s); + y[SFLAGS] := f; + y[SVALUE] := v; + return y; +end + +addfwd(l, a) do + if (Fwp >= FWDCL_SIZE) + aw("too many forward declarations", 0); + Fwlab[Fwp] := l; + Fwaddr[Fwp] := a; + Fwp := Fwp+1; +end + +! +! Emitter +! + +var Pass; + +var Outfile; +var Outbuf::BUFLEN; +var Outp; + +var Gp, Gtop; + +var Tp, Dp, Lp, Ls, Lp0, Lbp0; + +var Acc; + +var Codetbl; + +struct OPT = OINST1, OARG, OINST2, OREPL; + +var Opttbl; + +struct CG = CG_NULL, + CG_PUSH, CG_CLEAR, CG_DROP, + CG_LDVAL, CG_LDADDR, CG_LDLREF, CG_LDGLOB, + CG_LDLOCL, + CG_STGLOB, CG_STLOCL, CG_STINDR, CG_STINDB, + CG_INCGLOB, CG_INCLOCL, CG_INCR, + CG_STACK, CG_UNSTACK, CG_LOCLVEC, CG_GLOBVEC, + CG_INDEX, CG_DEREF, CG_INDXB, CG_DREFB, + CG_CALL, CG_CALR, CG_CALRF, CG_JUMP, CG_RJUMP, CG_JMPFALSE, + CG_JMPTRUE, CG_FOR, CG_FORDOWN, CG_MKFRAME, + CG_DELFRAME, CG_RET, CG_RETF, CG_IRET, CG_HALT, + CG_NEG, CG_INV, CG_LOGNOT, CG_ADD, CG_SUB, + CG_MUL, CG_DIV, CG_MOD, CG_AND, CG_OR, CG_XOR, + CG_SHL, CG_SHR, CG_EQ, CG_NE, CG_LT, CG_GT, + CG_LE, CG_GE, CG_JMPEQ, CG_JMPNE, CG_JMPLT, + CG_JMPGT, CG_JMPLE, CG_JMPGE, CG_PUSHA, CG_POPA; + +findlab(id) return Labels[id]; + +newlab() do + if (Lab >= LABEL_SIZE) aw("too many labels", 0); + Lab := Lab+1; + return Lab-1; +end + +decl commit(0); + +resolve(id) do + commit(); + Labels[id] := Tp; +end + +resolve_fwd(a) do var i; + i := 0; + while (i < Fwp) do + if (Fwaddr[i] = a) do + resolve(Fwlab[i]); + return; + end + i := i+1; + end + oops("unknown forward reference", 0); +end + +flush() do + if (\Outp) return; + if (t.write(Outfile, Outbuf, Outp) \= Outp) + aw("file write error", 0); + Outp := 0; +end + +emit(x) do + Tp := Tp+1; + if (Pass = 0) return; + if (Outp >= BUFLEN) flush(); + Outbuf::Outp := x; + Outp := Outp + 1; +end + +emitw(x) do + emit(255 & x); + emit(255 & (x>>8)); +end + +hex(c) ie (numeric(c)) + return c-'0'; + else + return c-'a'+10; + +byte(s) return 16*hex(s::0) + hex(s::1); + +rgen(s, v) do var n; + while (s::0) do + ie (s::0 = ',') do + ie (s::1 = 'w') + emitw(v); + else ie (s::1 = 'l') + emit(v); + else ie (s::1 = 'h') + emit(v+1); + else ie (s::1 = 'r') + emitw(v-Tp-2); + else ie (s::1 = 'R') do + n := byte(s+4) << 8 | byte(s+2); + emitw(n-Tp-2); + s := s+4; + end + else ie (s::1 = 'b') + emit(v); + else + oops("bad code", 0); + end + else do + emit(byte(s)); + end + s := s+2; + end +end + +var Qi, Qa; + +commit() do + rgen(Codetbl[Qi][1], Qa); + Qi := CG_NULL; +end + +gen(id, a) do var i, skiparg; + skiparg := %1; + i := 0; + while (Opttbl[i] \= %1) do + ie (Opttbl[i][OINST1] = %1) + skiparg := 0; + else if (Qi = Opttbl[i][OINST1] /\ + id = Opttbl[i][OINST2] /\ + (skiparg \/ Qa = Opttbl[i][OARG])) + do + Qi := Opttbl[i][OREPL]; + Qa := a; + return; + end + i := i+1; + end + if (Qi \= CG_NULL) commit(); + Qi := id; + Qa := a; +end + +spill() ie (Acc) + gen(CG_PUSH, 0); + else + Acc := 1; + +active() return Acc; + +clear() Acc := 0; + +activate() Acc := 1; + +builtin(name, arity, a) + add(name, GLOB|FUNC | (arity << 8), a); + +globaddr() do var l, i, g; + if (Gp >= Gtop) do + gen(CG_RJUMP, GPOOL_SIZE*2); + commit(); + Gp := Tp; + for (i=0, GPOOL_SIZE) emitw(0); + Gtop := Tp; + end + g := Gp; + Gp := Gp+2; + return g; +end + +align(x, a) return (x+a) & ~(a-1); + +! +! Scanner +! + +const META = 256; + +const TOKEN_LEN = 128; + +var Infile; +var Inbuf::BUFLEN; +var Ip, Ep; +var Rejected; +var Tk; +var Str::TOKEN_LEN; +var Val; +var Oid; + +var Equal_op, Minus_op, Mul_op, Add_op; + +struct OPER = OPREC, OLEN, ONAME, OTOK, OCODE; + +var Ops; + +struct TOKENS = + SYMBOL, INTEGER, STRING, + ADDROF, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCALL, KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, + KIF, KLEAVE, KLOOP, KMODULE, KOBJECT, KPACKED, KRETURN, + KSTRUCT, KVAR, KWHILE, KFAR, KFINT, KCALLFAR; + +readrc() do var c; + if (Rejected) do + c := Rejected; + Rejected := 0; + return c; + end + if (Ip >= Ep) do + Ep := t.read(Infile, Inbuf, BUFLEN); + Ip := 0; + end + if (Ip >= Ep) return ENDFILE; + c := Inbuf::Ip; + Ip := Ip+1; + return c; +end + +readc() do var c; + c := readrc(); + return 'A' <= c /\ c <= 'Z'-> c-'A'+'a': c; +end + +readec() do var c; + c := readrc(); + if (c \= '\\') return c; + c := readrc(); + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +reject(c) Rejected := c; + +skip() do var c; + c := readc(); + while (1) do + while (c = ' ' \/ c = '\t' \/ c = '\n' \/ c = '\r') do + if (c = '\n') Line := Line+1; + c := readc(); + end + if (c \= '!') + return c; + while (c \= '\n' /\ c \= ENDFILE) + c := readc(); + end +end + +findkw(s) do + if (s::0 = 'c') do + if (str_equal(s, "callfar")) return KCALLFAR; + if (str_equal(s, "call")) return KCALL; + if (str_equal(s, "const")) return KCONST; + return 0; + end + if (s::0 = 'd') do + if (str_equal(s, "do")) return KDO; + if (str_equal(s, "decl")) return KDECL; + return 0; + end + if (s::0 = 'e') do + if (str_equal(s, "else")) return KELSE; + if (str_equal(s, "end")) return KEND; + return 0; + end + if (s::0 = 'f') do + if (str_equal(s, "for")) return KFOR; + if (str_equal(s, "farint")) return KFINT; + if (str_equal(s, "far")) return KFAR; + return 0; + end + if (s::0 = 'h') do + if (str_equal(s, "halt")) return KHALT; + return 0; + end + if (s::0 = 'i') do + if (str_equal(s, "if")) return KIF; + if (str_equal(s, "ie")) return KIE; + return 0; + end + if (s::0 = 'l') do + if (str_equal(s, "leave")) return KLEAVE; + if (str_equal(s, "loop")) return KLOOP; + return 0; + end + if (s::0 = 'm') do + if (str_equal(s, "mod")) return BINOP; + if (str_equal(s, "module")) return KMODULE; + return 0; + end + if (s::0 = 'o') do + if (str_equal(s, "object")) return KOBJECT; + return 0; + end + if (s::0 = 'p') do + if (str_equal(s, "packed")) return KPACKED; + return 0; + end + if (s::0 = 'r') do + if (str_equal(s, "return")) return KRETURN; + return 0; + end + if (s::0 = 's') do + if (str_equal(s, "struct")) return KSTRUCT; + return 0; + end + if (s::0 = 'v') do + if (str_equal(s, "var")) return KVAR; + return 0; + end + if (s::0 = 'w') do + if (str_equal(s, "while")) return KWHILE; + return 0; + end + return 0; +end + +scanop(c) do var i, j; + i := 0; + j := 0; + Oid := %1; + while (Ops[i][OLEN] > 0) do + ie (Ops[i][OLEN] > j) do + if (Ops[i][ONAME]::j = c) do + Oid := i; + Str::j := c; + c := readc(); + j := j+1; + end + end + else do + leave; + end + i := i+1; + end + if (Oid = %1) do + Str::j := c; + j := j+1; + Str::j := 0; + aw("unknown operator", Str); + end + Str::j := 0; + reject(c); + return Ops[Oid][OTOK]; +end + +findop(s) do var i; + i := 0; + while (Ops[i][OLEN] > 0) do + if (str_equal(s, Ops[i][ONAME])) do + Oid := i; + return Oid; + end + i := i+1; + end + oops("operator not found", s); +end + +symbolic(c) return alphabetic(c) \/ c = '_' \/ c = '.'; + +scan() do var c, i, k, sgn, base; + c := skip(); + if (c = ENDFILE \/ c = EOFCHAR) do + str_copy(Str, "end of file"); + return ENDFILE; + end + if (symbolic(c)) do + i := 0; + while (symbolic(c) \/ numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("symbol too long", Str); + end + Str::i := c; + i := i+1; + c := readc(); + end + Str::i := 0; + reject(c); + k := findkw(Str); + if (k \= 0) do + if (k = BINOP) findop(Str); + return k; + end + return SYMBOL; + end + if (numeric(c) \/ c = '%') do + sgn := 1; + i := 0; + if (c = '%') do + sgn := %1; + c := readc(); + Str::i := c; + i := i+1; + if (\numeric(c)) + aw("missing digits after '%'", 0); + end + base := 10; + if (c = '0') do + c := readc(); + if (c = 'x') do + base := 16; + c := readc(); + if (\numeric(c) /\ (c < 'a' \/ c > 'f')) + aw("missing digits after '0x'", 0); + end + end + Val := 0; + while ( numeric(c) \/ + base = 16 /\ 'a' <= c /\ c <= 'f' + ) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("integer too long", Str); + end + Str::i := c; + i := i+1; + c := c >= 'a'-> c-'a'+10: c-'0'; + Val := Val * base + c; + c := readc(); + end + Str::i := 0; + reject(c); + Val := Val * sgn; + return INTEGER; + end + if (c = '\'') do + Val := readec(); + if (readc() \= '\'') + aw("missing ''' in character", 0); + return INTEGER; + end + if (c = '"') do + i := 0; + c := readec(); + while (c \= '"' /\ c \= ENDFILE) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("string too long", Str); + end + Str::i := c & (META-1); + i := i+1; + c := readec(); + end + Str::i := 0; + return STRING; + end + return scanop(c); +end + +! +! Parser +! + +const MAXTBL = 128; +const MAXLOOP = 100; + +var Retlab; +var Rettype; +var Frame; +var Loop0; +var Leaves[MAXLOOP], Lvp; +var Loops[MAXLOOP], Llp; + +expect(tok, s) do var b::100; + if (tok = Tk) return; + str_copy(b, s); + str_append(b, " expected"); + aw(b, Str); +end + +xeqsign() do + if (Tk \= BINOP \/ Oid \= Equal_op) + expect(BINOP, "'='"); + Tk := scan(); +end + +xsemi() do + expect(SEMI, "';'"); + Tk := scan(); +end + +xlparen() do + expect(LPAREN, "'('"); + Tk := scan(); +end + +xrparen() do + expect(RPAREN, "')'"); + Tk := scan(); +end + +xsymbol() expect(SYMBOL, "symbol"); + +constfac() do var v, y; + if (Tk = INTEGER) do + v := Val; + Tk := scan(); + return v; + end + if (Tk = SYMBOL) do + y := lookup(Str, CNST); + Tk := scan(); + return y[SVALUE]; + end + aw("constant value expected", Str); +end + +constval() do var v; + v := constfac(); + ie (Tk = BINOP /\ Oid = Mul_op) do + Tk := scan(); + v := v * constfac(); + end + else if (Tk = BINOP /\ Oid = Add_op) do + Tk := scan(); + v := v + constfac(); + end + return v; +end + +checklocal(y) + if (y[SVALUE] > 126 \/ y[SVALUE] < -126) + aw("local storage exceeded", y[SNAME]); + +vardecl(glb) do var y, size, a; + Tk := scan(); + while (1) do + xsymbol(); + ie (glb & GLOB) do + a := globaddr(); + y := add(Str, glb, a); + end + else do + y := add(Str, 0, Lp); + end + Tk := scan(); + size := 1; + ie (Tk = LBRACK) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + y[SFLAGS] := y[SFLAGS] | VECT; + expect(RBRACK, "']'"); + Tk := scan(); + end + else if (Tk = BYTEOP) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + size := (size + BPW-1) / BPW; + y[SFLAGS] := y[SFLAGS] | VECT; + end + ie (glb & GLOB) do + if (y[SFLAGS] & VECT) do + gen(CG_STACK, -(size*BPW)); + Dp := Dp + size*BPW; + gen(CG_GLOBVEC, a); + end + end + else do + ie (y[SFLAGS] & VECT) do + gen(CG_STACK, -((Ls+size)*BPW)); + Lp := Lp - size*BPW; + Ls := 0; + gen(CG_LOCLVEC, 0); + end + else do + Ls := Ls + 1; + end + Lp := Lp - BPW; + y[SVALUE] := Lp; + ! checklocal(y); + end + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +constdecl(glb) do var y; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, glb|CNST, 0); + Tk := scan(); + xeqsign(); + y[SVALUE] := constval(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +stcdecl(glb) do var y, i; + Tk := scan(); + xsymbol(); + y := add(Str, glb|CNST, 0); + Tk := scan(); + xeqsign(); + i := 0; + while (1) do + xsymbol(); + add(Str, glb|CNST, i); + i := i+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + y[SVALUE] := i; + xsemi(); +end + +fwddecl() do var y, n, l1, l2; + Tk := scan(); + l1 := newlab(); + gen(CG_JUMP, findlab(l1)); + while (1) do + xsymbol(); + l2 := newlab(); + commit(); + addfwd(l2, Tp); + y := add(Str, GLOB|FORW, Tp); + gen(CG_JUMP, findlab(l2)); + Tk := scan(); + xlparen(); + n := constval(); + if (n < 0) aw("invalid arity", 0); + y[SFLAGS] := y[SFLAGS] | (n << 8); + xrparen(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + resolve(l1); + xsemi(); +end + +decl stmt(1); + +fundecl() do + var l_base, l_addr; + var i, na, oyp, onp; + var y, l; + + if (Verbose) do + writes(Str); + nl(); + end + l_addr := 2*BPW; + na := 0; + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + y := add(Str, GLOB|FUNC, Tp); + Tk := scan(); + oyp := Yp; + onp := Np; + l_base := Yp; + xlparen(); + while (Tk = SYMBOL) do + add(Str, 0, l_addr); + l_addr := l_addr + BPW; + na := na+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xrparen(); + Rettype := KEND; + if (Tk = KFAR) do + y[SFLAGS] := y[SFLAGS] | FUNCF; + Rettype := KFAR; + Tk := scan(); + end + if (Tk = KFINT) do + y[SFLAGS] := y[SFLAGS] | FUNCI; + Rettype := KFINT; + Tk := scan(); + end + for (i = l_base, Yp, SYM) do + ie (Rettype = KFAR) + Syms[i+SVALUE] := 8+na*BPW - Syms[i+SVALUE]; + else ie (Rettype = KFINT) + Syms[i+SVALUE] := 2 - Syms[i+SVALUE]; + else + Syms[i+SVALUE] := 6+na*BPW - Syms[i+SVALUE]; + end + if (y[SFLAGS] & FORW) do + if (na \= y[SFLAGS] >> 8) + aw("function does not match DECL", y[SNAME]); + y[SFLAGS] := y[SFLAGS] & ~FORW | FUNC; + resolve_fwd(y[SVALUE]); + y[SVALUE] := Tp; + end + y[SFLAGS] := y[SFLAGS] | (na << 8); + if (na) gen(CG_MKFRAME, 0); + Frame := na; + Retlab := newlab(); + if (Rettype = KFINT) do + gen(CG_PUSHA, 0); + Lp := Lp - 20; + end + stmt(1); + ie (Rettype = KFAR) do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) gen(CG_DELFRAME, 0); + Frame := 0; + gen(CG_RETF, 0); + end + else ie (Rettype = KFINT) do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) do + gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + end + Frame := 0; + gen(CG_IRET, 0); + end + else do + if (Retlab) resolve(Retlab); + Retlab := 0; + if (Frame) gen(CG_DELFRAME, 0); + Frame := 0; + gen(CG_RET, 0); + end + resolve(l); + Yp := oyp; + Np := onp; + Lp := 0; +end + +declaration(glb) + ie (Tk = KVAR) + vardecl(glb); + else ie (Tk = KCONST) + constdecl(glb); + else ie (Tk = KSTRUCT) + stcdecl(glb); + else ie (Tk = KDECL) + fwddecl(); + else + fundecl(); + +decl expr(1); + +load(y) ie (y[SFLAGS] & GLOB) + gen(CG_LDGLOB, y[SVALUE]); + else + gen(CG_LDLOCL, y[SVALUE]); + +store(y) + ie (y[SFLAGS] & GLOB) + gen(CG_STGLOB, y[SVALUE]); + else + gen(CG_STLOCL, y[SVALUE]); + +fncall(fn, ind) do var i , msg; + msg := "call of non-function"; + Tk := scan(); + if (fn = 0) aw(msg, 0); + if (\ind /\ fn[SFLAGS] & (FUNC|FORW) = 0) aw(msg, fn[SNAME]); + i := 0; + while (Tk \= RPAREN) do + expr(0); + i := i+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RPAREN) + aw("syntax error", Str); + end + if (\ind /\ i \= fn[SFLAGS] >> 8) + aw("wrong number of arguments", fn[SNAME]); + expect(RPAREN, "')'"); + if (fn[SFLAGS] & (FUNCI)) + aw("wrong function type", fn[SNAME]); + Tk := scan(); + if (active()) spill(); + ie (ind = 2) do + if (fn[SFLAGS] & FUNC) + aw("wrong variable type", fn[SNAME]); + load(fn); + gen(CG_CALRF, 0); + end + else do + if (fn[SFLAGS] & FUNCF) + aw("wrong function type", fn[SNAME]); + ie (fn[SFLAGS] & (FUNC|FORW)) + gen(CG_CALL, fn[SVALUE]); + else do + load(fn); + gen(CG_CALR, 0); + end + end + if (i \= 0) gen(CG_UNSTACK, i*BPW); + activate(); +end + +mkstring(s) do var i, a, k, l; + k := str_length(s); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + for (i=0, k+1) emit(s::i); + resolve(l); + return a; +end + +mkbytevec() do var a, l, k; + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + while (1) do + k := constval(); + if (k > 255 \/ k < 0) + aw("byte vector member out of range", Str); + emit(k); + if (Tk \= COMMA) leave; + Tk := scan(); + end + expect(RBRACK, "']'"); + Tk := scan(); + resolve(l); + return a; +end + +var gtbl[MAXTBL*3], gaf[MAXTBL*3]; + +mktable2(depth) do + var n, i, a, l, y; + var tbl, af; + var dynamic; + + if (depth > 2) aw("table nesting too deep", 0); + tbl := @gtbl[depth*128]; + af := @gaf[depth*128]; + Tk := scan(); + dynamic := 0; + n := 0; + while (Tk \= RBRACK) do + if (n >= MAXTBL) + aw("table too big", 0); + ie (Tk = LPAREN /\ \dynamic) do + Tk := scan(); + dynamic := 1; + loop; + end + else ie (dynamic) do + expr(1); + l := newlab(); + gen(CG_STGLOB, findlab(l)); + tbl[n] := 0; + af[n] := l; + if (Tk = RPAREN) do + Tk := scan(); + dynamic := 0; + end + end + else ie (Tk = INTEGER \/ Tk = SYMBOL) do + tbl[n] := constval(); + af[n] := 0; + end + else ie (Tk = STRING) do + tbl[n] := mkstring(Str); + af[n] := 0; + Tk := scan(); + end + else ie (Tk = LBRACK) do + tbl[n] := mktable2(depth+1); + af[n] := 0; + end + else ie (Tk = KPACKED) do + tbl[n] := mkbytevec(); + af[n] := 0; + end + else ie (Tk = ADDROF) do + Tk := scan(); + xsymbol(); + y := lookup(Str, FUNC); + tbl[n] := y[SVALUE]; + af[n] := 0; + Tk := scan(); + end + else do + aw("invalid table element", Str); + end + n := n+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RBRACK) + aw("syntax error", Str); + end + if (dynamic) + aw("missing ')' in dynamic table", 0); + expect(RBRACK, "']'"); + if (n = 0) aw("empty table", 0); + Tk := scan(); + l := newlab(); + gen(CG_JUMP, findlab(l)); + commit(); + a := Tp; + for (i=0, n) do + if (af[i]) resolve(af[i]); + emitw(tbl[i]); + end + resolve(l); + return a; +end + +mktable() return mktable2(0); + +decl factor(0); + +address(lv, bp) do var y; + y := lookup(Str, 0); + Tk := scan(); + ie (y[SFLAGS] & CNST) do + if (lv > 0) aw("invalid location", y[SNAME]); + spill(); + gen(CG_LDVAL, y[SVALUE]); + end + else ie (y[SFLAGS] & (FUNC|FORW)) do + ! Don't load + end + else if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) do + spill(); + load(y); + end + if (Tk = LBRACK \/ Tk = BYTEOP) + if (y[SFLAGS] & (FUNC|FORW|CNST)) + aw("bad subscript", y[SNAME]); + while (Tk = LBRACK) do + Tk := scan(); + bp[0] := 0; + expr(0); + expect(RBRACK, "']'"); + Tk := scan(); + y := 0; + gen(CG_INDEX, 0); + if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) + gen(CG_DEREF, 0); + end + if (Tk = BYTEOP) do + Tk := scan(); + bp[0] := 1; + factor(); + y := 0; + gen(CG_INDXB, 0); + if (lv = 0) gen(CG_DREFB, 0); + end + return y; +end + +factor() do var y, op, b; + ie (Tk = INTEGER) do + spill(); + gen(CG_LDVAL, Val); + Tk := scan(); + end + else ie (Tk = SYMBOL) do + y := address(0, @b); + if (Tk = LPAREN) fncall(y, 0); + end + else ie (Tk = STRING) do + spill(); + gen(CG_LDADDR, mkstring(Str)); + Tk := scan(); + end + else ie (Tk = LBRACK) do + spill(); + gen(CG_LDADDR, mktable()); + end + else ie (Tk = KPACKED) do + spill(); + gen(CG_LDADDR, mkbytevec()); + end + else ie (Tk = ADDROF) do + Tk := scan(); + y := address(2, @b); + ie (y = 0) do + ; + end + else ie (y[SFLAGS] & GLOB) do + spill(); + gen(CG_LDADDR, y[SVALUE]); + end + else do + spill(); + gen(CG_LDLREF, y[SVALUE]); + end + end + else ie (Tk = BINOP) do + if (Oid \= Minus_op) + aw("syntax error", Str); + Tk := scan(); + factor(); + gen(CG_NEG, 0); + end + else ie (Tk = UNOP) do + op := Oid; + Tk := scan(); + factor(); + gen(Ops[op][OCODE], 0); + end + else ie (Tk = LPAREN) do + Tk := scan(); + expr(0); + xrparen(); + end + else ie (Tk = KCALL) do + Tk := scan(); + xsymbol(); + y := lookup(Str, 0); + Tk := scan(); + if (Tk \= LPAREN) aw("incomplete CALL", 0); + fncall(y, 1); + end + else ie (Tk = KCALLFAR) do + Tk := scan(); + xsymbol(); + y := lookup(Str, 0); + Tk := scan(); + if (Tk \= LPAREN) aw("incomplete CALLFAR", 0); + fncall(y, 2); + end + else do + aw("syntax error", Str); + end +end + +emitop(stk, p) do + gen(Ops[stk[p-1]][OCODE], 0); + return p-1; +end + +arith() do var stk[10], p; + factor(); + p := 0; + while (Tk = BINOP) do + while (p /\ Ops[Oid][OPREC] <= Ops[stk[p-1]][OPREC]) + p := emitop(stk, p); + stk[p] := Oid; + p := p+1; + Tk := scan(); + factor(); + end + while (p > 0) + p := emitop(stk, p); +end + +logop(conop) do var l; + ie (conop) + arith(); + else + logop(%1); + l := 0; + while (Tk = (conop-> CONJ: DISJ)) do + Tk := scan(); + if (\l) l := newlab(); + commit(); + gen(conop-> CG_JMPFALSE: CG_JMPTRUE, findlab(l)); + clear(); + ie (conop) + arith(); + else + logop(%1); + end + if (l) resolve(l); +end + +expr(clr) do var l1, l2; + if (clr) clear(); + logop(0); + if (Tk = COND) do + Tk := scan(); + l1 := newlab(); + l2 := newlab(); + gen(CG_JMPFALSE, findlab(l1)); + expr(1); + expect(COLON, "':'"); + Tk := scan(); + gen(CG_JUMP, findlab(l2)); + resolve(l1); + expr(1); + resolve(l2); + end +end + +halt_stmt() do var r; + Tk := scan(); + r := Tk = SEMI-> 0: constval(); + gen(CG_HALT, r); + xsemi(); +end + +return_stmt() do + Tk := scan(); + if (Retlab = 0) + aw("cannot return from main body", 0); + ie (Tk = SEMI) + gen(CG_CLEAR, 0); + else + expr(1); + ie (Frame /\ Lp /\ Lp0 = Lp) do + gen(CG_JUMP, findlab(Retlab)); + end + else do + if (Lp \= 0) gen(CG_UNSTACK, -Lp); + ie (Rettype = KFAR) do + if (Frame) gen(CG_DELFRAME, 0); + gen(CG_RETF, 0); + end + else ie (Rettype = KFINT) do + if (Frame) do + gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + end + gen(CG_IRET, 0); + end + else do + if (Frame) gen(CG_DELFRAME, 0); + gen(CG_RET, 0); + end + end + xsemi(); +end + +if_stmt(alt) do var l1, l2; + Tk := scan(); + xlparen(); + expr(1); + l1 := newlab(); + gen(CG_JMPFALSE, findlab(l1)); + xrparen(); + stmt(0); + if (alt) do + l2 := newlab(); + gen(CG_JUMP, findlab(l2)); + resolve(l1); + l1 := l2; + expect(KELSE, "ELSE"); + Tk := scan(); + stmt(0); + end + resolve(l1); +end + +while_stmt() do var olp, olv, l, a0; + Tk := scan(); + commit(); + olp := Loop0; + olv := Lvp; + a0 := Tp; + Loop0 := Tp; + xlparen(); + expr(1); + xrparen(); + l := newlab(); + gen(CG_JMPFALSE, findlab(l)); + stmt(0); + gen(CG_JUMP, a0); + resolve(l); + while (Lvp > olv) do + resolve(Leaves[Lvp-1]); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +for_stmt() do + var y, l, a0; + var step; + var oll, olp, olv; + var test; + + Tk := scan(); + oll := Llp; + olv := Lvp; + olp := Loop0; + Loop0 := 0; + xlparen(); + xsymbol(); + y := lookup(Str, 0); + if (y[SFLAGS] & (CNST|FUNC|FORW)) + aw("unexpected type", y[SNAME]); + Tk := scan(); + xeqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + Tk := scan(); + commit(); + a0 := Tp; + test := Tp; + load(y); + expr(0); + ie (Tk = COMMA) do + Tk := scan(); + step := constval(); + end + else do + step := 1; + end + l := newlab(); + gen(step<0-> CG_FORDOWN: CG_FOR, findlab(l)); + xrparen(); + stmt(0); + while (Llp > oll) do + resolve(Loops[Llp-1]); + Llp := Llp-1; + end + ie (y[SFLAGS] & GLOB) do + ie (step = 1) do + gen(CG_INCGLOB, y[SVALUE]); + end + else do + gen(CG_LDGLOB, y[SVALUE]); + gen(CG_INCR, step); + gen(CG_STGLOB, y[SVALUE]); + end + end + else do + ie (step = 1) do + gen(CG_INCLOCL, y[SVALUE]); + end + else do + gen(CG_LDLOCL, y[SVALUE]); + gen(CG_INCR, step); + gen(CG_STLOCL, y[SVALUE]); + end + end + gen(CG_JUMP, a0); + resolve(l); + while (Lvp > olv) do + resolve(Leaves[Lvp-1]); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +leave_stmt() do var l; + Tk := scan(); + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + xsemi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", 0); + l := newlab(); + Leaves[Lvp] := l; + if (Lbp0 \= Lp) gen(CG_UNSTACK, Lbp0-Lp); + gen(CG_JUMP, findlab(l)); + Lvp := Lvp+1; +end + +loop_stmt() do var l; + Tk := scan(); + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + xsemi(); + ie (Loop0 > 0) do + gen(CG_JUMP, Loop0); + end + else do + if (Llp >= MAXLOOP) + aw("too many LOOPs", 0); + l := newlab(); + Loops[Llp] := l; + if (Lbp0 \= Lp) gen(CG_UNSTACK, Lbp0-Lp); + gen(CG_JUMP, findlab(l)); + Llp := Llp+1; + end +end + +asg_or_call() do var y, b; + clear(); + y := address(1, @b); + ie (Tk = LPAREN) do + fncall(y, 0); + end + else ie (Tk = ASSIGN) do + Tk := scan(); + expr(0); + ie (y = 0) + gen(b-> CG_STINDB: CG_STINDR, 0); + else ie (y[SFLAGS] & (FUNC|FORW|CNST|VECT)) + aw("bad location", y[SNAME]); + else + store(y); + end + else do + aw("syntax error", Str); + end + xsemi(); +end + +decl compound(2); + +stmt(body) ie (Tk = KFOR) + for_stmt(); + else ie (Tk = KHALT) + halt_stmt(); + else ie (Tk = KIE) + if_stmt(1); + else ie (Tk = KIF) + if_stmt(0); + else ie (Tk = KELSE) + aw("ELSE without IE", 0); + else ie (Tk = KLEAVE) + leave_stmt(); + else ie (Tk = KLOOP) + loop_stmt(); + else ie (Tk = KRETURN) + return_stmt(); + else ie (Tk = KWHILE) + while_stmt(); + else ie (Tk = KDO) + compound(body, 0); + else ie (Tk = SYMBOL) + asg_or_call(); + else ie (Tk = KCALL) do + clear(); + factor(); + end + else ie (Tk = KCALLFAR) do + clear(); + factor(); + end + else ie (Tk = SEMI) + Tk := scan(); + else + expect(%1, "statement"); + +compound(body, main) do var oyp, olp, olbp, onp, ols, msg; + msg := "unexpected end of compound statement"; + Tk := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + ols := Ls; + olbp := Lbp0; + Ls := 0; + Lbp0 := Lp; + while (Tk = KVAR \/ Tk = KCONST \/ Tk = KSTRUCT) do + if (Tk = KVAR /\ \Frame) do + gen(CG_MKFRAME, 0); + Frame := 1; + end + declaration(0); + end + if (Ls) gen(CG_STACK, -(Ls*BPW)); + if (body) Lp0 := Lp; + if (main) Lbp0 := Lp; + while (Tk \= KEND) do + if (Tk = ENDFILE) aw(msg, 0); + stmt(0); + end + Tk := scan(); + if (body) do + gen(CG_CLEAR, 0); + resolve(Retlab); + Retlab := 0; + end + if (olp \= Lp) gen(CG_UNSTACK, olp-Lp); + if (body /\ Frame) do + if (Rettype = KFINT) gen(CG_POPA, 0); + gen(CG_DELFRAME, 0); + Frame := 0; + end + Yp := oyp; + Np := onp; + Lp := olp; + Ls := ols; + Lbp0 := olbp; +end + +checkclass() + if (\str_equal(Str, "t3x")) + aw("class name must be T3X", Str); + +module_decl() do + Tk := scan(); + xsymbol(); + Tk := scan(); + xlparen(); + xsymbol(); + checkclass(); + Tk := scan(); + xrparen(); + xsemi(); +end + +object_decl() do + Tk := scan(); + xsymbol(); + if (\str_equal(Str, "t")) + aw("object name must be T", Str); + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + expect(SYMBOL, "symbol"); + checkclass(); + Tk := scan(); + expect(RBRACK, "']'"); + Tk := scan(); + xsemi(); +end + +program() do var i; + Tk := scan(); + if (Tk = KMODULE) module_decl(); + if (Tk = KOBJECT) object_decl(); + while ( Tk = KVAR \/ Tk = KCONST \/ Tk = SYMBOL \/ + Tk = KDECL \/ Tk = KSTRUCT + ) + declaration(GLOB); + if (Tk \= KDO) + aw("DO or declaration expected", 0); + compound(0, 1); + if (Tk \= ENDFILE) + aw("trailing characters", Str); + gen(CG_HALT, 0); + for (i=0, Yp, SYM) + if (Syms[i+SFLAGS] & FORW /\ Syms[i+SVALUE]) + aw("undefined function", Syms[i+SNAME]); +end + +! +! Main +! + +emitlib() do var i, j, k, lib; + lib := + !LIBRARY! + i := 0; + while (lib[i]) do + k := lib[i]; + i := i+1; + for (j=0, k) emit(lib[i]::j); + i := i+1; + end +end + +init(p) do var i, b::10; + Pass := p; + Rejected := 0; + Ip := 0; + Ep := 0; + Gp := 0; + Gtop := 0; + Outp := 0; + Tp := 0x100; + Dp := 0; + Lp := 0; + Yp := 0; + Np := 0; + Fwp := 0; + Lab := 0; + Line := 1; + Acc := 0; + Retlab := 0; + Frame := 0; + Loop0 := %1; + Lvp := 0; + Llp := 0; + Qi := CG_NULL; + Codetbl := [ + [ CG_NULL, "" ], + [ CG_PUSH, "50" ], ! push ax + [ CG_CLEAR, "31c0" ], ! xor ax,ax + [ CG_DROP, "5b" ], ! pop bx + [ CG_LDVAL, "b8,w" ], ! mov ax,W + [ CG_LDADDR, "b8,w" ], ! mov ax,W + [ CG_LDLREF, "8d86,w" ], ! lea ax,[bp+W] + [ CG_LDGLOB, "a1,w" ], ! mov ax,[W] + [ CG_LDLOCL, "8b86,w" ], ! mov ax,[bp+W] + [ CG_STGLOB, "a3,w" ], ! mov [W],ax + [ CG_STLOCL, "8986,w" ], ! mov [bp+W],ax + [ CG_STINDR, "5b8907" ], ! pop bx; mov [bx],ax + [ CG_STINDB, "5b8807" ], ! pop bx; mov [bx],al + [ CG_INCGLOB, "ff06,w" ], ! inc word [W] + [ CG_INCLOCL, "ff86,w" ], ! inc word [bp+W] + [ CG_INCR, "05,w" ], ! add ax,W + [ CG_STACK, "81c4,w" ], ! add sp,W + [ CG_UNSTACK, "81c4,w" ], ! add sp,W + [ CG_LOCLVEC, "89e050" ], ! mov ax,sp; push ax + [ CG_GLOBVEC, "8926,w" ], ! mov [W],sp + [ CG_INDEX, "d1e05b01d8" ], ! shl ax,1;pop bx;add ax,bx + [ CG_DEREF, "89c38b07" ], ! mov bx,ax; mov ax,[bx] + [ CG_INDXB, "5b01d8" ], ! pop bx; add ax,bx + [ CG_DREFB, "89c331c08a07" ], ! mov bx,ax; xor ax,ax + ! mov ax,[bx] + [ CG_CALL, "e8,r" ], ! call R + [ CG_CALR, "ffd0" ], ! call ax + [ CG_CALRF, "89c3ff1f" ], ! mov bx,ax; call far [bx] + [ CG_JUMP, "e9,r" ], ! jmp R + [ CG_RJUMP, "eb,b" ], ! jmps R + [ CG_JMPFALSE, "09c07503e9,r" ], ! or ax,ax; jne +3; jmp R + [ CG_JMPTRUE, "09c07403e9,r" ], ! or ax,ax; je +3; jmp R + [ CG_FOR, "5b39c37c03e9,r"], ! pop bx; cmp bx,ax; jl +3 + ! jmp R + [ CG_FORDOWN, "5b39c37f03e9,r"], ! pop bx; cmp bx,ax; jg +3 + ! jmp R + [ CG_MKFRAME, "5589e5" ], ! push bp; mov bp,sp + [ CG_DELFRAME, "5d" ], ! pop bp + [ CG_RET, "c3" ], ! ret + [ CG_RETF, "cb" ], ! retf + [ CG_IRET, "cf" ], ! iret + [ CG_HALT, "b8004ccd21" ], ! mov ax,4c00h; int 21H + [ CG_NEG, "f7d8" ], ! neg ax + [ CG_INV, "f7d0" ], ! not ax + [ CG_LOGNOT, "f7d819c0f7d0" ], ! neg ax; sbb ax,ax; not ax + [ CG_ADD, "5b01d8" ], ! pop bx; add ax,bx + [ CG_SUB, "89c35829d8" ], ! mov bx,ax;pop ax;sub ax,bx + [ CG_MUL, "59f7e9" ], ! pop cx; imul cx + [ CG_DIV, "89c15899f7f9" ], ! mov cx,ax; pop ax; cwd; + ! idiv cx + [ CG_MOD, "89c15831d2f7f189d0"], ! mov ax,cx; pop ax + ! xor dx,dx; div cx + ! mov ax,dx + [ CG_AND, "5b21d8" ], ! pop bx; and ax,bx + [ CG_OR, "5b09d8" ], ! pop bx; or ax,bx + [ CG_XOR, "5b31d8" ], ! pop bx; xor ax,bx + [ CG_SHL, "89c158d3e0" ], ! mov cx,ax;pop ax;shl ax,cl + [ CG_SHR, "89c158d3e8" ], ! mov cx,ax;pop ax;shr ax,cl +! [ CG_EQ, "31d25b39c375014a89d0" ], ! xor dx,dx; pop bx +! [ CG_NE, "31d25b39c374014a89d0" ], ! cmp bx,ax; j?? +3 +! [ CG_LT, "31d25b39c37d014a89d0" ], ! dec dx; mov ax,dx +! [ CG_GT, "31d25b39c37e014a89d0" ], ! ??=ne,e,ge,le,g,l +! [ CG_LE, "31d25b39c37f014a89d0" ], +! [ CG_GE, "31d25b39c37c014a89d0" ], + [ CG_EQ, "e8,R2f01" ], ! call $12f + [ CG_NE, "e8,R3201" ], ! call $132 + [ CG_LT, "e8,R3501" ], ! call $135 + [ CG_GT, "e8,R3801" ], ! call $138 + [ CG_LE, "e8,R3b01" ], ! call $13b + [ CG_GE, "e8,R3e01" ], ! call $13e + [ CG_JMPEQ, "5b39c37503e9,r"], ! pop bx; cmp bx,ax; jne +3 + ! jmp R + [ CG_JMPNE, "5b39c37403e9,r"], ! ... je +3 ... + [ CG_JMPLT, "5b39c37d03e9,r"], ! ... jge +3 ... + [ CG_JMPGT, "5b39c37e03e9,r"], ! ... jle +3 ... + [ CG_JMPLE, "5b39c37f03e9,r"], ! ... jg +3 ... + [ CG_JMPGE, "5b39c37c03e9,r"], ! ... jl +3 ... + [ CG_PUSHA,"505351521e5606571689e0404050"], + ! push ax,bx,cx,dx,ds,si,es + ! push di,ss;mov ax,sp; + ! inc ax;inc ax;push ax + [ CG_POPA,"5b58fa8ed089dcfb5f075e1f5a595b58"], + ! pop ax,bx;cli;mov ss,ax + ! mov sp,bx;sti;pop di,es + ! pop si,ds,dx,cx,bx,ax + [ %1, "" ] ]; + Opttbl := [ + [ CG_EQ, 0, CG_JMPFALSE, CG_JMPNE ], + [ CG_NE, 0, CG_JMPFALSE, CG_JMPEQ ], + [ CG_LT, 0, CG_JMPFALSE, CG_JMPGE ], + [ CG_GT, 0, CG_JMPFALSE, CG_JMPLE ], + [ CG_LE, 0, CG_JMPFALSE, CG_JMPGT ], + [ CG_GE, 0, CG_JMPFALSE, CG_JMPLT ], + [ CG_LOGNOT, 0, CG_JMPFALSE, CG_JMPTRUE ], + [ %1, %1, %1, %1 ], + [ CG_LDVAL, 0, CG_ADD, CG_DROP ], + %1 ]; + Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], + [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], + [ 0, 1, ")", RPAREN, 0 ], + [ 0, 1, "[", LBRACK, 0 ], + [ 0, 1, "]", RBRACK, 0 ], + [ 3, 1, "=", BINOP, CG_EQ ], + [ 5, 1, "&", BINOP, CG_AND ], + [ 5, 1, "|", BINOP, CG_OR ], + [ 5, 1, "^", BINOP, CG_XOR ], + [ 0, 1, "@", ADDROF, 0 ], + [ 0, 1, "~", UNOP, CG_INV ], + [ 0, 1, ":", COLON, 0 ], + [ 0, 2, "::", BYTEOP, 0 ], + [ 0, 2, ":=", ASSIGN, 0 ], + [ 0, 1, "\\", UNOP, CG_LOGNOT ], + [ 1, 2, "\\/", DISJ, 0 ], + [ 3, 2, "\\=", BINOP, CG_NE ], + [ 4, 1, "<", BINOP, CG_LT ], + [ 4, 2, "<=", BINOP, CG_LE ], + [ 5, 2, "<<", BINOP, CG_SHL ], + [ 4, 1, ">", BINOP, CG_GT ], + [ 4, 2, ">=", BINOP, CG_GE ], + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], + [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); + Minus_op := findop("-"); + Mul_op := findop("*"); + Add_op := findop("+"); + i := 0; + while (Codetbl[i][0] \= %1) do + if (Codetbl[i][0] \= i) do + str_copy(b, ntoa(i)); + oops("bad code table entry", b); + end + i := i+1; + end + add("t3x.sysin", GLOB|CNST, 0); + add("t3x.sysout", GLOB|CNST, 1); + add("t3x.syserr", GLOB|CNST, 2); + add("t3x.oread", GLOB|CNST, 0); + add("t3x.owrite", GLOB|CNST, 1); + add("t3x.oappnd", GLOB|CNST, 3); + add("t3x.ptrsize", GLOB|CNST, 4); + builtin("t.bpw", 0, 0x0108); + builtin("t.newline", 1, 0x010b); + builtin("t.memcomp", 3, 0x010e); + builtin("t.memcopy", 3, 0x0111); + builtin("t.memfill", 3, 0x0114); + builtin("t.memscan", 3, 0x0117); + builtin("t.getarg", 3, 0x011a); + builtin("t.open", 2, 0x011d); + builtin("t.close", 1, 0x0120); + builtin("t.read", 3, 0x0123); + builtin("t.write", 3, 0x0126); + builtin("t.rename", 2, 0x0129); + builtin("t.remove", 1, 0x012c); + builtin("t.farcomp", 5, 0x0150); + builtin("t.farcopy", 5, 0x0153); + builtin("t.farfill", 4, 0x0156); + builtin("t.farscan", 4, 0x0159); + builtin("t.fargetb", 2, 0x015c); + builtin("t.farsetb", 3, 0x015f); + builtin("t.fargetw", 2, 0x0162); + builtin("t.farsetw", 3, 0x0165); + builtin("t.local", 0, 0x0168); + builtin("t.outb", 2, 0x016b); + builtin("t.inb", 1, 0x016e); + builtin("t.outw", 2, 0x0171); + builtin("t.inw", 1, 0x0174); + builtin("t.int86c", 7, 0x0177); + builtin("t.int86ax", 7, 0x017a); + builtin("t.int86z", 7, 0x017d); + builtin("t.setptr", 3, 0x0180); + builtin("t.getseg", 1, 0x0183); + builtin("t.getoff", 1, 0x0186); + emitlib(); +end + +info() do + writes("Text = "); + writes(ntoa(Tp - 0x100)); + writes(", Data = "); + writes(ntoa(Dp+622)); + writes(", Symbols = "); + writes(ntoa(Yp/SYM)); + writes(", Nlist = "); + writes(ntoa(Np)); + writes(", Labels = "); + writes(ntoa(Lab)); + nl(); +end + +phase(in, n) do + if (Verbose) do + writes(n-> "Pass 2:": "Pass 1:"); + nl(); + end + Infile := t.open(in, T3X.OREAD); + if (Infile < 0) aw("no such file", in); + Outfile := t.open(Outname, T3X.OWRITE); + if (Outfile < 0) aw("cannot create", Outname); + init(n); + program(); + commit(); + t.close(Infile); + flush(); + t.close(Outfile); +end + +upcase(s) do var i; + i := 0; + while (s::i) do + if ('a' <= s::i /\ s::i <= 'z') + s::i := s::i-'a'+'A'; + i := i+1; + end + return s; +end + +do var in::75, k; + Outname::0 := 0; + Verbose := 0; + if (t.getarg(2, in, 4) \= %1 /\ str_equal(upcase(in), "/V")) + Verbose := 1; + k := t.getarg(1, in, 72); + if (k < 0) aw("missing file name", 0); + t.memcopy(@in::k, ".t", 3); + str_copy(Outname, in); + t.memcopy(@Outname::k, ".com", 5); + phase(in, 0); + phase(in, 1); + info(); +end diff --git a/TODO.TXT b/TODO.TXT new file mode 100644 index 0000000..ac641ed --- /dev/null +++ b/TODO.TXT @@ -0,0 +1,7 @@ + + The language is pretty much fixed right now. + + Maybe: + + Add unsigned operators (./ .< .> .<= .>=). + diff --git a/TOOLS/DOSFILE.T b/TOOLS/DOSFILE.T new file mode 100644 index 0000000..2a80624 --- /dev/null +++ b/TOOLS/DOSFILE.T @@ -0,0 +1,113 @@ +! Convert file to PCDOS text format +! Nils M Holm, 2019,2021 +! Public domain / 0BSD + +module dosfile(t3x); + +object t[t3x]; + +const BUFLEN = 128; + +var Outbuf::BUFLEN; + +str_length(s) return t.memscan(s, 0, 32767); + +writes(fd, s) do + t.write(fd, s, str_length(s)); +end + +nl(fd) do var b::3; + writes(fd, t.newline(b)); +end + +aw(s) do + writes(T3X.SYSERR, s); + nl(T3X.SYSERR); + halt 1; +end + +var Inbuf::BUFLEN; +var Line::BUFLEN; +var Cp, Ep, More; + +readln(fd) do var i, c; + i := 0; + while (1) do + if (Cp >= Ep) do + Ep := t.read(fd, Inbuf, BUFLEN); + if (Ep < 1) do + More := 0; + leave; + end + Cp := 0; + end + c := Inbuf::Cp; + Cp := Cp+1; + if (c = '\r') loop; + if (c = '\n') leave; + if (i >= BUFLEN-1) leave; + Line::i := c; + i := i+1; + end + Line::i := 0; + return i; +end + +writeln(fd) do + writes(fd, Line); + writes(fd, "\r\n"); +end + +usage() do + writes(T3X.SYSOUT, "Usage..: dosfile infile outfile format"); + nl(T3X.SYSOUT); + writes(T3X.SYSOUT, " dosfile infile /r (replace file) format"); + nl(T3X.SYSOUT); + writes(T3X.SYSOUT, "Formats: dos, cpm"); + halt 1; +end + +var Fini::128; + +do var infile::64, outfile::64, format::5, infd, outfd, k, n, ren, eof; + ren := 0; + eof := %0; + if (t.getarg(1, infile, 64) < 1) usage(); + if (t.getarg(2, outfile, 64) < 1) usage(); + if (t.getarg(3, format, 5) < 1) usage(); + ie (t.memcomp(format, "dos", 3) = 0) + eof := %0; + else ie (t.memcomp(format, "cpm", 3) = 0) + eof := %1; + else + usage(); + if (t.memcomp(outfile, "/r", 3) = 0) do + t.memcopy(outfile, "dosfile.tmp", 12); + ren := 1; + end + infd := t.open(infile, T3X.OREAD); + if (infd < 0) aw("No file"); + outfd := t.open(outfile, T3X.OWRITE); + if (outfd < 0) aw("Cannot create file"); + Cp := 0; + Ep := 0; + More := %1; + n := 0; + k := readln(infd); + while (More) do + writeln(outfd); + n := n + k + 2; + k := readln(infd); + end + if (eof = %1) do + t.memfill(Fini, 0x1a, 128); + if (n mod 128 \= 0) + t.write(outfd, Fini, 128 - n mod 128); + end + t.close(outfd); + t.close(infd); + if (ren) do + t.remove(infile); + t.rename("dosfile.tmp", infile); + end +end diff --git a/TOOLS/MAKE.BAT b/TOOLS/MAKE.BAT new file mode 100755 index 0000000..aea1111 --- /dev/null +++ b/TOOLS/MAKE.BAT @@ -0,0 +1,4 @@ +..\bin\t mklib +move mklib.com ..\bin\mklib.com >NUL +..\bin\t dosfile +move dosfile.com ..\bin\dosfile.com >NUL \ No newline at end of file diff --git a/TOOLS/MKLIB.T b/TOOLS/MKLIB.T new file mode 100644 index 0000000..cc49db2 --- /dev/null +++ b/TOOLS/MKLIB.T @@ -0,0 +1,144 @@ +! Merge library image into the T3X/86 compiler source code. +! Nils M Holm, 2019,2021 +! Public domain / 0BSD + +module mklib(t3x); + +object t[t3x]; + +const BUFLEN = 128; + +var Outbuf::BUFLEN; + +str_length(s) return t.memscan(s, 0, 32767); + +writes(fd, s) do + t.write(fd, s, str_length(s)); +end + +nl(fd) do var b::3; + writes(fd, t.newline(b)); +end + +aw(s) do + writes(T3X.SYSERR, s); + nl(T3X.SYSERR); +end + +wrnib(fd, n) do var c::1; + ie (n > 9) + c::0 := n+'a'-10; + else + c::0 := n+'0'; + t.write(fd, c, 1); +end + +wrbyte(fd, n) do + wrnib(fd, n>>4); + wrnib(fd, n&15); +end + +copylib(lfd, tfd) do var k, i, j, n, len; + len := 32767; + writes(tfd, "\t[ "); + k := t.read(lfd, Outbuf, BUFLEN); + if (k > 4) len := Outbuf::3 + (Outbuf::4 << 8); + len := len-100; ! S86 assembler inserts wrong length + j := 0; + while (k > 0) do + if (j + k > len) k := len - j; + writes(tfd, "0x"); + wrbyte(tfd, k >> 8); + wrbyte(tfd, k & 255); + writes(tfd, ","); + nl(tfd); + writes(tfd, "\t packed [ "); + nl(tfd); + writes(tfd, "\t "); + n := 0; + for (i=0, k) do + n := n+1; + j := j+1; + ie (n > 12) do + nl(tfd); + writes(tfd, "\t 0x"); + n := 1; + end + else do + writes(tfd, "0x"); + end + wrbyte(tfd, Outbuf::i); + if (i < k-1) writes(tfd, ","); + end + writes(tfd, " ],"); + nl(tfd); + writes(tfd, "\t "); + if (j >= len) leave; + k := t.read(lfd, Outbuf, BUFLEN); + end + writes(tfd, "0 ];"); + nl(tfd); +end + +var Inbuf::BUFLEN; +var Line, Linebuf::BUFLEN; +var Cp, Ep, More; + +readln(fd) do var i, c; + i := 0; + while (1) do + if (Cp >= Ep) do + Ep := t.read(fd, Inbuf, BUFLEN); + if (Ep < 1) do + More := 0; + leave; + end + Cp := 0; + end + c := Inbuf::Cp; + Cp := Cp+1; + if (c = '\r') loop; + if (c = '\n') leave; + if (i >= BUFLEN-1) leave; + Line::i := c; + i := i+1; + end + Line::i := 0; + return i; +end + +writeln(fd) do + writes(fd, Line); + nl(fd); +end + +do var sfd, lfd, tfd, k; + sfd := t.open("tsource.t", T3X.OREAD); + if (sfd < 0) aw("mklib: 'tsource.t' file missing"); + lfd := t.open("lib.bin", T3X.OREAD); + if (lfd < 0) aw("mklib: 'lib.bin' file missing"); + tfd := t.open("t.t", T3X.OWRITE); + if (tfd < 0) aw("mklib: cannot create 't.t' file"); + Line := "!! DO NOT EDIT THIS FILE, EDIT TSOURCE.T INSTEAD !!"; + writeln(tfd); + Line := ""; + writeln(tfd); + Line := Linebuf; + Cp := 0; + Ep := 0; + More := %1; + k := readln(sfd); + while (More) do + if ( k >= 10 /\ + t.memcomp(Line, "\t!LIBRARY!", 10) = 0) + do + writeln(tfd); + copylib(lfd, tfd); + end + writeln(tfd); + k := readln(sfd); + end + t.close(tfd); + t.close(sfd); + t.close(lfd); +end diff --git a/TOOLS/PREPARE.BAT b/TOOLS/PREPARE.BAT new file mode 100755 index 0000000..bf86c3b --- /dev/null +++ b/TOOLS/PREPARE.BAT @@ -0,0 +1,2 @@ +..\base\t mklib +move mklib.com ..\bin\mklib.com >NUL \ No newline at end of file