BlankPage

The _BlankPage serves as a skeleton for new Wiki pages.

Syntax

_BlankSub arg1[, arg2]

result% = _BlankFunc(arg1[, arg2])

Parameters

• arg1 is a mandatory argument
• the arg2 is optional

Description

To use this skeleton click on the Edit tab above the page, then copy the raw text of this page and paste it into your new page. Change/remove sections as needed. Use this for italic and this for bold text style. To color your writings use the Text template. It takes either a color name or a #RRGGBB 32bit color, if the color part is omitted it will default to gray.

You can inline simple code one liners like w = _WIDTH

• an askerisk marks a list point
  • two askerisks will indent the list
    • three askerisks will indent even more

This is a definition list

The first description can follow right after a colon

or in a new line

more descriptions can follow

• using list bullets with an askerisk

as already seen in the syntax above, you may use desciptions without a defininition too

you may also nest descriptions

but at some point it's cluttering the page so please use it sparingly

This is a nice piece of paper for quotes and similar things. In case of short code snippets you may use the "Cb" (code blue) template to highlight and link keywords to the Wiki pages. FOR x = 1 TO 5 PRINT "Hello World!" NEXT x END As you see, this Text block is suitable for preformatted text, but note that the browser is still allowed to wrap too long lines. If you really need your preformatted text to be shown as is, then use a fixed text block instaed, see below.

Use this fixed text block for preformatted text, which is not even allowed to wrap long lines, such as tables etc.. As you see this very long line goes far over the display width, so please limit youself to the available space to not clutter the display too much.

Notes

• This may be a sub-section for further notes like special behavior, required prerequisites etc.
• If used/required, then this should always be a sub-section under the Description main section

Errors

• If used/required, then this also should be a sub-section under the Description main section
• This is not intended for the regular errors a SUB/FUNCTION could throw, those should be handled in the main description section.
  • Rather use it for subtle things, known mis-behavior, tendency for stack overflows and seg faults etc.

Availability

• 

  v1.3

• 

  all

• 
• 

  yes

• 

  yes

• 

  yes

• The capability to load from memory was introduced in QB64-PE v3.5.0.

Examples

Example 1

Each example should have a short description.

'Place your code example here 'The "Cl" (code link) template can be used to link keywords to its 'respective Wiki page. Those words will also get highlighted. COLOR 15,4 PRINT "Hello World!"

This template allows for a short author credit.

The output block is available for the SCREEN 0 background colors 0-7

Inside the output block use the "Ot" (output text) template for coloring

Hello World!

See also

• Keyword Reference - Alphabetical
• Keyword Reference - By usage

---

Navigation: Main Page with Articles and Tutorials Keyword Reference - Alphabetical Keyword Reference - By usage Report a broken link

'All variables will be of type LONG unless explicitly defined DEFLNG A-Z 'All arrays will be dynamically allocated so they can be REDIM-ed '$DYNAMIC 'We need console access to support command-line compilation via the -x command line compile option $CONSOLE 'Initially the "SCREEN" will be hidden, if the -x option is used it will never be created $SCREENHIDE $EXEICON:'./qb64pe.ico' $VERSIONINFO:CompanyName=QB64 Phoenix Edition $VERSIONINFO:FileDescription=QB64 IDE and Compiler $VERSIONINFO:InternalName=qb64pe.bas $VERSIONINFO:LegalCopyright=MIT $VERSIONINFO:LegalTrademarks= $VERSIONINFO:OriginalFilename=qb64pe.exe $VERSIONINFO:ProductName=QB64-PE $VERSIONINFO:Comments=QB64 is a modern extended BASIC programming language that retains QB4.5/QBasic compatibility and compiles native binaries for Windows, Linux and macOS. '$INCLUDE:'global\version.bas' '$INCLUDE:'global\settings.bas' '$INCLUDE:'global\constants.bas' '$INCLUDE:'subs_functions\extensions\opengl\opengl_global.bas' '$INCLUDE:'utilities\ini-manager\ini.bi' '$INCLUDE:'utilities\s-buffer\simplebuffer.bi' DEFLNG A-Z '-------- Optional IDE Component (1/2) -------- '$INCLUDE:'ide\ide_global.bas' REDIM SHARED OName(1000) AS STRING 'Operation Name REDIM SHARED PL(1000) AS INTEGER 'Priority Level REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables. Set_OrderOfOperations DIM SHARED NoExeSaved AS INTEGER DIM SHARED vWatchOn, vWatchRecompileAttempts, vWatchDesiredState, vWatchErrorCall$ DIM SHARED vWatchNewVariable$, vWatchVariableExclusions$ vWatchErrorCall$ = "if (stop_program) {*__LONG_VWATCH_LINENUMBER=0; SUB_VWATCH((ptrszint*)vwatch_global_vars,(ptrszint*)vwatch_local_vars);};if(new_error){bkp_new_error=new_error;new_error=0;*__LONG_VWATCH_LINENUMBER=-1; SUB_VWATCH((ptrszint*)vwatch_global_vars,(ptrszint*)vwatch_local_vars);new_error=bkp_new_error;};" vWatchVariableExclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__LONG_VWATCH_GOTO@" + _ "@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _ "@__ARRAY_BYTE_VWATCH_SKIPLINES@__STRING_VWATCH_INTERNALSUBNAME@__ARRAY_STRING_VWATCH_STACK@" DIM SHARED nativeDataTypes$ nativeDataTypes$ = "@_OFFSET@OFFSET@_UNSIGNED _OFFSET@UNSIGNED OFFSET@_BIT@BIT@_UNSIGNED _BIT@UNSIGNED BIT@_BYTE@_UNSIGNED _BYTE@BYTE@UNSIGNED BYTE@INTEGER@_UNSIGNED INTEGER@UNSIGNED INTEGER@LONG@_UNSIGNED LONG@UNSIGNED LONG@_INTEGER64@INTEGER64@_UNSIGNED _INTEGER64@UNSIGNED INTEGER64@SINGLE@DOUBLE@_FLOAT@FLOAT@STRING@" DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState DIM SHARED opex_recompileAttempts, opex_desiredState DIM SHARED opexarray_recompileAttempts, opexarray_desiredState REDIM EveryCaseSet(100), SelectCaseCounter AS _UNSIGNED LONG REDIM SelectCaseHasCaseBlock(100) DIM ExecLevel(255), ExecCounter AS INTEGER REDIM SHARED UserDefine(1, 100) AS STRING '0 element is the name, 1 element is the string value REDIM SHARED InValidLine(10000) AS _BYTE DIM DefineElse(255) AS _BYTE DIM SHARED UserDefineCount AS INTEGER, UserDefineList$ UserDefineList$ = "@DEFINED@UNDEFINED@WINDOWS@WIN@LINUX@MAC@MACOSX@32BIT@64BIT@VERSION@" UserDefine(0, 0) = "WINDOWS": UserDefine(0, 1) = "WIN" UserDefine(0, 2) = "LINUX" UserDefine(0, 3) = "MAC": UserDefine(0, 4) = "MACOSX" UserDefine(0, 5) = "32BIT": UserDefine(0, 6) = "64BIT" UserDefine(0, 7) = "VERSION" IF INSTR(_OS$, "WIN") THEN UserDefine(1, 0) = "-1": UserDefine(1, 1) = "-1" ELSE UserDefine(1, 0) = "0": UserDefine(1, 1) = "0" IF INSTR(_OS$, "LINUX") THEN UserDefine(1, 2) = "-1" ELSE UserDefine(1, 2) = "0" IF INSTR(_OS$, "MAC") THEN UserDefine(1, 3) = "-1": UserDefine(1, 4) = "-1" ELSE UserDefine(1, 3) = "0": UserDefine(1, 4) = "0" IF INSTR(_OS$, "32BIT") THEN UserDefine(1, 5) = "-1": UserDefine(1, 6) = "0" ELSE UserDefine(1, 5) = "0": UserDefine(1, 6) = "-1" UserDefine(1, 7) = Version$ DIM SHARED QB64_uptime! QB64_uptime! = TIMER NoInternalFolder: IF _DIREXISTS("internal") = 0 THEN _SCREENSHOW PRINT "QB64-PE cannot locate the 'internal' folder" PRINT PRINT "Check that QB64-PE has been extracted properly." PRINT "For MacOSX, launch 'qb64pe_start.command' or enter './qb64pe' in Terminal." PRINT "For Linux, in the console enter './qb64pe'." DO _LIMIT 1 LOOP UNTIL INKEY$ <> "" SYSTEM 1 END IF DIM SHARED Include_GDB_Debugging_Info 'set using "options.bin" DIM SHARED DEPENDENCY_LAST CONST DEPENDENCY_LOADFONT = 1: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_AUDIO_CONVERSION = 2: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_AUDIO_DECODE = 3: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_AUDIO_OUT = 4: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_GL = 5: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_IMAGE_CODEC = 6: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_CONSOLE_ONLY = 7: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 '=2 if via -g switch, =1 if via metacommand $CONSOLE:ONLY CONST DEPENDENCY_SOCKETS = 8: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_PRINTER = 9: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_ICON = 10: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_SCREENIMAGE = 11: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 CONST DEPENDENCY_DEVICEINPUT = 12: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 'removes support for gamepad input if not present CONST DEPENDENCY_ZLIB = 13: DEPENDENCY_LAST = DEPENDENCY_LAST + 1 'ZLIB library linkage, if desired, for compression/decompression. DIM SHARED DEPENDENCY(1 TO DEPENDENCY_LAST) DIM SHARED UseGL 'declared SUB _GL (no params) DIM SHARED OS_BITS AS LONG, WindowTitle AS STRING OS_BITS = 64: IF INSTR(_OS$, "[32BIT]") THEN OS_BITS = 32 IF OS_BITS = 32 THEN WindowTitle = "QB64 Phoenix Edition (x32)" ELSE WindowTitle = "QB64 Phoenix Edition (x64)" _TITLE WindowTitle DIM SHARED ConsoleMode, No_C_Compile_Mode, NoIDEMode DIM SHARED ShowWarnings AS _BYTE, QuietMode AS _BYTE, CMDLineFile AS STRING DIM SHARED MonochromeLoggingMode AS _BYTE TYPE usedVarList AS LONG id, linenumber, includeLevel, includedLine, scope, localIndex AS LONG arrayElementSize AS _BYTE used, watch, isarray, displayFormat 'displayFormat: 0=DEC;1=HEX;2=BIN;3=OCT AS STRING name, cname, varType, includedFile, subfunc AS STRING watchRange, indexes, elements, elementTypes 'for Arrays and UDTs AS STRING elementOffset, storage END TYPE REDIM SHARED backupUsedVariableList(1000) AS usedVarList DIM SHARED typeDefinitions$, backupTypeDefinitions$ DIM SHARED totalVariablesCreated AS LONG, totalMainVariablesCreated AS LONG DIM SHARED bypassNextVariable AS _BYTE DIM SHARED totalWarnings AS LONG, warningListItems AS LONG, lastWarningHeader AS STRING DIM SHARED duplicateConstWarning AS _BYTE, warningsissued AS _BYTE DIM SHARED emptySCWarning AS _BYTE, maxLineNumber AS LONG DIM SHARED ExeIconSet AS LONG, qb64prefix$, qb64prefix_set DIM SHARED VersionInfoSet AS _BYTE 'Variables to handle $VERSIONINFO metacommand: DIM SHARED viFileVersionNum$, viProductVersionNum$, viCompanyName$ DIM SHARED viFileDescription$, viFileVersion$, viInternalName$ DIM SHARED viLegalCopyright$, viLegalTrademarks$, viOriginalFilename$ DIM SHARED viProductName$, viProductVersion$, viComments$, viWeb$ DIM SHARED NoChecks DIM SHARED Console DIM SHARED ScreenHide DIM SHARED Asserts DIM SHARED OptMax AS LONG OptMax = 256 REDIM SHARED Opt(1 TO OptMax, 1 TO 10) AS STRING * 256 ' (1,1)="READ" ' (1,2)="WRITE" ' (1,3)="READ WRITE" REDIM SHARED OptWords(1 TO OptMax, 1 TO 10) AS INTEGER 'The number of words of each opt () element ' (1,1)=1 '"READ" ' (1,2)=1 '"WRITE" ' (1,3)=2 '"READ WRITE" REDIM SHARED T(1 TO OptMax) AS INTEGER 'The type of the entry ' t is 0 for ? opts ' ---------- 0 means ? , 1+ means a symbol or {}block ---------- ' t is 1 for symbol opts ' t is the number of rhs opt () index enteries for {READ|WRITE|READ WRITE} like opts REDIM SHARED Lev(1 TO OptMax) AS INTEGER 'The indwelling level of each opt () element (the lowest is 0) REDIM SHARED EntryLev(1 TO OptMax) AS INTEGER 'The level required from which this opt () can be validly be entered/checked-for REDIM SHARED DitchLev(1 TO OptMax) AS INTEGER 'The lowest level recorded between the previous Opt and this Opt REDIM SHARED DontPass(1 TO OptMax) AS INTEGER 'Set to 1 or 0, with 1 meaning don't pass 'Determines whether the opt () entry needs to actually be passed to the C++ sub/function REDIM SHARED TempList(1 TO OptMax) AS INTEGER REDIM SHARED PassRule(1 TO OptMax) AS LONG '0 means no pass rule 'negative values refer to an opt () element 'positive values refer to a flag value REDIM SHARED LevelEntered(OptMax) 'up to 64 levels supported REDIM SHARED separgs(OptMax + 1) AS STRING REDIM SHARED separgslayout(OptMax + 1) AS STRING REDIM SHARED separgs2(OptMax + 1) AS STRING REDIM SHARED separgslayout2(OptMax + 1) AS STRING DIM SHARED E DIM SHARED ResolveStaticFunctions REDIM SHARED ResolveStaticFunction_File(1 TO 100) AS STRING REDIM SHARED ResolveStaticFunction_Name(1 TO 100) AS STRING REDIM SHARED ResolveStaticFunction_Method(1 TO 100) AS LONG DIM SHARED Error_Happened AS LONG DIM SHARED Error_Message AS STRING DIM SHARED os AS STRING os$ = "WIN" IF INSTR(_OS$, "[LINUX]") THEN os$ = "LNX" DIM SHARED MacOSX AS LONG IF INSTR(_OS$, "[MACOSX]") THEN MacOSX = 1 DIM SHARED inline_DATA IF MacOSX THEN inline_DATA = 1 DIM SHARED BATCHFILE_EXTENSION AS STRING BATCHFILE_EXTENSION = ".bat" IF os$ = "LNX" THEN BATCHFILE_EXTENSION = ".sh" IF MacOSX THEN BATCHFILE_EXTENSION = ".command" DIM inlinedatastr(255) AS STRING FOR i = 0 TO 255 inlinedatastr(i) = str2$(i) + "," NEXT DIM SHARED extension AS STRING DIM SHARED path.exe$, path.source$, lastBinaryGenerated$ extension$ = ".exe" IF os$ = "LNX" THEN extension$ = "" 'no extension under Linux DIM SHARED pathsep AS STRING * 1 pathsep$ = "\" IF os$ = "LNX" THEN pathsep$ = "/" 'note: QB64 handles OS specific path separators automatically except under SHELL calls ON ERROR GOTO qberror_test DIM SHARED tmpdir AS STRING, tmpdir2 AS STRING IF os$ = "WIN" THEN tmpdir$ = ".\internal\temp\": tmpdir2$ = "..\\temp\\" IF os$ = "LNX" THEN tmpdir$ = "./internal/temp/": tmpdir2$ = "../temp/" IF NOT _DIREXISTS(tmpdir$) THEN MKDIR tmpdir$ DECLARE LIBRARY FUNCTION getpid& () END DECLARE thisinstancepid = getpid& DIM SHARED tempfolderindex IF INSTR(_OS$, "LINUX") THEN fh = FREEFILE OPEN ".\internal\temp\tempfoldersearch.bin" FOR RANDOM AS #fh LEN = LEN(tempfolderindex) tempfolderrecords = LOF(fh) / LEN(tempfolderindex) i = 1 IF tempfolderrecords = 0 THEN 'first run ever? PUT #fh, 1, thisinstancepid ELSE FOR i = 1 TO tempfolderrecords 'check if any of the temp folders is being used = pid still active GET #fh, i, tempfoldersearch SHELL _HIDE "ps -p " + STR$(tempfoldersearch) + " > /dev/null 2>&1; echo $? > internal/temp/checkpid.bin" fh2 = FREEFILE OPEN "internal/temp/checkpid.bin" FOR BINARY AS #fh2 LINE INPUT #fh2, checkpid$ CLOSE #fh2 IF VAL(checkpid$) = 1 THEN 'This temp folder was locked by an instance that's no longer active, so 'this will be our temp folder PUT #fh, i, thisinstancepid EXIT FOR END IF NEXT IF i > tempfolderrecords THEN 'All indexes were busy. Let's initiate a new one: PUT #fh, i, thisinstancepid END IF END IF CLOSE #fh IF i > 1 THEN tmpdir$ = "./internal/temp" + str2$(i) + "/": tmpdir2$ = "../temp" + str2$(i) + "/" IF _DIREXISTS(tmpdir$) = 0 THEN MKDIR tmpdir$ END IF END IF OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 ELSE ON ERROR GOTO qberror_test E = 0 i = 1 OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 DO WHILE E i = i + 1 IF i = 1000 THEN PRINT "Unable to locate the 'internal' folder": END 1 MKDIR ".\internal\temp" + str2$(i) IF os$ = "WIN" THEN tmpdir$ = ".\internal\temp" + str2$(i) + "\": tmpdir2$ = "..\\temp" + str2$(i) + "\\" IF os$ = "LNX" THEN tmpdir$ = "./internal/temp" + str2$(i) + "/": tmpdir2$ = "../temp" + str2$(i) + "/" E = 0 OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 LOOP END IF 'temp folder established tempfolderindex = i IF i > 1 THEN 'create modified version of qbx.cpp OPEN ".\internal\c\qbx" + str2$(i) + ".cpp" FOR OUTPUT AS #2 OPEN ".\internal\c\qbx.cpp" FOR BINARY AS #1 DO UNTIL EOF(1) LINE INPUT #1, a$ x = INSTR(a$, "..\\temp\\"): IF x THEN a$ = LEFT$(a$, x - 1) + "..\\temp" + str2$(i) + "\\" + RIGHT$(a$, LEN(a$) - (x + 9)) x = INSTR(a$, "../temp/"): IF x THEN a$ = LEFT$(a$, x - 1) + "../temp" + str2$(i) + "/" + RIGHT$(a$, LEN(a$) - (x + 7)) PRINT #2, a$ LOOP CLOSE #1, #2 END IF IF Debug THEN OPEN tmpdir$ + "debug.txt" FOR OUTPUT AS #9 ON ERROR GOTO qberror DIM SHARED tempfolderindexstr AS STRING 'appended to "Untitled" DIM SHARED tempfolderindexstr2 AS STRING IF tempfolderindex <> 1 THEN tempfolderindexstr$ = "(" + str2$(tempfolderindex) + ")": tempfolderindexstr2$ = str2$(tempfolderindex) DIM SHARED idedebuginfo DIM SHARED seperateargs_error DIM SHARED seperateargs_error_message AS STRING DIM SHARED compfailed DIM SHARED reginternalsubfunc DIM SHARED reginternalvariable DIM SHARED symboltype_size symboltype_size = 0 DIM SHARED use_global_byte_elements use_global_byte_elements = 0 'compiler-side IDE data & definitions 'SHARED variables "passed" to/from the compiler & IDE DIM SHARED idecommand AS STRING 'a 1 byte message-type code, followed by optional string data DIM SHARED idereturn AS STRING 'used to pass formatted-lines and return information back to the IDE DIM SHARED ideerror AS LONG DIM SHARED idecompiled AS LONG DIM SHARED idemode '1 if using the IDE to compile DIM SHARED ideerrorline AS LONG 'set by qb64-error(...) to the line number it would have reported, this number 'is later passed to the ide in message #8 DIM SHARED idemessage AS STRING 'set by qb64-error(...) to the error message to be reported, this 'is later passed to the ide in message #8 DIM SHARED optionexplicit AS _BYTE DIM SHARED optionexplicitarray AS _BYTE DIM SHARED optionexplicit_cmd AS _BYTE DIM SHARED ideStartAtLine AS LONG, errorLineInInclude AS LONG DIM SHARED warningInInclude AS LONG, warningInIncludeLine AS LONG DIM SHARED outputfile_cmd$ DIM SHARED compilelog$ '$INCLUDE:'global\IDEsettings.bas' DIM OutputIsRelativeToStartDir AS LONG CMDLineFile = ParseCMDLineArgs$ IF CMDLineFile <> "" AND _FILEEXISTS(_STARTDIR$ + "/" + CMDLineFile) THEN CMDLineFile = _STARTDIR$ + "/" + CMDLineFile OutputIsRelativeToStartDir = -1 END IF IF ConsoleMode THEN _DEST _CONSOLE ELSE _CONSOLE OFF _SCREENSHOW _ICON END IF 'the function ?=ide(?) should always be passed 0, it returns a message code number, any further information 'is passed back in idereturn 'message code numbers: '0 no ide present (auto defined array ide() return 0) '1 launch ide & with passed filename (compiler->ide) '2 begin new compilation with returned line of code (compiler<-ide) ' [2][line of code] '3 request next line (compiler->ide) ' [3] '4 next line of code returned (compiler<-ide) ' [4][line of code] '5 no more lines of code exist (compiler<-ide) ' [5] '6 code is OK/ready (compiler->ide) ' [6] '7 repass the code from the beginning (compiler->ide) ' [7] '8 an error has occurred with 'this' message on 'this' line(compiler->ide) ' [8][error message][line as LONG] '9 C++ compile (if necessary) and run with 'this' name (compiler<-ide) ' [9][name(no path, no .bas)] '10 The line requires more time to process ' Pass-back 'line of code' using method [4] when ready ' [10][line of code] '11 ".EXE file created" message '12 The name of the exe I'll create is '...' (compiler->ide) ' [12][exe name without .exe] '255 A qb error happened in the IDE (compiler->ide) ' note: detected by the fact that ideerror was not set to 0 ' [255] 'hash table data TYPE HashListItem Flags AS LONG Reference AS LONG NextItem AS LONG PrevItem AS LONG LastItem AS LONG 'note: this value is only valid on the first item in the list 'note: name is stored in a seperate array of strings END TYPE DIM SHARED HashFind_NextListItem AS LONG DIM SHARED HashFind_Reverse AS LONG DIM SHARED HashFind_SearchFlags AS LONG DIM SHARED HashFind_Name AS STRING DIM SHARED HashRemove_LastFound AS LONG DIM SHARED HashListSize AS LONG DIM SHARED HashListNext AS LONG DIM SHARED HashListFreeSize AS LONG DIM SHARED HashListFreeLast AS LONG 'hash lookup tables DIM SHARED hash1char(255) AS INTEGER DIM SHARED hash2char(65535) AS INTEGER FOR x = 1 TO 26 hash1char(64 + x) = x hash1char(96 + x) = x NEXT hash1char(95) = 27 '_ hash1char(48) = 28 '0 hash1char(49) = 29 '1 hash1char(50) = 30 '2 hash1char(51) = 31 '3 hash1char(52) = 23 '4 'note: x, y, z and beginning alphabet letters avoided because of common usage (eg. a2, y3) hash1char(53) = 22 '5 hash1char(54) = 20 '6 hash1char(55) = 19 '7 hash1char(56) = 18 '8 hash1char(57) = 17 '9 FOR c1 = 0 TO 255 FOR c2 = 0 TO 255 hash2char(c1 + c2 * 256) = hash1char(c1) + hash1char(c2) * 32 NEXT NEXT 'init HashListSize = 65536 HashListNext = 1 HashListFreeSize = 1024 HashListFreeLast = 0 REDIM SHARED HashList(1 TO HashListSize) AS HashListItem REDIM SHARED HashListName(1 TO HashListSize) AS STRING * 256 REDIM SHARED HashListFree(1 TO HashListFreeSize) AS LONG REDIM SHARED HashTable(16777215) AS LONG '64MB lookup table with indexes to the hashlist CONST HASHFLAG_LABEL = 2 CONST HASHFLAG_TYPE = 4 CONST HASHFLAG_RESERVED = 8 CONST HASHFLAG_OPERATOR = 16 CONST HASHFLAG_CUSTOMSYNTAX = 32 CONST HASHFLAG_SUB = 64 CONST HASHFLAG_FUNCTION = 128 CONST HASHFLAG_UDT = 256 CONST HASHFLAG_UDTELEMENT = 512 CONST HASHFLAG_CONSTANT = 1024 CONST HASHFLAG_VARIABLE = 2048 CONST HASHFLAG_ARRAY = 4096 CONST HASHFLAG_XELEMENTNAME = 8192 CONST HASHFLAG_XTYPENAME = 16384 TYPE Label_Type State AS _UNSIGNED _BYTE '0=label referenced, 1=label created cn AS STRING * 256 Scope AS LONG Data_Offset AS _INTEGER64 'offset within data Data_Referenced AS _UNSIGNED _BYTE 'set to 1 if data is referenced (data_offset will be used to create the data offset variable) Error_Line AS LONG 'the line number to reference on errors Scope_Restriction AS LONG 'cannot exist inside this scope (post checked) SourceLineNumber AS LONG END TYPE DIM SHARED nLabels, Labels_Ubound Labels_Ubound = 100 REDIM SHARED Labels(1 TO Labels_Ubound) AS Label_Type DIM SHARED Empty_Label AS Label_Type DIM SHARED PossibleSubNameLabels AS STRING 'format: name+sp+name+sp+name <-ucase$'d DIM SHARED SubNameLabels AS STRING 'format: name+sp+name+sp+name <-ucase$'d DIM SHARED CreatingLabel AS LONG DIM SHARED AllowLocalName AS LONG DIM SHARED DataOffset DIM SHARED prepass DIM SHARED autoarray DIM SHARED ontimerid, onkeyid, onstrigid DIM SHARED revertmaymusthave(1 TO 10000) DIM SHARED revertmaymusthaven DIM SHARED linecontinuation DIM SHARED dim2typepassback AS STRING 'passes back correct case sensitive version of type DIM SHARED inclevel DIM SHARED incname(100) AS STRING 'must be full path as given DIM SHARED inclinenumber(100) AS LONG DIM SHARED incerror AS STRING DIM SHARED fix046 AS STRING fix046$ = "__" + "ASCII" + "_" + "CHR" + "_" + "046" + "__" 'broken up to avoid detection for layout reversion DIM SHARED layout AS STRING 'passed to IDE DIM SHARED layoutok AS LONG 'tracks status of entire line DIM SHARED layoutcomment AS STRING DIM SHARED tlayout AS STRING 'temporary layout string set by supporting functions DIM SHARED layoutdone AS LONG 'tracks status of single command DIM SHARED fooindwel DIM SHARED alphanumeric(255) FOR i = 48 TO 57 alphanumeric(i) = -1 NEXT FOR i = 65 TO 90 alphanumeric(i) = -1 NEXT FOR i = 97 TO 122 alphanumeric(i) = -1 NEXT '_ is treated as an alphabet letter alphanumeric(95) = -1 DIM SHARED isalpha(255) FOR i = 65 TO 90 isalpha(i) = -1 NEXT FOR i = 97 TO 122 isalpha(i) = -1 NEXT '_ is treated as an alphabet letter isalpha(95) = -1 DIM SHARED isnumeric(255) FOR i = 48 TO 57 isnumeric(i) = -1 NEXT DIM SHARED lfsinglechar(255) lfsinglechar(40) = 1 '( lfsinglechar(41) = 1 ') lfsinglechar(42) = 1 '* lfsinglechar(43) = 1 '+ lfsinglechar(45) = 1 '- lfsinglechar(47) = 1 '/ lfsinglechar(60) = 1 '< lfsinglechar(61) = 1 '= lfsinglechar(62) = 1 '> lfsinglechar(92) = 1 '\ lfsinglechar(94) = 1 '^ lfsinglechar(44) = 1 ', lfsinglechar(46) = 1 '. lfsinglechar(58) = 1 ': lfsinglechar(59) = 1 '; lfsinglechar(35) = 1 '# (file no only) lfsinglechar(36) = 1 '$ (metacommand only) lfsinglechar(63) = 1 '? (print macro) lfsinglechar(95) = 1 '_ DIM SHARED nextrunlineindex AS LONG DIM SHARED lineinput3buffer AS STRING DIM SHARED lineinput3index AS LONG DIM SHARED dimstatic AS LONG DIM SHARED staticarraylist AS STRING DIM SHARED staticarraylistn AS LONG DIM SHARED commonarraylist AS STRING DIM SHARED commonarraylistn AS LONG 'CONST support DIM SHARED constmax AS LONG constmax = 100 DIM SHARED constlast AS LONG constlast = -1 REDIM SHARED constname(constmax) AS STRING REDIM SHARED constcname(constmax) AS STRING REDIM SHARED constnamesymbol(constmax) AS STRING 'optional name symbol ' `1 and `no-number must be handled correctly 'DIM SHARED constlastshared AS LONG 'so any defined inside a sub/function after this index can be "forgotten" when sub/function exits 'constlastshared = -1 REDIM SHARED consttype(constmax) AS LONG 'variable type number 'consttype determines storage REDIM SHARED constinteger(constmax) AS _INTEGER64 REDIM SHARED constuinteger(constmax) AS _UNSIGNED _INTEGER64 REDIM SHARED constfloat(constmax) AS _FLOAT REDIM SHARED conststring(constmax) AS STRING REDIM SHARED constsubfunc(constmax) AS LONG REDIM SHARED constdefined(constmax) AS LONG 'UDT 'names DIM SHARED lasttype AS LONG DIM SHARED lasttypeelement AS LONG TYPE idstruct n AS STRING * 256 'name cn AS STRING * 256 'case sensitive version of n arraytype AS LONG 'similar to t arrayelements AS INTEGER staticarray AS INTEGER 'set for arrays declared in the main module with static elements mayhave AS STRING * 8 'mayhave and musthave are exclusive of each other musthave AS STRING * 8 t AS LONG 'type tsize AS LONG subfunc AS INTEGER 'if function=1, sub=2 (max 100 arguments) Dependency AS INTEGER internal_subfunc AS INTEGER callname AS STRING * 256 ccall AS INTEGER overloaded AS _BYTE args AS INTEGER minargs AS INTEGER arg AS STRING * 400 'similar to t argsize AS STRING * 400 'similar to tsize (used for fixed length strings) specialformat AS STRING * 256 secondargmustbe AS STRING * 256 secondargcantbe AS STRING * 256 ret AS LONG 'the value it returns if it is a function (again like t) insubfunc AS STRING * 256 insubfuncn AS LONG share AS INTEGER nele AS STRING * 100 nelereq AS STRING * 100 linkid AS LONG linkarg AS INTEGER staticscope AS INTEGER 'For variables which are arguments passed to a sub/function sfid AS LONG 'id number of variable's parent sub/function sfarg AS INTEGER 'argument/parameter # within call (1=first) hr_syntax AS STRING END TYPE DIM SHARED id AS idstruct DIM SHARED idn AS LONG DIM SHARED ids_max AS LONG ids_max = 1024 REDIM SHARED ids(1 TO ids_max) AS idstruct REDIM SHARED cmemlist(1 TO ids_max + 1) AS INTEGER 'variables that must be in cmem REDIM SHARED sfcmemargs(1 TO ids_max + 1) AS STRING * 100 's/f arg that must be in cmem REDIM SHARED arrayelementslist(1 TO ids_max + 1) AS INTEGER 'arrayelementslist (like cmemlist) helps to resolve the number of elements in arrays with an unknown number of elements. Note: arrays with an unknown number of elements have .arrayelements=-1 'create blank id template for idclear to copy (stops strings being set to chr$(0)) DIM SHARED cleariddata AS idstruct cleariddata.cn = "" cleariddata.n = "" cleariddata.mayhave = "" cleariddata.musthave = "" cleariddata.callname = "" cleariddata.arg = "" cleariddata.argsize = "" cleariddata.specialformat = "" cleariddata.secondargmustbe = "" cleariddata.secondargcantbe = "" cleariddata.insubfunc = "" cleariddata.nele = "" cleariddata.nelereq = "" DIM SHARED ISSTRING AS LONG DIM SHARED ISFLOAT AS LONG DIM SHARED ISUNSIGNED AS LONG DIM SHARED ISPOINTER AS LONG DIM SHARED ISFIXEDLENGTH AS LONG DIM SHARED ISINCONVENTIONALMEMORY AS LONG DIM SHARED ISOFFSETINBITS AS LONG DIM SHARED ISARRAY AS LONG DIM SHARED ISREFERENCE AS LONG DIM SHARED ISUDT AS LONG DIM SHARED ISOFFSET AS LONG DIM SHARED STRINGTYPE AS LONG DIM SHARED BITTYPE AS LONG DIM SHARED UBITTYPE AS LONG DIM SHARED BYTETYPE AS LONG DIM SHARED UBYTETYPE AS LONG DIM SHARED INTEGERTYPE AS LONG DIM SHARED UINTEGERTYPE AS LONG DIM SHARED LONGTYPE AS LONG DIM SHARED ULONGTYPE AS LONG DIM SHARED INTEGER64TYPE AS LONG DIM SHARED UINTEGER64TYPE AS LONG DIM SHARED SINGLETYPE AS LONG DIM SHARED DOUBLETYPE AS LONG DIM SHARED FLOATTYPE AS LONG DIM SHARED OFFSETTYPE AS LONG DIM SHARED UOFFSETTYPE AS LONG DIM SHARED UDTTYPE AS LONG DIM SHARED gosubid AS LONG DIM SHARED redimoption AS INTEGER DIM SHARED dimoption AS INTEGER DIM SHARED arraydesc AS INTEGER DIM SHARED qberrorhappened AS INTEGER DIM SHARED qberrorcode AS INTEGER DIM SHARED qberrorline AS INTEGER 'COMMON SHARED defineaz() AS STRING 'COMMON SHARED defineextaz() AS STRING DIM SHARED sourcefile AS STRING 'the full path and filename DIM SHARED file AS STRING 'name of the file (without .bas or path) 'COMMON SHARED separgs() AS STRING DIM SHARED constequation AS INTEGER DIM SHARED DynamicMode AS INTEGER DIM SHARED findidsecondarg AS STRING DIM SHARED findanotherid AS INTEGER DIM SHARED findidinternal AS LONG DIM SHARED currentid AS LONG 'is the index of the last ID accessed DIM SHARED linenumber AS LONG, reallinenumber AS LONG, totallinenumber AS LONG, definingtypeerror AS LONG DIM SHARED wholeline AS STRING DIM SHARED firstLineNumberLabelvWatch AS LONG, lastLineNumberLabelvWatch AS LONG DIM SHARED vWatchUsedLabels AS STRING, vWatchUsedSkipLabels AS STRING DIM SHARED linefragment AS STRING 'COMMON SHARED bitmask() AS _INTEGER64 'COMMON SHARED bitmaskinv() AS _INTEGER64 DIM SHARED arrayprocessinghappened AS INTEGER DIM SHARED stringprocessinghappened AS INTEGER DIM SHARED cleanupstringprocessingcall AS STRING DIM SHARED inputfunctioncalled AS _BYTE DIM SHARED recompile AS INTEGER 'forces recompilation 'COMMON SHARED cmemlist() AS INTEGER DIM SHARED optionbase AS INTEGER DIM SHARED addmetastatic AS INTEGER DIM SHARED addmetadynamic AS INTEGER DIM SHARED addmetainclude AS STRING DIM SHARED closedmain AS INTEGER DIM SHARED module AS STRING DIM SHARED subfunc AS STRING DIM SHARED subfuncn AS LONG DIM SHARED closedsubfunc AS _BYTE DIM SHARED subfuncid AS LONG DIM SHARED defdatahandle AS INTEGER DIM SHARED dimsfarray AS INTEGER DIM SHARED dimshared AS INTEGER 'Allows passing of known elements to recompilation DIM SHARED sflistn AS INTEGER 'COMMON SHARED sfidlist() AS LONG 'COMMON SHARED sfarglist() AS INTEGER 'COMMON SHARED sfelelist() AS INTEGER DIM SHARED glinkid AS LONG DIM SHARED glinkarg AS INTEGER DIM SHARED typname2typsize AS LONG DIM SHARED uniquenumbern AS LONG 'CLEAR , , 16384 DIM SHARED bitmask(1 TO 64) AS _INTEGER64 DIM SHARED bitmaskinv(1 TO 64) AS _INTEGER64 DIM SHARED defineextaz(1 TO 27) AS STRING DIM SHARED defineaz(1 TO 27) AS STRING '27 is an underscore ISSTRING = 1073741824 ISFLOAT = 536870912 ISUNSIGNED = 268435456 ISPOINTER = 134217728 ISFIXEDLENGTH = 67108864 'only set for strings with pointer flag ISINCONVENTIONALMEMORY = 33554432 ISOFFSETINBITS = 16777216 ISARRAY = 8388608 ISREFERENCE = 4194304 ISUDT = 2097152 ISOFFSET = 1048576 STRINGTYPE = ISSTRING + ISPOINTER BITTYPE = 1& + ISPOINTER + ISOFFSETINBITS UBITTYPE = 1& + ISPOINTER + ISUNSIGNED + ISOFFSETINBITS 'QB64 will also support BIT*n, eg. DIM bitarray[10] AS _UNSIGNED _BIT*10 BYTETYPE = 8& + ISPOINTER UBYTETYPE = 8& + ISPOINTER + ISUNSIGNED INTEGERTYPE = 16& + ISPOINTER UINTEGERTYPE = 16& + ISPOINTER + ISUNSIGNED LONGTYPE = 32& + ISPOINTER ULONGTYPE = 32& + ISPOINTER + ISUNSIGNED INTEGER64TYPE = 64& + ISPOINTER UINTEGER64TYPE = 64& + ISPOINTER + ISUNSIGNED SINGLETYPE = 32& + ISFLOAT + ISPOINTER DOUBLETYPE = 64& + ISFLOAT + ISPOINTER FLOATTYPE = 256& + ISFLOAT + ISPOINTER '8-32 bytes OFFSETTYPE = 64& + ISOFFSET + ISPOINTER: IF OS_BITS = 32 THEN OFFSETTYPE = 32& + ISOFFSET + ISPOINTER UOFFSETTYPE = 64& + ISOFFSET + ISUNSIGNED + ISPOINTER: IF OS_BITS = 32 THEN UOFFSETTYPE = 32& + ISOFFSET + ISUNSIGNED + ISPOINTER UDTTYPE = ISUDT + ISPOINTER DIM SHARED statementn AS LONG DIM SHARED everycasenewcase AS LONG DIM SHARED controllevel AS INTEGER '0=not in a control block DIM SHARED controltype(1000) AS INTEGER '1=IF (awaiting END IF) '2=FOR (awaiting NEXT) '3=DO (awaiting LOOP [UNTIL|WHILE param]) '4=DO WHILE/UNTIL (awaiting LOOP) '5=WHILE (awaiting WEND) '6=$IF (precompiler) '10=SELECT CASE qbs (awaiting END SELECT/CASE) '11=SELECT CASE int64 (awaiting END SELECT/CASE) '12=SELECT CASE uint64 (awaiting END SELECT/CASE) '13=SELECT CASE LONG double (awaiting END SELECT/CASE/CASE ELSE) '14=SELECT CASE float ... '15=SELECT CASE double '16=SELECT CASE int32 '17=SELECT CASE uint32 '18=CASE (awaiting END SELECT/CASE/CASE ELSE) '19=CASE ELSE (awaiting END SELECT) '32=SUB/FUNCTION (awaiting END SUB/FUNCTION) DIM controlid(1000) AS LONG DIM controlvalue(1000) AS LONG DIM controlstate(1000) AS INTEGER DIM SHARED controlref(1000) AS LONG 'the line number the control was created on ' ' Collection of flags indicating which unstable features should be used during compilation ' REDIM SHARED unstableFlags(1 TO 2) AS _BYTE DIM UNSTABLE_MIDI AS LONG DIM UNSTABLE_HTTP AS LONG UNSTABLE_MIDI = 1 UNSTABLE_HTTP = 2 ON ERROR GOTO qberror i2&& = 1 FOR i&& = 1 TO 64 bitmask(i&&) = i2&& bitmaskinv(i&&) = NOT i2&& i2&& = i2&& + 2 ^ i&& NEXT DIM id2 AS idstruct cleanupstringprocessingcall$ = "qbs_cleanup(qbs_tmp_base," DIM SHARED sfidlist(1000) AS LONG DIM SHARED sfarglist(1000) AS INTEGER DIM SHARED sfelelist(1000) AS INTEGER '----------------ripgl.bas-------------------------------------------------------------------------------- gl_scan_header '----------------ripgl.bas-------------------------------------------------------------------------------- '-----------------------QB64 COMPILER ONCE ONLY SETUP CODE ENDS HERE--------------------------------------- IF NoIDEMode THEN IDE_AutoPosition = 0: GOTO noide DIM FileDropEnabled AS _BYTE IF FileDropEnabled = 0 THEN FileDropEnabled = -1: _ACCEPTFILEDROP IF IDE_AutoPosition AND NOT IDE_BypassAutoPosition THEN _SCREENMOVE IDE_LeftPosition, IDE_TopPosition idemode = 1 sendc$ = "" 'no initial message IF CMDLineFile <> "" THEN sendc$ = CHR$(1) + CMDLineFile sendcommand: idecommand$ = sendc$ C = ide(0) ideerror = 0 IF C = 0 THEN idemode = 0: GOTO noide c$ = idereturn$ IF C = 2 THEN 'begin ideerrorline = 0 'addresses invalid prepass error line numbers being reported idepass = 1 GOTO fullrecompile ideret1: wholeline$ = c$ GOTO ideprepass ideret2: IF lastLineReturn THEN GOTO lastLineReturn sendc$ = CHR$(3) 'request next line GOTO sendcommand END IF IF C = 4 THEN 'next line IF idepass = 1 THEN wholeline$ = c$ GOTO ideprepass '(returns to ideret2: above) END IF 'assume idepass>1 a3$ = c$ continuelinefrom = 0 GOTO ide4 ideret4: IF lastLineReturn THEN GOTO lastLineReturn sendc$ = CHR$(3) 'request next line GOTO sendcommand END IF IF C = 5 THEN 'end of program reached lastLine = 1 lastLineReturn = 1 IF idepass = 1 THEN wholeline$ = "" GOTO ideprepass '(returns to ideret2: above, then to lastLinePrepassReturn below) END IF 'idepass>1 a3$ = "" continuelinefrom = 0 GOTO ide4 'returns to ideret4, then to lastLinePrepassReturn below lastLineReturn: lastLineReturn = 0 lastLine = 0 IF idepass = 1 THEN 'prepass complete idepass = 2 GOTO ide3 ideret3: sendc$ = CHR$(7) 'repass request firstLine = 1 GOTO sendcommand END IF 'assume idepass=2 'finalize program GOTO ide5 ideret5: 'note: won't return here if a recompile was required! sendc$ = CHR$(6) 'ready idecompiled = 0 GOTO sendcommand END IF IF C = 9 THEN 'run IF idecompiled = 0 THEN 'exe needs to be compiled file$ = c$ 'locate accessible file and truncate f$ = file$ path.exe$ = "" IF SaveExeWithSource THEN IF LEN(ideprogname) THEN path.exe$ = idepath$ + pathsep$ END IF i = 1 nextexeindex: IF _FILEEXISTS(path.exe$ + file$ + extension$) THEN E = 0 ON ERROR GOTO qberror_test KILL path.exe$ + file$ + extension$ ON ERROR GOTO qberror IF E = 1 THEN i = i + 1 file$ = f$ + "(" + str2$(i) + ")" GOTO nextexeindex END IF END IF 'inform IDE of name change if necessary (IDE will respond with message 9 and corrected name) IF i <> 1 THEN sendc$ = CHR$(12) + file$ GOTO sendcommand END IF ideerrorline = 0 'addresses C++ comp. error's line number GOTO ide6 ideret6: idecompiled = 1 END IF IF iderunmode = 2 THEN sendc$ = CHR$(11) '.EXE file created GOTO sendcommand END IF 'execute program IF iderunmode = 1 THEN IF NoExeSaved THEN 'This is the section which deals with if the user selected to run the program without 'saving an EXE file to the disk. 'We start off by first running the EXE, and then we delete it from the drive. 'making it a temporary file when all is said and done. IF os$ = "WIN" THEN SHELL QuotedFilename$(CHR$(34) + lastBinaryGenerated$ + CHR$(34)) + ModifyCOMMAND$ 'run the newly created program SHELL _HIDE _DONTWAIT "del " + QuotedFilename$(CHR$(34) + lastBinaryGenerated$ + CHR$(34)) 'kill it END IF IF path.exe$ = "" THEN path.exe$ = "./" IF os$ = "LNX" THEN IF LEFT$(lastBinaryGenerated$, LEN(path.exe$)) = path.exe$ THEN SHELL QuotedFilename$(lastBinaryGenerated$) + ModifyCOMMAND$ KILL lastBinaryGenerated$ ELSE SHELL QuotedFilename$(path.exe$ + lastBinaryGenerated$) + ModifyCOMMAND$ KILL path.exe$ + lastBinaryGenerated$ END IF END IF IF path.exe$ = "./" THEN path.exe$ = "" NoExeSaved = 0 'reset the flag for a temp EXE sendc$ = CHR$(6) 'ready GOTO sendcommand END IF IF os$ = "WIN" THEN SHELL _DONTWAIT QuotedFilename$(CHR$(34) + lastBinaryGenerated$ + CHR$(34)) + ModifyCOMMAND$ IF path.exe$ = "" THEN path.exe$ = "./" IF os$ = "LNX" THEN IF LEFT$(lastBinaryGenerated$, LEN(path.exe$)) = path.exe$ THEN SHELL _DONTWAIT QuotedFilename$(lastBinaryGenerated$) + ModifyCOMMAND$ ELSE SHELL _DONTWAIT QuotedFilename$(path.exe$ + lastBinaryGenerated$) + ModifyCOMMAND$ END IF END IF IF path.exe$ = "./" THEN path.exe$ = "" ELSE IF os$ = "WIN" THEN SHELL QuotedFilename$(CHR$(34) + lastBinaryGenerated$ + CHR$(34)) + ModifyCOMMAND$ IF path.exe$ = "" THEN path.exe$ = "./" IF os$ = "LNX" THEN IF LEFT$(lastBinaryGenerated$, LEN(path.exe$)) = path.exe$ THEN SHELL QuotedFilename$(lastBinaryGenerated$) + ModifyCOMMAND$ ELSE SHELL QuotedFilename$(path.exe$ + lastBinaryGenerated$) + ModifyCOMMAND$ END IF END IF IF path.exe$ = "./" THEN path.exe$ = "" DO: LOOP UNTIL INKEY$ = "" DO: LOOP UNTIL _KEYHIT = 0 END IF IF idemode THEN 'Darken fg/bg colors dummy = DarkenFGBG(0) END IF IF vWatchOn THEN sendc$ = CHR$(254) 'launch debug interface ELSE sendc$ = CHR$(6) 'ready END IF GOTO sendcommand END IF PRINT "Invalid IDE message": END ideerror: IF INSTR(idemessage$, sp$) THEN 'Something went wrong here, so let's give a generic error message to the user. '(No error message should contain sp$ - that is, CHR$(13), when not in Debug mode) terrmsg$ = _ERRORMESSAGE$ IF terrmsg$ = "No error" THEN terrmsg$ = "Internal error" idemessage$ = "Compiler error (check for syntax errors) (" + terrmsg$ + ":" IF ERR THEN idemessage$ = idemessage$ + str2$(ERR) + "-" IF _ERRORLINE THEN idemessage$ = idemessage$ + str2$(_ERRORLINE) IF _INCLERRORLINE THEN idemessage$ = idemessage$ + "-" + _INCLERRORFILE$ + "-" + str2$(_INCLERRORLINE) idemessage$ = idemessage$ + ")" IF inclevel > 0 THEN idemessage$ = idemessage$ + incerror$ END IF sendc$ = CHR$(8) + idemessage$ + MKL$(ideerrorline) GOTO sendcommand noide: IF (qb64versionprinted = 0 OR ConsoleMode = 0) AND NOT QuietMode THEN qb64versionprinted = -1 PRINT "QB64-PE Compiler V" + Version$ END IF IF CMDLineFile = "" THEN LINE INPUT ; "COMPILE (.bas)>", f$ ELSE f$ = CMDLineFile END IF f$ = LTRIM$(RTRIM$(f$)) IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas" sourcefile$ = f$ CMDLineFile = sourcefile$ 'derive name from sourcefile f$ = RemoveFileExtension$(f$) path.exe$ = "" currentdir$ = _CWD$ path.source$ = getfilepath$(sourcefile$) IF LEN(path.source$) THEN IF _DIREXISTS(path.source$) = 0 THEN PRINT PRINT "Cannot locate source file: " + sourcefile$ IF ConsoleMode THEN SYSTEM 1 END 1 END IF CHDIR path.source$ path.source$ = _CWD$ IF RIGHT$(path.source$, 1) <> pathsep$ THEN path.source$ = path.source$ + pathsep$ CHDIR currentdir$ END IF IF SaveExeWithSource THEN path.exe$ = path.source$ FOR x = LEN(f$) TO 1 STEP -1 a$ = MID$(f$, x, 1) IF a$ = "/" OR a$ = "\" THEN f$ = RIGHT$(f$, LEN(f$) - x) EXIT FOR END IF NEXT file$ = f$ 'if cmemlist(currentid+1)<>0 before calling regid the variable 'MUST be defined in cmem! fullrecompile: IF idemode = 0 AND NOT QuietMode THEN PRINT PRINT "Beginning C++ output from QB64 code... " END IF BU_DEPENDENCY_CONSOLE_ONLY = DEPENDENCY(DEPENDENCY_CONSOLE_ONLY) FOR i = 1 TO UBOUND(DEPENDENCY): DEPENDENCY(i) = 0: NEXT DEPENDENCY(DEPENDENCY_CONSOLE_ONLY) = BU_DEPENDENCY_CONSOLE_ONLY AND 2 'Restore -g switch if used Error_Happened = 0 FOR closeall = 1 TO 255: CLOSE closeall: NEXT OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock bh = OpenBuffer%("O", tmpdir$ + "dyninfo.txt") IF Debug THEN CLOSE #9: OPEN tmpdir$ + "debug.txt" FOR OUTPUT AS #9 FOR i = 1 TO ids_max + 1 arrayelementslist(i) = 0 cmemlist(i) = 0 sfcmemargs(i) = "" NEXT 'erase cmemlist 'erase sfcmemargs lastunresolved = -1 'first pass sflistn = -1 'no entries SubNameLabels = sp 'QB64 will perform a repass to resolve sub names used as labels vWatchDesiredState = 0 vWatchRecompileAttempts = 0 qb64prefix_set_desiredState = 0 qb64prefix_set_recompileAttempts = 0 opex_desiredState = 0 opex_recompileAttempts = 0 opexarray_desiredState = 0 opexarray_recompileAttempts = 0 recompile: vWatchOn = vWatchDesiredState vWatchVariable "", -1 'reset internal variables list qb64prefix_set = qb64prefix_set_desiredState qb64prefix$ = "_" optionexplicit = opex_desiredState IF optionexplicit_cmd = -1 AND NoIDEMode = 1 THEN optionexplicit = -1 optionexplicitarray = opexarray_desiredState lastLineReturn = 0 lastLine = 0 firstLine = 1 Resize = 0 Resize_Scale = 0 UseGL = 0 Error_Happened = 0 HashClear 'clear the hash table 'add reserved words to hashtable f = HASHFLAG_TYPE + HASHFLAG_RESERVED HashAdd "_UNSIGNED", f, 0 HashAdd "_BIT", f, 0 HashAdd "_BYTE", f, 0 HashAdd "INTEGER", f, 0 HashAdd "LONG", f, 0 HashAdd "_INTEGER64", f, 0 HashAdd "_OFFSET", f, 0 HashAdd "SINGLE", f, 0 HashAdd "DOUBLE", f, 0 HashAdd "_FLOAT", f, 0 HashAdd "STRING", f, 0 HashAdd "ANY", f, 0 f = HASHFLAG_OPERATOR + HASHFLAG_RESERVED HashAdd "NOT", f, 0 HashAdd "IMP", f, 0 HashAdd "EQV", f, 0 HashAdd "AND", f, 0 HashAdd "OR", f, 0 HashAdd "XOR", f, 0 HashAdd "MOD", f, 0 f = HASHFLAG_RESERVED + HASHFLAG_CUSTOMSYNTAX HashAdd "LIST", f, 0 HashAdd "BASE", f, 0 HashAdd "_EXPLICIT", f, 0 HashAdd "AS", f, 0 HashAdd "IS", f, 0 HashAdd "OFF", f, 0 HashAdd "ON", f, 0 HashAdd "STOP", f, 0 HashAdd "TO", f, 0 HashAdd "USING", f, 0 'PUT(graphics) statement: HashAdd "PRESET", f, 0 HashAdd "PSET", f, 0 'OPEN statement: HashAdd "FOR", f, 0 HashAdd "OUTPUT", f, 0 HashAdd "RANDOM", f, 0 HashAdd "BINARY", f, 0 HashAdd "APPEND", f, 0 HashAdd "SHARED", f, 0 HashAdd "ACCESS", f, 0 HashAdd "LOCK", f, 0 HashAdd "READ", f, 0 HashAdd "WRITE", f, 0 'LINE statement: HashAdd "STEP", f, 0 'WIDTH statement: HashAdd "LPRINT", f, 0 'VIEW statement: HashAdd "PRINT", f, 0 f = HASHFLAG_RESERVED + HASHFLAG_XELEMENTNAME + HASHFLAG_XTYPENAME 'A 'B 'C HashAdd "COMMON", f, 0 HashAdd "CALL", f, 0 HashAdd "CASE", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "COM", f, 0 '(ON...) HashAdd "CONST", f, 0 'D HashAdd "DATA", f, 0 HashAdd "DECLARE", f, 0 HashAdd "DEF", f, 0 HashAdd "DEFDBL", f, 0 HashAdd "DEFINT", f, 0 HashAdd "DEFLNG", f, 0 HashAdd "DEFSNG", f, 0 HashAdd "DEFSTR", f, 0 HashAdd "DIM", f, 0 HashAdd "DO", f - HASHFLAG_XELEMENTNAME, 0 'E HashAdd "ERROR", f - HASHFLAG_XELEMENTNAME, 0 '(ON ...) HashAdd "ELSE", f, 0 HashAdd "ELSEIF", f, 0 HashAdd "ENDIF", f, 0 HashAdd "EXIT", f - HASHFLAG_XELEMENTNAME, 0 'F HashAdd "FIELD", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "FUNCTION", f, 0 'G HashAdd "GOSUB", f, 0 HashAdd "GOTO", f, 0 'H 'I HashAdd "INPUT", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 '(INPUT$ function exists, so conflicts if allowed as custom syntax) HashAdd "IF", f, 0 'K HashAdd "KEY", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 '(ON...) 'L HashAdd "LET", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "LOOP", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "LEN", f - HASHFLAG_XELEMENTNAME, 0 '(LEN function exists, so conflicts if allowed as custom syntax) 'M 'N HashAdd "NEXT", f - HASHFLAG_XELEMENTNAME, 0 'O 'P HashAdd "PLAY", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 '(ON...) HashAdd "PEN", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 '(ON...) 'Q 'R HashAdd "REDIM", f, 0 HashAdd "REM", f, 0 HashAdd "RESTORE", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "RESUME", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "RETURN", f - HASHFLAG_XELEMENTNAME, 0 HashAdd "RUN", f - HASHFLAG_XELEMENTNAME, 0 'S HashAdd "STATIC", f, 0 HashAdd "STRIG", f, 0 '(ON...) HashAdd "SEG", f, 0 HashAdd "SELECT", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 HashAdd "SUB", f, 0 HashAdd "SCREEN", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 'T HashAdd "THEN", f, 0 HashAdd "TIMER", f - HASHFLAG_XELEMENTNAME - HASHFLAG_XTYPENAME, 0 '(ON...) HashAdd "TYPE", f - HASHFLAG_XELEMENTNAME, 0 'U HashAdd "UNTIL", f, 0 HashAdd "UEVENT", f, 0 'V 'W HashAdd "WEND", f, 0 HashAdd "WHILE", f, 0 'X 'Y 'Z 'clear/init variables Console = 0 ScreenHide = 0 Asserts = 0 ResolveStaticFunctions = 0 dynamiclibrary = 0 dimsfarray = 0 dimstatic = 0 AllowLocalName = 0 PossibleSubNameLabels = sp 'QB64 will perform a repass to resolve sub names used as labels use_global_byte_elements = 0 dimshared = 0: dimmethod = 0: dimoption = 0: redimoption = 0: commonoption = 0 mylib$ = "": mylibopt$ = "" declaringlibrary = 0 nLabels = 0 dynscope = 0 elsefollowup = 0 ontimerid = 0: onkeyid = 0: onstrigid = 0 commonarraylist = "": commonarraylistn = 0 staticarraylist = "": staticarraylistn = 0 fooindwel = 0 layout = "" layoutok = 0 NoChecks = 0 inclevel = 0 errorLineInInclude = 0 addmetainclude$ = "" nextrunlineindex = 1 lasttype = 0 lasttypeelement = 0 REDIM SHARED udtxname(1000) AS STRING * 256 REDIM SHARED udtxcname(1000) AS STRING * 256 REDIM SHARED udtxsize(1000) AS LONG REDIM SHARED udtxbytealign(1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8 REDIM SHARED udtxnext(1000) AS LONG REDIM SHARED udtxvariable(1000) AS INTEGER 'true if the udt contains variable length elements 'elements REDIM SHARED udtename(1000) AS STRING * 256 REDIM SHARED udtecname(1000) AS STRING * 256 REDIM SHARED udtebytealign(1000) AS INTEGER REDIM SHARED udtesize(1000) AS LONG REDIM SHARED udtetype(1000) AS LONG REDIM SHARED udtetypesize(1000) AS LONG REDIM SHARED udtearrayelements(1000) AS LONG REDIM SHARED udtenext(1000) AS LONG definingtype = 0 definingtypeerror = 0 constlast = -1 'constlastshared = -1 closedmain = 0 addmetastatic = 0 addmetadynamic = 0 DynamicMode = 0 optionbase = 0 ExeIconSet = 0 VersionInfoSet = 0 viFileVersionNum$ = "": viProductVersionNum$ = "": viCompanyName$ = "" viFileDescription$ = "": viFileVersion$ = "": viInternalName$ = "" viLegalCopyright$ = "": viLegalTrademarks$ = "": viOriginalFilename$ = "" viProductName$ = "": viProductVersion$ = "": viComments$ = "": viWeb$ = "" DataOffset = 0 statementn = 0 everycasenewcase = 0 qberrorhappened = 0: qberrorcode = 0: qberrorline = 0 FOR i = 1 TO 27: defineaz(i) = "SINGLE": defineextaz(i) = "!": NEXT controllevel = 0 findidsecondarg$ = "": findanotherid = 0: findidinternal = 0: currentid = 0 linenumber = 0 wholeline$ = "" linefragment$ = "" idn = 0 arrayprocessinghappened = 0 stringprocessinghappened = 0 inputfunctioncalled = 0 subfuncn = 0 closedsubfunc = 0 subfunc = "" SelectCaseCounter = 0 ExecCounter = 0 UserDefineCount = 7 totalVariablesCreated = 0 typeDefinitions$ = "" totalMainVariablesCreated = 0 REDIM SHARED usedVariableList(1000) AS usedVarList totalWarnings = 0 duplicateConstWarning = 0 emptySCWarning = 0 warningListItems = 0 lastWarningHeader = "" vWatchUsedLabels = SPACE$(1000) vWatchUsedSkipLabels = SPACE$(1000) firstLineNumberLabelvWatch = 0 REDIM SHARED warning$(1000) REDIM SHARED warningLines(1000) AS LONG REDIM SHARED warningIncLines(1000) AS LONG REDIM SHARED warningIncFiles(1000) AS STRING maxLineNumber = 0 uniquenumbern = 0 ''create a type for storing memory blocks ''UDT ''names 'DIM SHARED lasttype AS LONG 'DIM SHARED udtxname(1000) AS STRING * 256 'DIM SHARED udtxcname(1000) AS STRING * 256 'DIM SHARED udtxsize(1000) AS LONG 'DIM SHARED udtxbytealign(1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8 'DIM SHARED udtxnext(1000) AS LONG ''elements 'DIM SHARED lasttypeelement AS LONG 'DIM SHARED udtename(1000) AS STRING * 256 'DIM SHARED udtecname(1000) AS STRING * 256 'DIM SHARED udtebytealign(1000) AS INTEGER 'DIM SHARED udtesize(1000) AS LONG 'DIM SHARED udtetype(1000) AS LONG 'DIM SHARED udtetypesize(1000) AS LONG 'DIM SHARED udtearrayelements(1000) AS LONG 'DIM SHARED udtenext(1000) AS LONG 'import _MEM type ptrsz = OS_BITS \ 8 lasttype = lasttype + 1: i = lasttype udtxname(i) = "_MEM" udtxcname(i) = "_MEM" udtxsize(i) = ((ptrsz) * 5 + (4) * 2 + (8) * 1) * 8 udtxbytealign(i) = 1 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "OFFSET" udtecname(i2) = "OFFSET" udtebytealign(i2) = 1 udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8 udtetypesize(i2) = 0 'tsize udtxnext(i) = i2 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "SIZE" udtecname(i2) = "SIZE" udtebytealign(i2) = 1 udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "$_LOCK_ID" udtecname(i2) = "$_LOCK_ID" udtebytealign(i2) = 1 udtetype(i2) = INTEGER64TYPE: udtesize(i2) = 64 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "$_LOCK_OFFSET" udtecname(i2) = "$_LOCK_OFFSET" udtebytealign(i2) = 1 udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "TYPE" udtecname(i2) = "TYPE" udtebytealign(i2) = 1 udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "ELEMENTSIZE" udtecname(i2) = "ELEMENTSIZE" udtebytealign(i2) = 1 udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 udtenext(i2) = 0 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "IMAGE" udtecname(i2) = "IMAGE" udtebytealign(i2) = 1 udtetype(i2) = LONGTYPE: udtesize(i2) = 32 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 udtenext(i2) = 0 i3 = i2 lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement udtename(i2) = "SOUND" udtecname(i2) = "SOUND" udtebytealign(i2) = 1 udtetype(i2) = LONGTYPE: udtesize(i2) = 32 udtetypesize(i2) = 0 'tsize udtenext(i3) = i2 udtenext(i2) = 0 ' Reset all unstable flags FOR i = 1 TO UBOUND(unstableFlags): unstableFlags(i) = 0: NEXT ' Indicates if a MIDI sound font was selected ' ' Captures both the line number and line contents for error reporting later-on ' in the compilation process MidiSoundFontSet = 0 MidiSoundFontLine$ = "" ' If MidiSoundFont$ is blank, then the default is used MidiSoundFont$ = "" 'begin compilation FOR closeall = 1 TO 255: CLOSE closeall: NEXT OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock bh = OpenBuffer%("O", tmpdir$ + "icon.rc") IF Debug THEN CLOSE #9: OPEN tmpdir$ + "debug.txt" FOR APPEND AS #9 IF idemode = 0 THEN qberrorhappened = -1 OPEN sourcefile$ FOR INPUT AS #1 qberrorhappened1: IF qberrorhappened = 1 THEN PRINT PRINT "Cannot locate source file: " + sourcefile$ IF ConsoleMode THEN SYSTEM 1 END 1 ELSE CLOSE #1 END IF qberrorhappened = 0 END IF reginternal IF qb64prefix_set THEN qb64prefix$ = "" 're-add internal keywords without the "_" prefix reginternal f = HASHFLAG_TYPE + HASHFLAG_RESERVED HashAdd "UNSIGNED", f, 0 HashAdd "BIT", f, 0 HashAdd "BYTE", f, 0 HashAdd "INTEGER64", f, 0 HashAdd "OFFSET", f, 0 HashAdd "FLOAT", f, 0 f = HASHFLAG_RESERVED + HASHFLAG_CUSTOMSYNTAX HashAdd "EXPLICIT", f, 0 END IF DIM SHARED GlobTxtBuf: GlobTxtBuf = OpenBuffer%("O", tmpdir$ + "global.txt") defdatahandle = GlobTxtBuf IF iderecompile THEN iderecompile = 0 idepass = 1 'prepass must be done again sendc$ = CHR$(7) 'repass request GOTO sendcommand END IF IF idemode THEN GOTO ideret1 lineinput3load sourcefile$ DO '### STEVE EDIT FOR CONST EXPANSION 10/11/2013 wholeline$ = lineinput3$ IF wholeline$ = CHR$(13) THEN EXIT DO ideprepass: prepassLastLine: IF lastLine <> 0 OR firstLine <> 0 THEN lineBackup$ = wholeline$ 'backup the real line (will be blank when lastline is set) forceIncludeFromRoot$ = "" IF vWatchOn THEN addingvWatch = 1 IF firstLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch.bi" IF lastLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch.bm" ELSE 'IF firstLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch_stub.bi" IF lastLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch_stub.bm" END IF firstLine = 0: lastLine = 0 IF LEN(forceIncludeFromRoot$) THEN GOTO forceInclude_prepass forceIncludeCompleted_prepass: addingvWatch = 0 wholeline$ = lineBackup$ END IF wholestv$ = wholeline$ '### STEVE EDIT FOR CONST EXPANSION 10/11/2013 prepass = 1 layout = "" layoutok = 0 linenumber = linenumber + 1 reallinenumber = reallinenumber + 1 DO UNTIL linenumber < UBOUND(InValidLine) 'color information flag for each line REDIM _PRESERVE InValidLine(UBOUND(InValidLine) + 1000) AS _BYTE LOOP InValidLine(linenumber) = 0 IF LEN(wholeline$) THEN IF UCASE$(_TRIM$(wholeline$)) = "$NOPREFIX" THEN qb64prefix_set_desiredState = 1 IF qb64prefix_set = 0 THEN IF qb64prefix_set_recompileAttempts = 0 THEN qb64prefix_set_recompileAttempts = qb64prefix_set_recompileAttempts + 1 GOTO do_recompile END IF END IF END IF wholeline$ = lineformat(wholeline$) IF Error_Happened THEN GOTO errmes temp$ = LTRIM$(RTRIM$(UCASE$(wholestv$))) IF temp$ = "$COLOR:0" THEN IF qb64prefix_set THEN addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color0_noprefix.bi" ELSE addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color0.bi" END IF GOTO finishedlinepp END IF IF temp$ = "$COLOR:32" THEN IF qb64prefix_set THEN addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color32_noprefix.bi" ELSE addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color32.bi" END IF GOTO finishedlinepp END IF IF temp$ = "$DEBUG" THEN vWatchDesiredState = 1 IF vWatchOn = 0 THEN IF vWatchRecompileAttempts = 0 THEN 'this is the first time a conflict has occurred, so react immediately with a full recompilation using the desired state vWatchRecompileAttempts = vWatchRecompileAttempts + 1 GOTO do_recompile ELSE 'continue compilation to retrieve the final state requested and act on that as required END IF END IF END IF IF LEFT$(temp$, 4) = "$IF " THEN IF RIGHT$(temp$, 5) <> " THEN" THEN a$ = "$IF without THEN": GOTO errmes temp$ = LTRIM$(MID$(temp$, 4)) 'strip off the $IF and extra spaces temp$ = RTRIM$(LEFT$(temp$, LEN(temp$) - 4)) 'and strip off the THEN and extra spaces temp = INSTR(temp$, "=") ExecCounter = ExecCounter + 1 ExecLevel(ExecCounter) = -1 'default to a skip value DefineElse(ExecCounter) = 1 '1 says we have an $IF statement at this level result = EvalPreIF(temp$, a$) IF a$ <> "" THEN GOTO errmes IF result <> 0 THEN ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'So we inherit the execlevel from above IF ExecLevel(ExecCounter) = 0 THEN DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 4 'Else if used and conditon found END IF GOTO finishedlinepp 'and then we're finished -- and at this point we didn't make a match so we exit with a DONT READ type flag on our code. END IF IF temp$ = "$ELSE" THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$ELSE without $IF": GOTO errmes IF DefineElse(ExecCounter) AND 2 THEN a$ = "$IF block already has $ELSE statement in it": GOTO errmes DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 2 'set the flag to declare an $ELSE already in this block IF DefineElse(ExecCounter) AND 4 THEN 'If we executed code in a previous IF or ELSE IF statement, we can't do it here ExecLevel(ExecCounter) = -1 'So we inherit the execlevel from above ELSE ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'If we were processing code before, code after this segment is going to be SKIPPED END IF GOTO finishedlinepp END IF IF LEFT$(temp$, 5) = "$ELSE" THEN 'looking for $ELSE IF temp$ = LTRIM$(MID$(temp$, 6)) IF LEFT$(temp$, 3) = "IF " THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$ELSE IF without $IF": GOTO errmes IF DefineElse(ExecCounter) AND 2 THEN a$ = "$ELSE IF cannot follow $ELSE": GOTO errmes IF RIGHT$(temp$, 5) <> " THEN" THEN a$ = "$ELSE IF without THEN": GOTO errmes IF DefineElse(ExecCounter) AND 4 THEN 'If we executed code in a previous IF or ELSE IF statement, we can't do it here ExecLevel(ExecCounter) = -1 GOTO finishedlinepp END IF temp$ = LTRIM$(MID$(temp$, 3)) 'strip off the IF and extra spaces temp$ = RTRIM$(LEFT$(temp$, LEN(temp$) - 4)) 'and strip off the THEN and extra spaces result = EvalPreIF(temp$, a$) IF a$ <> "" THEN GOTO errmes IF result <> 0 THEN ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'So we inherit the execlevel from above IF ExecLevel(ExecCounter) = 0 THEN DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 4 'Else if used and conditon found END IF GOTO finishedlinepp 'and then we're finished -- and at this point we didn't make a match so we exit with a DONT READ type flag on our code. END IF END IF IF temp$ = "$END IF" OR temp$ = "$ENDIF" THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$END IF without $IF": GOTO errmes DefineElse(ExecCounter) = 0 'We no longer have an $IF block at this level ExecCounter = ExecCounter - 1 GOTO finishedlinepp END IF IF ExecLevel(ExecCounter) THEN DO UNTIL linenumber < UBOUND(InValidLine) REDIM _PRESERVE InValidLine(UBOUND(InValidLine) + 1000) AS _BYTE LOOP InValidLine(linenumber) = -1 GOTO finishedlinepp 'we don't check for anything inside lines that we've marked for skipping END IF IF LEFT$(temp$, 7) = "$ERROR " THEN temp$ = LTRIM$(MID$(temp$, 7)) a$ = "Compilation check failed: " + temp$ GOTO errmes END IF IF LEFT$(temp$, 5) = "$LET " THEN temp$ = LTRIM$(MID$(temp$, 5)) 'simply shorten our string to parse 'For starters, let's make certain that we have 3 elements to deal with temp = INSTR(temp$, "=") 'without an = in there, we can't get a value from the left and right side IF temp = 0 THEN a$ = "Invalid Syntax. $LET <flag> = <value>": GOTO errmes l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + 1)) 'then validate to make certain the left side looks proper IF validname(l$) = 0 THEN a$ = "Invalid flag name": GOTO errmes IF LEFT$(r$, 1) = CHR$(34) THEN r$ = LTRIM$(MID$(r$, 2)) IF RIGHT$(r$, 1) = CHR$(34) THEN r$ = RTRIM$(LEFT$(r$, LEN(r$) - 1)) IF LEFT$(r$, 1) = "-" THEN r1$ = "-" r$ = LTRIM$(MID$(r$, 2)) ELSE r1$ = "" END IF 'then validate to make certain the left side looks proper FOR i = 1 TO LEN(r$) a = ASC(r$, i) SELECT CASE a CASE 32 CASE 46 'periods are fine. r1$ = r1$ + "." CASE IS < 48, IS > 90 a$ = "Invalid value": GOTO errmes CASE ELSE r1$ = r1$ + CHR$(a) END SELECT NEXT r$ = r1$ 'First look to see if we have an existing setting like this and if so, update it FOR i = 8 TO UserDefineCount 'UserDefineCount 1-7 are reserved for automatic OS/BIT detection & version IF UserDefine(0, i) = l$ THEN UserDefine(1, i) = r$: GOTO finishedlinepp NEXT 'Otherwise create a new setting and set the initial value for it UserDefineCount = UserDefineCount + 1 IF UserDefineCount > UBOUND(UserDefine, 2) THEN REDIM _PRESERVE UserDefine(1, UBOUND(UserDefine, 2) + 10) 'Add another 10 elements to the array so it'll expand as the user adds to it END IF UserDefine(0, UserDefineCount) = l$ UserDefine(1, UserDefineCount) = r$ GOTO finishedlinepp END IF ' We check for Unstable flags during the preprocessing step because it ' impacts what valid commands there are in all the other steps IF LEFT$(temp$, 10) = "$UNSTABLE:" THEN token$ = UCASE$(LTRIM$(RTRIM$(MID$(temp$, 11)))) SELECT CASE token$ CASE "MIDI" IF NOT UseMiniaudioBackend THEN a$ = "Midi is not supported with the old OpenAL audio backend." GOTO errmes END IF unstableFlags(UNSTABLE_MIDI) = -1 CASE "HTTP" unstableFlags(UNSTABLE_HTTP) = -1 regUnstableHttp CASE ELSE a$ = "Unrecognized unstable flag " + AddQuotes$(token$) GOTO errmes END SELECT END IF cwholeline$ = wholeline$ wholeline$ = eleucase$(wholeline$) '********REMOVE THIS LINE LATER******** addmetadynamic = 0: addmetastatic = 0 wholelinen = numelements(wholeline$) IF wholelinen THEN wholelinei = 1 'skip line number? e$ = getelement$(wholeline$, 1) IF (ASC(e$) >= 48 AND ASC(e$) <= 59) OR ASC(e$) = 46 THEN wholelinei = 2: GOTO ppskpl 'skip 'POSSIBLE' line label? IF wholelinen >= 2 THEN x2 = INSTR(wholeline$, sp + ":" + sp): x3 = x2 + 2 IF x2 = 0 THEN IF RIGHT$(wholeline$, 2) = sp + ":" THEN x2 = LEN(wholeline$) - 1: x3 = x2 + 1 END IF IF x2 THEN e$ = LEFT$(wholeline$, x2 - 1) IF validlabel(e$) THEN wholeline$ = RIGHT$(wholeline$, LEN(wholeline$) - x3) cwholeline$ = RIGHT$(cwholeline$, LEN(wholeline$) - x3) wholelinen = numelements(wholeline$) GOTO ppskpl END IF 'valid END IF 'includes ":" END IF 'wholelinen>=2 ppskpl: IF wholelinei <= wholelinen THEN '---------------------------------------- a$ = "" ca$ = "" ppblda: e$ = getelement$(wholeline$, wholelinei) ce$ = getelement$(cwholeline$, wholelinei) IF e$ = ":" OR e$ = "ELSE" OR e$ = "THEN" OR e$ = "" THEN IF LEN(a$) THEN IF Debug THEN PRINT #9, "PP[" + a$ + "]" n = numelements(a$) firstelement$ = getelement(a$, 1) secondelement$ = getelement(a$, 2) thirdelement$ = getelement(a$, 3) '======================================== IF n = 2 AND firstelement$ = "END" AND (secondelement$ = "SUB" OR secondelement$ = "FUNCTION") THEN closedsubfunc = -1 END IF 'declare library IF declaringlibrary THEN IF firstelement$ = "END" THEN IF n <> 2 OR secondelement$ <> "DECLARE" THEN a$ = "Expected END DECLARE": GOTO errmes declaringlibrary = 0 GOTO finishedlinepp END IF 'end declare declaringlibrary = 2 IF firstelement$ = "SUB" OR firstelement$ = "FUNCTION" THEN subfuncn = subfuncn - 1: GOTO declaresubfunc a$ = "Expected SUB/FUNCTION definition or END DECLARE (#2)": GOTO errmes END IF 'UDT TYPE definition IF definingtype THEN i = definingtype IF n >= 1 THEN IF firstelement$ = "END" THEN IF n <> 2 OR secondelement$ <> "TYPE" THEN a$ = "Expected END TYPE": GOTO errmes IF udtxnext(i) = 0 THEN a$ = "No elements defined in TYPE": GOTO errmes definingtype = 0 'create global buffer for SWAP space siz$ = str2$(udtxsize(i) \ 8) WriteBufLine GlobTxtBuf, "char *g_tmp_udt_" + RTRIM$(udtxname(i)) + "=(char*)malloc(" + siz$ + ");" 'print "END TYPE";udtxsize(i);udtxbytealign(i) GOTO finishedlinepp END IF END IF IF n < 3 THEN a$ = "Expected element-name AS type, AS type element-list, or END TYPE": GOTO errmes n$ = firstelement$ IF n$ <> "AS" THEN 'traditional variable-name AS type syntax, single-element lasttypeelement = lasttypeelement + 1 i2 = lasttypeelement WHILE i2 > UBOUND(udtenext): increaseUDTArrays: WEND udtenext(i2) = 0 ii = 2 udtearrayelements(i2) = 0 IF ii >= n OR getelement$(a$, ii) <> "AS" THEN a$ = "Expected element-name AS type, AS type element-list, or END TYPE": GOTO errmes t$ = getelements$(a$, ii + 1, n) IF t$ = RTRIM$(udtxname(definingtype)) THEN a$ = "Invalid self-reference": GOTO errmes typ = typname2typ(t$) IF Error_Happened THEN GOTO errmes IF typ = 0 THEN a$ = "Undefined type": GOTO errmes typsize = typname2typsize IF validname(n$) = 0 THEN a$ = "Invalid name": GOTO errmes udtename(i2) = n$ udtecname(i2) = getelement$(ca$, 1) NormalTypeBlock: typeDefinitions$ = typeDefinitions$ + MKL$(i2) + MKL$(LEN(n$)) + n$ udtetype(i2) = typ udtetypesize(i2) = typsize hashname$ = n$ 'check for name conflicts (any similar reserved or element from current UDT) hashchkflags = HASHFLAG_RESERVED + HASHFLAG_UDTELEMENT hashres = HashFind(hashname$, hashchkflags, hashresflags, hashresref) DO WHILE hashres IF hashresflags AND HASHFLAG_UDTELEMENT THEN IF hashresref = i THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes END IF IF hashresflags AND HASHFLAG_RESERVED THEN IF hashresflags AND (HASHFLAG_TYPE + HASHFLAG_CUSTOMSYNTAX + HASHFLAG_OPERATOR + HASHFLAG_XELEMENTNAME) THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes END IF IF hashres <> 1 THEN hashres = HashFindCont(hashresflags, hashresref) ELSE hashres = 0 LOOP 'add to hash table HashAdd hashname$, HASHFLAG_UDTELEMENT, i 'Calculate element's size IF typ AND ISUDT THEN u = typ AND 511 udtesize(i2) = udtxsize(u) IF udtxbytealign(u) THEN udtxbytealign(i) = 1: udtebytealign(i2) = 1 IF udtxvariable(u) THEN udtxvariable(i) = -1 ELSE IF (typ AND ISSTRING) THEN IF (typ AND ISFIXEDLENGTH) = 0 THEN udtesize(i2) = OFFSETTYPE AND 511 udtxvariable(i) = -1 ELSE udtesize(i2) = typsize * 8 END IF udtxbytealign(i) = 1: udtebytealign(i2) = 1 ELSE udtesize(i2) = typ AND 511 IF (typ AND ISOFFSETINBITS) = 0 THEN udtxbytealign(i) = 1: udtebytealign(i2) = 1 END IF END IF 'Increase block size IF udtebytealign(i2) THEN IF udtxsize(i) MOD 8 THEN udtxsize(i) = udtxsize(i) + (8 - (udtxsize(i) MOD 8)) END IF END IF udtxsize(i) = udtxsize(i) + udtesize(i2) 'Link element to previous element IF udtxnext(i) = 0 THEN udtxnext(i) = i2 ELSE udtenext(i2 - 1) = i2 END IF 'print "+"+rtrim$(udtename(i2));udtetype(i2);udtesize(i2);udtebytealign(i2);udtxsize(i) IF newAsTypeBlockSyntax THEN RETURN GOTO finishedlinepp ELSE 'new AS type variable-list syntax, multiple elements ii = 2 IF ii >= n THEN a$ = "Expected element-name AS type, AS type element-list, or END TYPE": GOTO errmes previousElement$ = "" t$ = "" lastElement$ = "" buildTypeName: lastElement$ = getelement$(a$, ii) IF lastElement$ <> "," AND lastElement$ <> "" THEN n$ = lastElement$ cn$ = getelement$(ca$, ii) IF LEN(previousElement$) THEN t$ = t$ + previousElement$ + " " previousElement$ = n$ lastElement$ = "" ii = ii + 1 GOTO buildTypeName END IF t$ = RTRIM$(t$) IF t$ = RTRIM$(udtxname(definingtype)) THEN a$ = "Invalid self-reference": GOTO errmes typ = typname2typ(t$) IF Error_Happened THEN GOTO errmes IF typ = 0 THEN a$ = "Undefined type": GOTO errmes typsize = typname2typsize previousElement$ = lastElement$ nexttypeelement: lasttypeelement = lasttypeelement + 1 i2 = lasttypeelement WHILE i2 > UBOUND(udtenext): increaseUDTArrays: WEND udtenext(i2) = 0 udtearrayelements(i2) = 0 udtename(i2) = n$ udtecname(i2) = cn$ IF validname(n$) = 0 THEN a$ = "Invalid name": GOTO errmes newAsTypeBlockSyntax = -1 GOSUB NormalTypeBlock newAsTypeBlockSyntax = 0 getNextElement: ii = ii + 1 lastElement$ = getelement$(a$, ii) IF lastElement$ = "" THEN GOTO finishedlinepp IF ii = n AND lastElement$ = "," THEN a$ = "Expected element-name": GOTO errmes IF lastElement$ = "," THEN IF previousElement$ = "," THEN a$ = "Expected element-name": GOTO errmes previousElement$ = lastElement$ GOTO getNextElement END IF n$ = lastElement$ IF previousElement$ <> "," THEN a$ = "Expected ,": GOTO errmes previousElement$ = lastElement$ cn$ = getelement$(ca$, ii) GOTO nexttypeelement END IF END IF 'definingtype IF definingtype AND n >= 1 THEN a$ = "Expected END TYPE": GOTO errmes IF n >= 1 THEN IF firstelement$ = "TYPE" THEN IF n <> 2 THEN a$ = "Expected TYPE typename": GOTO errmes lasttype = lasttype + 1 typeDefinitions$ = typeDefinitions$ + MKL$(-1) + MKL$(lasttype) definingtype = lasttype i = definingtype WHILE i > UBOUND(udtenext): increaseUDTArrays: WEND IF validname(secondelement$) = 0 THEN a$ = "Invalid name": GOTO errmes typeDefinitions$ = typeDefinitions$ + MKL$(LEN(secondelement$)) + secondelement$ udtxname(i) = secondelement$ udtxcname(i) = getelement(ca$, 2) udtxnext(i) = 0 udtxsize(i) = 0 udtxvariable(i) = 0 hashname$ = secondelement$ hashflags = HASHFLAG_UDT 'check for name conflicts (any similar reserved/sub/function/UDT name) hashchkflags = HASHFLAG_RESERVED + HASHFLAG_SUB + HASHFLAG_FUNCTION + HASHFLAG_UDT hashres = HashFind(hashname$, hashchkflags, hashresflags, hashresref) DO WHILE hashres allow = 0 IF hashresflags AND (HASHFLAG_SUB + HASHFLAG_FUNCTION) THEN allow = 1 END IF IF hashresflags AND HASHFLAG_RESERVED THEN IF (hashresflags AND (HASHFLAG_TYPE + HASHFLAG_OPERATOR + HASHFLAG_CUSTOMSYNTAX + HASHFLAG_XTYPENAME)) = 0 THEN allow = 1 END IF IF allow = 0 THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes IF hashres <> 1 THEN hashres = HashFindCont(hashresflags, hashresref) ELSE hashres = 0 LOOP 'add to hash table HashAdd hashname$, hashflags, i GOTO finishedlinepp END IF END IF IF n >= 1 AND firstelement$ = "CONST" THEN 'l$ = "CONST" 'DEF... do not change type, the expression is stored in a suitable type 'based on its value if type isn't forced/specified IF subfuncn > 0 AND closedsubfunc <> 0 THEN a$ = "Statement cannot be placed between SUB/FUNCTIONs": GOTO errmes 'convert periods to _046_ i2 = INSTR(a$, sp + "." + sp) IF i2 THEN DO a$ = LEFT$(a$, i2 - 1) + fix046$ + RIGHT$(a$, LEN(a$) - i2 - 2) ca$ = LEFT$(ca$, i2 - 1) + fix046$ + RIGHT$(ca$, LEN(ca$) - i2 - 2) i2 = INSTR(a$, sp + "." + sp) LOOP UNTIL i2 = 0 n = numelements(a$) firstelement$ = getelement(a$, 1): secondelement$ = getelement(a$, 2): thirdelement$ = getelement(a$, 3) END IF IF n < 3 THEN a$ = "Expected CONST name = value/expression": GOTO errmes i = 2 constdefpendingpp: pending = 0 n$ = getelement$(ca$, i): i = i + 1 typeoverride = 0 s$ = removesymbol$(n$) IF Error_Happened THEN GOTO errmes IF s$ <> "" THEN typeoverride = typname2typ(s$) IF Error_Happened THEN GOTO errmes IF typeoverride AND ISFIXEDLENGTH THEN a$ = "Invalid constant type": GOTO errmes IF typeoverride = 0 THEN a$ = "Invalid constant type": GOTO errmes END IF IF getelement$(a$, i) <> "=" THEN a$ = "Expected =": GOTO errmes i = i + 1 'get expression e$ = "" readable_e$ = "" B = 0 FOR i2 = i TO n e2$ = getelement$(ca$, i2) IF e2$ = "(" THEN B = B + 1 IF e2$ = ")" THEN B = B - 1 IF e2$ = "," AND B = 0 THEN pending = 1 i = i2 + 1 IF i > n - 2 THEN a$ = "Expected CONST ... , name = value/expression": GOTO errmes EXIT FOR END IF IF LEN(e$) = 0 THEN e$ = e2$ ELSE e$ = e$ + sp + e2$ e3$ = e2$ IF LEN(e2$) > 1 THEN IF ASC(e2$, 1) = 34 THEN removeComma = _INSTRREV(e2$, ",") e3$ = LEFT$(e2$, removeComma - 1) ELSE removeComma = INSTR(e2$, ",") e3$ = MID$(e2$, removeComma + 1) END IF END IF IF LEN(readable_e$) = 0 THEN readable_e$ = e3$ ELSE readable_e$ = readable_e$ + " " + e3$ END IF NEXT 'intercept current expression and pass it through Evaluate_Expression$ '(unless it is a literal string) IF LEFT$(readable_e$, 1) <> CHR$(34) THEN temp1$ = _TRIM$(Evaluate_Expression$(readable_e$)) IF LEFT$(temp1$, 5) <> "ERROR" AND e$ <> temp1$ THEN e$ = lineformat(temp1$) 'retrieve parseable format ELSE IF temp1$ = "ERROR - Division By Zero" THEN a$ = temp1$: GOTO errmes IF INSTR(temp1$, "Improper operations") THEN a$ = "Invalid CONST expression.14": GOTO errmes END IF END IF END IF 'Proceed as usual e$ = fixoperationorder(e$) IF Error_Happened THEN GOTO errmes e$ = evaluateconst(e$, t) IF Error_Happened THEN GOTO errmes IF t AND ISSTRING THEN 'string type IF typeoverride THEN IF (typeoverride AND ISSTRING) = 0 THEN a$ = "Type mismatch": GOTO errmes END IF ELSE 'not a string type IF typeoverride THEN IF typeoverride AND ISSTRING THEN a$ = "Type mismatch": GOTO errmes END IF IF t AND ISFLOAT THEN constval## = _CV(_FLOAT, e$) constval&& = constval## constval~&& = constval&& ELSE IF (t AND ISUNSIGNED) AND (t AND 511) = 64 THEN constval~&& = _CV(_UNSIGNED _INTEGER64, e$) constval&& = constval~&& constval## = constval&& ELSE constval&& = _CV(_INTEGER64, e$) constval## = constval&& constval~&& = constval&& END IF END IF 'override type? IF typeoverride THEN 'range check required here (noted in todo) t = typeoverride END IF END IF 'not a string type constlast = constlast + 1 IF constlast > constmax THEN constmax = constmax * 2 REDIM _PRESERVE constname(constmax) AS STRING REDIM _PRESERVE constcname(constmax) AS STRING REDIM _PRESERVE constnamesymbol(constmax) AS STRING 'optional name symbol REDIM _PRESERVE consttype(constmax) AS LONG 'variable type number REDIM _PRESERVE constinteger(constmax) AS _INTEGER64 REDIM _PRESERVE constuinteger(constmax) AS _UNSIGNED _INTEGER64 REDIM _PRESERVE constfloat(constmax) AS _FLOAT REDIM _PRESERVE conststring(constmax) AS STRING REDIM _PRESERVE constsubfunc(constmax) AS LONG REDIM _PRESERVE constdefined(constmax) AS LONG END IF i2 = constlast constsubfunc(i2) = subfuncn 'IF subfunc = "" THEN constlastshared = i2 IF validname(n$) = 0 THEN a$ = "Invalid name": GOTO errmes constname(i2) = UCASE$(n$) hashname$ = n$ 'check for name conflicts (any similar: reserved, sub, function, constant) allow = 0 const_recheck: hashchkflags = HASHFLAG_RESERVED + HASHFLAG_SUB + HASHFLAG_FUNCTION + HASHFLAG_CONSTANT hashres = HashFind(hashname$, hashchkflags, hashresflags, hashresref) DO WHILE hashres IF hashresflags AND HASHFLAG_CONSTANT THEN IF constsubfunc(hashresref) = subfuncn THEN 'If merely redefining a CONST with same value 'just issue a warning instead of an error issueWarning = 0 IF t AND ISSTRING THEN IF conststring(hashresref) = e$ THEN issueWarning = -1: thisconstval$ = e$ ELSE IF t AND ISFLOAT THEN IF constfloat(hashresref) = constval## THEN issueWarning = -1: thisconstval$ = STR$(constval##) ELSE IF t AND ISUNSIGNED THEN IF constuinteger(hashresref) = constval~&& THEN issueWarning = -1: thisconstval$ = STR$(constval~&&) ELSE IF constinteger(hashresref) = constval&& THEN issueWarning = -1: thisconstval$ = STR$(constval&&) END IF END IF END IF IF issueWarning THEN IF NOT IgnoreWarnings THEN addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "duplicate constant definition", n$ + " =" + thisconstval$ END IF GOTO constAddDone ELSE a$ = "Name already in use (" + hashname$ + ")": GOTO errmes END IF END IF END IF IF hashresflags AND HASHFLAG_RESERVED THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes END IF IF hashresflags AND (HASHFLAG_SUB + HASHFLAG_FUNCTION) THEN IF ids(hashresref).internal_subfunc = 0 OR RTRIM$(ids(hashresref).musthave) <> "$" THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes IF t AND ISSTRING THEN a$ = "Name already in use (" + hashname$ + ")": GOTO errmes END IF IF hashres <> 1 THEN hashres = HashFindCont(hashresflags, hashresref) ELSE hashres = 0 LOOP 'add to hash table HashAdd hashname$, HASHFLAG_CONSTANT, i2 constdefined(i2) = 1 constcname(i2) = n$ constnamesymbol(i2) = typevalue2symbol$(t) IF Error_Happened THEN GOTO errmes consttype(i2) = t IF t AND ISSTRING THEN conststring(i2) = e$ ELSE IF t AND ISFLOAT THEN constfloat(i2) = constval## ELSE IF t AND ISUNSIGNED THEN constuinteger(i2) = constval~&& ELSE constinteger(i2) = constval&& END IF END IF END IF constAddDone: IF pending THEN 'l$ = l$ + sp2 + "," GOTO constdefpendingpp END IF 'layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ GOTO finishedlinepp END IF 'DEFINE d = 0 IF firstelement$ = "DEFINT" THEN d = 1 IF firstelement$ = "DEFLNG" THEN d = 1 IF firstelement$ = "DEFSNG" THEN d = 1 IF firstelement$ = "DEFDBL" THEN d = 1 IF firstelement$ = "DEFSTR" THEN d = 1 IF firstelement$ = "_DEFINE" OR (firstelement$ = "DEFINE" AND qb64prefix_set = 1) THEN d = 1 IF d THEN predefining = 1: GOTO predefine predefined: predefining = 0 GOTO finishedlinepp END IF 'declare library IF firstelement$ = "DECLARE" THEN IF secondelement$ = "LIBRARY" OR secondelement$ = "DYNAMIC" OR secondelement$ = "CUSTOMTYPE" OR secondelement$ = "STATIC" THEN declaringlibrary = 1 indirectlibrary = 0 IF secondelement$ = "CUSTOMTYPE" OR secondelement$ = "DYNAMIC" THEN indirectlibrary = 1 GOTO finishedlinepp END IF END IF 'SUB/FUNCTION dynamiclibrary = 0 declaresubfunc: firstelement$ = getelement$(a$, 1) sf = 0 IF firstelement$ = "FUNCTION" THEN sf = 1 IF firstelement$ = "SUB" THEN sf = 2 IF sf THEN subfuncn = subfuncn + 1 closedsubfunc = 0 IF n = 1 THEN a$ = "Expected name after SUB/FUNCTION": GOTO errmes 'convert periods to _046_ i2 = INSTR(a$, sp + "." + sp) IF i2 THEN DO a$ = LEFT$(a$, i2 - 1) + fix046$ + RIGHT$(a$, LEN(a$) - i2 - 2) ca$ = LEFT$(ca$, i2 - 1) + fix046$ + RIGHT$(ca$, LEN(ca$) - i2 - 2) i2 = INSTR(a$, sp + "." + sp) LOOP UNTIL i2 = 0 n = numelements(a$) firstelement$ = getelement(a$, 1): secondelement$ = getelement(a$, 2): thirdelement$ = getelement(a$, 3) END IF n$ = getelement$(ca$, 2) symbol$ = removesymbol$(n$) IF Error_Happened THEN GOTO errmes IF sf = 2 AND symbol$ <> "" THEN a$ = "Type symbols after a SUB name are invalid": GOTO errmes 'remove STATIC (which is ignored) e$ = getelement$(a$, n): IF e$ = "STATIC" THEN a$ = LEFT$(a$, LEN(a$) - 7): ca$ = LEFT$(ca$, LEN(ca$) - 7): n = n - 1 'check for ALIAS aliasname$ = n$ 'use given name by default IF n > 2 THEN e$ = getelement$(a$, 3) IF e$ = "ALIAS" THEN IF declaringlibrary = 0 THEN a$ = "ALIAS can only be used with DECLARE LIBRARY": GOTO errmes IF n = 3 THEN a$ = "Expected ALIAS name-in-library": GOTO errmes e$ = getelement$(ca$, 4) 'strip string content (optional) IF LEFT$(e$, 1) = CHR$(34) THEN e$ = RIGHT$(e$, LEN(e$) - 1) x = INSTR(e$, CHR$(34)): IF x = 0 THEN a$ = "Expected " + CHR$(34): GOTO errmes e$ = LEFT$(e$, x - 1) END IF 'strip fix046$ (created by unquoted periods) DO WHILE INSTR(e$, fix046$) x = INSTR(e$, fix046$): e$ = LEFT$(e$, x - 1) + "." + RIGHT$(e$, LEN(e$) - x + 1 - LEN(fix046$)) LOOP 'validate alias name IF LEN(e$) = 0 THEN a$ = "Expected ALIAS name-in-library": GOTO errmes FOR x = 1 TO LEN(e$) a = ASC(e$, x) IF alphanumeric(a) = 0 AND a <> ASC_FULLSTOP AND a <> ASC_COLON THEN a$ = "Expected ALIAS name-in-library": GOTO errmes NEXT aliasname$ = e$ 'remove ALIAS section from line IF n <= 4 THEN a$ = getelements(a$, 1, 2) IF n >= 5 THEN a$ = getelements(a$, 1, 2) + sp + getelements(a$, 5, n) IF n <= 4 THEN ca$ = getelements(ca$, 1, 2) IF n >= 5 THEN ca$ = getelements(ca$, 1, 2) + sp + getelements(ca$, 5, n) n = n - 2 END IF END IF IF declaringlibrary THEN IF indirectlibrary THEN aliasname$ = n$ 'override the alias name END IF END IF params = 0 params$ = "" paramsize$ = "" nele$ = "" nelereq$ = "" IF n > 2 THEN e$ = getelement$(a$, 3) IF e$ <> "(" THEN a$ = "Expected (": GOTO errmes e$ = getelement$(a$, n) IF e$ <> ")" THEN a$ = "Expected )": GOTO errmes IF n < 4 THEN a$ = "Expected ( ... )": GOTO errmes IF n = 4 THEN GOTO nosfparams B = 0 a2$ = "" FOR i = 4 TO n - 1 e$ = getelement$(a$, i) IF e$ = "(" THEN B = B + 1 IF e$ = ")" THEN B = B - 1 IF e$ = "," AND B = 0 THEN IF i = n - 1 THEN a$ = "Expected , ... )": GOTO errmes getlastparam: IF a2$ = "" THEN a$ = "Expected ... ,": GOTO errmes a2$ = LEFT$(a2$, LEN(a2$) - 1) 'possible format: [BYVAL]a[%][(1)][AS][type] n2 = numelements(a2$) array = 0 t2$ = "" i2 = 1 e$ = getelement$(a2$, i2): i2 = i2 + 1 byvalue = 0 IF e$ = "BYVAL" THEN IF declaringlibrary = 0 THEN a$ = "BYVAL can currently only be used with DECLARE LIBRARY": GOTO errmes e$ = getelement$(a2$, i2): i2 = i2 + 1: byvalue = 1 END IF n2$ = e$ symbol2$ = removesymbol$(n2$) IF validname(n2$) = 0 THEN a$ = "Invalid name": GOTO errmes IF Error_Happened THEN GOTO errmes m = 0 FOR i2 = i2 TO n2 e$ = getelement$(a2$, i2) IF e$ = "(" THEN IF m <> 0 THEN a$ = "Syntax error - too many opening brackets": GOTO errmes m = 1 array = 1 GOTO gotaa END IF IF e$ = ")" THEN IF m <> 1 THEN a$ = "Syntax error - closing bracket without opening bracket": GOTO errmes m = 2 GOTO gotaa END IF IF e$ = "AS" THEN IF m <> 0 AND m <> 2 THEN a$ = "Syntax error - check your brackets": GOTO errmes m = 3 GOTO gotaa END IF IF m = 1 THEN GOTO gotaa 'ignore contents of bracket IF m <> 3 THEN a$ = "Syntax error - check your brackets": GOTO errmes IF t2$ = "" THEN t2$ = e$ ELSE t2$ = t2$ + " " + e$ gotaa: NEXT i2 params = params + 1: IF params > 100 THEN a$ = "SUB/FUNCTION exceeds 100 parameter limit": GOTO errmes argnelereq = 0 IF symbol2$ <> "" AND t2$ <> "" THEN a$ = "Syntax error - check parameter types": GOTO errmes IF t2$ = "" AND e$ = "AS" THEN a$ = "Expected AS type": GOTO errmes IF t2$ = "" THEN t2$ = symbol2$ IF t2$ = "" THEN IF LEFT$(n2$, 1) = "_" THEN v = 27 ELSE v = ASC(UCASE$(n2$)) - 64 t2$ = defineaz(v) END IF paramsize = 0 IF array = 1 THEN t = typname2typ(t2$) IF Error_Happened THEN GOTO errmes IF t = 0 THEN a$ = "Illegal SUB/FUNCTION parameter": GOTO errmes IF (t AND ISFIXEDLENGTH) THEN paramsize = typname2typsize t = t + ISARRAY 'check for recompilation override FOR i10 = 0 TO sflistn IF sfidlist(i10) = idn + 1 THEN IF sfarglist(i10) = params THEN argnelereq = sfelelist(i10) END IF END IF NEXT ELSE t = typname2typ(t2$) IF Error_Happened THEN GOTO errmes IF t = 0 THEN a$ = "Illegal SUB/FUNCTION parameter": GOTO errmes IF (t AND ISFIXEDLENGTH) THEN paramsize = typname2typsize IF byvalue THEN IF t AND ISPOINTER THEN t = t - ISPOINTER END IF END IF nelereq$ = nelereq$ + CHR$(argnelereq) 'consider changing 0 in following line too! nele$ = nele$ + CHR$(0) paramsize$ = paramsize$ + MKL$(paramsize) params$ = params$ + MKL$(t) a2$ = "" ELSE a2$ = a2$ + e$ + sp IF i = n - 1 THEN GOTO getlastparam END IF NEXT i END IF 'n>2 nosfparams: IF sf = 1 THEN 'function clearid id.n = n$ id.subfunc = 1 id.callname = "FUNC_" + UCASE$(n$) IF declaringlibrary THEN id.ccall = 1 IF indirectlibrary = 0 THEN id.callname = aliasname$ END IF id.args = params id.arg = params$ id.argsize = paramsize$ id.nele = nele$ id.nelereq = nelereq$ IF symbol$ <> "" THEN id.ret = typname2typ(symbol$) IF Error_Happened THEN GOTO errmes ELSE IF LEFT$(n$, 1) = "_" THEN v = 27 ELSE v = ASC(UCASE$(n$)) - 64 symbol$ = defineaz(v) id.ret = typname2typ(symbol$) IF Error_Happened THEN GOTO errmes END IF IF id.ret = 0 THEN a$ = "Invalid FUNCTION return type": GOTO errmes IF declaringlibrary THEN ctype$ = typ2ctyp$(id.ret, "") IF Error_Happened THEN GOTO errmes IF ctype$ = "qbs" THEN ctype$ = "char*" id.callname = "( " + ctype$ + " )" + RTRIM$(id.callname) END IF s$ = LEFT$(symbol$, 1) IF s$ <> "~" AND s$ <> "`" AND s$ <> "%" AND s$ <> "&" AND s$ <> "!" AND s$ <> "#" AND s$ <> "$" THEN symbol$ = type2symbol$(symbol$) IF Error_Happened THEN GOTO errmes END IF id.mayhave = symbol$ IF id.ret AND ISPOINTER THEN IF (id.ret AND ISSTRING) = 0 THEN id.ret = id.ret - ISPOINTER END IF regid IF Error_Happened THEN GOTO errmes ELSE 'sub clearid id.n = n$ id.subfunc = 2 id.callname = "SUB_" + UCASE$(n$) IF declaringlibrary THEN id.ccall = 1 IF indirectlibrary = 0 THEN id.callname = aliasname$ END IF id.args = params id.arg = params$ id.argsize = paramsize$ id.nele = nele$ id.nelereq = nelereq$ IF UCASE$(n$) = "_GL" AND params = 0 AND UseGL = 0 THEN reginternalsubfunc = 1: UseGL = 1: id.n = "_GL": DEPENDENCY(DEPENDENCY_GL) = 1 regid reginternalsubfunc = 0 IF Error_Happened THEN GOTO errmes END IF END IF '======================================== finishedlinepp: firstLine = 0 END IF a$ = "" ca$ = "" ELSE IF a$ = "" THEN a$ = e$: ca$ = ce$ ELSE a$ = a$ + sp + e$: ca$ = ca$ + sp + ce$ END IF IF wholelinei <= wholelinen THEN wholelinei = wholelinei + 1: GOTO ppblda '---------------------------------------- END IF 'wholelinei<=wholelinen END IF 'wholelinen END IF 'len(wholeline$) 'Include Manager #1 IF LEN(addmetainclude$) THEN IF Debug THEN PRINT #9, "Pre-pass:INCLUDE$-ing file:'" + addmetainclude$ + "':On line"; linenumber a$ = addmetainclude$: addmetainclude$ = "" 'read/clear message IF inclevel = 0 THEN includingFromRoot = 0 forceIncludingFile = 0 forceInclude_prepass: IF forceIncludeFromRoot$ <> "" THEN a$ = forceIncludeFromRoot$ forceIncludeFromRoot$ = "" forceIncludingFile = 1 includingFromRoot = 1 END IF END IF IF inclevel = 100 THEN a$ = "Too many indwelling INCLUDE files": GOTO errmes '1. Verify file exists (location is either (a)relative to source file or (b)absolute) fh = 99 + inclevel + 1 firstTryMethod = 1 IF includingFromRoot <> 0 AND inclevel = 0 THEN firstTryMethod = 2 FOR try = firstTryMethod TO 2 'if including file from root, do not attempt including from relative location IF try = 1 THEN IF inclevel = 0 THEN IF idemode THEN p$ = idepath$ + pathsep$ ELSE p$ = getfilepath$(sourcefile$) ELSE p$ = getfilepath$(incname(inclevel)) END IF f$ = p$ + a$ END IF IF try = 2 THEN f$ = a$ IF _FILEEXISTS(f$) THEN qberrorhappened = -3 'We're using the faster LINE INPUT, which requires a BINARY open. OPEN f$ FOR BINARY AS #fh 'And another line below edited qberrorhappened3: IF qberrorhappened = -3 THEN EXIT FOR END IF qberrorhappened = 0 NEXT IF qberrorhappened <> -3 THEN qberrorhappened = 0: a$ = "File " + a$ + " not found": GOTO errmes inclevel = inclevel + 1: incname$(inclevel) = f$: inclinenumber(inclevel) = 0 END IF 'fall through to next section... '-------------------- DO WHILE inclevel fh = 99 + inclevel '2. Feed next line IF EOF(fh) = 0 THEN LINE INPUT #fh, x$ wholeline$ = x$ inclinenumber(inclevel) = inclinenumber(inclevel) + 1 'create extended error string 'incerror$' errorLineInInclude = inclinenumber(inclevel) e$ = " in line " + str2(inclinenumber(inclevel)) + " of " + incname$(inclevel) + " included" IF inclevel > 1 THEN e$ = e$ + " (through " FOR x = 1 TO inclevel - 1 STEP 1 e$ = e$ + incname$(x) IF x < inclevel - 1 THEN 'a sep is req IF x = inclevel - 2 THEN e$ = e$ + " then " ELSE e$ = e$ + ", " END IF END IF NEXT e$ = e$ + ")" END IF incerror$ = e$ linenumber = linenumber - 1 'lower official linenumber to counter later increment IF Debug THEN PRINT #9, "Pre-pass:Feeding INCLUDE$ line:[" + wholeline$ + "]" IF idemode THEN sendc$ = CHR$(10) + wholeline$: GOTO sendcommand 'passback GOTO ideprepass END IF '3. Close & return control CLOSE #fh inclevel = inclevel - 1 IF forceIncludingFile = 1 AND inclevel = 0 THEN forceIncludingFile = 0 GOTO forceIncludeCompleted_prepass END IF LOOP '(end manager) IF idemode THEN GOTO ideret2 LOOP 'add final line IF lastLineReturn = 0 THEN lastLineReturn = 1 lastLine = 1 wholeline$ = "" GOTO prepassLastLine END IF IF definingtype THEN definingtype = 0 'ignore this error so that auto-formatting can be performed and catch it again later IF declaringlibrary THEN declaringlibrary = 0 'ignore this error so that auto-formatting can be performed and catch it again later totallinenumber = reallinenumber 'IF idemode = 0 AND NOT QuietMode THEN PRINT "first pass finished.": PRINT "Translating code... " 'prepass finished lineinput3index = 1 'reset input line 'ide specific ide3: addmetainclude$ = "" 'reset stray meta-includes 'reset altered variables DataOffset = 0 inclevel = 0 subfuncn = 0 lastLineReturn = 0 lastLine = 0 firstLine = 1 UserDefineCount = 7 FOR i = 0 TO constlast: constdefined(i) = 0: NEXT 'undefine constants FOR i = 1 TO 27: defineaz(i) = "SINGLE": defineextaz(i) = "!": NEXT DIM SHARED DataBinBuf: DataBinBuf = OpenBuffer%("O", tmpdir$ + "data.bin") DIM SHARED MainTxtBuf: MainTxtBuf = OpenBuffer%("O", tmpdir$ + "main.txt") DIM SHARED DataTxtBuf: DataTxtBuf = OpenBuffer%("O", tmpdir$ + "maindata.txt") DIM SHARED RegTxtBuf: RegTxtBuf = OpenBuffer%("O", tmpdir$ + "regsf.txt") DIM SHARED FreeTxtBuf: FreeTxtBuf = OpenBuffer%("O", tmpdir$ + "mainfree.txt") DIM SHARED RunTxtBuf: RunTxtBuf = OpenBuffer%("O", tmpdir$ + "runline.txt") DIM SHARED ErrTxtBuf: ErrTxtBuf = OpenBuffer%("O", tmpdir$ + "mainerr.txt") 'i. check the value of error_line 'ii. jump to the appropriate label errorlabels = 0 WriteBufLine ErrTxtBuf, "if (error_occurred){ error_occurred=0;" DIM SHARED ChainTxtBuf: ChainTxtBuf = OpenBuffer%("O", tmpdir$ + "chain.txt") DIM SHARED InpChainTxtBuf: InpChainTxtBuf = OpenBuffer%("O", tmpdir$ + "inpchain.txt") DIM SHARED TimeTxtBuf: TimeTxtBuf = OpenBuffer%("O", tmpdir$ + "ontimer.txt") DIM SHARED TimejTxtBuf: TimejTxtBuf = OpenBuffer%("O", tmpdir$ + "ontimerj.txt") '*****#26 used for locking qb64pe DIM SHARED KeyTxtBuf: KeyTxtBuf = OpenBuffer%("O", tmpdir$ + "onkey.txt") DIM SHARED KeyjTxtBuf: KeyjTxtBuf = OpenBuffer%("O", tmpdir$ + "onkeyj.txt") DIM SHARED StrigTxtBuf: StrigTxtBuf = OpenBuffer%("O", tmpdir$ + "onstrig.txt") DIM SHARED StrigjTxtBuf: StrigjTxtBuf = OpenBuffer%("O", tmpdir$ + "onstrigj.txt") gosubid = 1 'to be included whenever return without a label is called 'return [label] in QBASIC was not possible in a sub/function, but QB64 will support this 'special codes will represent special return conditions: '0=return from main to calling sub/function/proc by return [NULL]; '1... a global number representing a return point after a gosub 'note: RETURN [label] should fail if a "return [NULL];" type return is required DIM SHARED RetTxtBuf: RetTxtBuf = OpenBuffer%("O", tmpdir$ + "ret0.txt") WriteBufLine RetTxtBuf, "if (next_return_point){" WriteBufLine RetTxtBuf, "next_return_point--;" WriteBufLine RetTxtBuf, "switch(return_point[next_return_point]){" WriteBufLine RetTxtBuf, "case 0:" WriteBufLine RetTxtBuf, "return;" WriteBufLine RetTxtBuf, "break;" continueline = 0 endifs = 0 lineelseused = 0 continuelinefrom = 0 linenumber = 0 reallinenumber = 0 declaringlibrary = 0 WriteBufLine MainTxtBuf, "S_0:;" 'note: REQUIRED by run statement IF UseGL THEN gl_include_content 'ide specific IF idemode THEN GOTO ideret3 DO ide4: includeline: mainpassLastLine: IF lastLine <> 0 OR firstLine <> 0 THEN lineBackup$ = a3$ 'backup the real first line (will be blank when lastline is set) forceIncludeFromRoot$ = "" IF vWatchOn THEN addingvWatch = 1 IF firstLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch.bi" IF lastLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch.bm" ELSE 'IF firstLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch_stub.bi" IF lastLine <> 0 THEN forceIncludeFromRoot$ = "internal\support\vwatch\vwatch_stub.bm" END IF firstLine = 0: lastLine = 0 IF LEN(forceIncludeFromRoot$) THEN GOTO forceInclude forceIncludeCompleted: addingvWatch = 0 a3$ = lineBackup$ END IF prepass = 0 stringprocessinghappened = 0 IF continuelinefrom THEN start = continuelinefrom continuelinefrom = 0 GOTO contline END IF 'begin a new line impliedendif = 0 THENGOTO = 0 continueline = 0 endifs = 0 lineelseused = 0 newif = 0 'apply metacommands from previous line IF addmetadynamic = 1 THEN addmetadynamic = 0: DynamicMode = 1 IF addmetastatic = 1 THEN addmetastatic = 0: DynamicMode = 0 'a3$ is passed in idemode and when using $include IF idemode = 0 AND inclevel = 0 THEN a3$ = lineinput3$ IF a3$ = CHR$(13) THEN EXIT DO linenumber = linenumber + 1 reallinenumber = reallinenumber + 1 IF InValidLine(linenumber) THEN layoutok = 1 layout$ = SPACE$(controllevel + 1) + LTRIM$(RTRIM$(a3$)) IF idemode GOTO ideret4 ELSE GOTO skipide4 END IF layout = "" layoutok = 1 IF idemode = 0 AND NOT QuietMode THEN 'IF LEN(a3$) THEN ' dotlinecount = dotlinecount + 1: IF dotlinecount >= 100 THEN dotlinecount = 0: PRINT "."; 'END IF maxprogresswidth = 50 'arbitrary percentage = INT(reallinenumber / totallinenumber * 100) percentagechars = INT(maxprogresswidth * reallinenumber / totallinenumber) IF percentage <> prevpercentage AND percentagechars <> prevpercentagechars THEN prevpercentage = percentage prevpercentagechars = percentagechars IF ConsoleMode THEN PRINT "[" + STRING$(percentagechars, ".") + SPACE$(maxprogresswidth - percentagechars) + "]" + STR$(percentage) + "%"; IF os$ = "LNX" THEN PRINT CHR$(27) + "[A" ELSE PRINT CHR$(13); END IF ELSE LOCATE , 1 PRINT STRING$(percentagechars, 219) + STRING$(maxprogresswidth - percentagechars, 176) + STR$(percentage) + "%"; END IF END IF END IF a3$ = LTRIM$(RTRIM$(a3$)) wholeline = a3$ layoutoriginal$ = a3$ layoutcomment$ = "" 'clear any previous layout comment lhscontrollevel = controllevel linefragment = "[INFORMATION UNAVAILABLE]" IF LEN(a3$) = 0 THEN GOTO finishednonexec IF Debug THEN PRINT #9, "########" + a3$ + "########" layoutdone = 1 'validates layout of any following goto finishednonexec/finishedline 'We've already figured out in the prepass which lines are invalidated by the precompiler 'No need to go over those lines again. 'IF InValidLine(linenumber) THEN goto skipide4 'layoutdone = 0: GOTO finishednonexec a3u$ = UCASE$(a3$) 'QB64 Metacommands IF ASC(a3$) = 36 THEN '$ 'precompiler commands should always be executed FIRST. IF a3u$ = "$END IF" OR a3u$ = "$ENDIF" THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$END IF without $IF": GOTO errmes DefineElse(ExecCounter) = 0 'We no longer have an $IF block at this level ExecCounter = ExecCounter - 1 layout$ = SCase$("$End If") controltype(controllevel) = 0 controllevel = controllevel - 1 GOTO finishednonexec END IF IF LEFT$(a3u$, 4) = "$IF " THEN 'prevents code from being placed before 'CASE condition' in a SELECT CASE block IF SelectCaseCounter > 0 AND SelectCaseHasCaseBlock(SelectCaseCounter) = 0 THEN a$ = "Expected CASE expression": GOTO errmes END IF temp$ = LTRIM$(MID$(a3u$, 4)) 'strip off the $IF and extra spaces temp$ = RTRIM$(LEFT$(temp$, LEN(temp$) - 4)) 'and strip off the THEN and extra spaces temp = 0 IF temp = 0 THEN tempOp$ = "<=": temp = INSTR(temp$, tempOp$) IF temp = 0 THEN tempOp$ = "=<": temp = INSTR(temp$, tempOp$): tempOp$ = "<=" IF temp = 0 THEN tempOp$ = ">=": temp = INSTR(temp$, tempOp$) IF temp = 0 THEN tempOp$ = "=>": temp = INSTR(temp$, tempOp$): tempOp$ = ">=" IF temp = 0 THEN tempOp$ = "<>": temp = INSTR(temp$, tempOp$) IF temp = 0 THEN tempOp$ = "><": temp = INSTR(temp$, tempOp$): tempOp$ = "<>" IF temp = 0 THEN tempOp$ = "=": temp = INSTR(temp$, tempOp$) IF temp = 0 THEN tempOp$ = ">": temp = INSTR(temp$, tempOp$) IF temp = 0 THEN tempOp$ = "<": temp = INSTR(temp$, tempOp$) ExecCounter = ExecCounter + 1 ExecLevel(ExecCounter) = -1 'default to a skip value DefineElse(ExecCounter) = 1 '1 says we have an $IF statement at this level result = EvalPreIF(temp$, a$) IF a$ <> "" THEN GOTO errmes IF result <> 0 THEN ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'So we inherit the execlevel from above IF ExecLevel(ExecCounter) = 0 THEN DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 4 'Else if used and conditon found END IF controllevel = controllevel + 1 controltype(controllevel) = 6 IF temp = 0 THEN layout$ = SCase$("$If ") + temp$ + SCase$(" Then"): GOTO finishednonexec 'no = sign in the $IF statement, so we're going to assume the user is doing something like $IF flag l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + LEN(tempOp$))) layout$ = SCase$("$If ") + l$ + " " + tempOp$ + " " + r$ + SCase$(" Then") GOTO finishednonexec END IF IF a3u$ = "$ELSE" THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$ELSE without $IF": GOTO errmes IF DefineElse(ExecCounter) AND 2 THEN a$ = "$IF block already has $ELSE statement in it": GOTO errmes DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 2 'set the flag to declare an $ELSE already in this block IF DefineElse(ExecCounter) AND 4 THEN 'If we executed code in a previous IF or ELSE IF statement, we can't do it here ExecLevel(ExecCounter) = -1 'So we inherit the execlevel from above ELSE ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'If we were processing code before, code after this segment is going to be SKIPPED END IF layout$ = SCase$("$Else") lhscontrollevel = lhscontrollevel - 1 GOTO finishednonexec END IF IF LEFT$(a3u$, 5) = "$ELSE" THEN temp$ = LTRIM$(MID$(a3u$, 6)) IF LEFT$(temp$, 3) = "IF " THEN IF DefineElse(ExecCounter) = 0 THEN a$ = "$ELSE IF without $IF": GOTO errmes IF DefineElse(ExecCounter) AND 2 THEN a$ = "$ELSE IF cannot follow $ELSE": GOTO errmes IF RIGHT$(temp$, 5) <> " THEN" THEN a$ = "$ELSE IF without THEN": GOTO errmes temp$ = LTRIM$(MID$(temp$, 3)) 'strip off the IF and extra spaces temp$ = RTRIM$(LEFT$(temp$, LEN(temp$) - 4)) 'and strip off the THEN and extra spaces IF DefineElse(ExecCounter) AND 4 THEN 'If we executed code in a previous IF or ELSE IF statement, we can't do it here ExecLevel(ExecCounter) = -1 ELSE result = EvalPreIF(temp$, a$) IF a$ <> "" THEN GOTO errmes IF result <> 0 THEN ExecLevel(ExecCounter) = ExecLevel(ExecCounter - 1) 'So we inherit the execlevel from above IF ExecLevel(ExecCounter) = 0 THEN DefineElse(ExecCounter) = DefineElse(ExecCounter) OR 4 'Else if used and conditon found END IF END IF lhscontrollevel = lhscontrollevel - 1 temp = INSTR(temp$, "=") IF temp = 0 THEN layout$ = SCase$("$ElseIf ") + temp$ + SCase$(" Then"): GOTO finishednonexec 'no = sign in the $IF statement, so we're going to assume the user is doing something like $IF flag l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + 1)) layout$ = SCase$("$ElseIf ") + l$ + " = " + r$ + SCase$(" Then") GOTO finishednonexec END IF END IF IF ExecLevel(ExecCounter) THEN 'don't check for any more metacommands except the one's which worth with the precompiler layoutdone = 0 GOTO finishednonexec 'we don't check for anything inside lines that we've marked for skipping END IF IF LEFT$(a3u$, 5) = "$LET " THEN temp$ = a3u$ temp$ = LTRIM$(MID$(temp$, 5)) 'simply shorten our string to parse 'For starters, let's make certain that we have 3 elements to deal with temp = INSTR(temp$, "=") 'without an = in there, we can't get a value from the left and right side l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + 1)) layout$ = SCase$("$Let ") + l$ + " = " + r$ 'First look to see if we have an existing setting like this and if so, update it FOR i = 7 TO UserDefineCount 'UserDefineCount 1-7 are reserved for automatic OS/BIT detection & version IF UserDefine(0, i) = l$ THEN UserDefine(1, i) = r$: GOTO finishednonexec NEXT 'Otherwise create a new setting and set the initial value for it UserDefineCount = UserDefineCount + 1 IF UserDefineCount > UBOUND(UserDefine, 2) THEN REDIM _PRESERVE UserDefine(1, UBOUND(UserDefine, 2) + 10) 'Add another 10 elements to the array so it'll expand as the user adds to it END IF UserDefine(0, UserDefineCount) = l$ UserDefine(1, UserDefineCount) = r$ GOTO finishednonexec END IF IF a3u$ = "$COLOR:0" THEN layout$ = SCase$("$Color:0") IF qb64prefix_set THEN addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color0_noprefix.bi" ELSE addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color0.bi" END IF layoutdone = 1 GOTO finishednonexec END IF IF a3u$ = "$COLOR:32" THEN layout$ = SCase$("$Color:32") IF qb64prefix_set THEN addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color32_noprefix.bi" ELSE addmetainclude$ = getfilepath$(COMMAND$(0)) + "internal" + pathsep$ + "support" + pathsep$ + "color" + pathsep$ + "color32.bi" END IF layoutdone = 1 GOTO finishednonexec END IF IF a3u$ = "$NOPREFIX" THEN 'already set in prepass layout$ = SCase$("$NoPrefix") GOTO finishednonexec END IF IF a3u$ = "$VIRTUALKEYBOARD:ON" THEN 'Deprecated; does nothing. layout$ = SCase$("$VirtualKeyboard:On") addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Deprecated feature", "$VirtualKeyboard" GOTO finishednonexec END IF IF a3u$ = "$VIRTUALKEYBOARD:OFF" THEN 'Deprecated; does nothing. layout$ = SCase$("$VirtualKeyboard:Off") addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Deprecated feature", "$VirtualKeyboard" GOTO finishednonexec END IF IF a3u$ = "$DEBUG" THEN layout$ = SCase$("$Debug") IF NoIDEMode THEN addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "$Debug", "$Debug features only work from the IDE" END IF GOTO finishednonexec END IF IF a3u$ = "$CHECKING:OFF" THEN layout$ = SCase$("$Checking:Off") NoChecks = 1 IF vWatchOn <> 0 AND NoIDEMode = 0 AND inclevel = 0 THEN addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "$Debug", "$Debug features won't work in $Checking:Off blocks" END IF GOTO finishednonexec END IF IF a3u$ = "$CHECKING:ON" THEN layout$ = SCase$("$Checking:On") NoChecks = 0 GOTO finishednonexec END IF IF a3u$ = "$CONSOLE" THEN layout$ = SCase$("$Console") Console = 1 GOTO finishednonexec END IF IF a3u$ = "$CONSOLE:ONLY" THEN layout$ = SCase$("$Console:Only") DEPENDENCY(DEPENDENCY_CONSOLE_ONLY) = DEPENDENCY(DEPENDENCY_CONSOLE_ONLY) OR 1 Console = 1 IF prepass = 0 THEN IF NoChecks = 0 THEN WriteBufLine MainTxtBuf, "do{" WriteBufLine MainTxtBuf, "sub__dest(func__console());" WriteBufLine MainTxtBuf, "sub__source(func__console());" GOTO finishedline2 ELSE GOTO finishednonexec END IF END IF IF a3u$ = "$ASSERTS" THEN layout$ = SCase$("$Asserts") Asserts = 1 GOTO finishednonexec END IF IF a3u$ = "$ASSERTS:CONSOLE" THEN layout$ = SCase$("$Asserts:Console") Asserts = 1 Console = 1 GOTO finishednonexec END IF IF a3u$ = "$SCREENHIDE" THEN layout$ = SCase$("$ScreenHide") ScreenHide = 1 GOTO finishednonexec END IF IF a3u$ = "$SCREENSHOW" THEN layout$ = SCase$("$ScreenShow") ScreenHide = 0 GOTO finishednonexec END IF IF a3u$ = "$RESIZE:OFF" THEN layout$ = SCase$("$Resize:Off") Resize = 0: Resize_Scale = 0 GOTO finishednonexec END IF IF a3u$ = "$RESIZE:ON" THEN layout$ = SCase$("$Resize:On") Resize = 1: Resize_Scale = 0 GOTO finishednonexec END IF IF a3u$ = "$RESIZE:STRETCH" THEN layout$ = SCase$("$Resize:Stretch") Resize = 1: Resize_Scale = 1 GOTO finishednonexec END IF IF a3u$ = "$RESIZE:SMOOTH" THEN layout$ = SCase$("$Resize:Smooth") Resize = 1: Resize_Scale = 2 GOTO finishednonexec END IF IF LEFT$(a3u$, 12) = "$VERSIONINFO" THEN 'Embed version info into the final binary (Windows only) FirstDelimiter = INSTR(a3u$, ":") SecondDelimiter = INSTR(FirstDelimiter + 1, a3u$, "=") IF FirstDelimiter = 0 OR SecondDelimiter = 0 OR SecondDelimiter = FirstDelimiter + 1 THEN a$ = "Expected $VERSIONINFO:key=value": GOTO errmes END IF VersionInfoKey$ = LTRIM$(RTRIM$(MID$(a3u$, FirstDelimiter + 1, SecondDelimiter - FirstDelimiter - 1))) VersionInfoValue$ = StrReplace$(LTRIM$(RTRIM$(MID$(a3$, SecondDelimiter + 1))), CHR$(34), "'") SELECT CASE VersionInfoKey$ CASE "FILEVERSION#" GOSUB ValidateVersion viFileVersionNum$ = VersionInfoValue$ IF viFileVersion$ = "" THEN viFileVersion$ = viFileVersionNum$ layout$ = SCase$("$VersionInfo:FILEVERSION#=") + VersionInfoValue$ CASE "PRODUCTVERSION#" GOSUB ValidateVersion viProductVersionNum$ = VersionInfoValue$ IF viProductVersion$ = "" THEN viProductVersion$ = viProductVersionNum$ layout$ = SCase$("$VersionInfo:PRODUCTVERSION#=") + VersionInfoValue$ CASE "COMPANYNAME" viCompanyName$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "CompanyName=" + VersionInfoValue$ CASE "FILEDESCRIPTION" viFileDescription$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "FileDescription=" + VersionInfoValue$ CASE "FILEVERSION" viFileVersion$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "FileVersion=" + VersionInfoValue$ CASE "INTERNALNAME" viInternalName$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "InternalName=" + VersionInfoValue$ CASE "LEGALCOPYRIGHT" viLegalCopyright$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "LegalCopyright=" + VersionInfoValue$ CASE "LEGALTRADEMARKS" viLegalTrademarks$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "LegalTrademarks=" + VersionInfoValue$ CASE "ORIGINALFILENAME" viOriginalFilename$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "OriginalFilename=" + VersionInfoValue$ CASE "PRODUCTNAME" viProductName$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "ProductName=" + VersionInfoValue$ CASE "PRODUCTVERSION" viProductVersion$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "ProductVersion=" + VersionInfoValue$ CASE "COMMENTS" viComments$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "Comments=" + VersionInfoValue$ CASE "WEB" viWeb$ = VersionInfoValue$ layout$ = SCase$("$VersionInfo:") + "Web=" + VersionInfoValue$ CASE ELSE a$ = "Invalid key. (Use FILEVERSION#, PRODUCTVERSION#, CompanyName, FileDescription, FileVersion, InternalName, LegalCopyright, LegalTrademarks, OriginalFilename, ProductName, ProductVersion, Comments or Web)" GOTO errmes END SELECT VersionInfoSet = -1 GOTO finishednonexec ValidateVersion: 'Check if only numbers and commas (4 comma-separated values) IF LEN(VersionInfoValue$) = 0 THEN a$ = "Expected $VERSIONINFO:" + VersionInfoKey$ + "=#,#,#,# (4 comma-separated numeric values: major, minor, revision and build)": GOTO errmes viCommas = 0 FOR i = 1 TO LEN(VersionInfoValue$) IF ASC(VersionInfoValue$, i) = 44 THEN viCommas = viCommas + 1 IF INSTR("0123456789,", MID$(VersionInfoValue$, i, 1)) = 0 OR (i = LEN(VersionInfoValue$) AND viCommas <> 3) OR RIGHT$(VersionInfoValue$, 1) = "," THEN a$ = "Expected $VERSIONINFO:" + VersionInfoKey$ + "=#,#,#,# (4 comma-separated numeric values: major, minor, revision and build)": GOTO errmes END IF NEXT RETURN END IF IF LEFT$(a3u$, 8) = "$EXEICON" THEN 'Basic syntax check. Multi-platform. IF ExeIconSet THEN a$ = "$EXEICON already defined": GOTO errmes FirstDelimiter = INSTR(a3u$, "'") IF FirstDelimiter = 0 THEN a$ = "Expected $EXEICON:'filename'": GOTO errmes ELSE SecondDelimiter = INSTR(FirstDelimiter + 1, a3u$, "'") IF SecondDelimiter = 0 THEN a$ = "Expected $EXEICON:'filename'": GOTO errmes END IF ExeIconFile$ = RTRIM$(LTRIM$(MID$(a3$, FirstDelimiter + 1, SecondDelimiter - FirstDelimiter - 1))) IF LEN(ExeIconFile$) = 0 THEN a$ = "Expected $EXEICON:'filename'": GOTO errmes layout$ = SCase$("$ExeIcon:'") + ExeIconFile$ + "'" + MID$(a3$, SecondDelimiter + 1) IconPath$ = "" IF LEFT$(ExeIconFile$, 2) = "./" OR LEFT$(ExeIconFile$, 2) = ".\" THEN 'Relative to source file's folder IF NoIDEMode THEN IconPath$ = path.source$ IF LEN(IconPath$) > 0 AND RIGHT$(IconPath$, 1) <> pathsep$ THEN IconPath$ = IconPath$ + pathsep$ ELSE IF LEN(ideprogname) THEN IconPath$ = idepath$ + pathsep$ END IF ExeIconFile$ = IconPath$ + MID$(ExeIconFile$, 3) ELSEIF INSTR(ExeIconFile$, "/") OR INSTR(ExeIconFile$, "\") THEN FOR i = LEN(ExeIconFile$) TO 1 STEP -1 IF MID$(ExeIconFile$, i, 1) = "/" OR MID$(ExeIconFile$, i, 1) = "\" THEN IconPath$ = LEFT$(ExeIconFile$, i) ExeIconFileOnly$ = MID$(ExeIconFile$, i + 1) IF _DIREXISTS(IconPath$) = 0 THEN a$ = "File '" + ExeIconFileOnly$ + "' not found": GOTO errmes currentdir$ = _CWD$ CHDIR IconPath$ IconPath$ = _CWD$ CHDIR currentdir$ ExeIconFile$ = IconPath$ + pathsep$ + ExeIconFileOnly$ EXIT FOR END IF NEXT END IF IF _FILEEXISTS(ExeIconFile$) = 0 THEN a$ = "File '" + ExeIconFile$ + "' not found": GOTO errmes ExeIconSet = linenumber SetDependency DEPENDENCY_ICON IF NoChecks = 0 THEN WriteBufLine MainTxtBuf, "do{" WriteBufLine MainTxtBuf, "sub__icon(NULL,NULL,0);" GOTO finishedline2 END IF IF LEFT$(a3u$, 10) = "$UNSTABLE:" THEN layout$ = SCase("$Unstable:") token$ = LTRIM$(RTRIM$(MID$(a3u$, 11))) SELECT CASE token$ CASE "MIDI" layout$ = layout$ + SCase$("Midi") CASE "HTTP" layout$ = layout$ + SCase$("Http") END SELECT GOTO finishednonexec END IF IF unstableFlags(UNSTABLE_MIDI) THEN IF LEFT$(a3u$, 15) = "$MIDISOUNDFONT:" THEN IF MidiSoundFontSet THEN a$ = "$MIDISOUNDFONT already defined" GOTO errmes END IF layout$ = SCase$("$MidiSoundFont:") MidiSoundFont$ = LTRIM$(RTRIM$(MID$(a3$, 16))) IF MID$(MidiSoundFont$, 1, 1) = CHR$(34) THEN ' We have a quoted filename, verify it is valid ' We don't touch the filename in the formatting layout$ = layout$ + MidiSoundFont$ ' Strip the leading quote MidiSoundFont$ = MID$(MidiSoundFont$, 2) ' Verify that there is a quote character at the end IF INSTR(MidiSoundFont$, CHR$(34)) = 0 THEN a$ = "Expected " + CHR$(34) + " character at the end of the file name": GOTO errmes ' Verify there are no extra characters after end quote IF INSTR(MidiSoundFont$, CHR$(34)) <> LEN(MidiSoundFont$) THEN a$ = "Unexpected characters after the quoted file name": GOTO errmes MidiSoundFont$ = MID$(MidiSoundFont$, 1, LEN(MidiSoundFont$) - 1) IF NOT _FILEEXISTS(MidiSoundFont$) THEN a$ = "Soundfont file " + AddQuotes$(MidiSoundFont$) + " could not be found!" GOTO errmes END IF ELSE ' Constant values, only one for now SELECT CASE UCASE$(MidiSoundFont$) CASE "DEFAULT" layout$ = layout$ + SCase$("Default") ' Clear MidiSoundFont$ to indicate the default should be used MidiSoundFont$ = "" CASE ELSE a$ = "Unrecognized Soundfont option " + AddQuotes$(MidiSoundFont$) GOTO errmes END SELECT END IF MidiSoundFontSet = linenumber MidiSoundFontLine$ = layout$ GOTO finishednonexec END IF END IF END IF 'QB64 Metacommands IF ExecLevel(ExecCounter) THEN layoutdone = 0 GOTO finishednonexec 'we don't check for anything inside lines that we've marked for skipping END IF linedataoffset = DataOffset entireline$ = lineformat(a3$): IF LEN(entireline$) = 0 THEN GOTO finishednonexec IF Error_Happened THEN GOTO errmes u$ = UCASE$(entireline$) newif = 0 'Convert "CASE ELSE" to "CASE C-EL" to avoid confusing compiler 'note: CASE does not have to begin on a new line s = 1 i = INSTR(s, u$, "CASE" + sp + "ELSE") DO WHILE i skip = 0 IF i <> 1 THEN IF MID$(u$, i - 1, 1) <> sp THEN skip = 1 END IF IF i <> LEN(u$) - 8 THEN IF MID$(u$, i + 9, 1) <> sp THEN skip = 1 END IF IF skip = 0 THEN MID$(entireline$, i) = "CASE" + sp + "C-EL" u$ = UCASE$(entireline$) END IF s = i + 9 i = INSTR(s, u$, "CASE" + sp + "ELSE") LOOP n = numelements(entireline$) 'line number? a = ASC(entireline$) IF (a >= 48 AND a <= 57) OR a = 46 THEN 'numeric label$ = getelement(entireline$, 1) IF validlabel(label$) THEN IF closedmain <> 0 AND subfunc = "" THEN a$ = "Labels cannot be placed between SUB/FUNCTIONs": GOTO errmes v = HashFind(label$, HASHFLAG_LABEL, ignore, r) addlabchk100: IF v THEN s = Labels(r).Scope IF s = subfuncn OR s = -1 THEN 'same scope? IF s = -1 THEN Labels(r).Scope = subfuncn 'acquire scope IF Labels(r).State = 1 THEN a$ = "Duplicate label (" + RTRIM$(Labels(r).cn) + ")": GOTO errmes 'aquire state 0 types tlayout$ = RTRIM$(Labels(r).cn) GOTO addlabaq100 END IF 'same scope IF v = 2 THEN v = HashFindCont(ignore, r): GOTO addlabchk100 END IF 'does not exist nLabels = nLabels + 1: IF nLabels > Labels_Ubound THEN Labels_Ubound = Labels_Ubound * 2: REDIM _PRESERVE Labels(1 TO Labels_Ubound) AS Label_Type Labels(nLabels) = Empty_Label HashAdd label$, HASHFLAG_LABEL, nLabels r = nLabels Labels(r).cn = tlayout$ Labels(r).Scope = subfuncn addlabaq100: Labels(r).State = 1 Labels(r).Data_Offset = linedataoffset layout$ = tlayout$ WriteBufLine MainTxtBuf, "LABEL_" + label$ + ":;" IF INSTR(label$, "p") THEN MID$(label$, INSTR(label$, "p"), 1) = "." IF RIGHT$(label$, 1) = "d" OR RIGHT$(label$, 1) = "s" THEN label$ = LEFT$(label$, LEN(label$) - 1) WriteBufLine MainTxtBuf, "last_line=" + label$ + ";" inclinenump$ = "" IF inclinenumber(inclevel) THEN inclinenump$ = "," + str2$(inclinenumber(inclevel)) thisincname$ = getfilepath$(incname$(inclevel)) thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) END IF IF NoChecks = 0 THEN IF vWatchOn AND inclinenumber(inclevel) = 0 THEN temp$ = vWatchErrorCall$ ELSE temp$ = "" WriteBufLine MainTxtBuf, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}" END IF IF n = 1 THEN GOTO finishednonexec entireline$ = getelements(entireline$, 2, n): u$ = UCASE$(entireline$): n = n - 1 'note: fall through, numeric labels can be followed by alphanumeric label END IF 'validlabel END IF 'numeric 'it wasn't a line number 'label? 'note: ignores possibility that this could be a single command SUB/FUNCTION (as in QBASIC?) IF n >= 2 THEN x2 = INSTR(entireline$, sp + ":") IF x2 THEN IF x2 = LEN(entireline$) - 1 THEN x3 = x2 + 1 ELSE x3 = x2 + 2 a$ = LEFT$(entireline$, x2 - 1) CreatingLabel = 1 IF validlabel(a$) THEN IF validname(a$) = 0 THEN a$ = "Invalid name": GOTO errmes IF closedmain <> 0 AND subfunc = "" THEN a$ = "Labels cannot be placed between SUB/FUNCTIONs": GOTO errmes v = HashFind(a$, HASHFLAG_LABEL, ignore, r) addlabchk: IF v THEN s = Labels(r).Scope IF s = subfuncn OR s = -1 THEN 'same scope? IF s = -1 THEN Labels(r).Scope = subfuncn 'acquire scope IF Labels(r).State = 1 THEN a$ = "Duplicate label (" + RTRIM$(Labels(r).cn) + ")": GOTO errmes 'aquire state 0 types tlayout$ = RTRIM$(Labels(r).cn) GOTO addlabaq END IF 'same scope IF v = 2 THEN v = HashFindCont(ignore, r): GOTO addlabchk END IF 'does not exist nLabels = nLabels + 1: IF nLabels > Labels_Ubound THEN Labels_Ubound = Labels_Ubound * 2: REDIM _PRESERVE Labels(1 TO Labels_Ubound) AS Label_Type Labels(nLabels) = Empty_Label HashAdd a$, HASHFLAG_LABEL, nLabels r = nLabels Labels(r).cn = tlayout$ Labels(r).Scope = subfuncn addlabaq: Labels(r).State = 1 Labels(r).Data_Offset = linedataoffset Labels(r).SourceLineNumber = linenumber IF LEN(layout$) THEN layout$ = layout$ + sp + tlayout$ + ":" ELSE layout$ = tlayout$ + ":" WriteBufLine MainTxtBuf, "LABEL_" + a$ + ":;" inclinenump$ = "" IF inclinenumber(inclevel) THEN inclinenump$ = "," + str2$(inclinenumber(inclevel)) thisincname$ = getfilepath$(incname$(inclevel)) thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) END IF IF NoChecks = 0 THEN IF vWatchOn AND inclinenumber(inclevel) = 0 THEN temp$ = vWatchErrorCall$ ELSE temp$ = "" WriteBufLine MainTxtBuf, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}" END IF entireline$ = RIGHT$(entireline$, LEN(entireline$) - x3): u$ = UCASE$(entireline$) n = numelements(entireline$): IF n = 0 THEN GOTO finishednonexec END IF 'valid END IF 'includes sp+":" END IF 'n>=2 'remove leading ":" DO WHILE ASC(u$) = 58 '":" IF LEN(layout$) THEN layout$ = layout$ + sp2 + ":" ELSE layout$ = ":" IF LEN(u$) = 1 THEN GOTO finishednonexec entireline$ = getelements(entireline$, 2, n): u$ = UCASE$(entireline$): n = n - 1 LOOP 'ELSE at the beginning of a line IF ASC(u$) = 69 THEN '"E" e1$ = getelement(u$, 1) IF e1$ = "ELSE" THEN a$ = "ELSE" IF n > 1 THEN continuelinefrom = 2 GOTO gotcommand END IF IF e1$ = "ELSEIF" THEN IF n < 3 THEN a$ = "Expected ... THEN": GOTO errmes IF getelement(u$, n) = "THEN" THEN a$ = entireline$: GOTO gotcommand FOR i = 3 TO n - 1 IF getelement(u$, i) = "THEN" THEN a$ = getelements(entireline$, 1, i) continuelinefrom = i + 1 GOTO gotcommand END IF NEXT a$ = "Expected THEN": GOTO errmes END IF END IF '"E" start = 1 GOTO skipcontinit contline: n = numelements(entireline$) u$ = UCASE$(entireline$) skipcontinit: 'jargon: 'lineelseused - counts how many line ELSEs can POSSIBLY follow 'endifs - how many C++ endifs "}" need to be added at the end of the line 'lineelseused - counts the number of indwelling ELSE statements on a line 'impliedendif - stops autoformat from adding "END IF" a$ = "" FOR i = start TO n e$ = getelement(u$, i) IF e$ = ":" THEN IF i = start THEN layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp2 + ":" ELSE layout$ = ":" IF i <> n THEN continuelinefrom = i + 1 GOTO finishednonexec END IF IF i <> n THEN continuelinefrom = i GOTO gotcommand END IF 'begin scanning an 'IF' statement IF e$ = "IF" AND a$ = "" THEN newif = 1 IF e$ = "THEN" OR (e$ = "GOTO" AND newif = 1) THEN IF newif = 0 THEN a$ = "THEN without IF": GOTO errmes newif = 0 IF lineelseused > 0 THEN lineelseused = lineelseused - 1 IF e$ = "GOTO" THEN IF i = n THEN a$ = "Expected IF expression GOTO label": GOTO errmes i = i - 1 END IF a$ = a$ + sp + e$ '+"THEN"/"GOTO" IF i <> n THEN continuelinefrom = i + 1: endifs = endifs + 1 GOTO gotcommand END IF IF e$ = "ELSE" THEN IF start = i THEN IF lineelseused >= 1 THEN 'note: more than one else used (in a row) on this line, so close first if with an 'END IF' first 'note: parses 'END IF' then (after continuelinefrom) parses 'ELSE' 'consider the following: (square brackets make reading easier) 'eg. if a=1 then [if b=2 then c=2 else d=2] else e=3 impliedendif = 1: a$ = "END" + sp + "IF" endifs = endifs - 1 continuelinefrom = i lineelseused = lineelseused - 1 GOTO gotcommand END IF 'follow up previously encountered 'ELSE' by applying 'ELSE' a$ = "ELSE": continuelinefrom = i + 1 lineelseused = lineelseused + 1 GOTO gotcommand END IF 'start=i 'apply everything up to (but not including) 'ELSE' continuelinefrom = i GOTO gotcommand END IF '"ELSE" e$ = getelement(entireline$, i): IF a$ = "" THEN a$ = e$ ELSE a$ = a$ + sp + e$ NEXT 'we're reached the end of the line IF endifs > 0 THEN endifs = endifs - 1 impliedendif = 1: entireline$ = entireline$ + sp + ":" + sp + "END" + sp + "IF": n = n + 3 i = i + 1 'skip the ":" (i is now equal to n+2) continuelinefrom = i GOTO gotcommand END IF gotcommand: dynscope = 0 ca$ = a$ a$ = eleucase$(ca$) '***REVISE THIS SECTION LATER*** layoutdone = 0 linefragment = a$ IF Debug THEN PRINT #9, a$ n = numelements(a$) IF n = 0 THEN GOTO finishednonexec 'convert non-UDT dimensioned periods to _046_ IF INSTR(ca$, sp + "." + sp) THEN a3$ = getelement(ca$, 1) except = 0 aa$ = a3$ + sp 'rebuilt a$ (always has a trailing spacer) lastfuse = -1 FOR x = 2 TO n a2$ = getelement(ca$, x) IF except = 1 THEN except = 2: GOTO udtperiod 'skip element name IF a2$ = "." AND x <> n THEN IF except = 2 THEN except = 1: GOTO udtperiod 'sub-element of UDT IF a3$ = ")" THEN 'assume it was something like typevar(???).x and treat as a UDT except = 1 GOTO udtperiod END IF 'find an ID of that type try = findid(UCASE$(a3$)) IF Error_Happened THEN GOTO errmes DO WHILE try IF ((id.t AND ISUDT) <> 0) OR ((id.arraytype AND ISUDT) <> 0) THEN except = 1 GOTO udtperiod END IF IF try = 2 THEN findanotherid = 1: try = findid(UCASE$(a3$)) ELSE try = 0 IF Error_Happened THEN GOTO errmes LOOP 'not a udt; fuse lhs & rhs with _046_ IF isalpha(ASC(a3$)) = 0 AND lastfuse <> x - 2 THEN a$ = "Invalid '.'": GOTO errmes aa$ = LEFT$(aa$, LEN(aa$) - 1) + fix046$ lastfuse = x GOTO periodfused END IF '"." except = 0 udtperiod: aa$ = aa$ + a2$ + sp periodfused: a3$ = a2$ NEXT a$ = LEFT$(aa$, LEN(aa$) - 1) ca$ = a$ a$ = eleucase$(ca$) n = numelements(a$) END IF arrayprocessinghappened = 0 firstelement$ = getelement(a$, 1) secondelement$ = getelement(a$, 2) thirdelement$ = getelement(a$, 3) 'non-executable section IF n = 1 THEN IF firstelement$ = "'" THEN layoutdone = 1: GOTO finishednonexec 'nop END IF IF n <= 2 THEN IF firstelement$ = "DATA" THEN l$ = SCase$("Data") IF n = 2 THEN e$ = SPACE$((LEN(secondelement$) - 1) \ 2) FOR x = 1 TO LEN(e$) v1 = ASC(secondelement$, x * 2) v2 = ASC(secondelement$, x * 2 + 1) IF v1 < 65 THEN v1 = v1 - 48 ELSE v1 = v1 - 55 IF v2 < 65 THEN v2 = v2 - 48 ELSE v2 = v2 - 55 ASC(e$, x) = v1 + v2 * 16 NEXT l$ = l$ + sp + e$ END IF 'n=2 layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ GOTO finishednonexec END IF END IF 'declare library IF declaringlibrary THEN IF firstelement$ = "END" THEN IF n <> 2 OR secondelement$ <> "DECLARE" THEN a$ = "Expected END DECLARE": GOTO errmes declaringlibrary = 0 l$ = SCase$("End" + sp + "Declare") layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ GOTO finishednonexec END IF 'end declare declaringlibrary = 2 IF firstelement$ = "SUB" OR firstelement$ = "FUNCTION" THEN GOTO declaresubfunc2 END IF a$ = "Expected SUB/FUNCTION definition or END DECLARE": GOTO errmes END IF 'declaringlibrary 'check TYPE declarations (created on prepass) IF definingtype THEN IF firstelement$ = "END" THEN IF n <> 2 OR secondelement$ <> "TYPE" THEN a$ = "Expected END TYPE": GOTO errmes definingtype = 0 l$ = SCase$("End" + sp + "Type") layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ GOTO finishednonexec END IF 'IF n < 3 THEN definingtypeerror = linenumber: a$ = "Expected element-name AS type or AS type element-list": GOTO errmes IF n < 3 THEN a$ = "Expected element-name AS type or AS type element-list": GOTO errmes definingtype = 2 IF firstelement$ = "AS" THEN l$ = SCase$("As") t$ = "" wordsInTypeName = 0 DO nextElement$ = getelement$(a$, 2 + wordsInTypeName) IF nextElement$ = "," THEN 'element-list wordsInTypeName = wordsInTypeName - 2 EXIT DO END IF wordsInTypeName = wordsInTypeName + 1 IF wordsInTypeName = n - 2 THEN 'single element in line wordsInTypeName = wordsInTypeName - 1 EXIT DO END IF LOOP t$ = getelements$(a$, 2, 2 + wordsInTypeName) typ = typname2typ(t$) IF Error_Happened THEN GOTO errmes IF typ = 0 THEN a$ = "Undefined type": GOTO errmes IF typ AND ISUDT THEN IF UCASE$(RTRIM$(t$)) = "MEM" AND RTRIM$(udtxcname(typ AND 511)) = "_MEM" AND qb64prefix_set = 1 THEN t$ = MID$(RTRIM$(udtxcname(typ AND 511)), 2) ELSE t$ = RTRIM$(udtxcname(typ AND 511)) END IF l$ = l$ + sp + t$ ELSE l$ = l$ + sp + SCase2$(t$) END IF 'Now add each variable: FOR i = 3 + wordsInTypeName TO n thisElement$ = getelement$(ca$, i) IF thisElement$ = "," THEN l$ = l$ + thisElement$ ELSE l$ = l$ + sp + thisElement$ END IF NEXT layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ ELSE l$ = getelement(ca$, 1) + sp + SCase$("As") t$ = getelements$(a$, 3, n) typ = typname2typ(t$) IF Error_Happened THEN GOTO errmes IF typ = 0 THEN a$ = "Undefined type": GOTO errmes IF typ AND ISUDT THEN IF UCASE$(RTRIM$(t$)) = "MEM" AND RTRIM$(udtxcname(typ AND 511)) = "_MEM" AND qb64prefix_set = 1 THEN t$ = MID$(RTRIM$(udtxcname(typ AND 511)), 2) ELSE t$ = RTRIM$(udtxcname(typ AND 511)) END IF l$ = l$ + sp + t$ ELSE l$ = l$ + sp + SCase2$(t$) END IF layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ END IF GOTO finishednonexec END IF 'defining type IF firstelement$ = "TYPE" THEN IF n <> 2 THEN a$ = "Expected TYPE type-name": GOTO errmes l$ = SCase$("Type") + sp + getelement(ca$, 2) layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ definingtype = 1 definingtypeerror = linenumber GOTO finishednonexec END IF 'skip DECLARE SUB/FUNCTION IF n >= 1 THEN IF firstelement$ = "DECLARE" THEN IF secondelement$ = "LIBRARY" OR secondelement$ = "DYNAMIC" OR secondelement$ = "CUSTOMTYPE" OR secondelement$ = "STATIC" THEN declaringlibrary = 1 dynamiclibrary = 0 customtypelibrary = 0 indirectlibrary = 0 staticlinkedlibrary = 0 x = 3 l$ = SCase$("Declare" + sp + "Library") IF secondelement$ = "DYNAMIC" THEN e$ = getelement$(a$, 3): IF e$ <> "LIBRARY" THEN a$ = "Expected DYNAMIC LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes dynamiclibrary = 1 x = 4 l$ = SCase$("Declare" + sp + "Dynamic" + sp + "Library") IF n = 3 THEN a$ = "Expected DECLARE DYNAMIC LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes indirectlibrary = 1 END IF IF secondelement$ = "CUSTOMTYPE" THEN e$ = getelement$(a$, 3): IF e$ <> "LIBRARY" THEN a$ = "Expected CUSTOMTYPE LIBRARY": GOTO errmes customtypelibrary = 1 x = 4 l$ = SCase$("Declare" + sp + "CustomType" + sp + "Library") indirectlibrary = 1 END IF IF secondelement$ = "STATIC" THEN e$ = getelement$(a$, 3): IF e$ <> "LIBRARY" THEN a$ = "Expected STATIC LIBRARY": GOTO errmes x = 4 l$ = SCase$("Declare" + sp + "Static" + sp + "Library") staticlinkedlibrary = 1 END IF sfdeclare = 0: sfheader = 0 IF n >= x THEN sfdeclare = 1 addlibrary: libname$ = "" headername$ = "" 'assume library name in double quotes follows 'assume library is in main qb64pe folder x$ = getelement$(ca$, x) IF ASC(x$) <> 34 THEN a$ = "Expected LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes x$ = RIGHT$(x$, LEN(x$) - 1) z = INSTR(x$, CHR$(34)) IF z = 0 THEN a$ = "Expected LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes x$ = LEFT$(x$, z - 1) IF dynamiclibrary <> 0 AND LEN(x$) = 0 THEN a$ = "Expected DECLARE DYNAMIC LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes IF customtypelibrary <> 0 AND LEN(x$) = 0 THEN a$ = "Expected DECLARE CUSTOMTYPE LIBRARY " + CHR$(34) + "..." + CHR$(34): GOTO errmes 'convert '\\' to '\' WHILE INSTR(x$, "\\") z = INSTR(x$, "\\") x$ = LEFT$(x$, z - 1) + RIGHT$(x$, LEN(x$) - z) WEND autoformat_x$ = x$ 'used for autolayout purposes 'Remove version number from library name 'Eg. libname:1.0 becomes libname <-> 1.0 which later becomes libname.so.1.0 v$ = "" striplibver: FOR z = LEN(x$) TO 1 STEP -1 a = ASC(x$, z) IF a = ASC_BACKSLASH OR a = ASC_FORWARDSLASH THEN EXIT FOR IF a = ASC_FULLSTOP OR a = ASC_COLON THEN IF isuinteger(RIGHT$(x$, LEN(x$) - z)) THEN IF LEN(v$) THEN v$ = RIGHT$(x$, LEN(x$) - z) + "." + v$ ELSE v$ = RIGHT$(x$, LEN(x$) - z) x$ = LEFT$(x$, z - 1) IF a = ASC_COLON THEN EXIT FOR GOTO striplibver ELSE EXIT FOR END IF END IF NEXT libver$ = v$ IF os$ = "WIN" THEN 'convert forward-slashes to back-slashes DO WHILE INSTR(x$, "/") z = INSTR(x$, "/") x$ = LEFT$(x$, z - 1) + "\" + RIGHT$(x$, LEN(x$) - z) LOOP END IF IF os$ = "LNX" THEN 'convert any back-slashes to forward-slashes DO WHILE INSTR(x$, "\") z = INSTR(x$, "\") x$ = LEFT$(x$, z - 1) + "/" + RIGHT$(x$, LEN(x$) - z) LOOP END IF 'Separate path from name libpath$ = "" FOR z = LEN(x$) TO 1 STEP -1 a = ASC(x$, z) IF a = 47 OR a = 92 THEN '\ or / libpath$ = LEFT$(x$, z) x$ = RIGHT$(x$, LEN(x$) - z) EXIT FOR END IF NEXT 'Accept ./ and .\ as a reference to the source file 'folder, replacing it with the actual full path, if available IF libpath$ = "./" OR libpath$ = ".\" THEN libpath$ = "" IF NoIDEMode THEN libpath$ = path.source$ IF LEN(libpath$) > 0 AND RIGHT$(libpath$, 1) <> pathsep$ THEN libpath$ = libpath$ + pathsep$ ELSE IF LEN(ideprogname) THEN libpath$ = idepath$ + pathsep$ END IF END IF 'Create a path which can be used for inline code (uses \\ instead of \) libpath_inline$ = "" FOR z = 1 TO LEN(libpath$) a = ASC(libpath$, z) libpath_inline$ = libpath_inline$ + CHR$(a) IF a = 92 THEN libpath_inline$ = libpath_inline$ + "\" NEXT IF LEN(x$) THEN IF dynamiclibrary = 0 THEN 'Static library IF os$ = "WIN" THEN 'check for .lib IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + x$ + ".lib") THEN libname$ = libpath$ + x$ + ".lib" inlinelibname$ = libpath_inline$ + x$ + ".lib" END IF END IF 'check for .a IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + x$ + ".a") THEN libname$ = libpath$ + x$ + ".a" inlinelibname$ = libpath_inline$ + x$ + ".a" END IF END IF 'check for .o IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + x$ + ".o") THEN libname$ = libpath$ + x$ + ".o" inlinelibname$ = libpath_inline$ + x$ + ".o" END IF END IF 'check for .lib IF LEN(libname$) = 0 THEN IF _FILEEXISTS(x$ + ".lib") THEN libname$ = x$ + ".lib" inlinelibname$ = x$ + ".lib" END IF END IF 'check for .a IF LEN(libname$) = 0 THEN IF _FILEEXISTS(x$ + ".a") THEN libname$ = x$ + ".a" inlinelibname$ = x$ + ".a" END IF END IF 'check for .o IF LEN(libname$) = 0 THEN IF _FILEEXISTS(x$ + ".o") THEN libname$ = x$ + ".o" inlinelibname$ = x$ + ".o" END IF END IF END IF 'Windows IF os$ = "LNX" THEN IF staticlinkedlibrary = 0 THEN IF MacOSX THEN 'dylib support 'check for .dylib (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = libpath$ + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = libpath_inline$ + "lib" + x$ + "." + libver$ + ".dylib" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath " + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".dylib") THEN libname$ = libpath$ + "lib" + x$ + ".dylib" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".dylib" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath " + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF END IF 'check for .so (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = libpath_inline$ + "lib" + x$ + ".so." + libver$ IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath " + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".so") THEN libname$ = libpath$ + "lib" + x$ + ".so" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".so" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath " + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF END IF 'check for .a (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".a") THEN libname$ = libpath$ + "lib" + x$ + ".a" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".a" END IF END IF 'check for .o (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".o") THEN libname$ = libpath$ + "lib" + x$ + ".o" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".o" END IF END IF IF staticlinkedlibrary = 0 THEN 'check for .so (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib64/" + libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib64/" + libpath_inline$ + "lib" + x$ + ".so." + libver$ IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + libpath$ + "lib" + x$ + ".so") THEN libname$ = "/usr/lib64/" + libpath$ + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib64/" + libpath_inline$ + "lib" + x$ + ".so" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/ " END IF END IF END IF 'check for .a (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + libpath$ + "lib" + x$ + ".a") THEN libname$ = "/usr/lib64/" + libpath$ + "lib" + x$ + ".a" inlinelibname$ = "/usr/lib64/" + libpath_inline$ + "lib" + x$ + ".a" END IF END IF IF staticlinkedlibrary = 0 THEN IF MacOSX THEN 'dylib support 'check for .dylib (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + "." + libver$ + ".dylib" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".dylib") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".dylib" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".dylib" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF END IF 'check for .so (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".so." + libver$ IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".so") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".so" IF LEN(libpath$) THEN mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/" + libpath$ + " " ELSE mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF END IF 'check for .a (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".a") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".a" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".a" END IF END IF '--------------------------(without path)------------------------------ IF staticlinkedlibrary = 0 THEN IF MacOSX THEN 'dylib support 'check for .dylib (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "lib" + x$ + "." + libver$ + ".dylib" mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".dylib") THEN libname$ = "lib" + x$ + ".dylib" inlinelibname$ = "lib" + x$ + ".dylib" mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF END IF 'check for .so (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".so." + libver$) THEN libname$ = "lib" + x$ + ".so." + libver$ inlinelibname$ = "lib" + x$ + ".so." + libver$ mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".so") THEN libname$ = "lib" + x$ + ".so" inlinelibname$ = "lib" + x$ + ".so" mylibopt$ = mylibopt$ + " -Wl,-rpath ./ " END IF END IF END IF 'check for .a (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".a") THEN libname$ = "lib" + x$ + ".a" inlinelibname$ = "lib" + x$ + ".a" END IF END IF 'check for .o (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".o") THEN libname$ = "lib" + x$ + ".o" inlinelibname$ = "lib" + x$ + ".o" END IF END IF IF staticlinkedlibrary = 0 THEN 'check for .so (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib64/" + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib64/" + "lib" + x$ + ".so." + libver$ mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/ " END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + "lib" + x$ + ".so") THEN libname$ = "/usr/lib64/" + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib64/" + "lib" + x$ + ".so" mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib64/ " END IF END IF END IF 'check for .a (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + "lib" + x$ + ".a") THEN libname$ = "/usr/lib64/" + "lib" + x$ + ".a" inlinelibname$ = "/usr/lib64/" + "lib" + x$ + ".a" END IF END IF IF staticlinkedlibrary = 0 THEN IF MacOSX THEN 'dylib support 'check for .dylib (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib" END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".dylib") THEN libname$ = "/usr/lib/" + "lib" + x$ + ".dylib" inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".dylib" mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF END IF 'check for .so (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib/" + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".so." + libver$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".so") THEN libname$ = "/usr/lib/" + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".so" mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF END IF 'check for .a (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".a") THEN libname$ = "/usr/lib/" + "lib" + x$ + ".a" inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".a" mylibopt$ = mylibopt$ + " -Wl,-rpath /usr/lib/ " END IF END IF END IF 'Linux 'check for header IF LEN(headername$) = 0 THEN IF os$ = "WIN" THEN IF _FILEEXISTS(libpath$ + x$ + ".h") THEN headername$ = libpath_inline$ + x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS(libpath$ + x$ + ".hpp") THEN headername$ = libpath_inline$ + x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF '--------------------------(without path)------------------------------ IF _FILEEXISTS(x$ + ".h") THEN headername$ = x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS(x$ + ".hpp") THEN headername$ = x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF END IF 'Windows IF os$ = "LNX" THEN IF _FILEEXISTS(libpath$ + x$ + ".h") THEN headername$ = libpath_inline$ + x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS(libpath$ + x$ + ".hpp") THEN headername$ = libpath_inline$ + x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS("/usr/include/" + libpath$ + x$ + ".h") THEN headername$ = "/usr/include/" + libpath_inline$ + x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS("/usr/include/" + libpath$ + x$ + ".hpp") THEN headername$ = "/usr/include/" + libpath_inline$ + x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF '--------------------------(without path)------------------------------ IF _FILEEXISTS(x$ + ".h") THEN headername$ = x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS(x$ + ".hpp") THEN headername$ = x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS("/usr/include/" + x$ + ".h") THEN headername$ = "/usr/include/" + x$ + ".h" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF IF _FILEEXISTS("/usr/include/" + x$ + ".hpp") THEN headername$ = "/usr/include/" + x$ + ".hpp" IF customtypelibrary = 0 THEN sfdeclare = 0 sfheader = 1 GOTO GotHeader END IF END IF 'Linux GotHeader: END IF ELSE 'dynamic library IF os$ = "WIN" THEN 'check for .dll (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + x$ + ".dll") THEN libname$ = libpath$ + x$ + ".dll" inlinelibname$ = libpath_inline$ + x$ + ".dll" END IF END IF 'check for .dll (system32) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(ENVIRON$("SYSTEMROOT") + "\System32\" + libpath$ + x$ + ".dll") THEN libname$ = libpath$ + x$ + ".dll" inlinelibname$ = libpath_inline$ + x$ + ".dll" END IF END IF '--------------------------(without path)------------------------------ 'check for .dll (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(x$ + ".dll") THEN libname$ = x$ + ".dll" inlinelibname$ = x$ + ".dll" END IF END IF 'check for .dll (system32) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(ENVIRON$("SYSTEMROOT") + "\System32\" + x$ + ".dll") THEN libname$ = x$ + ".dll" inlinelibname$ = x$ + ".dll" END IF END IF END IF 'Windows IF os$ = "LNX" THEN 'Note: STATIC libraries (.a/.o) cannot be loaded as dynamic objects IF MacOSX THEN 'dylib support 'check for .dylib (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = libpath$ + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = libpath_inline$ + "lib" + x$ + "." + libver$ + ".dylib" IF LEFT$(libpath$, 1) <> "/" THEN libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".dylib") THEN libname$ = libpath$ + "lib" + x$ + ".dylib" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".dylib" IF LEFT$(libpath$, 1) <> "/" THEN libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF END IF 'check for .so (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = libpath_inline$ + "lib" + x$ + ".so." + libver$ IF LEFT$(libpath$, 1) <> "/" THEN libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS(libpath$ + "lib" + x$ + ".so") THEN libname$ = libpath$ + "lib" + x$ + ".so" inlinelibname$ = libpath_inline$ + "lib" + x$ + ".so" IF LEFT$(libpath$, 1) <> "/" THEN libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF 'check for .so (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib64/" + libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib64/" + libpath_inline$ + "lib" + x$ + ".so." + libver$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + libpath$ + "lib" + x$ + ".so") THEN libname$ = "/usr/lib64/" + libpath$ + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib64/" + libpath_inline$ + "lib" + x$ + ".so" END IF END IF IF MacOSX THEN 'dylib support 'check for .dylib (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + "." + libver$ + ".dylib" END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".dylib") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".dylib" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".dylib" END IF END IF END IF 'check for .so (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".so." + libver$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + libpath$ + "lib" + x$ + ".so") THEN libname$ = "/usr/lib/" + libpath$ + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib/" + libpath_inline$ + "lib" + x$ + ".so" END IF END IF '--------------------------(without path)------------------------------ IF MacOSX THEN 'dylib support 'check for .dylib (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "lib" + x$ + "." + libver$ + ".dylib" libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".dylib") THEN libname$ = "lib" + x$ + ".dylib" inlinelibname$ = "lib" + x$ + ".dylib" libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF END IF 'check for .so (direct) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".so." + libver$) THEN libname$ = "lib" + x$ + ".so." + libver$ inlinelibname$ = "lib" + x$ + ".so." + libver$ libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("lib" + x$ + ".so") THEN libname$ = "lib" + x$ + ".so" inlinelibname$ = "lib" + x$ + ".so" libname$ = "./" + libname$: inlinelibname$ = "./" + inlinelibname$ END IF END IF 'check for .so (usr/lib64) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib64/" + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib64/" + "lib" + x$ + ".so." + libver$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib64/" + "lib" + x$ + ".so") THEN libname$ = "/usr/lib64/" + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib64/" + "lib" + x$ + ".so" END IF END IF IF MacOSX THEN 'dylib support 'check for .dylib (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib") THEN libname$ = "/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib" inlinelibname$ = "/usr/lib/" + "lib" + x$ + "." + libver$ + ".dylib" END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".dylib") THEN libname$ = "/usr/lib/" + "lib" + x$ + ".dylib" inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".dylib" END IF END IF END IF 'check for .so (usr/lib) IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".so." + libver$) THEN libname$ = "/usr/lib/" + "lib" + x$ + ".so." + libver$ inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".so." + libver$ END IF END IF IF LEN(libname$) = 0 THEN IF _FILEEXISTS("/usr/lib/" + "lib" + x$ + ".so") THEN libname$ = "/usr/lib/" + "lib" + x$ + ".so" inlinelibname$ = "/usr/lib/" + "lib" + x$ + ".so" END IF END IF END IF 'Linux END IF 'Dynamic 'library found? IF dynamiclibrary <> 0 AND LEN(libname$) = 0 THEN a$ = "DYNAMIC LIBRARY not found": GOTO errmes IF LEN(libname$) = 0 AND LEN(headername$) = 0 THEN a$ = "LIBRARY not found": GOTO errmes '***actual method should cull redundant header and library entries*** IF dynamiclibrary = 0 THEN 'static IF LEN(libname$) THEN IF os$ = "WIN" THEN IF MID$(libname$, 2, 1) = ":" OR LEFT$(libname$, 1) = "\" THEN mylib$ = mylib$ + " " + libname$ + " " ELSE mylib$ = mylib$ + " ..\..\" + libname$ + " " END IF END IF IF os$ = "LNX" THEN IF LEFT$(libname$, 1) = "/" THEN mylib$ = mylib$ + " " + libname$ + " " ELSE mylib$ = mylib$ + " ../../" + libname$ + " " END IF END IF END IF ELSE 'dynamic IF LEN(headername$) = 0 THEN 'no header IF subfuncn THEN f = OpenBuffer%("A", tmpdir$ + "maindata.txt") ELSE f = DataTxtBuf END IF 'make name a C-appropriate variable name 'by converting everything except numbers and 'letters to underscores x2$ = x$ FOR x2 = 1 TO LEN(x2$) IF ASC(x2$, x2) < 48 THEN ASC(x2$, x2) = 95 IF ASC(x2$, x2) > 57 AND ASC(x2$, x2) < 65 THEN ASC(x2$, x2) = 95 IF ASC(x2$, x2) > 90 AND ASC(x2$, x2) < 97 THEN ASC(x2$, x2) = 95 IF ASC(x2$, x2) > 122 THEN ASC(x2$, x2) = 95 NEXT DLLname$ = x2$ IF sfdeclare THEN IF os$ = "WIN" THEN WriteBufLine RegTxtBuf, "HINSTANCE DLL_" + x2$ + "=NULL;" WriteBufLine f, "if (!DLL_" + x2$ + "){" WriteBufLine f, "DLL_" + x2$ + "=LoadLibrary(" + CHR$(34) + inlinelibname$ + CHR$(34) + ");" WriteBufLine f, "if (!DLL_" + x2$ + ") error(259);" WriteBufLine f, "}" END IF IF os$ = "LNX" THEN WriteBufLine RegTxtBuf, "void *DLL_" + x2$ + "=NULL;" WriteBufLine f, "if (!DLL_" + x2$ + "){" WriteBufLine f, "DLL_" + x2$ + "=dlopen(" + CHR$(34) + inlinelibname$ + CHR$(34) + ",RTLD_LAZY);" WriteBufLine f, "if (!DLL_" + x2$ + ") error(259);" WriteBufLine f, "}" END IF END IF END IF 'no header END IF 'dynamiclibrary IF LEN(headername$) THEN IF (os$ = "WIN" AND (MID$(headername$, 2, 1) = ":" OR LEFT$(headername$, 1) = "\")) _ OR (os$ = "LNX" AND (LEFT$(headername$, 1) = "/")) THEN WriteBufLine RegTxtBuf, "#include " + CHR$(34) + headername$ + CHR$(34) ELSE WriteBufLine RegTxtBuf, "#include " + CHR$(34) + "../../" + headername$ + CHR$(34) END IF END IF END IF l$ = l$ + sp + CHR$(34) + autoformat_x$ + CHR$(34) IF n > x THEN IF dynamiclibrary THEN a$ = "Cannot specify multiple DYNAMIC LIBRARY names in a single DECLARE statement": GOTO errmes x = x + 1: x2$ = getelement$(a$, x): IF x2$ <> "," THEN a$ = "Expected ,": GOTO errmes l$ = l$ + sp2 + "," x = x + 1: IF x > n THEN a$ = "Expected , ...": GOTO errmes GOTO addlibrary END IF END IF 'n>=x layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$ GOTO finishednonexec END IF GOTO finishednonexec 'note: no layout required END IF END IF 'begin SUB/FUNCTION IF n >= 1 THEN dynamiclibrary = 0 declaresubfunc2: sf = 0 IF firstelement$ = "FUNCTION" THEN sf = 1 IF firstelement$ = "SUB" THEN sf = 2 IF sf THEN IF declaringlibrary = 0 THEN IF LEN(subfunc) THEN a$ = "Expected END SUB/FUNCTION before " + firstelement$: GOTO errmes END IF IF n = 1 THEN a$ = "Expected name after SUB/FUNCTION": GOTO errmes e$ = getelement$(ca$, 2) symbol$ = removesymbol$(e$) '$,%,etc. IF Error_Happened THEN GOTO errmes IF sf = 2 AND symbol$ <> "" THEN a$ = "Type symbols after a SUB name are invalid": GOTO errmes try = findid(e$) IF Error_Happened THEN GOTO errmes DO WHILE try IF id.subfunc = sf THEN GOTO createsf IF try = 2 THEN findanotherid = 1: try = findid(e$) ELSE try = 0 IF Error_Happened THEN GOTO errmes LOOP a$ = "Unregistered SUB/FUNCTION encountered": GOTO errmes createsf: IF UCASE$(e$) = "_GL" THEN e$ = "_GL" IF firstelement$ = "SUB" THEN l$ = SCase$("Sub") + sp + e$ + symbol$ ELSE l$ = SCase$("Function") + sp + e$ + symbol$ END IF id2 = id targetid = currentid 'check for ALIAS aliasname$ = RTRIM$(id.cn) IF n > 2 THEN ee$ = getelement$(a$, 3) IF ee$ = "ALIAS" THEN IF declaringlibrary = 0 THEN a$ = "ALIAS can only be used with DECLARE LIBRARY": GOTO errmes IF n = 3 THEN a$ = "Expected ALIAS name-in-library": GOTO errmes ee$ = getelement$(ca$, 4) 'strip string content (optional) IF LEFT$(ee$, 1) = CHR$(34) THEN ee$ = RIGHT$(ee$, LEN(ee$) - 1) x = INSTR(ee$, CHR$(34)): IF x = 0 THEN a$ = "Expected " + CHR$(34): GOTO errmes ee$ = LEFT$(ee$, x - 1) l$ = l$ + sp + SCase$("Alias") + sp + CHR_QUOTE + ee$ + CHR_QUOTE ELSE l$ = l$ + sp + SCase$("Alias") + sp + ee$ END IF 'strip fix046$ (created by unquoted periods) DO WHILE INSTR(ee$, fix046$) x = INSTR(ee$, fix046$): ee$ = LEFT$(ee$, x - 1) + "." + RIGHT$(ee$, LEN(ee$) - x + 1 - LEN(fix046$)) LOOP aliasname$ = ee$ 'remove ALIAS section from line IF n <= 4 THEN a$ = getelements(a$, 1, 2) IF n >= 5 THEN a$ = getelements(a$, 1, 2) + sp + getelements(a$, 5, n) IF n <= 4 THEN ca$ = getelements(ca$, 1, 2) IF n >= 5 THEN ca$ = getelements(ca$, 1, 2) + sp + getelements(ca$, 5, n) n = n - 2 END IF END IF IF declaringlibrary THEN GOTO declibjmp1 IF closedmain = 0 THEN closemain 'check for open controls (copy #2) IF controllevel <> 0 AND controltype(controllevel) <> 6 THEN 'It's OK for subs to be inside $IF blocks a$ = "Unidentified open control block" SELECT CASE controltype(controllevel) CASE 1: a$ = "IF without END IF" CASE 2: a$ = "FOR without NEXT" CASE 3, 4: a$ = "DO without LOOP" CASE 5: a$ = "WHILE without WEND" CASE 10 TO 19: a$ = "SELECT CASE without END SELECT" END SELECT linenumber = controlref(controllevel) GOTO errmes END IF IF ideindentsubs THEN controllevel = controllevel + 1 controltype(controllevel) = 32 controlref(controllevel) = linenumber END IF subfunc = RTRIM$(id.callname) 'SUB_..." IF id.subfunc = 1 THEN subfuncoriginalname$ = "FUNCTION " ELSE subfuncoriginalname$ = "SUB " subfuncoriginalname$ = subfuncoriginalname$ + RTRIM$(id.cn) subfuncn = subfuncn + 1 closedsubfunc = 0 subfuncid = targetid subfuncret$ = "" DataTxtBuf = OpenBuffer%("O", tmpdir$ + "data" + str2$(subfuncn) + ".txt") FreeTxtBuf = OpenBuffer%("O", tmpdir$ + "free" + str2$(subfuncn) + ".txt") RetTxtBuf = OpenBuffer%("O", tmpdir$ + "ret" + str2$(subfuncn) + ".txt") defdatahandle = DataTxtBuf WriteBufLine RetTxtBuf, "if (next_return_point){" WriteBufLine RetTxtBuf, "next_return_point--;" WriteBufLine RetTxtBuf, "switch(return_point[next_return_point]){" WriteBufLine RetTxtBuf, "case 0:" WriteBufLine RetTxtBuf, "error(3);" 'return without gosub! WriteBufLine RetTxtBuf, "break;" declibjmp1: IF declaringlibrary THEN IF sfdeclare = 0 AND indirectlibrary = 0 THEN RegTxtBuf = OpenBuffer%("O", tmpdir$ + "regsf_ignore.txt") END IF IF sfdeclare = 1 AND customtypelibrary = 0 AND dynamiclibrary = 0 AND indirectlibrary = 0 THEN WriteBufLine RegTxtBuf, "#include " + CHR$(34) + "externtype" + str2(ResolveStaticFunctions + 1) + ".txt" + CHR$(34) fh = FREEFILE: OPEN tmpdir$ + "externtype" + str2(ResolveStaticFunctions + 1) + ".txt" FOR OUTPUT AS #fh: CLOSE #fh END IF END IF IF sf = 1 THEN rettyp = id.ret t$ = typ2ctyp$(id.ret, "") IF Error_Happened THEN GOTO errmes IF t$ = "qbs" THEN t$ = "qbs*" IF declaringlibrary THEN IF rettyp AND ISSTRING THEN t$ = "char*" END IF END IF IF declaringlibrary <> 0 AND dynamiclibrary <> 0 THEN IF os$ = "WIN" THEN WriteBufRawData RegTxtBuf, "typedef " + t$ + " (CALLBACK* DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(" END IF IF os$ = "LNX" THEN WriteBufRawData RegTxtBuf, "typedef " + t$ + " (*DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(" END IF ELSEIF declaringlibrary <> 0 AND customtypelibrary <> 0 THEN WriteBufRawData RegTxtBuf, "typedef " + t$ + " CUSTOMCALL_" + removecast$(RTRIM$(id.callname)) + "(" ELSE WriteBufRawData RegTxtBuf, t$ + " " + removecast$(RTRIM$(id.callname)) + "(" END IF IF declaringlibrary THEN GOTO declibjmp2 WriteBufRawData MainTxtBuf, t$ + " " + removecast$(RTRIM$(id.callname)) + "(" 'create variable to return result 'if type wasn't specified, define it IF symbol$ = "" THEN a = ASC(UCASE$(e$)): IF a = 95 THEN a = 91 a = a - 64 'so A=1, Z=27 and _=28 symbol$ = defineextaz(a) END IF