├── .ci └── windows │ ├── build.sh │ └── package.sh ├── .github └── workflows │ └── release.yml ├── .gitignore ├── LICENSE ├── README.md ├── build.sh ├── compiler ├── Makefile ├── ast.bi ├── ast.bm ├── cmdflags.bi ├── debugging_options.bm ├── dependency.bi ├── dependency.bm ├── emitters │ ├── dump │ │ └── dump.bm │ └── llvm │ │ ├── array.bm │ │ ├── assign.bm │ │ ├── builtins.bm │ │ ├── calls.bm │ │ ├── cast.bm │ │ ├── for.bm │ │ ├── if.bm │ │ ├── llvm.bi │ │ ├── llvm.bm │ │ ├── llvm.ffi │ │ ├── llvm_bindings.bm │ │ ├── loop.bm │ │ ├── proc.bm │ │ ├── stmt_expr.bm │ │ ├── string.bm │ │ ├── tempfile.bm │ │ ├── types.bm │ │ └── vars.bm ├── lbasic.bas ├── parser │ ├── array.bm │ ├── assignment.bm │ ├── common.bm │ ├── const.bm │ ├── default_type.bm │ ├── drawing.bm │ ├── exit.bm │ ├── for.bm │ ├── function.bm │ ├── goto.bm │ ├── if.bm │ ├── input.bm │ ├── labels.bm │ ├── loop.bm │ ├── metacommands.bm │ ├── option.bm │ ├── parser.bi │ ├── parser.bm │ ├── pratt.bm │ ├── preload.bm │ ├── print.bm │ ├── putimage.bm │ ├── select.bm │ ├── statement.bm │ ├── tokeng.bi │ ├── tokeng.bm │ ├── tokens.list │ ├── ts.rules │ ├── udt.bm │ ├── userfuncs.bm │ └── var.bm ├── spawn.bm ├── symtab.bi ├── symtab.bm ├── type.bi └── type.bm ├── doc ├── immediate.md ├── obj-ownership.txt └── typespec.md ├── runtime ├── core │ ├── Makefile │ └── string.bm └── foundation │ ├── Makefile │ ├── array.c │ ├── array.h │ ├── env.c │ ├── error.c │ ├── error.h │ ├── lbasic.h │ ├── main.c │ ├── minmax.h │ ├── names.h │ ├── print.c │ ├── str.c │ ├── string.c │ ├── string.h │ └── types.h ├── tests ├── array.test ├── assignment.test ├── const.test ├── for.test ├── if.test ├── loops.test ├── memory.test ├── print.test ├── string.test ├── test.test ├── udt.test └── variables.test └── tools ├── Makefile ├── ffigen.bas ├── incmerge.bas ├── prep.py ├── test.bas ├── tokgen.bas └── tsgen.bas /.ci/windows/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -ex 3 | 4 | QB64_URL='https://github.com/QB64-Phoenix-Edition/QB64pe/releases/download/v3.4.1/qb64pe_win-x64-3.4.1.7z' 5 | QB64_SHA256=41ba1d4da734c2c2ac309d923b48a9ccf3afbf936b1d23a3be9a885840a7f95d 6 | LLVM_MINGW_URL='https://github.com/mstorsjo/llvm-mingw/releases/download/20220323/llvm-mingw-20220323-ucrt-x86_64.zip' 7 | LLVM_MINGW_SHA256=3014a95e4ec4d5c9d31f52fbd6ff43174a0d9c422c663de7f7be8c2fcc9d837a 8 | 9 | wget --no-verbose "${QB64_URL}" -O qb64.7z 10 | wget --no-verbose "${LLVM_MINGW_URL}" -O llvm_mingw.zip 11 | 12 | sha256sum --check << EOT 13 | ${QB64_SHA256} qb64.7z 14 | ${LLVM_MINGW_SHA256} llvm_mingw.zip 15 | EOT 16 | 17 | mkdir out 18 | 19 | # Expected to extract directory 'qb64pe' 20 | 7z x qb64.7z 21 | 22 | unzip -q llvm_mingw.zip 23 | mv llvm-mingw-* llvm 24 | # This somewhat ugly copy is needed so the same relative path can be used to refer 25 | # to the llvm install from the pov of the build scripts _and_ the lbasic binary. 26 | # It would be better if the two could be configured separately. 27 | cp -r llvm out/llvm 28 | 29 | export QB64="$(pwd)/qb64pe/qb64pe.exe" 30 | export LLVM_INSTALL="llvm" 31 | export PYTHON="$(pwd)/${LLVM_INSTALL}/python/bin/python3.exe" 32 | 33 | ./build.sh 34 | -------------------------------------------------------------------------------- /.ci/windows/package.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -x 3 | 4 | UNUSED_ARCHES="aarch64-w64-mingw32 armv7-w64-mingw32 i686-w64-mingw32" 5 | 6 | for arch in $UNUSED_ARCHES; do 7 | rm -r "out/llvm/${arch}" 8 | done 9 | rm -r out/llvm/{include,python,lib/libear,lib/libscanbuild} out/{lbasic.bas,llvm.h} 10 | 11 | version=$GITHUB_REF_NAME 12 | 13 | mv out "lbasic-${version}" 14 | mkdir release 15 | 7z a "release/lbasic-${version}-windows-x86_64.7z" "lbasic-${version}" 16 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release 2 | on: 3 | push: 4 | tags: 5 | - 'v*.*.*' 6 | 7 | jobs: 8 | windows10-mingw-x86_64: 9 | name: Windows 10, MinGW x86_64 10 | runs-on: windows-2022 11 | defaults: 12 | run: 13 | shell: msys2 {0} 14 | steps: 15 | - uses: actions/checkout@v3 16 | - uses: msys2/setup-msys2@v2 17 | with: 18 | msystem: UCRT64 19 | install: git make p7zip unzip 20 | - name: Build 21 | run: .ci/windows/build.sh 22 | - name: Package 23 | run: .ci/windows/package.sh 24 | - name: Release 25 | uses: softprops/action-gh-release@v1 26 | with: 27 | files: release/lbasic-* 28 | fail_on_unmatched_files: true 29 | 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /*.bas 2 | /out 3 | *.exe 4 | *.o 5 | *.a 6 | *.bh 7 | LBINDEX 8 | compiler/parser/token_data.bi 9 | compiler/parser/token_registrations.bm 10 | compiler/parser/ts_data.bi 11 | compiler/parser/ts_data.bm 12 | compiler/emitters/llvm/llvm_bindings.bi 13 | /tools/*.tool 14 | *.swp 15 | *.testresult 16 | /llvm 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The L-BASIC programming language 2 | ====================== 3 | 4 | As you may imagine, this is a BASIC compiler. The language variant is reasonably close to QB64 but we're willing to break compatibility with programs from 1985 when needed. 5 | 6 | ## Building 7 | Building L-BASIC is more complex than a regular QB64 program, particularly because of the need to link against LLVM. Also, **neither the L-BASIC source tree or any prerequisites can be installed in a path containing spaces** - this is a limitation of `make`. L-BASIC itself can handle paths with spaces though. 8 | 9 | ### Windows 10 | Install prerequisites: 11 | - QB64 (Phoenix edition), version 3.4.1: https://github.com/QB64-Phoenix-Edition/QB64pe/releases/download/v3.4.1/qb64pe_win-x64-3.4.1.7z [SHA-256: 41ba1d4da734c2c2ac309d923b48a9ccf3afbf936b1d23a3be9a885840a7f95d] 12 | - MSYS2: https://www.msys2.org/ 13 | - LLVM-mingw (ucrt edition), version 20220323/14.0.0: https://github.com/mstorsjo/llvm-mingw/releases/download/20220323/llvm-mingw-20220323-ucrt-x86_64.zip [SHA-256: 3014a95e4ec4d5c9d31f52fbd6ff43174a0d9c422c663de7f7be8c2fcc9d837a] 14 | 15 | Inside an MSYS environment: 16 | - Install git and make: `pacman -S git make` 17 | - Extract LLVM-mingw to `~` 18 | - Extract QB64 to to `~` 19 | - Configure environment: 20 | ``` 21 | export QB64=~/qb64pe/qb64pe.exe 22 | export LLVM_INSTALL=~/llvm-mingw-20220323-ucrt-x86_64 23 | export PYTHON=$LLVM_INSTALL/python/bin/python3.exe 24 | ``` 25 | - Build: `./build.sh` 26 | 27 | The output binary is `out/lbasic.exe`. To compile a program: 28 | ``` 29 | ./out/lbasic.exe -t hello.bas 30 | ./hello.exe 31 | ``` 32 | 33 | ### Linux 34 | Install prerequisites: 35 | - QB64 (Phoenix edition), version 3.13.1: https://github.com/QB64-Phoenix-Edition/QB64pe/releases/download/v3.13.1/qb64pe_lnx-3.13.1.tar.gz [SHA-256: 78d86be389d6a2bb963cf0c822a950d297cc13dfa7b41d8917c924cd9bc47f38] 36 | - clang, version 14. On apt based systems: `sudo apt install clang-14`. If your distro doesn't have that version, the LLVM project provides a custom repository: https://apt.llvm.org/ 37 | - Configure environment: 38 | ``` 39 | export QB64=~/qb64pe/qb64pe 40 | ``` 41 | - Build: `./build.sh` 42 | 43 | The output binary is `out/lbasic`. To compile a program: 44 | ``` 45 | ./out/lbasic -t hello.bas 46 | ./hello 47 | ``` 48 | 49 | ### Build options 50 | These may be set as environment variables before running build.sh: 51 | - `QB64`: Path to QB64 compiler program 52 | - `QBFLAGS`: QB64 compilation flags to use 53 | - `OUT_DIR`: Directory to place final output binaries 54 | - `LBASIC_CORE_COMPILER`: L-BASIC compiler used to build internal libraries. Defaults to the just-built lbasic in OUT_DIR. 55 | - `TOOLS_DIR`: Location of the tools source directory 56 | - `LLVM_INSTALL`: Directory containing the bin and lib folder for the LLVM installation. If empty or set to `system`, expect programs to be on the PATH. 57 | - `CC`: C compiler used to build foundation library 58 | - `AR`: Archiver used to build internal libraries 59 | - `CFLAGS`: C compiler flags used to build foundation library 60 | - `PYTHON`: Path to python program used to run python build steps 61 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # SPDX-License-Identifier: Apache-2.0 3 | # Main build script 4 | set -e 5 | 6 | # Defaults 7 | : "${QB64:=qb64}" 8 | : "${QBFLAGS:="-w -q"}" 9 | : "${OUT_DIR:=out}" 10 | OUT_DIR=$(realpath "${OUT_DIR}") 11 | : "${LBASIC_CORE_COMPILER:=${OUT_DIR}/lbasic}" 12 | TOOLS_DIR=$(realpath tools) 13 | : "${LLVM_INSTALL:=system}" 14 | CFLAGS="-O2 -Wall -std=c17 ${CFLAGS}" 15 | : "${PYTHON:=python3}" 16 | 17 | llvm_ver=14 18 | case $(uname) in 19 | MINGW*) 20 | if [[ ${LLVM_INSTALL} = "system" ]]; then 21 | LLVM_LIB=libLLVM-${llvm_ver}.dll 22 | : "${CC:=clang.exe}" 23 | : "${AR:=ar.exe}" 24 | else 25 | LLVM_LIB="$(cygpath -m "${LLVM_INSTALL}/bin/libunwind.dll") $(cygpath -m "${LLVM_INSTALL}/bin/libc++.dll") $(cygpath -m "${LLVM_INSTALL}/bin/libLLVM-${llvm_ver}.dll")" 26 | : "${CC:=$(realpath "${LLVM_INSTALL}/bin/clang.exe")}" 27 | : "${AR:=$(realpath "${LLVM_INSTALL}/bin/ar.exe")}" 28 | fi 29 | ;; 30 | Linux) 31 | if [[ ${LLVM_INSTALL} = "system" ]]; then 32 | LLVM_LIB=libLLVM-${llvm_ver}.so 33 | : "${CC:=clang}" 34 | : "${AR:=ar}" 35 | else 36 | LLVM_LIB=${LLVM_INSTALL}/lib/libLLVM-${llvm_ver}.so 37 | : "${CC:=$(realpath "${LLVM_INSTALL}/bin/clang")}" 38 | : "${AR:=$(realpath "${LLVM_INSTALL}/bin/ar")}" 39 | fi 40 | ;; 41 | *) 42 | echo "Unknown system '$(uname)'" 43 | exit 1 44 | ;; 45 | esac 46 | 47 | # Subdirectories to build 48 | components="tools compiler runtime/foundation runtime/core" 49 | 50 | # Try determine a version 51 | if [[ $GITHUB_REF_TYPE = "tag" ]]; then 52 | VERSION=$GITHUB_REF_NAME 53 | elif [[ $CI != "true" ]]; then 54 | VERSION=$(git describe --tags) 55 | else 56 | VERSION=$(git rev-parse HEAD | head -c9) 57 | fi 58 | 59 | export QB64 QBFLAGS OUT_DIR TOOLS_DIR LBASIC_CORE_COMPILER LLVM_INSTALL LLVM_LIB CC AR CFLAGS PYTHON VERSION 60 | echo "QB64=${QB64}" 61 | echo "QBFLAGS=${QBFLAGS}" 62 | echo "OUT_DIR=${OUT_DIR}" 63 | echo "TOOLS_DIR=${TOOLS_DIR}" 64 | echo "LBASIC_CORE_COMPILER=${LBASIC_CORE_COMPILER}" 65 | echo "LLVM_INSTALL=${LLVM_INSTALL}" 66 | echo "LLVM_LIB=${LLVM_LIB}" 67 | echo "CC=${CC}" 68 | echo "AR=${AR}" 69 | echo "CFLAGS=${CFLAGS}" 70 | echo "PYTHON=${PYTHON}" 71 | echo "VERSION=${VERSION}" 72 | 73 | if [[ $1 = clean ]]; then 74 | set +e 75 | rm -r "${OUT_DIR}" 76 | for component in $components; do 77 | make -C "${component}" clean 78 | done 79 | exit 0 80 | fi 81 | 82 | if ! command -v "$QB64" > /dev/null; then 83 | echo Cannot locate QB64, either modify PATH or set the QB64 environment variable to point to the qb64 binary. 84 | exit 1 85 | fi 86 | 87 | mkdir -p "${OUT_DIR}/runtime" 88 | 89 | for component in $components; do 90 | make -C "${component}" 91 | done 92 | -------------------------------------------------------------------------------- /compiler/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright Luke Ceddia 2 | # SPDX-License-Identifier: Apache-2.0 3 | # Makefile for compiler binary 4 | 5 | OUTPUT_BINARY := $(OUT_DIR)/lbasic 6 | OUTPUT_SOURCE := $(OUT_DIR)/lbasic.bas 7 | 8 | .PHONY: all 9 | all: $(OUTPUT_BINARY) 10 | 11 | TS_FILES := parser/ts_data.bi parser/ts_data.bm 12 | TOKEN_FILES := parser/token_data.bi parser/token_registrations.bm 13 | LLVM_BINDING_FILES := emitters/llvm/llvm_bindings.bi $(OUT_DIR)/llvm.h 14 | 15 | $(TS_FILES): parser/ts.rules $(TOOLS_DIR)/tsgen.tool 16 | $(TOOLS_DIR)/tsgen.tool parser/ts.rules $(TS_FILES) 17 | 18 | $(TOKEN_FILES): parser/tokens.list $(TOOLS_DIR)/tokgen.tool 19 | $(TOOLS_DIR)/tokgen.tool parser/tokens.list $(TOKEN_FILES) 20 | 21 | $(LLVM_BINDING_FILES): emitters/llvm/llvm.ffi $(TOOLS_DIR)/ffigen.tool 22 | $(TOOLS_DIR)/ffigen.tool $< $(LLVM_BINDING_FILES) 23 | 24 | $(OUTPUT_SOURCE): lbasic.bas \ 25 | $(TS_FILES) $(TOKEN_FILES) \ 26 | $(LLVM_BINDING_FILES) \ 27 | $(TOOLS_DIR)/incmerge.tool $(TOOLS_DIR)/prep.py \ 28 | $(shell find . -type f -name '*.bm' -o -name '*.bi') 29 | $(eval temp := $(shell mktemp)) 30 | $(TOOLS_DIR)/incmerge.tool lbasic.bas $(temp) 31 | $(PYTHON) $(TOOLS_DIR)/prep.py -D '@LLVM_INSTALL@|"$(LLVM_INSTALL)"' -D '@VERSION@|"$(VERSION)"' $(temp) $@ 32 | rm $(temp) 33 | 34 | $(OUTPUT_BINARY): $(OUTPUT_SOURCE) 35 | $(QB64) $(QBFLAGS) -x $< -o $@ 36 | 37 | .PHONY: clean 38 | clean: 39 | rm -r $(TS_FILES) $(TOKEN_FILES) 2> /dev/null || true 40 | rm $(LLVM_BINDING_FILES) 2> /dev/null || true 41 | -------------------------------------------------------------------------------- /compiler/ast.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'ast.bi - Declarations for Abstract Syntax Tree 4 | 5 | 'This is a tree structure in a convoluted way 6 | 'The node definition 7 | type ast_node_t 8 | parent as long 9 | typ as long 10 | ref as long 11 | ref2 as long 12 | linenum as long 'File line this node started to appear 13 | end type 14 | 15 | 'The nodes themselves 16 | dim shared ast_nodes(0) as ast_node_t 17 | 'The children of a given node as a mkl$-encoded string 18 | dim shared ast_children(0) as string 19 | 'The id of the last node registered 20 | dim shared ast_last_node as long 21 | 22 | 'User-created procedures, including the main program 23 | dim shared ast_procedures(1) as long 24 | dim shared ast_last_procedure as long 25 | 26 | 'Every number and string appearing in the program gets an entry here 27 | dim shared ast_constants(0) as string 28 | dim shared ast_constant_types(0) as long 29 | dim shared ast_last_constant as long 30 | 'The ast optionally supports transactions; calling ast_rollback will 31 | 'remove all items added since the last call to ast_commit. 32 | 'WARNING: transaction rollbacks only undo adding nodes. Node changes 33 | 'are always immediately permanent. 34 | dim shared ast_last_commit_id 35 | dim shared ast_last_constant_commit_id 36 | 37 | 'Accessor macros 38 | $macro: @@->parent | ast_nodes(@1).parent 39 | $macro: @@->atype | ast_nodes(@1).typ 40 | $macro: @@->ref | ast_nodes(@1).ref 41 | $macro: @@->ref2 | ast_nodes(@1).ref2 42 | $macro: @@->linenum | ast_nodes(@1).linenum 43 | $macro: @@->cast(@@) | ast_add_cast(@1, @2) 44 | $macro: @@->attach(@@) | ast_attach @1, @2 45 | $macro: @@->pre_attach(@@) | ast_pre_attach @1, @2 46 | $macro: @@->attach_none | ast_attach @1, ast_add_node(AST_NONE) 47 | 48 | const AST_FALSE = 1 49 | const AST_TRUE = 2 50 | const AST_ONE = 3 51 | const AST_NEWLINE_STRING = 4 52 | const AST_TAB_STRING = 5 53 | const AST_EMPTY_STRING = 6 54 | 55 | 'The types of node. 56 | 'Note: an "expression"/"expr" is a CALL, CONSTANT, CAST, SELECT_VALUE, any of the lvalue 57 | 'types or NONE (if allowed). 58 | 59 | 'Every SUB and FUNCTION is rooted in an AST_PROCEDURE. 60 | 'First child is AST_BLOCK. Remaining children are AST_VAR for formal parameters, left to 61 | 'right. ref is the symtab entry for the function name, ref2 is the type signature. 62 | const AST_PROCEDURE = 1 63 | 'group of statements 64 | const AST_BLOCK = 2 65 | 'assign lvalue expr => lvalue = expr 66 | const AST_ASSIGN = 3 67 | 'if expr1 block1 [expr2 block2 ...] [block-n] => IF expr1 THEN block1 ELSEIF expr2 THEN 68 | 'block2 ... ELSE block-n 69 | const AST_IF = 4 70 | 'while expr block => WHILE expr: block: WEND 71 | 'Can't be an AST_DO_PRE because of EXIT 72 | const AST_WHILE = 5 73 | 'do expr block => DO WHILE expr: block: LOOP 74 | const AST_DO_PRE = 6 75 | 'do expr block => DO: block: LOOP WHILE expr 76 | const AST_DO_POST = 7 77 | 'for lvalue expr1 expr2 expr3 block => FOR lvalue = expr1 TO expr2 STEP expr3 78 | const AST_FOR = 8 79 | 'select expr [AST_SELECT_LIST]* AST_SELECT_ELSE? => SELECT CASE expr CASE AST_SELECT_LIST... AST_SELECT_ELSE 80 | const AST_SELECT = 9 81 | 'Children are AST_SELECT_IS or AST_SELECT_RANGE. Last child is block. 82 | const AST_SELECT_LIST = 10 83 | 'ref is comparison function, ref2 is type sig. First child is AST_SELECT_VALUE, second 84 | 'child is expr to compare against (second argument to function). Note that this is 85 | 'the same format as AST_CALL. 86 | const AST_SELECT_IS = 11 87 | 'ref is comparison function, ref2 is type sig. Left & right bounding expr are first and 88 | 'second children respectively. 89 | const AST_SELECT_RANGE = 12 90 | 'First child is block 91 | const AST_SELECT_ELSE = 13 92 | 'When evaluated, returns the base expression value of the inner-most SELECT CASE. ref is 93 | 'the type of the expression. 94 | const AST_SELECT_VALUE = 14 95 | 'call param* => A function call to ref with type signature ref2 and parameters as children 96 | const AST_CALL = 15 97 | 'ref is a reference to an entry in the constants table 98 | const AST_CONSTANT = 16 99 | 'Casts are first-class AST elements instead of just CALLs to a cast function. ref is a 100 | 'type, child is a CALL, CONSTANT or VAR. 101 | const AST_CAST = 17 102 | 'Used to pass extra data to some functions that have behaviour set by syntax (e.g. INPUT, LINE). 103 | 'ref is one of AST_FLAG_* defined below. ref2 is the corresponding value. 104 | const AST_FLAGS = 18 105 | 'If the goto is resolved, ref is the node to jump to. If unresolved, the label symtab. A 106 | 'fully-parsed program will have no unresolved labels. 107 | const AST_GOTO = 19 108 | 'Used for empty optional arguments to functions 109 | const AST_NONE = 20 110 | 'The EXIT statement. ref is the loop statement or function we're exiting. 111 | const AST_EXIT = 21 112 | 113 | 'These nodes may appear where-ever an lvalue is required 114 | 'ref is reference to symtab 115 | const AST_VAR = 22 116 | 'Access to a UDT element. First child is the lvalue we're accessing an element of, ref is 117 | 'the UDT element symbol. 118 | const AST_UDT_ACCESS = 23 119 | 'Access to an array element. First child is the lvalue to be indexed. Second child is 120 | 'expression for the index in leftmost dimension, then so on for other dimensions. 121 | const AST_ARRAY_ACCESS = 24 122 | 123 | 'Emitted by DIM statements to initialise an array. First child is lvalue to be 124 | 'initialised, then each pair of children after are expr for the lower and upper 125 | 'bound of each dimension. The array is zeroed out. 126 | const AST_ARRAY_CREATE = 25 127 | 'Like above, but preserve the contents of the array if any. 128 | const AST_ARRAY_RESIZE = 26 129 | 'Free an array's heap allocation, effectively a destructor. First child is an lvalue. 130 | const AST_ARRAY_DELETE = 27 131 | 'Like _CREATE, with the exception that the array is not touched if memory is already 132 | 'allocated. Added to support STATIC arrays. 133 | const AST_ARRAY_ESTABLISH = 28 134 | 'Try to claim ownership of an array. If unowned, the owner becomes the current scope. 135 | 'If already owned, does nothing. 136 | const AST_ARRAY_CLAIM = 29 137 | 138 | 'Sets the return value of the current function. first child is expr to return, ref 139 | 'is the return type. 140 | const AST_SET_RETURN = 30 141 | 142 | 'Flag is a value defined in cmdflags.bi. 143 | const AST_FLAG_MANUAL = 1 144 | 'Flag is a contextual argument and value is the index into the list of alternates. 145 | const AST_FLAG_CONTEXTUAL = 2 146 | 'Flag is a token. 147 | const AST_FLAG_TOKEN = 3 148 | -------------------------------------------------------------------------------- /compiler/ast.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'ast.bm - Routines for Abstract Syntax Tree 4 | 5 | deflng a-z 6 | 7 | ' Initialise a clean AST 8 | sub ast_init 9 | redim ast_nodes(10) as ast_node_t 10 | redim ast_children(10) as string 11 | ast_last_node = 0 12 | redim ast_constants(10) as string 13 | redim ast_constant_types(10) as long 14 | ast_constants(AST_FALSE) = "0" 15 | ast_constant_types(AST_FALSE) = TYPE_INTEGER 16 | ast_constants(AST_TRUE) = "-1" 17 | ast_constant_types(AST_TRUE) = TYPE_INTEGER 18 | ast_constants(AST_ONE) = "1" 19 | ast_constant_types(AST_ONE) = TYPE_INTEGER 20 | ast_constants(AST_NEWLINE_STRING) = chr$(10) 21 | ast_constant_types(AST_NEWLINE_STRING) = TYPE_STRING 22 | ast_constants(AST_TAB_STRING) = chr$(9) 23 | ast_constant_types(AST_TAB_STRING) = TYPE_STRING 24 | ast_constants(AST_EMPTY_STRING) = "" 25 | ast_constant_types(AST_EMPTY_STRING) = TYPE_STRING 26 | ast_last_constant = 6 27 | ast_commit 28 | end sub 29 | 30 | sub ast_commit 31 | ast_last_commit_id = ast_last_node 32 | ast_last_constant_commit_id = ast_last_constant 33 | end sub 34 | 35 | sub ast_rollback 36 | for i = ast_last_commit_id + 1 to ast_last_node 37 | ast_children(i) = "" 38 | next i 39 | ast_last_node = ast_last_commit_id 40 | ast_last_constant = ast_last_constant_commit_id 41 | end sub 42 | 43 | sub ast_clear_entrypoint 44 | 'Sets the main block to have 0 nodes. 45 | 'This doesn't actually delete the nodes, use ast_rollback for that. 46 | ast_children(AST_ENTRYPOINT) = "" 47 | end sub 48 | 49 | sub ast_add_procedure(node) 50 | if ast_last_procedure = ubound(ast_procedures) then 51 | new_size = ubound(ast_procedures) * 2 52 | redim _preserve ast_procedures(new_size) as long 53 | end if 54 | ast_last_procedure = ast_last_procedure + 1 55 | ast_procedures(ast_last_procedure) = node 56 | end sub 57 | 58 | function ast_add_constant(token, content$, force_type) 59 | if ast_last_constant = ubound(ast_constants) then ast_expand_constants_array 60 | ast_last_constant = ast_last_constant + 1 61 | select case token 62 | case TOK_NUMINT 63 | ast_constants(ast_last_constant) = content$ 64 | detected_type = type_detect_numint_type(content$) 65 | case TOK_NUMDEC 66 | ast_constants(ast_last_constant) = content$ 67 | detected_type = type_detect_numdec_type(ast_constants(ast_last_constant)) 68 | case TOK_NUMBASE 69 | ast_constants(ast_last_constant) = ltrim$(str$(val(content$))) 70 | detected_type = type_detect_numint_type(ast_constants(ast_last_constant)) 71 | case TOK_NUMEXP 72 | ast_constants(ast_last_constant) = content$ 73 | detected_type = type_detect_numexp_type(ast_constants(ast_last_constant)) 74 | case TOK_STRINGLIT 75 | 'Strip quotes 76 | ast_constants(ast_last_constant) = mid$(content$, 2, len(content$) - 2) 77 | detected_type = TYPE_STRING 78 | case TOK_CONTEXTUAL_ARGUMENT 79 | ast_constants(ast_last_constant) = "|" + content$ + "|" 80 | detected_type = TYPE_CONTEXTUAL_ARGUMENT 81 | end select 82 | if force_type > 0 then 83 | 'If you've used D or E, don't try and use # or ! as well! 84 | if token = TOK_NUMEXP or not type_can_safely_cast(detected_type, force_type) then ps_error "Cannot retype constant" 85 | ast_constant_types(ast_last_constant) = force_type 86 | else 87 | ast_constant_types(ast_last_constant) = detected_type 88 | end if 89 | ast_add_constant = ast_last_constant 90 | end function 91 | 92 | function ast_add_node(typ) 93 | if ast_last_node = ubound(ast_nodes) then ast_expand_nodes_arrays 94 | ast_last_node = ast_last_node + 1 95 | ast_last_node->atype = typ 96 | ast_last_node->linenum = ps_actual_linenum 97 | ast_add_node = ast_last_node 98 | end function 99 | 100 | function ast_add_cast(expr, vartyp) 101 | if vartyp = type_of_expr(expr) or vartyp = TYPE_ANY or type_is_array(vartyp) then 102 | 'Don't cast to TYPE_ANY because that's just a shorthand for a function that 103 | 'can handle any type. Don't cast when arrays are involved because they already 104 | 'have the element type matching exactly. 105 | ast_add_cast = expr 106 | exit function 107 | end if 108 | cast_node = ast_add_node(AST_CAST) 109 | cast_node->ref = vartyp 110 | cast_node->attach(expr) 111 | ast_add_cast = cast_node 112 | end function 113 | 114 | sub ast_attach(parent, child) 115 | if child = 0 or child = -1 then 116 | $if DEBUG_PARSE_TRACE then 117 | debuginfo "Not adding child node because it is " + ltrim$(str$(child)) 118 | $end if 119 | exit sub 120 | end if 121 | child->parent = parent 122 | ast_children(parent) = ast_children(parent) + mkl$(child) 123 | end sub 124 | 125 | sub ast_pre_attach(parent, child) 126 | if child = 0 or child = -1 then 127 | $if DEBUG_PARSE_TRACE then 128 | debuginfo "Not adding child node because it is " + ltrim$(str$(child)) 129 | $end if 130 | exit sub 131 | end if 132 | child->parent = parent 133 | ast_children(parent) = mkl$(child) + ast_children(parent) 134 | end sub 135 | 136 | function ast_num_children(node) 137 | ast_num_children = len(ast_children(node)) / len(dummy&) 138 | end function 139 | 140 | function ast_is_none(node) 141 | ast_is_none = node->atype = AST_NONE 142 | end function 143 | 144 | function ast_is_lvalue(node) 145 | select case node->atype 146 | case AST_VAR, AST_ARRAY_ACCESS, AST_UDT_ACCESS 147 | ast_is_lvalue = TRUE 148 | end select 149 | end function 150 | 151 | function ast_get_child(node, index) 152 | ast_get_child = cvl(mid$(ast_children(node), len(dummy&) * (index - 1) + 1, len(dummy&))) 153 | end function 154 | 155 | sub ast_replace_child(node, index, new_child) 156 | mid$(ast_children(node), len(dummy&) * (index - 1) + 1, len(dummy&)) = mkl$(new_child) 157 | end sub 158 | 159 | 'Inverse of ast_get_child. node == ast_get_child(parent, ast_find_child(parent, node)) 160 | function ast_find_child(parent, node) 161 | for i = 1 to ast_num_children(parent) 162 | if ast_get_child(parent, i) = node then 163 | ast_find_child = i 164 | exit function 165 | end if 166 | next i 167 | end function 168 | 169 | sub ast_expand_nodes_arrays() 170 | new_size = ubound(ast_nodes) * 2 171 | redim _preserve ast_nodes(new_size) as ast_node_t 172 | redim _preserve ast_children(new_size) as string 173 | end sub 174 | 175 | sub ast_expand_constants_array() 176 | new_size = ubound(ast_constants) * 2 177 | redim _preserve ast_constants(new_size) as string 178 | redim _preserve ast_constant_types(new_size) as long 179 | end sub 180 | 181 | 'List of nodes beginning at common ancestor of src & dest, ending at dest 182 | function ast_path_from_ancestor$(src, dest) 183 | src_path$ = ast_abs_path$(src) 184 | dest_path$ = ast_abs_path$(dest) 185 | for i = 1 to len(dest_path$) step 4 186 | if mid$(src_path$, i, 4) <> mid$(dest_path$, i, 4) then exit for 187 | next i 188 | ast_path_from_ancestor$ = mid$(dest_path$, i - 4) 189 | end function 190 | 191 | function ast_abs_path$(node) 192 | n = node 193 | do 194 | r$ = mkl$(n) + r$ 195 | n = n->parent 196 | loop while n 197 | ast_abs_path$ = r$ 198 | end function 199 | -------------------------------------------------------------------------------- /compiler/cmdflags.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'cmdflags.bi - Flags for specifying aspects of a runtime function's behaviour. 4 | 5 | const STMT_INPUT_NO_NEWLINE = 1 'Semicolon after INPUT 6 | const STMT_INPUT_PROMPT = 2 'A prompt is given 7 | const STMT_INPUT_NO_QUESTION = 4 'Comma after prompt string 8 | const STMT_INPUT_LINEMODE = 8 'Actually a LINE INPUT command 9 | 10 | const PRINT_NEXT_FIELD = 1 'A comma used after a variable moves to the next 14-char-wide field 11 | const PRINT_NEWLINE = 2 'No comma or semicolon at the end of the list 12 | 'Note: a semicolon sets no flag 13 | 14 | const PUTIMAGE_STEP_SRC1 = 1 15 | const PUTIMAGE_STEP_SRC2 = 2 16 | const PUTIMAGE_STEP_DEST1 = 4 17 | const PUTIMAGE_STEP_DEST2 = 8 18 | const PUTIMAGE_SMOOTH = 16 19 | 20 | const OPEN_INPUT = 1 21 | const OPEN_OUTPUT = 2 22 | const OPEN_BINARY = 4 23 | const OPEN_RANDOM = 8 24 | 'Concurrency options, not currently used 25 | const OPEN_READ = 16 26 | const OPEN_WRITE = 32 27 | const OPEN_SHARED = 64 28 | const OPEN_LOCK = 128 29 | -------------------------------------------------------------------------------- /compiler/debugging_options.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'This file controls what output is given when debug mode is enabled. Please do not 4 | 'make commits with these set to true, to avoid releasing versions that are slower 5 | 'than they should be (debugging info is calculated even if debug mode is not enabled 6 | 'at runtime). 7 | 'You may find it useful to tell git to ignore local modifications to this file: 8 | ' git update-index --skip-worktree compiler/debugging_options.bm 9 | 'you can undo this with: 10 | ' git update-index --no-skip-worktree compiler/debugging_options.bm 11 | 12 | $macro: debug_config_option @@, On | $let DEBUG_@1 = -1\nDebug_features$ = Debug_features$ + "[@1]" 13 | $macro: debug_config_option @@, Off | $let DEBUG_@1 = 0 14 | 15 | dim shared Debug_features$ 16 | 17 | debug_config_option PARSE_RESULT, Off 18 | debug_config_option PARSE_TRACE, Off 19 | debug_config_option TOKEN_STREAM, Off 20 | debug_config_option CALL_RESOLUTION, Off 21 | debug_config_option MEM_TRACE, Off 22 | debug_config_option HEAP, Off 23 | debug_config_option OWNERS, Off 24 | 25 | -------------------------------------------------------------------------------- /compiler/dependency.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'dependency.bi - Declarations for dependency and module management 4 | 5 | dim shared dep_files(1) as string 6 | dim shared dep_last_file as long 7 | 8 | -------------------------------------------------------------------------------- /compiler/dependency.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'dependency.bm - Dependency management and module generation 4 | 5 | sub dep_emit_header 6 | out_file = freefile 7 | open_file options.outputfile, out_file, TRUE 8 | 9 | for i = 1 to ast_last_procedure 10 | root = ast_procedures(i) 11 | func = root->ref 12 | if func->func_flags AND SYM_FUNCTION_PUBLIC then 13 | print #out_file, dep_make_func_declaration$(root) 14 | end if 15 | next i 16 | 17 | close #out_file 18 | end sub 19 | 20 | function dep_make_func_declaration$(root) 21 | func = root->ref 22 | sig = root->ref2 23 | o$ = "DECLARE " 24 | if type_sig_return(sig) = TYPE_NONE then 25 | o$ = o$ + "SUB " + func->identifier 26 | else 27 | o$ = o$ + "FUNCTION " + func->identifier + " AS " + type_human_readable$(type_sig_return(sig)) 28 | end if 29 | numargs = type_sig_numargs(sig) 30 | if numargs > 0 then 31 | o$ = o$ + "(" 32 | for i = 1 to numargs 33 | flags = type_sig_argflags(sig, i) 34 | if flags and TYPE_BYVAL then o$ = o$ + "BYVAL " 35 | if flags and TYPE_BYREF then o$ = o$ + "BYREF " 36 | if flags and TYPE_OPTIONAL then o$ = o$ + "OPTION " 37 | var = ast_get_child(root, i + 1) 38 | var = var->ref 39 | o$ = o$ + ps_remove_scope$(var->identifier) + " AS " 40 | o$ = o$ + type_human_readable$(type_sig_argtype(sig, i)) 41 | if i < numargs then 42 | o$ = o$ + ", " 43 | end if 44 | next i 45 | o$ = o$ + ")" 46 | end if 47 | dep_make_func_declaration$ = o$ 48 | end function 49 | 50 | sub dep_add_dependency(given$) 51 | 'Does the dependency itself exist? 52 | if _fileexists(given$) then 53 | path$ = given$ 54 | elseif _fileexists(given$ + ".a") then 55 | path$ = given$ + ".a" 56 | elseif _fileexists(given$ + ".o") then 57 | path$ = given$ + ".o" 58 | else 59 | fatalerror "Cannot locate dependency " + given$ 60 | end if 61 | 62 | if dep_last_file = ubound(dep_files) then 63 | new_size = ubound(dep_files) * 2 64 | redim _preserve dep_files(new_size) as string 65 | end if 66 | dep_last_file = dep_last_file + 1 67 | dep_files(dep_last_file) = path$ 68 | 69 | 'Is there an accompanying declaration file? 70 | header$ = remove_ext$(given$) + ".bh" 71 | if _fileexists(header$) then 72 | add_input_file header$, TRUE 73 | end if 74 | end sub 75 | 76 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/array.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'array.bm - Code generation for array handling 4 | 5 | sub ll_cg_array_create(node) 6 | dim as _offset lval, dummy 7 | var = ast_get_child(node, 1) 8 | lval = ll_cg_lval(var) 9 | typ = type_of_lvalue(var) 10 | num_bounds = ast_num_children(node) - 1 11 | func = TOK_ARRAY_INIT 12 | dim args(1 to 2 + num_bounds) as ll_arg_t 13 | args(1).lp = llvm_const_int(llvm_int16_type, num_bounds / 2, TRUE) 14 | args(1).is_byval = TRUE 15 | args(2).lp = ll_type_size(ll_type(typ->array_type)) 16 | args(2).is_byval = TRUE 17 | for i = 1 to num_bounds 18 | args(i + 2).lp = ll_cg_expr(ast_get_child(node, i + 1)) 19 | args(i + 2).is_byval = TRUE 20 | next i 21 | dummy = llvm_build_store(ll_cg_state.builder, ll_cg_call(func, -1, args()), lval) 22 | end sub 23 | 24 | function ll_cg_array_access%&(node) 25 | dim as _offset address 26 | address = ll_cg_array_lval(node) 27 | ll_cg_array_access%& = llvm_build_load(ll_cg_state.builder, address, "array") 28 | end function 29 | 30 | function ll_cg_array_lval%&(node) 31 | dim as _offset arrp, datap, data_offset, sizesp, data_size, l_bound, u_bound, index, adjusted_index, cmp 32 | dim as _offset currentBB, lboundBB, inboundsBB, outboundsBB, func, dummy 33 | currentBB = llvm_get_insert_block(ll_cg_state.builder) 34 | func = llvm_get_basic_block_parent(currentBB) 35 | dims = ast_num_children(node) - 1 36 | var_node = ast_get_child(node, 1) 37 | var = var_node->ref 38 | array_type = var->type 39 | elem_type = array_type->array_type 40 | 41 | 'Load pointer to descriptor 42 | arrp = llvm_build_load(ll_cg_state.builder, var->lp, var->identifier) 43 | 44 | 'Load pointer to data, casting to appropraite pointer type 45 | datap = llvm_build_load(ll_cg_state.builder, llvm_build_struct_gep(ll_cg_state.builder, arrp, 0, "datap"), "datap") 46 | datap = llvm_build_cast(ll_cg_state.builder, LLVMBitCast, datap, ll_pointer_type(elem_type), "cast") 47 | 48 | 'Base of sizes array 49 | sizesp = llvm_build_struct_gep(ll_cg_state.builder, arrp, 4, "sizesp") 50 | 51 | 'Multiply together indices to get final offset into data block 52 | data_size = llvm_const_int(llvm_int32_type, 1, FALSE) 53 | data_offset = llvm_const_int(llvm_int32_type, 0, FALSE) 54 | 55 | 'All dims can use the same block for out of bounds 56 | outboundsBB = llvm_create_basic_block("outbounds") 57 | llvm_append_existing_basic_block func, outboundsBB 58 | llvm_position_builder_at_end ll_cg_state.builder, outboundsBB 59 | ll_cg_callz TOK_ARRAY_OUT_OF_BOUNDS 60 | dummy = llvm_build_unreachable(ll_cg_state.builder) 61 | llvm_position_builder_at_end ll_cg_state.builder, currentBB 62 | 63 | for i = 1 to dims 64 | 'Blocks for bounds checks 65 | lboundBB = llvm_create_basic_block("check_lbound") 66 | inboundsBB = llvm_create_basic_block("inbounds") 67 | 68 | 'Load index 69 | index = ll_cg_expr(ast_get_child(node, i + 1)) 70 | 71 | 'Upper bounds check 72 | u_bound = llvm_build_load(ll_cg_state.builder, llvm_build_struct_gep(ll_cg_state.builder, sizesp, (i - 1) * 3, "u_bound"), "u_bound") 73 | cmp = llvm_build_icmp(ll_cg_state.builder, LLVMIntSGT, index, u_bound, "u_bound") 74 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, outboundsBB, lboundBB) 75 | 76 | 'Lower bounds check 77 | llvm_append_existing_basic_block func, lboundBB 78 | llvm_position_builder_at_end ll_cg_state.builder, lboundBB 79 | l_bound = llvm_build_load(ll_cg_state.builder, llvm_build_struct_gep(ll_cg_state.builder, sizesp, (i - 1) * 3 + 1, "l_bound"), "l_bound") 80 | cmp = llvm_build_icmp(ll_cg_state.builder, LLVMIntSLT, index, l_bound, "l_bound") 81 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, outboundsBB, inboundsBB) 82 | 83 | 'Subtrct lbound 84 | llvm_append_existing_basic_block func, inboundsBB 85 | llvm_position_builder_at_end ll_cg_state.builder, inboundsBB 86 | adjusted_index = llvm_build_sub(ll_cg_state.builder, index, l_bound, "elemp") 87 | 88 | ' data_offset = data_offset + data_size * index 89 | data_offset = llvm_build_add(ll_cg_state.builder, data_offset, llvm_build_mul(ll_cg_state.builder, data_size, adjusted_index, "elemp"), "elemp") 90 | 91 | 'Avoid loading data size for last dim as it will not be used 92 | if i < dims then 93 | data_size = llvm_build_load(ll_cg_state.builder, llvm_build_struct_gep(ll_cg_state.builder, sizesp, (i - 1) * 3 + 2, "data_size"), "data_size") 94 | end if 95 | next i 96 | 97 | 'Compute final address 98 | dim as _offset indices(0) 99 | indices(0) = data_offset 100 | ll_cg_array_lval%& = llvm_build_in_bounds_gep(ll_cg_state.builder, datap, indices(), 1, "index") 101 | end function 102 | 103 | 'Create the array type in llvm so we can calculate offsets of header fields. 104 | 'This must match up with the foundation library's idea of the LB_ARRAY type. 105 | function ll_cg_array_type%& 106 | static array_t as _offset 107 | if array_t = 0 then 108 | dim as _offset elements(1 to 5) 109 | elements(1) = llvm_pointer_type%&(llvm_int8_type, 0) 'data 110 | elements(2) = llvm_int8_type%& 'refcount 111 | elements(3) = llvm_int8_type%& 'dims 112 | elements(4) = llvm_int64_type%& 'element_size 113 | elements(5) = ll_cg_array_sizes_type 'sizes 114 | array_t = llvm_struct_type%&(elements(), ubound(elements), FALSE) 115 | end if 116 | ll_cg_array_type%& = array_t 117 | end function 118 | 119 | function ll_cg_array_sizes_type%& 120 | static sizes_t as _offset 121 | if sizes_t = 0 then 122 | sizes_t = llvm_array_type%&(llvm_int32_type%&, 0) 123 | end if 124 | ll_cg_array_sizes_type%& = sizes_t 125 | end function -------------------------------------------------------------------------------- /compiler/emitters/llvm/assign.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'assign.bm - Code generation for assignments 4 | 5 | sub ll_cg_assign(node) 6 | dim as _offset lvalue, rvalue, store 7 | rvalue = ll_cg_expr(ast_get_child(node, 2)) 8 | lvalue = ll_cg_lval(ast_get_child(node, 1)) 9 | if type_of_expr(ast_get_child(node, 1)) = TYPE_STRING then 10 | store = ll_cg_str_assign(rvalue, lvalue) 11 | else 12 | store = llvm_build_store(ll_cg_state.builder, rvalue, lvalue) 13 | end if 14 | end sub 15 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/builtins.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'builtins.bm - Code generation for builtin functions 4 | 5 | function ll_cg_builtin%&(func, sig, args() as ll_arg_t) 6 | select case func 7 | case TOK_IMP, TOK_EQV, TOK_XOR, TOK_OR, TOK_AND, _ 8 | TOK_EQUALS, TOK_CMP_NEQ, TOK_CMP_LT, TOK_CMP_GT, TOK_CMP_LTEQ, TOK_CMP_GTEQ, _ 9 | TOK_PLUS, TOK_DASH, TOK_MOD, TOK_BACKSLASH, TOK_STAR, TOK_SLASH 10 | ll_cg_builtin%& = ll_cg_builtin_binary(func, sig, args()) 11 | case TOK_NOT, TOK_NEGATIVE, TOK_LEN 12 | ll_cg_builtin%& = ll_cg_builtin_unary(func, sig, args()) 13 | end select 14 | end function 15 | 16 | function ll_cg_builtin_binary%&(func, sig, args() as ll_arg_t) 17 | dim as _offset lps(1 to 2) 18 | lps(1) = ll_cg_call_deref_and_shadow(type_sig_argtype(sig, 1), type_sig_argflags(sig, 1), args(1)) 19 | lps(2) = ll_cg_call_deref_and_shadow(type_sig_argtype(sig, 2), type_sig_argflags(sig, 2), args(2)) 20 | if type_is_int(type_sig_argtype(sig, 1)) then 21 | ll_cg_builtin_binary%& = ll_cg_builtin_binary_int(func, lps()) 22 | elseif type_is_fp(type_sig_argtype(sig, 1)) then 23 | ll_cg_builtin_binary%& = ll_cg_builtin_binary_fp(func, lps()) 24 | end if 25 | end function 26 | 27 | function ll_cg_builtin_binary_int%&(func, lps() as _offset) 28 | dim as _offset ret, tmp 29 | select case func 30 | case TOK_IMP 31 | tmp = llvm_build_not(ll_cg_state.builder, lps(1), "imp_not") 32 | ret = llvm_build_or(ll_cg_state.builder, tmp, lps(2), "imp_or") 33 | case TOK_EQV 34 | tmp = llvm_build_xor(ll_cg_state.builder, lps(1), lps(2), "eqv_xor") 35 | ret = llvm_build_not(ll_cg_state.builder, tmp, "eqv_not") 36 | case TOK_XOR 37 | ret = llvm_build_xor(ll_cg_state.builder, lps(1), lps(2), "xor") 38 | case TOK_OR 39 | ret = llvm_build_or(ll_cg_state.builder, lps(1), lps(2), "or") 40 | case TOK_AND 41 | ret = llvm_build_and(ll_cg_state.builder, lps(1), lps(2), "and") 42 | case TOK_EQUALS 43 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntEQ, lps(1), lps(2), "inteq") 44 | case TOK_CMP_NEQ 45 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntNE, lps(1), lps(2), "intne") 46 | case TOK_CMP_LT 47 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntSLT, lps(1), lps(2), "intlt") 48 | case TOK_CMP_GT 49 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntSGT, lps(1), lps(2), "intgt") 50 | case TOK_CMP_LTEQ 51 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntSLE, lps(1), lps(2), "intle") 52 | case TOK_CMP_GTEQ 53 | ret = llvm_build_icmp(ll_cg_state.builder, LLVMIntSGE, lps(1), lps(2), "intge") 54 | case TOK_PLUS 55 | ret = llvm_build_add(ll_cg_state.builder, lps(1), lps(2), "add") 56 | case TOK_DASH 57 | ret = llvm_build_sub(ll_cg_state.builder, lps(1), lps(2), "sub") 58 | case TOK_MOD 59 | ret = llvm_build_srem(ll_cg_state.builder, lps(1), lps(2), "srem") 60 | case TOK_BACKSLASH 61 | ret = llvm_build_sdiv(ll_cg_state.builder, lps(1), lps(2), "sdiv") 62 | case TOK_STAR 63 | ret = llvm_build_mul(ll_cg_state.builder, lps(1), lps(2), "mul") 64 | end select 65 | ll_cg_builtin_binary_int%& = ret 66 | end function 67 | 68 | function ll_cg_builtin_binary_fp%&(func, lps() as _offset) 69 | dim as _offset ret 70 | select case func 71 | case TOK_EQUALS 72 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealOEQ, lps(1), lps(2), "fpeq") 73 | case TOK_CMP_NEQ 74 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealONE, lps(1), lps(2), "fpne") 75 | case TOK_CMP_LT 76 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealOLT, lps(1), lps(2), "fplt") 77 | case TOK_CMP_GT 78 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealOGT, lps(1), lps(2), "fpgt") 79 | case TOK_CMP_LTEQ 80 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealOLE, lps(1), lps(2), "fple") 81 | case TOK_CMP_GTEQ 82 | ret = llvm_build_fcmp(ll_cg_state.builder, LLVMRealOGE, lps(1), lps(2), "fpge") 83 | case TOK_PLUS 84 | ret = llvm_build_fadd(ll_cg_state.builder, lps(1), lps(2), "fadd") 85 | case TOK_DASH 86 | ret = llvm_build_fsub(ll_cg_state.builder, lps(1), lps(2), "fsub") 87 | case TOK_STAR 88 | ret = llvm_build_fmul(ll_cg_state.builder, lps(1), lps(2), "fmul") 89 | case TOK_SLASH 90 | ret = llvm_build_fdiv(ll_cg_state.builder, lps(1), lps(2), "fdiv") 91 | end select 92 | ll_cg_builtin_binary_fp%& = ret 93 | end function 94 | 95 | function ll_cg_builtin_unary%&(func, sig, args() as ll_arg_t) 96 | dim as _offset lps(1 to 1) 97 | typ = type_sig_argtype(sig, 1) 98 | lps(1) = ll_cg_call_deref_and_shadow(typ, type_sig_argflags(sig, 1), args(1)) 99 | if type_is_int(typ) then 100 | ll_cg_builtin_unary%& = ll_cg_builtin_unary_int(func, sig, lps()) 101 | elseif type_is_fp(typ) then 102 | ll_cg_builtin_unary%& = ll_cg_builtin_unary_fp(func, sig, lps()) 103 | end if 104 | end function 105 | 106 | function ll_cg_builtin_unary_int%&(func, sig, lps() as _offset) 107 | dim as _offset ret 108 | select case func 109 | case TOK_NOT 110 | ret = llvm_build_not(ll_cg_state.builder, lps(1), "not") 111 | case TOK_NEGATIVE 112 | ret = llvm_build_neg(ll_cg_state.builder, lps(1), "neg") 113 | case TOK_LEN 114 | ret = ll_type_size(ll_type(type_sig_argtype(sig, 1))) 115 | end select 116 | ll_cg_builtin_unary_int%& = ret 117 | end function 118 | 119 | function ll_cg_builtin_unary_fp%&(func, sig, lps() as _offset) 120 | dim as _offset ret 121 | select case func 122 | case TOK_NEGATIVE 123 | ret = llvm_build_fneg(ll_cg_state.builder, lps(1), "fneg") 124 | case TOK_LEN 125 | ret = ll_type_size(ll_type(type_sig_argtype(sig, 1))) 126 | end select 127 | ll_cg_builtin_unary_fp%& = ret 128 | end function 129 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/calls.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'calls.bm - Code generation for calls to functions 4 | 5 | sub ll_cg_callz(func) 6 | dim args(0) as ll_arg_t 7 | dim dummy as _offset 8 | dummy = ll_cg_call(func, -1, args()) 9 | end sub 10 | 11 | function ll_cg_call%&(func, sig, args() as ll_arg_t) 12 | dim as _offset builtin 13 | if sig = -1 then 14 | sig = func->sig 15 | end if 16 | if sig->sig_lp = 0 then 17 | 'A builtin instruction? 18 | builtin = ll_cg_builtin(func, sig, args()) 19 | if builtin then 20 | ll_cg_call%& = builtin 21 | exit function 22 | end if 23 | 'First use of a non-builtin? 24 | ll_declare_func_sig func, sig 25 | if sig->sig_lp = 0 then 26 | 'Still nothing, throw an error (should never happen) 27 | ll_error "Call to " + func->identifier + " has no target pointer" 28 | end if 29 | end if 30 | 31 | numargs = ubound(args) 32 | dim lps(1 to numargs) as _offset 33 | sig_i = 1 'Decouple sig iterator from args iterator so we can fudge it for variadic args 34 | for i = 1 to numargs 35 | typ = type_sig_argtype(sig, sig_i) 36 | typflags = type_sig_argflags(sig, sig_i) 37 | lps(i) = ll_cg_call_deref_and_shadow(typ, typflags, args(i)) 38 | if (typflags AND TYPE_VARIADIC) = 0 then 39 | sig_i = sig_i + 1 40 | end if 41 | next i 42 | 43 | ll_cg_call%& = llvm_build_call(ll_cg_state.builder, sig->sig_lp, lps(), numargs, "") 44 | end function 45 | 46 | 'Apply dereferencing and shadowing needed to pass arg to (typ, typflags) 47 | function ll_cg_call_deref_and_shadow%&(typ, typflags, arg as ll_arg_t) 48 | if arg.omitted then 49 | if (typflags AND TYPE_OPTIONAL) = 0 then 50 | ll_error "Attempt to use omitted argument for non-optional parameter" 51 | else 52 | 'Omitted optional argument 53 | ll_cg_call_deref_and_shadow%& = llvm_const_pointer_null(llvm_pointer_type(ll_type(typ), 0)) 54 | end if 55 | elseif arg.is_byval and ((typflags AND TYPE_BYVAL) = 0) then 56 | 'Have a value but need a reference, create a shadow variable 57 | ll_cg_call_deref_and_shadow%& = ll_cg_shadow_expr(typ, arg.lp) 58 | elseif not arg.is_byval and (typflags AND TYPE_BYVAL) then 59 | 'Have a reference but need a value, dereference 60 | ll_cg_call_deref_and_shadow%& = ll_cg_deref_expr(arg.lp) 61 | else 62 | ll_cg_call_deref_and_shadow%& = arg.lp 63 | end if 64 | end function 65 | 66 | function ll_cg_call_node%&(node) 67 | numargs = ast_num_children(node) 68 | func = node->ref 69 | sig = node->ref2 70 | 71 | dim args(1 to numargs) as ll_arg_t 72 | for i = 1 to numargs 73 | arg_node = ast_get_child(node, i) 74 | if arg_node->atype = AST_NONE then 75 | args(i).omitted = TRUE 76 | else 77 | args(i).lp = ll_cg_expr(arg_node) 78 | 'll_cg_expr should always evaluate down to a value 79 | args(i).is_byval = TRUE 80 | typ = type_of_expr(arg_node) 81 | if typ = TYPE_STRING and _ 82 | (not type_is_lvalue(arg_node)) and _ 83 | (arg_node->atype <> AST_CONSTANT) then ll_cg_str_queue_transient args(i) 84 | end if 85 | next i 86 | ll_cg_call_node%& = ll_cg_call(func, sig, args()) 87 | end function 88 | 89 | sub ll_declare_func_sig(func, sig) 90 | dim as _offset prototype 91 | numargs = type_sig_numargs(sig) 92 | dim args(1 to numargs) as _offset 93 | for i = 1 to numargs 94 | if type_sig_argflags(sig, i) AND TYPE_VARIADIC then 95 | is_var_args = TRUE 96 | numargs = numargs - 1 97 | exit for 98 | end if 99 | if type_sig_argflags(sig, i) AND TYPE_BYVAL then 100 | args(i) = ll_type(type_sig_argtype(sig, i)) 101 | else 102 | args(i) = ll_pointer_type(type_sig_argtype(sig, i)) 103 | end if 104 | next i 105 | prototype = llvm_function_type(ll_type(type_sig_return(sig)), args(), numargs, is_var_args) 106 | if sig->link_name = "" then 107 | mangled$ = ll_mangled_proc_name$(func->identifier, sig) 108 | else 109 | mangled$ = sig->link_name 110 | end if 111 | sig->sig_lp = llvm_add_function(ll_cg_state.module, mangled$, prototype) 112 | end sub 113 | 114 | function ll_cg_shadow_expr%&(typ, expr as _offset) 115 | dim as _offset currentBB, entryBB, alloca, dummy 116 | currentBB = llvm_get_insert_block(ll_cg_state.builder) 117 | entryBB = llvm_get_entry_basic_block(llvm_get_basic_block_parent(currentBB)) 118 | llvm_position_builder_before ll_cg_state.builder, llvm_get_basic_block_terminator(entryBB) 119 | alloca = llvm_build_alloca(ll_cg_state.builder, ll_type(typ), "shadow") 120 | llvm_position_builder_at_end ll_cg_state.builder, currentBB 121 | dummy = llvm_build_store(ll_cg_state.builder, expr, alloca) 122 | ll_cg_shadow_expr%& = alloca 123 | end function 124 | 125 | function ll_cg_deref_expr%&(lp as _offset) 126 | ll_cg_deref_expr%& = llvm_build_load(ll_cg_state.builder, lp, "deref") 127 | end function 128 | 129 | sub ll_cg_set_return(node) 130 | dim as _offset value, dummy 131 | value = ll_cg_expr(ast_get_child(node, 1)) 132 | if type_of_expr(ast_get_child(node, 1)) = TYPE_STRING then 133 | dummy = ll_cg_str_assign(value, ll_cg_state.retvar) 134 | else 135 | dummy = llvm_build_store(ll_cg_state.builder, value, ll_cg_state.retvar) 136 | end if 137 | end sub 138 | 139 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/cast.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'cast.bm - Code generation for casts 4 | 5 | function ll_cg_cast%&(node) 6 | dim as _offset value 7 | child = ast_get_child(node, 1) 8 | value = ll_cg_expr(child) 9 | src_type = type_of_expr(child) 10 | dest_type = node->ref 11 | if type_is_int(src_type) and type_is_int(dest_type) then 12 | if type_fixed_size(dest_type) > type_fixed_size(src_type) then 13 | op = LLVMSExt 14 | else 15 | op = LLVMTrunc 16 | end if 17 | elseif type_is_int(src_type) and type_is_fp(dest_type) then 18 | op = LLVMSIToFP 19 | elseif type_is_fp(src_type) and type_is_int(dest_type) then 20 | dim args(1 to 1) as ll_arg_t 21 | args(1).lp = value 22 | args(1).is_byval = TRUE 23 | candidate$ = type_sigt_create$(src_type) 24 | candidate$ = type_sigt_add_arg$(candidate$, src_type, TYPE_BYVAL) 25 | sig = type_find_sig_match(TOK_ROUND, candidate$) 26 | value = ll_cg_call(TOK_ROUND, sig, args()) 27 | op = LLVMFPToSI 28 | elseif type_is_fp(src_type) and type_is_fp(dest_type) then 29 | if type_fixed_size(dest_type) > type_fixed_size(src_type) then 30 | op = LLVMFPExt 31 | else 32 | op = LLVMFPTrunc 33 | end if 34 | else 35 | ll_error "Bad cast" 36 | end if 37 | ll_cg_cast%& = llvm_build_cast(ll_cg_state.builder, op, value, ll_type(dest_type), "cast") 38 | end function 39 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/for.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'for.bm - Code generation for FOR loops 4 | 5 | sub ll_cg_for(node) 6 | dim as _offset preheadBB, headBB, upBB, downBB, bodyBB, endBB 7 | dim as _offset start_expr, end_expr, step_expr, direction 8 | dim as _offset func, var_lp, cmp, phi, nextval, zero, dummy 9 | dim args(1 to 2) as ll_arg_t 10 | 11 | varnode = ast_get_child(node, 1) 12 | var_type = type_of_lvalue(varnode) 13 | var_lp = ll_cg_lval(varnode) 14 | func = llvm_get_basic_block_parent(llvm_get_insert_block(ll_cg_state.builder)) 15 | preheadBB = llvm_get_insert_block(ll_cg_state.builder) 16 | headBB = llvm_create_basic_block("for_head") 17 | upBB = llvm_create_basic_block("for_up") 'Bounds check when step >= 0 18 | downBB = llvm_create_basic_block("for_down") 'Bounds check when step < 0 19 | bodyBB = llvm_create_basic_block("for_body") 20 | endBB = llvm_create_basic_block("for_end") 21 | 22 | start_expr = ll_cg_expr(ast_get_child(node, 2)) 23 | end_expr = ll_cg_expr(ast_get_child(node, 3)) 24 | step_expr = ll_cg_expr(ast_get_child(node, 4)) 25 | if type_is_int(var_type) then 26 | zero = llvm_const_int(ll_type(var_type), 0, 0) 27 | else 28 | zero = llvm_const_real(ll_type(var_type), 0) 29 | end if 30 | 'direction = (step_expr >= 0) 31 | direction = ll_cg_for_cmp(step_expr, TRUE, zero, TOK_CMP_GTEQ, var_type) 32 | dummy = llvm_build_br(ll_cg_state.builder, headBB) 33 | 34 | llvm_append_existing_basic_block func, headBB 35 | llvm_position_builder_at_end ll_cg_state.builder, headBB 36 | phi = llvm_build_phi(ll_cg_state.builder, ll_type(var_type), "for_phi") 37 | llvm_add_incoming phi, start_expr, preheadBB, 1 38 | dummy = llvm_build_store(ll_cg_state.builder, phi, var_lp) 39 | dummy = llvm_build_cond_br(ll_cg_state.builder, direction, upBB, downBB) 40 | 41 | 'Increasing value, check if var > end 42 | llvm_append_existing_basic_block func, upBB 43 | llvm_position_builder_at_end ll_cg_state.builder, upBB 44 | cmp = ll_cg_for_cmp(var_lp, FALSE, end_expr, TOK_CMP_GT, var_type) 45 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, endBB, bodyBB) 46 | 47 | 'Increasing value, check if var < end 48 | llvm_append_existing_basic_block func, downBB 49 | llvm_position_builder_at_end ll_cg_state.builder, downBB 50 | cmp = ll_cg_for_cmp(var_lp, FALSE, end_expr, TOK_CMP_LT, var_type) 51 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, endBB, bodyBB) 52 | 53 | llvm_append_existing_basic_block func, bodyBB 54 | llvm_position_builder_at_end ll_cg_state.builder, bodyBB 55 | ll_cg_block ast_get_child(node, 5) 56 | args(1).lp = var_lp 57 | args(1).is_byval = FALSE 58 | args(2).lp = step_expr 59 | args(2).is_byval = TRUE 60 | call_func = TOK_PLUS 61 | candidate$ = type_sigt_create$(var_type) 62 | candidate$ = type_sigt_add_arg$(candidate$, var_type, TYPE_BYVAL) 63 | candidate$ = type_sigt_add_arg$(candidate$, var_type, TYPE_BYVAL) 64 | sig = type_find_sig_match(call_func, candidate$) 65 | nextval = ll_cg_call(call_func, sig, args()) 66 | llvm_add_incoming phi, nextval, llvm_get_insert_block(ll_cg_state.builder), 1 67 | dummy = llvm_build_br(ll_cg_state.builder, headBB) 68 | 69 | llvm_append_existing_basic_block func, endBB 70 | llvm_position_builder_at_end ll_cg_state.builder, endBB 71 | end sub 72 | 73 | function ll_cg_for_cmp%&(a as _offset, a_byval, b as _offset, op, var_type) 74 | dim args(1 to 2) as ll_arg_t 75 | args(1).lp = a 76 | args(1).is_byval = a_byval 77 | args(2).lp = b 78 | args(2).is_byval = TRUE 79 | candidate$ = type_sigt_create$(TYPE_BOOL) 80 | candidate$ = type_sigt_add_arg$(candidate$, var_type, TYPE_BYVAL) 81 | candidate$ = type_sigt_add_arg$(candidate$, var_type, TYPE_BYVAL) 82 | sig = type_find_sig_match(op, candidate$) 83 | ll_cg_for_cmp%& = ll_cg_call(op, sig, args()) 84 | end function -------------------------------------------------------------------------------- /compiler/emitters/llvm/if.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'if.bm - Code generation for conditional statements 4 | 5 | sub ll_cg_if(node) 6 | dim as _offset func, guard, cmp, trueBB, falseBB, endBB, dummy 7 | 8 | func = llvm_get_basic_block_parent(llvm_get_insert_block(ll_cg_state.builder)) 9 | endBB = llvm_create_basic_block("if_end") 10 | 11 | 'Ignore possible else block as last child for now 12 | for i = 1 to (ast_num_children(node) \ 2) * 2 step 2 13 | cond_node = ast_get_child(node, i) 14 | cond_type = type_of_expr(cond_node) 15 | guard = ll_cg_expr(cond_node) 16 | if type_is_int(cond_type) then 17 | cmp = llvm_build_icmp(ll_cg_state.builder, LLVMIntNE, guard, llvm_const_int(ll_type(cond_type), 0, 0), "ifcmp") 18 | elseif type_is_fp(cond_type) then 19 | cmp = llvm_build_fcmp(ll_cg_state.builder, LLVMRealONE, guard, llvm_const_real(ll_type(cond_type), 0), "ifcmp") 20 | end if 21 | trueBB = llvm_create_basic_block("if_true") 22 | falseBB = llvm_create_basic_block("if_false") 23 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, trueBB, falseBB) 24 | 25 | llvm_append_existing_basic_block func, trueBB 26 | llvm_position_builder_at_end ll_cg_state.builder, trueBB 27 | ll_cg_block ast_get_child(node, i + 1) 28 | dummy = llvm_build_br(ll_cg_state.builder, endBB) 29 | 30 | llvm_append_existing_basic_block func, falseBB 31 | llvm_position_builder_at_end ll_cg_state.builder, falseBB 32 | next i 33 | 34 | 'Now handle optional else block 35 | if ast_num_children(node) mod 2 = 1 then 36 | ll_cg_block ast_get_child(node, ast_num_children(node)) 37 | end if 38 | dummy = llvm_build_br(ll_cg_state.builder, endBB) 39 | 40 | llvm_append_existing_basic_block func, endBB 41 | llvm_position_builder_at_end ll_cg_state.builder, endBB 42 | end sub -------------------------------------------------------------------------------- /compiler/emitters/llvm/llvm.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'llvm.bi - Declarations for LLVM compilation target 4 | 5 | $include: 'llvm_bindings.bi' 6 | 7 | type ll_cg_state_t 8 | target_machine as _offset 9 | module as _offset 'Current LLVM module 10 | builder as _offset 'Current instruction builder 11 | retvar as _offset 'The variable whose value will be loaded & returned 12 | end type 13 | 14 | dim shared ll_cg_state as ll_cg_state_t 15 | 16 | type ll_arg_t 17 | lp as _offset 'LLVM value 18 | is_byval as long 'false if this is a reference 19 | omitted as long 'true if this value is an optional omitted argument 20 | end type 21 | 22 | dim shared ll_cg_str_queued_transients(1) as ll_arg_t 23 | dim shared ll_cg_str_last_queued_transient as long 24 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/llvm.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'llvm.bm - Entry point for LLVM based compilation 4 | 5 | sub ll_build 6 | dynlib_llvm_init 7 | ll_cg_state.module = llvm_module_create_with_name(options.mainarg) 8 | ll_set_target 9 | for i = 1 to ast_last_procedure 10 | root = ast_procedures(i) 11 | ll_cg_procedure_entry root 12 | next i 13 | for i = 1 to ast_last_procedure 14 | root = ast_procedures(i) 15 | ll_cg_procedure root 16 | next i 17 | e = llvm_verify_module(ll_cg_state.module, LLVMAbortProcessAction, message$) 18 | if options.build_stages and BUILD_LINK then 19 | ll_do_link 20 | elseif options.build_stages and BUILD_OBJ then 21 | ll_emit_obj 22 | elseif options.build_stages and BUILD_ASM then 23 | ll_emit_asm 24 | elseif options.build_stages and BUILD_IR then 25 | ll_emit_ir 26 | end if 27 | llvm_dispose_module ll_cg_state.module 28 | end sub 29 | 30 | sub ll_emit_ir 31 | e = llvm_write_bitcode_to_file(ll_cg_state.module, options.outputfile) 32 | if e then ll_error "Failed to write to " + options.outputfile 33 | end sub 34 | 35 | sub ll_emit_asm 36 | e = llvm_target_machine_emit_to_file(ll_cg_state.target_machine, ll_cg_state.module, options.outputfile, LLVMAssemblyFile, message$) 37 | if e then ll_error message$ 38 | end sub 39 | 40 | sub ll_emit_obj 41 | e = llvm_target_machine_emit_to_file(ll_cg_state.target_machine, ll_cg_state.module, options.outputfile, LLVMObjectFile, message$) 42 | if e then ll_error message$ 43 | end sub 44 | 45 | sub ll_do_link 46 | 'Write module to disk as an object file 47 | dim as _offset obj_buf 48 | e = llvm_target_machine_emit_to_memory_buf(ll_cg_state.target_machine, ll_cg_state.module, LLVMObjectFile, message$, obj_buf) 49 | if e then ll_error message$ 50 | module_obj$ = ll_write_tempfile$(".o", llvm_get_buffer_start(obj_buf), llvm_get_buffer_size(obj_buf)) 51 | 52 | dim linker_opts$(0) 53 | split runtime_platform_settings.link_opts, " ", linker_opts$() 54 | num_linker_opts = ubound(linker_opts$) + 1 55 | 56 | 'Build array of arguments. This assumes there are no quoted spaces in the linker options. 57 | dim args$(1 to num_linker_opts + 1 + dep_last_file + 1 + 1) 'linker opts + module obj + dependencies + "-o" + output file 58 | p = 1 59 | for i = 1 to num_linker_opts 60 | args$(p) = linker_opts$(i - 1) 61 | p = p + 1 62 | next i 63 | args$(p) = module_obj$ 64 | p = p + 1 65 | for i = 1 to dep_last_file 66 | args$(p) = dep_files(i) 67 | p = p + 1 68 | next i 69 | args$(p) = "-o" 70 | p = p + 1 71 | args$(p) = options.outputfile 72 | 73 | 'Do it! 74 | ret = spawn(runtime_platform_settings.linker, args$()) 75 | 76 | 'Clean up 77 | kill module_obj$ 78 | 79 | if ret = -1 then 80 | fatalerror "Failed to invoke linker: " + runtime_platform_settings.linker 81 | elseif ret <> 0 then 82 | fatalerror "Linker exited with error code " + ltrim$(str$(ret)) 83 | end if 84 | end sub 85 | 86 | sub ll_set_target 87 | dim as _offset target, layout 88 | llvm_initialize_x86_target_info 89 | llvm_initialize_x86_target 90 | llvm_initialize_x86_target_mc 91 | llvm_initialize_x86_asm_printer 92 | if target_platform_settings.target_triple = "" then 93 | triple$ = llvm_get_default_target_triple$ 94 | else 95 | triple$ = target_platform_settings.target_triple 96 | end if 97 | 'Get target, i.e. one of `llc --version` 98 | target = llvm_get_target_from_triple(triple$, errmsg$) 99 | if target = 0 then ll_error "No target: " + errmsg$ 100 | 'Specific processor & additional features from `llc -march=... -mattr=help` 101 | cpu$ = "generic" 102 | features$ = "" 103 | ll_cg_state.target_machine = llvm_create_target_machine(target, triple$, cpu$, features$, LLVMCodeGenLevelNone, LLVMRelocPIC, LLVMCodeModelDefault) 104 | layout = llvm_create_target_data_layout(ll_cg_state.target_machine) 105 | llvm_module_set_data_layout ll_cg_state.module, layout 106 | llvm_set_target ll_cg_state.module, triple$ 107 | end sub 108 | 109 | sub ll_error(msg$) 110 | Error_message$ = msg$ 111 | error 101 112 | end sub 113 | 114 | $include: 'llvm_bindings.bm' 115 | $include: 'array.bm' 116 | $include: 'assign.bm' 117 | $include: 'builtins.bm' 118 | $include: 'calls.bm' 119 | $include: 'cast.bm' 120 | $include: 'for.bm' 121 | $include: 'if.bm' 122 | $include: 'loop.bm' 123 | $include: 'proc.bm' 124 | $include: 'stmt_expr.bm' 125 | $include: 'string.bm' 126 | $include: 'tempfile.bm' 127 | $include: 'types.bm' 128 | $include: 'vars.bm' 129 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/loop.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'loop.bm - Code generation for DO and WHILE loops 4 | 5 | sub ll_cg_do_pre(node) 6 | dim as _offset guard, func, cmp, headerBB, bodyBB, endBB, dummy 7 | cond_node = ast_get_child(node, 1) 8 | cond_type = type_of_expr(cond_node) 9 | 10 | func = llvm_get_basic_block_parent(llvm_get_insert_block(ll_cg_state.builder)) 11 | headerBB = llvm_append_basic_block(func, "do_pre_head") 12 | bodyBB = llvm_create_basic_block("do_pre_body") 13 | endBB = llvm_create_basic_block("do_pre_end") 14 | 15 | dummy = llvm_build_br(ll_cg_state.builder, headerBB) 16 | 17 | llvm_position_builder_at_end ll_cg_state.builder, headerBB 18 | guard = ll_cg_expr(cond_node) 19 | if type_is_int(cond_type) then 20 | cmp = llvm_build_icmp(ll_cg_state.builder, LLVMIntNE, guard, llvm_const_int(ll_type(cond_type), 0, 0), "do_pre_cmp") 21 | elseif type_is_fp(cond_type) then 22 | cmp = llvm_build_fcmp(ll_cg_state.builder, LLVMRealONE, guard, llvm_const_real(ll_type(cond_type), 0), "do_pre_cmp") 23 | end if 24 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, bodyBB, endBB) 25 | 26 | llvm_append_existing_basic_block func, bodyBB 27 | llvm_position_builder_at_end ll_cg_state.builder, bodyBB 28 | ll_cg_block ast_get_child(node, 2) 29 | dummy = llvm_build_br(ll_cg_state.builder, headerBB) 30 | 31 | llvm_append_existing_basic_block func, endBB 32 | llvm_position_builder_at_end ll_cg_state.builder, endBB 33 | end sub 34 | 35 | sub ll_cg_do_post(node) 36 | dim as _offset guard, func, cmp, bodyBB, tailBB, endBB, dummy 37 | cond_node = ast_get_child(node, 1) 38 | cond_type = type_of_expr(cond_node) 39 | 40 | func = llvm_get_basic_block_parent(llvm_get_insert_block(ll_cg_state.builder)) 41 | bodyBB = llvm_append_basic_block(func, "do_post_body") 42 | tailBB = llvm_create_basic_block("do_post_tail") 43 | endBB = llvm_create_basic_block("do_post_end") 44 | 45 | dummy = llvm_build_br(ll_cg_state.builder, bodyBB) 46 | 47 | llvm_position_builder_at_end ll_cg_state.builder, bodyBB 48 | ll_cg_block ast_get_child(node, 2) 49 | dummy = llvm_build_br(ll_cg_state.builder, tailBB) 50 | 51 | llvm_append_existing_basic_block func, tailBB 52 | llvm_position_builder_at_end ll_cg_state.builder, tailBB 53 | guard = ll_cg_expr(cond_node) 54 | if type_is_int(cond_type) then 55 | cmp = llvm_build_icmp(ll_cg_state.builder, LLVMIntNE, guard, llvm_const_int(ll_type(cond_type), 0, 0), "do_post_cmp") 56 | elseif type_is_fp(cond_type) then 57 | cmp = llvm_build_fcmp(ll_cg_state.builder, LLVMRealONE, guard, llvm_const_real(ll_type(cond_type), 0), "do_post_cmp") 58 | end if 59 | dummy = llvm_build_cond_br(ll_cg_state.builder, cmp, bodyBB, endBB) 60 | 61 | llvm_append_existing_basic_block func, endBB 62 | llvm_position_builder_at_end ll_cg_state.builder, endBB 63 | end sub 64 | 65 | sub ll_cg_while(node) 66 | ll_cg_do_pre node 67 | end sub 68 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/proc.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'proc.bm - Code generation for procedures 4 | 5 | sub ll_cg_procedure_entry(proc_node) 6 | dim as _offset param 7 | proc = proc_node->ref 8 | sig = proc_node->ref2 9 | ll_declare_func_sig proc, sig 10 | numargs = ast_num_children(proc_node) - 1 11 | 'Set parameter names for readability 12 | for i = 1 to numargs 13 | arg = ast_get_child(proc_node, i + 1) 14 | var = arg->ref 15 | param = llvm_get_param(sig->sig_lp, i - 1) 16 | llvm_set_value_name param, var->identifier 17 | var->lp = param 18 | next i 19 | if (proc->func_flags AND SYM_FUNCTION_PUBLIC) = 0 then 20 | llvm_set_linkage sig->sig_lp, LLVMInternalLinkage 21 | end if 22 | end sub 23 | 24 | sub ll_cg_procedure(proc_node) 25 | dim as _offset entryBB, startBB, cleanupBB, dummy 26 | proc = proc_node->ref 27 | sig = proc_node->ref2 28 | ll_cg_state.builder = llvm_create_builder 29 | 'entryBB: Setup things. Will also be used when generating user code for allocas 30 | 'when a shadow is needed. 31 | entryBB = llvm_append_basic_block(sig->sig_lp, "entry") 32 | 'startBB: Beginning of user code 33 | startBB = llvm_append_basic_block(sig->sig_lp, "start") 34 | 'cleanupBB: Free any values going out of scope 35 | cleanupBB = llvm_append_basic_block(sig->sig_lp, "cleanup") 36 | 37 | 'Setup locals and corresponding frees 38 | ll_cg_locals proc_node, entryBB, cleanupBB 39 | 40 | 'Handle return value storage and jump from entryBB to startBB 41 | llvm_position_builder_at_end ll_cg_state.builder, entryBB 42 | ret_type = type_sig_return(sig) 43 | if ret_type <> TYPE_NONE then 44 | 'Do not clean up return value because it must persist beyond the scope 45 | ll_cg_state.retvar = ll_cg_local_var(ret_type, "retval", entryBB, 0) 46 | end if 47 | dummy = llvm_build_br(ll_cg_state.builder, startBB) 48 | 49 | 'Generate user code, then jump to cleanupBB 50 | llvm_position_builder_at_end ll_cg_state.builder, startBB 51 | ll_cg_block ast_get_child(proc_node, 1) 52 | dummy = llvm_build_br(ll_cg_state.builder, cleanupBB) 53 | 54 | 'Generate return 55 | llvm_position_builder_at_end ll_cg_state.builder, cleanupBB 56 | if ret_type = TYPE_NONE then 57 | dummy = llvm_build_ret_void(ll_cg_state.builder) 58 | else 59 | ll_cg_state.retvar = llvm_build_load(ll_cg_state.builder, ll_cg_state.retvar, "retval") 60 | dummy = llvm_build_ret(ll_cg_state.builder, ll_cg_state.retvar) 61 | end if 62 | 63 | function_ok = llvm_verify_function(sig->sig_lp, LLVMAbortProcessAction) 64 | llvm_dispose_builder ll_cg_state.builder 65 | end sub 66 | 67 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/stmt_expr.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'stmt_expr.bm - Code generation for statements and expressions 4 | 5 | function ll_cg_expr%&(node) 6 | select case node->atype 7 | case AST_CALL 8 | ll_cg_expr%& = ll_cg_call_node(node) 9 | case AST_CONSTANT 10 | ll_cg_expr%& = ll_cg_constant(node) 11 | case AST_CAST 12 | ll_cg_expr%& = ll_cg_cast(node) 13 | case AST_VAR 14 | ll_cg_expr%& = ll_cg_var(node) 15 | case AST_ARRAY_ACCESS 16 | ll_cg_expr%& = ll_cg_array_access(node) 17 | case else 18 | ll_error "Bad expr type" + str$(node->atype) 19 | end select 20 | end function 21 | 22 | sub ll_cg_block(block) 23 | for i = 1 to ast_num_children(block) 24 | node = ast_get_child(block, i) 25 | select case node->atype 26 | case AST_ASSIGN 27 | ll_cg_assign node 28 | case AST_IF 29 | ll_cg_if node 30 | case AST_WHILE 31 | ll_cg_while node 32 | case AST_DO_PRE 33 | ll_cg_do_pre node 34 | case AST_DO_POST 35 | ll_cg_do_post node 36 | case AST_FOR 37 | ll_cg_for node 38 | case AST_SELECT 39 | 'll_cg_select node 40 | case AST_CALL 41 | none%& = ll_cg_call_node(node) 42 | case AST_GOTO 43 | 'll_cg_goto node 44 | case AST_EXIT 45 | 'll_cg_exit node 46 | case AST_SET_RETURN 47 | ll_cg_set_return node 48 | case AST_BLOCK 49 | ll_cg_block node 50 | case AST_ARRAY_CREATE 51 | ll_cg_array_create node 52 | end select 53 | 'We have completed a statement, so any transient strings 54 | 'can now be freed 55 | ll_cg_str_free_transients 56 | next i 57 | end sub 58 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/string.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'string.bm - Code generation for string handling 4 | 5 | function ll_cg_str_constant%&(constant) 6 | dim as _offset value, global, indices(1) 7 | s$ = ll_cg_str_header$(ast_constants(constant)) + ast_constants(constant) 8 | value = llvm_const_string(s$, len(s$), TRUE) 9 | global = llvm_add_global(ll_cg_state.module, llvm_type_of(value), "") 10 | llvm_set_initializer global, value 11 | llvm_set_global_constant global, TRUE 12 | llvm_set_linkage global, LLVMPrivateLinkage 13 | llvm_set_unnamed_address global, LLVMGlobalUnnamedAddr 14 | indices(0) = llvm_const_int(llvm_int32_type, 0, false) 15 | indices(1) = llvm_const_int(llvm_int32_type, 0, false) 16 | ll_cg_str_constant%& = llvm_const_in_bounds_gep(global, indices(), 2) 17 | end function 18 | 19 | 'Create the string type in llvm so we can calculate offsets of header fields. 20 | 'This must match up with the foundation library's idea of the LB_STRING type. 21 | function ll_cg_str_type%& 22 | static string_t as _offset 23 | if string_t = 0 then 24 | dim as _offset elements(1 to 5) 25 | elements(1) = llvm_int8_type%& 'flags 26 | elements(2) = llvm_int8_type%& 'refcount 27 | elements(3) = llvm_int32_type%& 'used 28 | elements(4) = llvm_int32_type%& 'alloc 29 | elements(5) = llvm_array_type%&(llvm_int8_type%&, 0) 'data 30 | string_t = llvm_struct_type%&(elements(), ubound(elements), FALSE) 31 | end if 32 | ll_cg_str_type%& = string_t 33 | end function 34 | 35 | function ll_cg_str_header$(s$) 36 | dim as _offset string_t 37 | string_t = ll_cg_str_type 38 | flags_offset = llvm_offset_of_element(llvm_get_module_data_layout(ll_cg_state.module), string_t, 0) 39 | 'no need for refcount 40 | used_offset = llvm_offset_of_element(llvm_get_module_data_layout(ll_cg_state.module), string_t, 2) 41 | alloc_offset = llvm_offset_of_element(llvm_get_module_data_layout(ll_cg_state.module), string_t, 3) 42 | 'header size including padding is given by offset of start of data 43 | header_size = llvm_offset_of_element(llvm_get_module_data_layout(ll_cg_state.module), string_t, 4) 44 | header$ = string$(header_size, chr$(0)) 45 | mid$(header$, flags_offset + 1, 1) = chr$(1) 'LB_STRING_READONLY 46 | mid$(header$, used_offset + 1, 4) = mkl$(len(s$)) 47 | mid$(header$, alloc_offset + 1, 4) = mkl$(len(s$)) 48 | ll_cg_str_header$ = header$ 49 | end function 50 | 51 | sub ll_cg_str_free_transients 52 | dim as _offset dummy 53 | dim as ll_arg_t args(1 to 1) 54 | for i = 1 to ll_cg_str_last_queued_transient 55 | args(1) = ll_cg_str_queued_transients(i) 56 | dummy = ll_cg_call(TOK_STRING_MAYBE_FREE, -1, args()) 57 | next i 58 | ll_cg_str_last_queued_transient = 0 59 | end sub 60 | 61 | sub ll_cg_str_queue_transient(s as ll_arg_t) 62 | u = ubound(ll_cg_str_queued_transients) 63 | if ll_cg_str_last_queued_transient = u then 64 | redim _preserve ll_cg_str_queued_transients(u * 2) as ll_arg_t 65 | end if 66 | ll_cg_str_last_queued_transient = ll_cg_str_last_queued_transient + 1 67 | ll_cg_str_queued_transients(ll_cg_str_last_queued_transient) = s 68 | end sub 69 | 70 | function ll_cg_str_assign%&(rvalue as _offset, lvalue as _offset) 71 | dim as ll_arg_t args(1 to 2) 72 | args(1).lp = lvalue 73 | args(1).is_byval = FALSE 74 | args(2).lp = rvalue 75 | args(2).is_byval = TRUE 76 | ll_cg_str_assign%& = ll_cg_call(TOK_STRING_ASSIGN, -1, args()) 77 | end function 78 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/tempfile.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'tempfile.bm - Manage temporary files 4 | 5 | $if WINDOWS then 6 | declare customtype library 7 | function GetTempPath&(byval s_len&, byval s%&) 8 | end declare 9 | 10 | 'This function is incorrect because it separately tests for the non-existence 11 | 'of the temp file, then opens it. 12 | function ll_write_tempfile$ (extension$, buf as _offset, buf_len&&) 13 | chars$ = "1234567890qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" 14 | dim mem as _mem 15 | dir_len = GetTempPath(0, 0) 16 | if dir_len = 0 then fatalerror "Cannot determine temp directory" 17 | mem = _memnew(dir_len + 1) 18 | ret = GetTempPath(dir_len + 1, mem.offset) 19 | if ret = 0 then fatalerror "Cannot determine temp directory" 20 | dir$ = space$(dir_len) 21 | _memget mem, mem.offset, dir$ 22 | _memfree mem 23 | if asc(right$(dir$, 1)) = 0 then dir$ = left$(dir$, len(dir$) - 1) 24 | for i = 1 to 1000 25 | nam$ = "" 26 | for j = 1 to 6 27 | nam$ = nam$ + mid$(chars$, int(rnd * len(chars$)) + 1, 1) 28 | next j 29 | path$ = dir$ + nam$ + extension$ 30 | if not _fileexists(path$) then 31 | fh = freefile 32 | open path$ for binary as #fh 33 | mem = _mem(buf, buf_len&&) 34 | content$ = space$(buf_len&&) 35 | _memget mem, mem.offset, content$ 36 | put #fh, , content$ 37 | close #fh 38 | ll_write_tempfile$ = path$ 39 | exit function 40 | end if 41 | next i 42 | fatalerror "Cannot create temp file" 43 | end function 44 | 45 | $else 46 | 47 | declare customtype library 48 | function mkstemps&(template$, byval suffixlen&) 49 | function c_write&& alias write(byval fd&, byval buf%&, byval count&&) 50 | function c_close& alias close(byval fd&) 51 | end declare 52 | 53 | function ll_write_tempfile$(extension$, buf as _offset, buflen&&) 54 | dir$ = environ$("TMPDIR") 55 | if dir$ = "" then dir$ = "/tmp" 56 | template$ = dir$ + "/XXXXXX" + extension$ + chr$(0) 57 | fd = mkstemps&(template$, len(extension$)) 58 | if fd = -1 then fatalerror "Cannot create temp file" 59 | ' mkstemps modifies the XXXXXX to be the actual value 60 | filename$ = left$(template$, len(template$) - 1) 61 | ret1&& = c_write&&(fd, buf, buflen&&) 62 | if ret1&& < buflen&& then fatalerror "Cannot write temp file" 63 | ret2 = c_close&(fd) 64 | if ret2 = -1 then fatalerror "Cannot write temp file" 65 | ll_write_tempfile$ = filename$ 66 | end function 67 | $end if 68 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/types.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'types.bm - Datatype and identifier management 4 | 5 | 'Name mangling rules: 6 | ' - Covert to all lowercase 7 | ' - Remove any leading underscore 8 | ' - Append $ 9 | ' - Append letter(s) for return type 10 | ' - Append letter(s) for each argument, if any. Make it uppercase if passed by reference 11 | 'The letters used are given by ll_mangle_type$ below. For arrays, "a" is followed by the 12 | 'number of dimensions, then the type of the array element. So "a3i" is a 3-dimensional 13 | 'array of INTEGERs. 14 | 15 | function ll_mangled_proc_name$(plain_name$, sig) 16 | n$ = lcase$(plain_name$) 17 | if left$(n$, 1) = "_" then n$ = mid$(n$, 2) 18 | n$ = n$ + "$" + ll_mangle_type$(type_sig_return(sig)) 19 | for i = 1 to type_sig_numargs(sig) 20 | char$ = ll_mangle_type$(type_sig_argtype(sig, i)) 21 | if (type_sig_argflags(sig, i) AND TYPE_BYVAL) = 0 then 22 | char$ = ucase$(char$) 23 | end if 24 | n$ = n$ + char$ 25 | next i 26 | ll_mangled_proc_name$ = n$ 27 | end function 28 | 29 | function ll_mangle_type$(typ) 30 | select case typ 31 | case TYPE_NONE 32 | ll_mangle_type$ = "n" 33 | case TYPE_ANY 34 | ll_mangle_type$ = "y" 35 | case TYPE_BOOL 36 | ll_mangle_type$ = "b" 37 | case TYPE_INTEGER 38 | ll_mangle_type$ = "i" 39 | case TYPE_LONG 40 | ll_mangle_type$ = "l" 41 | case TYPE_INTEGER64 42 | ll_mangle_type$ = "k" 43 | case TYPE_SINGLE 44 | ll_mangle_type$ = "s" 45 | case TYPE_DOUBLE 46 | ll_mangle_type$ = "d" 47 | case TYPE_QUAD 48 | ll_mangle_type$ = "q" 49 | case TYPE_STRING 50 | ll_mangle_type$ = "t" 'For "text" 51 | case else 52 | if type_is_array(typ) then 53 | ll_mangle_type$ = "a" + ltrim$(str$(typ->array_dims)) + ll_mangle_type$(typ->array_type) 54 | else 55 | ll_error "Unknown type: " + type_human_readable$(typ) 56 | end if 57 | end select 58 | end function 59 | 60 | function ll_pointer_type%&(typ) 61 | ll_pointer_type%& = llvm_pointer_type(ll_type(typ), 0) 62 | end function 63 | 64 | function ll_type%&(typ) 65 | select case typ 66 | case TYPE_NONE 67 | ll_type = llvm_void_type 68 | case TYPE_BOOL 69 | ll_type = llvm_int1_type 70 | case TYPE_INTEGER 71 | ll_type = llvm_int16_type 72 | case TYPE_LONG 73 | ll_type = llvm_int32_type 74 | case TYPE_INTEGER64 75 | ll_type = llvm_int64_type 76 | case TYPE_SINGLE 77 | ll_type = llvm_float_type 78 | case TYPE_DOUBLE 79 | ll_type = llvm_double_type 80 | case TYPE_QUAD 81 | ll_type = llvm_fp128_type 82 | case TYPE_STRING 83 | ll_type = llvm_pointer_type(llvm_int8_type, 0) 84 | case else 85 | if type_is_array(typ) then 86 | ll_type = llvm_pointer_type(ll_cg_array_type, 0) 87 | else 88 | ll_error "bad ll type: " + type_human_readable$(typ) 89 | end if 90 | end select 91 | end function 92 | 93 | function ll_type_size%&(typ as _offset) 94 | dim as _offset gep, indices(1 to 1) 95 | indices(1) = llvm_const_int(llvm_int32_type, 1, TRUE) 96 | gep = llvm_const_in_bounds_gep(llvm_const_pointer_null(llvm_pointer_type(typ, 0)), indices(), 1) 97 | ll_type_size%& = llvm_ptr_to_int(gep, llvm_int64_type) 98 | end function 99 | -------------------------------------------------------------------------------- /compiler/emitters/llvm/vars.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'vars.bm - Code generation for variables 4 | 5 | sub ll_cg_locals(proc_node, entryBB as _offset, cleanupBB as _offset) 6 | 'Copy any byval arguments to allocas so they may be treated identically 7 | 'TODO: byval string support 8 | dim as _offset ptr, store 9 | numargs = ast_num_children(proc_node) - 1 10 | llvm_position_builder_at_end ll_cg_state.builder, entryBB 11 | for i = 1 to numargs 12 | arg = ast_get_child(proc_node, i + 1) 13 | var = arg->ref 14 | if (var->vflags AND SYM_VARIABLE_DEREF) = 0 then 15 | ptr = llvm_build_alloca(ll_cg_state.builder, ll_type(var->type), var->identifier) 16 | store = llvm_build_store(ll_cg_state.builder, var->lp, ptr) 17 | var->lp = ptr 18 | end if 19 | next i 20 | 'Allocate and initialise all other local variables 21 | sig = proc_node->ref2 22 | var = sig->last_var 23 | while var 24 | var->lp = ll_cg_local_var(var->type, var->identifier, entryBB, cleanupBB) 25 | var = var->prev_var 26 | wend 27 | end sub 28 | 29 | function ll_cg_local_var%&(typ, var_name$, entryBB as _offset, cleanupBB as _offset) 30 | dim as _offset lp, constant_zero, dummy 31 | llvm_position_builder_at_end ll_cg_state.builder, entryBB 32 | lp = llvm_build_alloca(ll_cg_state.builder, ll_type(typ), var_name$) 33 | if type_is_int(typ) then 34 | constant_zero = llvm_const_int(ll_type(typ), 0, 0) 35 | elseif type_is_fp(typ) then 36 | constant_zero = llvm_const_real(ll_type(typ), 0) 37 | elseif type_is_array(typ) then 38 | 'No default value because arrays are initialised by AST_ARRAY_CREATE/RESIZE 39 | elseif typ = TYPE_STRING then 40 | constant_zero = ll_cg_str_constant(AST_EMPTY_STRING) 41 | if cleanupBB then 42 | 'cleanup code executed at end of function 43 | llvm_position_builder_at_end ll_cg_state.builder, cleanupBB 44 | dim args(1 to 1) as ll_arg_t 45 | args(1).lp = lp 46 | args(1).is_byval = FALSE 47 | dummy = ll_cg_call(TOK_STRING_MAYBE_FREE, -1, args()) 48 | end if 49 | else 50 | ll_error "Cannot create local var for type" 51 | end if 52 | llvm_position_builder_at_end ll_cg_state.builder, entryBB 53 | if constant_zero then 54 | dummy = llvm_build_store(ll_cg_state.builder, constant_zero, lp) 55 | end if 56 | ll_cg_local_var%& = lp 57 | end function 58 | 59 | 'Variables in an rvalue context 60 | function ll_cg_var%&(node) 61 | var = node->ref 62 | ll_cg_var%& = llvm_build_load(ll_cg_state.builder, var->lp, var->identifier) 63 | end function 64 | 65 | 'Variables in an lvalue context 66 | function ll_cg_lval%&(node) 67 | select case node->atype 68 | case AST_VAR 69 | var = node->ref 70 | ll_cg_lval%& = var->lp 71 | case AST_UDT_ACCESS 72 | ll_error "UDT Unsupported" 73 | case AST_ARRAY_ACCESS 74 | ll_cg_lval%& = ll_cg_array_lval(node) 75 | end select 76 | end function 77 | 78 | function ll_cg_constant%&(node) 79 | constant = node->ref 80 | select case ast_constant_types(constant) 81 | case TYPE_BOOL 82 | ll_cg_constant%& = llvm_const_int_of_string(llvm_int1_type, ast_constants(constant), 10) 83 | case TYPE_INTEGER 84 | ll_cg_constant%& = llvm_const_int_of_string(llvm_int16_type, ast_constants(constant), 10) 85 | case TYPE_LONG 86 | ll_cg_constant%& = llvm_const_int_of_string(llvm_int32_type, ast_constants(constant), 10) 87 | case TYPE_INTEGER64 88 | ll_cg_constant%& = llvm_const_int_of_string(llvm_int64_type, ast_constants(constant), 10) 89 | case TYPE_SINGLE 90 | ll_cg_constant%& = llvm_const_real_of_string(llvm_float_type, ast_constants(constant)) 91 | case TYPE_DOUBLE 92 | ll_cg_constant%& = llvm_const_real_of_string(llvm_double_type, ast_constants(constant)) 93 | case TYPE_QUAD 94 | ll_cg_constant%& = llvm_const_real_of_string(llvm_fp128_type, ast_constants(constant)) 95 | case TYPE_STRING 96 | ll_cg_constant%& = ll_cg_str_constant(constant) 97 | case else 98 | ll_error "Bad constant type" 99 | end select 100 | end function 101 | 102 | -------------------------------------------------------------------------------- /compiler/parser/assignment.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'assignment.bm - Parse rules for variable assignment 4 | 5 | 'Expects: lvalue token 6 | 'Results: token after rvalue 7 | function ps_assignment 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start assignment" 10 | $end if 11 | root = ast_add_node(AST_ASSIGN) 12 | 13 | lval = ps_lvalue_mutable 14 | ast_attach root, lval 15 | ps_consume TOK_EQUALS 16 | 17 | expr = ps_expr 18 | lvalue_type = type_of_lvalue(lval) 19 | rvalue_type = type_of_expr(expr) 20 | if not type_can_cast(rvalue_type, lvalue_type) then ps_error "Type of variable in assignment does not match value being assigned" 21 | expr = expr->cast(lvalue_type) 22 | root->attach(expr) 23 | 24 | ps_assignment = root 25 | $if DEBUG_PARSE_TRACE then 26 | debuginfo "Completed assignment" 27 | $end if 28 | end function 29 | 30 | -------------------------------------------------------------------------------- /compiler/parser/common.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'const.bm - Parse rules for COMMON 4 | 5 | 'Expects: TOK_COMMON 6 | 'Results: token after list 7 | sub ps_common 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start common" 10 | $end if 11 | 12 | ps_consume TOK_COMMON 13 | do 14 | 15 | if tok_token->stype <> SYM_FUNCTION then ps_error "Only functions may be COMMON" 16 | if tok_token->func_flags AND SYM_FUNCTION_INTRINSIC then 17 | ps_error "Cannot make intrinsic function COMMON" 18 | end if 19 | tok_token->func_flags = tok_token->func_flags OR SYM_FUNCTION_PUBLIC 20 | tok_advance 21 | loop while ps_consumed(TOK_COMMA) 22 | ps_is_module = TRUE 23 | 24 | $if DEBUG_PARSE_TRACE then 25 | debuginfo "Completed common" 26 | $end if 27 | end sub 28 | 29 | -------------------------------------------------------------------------------- /compiler/parser/const.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'const.bm - Parse rules for CONST 4 | 5 | 'Expects: TOK_CONST 6 | 'Results: token after rvalue 7 | function ps_const 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start const" 10 | $end if 11 | ps_consume TOK_CONST 12 | 'We use a block so we can deal with multiple consts 13 | root = ast_add_node(AST_BLOCK) 14 | 15 | do 16 | if tok_token <> TOK_UNKNOWN then ps_error "CONST already defined" 17 | const_name$ = tok_content$ 18 | tok_advance 19 | sigil = ps_opt_sigil 20 | var = ps_new_var_pp(const_name$, sigil, TRUE, FALSE) 21 | lval = ast_add_node(AST_VAR) 22 | lval->ref = var 23 | var->vflags = var->vflags or SYM_VARIABLE_CONST 'Mark constant 24 | assignment = ast_add_node(AST_ASSIGN) 25 | root->attach(assignment) 26 | assignment->attach(lval) 27 | ps_consume TOK_EQUALS 28 | 29 | expr = ps_expr 30 | if sigil = 0 then 31 | var->type = type_of_expr(expr) 32 | ast_attach assignment, expr 33 | elseif type_can_cast(type_of_expr(expr), sigil) then 34 | cast = ast_add_node(AST_CAST) 35 | cast->ref = sigil 36 | cast->attach(expr) 37 | assignment->attach(cast) 38 | else 39 | ps_error "Type mismatch" 40 | end if 41 | loop while ps_consumed(TOK_COMMA) 42 | 43 | ps_const = root 44 | $if DEBUG_PARSE_TRACE then 45 | debuginfo "Completed const" 46 | $end if 47 | end function 48 | -------------------------------------------------------------------------------- /compiler/parser/default_type.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'default_type.bm - Parse rules for DEF* A-Z and _DEFINE A-Z commands 4 | 5 | 'Expects: TOK_DEF{INT,LNG,SNG,DBL,STR} 6 | 'Results: NEWLINE 7 | sub ps_deftype 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start deftype" 10 | $end if 11 | token = tok_token 12 | 'Do error checking for making any changes 13 | tok_advance 14 | if ucase$(tok_content$) <> "A" then ps_error "Range must be A-Z" 15 | tok_advance 16 | ps_consume TOK_DASH 17 | if ucase$(tok_content$) <> "Z" then ps_error "Range must be A-Z" 18 | tok_advance 19 | select case token 20 | case TOK_DEFINT 21 | ps_default_type = TYPE_INTEGER 22 | case TOK_DEFLNG 23 | ps_default_type = TYPE_LONG 24 | case TOK_DEFSNG 25 | ps_default_type = TYPE_SINGLE 26 | case TOK_DEFDBL 27 | ps_default_type = TYPE_DOUBLE 28 | case TOK_DEFSTR 29 | ps_default_type = TYPE_STRING 30 | end select 31 | $if DEBUG_PARSE_TRACE then 32 | debuginfo "Completed deftype" 33 | $end if 34 | end sub 35 | 36 | 'Expects: TOK__DEFINE 37 | 'Results: NEWLINE 38 | sub ps_define_type 39 | $if DEBUG_PARSE_TRACE then 40 | debuginfo "Start define type" 41 | $end if 42 | ps_consume TOK__DEFINE 43 | if ucase$(tok_content$) <> "A" then ps_error "Range must be A-Z" 44 | tok_advance 45 | ps_consume TOK_DASH 46 | if ucase$(tok_content$) <> "Z" then ps_error "Range must be A-Z" 47 | tok_advance 48 | typ = ps_opt_sigil 49 | if typ = 0 then ps_error "Expected type specifier" 50 | ps_default_type = typ 51 | $if DEBUG_PARSE_TRACE then 52 | debuginfo "Completed define type" 53 | $end if 54 | end sub 55 | -------------------------------------------------------------------------------- /compiler/parser/drawing.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'drawing.bm - Parse rules for vector drawing commands 4 | -------------------------------------------------------------------------------- /compiler/parser/exit.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'exit.bm - Parse rules for EXIT statements 4 | 5 | function ps_exit 6 | $if DEBUG_PARSE_TRACE then 7 | debuginfo "Start exit" 8 | $end if 9 | root = ast_add_node(AST_EXIT) 10 | ps_consume TOK_EXIT 11 | 12 | select case tok_token 13 | case TOK_DO 14 | target = ps_last_nested(AST_DO_PRE) 15 | if target = 0 then target = ps_last_nested(AST_DO_POST) 16 | case TOK_WHILE 17 | target = ps_last_nested(AST_WHILE) 18 | case TOK_FOR 19 | target = ps_last_nested(AST_FOR) 20 | case TOK_FUNCTION, TOK_SUB 21 | target = ps_last_nested(AST_PROCEDURE) 22 | case else 23 | ps_error "Expected DO, WHILE or FOR" 24 | end select 25 | if target = 0 then ps_error "Not inside a " + tok_human_readable$(tok_token) + " block" 26 | tok_advance 27 | root->ref = target 28 | 29 | ps_exit = root 30 | $if DEBUG_PARSE_TRACE then 31 | debuginfo "Completed exit" 32 | $end if 33 | end function 34 | -------------------------------------------------------------------------------- /compiler/parser/for.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'for.bm - Parse rules for FOR loop 4 | 5 | 'Expects: FOR 6 | 'Results: NEWLINE after NEXT or iterator variable 7 | function ps_for 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start FOR loop" 10 | $end if 11 | root = ast_add_node(AST_FOR) 12 | ps_add_nested_structure root 13 | ps_consume TOK_FOR 14 | 15 | var = ps_lvalue_mutable 16 | var_type = type_of_lvalue(var) 17 | if not type_is_number(var_type) then ps_error "FOR iterator variable must be numeric" 18 | root->attach(var) 19 | ps_consume TOK_EQUALS 20 | 21 | start_val = ps_expr 22 | if not type_is_number(type_of_expr(start_val)) then ps_error "FOR start value must be numeric" 23 | if type_of_expr(start_val) <> var_type then 24 | cast = ast_add_node(AST_CAST) 25 | cast->ref = var_type 26 | cast->attach(start_val) 27 | start_val = cast 28 | end if 29 | ps_consume TOK_TO 30 | 31 | end_val = ps_expr 32 | if not type_is_number(type_of_expr(end_val)) then ps_error "FOR end value must be numeric" 33 | if type_of_expr(end_val) <> var_type then 34 | cast = ast_add_node(AST_CAST) 35 | cast->ref = var_type 36 | cast->attach(end_val) 37 | end_val = cast 38 | end if 39 | 40 | if tok_token = TOK_STEP then 41 | ps_consume TOK_STEP 42 | step_val = ps_expr 43 | if not type_is_number(type_of_expr(step_val)) then ps_error "FOR STEP value must be numeric" 44 | else 45 | step_val = ast_add_node(AST_CONSTANT) 46 | step_val->ref = AST_ONE 47 | end if 48 | if type_of_expr(step_val) <> var_type then 49 | cast = ast_add_node(AST_CAST) 50 | cast->ref = var_type 51 | cast->attach(step_val) 52 | step_val = cast 53 | end if 54 | ps_consume TOK_NEWLINE 55 | 56 | root->attach(start_val) 57 | root->attach(end_val) 58 | root->attach(step_val) 59 | root->attach(ps_block) 60 | 61 | ps_consume TOK_NEXT 62 | 'TODO: Check this lvalue matches the one at the top of the loop 63 | if tok_token <> TOK_NEWLINE then dummy = ps_lvalue_mutable 64 | 65 | ps_remove_nested_structure 66 | ps_for = root 67 | $if DEBUG_PARSE_TRACE then 68 | debuginfo "Completed FOR loop" 69 | $end if 70 | end function 71 | -------------------------------------------------------------------------------- /compiler/parser/goto.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'goto.bm - Parse rules for GOTO statement 4 | 5 | 'Expects: GOTO 6 | 'Results: token after line number 7 | function ps_goto 8 | ps_consume TOK_GOTO 9 | ps_goto = ps_goto_p 10 | end function 11 | 12 | 'Expects: line number 13 | 'Results: token after line number 14 | function ps_goto_p 15 | $if DEBUG_PARSE_TRACE then 16 | debuginfo "Start goto" 17 | $end if 18 | ps_assert TOK_NUMINT 19 | root = ast_add_node(AST_GOTO) 20 | id = symtab_get_id(tok_content$) 21 | if id > 0 and id->label_found and id->label_node > 0 then 22 | 'Label exists, is resolved and is attached 23 | $if DEBUG_PARSE_TRACE then 24 | debuginfo "Goto resolves to" + str$(id->label_node) 25 | $end if 26 | root->ref = id->label_node 27 | elseif id > 0 then 28 | 'This case helps with things like "10 GOTO 10" (label resolved but not attached) 29 | $if DEBUG_PARSE_TRACE then 30 | debuginfo "Reference to pre-existing unresolved or unattached label" 31 | $end if 32 | root->ref = id 33 | ps_unresolved_jumps$ = ps_unresolved_jumps$ + mkl$(root) 34 | else 35 | $if DEBUG_PARSE_TRACE then 36 | debuginfo "Unresolved goto" 37 | $end if 38 | dim symtab_label as symtab_entry_t 39 | symtab_label.identifier = tok_content$ 40 | symtab_add_entry symtab_label 41 | symtab_last_entry->stype = SYM_LABEL 42 | 'Unresolved, so point directly to the label 43 | root->ref = symtab_last_entry 44 | ps_unresolved_jumps$ = ps_unresolved_jumps$ + mkl$(root) 45 | end if 46 | ps_consume TOK_NUMINT 47 | ps_goto_p = root 48 | $if DEBUG_PARSE_TRACE then 49 | debuginfo "Completed goto" 50 | $end if 51 | end function 52 | -------------------------------------------------------------------------------- /compiler/parser/if.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'if.bm - Parse rules for IF statement 4 | 5 | 'Expects: IF 6 | 'Results: newline 7 | function ps_if 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start conditional" 10 | $end if 11 | root = ast_add_node(AST_IF) 12 | ps_consume TOK_IF 13 | ps_add_nested_structure root 14 | 15 | condition = ps_expr 16 | if not type_is_number(type_of_expr(condition)) then ps_error "Condition must be a numeric expression" 17 | root->attach(condition) 18 | ps_consume TOK_THEN 19 | 20 | 'A REM after THEN acts as a command; we remain in single-line if mode 21 | if ucase$(tok_content$) = "REM" then 22 | block = ast_add_node(AST_BLOCK) 23 | root->attach(block) 24 | ps_remove_nested_structure 25 | ps_if = root 26 | $if DEBUG_PARSE_TRACE then 27 | debuginfo "Completed conditional (single-line REM)" 28 | $end if 29 | exit function 30 | end if 31 | 32 | if tok_token <> TOK_NEWLINE or ps_is_linejoin then 33 | $if DEBUG_PARSE_TRACE then 34 | debuginfo "Single-line IF" 35 | $end if 36 | root->attach(ps_if_stmts) 37 | if tok_token = TOK_ELSE then 38 | ps_consume TOK_ELSE 39 | root->attach(ps_if_stmts) 40 | end if 41 | else 42 | $if DEBUG_PARSE_TRACE then 43 | debuginfo "Multi-line IF" 44 | $end if 45 | root->attach(ps_block) 46 | do while tok_token = TOK_ELSEIF 47 | ps_consume TOK_ELSEIF 48 | condition = ps_expr 49 | if not type_is_number(type_of_expr(condition)) then ps_error "Condition must be a numeric expression" 50 | root->attach(condition) 51 | ps_consume TOK_THEN 52 | root->attach(ps_block) 53 | loop 54 | if tok_token = TOK_ELSE then 55 | ps_consume TOK_ELSE 56 | root->attach(ps_block) 57 | end if 58 | ps_consume TOK_END 59 | ps_consume TOK_IF 60 | end if 61 | 62 | ps_remove_nested_structure 63 | ps_if = root 64 | $if DEBUG_PARSE_TRACE then 65 | debuginfo "Completed conditional" 66 | $end if 67 | end function 68 | 69 | 'Expects: Start of a statement or : 70 | 'Results: ELSE or NEWLINE 71 | 'Note: This handles one or more statements joined by : and terminated by ELSE/NEWLINE, or an implicit GOTO 72 | function ps_if_stmts 73 | $if DEBUG_PARSE_TRACE then 74 | debuginfo "Start if stmts" 75 | $end if 76 | block = ast_add_node(AST_BLOCK) 77 | if tok_token = TOK_NUMINT then 78 | block->attach(ps_goto_p) 79 | else 80 | do 81 | while ps_is_linejoin 82 | ps_consume TOK_NEWLINE 83 | wend 84 | stmt = ps_stmt 85 | block->attach(stmt) 86 | while ps_is_linejoin 87 | ps_consume TOK_NEWLINE 88 | wend 89 | loop until ps_is_terminator(tok_token) 90 | end if 91 | ps_if_stmts = block 92 | $if DEBUG_PARSE_TRACE then 93 | debuginfo "Completed if stmts" 94 | $end if 95 | end function 96 | -------------------------------------------------------------------------------- /compiler/parser/input.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'input.bm - Parse rules for INPUT statement 4 | 5 | 'Expects: TOK_INPUT or TOK_LINEINPUT 6 | 'Results: token after input variables 7 | 'Format: INPUT[;]["prompt"{;|,}]variablelist 8 | 'or LINE INPUT[;]["prompt"{;|,}]variable$ 9 | function ps_stmt_input 10 | $if DEBUG_PARSE_TRACE then 11 | debuginfo "Start stmt input" 12 | $end if 13 | root = ast_add_node(AST_CALL) 14 | root->ref = TOK_INPUT 15 | root->ref2 = TOK_INPUT->sig 16 | flags = ast_add_node(AST_FLAGS) 17 | flags->ref = AST_FLAG_MANUAL 18 | root->attach(flags) 19 | flags->ref2 = 0 20 | if ps_consumed(TOK_LINEINPUT) then 21 | flags->ref2 = flags->ref2 OR STMT_INPUT_LINEMODE 22 | linemode = TRUE 23 | end if 24 | ps_consume TOK_INPUT 25 | 26 | if ps_consumed(TOK_SEMICOLON) then 27 | flags->ref2 = STMT_INPUT_NO_NEWLINE 28 | end if 29 | 30 | 'The prompt must be a literal string, no expressions. Crazy, right? 31 | if tok_token = TOK_STRINGLIT then 32 | prompt = ast_add_node(AST_CONSTANT) 33 | prompt->ref = ast_add_constant(tok_token, tok_content$, TYPE_STRINGLIT) 34 | flags->ref2 = flags->ref2 OR STMT_INPUT_PROMPT 35 | root->attach(prompt) 36 | ps_consume TOK_STRINGLIT 37 | if tok_token = TOK_COMMA then 38 | flags->ref2 = flags->ref2 OR STMT_INPUT_NO_QUESTION 39 | ps_consume TOK_COMMA 40 | else 41 | ps_consume TOK_SEMICOLON 42 | end if 43 | 'It turns out INPUT and LINE INPUT interpret the {;|,} with exactly opposite 44 | 'meaning 45 | if linemode then 46 | flags->ref2 = flags->ref2 XOR STMT_INPUT_NO_QUESTION 47 | end if 48 | end if 49 | 50 | if linemode then 51 | var = ps_lvalue_mutable 52 | if type_of_lvalue(var) <> TYPE_STRING then ps_error "Variable must be a string" 53 | root->attach(var) 54 | else 55 | do 56 | var = ps_lvalue_mutable 57 | root->attach(var) 58 | loop while ps_consumed(TOK_COMMA) 59 | end if 60 | 61 | ps_stmt_input = root 62 | $if DEBUG_PARSE_TRACE then 63 | debuginfo "Completed stmt input" 64 | $end if 65 | end function 66 | -------------------------------------------------------------------------------- /compiler/parser/labels.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'labels.bm - Parse rule for labels and utility functions for handling them 4 | 5 | 'Expects: TOK_LINENUM 6 | 'Results: next token 7 | 'Note: this is for label definitions, not references 8 | sub ps_label 9 | $if DEBUG_PARSE_TRACE then 10 | debuginfo "Start label" 11 | $end if 12 | id = symtab_get_id(tok_content$) 13 | if id > 0 and id->stype <> SYM_LABEL then 14 | ps_error "Label name conflicts with existing identifier" 15 | elseif id > 0 and id->label_found then 16 | ps_error "Label already defined" 17 | elseif id > 0 then 18 | 'This is a label that was only referenced until now; mark it found 19 | id->label_found = TRUE 20 | else 21 | dim symtab_label as symtab_entry_t 22 | symtab_label.identifier = tok_content$ 23 | symtab_add_entry symtab_label 24 | id = symtab_last_entry 25 | id->stype = SYM_LABEL 26 | id->label_found = TRUE 27 | end if 28 | ps_unattached_labels$ = ps_unattached_labels$ + mkl$(id) 29 | ps_consume TOK_LINENUM 30 | $if DEBUG_PARSE_TRACE then 31 | debuginfo "Completed label" 32 | $end if 33 | end sub 34 | 35 | 'There may have been 0 or more labels since the last statement that produced 36 | 'nodes (some non-executable statements may not produce nodes). This attaches 37 | 'those labels to a node. It also resolves any jumps to those labels to point 38 | 'to the node. 39 | sub ps_attach_labels(node) 40 | if node > 0 then 41 | for i = 1 to len(ps_unattached_labels$) step 4 42 | label_id = cvl(mid$(ps_unattached_labels$, i, 4)) 43 | $if DEBUG_PARSE_TRACE then 44 | debuginfo "Attached label " + label_id->identifier 45 | $end if 46 | label_id->label_node = node 47 | 'Have we resolved an unresolved jump? 48 | for j = 1 to len(ps_unresolved_jumps$) step 4 49 | unres_node = cvl(mid$(ps_unresolved_jumps$, j, 4)) 50 | if unres_node->ref = label_id then 51 | unres_node->ref = node 52 | else 53 | still_unres$ = still_unres$ + mkl$(unres_node) 54 | end if 55 | next j 56 | ps_unresolved_jumps$ = still_unres$ 57 | next i 58 | ps_unattached_labels$ = "" 59 | end if 60 | end sub 61 | 62 | 'Handles any labels not yet attached by the end of the program, because 63 | 'they're trailing empty lines or trailing non-executable statements. 64 | 'Also ensures all references point to an existent label. 65 | sub ps_finish_labels(block) 66 | if len(ps_unattached_labels$) > 0 then 67 | end_node = ast_add_node(AST_BLOCK) 68 | block->attach(end_node) 69 | ps_attach_labels end_node 70 | end if 71 | if len(ps_unresolved_jumps$) then 72 | $macro: ps_finish_label_name(@@) | symtab(ast_nodes(cvl(mid$(ps_unresolved_jumps$, @1, 4))).ref).identifier 73 | labels$ = ps_finish_label_name(1) 74 | for i = 5 to len(ps_unresolved_jumps$) step 4 75 | labels$ = ", " + ps_finish_label_name(i) 76 | next i 77 | ps_error "Undefined label(s): " + labels$ 78 | end if 79 | end sub 80 | 81 | -------------------------------------------------------------------------------- /compiler/parser/loop.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'loop.bm - Parse rules for DO LOOP and WHILE WEND 4 | 5 | 'Expects: WHILE 6 | 'Results: NEWLINE after WEND 7 | function ps_while 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start WHILE loop" 10 | $end if 11 | root = ast_add_node(AST_WHILE) 12 | ps_add_nested_structure root 13 | ps_consume TOK_WHILE 14 | 15 | root->attach(ps_expr) 16 | ps_consume TOK_NEWLINE 17 | 18 | root->attach(ps_block) 19 | ps_consume TOK_WEND 20 | 21 | ps_remove_nested_structure 22 | ps_while = root 23 | $if DEBUG_PARSE_TRACE then 24 | debuginfo "Completed WHILE loop" 25 | $end if 26 | end function 27 | 28 | 'Expects: DO 29 | 'Results: NEWLINE after LOOP or condition 30 | function ps_do 31 | $if DEBUG_PARSE_TRACE then 32 | debuginfo "Start DO loop" 33 | $end if 34 | ps_consume TOK_DO 35 | if tok_token = TOK_WHILE or tok_token = TOK_UNTIL then ps_do = ps_do_pre else ps_do = ps_do_post 36 | $if DEBUG_PARSE_TRACE then 37 | debuginfo "Completed DO loop" 38 | $end if 39 | end function 40 | 41 | 'Expects: WHILE or UNTIL 42 | 'Results: NEWLINE after LOOP 43 | function ps_do_pre 44 | $if DEBUG_PARSE_TRACE then 45 | debuginfo "Start DO-pre loop" 46 | $end if 47 | root = ast_add_node(AST_DO_PRE) 48 | ps_add_nested_structure root 49 | if tok_token = TOK_UNTIL then 50 | ps_consume TOK_UNTIL 51 | 'Need to invert guard condition 52 | guard = ast_add_node(AST_CALL) 53 | guard->ref = TOK_EQUALS 54 | sig$ = type_sigt_add_arg(type_sigt_add_arg(type_sigt_create$(TYPE_ANY), TYPE_INTEGER, 0), TYPE_INTEGER, 0) 55 | guard->ref2 = type_find_sig_match(TOK_EQUALS, sig$) 56 | guard->attach(ps_expr) 57 | f = ast_add_node(AST_CONSTANT) 58 | f->ref = AST_FALSE 59 | guard->attach(f) 60 | else 61 | ps_consume TOK_WHILE 62 | guard = ps_expr 63 | end if 64 | root->attach(guard) 65 | ps_consume TOK_NEWLINE 66 | 67 | root->attach(ps_block) 68 | ps_consume TOK_LOOP 69 | 70 | ps_remove_nested_structure 71 | ps_do_pre = root 72 | $if DEBUG_PARSE_TRACE then 73 | debuginfo "Completed DO-pre loop" 74 | $end if 75 | end function 76 | 77 | 'Expects: NEWLINE 78 | 'Results: NEWLINE after loop guard condition 79 | function ps_do_post 80 | $if DEBUG_PARSE_TRACE then 81 | debuginfo "Start DO-post loop" 82 | $end if 83 | ps_consume TOK_NEWLINE 84 | root = ast_add_node(AST_DO_POST) 85 | ps_add_nested_structure root 86 | block = ps_block 87 | 88 | ps_consume TOK_LOOP 89 | if tok_token = TOK_UNTIL then 90 | ps_consume TOK_UNTIL 91 | 'Need to invert guard condition 92 | guard = ast_add_node(AST_CALL) 93 | guard->ref = TOK_EQUALS 94 | sig$ = type_sigt_add_arg(type_sigt_add_arg(type_sigt_create$(TYPE_ANY), TYPE_INTEGER, 0), TYPE_INTEGER, 0) 95 | guard->ref2 = type_find_sig_match(TOK_EQUALS, sig$) 96 | guard->attach(ps_expr) 97 | f = ast_add_node(AST_CONSTANT) 98 | f->ref = AST_FALSE 99 | guard->attach(f) 100 | elseif tok_token = TOK_WHILE then 101 | ps_consume TOK_WHILE 102 | guard = ps_expr 103 | else 104 | 'Infinite loop 105 | guard = ast_add_node(AST_CONSTANT) 106 | guard->ref = AST_TRUE 107 | end if 108 | root->attach(guard) 109 | root->attach(block) 110 | 111 | ps_remove_nested_structure 112 | ps_do_post = root 113 | $if DEBUG_PARSE_TRACE then 114 | debuginfo "Completed DO-post loop" 115 | $end if 116 | end function 117 | -------------------------------------------------------------------------------- /compiler/parser/metacommands.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'metacommands.bm - Process $metacommands in parser 4 | 5 | 'Expects: META_LIST 6 | 'Results: TOK_NEWLINE 7 | sub ps_meta_list 8 | $if DEBUG_DUMP then 9 | ps_consume META_LIST 10 | category$ = "SYMTAB" 11 | if tok_token = TOK_METAPARAM then 12 | category$ = _trim$(ucase$(tok_content$)) 13 | ps_consume TOK_METAPARAM 14 | end if 15 | select case left$(category$, 1) 16 | case "S" 'SYMTAB 17 | dump_symtab 18 | case "F" 'FUNCTIONS 19 | dump_functions 20 | case "P" 'PROGRAM 21 | dump_ast AST_ENTRYPOINT, 0 22 | dump_subprocedures 23 | case "C" 'CONSTANTS 24 | dump_constants 25 | case else 26 | ps_error "$LIST [SFPC]" 27 | end select 28 | $else 29 | ps_error "Feature not enabled" 30 | $end if 31 | end sub 32 | 33 | 'Expects: META_DEBUG 34 | 'Results: TOK_NEWLINE 35 | sub ps_meta_debug 36 | ps_consume META_DEBUG 37 | action$ = "ON" 38 | if tok_token = TOK_METAPARAM then 39 | action$ = _trim$(ucase$(tok_content$)) 40 | ps_consume TOK_METAPARAM 41 | end if 42 | select case action$ 43 | case "ON" 44 | options.debug = TRUE 45 | case "OFF" 46 | options.debug = FALSE 47 | case else 48 | ps_error "$DEBUG [ON|OFF]" 49 | end select 50 | end sub 51 | 52 | 'Expects: META_INCLUDE 53 | 'Results: TOK_NEWLINE 54 | sub ps_meta_include 55 | $if DEBUG_PARSE_TRACE then 56 | debuginfo "Start $include" 57 | $end if 58 | ps_consume META_INCLUDE 59 | if tok_token <> TOK_METAPARAM then ps_error "Filename required" 60 | filename$ = _trim$(tok_content$) 61 | tok_advance 'Consume file name 62 | if left$(filename$, 1) <> "'" or right$(filename$, 1) <> "'" then 63 | ps_error "Filename must be surrounded by single quotes" 64 | end if 65 | filename$ = mid$(filename$, 2, len(filename$) - 2) 66 | 'A relative path is relative to the location of the including file 67 | filename$ = locate_path$(filename$, input_files(input_files_current).dirname) 68 | add_input_file filename$, TRUE 69 | $if DEBUG_PARSE_TRACE then 70 | debuginfo "Completed $include" 71 | $end if 72 | end sub 73 | 74 | 'Expects: META_OPTION 75 | 'Results: TOK_NEWLINE 76 | sub ps_meta_option 77 | $if DEBUG_PARSE_TRACE then 78 | debuginfo "Start $option" 79 | $end if 80 | ps_consume META_OPTION 81 | if tok_token <> TOK_METAPARAM then ps_error "Expected list of options" 82 | redim options(0) as string 83 | split ucase$(tok_content$), ",", options() 84 | for i = 0 to ubound(options) 85 | plus = TRUE 86 | if left$(options(i), 1) = "+" then 87 | plus = TRUE 88 | options(i) = mid$(options(i), 2) 89 | elseif left$(options(i), 1) = "-" then 90 | plus = FALSE 91 | options(i) = mid$(options(i), 2) 92 | end if 93 | select case _trim$(options(i)) 94 | case "_EXPLICIT", "EXPLICIT" 95 | ps_allow_implicit_vars = not plus 96 | case "_EXPLICITARRAY" 97 | 'Arrays are never allowed to be implicit so this is always in effect. 98 | 'Ignore silently for compatibility. 99 | case "OVERFLOW" 100 | imm_allow_overflow = plus 101 | case else 102 | ps_error "Unknown option " + options(i) 103 | end select 104 | next i 105 | tok_advance 106 | $if DEBUG_PARSE_TRACE then 107 | debuginfo "Completed $option" 108 | $end if 109 | end sub 110 | 111 | 'Expects: META_MODULE 112 | 'Results: TOK_NEWLINE 113 | sub ps_meta_module 114 | $if DEBUG_PARSE_TRACE then 115 | debuginfo "Start $module" 116 | $end if 117 | 118 | ps_consume META_MODULE 119 | ps_is_module = TRUE 120 | 121 | $if DEBUG_PARSE_TRACE then 122 | debuginfo "Completed $module" 123 | $end if 124 | end sub 125 | 126 | 'Expects: unknown metacommand 127 | 'Results: TOK_NEWLINE 128 | sub ps_meta_unknown 129 | $if DEBUG_PARSE_TRACE then 130 | debuginfo "Metacommand " + tok_content$ + " is unknown" 131 | $end if 132 | while tok_token <> TOK_NEWLINE 133 | tok_advance 134 | wend 135 | end sub 136 | -------------------------------------------------------------------------------- /compiler/parser/option.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'option.bm - Parse rules for the OPTION statement 4 | 5 | 'Expects: TOK_OPTION 6 | 'Results: NEWLINE 7 | sub ps_stmt_option 8 | ps_consume TOK_OPTION 9 | if ps_consumed(TOK__EXPLICIT) then 10 | ps_allow_implicit_vars = FALSE 11 | elseif ps_consumed(TOK__EXPLICITARRAY) then 12 | 'Arrays are never allowed to be implicit so this is always in effect. 13 | 'Ignore silently for compatibility. 14 | else 15 | ps_error "Expected OPTION _EXPLICIT" 16 | end if 17 | end sub 18 | -------------------------------------------------------------------------------- /compiler/parser/parser.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'parser.bi - Declarations for parser module 4 | 5 | $include: 'tokeng.bi' 6 | 7 | 'The symtab entry of the last local variable created, used to help build the 8 | 'linked list. 9 | 'This applies to the current scope - the parser for subs/functions will save and 10 | 'restore this value so it is preserved for the main program. 11 | dim shared ps_scoped_last_var as long 12 | 13 | 'When in a sub/function, we make the main program's last_var available too so that 14 | 'STATIC variables can be made part of the main program's scope. This value is only 15 | 'valid when in a sub/function. 16 | dim shared ps_main_last_var as long 17 | 18 | 'actual as opposed to any explicit old-timey line numbers/labels in the program 19 | dim shared ps_actual_linenum as long 20 | 21 | dim shared ps_default_type as long 22 | 23 | 'Set TRUE if processing a preload file, meaning internal functions 24 | 'can be overridden with user-supplied ones. 25 | dim shared ps_is_preload as long 26 | 27 | 'Whether we are compiling a module, so no public main function. 28 | dim shared ps_is_module as long 29 | 30 | 'mkl$ list of symtab labels that are not attached to an AST node. 31 | 'This occurs if you have labels on empty or non-executable lines. 32 | dim shared ps_unattached_labels$ 33 | 34 | 'mkl$ list of nodes that ref a label location but were unresolved 35 | 'because the label hadn't been positioned yet. 36 | dim shared ps_unresolved_jumps$ 37 | 38 | 'mkl$ list of nodes that are DO, WHILE, FOR, SUB/FUNCTION for the purposes of 39 | 'parsing EXIT statements. 40 | dim shared ps_nested_structures$ 41 | 42 | 'Name of the containing function, used as part of a prefix for local objects. 43 | dim shared ps_scope_name$ 44 | 'Numeric value used to disambiguate different scopes with the same name 45 | dim shared ps_scope_id 46 | 47 | 'Sometimes we need to run cleanup code just before exiting a scope. This is 48 | 'a list of nodes to be added to the end of a scope's block. 49 | dim shared ps_queued_cleanup_nodes$ 50 | 51 | 'Like above, but for entry into a scope 52 | dim shared ps_queued_entry_nodes$ 53 | 54 | 'Set to FALSE if OPTION _EXPLICIT is in effect 55 | dim shared ps_allow_implicit_vars 56 | -------------------------------------------------------------------------------- /compiler/parser/pratt.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'pratt.bm - Expression parser using the Pratt algorithm 4 | 5 | 'Expects: first token of expr 6 | 'Results: token after expression 7 | 'Note: the expression parser is greedy; it will only stop when it encounters 8 | ' a token that cannot possibly be part of an expression. 9 | function ps_expr 10 | $if DEBUG_PARSE_TRACE then 11 | debuginfo "Start expr" 12 | $end if 13 | ps_expr = pt_expr(0) 14 | $if DEBUG_PARSE_TRACE then 15 | debuginfo "Completed expr" 16 | $end if 17 | end function 18 | 19 | function pt_expr(rbp) 20 | t = tok_token 21 | content$ = tok_content$ 22 | tok_advance 23 | left_node = nud(t, content$) 24 | while rbp < lbp(tok_token, tok_content$) 25 | t = tok_token 26 | content$ = tok_content$ 27 | tok_advance 28 | left_node = led(t, content$, left_node) 29 | wend 30 | pt_expr = left_node 31 | end function 32 | 33 | 'tok_token is positioned one after whatever token is. 34 | 'ps_ functions called from here usually need to be specially written 35 | 'to take their first token as an argument instead of from tok_token. 36 | function nud(token, content$) 37 | select case token 38 | case TOK_NUMINT, TOK_NUMBASE, TOK_NUMDEC, TOK_NUMEXP, TOK_STRINGLIT 39 | node = ast_add_node(AST_CONSTANT) 40 | node->ref = ast_add_constant(token, content$, ps_opt_sigil) 41 | case TOK_OPAREN 42 | node = pt_expr(0) 43 | ps_consume TOK_CPAREN 44 | case TOK_DASH 45 | 'Hardcoded hack to change TOK_DASH into TOK_NEGATIVE 46 | token = TOK_NEGATIVE 47 | goto negative_hack 48 | case TOK_UNKNOWN 49 | 'Implicit variable definitions 50 | node = ps_simple_variable_p(token, content$) 51 | case else 52 | negative_hack: 53 | select case token->stype 54 | case SYM_FUNCTION 55 | node = ps_funccall_p(token) 56 | case SYM_VARIABLE 57 | node = ps_lvalue_p(token, content$) 58 | case SYM_PREFIX 59 | node = ast_add_node(AST_CALL) 60 | node->ref = token 61 | expr = pt_expr(token->precedence) 62 | if type_is_lvalue(expr) then candidate_flags = TYPE_BYREF 63 | candidate$ = type_sigt_create$(TYPE_ANY) 64 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr), flags) 65 | matching_sig = type_find_sig_match(token, candidate$) 66 | if matching_sig = 0 then ps_error "Cannot find matching type signature" 67 | cast = ast_add_cast(expr, type_sig_argtype(matching_sig, 1)) 68 | node->attach(cast) 69 | node->ref2 = matching_sig 70 | case else 71 | ps_error "Unexpected " + tok_human_readable$(token) 72 | end select 73 | end select 74 | nud = node 75 | end function 76 | 77 | function lbp(token, content$) 78 | select case token 79 | case is < 0 80 | ps_error "Unexpected literal " + content$ 81 | case TOK_CPAREN 82 | lbp = 0 83 | case else 84 | select case token->stype 85 | case SYM_INFIX 86 | lbp = token->precedence 87 | case else 88 | 'We've hit something that isn't part if the expression, 89 | 'time to finish. 90 | lbp = 0 91 | end select 92 | end select 93 | end function 94 | 95 | function led(token, content$, left_node) 96 | 'content$ is not used but might be useful one day. 97 | 'This next line stops the warning about unused variables. 98 | content$ = content$ 99 | node = ast_add_node(AST_CALL) 100 | node->ref = token 101 | select case token->stype 102 | case SYM_INFIX 103 | if token->associativity = 0 then 'Left-associative 104 | right_node = pt_expr(token->precedence) 105 | else 'right-associative 106 | right_node = pt_expr(token->precedence - 1) 107 | end if 108 | candidate$ = type_sigt_create$(TYPE_ANY) 109 | if type_is_lvalue(left_node) then candidate_flags = TYPE_BYREF 110 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(left_node), flags) 111 | if type_is_lvalue(right_node) then candidate_flags = TYPE_BYREF 112 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(right_node), flags) 113 | matching_sig = type_find_sig_match(token, candidate$) 114 | if matching_sig = 0 then ps_error "Cannot find matching type signature" 115 | cast = ast_add_cast(left_node, type_sig_argtype(matching_sig, 1)) 116 | node->attach(cast) 117 | cast = ast_add_cast(right_node, type_sig_argtype(matching_sig, 2)) 118 | node->attach(cast) 119 | node->ref2 = matching_sig 120 | case else 121 | ps_error "Unexpected led " + tok_human_readable$(token) 122 | end select 123 | led = node 124 | end function 125 | -------------------------------------------------------------------------------- /compiler/parser/preload.bm: -------------------------------------------------------------------------------- 1 | sub ps_preload_file 2 | $if DEBUG_PARSE_TRACE then 3 | debuginfo "Start preload file" 4 | $end if 5 | ps_is_preload = TRUE 6 | do 7 | do while tok_token = TOK_NEWLINE 8 | ps_consume TOK_NEWLINE 9 | loop 10 | stmt = ps_stmt 11 | if stmt > 0 then ps_error "Preload cannot contain executable code in main program" 12 | if stmt = -1 then exit do 13 | loop 14 | ps_is_preload = FALSE 15 | $if DEBUG_PARSE_TRACE then 16 | debuginfo "Completed preload file" 17 | $end if 18 | end sub 19 | -------------------------------------------------------------------------------- /compiler/parser/print.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'print.bm - Parse rules for PRINT statement 4 | 5 | 'Expects: TOK_PRINT 6 | 'Results: token after last expression, comma or semicolon 7 | 'Format: PRINT (expr|,|;)* 8 | function ps_print 9 | $if DEBUG_PARSE_TRACE then 10 | debuginfo "Start print" 11 | $end if 12 | ps_consume TOK_PRINT 13 | root = ast_add_node(AST_BLOCK) 14 | 15 | do until ps_is_terminator(tok_token) 16 | same_line = FALSE 17 | c = 0 18 | select case tok_token 19 | case TOK_COMMA 20 | same_line = TRUE 21 | expr = ast_add_node(AST_CONSTANT) 22 | expr->ref = AST_TAB_STRING 23 | c = ps_print_call(expr) 24 | ps_consume TOK_COMMA 25 | case TOK_SEMICOLON 26 | same_line = TRUE 27 | ps_consume TOK_SEMICOLON 28 | case else 29 | c = ps_print_call(ps_expr) 30 | end select 31 | if c then root->attach(c) 32 | loop 33 | 34 | 'Do not add a newline if the last thing was a semicolon or comma 35 | if not same_line then 36 | expr = ast_add_node(AST_CONSTANT) 37 | expr->ref = AST_NEWLINE_STRING 38 | c = ps_print_call(expr) 39 | root->attach(c) 40 | end if 41 | 42 | ps_print = root 43 | $if DEBUG_PARSE_TRACE then 44 | debuginfo "Completed print" 45 | $end if 46 | end function 47 | 48 | function ps_print_call(expr) 49 | c = ast_add_node(AST_CALL) 50 | c->ref = TOK_PRINT 51 | candidate$ = type_sigt_create$(TYPE_NONE) 52 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr), 0) 53 | sig = type_find_sig_match(TOK_PRINT, candidate$) 54 | if sig = 0 then ps_error "Don't know to print values of type " + type_human_readable$(type_of_expr(expr)) 55 | c->ref2 = sig 56 | cast = ast_add_cast(expr, type_sig_argtype(sig, 1)) 57 | c->attach(cast) 58 | ps_print_call = c 59 | end function 60 | -------------------------------------------------------------------------------- /compiler/parser/putimage.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'putimage.bm - Parse rules for _PUTIMAGE statement 4 | 5 | 'Expects: TOK__PUTIMAGE 6 | 'Results: NEWLINE 7 | 'Format: [[STEP] (single, single) [- [STEP] (single, single)]], [long], [long], [[STEP] (single, single) [- STEP (single, single)]] [, _SMOOTH] 8 | 9 | function ps__putimage 10 | $if DEBUG_PARSE_TRACE then 11 | debuginfo "Start _putimage" 12 | $end if 13 | 14 | root = ast_add_node(AST_CALL) 15 | root->ref = TOK__PUTIMAGE 16 | root->ref2 = TOK__PUTIMAGE->sig 17 | ps_consume TOK__PUTIMAGE 18 | flag_node = ast_add_node(AST_FLAGS) 19 | flag_node->ref = AST_FLAG_MANUAL 20 | root->attach(flag_node) 21 | 22 | if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_SRC1 23 | if ps_consumed(TOK_OPAREN) then 24 | root->attach(ps_expr) 25 | ps_consume TOK_COMMA 26 | root->attach(ps_expr) 27 | ps_consume TOK_CPAREN 28 | else 29 | root->attach_none 30 | root->attach_none 31 | end if 32 | if ps_consumed(TOK_DASH) then 33 | if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_SRC2 34 | ps_consume TOK_OPAREN 35 | root->attach(ps_expr) 36 | ps_consume TOK_COMMA 37 | root->attach(ps_expr) 38 | ps_consume TOK_CPAREN 39 | else 40 | root->attach_none 41 | root->attach_none 42 | end if 43 | if not ps_consumed(TOK_COMMA) then goto putimage_parse_done 44 | if tok_token <> TOK_COMMA then root->attach(ps_expr) else root->attach_none 45 | if not ps_consumed(TOK_COMMA) then goto putimage_parse_done 46 | if tok_token <> TOK_COMMA then root->attach(ps_expr) else root->attach_none 47 | if not ps_consumed(TOK_COMMA) then goto putimage_parse_done 48 | if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_DEST1 49 | if ps_consumed(TOK_OPAREN) then 50 | root->attach(ps_expr) 51 | ps_consume TOK_COMMA 52 | root->attach(ps_expr) 53 | ps_consume TOK_CPAREN 54 | else 55 | root->attach_none 56 | root->attach_none 57 | end if 58 | if ps_consumed(TOK_DASH) then 59 | if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_DEST2 60 | ps_consume TOK_OPAREN 61 | root->attach(ps_expr) 62 | ps_consume TOK_COMMA 63 | root->attach(ps_expr) 64 | ps_consume TOK_CPAREN 65 | else 66 | root->attach_none 67 | root->attach_none 68 | end if 69 | if ps_consumed(TOK_COMMA) then 70 | ps_consume TOK__SMOOTH 71 | flags = flags OR PUTIMAGE_SMOOTH 72 | end if 73 | 74 | putimage_parse_done: 75 | flag_node->ref2 = flags 76 | 'Fill in any missing arguments on the end 77 | for i = ast_num_children(root) + 1 to 11 78 | root->attach_none 79 | next i 80 | ps__putimage = root 81 | 82 | $if DEBUG_PARSE_TRACE then 83 | debuginfo "Completed _putimage" 84 | $end if 85 | end function 86 | -------------------------------------------------------------------------------- /compiler/parser/select.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'select.bm - Parse rules for SELECT CASE statement 4 | 5 | 'Expects: TOK_SELECT 6 | 'Results: NEWLINE 7 | function ps_select 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start select" 10 | $end if 11 | 12 | root = ast_add_node(AST_SELECT) 13 | ps_consume TOK_SELECT 14 | ps_consume TOK_CASE 15 | expr = ps_expr 16 | root->attach(expr) 17 | ps_add_nested_structure root 18 | ps_consume TOK_NEWLINE 19 | ps_line_prelude 20 | 21 | while not ps_consumed(TOK_END) 22 | c = ps_select_case(type_of_expr(expr)) 23 | root->attach(c) 24 | wend 25 | 26 | ps_consume TOK_SELECT 27 | ps_remove_nested_structure 28 | ps_select = root 29 | 30 | $if DEBUG_PARSE_TRACE then 31 | debuginfo "Completed select" 32 | $end if 33 | end function 34 | 35 | function ps_select_case(typ) 36 | $if DEBUG_PARSE_TRACE then 37 | debuginfo "Start select case" 38 | $end if 39 | 40 | ps_consume TOK_CASE 41 | if ps_consumed(TOK_ELSE) then 42 | node = ast_add_node(AST_SELECT_ELSE) 43 | else 44 | node = ast_add_node(AST_SELECT_LIST) 45 | do 46 | t = ps_select_case_guard(typ) 47 | node->attach(t) 48 | loop while ps_consumed(TOK_COMMA) 49 | end if 50 | node->attach(ps_block) 51 | ps_select_case = node 52 | 53 | $if DEBUG_PARSE_TRACE then 54 | debuginfo "Completed select case" 55 | $end if 56 | end function 57 | 58 | function ps_select_case_guard(typ) 59 | $if DEBUG_PARSE_TRACE then 60 | debuginfo "Start select case guard" 61 | $end if 62 | 63 | if ps_consumed(TOK_IS) then 64 | node = ast_add_node(AST_SELECT_IS) 65 | ref = tok_token 66 | ref_typ = ref->stype 67 | if not (ref_typ = SYM_INFIX or ref_typ = SYM_PREFIX or ref_typ = SYM_FUNCTION) then 68 | ps_error "Not a function" 69 | end if 70 | tok_advance 71 | expr = ps_expr 72 | candidate$ = type_sigt_create$(TYPE_INTEGER) 73 | candidate$ = type_sigt_add_arg$(candidate$, typ, 0) 74 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr), 0) 75 | sig = type_find_sig_match(ref, candidate$) 76 | if sig = 0 then ps_error "Bad function" 77 | node->ref = ref 78 | node->ref2 = sig 79 | value_node = ast_add_node(AST_SELECT_VALUE) 80 | value_node->ref = typ 81 | c = ast_add_cast(value_node, type_sig_argtype(sig, 1)) 82 | node->attach(c) 83 | expr = ast_add_cast(expr, type_sig_argtype(sig, 2)) 84 | node->attach(expr) 85 | else 86 | expr1 = ps_expr 87 | if ps_consumed(TOK_TO) then 88 | expr2 = ps_expr 89 | 'Lookup <= to confirm types are well-ordered. Note that we use <= for 90 | 'both bounds, which simplfied this code a little and allows future fancy 91 | 'stuff (custom orderings etc.) to only need to implement the one function. 92 | node = ast_add_node(AST_SELECT_RANGE) 93 | candidate$ = type_sigt_create$(TYPE_INTEGER) 94 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr1), 0) 95 | candidate$ = type_sigt_add_arg$(candidate$, typ, 0) 96 | sig = type_find_sig_match(TOK_CMP_LTEQ, candidate$) 97 | if sig = 0 then ps_error "Bad function" 98 | if type_sig_argtype(sig, 1) <> type_sig_argtype(sig, 2) then 99 | 'The arguments need to have the same type so we can use it 100 | 'with reversed arguments too. 101 | ps_error "Function does not have exchangable argument types" 102 | end if 103 | node->ref = TOK_CMP_LTEQ 104 | node->ref2 = sig 105 | node->attach(expr1) 106 | node->attach(expr2) 107 | else 108 | 'Simple CASE x 109 | node = ast_add_node(AST_SELECT_IS) 110 | candidate$ = type_sigt_create$(TYPE_INTEGER) 111 | candidate$ = type_sigt_add_arg$(candidate$, typ, 0) 112 | candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr1), 0) 113 | sig = type_find_sig_match(TOK_EQUALS, candidate$) 114 | if sig = 0 then ps_error "Cannot compare for equality" 115 | node->ref = TOK_EQUALS 116 | node->ref2 = sig 117 | value_node = ast_add_node(AST_SELECT_VALUE) 118 | value_node->ref = typ 119 | c = ast_add_cast(value_node, type_sig_argtype(sig, 1)) 120 | node->attach(c) 121 | expr1 = ast_add_cast(expr1, type_sig_argtype(sig, 2)) 122 | node->attach(expr1) 123 | end if 124 | end if 125 | ps_select_case_guard = node 126 | 127 | $if DEBUG_PARSE_TRACE then 128 | debuginfo "Completed select case guard" 129 | $end if 130 | end function 131 | -------------------------------------------------------------------------------- /compiler/parser/statement.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'statement.bm - Parse rules for statements 4 | 5 | 'Expects: first token of statement 6 | 'Results: NEWLINE or block end marker 7 | 'Returns: 8 | ' -2 -> a SUB or FUNCTION was defined (useful for interactive mode to know) 9 | ' -1 -> end of a block 10 | ' 0 -> statement did not generate any ast nodes 11 | ' > 0 -> ast node 12 | function ps_stmt 13 | ps_line_prelude 14 | 15 | if tok_token = TOK_LINENUM then ps_label 16 | $if DEBUG_PARSE_TRACE then 17 | debuginfo "Start statement" 18 | $end if 19 | 'Sigh 20 | if tok_token = TOK_LINE and ucase$(tok_next_content$) = "INPUT" then tok_token = TOK_LINEINPUT 21 | select case tok_token 22 | case is < 0 23 | ps_error "Unexpected literal " + tok_content$ 24 | case META_LIST 25 | ps_meta_list 26 | case META_DEBUG 27 | ps_meta_debug 28 | case META_INCLUDE 29 | ps_meta_include 30 | case META_MODULE 31 | ps_meta_module 32 | case META_OPTION 33 | ps_meta_option 34 | case META_UNKNOWN 35 | ps_meta_unknown 36 | case TOK_CALL 37 | stmt = ps_call 38 | case TOK_CONST 39 | stmt = ps_const 40 | case TOK_COMMON 41 | ps_common 42 | case TOK_DECLARE 43 | stmt = ps_declare 44 | case TOK__DEFINE 45 | ps_define_type 46 | case TOK_DEFINT, TOK_DEFLNG, TOK_DEFSNG, TOK_DEFDBL, TOK_DEFSTR 47 | ps_deftype 48 | case TOK_DIM, TOK_REDIM, TOK_STATIC 49 | 'REDIM is treated as an alias for DIM. 50 | 'STATIC is so similar we handle it here too. 51 | stmt = ps_dim 52 | case TOK_DO 53 | stmt = ps_do 54 | case TOK_EXIT 55 | stmt = ps_exit 56 | case TOK_FOR 57 | stmt = ps_for 58 | case TOK_FUNCTION 59 | stmt = ps_userfunc 60 | case TOK_GOTO 61 | stmt = ps_goto 62 | case TOK_IF 63 | stmt = ps_if 64 | case TOK_INPUT, TOK_LINEINPUT 65 | 'These two are so similar, we parse them as the same function 66 | stmt = ps_stmt_input 67 | case TOK_OPTION 68 | ps_stmt_option 69 | case TOK_PRINT 70 | stmt = ps_print 71 | case TOK__PUTIMAGE 72 | stmt = ps__putimage 73 | case TOK_SELECT 74 | stmt = ps_select 75 | case TOK_SUB 76 | stmt = ps_userfunc 77 | case TOK_TYPE 78 | 'For non-interactive modes a TYPE is processed in the prepass, so ignore 79 | 'it here 80 | if options.oper_mode = MODE_REPL or options.oper_mode = MODE_EXEC then 81 | stmt = ps_udt 82 | else 83 | ps_udt_ignore 84 | end if 85 | case TOK_WHILE 86 | stmt = ps_while 87 | case TOK_UNKNOWN 88 | stmt = ps_assignment 89 | case TOK_NEWLINE 90 | 'Blank line; ignore it 91 | stmt = 0 92 | 'These all end a block in some fashion. The block-specific code will assert the 93 | 'ending token, but we check it's syntactically valid here. 94 | case TOK_END 95 | 'We can't check tok_next_token because it does not always contain correct look-ahead information 96 | next_content$ = ucase$(tok_next_content$) 97 | nesting = ps_final_nested->atype 98 | if next_content$ <> "IF" and _ 99 | next_content$ <> "SELECT" and _ 100 | next_content$ <> "SUB" and _ 101 | next_content$ <> "FUNCTION" then 102 | 'Handle regular END command 103 | stmt = ps_stmtreg 104 | elseif nesting <> AST_IF and nesting <> AST_SELECT and nesting <> AST_PROCEDURE then 105 | ps_error "Unexpected END" 106 | else 107 | stmt = -1 108 | end if 109 | case TOK_ELSE, TOK_ELSEIF 110 | if ps_final_nested->atype <> AST_IF then ps_error tok_human_readable$(tok_token) + " without IF" 111 | stmt = -1 112 | case TOK_LOOP 113 | if ps_final_nested->atype <> AST_DO_PRE and ps_final_nested->atype <> AST_DO_POST then ps_error "LOOP without DO" 114 | stmt = -1 115 | case TOK_WEND 116 | if ps_final_nested->atype <> AST_WHILE then ps_error "WEND without WHILE" 117 | stmt = -1 118 | case TOK_NEXT 119 | if ps_final_nested->atype <> AST_FOR then ps_error "NEXT without FOR" 120 | stmt = -1 121 | case TOK_CASE 122 | if ps_final_nested->atype <> AST_SELECT then ps_error "CASE without SELECT" 123 | stmt = -1 124 | case TOK_IEOF 125 | if ps_final_nested <> 0 then ps_error "Unexpected end of file" 126 | stmt = -1 127 | case else 128 | select case tok_token->stype 129 | case SYM_VARIABLE 130 | stmt = ps_assignment 131 | case SYM_FUNCTION 132 | stmt = ps_stmtreg 133 | case else 134 | ps_error tok_human_readable$(tok_token) + " (" + tok_content$ + ") doesn't belong here" 135 | end select 136 | end select 137 | 138 | ps_attach_labels stmt 139 | 140 | ps_stmt = stmt 141 | $if DEBUG_PARSE_TRACE then 142 | debuginfo "Completed statement" 143 | $end if 144 | end function 145 | 146 | 147 | 'Expects: statement token 148 | 'Results: token after last argument 149 | function ps_stmtreg 150 | $if DEBUG_PARSE_TRACE then 151 | debuginfo "Start stmtreg" 152 | $end if 153 | 'Is this in fact assigning the return value of a function? 154 | root = ps_func_return 155 | if root = 0 then 156 | 'Nope, it's just a statement 157 | root = ast_add_node(AST_CALL) 158 | root->ref = tok_token 159 | tok_advance 160 | 'TYPE_NONE to indicate we have no return value 161 | ps_funcargs root, type_sigt_create$(TYPE_NONE), TRUE 162 | end if 163 | ps_stmtreg = root 164 | $if DEBUG_PARSE_TRACE then 165 | debuginfo "Completed stmtreg" 166 | $end if 167 | end function 168 | -------------------------------------------------------------------------------- /compiler/parser/tokeng.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'tokeng.bi - Delcarations for tokeniser engine 4 | 5 | $include: 'ts_data.bi' 6 | $include: 'token_data.bi' 7 | 8 | type tokeniser_state_t 9 | index as long 10 | curstate as long 11 | has_data as long 12 | linestart as long 13 | recovery_mode as long 14 | raw_line_in as string 15 | end type 16 | 17 | dim shared tokeng_state as tokeniser_state_t 18 | 19 | dim shared tok_content$ 20 | dim shared tok_token as long 21 | dim shared tok_next_content$ 22 | dim shared tok_next_token as long 23 | 24 | 'Used to map TS_ to TOK_ 25 | dim shared tok_direct(1 to TS_MAX) 26 | -------------------------------------------------------------------------------- /compiler/parser/tokeng.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'tokeng.bm - Tokeniser Engine 4 | 5 | deflng a-z 6 | 7 | sub tok_init 8 | 'Read in the state machine for the lexer 9 | restore tokeng_data 10 | for s = 1 to ubound(t_states~%, 2) 11 | read t_statenames$(s) 12 | for b = 1 to 127 13 | read cmd 14 | t_states~%(b, s) = cmd 15 | next b 16 | next s 17 | 18 | 19 | 'Populate token and type signature data 20 | 'TODO check if this impacts startup times 21 | $include: 'token_registrations.bm' 22 | 23 | tokeng_data: 24 | $include: 'ts_data.bm' 25 | 26 | tok_reinit 27 | end sub 28 | 29 | sub tok_reinit 30 | tokeng_state.index = 1 31 | tokeng_state.curstate = 1 32 | tokeng_state.has_data = FALSE 33 | tokeng_state.linestart = TRUE 34 | tokeng_state.recovery_mode = FALSE 35 | 'Fill the 'next' buffer and propagate to tok_token 36 | tok_read_next_token 37 | tok_advance 38 | end sub 39 | 40 | sub tok_advance 41 | 'We defer symbol table lookups to now (instead of in tok_read_next_token) so 42 | 'we can correctly find any recently declared symbols. 43 | 'Also avoid ever doing lookups in recovery mode, because results are likely 44 | 'garbage. 45 | if tok_next_token = 0 and not tokeng_state.recovery_mode then 46 | 'First check local scope 47 | id = symtab_get_id(ucase$(ps_scope$ + tok_next_content$)) 48 | 'Then check global scope 49 | if id = 0 then id = symtab_get_id(ucase$(tok_next_content$)) 50 | 'Did we find anything? 51 | if id = 0 then 52 | tok_token = TOK_UNKNOWN 53 | else 54 | tok_token = id 55 | end if 56 | else 57 | tok_token = tok_next_token 58 | end if 59 | tok_content$ = tok_next_content$ 60 | if options.oper_mode <> MODE_REPL then 61 | tok_read_next_token 62 | else 63 | if tok_token = TOK_NEWLINE and tok_content$ <> ":" then 64 | 'All lines end with TOK_EOI 65 | tok_next_token = TOK_EOI 66 | elseif tok_token = TOK_EOI then 67 | 'No line starts with TOK_NEWLINE 68 | do 69 | tok_read_next_token 70 | loop while tok_next_token = TOK_NEWLINE and tok_content$ <> ":" 71 | else 72 | tok_read_next_token 73 | end if 74 | end if 75 | $if DEBUG_TOKEN_STREAM then 76 | debuginfo ">>> " + tok_content$ 77 | $end if 78 | end sub 79 | 80 | 'Advance token stream until reaching end_marker, but do no processing of 81 | 'incoming data. Used to recover from errors. Results in tok_token = end_marker. 82 | sub tok_recover(end_marker) 83 | tokeng_state.recovery_mode = TRUE 84 | do until tok_token = end_marker 85 | tok_advance 86 | loop 87 | tokeng_state.recovery_mode = FALSE 88 | end sub 89 | 90 | sub tok_read_next_token 91 | if not tokeng_state.has_data then 92 | if general_eof then 93 | tok_next_token = TOK_IEOF 94 | exit function 95 | end if 96 | tokeng_state.index = 1 97 | tokeng_state.raw_line_in = general_next_line$ 98 | tokeng_state.has_data = TRUE 99 | end if 100 | 101 | tok_next_content$ = tok_next_ts$(tokeng_state.raw_line_in, ts_type) 102 | 103 | select case ts_type 104 | case 0 'Out of data (an error) 105 | ps_error "Unexpected end of line" 106 | 107 | case TS_ID 108 | 'Special cases! 109 | if tok_next_content$ = "?" then 110 | tok_next_content$ = "PRINT" 111 | elseif ucase$(tok_next_content$) = "REM" then 112 | goto rem_hack 113 | end if 114 | tokeng_state.linestart = FALSE 115 | 'tok_next_token is not properly set here; see comments in tok_advance 116 | tok_next_token = 0 117 | 118 | case TS_METACMD 119 | tok_next_token = symtab_get_id(ucase$(tok_next_content$)) 120 | if tok_next_token = 0 then tok_next_token = META_UNKNOWN 121 | 122 | case TS_LINENUM 123 | if not tokeng_state.linestart then ps_error "Line number must be at start of line" 124 | tok_next_token = TOK_LINENUM 125 | tokeng_state.linestart = FALSE 126 | 127 | case TS_COLON 128 | tok_next_token = TOK_NEWLINE 129 | tokeng_state.linestart = FALSE 130 | 131 | case TS_NEWLINE 132 | rem_hack: 133 | tokeng_state.has_data = FALSE 134 | tokeng_state.linestart = TRUE 135 | tok_next_token = TOK_NEWLINE 136 | 137 | case else 138 | if tok_direct(ts_type) then 139 | tok_next_token = tok_direct(ts_type) 140 | else 141 | ps_error "Unhandled TS" + str$(ts_type) 142 | end if 143 | tokeng_state.linestart = FALSE 144 | end select 145 | end function 146 | 147 | function tok_next_ts$(text$, ts_type) 148 | if tokeng_state.index > len(text$) then 149 | 'Out of data 150 | ts_type = 0 151 | exit function 152 | end if 153 | for i = tokeng_state.index to len(text$) 154 | c = asc(text$, i) 155 | 'No utf-8 support for now 156 | if c > 127 then ps_error "Character outside character set (" + ltrim$(str$(c)) + ")" 157 | 'Ignore CR as an artifact on windows line endings 158 | if c = 13 then _continue 159 | command = t_states~%(c, tokeng_state.curstate) 160 | 'Rules of the form "A: B ~ Error" encode to 0 161 | if command = 0 then 162 | 'As an affordance to interactive mode, skip over the bad character so we don't get caught in an 163 | 'infinite loop when we restart after error 164 | tokeng_state.index = i + 1 165 | ps_error chr$(34) + chr$(c) + chr$(34) + " from " + t_statenames$(tokeng_state.curstate) + " illegal" 166 | end if 167 | 'High byte is next state, low byte is token, high bit of low byte is pushback flag 168 | ts_type_internal = command and 127 169 | pushback = command and 128 170 | 'print t_statenames$(tokeng_state.curstate); ":"; c; "~ "; 171 | tokeng_state.curstate = command \ 2^8 172 | 'print t_statenames$(tokeng_state.curstate) 173 | if ts_type_internal > 0 then 174 | ts_type = ts_type_internal 175 | if pushback then 176 | 'This doesn't include the current character, and uses it next time... 177 | if ts_type <> 1 then tok_next_ts$ = mid$(text$, tokeng_state.index, i - tokeng_state.index) 178 | tokeng_state.index = i 179 | else 180 | '...but this does include it, and starts from the next character next time. 181 | if ts_type <> 1 then tok_next_ts$ = mid$(text$, tokeng_state.index, i - tokeng_state.index + 1) 182 | tokeng_state.index = i + 1 183 | end if 184 | if ts_type <> TS_SKIP then exit function 185 | end if 186 | next i 187 | ts_type = 0 188 | end function 189 | 190 | function tok_human_readable$(token) 191 | if token > 0 then 192 | tok_human_readable$ = token->identifier 193 | else 194 | tok_human_readable$ = "LITERAL_" + mid$(str$(token), 2) 195 | end if 196 | end function 197 | 198 | -------------------------------------------------------------------------------- /compiler/parser/ts.rules: -------------------------------------------------------------------------------- 1 | # Copyright Luke Ceddia 2 | # SPDX-License-Identifier: Apache-2.0 3 | # ts.rules - Token Symbol scanner rules 4 | 5 | %class letter = abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_ 6 | %class number = 0123456789 7 | # The comment character (') is not in this list 8 | %class punc = ~!#$%^&*()[]{}-+=\5c:;"<>,./? 9 | %class hexchar = 0123456789ABCDEFabcdef 10 | %class sp = \09\0b\0c\20 11 | %class nl = \0a 12 | %class bang = ! 13 | %class amp = & 14 | 15 | Begin: $letter ~ Id 16 | Begin: $number ~ Linenum 17 | Begin: "' ~ Comment 18 | Begin: "$ ~ Metacmd 19 | Begin: "? ~ General ! ID 20 | Begin: $sp ~ Begin ! SKIP 21 | Begin: $nl ~ Begin ! NEWLINE 22 | 23 | Linenum: $number ~ Linenum 24 | Linenum: ": ~ General ! LINENUM 25 | Linenum: $sp ~ General & LINENUM 26 | Linenum: "' ~ Comment & LINENUM 27 | Linenum: $nl ~ Begin & LINENUM 28 | 29 | Metacmd: * ~ Error 30 | Metacmd: $letter ~ Metacmd 31 | Metacmd: $number ~ Metacmd 32 | Metacmd: ": ~ Metagap & METACMD 33 | Metacmd: $sp ~ Metagap & METACMD 34 | Metacmd: $nl ~ Begin & METACMD 35 | 36 | Metagap: * ~ Metaparam 37 | Metagap: $sp ~ Metaparam ! SKIP 38 | Metagap: ": ~ Metaparam ! SKIP 39 | 40 | Metaparam: * ~ Metaparam 41 | Metaparam: $nl ~ Begin & METAPARAM 42 | 43 | Id: $letter ~ Id 44 | Id: $number ~ Id 45 | Id: $punc ~ General & ID 46 | # We're just going to pretend line labels don't exist for 47 | # now so we can unambiguously call : a command separator 48 | # Id: ": ~ General ! LINELABEL 49 | Id: $sp ~ General & ID 50 | Id: "' ~ Comment & ID 51 | Id: $nl ~ Begin & ID 52 | 53 | Comment: * ~ Comment 54 | Comment: $nl ~ Begin ! NEWLINE 55 | 56 | String: * ~ String 57 | String: "" ~ General ! STRINGLIT 58 | 59 | General: $letter ~ Id 60 | General: $number ~ Number 61 | General: "? ~ General ! ID 62 | General: $bang ~ General ! SINGLE_SFX 63 | General: "# ~ HashPfx 64 | General: "$ ~ General ! STRING_SFX 65 | General: "% ~ PercentPfx 66 | General: "^ ~ General ! POWER 67 | General: $amp ~ AmpersandPfx 68 | General: "* ~ General ! STAR 69 | General: "( ~ General ! OPAREN 70 | General: ") ~ General ! CPAREN 71 | General: "[ ~ General ! OBRACKET 72 | General: "] ~ General ! CBRACKET 73 | General: "{ ~ General ! OBRACE 74 | General: "} ~ General ! CBRACE 75 | General: "- ~ General ! DASH 76 | General: "+ ~ General ! PLUS 77 | General: "= ~ General ! EQUALS 78 | General: "\ ~ General ! BACKSLASH 79 | General: ": ~ General ! COLON 80 | General: "; ~ General ! SEMICOLON 81 | General: "" ~ String 82 | General: "' ~ Begin ! NEWLINE 83 | General: "< ~ LtPfx 84 | General: "> ~ GtPfx 85 | General: ", ~ General ! COMMA 86 | General: ". ~ Dot 87 | General: "/ ~ General ! SLASH 88 | General: $sp ~ General ! SKIP 89 | General: $nl ~ Begin ! NEWLINE 90 | 91 | Number: * ~ General & NUMINT 92 | Number: $number ~ Number 93 | Number: ". ~ NumDec 94 | Number: "E ~ NumExpSgn 95 | Number: "e ~ NumExpSgn 96 | Number: "D ~ NumExpSgn 97 | Number: "d ~ NumExpSgn 98 | 99 | NumDec: * ~ General & NUMDEC 100 | NumDec: $number ~ NumDec 101 | NumDec: "E ~ NumExpSgn 102 | NumDec: "e ~ NumExpSgn 103 | NumDec: "D ~ NumExpSgn 104 | NumDec: "d ~ NumExpSgn 105 | 106 | NumExpSgn: * ~ General & NUMEXP 107 | NumExpSgn: $number ~ NumExp 108 | NumExpSgn: "+ ~ NumExp 109 | NumExpSgn: "- ~ NumExp 110 | 111 | NumExp: * ~ General & NUMEXP 112 | NumExp: $number ~ NumExp 113 | 114 | PercentPfx: * ~ General & INTEGER_SFX 115 | PercentPfx: $amp ~ General ! OFFSET_SFX 116 | 117 | HashPfx: * ~ General & DOUBLE_SFX 118 | HashPfx: "# ~ General ! QUAD_SFX 119 | 120 | AmpersandPfx: * ~ General & LONG_SFX 121 | AmpersandPfx: $amp ~ General ! INTEGER64_SFX 122 | 123 | AmpersandPfx: "h ~ NumBase 124 | AmpersandPfx: "o ~ NumBase 125 | AmpersandPfx: "b ~ NumBase 126 | AmpersandPfx: "H ~ NumBase 127 | AmpersandPfx: "O ~ NumBase 128 | AmpersandPfx: "B ~ NumBase 129 | 130 | NumBase: * ~ General & NUMBASE 131 | NumBase: $hexchar ~ NumBase 132 | 133 | LtPfx: * ~ General & CMP_LT 134 | LtPfx: "= ~ General ! CMP_LTEQ 135 | LtPfx: "> ~ General ! CMP_NEQ 136 | 137 | GtPfx: * ~ General & CMP_GT 138 | GtPfx: "= ~ General ! CMP_GTEQ 139 | 140 | # We do not get here if digits have proceeded the dot. 141 | # Thus we don't have to worry about something like "10." 142 | Dot: $letter ~ General & DOT 143 | Dot: $number ~ NumDec 144 | -------------------------------------------------------------------------------- /compiler/parser/udt.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'udt.bm - Parser for user-defined types 4 | 5 | 'Expects: TOK_TYPE 6 | 'Results: token after END TYPE 7 | sub ps_udt_ignore 8 | $if DEBUG_PARSE_TRACE then 9 | debuginfo "Start ignored UDT" 10 | $end if 11 | ps_consume TOK_TYPE 12 | tok_advance 'type name 13 | if ps_consumed(TOK_NEWLINE) then ps_line_prelude 14 | do 15 | dummy = ps_opt_sigil 16 | do 17 | tok_advance 'field name 18 | dummy = ps_opt_sigil 19 | loop while ps_consumed(TOK_COMMA) 20 | if ps_consumed(TOK_NEWLINE) then ps_line_prelude 21 | loop until ps_consumed(TOK_END) 22 | ps_consume TOK_TYPE 23 | $if DEBUG_PARSE_TRACE then 24 | debuginfo "Completed ignored UDT" 25 | $end if 26 | end sub 27 | 28 | 'Expects: TOK_TYPE 29 | 'Results: token after END TYPE 30 | function ps_udt 31 | $if DEBUG_PARSE_TRACE then 32 | debuginfo "Start UDT definition" 33 | $end if 34 | dim udt_sym as symtab_entry_t 35 | udt_sym-stype = SYM_TYPE 36 | udt_sym-fixed_size = 0 37 | udt_sym-tflags = SYM_TYPE_UDT 38 | 39 | ps_consume TOK_TYPE 40 | if tok_token <> TOK_UNKNOWN then ps_error "UDT name already in use" 41 | udt_sym-identifier = ucase$(tok_content$) 42 | tok_advance 43 | if ps_consumed(TOK_NEWLINE) then ps_line_prelude 44 | do 45 | 'Handle As Long X style definitions 46 | typ = ps_opt_sigil 47 | do 48 | elem = ps_udt_element(udt_sym, typ) 49 | udt_sym-fixed_size = udt_sym-fixed_size + type_fixed_size(elem->type) 50 | loop while ps_consumed(TOK_COMMA) 51 | 'If we ever need to keep a list of all the elements in a UDT, 52 | 'this is where we'd build it. 53 | if ps_consumed(TOK_NEWLINE) then ps_line_prelude 54 | loop until ps_consumed(TOK_END) 55 | ps_consume TOK_TYPE 56 | 57 | symtab_add_entry udt_sym 58 | ps_udt = 0 'Never generate any ast nodes 59 | $if DEBUG_PARSE_TRACE then 60 | debuginfo "End UDT definition" 61 | $end if 62 | end function 63 | 64 | 'Expects: Element identifier 65 | 'Results: token after variable (comma or newline) 66 | function ps_udt_element(udt_sym as symtab_entry_t, pre_typ) 67 | $if DEBUG_PARSE_TRACE then 68 | debuginfo "Start UDT element" 69 | $end if 70 | dim elem_sym as symtab_entry_t 71 | elem_sym-stype = SYM_UDT_ELEMENT 72 | 73 | 'Because UDT element names appear in such a restricted environment, 74 | 'they can live in their own namespace without conflicting with 75 | 'existing symbols. We just require that the name be an alphanumeric 76 | 'identifier. 77 | elem_name$ = ucase$(tok_content$) 78 | select case left$(elem_name$, 1) 79 | case "A" to "Z", "_" 80 | case else 81 | print tok_content$ 82 | ps_error "Invalid UDT element name" 83 | end select 84 | for i = 2 to len(elem_name$) 85 | select case mid$(elem_name$, i, 1) 86 | case "A" to "Z", "0" to "9", "_" 87 | case else 88 | ps_error "Invalid UDT element name" 89 | end select 90 | next i 91 | elem_sym-identifier = udt_sym-identifier + "." + elem_name$ 92 | tok_advance 93 | 94 | 'Set type from sigil, AS clause or default type 95 | sigil = ps_opt_sigil 96 | if pre_typ > 0 and sigil > 0 and pre_typ <> sigil then 97 | ps_error "Declared type does not match" 98 | end if 99 | if sigil = 0 then sigil = pre_typ 100 | if sigil = 0 then elem_sym-type = ps_default_type else elem_sym-type = sigil 101 | 102 | 'Get offset of element in UDT 103 | elem_sym-udt_element_offset = udt_sym-fixed_size 104 | symtab_add_entry elem_sym 105 | 106 | ps_udt_element = symtab_last_entry 107 | $if DEBUG_PARSE_TRACE then 108 | debuginfo "Completed UDT element" 109 | $end if 110 | end function 111 | 112 | 'Expects: Element 113 | 'Results: token after element 114 | 'Takes udt variable as argument 115 | function ps_udt_element_access(lvalue) 116 | $if DEBUG_PARSE_TRACE then 117 | debuginfo "Start udt element access" 118 | $end if 119 | t = type_of_lvalue(lvalue) 120 | head_typ_name$ = t->identifier 121 | elem = symtab_get_id(head_typ_name$ + "." + ucase$(tok_content$)) 122 | if elem = 0 or elem->stype <> SYM_UDT_ELEMENT then ps_error "Bad UDT element access" 123 | tok_advance 124 | node = ast_add_node(AST_UDT_ACCESS) 125 | node->attach(lvalue) 126 | node->ref = elem 127 | ps_udt_element_access = node 128 | $if DEBUG_PARSE_TRACE then 129 | debuginfo "Completed udt element access" 130 | $end if 131 | end function 132 | -------------------------------------------------------------------------------- /compiler/parser/var.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'var.bm - Parse rules for DIM and variables 4 | 5 | 'Expects: TOK_DIM, TOK_REDIM or TOK_STATIC 6 | 'Results: token after last declaration 7 | 'Format: DIM [STATIC] [_PRESERVE] [SHARED] variablelist 8 | function ps_dim 9 | $if DEBUG_PARSE_TRACE then 10 | debuginfo "Start dim" 11 | $end if 12 | if tok_token = TOK_DIM or tok_token = TOK_REDIM then tok_advance 13 | if ps_consumed(TOK_STATIC) then is_static = TRUE 14 | if ps_consumed(TOK__PRESERVE) then preserve = TRUE 15 | if ps_consumed(TOK_SHARED) then is_shared = TRUE 16 | if is_static then 17 | if is_shared or preserve then ps_error "Cannot be SHARED or _PRESERVE when STATIC" 18 | if ps_last_nested(AST_PROCEDURE) = 0 then ps_error "Not in function" 19 | 'Switch back to the main program's frame so that statics are allocated 20 | 'in there instead of locally. 21 | inner_last_var = ps_scoped_last_var 22 | ps_scoped_last_var = ps_main_last_var 23 | end if 24 | 25 | 'Check for Dim As Long style syntax 26 | typ = ps_opt_sigil 27 | do 28 | name_token = tok_token 29 | 'This is a little messy because we have to look-ahead some to see if 30 | 'it's a scalar or array. 31 | variable_name$ = tok_content$ 32 | tok_advance 33 | sigil = ps_opt_sigil 34 | if typ > 0 and sigil > 0 and typ <> sigil then ps_error "Variable type does not match DIM type" 35 | if typ then sigil = typ 36 | if tok_token = TOK_OPAREN or type_is_array(sigil) then 37 | 'Array declaration. 38 | 'The block holds all resizes declared in this DIM statement 39 | if block = 0 then block = ast_add_node(AST_BLOCK) 40 | ps_dim_array name_token, variable_name$, sigil, block, is_shared, preserve, is_static 41 | else 42 | 'Just a regular variable 43 | if name_token <> TOK_UNKNOWN then ps_error "Expected new variable name" 44 | sym = ps_new_var_pp(variable_name$, sigil, is_shared, FALSE) 45 | if is_static then sym->vflags = sym->vflags OR SYM_VARIABLE_MAINFRAME 46 | end if 47 | loop while ps_consumed(TOK_COMMA) 48 | ps_dim = block 49 | 50 | if is_static then 51 | ps_main_last_var = ps_scoped_last_var 52 | ps_scoped_last_var = inner_last_var 53 | end if 54 | $if DEBUG_PARSE_TRACE then 55 | debuginfo "Completed dim" 56 | $end if 57 | end function 58 | 59 | function ps_lvalue 60 | token = tok_token 61 | content$ = tok_content$ 62 | tok_advance 63 | ps_lvalue = ps_lvalue_p(token, content$) 64 | end function 65 | 66 | function ps_lvalue_mutable 67 | node = ps_lvalue 68 | sym = node->ref 69 | if sym->vflags AND SYM_VARIABLE_CONST then 70 | ps_error "Cannot reassign CONST" 71 | end if 72 | ps_lvalue_mutable = node 73 | end function 74 | 75 | function ps_lvalue_p(head, content$) 76 | $if DEBUG_PARSE_TRACE then 77 | debuginfo "Start lvalue" 78 | $end if 79 | node = ps_simple_variable_p(head, content$) 80 | do while tok_token = TOK_DOT or tok_token = TOK_OPAREN 81 | if ps_consumed(TOK_DOT) then 82 | 'UDT element access 83 | node = ps_udt_element_access(node) 84 | elseif ps_consumed(TOK_OPAREN) and not ps_consumed(TOK_CPAREN) then 85 | 'array access. Something like `a()` is a reference to the entire array, 86 | 'so no access operation needed. 87 | node = ps_array_element_access(node) 88 | end if 89 | loop 90 | ps_lvalue_p = node 91 | $if DEBUG_PARSE_TRACE then 92 | debuginfo "Completed lvalue" 93 | $end if 94 | end function 95 | 96 | function ps_simple_variable 97 | token = tok_token 98 | content$ = tok_content$ 99 | tok_advance 100 | ps_simple_variable = ps_simple_variable_p(token, content$) 101 | end function 102 | 103 | 'Expects: token after variable, variable token as arg 104 | 'Results: token after optional sigil 105 | 'Note: process simple variables, i.e. no udt or array stuff. Returns AST_VAR. 106 | function ps_simple_variable_p(head, content$) 107 | $if DEBUG_PARSE_TRACE then 108 | debuginfo "Start simple variable" 109 | $end if 110 | node = ast_add_node(AST_VAR) 111 | if head = TOK_UNKNOWN then 112 | 'Add new variable (implicit declaration) 113 | if not ps_allow_implicit_vars then ps_error "Implicit variable declaration" 114 | node->ref = ps_new_var_p(content$) 115 | elseif head->stype <> SYM_VARIABLE then 116 | ps_error "Expected variable" 117 | else 118 | 'Existing variable 119 | sigil = ps_opt_sigil 120 | current_type = head->type 121 | if current_type->tflags = SYM_TYPE_ARRAY then current_type = current_type->array_type 122 | if sigil and sigil <> current_type then ps_error "Type suffix does not match existing variable type" 123 | node->ref = head 124 | end if 125 | 126 | ps_simple_variable_p = node 127 | $if DEBUG_PARSE_TRACE then 128 | debuginfo "Completed simple variable" 129 | $end if 130 | end function 131 | 132 | 'Expects: sigil or otherwise 133 | 'Results: post token if sigil present, unchanged otherwise 134 | function ps_opt_sigil 135 | $if DEBUG_PARSE_TRACE then 136 | debuginfo "Start optional sigil" 137 | $end if 138 | if ps_consumed(TOK_AS) then 139 | typ = tok_token 140 | if typ = 0 or typ->stype <> SYM_TYPE then ps_error "Expected type name" 141 | else 142 | select case tok_token 143 | case TOK_INTEGER_SFX 144 | typ = TYPE_INTEGER 145 | case TOK_LONG_SFX 146 | typ = TYPE_LONG 147 | case TOK_INTEGER64_SFX 148 | typ = TYPE_INTEGER64 149 | case TOK_SINGLE_SFX 150 | typ = TYPE_SINGLE 151 | case TOK_DOUBLE_SFX 152 | typ = TYPE_DOUBLE 153 | case TOK_QUAD_SFX 154 | typ = TYPE_QUAD 155 | case TOK_STRING_SFX 156 | typ = TYPE_STRING 157 | case else 158 | typ = 0 159 | end select 160 | end if 161 | if typ then tok_advance 162 | if ps_consumed(TOK_OBRACKET) then 163 | 'Array type. If the element type hasn't been given, assume it to 164 | 'be the default type. 165 | if typ = 0 then typ = ps_default_type 166 | ps_assert TOK_NUMINT 167 | dimensions = val(tok_content$) 168 | tok_advance 169 | ps_consume TOK_CBRACKET 170 | typ = type_make_array(typ, dimensions) 171 | end if 172 | ps_opt_sigil = typ 173 | $if DEBUG_PARSE_TRACE then 174 | debuginfo "Completed optional sigil" 175 | $end if 176 | end function 177 | 178 | function ps_new_var_p(var_name$) 179 | sigil = ps_opt_sigil 180 | ps_new_var_p = ps_new_var_pp(var_name$, sigil, FALSE, FALSE) 181 | end function 182 | 183 | function ps_new_var_pp(var_name$, sigil, is_shared, is_ref) 184 | dim sym as symtab_entry_t 185 | if is_shared then 186 | sym-identifier = ucase$(var_name$) 187 | else 188 | sym-identifier = ps_scope$ + ucase$(var_name$) 189 | end if 190 | sym-stype = SYM_VARIABLE 191 | if sigil then sym-type = sigil else sym-type = ps_default_type 192 | sym-prev_var = ps_scoped_last_var 193 | if is_shared then sym-vflags = SYM_VARIABLE_MAINFRAME else sym-vflags = 0 194 | if is_ref then sym-vflags = sym-vflags OR SYM_VARIABLE_DEREF 195 | symtab_add_entry sym 196 | ps_scoped_last_var = symtab_last_entry 197 | ps_new_var_pp = symtab_last_entry 198 | end function 199 | -------------------------------------------------------------------------------- /compiler/spawn.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'spawn.bm - Process spawning 4 | 5 | 'This function exists because using SHELL on Windows seems nigh impossible 6 | 'to get right with quoted paths. On Unix though it's easier to get the SHELL 7 | 'quoting right than it is to wrangle fork/exec/wait or posix_spawn/wait. 8 | 9 | $if WINDOWS then 10 | 11 | declare customtype library 12 | function spawnv& alias _spawnv(byval mode&, cmdname$, byval argv%&) 13 | end declare 14 | 15 | 'Warning: this function modifies its arguments 16 | function spawn(cmd$, args$()) 17 | dim as _offset argv(lbound(args$) - 1 to ubound(args$) + 1) 18 | arg0$ = chr$(34) + cmd$ + chr$(34) + chr$(0) 19 | cmd$ = cmd$ + chr$(0) 20 | for i = lbound(args$) to ubound(args$) 21 | args$(i) = chr$(34) + args$(i) + chr$(34) + chr$(0) 22 | next i 23 | argv(lbound(argv)) = _offset(arg0$) 24 | for i = lbound(args$) to ubound(args$) 25 | argv(i) = _offset(args$(i)) 26 | next i 27 | argv(ubound(argv)) = 0 28 | spawn = spawnv&(0, cmd$, _offset(argv())) '_p_wait = 0 29 | end function 30 | 31 | $else 32 | 33 | function spawn(cmd$, args$()) 34 | l$ = shell_protect$(cmd$) 35 | for i = lbound(args$) to ubound(args$) 36 | l$ = l$ + " " + shell_protect$(args$(i)) 37 | next i 38 | spawn = shell(l$) 39 | end function 40 | 41 | function shell_protect$(s$) 42 | r$ = "" 43 | for i = 1 to len(s$) 44 | c$ = mid$(s$, i, 1) 45 | if c$ = "'" then 46 | r$ = r$ + "'\''" 47 | else 48 | r$ = r$ + c$ 49 | end if 50 | next i 51 | shell_protect$ = "'" + r$ + "'" 52 | end function 53 | 54 | $end if 55 | -------------------------------------------------------------------------------- /compiler/symtab.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'symtab.bi - Declarations for symbol table 4 | 5 | type symtab_entry_t 6 | identifier as string 7 | typ as long 8 | 'the vn are generic parameters whose meaning depends on typ. 9 | v1 as long 10 | v2 as long 11 | v3 as long 12 | v4 as long 13 | 'lp is a pointer to the llvm-returned instantiation of the object, with the exception 14 | 'that callables (operators & functions) are instantiated per type signature instead. 15 | lp as _offset 16 | end type 17 | 18 | $macro: @@->identifier | symtab(@1).identifier 19 | $macro: @@-identifier | @1.identifier 20 | $macro: @@->lp | symtab(@1).lp 21 | $macro: @@-lp | @1.lp 22 | $macro: @@->stype | symtab(@1).typ 23 | $macro: @@-stype | @1.typ 24 | $macro: @@->sig | symtab(@1).v1 25 | $macro: @@-sig | @1.v1 26 | $macro: @@->precedence | symtab(@1).v2 27 | $macro: @@-precedence | @1.v2 28 | $macro: @@->associativity | symtab(@1).v3 29 | $macro: @@-associativity | @1.v3 30 | $macro: @@->type | symtab(@1).v1 31 | $macro: @@-type | @1.v1 32 | $macro: @@->prev_var | symtab(@1).v2 33 | $macro: @@-prev_var | @1.v2 34 | $macro: @@->vflags | symtab(@1).v3 35 | $macro: @@-vflags | @1.v3 36 | $macro: @@->func_flags | symtab(@1).v2 37 | $macro: @@-func_flags | @1.v2 38 | $macro: @@->label_node | symtab(@1).v1 39 | $macro: @@-label_node | @1.v1 40 | $macro: @@->label_found | symtab(@1).v2 41 | $macro: @@-label_found | @1.v2 42 | $macro: @@->fixed_size | symtab(@1).v1 43 | $macro: @@-fixed_size | @1.v1 44 | $macro: @@->tflags | symtab(@1).v2 45 | $macro: @@-tflags | @1.v2 46 | $macro: @@->array_type | symtab(@1).v3 47 | $macro: @@-array_type | @1.v3 48 | $macro: @@->array_dims | symtab(@1).v4 49 | $macro: @@-array_dims | @1.v4 50 | $macro: @@->udt_element_offset | symtab(@1).v2 51 | $macro: @@-udt_element_offset | @1.v2 52 | 53 | 54 | 'A generic entry. No vn parameters are used. 55 | const SYM_GENERIC = 1 56 | 'A function with infix notation. 57 | 'v1 ->sig | reference to the type signature 58 | 'v2 ->precedence | binding power (controls precedence) 59 | 'v3 ->associativity | associativity (1/0 = right/left) 60 | const SYM_INFIX = 2 61 | 'A function with prefix notation (and parentheses are not required) 62 | 'v1 ->sig | reference to the type signature 63 | 'v2 ->precedence | binding power (controls precedence) 64 | const SYM_PREFIX = 3 65 | 'A variable. 66 | 'v1 ->type | the data type 67 | 'v2 ->prev_var | the sym entry of the previous variable in the same scope, 0 if none. Forms a linked list. Does not apply to arguments. 68 | 'v3 ->vflags | various SYM_VARIABLE_* flags 69 | const SYM_VARIABLE = 4 70 | 'A function (subs too!) 71 | 'v1 ->sig | reference to the type signature 72 | 'v2 ->func_flags | Combination of SYM_FUNCTION_*, see below 73 | const SYM_FUNCTION = 5 74 | 'A line number or label. Labels have the : removed. 75 | 'v1 ->label_node | AST node that is labelled. 76 | 'v2 ->label_found | Label has been located (if false, label has only been referenced) 77 | const SYM_LABEL = 6 78 | 'Both internal types and UDTs 79 | 'v1 ->fixed_size | Fixed size of data type 80 | 'v2 ->tflags | One of SYM_TYPE_*, see below 81 | 'v3 ->array_type | If SYM_TYPE_ARRAY, type of the array element 82 | 'v4 ->array_dims | If SYM_TYPE_ARRAY, number of dimensions 83 | const SYM_TYPE = 7 84 | 'An element of a udt, stored with the name "udt_name.element_name" 85 | 'v1 ->type | the data type 86 | 'v2 ->udt_element_offset | position of element in udt (first is 0, then incrementing by the fixed size of previous values) 87 | const SYM_UDT_ELEMENT = 8 88 | 'A metacommand, stored with its characteristic leading $ in the name 89 | const SYM_META = 9 90 | 91 | 'Further categorisation of SYM_TYPE 92 | 'e.g. INTEGER, STRING 93 | const SYM_TYPE_INTERNAL = 0 94 | 'Stored as the UDT name 95 | const SYM_TYPE_UDT = 1 96 | 'Stored as the element type followed by brackets and the number of dimensions, e.g. INTEGER[2] or INTEGER[0] for 97 | 'an indeterminate number of dimensions 98 | const SYM_TYPE_ARRAY = 2 99 | 100 | 'Settings for SYM_VARIABLE 101 | 'This variable is a constant and cannot be reassigned 102 | const SYM_VARIABLE_CONST = 1 103 | 'This variable must be dereferenced before access (to support pass-by-reference) 104 | const SYM_VARIABLE_DEREF = 2 105 | 'This variable is stored in the main program's stack frame, not the frame of any scoping function (SHARED or STATIC) 106 | const SYM_VARIABLE_MAINFRAME = 4 107 | 108 | 'Further categorisation of SYM_FUNCTION 109 | 'This function is handled directly when generating code, and does not have a normal 110 | 'instantiation. 111 | const SYM_FUNCTION_INTRINSIC = 1 112 | 'This function should have public linkage, instead of the default private. 113 | const SYM_FUNCTION_PUBLIC = 2 114 | 115 | dim shared symtab(1000) as symtab_entry_t 116 | dim shared symtab_last_entry 117 | dim shared symtab_map(1750) 118 | 119 | 'The symtab optionally supports transactions; calling symtab_rollback will 120 | 'remove all items added since the last call to symtab_commit. 121 | 'WARNING: transaction rollbacks only undo adding entries. Changes to entries 122 | 'are always immediately permanent. 123 | dim shared symtab_last_commit_id 124 | -------------------------------------------------------------------------------- /compiler/symtab.bm: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'symtab.bm - Symbol Table 4 | 5 | sub symtab_add_entry(entry as symtab_entry_t) 6 | symtab_expand_if_needed 7 | symtab_last_entry = symtab_last_entry + 1 8 | symtab(symtab_last_entry) = entry 9 | symtab_map_insert entry.identifier, symtab_last_entry 10 | end sub 11 | 12 | function symtab_get_id(identifier$) 13 | h~& = symtab_hash~&(identifier$, ubound(symtab_map)) 14 | do 15 | id = symtab_map(h~&) 16 | if id = 0 then 17 | exit function 18 | end if 19 | if symtab(id).identifier = identifier$ then 20 | symtab_get_id = id 21 | exit function 22 | endif 23 | h~& = (h~& + 1) mod (ubound(symtab_map) + 1) 24 | loop 25 | end function 26 | 27 | sub symtab_commit 28 | symtab_last_commit_id = symtab_last_entry 29 | end sub 30 | 31 | sub symtab_rollback 32 | 'Would it be more efficient to do this in reverse order? 33 | 'Does anyone care about how fast it is? 34 | for i = symtab_last_commit_id + 1 to symtab_last_entry 35 | identifier$ = symtab(i).identifier 36 | h~& = symtab_hash~&(identifier$, ubound(symtab_map)) 37 | do 38 | id = symtab_map(h~&) 39 | if symtab(id).identifier = identifier$ then exit do 40 | h~& = (h~& + 1) mod (ubound(symtab_map) + 1) 41 | loop 42 | symtab_map(h~&) = 0 43 | next i 44 | symtab_last_entry = symtab_last_commit_id 45 | end sub 46 | 47 | 'Strictly internal functions below 48 | sub symtab_expand_if_needed 49 | const SYMTAB_MAX_LOADING = 0.75 50 | const SYMTAB_GROWTH_FACTOR = 2 51 | if symtab_last_entry = ubound(symtab) then 52 | redim _preserve symtab(ubound(symtab) * SYMTAB_GROWTH_FACTOR) as symtab_entry_t 53 | end if 54 | 55 | if symtab_last_entry / ubound(symtab_map) <= SYMTAB_MAX_LOADING then exit function 56 | redim symtab_map(ubound(symtab_map) * SYMTAB_GROWTH_FACTOR) 57 | for i = 1 to symtab_last_entry 58 | symtab_map_insert symtab(i).identifier, i 59 | next i 60 | end sub 61 | 62 | sub symtab_map_insert (k$, v) 63 | h~& = symtab_hash~&(k$, ubound(symtab_map)) 64 | do 65 | if symtab_map(h~&) = 0 then exit do 66 | h~& = (h~& + 1) mod (ubound(symtab_map) + 1) 67 | loop 68 | symtab_map(h~&) = v 69 | end sub 70 | 71 | 'http://www.cse.yorku.ca/~oz/hash.html 72 | 'Attributed to D. J. Bernstein 73 | function symtab_hash~&(k$, max) 74 | hash~& = 5381 75 | for i = 1 to len(k$) 76 | hash~& = ((hash~& * 33) xor asc(k$, i)) mod max 77 | next i 78 | '0<=hash<=max-1, so 1<=hash+1<=max 79 | symtab_hash~& = hash~& + 1 80 | end function 81 | -------------------------------------------------------------------------------- /compiler/type.bi: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'type.bi - Declarations for type management routines 4 | 5 | 'type_signatures() is a linked list. 6 | 'A function token points to a single type_signature_t, and that element may point to 7 | 'alternative signatures for that function. This allows us to support declaring a 8 | 'function multiple times with different signatures by chaining each declaration's 9 | 'signature together. 10 | 11 | type type_signature_t 12 | 'sig is an mkl$-encoded string. Its format is mkl$(return type) + 13 | 'mkl$(argument 1 type) + mkl$(argument 1 flags) + mkl$(argument 2 type) + 14 | 'mkl$(argument 2 flags) + ... 15 | 'For each flag, one or more TYPE_* flags as defined below are set. 16 | sig as string 17 | 'lp is a pointer to the LLVM instantiation of the function with 18 | 'that particular signature (each alternative gets a separate instantiation). 19 | lp as _offset 20 | 'proc_node is the AST_PROCEDURE holding the executable code for this function. 21 | 'Different signatures for a function may point to different procedures because 22 | 'of type overloading. proc_node may be 0 if the function is implemented natively, 23 | 'i.e. is translated directly to a sequence of instructions. 24 | proc_node as long 25 | 'last_var is the sym entry of the last variable in this scope, excluding arguments. 26 | last_var as long 27 | 'If set, this name will be used as-is in generated code. If empty, the name will 28 | 'be subject to type mangling. Setting this should only be needed for calling 29 | 'functions not written in L-BASIC. 30 | link_name as string 31 | 'Pointer to next sig 32 | succ as long 'Can't call this "next" :( 33 | end type 34 | 35 | redim shared type_signatures(1000) as type_signature_t 36 | dim shared type_last_signature as long 37 | 38 | $macro: @@->sig_str | type_signatures(@1).sig 39 | $macro: @@->sig_lp | type_signatures(@1).lp 40 | $macro: @@->proc_node | type_signatures(@1).proc_node 41 | $macro: @@->last_var | type_signatures(@1).last_var 42 | $macro: @@->link_name | type_signatures(@1).link_name 43 | $macro: @@->succ | type_signatures(@1).succ 44 | 45 | 'Note: constants for actual data types (TYPE_LONG etc.) are defined in tokens.list 46 | 'for greater ease of handling UDTs. 47 | 48 | 'Flags for type signature flags. 49 | 'This argument can be omitted. 50 | const TYPE_OPTIONAL = 1 51 | 'This argument is passed by reference *and* cannot be an expression, it must be a 52 | 'reference to an lvalue. Used when the callee passes information back to the caller 53 | 'through this argument. 54 | const TYPE_BYREF = 2 55 | 'This argument is passed by value. The callee does not expect modifications to pass 56 | 'back to the caller. 57 | const TYPE_BYVAL = 4 58 | 'Note: BYVAL and BYREF are not entirely opposite. BYVAL is purely a description of the 59 | 'calling convention, i.e. values are passed directly not as a reference. BYREF requires 60 | 'the call to use a reference, but also enforces a requirement on the kind of value the 61 | 'caller supplies. The default (neither BYREF not BYVAL) is in between: values are passed 62 | 'by reference, but may be non-lvalues. 63 | 64 | 'This argument can have a leading # to indicate a file handle 65 | const TYPE_FILEHANDLE = 8 66 | 'This argument is a literal token and the type refers to that token id 67 | const TYPE_TOKEN = 16 68 | 'This argument is only a syntax element and should not have an ast node generated for it 69 | const TYPE_SYNTAX_ONLY = 32 70 | 'This argument needs to be matched by textual name. This allows parameters 71 | 'that have meaning only in a specific context, like LINE's B/BF. The argument 'type' 72 | 'is the index of a constant that contains a | separated list of allowable values. 73 | const TYPE_CONTEXTUAL = 64 74 | 'This argument can in fact be one or more arguments, all of the same type. 75 | const TYPE_VARIADIC = 128 -------------------------------------------------------------------------------- /doc/immediate.md: -------------------------------------------------------------------------------- 1 | # Immediate Mode 2 | Immediate mode executes the current program or program fragment by walking the AST directly. Its initial purpose was to help verify the correctness of the produced AST, but also serves as a way to have an interactive interpreter session. Execution is significantly slower than compiled code. 3 | 4 | ## Memory Layout 5 | Memory is divided into two separate regions, a stack and a heap. The stack is used for storing local variables, passing parameter to and returning values from procedures. The heap holds array data. Heap memory is managed using a pair of calls equivalent to C's malloc()/free(). 6 | 7 | When a procedure is started, sufficient slots are allocated on the stack to store its local variables, passed parameters and a return value (if needed). For the main procedure, "local" variables here also includes STATIC and SHARED variables as they need to exist for the entire program's lifetime and putting them on the heap would complicate matters. 8 | 9 | ### Arrays 10 | Arrays consist of a descriptor with the following layout: 11 | * Address of data 12 | * Number of dimensions 13 | * Lbound of leftmost dimension 14 | * Ubound of leftmost dimension 15 | * etc. 16 | * Lbound of rightmost dimension 17 | * Ubound of rightmost dimension 18 | 19 | Generally the descriptor exists on the stack, and the actual data exists as a heap allocation. This allows freely resizing arrays without moving around stack positions. 20 | 21 | ## Calling Convention 22 | Intrinsic procedures are free to each do their own thing. This only applies to user-defined procedures. 23 | 24 | When a procedure is called, a new stack frame is created to hold: 25 | * All the procedure's local, non-STATIC variables 26 | * Each of the procedure's arguments 27 | * Any shadow arguments as needed 28 | * The procedure return value as needed 29 | 30 | Each argument is evaluated. In the simplest case, the parameter is declared BYVAL and so the argument is copied straight to the stack position allocated for it. If it is BYREF (either explicitly or because the argument is an lvalue), the address of the passed variable is passed. Note in either case the procedure knows whether it is receiving a value or an address by how it was declared initially. 31 | 32 | If the parameter is implicitly BYREF and the argument is not an lvalue, we make use of a shadow argument. Because the procedure is expecting an address but we only have the evaluation result, the result is written to the shadow location and the address of the shadow is passed. 33 | 34 | If the procedure is a function, a stack position for the return value is allocated. 35 | 36 | ### Arrays 37 | Arrays are always passed by reference. Specifically, the address of the descriptor is passed. 38 | -------------------------------------------------------------------------------- /doc/obj-ownership.txt: -------------------------------------------------------------------------------- 1 | sub s(a()) 2 | 'do not destruct a() because we are never the owner 3 | end sub 4 | 5 | ''' 6 | 7 | dim b(2) 8 | 'destruct b() because we are the owner 9 | 10 | ''' 11 | 12 | function s2[1]() 13 | dim c(4) 14 | s2 = c 'Full copy 15 | 'destruct c() because we are the owner 16 | return pointer to array copy @ X 17 | end function 18 | dim d() 19 | d = s2 'd points to array @ X 20 | 'destruct d() 21 | 22 | ''' 23 | 24 | sub s(a()) 25 | end sub 26 | function s2[1]() 27 | dim c(4) 28 | s2 = c 'Full copy 29 | 'destruct c() because we are the owner 30 | return pointer to array copy @ X 31 | end function 32 | s s2 33 | 'array @ X is passed to s, but s does not free it! 34 | 35 | ''' 36 | 37 | Solution: add a "owned" field to array descriptor 38 | sub s(a()) 39 | 'on entry, claim ownership of a() if it is unowned 40 | 'on exit, destruct a() if we are the owner 41 | end sub 42 | function s2[1]() 43 | dim c(4) 'create c and claim ownership 44 | s2 = c 'copy and set s2 as unowned 45 | 'destruct c() because we are the owner 46 | end function 47 | s s2 's will claim ownership of array and free it 48 | dim d() 49 | d = s2 'claim ownership of returned array 50 | 51 | Note: ownership needs to be linked to scope at runtime. Otherwise: 52 | sub s(a()) 53 | t a 54 | end sub 55 | sub t(b()) 56 | end sub 57 | Assuming `s a` is called with a unowned, s will claim ownership. On t's exit, it cannot distinguish between its ownership (which it doesn't have) and s's ownership. 58 | 59 | What about recursion though? 60 | sub s(a(), z) 61 | if z > 0 then s a, z - 1 62 | ? a(0) 63 | end sub 64 | Assume `s a 2` is called with a unowned. s claims ownership, then recurses several times. When the deepest invocation of s exits, it frees a because s owns a. But an outer invocation of s then wants to access a! 65 | 66 | Solution: ownership is claimed using base stack address as an identifier, since objects can never be owned by a scope that has exited. 67 | -------------------------------------------------------------------------------- /doc/typespec.md: -------------------------------------------------------------------------------- 1 | ## Available Data Types 2 | - ANY, a pseudo-type used internally to accept any data type 3 | - INTEGER (%), a signed 16 bit integer 4 | - LONG (&), a signed 32 bit integer 5 | - INTEGER64 (&&), a signed 64 bit integer 6 | - SINGLE (!), a single-precision floating-point number 7 | - DOUBLE (#), a double-precision floating-point number 8 | - QUAD (##), a quadruple-precision floating-point number 9 | - STRING ($), a variable-length sequence of bytes 10 | - User Defined Types 11 | - Arrays of the above 12 | 13 | ## Definitions 14 | * The types INTEGER, LONG, INTEGER64, SINGLE, DOUBLE and QUAD are considered NUMBER types. 15 | * An expression is something that can be evaluated to have a particular value. 16 | 17 | ## Casts 18 | The following functions cast from any NUMBER type: 19 | * CINT%() 20 | * CLNG&() 21 | * CSNG!() 22 | * CDBL#() 23 | 24 | These functions may throw an Overflow error (ERR 6) at runtime if the value is outside the bounds of the desired type. Alternatively, the value may be wrapped or truncated without notice, depending on the implementation. 25 | 26 | ### Implicit Casts 27 | An implicit cast takes place when assigning to a variable with a different type, between NUMBER types only. The compiler will automatically insert the appropriate casting function. For example: 28 | * `x% = y&` becomes `x% = CINT(y&)` 29 | * `x# = y% + z%` becomes `x# = CDBL(y% + z%)` 30 | * `x# = y#` remains as-is 31 | * `x$ = y%` is illegal 32 | 33 | ## Constants 34 | The type of non-NUMBER types is obvious (a string literal is of STRING type). If a type suffix is present then that determines the type. Otherwise: 35 | * If the number has no decimal point or exponent, then its type is the smallest of INTEGER, LONG or INTEGER64 that can hold it. If no type can hold it, the next rule applies. 36 | * If the number has a decimal point or an exponent (e.g. 3E8) or does not fit an INTEGER64, then its type is the smallest of SINGLE, DOUBLE or QUAD that can hold it (with respect to magnitude). If no type can hold it, the number is illegal. 37 | A type suffix may not specify a type smaller than what would be determined by the above rules. 38 | 39 | ## Arrays 40 | An array's type is a combination of its element type and its number of dimensions. An array X may be cast to array Y for the purposes of passing as a function argument if and only if: 41 | * The element types are exactly equivalent, or Y's element type is ANY 42 | * The number of dimensions are exactly equal, or Y's number of dimensions is unspecified (given as 0). 43 | Arrays are always passed by reference. 44 | 45 | ## Function arguments 46 | A function has 0 or more arguments and a return type (or a not-considered return type if it is a SUB). A function declaration specifies the type of each argument and the return type. When called, arguments are passed in one of two ways: 47 | * If an argument is specified as a single variable and the type of the variable exactly matches the declared type of the argument, it is passed _by reference_. 48 | * If an argument is specified as an expression or constant, or is a variable of a different type but can be implicitly cast, it is passed _by value_. 49 | 50 | ### Binary Operators 51 | The operators `\`, `AND`, `OR`, `EQV`, `IMP` and `XOR` behave as follows: 52 | * If both arguments are of type INTEGER, LONG or INTEGER64, the return type is the larger of the two arguments. 53 | * If one or both arguments are of type SINGLE, DOUBLE or QUAD, the arguments are cast to the smallest integral type that is lossless. Note that this has the potential to cause an Overflow error with QUAD values. 54 | 55 | The operators `/` and `^` behave as follows: 56 | * First, any arguments of type 57 | * INTEGER are cast to SINGLE 58 | * LONG are cast to DOUBLE 59 | * INTEGER64 are cast to QUAD 60 | * Then the return type is the larger of the two arguments (one of SINGLE, DOUBLE or QUAD). 61 | 62 | The operators `+`, `-` and `*` have a return type that is the larger of the two arguments. 63 | 64 | ### BYVAL and BYREF arguments 65 | A function argument may be declared as BYVAL or BYREF (but not both). This forces calls to pass the argument by value or reference, respectively. This means a BYREF argument must be passed a single variable of the correct type, never an expression or constant. 66 | -------------------------------------------------------------------------------- /runtime/core/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright Luke Ceddia 2 | # SPDX-License-Identifier: Apache-2.0 3 | # Makefile for runtime core 4 | 5 | OUTPUT_LIBRARY := $(OUT_DIR)/runtime/core 6 | OUT_HEADER := $(OUTPUT_LIBRARY).bh 7 | OUT_BINARY := $(OUTPUT_LIBRARY).a 8 | 9 | .PHONY: all 10 | all: $(OUT_HEADER) $(OUT_BINARY) 11 | 12 | OBJ := $(addsuffix .o, $(basename $(wildcard *.bm))) 13 | HEADERS := $(addsuffix .bh, $(basename $(wildcard *.bm))) 14 | 15 | %.o %.bh: %.bm 16 | $(LBASIC_CORE_COMPILER) -t --no-core -e obj -o $*.o $< 17 | 18 | $(OUT_HEADER): $(HEADERS) 19 | cat *.bh > $@ 20 | 21 | $(OUT_BINARY): $(OBJ) 22 | $(AR) rcs $@ $(OBJ) 23 | 24 | .PHONY: clean 25 | clean: 26 | rm *.o 2> /dev/null || true 27 | rm *.bh 2> /dev/null || true 28 | -------------------------------------------------------------------------------- /runtime/core/string.bm: -------------------------------------------------------------------------------- 1 | common left, right 2 | 3 | function left$(src$, length&) 4 | left$ = mid$(src$, 1, length&) 5 | end function 6 | 7 | function right$(src$, length&) 8 | right$ = mid$(src$, len(src$) - length& + 1, length&) 9 | end function 10 | -------------------------------------------------------------------------------- /runtime/foundation/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright Luke Ceddia 2 | # SPDX-License-Identifier: Apache-2.0 3 | # Makefile for runtime foundation 4 | 5 | OUTPUT_LIBRARY := $(OUT_DIR)/runtime/foundation.a 6 | 7 | .PHONY: all 8 | all: $(OUTPUT_LIBRARY) 9 | 10 | OBJ := $(addsuffix .o, $(basename $(wildcard *.c))) 11 | 12 | %.o: %.c $(wildcard *.h) 13 | $(CC) $(CFLAGS) -c -o $@ $< 14 | 15 | $(OUTPUT_LIBRARY): $(OBJ) 16 | $(AR) rcs $@ $(OBJ) 17 | 18 | .PHONY: clean 19 | clean: 20 | rm *.o 2> /dev/null || true 21 | -------------------------------------------------------------------------------- /runtime/foundation/array.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Array routines 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include "lbasic.h" 10 | 11 | static LB_ARRAY *alloc_new(uint16_t dims, size_t data_size) { 12 | size_t header_size = sizeof(LB_ARRAY) + dims * sizeof(int32_t) * 3; 13 | LB_ARRAY *header = malloc(header_size); 14 | if (!header) { 15 | fatal_error(ERR_ARRAY_ALLOC_FAILED); 16 | } 17 | header->data = malloc(data_size); 18 | if (!header->data) { 19 | fatal_error(ERR_ARRAY_TOO_BIG); 20 | } 21 | memset(header->data, 0, data_size); 22 | header->refcount = 0; 23 | header->dims = dims; 24 | header->data_size = data_size; 25 | return header; 26 | } 27 | 28 | LB_ARRAY *ARRAY_INIT(uint16_t dims, int64_t element_size, ...) { 29 | va_list args; 30 | size_t data_size; 31 | int32_t lbound, ubound; 32 | 33 | va_start(args, element_size); 34 | if (element_size < 0 || (uint64_t)element_size > SIZE_MAX) { 35 | // element_size should never be negative, but we want to really avoid computing a 36 | // bogus value for the memory allocation coming up. 37 | fatal_error(ERR_ARRAY_TOO_BIG); 38 | } 39 | data_size = element_size; 40 | for (uint8_t i = 0; i < dims; i++) { 41 | lbound = va_arg(args, int32_t); 42 | ubound = va_arg(args, int32_t); 43 | if (lbound > ubound) { 44 | fatal_error(ERR_ARRAY_BAD_BOUNDS); 45 | } 46 | if (__builtin_mul_overflow(data_size, (ubound - lbound + 1), &data_size)) { 47 | fatal_error(ERR_ARRAY_TOO_BIG); 48 | } 49 | } 50 | va_end(args); 51 | 52 | LB_ARRAY *array = alloc_new(dims, data_size); 53 | va_start(args, element_size); 54 | data_size = 1; // Sizes stored in units of element_size 55 | for (uint8_t i = 0; i < dims; i++) { 56 | lbound = va_arg(args, int32_t); 57 | ubound = va_arg(args, int32_t); 58 | array->sizes[i * 3] = ubound; 59 | array->sizes[i * 3 + 1] = lbound; 60 | int32_t tmp = (ubound - lbound + 1) * data_size; 61 | array->sizes[i * 3 + 2] = tmp; 62 | data_size = tmp; 63 | } 64 | va_end(args); 65 | return array; 66 | } 67 | 68 | void ARRAY_OUT_OF_BOUNDS(void) { 69 | fatal_error(ERR_ARRAY_OUT_OF_BOUNDS); 70 | } 71 | 72 | LB_LONG LBOUND(LB_ARRAY *array, uint16_t *dim_p) { 73 | uint16_t dim; 74 | if (dim_p == NULL) { 75 | dim = 1; 76 | } 77 | else { 78 | dim = *dim_p; 79 | if (dim > array->dims) { 80 | fatal_error(ERR_ARRAY_BAD_DIM); 81 | } 82 | } 83 | return array->sizes[(dim - 1) * 3 + 1]; 84 | } 85 | 86 | LB_LONG UBOUND(LB_ARRAY *array, uint16_t *dim_p) { 87 | uint16_t dim; 88 | if (dim_p == NULL) { 89 | dim = 1; 90 | } 91 | else { 92 | dim = *dim_p; 93 | if (dim > array->dims) { 94 | fatal_error(ERR_ARRAY_BAD_DIM); 95 | } 96 | } 97 | return array->sizes[(dim - 1) * 3]; 98 | } 99 | 100 | LB_INTEGER64 LEN_ARRAY(LB_ARRAY *array) { 101 | // It is possible for this value to be bigger than a signed int64. 102 | // The current approach of blithely ignoring this is not great. 103 | return array->data_size; 104 | } -------------------------------------------------------------------------------- /runtime/foundation/array.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Array routines header 4 | 5 | #ifndef LB_ARRAY_H 6 | #define LB_ARRAY_H 7 | 8 | #include 9 | 10 | struct lbarray_t { 11 | int8_t *data; 12 | uint8_t refcount; 13 | uint16_t dims; 14 | uint64_t data_size; 15 | // sizes[0] -> ubound of first dimension 16 | // sizes[1] -> lbound of first dimension 17 | // sizes[2] -> size of first dimension in units of element size 18 | // ... 19 | // sizes[(dims-1) * 3] -> ubound of last dimension 20 | // sizes[(dims-1) * 3 + 1] -> lbound of last dimension 21 | // sizes[(dims-1) * 3 + 2] -> size of last dimension in units of element size, incorporating size of previous dimensions 22 | // The ubound is not strictly necessary as it could be derived from the other values, but makes bounds checking easier. 23 | // There is potentially an optimisation to be made by not storing/using the ubound explicitly. 24 | int32_t sizes[]; 25 | }; 26 | 27 | typedef struct lbarray_t LB_ARRAY; 28 | 29 | #endif 30 | -------------------------------------------------------------------------------- /runtime/foundation/env.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Basic interactions with the operating environment 4 | 5 | #include 6 | #include "lbasic.h" 7 | 8 | void SYSTEM(LB_INTEGER *return_code) { 9 | if (return_code) { 10 | exit(*return_code); 11 | } 12 | else { 13 | exit(0); 14 | } 15 | } 16 | 17 | void END(LB_INTEGER *return_code) { 18 | if (return_code) { 19 | exit(*return_code); 20 | } 21 | else { 22 | exit(0); 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /runtime/foundation/error.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Error handling 4 | 5 | #include 6 | #include 7 | #include "lbasic.h" 8 | 9 | void fatal_error(enum error_code code) { 10 | fprintf(stderr, "Fatal error %d\n", code); 11 | exit(2); 12 | } 13 | -------------------------------------------------------------------------------- /runtime/foundation/error.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Error codes and handling functions 4 | 5 | #ifndef LB_ERROR_H 6 | #define LB_ERROR_H 7 | 8 | enum error_code { 9 | ERR_STR_ALLOC_FAILED = 1, 10 | ERR_STRING_TOO_BIG, 11 | ERR_ARRAY_ALLOC_FAILED, 12 | ERR_ARRAY_TOO_BIG, 13 | ERR_ARRAY_BAD_BOUNDS, 14 | ERR_ARRAY_OUT_OF_BOUNDS, 15 | ERR_ARRAY_BAD_DIM, 16 | ERR_ARG_RANGE, 17 | }; 18 | 19 | void fatal_error(enum error_code code); 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /runtime/foundation/lbasic.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Main include file for C functions 4 | 5 | #ifndef LB_LBASIC_H 6 | #define LB_LBASIC_H 7 | 8 | #include "error.h" 9 | #include "types.h" 10 | #include "names.h" 11 | #include "string.h" 12 | #include "array.h" 13 | #include "minmax.h" 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /runtime/foundation/main.c: -------------------------------------------------------------------------------- 1 | #include "lbasic.h" 2 | 3 | extern void MAIN(void); 4 | 5 | int main(int argc, char **argv) { 6 | MAIN(); 7 | return 0; 8 | } 9 | -------------------------------------------------------------------------------- /runtime/foundation/minmax.h: -------------------------------------------------------------------------------- 1 | // This file incorporates a max macro by David Titarenco, 2 | // (https://stackoverflow.com/a/3437484). 3 | // SPDX-License-Identifier: CC-BY-SA-2.5 4 | 5 | #ifndef LB_MINMAX_H 6 | #define LB_MINMAX_H 7 | 8 | #define max(a,b) \ 9 | ({ __typeof__ (a) _a = (a); \ 10 | __typeof__ (b) _b = (b); \ 11 | _a > _b ? _a : _b; }) 12 | 13 | #define min(a,b) \ 14 | ({ __typeof__ (a) _a = (a); \ 15 | __typeof__ (b) _b = (b); \ 16 | _a < _b ? _a : _b; }) 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /runtime/foundation/names.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Mangled versions of identifiers 4 | 5 | #ifndef LB_NAMES_H 6 | #define LB_NAMES_H 7 | 8 | #define MAIN main$n 9 | 10 | #define ARRAY_INIT LB$$ARRAY_INIT 11 | #define ARRAY_OUT_OF_BOUNDS LB$$ARRAY_OUT_OF_BOUNDS 12 | #define STRING_INIT LB$$STRING_INIT 13 | #define STRING_ASSIGN LB$$STRING_ASSIGN 14 | #define STRING_MAYBE_FREE LB$$STRING_MAYBE_FREE 15 | #define STRING_ADD LB$$STRING_ADD 16 | #define STRING_EQ LB$$STRING_EQ 17 | #define STRING_NE LB$$STRING_NE 18 | #define STRING_LT LB$$STRING_LT 19 | #define STRING_LE LB$$STRING_LE 20 | #define STRING_GT LB$$STRING_GT 21 | #define STRING_GE LB$$STRING_GE 22 | 23 | #define ASC asc$itL 24 | #define CHR chr$tk 25 | #define END end$nI 26 | #define LBOUND lbound$la0yI 27 | #define LEN_STRING len$lt 28 | #define LEN_ARRAY len$ka0y 29 | #define MID mid$ttlL 30 | #define PRINT_BOOL print$nb 31 | #define PRINT_INTEGER print$ni 32 | #define PRINT_LONG print$nl 33 | #define PRINT_INTEGER64 print$nk 34 | #define PRINT_SINGLE print$ns 35 | #define PRINT_DOUBLE print$nd 36 | #define PRINT_STRING print$nt 37 | #define STR_BOOL str$tb 38 | #define STR_INTEGER str$ti 39 | #define STR_LONG str$tl 40 | #define STR_INTEGER64 str$tk 41 | #define SYSTEM system$nI 42 | #define UBOUND ubound$la0yI 43 | 44 | #endif 45 | -------------------------------------------------------------------------------- /runtime/foundation/print.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // PRINT statement 4 | 5 | #include 6 | #include 7 | #include "lbasic.h" 8 | 9 | void PRINT_BOOL(LB_BOOL num) { 10 | if (num) { 11 | printf("-1 "); 12 | } 13 | else { 14 | printf(" 0 "); 15 | } 16 | } 17 | 18 | void PRINT_INTEGER(LB_INTEGER num) { 19 | printf("% hd ", num); 20 | } 21 | 22 | void PRINT_LONG(LB_LONG num) { 23 | printf("% " PRId32 " ", num); 24 | } 25 | 26 | void PRINT_INTEGER64(LB_INTEGER64 num) { 27 | printf("% " PRId64 " ", num); 28 | } 29 | 30 | // Using %g is not really correct, but is a good approximation for now 31 | void PRINT_SINGLE(LB_SINGLE num) { 32 | printf("% g ", num); 33 | } 34 | 35 | void PRINT_DOUBLE(LB_DOUBLE num) { 36 | printf("% g ", num); 37 | } 38 | 39 | void PRINT_STRING(LB_STRING *str) { 40 | fwrite(str->data, 1, str->len, stdout); 41 | } 42 | 43 | -------------------------------------------------------------------------------- /runtime/foundation/str.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // STR$ number to string functions 4 | 5 | #include 6 | #include 7 | #include "lbasic.h" 8 | 9 | LB_STRING *STR_BOOL(LB_BOOL value) { 10 | // Range -1 to 0 11 | LB_STRING *result = STRING_INIT(2); 12 | if (value) { 13 | result->data[0] = '-'; 14 | result->data[1] = '1'; 15 | } 16 | else { 17 | result->data[0] = ' '; 18 | result->data[1] = '0'; 19 | } 20 | result->len = 2; 21 | return result; 22 | } 23 | 24 | LB_STRING *STR_INTEGER(LB_INTEGER value) { 25 | // Range -32768 to 32767 26 | LB_STRING *result = STRING_INIT(7); 27 | result->len = snprintf(result->data, result->alloc, "% hd", value); 28 | return result; 29 | } 30 | 31 | LB_STRING *STR_LONG(LB_LONG value) { 32 | // Range -2147483648 to 2147483647 33 | LB_STRING *result = STRING_INIT(12); 34 | result->len = snprintf(result->data, result->alloc, "% " PRId32, value); 35 | return result; 36 | } 37 | 38 | LB_STRING *STR_INTEGER64(LB_INTEGER64 value) { 39 | // Range -9223372036854775808 to 9223372036854775807 40 | LB_STRING *result = STRING_INIT(21); 41 | result->len = snprintf(result->data, result->alloc, "% " PRId64, value); 42 | return result; 43 | } -------------------------------------------------------------------------------- /runtime/foundation/string.c: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // String routines 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include "lbasic.h" 10 | 11 | /** 12 | * Make a new instance of a string with the same content as 13 | * src. The refcount is set to 0 and flags are cleared. 14 | */ 15 | static LB_STRING *duplicate(LB_STRING *src); 16 | 17 | /** 18 | * Return a string suitable for permanent assignment. The refcount 19 | * is incremented if the string is mutable. A copy may be made if 20 | * the refcount is at its limit. 21 | */ 22 | static LB_STRING *acquire(LB_STRING *s); 23 | 24 | /** 25 | * Remove an assignment of a string. If mutable, the refcount is 26 | * decremented and the string's memory is freed if it is 0. 27 | */ 28 | static void release(LB_STRING *s); 29 | 30 | 31 | static LB_STRING *duplicate(LB_STRING *src) { 32 | LB_STRING *dup = STRING_INIT(src->len); 33 | dup->len = src->len; 34 | memmove(dup->data, src->data, src->len); 35 | return dup; 36 | } 37 | 38 | static LB_STRING *acquire(LB_STRING *s) { 39 | if (s->flags & LB_STRING_READONLY) { 40 | // Cannot modify readonly string 41 | return s; 42 | } 43 | if (s->refcount == UINT8_MAX) { 44 | // Max number of references to this string 45 | LB_STRING *dup = duplicate(s); 46 | dup->refcount = 1; 47 | return dup; 48 | } 49 | s->refcount++; 50 | return s; 51 | } 52 | 53 | static void release(LB_STRING *s) { 54 | if (s->flags & LB_STRING_READONLY) { 55 | // Cannot modify readonly string 56 | return; 57 | } 58 | // Do not decrement if already at 0. A string may already have a 0 59 | // refcount if, e.g., it is the return value of a function. 60 | if (s->refcount > 0) { 61 | s->refcount--; 62 | } 63 | if (s->refcount == 0) { 64 | free(s); 65 | } 66 | } 67 | 68 | /** 69 | * Allocate memory for a string that can hold alloc_size bytes. 70 | * Flags are cleared, refcount and len are set to 0. 71 | */ 72 | LB_STRING *STRING_INIT(LB_STRING_SIZE_T alloc_size) { 73 | size_t total_size = sizeof(LB_STRING) + alloc_size; 74 | if (total_size < alloc_size) { 75 | fatal_error(ERR_STRING_TOO_BIG); 76 | } 77 | LB_STRING *lbs = malloc(total_size); 78 | if (!lbs) { 79 | fatal_error(ERR_STR_ALLOC_FAILED); 80 | } 81 | lbs->flags = 0; 82 | lbs->refcount = 0; 83 | lbs->len = 0; 84 | lbs->alloc = alloc_size; 85 | return lbs; 86 | } 87 | 88 | /** 89 | * Implement string assignment 90 | */ 91 | void STRING_ASSIGN(LB_STRING **dest_p, LB_STRING *src) { 92 | LB_STRING *dest = *dest_p; 93 | if (dest) { 94 | release(dest); 95 | } 96 | *dest_p = acquire(src); 97 | } 98 | 99 | /** 100 | * Implement string concatenation 101 | */ 102 | LB_STRING *STRING_ADD(LB_STRING *left, LB_STRING *right) { 103 | // It may be more efficient to reuse the left string if it 104 | // can be modified. 105 | size_t new_len = left->len + right->len; 106 | if (new_len < left->len) { 107 | fatal_error(ERR_STRING_TOO_BIG); 108 | } 109 | LB_STRING *result = STRING_INIT(new_len); 110 | result->len = new_len; 111 | memmove(result->data, left->data, left->len); 112 | memmove(result->data + left->len, right->data, right->len); 113 | return result; 114 | } 115 | 116 | /** 117 | * Free a string if it is no longer needed. Calls to this 118 | * are emitted periodically to free strings that are thought 119 | * to be temporary, or when a variable goes out of scope. 120 | */ 121 | void STRING_MAYBE_FREE(LB_STRING *src) { 122 | release(src); 123 | } 124 | 125 | LB_STRING *MID(LB_STRING *src, LB_LONG start, LB_LONG *length_p) { 126 | LB_LONG length; 127 | if (start > src->len) { 128 | return STRING_INIT(0); 129 | } 130 | 131 | if (length_p) { 132 | length = *length_p - max(1 - start, 0); 133 | start = max(1, start); 134 | length = min(src->len - start + 1, length); 135 | } 136 | else { 137 | start = max(1, start); 138 | length = src->len - start + 1; 139 | } 140 | 141 | LB_STRING *dest = STRING_INIT(length); 142 | dest->len = length; 143 | memmove(dest->data, src->data + start - 1, length); 144 | return dest; 145 | } 146 | 147 | LB_LONG LEN_STRING(LB_STRING *s) { 148 | return s->len; 149 | } 150 | 151 | LB_STRING *CHR(LB_INTEGER64 v) { 152 | LB_STRING *result = STRING_INIT(1); 153 | result->len = 1; 154 | if (v < 0 || v > 255) { 155 | fatal_error(ERR_ARG_RANGE); 156 | } 157 | result->data[0] = (char) v; 158 | return result; 159 | } 160 | 161 | LB_INTEGER ASC(LB_STRING *s, LB_LONG *index_p) { 162 | LB_LONG index = index_p ? *index_p : 1; 163 | if (s->len < index) { 164 | fatal_error(ERR_ARG_RANGE); 165 | } 166 | return s->data[index - 1]; 167 | } 168 | 169 | LB_BOOL STRING_EQ(LB_STRING *a, LB_STRING *b) { 170 | if (a->len != b->len) { 171 | return 0; 172 | } 173 | return memcmp(a->data, b->data, a->len) == 0; 174 | } 175 | 176 | LB_BOOL STRING_NE(LB_STRING *a, LB_STRING *b) { 177 | return !STRING_EQ(a, b); 178 | } 179 | 180 | LB_BOOL STRING_LT(LB_STRING *a, LB_STRING *b) { 181 | LB_LONG length = min(a->len, b->len); 182 | int cmp = memcmp(a->data, b->data, length); 183 | return cmp < 0 || 184 | (cmp == 0 && a->len < b->len); 185 | } 186 | 187 | LB_BOOL STRING_LE(LB_STRING *a, LB_STRING *b) { 188 | LB_LONG length = min(a->len, b->len); 189 | int cmp = memcmp(a->data, b->data, length); 190 | return cmp < 0 || 191 | (cmp == 0 && a->len <= b->len); 192 | } 193 | 194 | LB_BOOL STRING_GT(LB_STRING *a, LB_STRING *b) { 195 | return STRING_LT(b, a); 196 | } 197 | 198 | LB_BOOL STRING_GE(LB_STRING *a, LB_STRING *b) { 199 | return STRING_LE(b, a); 200 | } 201 | 202 | -------------------------------------------------------------------------------- /runtime/foundation/string.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // String routines header 4 | 5 | #ifndef LB_STRING_H 6 | #define LB_STRING_H 7 | 8 | #include 9 | 10 | typedef uint32_t LB_STRING_SIZE_T; 11 | 12 | struct lbstr_t { 13 | uint8_t flags; 14 | uint8_t refcount; 15 | LB_STRING_SIZE_T len; 16 | LB_STRING_SIZE_T alloc; 17 | char data[]; 18 | }; 19 | 20 | typedef struct lbstr_t LB_STRING; 21 | 22 | LB_STRING *STRING_INIT(LB_STRING_SIZE_T alloc_size); 23 | 24 | #define LB_STRING_READONLY (1<<0) 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /runtime/foundation/types.h: -------------------------------------------------------------------------------- 1 | // Copyright Luke Ceddia 2 | // SPDX-License-Identifier: Apache-2.0 3 | // Definitions of L-BASIC primative types 4 | 5 | #ifndef LB_TYPES_H 6 | #define LB_TYPES_H 7 | 8 | #include 9 | #include 10 | 11 | typedef _Bool LB_BOOL; 12 | typedef int16_t LB_INTEGER; 13 | typedef int32_t LB_LONG; 14 | typedef int64_t LB_INTEGER64; 15 | typedef float LB_SINGLE; 16 | typedef double LB_DOUBLE; 17 | // typedef fp128 LB_QUAD; 18 | 19 | #if SIZE_MAX > UINT64_MAX 20 | #error size_t cannot be larger than int64_t 21 | #endif 22 | 23 | #endif 24 | -------------------------------------------------------------------------------- /tests/array.test: -------------------------------------------------------------------------------- 1 | $title: one dimensional array 2 | dim f(4) 3 | dim g(6) as string 4 | dim h&(-3 to 6) 5 | for i = 0 to 4 6 | if i <> 3 then f(i) = i + 0.5 7 | next i 8 | for i = 0 to 6 9 | if i <> 4 then g(i) = ltrim(str(i)) 10 | next i 11 | for i = -3 to 6 12 | h&(i) = i + 0.1 13 | next i 14 | for i = 0 to 4 15 | print f(i); 16 | next i 17 | print 18 | for i = 0 to 6 19 | print g(i); 20 | next i 21 | print 22 | for i = -3 to 6 23 | print h(i); 24 | next i 25 | $expect: stdout 26 | .5 1.5 2.5 0 4.5 27 | 012356 28 | -3 -2 -1 0 1 2 3 4 5 6 29 | $finish 30 | 31 | $title: multi-dimensional array 32 | dim f$(3, 1 to 2, -3 to 1) 33 | for i = 0 to 3 34 | for j = 1 to 2 35 | for k = -3 to 1 36 | f(i, j, k) = str(i) + ltrim(str(j)) + ltrim(str(k)) 37 | next k 38 | next j 39 | next i 40 | for i = 0 to 3 41 | for j = 1 to 2 42 | for k = -3 to 1 43 | print f(i, j, k); 44 | next k 45 | next j 46 | next i 47 | $expect: stdout 48 | 01-3 21-3 21-2 22-3 22-2 21-2 22-3 22-2 22-1 220 11-3 31-3 31-2 32-3 32-2 31-2 32-3 32-2 32-1 320 21-3 21-2 22-3 22-2 22-1 22-3 22-2 22-1 220 221 31-3 31-2 32-3 32-2 32-1 32-3 32-2 32-1 320 321 49 | $finish 50 | 51 | $title: array of udt 52 | type t 53 | a as long 54 | b as string 55 | end type 56 | dim f(4) as t 57 | for i = 0 to 4 58 | f(i).a = i 59 | f(i).b = ltrim(str(i)) 60 | next i 61 | for i = 0 to 4 62 | print f(i).a; f(i).b; 63 | next i 64 | $expect: stdout 65 | 0 0 1 1 2 2 3 3 4 4 66 | $finish 67 | 68 | 69 | $title: array bounds checking 1 70 | dim f(4) 71 | f(5) = 3 72 | $expect: error 73 | 74 | $title: array bounds checking 2 75 | dim f(4) 76 | f(-1) = 3 77 | $expect: error 78 | 79 | $title: array bounds checking 3 80 | dim f(2 to 4) 81 | f(1) = 3 82 | $expect: error 83 | 84 | $title: array bounds checking 4 85 | dim f(3, 1 to 6) 86 | f(1, 0) = 3 87 | $expect: error 88 | -------------------------------------------------------------------------------- /tests/assignment.test: -------------------------------------------------------------------------------- 1 | $title: simple assignment 2 | a = 1 3 | b& = a 4 | c&& = b 5 | d! = c 6 | e# = d 7 | f## = e 8 | g$ = "hello" 9 | print a; b&; c; d!; e; f##; g 10 | $expect: stdout 11 | 1 1 1 1 1 1 hello 12 | $finish 13 | 14 | $title: expression 15 | a = 1 + 7 - 5 16 | print a 17 | $expect: stdout 18 | 3 19 | $finish 20 | 21 | $title: comparison 22 | a = 1 = 1 23 | print a 24 | $expect: stdout 25 | -1 26 | $finish 27 | 28 | $title: self-referential 29 | a = 2 30 | a = a + 1 31 | b = b + 1 32 | print a; b 33 | $expect: stdout 34 | 3 1 35 | $finish 36 | 37 | $title: string to number illegal 38 | a& = "hello" 39 | $expect: error 40 | 41 | $title: number to string illegal 42 | a$ = 1 43 | $expect: error 44 | -------------------------------------------------------------------------------- /tests/const.test: -------------------------------------------------------------------------------- 1 | $title: literals 2 | const a = 20.2 3 | const b = "hello" 4 | const c = b 5 | print a; b; c 6 | $expect: stdout 7 | 20.2 hellohello 8 | $finish 9 | 10 | $title: expressions 11 | const false = 0 12 | const true = not false 13 | print true; false 14 | $expect: stdout 15 | -1 0 16 | $finish 17 | 18 | $title: combined definition 19 | const false = 0, true = not false 20 | print true; false 21 | $expect: stdout 22 | -1 0 23 | $finish 24 | 25 | $title: duplicate const is illegal 26 | const a = 1 27 | const a = 3 28 | $expect: error 29 | 30 | $title: reassigning is illegal 31 | const a = 1 32 | a = 3 33 | $expect: error 34 | 35 | $title: compound const 36 | const false = 0, true = not false 37 | const a = 1, b = 2, c = a + b 38 | ?a; c; true 39 | $expect: stdout 40 | 1 3 -1 41 | $finish 42 | 43 | $title: const scoping 44 | const a = 3 45 | sub s 46 | print a 47 | end sub 48 | s 49 | $expect: stdout 50 | 3 51 | $finish 52 | -------------------------------------------------------------------------------- /tests/for.test: -------------------------------------------------------------------------------- 1 | $title: ascending counter 2 | for i = 1 to 3 3 | print i; 4 | next i 5 | $expect: stdout 6 | 1 2 3 7 | $finish 8 | 9 | $title: ascending counter, explicit step 10 | for i = 1 to 3 step 1 11 | print i; 12 | next i 13 | $expect: stdout 14 | 1 2 3 15 | $finish 16 | 17 | $title: ascending counter, imperfect step divisor 18 | for i = 1 to 5 step 3 19 | print i; 20 | next i 21 | $expect: stdout 22 | 1 4 23 | $finish 24 | 25 | $title: descending counter 26 | for i = 3 to 1 step -1 27 | print i; 28 | next i 29 | $expect: stdout 30 | 3 2 1 31 | $finish 32 | 33 | $title: descending counter, no step 34 | for i = 3 to 1 35 | print i; 36 | next i 37 | $expect: stdout 38 | $finish 39 | 40 | $title: ascending range, negative step 41 | for i = 1 to 3 step -1 42 | print i; 43 | next i 44 | $expect: stdout 45 | $finish 46 | 47 | $title: singular range, positive step 48 | for i = 1 to 1 step 1 49 | print i; 50 | next i 51 | $expect: stdout 52 | 1 53 | $finish 54 | 55 | $title: singular range, negative step 56 | for i = 1 to 1 step -1 57 | print i; 58 | next i 59 | $expect: stdout 60 | 1 61 | $finish 62 | 63 | $title: descending range, zero step 64 | for i = 2 to 1 step 0 65 | print i; 66 | next i 67 | $expect: stdout 68 | $finish 69 | 70 | $title: singluar range, zero step 71 | for i = 1 to 2 step 0 72 | lim = lim + 1 73 | print i; 74 | if lim = 4 then system 75 | next i 76 | $expect: stdout 77 | 1 1 1 1 78 | $finish 79 | 80 | $title: nested 81 | for i = 1 to 3 82 | for j = 1 to i 83 | print i; j 84 | next j 85 | next i 86 | $expect: stdout 87 | 1 1 88 | 2 1 89 | 2 2 90 | 3 1 91 | 3 2 92 | 3 3 93 | $finish 94 | 95 | $title: implicit variable name 96 | for i = 1 to 3 97 | print i; 98 | next 99 | $expect: stdout 100 | 1 2 3 101 | $finish 102 | -------------------------------------------------------------------------------- /tests/if.test: -------------------------------------------------------------------------------- 1 | $title: single line 2 | if 1 then print "a" 3 | if 0 then print "b" 4 | $expect: stdout 5 | a 6 | $finish 7 | 8 | $title: single line with else 9 | if 1 then print "x"; else print "y"; 10 | if 0 then print "a" else print "b" 11 | $expect: stdout 12 | xb 13 | $finish 14 | 15 | $title: multi line 16 | if 1 then 17 | print "x"; 18 | print "y" 19 | end if 20 | if 0 then 21 | print "x"; 22 | print "y" 23 | else 24 | print "a"; 25 | print "b" 26 | end if 27 | if 1 then 28 | else 29 | print "z" 30 | end if 31 | if 1 then 32 | print "c" 33 | else 34 | end if 35 | $expect: stdout 36 | xy 37 | ab 38 | c 39 | $finish 40 | 41 | $title: single elseif 42 | if 0 then 43 | print "a" 44 | elseif 1 then 45 | print "b" 46 | end if 47 | $expect: stdout 48 | b 49 | $finish 50 | 51 | $title: multiple elseifs 52 | if 0 then 53 | print "a" 54 | elseif 0 then 55 | elseif 1 then 56 | print "c" 57 | end if 58 | $expect: stdout 59 | c 60 | $finish 61 | 62 | $title: else must be last clause 63 | if 1 then 64 | print "a" 65 | else 66 | print "b" 67 | elseif 1 then 68 | print "c" 69 | end if 70 | $expect: builderror 71 | 72 | $title: single line with colons 73 | if 1 then print "a";:print "b"; 74 | if 1 then : 75 | if 1 then :print "c";: 76 | if 1 then :print "d";:print "e"; 77 | if 0 then print "f"; else : 78 | if 0 then print "g"; else print "h";:print "i"; 79 | if 0 then print "j"; else :print "k": 80 | $expect: stdout 81 | abcdehik 82 | $finish 83 | 84 | $title: multiline with colons 85 | if 0 then 86 | print "a" 87 | else : print "b"; 88 | end if 89 | if 0 then 90 | print "c" 91 | else : print "d"; 92 | end if 93 | if 0 then 94 | print "e" 95 | else : print "f": end if 96 | $expect: stdout 97 | bdf 98 | $finish 99 | 100 | $title: rem 101 | if 1 then rem 102 | if 1 then 103 | print "a"; 104 | else rem 105 | end if 106 | if 0 then 107 | else rem 108 | print "b" 109 | end if 110 | $expect: stdout 111 | ab 112 | $finish 113 | 114 | $title: expressions 115 | if -1 + 1 then print "a" else print "b" 116 | $expect: stdout 117 | b 118 | $finish 119 | 120 | $title: nested if 121 | if 10 > 1 then 122 | print "a"; 123 | if 3 < 2 then 124 | print "b"; 125 | else 126 | print "c"; 127 | end if 128 | end if 129 | $expect: stdout 130 | ac 131 | $finish 132 | 133 | $title: floating-point guards 134 | if 1.2 then print "a"; 135 | if 1.2 - 1.2 then print "b"; else print "c"; 136 | if 9.8# then print "d"; 137 | $expect: stdout 138 | acd 139 | $finish -------------------------------------------------------------------------------- /tests/loops.test: -------------------------------------------------------------------------------- 1 | $title: while 2 | while x < 3 3 | print x 4 | x = x + 1 5 | wend 6 | $expect: stdout 7 | 0 8 | 1 9 | 2 10 | $finish 11 | 12 | $title: do while 13 | do while x < 3 14 | print x 15 | x = x + 1 16 | loop 17 | $expect: stdout 18 | 0 19 | 1 20 | 2 21 | $finish 22 | 23 | $title: do until 24 | do until x >= 3 25 | print x 26 | x = x + 1 27 | loop 28 | $expect: stdout 29 | 0 30 | 1 31 | 2 32 | $finish 33 | 34 | $title: loop while 35 | do 36 | print x 37 | x = x + 1 38 | loop while x < 3 39 | $expect: stdout 40 | 0 41 | 1 42 | 2 43 | $finish 44 | 45 | $title: loop until 46 | do 47 | print x 48 | x = x + 1 49 | loop until x >= 3 50 | $expect: stdout 51 | 0 52 | 1 53 | 2 54 | $finish 55 | 56 | $title: do with dual conditions illegal 57 | x = 0 58 | do until x >= 3 59 | print x 60 | x = x + 1 61 | loop until x < 3 62 | $expect: error 63 | 64 | $title: nested do 65 | do while x < 2 66 | y = 0 67 | do while y < 2 68 | print x; y 69 | y = y + 1 70 | loop 71 | x = x + 1 72 | loop 73 | $expect: stdout 74 | 0 0 75 | 0 1 76 | 1 0 77 | 1 1 78 | $finish 79 | 80 | $title: nested while & do 81 | do while x < 2 82 | y = 0 83 | while y < 2 84 | print x; y 85 | y = y + 1 86 | wend 87 | x = x + 1 88 | loop 89 | $expect: stdout 90 | 0 0 91 | 0 1 92 | 1 0 93 | 1 1 94 | $finish 95 | -------------------------------------------------------------------------------- /tests/memory.test: -------------------------------------------------------------------------------- 1 | $title: len 2 | 'len(f##) is 32 in QB64, but should be 16 3 | print len(a%); len(b&); len(c&&); len(d!); len(e#); len(f##); len("hello") 4 | $expect: stdout 5 | 2 4 8 4 8 32 5 6 | $finish 7 | -------------------------------------------------------------------------------- /tests/print.test: -------------------------------------------------------------------------------- 1 | $title: newline 2 | print "top" 3 | print 4 | print "bottom" 5 | $expect: stdout_exact 6 | top 7 | 8 | bottom 9 | $finish 10 | 11 | $title: nothing 12 | print "top" 13 | print ; 14 | print "bottom" 15 | $expect: stdout_exact 16 | top 17 | bottom 18 | $finish 19 | 20 | $title: semicolon joined 21 | print "hello"; "world" 22 | print "the"; "rain"; ; "in"; 23 | print ;"spain"; "fal" + "ls"; "mainly" 24 | $expect: stdout_exact 25 | helloworld 26 | theraininspainfallsmainly 27 | $finish 28 | 29 | $title: semicolons and commas 30 | 'Warning: the expected output for this test contains embedded tabs 31 | print "hello", "world" 32 | print ,"the rain",,"in";,"spain", 33 | print "falls" 34 | $expect: stdout_exact 35 | hello world 36 | the rain in spain falls 37 | $finish 38 | 39 | $title: booleans 40 | print 1 > 0 41 | print 1 < 0 42 | $expect: stdout_exact 43 | -1 44 | 0 45 | $finish 46 | 47 | $title: integral numbers 48 | biggestint% = 32767 49 | smallestint% = -32768 50 | biggestlong& = 2147483647 51 | smallestlong& = -2147483648 52 | biggestint64&& = 9223372036854775807 53 | smallestint64&& = -9223372036854775808 54 | print 134; -7; biggestint%; smallestint%; biggestlong&; smallestlong&; biggestint64&&; smallestint64&& 55 | $expect: stdout_exact 56 | 134 -7 32767 -32768 2147483647 -2147483648 9223372036854775807 -9223372036854775808 57 | $finish 58 | 59 | $title: floating-point numbers 60 | smallsingle! = 1234567 61 | bigsingle! = 12345678 62 | smalldouble# = 1234567890123456 63 | bigdouble# = 12345678901234567 64 | print smallsingle!; bigsingle!; smalldouble#; bigdouble# 65 | $expect: stdout_exact 66 | 1234567 1.234568E+07 1234567890123456 1.234567890123457D+16 67 | $finish 68 | 69 | $title: ? shortcut 70 | ?"a" 71 | ?1 72 | $expect: stdout_exact 73 | a 74 | 1 75 | $finish 76 | 77 | -------------------------------------------------------------------------------- /tests/string.test: -------------------------------------------------------------------------------- 1 | $title: equality 2 | a$ = "hello" 3 | b$ = "world" 4 | c$ = "hello" 5 | print a$ = b$; a$ = c$; a$ <> b$; a$ <> c$ 6 | $expect: stdout 7 | 0 -1 -1 0 8 | $finish 9 | 10 | $title: asc 11 | a$ = "hello world" 12 | print asc(a$); asc(a$, 2) 13 | $expect: stdout 14 | 104 101 15 | $finish 16 | 17 | $title: asc past end of string illegal 18 | a$ = "hello" 19 | print asc(a$, 6) 20 | $expect: error 21 | 22 | $title: chr 23 | print chr$(101) 24 | $expect: stdout 25 | e 26 | $finish 27 | 28 | $title: chr greater than byte illegal 29 | print chr$(300) 30 | $expect: error 31 | 32 | $title: negative chr illegal 33 | print chr$(-40) 34 | $expect: error 35 | 36 | $title: binary instr 37 | print instr("hello", "h"); instr("hello", "lo"); instr("hello", "asdf") 38 | print instr("hello", ""); instr("", "h"); instr("", "") 39 | $expect: stdout 40 | 1 4 0 41 | 1 0 0 42 | $finish 43 | 44 | $title: ternary instr 45 | print instr(1, "hello", "h"); instr(-2, "hello", "e"); instr(4, "hello", "l") 46 | print instr(10, "hello", "h") 47 | $expect: stdout 48 | 1 2 4 49 | 0 50 | $finish 51 | 52 | $title: lcase 53 | print lcase$("HeLLo") 54 | $expect: stdout 55 | hello 56 | $finish 57 | 58 | $title: left 59 | print left$("hello", 2) 60 | print left$("hello", 6) 61 | print left$("hello", 0) 62 | print left$("hello", -1) 63 | $expect: stdout 64 | he 65 | hello 66 | 67 | 68 | $finish 69 | 70 | $title: right 71 | print right$("hello", 2) 72 | print right$("hello", 6) 73 | print right$("hello", 0) 74 | print right$("hello", -1) 75 | $expect: stdout 76 | lo 77 | hello 78 | 79 | 80 | $finish 81 | 82 | $title: ltrim 83 | print "{"; ltrim$(" hello "); "}" 84 | $expect: stdout 85 | {hello } 86 | $finish 87 | 88 | $title: rtrim 89 | print "{"; rtrim$(" hello "); "}" 90 | $expect: stdout 91 | { hello} 92 | $finish 93 | 94 | $title: _trim 95 | print "{"; _trim$(" hello "); "}" 96 | $expect: stdout 97 | {hello} 98 | $finish 99 | 100 | $title: binary mid 101 | print mid$("hello", 3) 102 | print mid$("hello", -2) 103 | print mid$("hello", 6) 104 | print mid$("", 1) 105 | $expect: stdout 106 | llo 107 | hello 108 | 109 | 110 | $finish 111 | 112 | $title: ternary mid 113 | print mid$("hello", 2, 3) 114 | print mid$("hello", 4, 3) 115 | $expect: stdout 116 | ell 117 | lo 118 | $finish 119 | 120 | $title: space 121 | print "{"; space$(4); "}" 122 | $expect: stdout 123 | { } 124 | $finish 125 | 126 | $title: ucase 127 | print ucase$("HeLLo") 128 | $expect: stdout 129 | HELLO 130 | $finish 131 | -------------------------------------------------------------------------------- /tests/test.test: -------------------------------------------------------------------------------- 1 | $title: Example successful test 2 | print "Hello world" 3 | $expect: stdout 4 | Hello world 5 | $finish 6 | 7 | $title: Example successful error 8 | asdfjkl 9 | $expect: builderror 10 | -------------------------------------------------------------------------------- /tests/udt.test: -------------------------------------------------------------------------------- 1 | $title: simple udt 2 | type t 3 | a as long 4 | b$ 5 | as double c 6 | end type 7 | dim q as t 8 | q.a = 3 9 | q.b = "hello" 10 | q.c = 2.3 11 | print q.a; q.c; q.b 12 | $expect: stdout 13 | 3 2.3 hello 14 | $finish 15 | 16 | $title: udt format variations 17 | type t1 18 | a as long 19 | as string b, c 20 | d as integer, e& 21 | end type 22 | type t2 a$ end type 23 | dim q as t1, q2 as t2 24 | q.a = 10 25 | q.b = "hello" 26 | q.c = "bye" 27 | q.d = 5 28 | q.e = 7 29 | q2.a = "boo" 30 | print q.a; q.b; q.c; q.d; q.e; q2.a 31 | $expect: stdout 32 | 10 hellobye 5 7 boo 33 | $finish 34 | 35 | $title: nested udt 36 | type t1 37 | a as long 38 | b$ 39 | c 40 | end type 41 | type t2 42 | a$ 43 | b as t1 44 | c 45 | end type 46 | dim q as t2 47 | q.a = "hello" 48 | q.b.a = 3 49 | q.b.b = "world" 50 | print q.a; q.b.a; q.b.b 51 | $expect: stdout 52 | hello 3 world 53 | $finish 54 | 55 | $title: full udt copy 56 | type t1 57 | a as long 58 | b$ 59 | c 60 | end type 61 | type t2 62 | a$ 63 | b as t1 64 | c 65 | end type 66 | dim p as t1, q as t2, r as t2 67 | q.a = "hello" 68 | q.b.a = 3 69 | q.b.b = "world" 70 | q.c = 1.1 71 | p.a = 4 72 | p.b = "rain" 73 | q.b = p 74 | r = q 75 | print r.a; r.b.a; r.b.b; r.c 76 | $expect: stdout 77 | hello 4 rain 1.1 78 | $finish 79 | -------------------------------------------------------------------------------- /tests/variables.test: -------------------------------------------------------------------------------- 1 | $title: disallow changing variable types 2 | x% = 1 3 | x& = 2 4 | $expect: error 5 | 6 | $title: disallow changing variable types on same line 7 | x% = x& 8 | $expect: error 9 | 10 | $title: implicit type symbols 11 | x% = 1 12 | y& = 2 13 | z$ = "hello" 14 | print x%; y&; z$ 15 | $expect: stdout 16 | 1 2 hello 17 | $finish 18 | 19 | $title: default to 0 and empty string 20 | print x%; y!; "{"; z$; "}" 21 | $expect: stdout 22 | 0 0 {} 23 | $finish 24 | 25 | $title: dim 26 | type t 27 | v as long 28 | end type 29 | dim a as t, b$ 30 | a.v = 3 31 | b = "test" 32 | dim as t x, y 33 | x.v = 1 34 | y.v = 2 35 | $expect: silence 36 | 37 | -------------------------------------------------------------------------------- /tools/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright Luke Ceddia 2 | # SPDX-License-Identifier: Apache-2.0 3 | # Makefile for helper tools 4 | 5 | .PHONY: all 6 | all: tsgen.tool tokgen.tool incmerge.tool ffigen.tool test.tool 7 | 8 | %.tool: %.bas 9 | $(QB64) $(QBFLAGS) -x "$(realpath $<)" -o "$(realpath .)/$@" 10 | 11 | .PHONY: clean 12 | clean: 13 | rm *.tool *.exe 2> /dev/null || true 14 | -------------------------------------------------------------------------------- /tools/incmerge.bas: -------------------------------------------------------------------------------- 1 | 'Copyright Luke Ceddia 2 | 'SPDX-License-Identifier: Apache-2.0 3 | 'incmerge.bas - Include Merger 4 | 'Merge a .bas file and all its $include files into one. 5 | 6 | $console:only 7 | _dest _console 8 | deflng a-z 9 | on error goto ehandler 10 | chdir _startdir$ 11 | 12 | if _commandcount <> 2 then 13 | print "Usage: "; command$(0); " "; " " 14 | system 1 15 | end if 16 | 17 | open command$(2) for output as #1 18 | process command$(1) 19 | close #1 20 | 21 | system 22 | 23 | ehandler: 24 | print err; _errorline 25 | system 1 26 | 27 | sub process (filename$) 28 | fh = freefile 29 | open filename$ for binary as #fh 30 | olddir$ = _cwd$ 31 | chdir dirname$(filename$) 32 | do 33 | line input #fh, l$ 34 | if instr(ltrim$(l$), "$include") = 1 then 35 | t$ = ltrim$(l$) 36 | q1 = instr(2, t$, "'") 37 | q2 = instr(q1 + 1, t$, "'") 38 | process mid$(t$, q1 + 1, q2 - q1 - 1) 39 | else 40 | print #1, l$ 41 | end if 42 | loop until eof(fh) 43 | close #fh 44 | chdir olddir$ 45 | end sub 46 | 47 | function dirname$(filename$) 48 | slash = _instrrev(filename$, "/") 49 | if slash = 0 then 50 | dirname$ = "." 51 | else 52 | dirname$ = left$(filename$, slash - 1) 53 | end if 54 | end function 55 | -------------------------------------------------------------------------------- /tools/prep.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | # Copyright Luke Ceddia 3 | # SPDX-License-Identifier: Apache-2.0 4 | # prep.py - Preprocess and prepare 5 | # This is basically a macro expander. It also removes comments. 6 | 7 | # A macro is a text-based replacement that allows for more concise and self-describing code. 8 | # To define a macro, the $macro directive is used. The general syntax is 9 | # $macro: INPUTFORMAT | OUTPUTFORMAT 10 | # Alternatively, macros may be defined as command line arguments with the -D option: 11 | # -D 'INPUTFORMAT | OUTPUTFORMAT' 12 | # 13 | # Whenever a match is found for INPUTFORMAT, it is replaced by OUTPUTFORMAT. The double-at 14 | # operator @@ may appear multiple times in the INPUTFORMAT. These are matched with a word 15 | # (a word is a string matching [A-Za-z0-9_]+) and can be referred to in the OUTPUTFORMAT 16 | # as @1, @2 etc. counted in order of appearance. A '\n' in OUTPUTFORMAT is translated to 17 | # a newline in the final result. 18 | # Content in string literals is not modified. 19 | 20 | import re 21 | import argparse 22 | 23 | RE_MACRO_DEF = re.compile(r'^[ \t]*\$macro[ \t]*:([^|]+)\|(.+)', flags=re.I) 24 | RE_COMMENT = re.compile(r"^[ \t]*(rem |')", flags=re.I) 25 | RE_IGNORE_LINE = re.compile(r"^[ \t]*(?:''|data)", flags=re.I) 26 | RE_STRINGS = re.compile(r'"[^"]*"') 27 | 28 | macros = {} 29 | 30 | def process_line(line): 31 | global macros 32 | def_match = re.match(RE_MACRO_DEF, line) 33 | if def_match: 34 | output_format = def_match.group(2).strip() 35 | output_format = output_format.replace('\\n', '\n') 36 | define_macro(def_match.group(1).strip(), output_format) 37 | return '' 38 | elif re.match(RE_IGNORE_LINE, line): 39 | # Leave double-commented and DATA lines entirely alone 40 | return line 41 | elif re.match(RE_COMMENT, line): 42 | # Remove comments 43 | return '' 44 | elif re.match(r'[ \t]*\$dynamic', line): 45 | # Fix up the silliness that is $dynamic 46 | return "'$dynamic\n" 47 | else: 48 | # Temporarily replace any quoted strings to protect their contents 49 | literals = re.findall(RE_STRINGS, line) 50 | line = re.sub(RE_STRINGS, '@@', line) 51 | 52 | # Apply macros 53 | for (pattern, result) in macros.items(): 54 | line = re.sub(pattern, result, line) 55 | 56 | # Put back strings 57 | line = re.sub('@@', lambda _ : literals.pop(0), line) 58 | return line 59 | 60 | def define_macro(pattern, result): 61 | global macros 62 | # Protect special characters 63 | pattern = re.escape(pattern) 64 | # Setup matching groups 65 | pattern = pattern.replace('@@', r'(\w+)') 66 | result = re.sub('@(\d)', lambda m : '\\' + m.group(1), result) 67 | macros[pattern] = result 68 | 69 | def main(): 70 | argparser = argparse.ArgumentParser() 71 | argparser.add_argument('-D', '--define', metavar="'INPUTFORMAT | OUTPUTFORMAT'", action='append') 72 | argparser.add_argument('infile') 73 | argparser.add_argument('outfile') 74 | args = argparser.parse_args() 75 | 76 | if args.define is not None: 77 | for pattern, result in map(lambda x: x.split('|'), args.define): 78 | define_macro(pattern, result) 79 | 80 | with open(args.infile) as inputfile, open(args.outfile, 'w') as outputfile: 81 | for line in inputfile.readlines(): 82 | result = process_line(line) 83 | outputfile.write(result) 84 | 85 | if __name__ == '__main__': 86 | main() 87 | --------------------------------------------------------------------------------