The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 


  << Previous TopicReturn to Index  

(not QB, but we don't have a misc forum anymore) xl0 abandonded

August 14 2017 at 2:46 PM
Michael Calkins  (Login MCalkins)
ASM Forum

 
For libraries, I'm thinking:

strings:

provide a data type for variable length string descriptors. functions to help manage string descriptors, and to manipulate strings.

console:

provide a standard and idealized way of dealing with VGA compatible text buffers, and keyboard/mouse input.

files:

provide handle based functions to work with files, and to manipulate the file system. files can be used in either binary or ascii mode. the following capabilities will be provided: open, close, read, write, lock, unlock, create, delete, rename, find, attributes, create folder, delete folder, rename folder, change path. if possible, support asyncronous i/o.

sockets:

provide an ipv4 sockets api, including raw sockets, tcp, and udp. should mirror winsock or wsock2 to the extent possible. if possible, support asyncronous i/o.

system:

provide functions for allocating and releasing memory. provide functions for retrieving command line parameters. provide functions for executing other programs. provide a psudeo-random number function.

crypt:

provide cryptographic functions, including md5, sha-1, and sha-2 hashes, and aes cipher. if possible, provide asymetric ciphers. if possible, provide a cryptographic random number function.

draw:

provide functions to do primitive 2d graphics in standard vga and svga modes. should be similar to qbasic graphics functions. possibly, provide unicode text drawing functions.

sound:

provide internal speaker functions, if possible. provide sound functions. provide midi music functions.

i'm thinking that i need to be moving away from real mode, especially for a lot of the above functionality.

the sizeof constants seem like a major waste. I'm thinking of removing them.

I need a way of specifying section names, for large real mode programs.

Maybe add an LEA instruction to create a pointer based on indexing.

I'm thinking that unions might not need names.

Init data will go in data, uninit data will go in bss, even in call absolute.

When I get around to doing a string libarary, I'm leaning toward the following descriptor format:

dword currentlength
dword maximumlength
dword address

Does the "hidden parameter" affect stdcall name mangling? (i think it is in eax, which would mean it shouldn't. but that also means the current doc is wrong.)

Revision 20110330

I should consider designing a new programming language. This will be similar to my abandoned SBC project, with a few differences. The major holdups on my SBC project were uncertainties about how to implement error trapping, and automatic string management. I know believe I should completely avoid error trapping, and leave string management to the programmer.

Goal:
Design a language and a reference compiler, partway between Qbasic and assembly.

The language will have a simple, consistant syntax, similar to Qbasic's syntax style.

The language will have few keywords, unlike Qbasic. Most functionality will be left to the programmer, like in assembly.

The language will be simple. The majority of it will have no dependance on any run time environment. This means that code can be used as subroutines of programs written in other languages, including Qbasic, C, and assembly.

The language will allow the user to specify calling conventions for each function. The same module can contain functions using C style, Qbasic style, and Win32 stdcall style.

My compiler will generate Nasm code for i386/387 or higher. It will have the following output modes: real mode Qbasic call absolute, real mode DOS .com, real mode DOS module, and protected mode Win32 module.

The language will allow inline assembly. The rules for using it will be documented, but might change until the language becomes stable.

In real mode, far pointers will always be used. Near pointers will be used in protected mode. This means pointers will always be dwords (either a protected mode near pointer, or a real mode segment:offset pair). Pointer will specify a data type, like in assembly, but unlike in C. The language will allow multidimensional arrays, in which case indexing will use pointer arithmatic based on data type size.

The language will make available the use of bitwise boolean logic, signed and unsigned integer math, and inline integer data type conversion (sign extend, zero extend, truncate). Initial focus will be on integer math. Floating point math will be added later.

The data types will be:
BYTE: 8 bits.
WORD: 16 bits.
DWORD: 32 bits.
QWORD: 64 bits.
TWORD: 80 bits.
Data types specify size only. They do not specify signed vs unsigned or integer vs float. That is specified by the specific math operator. This is like assembly, and unlike Qbasic and C. Integers are always little-endian. Floating point is always IEEE-754 little-endian.

User defined data types will be unpadded by default. The programmer may manually specify padding. Base addresses of variable and arrays will be unaligned by default. The programmer may manually specify alignment.

Initially, complex expression support may be omitted, but it should eventually be added.

Symbols (variable names and function names), symbolic constants, user defined data types, and elements of user defined data types will all be case sensitive.

Keyword names, including standard data types, will be case insensitive.

The language will initially have only a very minimal standard library. The initial standard library will contain low level string functions. The programmer will have to be aware of string issues. These functions will be there to assist the programmer in performing string operations, not to completely automate the job. String functions will come in 8 bit and 16 bit character versions.

The language will not provide error handling or trapping, file i/o, file system services, graphics, console i/o, process or memory management, or anything of the sort. All of that is stuff that can and should be handled by system calls or libraries, not by the language. Although the language is i386/387 specific, nothing in the language itself is operating system specific.

The result of this will be a language that should be less cumbersome than pure assembly, and more flexible and more "ideal" than Qbasic.

I realise that C already fills that role. If you are skilled with C, then this language is probably not for you. This language is aimed at people who understand qbasic, are at least familiar with assembly, and are unsatisfied with C.

This language's main advantages over C, in my opinion, are these: It is i386 specific, without some of the vaguenesses of C. For example, numbers are always little-endian, user defined data types unpadded by default, and data type sizes are unambiguous. Also, it should be more self-explanatory, since its syntax is closer to Qbasic's.

The language has several disadvantages to C: The same thing can be accomplished in C with less typing. This language trades brevity for clarity. This language (at least as implemented by my compiler) will not be as efficient as optimized C, and certainly not as efficient as assembly, but should beat interpreted Qbasic.

The main advantages over Qbasic, in my opinion, are these: Much greater flexibility with regard to data types, unsigned arithmatic, and pointers. The lack of implicit data type conversion trades convenience for clarity. Interoperability with other languages.

The main disadvantages compared to Qbasic: Lack of automatic string management. Not newbie friendly.

Keywords:

$INCLUDE
$LANGUAGE
$EXPECTED
$IF
$ELSEIF
$ELSE
$END
STACK
SECTIONS
CONST
WLIT
ALIT
TYPE
UNION
PAD
BYTE
WORD
DWORD
QWORD
TWORD
SIZEOF
OFFSET
DIM
AS
ROWMAJ
COLMAJ
PEEKB
PEEKW
PEEKD
PEEKQ
POKEB
POKEW
POKED
POKEQ
SWAPB
SWAPW
SWAPD
INCB
INCW
INCD
DECB
DECW
DECD
PTR
ZXBW
ZXBD
ZXBQ
ZXWD
ZXWQ
ZXDQ
SXBW
SXBD
SXBQ
SXWD
SXWQ
SXDQ
TRQD
TRQW
TRQB
TRDW
TRDB
TRWB
DECLARE
CDECL
PASCAL
STDCALL
GLOBAL
TWORD
CALL
FUNCTION
VOID
RETURN
FPRT
ASM
=
<>
S<
S>
S>=
S<=
U<
U>
U>=
U<=
+
-
+C
-B
S*
S\
SMOD
S/
U*
U\
UMOD
U/
AND
OR
XOR
NOT
NEG
SHL
SHR
SAR
ROL
ROR
RCL
RCR
STC
CLC
CMC
ABS
IF
IS
OVERFLOW
NOVERFLOW
PARITY
NPARITY
THEN
ELSE
ELSEIF
SELECT
CASE
DO
LOOP
WHILE
UNTIL
FOR
TO
STEP
NEXT
GOTO
END
EXIT
.
(
)
"
'
:
,

Floating point keywords will be added later.

-----
'

Comment (Unless used within a string literal or asm block).

Anything on the same line after a single quote mark is ignored by the compiler.

-----
STACK mainfunctionname, [, size]

This keyword does three things: It specifies that the current module is the main module in the program, it specifies the name of the function that the initilization code should call, and it sets the size of the stack in bytes.

This keyword must be the very first line in the main source file. Nothing else, including comments or blank lines, should precede it. Usage anywhere except the first line will cause my compiler to generate an error.

mainfunctionname is the name of the function that the initialization code will call. The function identified by it should be in the form:

DECLARE STDCALL mainfunctionname() AS DWORD

Default stack size is 0x4000.

My compiler requires this keyword in "rdos:com" mode, and for the main module in "rdos:module" mode. It will silently ignore it in other modes. In "rdos:com" mode, there is only one module, but the stack will be checked against the specified size once at program startup.

It is up to the programmer to determine that the code will not create stack overflows. Remember that each layer of function call uses stack space for parameters, return address, local variables, etc.

My compiler does no runtime checking of free stack space, except in the "rdos:com" mode once at program startup.

-----
SECTIONS ["code"], [codealign], ["data"], [dataalign], ["bss"], [bssalign]

This specifies the section names to be used for subsequent code, and the alignment, in bytes, of those sections. Should not be used inside any block, including functions.

The purpose of letting you specify section names is to help you write large "r:dos:module" programs. You should not need to do this for protected mode programs or small real mode programs.

The default names are ".text", ".data", and ".bss" respectively. Default section alignment is 1 byte for all sections. However, for any mode other than "r:dos:qbasic", you should align the data and bss sections to at least 4 bytes.

If you are using ALIGN with your DIM statements, you should also align the section by at least as many bytes.

Alignment must be a power of 2.

-----
$INCLUDE file

Includes a source file. file is a string literal, but does not use ALIT or WLIT. It is not a sequence, but a simple string literal.

Example:

$include "stringh.xl0"

-----
$LANGUAGE major, minor

The expected language version. major is a decimal or hexadecimal dword integer. minor is a decimal or hexadecimal dword integer. They are separted by a comma.

Might be ignored by the compiler.

-----
$EXPECTED list

Specifies which target mode or modes the program was written for. Optional, and might not be enforced.

list is a string literal, but does not use ALIT or WLIT. It is not a sequence, but a simple string literal.

It will be lowercase. It will contain a comma seperated list, with no spaces. Each item in the list descibes a target mode that the code is compatible with. The format for each item is:

mode[:api[:type]]

mode is processor mode, "r" for real, "p" for protected, "a" for any.

ooo is operating system api. Some choices are: "win" for Win32, "dos" for DOS, "os2" for OS/2 32, "a" for any. Others may be added later.

type is the output type. "qbasic" for Qbasic call absolute. "com" for standalone DOS .com. "module" for any object module. "a" for any.

specifics is undefined at this point.

For example:

$EXPECTED "r:dos:qbasic"

Compilers might or might not enforce this expectation. Compilers can do anything from ignoring it, to warning the user, to not compiling.

-----
$IF list
[$ELSEIF list]
[$ELSE]
$END

Conditional compilation.

Multiple $ELSEIFs are allowed.

list is in the same format as for $EXPECTED.

If the target mode matches any mode in the specified list, the code block is processed. Otherwise, it is skipped.

The purpose of this is to help you write portable code.

Example:

DIM n AS WORD

$IF "r:dos:qbasic"
ASM
mov word [bx+_n],0x0
END
$ELSE
ASM
mov word [_n],0x0
END
$END

-----
CONST constant = value

Defines a compile/assemble time constant.

Constants are not variables, and take up no memory when the program is running. Therefore, they do not have addresses. They cannot be reassigned. This is not runtime assignment, this is compile/assemble time assignment.

value must be a DWORD integer literal, or a literal sequence of no more than DWORD size.

My compiler will prefix an underscore and create an equ line in the Nasm source. CONST maxentries = 5 will become something like _maxentires equ 0x5 in the Nasm source.

Example:

CONST maxentries = 5

-----
STACKALIGN

A constant provided by the compiler to indicate the stack alignment. In real mode, will be 2. In protected mode, will be 4.

STACKALIGN is case insensitive. To access it from inline assembly, use the case sensitive "_stackalign".

The purpose of this is to help you write portable code.

-----
String literals.

ALIT "stringliteral"
WLIT "stringliteral"

Specifies string literals. In either case, the text inside the quotation mark is CP437 text.

ALIT specifies that the text will remain CP437 and will be considered a sequence of BYTEs.

WLIT specifies that the CP437 text will be translated into Unicode, and will be considered a sequence of WORDs. CP437 characters in the control code range will be translated to the non-control code Unicode character that contains the appropriate glyph. This is compile/assemble time translation for literal constants; it is not run time translation.

Literal strings may contain any CP437 character except cr (0xd), lf (0xa), or double quote mark (0x22).

Either one of these specifies a sequence (either BYTEs or WORDs).

Example:

DIM buffer AS BYTE * 12 = (ALIT "Hello, World")
DIM thisoneisbigger AS WORD * 12 = (WLIT "Hello, World")

-----
Standard data types.

Data types specify only size. They do not specify whether the data is signed or not, or whether it is floating point or integer.

BYTE: 8 bits
WORD: 16 bits
DWORD: 32 bits
QWORD: 64 bits.
TWORD: 80 bits.

Not all data types are compatible with all operations.

-----
TYPE name
 elementlist
END [TYPE]

Defines a user defined data type.

name is the name of the data type. It cannot be a standard data type, or a previously defined data type. Names can contain letters and numbers, but should start with a letter. Name length can be up to 64 characters. Names of data types will be case sensitive.

elementlist can contain standard declarations:

 element AS type [* factor]

* factor

indicates that the element is a buffer with a size that is factor times the size of the specified type. This is not the same as an array. For example, AS BYTE * 5 would be similar to AS STRING * 5 in Qbasic. factor must be a compile time constant.

elementlist can contain unions:

 UNION element
  elementlist
 END [UNION]

It can contain padding:

PAD numberofbytes

numberofbytes is a compile time constant.

Names of elements can contain letters and numbers, but should start with a letter. Name length can be up to 64 characters. Names of elements will be case sensitive.

Type blocks cannot be nested, but can, of course, include references to already defined user defined types.

Example:

'derived from mingw's wincon.h

TYPE COORD
 X AS WORD
 Y AS WORD
END
 
TYPE KEY_EVENT_RECORD
 bKeyDown AS DWORD
 wRepeatCount AS WORD
 wVirtualKeyCode AS WORD
 wVirtualScanCode AS WORD
 UNION uChar
  UnicodeChar AS WORD
  AsciiChar AS BYTE
 END
 dwControlKeyState AS DWORD
END

TYPE MOUSE_EVENT_RECORD
 dwMousePosition AS COORD
 dwButtonState AS DWORD
 dwControlKeyState AS DWORD
 dwEventFlags AS DWORD
END

TYPE WINDOW_BUFFER_SIZE_RECORD
 dwSize AS COORD
END

TYPE MENU_EVENT_RECORD
 dwCommandId AS DWORD
END

TYPE FOCUSE_EVENT_RECORD
 bSetFocus AS DWORD
END

TYPE INPUT_RECORD
 EventType AS WORD
 PAD 2
 UNION Event
  KeyEvent AS KEY_EVENT_RECORD
  MouseEvent AS MOUSE_EVENT_RECORD
  WindowBufferSizeEvent AS WINDOW_BUFFER_SIZE_RECORD
  MenuEvent AS MENU_EVENT_RECORD
  FocusEvent AS FOCUS_EVENT_RECORD
 END
END

My compiler will, by default, create two equ lines in the Nasm source for each element and union, for each user defined type, plus one more for each type. An underscore will be prefixed. The above example will result in something like:

_COORD.X equ 0x0
_sizeof_COORD.X equ 0x2
_COORD.Y equ 0x2
_sizeof_COORD.Y equ 0x2
_sizeof_COORD equ 0x4
 
_KEY_EVENT_RECORD.bKeyDown equ 0x0
_sizeof_KEY_EVENT_RECORD.bKeyDown equ 0x4
_KEY_EVENT_RECORD.wRepeatCount equ 0x4
_sizeof_KEY_EVENT_RECORD.wRepeatCount equ 0x2
_KEY_EVENT_RECORD.wVirtualKeyCode equ 0x6
_sizeof_KEY_EVENT_RECORD.wVirtualKeyCode equ 0x2
_KEY_EVENT_RECORD.wVirtualScanCode equ 0x8
_sizeof_KEY_EVENT_RECORD.wVirtualScanCode equ 0x2
_KEY_EVENT_RECORD.uChar equ 0xa
_KEY_EVENT_RECORD.UnicodeChar equ 0xa
_sizeof_KEY_EVENT_RECORD.UnicodeChar equ 0x2
_KEY_EVENT_RECORD.AsciiChar equ 0xa
_sizeof_KEY_EVENT_RECORD.AsciiChar equ 0x1
_sizeof_KEY_EVENT_RECORD.uChar equ 0x2
_KEY_EVENT_RECORD.dwControlKeyState equ 0xc
_sizeof_KEY_EVENT_RECORD.dwControlKeyState equ 0x4
_sizeof_KEY_EVENT_RECORD equ 0x10

_MOUSE_EVENT_RECORD.dwMousePosition equ 0x0
_sizeof_MOUSE_EVENT_RECORD.dwMousePosition equ 0x4
_MOUSE_EVENT_RECORD.dwButtonState equ 0x4
_sizeof_MOUSE_EVENT_RECORD.dwButtonState equ 0x4
_MOUSE_EVENT_RECORD.dwControlKeyState equ 0x8
_sizeof_MOUSE_EVENT_RECORD.dwControlKeyState equ 0x4
_MOUSE_EVENT_RECORD.dwEventFlags equ 0xc
_sizeof_MOUSE_EVENT_RECORD.dwEventFlags equ 0x4
_sizeof_MOUSE_EVENT_RECORD equ 0x10

_WINDOW_BUFFER_SIZE_RECORD.dwSize equ 0x0
_sizeof_WINDOW_BUFFER_SIZE_RECORD.dwSize equ 0x4
_sizeof_WINDOW_BUFFER_SIZE_RECORD equ 0x4

_MENU_EVENT_RECORD.dwCommandId equ 0x0
_sizeof_MENU_EVENT_RECORD.dwCommandId equ 0x4
sizeof_MENU_EVENT_RECORD equ 0x4

_FOCUS_EVENT_RECORD.bSetFocus equ 0x0
_sizeof_FOCUS_EVENT_RECORD.bSetFocus equ 0x4
sizeof_FOCUS_EVENT_RECORD equ 0x4

_INPUT_RECORD.EventType equ 0x0
_sizeof_INPUT_RECORD.EventType equ 0x2
_INPUT_RECORD.Event equ 0x4
_INPUT_RECORD.KeyEvent equ 0x4
_sizeof_INPUT_RECORD.KeyEvent equ 0x10
_INPUT_RECORD.MouseEvent equ 0x4
_sizeof_INPUT_RECORD.KeyEvent equ 0x10
_INPUT_RECORD.WindowBufferSizeEvent equ 0x4
_sizeof_INPUT_RECORD.WindowBufferSizeEvent equ 0x4
_INPUT_RECORD.MenuEvent equ 0x4
_sizeof_INPUT_RECORD.MenuEvent equ 0x4
_INPUT_RECORD.FocusEvent equ 0x4
_sizeof_INPUT_RECORD.FocusEvent equ 0x4
_sizeof_INPUT_RECORD.Event equ 0x10

When accessing member elements of a variable, the period is used. For example:

DIM instanceofCOORD AS COORD
instanceofCOORD.X = 0

-----
DIM [{GLOBAL | EXTERN}] variable AS type [* factor] [ALIGN bytes] [= value]
DIM [{GLOBAL | EXTERN}] [{ROWMAJ | COLMAJ}] array(dimensionlist) AS type [* factor] [ALIGN bytes] [= value]

Creates or imports a variable or array of the specified type.

If done within a function, the variable is created on the stack each time the function is called, and is destroyed each time the function exits. The location will be a constant offset from BP or EBP.

If done outside of any function, the variable is created in the data section if it is initialized, and if the bss section if it is not initialized. The location will be a constant offset from the section base (BX, in call absolute mode).

GLOBAL

Exports the symbol to other modules. Can only be used if the variable is created outside of any function.

EXTERN

Imports the symbol from some other module, instead of creating it. Can only be used outside of any function.

ROWMAJ

Specifies that the multidimensional array will be row major order.

COLMAJ

Specifies that the multidimensional array will be column major order.

If no order is specified for a multidimensional array, ROWMAJ is assumed. This might generate a compiler warning.

Names of variables can contain letters, numbers, underscore, and @, but should start with a letter. Name length can be up to 64 characters. Names of variables will be case sensitive. C sytle name mangling will be used.

AS type [* factor]

Specifies the type of the variable. Can be either a standard type, or a user defined type. factor can only be used with standard types. This is not the same as an array, although it can be used in the type of an array. For example: DIM buffer(5) AS WORD * 3 creates 6 (numbered 0 to 5) buffers of 6 bytes (3 WORDs) each.

= value

Creates the variable with initialized data. If omitted, the variable initially contains undefined data. Can only be used if the variable is created outside of any function, and is not EXTERN. This is not runtime assignment, it is compile/assemble time assignment.

The value will be in the form of a literal or a sequence. 

ALIGN

Specifies that the variable will be aligned on a boundry specified in bytes. Should be 1, 2, 4, 8, or 16. Default is 1. May only be used if the variable is not EXTERN. If used within a function, should be not excede STACKALIGN. See also SECTIONALIGN.

dimensionlist

A comma separated list of upper bounds. Lower bounds will always be 0. Note that this sytax differs from C: In C, you specify the number of elements, not the upper bound.

Imported variables, and variables created outside of any function are accessible from any function in the module. This makes Qbasic's SHARED unnecessary, as well as STATIC, since functions can use module level variables.

My compiler will, by default, create in the Nasm source one equ line for each variable and two equ lines for each array. For example:

DIM n AS WORD
DIM a(5) AS BYTE

will result in something like this being created:

_sizeof_n equ 0x2
_sizeof_a equ 0x5
_elementsizeof_a equ 0x1

Local variables will also result in something like this:

_functionname_variable equ 0xn

where n is what you need to subtract from BP or EBP to access it from inline assembly.

-----
OFFSET(datatype.element)

Returns the offset of an element within a data type.
Generally, this won't be needed, because the programmer should know the position.

-----
SIZEOF(datatype)
SIZEOF(datatype.element)
SIZEOF(array)
SIZEOF(array())

Returns the size of the data type, data type element, array, or array element. If no parenthesis are used with the array name, returns the size of the whole array. If parenthesis are used, returns the size of each element.
Generally, this won't be needed, because the programmer should know the size.

-----
PEEKB(address[, type[(dimension)][.member]])
PEEKW(address[, type[(dimension)][.member]])
PEEKD(address[, type[(dimension)][.member]])
PEEKQ(address[, type[(dimension)][.member]])
POKEB(address[, type[(dimension)][.member]]) = expression
POKEW(address[, type[(dimension)][.member]]) = expression
POKED(address[, type[(dimension)][.member]]) = expression
POKEQ(address[, type[(dimension)][.member]]) = expression
SWAPB address, address
SWAPW address, address
SWAPD address, address
INCB address[, type[(dimension)][.member]]
INCW address[, type[(dimension)][.member]]
INCD address[, type[(dimension)][.member]]
DECB address[, type[(dimension)][.member]]
DECW address[, type[(dimension)][.member]]
DECD address[, type[(dimension)][.member]]

The PEEK family reads a BYTE, a WORD, a DWORD, or a QWORD from the specified address.

The POKE family writes a BYTE, a WORD, a DWORD, or a QWORD to the specified address. The Syntax looks a little funny, but think of the POKE as standing in for a variable in an assignment.

The SWAP family exchanges the BYTE, WORD, or DWORD data at two specified addresses.

The INC and DEC families increment or decrement the BYTE, WORD, or DWORD at the specified adress.

address is any DWORD expression. Arithmatic done in this part does not take into account the size of the data type being pointed to. For example, PEEKW(pbuffer+1) will read a WORD from the address contained in pbuffer + 1 byte. Remember that address must be a pointer! For example, POKEW(n) does not write to n, but to the location pointed to by n. Use POKEW(PTR(n)) to write to n, or just n = whatever.

With the PEEK and POKE families, you can optionally treat the address as the base of a user defined data type or an array of any data type. For example, PEEKW(pbuffer,WORD(3)) treats the address contained in pbuffer as a pointer to an array, and reads a WORD from the address + 6 bytes.

Example:

'This example is for Real Mode DOS. It reads a character and color attribute
'from the first position, writes it to the second position, then writes a
'white,blue "a" to the first position.

$EXPECTED "r:dos"
DIM n AS WORD
n = PEEKW(0xb8000000)
POKEW(0xb8000002) = n
POKEW(0xb8000000) = 0x1761

-----
PTR(function)
PTR(variable[(index)][.member])

Returns the address of the specified symbol, either a variable, or a function. If no index or member is specified, then the address of the base of the variable or array is returned. If an index and/or member element is specified, then the pointer to the specific element is returned.

In protected mode, the address will be a DWORD, a near pointer. In real mode, the address will be a DWORD, a far pointer, with the segment as the high word, and the offset as the low word. A pointer is always a DWORD.

Example:

DIM n AS WORD
DIM p AS DWORD
p = PTR(n)
POKEW(p) = 5 'similar to n = 5

-----
ZXBW(expression)
ZXBD(expression)
ZXBQ(expression)
ZXWD(expression
ZXWQ(expression)
ZXDQ(expression)
SXBW(expression)
SXBD(expression)
SXBQ(expression)
SXWD(expression)
SXWQ(expression)
SXDQ(expression)
TRQD(expression)
TRQW(expression)
TRQB(expression)
TRDW(expression)
TRDB(expression)
TRWB(expression)

These are for integer data type conversion.

The ZX family zero extends an expression from a smaller type to a larger type. This is unsigned type conversion. For example, ZXBW converts an unsigned BYTE to an unsigned WORD.

The SX family sign extends an expression from a smaller type to a larger type. This is signed type conversion. For example, SXWD converts a signed WORD to a signed DWORD.

The TR family truncates an expression from a larger type to a smaller type. For example, TRWB converts a WORD to a BYTE.

The functions are necessary because this language will be very picky about the sizes of data types used in all the math operations.

Example:

DIM a AS DWORD
DIM b AS WORD

'a = a + b 'This is illegal, because a and b are different sizes.

a = a + ZXWD(b) 'You can zero extend b to the correct size...

b = b + TRDW(a) 'Adds low word of a to b.

'If you wanted to add b to the low word of a without affecting the high word:
POKEW(PTR(a)) = TRDW(a) + b

'Or...

POKEW(PTR(a)) = PEEKW(PTR(a)) + b

'Or...

a = (a AND 0xffff0000) OR ZXWD(TRDW(a) + b)

-----
DECLARE [{GLOBAL | EXTERN}] [{CDECL | PASCAL | STDCALL}] name([parameterlist]) AS {VOID | [FPRT] returntype [* factor]}

Declares a function prototype.

Names of functions can contain letters, numbers, underscore, and @, but should start with a letter. Name length can be up to 64 characters. Names of functions will be case sensitive.

GLOBAL

Exports the symbol to other modules.

EXTERN

Imports the symbol from some other module.

CDECL

Uses C style calling convention and name mangling. Parameters are passed by value from right to left, and the caller clears the stack.

PASCAL

Uses Pascal style calling convention. Pointers are passed by value from left to right, and the function clears the stack. Name mangling will still be C style.

STDCALL

Uses Win32 API calling convention and name mangling. Parameters are passed by value from right to left, and the function clears the stack.

If no convention is specified, STDCALL is assumed. This might generate a compiler warning.

parameterlist

This is a comma seperated list of parameters that the function expects. They will be in the form:

[parameter AS] type [* factor]

In the prototype declaration, the parameter name is optional. Only the type matters. The parameter list will be enforced, except for EXTERN CDECL, to allow usage of imported C functions like printf, in which case, it is ignored and not needed.

Although parameters can be various sizes, each will use a multiple of 2 bytes in real mode, and a multiple of 4 bytes in protected mode. Remember that pointers are always DWORDs, in either real or protected mode.

VOID

Specifies that the function does not return a value, or the value from an EXTERN function should be discarded.

returntype

The data type of the value returned by the function.

The returned value will be in AL, AX, EAX, DX:AX, EDX:EAX, or ST0, depending on size, whether the target is protected mode or real mode, and whether the value is floating point or not.

FPRT

Indicates that the returned value will be floating point, and will be returned in ST0.

Functions should not return values bigger than QWORD (DWORD if targeting real mode). If a function needs to return a value bigger than QWORD, use a DWORD parameter at the beginning of the parameter list to act as a pointer to a buffer to hold the returned value. Doing so should provide interoperability with CDECL and STDCALL, which use a "hidden" first parameter in such cases. (PROBABLY NOT TRUE. I think a pointer is passed to the function in eax.)

Example:

DECLARE EXTERN STDCALL GetStdHandle(DWORD) AS DWORD
DECLARE EXTERN STDCALL WriteConsoleW(DWORD,DWORD,DWORD,DWORD,DWORD) AS DWORD
DECLARE EXTERN CDECL printf() AS DWORD

-----
name(parameters)

Calls a function. If not used as part of an expression, any returned value is discarded.

CALL(address,name(parameters))

Calls a function at the specified address, treating it according to the function profile identified by name. If not used as part of an expression, any returned value is discarded.

name

The name of a function.

parameters

Parameters seperated by commas. Except for EXTERN CDECL functions, parameters are type checked against the prototype. Parameters are always passed by value. If you are calling a PASCAL function, you should pass pointers by value.

Example:

DECLARE PASCAL invertcase(DWORD) AS VOID

TYPE qbstring
 length AS WORD
 offset AS WORD
 buffer AS BYTE * 16
END

DIM string AS qbstring
DIM p AS DWORD

string.offset = TRDW(PTR(string.buffer))
string.buffer = ALIT("abc")
string.length = 3

invertcase(PTR(string))

'alternatively:

p = PTR(invertcase)
CALL(p,invertcase(string))

Another example:

DECLARE EXTERN STDCALL GetStdHandle(DWORD) AS DWORD
DECLARE EXTERN STDCALL WriteConsoleW(DWORD,DWORD,DWORD,DWORD,DWORD) AS DWORD

DIM stdout AS DWORD
DIM buffer(14) AS BYTE = WLIT("Hello, World."), WORD 0xd, WORD 0xa
DIM trash AS DWORD

stdout = GetStdHandle(-11)
WriteConsoleW(stdout,PTR(buffer),12,PTR(trash),0)

-----
FUNCTION [{CDECL | PASCAL | STDCALL}] name[(parameterlist)] AS [FPRT] {VOID | type}
 ...
 RETURN [expression]
END [FUNCTION]

Implements a function.

name

The name of the function.

parameterlist

The comma seperated list of parameters. Unlike in a prototype declaration, this list must contain the name of each parameter, so that it can be identified inside the function. The list items are in the form of:

variable AS type

RETURN [expression]

Exits the function, optionally returning a specified value.

Example:

DECLARE PASCAL invertcase(DWORD) AS VOID

TYPE qbstring
 length AS WORD
 offset AS WORD
 buffer AS BYTE * 16
END

FUNCTION invertcase(pqbstring AS DWORD) AS VOID
 DIM i AS WORD
 DIM n AS BYTE
 FOR i = 0 TO PEEKW(pqbstring, qbstring.length) - 1
  n = PEEKB(pqbstring + i, qbstring.buffer)
  n = (n AND 0xdf) - 0x41
  IF n u< 0x1a THEN
   POKEB(pqbstring + i, qbstring.buffer) = PEEKB(pqbstring + i, qbstring.buffer) XOR 0x20
  END
 NEXT
 RETURN
END

-----
ASM
 ...
END [ASM]

Includes inline assembly. The compiler will include the enclosed block in the generated assembly output. Only valid assembly source should be included between the ASM line and the END line.

The assembly block will start in section .text, but you can include assembler directives to output to other sections.

-----
Assignment operator =

For compile/assemble time assignment, see also CONST and DIM.

In the case of CONST, the value must be a DWORD.

In any case, the value must be a literal constant. The Format for literal constants is shown below.

Runtime assignment:

variable = {expression | litsequence}
array(index) = {expression | litsequence}
array = litsequence
POKEB(address[, type[(dimension)][.member]]) = {expression | litsequence}
POKEW(address[, type[(dimension)][.member]]) = {expression | litsequence}
POKED(address[, type[(dimension)][.member]]) = {expression | litsequence}
POKEQ(address[, type[(dimension)][.member]]) = {expression | litsequence}

expression can be any valid expression that matches the size of the destination. You may have to use the extend or truncate functions to adjust the size of the expression, or use one of the poke functions to adjust the size of the destination.

litsequence is a comma seperated list, within parenthesis, with each item in the form of:

{{ALIT | WLIT} "strconst" | standardtype numconst}

Numeric literals will be preceded by one of the standard data types to identify its size. For example: (BYTE 0xd, BYTE 0xa) specifies an Ascii crlf pair, and so does (WORD 0xa0d).

The total size of the sequence may not excede the size of the destination variable or array.

variable = variable

Is an example of an expression being assigned.

variable = 0xa

0xa is a literal constant. It is assumed to be of the same type as variable.

variable = (ALIT "a")

Even though there is only item, it is considered a sequence.

Example:

$EXPECTED "rdos:com"
DECLARE STDCALL main() AS DWORD
DIM buffer AS BYTE * 15 = (ALIT "Hello, World", WORD 0xa0d, ALIT "$")

FUNCTION main() AS DWORD
 ASM
  mov dx,_buffer
  mov ah,0x9
  int 0x21
 END
RETURN 0x0
END

-----
Integer comparison operators

Operator   Description                     Asm equivilents Qbasic equivilent
=          equal                           e, z            =
<>         not equal                       ne, nz          <>
S<         signed less than                l, nge          <
S>         signed greater than             g, nle          >
S<=        signed less than or equal       le, ng          <=
S>=        signed greater than or equal    ge, nl          >=
U<         unsigned below                  b, c, nae
U>         unsigned above                  a, nbe
U<=        unsigned below or equal         be, na
U>=        unsigned above or equal         ae, nb, nc

Performs a comparison. The S family performs signed comparison. The U family performs unsigned comparison.

Syntax, as part of an expression:

expression operator expression

In such a case, the comparison is performed (using either a subtraction or an AND). The result is returned as 0 for false, and -1 for true (That is, 0x0 for false, and 0xff for true, sign extended to the correct size). The two input expressions, and the returned output, will all be the same size. DWORD is the maximum size.

If this operation is the last to be evaluated in an expression, then subsequent code may rely on the flags, as long as nothing in between destroys them. Assignment to a regular variable will not destroy them. Assignment that involves any array indexing might destroy them.

Syntax as part of an IF IS:

IF IS operator THEN

See IF for details.

Syntax as part of a CASE IS:

CASE IS operator expression

See SELECT for details.

-----
Integer addition and subtraction operators

Operator   Description                     Asm equivilent  Qbasic equivilent
+          add                             add             + (signed only)
-          subtract                        sub, cmp        - (signed only)
+C         add with carry                  adc
-B         subtract with borrow            sbb

Syntax:

expression operator expression

Performs an arithmatic operation. The result is returned. The two input expressions, and the returned output, will all be the same size. DWORD is the maximum size.

The +C and -B operations depend on the carry flag. Be very careful that you don't do anything to accidently destroy the flag in between your deliberate setting of it, and your reliance on it.

-----
Integer multiplication and division operators

Operator   Description                     Asm equivilent  Qbasic equivilent
S*         signed multiply                 imul            * (all same size)
S\         signed divide                   idiv            \ (all same size)
SMOD       signed remainder                idiv           MOD (all same size)
S/         signed divide & remainder       idiv
U*         unsigned multiply               mul
U\         unsigned divide                 div
UMOD       unsigned remainder              div
U/         unside divide & remainder       div

Syntax:

expression operator expression

Performs an arithmatic operation. The result is returned. The S family performs signed arithmatic. The U family performs unsigned arithmatic.

In the case of multiplication, the inputs will be the same size, and the output will be twice the size of each input. Maximum input size is DWORD. Maximum output size is QWORD.

In the case of S\, SMOD, U\, and UMOD, the dividend is the first expression, and is twice the size of the divisor. The divisor is the second expression, and is half the size of the dividend. The returned result is the size of the divisor. Maxium dividend size is QWORD. Maximum divisor and result size is DWORD.

In the case of S/, U/, the dividend is the first expression, and is twice the size of the divisor. The divisor is the second expression, and is half the size of the dividend. The returned result is the size of the dividend. Maxium dividend and result size is QWORD. Maximum divisor size is DWORD. The high half of the result will be the remainder, the low half will be the quotient. On this point, I am defering to Intel. In my opinion, the reverse would have been better.

-----
Bitwise logic operators

Operator   Description                     Asm equivilent  Qbasic equivilent
AND        bitwise and                     and, test       AND
OR         bitwise or                      or              OR
XOR        bitwise exclusive or            xor             XOR
NOT        bitwise one's compliment        not             NOT
NEG        bitwise two's compliment        neg

Syntax for AND, OR, and XOR:

expression operator expression

Syntax for NOT and NEG:

operator expression

Performs bitwise logic. The result is returned. The input expressions, and the returned output, will all be the same size. DWORD is the maximum size.

If this operation is the last to be evaluated in an expression, then subsequent code may rely on the flags, as long as nothing in between destroys them. Assignment to a regular variable will not destroy them. Assignment that involves any array indexing might destroy them.

-----
Bitwise shift and rotate operators

Operator   Description                     Asm equivilent  Qbasic equivilent
SHL        shift left                      shl
SHR        shift right                     shr
SAR        arithmatic shift right          sar
ROL        rotate left                     rol
ROR        rotate right                    ror
RCL        rotate through carry left       rcl
RCR        rotate through carry right      rcr

Syntax:

expression operator expression

Performs bitwise shift or rotation. The first expression will be shifted or rotated by the number of bits specified in the second expression. The result is returned. The first expressions and the returned output will be the same size. DWORD is the maximum size. The second expression will be BYTE size, with only the low 5 bits mattering.

The RCR and RCL operations depend on the carry flag. Be very careful that you don't do anything to accidently destroy the flag in between your deliberate setting of it, and your reliance on it. 

If the operation is the last to be evaluated in an expression, then subsequent code may rely on the flags, as long as nothing in between destroys them. Assignment to a regular variable will not destroy them. Assignment that involves any array indexing might destroy them.

-----
VOID expression

Evaluates an expression, but discards the result. This is meant for use in setting the flags for subsequent flag dependant code. Be very careful that you don't do anything to accidently destroy the flags in between your deliberate setting of them, and your reliance on them.

-----
STC
CLC
CMC

Set, clear, or compliment the carry flag.

Be very careful that you don't do anything to accidently destroy the flags in between your deliberate setting of them, and your reliance on them.

-----
ABS(expression)

Returns the absolute value of a signed BYTE, WORD, or DWORD. The returned value will match the expression in size.

-----

IF {expression | IS condition} THEN GOTO label

IF {expression | IS condition} THEN
...
[ELSEIF {expression | IS condition} THEN
...]
[ELSE 
...]
END [IF]

Conditional execution.

expression

If the value of the expression is 0, it is considered false. If the value is non-zero, It is considered true.

IS condition

Tests for the specified condition, based on the status flags. 

condition can be one of the relational operators (=, <>, U>, U>=, U<, U<=, S>, S>=, S<, or S<=), or it can be PARITY, NPARITY, OVERFLOW, or NOVERFLOW.

Be very careful that you don't do anything to accidently destroy the flags in between your deliberate setting of them, and your reliance on them.

GOTO will be the only thing you can do with a single line IF statement. Anything else, requires a block.

Multiple ESLEIFs are allowed with a block, but only one ELSE.

IF and ELSEIFs are checked in order. The code of the first one that is true is executed, and any remaining ones are not checked.

-----
SELECT [CASE] mainexpression
CASE list
 ...
[CASE ELSE]
 ...
END [SELECT]

Conditional execution.

list is a comma separated list, with each item of this format:

{expression | expression TO expression | IS operator expression}

mainexpression is compared with various posibilities. It will be a BYTE, WORD, or DWORD, and the expressions compared with it must be the same size.

CASE expression

If expression equals mainexpression, then the code will be exected. This is the same as CASE IS = expression.

CASE expression TO expression

If mainexpression is U>= first expression, and mainexpression U<= second expression, then the code will be executed.

CASE IS operator expression

operator is a relational operator (=, <>, U>, U>=, U<, U<=, S>, S>=, S<, or S<=) or a dual operand bitwise logic operator (AND, OR, XOR).

If mainexpression operator expression is true (non-zero), then the code will be executed.

CASE ELSE

The code will be executed if none of the others were true.

CASEs are checked in order. The first one that is true is executed, and any remaining ones are not checked.

-----
DO [{WHILE | UNTIL} doexpression]
 ...
LOOP [{WHILE | UNTIL} loopexpression]

Looping mechanism.

A condition may be specified on the DO, on the LOOP, on both, or on neither.

doexpression and loopexpressions must be BYTE, WORD, or DWORD, but do not have to be the same.

WHILE allows the loop to repeat if the expression is true (non-zero). Otherwise, the loop is not repeated.

UNTIL allows the loop to repeat if the expression is false (zero). Otherwise, the loop is not repeated.

The expression on DO, if any, is evaluated before entry into the loop, and then again each time LOOP sends execution back.

The expression on LOOP, if any, is evaluated each time before the loop repeats, and before the DO expression is reevaluated.

DO WHILE doexpression
 something
LOOP WHILE loopexpression

is basically the same as:

startofloop:
IF doexpression THEN
 something
 IF loopexpression THEN GOTO startofloop
END

-----
FOR variable = initial TO upperlimit
 ...
NEXT [variable]

FOR variable = initial {WHILE | UNTIL} operator expression [STEP addend]
 ...
NEXT [variable]

Looping mechanism.

variable

The variable that will be used for tracking. May be a POKE instead of a variable. May be a BYTE, WORD, or DWORD. variable, intial, expression, and addend must all be the same size.

inital

The expression initially assigned to variable.

TO upperlimit

variable U<= upperlimit will be evaluated after the assignment, but before the loop is entered. It will be reevaluated after each iteration to determine wheter to repeat the loop. The loop will be entered/repeated if the evaluation is true (non-zero).

{WHILE | UNTIL} operator expression

operator is a relational operator (=, <>, U>, U>=, U<, U<=, S>, S>=, S<, or S<=) or a dual operand bitwise logic operator (AND, OR, XOR).

variable operator expression will be evaluated after the assignment, but before the loop is entered. It will be reevaluated after each iteration to determine wheter to repeat the loop. If WHILE is used, the loop will be entered/repeated if the evaluation is true (non-zero). If UNTIL is used, the loop will be entered/repeated if the evaluation is false (zero).

STEP addend

addend will be evaluated and added to variable at the end of each iteration, but before the looping condition is reevaluated. If omitted, 1 will be assumed. Cannot be used with the TO upperlimit syntax.

FOR n = 0 TO 3
 something
NEXT

is basically the same as:

n = 0
DO WHILE n U<= 3
 something
 n = n + 1
LOOP

and:

FOR n = 5 WHILE S>= -2 STEP -1
 something
NEXT

This is basically the same as:

n = 5
DO WHILE n S>= -2
 something
 n = n + -1
LOOP

-----
EXIT [{IF | SELECT | DO | FOR}]

Exits the currently innermost block of the specified type. If not type is specified, exits the current innermost block of whatever type.

IF whatever THEN
 EXIT IF
 dosomething
END

Is basically the same as:

IF whatever THEN
 GOTO getmeoutofhere
 dosomething
END
getmeoutofhere:

-----
GOTO label
label:

Jumps to a label anywhere within the same function. Cannot cross functions. If used outside of any function, jumps to a label outside of any function.

Label names may be letters and numbers, but should start with a letter. Labels are case sensitive. Name length can be up to 64 characters. My compiler wil prefix ".l" in the Nasm source, making the label a local label.
-----
Order of precedence.

Operations with the same precedence are evaluated in the order they are encountered left to right.

In the list below, each of the operators grouped togegether has the same precedence as all the others in the same group.

Parenthesis: ()
Single operand bitwise logic: NOT, NEG
Multiplication and divison: S*, S\, SMOD, S/, U*, U\, UMOD, U/
Addition and subtraction: +, -, +C, -B
Shifts and rotates: SHL, SHR, SAR, ROL, ROR, RCL, RCR
Relational operators: =, <>, S<, S>, S>=, S<=, U<, U>, U>=, U<=
Double operand bitwise logic: AND, OR, XOR

I recommend not relying too much on this. I'd recommend using parenthesis to be safe.

Depending on compiler implementation, function procedures called from within an expression that change variables in the expression might cause unexpected results.

 
 Respond to this message   
AuthorReply
Michael Calkins
(Login MCalkins)
ASM Forum

xl0c.bas (abandoned)

August 14 2017, 3:00 PM 

'reexamine .com stack checking.

' will eventually have to add expression evaluation.
' am avoiding it for now.

'eXpirimental Language 0 Compiler.
'Originally called "Medium Level Basic Compiler"
'By Michael Calkins.
'Started on the compiler February 24, 2011. Started on the language a few days
'before that.

'this program assumes all variables are initiallized to 0, which is the case
'in QBASIC, and probably QB64 also.

CONST inf$ = "c:\xl0\t.xl0"
CONST outf$ = "c:\xl0\t.asm"
CONST pmode = 0
CONST os = "dos"
CONST ttype = "com"

CONST majorversion = 0
CONST minorversion = 0
CONST revision = &H20110330
CONST langmajorversion = 0
CONST langminorversion = 0

CONST maxdatatypes = 256
CONST maxelements = 512
CONST maxvariables = 1024 'variables and arrays
CONST maxarrays = 256 'arrays only
CONST maxfunctions = 256
CONST maxblks = 64
CONST maxconsts = 64

CONST txt = 0
CONST dat = 1
CONST bss = 2

DEFINT A-Z
DECLARE FUNCTION isexpected% (t$, i%)
DECLARE FUNCTION getconstbyte$ (t$, i%)
DECLARE FUNCTION getconstword% (t$, i%)
DECLARE FUNCTION readword% (t$)
DECLARE FUNCTION readbyte$ (t$)
DECLARE SUB verifyint (t$)
DECLARE FUNCTION getconstwordseq% (t$, i%, sup%)
DECLARE FUNCTION getconstbyteseq$ (t$, i%, sup%)
DECLARE FUNCTION getconstqwordseq$ (t$, i%, sup%)
DECLARE FUNCTION getconsttwordseq$ (t$, i%, sup%)
DECLARE FUNCTION getsequence$ (t$, i%)
DECLARE FUNCTION getconstdwordseq& (t$, i%, sup%)
DECLARE SUB warn (n AS INTEGER)
DECLARE SUB checkid (t$)
DECLARE SUB process (t$)
DECLARE FUNCTION getconstdword& (t$, i%)
DECLARE SUB bomb (n%, t$)
DECLARE SUB section (n AS INTEGER)
DECLARE FUNCTION readdword& (t$)
DECLARE SUB processfile (f$)
DECLARE FUNCTION nextword$ (t$, i%)
DIM SHARED dt(0 TO maxdatatypes - 1) AS STRING 'name of data type
DIM SHARED dte(0 TO maxdatatypes - 1) AS STRING 'list of elements
'will be a sequence of INTEGER indexes into the array of elements
DIM SHARED dts(0 TO maxdatatypes - 1) AS LONG 'size of data type
DIM SHARED el(0 TO maxelements - 1) AS STRING 'name of element
DIM SHARED elo(0 TO maxelements - 1) AS LONG 'offset within data type
DIM SHARED eld(0 TO maxelements - 1) AS INTEGER 'data type of element
DIM SHARED els(0 TO maxelements - 1) AS LONG 'size of element
'type * factor will be accomplished by storing the resulting size, instead of
'the size of the plain type.
DIM SHARED va(0 TO maxvariables - 1) AS STRING 'name of variable or array
DIM SHARED vadt(0 TO maxvariables - 1) AS INTEGER 'index into array of types
DIM SHARED vaf(0 TO maxvariables - 1) AS INTEGER 'index into array of funcs
'if the variable is local to a function, the high bit is set, and the other
'bits are an index into the array of functions.
DIM SHARED vadi(0 TO maxvariables - 1) AS INTEGER 'link to dimension info
'if high bit clear, variable is not an array. if high bit set, the variable is
'an array, in which case the 2nd highest bit is set if column major, clear if
'row major, and the other bits are an index into the array of dimensions.
DIM SHARED vas(0 TO maxvariables - 1) AS LONG 'size of variable
DIM SHARED adi(0 TO maxarrays - 1) AS STRING 'list of array upper bounds
'will be a sequence of LONGs
DIM SHARED aes(0 TO maxarrays - 1) AS LONG 'size of element
'type * factor will be accomplished by storing the resulting size, instead of
'the size of the plain type.
DIM SHARED fu(0 TO maxfunctions - 1) AS STRING 'function name
DIM SHARED fur(0 TO maxfunctions - 1) AS INTEGER 'function return data type
'if high bit set, function returns a floating point. The other bits are an
'index into the array of data types. If 0, function is void.
DIM SHARED fup(0 TO maxfunctions - 1) AS STRING 'list of parameters
'will be a sequence of LONGS. The high 16 bits are the size of the parameter.
'The low 16 bits are an index into the array of data types.
DIM SHARED fus(0 TO maxfunctions - 1) AS INTEGER 'info about the function
'the high 3 bits indicate the calling convention. the low ten bits are the
'number of words pushed onto the stack. The other bits are currently reserved.
'calling conventions:
'w32 stdcall 0
'cdecl 1
'pascal 2
'w32 fastcall 3
'os2 syscall 4
'reserved 5 to 7
DIM SHARED funv(0 TO maxfunctions - 1) AS INTEGER 'next variable
'defines the next valid end offset for a local variable. for example, if this
'number is 0, the next local variable may end at (ebp-1), and start at
'((ebp-1)-lengthofvariable).
DIM SHARED constname(0 TO maxconsts - 1) AS STRING 'name of const
DIM SHARED constvalue(0 TO maxconsts - 1) AS LONG 'value of const

DIM SHARED ndt AS INTEGER 'num of data types
DIM SHARED nel AS INTEGER 'num of elements
DIM SHARED nva AS INTEGER 'num of variables
DIM SHARED nar AS INTEGER 'num of arrays
DIM SHARED nfu AS INTEGER 'num of functions
DIM SHARED nco AS INTEGER 'num of consts

DIM SHARED blktype(0 TO maxblks - 1) AS INTEGER 'type of block
'0=function, 1=if, 2=select, 3=do, 4=for, 6=$if
DIM SHARED blknum(0 TO maxblks - 1) AS LONG 'unique id, if needed
'in the case of functions, will be an index into array of funcs
'in the case of $if, will be 1 if the block has already had a true condition,
'2 if it has already had an $else, otherwise 0.
DIM SHARED blkstack AS INTEGER 'number of blocks currently active
DIM SHARED blknextnum AS LONG 'the next available unique id
DIM SHARED currentsection AS INTEGER 'the current output section
DIM SHARED curfil AS STRING 'current source file
DIM SHARED curlin AS LONG 'current line number
DIM SHARED dataalign AS LONG
DIM SHARED bssalign AS LONG
DIM SHARED biggestdataalign AS LONG
DIM SHARED biggestbssalign AS LONG


dt(0) = "void"
dte(0) = ""
dts(0) = 0
dt(1) = "byte"
dte(1) = ""
dts(1) = 1
dt(2) = "word"
dte(2) = ""
dts(2) = 2
dt(3) = "dword"
dte(3) = ""
dts(3) = 4
dt(4) = "qword"
dte(4) = ""
dts(4) = 8
dt(5) = "tword"
dte(5) = ""
dts(5) = 10

constname(0) = "stackalign"
IF pmode THEN constvalue(0) = 4 ELSE constvalue(0) = 2

ndt = 6
nel = 0
nva = 0
nar = 0
nfu = 0
nco = 1

blknextnum = 0
blkstack = 0

DIM SHARED ulu AS STRING 'unicode lookup table
ulu = "263a263b2665266626632660202225d825cb25d926422640266a266b263c"
ulu = ulu + "25ba25c42195203c00b600a725ac21a82191219321922190221f219425b225bc"
ulu = ulu + "2302"
ulu = ulu + "00c700fc00e900e200e400e000e500e700ea00eb00e800ef00ee00ec00c400c5"
ulu = ulu + "00c900e600c600f400f600f200fb00f900ff00d600dc00a200a300a520a70192"
ulu = ulu + "00e100ed00f300fa00f100d100aa00ba00bf231000ac00bd00bc00a100ab00bb"
ulu = ulu + "259125922593250225242561256225562555256325512557255d255c255b2510"
ulu = ulu + "25142534252c251c2500253c255e255f255a25542569255625602550256c2567"
ulu = ulu + "2568256425652559255825522553256b256a2518250c25882584258c25902580"
ulu = ulu + "03b100df039303c003a303c300b503c403a6039803a903b4221e03c603b52229"
ulu = ulu + "226100b1226522642320232100f7224800b0221900b7221a207f00b225a000a0"

PRINT "eXpirimental Language 0 Compiler"
PRINT "Public Domain. Written by Michael Calkins. http://www.qbasicmichael.com"
PRINT "http://www.network54.com/index/10167"
PRINT "Version:"; STR$(majorversion); "."; LTRIM$(STR$(majorversion)); ", Revision: "; HEX$(revision);
PRINT ", Supported language version:"; STR$(langmajorversion); "."; LTRIM$(STR$(langmajorversion))
OPEN outf$ FOR OUTPUT AS 1
PRINT #1, "_stackalign equ 0x"; HEX$(constvalue(0))
PRINT #1, "section .text align=0x1"
PRINT #1, "section .data align=0x1"
PRINT #1, "section .bss align=0x1"
dataalign = 1
bssalign = 1
currentsection = bss
processfile inf$
CLOSE
SYSTEM

SUB bomb (n, t$)
 PRINT
 PRINT "Error in "; CHR$(&H22); curfil; CHR$(&H22); ", line"; curlin
 SELECT CASE n
 CASE 0: PRINT "Syntax error."
 CASE 1: PRINT "Feature not yet implemented."
 CASE 2: PRINT "Unknown identifier."
 CASE 3: PRINT "Block mismatch or syntax error."
 CASE 4: PRINT "Reached end of file while inside block."
 CASE 5: PRINT "Invalid identifier."
 CASE 6: PRINT "Duplicate definition."
 CASE 7: PRINT "Data type mismatch."
 END SELECT
 IF LEN(t$) THEN PRINT t$
 CLOSE
 KILL outf$
 SYSTEM
END SUB

SUB checkid (t$)
'checks an identifier to make sure it is valid, and isn't reserved.

END SUB

FUNCTION getconstbyte$ (t$, i)
'evaluates a byte constant
'adjusts i in the same way that nextword$ does.

'it could be a constant expression. but for now, just read it as a simple
'literal

 getconstbyte$ = readbyte$(nextword$(t$, i))
END FUNCTION

FUNCTION getconstbyteseq$ (t$, i, sup)
'evaluates byte constant or sequence up to byte size, and returns a byte.
'adjusts i in the same way that nextword$ does.

 IF MID$(t$, i) = "(" THEN
  SELECT CASE LCASE$(nextword$(t$, i + 1)) 'i is not affected
  CASE "byte", "word", "dword", "qword", "tword", "alit", "wlit"
   t$ = getsequence$(t$, i)
   IF sup THEN
    SELECT CASE LEN(t$)
    CASE IS < 1: warn 6
    CASE IS > 1: bomb 7, "Initiallization value is too big."
    END SELECT
   ELSE
    IF LEN(t$) <> 1 THEN bomb 7, "Expected: BYTE constant."
   END IF
   getconstbyteseq$ = t$
  CASE ELSE
   getconstbyteseq$ = getconstbyte$(t$, i)
  END SELECT
 ELSE
  getconstbyteseq$ = getconstbyte$(t$, i)
 END IF

END FUNCTION

FUNCTION getconstdword& (t$, i)
'evaluates a dword constant
'adjusts i in the same way that nextword$ does.

'it could be a constant expression. but for now, just read it as a simple
'literal
 
 getconstdword& = readdword&(nextword$(t$, i))
END FUNCTION

FUNCTION getconstdwordseq& (t$, i, sup)
'evaluates dword constant or sequence up to dword size, and returns a dword.
'adjusts i in the same way that nextword$ does.
 IF MID$(t$, i) = "(" THEN
  SELECT CASE LCASE$(nextword$(t$, i + 1)) 'i is not affected
  CASE "byte", "word", "dword", "qword", "tword", "alit", "wlit"
   t$ = getsequence$(t$, i)
   IF sup THEN
    SELECT CASE LEN(t$)
    CASE IS < 4: warn 6
    CASE IS > 4: bomb 7, "Initiallization value is too big."
    END SELECT
   ELSE
    IF LEN(t$) <> 4 THEN bomb 7, "Expected: DWORD constant."
   END IF
   getconstdwordseq& = CVL(t$)
  CASE ELSE
   getconstdwordseq& = getconstdword&(t$, i)
  END SELECT
 ELSE
  getconstdwordseq& = getconstdword&(t$, i)
 END IF
END FUNCTION

FUNCTION getconstqwordseq$ (t$, i, sup)
'evaluates qword constant or sequence up to qword size, and returns a qword.
'adjusts i in the same way that nextword$ does.
 IF MID$(t$, i) = "(" THEN
  SELECT CASE LCASE$(nextword$(t$, i + 1)) 'i is not affected
  CASE "byte", "word", "dword", "qword", "tword", "alit", "wlit"
   t$ = getsequence$(t$, i)
   IF sup THEN
    SELECT CASE LEN(t$)
    CASE IS < 8: warn 6
    CASE IS > 8: bomb 7, "Initiallization value is too big."
    END SELECT
   ELSE
    IF LEN(t$) <> 8 THEN bomb 7, "Expected: QWORD constant."
   END IF
   getconstqwordseq$ = t$
  CASE ELSE
   bomb 1, "QWORD literals are not yet supported."
  END SELECT
 ELSE
  bomb 1, "QWORD literals are not yet supported."
 END IF
END FUNCTION

FUNCTION getconsttwordseq$ (t$, i, sup)
'evaluates qword constant or sequence up to qword size, and returns a qword.
'adjusts i in the same way that nextword$ does.
 IF MID$(t$, i) = "(" THEN
  SELECT CASE LCASE$(nextword$(t$, i + 1)) 'i is not affected
  CASE "byte", "word", "dword", "qword", "tword", "alit", "wlit"
   t$ = getsequence$(t$, i)
   IF sup THEN
    SELECT CASE LEN(t$)
    CASE IS < 10: warn 6
    CASE IS > 10: bomb 7, "Initiallization value is too big."
    END SELECT
   ELSE
    IF LEN(t$) <> 10 THEN bomb 7, "Expected: TWORD constant."
   END IF
   getconsttwordseq$ = t$
  CASE ELSE
   bomb 1, "TWORD literals are not yet supported."
  END SELECT
 ELSE
  bomb 1, "QWORD literals are not yet supported."
 END IF
END FUNCTION

FUNCTION getconstword% (t$, i)
'evaluates a word constant
'adjusts i in the same way that nextword$ does.

'it could be a constant expression. but for now, just read it as a simple
'literal

 getconstword% = readword%(nextword$(t$, i))
END FUNCTION

FUNCTION getconstwordseq% (t$, i, sup)
'evaluates word constant or sequence up to word size, and returns a word.
'adjusts i in the same way that nextword$ does.

 IF MID$(t$, i) = "(" THEN
  SELECT CASE LCASE$(nextword$(t$, i + 1)) 'i is not affected
  CASE "byte", "word", "dword", "qword", "tword", "alit", "wlit"
   t$ = getsequence$(t$, i)
   IF sup THEN
    SELECT CASE LEN(t$)
    CASE IS < 2: warn 6
    CASE IS > 2: bomb 7, "Initiallization value is too big."
    END SELECT
   ELSE
    IF LEN(t$) <> 2 THEN bomb 7, "Expected: WORD constant."
   END IF
   getconstwordseq% = CVI(t$)
  CASE ELSE
   getconstwordseq% = getconstword%(t$, i)
  END SELECT
 ELSE
  getconstwordseq% = getconstword%(t$, i)
 END IF
END FUNCTION

FUNCTION getsequence$ (t$, i)
 DIM a$
 IF MID$(t$, i, 1) <> "(" THEN bomb 0, "Sequences must be within parenthesis. Expected: (."
 i = i + 1
 DO
  SELECT CASE LCASE$(nextword$(t$, i))
  CASE "byte": a$ = a$ + getconstbyte$(t$, i)
  CASE "word": a$ = a$ + MKI$(getconstword%(t$, i))
  CASE "dword": a$ = a$ + MKD$(getconstdword&(t$, i))
  CASE "qword": bomb 1, "QWORD literals are not yet supported."
  CASE "tword": bomb 1, "TWORD literals are not yet supported."
  CASE "alit"
   IF MID$(t$, i, 1) = " " THEN i = i + 1
   IF MID$(t$, i, 1) <> CHR$(&H22) THEN bomb 0, "Expected: " + CHR$(&H22) + "."
   DO
    i = i + 1
    IF MID$(t$, i, 1) = CHR$(&H22) THEN EXIT DO
    a$ = a$ + MID$(t$, i, 1)
   LOOP
   i = i + 1
  CASE "wlit"
   IF MID$(t$, i, 1) = " " THEN i = i + 1
   IF MID$(t$, i, 1) <> CHR$(&H22) THEN bomb 0, "Expected: " + CHR$(&H22) + "."
   DO
    i = i + 1
    IF MID$(t$, i, 1) = CHR$(&H22) THEN EXIT DO
    n = ASC(MID$(t$, i, 1))
    SELECT CASE n
    CASE &H1 TO &H1F: a$ = a$ + MKI$(VAL("&h" + MID$(ulu, 1 + (4 * (n - 1)), 4)))
    CASE IS > &H7E: a$ = a$ + MKI$(VAL("&h" + MID$(ulu, 1 + (4 * (n - &H60)), 4)))
    CASE ELSE: a$ = a$ + MKI$(n)
    END SELECT
   LOOP
   i = i + 1
  CASE ELSE: bomb 0, "Expected: standard data type or ALIT or WLIT."
  END SELECT
  SELECT CASE MID$(t$, i, 1)
  CASE ",": i = i + 1
  CASE ")": i = i + 1: EXIT DO
  CASE ELSE: bomb 0, "Expected: , or )."
  END SELECT
 LOOP
 IF i > LEN(t$) THEN i = 0
 getsequence$ = a$
END FUNCTION

FUNCTION isexpected% (t$, i)
'returns true if the specified quote enclosed string contains an output mode
'that matches the current output mode.

'adjusts i like nextword$

 IF MID$(t$, i, 1) <> CHR$(&H22) THEN bomb 0, "Expected: " + CHR$(&H22) + "."
 i = i + 1
 DO
  thismatches = -1
  n = INSTR(i, t$, ":"): last = 0
  IF n = 0 THEN n = INSTR(i, t$, ","): last = 1
  IF n = 0 THEN n = INSTR(i, t$, CHR$(&H22)): last = 2
  IF n = 0 THEN bomb 0, "Can't find : or , or " + CHR$(&H22) + "."
  w$ = LCASE$(MID$(t$, i, n - i))
  SELECT CASE w$
  CASE "p": IF pmode = 0 THEN thismatches = 0
  CASE "r": IF pmode THEN thismatches = 0
  CASE "a"
  CASE ELSE: bomb 0, "Expected: A or P or R."
  END SELECT
  i = n + 1
  IF last THEN EXIT DO
  n = INSTR(i, t$, ":"): last = 0
  IF n = 0 THEN n = INSTR(i, t$, ","): last = 1
  IF n = 0 THEN n = INSTR(i, t$, CHR$(&H22)): last = 2
  IF n = 0 THEN bomb 0, "Can't find : or , or " + CHR$(&H22) + "."
  w$ = LCASE$(MID$(t$, i, n - i))
  SELECT CASE w$
  CASE "win": IF os <> "win" THEN thismatches = 0
  CASE "dos": IF os <> "dos" THEN thismatches = 0
  CASE "os2": IF os <> "os2" THEN thismatches = 0
  CASE "a"
  CASE ELSE: warn 8
  END SELECT
  i = n + 1
  IF last THEN EXIT DO
  n = INSTR(i, t$, ":"): last = 0
  IF n = 0 THEN n = INSTR(i, t$, ","): last = 1
  IF n = 0 THEN n = INSTR(i, t$, CHR$(&H22)): last = 2
  IF n = 0 THEN bomb 0, "Can't find : or , or " + CHR$(&H22) + "."
  w$ = LCASE$(MID$(t$, i, n - i))
  SELECT CASE w$
  CASE "qbasic": IF ttype <> "qbasic" THEN thismatches = 0
  CASE "com": IF ttype <> "com" THEN thismatches = 0
  CASE "module": IF ttype <> "module" THEN thismatches = 0
  CASE "a"
  CASE ELSE: warn 8
  END SELECT
  i = n + 1
  IF last = 0 THEN
   warn 9
   n = INSTR(i, t$, ","): last = 1
   IF n = 0 THEN n = INSTR(i, t$, CHR$(&H22)): last = 2
   IF n = 0 THEN bomb 0, "Can't find , or " + CHR$(&H22) + "."
   i = n + 1
  END IF
  IF last THEN
   IF thismatches THEN match = -1
   'the loop is not exited so that the syntax of the rest of the string can be
   'checked.
  END IF
 LOOP UNTIL last = 2
 IF i > LEN(t$) THEN i = 0
 isexpected% = match
END FUNCTION

FUNCTION nextword$ (t$, i)
'starts searching a string at position i. skips initial spaces, starts when it
'encounters a non-space, stops when it encounters a space, a parenthesis, a
'comma, or a period. the found string is returned, and i will be the position
'after the end of the found string. If the end of the string has been reached,
'i will be 0.
DIM c AS STRING * 1
 IF i = 0 THEN bomb 0, "Unexpectedly reached end of line."
 n$ = ""
 m = 0
 DO WHILE i <= LEN(t$)
  c = MID$(t$, i, 1)
  i = i + 1
  SELECT CASE c
  CASE " ": IF m THEN EXIT DO
  CASE "(", ")", ".", ",": EXIT DO
  CASE ELSE
   m = -1
   n$ = n$ + c
  END SELECT
 LOOP
 IF i > LEN(t$) THEN i = 0
 nextword$ = n$
END FUNCTION

SUB process (t$)
'processes a line of source code: removes comments and redundant spaces.
'remove any space after a space, comma, period, or left parenthesis
 t$ = LTRIM$(RTRIM$(t$))
 outquote = 0
 killspace = 0
 i = 1
 DO UNTIL i >= LEN(t$)
  SELECT CASE MID$(t$, i, 1)
  CASE CHR$(&H22): outquote = NOT outquote
  CASE "'"
   IF outquote THEN t$ = RTRIM$(LEFT$(t$, i - 1)): EXIT DO
  CASE ",", ".", "(": killspace = -1
  CASE " "
   IF killspace AND outquote THEN t$ = LEFT$(t$, i - 1) + MID$(t$, i + 1)
   killspace = -1
  CASE ELSE: killspace = 0
  END SELECT
  i = i + 1
 LOOP
END SUB

SUB processfile (f$)
 curfil = f$
 DIM lin AS LONG
 PRINT
 PRINT "Beginning to process file: "; f$
 fln = FREEFILE
 OPEN f$ FOR INPUT AS fln
 lin = 0
 notskip = -1
 DO UNTIL EOF(fln)
  lin = lin + 1
  curlin = lin
  LINE INPUT #fln, t$
  process t$
  i = 1
  w$ = nextword(t$, i)
  IF (fln = 2) AND (curlin = 1) THEN
   IF (pmode = 0) AND (os = "dos") AND (ttype = "com") AND (LCASE$(w$) <> "stack") THEN
    bomb 0, "In r:dos:com mode, STACK must be the first line."
   END IF
  END IF
  SELECT CASE LCASE$(w$)
  CASE "$elseif"
   IF blkstack = 0 THEN bomb 3, "$elseif without $if."
   IF blktype(blkstack - 1) <> 6 THEN bomb 3, "$elseif without $if."
   notskip = 0
   IF blknum(blkstack - 1) = 2 THEN bomb 3, "$elseif after $else."
   IF blknum(blkstack - 1) = 0 THEN
    IF i = 0 THEN bomb 0, "Expected: " + CHR$(&H22) + "."
    IF isexpected%(t$, i) = 0 THEN
     blknum(blkstack - 1) = 1
     notskip = -1
    END IF
    IF i THEN bomb 0, "Expected: end of line."
   END IF
  CASE "$else"
   IF i THEN bomb 0, "Expected: end of line."
   IF blkstack = 0 THEN bomb 3, "$else without $if."
   IF blktype(blkstack - 1) <> 6 THEN bomb 3, "$else without $if."
   IF blknum(blkstack - 1) THEN
    notskip = 0
   ELSE
    notskip = -1
   END IF
   blknum(blkstack - 1) = 2
  CASE "$end"
   IF i THEN bomb 0, "Expected: end of line."
   IF blkstack = 0 THEN bomb 3, "$end without $if."
   IF blktype(blkstack - 1) <> 6 THEN bomb 3, "$end without $if."
   notskip = -1
   blkstack = blkstack - 1
  CASE ELSE
   IF notskip THEN
    SELECT CASE LCASE$(w$)
    CASE "$if"
     IF i = 0 THEN bomb 0, "Expected: " + CHR$(&H22) + "."
     blktype(blkstack) = 6
     IF isexpected%(t$, i) = 0 THEN
      blknum(blkstack) = 1
      notskip = -1
     ELSE
      blknum(blkstack) = 0
      notskip = 0
     END IF
     blkstack = blkstack + 1
     IF i THEN bomb 0, "Expected: end of line."
    CASE "$include"
     IF MID$(t$, i, 2) <> MKI$(&H2220) THEN bomb 0, "Expected: " + CHR$(&H22) + "."
     i = i + 2
     n = INSTR(i, t$, CHR$(&H22))
     if$ = MID$(t$, i, n - i)
     i = n + 1
     IF n <= LEN(t$) THEN bomb 0, "Expected: end of line."
     processfile if$
    CASE "$language"
    CASE "$expected"
     IF i = 0 THEN bomb 0, "Expected: " + CHR$(&H22) + "."
     IF isexpected%(t$, i) = 0 THEN warn 4
     IF i THEN bomb 0, "Expected: end of line."
    CASE "asm"
     section txt
     DO
      IF EOF(fln) THEN bomb 4, "Still inside ASM block."
      LINE INPUT #fln, t$
      lin = lin + 1
      curlin = lin
      IF LCASE$(nextword$(t$, 1)) = "end" THEN EXIT DO
      PRINT #1, t$
     LOOP
    CASE "stack"
     IF (fln > 2) OR (curlin > 1) THEN bomb 0, "STACK can only be in the first line in the main source file."
     w$ = nextword$(t$, i)
     IF i THEN
      IF MID$(t$, i, 1) <> "," THEN bomb 0, "Expected: , or end of line."
      n = getconstword%(t$, i)
      IF i THEN bomb 0, "Expected: end of line."
     ELSE
      n = &H4000
     END IF
     IF n < &H1000 THEN warn 7
     IF (pmode = 0) AND (os = "dos") THEN
      SELECT CASE ttype
      CASE "com"
       PRINT #1, "org 0x100"
       PRINT #1, "section .stack nobits"
       PRINT #1, "stackbottom:"
       PRINT #1, "section .text"
       currentsection = txt
       PRINT #1, "mov ax,sp"
       PRINT #1, "sub ax,stackbottom"
       PRINT #1, "cmp ax,0x"; HEX$(n)
'this is used instead of cmp sp,stackbottom+n because if stackbottom+n is >
'0xffff, then cmp sp,stackbottom+n won't set the carry flag.
       PRINT #1, "jb stackerror"
       PRINT #1, "push cs"
       PRINT #1, "call _"; w$; "@0"
       PRINT #1, "xor ah,ah"
       PRINT #1, "int 0x21"
       PRINT #1, "stackerror:"
       PRINT #1, "mov ah,0x9"
       PRINT #1, "mov dx,stackmsg"
       PRINT #1, "int 0x21"
       PRINT #1, "xor ah,ah"
       PRINT #1, "int 0x21"
       PRINT #1, "stackmsg:"
       PRINT #1, "db 'Error: Insufficient stack space.',0xd,0xa,'$'"
      CASE "module"
       PRINT #1, "section .stack stack"
       PRINT #1, "stackbottom:"
       PRINT #1, "resb 0x"; HEX$(n)
       PRINT #1, "stacktop:"
       PRINT #1, "section .text"
       currentsection = txt
       PRINT #1, "..start:"
       PRINT #1, "mov ax,stack"
       PRINT #1, "mov ss,ax"
       PRINT #1, "mov sp,stacktop"
       PRINT #1, "mov ax,.data"
       PRINT #1, "mov ds,ax"
       PRINT #1, "mov es,ax"
       PRINT #1, "call far _"; w$; "@0"
       PRINT #1, "mov ah,0x4c"
       PRINT #1, "int 0x21"
      END SELECT
     END IF
    CASE "sectionalign"
     dataalign = getconstdword&(t$, i)
     PRINT #1, "section .data align=0x"; HEX$(dataalign)
     IF MID$(t$, i, 1) <> "," THEN bomb 0, "Expected: ,."
     i = i + 1
     bssalign = getconstdword&(t$, i)
     PRINT #1, "section .bss align=0x"; HEX$(bssalign)
     currentsection = bss
     IF i THEN bomb 0, "Expected: end of line."
    CASE "const"
     constname(nco) = nextword$(t$, i)
     IF nextword$(t$, i) <> "=" THEN bomb 0, "Expected: =."
     constvalue(nco) = getconstdwordseq&(t$, i, 0)
     PRINT #1, "_"; constname(nco); " equ "; 0; x; ";hex$(constvalue(nco))"
     nco = nco + 1
     IF i THEN bomb 0, "Expected: end of line."
    CASE "type"
     dt(ndt) = nextword$(t$, i)
     checkid dt(ndt)
     DO
      IF EOF(fln) THEN bomb 4, "Still inside TYPE block."
      LINE INPUT #fln, t$
      lin = lin + 1
      curlin = lin
      process t$
      i = 1
      w$ = nextword$(t$, i)
      SELECT CASE w$
      CASE "union"
       union = &H80000000 OR nel
       el(nel) = nextword$(t$, i)
       elo(nel) = dts(ndt)
       PRINT #1, "_"; dt(ndt); "."; el(nel); " equ 0x"; HEX$(elo(nel))
       IF i THEN bomb 0, "Expected: end of line."
      CASE "end"
       IF union THEN
        dts(ndt) = dts(ndt) + els(union AND &H7FFFFFFF)
        PRINT #1, "_sizeof_"; dt(ndt); "."; el(union AND &H7FFFFFFF); " equ 0x"; HEX$(els(union AND &H7FFFFFFF))
        union = 0
        IF i THEN
         IF LCASE$(nextword(t$, i)) <> "union" THEN bomb 3, "Expected: UNION or end of line."
         IF i THEN bomb 0, "Expected: end of line."
        END IF
       ELSE
        IF i THEN
         IF LCASE$(nextword(t$, i)) <> "type" THEN bomb 3, "Expected: TYPE or end of line."
         IF i THEN bomb 0, "Expected: end of line."
        END IF
        EXIT DO
       END IF
      CASE ELSE
       dte(ndt) = dte(ndt) + MKI$(nel)
       el(nel) = w$
       checkid w$
       elo(nel) = dts(ndt)
       IF LCASE$(nextword(t$, i)) <> "as" THEN bomb 0, "Expected: AS."
       w$ = nextword(t$, i)
       FOR n = 1 TO 5
        'standard types are not case sensitive
        IF LCASE$(w$) = dt(n) THEN eld(nel) = n: EXIT FOR
       NEXT n
       IF eld(nel) = 0 THEN
        FOR n = 6 TO ndt - 1
         'udts are case sensitive
         IF w$ = dt(n) THEN eld(nel) = n: EXIT FOR
        NEXT n
        IF eld(nel) = 0 THEN bomb 2, "Failed to find the specified type."
        els(nel) = dts(eld(nel))
       ELSE
        IF i THEN
         IF nextword$(t$, i) <> "*" THEN bomb 0, "Expected: * or end of line."
         els(nel) = dts(eld(nel)) * getconstdword&(t$, i)
        END IF
       END IF
       PRINT #1, "_"; dt(ndt); "."; el(nel); " equ 0x"; HEX$(elo(nel))
       PRINT #1, "_sizeof_"; dt(ndt); "."; el(nel); " equ 0x"; HEX$(els(nel))
       IF union THEN
        IF els(nel) > els(union AND &H7FFFFFFF) THEN els(union AND &H7FFFFFFF) = els(nel)
       ELSE
        dts(ndt) = dts(ndt) + els(nel)
       END IF
       nel = nel + 1
       IF i THEN bomb 0, "Expected: end of line."
      END SELECT
     LOOP
     ndt = ndt + 1
    CASE "dim"
     m = 0
     IF blkstack THEN
      FOR n = 0 TO blkstack - 1
       IF blktype(n) = 0 THEN vaf(nva) = blknum(n): EXIT FOR
      NEXT
     END IF
     w$ = nextword$(t$, i)
     SELECT CASE LCASE$(w$)
     CASE "global"
      IF vaf(nva) THEN bomb 0, "GLOBAL not allowed inside function block."
      m = 1
      w$ = nextword$(t$, i)
     CASE "extern"
      IF vaf(nva) THEN bomb 0, "EXTERN not allowed inside function block."
      m = 2
      w$ = nextword$(t$, i)
     END SELECT
     SELECT CASE LCASE$(w$)
     CASE "rowmaj"
      m = m OR 4
      w$ = nextword$(t$, i)
     CASE "colmaj"
      m = m OR 8
      w$ = nextword$(t$, i)
     END SELECT
     checkid w$
     va(nva) = w$
     IF MID$(t$, i, 1) = "(" THEN
      i = i + 1
      s = 0
      vadi(nva) = &H8000 OR nar
      DO
       n = getconstdword&(t$, i)
       s = s * (n + 1)
       adi(nar) = adi(nar) + MKL$(n)
       SELECT CASE MID$(t$, i, 1)
       CASE ",": i = i + 1
       CASE ")": i = i + 1: EXIT DO
       CASE ELSE: bomb 0, "Expected: , or )."
       END SELECT
      LOOP
      IF LEN(adi(nar)) > 4 THEN
       IF (m AND &HC) = 0 THEN warn 1
       IF m AND &H8 THEN vadi(nva) = &HC000 OR nar
      ELSE
       IF m AND &HC THEN bomb 0, "ROWMAJ or COLMAJ is specified, but array has only 1 dimension."
      END IF
     END IF
     IF LCASE$(nextword(t$, i)) <> "as" THEN bomb 0, "Expected: AS."
     w$ = nextword(t$, i)
     FOR n = 1 TO 5
      'standard types are not case sensitive
      IF LCASE$(w$) = dt(n) THEN vadt(nva) = n: EXIT FOR
     NEXT n
     f = 1
     IF vadt(nva) = 0 THEN
      FOR n = 6 TO ndt - 1
       'udts are case sensitive
       IF w$ = dt(n) THEN vadt(nva) = n: EXIT FOR
      NEXT n
      IF vadt(nva) = 0 THEN bomb 2, "Failed to find the specified type."
     ELSE
      IF i THEN
       IF nextword$(t$, i) <> "*" THEN bomb 0, "Expected: * or end of line."
       f = getconstdword&(t$, i)
      END IF
     END IF
     IF vadi(nva) AND &H8000 THEN
      aes(nar) = dts(vadt(nva)) * f
      vas(nva) = aes(nar) * s
     ELSE
      vas(nva) = dts(vadt(nva)) * f
     END IF
     a = 1
     init = 0
     IF i THEN
      IF m AND 2 THEN bomb 0, "Expected: end of line."
      w$ = nextword$(t$, i)
      SELECT CASE LCASE$(w$)
      CASE "align"
       a = getconstdword&(t$, i)
       IF i THEN
        w$ = nextword$(t$, i)
       ELSE
        w$ = ""
       END IF
      CASE "="
      CASE ELSE
       IF vaf(nva) THEN
        bomb 0, "Expected: ALIGN or end of line."
       ELSE
        bomb 0, "Expected: ALIGN or = or end of line."
       END IF
      END SELECT
      SELECT CASE LCASE$(w$)
      CASE "="
       SELECT CASE vas(nva)
       CASE 1: t$ = getconstbyteseq$(t$, i, -1)
       CASE 2: t$ = MKI$(getconstwordseq%(t$, i, -1))
       CASE 4: t$ = MKL$(getconstdwordseq&(t$, i, -1))
       CASE 8: t$ = getconstqwordseq$(t$, i, -1)
       CASE 10: t$ = getconsttwordseq$(t$, i, -1)
       CASE ELSE
        t$ = getsequence$(t$, i)
        SELECT CASE LEN(t$)
        CASE IS < vas(nva): warn 6
        CASE IS > vas(nva): bomb 7, "Initiallization value is too big."
        END SELECT
       END SELECT
       init = -1
      CASE ""
      CASE ELSE
       IF vaf(nva) THEN
        bomb 0, "Expected: end of line."
       ELSE
        bomb 0, "Expected: = or end of line."
       END IF
      END SELECT
     END IF
     SELECT CASE a
     CASE 1, 2, 4, 8, 16
     CASE ELSE: bomb 0, "Invalid alignment."
     END SELECT
     SELECT CASE m AND 3
     CASE 1: PRINT #1, "global _"; va(nva)
     CASE 2: PRINT #1, "extern _"; va(nva)
     END SELECT
     IF vaf(nva) THEN
      IF a > constvalue(0) THEN warn 5
      s = funv(vaf(nva) AND &H7FFF)
      s = s + vas(nva)
      s = s + (a - (s MOD a))
      PRINT #1, "_"; fu(vaf(nva) AND &H7FFF); "_"; va(nva); " equ 0x"; HEX$(s + 1)
      funv(vaf(nva) AND &H7FFF) = s
      PRINT #1, "_sizeof_"; fu(vaf(nva) AND &H7FFF); "_"; va(nva); " equ 0x"; HEX$(vas(nva))
      IF vadi(nva) THEN PRINT #1, "_elementsizeof_"; fu(vaf(nva) AND &H7FFF); "_"; va(nva); " equ 0x"; HEX$(aes(nar))
     ELSE
      IF init THEN
       IF a > dataalign THEN warn 0
       section dat
       IF a > 1 THEN PRINT #1, "align 0x"; HEX$(a)
       PRINT #1, "_"; va(nva); ":"
       IF LEN(t$) >= 4 THEN
        PRINT #1, "dd ";
        DO WHILE LEN(t$) >= 4
         PRINT #1, "0x"; HEX$(CVL(LEFT$(t$, 4)))
         t$ = MID$(t$, 5)
         IF LEN(t$) >= 4 THEN PRINT #1, ",";
        LOOP
        PRINT #1, ""
       END IF
       IF LEN(t$) >= 2 THEN
        PRINT #1, "dw ";
        DO WHILE LEN(t$) >= 2
         PRINT #1, "0x"; HEX$(CVI(LEFT$(t$, 2)))
         t$ = MID$(t$, 3)
         IF LEN(t$) >= 2 THEN PRINT #1, ",";
        LOOP
        PRINT #1, ""
       END IF
       IF LEN(t$) THEN
        PRINT #1, "db ";
        DO WHILE LEN(t$)
         PRINT #1, "0x"; HEX$(ASC(LEFT$(t$, 1)))
         t$ = MID$(t$, 2)
         IF LEN(t$) THEN PRINT #1, ",";
        LOOP
        PRINT #1, ""
       END IF
      ELSE
       IF (m AND 2) = 0 THEN
        IF a > bssalign THEN warn 0
        section bss
        IF a > 1 THEN PRINT #1, "alignb 0x"; HEX$(a)
        PRINT #1, "_"; va(nva); ":"
        PRINT #1, "resb 0x"; HEX$(vas(nva))
       END IF
      END IF
      PRINT #1, "_sizeof_"; va(nva); " equ 0x"; HEX$(vas(nva))
      IF vadi(nva) THEN PRINT #1, "_elementsizeof_"; va(nva); " equ 0x"; HEX$(aes(nar))
     END IF
     IF vadi(nva) THEN nar = nar + 1
     nva = nva + 1
    CASE "end"
     SELECT CASE blktype(blkstack)
     END SELECT
    CASE ELSE
    END SELECT
   END IF
  END SELECT
 LOOP
 CLOSE fln
 PRINT
 PRINT "Done processing file: "; f$
END SUB

FUNCTION readbyte$ (t$)
'reads a decimal or hex integer byte.
 verifyint t$
 IF LEFT$(t$, 2) = "0x" THEN
  IF LEN(t$) > 4 THEN bomb 7, "Expected: WORD constant literal."
  readbyte$ = CHR$(VAL("&h" + MID$(t$, 3)))
 ELSE
  n& = VAL(t$)
  IF (n& < &H0) OR (n& > &HFF) THEN bomb 7, "Expected: WORD constant literal."
  readbyte$ = CHR$(VAL(t$))
 END IF
END FUNCTION

FUNCTION readdword& (t$)
'reads a decimal or hex integer dword.
 verifyint t$
 IF LEFT$(t$, 2) = "0x" THEN
  readdword& = VAL("&h" + MID$(t$, 3))
 ELSE
  readdword& = VAL(t$)
 END IF
END FUNCTION

FUNCTION readword% (t$)
'reads a decimal or hex integer word.
 verifyint t$
 IF LEFT$(t$, 2) = "0x" THEN
  IF LEN(t$) > 6 THEN bomb 7, "Expected: WORD constant literal."
  readword% = VAL("&h" + MID$(t$, 3))
 ELSE
  n& = VAL(t$)
  IF (n& < &H8000) OR (n& > &H7FFF) THEN bomb 7, "Expected: WORD constant literal."
  readword% = VAL(t$)
 END IF
END FUNCTION

SUB section (n AS INTEGER)
 IF n <> currentsection THEN
  SELECT CASE n
  CASE txt: PRINT #1, "section .text"
  CASE dat: PRINT #1, "section .data"
  CASE bss: PRINT #1, "section .bss"
  END SELECT
  currentsection = n
 END IF
END SUB

SUB verifyint (t$)
 IF LEFT$(t$, 2) = "0x" THEN
  FOR i = 3 TO LEN(t$)
   SELECT CASE ASC(LCASE$(MID$(t$, i, 1)))
   CASE &H30 TO &H39, &H61 TO &H66
   CASE ELSE: bomb 0, "Constant literal hex integer contains invalid characters."
   END SELECT
  NEXT i
 ELSE
  FOR i = 1 TO LEN(t$)
   SELECT CASE ASC(MID$(t$, i, 1))
   CASE &H30 TO &H39
   CASE ELSE: bomb 0, "Constant literal dec integer contains invalid characters."
   END SELECT
  NEXT i
 END IF
END SUB

SUB warn (n AS INTEGER)
 PRINT
 IF n THEN
  PRINT "Warning in "; CHR$(&H22); curfil; CHR$(&H22); ", line"; curlin
 ELSE
  PRINT "Warning"
 END IF
 SELECT CASE n
 CASE 0: PRINT "Variable alignment excedes section alignment."
 CASE 1: PRINT "Multidimension array style not specified. Assuming ROWMAJ."
 CASE 2: PRINT "Calling convention not specified. Assuming STDCALL."
 CASE 3: PRINT "Language version mismatch."
 CASE 4: PRINT "Unexpected target."
 CASE 5: PRINT "Local variable alignment excedes stack alignment."
 CASE 6: PRINT "Initiallization value is too small. Zero extending."
 CASE 7: PRINT "Stack size is less than 0x1000 bytes."
 CASE 8: PRINT "Unknown mode."
 CASE 9: PRINT "Unused information is being supplied."
 END SELECT
END SUB

 
 Respond to this message   
 
  << Previous TopicReturn to Index  
 Copyright © 1999-2017 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums