$CONSOLE
$SCREENHIDE
'### STEVE WAS HERE 10/11/2013 ###
$RESIZE:ON
'### STEVE WAS HERE 10/17/2013 ###
REDIM SHARED OName(0) AS STRING 'Operation Name
REDIM SHARED PL(0) AS INTEGER 'Priority Level
REDIM SHARED vars(26) AS STRING ' 0 is previous answer, 1 - 26 is A - Z
DIM SHARED FileName AS STRING, DirName AS STRING
DIM SHARED QuickReturn AS INTEGER
DirName = "internal/MathEval/"
FileName = "internal/MathEval/Math Evaluator User Variables.bin"
Set_OrderOfOperations 'This will also make certain our directories are valid, and if not make them.
DIM SHARED AltSpecial AS _BYTE
'### END OF STEVE EDIT
'
'$DYNAMIC
DEFLNG A-Z
DIM SHARED MakeAndroid 'build an Android project (refer to SUB UseAndroid)
DIM SHARED AllowUpdates
DIM SHARED IDEBuildModeChanged
'refactor patch
DIM SHARED Refactor_Source AS STRING
DIM SHARED Refactor_Dest AS STRING
IF _FILEEXISTS("refactor.txt") THEN
fh = FREEFILE
OPEN "refactor.txt" FOR INPUT AS #fh
LINE INPUT #fh, Refactor_Source
LINE INPUT #fh, Refactor_Dest
CLOSE fh
END IF
IF _DIREXISTS("internal") = 0 THEN
_SCREENSHOW
PRINT "QB64 cannot locate the 'internal' folder"
PRINT
PRINT "Check that QB64 has been extracted properly."
PRINT "For MacOSX, launch 'qb64_start.command' or enter './qb64' in Terminal."
PRINT "For Linux, in the console enter './qb64'."
DO
_LIMIT 1
LOOP UNTIL INKEY$ <> ""
SYSTEM
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
DIM SHARED DEPENDENCY(1 TO DEPENDENCY_LAST)
DIM SHARED UseGL 'declared SUB _GL (no params)
DIM SHARED Version AS STRING
DIM SHARED C_Core AS LONG '0=SDL, 1=GLUT+OpenGL
DIM SHARED Debug AS LONG 'debug logging is off by default
Version$ = "0.990": Debug = 0: C_Core = 1
_TITLE "QB64"
'----------------ripgl.bas--------------------------------------------------------------------------------
TYPE GL_idstruct
cn AS STRING * 64 'case sensitive version of n
subfunc AS INTEGER 'if function=1, sub=2
callname AS STRING * 64
args AS INTEGER
arg AS STRING * 80 'similar to t
ret AS LONG 'the value it returns if it is a function (again like t)
END TYPE
REDIM SHARED GL_COMMANDS(2000) AS GL_idstruct
DIM SHARED GL_HELPER_CODE AS STRING
DIM SHARED GL_COMMANDS_LAST
REDIM SHARED GL_DEFINES(2000) AS STRING 'average ~600 entries
REDIM SHARED GL_DEFINES_VALUE(2000) AS _INTEGER64
DIM SHARED GL_DEFINES_LAST
DIM SHARED GL_KIT: GL_KIT = 0
'----------------ripgl.bas--------------------------------------------------------------------------------
DIM SHARED Cloud 'set by the -q switch for building a restricted QB64 QLOUD app
Cloud = 0
DIM SHARED OS_BITS AS LONG
OS_BITS = 64: IF INSTR(_OS$, "[32BIT]") THEN OS_BITS = 32
DIM SHARED command2$
command2$ = COMMAND$
DIM SHARED ConsoleMode
DIM SHARED No_C_Compile_Mode
a$ = LTRIM$(RTRIM$(command2$))
a2$ = LCASE$(LEFT$(a$, 2))
IF a2$ = "-q" THEN command2$ = "-x" + RIGHT$(a$, LEN(a$) - 2): Cloud = 1: a2$ = "-x"
IF a2$ = "-z" THEN command2$ = "-c" + RIGHT$(a$, LEN(a$) - 2): No_C_Compile_Mode = 1: ConsoleMode = 1
IF a2$ = "-x" THEN command2$ = "-c" + RIGHT$(a$, LEN(a$) - 2): ConsoleMode = 1
IF ConsoleMode THEN
_DEST _CONSOLE
ELSE
_CONSOLE OFF
_SCREENSHOW
_ICON
END IF
DIM SHARED NoChecks
DIM SHARED Console
DIM SHARED ScreenHide
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
_CONTROLCHR OFF
DIM SHARED IdeInfo AS STRING
'QB64 Help
DIM SHARED Cache_Folder AS STRING
Cache_Folder$ = "internal\help"
IF _DIREXISTS(Cache_Folder$) = 0 THEN MKDIR Cache_Folder$
DIM SHARED Help_sx, Help_sy, Help_cx, Help_cy
DIM SHARED Help_Select, Help_cx1, Help_cy1, Help_SelX1, Help_SelX2, Help_SelY1, Help_SelY2
DIM SHARED Help_MSelect
Help_sx = 1: Help_sy = 1: Help_cx = 1: Help_cy = 1
DIM SHARED Help_wx1, Help_wy1, Help_wx2, Help_wy2 'defines the text section of the help window on-screen
DIM SHARED Help_ww, Help_wh 'width & height of text region
DIM SHARED help_h, help_w 'width & height
DIM SHARED Help_Txt$ '[chr][col][link-byte1][link-byte2]
DIM SHARED Help_Txt_Len
DIM SHARED Help_Line$ 'index of first txt element of a line
DIM SHARED Help_Link$ 'the link info [sep][type:]...[sep]
DIM SHARED Help_Link_Sep$: Help_Link_Sep$ = CHR$(13)
DIM SHARED Help_LinkN
DIM SHARED Help_NewLineIndent
DIM SHARED Help_Underline
'Link Types:
' PAGE:wikipagename
DIM SHARED Help_Pos, Help_Wrap_Pos
DIM SHARED Help_BG_Col
DIM SHARED Help_Col_Normal: Help_Col_Normal = 7
DIM SHARED Help_Col_Link: Help_Col_Link = 9
DIM SHARED Help_Col_Bold: Help_Col_Bold = 15
DIM SHARED Help_Col_Italic: Help_Col_Italic = 15
DIM SHARED Help_Col_Section: Help_Col_Section = 8
DIM SHARED Help_Bold, Help_Italic
DIM SHARED Help_LockWrap
REDIM SHARED Help_LineLen(1)
REDIM SHARED Back$(1)
REDIM SHARED Back_Name$(1)
TYPE Help_Back_Type
sx AS LONG
sy AS LONG
cx AS LONG
cy AS LONG
END TYPE
REDIM SHARED Help_Back(1) AS Help_Back_Type
Back$(1) = "QB64 Help Menu"
Back_Name$(1) = Back2BackName$(Back$(1))
Help_Back(1).sx = 1: Help_Back(1).sy = 1: Help_Back(1).cx = 1: Help_Back(1).cy = 1
DIM SHARED Help_Back_Pos
Help_Back_Pos = 1
DIM SHARED Help_Search_Time AS DOUBLE
DIM SHARED Help_Search_Str AS STRING
DIM SHARED Help_PageLoaded AS STRING
DIM SHARED Help_Recaching, Help_IgnoreCache
DIM SHARED E
DIM SHARED IdeSystem AS LONG
'1=Entering text into the main IDE window
'2=Entering text into the quick search bar
'3=Scrolling within the help window
IdeSystem = 1
DIM SHARED IdeRecentLink(1 TO 4, 1 TO 2) AS STRING
DIM SHARED IdeOpenFile AS STRING 'makes IdeOpen directly open the file passed
TYPE IdeBmkType
y AS LONG 'the vertical line
x AS LONG 'the horizontal position to move cursor to
reserved AS LONG
reserved2 AS LONG
END TYPE
REDIM SHARED IdeBmk(1) AS IdeBmkType
DIM SHARED IdeBmkN
'GetInput global variables
DIM SHARED iCHECKLATER 'the values will be checked later
DIM SHARED iCHANGED
DIM SHARED mX, mY
DIM SHARED mB, mB2
DIM SHARED mOB, mOB2
DIM SHARED mCLICK, mCLICK2
DIM SHARED mRELEASE, mRELEASE2
DIM SHARED mWHEEL
DIM SHARED KB '_KEYHIT value (or 0)
DIM SHARED K$ 'INKEY$ equivalent of _KEYHIT's return (or "")
DIM SHARED KSTATECHANGED
DIM SHARED KSHIFT
DIM SHARED KCTRL 'the control key
DIM SHARED KCONTROL 'PC-CTRL or MAC-APPLE KEY
DIM SHARED KALT, KOALT, KALTPRESS, KALTRELEASE
CONST ASC_BACKSLASH = 92
CONST ASC_FORWARDSLASH = 47
CONST ASC_LEFTBRACKET = 40
CONST ASC_RIGHTBRACKET = 41
CONST ASC_FULLSTOP = 46
CONST ASC_COLON = 58
CONST ASC_SEMICOLON = 59
CONST ASC_UNDERSCORE = 95
CONST ASC_QUOTE = 34
CONST ASC_LEFTSQUAREBRACKET = 91
CONST ASC_RIGHTSQUAREBRACKET = 93
CONST ASC_QUESTIONMARK = 63
DIM SHARED CHR_QUOTE AS STRING: CHR_QUOTE = CHR$(34)
CONST KEY_LSHIFT = 100304
CONST KEY_RSHIFT = 100303
CONST KEY_LCTRL = 100306
CONST KEY_RCTRL = 100305
CONST KEY_LALT = 100308
CONST KEY_RALT = 100307
CONST KEY_LAPPLE = 100310
CONST KEY_RAPPLE = 100309
CONST KEY_F1 = 15104
CONST KEY_F2 = 15360
CONST KEY_F3 = 15616
CONST KEY_F4 = 15872
CONST KEY_F5 = 16128
CONST KEY_F6 = 16384
CONST KEY_F7 = 16640
CONST KEY_F8 = 16896
CONST KEY_F9 = 17152
CONST KEY_F10 = 17408
CONST KEY_F11 = 34048
CONST KEY_F12 = 34304
CONST KEY_INSERT = 20992
CONST KEY_DELETE = 21248
CONST KEY_HOME = 18176
CONST KEY_END = 20224
CONST KEY_PAGEUP = 18688
CONST KEY_PAGEDOWN = 20736
CONST KEY_LEFT = 19200
CONST KEY_RIGHT = 19712
CONST KEY_UP = 18432
CONST KEY_DOWN = 20480
CONST KEY_ESC = 27
CONST KEY_ENTER = 13
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 sp AS STRING * 1, sp2 AS STRING * 1, sp3 AS STRING * 1
sp = CHR$(13): sp2 = CHR$(10): sp3 = CHR$(26)
DIM SHARED sp_asc AS LONG, sp2_asc AS LONG, sp3_asc AS LONG
sp_asc = ASC(sp): sp2_asc = ASC(sp2): sp3_asc = ASC(sp3)
IF Debug THEN sp = CHR$(250): sp2 = CHR$(249): sp3 = "³" 'makes debug output more readable
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
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/"
DIM SHARED tempfolderindex
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
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
'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 INPUT 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 block_chr(255) AS INTEGER
block_chr(10) = 1
block_chr(13) = 1
DIM SHARED crlf AS STRING
crlf = CHR$(13) + CHR$(10)
DIM SHARED chr_tab AS STRING
chr_tab = CHR$(9)
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
'setup optional codepages
DIM SHARED idecpindex
CONST idecpnum& = 27
DIM SHARED idecpname(1 TO idecpnum) AS STRING
DIM SHARED idecp(1 TO idecpnum) AS STRING
'
idecpname$(1) = "micsft_pc_cp437"
idecp$(1) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E4000000E0000000E5000000E7000000EA000000EB000000E8000000EF000000EE000000EC000000C4000000C5000000C9000000E6000000C6000000F4000000F6000000F2000000FB000000F9000000FF000000D6000000DC000000A2000000A3000000A5000020A700000192000000E1000000ED000000F3000000FA000000F1000000D1000000AA000000BA000000BF00002310000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(2) = "micsft_pc_cp737"
idecp$(2) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F0000039100000392000003930000039400000395000003960000039700000398000003990000039A0000039B0000039C0000039D0000039E0000039F000003A0000003A1000003A3000003A4000003A5000003A6000003A7000003A8000003A9000003B1000003B2000003B3000003B4000003B5000003B6000003B7000003B8000003B9000003BA000003BB000003BC000003BD000003BE000003BF000003C0000003C1000003C3000003C2000003C4000003C5000003C6000003C7000003C80000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003C9000003AC000003AD000003AE000003CA000003AF000003CC000003CD000003CB000003CE0000038600000388000003890000038A0000038C0000038E0000038F000000B10000226500002264000003AA000003AB000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(3) = "micsft_pc_cp775"
idecp$(3) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F00000106000000FC000000E900000101000000E400000123000000E500000107000001420000011300000156000001570000012B00000179000000C4000000C5000000C9000000E6000000C60000014D000000F600000122000000A20000015A0000015B000000D6000000DC000000F8000000A3000000D8000000D7000000A4000001000000012A000000F30000017B0000017C0000017A0000201D000000A6000000A9000000AE000000AC000000BD000000BC00000141000000AB000000BB0000259100002592000025930000250200002524000001040000010C00000118000001160000256300002551000025570000255D0000012E000001600000251000002514000025340000252C0000251C000025000000253C000001720000016A0000255A00002554000025690000256600002560000025500000256C0000017D000001050000010D00000119000001170000012F00000161000001730000016B0000017E000025180000250C00002588000025840000258C0000259000002580000000D3000000DF0000014C00000143000000F5000000D5000000B50000014400000136000001370000013B0000013C00000146000001120000014500002019000000AD000000B10000201C000000BE000000B6000000A7000000F70000201E000000B000002219000000B7000000B9000000B3000000B2000025A0000000A0"
idecpname$(4) = "micsft_pc_cp850"
idecp$(4) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E4000000E0000000E5000000E7000000EA000000EB000000E8000000EF000000EE000000EC000000C4000000C5000000C9000000E6000000C6000000F4000000F6000000F2000000FB000000F9000000FF000000D6000000DC000000F8000000A3000000D8000000D700000192000000E1000000ED000000F3000000FA000000F1000000D1000000AA000000BA000000BF000000AE000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000000C1000000C2000000C0000000A90000256300002551000025570000255D000000A2000000A50000251000002514000025340000252C0000251C000025000000253C000000E3000000C30000255A00002554000025690000256600002560000025500000256C000000A4000000F0000000D0000000CA000000CB000000C800000131000000CD000000CE000000CF000025180000250C0000258800002584000000A6000000CC00002580000000D3000000DF000000D4000000D2000000F5000000D5000000B5000000FE000000DE000000DA000000DB000000D9000000FD000000DD000000AF000000B4000000AD000000B100002017000000BE000000B6000000A7000000F7000000B8000000B0000000A8000000B7000000B9000000B3000000B2000025A0000000A0"
idecpname$(5) = "micsft_pc_cp852"
idecp$(5) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E40000016F00000107000000E700000142000000EB0000015000000151000000EE00000179000000C400000106000000C9000001390000013A000000F4000000F60000013D0000013E0000015A0000015B000000D6000000DC000001640000016500000141000000D70000010D000000E1000000ED000000F3000000FA00000104000001050000017D0000017E0000011800000119000000AC0000017A0000010C0000015F000000AB000000BB0000259100002592000025930000250200002524000000C1000000C20000011A0000015E0000256300002551000025570000255D0000017B0000017C0000251000002514000025340000252C0000251C000025000000253C00000102000001030000255A00002554000025690000256600002560000025500000256C000000A400000111000001100000010E000000CB0000010F00000147000000CD000000CE0000011B000025180000250C0000258800002584000001620000016E00002580000000D3000000DF000000D4000001430000014400000148000001600000016100000154000000DA0000015500000170000000FD000000DD00000163000000B4000000AD000002DD000002DB000002C7000002D8000000A7000000F7000000B8000000B0000000A8000002D9000001710000015800000159000025A0000000A0"
idecpname$(6) = "micsft_pc_cp855"
idecp$(6) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F0000045200000402000004530000040300000451000004010000045400000404000004550000040500000456000004060000045700000407000004580000040800000459000004090000045A0000040A0000045B0000040B0000045C0000040C0000045E0000040E0000045F0000040F0000044E0000042E0000044A0000042A0000043000000410000004310000041100000446000004260000043400000414000004350000041500000444000004240000043300000413000000AB000000BB0000259100002592000025930000250200002524000004450000042500000438000004180000256300002551000025570000255D00000439000004190000251000002514000025340000252C0000251C000025000000253C0000043A0000041A0000255A00002554000025690000256600002560000025500000256C000000A40000043B0000041B0000043C0000041C0000043D0000041D0000043E0000041E0000043F000025180000250C00002588000025840000041F0000044F000025800000042F0000044000000420000004410000042100000442000004220000044300000423000004360000041600000432000004120000044C0000042C00002116000000AD0000044B0000042B000004370000041700000448000004280000044D0000042D00000449000004290000044700000427000000A7000025A0000000A0"
idecpname$(7) = "micsft_pc_cp857"
idecp$(7) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E4000000E0000000E5000000E7000000EA000000EB000000E8000000EF000000EE00000131000000C4000000C5000000C9000000E6000000C6000000F4000000F6000000F2000000FB000000F900000130000000D6000000DC000000F8000000A3000000D80000015E0000015F000000E1000000ED000000F3000000FA000000F1000000D10000011E0000011F000000BF000000AE000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000000C1000000C2000000C0000000A90000256300002551000025570000255D000000A2000000A50000251000002514000025340000252C0000251C000025000000253C000000E3000000C30000255A00002554000025690000256600002560000025500000256C000000A4000000BA000000AA000000CA000000CB000000C800000000000000CD000000CE000000CF000025180000250C0000258800002584000000A6000000CC00002580000000D3000000DF000000D4000000D2000000F5000000D5000000B500000000000000D7000000DA000000DB000000D9000000EC000000FF000000AF000000B4000000AD000000B100000000000000BE000000B6000000A7000000F7000000B8000000B0000000A8000000B7000000B9000000B3000000B2000025A0000000A0"
idecpname$(8) = "micsft_pc_cp860"
idecp$(8) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E3000000E0000000C1000000E7000000EA000000CA000000E8000000CD000000D4000000EC000000C3000000C2000000C9000000C0000000C8000000F4000000F5000000F2000000DA000000F9000000CC000000D5000000DC000000A2000000A3000000D9000020A7000000D3000000E1000000ED000000F3000000FA000000F1000000D1000000AA000000BA000000BF000000D2000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(9) = "micsft_pc_cp861"
idecp$(9) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E4000000E0000000E5000000E7000000EA000000EB000000E8000000D0000000F0000000DE000000C4000000C5000000C9000000E6000000C6000000F4000000F6000000FE000000FB000000DD000000FD000000D6000000DC000000F8000000A3000000D8000020A700000192000000E1000000ED000000F3000000FA000000C1000000CD000000D3000000DA000000BF00002310000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(10) = "micsft_pc_cp862"
idecp$(10) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000005D0000005D1000005D2000005D3000005D4000005D5000005D6000005D7000005D8000005D9000005DA000005DB000005DC000005DD000005DE000005DF000005E0000005E1000005E2000005E3000005E4000005E5000005E6000005E7000005E8000005E9000005EA000000A2000000A3000000A5000020A700000192000000E1000000ED000000F3000000FA000000F1000000D1000000AA000000BA000000BF00002310000000AC000000BD000000BC000000A1000000AB000000BB0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(11) = "micsft_pc_cp863"
idecp$(11) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000C2000000E0000000B6000000E7000000EA000000EB000000E8000000EF000000EE00002017000000C0000000A7000000C9000000C8000000CA000000F4000000CB000000CF000000FB000000F9000000A4000000D4000000DC000000A2000000A3000000D9000000DB00000192000000A6000000B4000000F3000000FA000000A8000000B8000000B3000000AF000000CE00002310000000AC000000BD000000BC000000BE000000AB000000BB0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(12) = "micsft_pc_cp864"
idecp$(12) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F00000020000000210000002200000023000000240000066A000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000B0000000B7000022190000221A0000259200002500000025020000253C000025240000252C0000251C00002534000025100000250C0000251400002518000003B20000221E000003C6000000B1000000BD000000BC00002248000000AB000000BB0000FEF70000FEF800000000000000000000FEFB0000FEFC00000000000000A0000000AD0000FE82000000A3000000A40000FE8400000000000000000000FE8E0000FE8F0000FE950000FE990000060C0000FE9D0000FEA10000FEA5000006600000066100000662000006630000066400000665000006660000066700000668000006690000FED10000061B0000FEB10000FEB50000FEB90000061F000000A20000FE800000FE810000FE830000FE850000FECA0000FE8B0000FE8D0000FE910000FE930000FE970000FE9B0000FE9F0000FEA30000FEA70000FEA90000FEAB0000FEAD0000FEAF0000FEB30000FEB70000FEBB0000FEBF0000FEC10000FEC50000FECB0000FECF000000A6000000AC000000F7000000D70000FEC9000006400000FED30000FED70000FEDB0000FEDF0000FEE30000FEE70000FEEB0000FEED0000FEEF0000FEF30000FEBD0000FECC0000FECE0000FECD0000FEE10000FE7D000006510000FEE50000FEE90000FEEC0000FEF00000FEF20000FED00000FED50000FEF50000FEF60000FEDD0000FED90000FEF1000025A000000000"
idecpname$(13) = "micsft_pc_cp865"
idecp$(13) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000000C7000000FC000000E9000000E2000000E4000000E0000000E5000000E7000000EA000000EB000000E8000000EF000000EE000000EC000000C4000000C5000000C9000000E6000000C6000000F4000000F6000000F2000000FB000000F9000000FF000000D6000000DC000000F8000000A3000000D8000020A700000192000000E1000000ED000000F3000000FA000000F1000000D1000000AA000000BA000000BF00002310000000AC000000BD000000BC000000A1000000AB000000A40000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
idecpname$(14) = "micsft_pc_cp866"
idecp$(14) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000004100000041100000412000004130000041400000415000004160000041700000418000004190000041A0000041B0000041C0000041D0000041E0000041F000004200000042100000422000004230000042400000425000004260000042700000428000004290000042A0000042B0000042C0000042D0000042E0000042F000004300000043100000432000004330000043400000435000004360000043700000438000004390000043A0000043B0000043C0000043D0000043E0000043F0000259100002592000025930000250200002524000025610000256200002556000025550000256300002551000025570000255D0000255C0000255B0000251000002514000025340000252C0000251C000025000000253C0000255E0000255F0000255A00002554000025690000256600002560000025500000256C00002567000025680000256400002565000025590000255800002552000025530000256B0000256A000025180000250C00002588000025840000258C0000259000002580000004400000044100000442000004430000044400000445000004460000044700000448000004490000044A0000044B0000044C0000044D0000044E0000044F0000040100000451000004040000045400000407000004570000040E0000045E000000B000002219000000B70000221A00002116000000A4000025A0000000A0"
idecpname$(15) = "micsft_pc_cp869"
idecp$(15) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F0000000000000000000000000000000000000000000000000000038600000000000000B7000000AC000000A600002018000020190000038800002015000003890000038A000003AA0000038C00000000000000000000038E000003AB000000A90000038F000000B2000000B3000003AC000000A3000003AD000003AE000003AF000003CA00000390000003CC000003CD00000391000003920000039300000394000003950000039600000397000000BD0000039800000399000000AB000000BB00002591000025920000259300002502000025240000039A0000039B0000039C0000039D0000256300002551000025570000255D0000039E0000039F0000251000002514000025340000252C0000251C000025000000253C000003A0000003A10000255A00002554000025690000256600002560000025500000256C000003A3000003A4000003A5000003A6000003A7000003A8000003A9000003B1000003B2000003B3000025180000250C0000258800002584000003B4000003B500002580000003B6000003B7000003B8000003B9000003BA000003BB000003BC000003BD000003BE000003BF000003C0000003C1000003C3000003C2000003C400000384000000AD000000B1000003C5000003C6000003C7000000A7000003C800000385000000B0000000A8000003C9000003CB000003B0000003CE000025A0000000A0"
idecpname$(16) = "micsft_pc_cp874"
idecp$(16) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC0000000000000000000000000000000000002026000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002018000020190000201C0000201D0000202200002013000020140000000000000000000000000000000000000000000000000000000000000000000000A000000E0100000E0200000E0300000E0400000E0500000E0600000E0700000E0800000E0900000E0A00000E0B00000E0C00000E0D00000E0E00000E0F00000E1000000E1100000E1200000E1300000E1400000E1500000E1600000E1700000E1800000E1900000E1A00000E1B00000E1C00000E1D00000E1E00000E1F00000E2000000E2100000E2200000E2300000E2400000E2500000E2600000E2700000E2800000E2900000E2A00000E2B00000E2C00000E2D00000E2E00000E2F00000E3000000E3100000E3200000E3300000E3400000E3500000E3600000E3700000E3800000E3900000E3A0000000000000000000000000000000000000E3F00000E4000000E4100000E4200000E4300000E4400000E4500000E4600000E4700000E4800000E4900000E4A00000E4B00000E4C00000E4D00000E4E00000E4F00000E5000000E5100000E5200000E5300000E5400000E5500000E5600000E5700000E5800000E5900000E5A00000E5B00000000000000000000000000000000"
idecpname$(17) = "micsft_windows_cp1250"
idecp$(17) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000000000000201E000020260000202000002021000000000000203000000160000020390000015A000001640000017D000001790000000000002018000020190000201C0000201D0000202200002013000020140000000000002122000001610000203A0000015B000001650000017E0000017A000000A0000002C7000002D800000141000000A400000104000000A6000000A7000000A8000000A90000015E000000AB000000AC000000AD000000AE0000017B000000B0000000B1000002DB00000142000000B4000000B5000000B6000000B7000000B8000001050000015F000000BB0000013D000002DD0000013E0000017C00000154000000C1000000C200000102000000C40000013900000106000000C70000010C000000C900000118000000CB0000011A000000CD000000CE0000010E000001100000014300000147000000D3000000D400000150000000D6000000D7000001580000016E000000DA00000170000000DC000000DD00000162000000DF00000155000000E1000000E200000103000000E40000013A00000107000000E70000010D000000E900000119000000EB0000011B000000ED000000EE0000010F000001110000014400000148000000F3000000F400000151000000F6000000F7000001590000016F000000FA00000171000000FC000000FD00000163000002D9"
idecpname$(18) = "micsft_windows_cp1251"
idecp$(18) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F00000402000004030000201A000004530000201E000020260000202000002021000020AC0000203000000409000020390000040A0000040C0000040B0000040F0000045200002018000020190000201C0000201D0000202200002013000020140000000000002122000004590000203A0000045A0000045C0000045B0000045F000000A00000040E0000045E00000408000000A400000490000000A6000000A700000401000000A900000404000000AB000000AC000000AD000000AE00000407000000B0000000B1000004060000045600000491000000B5000000B6000000B7000004510000211600000454000000BB00000458000004050000045500000457000004100000041100000412000004130000041400000415000004160000041700000418000004190000041A0000041B0000041C0000041D0000041E0000041F000004200000042100000422000004230000042400000425000004260000042700000428000004290000042A0000042B0000042C0000042D0000042E0000042F000004300000043100000432000004330000043400000435000004360000043700000438000004390000043A0000043B0000043C0000043D0000043E0000043F000004400000044100000442000004430000044400000445000004460000044700000448000004490000044A0000044B0000044C0000044D0000044E0000044F"
idecpname$(19) = "micsft_windows_cp1252"
idecp$(19) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000001920000201E000020260000202000002021000002C600002030000001600000203900000152000000000000017D000000000000000000002018000020190000201C0000201D000020220000201300002014000002DC00002122000001610000203A00000153000000000000017E00000178000000A0000000A1000000A2000000A3000000A4000000A5000000A6000000A7000000A8000000A9000000AA000000AB000000AC000000AD000000AE000000AF000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000B8000000B9000000BA000000BB000000BC000000BD000000BE000000BF000000C0000000C1000000C2000000C3000000C4000000C5000000C6000000C7000000C8000000C9000000CA000000CB000000CC000000CD000000CE000000CF000000D0000000D1000000D2000000D3000000D4000000D5000000D6000000D7000000D8000000D9000000DA000000DB000000DC000000DD000000DE000000DF000000E0000000E1000000E2000000E3000000E4000000E5000000E6000000E7000000E8000000E9000000EA000000EB000000EC000000ED000000EE000000EF000000F0000000F1000000F2000000F3000000F4000000F5000000F6000000F7000000F8000000F9000000FA000000FB000000FC000000FD000000FE000000FF"
idecpname$(20) = "micsft_windows_cp1253"
idecp$(20) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000001920000201E00002026000020200000202100000000000020300000000000002039000000000000000000000000000000000000000000002018000020190000201C0000201D0000202200002013000020140000000000002122000000000000203A00000000000000000000000000000000000000A00000038500000386000000A3000000A4000000A5000000A6000000A7000000A8000000A900000000000000AB000000AC000000AD000000AE00002015000000B0000000B1000000B2000000B300000384000000B5000000B6000000B700000388000003890000038A000000BB0000038C000000BD0000038E0000038F000003900000039100000392000003930000039400000395000003960000039700000398000003990000039A0000039B0000039C0000039D0000039E0000039F000003A0000003A100000000000003A3000003A4000003A5000003A6000003A7000003A8000003A9000003AA000003AB000003AC000003AD000003AE000003AF000003B0000003B1000003B2000003B3000003B4000003B5000003B6000003B7000003B8000003B9000003BA000003BB000003BC000003BD000003BE000003BF000003C0000003C1000003C2000003C3000003C4000003C5000003C6000003C7000003C8000003C9000003CA000003CB000003CC000003CD000003CE00000000"
idecpname$(21) = "micsft_windows_cp1254"
idecp$(21) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000001920000201E000020260000202000002021000002C6000020300000016000002039000001520000000000000000000000000000000000002018000020190000201C0000201D000020220000201300002014000002DC00002122000001610000203A00000153000000000000000000000178000000A0000000A1000000A2000000A3000000A4000000A5000000A6000000A7000000A8000000A9000000AA000000AB000000AC000000AD000000AE000000AF000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000B8000000B9000000BA000000BB000000BC000000BD000000BE000000BF000000C0000000C1000000C2000000C3000000C4000000C5000000C6000000C7000000C8000000C9000000CA000000CB000000CC000000CD000000CE000000CF0000011E000000D1000000D2000000D3000000D4000000D5000000D6000000D7000000D8000000D9000000DA000000DB000000DC000001300000015E000000DF000000E0000000E1000000E2000000E3000000E4000000E5000000E6000000E7000000E8000000E9000000EA000000EB000000EC000000ED000000EE000000EF0000011F000000F1000000F2000000F3000000F4000000F5000000F6000000F7000000F8000000F9000000FA000000FB000000FC000001310000015F000000FF"
idecpname$(22) = "micsft_windows_cp1255"
idecp$(22) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000001920000201E000020260000202000002021000002C6000020300000000000002039000000000000000000000000000000000000000000002018000020190000201C0000201D000020220000201300002014000002DC00002122000000000000203A00000000000000000000000000000000000000A0000000A1000000A2000000A3000020AA000000A5000000A6000000A7000000A8000000A9000000D7000000AB000000AC000000AD000000AE000000AF000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000B8000000B9000000F7000000BB000000BC000000BD000000BE000000BF000005B0000005B1000005B2000005B3000005B4000005B5000005B6000005B7000005B8000005B900000000000005BB000005BC000005BD000005BE000005BF000005C0000005C1000005C2000005C3000005F0000005F1000005F2000005F3000005F400000000000000000000000000000000000000000000000000000000000005D0000005D1000005D2000005D3000005D4000005D5000005D6000005D7000005D8000005D9000005DA000005DB000005DC000005DD000005DE000005DF000005E0000005E1000005E2000005E3000005E4000005E5000005E6000005E7000005E8000005E9000005EA00000000000000000000200E0000200F00000000"
idecpname$(23) = "micsft_windows_cp1256"
idecp$(23) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC0000067E0000201A000001920000201E000020260000202000002021000002C600002030000006790000203900000152000006860000069800000688000006AF00002018000020190000201C0000201D000020220000201300002014000006A900002122000006910000203A000001530000200C0000200D000006BA000000A00000060C000000A2000000A3000000A4000000A5000000A6000000A7000000A8000000A9000006BE000000AB000000AC000000AD000000AE000000AF000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000B8000000B90000061B000000BB000000BC000000BD000000BE0000061F000006C10000062100000622000006230000062400000625000006260000062700000628000006290000062A0000062B0000062C0000062D0000062E0000062F00000630000006310000063200000633000006340000063500000636000000D70000063700000638000006390000063A00000640000006410000064200000643000000E000000644000000E200000645000006460000064700000648000000E7000000E8000000E9000000EA000000EB000006490000064A000000EE000000EF0000064B0000064C0000064D0000064E000000F40000064F00000650000000F700000651000000F900000652000000FB000000FC0000200E0000200F000006D2"
idecpname$(24) = "micsft_windows_cp1257"
idecp$(24) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000000000000201E0000202600002020000020210000000000002030000000000000203900000000000000A8000002C7000000B80000000000002018000020190000201C0000201D0000202200002013000020140000000000002122000000000000203A00000000000000AF000002DB00000000000000A000000000000000A2000000A3000000A400000000000000A6000000A7000000D8000000A900000156000000AB000000AC000000AD000000AE000000C6000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000F8000000B900000157000000BB000000BC000000BD000000BE000000E6000001040000012E0000010000000106000000C4000000C500000118000001120000010C000000C9000001790000011600000122000001360000012A0000013B000001600000014300000145000000D30000014C000000D5000000D6000000D700000172000001410000015A0000016A000000DC0000017B0000017D000000DF000001050000012F0000010100000107000000E4000000E500000119000001130000010D000000E90000017A0000011700000123000001370000012B0000013C000001610000014400000146000000F30000014D000000F5000000F6000000F700000173000001420000015B0000016B000000FC0000017C0000017E000002D9"
idecpname$(25) = "micsft_windows_cp1258"
idecp$(25) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC000000000000201A000001920000201E000020260000202000002021000002C6000020300000000000002039000001520000000000000000000000000000000000002018000020190000201C0000201D000020220000201300002014000002DC00002122000000000000203A00000153000000000000000000000178000000A0000000A1000000A2000000A3000000A4000000A5000000A6000000A7000000A8000000A9000000AA000000AB000000AC000000AD000000AE000000AF000000B0000000B1000000B2000000B3000000B4000000B5000000B6000000B7000000B8000000B9000000BA000000BB000000BC000000BD000000BE000000BF000000C0000000C1000000C200000102000000C4000000C5000000C6000000C7000000C8000000C9000000CA000000CB00000300000000CD000000CE000000CF00000110000000D100000309000000D3000000D4000001A0000000D6000000D7000000D8000000D9000000DA000000DB000000DC000001AF00000303000000DF000000E0000000E1000000E200000103000000E4000000E5000000E6000000E7000000E8000000E9000000EA000000EB00000301000000ED000000EE000000EF00000111000000F100000323000000F3000000F4000001A1000000F6000000F7000000F8000000F9000000FA000000FB000000FC000001B0000020AB000000FF"
idecpname$(26) = "micsft_windows_cp874"
idecp$(26) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000020AC0000000000000000000000000000000000002026000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002018000020190000201C0000201D0000202200002013000020140000000000000000000000000000000000000000000000000000000000000000000000A000000E0100000E0200000E0300000E0400000E0500000E0600000E0700000E0800000E0900000E0A00000E0B00000E0C00000E0D00000E0E00000E0F00000E1000000E1100000E1200000E1300000E1400000E1500000E1600000E1700000E1800000E1900000E1A00000E1B00000E1C00000E1D00000E1E00000E1F00000E2000000E2100000E2200000E2300000E2400000E2500000E2600000E2700000E2800000E2900000E2A00000E2B00000E2C00000E2D00000E2E00000E2F00000E3000000E3100000E3200000E3300000E3400000E3500000E3600000E3700000E3800000E3900000E3A0000000000000000000000000000000000000E3F00000E4000000E4100000E4200000E4300000E4400000E4500000E4600000E4700000E4800000E4900000E4A00000E4B00000E4C00000E4D00000E4E00000E4F00000E5000000E5100000E5200000E5300000E5400000E5500000E5600000E5700000E5800000E5900000E5A00000E5B00000000000000000000000000000000"
idecpname$(27) = "MIK"
idecp$(27) = "000000000000000100000002000000030000000400000005000000060000000700000008000000090000000A0000000B0000000C0000000D0000000E0000000F000000100000001100000012000000130000001400000015000000160000001700000018000000190000001A0000001B0000001C0000001D0000001E0000001F000000200000002100000022000000230000002400000025000000260000002700000028000000290000002A0000002B0000002C0000002D0000002E0000002F000000300000003100000032000000330000003400000035000000360000003700000038000000390000003A0000003B0000003C0000003D0000003E0000003F000000400000004100000042000000430000004400000045000000460000004700000048000000490000004A0000004B0000004C0000004D0000004E0000004F000000500000005100000052000000530000005400000055000000560000005700000058000000590000005A0000005B0000005C0000005D0000005E0000005F000000600000006100000062000000630000006400000065000000660000006700000068000000690000006A0000006B0000006C0000006D0000006E0000006F000000700000007100000072000000730000007400000075000000760000007700000078000000790000007A0000007B0000007C0000007D0000007E0000007F000004100000041100000412000004130000041400000415000004160000041700000418000004190000041A0000041B0000041C0000041D0000041E0000041F000004200000042100000422000004230000042400000425000004260000042700000428000004290000042A0000042B0000042C0000042D0000042E0000042F000004300000043100000432000004330000043400000435000004360000043700000438000004390000043A0000043B0000043C0000043D0000043E0000043F000004400000044100000442000004430000044400000445000004460000044700000448000004490000044A0000044B0000044C0000044D0000044E0000044F00002514000025340000252C0000251C000025000000253C00002563000025510000255A00002554000025690000256600002560000025500000256C00002510000025910000259200002593000025020000252400002116000000A7000025570000255D000025180000250C00002588000025840000258C0000259000002580000003B1000000DF00000393000003C0000003A3000003C3000000B5000003C4000003A600000398000003A9000003B40000221E000003C6000003B50000222900002261000000B100002265000022640000232000002321000000F700002248000000B000002219000000B70000221A0000207F000000B2000025A0000000A0"
'######## update.bas: init ########
'data for managing multiple file downloading
CONST Maxdls = 1
DIM SHARED DLs AS LONG
TYPE Download_Type
State AS LONG
'-1=failed
'0=inactive
'1=connected and reading data
'2=finished!
Handle AS LONG
END TYPE
DIM SHARED DL(1 TO Maxdls) AS Download_Type
DIM SHARED DL_Data(1 TO Maxdls) AS STRING
DIM SHARED Download_String AS STRING
'compress/decompress shared variables
DIM SHARED huff_count(0 TO 255) AS LONG
DIM SHARED huff_weight(0 TO 1000) AS LONG
DIM SHARED huff_branch(0 TO 255) AS LONG
DIM SHARED huff_parent(0 TO 1000) AS LONG
DIM SHARED huff_bit(0 TO 1000) AS LONG
DIM SHARED huff_bit0link(0 TO 1000) AS LONG
DIM SHARED huff_bit1link(0 TO 1000) AS LONG
DIM SHARED huff_mask(32 * 8 * 256) AS _UNSIGNED _BYTE
DIM SHARED huff_mask_bytes(0 TO 7, 0 TO 255) AS LONG 'number of bytes in mask (at offset 0-7)
DIM SHARED huff_mask_bits(0 TO 255) AS LONG 'number of bits in mask
DIM SHARED huff_bitval(0 TO 7) AS LONG
huff_bitval(0) = 1: huff_bitval(1) = 2: huff_bitval(2) = 4: huff_bitval(3) = 8
huff_bitval(4) = 16: huff_bitval(5) = 32: huff_bitval(6) = 64: huff_bitval(7) = 128
DIM SHARED huff_branch0(1000) AS LONG
DIM SHARED huff_branch1(1000) AS LONG
'(end of compress/decompress shared variables)
REDIM SHARED chksums_name(1 TO 1) AS STRING
REDIM SHARED chksums_valstr(1 TO 1) AS STRING
DIM SHARED update_error
DIM SHARED UpdateHandle
GOTO skip_update_error_handler
update_error_handler:
update_error = 1
RESUME NEXT
skip_update_error_handler:
'compiler-side IDE data & definitions
DIM SHARED idecurrentlinelayout AS STRING
DIM SHARED idecurrentlinelayouti AS LONG
DIM SHARED idelayoutallow AS LONG
DIM SHARED idecommand AS STRING
DIM SHARED idereturn AS STRING
DIM SHARED ideerror AS LONG
DIM SHARED idecompiled AS LONG
DIM SHARED idemode
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
'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]
'IDE MODULE: shared data & definitions
DIM SHARED mousex AS INTEGER
DIM SHARED mousey AS INTEGER
DIM SHARED mousewheel AS INTEGER
DIM SHARED mousebutton1 AS INTEGER
DIM SHARED mousebutton2 AS INTEGER
DIM SHARED mousevisible AS INTEGER
DIM SHARED mousepassed AS INTEGER
'---------------------------------------------------
DIM SHARED idesubwindow, idehelp
DIM SHARED ideexit
DIM SHARED idet AS STRING, idel, ideli, iden
DIM SHARED ideundopos, ideundobase, ideundoflag
DIM SHARED idelaunched, idecompiling
DIM SHARED idecompiledline 'stores the number of the last line sent to the compiler, used only to know which line to send next
DIM SHARED idecompiledline$ 'stores the last line sent to the compiler
DIM SHARED idesx, idesy, idecx, idecy
DIM SHARED ideselect, ideselectx1, ideselecty1, idemouseselect, idembmonitor
DIM SHARED ideunsaved
DIM SHARED ideroot AS STRING
DIM SHARED idetxt(1000) AS STRING
DIM SHARED idetxtlast AS INTEGER
DIM SHARED idehl
DIM SHARED idealtcode(255) AS INTEGER
DIM SHARED ideprogname AS STRING
DIM SHARED idepath AS STRING
DIM SHARED idefindtext AS STRING
DIM SHARED idefindcasesens AS INTEGER
DIM SHARED idefindwholeword AS INTEGER
DIM SHARED idefindbackwards AS INTEGER
DIM SHARED idefindinvert AS INTEGER
DIM SHARED idechangeto AS STRING
DIM SHARED idechangemade AS INTEGER
DIM SHARED ideinsert AS INTEGER
DIM SHARED idepathsep AS STRING * 1
'--------------------------------------------------------------------------------
TYPE idedbptype
x AS LONG
y AS LONG
w AS LONG
h AS LONG
nam AS LONG
END TYPE
'--------------------------------------------------------------------------------
TYPE idedbotype
par AS idedbptype
x AS LONG
y AS LONG
w AS LONG
h AS LONG
typ AS LONG
nam AS LONG
txt AS LONG
dft AS LONG
cx AS LONG
cy AS LONG
foc AS LONG
sel AS LONG 'selected item no.
stx AS LONG 'selected item in string form
v1 AS LONG
num AS LONG
END TYPE
'--------------------------------------------------------------------------------
DIM SHARED idefocusline 'simply stores the location of the line to highlight in red
DIM SHARED ideautorun
DIM SHARED menu$(1 TO 10, 0 TO 20)
DIM SHARED menusize(1 TO 10)
DIM SHARED menus AS INTEGER
DIM SHARED menubar$
DIM SHARED ideundocombo, ideundocombochr, idenoundo, idemergeundo
DIM SHARED idealthighlight, ideentermenu
DIM SHARED ideautolayout, ideautoindent, ideautoindentsize, idebackupsize
DIM SHARED idewx, idewy, idecustomfont, idecustomfontfile$, idecustomfontheight, idecustomfonthandle
DIM SHARED iderunmode
'IDE MODULE SECTION END: shared data & definitions
'update settings
DIM SHARED ideupdatecheck, ideupdatedaily, ideupdateauto, ideupdatelast, idedebuginfo
DIM SHARED ideupdatetimerval AS SINGLE
DIM SHARED IdeAndroidMenu
DIM SHARED IdeAndroidStartScript AS STRING
DIM SHARED IdeAndroidMakeScript AS STRING
'ref: options.bin
'SEEK 1
'[2] ideautolayout(=1)
'[2] ideautoindent(=1)
'[2] ideautoindentsize(=4)
'SEEK 7
'[2] idewx(=80)
'[2] idewy(=25)
'[2] idecustomfont(=0)
'[1024]idecustomfontfile(=c:\windows\fonts\lucon.ttf)
'[2] idecustomfontheight(=21)
'SEEK 1039
'[2] ideupdatecheck(=1)
'[2] ideupdatedaily(=1)
'[2] ideupdateauto(=0)
'[4] ideupdatelast(=0)
'SEEK 1049
'[2] codepage(=0)
'SEEK 1051
'[4] backupsize(=100)
'SEEK 1055
'[2] embed debug info
'total bytes: 1056
OPEN ".\internal\temp\options.bin" FOR BINARY AS #150
'remake options with defaults?
IF LOF(150) < 1048 THEN
CLOSE #150
OPEN ".\internal\temp\options.bin" FOR OUTPUT AS #150: CLOSE #150
OPEN ".\internal\temp\options.bin" FOR BINARY AS #150
v% = 1: PUT #150, , v% 'layout
v% = 1: PUT #150, , v% 'indent
v% = 4: PUT #150, , v% 'indentsize
v% = 80: PUT #150, , v% 'w
v% = 25: PUT #150, , v% 'h
v% = 0: PUT #150, , v% 'use custom font?
v$ = SPACE$(1024): MID$(v$, 1) = "c:\windows\fonts\lucon.ttf": PUT #150, , v$
v% = 21: PUT #150, , v% 'custom font height
v% = 1: PUT #150, , v% 'update-check
v% = 1: PUT #150, , v% 'update-daily
v% = 0: PUT #150, , v% 'update-autoapply
ideupdatelast& = 0: PUT #150, , ideupdatelast& 'update-datestamp(last)
END IF
IF LOF(150) < 1050 THEN
SEEK #150, 1049
v% = 0: PUT #150, , v% 'codepage
END IF
IF LOF(150) < 1054 THEN
SEEK #150, 1051
v& = 100: PUT #150, , v& 'backup-size(mb)
END IF
IF LOF(150) < 1056 THEN
SEEK #150, 1055
v% = 0: PUT #150, , v% 'idedebuginfo
END IF
'@1056
IF LOF(150) < 1056 + 2 + 256 + 256 THEN
SEEK #150, 1057
v% = 0: PUT #150, , v% 'IdeAndroidMenu
a$ = "programs\android\start_android.bat"
a$ = a$ + SPACE$(256 - LEN(a$))
PUT #150, , a$ 'IdeAndroidStartScript
a$ = "programs\android\make_android.bat"
a$ = a$ + SPACE$(256 - LEN(a$))
PUT #150, , a$ 'IdeAndroidMakeScript
END IF
'load options
SEEK #150, 1
'layout:
GET #150, , v%: IF v% <> 0 THEN v% = 1
ideautolayout = v%
GET #150, , v%: IF v% <> 0 THEN v% = 1
ideautoindent = v%
GET #150, , v%: IF v% < 0 OR v% > 64 THEN v% = 4
ideautoindentsize = v%
'display:
GET #150, , v%: IF v% < 80 OR v% > 1000 THEN v% = 80
idewx = v%
GET #150, , v%: IF v% < 25 OR v% > 1000 THEN v% = 25
idewy = v%
GET #150, , v%: IF v% <> 0 THEN v% = 1
idecustomfont = v%
v$ = SPACE$(1024): GET #150, , v$: idecustomfontfile$ = RTRIM$(v$)
GET #150, , v%: IF v% < 8 OR v% > 100 THEN v% = 21
idecustomfontheight = v%
GET #150, , v%: IF v% < 0 OR v% > 1 THEN v% = 1
ideupdatecheck = v%
GET #150, , v%: IF v% < 0 OR v% > 1 THEN v% = 1
ideupdatedaily = v%
GET #150, , v%: IF v% < 0 OR v% > 1 THEN v% = 1
ideupdateauto = v%
GET #150, , v&
ideupdatelast = v&
GET #150, , v%: IF v% < 0 OR v% > idecpnum THEN v% = 0
idecpindex = v%
GET #150, , v&: IF v& < 10 OR v& > 2000 THEN v& = 100
idebackupsize = v&
GET #150, , v%: IF v% < 0 OR v% > 1 THEN v% = 0
idedebuginfo = v%
Include_GDB_Debugging_Info = idedebuginfo
GET #150, , v%: IF v% < 0 OR v% > 1 THEN v% = 0
IdeAndroidMenu = v%
a$ = SPACE$(256)
GET #150, , a$
a$ = RTRIM$(a$)
IdeAndroidStartScript = a$
a$ = SPACE$(256)
GET #150, , a$
a$ = RTRIM$(a$)
IdeAndroidMakeScript = a$
CLOSE #150
IF os$ = "WIN" AND AllowUpdates <> 0 THEN
'begin update check
IF ideupdatecheck THEN
a$ = DATE$: dateval = VAL(MID$(a$, 4, 2)) + VAL(MID$(a$, 1, 2)) * 32 + VAL(MID$(a$, 7, 4)) * 416 'create unique date value
IF ideupdatedaily = 0 OR dateval <> ideupdatelast THEN
'note: regardless of success or failure, daily checks are attempted once, so the 'last' value is updated here
ideupdatelast = dateval
OPEN ".\internal\temp\options.bin" FOR BINARY AS #150
IF LOF(150) >= 1048 THEN
SEEK #150, 1045
PUT #150, , ideupdatelast
END IF
CLOSE #150
'connect
UpdateHandle = BeginDownload("www.qb64.net/update2.txt")
ideupdatetimerval = TIMER
END IF 'update check required
END IF 'ideupdatecheck on
END IF 'win
'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)
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 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
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
args 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)
NoCloud AS INTEGER
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
DIM SHARED wholeline 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 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 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 56) AS _INTEGER64
DIM SHARED bitmaskinv(1 TO 56) 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 controllevel AS INTEGER '0=not in a control block
DIM 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)
'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)
DIM controlid(1000) AS LONG
DIM controlvalue(1000) AS LONG
DIM controlstate(1000) AS INTEGER
DIM controlref(1000) AS LONG 'the line number the control was created on
ON ERROR GOTO qberror
i2&& = 1
FOR i&& = 1 TO 56
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---------------------------------------
a$ = LTRIM$(RTRIM$(command2$))
a2$ = LCASE$(LEFT$(a$, 2))
IF a2$ = "-c" THEN command2$ = LTRIM$(RIGHT$(a$, LEN(a$) - 2)): GOTO noide
'assume command2$ contains the name of a file to load/compile
idemode = 1
sendc$ = "" 'no initial message
IF command2$ <> "" THEN sendc$ = CHR$(1) + command2$
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:
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:
sendc$ = CHR$(3) 'request next line
GOTO sendcommand
END IF
IF c = 5 THEN 'end of program reached
IF idepass = 1 THEN
'prepass complete
idepass = 2
GOTO ide3
ideret3:
sendc$ = CHR$(7) 'repass request
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$
i = 1
nextexeindex:
IF _FILEEXISTS(file$ + extension$) THEN
E = 0
ON ERROR GOTO qberror_test
KILL 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 MakeAndroid THEN
'generate program name
pf$ = "programs\android\" + file$
IF _DIREXISTS(pf$) = 0 THEN
'once only setup
COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window
LOCATE idewy - 3, 2: PRINT "Initializing project [programs\android\" + file$ + "]...";
PCOPY 3, 0
MKDIR pf$
SHELL _HIDE "cmd /c xcopy /e programs\android\project_template\*.* " + pf$
SHELL _HIDE "cmd /c xcopy /e programs\android\eclipse_template\*.* " + pf$
'modify templates
fr_fh = FREEFILE
OPEN pf$ + "\AndroidManifest.xml" FOR BINARY AS #fr_fh
a$ = SPACE$(LOF(fr_fh))
GET #fr_fh, , a$
CLOSE fr_fh
OPEN pf$ + "\AndroidManifest.xml" FOR OUTPUT AS #fr_fh
ss$ = CHR$(34) + "com.example.native_activity" + CHR$(34)
file_namespace$ = LCASE$(file$)
a = ASC(file_namespace$)
IF a >= 48 AND a <= 57 THEN file_namespace$ = "ns_" + file_namespace$
i = INSTR(a$, ss$)
a$ = LEFT$(a$, i - 1) + CHR$(34) + "com.example." + file_namespace$ + CHR$(34) + RIGHT$(a$, LEN(a$) - i - LEN(ss$) + 1)
PRINT #fr_fh, a$;
CLOSE fr_fh
fr_fh = FREEFILE
OPEN pf$ + "\res\values\strings.xml" FOR BINARY AS #fr_fh
a$ = SPACE$(LOF(fr_fh))
GET #fr_fh, , a$
CLOSE fr_fh
OPEN pf$ + "\res\values\strings.xml" FOR OUTPUT AS #fr_fh
ss$ = ">NativeActivity<"
i = INSTR(a$, ss$)
a$ = LEFT$(a$, i - 1) + ">" + file$ + "<" + RIGHT$(a$, LEN(a$) - i - LEN(ss$) + 1)
PRINT #fr_fh, a$;
CLOSE fr_fh
fr_fh = FREEFILE
OPEN pf$ + "\.project" FOR BINARY AS #fr_fh
a$ = SPACE$(LOF(fr_fh))
GET #fr_fh, , a$
CLOSE fr_fh
OPEN pf$ + "\.project" FOR OUTPUT AS #fr_fh
ss$ = "NativeActivity"
i = INSTR(a$, ss$)
a$ = LEFT$(a$, i - 1) + "" + file$ + "" + RIGHT$(a$, LEN(a$) - i - LEN(ss$) + 1)
PRINT #fr_fh, a$;
CLOSE fr_fh
IF _DIREXISTS(pf$ + "\jni\temp") = 0 THEN MKDIR pf$ + "\jni\temp"
IF _DIREXISTS(pf$ + "\jni\c") = 0 THEN MKDIR pf$ + "\jni\c"
'c
ex_fh = FREEFILE
OPEN "internal\temp\xcopy_exclude.txt" FOR OUTPUT AS #ex_fh
PRINT #ex_fh, "c_compiler\"
CLOSE ex_fh
SHELL _HIDE "cmd /c xcopy /e /EXCLUDE:internal\temp\xcopy_exclude.txt internal\c\*.* " + pf$ + "\jni\c"
ELSE
COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window
LOCATE idewy - 3, 2: PRINT "Updating project [programs\android\" + file$ + "]...";
PCOPY 3, 0
END IF
'temp
SHELL _HIDE "cmd /c del " + pf$ + "\jni\temp\*.txt"
SHELL _HIDE "cmd /c copy " + tmpdir$ + "*.txt " + pf$ + "\jni\temp"
'touch main.cpp (for ndk)
fr_fh = FREEFILE
OPEN pf$ + "\jni\main.cpp" FOR BINARY AS #fr_fh
a$ = SPACE$(LOF(fr_fh))
GET #fr_fh, , a$
CLOSE fr_fh
OPEN pf$ + "\jni\main.cpp" FOR OUTPUT AS #fr_fh
IF ASC(a$, LEN(a$)) <> 32 THEN a$ = a$ + " " ELSE a$ = LEFT$(a$, LEN(a$) - 1)
PRINT #fr_fh, a$;
CLOSE fr_fh
'note: .bat files affect the directory they are called from
CHDIR pf$
IF INSTR(IdeAndroidStartScript, ":") THEN
SHELL _HIDE IdeAndroidMakeScript
ELSE
SHELL _HIDE "..\..\..\" + IdeAndroidMakeScript
END IF
CHDIR "..\..\.."
''touch manifest (for Eclipse)
'fr_fh = FREEFILE
'OPEN pf$ + "\AndroidManifest.xml" FOR BINARY AS #fr_fh
'a$ = SPACE$(LOF(fr_fh))
'GET #fr_fh, , a$
'CLOSE fr_fh
'OPEN pf$ + "\AndroidManifest.xml" FOR OUTPUT AS #fr_fh
'IF ASC(a$, LEN(a$)) <> 32 THEN a$ = a$ + " " ELSE a$ = LEFT$(a$, LEN(a$) - 1)
'PRINT #fr_fh, a$;
'CLOSE fr_fh
'^^^^above inconsistent^^^^
'clear the gen folder (for Eclipse)
IF _DIREXISTS(pf$ + "\gen") THEN
SHELL _HIDE "cmd /c rmdir /s /q " + pf$ + "\gen"
SHELL _HIDE "cmd /c md " + pf$ + "\gen"
END IF
sendc$ = CHR$(11) '".EXE file created" aka "Android project created"
GOTO sendcommand
END IF
IF iderunmode = 2 THEN
sendc$ = CHR$(11) '.EXE file created
GOTO sendcommand
END IF
'hack! (a new message should be sent to the IDE stating C++ compilation was successful)
COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window
LOCATE idewy - 3, 2: PRINT "Starting program...";
PCOPY 3, 0
'execute program
IF iderunmode = 1 THEN
IF os$ = "WIN" THEN SHELL _DONTWAIT idezfilename$(CHR$(34) + file$ + extension$ + CHR$(34))
IF os$ = "LNX" THEN SHELL _DONTWAIT idezfilename$("./" + file$ + extension$)
ELSE
IF os$ = "WIN" THEN SHELL idezfilename$(CHR$(34) + file$ + extension$ + CHR$(34))
IF os$ = "LNX" THEN SHELL idezfilename$("./" + file$ + extension$)
END IF
sendc$ = CHR$(6) 'ready
GOTO sendcommand
END IF
PRINT "Invalid IDE message": END
ideerror:
sendc$ = CHR$(8) + idemessage$ + MKL$(ideerrorline)
GOTO sendcommand
noide:
PRINT "QB64 COMPILER V" + Version$
IF command2$ = "" THEN
LINE INPUT ; "COMPILE (.bas)>", f$
ELSE
f$ = command2$
END IF
f$ = LTRIM$(RTRIM$(f$))
IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas"
sourcefile$ = f$
'derive name from sourcefile
f$ = RemoveFileExtension$(f$)
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:
FOR i = 1 TO UBOUND(DEPENDENCY): DEPENDENCY(i) = 0: NEXT
Error_Happened = 0
FOR closeall = 1 TO 255: CLOSE closeall: NEXT
OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock
fh = FREEFILE: OPEN tmpdir$ + "dyninfo.txt" FOR OUTPUT AS #fh: CLOSE #fh
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
recompile:
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 "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 "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
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
addmetainclude$ = ""
nextrunlineindex = 1
lasttype = 0
lasttypeelement = 0
definingtype = 0
constlast = -1
'constlastshared = -1
defdatahandle = 18
closedmain = 0
addmetastatic = 0
addmetadynamic = 0
DynamicMode = 0
optionbase = 0
DataOffset = 0
statementn = 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
subfuncn = 0
subfunc = ""
''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
IF Cloud = 0 THEN
lasttype = lasttype + 1: i = lasttype
udtxname(i) = "_MEM"
udtxcname(i) = "_MEM"
udtxsize(i) = ((ptrsz) * 4 + (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) = LONGTYPE: udtesize(i2) = 32
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
END IF 'cloud = 0
'begin compilation
FOR closeall = 1 TO 255: CLOSE closeall: NEXT
OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock
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
OPEN tmpdir$ + "global.txt" FOR OUTPUT AS #18
IF Cloud THEN PRINT #18, "int32 cloud_app=1;" ELSE PRINT #18, "int32 cloud_app=0;"
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
stevewashere: '### STEVE EDIT FOR CONST EXPANSION 10/11/2013
wholeline$ = lineinput3$
IF wholeline$ = CHR$(13) THEN EXIT DO
ideprepass:
wholestv$ = wholeline$ '### STEVE EDIT FOR CONST EXPANSION 10/11/2013
prepass = 1
layout = ""
layoutok = 0
linenumber = linenumber + 1
IF LEN(wholeline$) THEN
wholeline$ = lineformat(wholeline$)
IF Error_Happened THEN GOTO errmes
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)
'========================================
'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)
PRINT #18, "char *g_tmp_udt_" + RTRIM$(udtxname(i)) + "=(char*)malloc(" + siz$ + ");"
'print "END TYPE";udtxsize(i);udtxbytealign(i)
GOTO finishedlinepp
END IF
END IF
lasttypeelement = lasttypeelement + 1
i2 = lasttypeelement
udtenext(i2) = 0
IF n < 3 THEN a$ = "Expected variablename AS type or END TYPE": GOTO errmes
n$ = firstelement$
ii = 2
udtearrayelements(i2) = 0
IF ii >= n OR getelement$(a$, ii) <> "AS" THEN a$ = "Expected variablename AS type or END TYPE": GOTO errmes
t$ = getelements$(a$, ii + 1, n)
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)
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": 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": 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
ELSE
IF (typ AND ISSTRING) THEN
IF (typ AND ISFIXEDLENGTH) = 0 THEN a$ = "Expected STRING *": GOTO errmes
udtesize(i2) = typsize * 8
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));udtesize(i2);udtebytealign(i2);udtxsize(i)
GOTO finishedlinepp
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
definingtype = lasttype
i = definingtype
IF validname(secondelement$) = 0 THEN a$ = "Invalid name": GOTO errmes
udtxname(i) = secondelement$
udtxcname(i) = getelement(ca$, 2)
udtxnext(i) = 0
udtxsize(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": 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
stevewashere2: ' ### STEVE EDIT ON 10/11/2013 (Const Expansion)
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
'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
'Steve Tweak to add _RGB32 and _MATH support to CONST
'Our alteration to allow for multiple uses of RGB and RGBA inside a CONST //SMcNeill
altered = 0
'Edit 02/23/2014 to add space between = and _ for statements like CONST x=_RGB(123,0,0) and stop us from gettting an error.
DO
l = INSTR(wholestv$, "=_")
IF l THEN
wholestv$ = LEFT$(wholestv$, l) + " " + MID$(wholestv$, l + 1)
END IF
LOOP UNTIL l = 0
'End of Edit on 02/23/2014
DO
finished = -1
l = INSTR(l + 1, UCASE$(wholestv$), " _RGBA")
IF l > 0 THEN
altered = -1
l$ = LEFT$(wholestv$, l - 1)
vp = INSTR(l, wholestv$, "(")
IF vp > 0 THEN
E = INSTR(vp + 1, wholestv$, ")")
IF E > 0 THEN
'get our 3 colors or 4 if we need RGBA values
first = INSTR(vp, wholestv$, ",")
second = INSTR(first + 1, wholestv$, ",")
third = INSTR(second + 1, wholestv$, ",")
fourth = INSTR(third + 1, wholestv$, ",") 'If we need RGBA we need this one as well
red$ = MID$(wholestv$, vp + 1, first - vp - 1)
green$ = MID$(wholestv$, first + 1, second - first - 1)
blue$ = MID$(wholestv$, second + 1, third - second - 1)
alpha$ = MID$(wholestv$, third + 1)
IF MID$(wholestv$, l + 6, 2) = "32" THEN
val$ = "32"
ELSE
val$ = MID$(wholestv$, fourth + 1)
END IF
SELECT CASE VAL(val$)
CASE 0, 1, 2, 7, 8, 9, 10, 11, 12, 13, 256
wi& = _NEWIMAGE(240, 120, VAL(val$))
clr~& = _RGBA(VAL(red$), VAL(green$), VAL(blue$), VAL(alpha$), wi&)
_FREEIMAGE wi&
CASE 32
clr~& = _RGBA32(VAL(red$), VAL(green$), VAL(blue$), VAL(alpha$))
CASE ELSE
a$ = "Invalid Screen Mode.": GOTO errmes
END SELECT
wholestv$ = l$ + STR$(clr~&) + RIGHT$(wholestv$, LEN(wholestv$) - E)
finished = 0
ELSE
'no finishing bracket
a$ = ") Expected": GOTO errmes
END IF
ELSE
'no starting bracket
a$ = "( Expected": GOTO errmes
END IF
END IF
LOOP UNTIL finished
DO
finished = -1
l = INSTR(l + 1, UCASE$(wholestv$), " _RGB")
IF l > 0 THEN
altered = -1
l$ = LEFT$(wholestv$, l - 1)
vp = INSTR(l, wholestv$, "(")
IF vp > 0 THEN
E = INSTR(vp + 1, wholestv$, ")")
IF E > 0 THEN
first = INSTR(vp, wholestv$, ",")
second = INSTR(first + 1, wholestv$, ",")
third = INSTR(second + 1, wholestv$, ",")
red$ = MID$(wholestv$, vp + 1, first - vp - 1)
green$ = MID$(wholestv$, first + 1, second - first - 1)
blue$ = MID$(wholestv$, second + 1)
IF MID$(wholestv$, l + 5, 2) = "32" THEN
val$ = "32"
ELSE
val$ = MID$(wholestv$, third + 1)
END IF
SELECT CASE VAL(val$)
CASE 0, 1, 2, 7, 8, 9, 10, 11, 12, 13, 256
wi& = _NEWIMAGE(240, 120, VAL(val$))
clr~& = _RGB(VAL(red$), VAL(green$), VAL(blue$), wi&)
_FREEIMAGE wi&
CASE 32
clr~& = _RGB32(VAL(red$), VAL(green$), VAL(blue$))
CASE ELSE
a$ = "Invalid Screen Mode.": GOTO errmes
END SELECT
wholestv$ = l$ + STR$(clr~&) + RIGHT$(wholestv$, LEN(wholestv$) - E)
finished = 0
ELSE
a$ = ") Expected": GOTO errmes
END IF
ELSE
a$ = "( Expected": GOTO errmes
END IF
END IF
LOOP UNTIL finished
' ### END OF STEVE EDIT FOR EXPANDED CONST SUPPORT ###
'New Edit by Steve on 02/23/2014 to add support for the new Math functions
l = 0: Emergency_Exit = 0 'A counter where if we're inside the same DO-Loop for more than 10,000 times, we assume it's an endless loop that didn't process properly and toss out an error message instead of locking up the program.
DO
l = INSTR(l + 1, wholestv$, "=")
IF l THEN
l2 = INSTR(l + 1, wholestv$, ",") 'Look for a comma after that
IF l2 = 0 THEN 'If there's no comma, then we're working to the end of the line
l2 = LEN(wholestv$)
ELSE
l2 = l2 - 1 'else we only want to take what's before that comma and see if we can use it
END IF
temp$ = RTRIM$(LTRIM$(MID$(wholestv$, l + 1, l2 - l)))
temp1$ = RTRIM$(LTRIM$(Evaluate_Expression$(temp$)))
IF LEFT$(temp1$, 5) <> "ERROR" AND temp$ <> temp1$ THEN
'The math routine should have did its replacement for us.
altered = -1
wholestv$ = LEFT$(wholestv$, l) + temp1$ + MID$(wholestv$, l2 + 1)
ELSE
'We should leave it as it is and let the normal CONST routine handle things from here on out and see if it passes the rest of the error checks.
END IF
l = l + 1
END IF
Emergency_Exit = Emergency_Exit + 1
IF Emergency_Exit > 10000 THEN a$ = "CONST ERROR: Attempting to process MATH Function caused Endless Loop. Please recheck your math formula.": GOTO errmes
LOOP UNTIL l = 0
'End of Math Support Edit
'Steve edit to update the CONST with the Math and _RGB functions
IF altered THEN
altered = 0
wholeline$ = wholestv$
linenumber = linenumber - 1
GOTO ideprepass
END IF
'End of Final Edits to CONST
IF n < 3 THEN a$ = "Expected CONST name = value/expression": GOTO errmes
i = 2
constdefpendingpp:
pending = 0
n$ = getelement$(ca$, i): i = i + 1
'l$ = l$ + sp + n$ + sp + "="
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$ = ""
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$
NEXT
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
'l$ = l$ + sp + tlayout$
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 a$ = "Name already in use": GOTO errmes
END IF
IF hashresflags AND HASHFLAG_RESERVED THEN
a$ = "Name already in use": 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": GOTO errmes
IF t AND ISSTRING THEN a$ = "Name already in use": 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
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" 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
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
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
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": GOTO errmes
m = 1
array = 1
GOTO gotaa
END IF
IF e$ = ")" THEN
IF m <> 1 THEN a$ = "Syntax error": GOTO errmes
m = 2
GOTO gotaa
END IF
IF e$ = "AS" THEN
IF m <> 0 AND m <> 2 THEN a$ = "Syntax error": 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": 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": 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:
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 = 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
FOR try = 1 TO 2
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
OPEN f$ FOR INPUT AS #fh
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$'
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
LOOP
'(end manager)
IF idemode THEN GOTO ideret2
LOOP
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
'prepass finished
lineinput3index = 1 'reset input line
'ide specific
ide3:
addmetainclude$ = "" 'reset stray meta-includes
'reset altered variables
DataOffset = 0
inclevel = 0
subfuncn = 0
FOR i = 0 TO constlast: constdefined(i) = 0: NEXT 'undefine constants
FOR i = 1 TO 27: defineaz(i) = "SINGLE": defineextaz(i) = "!": NEXT
OPEN tmpdir$ + "data.bin" FOR OUTPUT AS #16: CLOSE #16
OPEN tmpdir$ + "data.bin" FOR BINARY AS #16
OPEN tmpdir$ + "main.txt" FOR OUTPUT AS #12
OPEN tmpdir$ + "maindata.txt" FOR OUTPUT AS #13
OPEN tmpdir$ + "regsf.txt" FOR OUTPUT AS #17
OPEN tmpdir$ + "mainfree.txt" FOR OUTPUT AS #19
OPEN tmpdir$ + "runline.txt" FOR OUTPUT AS #21
OPEN tmpdir$ + "mainerr.txt" FOR OUTPUT AS #14 'main error handler
'i. check the value of error_line
'ii. jump to the appropriate label
errorlabels = 0
PRINT #14, "if (error_occurred){ error_occurred=0;"
OPEN tmpdir$ + "chain.txt" FOR OUTPUT AS #22: CLOSE #22 'will be appended to as necessary
OPEN tmpdir$ + "inpchain.txt" FOR OUTPUT AS #23: CLOSE #23 'will be appended to as necessary
'*** #22 & #23 are reserved for usage by chain & inpchain ***
OPEN tmpdir$ + "ontimer.txt" FOR OUTPUT AS #24
OPEN tmpdir$ + "ontimerj.txt" FOR OUTPUT AS #25
'*****#26 used for locking qb64
OPEN tmpdir$ + "onkey.txt" FOR OUTPUT AS #27
OPEN tmpdir$ + "onkeyj.txt" FOR OUTPUT AS #28
OPEN tmpdir$ + "onstrig.txt" FOR OUTPUT AS #29
OPEN tmpdir$ + "onstrigj.txt" FOR OUTPUT AS #30
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
OPEN tmpdir$ + "ret0.txt" FOR OUTPUT AS #15
PRINT #15, "if (next_return_point){"
PRINT #15, "next_return_point--;"
PRINT #15, "switch(return_point[next_return_point]){"
PRINT #15, "case 0:"
IF C_Core = 0 THEN PRINT #15, "return NULL;"
IF C_Core = 1 THEN PRINT #15, "return;"
PRINT #15, "break;"
continueline = 0
endifs = 0
lineelseused = 0
continuelinefrom = 0
linenumber = 0
declaringlibrary = 0
PRINT #12, "S_0:;" 'note: REQUIRED by run statement
IF UseGL THEN gl_include_content
'ide specific
IF idemode THEN GOTO ideret3
DO
ide4:
includeline:
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
layout = ""
layoutok = 1
IF idemode = 0 THEN
IF LEN(a3$) THEN
dotlinecount = dotlinecount + 1: IF dotlinecount >= 100 THEN dotlinecount = 0: PRINT ".";
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
'QB64 Metacommands
IF ASC(a3$) = 36 THEN '$
a3u$ = UCASE$(a3$)
IF a3u$ = "$CHECKING:OFF" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$CHECKING:OFF"
NoChecks = 1
GOTO finishednonexec
END IF
IF a3u$ = "$CHECKING:ON" THEN
layout$ = "$CHECKING:ON"
NoChecks = 0
GOTO finishednonexec
END IF
IF a3u$ = "$CONSOLE" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$CONSOLE"
Console = 1
GOTO finishednonexec
END IF
IF a3u$ = "$SCREENHIDE" THEN
layout$ = "$SCREENHIDE"
ScreenHide = 1
GOTO finishednonexec
END IF
IF a3u$ = "$SCREENSHOW" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$SCREENSHOW"
ScreenHide = 0
GOTO finishednonexec
END IF
IF a3u$ = "$RESIZE:OFF" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$RESIZE:OFF"
Resize = 0: Resize_Scale = 0
GOTO finishednonexec
END IF
IF a3u$ = "$RESIZE:ON" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$RESIZE:ON"
Resize = 1: Resize_Scale = 0
GOTO finishednonexec
END IF
IF a3u$ = "$RESIZE:STRETCH" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$RESIZE:STRETCH"
Resize = 1: Resize_Scale = 1
GOTO finishednonexec
END IF
IF a3u$ = "$RESIZE:SMOOTH" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
layout$ = "$RESIZE:SMOOTH"
Resize = 1: Resize_Scale = 2
GOTO finishednonexec
END IF
END IF 'QB64 Metacommands
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
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": 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$
PRINT #12, "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)
PRINT #12, "last_line=" + label$ + ";"
IF NoChecks = 0 THEN
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + ");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
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": 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
IF LEN(layout$) THEN layout$ = layout$ + sp + tlayout$ + ":" ELSE layout$ = tlayout$ + ":"
PRINT #12, "LABEL_" + a$ + ":;"
IF NoChecks = 0 THEN
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + ");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$ = firstelement$
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$ = "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$ = "END" + sp + "TYPE"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec
END IF
IF n < 3 OR secondelement$ <> "AS" THEN a$ = "Expected element-name AS type-name": GOTO errmes
definingtype = 2
l$ = getelement(ca$, 1) + sp + "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
t$ = RTRIM$(udtxcname(typ AND 511))
END IF
l$ = l$ + sp + t$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec
END IF 'defining type
IF firstelement$ = "TYPE" THEN
IF n <> 2 THEN a$ = "Expected TYPE type-name": GOTO errmes
l$ = "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$ = "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$ = "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$ = "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$ = "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 qb64 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
'Seperate 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
'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
mylib$ = mylib$ + " ..\..\" + libname$ + " "
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 = FREEFILE
OPEN tmpdir$ + "maindata.txt" FOR APPEND AS #f
ELSE
f = 13
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
PRINT #17, "HINSTANCE DLL_" + x2$ + "=NULL;"
PRINT #f, "if (!DLL_" + x2$ + "){"
PRINT #f, "DLL_" + x2$ + "=LoadLibrary(" + CHR$(34) + inlinelibname$ + CHR$(34) + ");"
PRINT #f, "if (!DLL_" + x2$ + ") error(259);"
PRINT #f, "}"
END IF
IF os$ = "LNX" THEN
PRINT #17, "void *DLL_" + x2$ + "=NULL;"
PRINT #f, "if (!DLL_" + x2$ + "){"
PRINT #f, "DLL_" + x2$ + "=dlopen(" + CHR$(34) + inlinelibname$ + CHR$(34) + ",RTLD_LAZY);"
PRINT #f, "if (!DLL_" + x2$ + ") error(259);"
PRINT #f, "}"
END IF
END IF
IF subfuncn THEN CLOSE #f
END IF 'no header
END IF 'dynamiclibrary
IF LEN(headername$) THEN
IF os$ = "WIN" THEN
PRINT #17, "#include " + CHR$(34) + "..\\..\\" + headername$ + CHR$(34)
END IF
IF os$ = "LNX" THEN
IF LEFT$(headername$, 1) = "/" THEN
PRINT #17, "#include " + CHR$(34) + headername$ + CHR$(34)
ELSE
PRINT #17, "#include " + CHR$(34) + "../../" + headername$ + CHR$(34)
END IF
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"
l$ = firstelement$ + sp + e$ + symbol$
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 + "ALIAS" + sp + CHR_QUOTE + ee$ + CHR_QUOTE
ELSE
l$ = l$ + sp + "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 THEN
x = controltype(controllevel)
IF x = 1 THEN a$ = "IF without END IF"
IF x = 2 THEN a$ = "FOR without NEXT"
IF x = 3 OR x = 4 THEN a$ = "DO without LOOP"
IF x = 5 THEN a$ = "WHILE without WEND"
IF (x >= 10 AND x <= 17) OR x = 18 OR x = 19 THEN a$ = "SELECT CASE without END SELECT"
linenumber = controlref(controllevel)
GOTO errmes
END IF
subfunc = RTRIM$(id.callname) 'SUB_..."
subfuncn = subfuncn + 1
subfuncid = targetid
subfuncret$ = ""
CLOSE #13: OPEN tmpdir$ + "data" + str2$(subfuncn) + ".txt" FOR OUTPUT AS #13
CLOSE #19: OPEN tmpdir$ + "free" + str2$(subfuncn) + ".txt" FOR OUTPUT AS #19
CLOSE #15: OPEN tmpdir$ + "ret" + str2$(subfuncn) + ".txt" FOR OUTPUT AS #15
PRINT #15, "if (next_return_point){"
PRINT #15, "next_return_point--;"
PRINT #15, "switch(return_point[next_return_point]){"
PRINT #15, "case 0:"
PRINT #15, "error(3);" 'return without gosub!
PRINT #15, "break;"
defdatahandle = 13
declibjmp1:
IF declaringlibrary THEN
IF sfdeclare = 0 AND indirectlibrary = 0 THEN
CLOSE #17
OPEN tmpdir$ + "regsf_ignore.txt" FOR OUTPUT AS #17
END IF
IF sfdeclare = 1 AND customtypelibrary = 0 AND dynamiclibrary = 0 AND indirectlibrary = 0 THEN
PRINT #17, "#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
PRINT #17, "typedef " + t$ + " (CALLBACK* DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(";
END IF
IF os$ = "LNX" THEN
PRINT #17, "typedef " + t$ + " (*DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(";
END IF
ELSEIF declaringlibrary <> 0 AND customtypelibrary <> 0 THEN
PRINT #17, "typedef " + t$ + " CUSTOMCALL_" + removecast$(RTRIM$(id.callname)) + "(";
ELSE
PRINT #17, t$ + " " + removecast$(RTRIM$(id.callname)) + "(";
END IF
IF declaringlibrary THEN GOTO declibjmp2
PRINT #12, 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
reginternalvariable = 1
ignore = dim2(e$, symbol$, 0, "")
IF Error_Happened THEN GOTO errmes
reginternalvariable = 0
'the following line stops the return variable from being free'd before being returned
CLOSE #19: OPEN tmpdir$ + "free" + str2$(subfuncn) + ".txt" FOR OUTPUT AS #19
'create return
IF (rettyp AND ISSTRING) THEN
r$ = refer$(str2$(currentid), id.t, 1)
IF Error_Happened THEN GOTO errmes
subfuncret$ = subfuncret$ + "qbs_maketmp(" + r$ + ");"
subfuncret$ = subfuncret$ + "return " + r$ + ";"
ELSE
r$ = refer$(str2$(currentid), id.t, 0)
IF Error_Happened THEN GOTO errmes
subfuncret$ = "return " + r$ + ";"
END IF
ELSE
IF declaringlibrary <> 0 AND dynamiclibrary <> 0 THEN
IF os$ = "WIN" THEN
PRINT #17, "typedef void (CALLBACK* DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(";
END IF
IF os$ = "LNX" THEN
PRINT #17, "typedef void (*DLLCALL_" + removecast$(RTRIM$(id.callname)) + ")(";
END IF
ELSEIF declaringlibrary <> 0 AND customtypelibrary <> 0 THEN
PRINT #17, "typedef void CUSTOMCALL_" + removecast$(RTRIM$(id.callname)) + "(";
ELSE
PRINT #17, "void " + removecast$(RTRIM$(id.callname)) + "(";
END IF
IF declaringlibrary THEN GOTO declibjmp2
PRINT #12, "void " + removecast$(RTRIM$(id.callname)) + "(";
END IF
declibjmp2:
addstatic2layout = 0
staticsf = 0
e$ = getelement$(a$, n)
IF e$ = "STATIC" THEN
IF declaringlibrary THEN a$ = "STATIC cannot be used in a library declaration": GOTO errmes
addstatic2layout = 1
staticsf = 2
a$ = LEFT$(a$, LEN(a$) - 7): n = n - 1 'remove STATIC
END IF
'check items to pass
params = 0
AllowLocalName = 1
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
l$ = l$ + sp + "("
IF n = 4 THEN GOTO nosfparams2
IF n < 4 THEN a$ = "Expected ( ... )": GOTO errmes
B = 0
a2$ = ""
FOR i = 4 TO n - 1
e$ = getelement$(ca$, 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
getlastparam2:
IF a2$ = "" THEN a$ = "Expected ... ,": GOTO errmes
a2$ = LEFT$(a2$, LEN(a2$) - 1)
'possible format: [BYVAL]a[%][(1)][AS][type]
params = params + 1
glinkid = targetid
glinkarg = params
IF params > 1 THEN
PRINT #17, ",";
IF declaringlibrary = 0 THEN
PRINT #12, ",";
END IF
END IF
n2 = numelements(a2$)
array = 0
t2$ = ""
e$ = getelement$(a2$, 1)
byvalue = 0
IF UCASE$(e$) = "BYVAL" THEN
IF declaringlibrary = 0 THEN a$ = "BYVAL can currently only be used with DECLARE LIBRARY": GOTO errmes
byvalue = 1: a2$ = RIGHT$(a2$, LEN(a2$) - 6)
IF RIGHT$(l$, 1) = "(" THEN l$ = l$ + sp2 + "BYVAL" ELSE l$ = l$ + sp + "BYVAL"
n2 = numelements(a2$): e$ = getelement$(a2$, 1)
END IF
IF RIGHT$(l$, 1) = "(" THEN l$ = l$ + sp2 + e$ ELSE l$ = l$ + sp + e$
n2$ = e$
dimmethod = 0
symbol2$ = removesymbol$(n2$)
IF validname(n2$) = 0 THEN a$ = "Invalid name": GOTO errmes
IF Error_Happened THEN GOTO errmes
IF symbol2$ <> "" THEN dimmethod = 1
m = 0
FOR i2 = 2 TO n2
e$ = getelement$(a2$, i2)
IF e$ = "(" THEN
IF m <> 0 THEN a$ = "Syntax error": GOTO errmes
m = 1
array = 1
l$ = l$ + sp2 + "("
GOTO gotaa2
END IF
IF e$ = ")" THEN
IF m <> 1 THEN a$ = "Syntax error": GOTO errmes
m = 2
l$ = l$ + sp2 + ")"
GOTO gotaa2
END IF
IF UCASE$(e$) = "AS" THEN
IF m <> 0 AND m <> 2 THEN a$ = "Syntax error": GOTO errmes
m = 3
l$ = l$ + sp + "AS"
GOTO gotaa2
END IF
IF m = 1 THEN l$ = l$ + sp + e$: GOTO gotaa2 'ignore contents of option bracket telling how many dimensions (add to layout as is)
IF m <> 3 THEN a$ = "Syntax error": GOTO errmes
IF t2$ = "" THEN t2$ = e$ ELSE t2$ = t2$ + " " + e$
gotaa2:
NEXT i2
IF symbol2$ <> "" AND t2$ <> "" THEN a$ = "Syntax error": GOTO errmes
IF LEN(t2$) THEN 'add type-name after AS
t2$ = UCASE$(t2$)
t3$ = t2$
typ = typname2typ(t3$)
IF Error_Happened THEN GOTO errmes
IF typ = 0 THEN a$ = "Undefined type": GOTO errmes
IF typ AND ISUDT THEN
t3$ = RTRIM$(udtxcname(typ AND 511))
ELSE
FOR t3i = 1 TO LEN(t3i)
IF ASC(t3$, t3i) = 32 THEN ASC(t3$, t3i) = ASC(sp)
NEXT
END IF
l$ = l$ + sp + t3$
END IF
IF t2$ = "" THEN t2$ = symbol2$
IF t2$ = "" THEN
IF LEFT$(n2$, 1) = "_" THEN v = 27 ELSE v = ASC(UCASE$(n2$)) - 64
t2$ = defineaz(v)
dimmethod = 1
END IF
IF array = 1 THEN
IF declaringlibrary THEN a$ = "Arrays cannot be passed to a library": GOTO errmes
dimsfarray = 1
'note: id2.nele is currently 0
nelereq = ASC(MID$(id2.nelereq, params, 1))
IF nelereq THEN
nele = nelereq
MID$(id2.nele, params, 1) = CHR$(nele)
ids(targetid) = id2
ignore = dim2(n2$, t2$, dimmethod, str2$(nele))
IF Error_Happened THEN GOTO errmes
ELSE
nele = 1
MID$(id2.nele, params, 1) = CHR$(nele)
ids(targetid) = id2
ignore = dim2(n2$, t2$, dimmethod, "?")
IF Error_Happened THEN GOTO errmes
END IF
dimsfarray = 0
r$ = refer$(str2$(currentid), id.t, 1)
IF Error_Happened THEN GOTO errmes
PRINT #17, "ptrszint*" + r$;
PRINT #12, "ptrszint*" + r$;
ELSE
IF declaringlibrary THEN
'is it a udt?
FOR xx = 1 TO lasttype
IF t2$ = RTRIM$(udtxname(xx)) THEN
PRINT #17, "void*"
GOTO decudt
END IF
NEXT
t$ = typ2ctyp$(0, t2$)
IF Error_Happened THEN GOTO errmes
IF t$ = "qbs" THEN
t$ = "char*"
IF byvalue = 1 THEN a$ = "STRINGs cannot be passed using BYVAL": GOTO errmes
byvalue = 1 'use t$ as is
END IF
IF byvalue THEN PRINT #17, t$; ELSE PRINT #17, t$ + "*";
decudt:
GOTO declibjmp3
END IF
dimsfarray = 1
ignore = dim2(n2$, t2$, dimmethod, "")
IF Error_Happened THEN GOTO errmes
dimsfarray = 0
t$ = ""
typ = id.t 'the typ of the ID created by dim2
t$ = typ2ctyp$(typ, "")
IF Error_Happened THEN GOTO errmes
IF t$ = "" THEN a$ = "Cannot find C type to return array data": GOTO errmes
'searchpoint
'get the name of the variable
r$ = refer$(str2$(currentid), id.t, 1)
IF Error_Happened THEN GOTO errmes
PRINT #17, t$ + "*" + r$;
PRINT #12, t$ + "*" + r$;
IF t$ = "qbs" THEN
u$ = str2$(uniquenumber)
PRINT #13, "qbs*oldstr" + u$ + "=NULL;"
PRINT #13, "if(" + r$ + "->tmp||" + r$ + "->fixed||" + r$ + "->readonly){"
PRINT #13, "oldstr" + u$ + "=" + r$ + ";"
PRINT #13, "if (oldstr" + u$ + "->cmem_descriptor){"
PRINT #13, r$ + "=qbs_new_cmem(oldstr" + u$ + "->len,0);"
PRINT #13, "}else{"
PRINT #13, r$ + "=qbs_new(oldstr" + u$ + "->len,0);"
PRINT #13, "}"
PRINT #13, "memcpy(" + r$ + "->chr,oldstr" + u$ + "->chr,oldstr" + u$ + "->len);"
PRINT #13, "}"
PRINT #19, "if(oldstr" + u$ + "){"
PRINT #19, "if(oldstr" + u$ + "->fixed)qbs_set(oldstr" + u$ + "," + r$ + ");"
PRINT #19, "qbs_free(" + r$ + ");"
PRINT #19, "}"
END IF
END IF
declibjmp3:
IF i <> n - 1 THEN l$ = l$ + sp2 + ","
a2$ = ""
ELSE
a2$ = a2$ + e$ + sp
IF i = n - 1 THEN GOTO getlastparam2
END IF
NEXT i
nosfparams2:
l$ = l$ + sp2 + ")"
END IF 'n>2
AllowLocalName = 0
IF addstatic2layout THEN l$ = l$ + sp + "STATIC"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #17, ");"
IF declaringlibrary THEN GOTO declibjmp4
PRINT #12, "){"
PRINT #12, "qbs *tqbs;"
PRINT #12, "ptrszint tmp_long;"
PRINT #12, "int32 tmp_fileno;"
PRINT #12, "uint32 qbs_tmp_base=qbs_tmp_list_nexti;"
PRINT #12, "uint8 *tmp_mem_static_pointer=mem_static_pointer;"
PRINT #12, "uint32 tmp_cmem_sp=cmem_sp;"
PRINT #12, "#include " + CHR$(34) + "data" + str2$(subfuncn) + ".txt" + CHR$(34)
'create new _MEM lock for this scope
PRINT #12, "mem_lock *sf_mem_lock;" 'MUST not be static for recursion reasons
PRINT #12, "new_mem_lock();"
PRINT #12, "sf_mem_lock=mem_lock_tmp;"
PRINT #12, "sf_mem_lock->type=3;"
PRINT #12, "if (new_error) goto exit_subfunc;"
'statementn = statementn + 1
'if nochecks=0 then PRINT #12, "S_" + str2$(statementn) + ":;"
dimstatic = staticsf
declibjmp4:
IF declaringlibrary THEN
IF customtypelibrary THEN
callname$ = removecast$(RTRIM$(id2.callname))
PRINT #17, "CUSTOMCALL_" + callname$ + " *" + callname$ + "=NULL;"
IF subfuncn THEN
f = FREEFILE
OPEN tmpdir$ + "maindata.txt" FOR APPEND AS #f
ELSE
f = 13
END IF
PRINT #f, callname$ + "=(CUSTOMCALL_" + callname$ + "*)&" + aliasname$ + ";"
IF subfuncn THEN CLOSE #f
'if no header exists to make the external function available, the function definition must be found
IF sfheader = 0 AND sfdeclare <> 0 THEN
ResolveStaticFunctions = ResolveStaticFunctions + 1
'expand array if necessary
IF ResolveStaticFunctions > UBOUND(ResolveStaticFunction_Name) THEN
REDIM _PRESERVE ResolveStaticFunction_Name(1 TO ResolveStaticFunctions + 100) AS STRING
REDIM _PRESERVE ResolveStaticFunction_File(1 TO ResolveStaticFunctions + 100) AS STRING
REDIM _PRESERVE ResolveStaticFunction_Method(1 TO ResolveStaticFunctions + 100) AS LONG
END IF
ResolveStaticFunction_File(ResolveStaticFunctions) = libname$
ResolveStaticFunction_Name(ResolveStaticFunctions) = aliasname$
ResolveStaticFunction_Method(ResolveStaticFunctions) = 1
END IF 'sfheader=0
END IF
IF dynamiclibrary THEN
IF sfdeclare THEN
PRINT #17, "DLLCALL_" + removecast$(RTRIM$(id2.callname)) + " " + removecast$(RTRIM$(id2.callname)) + "=NULL;"
IF subfuncn THEN
f = FREEFILE
OPEN tmpdir$ + "maindata.txt" FOR APPEND AS #f
ELSE
f = 13
END IF
PRINT #f, "if (!" + removecast$(RTRIM$(id2.callname)) + "){"
IF os$ = "WIN" THEN
PRINT #f, removecast$(RTRIM$(id2.callname)) + "=(DLLCALL_" + removecast$(RTRIM$(id2.callname)) + ")GetProcAddress(DLL_" + DLLname$ + "," + CHR$(34) + aliasname$ + CHR$(34) + ");"
PRINT #f, "if (!" + removecast$(RTRIM$(id2.callname)) + ") error(260);"
END IF
IF os$ = "LNX" THEN
PRINT #f, removecast$(RTRIM$(id2.callname)) + "=(DLLCALL_" + removecast$(RTRIM$(id2.callname)) + ")dlsym(DLL_" + DLLname$ + "," + CHR$(34) + aliasname$ + CHR$(34) + ");"
PRINT #f, "if (dlerror()) error(260);"
END IF
PRINT #f, "}"
IF subfuncn THEN CLOSE #f
END IF 'sfdeclare
END IF 'dynamic
IF sfdeclare = 1 AND customtypelibrary = 0 AND dynamiclibrary = 0 AND indirectlibrary = 0 THEN
ResolveStaticFunctions = ResolveStaticFunctions + 1
'expand array if necessary
IF ResolveStaticFunctions > UBOUND(ResolveStaticFunction_Name) THEN
REDIM _PRESERVE ResolveStaticFunction_Name(1 TO ResolveStaticFunctions + 100) AS STRING
REDIM _PRESERVE ResolveStaticFunction_File(1 TO ResolveStaticFunctions + 100) AS STRING
REDIM _PRESERVE ResolveStaticFunction_Method(1 TO ResolveStaticFunctions + 100) AS LONG
END IF
ResolveStaticFunction_File(ResolveStaticFunctions) = libname$
ResolveStaticFunction_Name(ResolveStaticFunctions) = aliasname$
ResolveStaticFunction_Method(ResolveStaticFunctions) = 2
END IF
IF sfdeclare = 0 AND indirectlibrary = 0 THEN
CLOSE #17
OPEN tmpdir$ + "regsf.txt" FOR APPEND AS #17
END IF
END IF 'declaring library
GOTO finishednonexec
END IF
END IF
'END SUB/FUNCTION
IF n = 2 THEN
IF firstelement$ = "END" THEN
sf = 0
IF secondelement$ = "FUNCTION" THEN sf = 1
IF secondelement$ = "SUB" THEN sf = 2
IF sf THEN
IF LEN(subfunc) = 0 THEN a$ = "END " + secondelement$ + " without " + secondelement$: GOTO errmes
'check for open controls (copy #3)
IF controllevel THEN
x = controltype(controllevel)
IF x = 1 THEN a$ = "IF without END IF"
IF x = 2 THEN a$ = "FOR without NEXT"
IF x = 3 OR x = 4 THEN a$ = "DO without LOOP"
IF x = 5 THEN a$ = "WHILE without WEND"
IF (x >= 10 AND x <= 17) OR x = 18 OR x = 19 THEN a$ = "SELECT CASE without END SELECT"
linenumber = controlref(controllevel)
GOTO errmes
END IF
l$ = firstelement$ + sp + secondelement$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
staticarraylist = "": staticarraylistn = 0 'remove previously listed arrays
dimstatic = 0
PRINT #12, "exit_subfunc:;"
'release _MEM lock for this scope
PRINT #12, "free_mem_lock(sf_mem_lock);"
PRINT #12, "#include " + CHR$(34) + "free" + str2$(subfuncn) + ".txt" + CHR$(34)
PRINT #12, "if ((tmp_mem_static_pointer>=mem_static)&&(tmp_mem_static_pointer<=mem_static_limit)) mem_static_pointer=tmp_mem_static_pointer; else mem_static_pointer=mem_static;"
PRINT #12, "cmem_sp=tmp_cmem_sp;"
IF subfuncret$ <> "" THEN PRINT #12, subfuncret$
PRINT #12, "}" 'skeleton sub
'ret???.txt
PRINT #15, "}" 'end case
PRINT #15, "}"
PRINT #15, "error(3);" 'no valid return possible
subfunc = ""
'unshare temp. shared variables
FOR i = 1 TO idn
IF ids(i).share AND 2 THEN ids(i).share = ids(i).share - 2
NEXT
FOR i = 1 TO revertmaymusthaven
x = revertmaymusthave(i)
SWAP ids(x).musthave, ids(x).mayhave
NEXT
revertmaymusthaven = 0
'undeclare constants in sub/function's scope
'constlast = constlastshared
GOTO finishednonexec
END IF
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 n < 3 THEN a$ = "Expected CONST name = value/expression": GOTO errmes
i = 2
constdefpending:
pending = 0
n$ = getelement$(ca$, i): i = i + 1
l$ = l$ + sp + n$ + sp + "="
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$ = ""
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$
NEXT
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
'Note: Actual CONST definition handled in prepass
'Set CONST as defined
hashname$ = n$
hashchkflags = HASHFLAG_CONSTANT
hashres = HashFind(hashname$, hashchkflags, hashresflags, hashresref)
DO WHILE hashres
IF constsubfunc(hashresref) = subfuncn THEN constdefined(hashresref) = 1: EXIT DO
IF hashres <> 1 THEN hashres = HashFindCont(hashresflags, hashresref) ELSE hashres = 0
LOOP
IF pending THEN l$ = l$ + sp2 + ",": GOTO constdefpending
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec
END IF
predefine:
IF n >= 2 THEN
asreq = 0
IF firstelement$ = "DEFINT" THEN a$ = a$ + sp + "AS" + sp + "INTEGER": n = n + 2: GOTO definetype
IF firstelement$ = "DEFLNG" THEN a$ = a$ + sp + "AS" + sp + "LONG": n = n + 2: GOTO definetype
IF firstelement$ = "DEFSNG" THEN a$ = a$ + sp + "AS" + sp + "SINGLE": n = n + 2: GOTO definetype
IF firstelement$ = "DEFDBL" THEN a$ = a$ + sp + "AS" + sp + "DOUBLE": n = n + 2: GOTO definetype
IF firstelement$ = "DEFSTR" THEN a$ = a$ + sp + "AS" + sp + "STRING": n = n + 2: GOTO definetype
IF firstelement$ = "_DEFINE" THEN
asreq = 1
definetype:
l$ = firstelement$
'get type from rhs
typ$ = ""
typ2$ = ""
t$ = ""
FOR i = n TO 2 STEP -1
t$ = getelement$(a$, i)
IF t$ = "AS" THEN EXIT FOR
typ$ = t$ + " " + typ$
typ2$ = t$ + sp + typ2$
NEXT
typ$ = RTRIM$(typ$)
IF t$ <> "AS" THEN a$ = "_DEFINE: Expected ... AS ...": GOTO errmes
IF i = n OR i = 2 THEN a$ = "_DEFINE: Expected ... AS ...": GOTO errmes
n = i - 1
'the data is from element 2 to element n
i = 2 - 1
definenext:
'expects an alphabet letter or underscore
i = i + 1: e$ = getelement$(a$, i): E = ASC(UCASE$(e$))
IF LEN(e$) > 1 THEN a$ = "_DEFINE: Expected an alphabet letter or the underscore character (_)": GOTO errmes
IF E <> 95 AND (E > 90 OR E < 65) THEN a$ = "_DEFINE: Expected an alphabet letter or the underscore character (_)": GOTO errmes
IF E = 95 THEN E = 27 ELSE E = E - 64
defineaz(E) = typ$
defineextaz(E) = type2symbol(typ$)
IF Error_Happened THEN GOTO errmes
firste = E
l$ = l$ + sp + e$
IF i = n THEN
IF predefining = 1 THEN GOTO predefined
IF asreq THEN l$ = l$ + sp + "AS" + sp + typ2$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec
END IF
'expects "-" or ","
i = i + 1: e$ = getelement$(a$, i)
IF e$ <> "-" AND e$ <> "," THEN a$ = "_DEFINE: Expected - or ,": GOTO errmes
IF e$ = "-" THEN
l$ = l$ + sp2 + "-"
IF i = n THEN a$ = "_DEFINE: Syntax incomplete": GOTO errmes
'expects an alphabet letter or underscore
i = i + 1: e$ = getelement$(a$, i): E = ASC(UCASE$(e$))
IF LEN(e$) > 1 THEN a$ = "_DEFINE: Expected an alphabet letter or the underscore character (_)": GOTO errmes
IF E <> 95 AND (E > 90 OR E < 65) THEN a$ = "_DEFINE: Expected an alphabet letter or the underscore character (_)": GOTO errmes
IF E = 95 THEN E = 27 ELSE E = E - 64
IF firste > E THEN SWAP E, firste
FOR e2 = firste TO E
defineaz(e2) = typ$
defineextaz(e2) = type2symbol(typ$)
IF Error_Happened THEN GOTO errmes
NEXT
l$ = l$ + sp2 + e$
IF i = n THEN
IF predefining = 1 THEN GOTO predefined
IF asreq THEN l$ = l$ + sp + "AS" + sp + typ2$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec
END IF
'expects ","
i = i + 1: e$ = getelement$(a$, i)
IF e$ <> "," THEN a$ = "_DEFINE: Expected ,": GOTO errmes
END IF
l$ = l$ + sp2 + ","
GOTO definenext
END IF '_DEFINE
END IF '2
IF predefining = 1 THEN GOTO predefined
IF closedmain <> 0 AND subfunc = "" THEN a$ = "Statement cannot be placed between SUB/FUNCTIONs": GOTO errmes
'executable section:
statementn = statementn + 1
IF n >= 1 THEN
IF firstelement$ = "NEXT" THEN
l$ = "NEXT"
IF n = 1 THEN GOTO simplenext
v$ = ""
FOR i = 2 TO n
a2$ = getelement(ca$, i)
IF a2$ = "," THEN
lastnextele:
e$ = fixoperationorder(v$)
IF Error_Happened THEN GOTO errmes
IF LEN(l$) = 4 THEN l$ = l$ + sp + tlayout$ ELSE l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN
getid VAL(e$)
IF Error_Happened THEN GOTO errmes
IF (id.t AND ISPOINTER) THEN
IF (id.t AND ISSTRING) = 0 THEN
IF (id.t AND ISOFFSETINBITS) = 0 THEN
IF (id.t AND ISARRAY) = 0 THEN
GOTO fornextfoundvar2
END IF
END IF
END IF
END IF
END IF
a$ = "Unsupported variable after NEXT": GOTO errmes
fornextfoundvar2:
simplenext:
IF controltype(controllevel) <> 2 THEN a$ = "NEXT without FOR": GOTO errmes
IF n <> 1 AND controlvalue(controllevel) <> currentid THEN a$ = "Incorrect variable after NEXT": GOTO errmes
PRINT #12, "}"
PRINT #12, "fornext_exit_" + str2$(controlid(controllevel)) + ":;"
controllevel = controllevel - 1
IF n = 1 THEN EXIT FOR
v$ = ""
ELSE
IF LEN(v$) THEN v$ = v$ + sp + a2$ ELSE v$ = a2$
IF i = n THEN GOTO lastnextele
END IF
NEXT
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec '***no error causing code, event checking done by FOR***
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "WHILE" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
controllevel = controllevel + 1
controlref(controllevel) = linenumber
controltype(controllevel) = 5
controlid(controllevel) = uniquenumber
IF n >= 2 THEN
e$ = fixoperationorder(getelements$(ca$, 2, n))
IF Error_Happened THEN GOTO errmes
l$ = "WHILE" + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer$(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF stringprocessinghappened THEN e$ = cleanupstringprocessingcall$ + e$ + ")"
IF (typ AND ISSTRING) THEN a$ = "WHILE ERROR! Cannot accept a STRING type.": GOTO errmes
PRINT #12, "while((" + e$ + ")||new_error){"
ELSE
a$ = "WHILE ERROR! Expected expression after WHILE.": GOTO errmes
END IF
GOTO finishedline
END IF
END IF
IF n = 1 THEN
IF firstelement$ = "WEND" THEN
IF controltype(controllevel) <> 5 THEN a$ = "WEND without WHILE": GOTO errmes
PRINT #12, "}"
PRINT #12, "ww_exit_" + str2$(controlid(controllevel)) + ":;"
controllevel = controllevel - 1
l$ = "WEND"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec '***no error causing code, event checking done by WHILE***
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "DO" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
controllevel = controllevel + 1
controlref(controllevel) = linenumber
l$ = "DO"
IF n >= 2 THEN
whileuntil = 0
IF secondelement$ = "WHILE" THEN whileuntil = 1: l$ = l$ + sp + "WHILE"
IF secondelement$ = "UNTIL" THEN whileuntil = 2: l$ = l$ + sp + "UNTIL"
IF whileuntil = 0 THEN a$ = "DO ERROR! Expected WHILE or UNTIL after DO.": GOTO errmes
e$ = fixoperationorder(getelements$(ca$, 3, n))
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer$(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF stringprocessinghappened THEN e$ = cleanupstringprocessingcall$ + e$ + ")"
IF (typ AND ISSTRING) THEN a$ = "DO ERROR! Cannot accept a STRING type.": GOTO errmes
IF whileuntil = 1 THEN PRINT #12, "while((" + e$ + ")||new_error){" ELSE PRINT #12, "while((!(" + e$ + "))||new_error){"
controltype(controllevel) = 4
ELSE
controltype(controllevel) = 3
PRINT #12, "do{"
END IF
controlid(controllevel) = uniquenumber
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "LOOP" THEN
l$ = "LOOP"
IF controltype(controllevel) <> 3 AND controltype(controllevel) <> 4 THEN a$ = "PROGRAM FLOW ERROR!": GOTO errmes
IF n >= 2 THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF controltype(controllevel) = 4 THEN a$ = "PROGRAM FLOW ERROR!": GOTO errmes
whileuntil = 0
IF secondelement$ = "WHILE" THEN whileuntil = 1: l$ = l$ + sp + "WHILE"
IF secondelement$ = "UNTIL" THEN whileuntil = 2: l$ = l$ + sp + "UNTIL"
IF whileuntil = 0 THEN a$ = "LOOP ERROR! Expected WHILE or UNTIL after LOOP.": GOTO errmes
e$ = fixoperationorder(getelements$(ca$, 3, n))
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer$(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF stringprocessinghappened THEN e$ = cleanupstringprocessingcall$ + e$ + ")"
IF (typ AND ISSTRING) THEN a$ = "LOOP ERROR! Cannot accept a STRING type.": GOTO errmes
IF whileuntil = 1 THEN PRINT #12, "}while((" + e$ + ")&&(!new_error));" ELSE PRINT #12, "}while((!(" + e$ + "))&&(!new_error));"
ELSE
IF controltype(controllevel) = 4 THEN
PRINT #12, "}"
ELSE
PRINT #12, "}while(1);" 'infinite loop!
END IF
END IF
PRINT #12, "dl_exit_" + str2$(controlid(controllevel)) + ":;"
controllevel = controllevel - 1
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
IF n = 1 THEN GOTO finishednonexec '***no error causing code, event checking done by DO***
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "FOR" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
l$ = "FOR"
controllevel = controllevel + 1
controlref(controllevel) = linenumber
controltype(controllevel) = 2
controlid(controllevel) = uniquenumber
v$ = ""
startvalue$ = ""
p3$ = "1": stepused = 0
p2$ = ""
mode = 0
E = 0
FOR i = 2 TO n
e$ = getelement$(a$, i)
IF e$ = "=" THEN
IF mode <> 0 THEN E = 1: EXIT FOR
mode = 1
v$ = getelements$(ca$, 2, i - 1)
equpos = i
END IF
IF e$ = "TO" THEN
IF mode <> 1 THEN E = 1: EXIT FOR
mode = 2
startvalue$ = getelements$(ca$, equpos + 1, i - 1)
topos = i
END IF
IF e$ = "STEP" THEN
IF mode <> 2 THEN E = 1: EXIT FOR
mode = 3
stepused = 1
p2$ = getelements$(ca$, topos + 1, i - 1)
p3$ = getelements$(ca$, i + 1, n)
EXIT FOR
END IF
NEXT
IF mode < 2 THEN E = 1
IF p2$ = "" THEN p2$ = getelements$(ca$, topos + 1, n)
IF LEN(v$) = 0 OR LEN(startvalue$) = 0 OR LEN(p2$) = 0 THEN E = 1
IF E <> 0 AND mode < 3 THEN a$ = "Expected FOR name = start TO end": GOTO errmes
IF E THEN a$ = "Expected FOR name = start TO end STEP increment": GOTO errmes
e$ = fixoperationorder(v$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN
getid VAL(e$)
IF Error_Happened THEN GOTO errmes
IF (id.t AND ISPOINTER) THEN
IF (id.t AND ISSTRING) = 0 THEN
IF (id.t AND ISOFFSETINBITS) = 0 THEN
IF (id.t AND ISARRAY) = 0 THEN
GOTO fornextfoundvar
END IF
END IF
END IF
END IF
END IF
a$ = "Unsupported variable used in FOR statement": GOTO errmes
fornextfoundvar:
controlvalue(controllevel) = currentid
v$ = e$
'find C++ datatype to match variable
'markup to cater for greater range/accuracy
ctype$ = ""
ctyp = typ - ISPOINTER
bits = typ AND 511
IF (typ AND ISFLOAT) THEN
IF bits = 32 THEN ctype$ = "double": ctyp = 64& + ISFLOAT
IF bits = 64 THEN ctype$ = "long double": ctyp = 256& + ISFLOAT
IF bits = 256 THEN ctype$ = "long double": ctyp = 256& + ISFLOAT
ELSE
IF bits = 8 THEN ctype$ = "int16": ctyp = 16&
IF bits = 16 THEN ctype$ = "int32": ctyp = 32&
IF bits = 32 THEN ctype$ = "int64": ctyp = 64&
IF bits = 64 THEN ctype$ = "int64": ctyp = 64&
END IF
IF ctype$ = "" THEN a$ = "Unsupported variable used in FOR statement": GOTO errmes
u$ = str2(uniquenumber)
IF subfunc = "" THEN
PRINT #13, "static " + ctype$ + " fornext_value" + u$ + ";"
PRINT #13, "static " + ctype$ + " fornext_finalvalue" + u$ + ";"
PRINT #13, "static " + ctype$ + " fornext_step" + u$ + ";"
PRINT #13, "static uint8 fornext_step_negative" + u$ + ";"
ELSE
PRINT #13, ctype$ + " fornext_value" + u$ + ";"
PRINT #13, ctype$ + " fornext_finalvalue" + u$ + ";"
PRINT #13, ctype$ + " fornext_step" + u$ + ";"
PRINT #13, "uint8 fornext_step_negative" + u$ + ";"
END IF
'calculate start
e$ = fixoperationorder$(startvalue$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + "=" + sp + tlayout$
e$ = evaluatetotyp$(e$, ctyp)
IF Error_Happened THEN GOTO errmes
PRINT #12, "fornext_value" + u$ + "=" + e$ + ";"
'final
e$ = fixoperationorder$(p2$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + "TO" + sp + tlayout$
e$ = evaluatetotyp(e$, ctyp)
IF Error_Happened THEN GOTO errmes
PRINT #12, "fornext_finalvalue" + u$ + "=" + e$ + ";"
'step
e$ = fixoperationorder$(p3$)
IF Error_Happened THEN GOTO errmes
IF stepused = 1 THEN l$ = l$ + sp + "STEP" + sp + tlayout$
e$ = evaluatetotyp(e$, ctyp)
IF Error_Happened THEN GOTO errmes
PRINT #12, "fornext_step" + u$ + "=" + e$ + ";"
PRINT #12, "if (fornext_step" + u$ + "<0) fornext_step_negative" + u$ + "=1; else fornext_step_negative" + u$ + "=0;"
PRINT #12, "if (new_error) goto fornext_error" + u$ + ";"
PRINT #12, "goto fornext_entrylabel" + u$ + ";"
PRINT #12, "while(1){"
typbak = typ
PRINT #12, "fornext_value" + u$ + "=fornext_step" + u$ + "+(" + refer$(v$, typ, 0) + ");"
IF Error_Happened THEN GOTO errmes
typ = typbak
PRINT #12, "fornext_entrylabel" + u$ + ":"
setrefer v$, typ, "fornext_value" + u$, 1
IF Error_Happened THEN GOTO errmes
PRINT #12, "if (fornext_step_negative" + u$ + "){"
PRINT #12, "if (fornext_value" + u$ + "fornext_finalvalue" + u$ + ") break;"
PRINT #12, "}"
PRINT #12, "fornext_error" + u$ + ":;"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
IF n = 1 THEN
IF firstelement$ = "ELSE" THEN
FOR i = controllevel TO 1 STEP -1
t = controltype(i)
IF t = 1 THEN
IF controlstate(controllevel) = 2 THEN a$ = "IF-THEN already contains an ELSE statement": GOTO errmes
PRINT #12, "}else{"
controlstate(controllevel) = 2
IF lineelseused = 0 THEN lhscontrollevel = lhscontrollevel - 1
l$ = "ELSE"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec '***no error causing code, event checking done by IF***
END IF
NEXT
a$ = "ELSE without IF": GOTO errmes
END IF
END IF
IF n >= 3 THEN
IF firstelement$ = "ELSEIF" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
FOR i = controllevel TO 1 STEP -1
t = controltype(i)
IF t = 1 THEN
IF controlstate(controllevel) = 2 THEN a$ = "ELSEIF invalid after ELSE": GOTO errmes
controlstate(controllevel) = 1
controlvalue(controllevel) = controlvalue(controllevel) + 1
e$ = getelement$(a$, n)
IF e$ <> "THEN" THEN a$ = "Expected ELSEIF expression THEN": GOTO errmes
PRINT #12, "}else{"
e$ = fixoperationorder$(getelements$(ca$, 2, n - 1))
IF Error_Happened THEN GOTO errmes
l$ = "ELSEIF" + sp + tlayout$ + sp + "THEN"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer$(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF typ AND ISSTRING THEN
a$ = "Expected ELSEIF LEN(stringexpression) THEN": GOTO errmes
END IF
IF stringprocessinghappened THEN
PRINT #12, "if (" + cleanupstringprocessingcall$ + e$ + ")){"
ELSE
PRINT #12, "if (" + e$ + "){"
END IF
lhscontrollevel = lhscontrollevel - 1
GOTO finishedline
END IF
NEXT
a$ = "ELSEIF without IF": GOTO errmes
END IF
END IF
IF n >= 3 THEN
IF firstelement$ = "IF" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
e$ = getelement(a$, n)
iftype = 0
IF e$ = "THEN" THEN iftype = 1
IF e$ = "GOTO" THEN iftype = 2
IF iftype = 0 THEN a$ = "Expected IF expression THEN/GOTO": GOTO errmes
controllevel = controllevel + 1
controlref(controllevel) = linenumber
controltype(controllevel) = 1
controlvalue(controllevel) = 0 'number of extra closing } required at END IF
controlstate(controllevel) = 0
e$ = fixoperationorder$(getelements(ca$, 2, n - 1))
IF Error_Happened THEN GOTO errmes
l$ = "IF" + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer$(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF typ AND ISSTRING THEN
a$ = "Expected IF LEN(stringexpression) THEN": GOTO errmes
END IF
IF stringprocessinghappened THEN
PRINT #12, "if ((" + cleanupstringprocessingcall$ + e$ + "))||new_error){"
ELSE
PRINT #12, "if ((" + e$ + ")||new_error){"
END IF
IF iftype = 1 THEN l$ = l$ + sp + "THEN" 'note: 'GOTO' will be added when iftype=2
layoutdone = 1: IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
IF iftype = 2 THEN 'IF ... GOTO
GOTO finishedline
END IF
THENGOTO = 1 'possible: IF a=1 THEN 10
GOTO finishedline2
END IF
END IF
'END IF
IF n = 2 THEN
IF getelement(a$, 1) = "END" AND getelement(a$, 2) = "IF" THEN
IF controltype(controllevel) <> 1 THEN a$ = "END IF without IF": GOTO errmes
layoutdone = 1
IF impliedendif = 0 THEN
l$ = "END" + sp + "IF"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
END IF
PRINT #12, "}"
FOR i = 1 TO controlvalue(controllevel)
PRINT #12, "}"
NEXT
controllevel = controllevel - 1
GOTO finishednonexec '***no error causing code, event checking done by IF***
END IF
END IF
'SELECT CASE
IF n >= 1 THEN
IF firstelement$ = "SELECT" THEN
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF n = 1 OR secondelement$ <> "CASE" THEN a$ = "Expected CASE": GOTO errmes
IF n = 2 THEN a$ = "Expected SELECT CASE expression": GOTO errmes
e$ = fixoperationorder(getelements$(ca$, 3, n))
IF Error_Happened THEN GOTO errmes
l$ = "SELECT" + sp + "CASE" + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
u = uniquenumber
controllevel = controllevel + 1
controlvalue(controllevel) = 0 'id
t$ = ""
IF (typ AND ISSTRING) THEN
t = 0
IF (typ AND ISUDT) = 0 AND (typ AND ISARRAY) = 0 AND (typ AND ISREFERENCE) <> 0 THEN
controlvalue(controllevel) = VAL(e$)
ELSE
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
PRINT #13, "static qbs *sc_" + str2$(u) + "=qbs_new(0,0);"
PRINT #12, "qbs_set(sc_" + str2$(u) + "," + e$ + ");"
IF stringprocessinghappened THEN PRINT #12, cleanupstringprocessingcall$ + "0);"
END IF
ELSE
IF (typ AND ISFLOAT) THEN
IF (typ AND 511) > 64 THEN t = 3: t$ = "long double"
IF (typ AND 511) = 32 THEN t = 4: t$ = "float"
IF (typ AND 511) = 64 THEN t = 5: t$ = "double"
IF (typ AND ISUDT) = 0 AND (typ AND ISARRAY) = 0 AND (typ AND ISREFERENCE) <> 0 THEN
controlvalue(controllevel) = VAL(e$)
ELSE
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
PRINT #13, "static " + t$ + " sc_" + str2$(u) + ";"
PRINT #12, "sc_" + str2$(u) + "=" + e$ + ";"
IF stringprocessinghappened THEN PRINT #12, cleanupstringprocessingcall$ + "0);"
END IF
ELSE
'non-float
t = 1: t$ = "int64"
IF (typ AND ISUNSIGNED) THEN
IF (typ AND 511) <= 32 THEN t = 7: t$ = "uint32"
IF (typ AND 511) > 32 THEN t = 2: t$ = "uint64"
ELSE
IF (typ AND 511) <= 32 THEN t = 6: t$ = "int32"
IF (typ AND 511) > 32 THEN t = 1: t$ = "int64"
END IF
IF (typ AND ISUDT) = 0 AND (typ AND ISARRAY) = 0 AND (typ AND ISREFERENCE) <> 0 THEN
controlvalue(controllevel) = VAL(e$)
ELSE
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
PRINT #13, "static " + t$ + " sc_" + str2$(u) + ";"
PRINT #12, "sc_" + str2$(u) + "=" + e$ + ";"
IF stringprocessinghappened THEN PRINT #12, cleanupstringprocessingcall$ + "0);"
END IF
END IF
END IF
controlref(controllevel) = linenumber
controltype(controllevel) = 10 + t
controlid(controllevel) = u
GOTO finishedline
END IF
END IF
'END SELECT
IF n = 2 THEN
IF firstelement$ = "END" AND secondelement$ = "SELECT" THEN
'complete current case if necessary
'18=CASE (awaiting END SELECT/CASE/CASE ELSE)
'19=CASE ELSE (awaiting END SELECT)
IF controltype(controllevel) = 18 THEN
controllevel = controllevel - 1
PRINT #12, "goto sc_" + str2$(controlid(controllevel)) + "_end;"
PRINT #12, "}"
END IF
IF controltype(controllevel) = 19 THEN
controllevel = controllevel - 1
END IF
PRINT #12, "sc_" + str2$(controlid(controllevel)) + "_end:;"
IF controltype(controllevel) < 10 OR controltype(controllevel) > 17 THEN a$ = "END SELECT without SELECT CASE": GOTO errmes
controllevel = controllevel - 1
l$ = "END" + sp + "SELECT"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec '***no error causing code, event checking done by SELECT CASE***
END IF
END IF
'CASE
IF n >= 1 THEN
IF firstelement$ = "CASE" THEN
l$ = "CASE"
'complete current case if necessary
'18=CASE (awaiting END SELECT/CASE/CASE ELSE)
'19=CASE ELSE (awaiting END SELECT)
IF controltype(controllevel) = 19 THEN a$ = "Expected END SELECT": GOTO errmes
IF controltype(controllevel) = 18 THEN
lhscontrollevel = lhscontrollevel - 1
controllevel = controllevel - 1
PRINT #12, "goto sc_" + str2$(controlid(controllevel)) + "_end;"
PRINT #12, "}"
'following line fixes problem related to RESUME after error
'statementn = statementn + 1
'if nochecks=0 then PRINT #12, "S_" + str2$(statementn) + ":;"
END IF
IF controltype(controllevel) < 10 OR controltype(controllevel) > 17 THEN a$ = "CASE without SELECT CASE": GOTO errmes
IF n = 1 THEN a$ = "Expected CASE expression": GOTO errmes
'upgrade:
'#1: variables can be referred to directly by storing an id in 'controlref'
' (but not if part of an array etc.)
'DIM controlvalue(1000) AS LONG
'#2: more types will be available
' +SINGLE
' +DOUBLE
' -LONG DOUBLE
' +INT32
' +UINT32
'14=SELECT CASE float ...
'15=SELECT CASE double
'16=SELECT CASE int32
'17=SELECT CASE uint32
'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
' bits = targettyp AND 511
' IF bits <= 16 THEN e$ = "qbr_float_to_long(" + e$ + ")"
' IF bits > 16 AND bits < 32 THEN e$ = "qbr_double_to_long(" + e$ + ")"
' IF bits >= 32 THEN e$ = "qbr(" + e$ + ")"
t = controltype(controllevel) - 10
'get required type cast, and float options
flt = 0
IF t = 0 THEN tc$ = ""
IF t = 1 THEN tc$ = ""
IF t = 2 THEN tc$ = ""
IF t = 3 THEN tc$ = "": flt = 1
IF t = 4 THEN tc$ = "(float)": flt = 1
IF t = 5 THEN tc$ = "(double)": flt = 1
IF t = 6 THEN tc$ = ""
IF t = 7 THEN tc$ = ""
n$ = "sc_" + str2$(controlid(controllevel))
cv = controlvalue(controllevel)
IF cv THEN
n$ = refer$(str2$(cv), 0, 0)
IF Error_Happened THEN GOTO errmes
END IF
'CASE ELSE
IF n = 2 THEN
IF getelement$(a$, 2) = "C-EL" THEN
controllevel = controllevel + 1: controltype(controllevel) = 19
controlref(controllevel) = controlref(controllevel - 1)
l$ = l$ + sp + "ELSE"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishednonexec '***no error causing code, event checking done by SELECT CASE***
END IF
END IF
IF NoChecks = 0 THEN PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
f12$ = ""
nexp = 0
B = 0
e$ = ""
FOR i = 2 TO n
e2$ = getelement$(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF i = n THEN e$ = e$ + sp + e2$
IF i = n OR (e2$ = "," AND B = 0) THEN
IF nexp <> 0 THEN l$ = l$ + sp2 + ",": f12$ = f12$ + "||"
IF e$ = "" THEN a$ = "Expected expression": GOTO errmes
e$ = RIGHT$(e$, LEN(e$) - 1)
'TYPE 1? ... TO ...
n2 = numelements(e$)
b2 = 0
el$ = "": er$ = ""
usedto = 0
FOR i2 = 1 TO n2
e3$ = getelement$(e$, i2)
IF e3$ = "(" THEN b2 = b2 + 1
IF e3$ = ")" THEN b2 = b2 - 1
IF b2 = 0 AND UCASE$(e3$) = "TO" THEN
usedto = 1
ELSE
IF usedto = 0 THEN el$ = el$ + sp + e3$ ELSE er$ = er$ + sp + e3$
END IF
NEXT
IF usedto = 1 THEN
IF el$ = "" OR er$ = "" THEN a$ = "Expected expression TO expression": GOTO errmes
el$ = RIGHT$(el$, LEN(el$) - 1): er$ = RIGHT$(er$, LEN(er$) - 1)
'evaluate each side
FOR i2 = 1 TO 2
IF i2 = 1 THEN e$ = el$ ELSE e$ = er$
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
IF i2 = 1 THEN l$ = l$ + sp + tlayout$ ELSE l$ = l$ + sp + "TO" + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF t = 0 THEN
IF (typ AND ISSTRING) = 0 THEN a$ = "Expected string expression": GOTO errmes
IF i2 = 1 THEN f12$ = f12$ + "(qbs_greaterorequal(" + n$ + "," + e$ + ")&&qbs_lessorequal(" + n$ + ","
IF i2 = 2 THEN f12$ = f12$ + e$ + "))"
ELSE
IF (typ AND ISSTRING) THEN a$ = "Expected numeric expression": GOTO errmes
'round to integer?
IF (typ AND ISFLOAT) THEN
IF t = 1 THEN e$ = "qbr(" + e$ + ")"
IF t = 2 THEN e$ = "qbr_longdouble_to_uint64(" + e$ + ")"
IF t = 6 OR t = 7 THEN e$ = "qbr_double_to_long(" + e$ + ")"
END IF
'cast result?
IF LEN(tc$) THEN e$ = tc$ + "(" + e$ + ")"
IF i2 = 1 THEN f12$ = f12$ + "((" + n$ + ">=(" + e$ + "))&&(" + n$ + "<=("
IF i2 = 2 THEN f12$ = f12$ + e$ + ")))"
END IF
NEXT
GOTO addedexp
END IF
'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
' bits = targettyp AND 511
' IF bits <= 16 THEN e$ = "qbr_float_to_long(" + e$ + ")"
' IF bits > 16 AND bits < 32 THEN e$ = "qbr_double_to_long(" + e$ + ")"
' IF bits >= 32 THEN e$ = "qbr(" + e$ + ")"
o$ = "==" 'used by type 3
'TYPE 2?
x$ = getelement$(e$, 1)
IF isoperator(x$) THEN 'non-standard usage correction
IF x$ = "=" OR x$ = "<>" OR x$ = ">" OR x$ = "<" OR x$ = ">=" OR x$ = "<=" THEN
e$ = "IS" + sp + e$
x$ = "IS"
END IF
END IF
IF UCASE$(x$) = "IS" THEN
n2 = numelements(e$)
IF n2 < 3 THEN a$ = "Expected IS =,<>,>,<,>=,<= expression": GOTO errmes
o$ = getelement$(e$, 2)
o2$ = o$
o = 0
IF o$ = "=" THEN o$ = "==": o = 1
IF o$ = "<>" THEN o$ = "!=": o = 1
IF o$ = ">" THEN o = 1
IF o$ = "<" THEN o = 1
IF o$ = ">=" THEN o = 1
IF o$ = "<=" THEN o = 1
IF o <> 1 THEN a$ = "Expected IS =,<>,>,<,>=,<= expression": GOTO errmes
l$ = l$ + sp + "IS" + sp + o2$
e$ = getelements$(e$, 3, n2)
'fall through to type 3 using modified e$ & o$
END IF
'TYPE 3? simple expression
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISREFERENCE) THEN e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
IF t = 0 THEN
'string comparison
IF (typ AND ISSTRING) = 0 THEN a$ = "Expected string expression": GOTO errmes
IF o$ = "==" THEN o$ = "qbs_equal"
IF o$ = "!=" THEN o$ = "qbs_notequal"
IF o$ = ">" THEN o$ = "qbs_greaterthan"
IF o$ = "<" THEN o$ = "qbs_lessthan"
IF o$ = ">=" THEN o$ = "qbs_greaterorequal"
IF o$ = "<=" THEN o$ = "qbs_lessorequal"
f12$ = f12$ + o$ + "(" + n$ + "," + e$ + ")"
ELSE
'numeric
IF (typ AND ISSTRING) THEN a$ = "Expected numeric expression": GOTO errmes
'round to integer?
IF (typ AND ISFLOAT) THEN
IF t = 1 THEN e$ = "qbr(" + e$ + ")"
IF t = 2 THEN e$ = "qbr_longdouble_to_uint64(" + e$ + ")"
IF t = 6 OR t = 7 THEN e$ = "qbr_double_to_long(" + e$ + ")"
END IF
'cast result?
IF LEN(tc$) THEN e$ = tc$ + "(" + e$ + ")"
f12$ = f12$ + "(" + n$ + o$ + "(" + e$ + "))"
END IF
addedexp:
e$ = ""
nexp = nexp + 1
ELSE
e$ = e$ + sp + e2$
END IF
NEXT
IF stringprocessinghappened THEN
PRINT #12, "if ((" + cleanupstringprocessingcall$ + f12$ + "))||new_error){"
ELSE
PRINT #12, "if ((" + f12$ + ")||new_error){"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
controllevel = controllevel + 1
controlref(controllevel) = controlref(controllevel - 1)
controltype(controllevel) = 18
GOTO finishedline
END IF
END IF
'static scope commands:
IF NoChecks = 0 THEN
PRINT #12, "do{"
'PRINT #12, "S_" + str2$(statementn) + ":;"
END IF
IF n > 1 THEN
IF firstelement$ = "PALETTE" THEN
IF secondelement$ = "USING" THEN
l$ = "PALETTE" + sp + "USING" + sp
IF n < 3 THEN a$ = "Expected PALETTE USING array-name": GOTO errmes
'check array
e$ = getelement$(ca$, 3)
IF FindArray(e$) THEN
IF Error_Happened THEN GOTO errmes
z = 1
t = id.arraytype
IF (t AND 511) <> 16 AND (t AND 511) <> 32 THEN z = 0
IF t AND ISFLOAT THEN z = 0
IF t AND ISOFFSETINBITS THEN z = 0
IF t AND ISSTRING THEN z = 0
IF t AND ISUDT THEN z = 0
IF t AND ISUNSIGNED THEN z = 0
IF z = 0 THEN a$ = "Array must be of type INTEGER or LONG": GOTO errmes
bits = t AND 511
GOTO pu_gotarray
END IF
IF Error_Happened THEN GOTO errmes
a$ = "Expected PALETTE USING array-name": GOTO errmes
pu_gotarray:
'add () if index not specified
IF n = 3 THEN
e$ = e$ + sp + "(" + sp + ")"
ELSE
IF n = 4 OR getelement$(a$, 4) <> "(" OR getelement$(a$, n) <> ")" THEN a$ = "Expected PALETTE USING array-name(...)": GOTO errmes
e$ = e$ + sp + getelements$(ca$, 4, n)
END IF
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
e$ = evaluatetotyp(e$, -2)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_paletteusing(" + e$ + "," + str2(bits) + ");"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF 'using
END IF 'palette
END IF 'n>1
IF firstelement$ = "KEY" THEN
IF n = 1 THEN a$ = "Expected KEY ...": GOTO errmes
l$ = "KEY" + sp
IF secondelement$ = "OFF" THEN
IF n > 2 THEN a$ = "Expected KEY OFF only": GOTO errmes
l$ = l$ + "OFF": layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "key_off();"
GOTO finishedline
END IF
IF secondelement$ = "ON" THEN
IF n > 2 THEN a$ = "Expected KEY ON only": GOTO errmes
l$ = l$ + "ON": layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "key_on();"
GOTO finishedline
END IF
IF secondelement$ = "LIST" THEN
IF n > 2 THEN a$ = "Expected KEY LIST only": GOTO errmes
l$ = l$ + "LIST": layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "key_list();"
GOTO finishedline
END IF
'search for comma to indicate assignment
B = 0: e$ = ""
FOR i = 2 TO n
e2$ = getelement(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF e2$ = "," AND B = 0 THEN
i = i + 1: GOTO key_assignment
END IF
IF LEN(e$) THEN e$ = e$ + sp + e2$ ELSE e$ = e2$
NEXT
'assume KEY(x) ON/OFF/STOP and handle as a sub
GOTO key_fallthrough
key_assignment:
'KEY x, "string"
'index
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + "," + sp
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "key_assign(" + e$ + ",";
'string
e$ = getelements$(ca$, i, n)
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
e$ = evaluatetotyp(e$, ISSTRING)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ");"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF 'KEY
key_fallthrough:
IF firstelement$ = "FIELD" THEN
'get filenumber
B = 0: e$ = ""
FOR i = 2 TO n
e2$ = getelement(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF e2$ = "," AND B = 0 THEN
i = i + 1: GOTO fieldgotfn
END IF
IF LEN(e$) THEN e$ = e$ + sp + e2$ ELSE e$ = e2$
NEXT
GOTO fielderror
fieldgotfn:
IF e$ = "#" OR LEN(e$) = 0 THEN GOTO fielderror
IF LEFT$(e$, 2) = "#" + sp THEN e$ = RIGHT$(e$, LEN(e$) - 2): l$ = "FIELD" + sp + "#" + sp2 ELSE l$ = "FIELD" + sp
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + "," + sp
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "field_new(" + e$ + ");"
fieldnext:
'get fieldwidth
IF i > n THEN GOTO fielderror
B = 0: e$ = ""
FOR i = i TO n
e2$ = getelement(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF UCASE$(e2$) = "AS" AND B = 0 THEN
i = i + 1: GOTO fieldgotfw
END IF
IF LEN(e$) THEN e$ = e$ + sp + e2$ ELSE e$ = e2$
NEXT
GOTO fielderror
fieldgotfw:
IF LEN(e$) = 0 THEN GOTO fielderror
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp + "AS" + sp
sizee$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
'get variable name
IF i > n THEN GOTO fielderror
B = 0: e$ = ""
FOR i = i TO n
e2$ = getelement(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF (i = n OR e2$ = ",") AND B = 0 THEN
IF e2$ = "," THEN i = i - 1
IF i = n THEN
IF LEN(e$) THEN e$ = e$ + sp + e2$ ELSE e$ = e2$
END IF
GOTO fieldgotfname
END IF
IF LEN(e$) THEN e$ = e$ + sp + e2$ ELSE e$ = e2$
NEXT
GOTO fielderror
fieldgotfname:
IF LEN(e$) = 0 THEN GOTO fielderror
'evaluate it to check it is a STRING
e$ = fixoperationorder(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
e$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISSTRING) = 0 THEN GOTO fielderror
IF typ AND ISFIXEDLENGTH THEN a$ = "Fixed length strings cannot be used in a FIELD statement": GOTO errmes
IF (typ AND ISREFERENCE) = 0 THEN GOTO fielderror
e$ = refer(e$, typ, 0)
IF Error_Happened THEN GOTO errmes
PRINT #12, "field_add(" + e$ + "," + sizee$ + ");"
IF i < n THEN
i = i + 1
e$ = getelement(a$, i)
IF e$ <> "," THEN a$ = "Expected ,": GOTO errmes
l$ = l$ + sp2 + "," + sp
i = i + 1
GOTO fieldnext
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
fielderror: a$ = "Expected FIELD #filenumber, characters AS variable$, ...": GOTO errmes
END IF
'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)
IF n = 2 THEN
IF firstelement$ = "EXIT" THEN
l$ = firstelement$ + sp + secondelement$
IF secondelement$ = "DO" THEN
'scan backwards until previous control level reached
FOR i = controllevel TO 1 STEP -1
t = controltype(i)
IF t = 3 OR t = 4 THEN
PRINT #12, "goto dl_exit_" + str2$(controlid(i)) + ";"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
NEXT
a$ = "EXIT DO without DO": GOTO errmes
END IF
IF secondelement$ = "FOR" THEN
'scan backwards until previous control level reached
FOR i = controllevel TO 1 STEP -1
t = controltype(i)
IF t = 2 THEN
PRINT #12, "goto fornext_exit_" + str2$(controlid(i)) + ";"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
NEXT
a$ = "EXIT FOR without FOR": GOTO errmes
END IF
IF secondelement$ = "WHILE" THEN
'scan backwards until previous control level reached
FOR i = controllevel TO 1 STEP -1
t = controltype(i)
IF t = 5 THEN
PRINT #12, "goto ww_exit_" + str2$(controlid(i)) + ";"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
NEXT
a$ = "EXIT WHILE without WHILE": GOTO errmes
END IF
END IF
END IF
IF n >= 2 THEN
IF firstelement$ = "ON" AND secondelement$ = "STRIG" THEN
i = 3
IF i > n THEN a$ = "Expected (": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
IF a2$ <> "(" THEN a$ = "Expected (": GOTO errmes
l$ = "ON" + sp + "STRIG" + sp2 + "("
IF i > n THEN a$ = "Expected ...": GOTO errmes
B = 0
x = 0
e2$ = ""
e3$ = ""
FOR i = i TO n
e$ = getelement$(ca$, i)
a = ASC(e$)
IF a = 40 THEN B = B + 1
IF a = 41 THEN B = B - 1
IF B = -1 THEN GOTO onstriggotarg
IF a = 44 AND B = 0 THEN
x = x + 1
IF x > 1 THEN a$ = "Expected )": GOTO errmes
IF e2$ = "" THEN a$ = "Expected ... ,": GOTO errmes
e3$ = e2$
e2$ = ""
ELSE
IF LEN(e2$) THEN e2$ = e2$ + sp + e$ ELSE e2$ = e$
END IF
NEXT
a$ = "Expected )": GOTO errmes
onstriggotarg:
IF e2$ = "" THEN a$ = "Expected ... )": GOTO errmes
PRINT #12, "onstrig_setup(";
'sort scanned results
IF LEN(e3$) THEN
optI$ = e3$
optController$ = e2$
optPassed$ = "1"
ELSE
optI$ = e2$
optController$ = "0"
optPassed$ = "0"
END IF
'i
e$ = fixoperationorder$(optI$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + tlayout$
e$ = evaluatetotyp(e$, 32&): IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ",";
'controller , passed
IF optPassed$ = "1" THEN
e$ = fixoperationorder$(optController$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluatetotyp(e$, 32&): IF Error_Happened THEN GOTO errmes
ELSE
e$ = optController$
END IF
PRINT #12, e$ + "," + optPassed$ + ",";
l$ = l$ + sp2 + ")" + sp 'close brackets
i = i + 1
IF i > n THEN a$ = "Expected GOSUB/sub-name": GOTO errmes
a2$ = getelement$(a$, i): i = i + 1
onstrigid = onstrigid + 1
PRINT #12, str2$(onstrigid) + ",";
IF a2$ = "GOSUB" THEN
IF i > n THEN a$ = "Expected linenumber/label": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
PRINT #12, "0);"
IF validlabel(a2$) = 0 THEN a$ = "Invalid label": GOTO errmes
v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk60z:
IF v THEN
s = Labels(r).Scope
IF s = 0 OR s = -1 THEN 'main scope?
IF s = -1 THEN Labels(r).Scope = 0 'acquire scope
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Scope_Restriction = subfuncn
Labels(r).Error_Line = linenumber
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk60z
END IF
END IF
IF x THEN
'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 a2$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = 0
Labels(r).Error_Line = linenumber
Labels(r).Scope_Restriction = subfuncn
END IF 'x
l$ = l$ + "GOSUB" + sp + tlayout$
PRINT #30, "if(strig_event_id==" + str2$(onstrigid) + ")goto LABEL_" + a2$ + ";"
PRINT #29, "case " + str2$(onstrigid) + ":"
PRINT #29, "strig_event_occurred++;"
PRINT #29, "strig_event_id=" + str2$(onstrigid) + ";"
PRINT #29, "strig_event_occurred++;"
PRINT #29, "return_point[next_return_point++]=0;"
PRINT #29, "if (next_return_point>=return_points) more_return_points();"
PRINT #29, "QBMAIN(NULL);"
PRINT #29, "break;"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
ELSE
'establish whether sub a2$ exists using try
x = 0
try = findid(a2$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.subfunc = 2 THEN x = 1: EXIT DO
IF try = 2 THEN findanotherid = 1: try = findid(a2$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
IF x = 0 THEN a$ = "Expected GOSUB/sub": GOTO errmes
l$ = l$ + RTRIM$(id.cn)
PRINT #29, "case " + str2$(onstrigid) + ":"
PRINT #29, RTRIM$(id.callname) + "(";
IF id.args > 1 THEN a$ = "SUB requires more than one argument": GOTO errmes
IF i > n THEN
IF id.args = 1 THEN a$ = "Expected argument after SUB": GOTO errmes
PRINT #12, "0);"
PRINT #29, ");"
ELSE
IF id.args = 0 THEN a$ = "SUB has no arguments": GOTO errmes
t = CVL(id.arg)
B = t AND 511
IF B = 0 OR (t AND ISARRAY) <> 0 OR (t AND ISFLOAT) <> 0 OR (t AND ISSTRING) <> 0 OR (t AND ISOFFSETINBITS) <> 0 THEN a$ = "Only SUB arguments of integer-type allowed": GOTO errmes
IF B = 8 THEN ct$ = "int8"
IF B = 16 THEN ct$ = "int16"
IF B = 32 THEN ct$ = "int32"
IF B = 64 THEN ct$ = "int64"
IF t AND ISOFFSET THEN ct$ = "ptrszint"
IF t AND ISUNSIGNED THEN ct$ = "u" + ct$
PRINT #29, "(" + ct$ + "*)&i64);"
e$ = getelements$(ca$, i, n)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, INTEGER64TYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ");"
END IF
PRINT #29, "break;"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
END IF
END IF
END IF
IF n >= 2 THEN
IF firstelement$ = "ON" AND secondelement$ = "TIMER" THEN
i = 3
IF i > n THEN a$ = "Expected (": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
IF a2$ <> "(" THEN a$ = "Expected (": GOTO errmes
l$ = "ON" + sp + "TIMER" + sp2 + "("
IF i > n THEN a$ = "Expected ...": GOTO errmes
B = 0
x = 0
e2$ = ""
e3$ = ""
FOR i = i TO n
e$ = getelement$(ca$, i)
a = ASC(e$)
IF a = 40 THEN B = B + 1
IF a = 41 THEN B = B - 1
IF B = -1 THEN GOTO ontimgotarg
IF a = 44 AND B = 0 THEN
x = x + 1
IF x > 1 THEN a$ = "Expected )": GOTO errmes
IF e2$ = "" THEN a$ = "Expected ... ,": GOTO errmes
e3$ = e2$
e2$ = ""
ELSE
IF LEN(e2$) THEN e2$ = e2$ + sp + e$ ELSE e2$ = e$
END IF
NEXT
a$ = "Expected )": GOTO errmes
ontimgotarg:
IF e2$ = "" THEN a$ = "Expected ... )": GOTO errmes
PRINT #12, "ontimer_setup(";
'i
IF LEN(e3$) THEN
e$ = fixoperationorder$(e3$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + tlayout$ + "," + sp
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ",";
ELSE
PRINT #12, "0,";
l$ = l$ + sp2
END IF
'sec
e$ = fixoperationorder$(e2$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + ")" + sp
e$ = evaluatetotyp(e$, DOUBLETYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ",";
i = i + 1
IF i > n THEN a$ = "Expected GOSUB/sub-name": GOTO errmes
a2$ = getelement$(a$, i): i = i + 1
ontimerid = ontimerid + 1
PRINT #12, str2$(ontimerid) + ",";
IF a2$ = "GOSUB" THEN
IF i > n THEN a$ = "Expected linenumber/label": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
PRINT #12, "0);"
IF validlabel(a2$) = 0 THEN a$ = "Invalid label": GOTO errmes
v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk60:
IF v THEN
s = Labels(r).Scope
IF s = 0 OR s = -1 THEN 'main scope?
IF s = -1 THEN Labels(r).Scope = 0 'acquire scope
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Scope_Restriction = subfuncn
Labels(r).Error_Line = linenumber
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk60
END IF
END IF
IF x THEN
'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 a2$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = 0
Labels(r).Error_Line = linenumber
Labels(r).Scope_Restriction = subfuncn
END IF 'x
l$ = l$ + "GOSUB" + sp + tlayout$
PRINT #25, "if(timer_event_id==" + str2$(ontimerid) + ")goto LABEL_" + a2$ + ";"
PRINT #24, "case " + str2$(ontimerid) + ":"
PRINT #24, "timer_event_occurred++;"
PRINT #24, "timer_event_id=" + str2$(ontimerid) + ";"
PRINT #24, "timer_event_occurred++;"
PRINT #24, "return_point[next_return_point++]=0;"
PRINT #24, "if (next_return_point>=return_points) more_return_points();"
PRINT #24, "QBMAIN(NULL);"
PRINT #24, "break;"
'call validlabel (to validate the label) [see goto]
'increment ontimerid
'use ontimerid to generate the jumper routine
'etc.
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
ELSE
'establish whether sub a2$ exists using try
x = 0
try = findid(a2$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.subfunc = 2 THEN x = 1: EXIT DO
IF try = 2 THEN findanotherid = 1: try = findid(a2$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
IF x = 0 THEN a$ = "Expected GOSUB/sub": GOTO errmes
l$ = l$ + RTRIM$(id.cn)
PRINT #24, "case " + str2$(ontimerid) + ":"
PRINT #24, RTRIM$(id.callname) + "(";
IF id.args > 1 THEN a$ = "SUB requires more than one argument": GOTO errmes
IF i > n THEN
IF id.args = 1 THEN a$ = "Expected argument after SUB": GOTO errmes
PRINT #12, "0);"
PRINT #24, ");"
ELSE
IF id.args = 0 THEN a$ = "SUB has no arguments": GOTO errmes
t = CVL(id.arg)
B = t AND 511
IF B = 0 OR (t AND ISARRAY) <> 0 OR (t AND ISFLOAT) <> 0 OR (t AND ISSTRING) <> 0 OR (t AND ISOFFSETINBITS) <> 0 THEN a$ = "Only SUB arguments of integer-type allowed": GOTO errmes
IF B = 8 THEN ct$ = "int8"
IF B = 16 THEN ct$ = "int16"
IF B = 32 THEN ct$ = "int32"
IF B = 64 THEN ct$ = "int64"
IF t AND ISOFFSET THEN ct$ = "ptrszint"
IF t AND ISUNSIGNED THEN ct$ = "u" + ct$
PRINT #24, "(" + ct$ + "*)&i64);"
e$ = getelements$(ca$, i, n)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, INTEGER64TYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ");"
END IF
PRINT #24, "break;"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
END IF
END IF
END IF
IF n >= 2 THEN
IF firstelement$ = "ON" AND secondelement$ = "KEY" THEN
i = 3
IF i > n THEN a$ = "Expected (": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
IF a2$ <> "(" THEN a$ = "Expected (": GOTO errmes
l$ = "ON" + sp + "KEY" + sp2 + "("
IF i > n THEN a$ = "Expected ...": GOTO errmes
B = 0
x = 0
e2$ = ""
FOR i = i TO n
e$ = getelement$(ca$, i)
a = ASC(e$)
IF a = 40 THEN B = B + 1
IF a = 41 THEN B = B - 1
IF B = -1 THEN EXIT FOR
IF LEN(e2$) THEN e2$ = e2$ + sp + e$ ELSE e2$ = e$
NEXT
IF i = n + 1 THEN a$ = "Expected )": GOTO errmes
IF e2$ = "" THEN a$ = "Expected ... )": GOTO errmes
e$ = fixoperationorder$(e2$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + ")" + sp
e$ = evaluatetotyp(e$, DOUBLETYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
PRINT #12, "onkey_setup(" + e$ + ",";
i = i + 1
IF i > n THEN a$ = "Expected GOSUB/sub-name": GOTO errmes
a2$ = getelement$(a$, i): i = i + 1
onkeyid = onkeyid + 1
PRINT #12, str2$(onkeyid) + ",";
IF a2$ = "GOSUB" THEN
IF i > n THEN a$ = "Expected linenumber/label": GOTO errmes
a2$ = getelement$(ca$, i): i = i + 1
PRINT #12, "0);"
IF validlabel(a2$) = 0 THEN a$ = "Invalid label": GOTO errmes
v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk61:
IF v THEN
s = Labels(r).Scope
IF s = 0 OR s = -1 THEN 'main scope?
IF s = -1 THEN Labels(r).Scope = 0 'acquire scope
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Scope_Restriction = subfuncn
Labels(r).Error_Line = linenumber
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk61
END IF
END IF
IF x THEN
'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 a2$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = 0
Labels(r).Error_Line = linenumber
Labels(r).Scope_Restriction = subfuncn
END IF 'x
l$ = l$ + "GOSUB" + sp + tlayout$
PRINT #28, "if(key_event_id==" + str2$(onkeyid) + ")goto LABEL_" + a2$ + ";"
PRINT #27, "case " + str2$(onkeyid) + ":"
PRINT #27, "key_event_occurred++;"
PRINT #27, "key_event_id=" + str2$(onkeyid) + ";"
PRINT #27, "key_event_occurred++;"
PRINT #27, "return_point[next_return_point++]=0;"
PRINT #27, "if (next_return_point>=return_points) more_return_points();"
PRINT #27, "QBMAIN(NULL);"
PRINT #27, "break;"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
ELSE
'establish whether sub a2$ exists using try
x = 0
try = findid(a2$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.subfunc = 2 THEN x = 1: EXIT DO
IF try = 2 THEN findanotherid = 1: try = findid(a2$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
IF x = 0 THEN a$ = "Expected GOSUB/sub": GOTO errmes
l$ = l$ + RTRIM$(id.cn)
PRINT #27, "case " + str2$(onkeyid) + ":"
PRINT #27, RTRIM$(id.callname) + "(";
IF id.args > 1 THEN a$ = "SUB requires more than one argument": GOTO errmes
IF i > n THEN
IF id.args = 1 THEN a$ = "Expected argument after SUB": GOTO errmes
PRINT #12, "0);"
PRINT #27, ");"
ELSE
IF id.args = 0 THEN a$ = "SUB has no arguments": GOTO errmes
t = CVL(id.arg)
B = t AND 511
IF B = 0 OR (t AND ISARRAY) <> 0 OR (t AND ISFLOAT) <> 0 OR (t AND ISSTRING) <> 0 OR (t AND ISOFFSETINBITS) <> 0 THEN a$ = "Only SUB arguments of integer-type allowed": GOTO errmes
IF B = 8 THEN ct$ = "int8"
IF B = 16 THEN ct$ = "int16"
IF B = 32 THEN ct$ = "int32"
IF B = 64 THEN ct$ = "int64"
IF t AND ISOFFSET THEN ct$ = "ptrszint"
IF t AND ISUNSIGNED THEN ct$ = "u" + ct$
PRINT #27, "(" + ct$ + "*)&i64);"
e$ = getelements$(ca$, i, n)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, INTEGER64TYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
PRINT #12, e$ + ");"
END IF
PRINT #27, "break;"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
layoutdone = 1
GOTO finishedline
END IF
END IF
END IF
'SHARED (SUB)
IF n >= 1 THEN
IF firstelement$ = "SHARED" THEN
IF n = 1 THEN a$ = "Expected SHARED ...": GOTO errmes
i = 2
IF subfuncn = 0 THEN a$ = "SHARED must be used within a SUB/FUNCTION": GOTO errmes
l$ = "SHARED"
subfuncshr:
'get variable name
n$ = getelement$(ca$, i): i = i + 1
IF n$ = "" THEN a$ = "Expected SHARED variable-name": GOTO errmes
s$ = removesymbol(n$)
IF Error_Happened THEN GOTO errmes
l2$ = s$ 'either symbol or nothing
'array?
a = 0
IF getelement$(a$, i) = "(" THEN
IF getelement$(a$, i + 1) <> ")" THEN a$ = "Expected ()": GOTO errmes
i = i + 2
a = 1
l2$ = l2$ + sp2 + "(" + sp2 + ")"
END IF
method = 1
'specific type?
t$ = ""
ts$ = ""
t3$ = ""
IF getelement$(a$, i) = "AS" THEN
l2$ = l2$ + sp + "AS"
getshrtyp:
i = i + 1
t2$ = getelement$(a$, i)
IF t2$ <> "," AND t2$ <> "" THEN
IF t$ = "" THEN t$ = t2$ ELSE t$ = t$ + " " + t2$
IF t3$ = "" THEN t3$ = t2$ ELSE t3$ = t3$ + sp + t2$
GOTO getshrtyp
END IF
IF t$ = "" THEN a$ = "Expected AS type": GOTO errmes
t = typname2typ(t$)
IF Error_Happened THEN GOTO errmes
IF t AND ISINCONVENTIONALMEMORY THEN t = t - ISINCONVENTIONALMEMORY
IF t AND ISPOINTER THEN t = t - ISPOINTER
IF t AND ISREFERENCE THEN t = t - ISREFERENCE
tsize = typname2typsize
method = 0
IF (t AND ISUDT) = 0 THEN ts$ = type2symbol$(t$) ELSE t3$ = RTRIM$(udtxcname(t AND 511))
IF Error_Happened THEN GOTO errmes
l2$ = l2$ + sp + t3$
END IF 'as
IF LEN(s$) <> 0 AND LEN(t$) <> 0 THEN a$ = "Expected symbol or AS type after variable name": GOTO errmes
'no symbol of type specified, apply default
IF s$ = "" AND t$ = "" THEN
IF LEFT$(n$, 1) = "_" THEN v = 27 ELSE v = ASC(UCASE$(n$)) - 64
s$ = defineextaz(v)
END IF
'switch to main module
oldsubfunc$ = subfunc$
subfunc$ = ""
defdatahandle = 18
CLOSE #13: OPEN tmpdir$ + "maindata.txt" FOR APPEND AS #13
CLOSE #19: OPEN tmpdir$ + "mainfree.txt" FOR APPEND AS #19
'use 'try' to locate the variable (if it already exists)
n2$ = n$ + s$ + ts$ 'note: either ts$ or s$ will exist unless it is a UDT
try = findid(n2$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF a THEN
'an array
IF id.arraytype THEN
IF LEN(t$) = 0 THEN GOTO shrfound
t2 = id.arraytype: t2size = id.tsize
IF t2 AND ISINCONVENTIONALMEMORY THEN t2 = t2 - ISINCONVENTIONALMEMORY
IF t2 AND ISPOINTER THEN t2 = t2 - ISPOINTER
IF t2 AND ISREFERENCE THEN t2 = t2 - ISREFERENCE
IF t = t2 AND tsize = t2size THEN GOTO shrfound
END IF
ELSE
'not an array
IF id.t THEN
IF LEN(t$) = 0 THEN GOTO shrfound
t2 = id.t: t2size = id.tsize
IF t2 AND ISINCONVENTIONALMEMORY THEN t2 = t2 - ISINCONVENTIONALMEMORY
IF t2 AND ISPOINTER THEN t2 = t2 - ISPOINTER
IF t2 AND ISREFERENCE THEN t2 = t2 - ISREFERENCE
IF Debug THEN PRINT #9, "SHARED:comparing:"; t; t2, tsize; t2size
IF t = t2 AND tsize = t2size THEN GOTO shrfound
END IF
END IF
IF try = 2 THEN findanotherid = 1: try = findid(n2$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
'unknown variable
IF a THEN a$ = "Array not defined": GOTO errmes
'create variable
IF LEN(s$) THEN typ$ = s$ ELSE typ$ = t$
retval = dim2(n$, typ$, method, "")
IF Error_Happened THEN GOTO errmes
'note: variable created!
shrfound:
l$ = l$ + sp + RTRIM$(id.cn) + l2$
ids(currentid).share = ids(currentid).share OR 2 'set as temporarily shared
'method must apply to the current sub/function regardless of how the variable was defined in 'main'
lmay = LEN(RTRIM$(id.mayhave)): lmust = LEN(RTRIM$(id.musthave))
IF lmay <> 0 OR lmust <> 0 THEN
IF (method = 1 AND lmust = 0) OR (method = 0 AND lmay = 0) THEN
revertmaymusthaven = revertmaymusthaven + 1
revertmaymusthave(revertmaymusthaven) = currentid
SWAP ids(currentid).musthave, ids(currentid).mayhave
END IF
END IF
'switch back to sub/func
subfunc$ = oldsubfunc$
defdatahandle = 13
CLOSE #13: OPEN tmpdir$ + "data" + str2$(subfuncn) + ".txt" FOR APPEND AS #13
CLOSE #19: OPEN tmpdir$ + "free" + str2$(subfuncn) + ".txt" FOR APPEND AS #19
IF getelement$(a$, i) = "," THEN i = i + 1: l$ = l$ + sp2 + ",": GOTO subfuncshr
IF getelement$(a$, i) <> "" THEN a$ = "Expected ,": GOTO errmes
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
'EXIT SUB/FUNCTION
IF n = 2 THEN
IF firstelement$ = "EXIT" THEN
sf = 0
IF secondelement$ = "FUNCTION" THEN sf = 1
IF secondelement$ = "SUB" THEN sf = 2
IF sf THEN
IF LEN(subfunc) = 0 THEN a$ = "EXIT " + secondelement$ + " must be used within a SUB/FUNCTION": GOTO errmes
PRINT #12, "goto exit_subfunc;"
l$ = firstelement$ + sp + secondelement$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
END IF
'ASC statement (fully inline)
IF n >= 1 THEN
IF firstelement$ = "ASC" THEN
IF getelement$(a$, 2) <> "(" THEN a$ = "Expected ( after ASC": GOTO errmes
'calculate 3 parts
useposition = 0
part = 1
i = 3
a3$ = ""
stringvariable$ = ""
position$ = ""
B = 0
DO
IF i > n THEN 'got part 3
IF part <> 3 OR LEN(a3$) = 0 THEN a$ = "Expected ASC ( ... , ... ) = ...": GOTO errmes
expression$ = a3$
EXIT DO
END IF
a2$ = getelement$(ca$, i)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF B = -1 THEN
IF part = 1 THEN 'eg. ASC(a$)=65
IF getelement$(a$, i + 1) <> "=" THEN a$ = "Expected =": GOTO errmes
stringvariable$ = a3$
position$ = "1"
part = 3: a3$ = "": i = i + 1: GOTO ascgotpart
END IF
IF part = 2 THEN 'eg. ASC(a$,i)=65
IF getelement$(a$, i + 1) <> "=" THEN a$ = "Expected =": GOTO errmes
useposition = 1
position$ = a3$
part = 3: a3$ = "": i = i + 1: GOTO ascgotpart
END IF
'fall through, already in part 3
END IF
IF a2$ = "," AND B = 0 THEN
IF part = 1 THEN stringvariable$ = a3$: part = 2: a3$ = "": GOTO ascgotpart
END IF
IF LEN(a3$) THEN a3$ = a3$ + sp + a2$ ELSE a3$ = a2$
ascgotpart:
i = i + 1
LOOP
IF LEN(stringvariable$) = 0 OR LEN(position$) = 0 THEN a$ = "Expected ASC ( ... , ... ) = ...": GOTO errmes
'validate stringvariable$
stringvariable$ = fixoperationorder$(stringvariable$)
IF Error_Happened THEN GOTO errmes
l$ = "ASC" + sp2 + "(" + sp2 + tlayout$
e$ = evaluate(stringvariable$, sourcetyp)
IF Error_Happened THEN GOTO errmes
IF (sourcetyp AND ISREFERENCE) = 0 OR (sourcetyp AND ISSTRING) = 0 THEN a$ = "Expected ASC ( string-variable , ...": GOTO errmes
stringvariable$ = evaluatetotyp(stringvariable$, ISSTRING)
IF Error_Happened THEN GOTO errmes
IF position$ = "1" THEN
IF useposition THEN l$ = l$ + sp2 + "," + sp + "1" + sp2 + ")" + sp + "=" ELSE l$ = l$ + sp2 + ")" + sp + "="
PRINT #12, "tqbs=" + stringvariable$ + "; if (!new_error){"
e$ = fixoperationorder$(expression$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "tmp_long=" + e$ + "; if (!new_error){"
PRINT #12, "if (tqbs->len){tqbs->chr[0]=tmp_long;}else{error(5);}"
PRINT #12, "}}"
ELSE
PRINT #12, "tqbs=" + stringvariable$ + "; if (!new_error){"
e$ = fixoperationorder$(position$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$ + sp2 + ")" + sp + "="
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "tmp_fileno=" + e$ + "; if (!new_error){"
e$ = fixoperationorder$(expression$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
e$ = evaluatetotyp(e$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "tmp_long=" + e$ + "; if (!new_error){"
PRINT #12, "if ((tmp_fileno>0)&&(tmp_fileno<=tqbs->len)){tqbs->chr[tmp_fileno-1]=tmp_long;}else{error(5);}"
PRINT #12, "}}}"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
'MID$ statement
IF n >= 1 THEN
IF firstelement$ = "MID$" THEN
IF getelement$(a$, 2) <> "(" THEN a$ = "Expected ( after MID$": GOTO errmes
'calculate 4 parts
length$ = ""
part = 1
i = 3
a3$ = ""
stringvariable$ = ""
start$ = ""
B = 0
DO
IF i > n THEN
IF part <> 4 OR a3$ = "" THEN a$ = "Expected MID$(...)=...": GOTO errmes
stringexpression$ = a3$
EXIT DO
END IF
a2$ = getelement$(ca$, i)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF B = -1 THEN
IF part = 2 THEN
IF getelement$(a$, i + 1) <> "=" THEN a$ = "Expected = after )": GOTO errmes
start$ = a3$: part = 4: a3$ = "": i = i + 1: GOTO midgotpart
END IF
IF part = 3 THEN
IF getelement$(a$, i + 1) <> "=" THEN a$ = "Expected = after )": GOTO errmes
IF a3$ = "" THEN a$ = "Omit , before ) if omitting length in MID$ statement": GOTO errmes
length$ = a3$: part = 4: a3$ = "": i = i + 1: GOTO midgotpart
END IF
END IF
IF a2$ = "," AND B = 0 THEN
IF part = 1 THEN stringvariable$ = a3$: part = 2: a3$ = "": GOTO midgotpart
IF part = 2 THEN start$ = a3$: part = 3: a3$ = "": GOTO midgotpart
END IF
IF LEN(a3$) THEN a3$ = a3$ + sp + a2$ ELSE a3$ = a2$
midgotpart:
i = i + 1
LOOP
IF stringvariable$ = "" THEN a$ = "Syntax error": GOTO errmes
IF start$ = "" THEN a$ = "Syntax error": GOTO errmes
'check if it is a valid source string
stringvariable$ = fixoperationorder$(stringvariable$)
IF Error_Happened THEN GOTO errmes
l$ = "MID$" + sp2 + "(" + sp2 + tlayout$
e$ = evaluate(stringvariable$, sourcetyp)
IF Error_Happened THEN GOTO errmes
IF (sourcetyp AND ISREFERENCE) = 0 OR (sourcetyp AND ISSTRING) = 0 THEN a$ = "MID$ expects a string variable/array-element as its first argument": GOTO errmes
stringvariable$ = evaluatetotyp(stringvariable$, ISSTRING)
IF Error_Happened THEN GOTO errmes
start$ = evaluatetotyp(fixoperationorder$(start$), 32&)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
stringexpression$ = fixoperationorder$(stringexpression$)
IF Error_Happened THEN GOTO errmes
l2$ = tlayout$
stringexpression$ = evaluatetotyp(stringexpression$, ISSTRING)
IF Error_Happened THEN GOTO errmes
IF LEN(length$) THEN
length$ = fixoperationorder$(length$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
length$ = evaluatetotyp(length$, 32&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_mid(" + stringvariable$ + "," + start$ + "," + length$ + "," + stringexpression$ + ",1);"
ELSE
PRINT #12, "sub_mid(" + stringvariable$ + "," + start$ + ",0," + stringexpression$ + ",0);"
END IF
l$ = l$ + sp2 + ")" + sp + "=" + sp + l2$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
IF n >= 2 THEN
IF firstelement$ = "ERASE" THEN
i = 2
l$ = "ERASE"
erasenextarray:
var$ = getelement$(ca$, i)
x$ = var$: ls$ = removesymbol(x$)
IF Error_Happened THEN GOTO errmes
IF FindArray(var$) THEN
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + RTRIM$(id.cn) + ls$
'erase the array
clearerase:
n$ = RTRIM$(id.callname)
bytesperelement$ = str2((id.arraytype AND 511) \ 8)
IF id.arraytype AND ISSTRING THEN bytesperelement$ = str2(id.tsize)
IF id.arraytype AND ISOFFSETINBITS THEN bytesperelement$ = str2((id.arraytype AND 511)) + "/8+1"
IF id.arraytype AND ISUDT THEN
bytesperelement$ = str2(udtxsize(id.arraytype AND 511) \ 8)
END IF
PRINT #12, "if (" + n$ + "[2]&1){" 'array is defined
PRINT #12, "if (" + n$ + "[2]&2){" 'array is static
IF (id.arraytype AND ISSTRING) <> 0 AND (id.arraytype AND ISFIXEDLENGTH) = 0 THEN
PRINT #12, "tmp_long=";
FOR i2 = 1 TO ABS(id.arrayelements)
IF i2 <> 1 THEN PRINT #12, "*";
PRINT #12, n$ + "[" + str2(i2 * 4 - 4 + 5) + "]";
NEXT
PRINT #12, ";"
PRINT #12, "while(tmp_long--){"
PRINT #12, "((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]))->len=0;"
PRINT #12, "}"
ELSE
'numeric
'clear array
PRINT #12, "memset((void*)(" + n$ + "[0]),0,";
FOR i2 = 1 TO ABS(id.arrayelements)
IF i2 <> 1 THEN PRINT #12, "*";
PRINT #12, n$ + "[" + str2(i2 * 4 - 4 + 5) + "]";
NEXT
PRINT #12, "*" + bytesperelement$ + ");"
END IF
PRINT #12, "}else{" 'array is dynamic
'1. free memory & any allocated strings
IF (id.arraytype AND ISSTRING) <> 0 AND (id.arraytype AND ISFIXEDLENGTH) = 0 THEN
'free strings
PRINT #12, "tmp_long=";
FOR i2 = 1 TO ABS(id.arrayelements)
IF i2 <> 1 THEN PRINT #12, "*";
PRINT #12, n$ + "[" + str2(i2 * 4 - 4 + 5) + "]";
NEXT
PRINT #12, ";"
PRINT #12, "while(tmp_long--){"
PRINT #12, "qbs_free((qbs*)(((uint64*)(" + n$ + "[0]))[tmp_long]));"
PRINT #12, "}"
'free memory
PRINT #12, "free((void*)(" + n$ + "[0]));"
ELSE
'free memory
PRINT #12, "if (" + n$ + "[2]&4){" 'cmem array
PRINT #12, "cmem_dynamic_free((uint8*)(" + n$ + "[0]));"
PRINT #12, "}else{" 'non-cmem array
PRINT #12, "free((void*)(" + n$ + "[0]));"
PRINT #12, "}"
END IF
'2. set array (and its elements) as undefined
PRINT #12, n$ + "[2]^=1;" 'remove defined flag, keeping other flags (such as cmem)
'set dimensions as undefined
FOR i2 = 1 TO ABS(id.arrayelements)
B = i2 * 4
PRINT #12, n$ + "[" + str2(B) + "]=2147483647;" 'base
PRINT #12, n$ + "[" + str2(B + 1) + "]=0;" 'num. index
PRINT #12, n$ + "[" + str2(B + 2) + "]=0;" 'multiplier
NEXT
IF (id.arraytype AND ISSTRING) <> 0 AND (id.arraytype AND ISFIXEDLENGTH) = 0 THEN
PRINT #12, n$ + "[0]=(ptrszint)¬hingstring;"
ELSE
PRINT #12, n$ + "[0]=(ptrszint)nothingvalue;"
END IF
PRINT #12, "}" 'static/dynamic
PRINT #12, "}" 'array is defined
IF clearerasereturn = 1 THEN clearerasereturn = 0: GOTO clearerasereturned
GOTO erasedarray
END IF
IF Error_Happened THEN GOTO errmes
a$ = "Undefined array passed to ERASE": GOTO errmes
erasedarray:
IF i < n THEN
i = i + 1: n$ = getelement$(a$, i): IF n$ <> "," THEN a$ = "Expected ,": GOTO errmes
l$ = l$ + sp2 + ","
i = i + 1: IF i > n THEN a$ = "Expected , ...": GOTO errmes
GOTO erasenextarray
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
'DIM/REDIM/STATIC
IF n >= 2 THEN
dimoption = 0: redimoption = 0: commonoption = 0
IF firstelement$ = "DIM" THEN dimoption = 1
IF firstelement$ = "REDIM" THEN
dimoption = 2: redimoption = 1
IF secondelement$ = "_PRESERVE" THEN
redimoption = 2
IF n = 2 THEN a$ = "Expected REDIM _PRESERVE ...": GOTO errmes
END IF
END IF
IF firstelement$ = "STATIC" THEN dimoption = 3
IF firstelement$ = "COMMON" THEN dimoption = 1: commonoption = 1
IF dimoption THEN
l$ = firstelement$
IF dimoption = 3 AND subfuncn = 0 THEN a$ = "STATIC must be used within a SUB/FUNCTION": GOTO errmes
IF commonoption = 1 AND subfuncn <> 0 THEN a$ = "COMMON cannot be used within a SUB/FUNCTION": GOTO errmes
i = 2
IF redimoption = 2 THEN i = 3: l$ = l$ + sp + "_PRESERVE"
IF dimoption <> 3 THEN 'shared cannot be static
a2$ = getelement(a$, i)
IF a2$ = "SHARED" THEN
IF subfuncn <> 0 THEN a$ = "DIM/REDIM SHARED invalid within a SUB/FUNCTION": GOTO errmes
dimshared = 1
i = i + 1
l$ = l$ + sp + a2$
END IF
END IF
IF dimoption = 3 THEN dimstatic = 1: AllowLocalName = 1
dimnext:
notype = 0
listarray = 0
'old chain code
'chaincommonarray=0
varname$ = getelement(ca$, i): i = i + 1
IF varname$ = "" THEN a$ = "Expected variable-name": GOTO errmes
'get the next element
IF i >= n + 1 THEN e$ = "" ELSE e$ = getelement(a$, i): i = i + 1
'check if next element is a ( to create an array
elements$ = ""
IF e$ = "(" THEN
B = 1
FOR i = i TO n
e$ = getelement(ca$, i)
IF e$ = "(" THEN B = B + 1
IF e$ = ")" THEN B = B - 1
IF B = 0 THEN EXIT FOR
IF LEN(elements$) THEN elements$ = elements$ + sp + e$ ELSE elements$ = e$
NEXT
IF B <> 0 THEN a$ = "Expected )": GOTO errmes
i = i + 1 'set i to point to the next element
IF commonoption THEN elements$ = "?"
IF Debug THEN PRINT #9, "DIM2:array:elements$:[" + elements$ + "]"
'arrayname() means list array to it will automatically be static when it is formally dimensioned later
'note: listed arrays are always created in dynamic memory, but their contents are not erased
' this differs from static arrays from SUB...STATIC and the unique QB64 method -> STATIC arrayname(100)
IF dimoption = 3 THEN 'STATIC used
IF LEN(elements$) = 0 THEN 'nothing between brackets
listarray = 1 'add to static list
END IF
END IF
'last element was ")"
'get next element
IF i >= n + 1 THEN e$ = "" ELSE e$ = getelement(a$, i): i = i + 1
END IF 'e$="("
d$ = e$
dimmethod = 0
appendname$ = "" 'the symbol to append to name returned by dim2
appendtype$ = "" 'eg. sp+AS+spINTEGER
dim2typepassback$ = ""
'does varname have an appended symbol?
s$ = removesymbol$(varname$)
IF Error_Happened THEN GOTO errmes
IF validname(varname$) = 0 THEN a$ = "Invalid variable name": GOTO errmes
IF s$ <> "" THEN
typ$ = s$
dimmethod = 1
appendname$ = typ$
GOTO dimgottyp
END IF
IF d$ = "AS" THEN
appendtype$ = sp + "AS"
typ$ = ""
FOR i = i TO n
d$ = getelement(a$, i)
IF d$ = "," THEN i = i + 1: EXIT FOR
typ$ = typ$ + d$ + " "
appendtype$ = appendtype$ + sp + d$
d$ = ""
NEXT
appendtype$ = UCASE$(appendtype$) 'capitalise default types (udt override this later if necessary)
typ$ = RTRIM$(typ$)
GOTO dimgottyp
END IF
'auto-define type based on name
notype = 1
IF LEFT$(varname$, 1) = "_" THEN v = 27 ELSE v = ASC(UCASE$(varname$)) - 64
typ$ = defineaz(v)
dimmethod = 1
GOTO dimgottyp
dimgottyp:
IF d$ <> "" AND d$ <> "," THEN a$ = "DIM: Expected comma!": GOTO errmes
'In QBASIC, if no type info is given it can refer to an expeicit/formally defined array
IF notype <> 0 AND dimoption <> 3 AND dimoption <> 1 THEN 'not DIM or STATIC which only create new content
IF LEN(elements$) THEN 'an array
IF FindArray(varname$) THEN
IF LEN(RTRIM$(id.mayhave)) THEN 'explict/formally defined
typ$ = id2fulltypename$ 'adopt type
dimmethod = 0 'set as formally defined
END IF
END IF
END IF
END IF
IF dimoption = 3 AND LEN(elements$) THEN 'eg. STATIC a(100)
'does a conflicting array exist? (use findarray) if so again this should lead to duplicate definition
typ2$ = symbol2fulltypename$(typ$)
t = typname2typ(typ2$): ts = typname2typsize
'try name without any extension
IF FindArray(varname$) THEN 'name without any symbol
IF id.insubfuncn = subfuncn THEN 'global cannot conflict with static
IF LEN(RTRIM$(id.musthave)) THEN
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
ELSE
IF dimmethod = 0 THEN
a$ = "Name already in use": GOTO errmes 'explicit over explicit
ELSE
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
END IF
END IF
END IF
END IF
'add extension (if possible)
IF (t AND ISUDT) = 0 THEN
s2$ = type2symbol$(typ2$)
IF Error_Happened THEN GOTO errmes
IF FindArray(varname$ + s2$) THEN
IF id.insubfuncn = subfuncn THEN 'global cannot conflict with static
IF LEN(RTRIM$(id.musthave)) THEN
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
ELSE
IF dimmethod = 0 THEN
a$ = "Name already in use": GOTO errmes 'explicit over explicit
ELSE
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
END IF
END IF
END IF
END IF
END IF 'not a UDT
END IF
IF listarray THEN 'eg. STATIC a()
'note: list is cleared by END SUB/FUNCTION
'is a conflicting array already listed? if so this should cause a duplicate definition error
'check for conflict within list:
xi = 1
FOR x = 1 TO staticarraylistn
varname2$ = getelement$(staticarraylist, xi): xi = xi + 1
typ2$ = getelement$(staticarraylist, xi): xi = xi + 1
dimmethod2 = VAL(getelement$(staticarraylist, xi)): xi = xi + 1
'check if they are similar
IF UCASE$(varname$) = UCASE$(varname2$) THEN
IF dimmethod2 = 1 THEN
'old using symbol
IF symbol2fulltypename$(typ$) = typ2$ THEN a$ = "Name already in use": GOTO errmes
ELSE
'old using AS
IF dimmethod = 0 THEN
a$ = "Name already in use": GOTO errmes
ELSE
IF symbol2fulltypename$(typ$) = typ2$ THEN a$ = "Name already in use": GOTO errmes
END IF
END IF
END IF
NEXT
'does a conflicting array exist? (use findarray) if so again this should lead to duplicate definition
typ2$ = symbol2fulltypename$(typ$)
t = typname2typ(typ2$): ts = typname2typsize
'try name without any extension
IF FindArray(varname$) THEN 'name without any symbol
IF id.insubfuncn = subfuncn THEN 'global cannot conflict with static
IF LEN(RTRIM$(id.musthave)) THEN
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
ELSE
IF dimmethod = 0 THEN
a$ = "Name already in use": GOTO errmes 'explicit over explicit
ELSE
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
END IF
END IF
END IF
END IF
'add extension (if possible)
IF (t AND ISUDT) = 0 THEN
s2$ = type2symbol$(typ2$)
IF Error_Happened THEN GOTO errmes
IF FindArray(varname$ + s2$) THEN
IF id.insubfuncn = subfuncn THEN 'global cannot conflict with static
IF LEN(RTRIM$(id.musthave)) THEN
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
ELSE
IF dimmethod = 0 THEN
a$ = "Name already in use": GOTO errmes 'explicit over explicit
ELSE
'if types match then fail
IF (id.arraytype AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) = (t AND (ISFLOAT + ISUDT + 511 + ISUNSIGNED + ISSTRING + ISFIXEDLENGTH)) THEN
IF ts = id.tsize THEN
a$ = "Name already in use": GOTO errmes
END IF
END IF
END IF
END IF
END IF
END IF
END IF 'not a UDT
'note: static list arrays cannot be created until they are formally [or informally] (RE)DIM'd later
IF LEN(staticarraylist) THEN staticarraylist = staticarraylist + sp
staticarraylist = staticarraylist + varname$ + sp + symbol2fulltypename$(typ$) + sp + str2(dimmethod)
IF Error_Happened THEN GOTO errmes
staticarraylistn = staticarraylistn + 1
l$ = l$ + sp + varname$ + appendname$ + sp2 + "(" + sp2 + ")" + appendtype$
'note: none of the following code is run, dim2 call is also skipped
ELSE
olddimstatic = dimstatic
'check if varname is on the static list
IF LEN(elements$) THEN 'it's an array
IF subfuncn THEN 'it's in a sub/function
xi = 1
FOR x = 1 TO staticarraylistn
varname2$ = getelement$(staticarraylist, xi): xi = xi + 1
typ2$ = getelement$(staticarraylist, xi): xi = xi + 1
dimmethod2 = VAL(getelement$(staticarraylist, xi)): xi = xi + 1
'check if they are similar
IF UCASE$(varname$) = UCASE$(varname2$) THEN
IF symbol2fulltypename$(typ$) = typ2$ THEN
IF Error_Happened THEN GOTO errmes
IF dimmethod = dimmethod2 THEN
'match found!
varname$ = varname2$
dimstatic = 3
IF dimoption = 3 THEN a$ = "Array already listed as STATIC": GOTO errmes
END IF
END IF 'typ
END IF 'varname
NEXT
END IF
END IF
'COMMON exception
'note: COMMON alone does not imply SHARED
' if either(or both) COMMON & later DIM have SHARED, variable becomes shared
IF commonoption THEN
IF LEN(elements$) THEN
'add array to list
IF LEN(commonarraylist) THEN commonarraylist = commonarraylist + sp
'note: dimmethod distinguishes between a%(...) vs a(...) AS INTEGER
commonarraylist = commonarraylist + varname$ + sp + symbol2fulltypename$(typ$) + sp + str2(dimmethod) + sp + str2(dimshared)
IF Error_Happened THEN GOTO errmes
commonarraylistn = commonarraylistn + 1
IF Debug THEN PRINT #9, "common listed:" + varname$ + sp + symbol2fulltypename$(typ$) + sp + str2(dimmethod) + sp + str2(dimshared)
IF Error_Happened THEN GOTO errmes
x = 0
v$ = varname$
IF dimmethod = 1 THEN v$ = v$ + typ$
try = findid(v$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.arraytype THEN
t = typname2typ(typ$)
IF Error_Happened THEN GOTO errmes
s = typname2typsize
match = 1
'note: dimmethod 2 is already matched
IF dimmethod = 0 THEN
t2 = id.arraytype
s2 = id.tsize
IF (t AND ISFLOAT) <> (t2 AND ISFLOAT) THEN match = 0
IF (t AND ISUNSIGNED) <> (t2 AND ISUNSIGNED) THEN match = 0
IF (t AND ISSTRING) <> (t2 AND ISSTRING) THEN match = 0
IF (t AND ISFIXEDLENGTH) <> (t2 AND ISFIXEDLENGTH) THEN match = 0
IF (t AND ISOFFSETINBITS) <> (t2 AND ISOFFSETINBITS) THEN match = 0
IF (t AND ISUDT) <> (t2 AND ISUDT) THEN match = 0
IF (t AND 511) <> (t2 AND 511) THEN match = 0
IF s <> s2 THEN match = 0
'check for implicit/explicit declaration match
oldmethod = 0: IF LEN(RTRIM$(id.musthave)) THEN oldmethod = 1
IF oldmethod <> dimmethod THEN match = 0
END IF
IF match THEN
x = currentid
IF dimshared THEN ids(x).share = 1 'share if necessary
tlayout$ = RTRIM$(id.cn) + sp + "(" + sp2 + ")"
IF dimmethod = 0 THEN
IF t AND ISUDT THEN
dim2typepassback$ = RTRIM$(udtxcname(t AND 511))
ELSE
dim2typepassback$ = typ$
DO WHILE INSTR(dim2typepassback$, " ")
ASC(dim2typepassback$, INSTR(dim2typepassback$, " ")) = ASC(sp)
LOOP
dim2typepassback$ = UCASE$(dim2typepassback$)
END IF
END IF 'method 0
EXIT DO
END IF 'match
END IF 'arraytype
IF try = 2 THEN findanotherid = 1: try = findid(v$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
IF x = 0 THEN x = idn + 1
'note: the following code only adds include directives, everything else is defered
OPEN tmpdir$ + "chain.txt" FOR APPEND AS #22
'include directive
PRINT #22, "#include " + CHR$(34) + "chain" + str2$(x) + ".txt" + CHR$(34)
CLOSE #22
'create/clear include file
OPEN tmpdir$ + "chain" + str2$(x) + ".txt" FOR OUTPUT AS #22: CLOSE #22
OPEN tmpdir$ + "inpchain.txt" FOR APPEND AS #22
'include directive
PRINT #22, "#include " + CHR$(34) + "inpchain" + str2$(x) + ".txt" + CHR$(34)
CLOSE #22
'create/clear include file
OPEN tmpdir$ + "inpchain" + str2$(x) + ".txt" FOR OUTPUT AS #22: CLOSE #22
'note: elements$="?"
IF x <> idn + 1 THEN GOTO skipdim 'array already exists
GOTO dimcommonarray
END IF
END IF
'is varname on common list?
'******
IF LEN(elements$) THEN 'it's an array
IF subfuncn = 0 THEN 'not in a sub/function
IF Debug THEN PRINT #9, "common checking:" + varname$
xi = 1
FOR x = 1 TO commonarraylistn
varname2$ = getelement$(commonarraylist, xi): xi = xi + 1
typ2$ = getelement$(commonarraylist, xi): xi = xi + 1
dimmethod2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
dimshared2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
IF Debug THEN PRINT #9, "common checking against:" + varname2$ + sp + typ2$ + sp + str2(dimmethod2) + sp + str2(dimshared2)
'check if they are similar
IF varname$ = varname2$ THEN
IF symbol2fulltypename$(typ$) = typ2$ THEN
IF Error_Happened THEN GOTO errmes
IF dimmethod = dimmethod2 THEN
'match found!
'enforce shared status (if necessary)
IF dimshared2 THEN dimshared = dimshared OR 2 'temp force SHARED
'old chain code
'chaincommonarray=x
END IF 'method
END IF 'typ
END IF 'varname
NEXT
END IF
END IF
dimcommonarray:
retval = dim2(varname$, typ$, dimmethod, elements$)
IF Error_Happened THEN GOTO errmes
skipdim:
IF dimshared >= 2 THEN dimshared = dimshared - 2
'non-array COMMON variable
IF commonoption <> 0 AND LEN(elements$) = 0 THEN
'CHAIN.TXT (save)
use_global_byte_elements = 1
'switch output from main.txt to chain.txt
CLOSE #12
OPEN tmpdir$ + "chain.txt" FOR APPEND AS #12
l2$ = tlayout$
PRINT #12, "int32val=1;" 'simple variable
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
t = id.t
bits = t AND 511
IF t AND ISUDT THEN bits = udtxsize(t AND 511)
IF t AND ISSTRING THEN
IF t AND ISFIXEDLENGTH THEN
bits = id.tsize * 8
ELSE
PRINT #12, "int64val=__STRING_" + RTRIM$(id.n) + "->len*8;"
bits = 0
END IF
END IF
IF bits THEN
PRINT #12, "int64val=" + str2$(bits) + ";" 'size in bits
END IF
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
'put the variable
e$ = RTRIM$(id.n)
IF (t AND ISUDT) = 0 THEN
IF t AND ISFIXEDLENGTH THEN
e$ = e$ + "$" + str2$(id.tsize)
ELSE
e$ = e$ + typevalue2symbol$(t)
IF Error_Happened THEN GOTO errmes
END IF
END IF
e$ = evaluatetotyp(fixoperationorder$(e$), -4)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_put(FF,NULL," + e$ + ",0);"
tlayout$ = l2$
'revert output to main.txt
CLOSE #12
OPEN tmpdir$ + "main.txt" FOR APPEND AS #12
'INPCHAIN.TXT (load)
'switch output from main.txt to chain.txt
CLOSE #12
OPEN tmpdir$ + "inpchain.txt" FOR APPEND AS #12
l2$ = tlayout$
PRINT #12, "if (int32val==1){"
'get the size in bits
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
'***assume correct size***
e$ = RTRIM$(id.n)
t = id.t
IF (t AND ISUDT) = 0 THEN
IF t AND ISFIXEDLENGTH THEN
e$ = e$ + "$" + str2$(id.tsize)
ELSE
e$ = e$ + typevalue2symbol$(t)
IF Error_Happened THEN GOTO errmes
END IF
END IF
IF t AND ISSTRING THEN
IF (t AND ISFIXEDLENGTH) = 0 THEN
PRINT #12, "tqbs=qbs_new(int64val>>3,1);"
PRINT #12, "qbs_set(__STRING_" + RTRIM$(id.n) + ",tqbs);"
'now that the string is the correct size, the following GET command will work correctly...
END IF
END IF
e$ = evaluatetotyp(fixoperationorder$(e$), -4)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_get(FF,NULL," + e$ + ",0);"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);" 'get next command
PRINT #12, "}"
tlayout$ = l2$
'revert output to main.txt
CLOSE #12
OPEN tmpdir$ + "main.txt" FOR APPEND AS #12
use_global_byte_elements = 0
END IF
commonarraylisted:
n2 = numelements(tlayout$)
l$ = l$ + sp + getelement$(tlayout$, 1) + appendname$
IF n2 > 1 THEN
l$ = l$ + sp2 + getelements$(tlayout$, 2, n2)
END IF
IF LEN(appendtype$) THEN
IF LEN(dim2typepassback$) THEN appendtype$ = sp + "AS" + sp + dim2typepassback$
l$ = l$ + appendtype$
END IF
'modify first element name to include symbol
dimstatic = olddimstatic
END IF 'listarray=0
IF d$ = "," THEN l$ = l$ + sp2 + ",": GOTO dimnext
dimoption = 0
dimshared = 0
redimoption = 0
IF dimstatic = 1 THEN dimstatic = 0
AllowLocalName = 0
layoutdone = 1
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
GOTO finishedline
END IF
END IF
'THEN [GOTO] linenumber?
IF THENGOTO = 1 THEN
IF n = 1 THEN
l$ = ""
a = ASC(LEFT$(firstelement$, 1))
IF a = 46 OR (a >= 48 AND a <= 57) THEN a2$ = ca$: GOTO THENGOTO
END IF
END IF
'goto
IF n = 2 THEN
IF getelement$(a$, 1) = "GOTO" THEN
l$ = "GOTO"
a2$ = getelement$(ca$, 2)
THENGOTO:
IF validlabel(a2$) = 0 THEN a$ = "Invalid label!": GOTO errmes
v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk2:
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
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk2
END IF
END IF
IF x THEN
'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 a2$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = subfuncn
Labels(r).Error_Line = linenumber
END IF 'x
IF LEN(l$) THEN l$ = l$ + sp + tlayout$ ELSE l$ = tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "goto LABEL_" + a2$ + ";"
GOTO finishedline
END IF
END IF
IF firstelement$ = "RUN" THEN 'RUN
l$ = "RUN"
IF n = 1 THEN
'no parameters
PRINT #12, "sub_run_init();" 'note: called first to free up screen-locked image handles
PRINT #12, "sub_clear(NULL,NULL,NULL,NULL);" 'use functionality of CLEAR
IF LEN(subfunc$) THEN
PRINT #12, "QBMAIN(NULL);"
ELSE
PRINT #12, "goto S_0;"
END IF
ELSE
'parameter passed
e$ = getelements$(ca$, 2, n)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l2$ = tlayout$
ignore$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF n = 2 AND ((typ AND ISSTRING) = 0) THEN
'assume it's a label or line number
lbl$ = getelement$(ca$, 2)
IF validlabel(lbl$) = 0 THEN a$ = "Invalid label!": GOTO errmes 'invalid label
v = HashFind(lbl$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk501:
IF v THEN
s = Labels(r).Scope
IF s = 0 OR s = -1 THEN 'main scope?
IF s = -1 THEN Labels(r).Scope = 0 'acquire scope
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Scope_Restriction = subfuncn
Labels(r).Error_Line = linenumber
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk501
END IF
END IF
IF x THEN
'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 lbl$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = 0
Labels(r).Error_Line = linenumber
Labels(r).Scope_Restriction = subfuncn
END IF 'x
l$ = l$ + sp + tlayout$
PRINT #12, "sub_run_init();" 'note: called first to free up screen-locked image handles
PRINT #12, "sub_clear(NULL,NULL,NULL,NULL);" 'use functionality of CLEAR
IF LEN(subfunc$) THEN
PRINT #21, "if (run_from_line==" + str2(nextrunlineindex) + "){run_from_line=0;goto LABEL_" + lbl$ + ";}"
PRINT #12, "run_from_line=" + str2(nextrunlineindex) + ";"
nextrunlineindex = nextrunlineindex + 1
PRINT #12, "QBMAIN(NULL);"
ELSE
PRINT #12, "goto LABEL_" + lbl$ + ";"
END IF
ELSE
'assume it's a string containing a filename to execute
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
e$ = evaluatetotyp(e$, ISSTRING)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_run(" + e$ + ");"
l$ = l$ + sp + l2$
END IF 'isstring
END IF 'n=1
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF 'run
IF firstelement$ = "END" THEN
l$ = "END"
IF n > 1 THEN
e$ = getelements$(ca$, 2, n)
e$ = fixoperationorder$(e$): IF Error_Happened THEN GOTO errmes
l2$ = tlayout$
e$ = evaluatetotyp(e$, ISINTEGER64): IF Error_Happened THEN GOTO errmes
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + ");}" 'non-resumable error check (cannot exit without handling errors)
PRINT #12, "exit_code=" + e$ + ";"
l$ = l$ + sp + l2$
END IF
xend
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF firstelement$ = "SYSTEM" THEN
l$ = "SYSTEM"
IF n > 1 THEN
e$ = getelements$(ca$, 2, n)
e$ = fixoperationorder$(e$): IF Error_Happened THEN GOTO errmes
l2$ = tlayout$
e$ = evaluatetotyp(e$, ISINTEGER64): IF Error_Happened THEN GOTO errmes
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + ");}" 'non-resumable error check (cannot exit without handling errors)
PRINT #12, "exit_code=" + e$ + ";"
l$ = l$ + sp + l2$
END IF
PRINT #12, "if (sub_gl_called) error(271);"
PRINT #12, "close_program=1;"
PRINT #12, "end();"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF n >= 1 THEN
IF firstelement$ = "STOP" THEN
l$ = "STOP"
IF n > 1 THEN
e$ = getelements$(ca$, 2, n)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = "STOP" + sp + tlayout$
e$ = evaluatetotyp(e$, 64)
IF Error_Happened THEN GOTO errmes
'note: this value is currently ignored but evaluated for checking reasons
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "close_program=1;"
PRINT #12, "end();"
GOTO finishedline
END IF
END IF
IF n = 2 THEN
IF firstelement$ = "GOSUB" THEN
xgosub ca$, n
IF Error_Happened THEN GOTO errmes
'note: layout implemented in xgosub
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "RETURN" THEN
IF n = 1 THEN
PRINT #12, "#include " + CHR$(34) + "ret" + str2$(subfuncn) + ".txt" + CHR$(34)
l$ = "RETURN"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
ELSE
'label/linenumber follows
IF subfuncn <> 0 THEN a$ = "RETURN linelabel/linenumber invalid within a SUB/FUNCTION": GOTO errmes
IF n > 2 THEN a$ = "Expected linelabel/linenumber after RETURN": GOTO errmes
PRINT #12, "if (!next_return_point) error(3);" 'check return point available
PRINT #12, "next_return_point--;" 'destroy return point
a2$ = getelement$(ca$, 2)
IF validlabel(a2$) = 0 THEN a$ = "Invalid label!": GOTO errmes
v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk505:
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
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk505
END IF
END IF
IF x THEN
'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 a2$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = subfuncn
Labels(r).Error_Line = linenumber
END IF 'x
PRINT #12, "goto LABEL_" + a2$ + ";"
l$ = "RETURN" + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "RESUME" THEN
l$ = "RESUME"
IF n = 1 THEN
resumeprev:
IF C_Core = 0 THEN PRINT #12, "if (!error_handling){error(20);}else{error_retry=1; qbevent=1; error_handling=0; error_err=0; return NULL;}"
IF C_Core = 1 THEN PRINT #12, "if (!error_handling){error(20);}else{error_retry=1; qbevent=1; error_handling=0; error_err=0; return;}"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF n > 2 THEN a$ = "Too many parameters": GOTO errmes
s$ = getelement$(ca$, 2)
IF UCASE$(s$) = "NEXT" THEN
IF C_Core = 0 THEN PRINT #12, "if (!error_handling){error(20);}else{error_handling=0; error_err=0; return NULL;}"
IF C_Core = 1 THEN PRINT #12, "if (!error_handling){error(20);}else{error_handling=0; error_err=0; return;}"
l$ = l$ + sp + "NEXT"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF s$ = "0" THEN l$ = l$ + sp + "0": GOTO resumeprev
IF validlabel(s$) = 0 THEN a$ = "Invalid label passed to RESUME": GOTO errmes
v = HashFind(s$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk506:
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
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk506
END IF
END IF
IF x THEN
'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 s$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = subfuncn
Labels(r).Error_Line = linenumber
END IF 'x
l$ = l$ + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
PRINT #12, "if (!error_handling){error(20);}else{error_handling=0; error_err=0; goto LABEL_" + s$ + ";}"
GOTO finishedline
END IF
END IF
IF n = 4 THEN
IF getelements(a$, 1, 3) = "ON" + sp + "ERROR" + sp + "GOTO" THEN
l$ = "ON" + sp + "ERROR" + sp + "GOTO"
lbl$ = getelement$(ca$, 4)
IF lbl$ = "0" THEN
PRINT #12, "error_goto_line=0;"
l$ = l$ + sp + "0"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF validlabel(lbl$) = 0 THEN a$ = "Invalid label": GOTO errmes
v = HashFind(lbl$, HASHFLAG_LABEL, ignore, r)
x = 1
labchk6:
IF v THEN
s = Labels(r).Scope
IF s = 0 OR s = -1 THEN 'main scope?
IF s = -1 THEN Labels(r).Scope = 0 'acquire scope
x = 0 'already defined
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Scope_Restriction = subfuncn
Labels(r).Error_Line = linenumber
ELSE
IF v = 2 THEN v = HashFindCont(ignore, r): GOTO labchk6
END IF
END IF
IF x THEN
'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 lbl$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = 0
Labels(r).Error_Line = linenumber
Labels(r).Scope_Restriction = subfuncn
END IF 'x
l$ = l$ + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
errorlabels = errorlabels + 1
PRINT #12, "error_goto_line=" + str2(errorlabels) + ";"
PRINT #14, "if (error_goto_line==" + str2(errorlabels) + "){error_handling=1; goto LABEL_" + lbl$ + ";}"
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "RESTORE" THEN
l$ = "RESTORE"
IF n = 1 THEN
PRINT #12, "data_offset=0;"
ELSE
IF n > 2 THEN a$ = "Syntax error": GOTO errmes
lbl$ = getelement$(ca$, 2)
IF validlabel(lbl$) = 0 THEN a$ = "Invalid label": GOTO errmes
'rule: a RESTORE label has no scope, therefore, only one instance of that label may exist
'how: enforced by a post check for duplicates
v = HashFind(lbl$, HASHFLAG_LABEL, ignore, r)
x = 1
IF v THEN 'already defined
x = 0
tlayout$ = RTRIM$(Labels(r).cn)
Labels(r).Data_Referenced = 1 'make sure the data referenced flag is set
IF Labels(r).Error_Line = 0 THEN Labels(r).Error_Line = linenumber
END IF
IF x THEN
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 lbl$, HASHFLAG_LABEL, nLabels
r = nLabels
Labels(r).State = 0
Labels(r).cn = tlayout$
Labels(r).Scope = -1 'modifyable scope
Labels(r).Error_Line = linenumber
Labels(r).Data_Referenced = 1
END IF 'x
l$ = l$ + sp + tlayout$
PRINT #12, "data_offset=data_at_LABEL_" + lbl$ + ";"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
'ON ... GOTO/GOSUB
IF n >= 1 THEN
IF firstelement$ = "ON" THEN
xongotogosub a$, ca$, n
IF Error_Happened THEN GOTO errmes
GOTO finishedline
END IF
END IF
'(_MEM) _MEMPUT _MEMGET
IF n >= 1 THEN
IF firstelement$ = "_MEMGET" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
'get expressions
e$ = ""
B = 0
ne = 0
FOR i2 = 2 TO n
e2$ = getelement$(ca$, i2)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF e2$ = "," AND B = 0 THEN
ne = ne + 1
IF ne = 1 THEN blk$ = e$: e$ = ""
IF ne = 2 THEN offs$ = e$: e$ = ""
IF ne = 3 THEN a$ = "Syntax error": GOTO errmes
ELSE
IF LEN(e$) = 0 THEN e$ = e2$ ELSE e$ = e$ + sp + e2$
END IF
NEXT
var$ = e$
IF e$ = "" OR ne <> 2 THEN a$ = "Expected _MEMGET mem-reference,offset,variable": GOTO errmes
l$ = "_MEMGET" + sp
e$ = fixoperationorder$(blk$): IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
test$ = evaluate(e$, typ): IF Error_Happened THEN GOTO errmes
IF (typ AND ISUDT) = 0 OR (typ AND 511) <> 1 THEN a$ = "Expected _MEM type": GOTO errmes
blkoffs$ = evaluatetotyp(e$, -6)
' IF typ AND ISREFERENCE THEN e$ = refer(e$, typ, 0)
'PRINT #12, blkoffs$ '???
e$ = fixoperationorder$(offs$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluatetotyp(e$, OFFSETTYPE - ISPOINTER): IF Error_Happened THEN GOTO errmes
offs$ = e$
'PRINT #12, e$ '???
e$ = fixoperationorder$(var$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
varsize$ = evaluatetotyp(e$, -5): IF Error_Happened THEN GOTO errmes
varoffs$ = evaluatetotyp(e$, -6): IF Error_Happened THEN GOTO errmes
'PRINT #12, varoffs$ '???
'PRINT #12, varsize$ '???
'what do we do next
'need to know offset of variable and its size
'known sizes will be handled by designated command casts, otherwise use memmove
s = 0
IF varsize$ = "1" THEN s = 1: st$ = "int8"
IF varsize$ = "2" THEN s = 2: st$ = "int16"
IF varsize$ = "4" THEN s = 4: st$ = "int32"
IF varsize$ = "8" THEN s = 8: st$ = "int64"
IF NoChecks THEN
'fast version:
IF s THEN
PRINT #12, "*(" + st$ + "*)" + varoffs$ + "=*(" + st$ + "*)(" + offs$ + ");"
ELSE
PRINT #12, "memmove(" + varoffs$ + ",(void*)" + offs$ + "," + varsize$ + ");"
END IF
ELSE
'safe version:
PRINT #12, "tmp_long=" + offs$ + ";"
'is mem block init?
PRINT #12, "if ( ((mem_block*)(" + blkoffs$ + "))->lock_offset ){"
'are region and id valid?
PRINT #12, "if ("
PRINT #12, "tmp_long < ((mem_block*)(" + blkoffs$ + "))->offset ||"
PRINT #12, "(tmp_long+(" + varsize$ + ")) > ( ((mem_block*)(" + blkoffs$ + "))->offset + ((mem_block*)(" + blkoffs$ + "))->size) ||"
PRINT #12, "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id ){"
'diagnose error
PRINT #12, "if (" + "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id" + ") error(308); else error(300);"
PRINT #12, "}else{"
IF s THEN
PRINT #12, "*(" + st$ + "*)" + varoffs$ + "=*(" + st$ + "*)tmp_long;"
ELSE
PRINT #12, "memmove(" + varoffs$ + ",(void*)tmp_long," + varsize$ + ");"
END IF
PRINT #12, "}"
PRINT #12, "}else error(309);"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "_MEMPUT" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
'get expressions
typ$ = ""
e$ = ""
B = 0
ne = 0
FOR i2 = 2 TO n
e2$ = getelement$(ca$, i2)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF (e2$ = "," OR UCASE$(e2$) = "AS") AND B = 0 THEN
ne = ne + 1
IF ne = 1 THEN blk$ = e$: e$ = ""
IF ne = 2 THEN offs$ = e$: e$ = ""
IF ne = 3 THEN var$ = e$: e$ = ""
IF (UCASE$(e2$) = "AS" AND ne <> 3) OR (ne = 3 AND UCASE$(e2$) <> "AS") OR ne = 4 THEN a$ = "Expected _MEMPUT mem-reference,offset,variable|value[AS type]": GOTO errmes
ELSE
IF LEN(e$) = 0 THEN e$ = e2$ ELSE e$ = e$ + sp + e2$
END IF
NEXT
IF ne < 2 OR e$ = "" THEN a$ = "Expected _MEMPUT mem-reference,offset,variable|value[AS type]": GOTO errmes
IF ne = 2 THEN var$ = e$ ELSE typ$ = UCASE$(e$)
l$ = "_MEMPUT" + sp
e$ = fixoperationorder$(blk$): IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
test$ = evaluate(e$, typ): IF Error_Happened THEN GOTO errmes
IF (typ AND ISUDT) = 0 OR (typ AND 511) <> 1 THEN a$ = "Expected _MEM type": GOTO errmes
blkoffs$ = evaluatetotyp(e$, -6)
e$ = fixoperationorder$(offs$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluatetotyp(e$, OFFSETTYPE - ISPOINTER): IF Error_Happened THEN GOTO errmes
offs$ = e$
IF ne = 2 THEN
e$ = fixoperationorder$(var$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
test$ = evaluate(e$, t)
IF (t AND ISREFERENCE) = 0 AND (t AND ISSTRING) THEN
PRINT #12, "g_tmp_str=" + test$ + ";"
varsize$ = "g_tmp_str->len"
varoffs$ = "g_tmp_str->chr"
ELSE
varsize$ = evaluatetotyp(e$, -5): IF Error_Happened THEN GOTO errmes
varoffs$ = evaluatetotyp(e$, -6): IF Error_Happened THEN GOTO errmes
END IF
'known sizes will be handled by designated command casts, otherwise use memmove
s = 0
IF varsize$ = "1" THEN s = 1: st$ = "int8"
IF varsize$ = "2" THEN s = 2: st$ = "int16"
IF varsize$ = "4" THEN s = 4: st$ = "int32"
IF varsize$ = "8" THEN s = 8: st$ = "int64"
IF NoChecks THEN
'fast version:
IF s THEN
PRINT #12, "*(" + st$ + "*)(" + offs$ + ")=*(" + st$ + "*)" + varoffs$ + ";"
ELSE
PRINT #12, "memmove((void*)" + offs$ + "," + varoffs$ + "," + varsize$ + ");"
END IF
ELSE
'safe version:
PRINT #12, "tmp_long=" + offs$ + ";"
'is mem block init?
PRINT #12, "if ( ((mem_block*)(" + blkoffs$ + "))->lock_offset ){"
'are region and id valid?
PRINT #12, "if ("
PRINT #12, "tmp_long < ((mem_block*)(" + blkoffs$ + "))->offset ||"
PRINT #12, "(tmp_long+(" + varsize$ + ")) > ( ((mem_block*)(" + blkoffs$ + "))->offset + ((mem_block*)(" + blkoffs$ + "))->size) ||"
PRINT #12, "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id ){"
'diagnose error
PRINT #12, "if (" + "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id" + ") error(308); else error(300);"
PRINT #12, "}else{"
IF s THEN
PRINT #12, "*(" + st$ + "*)tmp_long=*(" + st$ + "*)" + varoffs$ + ";"
ELSE
PRINT #12, "memmove((void*)tmp_long," + varoffs$ + "," + varsize$ + ");"
END IF
PRINT #12, "}"
PRINT #12, "}else error(309);"
END IF
ELSE
'... AS type method
'FUNCTION typname2typ& (t2$)
'typname2typsize = 0 'the default
t = typname2typ(typ$)
IF t = 0 THEN a$ = "Invalid type": GOTO errmes
IF (t AND ISOFFSETINBITS) <> 0 OR (t AND ISUDT) <> 0 OR (t AND ISSTRING) THEN a$ = "_MEMPUT requires numeric type": GOTO errmes
IF (t AND ISPOINTER) THEN t = t - ISPOINTER
'attempt conversion...
e$ = fixoperationorder$(var$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$ + sp + "AS" + sp + typ$
e$ = evaluatetotyp(e$, t): IF Error_Happened THEN GOTO errmes
st$ = typ2ctyp$(t, "")
varsize$ = str2((t AND 511) \ 8)
IF NoChecks THEN
'fast version:
PRINT #12, "*(" + st$ + "*)(" + offs$ + ")=" + e$ + ";"
ELSE
'safe version:
PRINT #12, "tmp_long=" + offs$ + ";"
'is mem block init?
PRINT #12, "if ( ((mem_block*)(" + blkoffs$ + "))->lock_offset ){"
'are region and id valid?
PRINT #12, "if ("
PRINT #12, "tmp_long < ((mem_block*)(" + blkoffs$ + "))->offset ||"
PRINT #12, "(tmp_long+(" + varsize$ + ")) > ( ((mem_block*)(" + blkoffs$ + "))->offset + ((mem_block*)(" + blkoffs$ + "))->size) ||"
PRINT #12, "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id ){"
'diagnose error
PRINT #12, "if (" + "((mem_lock*)((mem_block*)(" + blkoffs$ + "))->lock_offset)->id != ((mem_block*)(" + blkoffs$ + "))->lock_id" + ") error(308); else error(300);"
PRINT #12, "}else{"
PRINT #12, "*(" + st$ + "*)tmp_long=" + e$ + ";"
PRINT #12, "}"
PRINT #12, "}else error(309);"
END IF
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
IF n >= 1 THEN
IF firstelement$ = "_MEMFILL" THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
'get expressions
typ$ = ""
e$ = ""
B = 0
ne = 0
FOR i2 = 2 TO n
e2$ = getelement$(ca$, i2)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF (e2$ = "," OR UCASE$(e2$) = "AS") AND B = 0 THEN
ne = ne + 1
IF ne = 1 THEN blk$ = e$: e$ = ""
IF ne = 2 THEN offs$ = e$: e$ = ""
IF ne = 3 THEN bytes$ = e$: e$ = ""
IF ne = 4 THEN var$ = e$: e$ = ""
IF (UCASE$(e2$) = "AS" AND ne <> 4) OR (ne = 4 AND UCASE$(e2$) <> "AS") OR ne = 5 THEN a$ = "Expected _MEMFILL mem-reference,offset,bytes,variable|value[AS type]": GOTO errmes
ELSE
IF LEN(e$) = 0 THEN e$ = e2$ ELSE e$ = e$ + sp + e2$
END IF
NEXT
IF ne < 3 OR e$ = "" THEN a$ = "Expected _MEMFILL mem-reference,offset,bytes,variable|value[AS type]": GOTO errmes
IF ne = 3 THEN var$ = e$ ELSE typ$ = UCASE$(e$)
l$ = "_MEMFILL" + sp
e$ = fixoperationorder$(blk$): IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
test$ = evaluate(e$, typ): IF Error_Happened THEN GOTO errmes
IF (typ AND ISUDT) = 0 OR (typ AND 511) <> 1 THEN a$ = "Expected _MEM type": GOTO errmes
blkoffs$ = evaluatetotyp(e$, -6)
e$ = fixoperationorder$(offs$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluatetotyp(e$, OFFSETTYPE - ISPOINTER): IF Error_Happened THEN GOTO errmes
offs$ = e$
e$ = fixoperationorder$(bytes$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluatetotyp(e$, OFFSETTYPE - ISPOINTER): IF Error_Happened THEN GOTO errmes
bytes$ = e$
IF ne = 3 THEN 'no AS
e$ = fixoperationorder$(var$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
test$ = evaluate(e$, t)
IF (t AND ISREFERENCE) = 0 AND (t AND ISSTRING) THEN
PRINT #12, "tmp_long=(ptrszint)" + test$ + ";"
varsize$ = "((qbs*)tmp_long)->len"
varoffs$ = "((qbs*)tmp_long)->chr"
ELSE
varsize$ = evaluatetotyp(e$, -5): IF Error_Happened THEN GOTO errmes
varoffs$ = evaluatetotyp(e$, -6): IF Error_Happened THEN GOTO errmes
END IF
IF NoChecks THEN
PRINT #12, "sub__memfill_nochecks(" + offs$ + "," + bytes$ + ",(ptrszint)" + varoffs$ + "," + varsize$ + ");"
ELSE
PRINT #12, "sub__memfill((mem_block*)" + blkoffs$ + "," + offs$ + "," + bytes$ + ",(ptrszint)" + varoffs$ + "," + varsize$ + ");"
END IF
ELSE
'... AS type method
t = typname2typ(typ$)
IF t = 0 THEN a$ = "Invalid type": GOTO errmes
IF (t AND ISOFFSETINBITS) <> 0 OR (t AND ISUDT) <> 0 OR (t AND ISSTRING) THEN a$ = "_MEMFILL requires numeric type": GOTO errmes
IF (t AND ISPOINTER) THEN t = t - ISPOINTER
'attempt conversion...
e$ = fixoperationorder$(var$): IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$ + sp + "AS" + sp + typ$
e$ = evaluatetotyp(e$, t): IF Error_Happened THEN GOTO errmes
c$ = "sub__memfill_"
IF NoChecks THEN c$ = "sub__memfill_nochecks_"
IF t AND ISOFFSET THEN
c$ = c$ + "OFFSET"
ELSE
IF t AND ISFLOAT THEN
IF (t AND 511) = 32 THEN c$ = c$ + "SINGLE"
IF (t AND 511) = 64 THEN c$ = c$ + "DOUBLE"
IF (t AND 511) = 256 THEN c$ = c$ + "FLOAT" 'padded variable
ELSE
c$ = c$ + str2((t AND 511) \ 8)
END IF
END IF
c$ = c$ + "("
IF NoChecks = 0 THEN c$ = c$ + "(mem_block*)" + blkoffs$ + ","
PRINT #12, c$ + offs$ + "," + bytes$ + "," + e$ + ");"
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
'note: ABSOLUTE cannot be used without CALL
cispecial = 0
IF n > 1 THEN
IF firstelement$ = "INTERRUPT" OR firstelement$ = "INTERRUPTX" THEN
a$ = "CALL" + sp + firstelement$ + sp + "(" + sp + getelements$(a$, 2, n) + sp + ")"
ca$ = "CALL" + sp + firstelement$ + sp + "(" + sp + getelements$(ca$, 2, n) + sp + ")"
n = n + 3
firstelement$ = "CALL"
cispecial = 1
'fall through
END IF
END IF
usecall = 0
IF firstelement$ = "CALL" THEN
usecall = 1
IF n = 1 THEN a$ = "Expected CALL sub-name [(...)]": GOTO errmes
cn$ = getelement$(ca$, 2): n$ = UCASE$(cn$)
IF n > 2 THEN
IF n <= 4 THEN a$ = "Expected CALL sub-name (...)": GOTO errmes
IF getelement$(a$, 3) <> "(" OR getelement$(a$, n) <> ")" THEN a$ = "Expected CALL sub-name (...)": GOTO errmes
a$ = n$ + sp + getelements$(a$, 4, n - 1)
ca$ = cn$ + sp + getelements$(ca$, 4, n - 1)
IF n$ = "INTERRUPT" OR n$ = "INTERRUPTX" THEN 'assume CALL INTERRUPT[X] request
'print "CI: call interrupt command reached":sleep 1
IF n$ = "INTERRUPT" THEN PRINT #12, "call_interrupt("; ELSE PRINT #12, "call_interruptx(";
argn = 0
n = numelements(a$)
B = 0
e$ = ""
FOR i = 2 TO n
e2$ = getelement$(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF (e2$ = "," AND B = 0) OR i = n THEN
IF i = n THEN
IF e$ = "" THEN e$ = e2$ ELSE e$ = e$ + sp + e2$
END IF
argn = argn + 1
IF argn = 1 THEN 'interrupt number
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = "CALL" + sp + n$ + sp2 + "(" + sp2 + tlayout$
IF cispecial = 1 THEN l$ = n$ + sp + tlayout$
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN GOTO errmes
'print "CI: evaluated interrupt number as ["+e$+"]":sleep 1
PRINT #12, e$;
END IF
IF argn = 2 OR argn = 3 THEN 'inregs, outregs
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e2$ = e$
e$ = evaluatetotyp(e$, -2) 'offset+size
IF Error_Happened THEN GOTO errmes
'print "CI: evaluated in/out regs ["+e2$+"] as ["+e$+"]":sleep 1
PRINT #12, "," + e$;
END IF
e$ = ""
ELSE
IF e$ = "" THEN e$ = e2$ ELSE e$ = e$ + sp + e2$
END IF
NEXT
IF argn <> 3 THEN a$ = "Expected CALL INTERRUPT (interrupt-no, inregs, outregs)": GOTO errmes
PRINT #12, ");"
IF cispecial = 0 THEN l$ = l$ + sp2 + ")"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
'print "CI: done":sleep 1
GOTO finishedline
END IF 'call interrupt
'call to CALL ABSOLUTE beyond reasonable doubt
IF n$ = "ABSOLUTE" THEN
l$ = "CALL" + sp + "ABSOLUTE" + sp2 + "(" + sp2
argn = 0
n = numelements(a$)
B = 0
e$ = ""
FOR i = 2 TO n
e2$ = getelement$(ca$, i)
IF e2$ = "(" THEN B = B + 1
IF e2$ = ")" THEN B = B - 1
IF (e2$ = "," AND B = 0) OR i = n THEN
IF i < n THEN
IF e$ = "" THEN a$ = "Expected expression before , or )": GOTO errmes
'1. variable or value?
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + "," + sp
ignore$ = evaluate(e$, typ)
IF Error_Happened THEN GOTO errmes
IF (typ AND ISPOINTER) <> 0 AND (typ AND ISREFERENCE) <> 0 THEN
'assume standard variable
'assume not string/array/udt/etc
e$ = "VARPTR" + sp + "(" + sp + e$ + sp + ")"
e$ = evaluatetotyp(e$, UINTEGERTYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
ELSE
'assume not string
'single, double or integer64?
IF typ AND ISFLOAT THEN
IF (typ AND 511) = 32 THEN
e$ = evaluatetotyp(e$, SINGLETYPE - ISPOINTER)
IF Error_Happened THEN GOTO errmes
v$ = "pass" + str2$(uniquenumber)
PRINT #defdatahandle, "float *" + v$ + "=NULL;"
PRINT #13, "if(" + v$ + "==NULL){"
PRINT #13, "cmem_sp-=4;"
PRINT #13, v$ + "=(float*)(dblock+cmem_sp);"
PRINT #13, "if (cmem_sp2
a$ = n$
ca$ = cn$
usecall = 2
END IF 'n>2
n = numelements(a$)
firstelement$ = getelement$(a$, 1)
'valid SUB name
validsub = 0
findidsecondarg = "": IF n >= 2 THEN findidsecondarg = getelement$(a$, 2)
try = findid(firstelement$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.subfunc = 2 THEN validsub = 1: EXIT DO
IF try = 2 THEN
findidsecondarg = "": IF n >= 2 THEN findidsecondarg = getelement$(a$, 2)
findanotherid = 1
try = findid(firstelement$)
IF Error_Happened THEN GOTO errmes
ELSE
try = 0
END IF
LOOP
IF validsub = 0 THEN a$ = "Expected CALL sub-name [(...)]": GOTO errmes
END IF
'sub?
IF n >= 1 THEN
IF firstelement$ = "?" THEN firstelement$ = "PRINT"
findidsecondarg = "": IF n >= 2 THEN findidsecondarg = getelement$(a$, 2)
try = findid(firstelement$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.subfunc = 2 THEN
'check symbol
s$ = removesymbol$(firstelement$ + "")
IF Error_Happened THEN GOTO errmes
IF ASC(id.musthave) = 36 THEN '="$"
IF s$ <> "$" THEN GOTO notsubcall 'missing musthave "$"
ELSE
IF LEN(s$) THEN GOTO notsubcall 'unrequired symbol added
END IF
'check for variable assignment
IF n > 1 THEN
IF ASC(id.specialformat) <> 61 THEN '<>"="
IF ASC(getelement$(a$, 2)) = 61 THEN GOTO notsubcall 'assignment, not sub call
END IF
END IF
'check for array assignment
IF n > 2 THEN
IF getelement$(a$, 2) = "(" THEN
B = 1
FOR i = 3 TO n
e$ = getelement$(a$, i)
IF e$ = "(" THEN B = B + 1
IF e$ = ")" THEN
B = B - 1
IF B = 0 THEN
IF i = n THEN EXIT FOR
IF getelement$(a$, i + 1) = "=" THEN GOTO notsubcall
END IF
END IF
NEXT
END IF
END IF
IF id.NoCloud THEN
IF Cloud THEN a$ = "Feature not supported on QLOUD": GOTO errmes '***NOCLOUD***
END IF
'generate error on driect _GL call
IF firstelement$ = "_GL" THEN a$ = "Cannot call SUB _GL directly": GOTO errmes
IF firstelement$ = "OPEN" THEN
'gwbasic or qbasic version?
B = 0
FOR x = 2 TO n
a2$ = getelement$(a$, x)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF a2$ = "FOR" OR a2$ = "AS" THEN EXIT FOR 'qb style open verified
IF B = 0 AND a2$ = "," THEN 'the gwbasic version includes a comma after the first string expression
findanotherid = 1
try = findid(firstelement$) 'id of sub_open_gwbasic
IF Error_Happened THEN GOTO errmes
EXIT FOR
END IF
NEXT
END IF
'IF findid(firstelement$) THEN
'IF id.subfunc = 2 THEN
IF firstelement$ = "CLOSE" OR firstelement$ = "RESET" THEN
IF firstelement$ = "RESET" THEN
IF n > 1 THEN a$ = "Syntax error": GOTO errmes
END IF
l$ = firstelement$
IF n = 1 THEN
PRINT #12, "sub_close(NULL,0);" 'closes all files
ELSE
l$ = l$ + sp
B = 0
s = 0
a3$ = ""
FOR x = 2 TO n
a2$ = getelement$(ca$, x)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF a2$ = "#" AND B = 0 THEN
IF s = 0 THEN s = 1 ELSE a$ = "Unexpected #": GOTO errmes
l$ = l$ + "#" + sp2
GOTO closenexta
END IF
IF a2$ = "," AND B = 0 THEN
IF s = 2 THEN
e$ = fixoperationorder$(a3$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$ + sp2 + "," + sp
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_close(" + e$ + ",1);"
a3$ = ""
s = 0
GOTO closenexta
ELSE
a$ = "Expected expression before ,": GOTO errmes
END IF
END IF
s = 2
IF a3$ = "" THEN a3$ = a2$ ELSE a3$ = a3$ + sp + a2$
closenexta:
NEXT
IF s = 2 THEN
e$ = fixoperationorder$(a3$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + tlayout$
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_close(" + e$ + ",1);"
ELSE
l$ = LEFT$(l$, LEN(l$) - 1)
END IF
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF 'close
'data, restore, read
IF firstelement$ = "READ" THEN 'file input
xread ca$, n
IF Error_Happened THEN GOTO errmes
'note: layout done in xread sub
GOTO finishedline
END IF 'read
lineinput = 0
IF n >= 2 THEN
IF firstelement$ = "LINE" AND secondelement$ = "INPUT" THEN
lineinput = 1
a$ = RIGHT$(a$, LEN(a$) - 5): ca$ = RIGHT$(ca$, LEN(ca$) - 5): n = n - 1 'remove "LINE"
firstelement$ = "INPUT"
END IF
END IF
IF firstelement$ = "INPUT" THEN 'file input
IF n > 1 THEN
IF getelement$(a$, 2) = "#" THEN
l$ = "INPUT" + sp + "#": IF lineinput THEN l$ = "LINE" + sp + l$
u$ = str2$(uniquenumber)
'which file?
IF n = 2 THEN a$ = "Expected # ... , ...": GOTO errmes
a3$ = ""
B = 0
FOR i = 3 TO n
a2$ = getelement$(ca$, i)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF a2$ = "," AND B = 0 THEN
IF a3$ = "" THEN a$ = "Expected # ... , ...": GOTO errmes
GOTO inputgotfn
END IF
IF a3$ = "" THEN a3$ = a2$ ELSE a3$ = a3$ + sp + a2$
NEXT
inputgotfn:
e$ = fixoperationorder$(a3$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + tlayout$
e$ = evaluatetotyp(e$, 64&)
IF Error_Happened THEN GOTO errmes
PRINT #12, "tmp_fileno=" + e$ + ";"
PRINT #12, "if (new_error) goto skip" + u$ + ";"
i = i + 1
IF i > n THEN a$ = "Expected , ...": GOTO errmes
a3$ = ""
B = 0
FOR i = i TO n
a2$ = getelement$(ca$, i)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF i = n THEN
IF a3$ = "" THEN a3$ = a2$ ELSE a3$ = a3$ + sp + a2$
a2$ = ",": B = 0
END IF
IF a2$ = "," AND B = 0 THEN
IF a3$ = "" THEN a$ = "Expected , ...": GOTO errmes
e$ = fixoperationorder$(a3$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp2 + "," + sp + tlayout$
e$ = evaluate(e$, t)
IF Error_Happened THEN GOTO errmes
IF (t AND ISREFERENCE) = 0 THEN a$ = "Expected variable-name": GOTO errmes
IF (t AND ISSTRING) THEN
e$ = refer(e$, t, 0)
IF Error_Happened THEN GOTO errmes
IF lineinput THEN
PRINT #12, "sub_file_line_input_string(tmp_fileno," + e$ + ");"
PRINT #12, "if (new_error) goto skip" + u$ + ";"
ELSE
PRINT #12, "sub_file_input_string(tmp_fileno," + e$ + ");"
PRINT #12, "if (new_error) goto skip" + u$ + ";"
END IF
stringprocessinghappened = 1
ELSE
IF lineinput THEN a$ = "Expected string-variable": GOTO errmes
'numeric variable
IF (t AND ISFLOAT) <> 0 OR (t AND 511) <> 64 THEN
IF (t AND ISOFFSETINBITS) THEN
setrefer e$, t, "((int64)func_file_input_float(tmp_fileno," + str2(t) + "))", 1
IF Error_Happened THEN GOTO errmes
ELSE
setrefer e$, t, "func_file_input_float(tmp_fileno," + str2(t) + ")", 1
IF Error_Happened THEN GOTO errmes
END IF
ELSE
IF t AND ISUNSIGNED THEN
setrefer e$, t, "func_file_input_uint64(tmp_fileno)", 1
IF Error_Happened THEN GOTO errmes
ELSE
setrefer e$, t, "func_file_input_int64(tmp_fileno)", 1
IF Error_Happened THEN GOTO errmes
END IF
END IF
PRINT #12, "if (new_error) goto skip" + u$ + ";"
END IF
IF i = n THEN EXIT FOR
IF lineinput THEN a$ = "Too many variables": GOTO errmes
a3$ = "": a2$ = ""
END IF
IF a3$ = "" THEN a3$ = a2$ ELSE a3$ = a3$ + sp + a2$
NEXT
PRINT #12, "skip" + u$ + ":"
PRINT #12, "revert_input_check();"
IF stringprocessinghappened THEN PRINT #12, cleanupstringprocessingcall$ + "0);"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
END IF
END IF 'input#
IF firstelement$ = "INPUT" THEN
l$ = "INPUT": IF lineinput THEN l$ = "LINE" + sp + l$
commaneeded = 0
i = 2
newline = 1: IF getelement$(a$, i) = ";" THEN newline = 0: i = i + 1: l$ = l$ + sp + ";"
a2$ = getelement$(ca$, i)
IF LEFT$(a2$, 1) = CHR$(34) THEN
e$ = fixoperationorder$(a2$): l$ = l$ + sp + tlayout$
IF Error_Happened THEN GOTO errmes
PRINT #12, "qbs_print(qbs_new_txt_len(" + a2$ + "),0);"
i = i + 1
'MUST be followed by a ; or ,
a2$ = getelement$(ca$, i)
i = i + 1
l$ = l$ + sp2 + a2$
IF a2$ = ";" THEN
IF lineinput THEN GOTO finishedpromptstring
PRINT #12, "qbs_print(qbs_new_txt(" + CHR$(34) + "? " + CHR$(34) + "),0);"
GOTO finishedpromptstring
END IF
IF a2$ = "," THEN
GOTO finishedpromptstring
END IF
a$ = "INPUT STATEMENT: SYNTAX ERROR!": GOTO errmes
END IF
'there was no promptstring, so print a ?
IF lineinput = 0 THEN PRINT #12, "qbs_print(qbs_new_txt(" + CHR$(34) + "? " + CHR$(34) + "),0);"
finishedpromptstring:
numvar = 0
FOR i = i TO n
IF commaneeded = 1 THEN
a2$ = getelement$(ca$, i)
IF a2$ <> "," THEN a$ = "INPUT STATEMENT: SYNTAX ERROR! (COMMA EXPECTED)": GOTO errmes
ELSE
B = 0
e$ = ""
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 i2 = i2 - 1: EXIT FOR
e$ = e$ + sp + e2$
NEXT
i = i2: IF i > n THEN i = n
IF e$ = "" THEN a$ = "Expected variable": GOTO errmes
e$ = RIGHT$(e$, LEN(e$) - 1)
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$: IF i <> n THEN l$ = l$ + sp2 + ","
e$ = evaluate(e$, t)
IF Error_Happened THEN GOTO errmes
IF (t AND ISREFERENCE) = 0 THEN a$ = "Expected variable": GOTO errmes
IF (t AND ISSTRING) THEN
e$ = refer(e$, t, 0)
IF Error_Happened THEN GOTO errmes
numvar = numvar + 1
IF lineinput THEN
PRINT #12, "qbs_input_variabletypes[" + str2(numvar) + "]=ISSTRING+512;"
ELSE
PRINT #12, "qbs_input_variabletypes[" + str2(numvar) + "]=ISSTRING;"
END IF
PRINT #12, "qbs_input_variableoffsets[" + str2(numvar) + "]=" + e$ + ";"
GOTO gotinputvar
END IF
IF lineinput THEN a$ = "Expected string variable": GOTO errmes
IF (t AND ISARRAY) THEN
IF (t AND ISOFFSETINBITS) THEN
a$ = "INPUT cannot handle BIT array elements yet": GOTO errmes
END IF
END IF
e$ = "&(" + refer(e$, t, 0) + ")"
IF Error_Happened THEN GOTO errmes
'remove assumed/unnecessary flags
IF (t AND ISPOINTER) THEN t = t - ISPOINTER
IF (t AND ISINCONVENTIONALMEMORY) THEN t = t - ISINCONVENTIONALMEMORY
IF (t AND ISREFERENCE) THEN t = t - ISREFERENCE
'IF (t AND ISOFFSETINBITS) THEN
'numvar = numvar + 1
'consider storing the bit offset in unused bits of t
'PRINT #12, "qbs_input_variabletypes[" + str2(numvar) + "]=" + str2(t) + ";"
'PRINT #12, "qbs_input_variableoffsets[" + str2(numvar) + "]=" + refer(ref$, typ, 1) + ";"
'GOTO gotinputvar
'END IF
'assume it is a regular variable
numvar = numvar + 1
PRINT #12, "qbs_input_variabletypes[" + str2(numvar) + "]=" + str2$(t) + ";"
PRINT #12, "qbs_input_variableoffsets[" + str2(numvar) + "]=" + e$ + ";"
GOTO gotinputvar
END IF
gotinputvar:
commaneeded = commaneeded + 1: IF commaneeded = 2 THEN commaneeded = 0
NEXT
IF numvar = 0 THEN a$ = "INPUT STATEMENT: SYNTAX ERROR! (NO VARIABLES LISTED FOR INPUT)": GOTO errmes
IF lineinput = 1 AND numvar > 1 THEN a$ = "Too many variables": GOTO errmes
PRINT #12, "qbs_input(" + str2(numvar) + "," + str2$(newline) + ");"
PRINT #12, "if (stop_program) end();"
PRINT #12, cleanupstringprocessingcall$ + "0);"
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF firstelement$ = "WRITE" THEN 'file write
IF n > 1 THEN
IF getelement$(a$, 2) = "#" THEN
xfilewrite ca$, n
IF Error_Happened THEN GOTO errmes
GOTO finishedline
END IF '#
END IF 'n>1
END IF '"write"
IF firstelement$ = "WRITE" THEN 'write
xwrite ca$, n
IF Error_Happened THEN GOTO errmes
GOTO finishedline
END IF '"write"
IF firstelement$ = "PRINT" THEN 'file print
IF n > 1 THEN
IF getelement$(a$, 2) = "#" THEN
xfileprint a$, ca$, n
IF Error_Happened THEN GOTO errmes
l$ = tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF '#
END IF 'n>1
END IF '"print"
IF firstelement$ = "PRINT" OR firstelement$ = "LPRINT" THEN
xprint a$, ca$, n
IF Error_Happened THEN GOTO errmes
l$ = tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
IF firstelement$ = "CLEAR" THEN
IF subfunc$ <> "" THEN a$ = "CLEAR cannot be used inside a SUB/FUNCTION": GOTO errmes
END IF
'LSET/RSET
IF firstelement$ = "LSET" OR firstelement$ = "RSET" THEN
IF n = 1 THEN a$ = "Expected " + firstelement$ + " ...": GOTO errmes
l$ = firstelement$
dest$ = ""
source$ = ""
part = 1
i = 2
a3$ = ""
B = 0
DO
IF i > n THEN
IF part <> 2 OR a3$ = "" THEN a$ = "Expected LSET/RSET stringvariable=string": GOTO errmes
source$ = a3$
EXIT DO
END IF
a2$ = getelement$(ca$, i)
IF a2$ = "(" THEN B = B + 1
IF a2$ = ")" THEN B = B - 1
IF a2$ = "=" AND B = 0 THEN
IF part = 1 THEN dest$ = a3$: part = 2: a3$ = "": GOTO lrsetgotpart
END IF
IF LEN(a3$) THEN a3$ = a3$ + sp + a2$ ELSE a3$ = a2$
lrsetgotpart:
i = i + 1
LOOP
IF dest$ = "" THEN a$ = "Expected LSET/RSET stringvariable=string": GOTO errmes
'check if it is a valid source string
f$ = fixoperationorder$(dest$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$ + sp + "="
e$ = evaluate(f$, sourcetyp)
IF Error_Happened THEN GOTO errmes
IF (sourcetyp AND ISREFERENCE) = 0 OR (sourcetyp AND ISSTRING) = 0 THEN a$ = "LSET/RSET expects a string variable/array-element as its first argument": GOTO errmes
dest$ = evaluatetotyp(f$, ISSTRING)
IF Error_Happened THEN GOTO errmes
source$ = fixoperationorder$(source$)
IF Error_Happened THEN GOTO errmes
l$ = l$ + sp + tlayout$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
source$ = evaluatetotyp(source$, ISSTRING)
IF Error_Happened THEN GOTO errmes
IF firstelement$ = "LSET" THEN
PRINT #12, "sub_lset(" + dest$ + "," + source$ + ");"
ELSE
PRINT #12, "sub_rset(" + dest$ + "," + source$ + ");"
END IF
GOTO finishedline
END IF
'SWAP
IF firstelement$ = "SWAP" THEN
IF n < 4 THEN a$ = "Expected SWAP ... , ...": GOTO errmes
B = 0
ele = 1
e1$ = ""
e2$ = ""
FOR i = 2 TO n
e$ = getelement$(ca$, i)
IF e$ = "(" THEN B = B + 1
IF e$ = ")" THEN B = B - 1
IF e$ = "," AND B = 0 THEN
IF ele = 2 THEN a$ = "Expected SWAP ... , ...": GOTO errmes
ele = 2
ELSE
IF ele = 1 THEN e1$ = e1$ + sp + e$ ELSE e2$ = e2$ + sp + e$
END IF
NEXT
IF e2$ = "" THEN a$ = "Expected SWAP ... , ...": GOTO errmes
e1$ = RIGHT$(e1$, LEN(e1$) - 1): e2$ = RIGHT$(e2$, LEN(e2$) - 1)
e1$ = fixoperationorder(e1$)
IF Error_Happened THEN GOTO errmes
e1l$ = tlayout$
e2$ = fixoperationorder(e2$)
IF Error_Happened THEN GOTO errmes
e2l$ = tlayout$
e1$ = evaluate(e1$, e1typ): e2$ = evaluate(e2$, e2typ)
IF Error_Happened THEN GOTO errmes
IF (e1typ AND ISREFERENCE) = 0 OR (e2typ AND ISREFERENCE) = 0 THEN a$ = "Expected variable": GOTO errmes
layoutdone = 1
l$ = "SWAP" + sp + e1l$ + sp2 + "," + sp + e2l$
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
'swap strings?
IF (e1typ AND ISSTRING) THEN
IF (e2typ AND ISSTRING) = 0 THEN a$ = "Type mismatch": GOTO errmes
e1$ = refer(e1$, e1typ, 0): e2$ = refer(e2$, e2typ, 0)
IF Error_Happened THEN GOTO errmes
PRINT #12, "swap_string(" + e1$ + "," + e2$ + ");"
GOTO finishedline
END IF
'swap UDT?
'note: entire UDTs, unlike thier elements cannot be swapped like standard variables
' as UDT sizes may vary, and to avoid a malloc operation, QB64 should allocate a buffer
' in global.txt for the purpose of swapping each UDT type
IF e1typ AND ISUDT THEN
a$ = e1$
'retrieve ID
i = INSTR(a$, sp3)
IF i THEN
idnumber = VAL(LEFT$(a$, i - 1)): a$ = RIGHT$(a$, LEN(a$) - i)
getid idnumber
IF Error_Happened THEN GOTO errmes
u = VAL(a$)
i = INSTR(a$, sp3): a$ = RIGHT$(a$, LEN(a$) - i): E = VAL(a$)
i = INSTR(a$, sp3): o$ = RIGHT$(a$, LEN(a$) - i)
n$ = "UDT_" + RTRIM$(id.n): IF id.t = 0 THEN n$ = "ARRAY_" + n$ + "[0]"
IF E = 0 THEN 'not an element of UDT u
lhsscope$ = scope$
e$ = e2$: t2 = e2typ
IF (t2 AND ISUDT) = 0 THEN a$ = "Expected SWAP with similar user defined type": GOTO errmes
idnumber2 = VAL(e$)
getid idnumber2
IF Error_Happened THEN GOTO errmes
n2$ = "UDT_" + RTRIM$(id.n): IF id.t = 0 THEN n2$ = "ARRAY_" + n2$ + "[0]"
i = INSTR(e$, sp3): e$ = RIGHT$(e$, LEN(e$) - i): u2 = VAL(e$)
i = INSTR(e$, sp3): e$ = RIGHT$(e$, LEN(e$) - i): e2 = VAL(e$)
i = INSTR(e$, sp3): o2$ = RIGHT$(e$, LEN(e$) - i)
'WARNING: u2 may need minor modifications based on e to see if they are the same
IF u <> u2 OR e2 <> 0 THEN a$ = "Expected SWAP with similar user defined type": GOTO errmes
dst$ = "(((char*)" + lhsscope$ + n$ + ")+(" + o$ + "))"
src$ = "(((char*)" + scope$ + n2$ + ")+(" + o2$ + "))"
B = udtxsize(u) \ 8
siz$ = str2$(B)
IF B = 1 THEN PRINT #12, "swap_8(" + src$ + "," + dst$ + ");"
IF B = 2 THEN PRINT #12, "swap_16(" + src$ + "," + dst$ + ");"
IF B = 4 THEN PRINT #12, "swap_32(" + src$ + "," + dst$ + ");"
IF B = 8 THEN PRINT #12, "swap_64(" + src$ + "," + dst$ + ");"
IF B <> 1 AND B <> 2 AND B <> 4 AND B <> 8 THEN PRINT #12, "swap_block(" + src$ + "," + dst$ + "," + siz$ + ");"
GOTO finishedline
END IF 'e=0
END IF 'i
END IF 'isudt
'cull irrelavent flags to make comparison possible
e1typc = e1typ
IF e1typc AND ISPOINTER THEN e1typc = e1typc - ISPOINTER
IF e1typc AND ISINCONVENTIONALMEMORY THEN e1typc = e1typc - ISINCONVENTIONALMEMORY
IF e1typc AND ISARRAY THEN e1typc = e1typc - ISARRAY
IF e1typc AND ISUNSIGNED THEN e1typc = e1typc - ISUNSIGNED
IF e1typc AND ISUDT THEN e1typc = e1typc - ISUDT
e2typc = e2typ
IF e2typc AND ISPOINTER THEN e2typc = e2typc - ISPOINTER
IF e2typc AND ISINCONVENTIONALMEMORY THEN e2typc = e2typc - ISINCONVENTIONALMEMORY
IF e2typc AND ISARRAY THEN e2typc = e2typc - ISARRAY
IF e2typc AND ISUNSIGNED THEN e2typc = e2typc - ISUNSIGNED
IF e2typc AND ISUDT THEN e2typc = e2typc - ISUDT
IF e1typc <> e2typc THEN a$ = "Type mismatch": GOTO errmes
t = e1typ
IF t AND ISOFFSETINBITS THEN a$ = "Cannot SWAP bit-length variables": GOTO errmes
B = t AND 511
t$ = str2$(B): IF B > 64 THEN t$ = "longdouble"
PRINT #12, "swap_" + t$ + "(&" + refer(e1$, e1typ, 0) + ",&" + refer(e2$, e2typ, 0) + ");"
IF Error_Happened THEN GOTO errmes
GOTO finishedline
END IF
IF firstelement$ = "OPTION" THEN
IF n <> 3 THEN a$ = "Expected OPTION BASE 0 or 1": GOTO errmes
IF getelement$(a$, 2) <> "BASE" THEN a$ = "Expected OPTION BASE 0 or 1": GOTO errmes
l$ = getelement$(a$, 3)
IF l$ <> "0" AND l$ <> "1" THEN a$ = "Expected OPTION BASE 0 or 1": GOTO errmes
IF l$ = "1" THEN optionbase = 1 ELSE optionbase = 0
l$ = "OPTION" + sp + "BASE" + sp + l$
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
GOTO finishedline
END IF
'any other "unique" subs can be processed above
id2 = id
targetid = currentid
IF RTRIM$(id2.callname) = "sub_stub" THEN a$ = "Command not implemented": GOTO errmes
IF n > 1 THEN
IF id2.args = 0 THEN a$ = "SUB does not require any arguments": GOTO errmes
END IF
SetDependency id2.Dependency
seperateargs_error = 0
passedneeded = seperateargs(getelements(a$, 2, n), getelements(ca$, 2, n), passed&)
IF seperateargs_error THEN a$ = seperateargs_error_message: GOTO errmes
'backup args to local string array space before calling evaluate
FOR i = 1 TO OptMax: separgs2(i) = "": NEXT 'save space!
FOR i = 1 TO OptMax + 1: separgslayout2(i) = "": NEXT
FOR i = 1 TO id2.args: separgs2(i) = separgs(i): NEXT
FOR i = 1 TO id2.args + 1: separgslayout2(i) = separgslayout(i): NEXT
IF Debug THEN
PRINT #9, "separgs:": FOR i = 1 TO id2.args: PRINT #9, i, separgs2(i): NEXT
PRINT #9, "separgslayout:": FOR i = 1 TO id2.args + 1: PRINT #9, i, separgslayout2(i): NEXT
END IF
'note: seperateargs finds the arguments to pass and sets passed& as necessary
' FIXOPERTIONORDER is not called on these args yet
' what we need it to do is build a second array of layout info at the same time
' ref:DIM SHARED separgslayout(100) AS STRING
' the above array stores what layout info (if any) goes BEFORE the arg in question
' it has one extra index which is the arg after
IF usecall THEN
IF usecall = 1 THEN l$ = "CALL" + sp + RTRIM$(id.cn) + RTRIM$(id.musthave) + sp2 + "(" + sp2
IF usecall = 2 THEN l$ = "CALL" + sp + RTRIM$(id.cn) + RTRIM$(id.musthave) + sp 'sp at end for easy parsing
ELSE
l$ = RTRIM$(id.cn) + RTRIM$(id.musthave) + sp
END IF
subcall$ = RTRIM$(id.callname) + "("
addedlayout = 0
fieldcall = 0
'GET/PUT field exception
IF RTRIM$(id2.callname) = "sub_get" OR RTRIM$(id2.callname) = "sub_put" THEN
IF passed AND 2 THEN
'regular GET/PUT call with variable provided
passed = passed - 2 'for complience with existing methods, remove 'passed' flag for the passing of a variable
ELSE
'FIELD GET/PUT call with variable omited
IF RTRIM$(id2.callname) = "sub_get" THEN
fieldcall = 1
subcall$ = "field_get("
ELSE
fieldcall = 2
subcall$ = "field_put("
END IF
END IF
END IF 'field exception
IF RTRIM$(id2.callname) = "sub_timer" OR RTRIM$(id2.callname) = "sub_key" THEN 'spacing exception
IF usecall = 0 THEN
l$ = LEFT$(l$, LEN(l$) - 1) + sp2
END IF
END IF
FOR i = 1 TO id2.args
targettyp = CVL(MID$(id2.arg, -3 + i * 4, 4))
nele = ASC(MID$(id2.nele, i, 1))
nelereq = ASC(MID$(id2.nelereq, i, 1))
addlayout = 1 'omits option values in layout (eg. BINARY="2")
convertspacing = 0 'if an 'equation' is next, it will be preceeded by a space
x$ = separgslayout2$(i)
DO WHILE LEN(x$)
x = ASC(x$)
IF x THEN
convertspacing = 0
x2$ = MID$(x$, 2, x)
x$ = RIGHT$(x$, LEN(x$) - x - 1)
s = 0
an = 0
x3$ = RIGHT$(l$, 1)
IF x3$ = sp THEN s = 1
IF x3$ = sp2 THEN
s = 2
IF alphanumeric(ASC(RIGHT$(l$, 2))) THEN an = 1
ELSE
IF alphanumeric(ASC(x3$)) THEN an = 1
END IF
s1 = s
IF alphanumeric(ASC(x2$)) THEN convertspacing = 1
IF x2$ = "LPRINT" THEN
'x2$="LPRINT"
'x$=CHR$(0)
'x3$=[sp] from WIDTH[sp]
'therefore...
's=1
'an=0
'convertspacing=1
'if debug=1 then
'print #9,"LPRINT:"
'print #9,s
'print #9,an
'print #9,l$
'print #9,x2$
'end if
END IF
IF (an = 1 OR addedlayout = 1) AND alphanumeric(ASC(x2$)) <> 0 THEN
s = 1 'force space
x2$ = x2$ + sp2
GOTO customlaychar
END IF
IF x2$ = "=" THEN
s = 1
x2$ = x2$ + sp
GOTO customlaychar
END IF
IF x2$ = "#" THEN
s = 1
x2$ = x2$ + sp2
GOTO customlaychar
END IF
IF x2$ = "," THEN x2$ = x2$ + sp: GOTO customlaychar
IF x$ = CHR$(0) THEN 'substitution
IF x2$ = "STEP" THEN x2$ = x2$ + sp2: GOTO customlaychar
x2$ = x2$ + sp: GOTO customlaychar
END IF
'default solution sp2+?+sp2
x2$ = x2$ + sp2
customlaychar:
IF s = 0 THEN s = 2
IF s <> s1 THEN
IF s1 THEN l$ = LEFT$(l$, LEN(l$) - 1)
IF s = 1 THEN l$ = l$ + sp
IF s = 2 THEN l$ = l$ + sp2
END IF
IF (RTRIM$(id2.callname) = "sub_timer" OR RTRIM$(id2.callname) = "sub_key") AND i = id2.args THEN 'spacing exception
IF x2$ <> ")" + sp2 THEN
l$ = LEFT$(l$, LEN(l$) - 1) + sp
END IF
END IF
l$ = l$ + x2$
ELSE
addlayout = 0
x$ = RIGHT$(x$, LEN(x$) - 1)
END IF
addedlayout = 0
LOOP
'---better sub syntax checking begins here---
IF targettyp = -3 THEN
IF separgs2(i) = "NULL" THEN a$ = "Expected array name": GOTO errmes
'names of numeric arrays have ( ) automatically appended (nothing else)
e$ = separgs2(i)
IF INSTR(e$, sp) = 0 THEN 'one element only
try_string$ = e$
try = findid(try_string$)
IF Error_Happened THEN GOTO errmes
DO
IF try THEN
IF id.arraytype THEN
IF (id.arraytype AND ISSTRING) = 0 THEN
e$ = e$ + sp + "(" + sp + ")"
EXIT DO
END IF
END IF
'---
IF try = 2 THEN findanotherid = 1: try = findid(try_string$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
END IF 'if try
IF try = 0 THEN 'add symbol?
IF LEN(removesymbol$(try_string$)) = 0 THEN
IF Error_Happened THEN GOTO errmes
a = ASC(try_string$)
IF a >= 97 AND a <= 122 THEN a = a - 32
IF a = 95 THEN a = 91
a = a - 64
IF LEN(defineextaz(a)) THEN try_string$ = try_string$ + defineextaz(a): try = findid(try_string$)
IF Error_Happened THEN GOTO errmes
END IF
END IF 'try=0
LOOP UNTIL try = 0
END IF 'one element only
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
IF convertspacing = 1 AND addlayout = 1 THEN l$ = LEFT$(l$, LEN(l$) - 1) + sp
IF addlayout THEN l$ = l$ + tlayout$: addedlayout = 1
e$ = evaluatetotyp(e$, -2)
IF Error_Happened THEN GOTO errmes
GOTO sete
END IF '-3
IF targettyp = -2 THEN
e$ = fixoperationorder$(e$)
IF Error_Happened THEN GOTO errmes
IF convertspacing = 1 AND addlayout = 1 THEN l$ = LEFT$(l$, LEN(l$) - 1) + sp
IF addlayout THEN l$ = l$ + tlayout$: addedlayout = 1
e$ = evaluatetotyp(e$, -2)
IF Error_Happened THEN GOTO errmes
GOTO sete
END IF '-2
IF targettyp = -4 THEN
IF fieldcall THEN
i = id2.args + 1
EXIT FOR
END IF
IF separgs2(i) = "NULL" THEN a$ = "Expected variable name/array element": GOTO errmes
e$ = fixoperationorder$(separgs2(i))
IF Error_Happened THEN GOTO errmes
IF convertspacing = 1 AND addlayout = 1 THEN l$ = LEFT$(l$, LEN(l$) - 1) + sp
IF addlayout THEN l$ = l$ + tlayout$: addedlayout = 1
'GET/PUT RANDOM-ACCESS override
IF firstelement$ = "GET" OR firstelement$ = "PUT" THEN
e2$ = e$ 'backup
e$ = evaluate(e$, sourcetyp)
IF Error_Happened THEN GOTO errmes
IF (sourcetyp AND ISSTRING) THEN
IF (sourcetyp AND ISFIXEDLENGTH) = 0 THEN
'replace name of sub to call
subcall$ = RIGHT$(subcall$, LEN(subcall$) - 7) 'delete original name
'note: GET2 & PUT2 take differing input, following code is correct
IF firstelement$ = "GET" THEN
subcall$ = "sub_get2" + subcall$
e$ = refer(e$, sourcetyp, 0) 'pass a qbs pointer instead
IF Error_Happened THEN GOTO errmes
GOTO sete
ELSE
subcall$ = "sub_put2" + subcall$
'no goto sete required, fall through
END IF
END IF
END IF
e$ = e2$ 'restore
END IF 'override
e$ = evaluatetotyp(e$, -4)
IF Error_Happened THEN GOTO errmes
GOTO sete
END IF '-4
IF separgs2(i) = "NULL" THEN
e$ = "NULL"
ELSE
e2$ = fixoperationorder$(separgs2(i))
IF Error_Happened THEN GOTO errmes
IF convertspacing = 1 AND addlayout = 1 THEN l$ = LEFT$(l$, LEN(l$) - 1) + sp
IF addlayout THEN l$ = l$ + tlayout$: addedlayout = 1
e$ = evaluate(e2$, sourcetyp)
IF Error_Happened THEN GOTO errmes
IF sourcetyp AND ISOFFSET THEN
IF (targettyp AND ISOFFSET) = 0 THEN
IF id2.internal_subfunc = 0 THEN a$ = "Cannot convert _OFFSET type to other types": GOTO errmes
END IF
END IF
IF RTRIM$(id2.callname) = "sub_paint" THEN
IF i = 3 THEN
IF (sourcetyp AND ISSTRING) THEN
targettyp = ISSTRING
END IF
END IF
END IF
IF LEFT$(separgs2(i), 2) = "(" + sp THEN dereference = 1 ELSE dereference = 0
'pass by reference
IF (targettyp AND ISPOINTER) THEN
IF dereference = 0 THEN 'check deferencing wasn't used
'note: array pointer
IF (targettyp AND ISARRAY) THEN
IF (sourcetyp AND ISREFERENCE) = 0 THEN a$ = "Expected arrayname()": GOTO errmes
IF (sourcetyp AND ISARRAY) = 0 THEN a$ = "Expected arrayname()": GOTO errmes
IF Debug THEN PRINT #9, "sub:array reference:[" + e$ + "]"
'check arrays are of same type
targettyp2 = targettyp: sourcetyp2 = sourcetyp
targettyp2 = targettyp2 AND (511 + ISOFFSETINBITS + ISUDT + ISSTRING + ISFIXEDLENGTH + ISFLOAT)
sourcetyp2 = sourcetyp2 AND (511 + ISOFFSETINBITS + ISUDT + ISSTRING + ISFIXEDLENGTH + ISFLOAT)
IF sourcetyp2 <> targettyp2 THEN a$ = "Incorrect array type passed to sub": GOTO errmes
'check arrayname was followed by '()'
IF targettyp AND ISUDT THEN
IF Debug THEN PRINT #9, "sub:array reference:udt reference:[" + e$ + "]"
'get UDT info
udtrefid = VAL(e$)
getid udtrefid
IF Error_Happened THEN GOTO errmes
udtrefi = INSTR(e$, sp3) 'end of id
udtrefi2 = INSTR(udtrefi + 1, e$, sp3) 'end of u
udtrefu = VAL(MID$(e$, udtrefi + 1, udtrefi2 - udtrefi - 1))
udtrefi3 = INSTR(udtrefi2 + 1, e$, sp3) 'skip e
udtrefe = VAL(MID$(e$, udtrefi2 + 1, udtrefi3 - udtrefi2 - 1))
o$ = RIGHT$(e$, LEN(e$) - udtrefi3)
'note: most of the UDT info above is not required
IF LEFT$(o$, 4) <> "(0)*" THEN a$ = "Expected arrayname()": GOTO errmes
ELSE
IF RIGHT$(e$, 2) <> sp3 + "0" THEN a$ = "Expected arrayname()": GOTO errmes
END IF
idnum = VAL(LEFT$(e$, INSTR(e$, sp3) - 1))
getid idnum
IF Error_Happened THEN GOTO errmes
IF targettyp AND ISFIXEDLENGTH THEN
targettypsize = CVL(MID$(id2.argsize, i * 4 - 4 + 1, 4))
IF id.tsize <> targettypsize THEN a$ = "Incorrect array type passed to sub": GOTO errmes
END IF
IF MID$(sfcmemargs(targetid), i, 1) = CHR$(1) THEN 'cmem required?
IF cmemlist(idnum) = 0 THEN
cmemlist(idnum) = 1
recompile = 1
END IF
END IF
IF id.linkid = 0 THEN
'if id.linkid is 0, it means the number of array elements is definietly
'known of the array being passed, this is not some "fake"/unknown array.
'using the numer of array elements of a fake array would be dangerous!
IF nelereq = 0 THEN
'only continue if the number of array elements required is unknown
'and it needs to be set
IF id.arrayelements > 0 THEN '2009
nelereq = id.arrayelements
MID$(id2.nelereq, i, 1) = CHR$(nelereq)
END IF
'print rtrim$(id2.n)+">nelereq=";nelereq
ids(targetid) = id2
ELSE
'the number of array elements required is known AND
'the number of elements in the array to be passed is known
IF id.arrayelements <> nelereq THEN a$ = "Passing arrays with a differing number of elements to a SUB/FUNCTION is not supported (yet)": GOTO errmes
END IF
END IF
e$ = refer(e$, sourcetyp, 1)
IF Error_Happened THEN GOTO errmes
GOTO sete
END IF 'target is an array
'note: not an array...
'target is not an array
IF (targettyp AND ISSTRING) = 0 THEN
IF (sourcetyp AND ISREFERENCE) THEN
idnum = VAL(LEFT$(e$, INSTR(e$, sp3) - 1)) 'id# of sourcetyp
targettyp2 = targettyp: sourcetyp2 = sourcetyp
'get info about source/target
arr = 0: IF (sourcetyp2 AND ISARRAY) THEN arr = 1
passudtelement = 0: IF (targettyp2 AND ISUDT) = 0 AND (sourcetyp2 AND ISUDT) <> 0 THEN passudtelement = 1: sourcetyp2 = sourcetyp2 - ISUDT
'remove flags irrelevant for comparison... ISPOINTER,ISREFERENCE,ISINCONVENTIONALMEMORY,ISARRAY
targettyp2 = targettyp2 AND (511 + ISOFFSETINBITS + ISUDT + ISFLOAT + ISSTRING)
sourcetyp2 = sourcetyp2 AND (511 + ISOFFSETINBITS + ISUDT + ISFLOAT + ISSTRING)
'compare types
IF sourcetyp2 = targettyp2 THEN
IF sourcetyp AND ISUDT THEN
'udt/udt array
'get info
udtrefid = VAL(e$)
getid udtrefid
IF Error_Happened THEN GOTO errmes
udtrefi = INSTR(e$, sp3) 'end of id
udtrefi2 = INSTR(udtrefi + 1, e$, sp3) 'end of u
udtrefu = VAL(MID$(e$, udtrefi + 1, udtrefi2 - udtrefi - 1))
udtrefi3 = INSTR(udtrefi2 + 1, e$, sp3) 'skip e
udtrefe = VAL(MID$(e$, udtrefi2 + 1, udtrefi3 - udtrefi2 - 1))
o$ = RIGHT$(e$, LEN(e$) - udtrefi3)
'note: most of the UDT info above is not required
IF arr THEN
n$ = scope$ + "ARRAY_UDT_" + RTRIM$(id.n) + "[0]"
ELSE
n$ = scope$ + "UDT_" + RTRIM$(id.n)
END IF
e$ = "(void*)( ((char*)(" + n$ + ")) + (" + o$ + ") )"
'convert void* to target type*
IF passudtelement THEN e$ = "(" + typ2ctyp$(targettyp2 + (targettyp AND ISUNSIGNED), "") + "*)" + e$
IF Error_Happened THEN GOTO errmes
ELSE
'not a udt
IF arr THEN
IF (sourcetyp2 AND ISOFFSETINBITS) THEN a$ = "Cannot pass BIT array offsets yet": GOTO errmes
e$ = "(&(" + refer(e$, sourcetyp, 0) + "))"
IF Error_Happened THEN GOTO errmes
ELSE
e$ = refer(e$, sourcetyp, 1)
IF Error_Happened THEN GOTO errmes
END IF
'note: signed/unsigned mismatch requires casting
IF (sourcetyp AND ISUNSIGNED) <> (targettyp AND ISUNSIGNED) THEN
e$ = "(" + typ2ctyp$(targettyp2 + (targettyp AND ISUNSIGNED), "") + "*)" + e$
IF Error_Happened THEN GOTO errmes
END IF
END IF 'udt?
IF MID$(sfcmemargs(targetid), i, 1) = CHR$(1) THEN 'cmem required?
IF cmemlist(idnum) = 0 THEN
cmemlist(idnum) = 1
recompile = 1
END IF
END IF
GOTO sete
END IF 'similar
END IF 'reference
ELSE 'not a string
'its a string
IF (sourcetyp AND ISREFERENCE) THEN
idnum = VAL(LEFT$(e$, INSTR(e$, sp3) - 1)) 'id# of sourcetyp
IF MID$(sfcmemargs(targetid), i, 1) = CHR$(1) THEN 'cmem required?
IF cmemlist(idnum) = 0 THEN
cmemlist(idnum) = 1
recompile = 1
END IF
END IF
END IF 'reference
END IF 'its a string
END IF 'dereference check
END IF 'target is a pointer
'note: Target is not a pointer...
'String-numeric mismatch?
IF targettyp AND ISSTRING THEN
IF (sourcetyp AND ISSTRING) = 0 THEN
nth = i
IF ids(targetid).args = 1 THEN a$ = "String required for sub": GOTO errmes
a$ = str_nth$(nth) + " sub argument requires a string": GOTO errmes
END IF
END IF
IF (targettyp AND ISSTRING) = 0 THEN
IF sourcetyp AND ISSTRING THEN
nth = i
IF ids(targetid).args = 1 THEN a$ = "Number required for sub": GOTO errmes
a$ = str_nth$(nth) + " sub argument requires a number": GOTO errmes
END IF
END IF
'change to "non-pointer" value
IF (sourcetyp AND ISREFERENCE) THEN
e$ = refer(e$, sourcetyp, 0)
IF Error_Happened THEN GOTO errmes
END IF
IF explicitreference = 0 THEN
IF targettyp AND ISUDT THEN
nth = i
x$ = "'" + RTRIM$(udtxcname(targettyp AND 511)) + "'"
IF ids(targetid).args = 1 THEN a$ = "TYPE " + x$ + " required for sub": GOTO errmes
a$ = str_nth$(nth) + " sub argument requires TYPE " + x$: GOTO errmes
END IF
ELSE
IF sourcetyp AND ISUDT THEN a$ = "Number required for sub": GOTO errmes
END IF
'round to integer if required
IF (sourcetyp AND ISFLOAT) THEN
IF (targettyp AND ISFLOAT) = 0 THEN
'**32 rounding fix
bits = targettyp AND 511
IF bits <= 16 THEN e$ = "qbr_float_to_long(" + e$ + ")"
IF bits > 16 AND bits < 32 THEN e$ = "qbr_double_to_long(" + e$ + ")"
IF bits >= 32 THEN e$ = "qbr(" + e$ + ")"
END IF
END IF
IF (targettyp AND ISPOINTER) THEN 'pointer required
IF (targettyp AND ISSTRING) THEN GOTO sete 'no changes required
t$ = typ2ctyp$(targettyp, "")
IF Error_Happened THEN GOTO errmes
v$ = "pass" + str2$(uniquenumber)
'assume numeric type
IF MID$(sfcmemargs(targetid), i, 1) = CHR$(1) THEN 'cmem required?
bytesreq = ((targettyp AND 511) + 7) \ 8
PRINT #defdatahandle, t$ + " *" + v$ + "=NULL;"
PRINT #13, "if(" + v$ + "==NULL){"
PRINT #13, "cmem_sp-=" + str2(bytesreq) + ";"
PRINT #13, v$ + "=(" + t$ + "*)(dblock+cmem_sp);"
PRINT #13, "if (cmem_spchr"
END IF
IF LTRIM$(RTRIM$(e$)) = "0" THEN e$ = "NULL"
END IF
IF i <> 1 THEN subcall$ = subcall$ + ","
subcall$ = subcall$ + e$
NEXT
'note: i=id.args+1
x$ = separgslayout2$(i)
DO WHILE LEN(x$)
x = ASC(x$)
IF x THEN
x2$ = MID$(x$, 2, x)
x$ = RIGHT$(x$, LEN(x$) - x - 1)
s = 0
an = 0
x3$ = RIGHT$(l$, 1)
IF x3$ = sp THEN s = 1
IF x3$ = sp2 THEN
s = 2
IF alphanumeric(ASC(RIGHT$(l$, 2))) THEN an = 1
'if asc(right$(l$,2))=34 then an=1
ELSE
IF alphanumeric(ASC(x3$)) THEN an = 1
'if asc(x3$)=34 then an=1
END IF
s1 = s
IF (an = 1 OR addedlayout = 1) AND alphanumeric(ASC(x2$)) <> 0 THEN
s = 1 'force space
x2$ = x2$ + sp2
GOTO customlaychar2
END IF
IF x2$ = "=" THEN
s = 1
x2$ = x2$ + sp
GOTO customlaychar2
END IF
IF x2$ = "#" THEN
s = 1
x2$ = x2$ + sp2
GOTO customlaychar2
END IF
IF x2$ = "," THEN x2$ = x2$ + sp: GOTO customlaychar2
IF x$ = CHR$(0) THEN 'substitution
IF x2$ = "STEP" THEN x2$ = x2$ + sp2: GOTO customlaychar2
x2$ = x2$ + sp: GOTO customlaychar2
END IF
'default solution sp2+?+sp2
x2$ = x2$ + sp2
customlaychar2:
IF s = 0 THEN s = 2
IF s <> s1 THEN
IF s1 THEN l$ = LEFT$(l$, LEN(l$) - 1)
IF s = 1 THEN l$ = l$ + sp
IF s = 2 THEN l$ = l$ + sp2
END IF
l$ = l$ + x2$
ELSE
addlayout = 0
x$ = RIGHT$(x$, LEN(x$) - 1)
END IF
addedlayout = 0
LOOP
IF passedneeded THEN
subcall$ = subcall$ + "," + str2$(passed&)
END IF
subcall$ = subcall$ + ");"
PRINT #12, subcall$
subcall$ = ""
IF stringprocessinghappened THEN PRINT #12, cleanupstringprocessingcall$ + "0);"
layoutdone = 1
x$ = RIGHT$(l$, 1): IF x$ = sp OR x$ = sp2 THEN l$ = LEFT$(l$, LEN(l$) - 1)
IF usecall = 1 THEN l$ = l$ + sp2 + ")"
IF Debug THEN PRINT #9, "SUB layout:[" + l$ + "]"
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
GOTO finishedline
END IF
IF try = 2 THEN
findidsecondarg = "": IF n >= 2 THEN findidsecondarg = getelement$(a$, 2)
findanotherid = 1
try = findid(firstelement$)
IF Error_Happened THEN GOTO errmes
ELSE
try = 0
END IF
LOOP
END IF
notsubcall:
IF n >= 1 THEN
IF firstelement$ = "LET" THEN
IF n = 1 THEN a$ = "Syntax error": GOTO errmes
ca$ = RIGHT$(ca$, LEN(ca$) - 4)
n = n - 1
l$ = "LET"
IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
'note: layoutdone=1 will be set later
GOTO letused
END IF
END IF
'LET ???=???
IF n >= 3 THEN
IF INSTR(a$, sp + "=" + sp) THEN
letused:
assign ca$, n
IF Error_Happened THEN GOTO errmes
layoutdone = 1
IF LEN(layout$) = 0 THEN layout$ = tlayout$ ELSE layout$ = layout$ + sp + tlayout$
GOTO finishedline
END IF
END IF '>=3
IF RIGHT$(a$, 2) = sp + "=" THEN a$ = "Expected ... = expression": GOTO errmes
'Syntax error
a$ = "Syntax error": GOTO errmes
finishedline:
THENGOTO = 0
finishedline2:
IF arrayprocessinghappened = 1 THEN arrayprocessinghappened = 0
IF NoChecks = 0 THEN
IF dynscope THEN
dynscope = 0
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + ");if(r)goto S_" + str2$(statementn) + ";}"
ELSE
PRINT #12, "if(!qbevent)break;evnt(" + str2$(linenumber) + ");}while(r);"
END IF
END IF
finishednonexec:
IF layoutdone = 0 THEN layoutok = 0 'invalidate layout if not handled
IF continuelinefrom = 0 THEN 'note: manager #2 requires this condition
'Include Manager #2 '***
IF LEN(addmetainclude$) THEN
IF inclevel = 0 THEN
'backup line formatting
layoutcomment_backup$ = layoutcomment$
layoutok_backup = layoutok
layout_backup$ = layout$
END IF
a$ = addmetainclude$: addmetainclude$ = "" 'read/clear message
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
FOR try = 1 TO 2
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 = -2 '***
OPEN f$ FOR INPUT AS #fh
qberrorhappened2: '***
IF qberrorhappened = -2 THEN EXIT FOR '***
END IF
qberrorhappened = 0
NEXT
IF qberrorhappened <> -2 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$
a3$ = x$
continuelinefrom = 0
inclinenumber(inclevel) = inclinenumber(inclevel) + 1
'create extended error string 'incerror$'
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 idemode THEN sendc$ = CHR$(10) + a3$: GOTO sendcommand 'passback
GOTO includeline
END IF
'3. Close & return control
CLOSE #fh
inclevel = inclevel - 1
IF inclevel = 0 THEN
'restore line formatting
layoutok = layoutok_backup
layout$ = layout_backup$
layoutcomment$ = layoutcomment_backup$
END IF
LOOP 'fall through to next section...
'(end manager)
END IF 'continuelinefrom=0
IF Debug THEN
PRINT #9, "[layout check]"
PRINT #9, "[" + layoutoriginal$ + "]"
PRINT #9, "[" + layout$ + "]"
PRINT #9, layoutok
PRINT #9, "[end layout check]"
END IF
IF idemode THEN
IF continuelinefrom <> 0 THEN GOTO ide4 'continue processing other commands on line
IF LEN(layoutcomment$) THEN
IF LEN(layout$) THEN layout$ = layout$ + sp + layoutcomment$ ELSE layout$ = layoutcomment$
END IF
IF layoutok = 0 THEN
layout$ = layoutoriginal$
ELSE
'reverse '046' changes present in autolayout
'replace fix046$ with .
i = INSTR(layout$, fix046$)
DO WHILE i
layout$ = LEFT$(layout$, i - 1) + "." + RIGHT$(layout$, LEN(layout$) - (i + LEN(fix046$) - 1))
i = INSTR(layout$, fix046$)
LOOP
END IF
x = lhscontrollevel: IF controllevel < lhscontrollevel THEN x = controllevel
IF definingtype = 2 THEN x = x + 1
IF declaringlibrary = 2 THEN x = x + 1
layout$ = SPACE$(x) + layout$
IF linecontinuation THEN layout$ = ""
GOTO ideret4 'return control to IDE
END IF
'layout is not currently used by the compiler (as appose to the IDE), if it was it would be used here
LOOP
ide5:
linenumber = 0
IF closedmain = 0 THEN closemain
IF definingtype THEN linenumber = definingtypeerror: a$ = "TYPE without END TYPE": GOTO errmes
'check for open controls (copy #1)
IF controllevel THEN
x = controltype(controllevel)
IF x = 1 THEN a$ = "IF without END IF"
IF x = 2 THEN a$ = "FOR without NEXT"
IF x = 3 OR x = 4 THEN a$ = "DO without LOOP"
IF x = 5 THEN a$ = "WHILE without WEND"
IF (x >= 10 AND x <= 17) OR x = 18 OR x = 19 THEN a$ = "SELECT CASE without END SELECT"
linenumber = controlref(controllevel)
GOTO errmes
END IF
IF LEN(subfunc) THEN a$ = "SUB/FUNCTION without END SUB/FUNCTION": GOTO errmes
'close the error handler (cannot be put in 'closemain' because subs/functions can also add error jumps to this file)
PRINT #14, "exit(99);" 'in theory this line should never be run!
PRINT #14, "}" 'close error jump handler
'create CLEAR method "CLEAR"
CLOSE #12 'close code handle
OPEN tmpdir$ + "clear.txt" FOR OUTPUT AS #12 'direct code to clear.txt
FOR i = 1 TO idn
IF ids(i).staticscope THEN 'static scope?
subfunc = RTRIM$(ids(i).insubfunc) 'set static scope
GOTO clearstaticscope
END IF
a = ASC(ids(i).insubfunc)
IF a = 0 OR a = 32 THEN 'global scope?
subfunc = "" 'set global scope
clearstaticscope:
IF ids(i).arraytype THEN 'an array
getid i
IF Error_Happened THEN GOTO errmes
IF id.arrayelements = -1 THEN GOTO clearerasereturned 'cannot erase non-existant array
clearerasereturn = 1: GOTO clearerase
END IF 'array
IF ids(i).t THEN 'non-array variable
getid i
IF Error_Happened THEN GOTO errmes
bytes$ = variablesize$(-1)
IF Error_Happened THEN GOTO errmes
'create a reference
typ = id.t + ISREFERENCE
IF typ AND ISUDT THEN
e$ = str2(i) + sp3 + str2(typ AND 511) + sp3 + "0" + sp3 + "0"
ELSE
e$ = str2(i)
END IF
e$ = refer$(e$, typ, 1)
IF Error_Happened THEN GOTO errmes
IF typ AND ISSTRING THEN
IF typ AND ISFIXEDLENGTH THEN
PRINT #12, "memset((void*)(" + e$ + "->chr),0," + bytes$ + ");"
GOTO cleared
ELSE
PRINT #12, e$ + "->len=0;"
GOTO cleared
END IF
END IF
IF typ AND ISUDT THEN
PRINT #12, "memset((void*)" + e$ + ",0," + bytes$ + ");"
ELSE
PRINT #12, "*" + e$ + "=0;"
END IF
GOTO cleared
END IF 'non-array variable
END IF 'scope
cleared:
clearerasereturned:
NEXT
CLOSE #12
IF Debug THEN
PRINT #9, "finished making program!"
PRINT #9, "recompile="; recompile
END IF
'Set cmem flags for subs/functions requiring data passed in cmem
FOR i = 1 TO idn
IF cmemlist(i) THEN 'must be in cmem
getid i
IF Error_Happened THEN GOTO errmes
IF Debug THEN PRINT #9, "recompiling cmem sf! checking:"; RTRIM$(id.n)
IF id.sfid THEN 'it is an argument of a sub/function
IF Debug THEN PRINT #9, "recompiling cmem sf! It's a sub/func arg!"
i2 = id.sfid
x = id.sfarg
IF Debug THEN PRINT #9, "recompiling cmem sf! values:"; i2; x
'check if cmem flag is set, if not then set it & force recompile
IF MID$(sfcmemargs(i2), x, 1) <> CHR$(1) THEN
MID$(sfcmemargs(i2), x, 1) = CHR$(1)
IF Debug THEN PRINT #9, "recompiling cmem sf! setting:"; i2; x
recompile = 1
END IF
END IF
END IF
NEXT i
unresolved = 0
FOR i = 1 TO idn
getid i
IF Error_Happened THEN GOTO errmes
IF Debug THEN PRINT #9, "checking id named:"; id.n
IF id.subfunc THEN
FOR i2 = 1 TO id.args
t = CVL(MID$(id.arg, i2 * 4 - 3, 4))
IF t > 0 THEN
IF (t AND ISPOINTER) THEN
IF (t AND ISARRAY) THEN
IF Debug THEN PRINT #9, "checking argument "; i2; " of "; id.args
nele = ASC(MID$(id.nele, i2, 1))
nelereq = ASC(MID$(id.nelereq, i2, 1))
IF Debug THEN PRINT #9, "nele="; nele
IF Debug THEN PRINT #9, "nelereq="; nelereq
IF nele <> nelereq THEN
IF Debug THEN PRINT #9, "mismatch detected!"
unresolved = unresolved + 1
sflistn = sflistn + 1
sfidlist(sflistn) = i
sfarglist(sflistn) = i2
sfelelist(sflistn) = nelereq '0 means still unknown
END IF
END IF
END IF
END IF
NEXT
END IF
NEXT
'is recompilation required to resolve this?
IF unresolved > 0 THEN
IF lastunresolved = -1 THEN
'first pass
recompile = 1
IF Debug THEN
PRINT #9, "recompiling to resolve array elements (first time)"
PRINT #9, "sflistn="; sflistn
PRINT #9, "oldsflistn="; oldsflistn
END IF
ELSE
'not first pass
IF unresolved < lastunresolved THEN
recompile = 1
IF Debug THEN
PRINT #9, "recompiling to resolve array elements (not first time)"
PRINT #9, "sflistn="; sflistn
PRINT #9, "oldsflistn="; oldsflistn
END IF
END IF
END IF
END IF 'unresolved
lastunresolved = unresolved
'IDEA!
'have a flag to record if anything gets resolved in a pass
'if not then it's time to stop
'the problem is the same amount of new problems may be created by a
'resolve as those that get fixed
'also/or.. could it be that previous fixes are overridden in a recompile
' by a new fix? if so, it would give these effects
'could recompilation resolve this?
'IF sflistn <> -1 THEN
'IF sflistn <> oldsflistn THEN
'recompile = 1
'
'if debug then
'print #9,"recompile set to 1 to resolve array elements"
'print #9,"sflistn=";sflistn
'print #9,"oldsflistn=";oldsflistn
'end if
'
'END IF
'END IF
IF Debug THEN PRINT #9, "Beginning COMMON array list check..."
xi = 1
FOR x = 1 TO commonarraylistn
varname$ = getelement$(commonarraylist, xi): xi = xi + 1
typ$ = getelement$(commonarraylist, xi): xi = xi + 1
dimmethod2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
dimshared2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
'find the array ID (try method)
t = typname2typ(typ$)
IF Error_Happened THEN GOTO errmes
IF (t AND ISUDT) = 0 THEN varname$ = varname$ + type2symbol$(typ$)
IF Error_Happened THEN GOTO errmes
IF Debug THEN PRINT #9, "Checking for array '" + varname$ + "'..."
try = findid(varname$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.arraytype THEN GOTO foundcommonarray2
IF try = 2 THEN findanotherid = 1: try = findid(varname$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
foundcommonarray2:
IF Debug THEN PRINT #9, "Found array '" + varname$ + "!"
IF id.arrayelements = -1 THEN
IF arrayelementslist(currentid) <> 0 THEN recompile = 1
IF Debug THEN PRINT #9, "Recompiling to resolve elements of:" + varname$
END IF
NEXT
IF Debug THEN PRINT #9, "Finished COMMON array list check!"
IF recompile THEN
do_recompile:
IF Debug THEN PRINT #9, "Recompile required!"
recompile = 0
IF idemode THEN iderecompile = 1
FOR closeall = 1 TO 255: CLOSE closeall: NEXT
OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock
GOTO recompile
END IF
IF Debug THEN PRINT #9, "Beginning label check..."
FOR r = 1 TO nLabels
IF Labels(r).Scope_Restriction THEN
a$ = RTRIM$(Labels(r).cn)
ignore = validlabel(a$)
v = HashFind(a$, HASHFLAG_LABEL, ignore, r2)
addlabchk7:
IF v THEN
IF Labels(r2).Scope = Labels(r).Scope_Restriction THEN
linenumber = Labels(r).Error_Line: a$ = "Common label within a SUB/FUNCTION": GOTO errmes
END IF
IF v = 2 THEN v = HashFindCont(ignore, r2): GOTO addlabchk7
END IF 'v
END IF 'restriction
'check for undefined labels
IF Labels(r).State = 0 THEN
IF INSTR(PossibleSubNameLabels$, sp + UCASE$(RTRIM$(Labels(r).cn)) + sp) THEN
IF INSTR(SubNameLabels$, sp + UCASE$(RTRIM$(Labels(r).cn)) + sp) = 0 THEN 'not already added
SubNameLabels$ = SubNameLabels$ + UCASE$(RTRIM$(Labels(r).cn)) + sp
IF Debug THEN PRINT #9, "Recompiling to resolve label:"; RTRIM$(Labels(r).cn)
GOTO do_recompile
END IF
END IF
linenumber = Labels(r).Error_Line: a$ = "Label not defined": GOTO errmes
END IF
IF Labels(r).Data_Referenced THEN
'check for ambiguous RESTORE reference
x = 0
a$ = RTRIM$(Labels(r).cn)
ignore = validlabel(a$)
v = HashFind(a$, HASHFLAG_LABEL, ignore, r2)
addlabchk4:
IF v THEN
x = x + 1
IF v = 2 THEN v = HashFindCont(ignore, r2): GOTO addlabchk4
END IF 'v
IF x <> 1 THEN linenumber = Labels(r).Error_Line: a$ = "Ambiguous DATA label": GOTO errmes
'add global data offset variable
PRINT #18, "ptrszint data_at_LABEL_" + a$ + "=" + str2(Labels(r).Data_Offset) + ";"
END IF 'data referenced
NEXT
IF Debug THEN PRINT #9, "Finished check!"
'if targettyp=-4 or targettyp=-5 then '? -> byte_element(offset,element size in bytes)
' IF (sourcetyp AND ISREFERENCE) = 0 THEN a$ = "Expected variable name/array element": GOTO errmes
'create include files for COMMON arrays
CLOSE #12
'return to 'main'
subfunc$ = ""
defdatahandle = 18
CLOSE #13: OPEN tmpdir$ + "maindata.txt" FOR APPEND AS #13
CLOSE #19: OPEN tmpdir$ + "mainfree.txt" FOR APPEND AS #19
IF Console THEN
PRINT #18, "int32 console=1;"
ELSE
PRINT #18, "int32 console=0;"
END IF
IF ScreenHide THEN
PRINT #18, "int32 screen_hide_startup=1;"
ELSE
PRINT #18, "int32 screen_hide_startup=0;"
END IF
fh = FREEFILE
OPEN tmpdir$ + "dyninfo.txt" FOR APPEND AS #fh
IF Resize THEN
PRINT #fh, "ScreenResize=1;"
END IF
IF Resize_Scale THEN
PRINT #fh, "ScreenResizeScale=" + str2(Resize_Scale) + ";"
END IF
CLOSE #fh
'DATA_finalize
PRINT #18, "ptrszint data_size=" + str2(DataOffset) + ";"
IF DataOffset = 0 THEN
PRINT #18, "uint8 *data=(uint8*)calloc(1,1);"
ELSE
IF inline_DATA = 0 THEN
IF os$ = "WIN" THEN
x$ = CHR$(0): PUT #16, , x$
PRINT #18, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #18, "extern char *binary_____temp" + tempfolderindexstr2$ + "__data_bin_start;"
PRINT #18, "}"
PRINT #18, "uint8 *data=(uint8*)&binary_____temp" + tempfolderindexstr2$ + "__data_bin_start;"
END IF
IF os$ = "LNX" THEN
x$ = CHR$(0): PUT #16, , x$
PRINT #18, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #18, "extern char *_binary____temp" + tempfolderindexstr2$ + "_data_bin_start;"
PRINT #18, "}"
PRINT #18, "uint8 *data=(uint8*)&_binary____temp" + tempfolderindexstr2$ + "_data_bin_start;"
END IF
ELSE
'inline data
CLOSE #16
ff = FREEFILE
OPEN tmpdir$ + "data.bin" FOR BINARY AS #ff
x$ = SPACE$(LOF(ff))
GET #ff, , x$
CLOSE #ff
x2$ = "uint8 inline_data[]={"
FOR i = 1 TO LEN(x$)
x2$ = x2$ + inlinedatastr$(ASC(x$, i))
NEXT
x2$ = x2$ + "0};"
PRINT #18, x2$
PRINT #18, "uint8 *data=&inline_data[0];"
x$ = "": x2$ = ""
END IF
END IF
IF Debug THEN PRINT #9, "Beginning generation of code for saving/sharing common array data..."
use_global_byte_elements = 1
ncommontmp = 0
xi = 1
FOR x = 1 TO commonarraylistn
varname$ = getelement$(commonarraylist, xi): xi = xi + 1
typ$ = getelement$(commonarraylist, xi): xi = xi + 1
dimmethod2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
dimshared2 = VAL(getelement$(commonarraylist, xi)): xi = xi + 1
'find the array ID (try method)
purevarname$ = varname$
t = typname2typ(typ$)
IF Error_Happened THEN GOTO errmes
IF (t AND ISUDT) = 0 THEN varname$ = varname$ + type2symbol$(typ$)
IF Error_Happened THEN GOTO errmes
try = findid(varname$)
IF Error_Happened THEN GOTO errmes
DO WHILE try
IF id.arraytype THEN GOTO foundcommonarray
IF try = 2 THEN findanotherid = 1: try = findid(varname$) ELSE try = 0
IF Error_Happened THEN GOTO errmes
LOOP
a$ = "COMMON array unlocatable": GOTO errmes 'should never happen
foundcommonarray:
IF Debug THEN PRINT #9, "Found common array '" + varname$ + "'!"
i = currentid
arraytype = id.arraytype
arrayelements = id.arrayelements
e$ = RTRIM$(id.n)
IF (t AND ISUDT) = 0 THEN e$ = e$ + typevalue2symbol$(t)
IF Error_Happened THEN GOTO errmes
n$ = e$
n2$ = RTRIM$(id.callname)
tsize = id.tsize
'select command
command = 3 'fixed length elements
IF t AND ISSTRING THEN
IF (t AND ISFIXEDLENGTH) = 0 THEN
command = 4 'var-len elements
END IF
END IF
'if...
'i) array elements are still undefined (ie. arrayelements=-1) pass the input content along
' if any existed or an array-placeholder
'ii) if the array's elements were defined, any input content would have been loaded so the
' array (in whatever state it currently is) should be passed. If it is currently erased
' then it should be passed as a placeholder
IF arrayelements = -1 THEN
'load array (copies the array, if any, into a buffer for later)
OPEN tmpdir$ + "inpchain" + str2$(i) + ".txt" FOR OUTPUT AS #12
PRINT #12, "if (int32val==2){" 'array place-holder
'create buffer to store array as-is in global.txt
x$ = str2$(uniquenumber)
x1$ = "chainarraybuf" + x$
x2$ = "chainarraybufsiz" + x$
PRINT #18, "static uint8 *" + x1$ + "=(uint8*)malloc(1);"
PRINT #18, "static int64 " + x2$ + "=0;"
'read next command
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
IF command = 3 THEN PRINT #12, "if (int32val==3){" 'fixed-length-element array
IF command = 4 THEN PRINT #12, "if (int32val==4){" 'var-length-element array
PRINT #12, x2$ + "+=4; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + "); *(int32*)(" + x1$ + "+" + x2$ + "-4)=int32val;"
IF command = 3 THEN
'read size in bits of one element, convert it to bytes
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
PRINT #12, x2$ + "+=8; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + "); *(int64*)(" + x1$ + "+" + x2$ + "-8)=int64val;"
PRINT #12, "bytes=int64val>>3;"
END IF 'com=3
IF command = 4 THEN PRINT #12, "bytes=1;" 'bytes used to calculate number of elements
'read number of dimensions
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
PRINT #12, x2$ + "+=4; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + "); *(int32*)(" + x1$ + "+" + x2$ + "-4)=int32val;"
'read size of dimensions & calculate the size of the array in bytes
PRINT #12, "while(int32val--){"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);" 'lbound
PRINT #12, x2$ + "+=8; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + "); *(int64*)(" + x1$ + "+" + x2$ + "-8)=int64val;"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val2,8," + NewByteElement$ + "),0);" 'ubound
PRINT #12, x2$ + "+=8; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + "); *(int64*)(" + x1$ + "+" + x2$ + "-8)=int64val2;"
PRINT #12, "bytes*=(int64val2-int64val+1);"
PRINT #12, "}"
IF command = 3 THEN
'read the array data
PRINT #12, x2$ + "+=bytes; " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + ");"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)(" + x1$ + "+" + x2$ + "-bytes),bytes," + NewByteElement$ + "),0);"
END IF 'com=3
IF command = 4 THEN
PRINT #12, "bytei=0;"
PRINT #12, "while(bytei>3); " + x1$ + "=(uint8*)realloc(" + x1$ + "," + x2$ + ");"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)(" + x1$ + "+" + x2$ + "-(int64val>>3)),(int64val>>3)," + NewByteElement$ + "),0);"
PRINT #12, "bytei++;"
PRINT #12, "}"
END IF
'get next command
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
PRINT #12, "}" 'command=3 or 4
PRINT #12, "}" 'array place-holder
CLOSE #12
'save array (saves the buffered data, if any, for later)
OPEN tmpdir$ + "chain" + str2$(i) + ".txt" FOR OUTPUT AS #12
PRINT #12, "int32val=2;" 'placeholder
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)" + x1$ + "," + x2$ + "," + NewByteElement$ + "),0);"
CLOSE #12
ELSE
'note: arrayelements<>-1
'load array
OPEN tmpdir$ + "inpchain" + str2$(i) + ".txt" FOR OUTPUT AS #12
PRINT #12, "if (int32val==2){" 'array place-holder
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
IF command = 3 THEN PRINT #12, "if (int32val==3){" 'fixed-length-element array
IF command = 4 THEN PRINT #12, "if (int32val==4){" 'var-length-element array
IF command = 3 THEN
'get size in bits
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
'***assume correct***
END IF
'get number of elements
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
'***assume correct***
e$ = ""
IF command = 4 THEN PRINT #12, "bytes=1;" 'bytes counts the number of total elements
FOR x2 = 1 TO arrayelements
'create 'secret' variables to assist in passing common arrays
IF x2 > ncommontmp THEN
ncommontmp = ncommontmp + 1
IF Debug THEN PRINT #9, "Calling DIM2(...)..."
IF Error_Happened THEN GOTO errmes
retval = dim2("___RESERVED_COMMON_LBOUND" + str2$(ncommontmp), "_INTEGER64", 0, "")
IF Error_Happened THEN GOTO errmes
retval = dim2("___RESERVED_COMMON_UBOUND" + str2$(ncommontmp), "_INTEGER64", 0, "")
IF Error_Happened THEN GOTO errmes
IF Debug THEN PRINT #9, "Finished calling DIM2(...)!"
IF Error_Happened THEN GOTO errmes
END IF
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
PRINT #12, "*__INTEGER64____RESERVED_COMMON_LBOUND" + str2$(x2) + "=int64val;"
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int64val2,8," + NewByteElement$ + "),0);"
PRINT #12, "*__INTEGER64____RESERVED_COMMON_UBOUND" + str2$(x2) + "=int64val2;"
IF command = 4 THEN PRINT #12, "bytes*=(int64val2-int64val+1);"
IF x2 > 1 THEN e$ = e$ + sp + "," + sp
e$ = e$ + "___RESERVED_COMMON_LBOUND" + str2$(x2) + sp + "TO" + sp + "___RESERVED_COMMON_UBOUND" + str2$(x2)
NEXT
IF Debug THEN PRINT #9, "Calling DIM2(" + purevarname$ + "," + typ$ + ",0," + e$ + ")..."
IF Error_Happened THEN GOTO errmes
'Note: purevarname$ is simply varname$ without the type symbol after it
redimoption = 1
retval = dim2(purevarname$, typ$, 0, e$)
IF Error_Happened THEN GOTO errmes
redimoption = 0
IF Debug THEN PRINT #9, "Finished calling DIM2(" + purevarname$ + "," + typ$ + ",0," + e$ + ")!"
IF Error_Happened THEN GOTO errmes
IF command = 3 THEN
'use get to load in the array data
varname$ = varname$ + sp + "(" + sp + ")"
e$ = evaluatetotyp(fixoperationorder$(varname$), -4)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_get(FF,NULL," + e$ + ",0);"
END IF
IF command = 4 THEN
PRINT #12, "bytei=0;"
PRINT #12, "while(bytei>3,1));" 'change string size
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)tqbs->chr,int64val>>3," + NewByteElement$ + "),0);" 'get size
PRINT #12, "bytei++;"
PRINT #12, "}"
END IF
'get next command
PRINT #12, "sub_get(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
PRINT #12, "}"
PRINT #12, "}"
CLOSE #12
'save array
OPEN tmpdir$ + "chain" + str2$(i) + ".txt" FOR OUTPUT AS #12
PRINT #12, "int32val=2;" 'placeholder
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
PRINT #12, "if (" + n2$ + "[2]&1){" 'don't add unless defined
IF command = 3 THEN PRINT #12, "int32val=3;"
IF command = 4 THEN PRINT #12, "int32val=4;"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
IF command = 3 THEN
'size of each element in bits
bits = t AND 511
IF t AND ISUDT THEN bits = udtxsize(t AND 511)
IF t AND ISSTRING THEN bits = tsize * 8
PRINT #12, "int64val=" + str2$(bits) + ";" 'size in bits
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
END IF 'com=3
PRINT #12, "int32val=" + str2$(arrayelements) + ";" 'number of dimensions
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int32val,4," + NewByteElement$ + "),0);"
IF command = 3 THEN
FOR x2 = 1 TO arrayelements
'simulate calls to lbound/ubound
e$ = "LBOUND" + sp + "(" + sp + n$ + sp + "," + sp + str2$(x2) + sp + ")"
e$ = evaluatetotyp(fixoperationorder$(e$), 64)
IF Error_Happened THEN GOTO errmes
PRINT #12, "int64val=" + e$ + ";"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
e$ = "UBOUND" + sp + "(" + sp + n$ + sp + "," + sp + str2$(x2) + sp + ")"
e$ = evaluatetotyp(fixoperationorder$(e$), 64)
IF Error_Happened THEN GOTO errmes
PRINT #12, "int64val=" + e$ + ";"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
NEXT
'array data
e$ = evaluatetotyp(fixoperationorder$(n$ + sp + "(" + sp + ")"), -4)
IF Error_Happened THEN GOTO errmes
PRINT #12, "sub_put(FF,NULL," + e$ + ",0);"
END IF 'com=3
IF command = 4 THEN
'store LBOUND/UBOUND values and calculate number of total elements/strings
PRINT #12, "bytes=1;" 'note: bytes is actually the total number of elements
FOR x2 = 1 TO arrayelements
e$ = "LBOUND" + sp + "(" + sp + n$ + sp + "," + sp + str2$(x2) + sp + ")"
e$ = evaluatetotyp(fixoperationorder$(e$), 64)
IF Error_Happened THEN GOTO errmes
PRINT #12, "int64val=" + e$ + ";"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);"
e$ = "UBOUND" + sp + "(" + sp + n$ + sp + "," + sp + str2$(x2) + sp + ")"
e$ = evaluatetotyp(fixoperationorder$(e$), 64)
IF Error_Happened THEN GOTO errmes
PRINT #12, "int64val2=" + e$ + ";"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val2,8," + NewByteElement$ + "),0);"
PRINT #12, "bytes*=(int64val2-int64val+1);"
NEXT
PRINT #12, "bytei=0;"
PRINT #12, "while(byteilen; int64val<<=3;"
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)&int64val,8," + NewByteElement$ + "),0);" 'size of element
PRINT #12, "sub_put(FF,NULL,byte_element((uint64)tqbs->chr,tqbs->len," + NewByteElement$ + "),0);" 'element data
PRINT #12, "bytei++;"
PRINT #12, "}"
END IF 'com=4
PRINT #12, "}" 'don't add unless defined
CLOSE #12
'if chaincommonarray then
'l2$=tlayout$
'x=chaincommonarray
'
''chain???.txt
'open tmpdir$ + "chain" + str2$(x) + ".txt" for append as #22
'if lof(22) then close #22: goto chaindone 'only add this once
''***assume non-var-len-string array***
'print #22,"int32val=3;" 'non-var-len-element array
'print #22,"sub_put(FF,NULL,byte_element((uint64)&int32val,4,"+NewByteElement$+"),0);"
't=id.arraytype
''***check for UDT size if necessary***
''***check for string length if necessary***
'bits=t and 511
'print #22,"int64val="+str2$(bits)+";" 'size in bits
'print #22,"sub_put(FF,NULL,byte_element((uint64)&int64val,8,"+NewByteElement$+"),0);"
'print #22,"int32val="+str2$(id.arrayelements)+";" 'number of elements
'print #22,"sub_put(FF,NULL,byte_element((uint64)&int32val,4,"+NewByteElement$+"),0);"
'e$=rtrim$(id.n)
'if (t and ISUDT)=0 then e$=e$+typevalue2symbol$(t)
'n$=e$
'for x2=1 to id.arrayelements
''simulate calls to lbound/ubound
'e$="LBOUND"+sp+"("+sp+n$+sp+","+sp+str2$(x2)+sp+")"
'e$=evaluatetotyp(fixoperationorder$(e$),64)
'print #22,"int64val="+e$+";"'LBOUND
'print #22,"sub_put(FF,NULL,byte_element((uint64)&int64val,8,"+NewByteElement$+"),0);"
'e$="UBOUND"+sp+"("+sp+n$+sp+","+sp+str2$(x2)+sp+")"
'e$=evaluatetotyp(fixoperationorder$(e$),64)
'print #22,"int64val="+e$+";"'LBOUND
'print #22,"sub_put(FF,NULL,byte_element((uint64)&int64val,8,"+NewByteElement$+"),0);"
'next
''add array data
'e$=evaluatetotyp(fixoperationorder$(n$+sp+"("+sp+")"),-4)
'print #22,"sub_put(FF,NULL,"+e$+",0);"
'close #22
'
''inpchain???.txt
'open tmpdir$ + "chain" + str2$(x) + ".txt" for append as #22
'print #22,"if (int32val==1){" 'common declaration of an array
'print #22,"sub_get(FF,NULL,byte_element((uint64)&int32val,4,"+NewByteElement$+"),0);"
'print #22,"if (int32val==3){" 'fixed-length-element array
'
'print #22,"sub_get(FF,NULL,byte_element((uint64)&int64val,8,"+NewByteElement$+"),0);"
''***assume size correct and continue***
'
''get number of elements
'print #22,"sub_get(FF,NULL,byte_element((uint64)&int32val,4,"+NewByteElement$+"),0);"
'
''call dim2 and tell it to redim an array
'
''*********this should happen BEFORE the array (above) is actually dimensioned,
''*********where the common() declaration is
'
''****although, if you never reference the array.............
''****ARGH! you can access an undimmed array just like in a sub/function
'
'
'
'
'print #22,"}"
'print #22,"}"
'close #22
'
'chaindone:
'tlayout$=l2$
'end if 'chaincommonarray
'OPEN tmpdir$ + "chain.txt" FOR APPEND AS #22
''include directive
'print #22, "#include " + CHR$(34) + "chain" + str2$(x) + ".txt" + CHR$(34)
'close #22
''create/clear include file
'open tmpdir$ + "chain" + str2$(x) + ".txt" for output as #22:close #22
'
'OPEN tmpdir$ + "inpchain.txt" FOR APPEND AS #22
''include directive
'print #22, "#include " + CHR$(34) + "inpchain" + str2$(x) + ".txt" + CHR$(34)
'close #22
''create/clear include file
'open tmpdir$ + "inpchain" + str2$(x) + ".txt" for output as #22:close #22
END IF 'id.arrayelements=-1
NEXT
use_global_byte_elements = 0
IF Debug THEN PRINT #9, "Finished generation of code for saving/sharing common array data!"
FOR closeall = 1 TO 255: CLOSE closeall: NEXT
OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock
IF idemode THEN GOTO ideret5
ide6:
IF idemode = 0 AND No_C_Compile_Mode = 0 THEN
PRINT
IF os$ = "LNX" THEN
PRINT "COMPILING C++ CODE INTO EXECUTABLE..."
ELSE
PRINT "COMPILING C++ CODE INTO EXE..."
END IF
IF _FILEEXISTS(file$ + extension$) THEN
E = 0
ON ERROR GOTO qberror_test
KILL file$ + extension$
ON ERROR GOTO qberror
IF E = 1 THEN
a$ = "CANNOT CREATE " + CHR$(34) + file$ + extension$ + CHR$(34) + " BECAUSE THE FILE IS ALREADY IN USE!": GOTO errmes
END IF
END IF
END IF
'Update dependencies
o$ = LCASE$(os$)
win = 0: IF os$ = "WIN" THEN win = 1
lnx = 0: IF os$ = "LNX" THEN lnx = 1
mac = 0: IF MacOSX THEN mac = 1: o$ = "osx"
defines$ = "": defines_header$ = " -D "
ver$ = Version$ 'eg. "0.123"
x = INSTR(ver$, "."): IF x THEN ASC(ver$, x) = 95 'change "." to "_"
libs$ = ""
IF DEPENDENCY(DEPENDENCY_GL) THEN
IF Cloud THEN a$ = "GL not supported on QLOUD": GOTO errmes '***NOCLOUD***
defines$ = defines$ + defines_header$ + "DEPENDENCY_GL"
END IF
IF DEPENDENCY(DEPENDENCY_IMAGE_CODEC) THEN
defines$ = defines$ + defines_header$ + "DEPENDENCY_IMAGE_CODEC"
END IF
IF DEPENDENCY(DEPENDENCY_LOADFONT) THEN
d$ = "internal\c\parts\video\font\ttf\"
'rebuild?
IF _FILEEXISTS(d$ + "os\" + o$ + "\src.o") = 0 THEN
Build d$ + "os\" + o$
END IF
defines$ = defines$ + defines_header$ + "DEPENDENCY_LOADFONT"
libs$ = libs$ + " " + "parts\video\font\ttf\os\" + o$ + "\src.o"
END IF
IF DEPENDENCY(DEPENDENCY_AUDIO_DECODE) THEN DEPENDENCY(DEPENDENCY_AUDIO_CONVERSION) = 1
IF DEPENDENCY(DEPENDENCY_AUDIO_CONVERSION) THEN DEPENDENCY(DEPENDENCY_AUDIO_OUT) = 1
IF DEPENDENCY(DEPENDENCY_AUDIO_DECODE) THEN DEPENDENCY(DEPENDENCY_AUDIO_OUT) = 1
IF DEPENDENCY(DEPENDENCY_AUDIO_CONVERSION) THEN
defines$ = defines$ + defines_header$ + "DEPENDENCY_AUDIO_CONVERSION"
d1$ = "parts\audio\conversion"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.a") = 0 THEN 'rebuild?
Build d3$
END IF
libs$ = libs$ + " " + d2$ + "\src.a"
d1$ = "parts\audio\libresample"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.a") = 0 THEN 'rebuild?
Build d3$
END IF
libs$ = libs$ + " " + d2$ + "\src.a"
END IF
IF DEPENDENCY(DEPENDENCY_AUDIO_DECODE) THEN
'General decoder
defines$ = defines$ + defines_header$ + "DEPENDENCY_AUDIO_DECODE"
'MP3 decoder
d1$ = "parts\audio\decode\mp3"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.a") = 0 THEN 'rebuild?
Build d3$
END IF
libs$ = libs$ + " " + d2$ + "\src.a"
'OGG decoder
d1$ = "parts\audio\decode\ogg"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.o") = 0 THEN 'rebuild?
Build d3$
END IF
libs$ = libs$ + " " + d2$ + "\src.o"
'WAV decoder
'(no action required)
END IF
IF DEPENDENCY(DEPENDENCY_AUDIO_OUT) THEN
defines$ = defines$ + defines_header$ + "DEPENDENCY_AUDIO_OUT"
d1$ = "parts\audio\out"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.a") = 0 THEN 'rebuild?
Build d3$
END IF
libs$ = libs$ + " " + d2$ + "\src.a"
END IF
'finalize libs$ and defines$ strings
IF LEN(libs$) THEN libs$ = libs$ + " "
PATH_SLASH_CORRECT libs$
IF LEN(defines$) THEN defines$ = defines$ + " "
'Build core?
IF mac = 0 THEN 'macosx uses Apple's GLUT not FreeGLUT
d1$ = "parts\core"
d2$ = d1$ + "\os\" + o$
d3$ = "internal\c\" + d2$
IF _FILEEXISTS(d3$ + "\src.a") = 0 THEN 'rebuild?
Build d3$
END IF
END IF 'mac = 0
'Build libqb?
depstr$ = ver$ + "_"
FOR i = 1 TO DEPENDENCY_LAST
IF DEPENDENCY(i) THEN depstr$ = depstr$ + "1" ELSE depstr$ = depstr$ + "0"
NEXT
libqb$ = " libqb\os\" + o$ + "\libqb_" + depstr$ + ".o "
PATH_SLASH_CORRECT libqb$
IF _FILEEXISTS("internal\c\" + LTRIM$(RTRIM$(libqb$))) = 0 THEN
CHDIR "internal\c"
IF os$ = "WIN" THEN
SHELL _HIDE GDB_Fix("cmd /c c_compiler\bin\g++ -c -s -w -Wall libqb.cpp -D FREEGLUT_STATIC " + defines$ + " -o libqb\os\" + o$ + "\libqb_" + depstr$ + ".o")
ELSE
IF mac THEN
SHELL _HIDE GDB_Fix("g++ -c -s -w -Wall libqb.cpp " + defines$ + " -o libqb/os/" + o$ + "/libqb_" + depstr$ + ".o")
ELSE
SHELL _HIDE GDB_Fix("g++ -c -s -w -Wall libqb.cpp -D FREEGLUT_STATIC " + defines$ + " -o libqb/os/" + o$ + "/libqb_" + depstr$ + ".o")
END IF
END IF
CHDIR "..\.."
END IF
'link-time only defines
IF DEPENDENCY(DEPENDENCY_AUDIO_OUT) THEN
IF mac THEN defines$ = defines$ + " -framework AudioUnit -framework AudioToolbox "
END IF
IF MakeAndroid THEN
GOTO Skip_Build
END IF
IF os$ = "WIN" THEN
'resolve static function definitions and add to global.txt
FOR x = 1 TO ResolveStaticFunctions
IF LEN(ResolveStaticFunction_File(x)) THEN
n = 0
SHELL _HIDE "internal\c\c_compiler\bin\nm.exe " + CHR$(34) + ResolveStaticFunction_File(x) + CHR$(34) + " --demangle -g >internal\temp\nm_output.txt"
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x) + "("
OPEN "internal\temp\nm_output.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname+LEFTBRACKET
x1 = INSTR(a$, s$)
IF x1 THEN
IF ResolveStaticFunction_Method(x) = 1 THEN
x1 = x1 + 1
x2 = INSTR(x1, a$, ")")
fh2 = FREEFILE
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern void " + MID$(a$, x1, x2 - x1 + 1) + ";"
CLOSE #fh2
END IF
n = n + 1
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
IF n > 1 THEN a$ = "Unable to resolve multiple instances of sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
IF n = 0 THEN 'attempt to locate simple function name without brackets
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x)
OPEN "internal\temp\nm_output.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname
x1 = INSTR(a$, s$)
IF RIGHT$(a$, LEN(s$)) = s$ THEN
fh2 = FREEFILE
IF ResolveStaticFunction_Method(x) = 1 THEN
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #fh2, "extern void " + s$ + "(void);"
PRINT #fh2, "}"
ELSE
OPEN tmpdir$ + "externtype" + str2(x) + ".txt" FOR OUTPUT AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + " "
END IF
CLOSE #fh2
n = n + 1
EXIT DO
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
END IF
IF n = 0 THEN 'a C++ dynamic object library?
SHELL _HIDE "internal\c\c_compiler\bin\nm " + CHR$(34) + ResolveStaticFunction_File(x) + CHR$(34) + " -D --demangle -g >.\internal\temp\nm_output_dynamic.txt"
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x) + "("
OPEN "internal\temp\nm_output_dynamic.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname+LEFTBRACKET
x1 = INSTR(a$, s$)
IF x1 THEN
IF ResolveStaticFunction_Method(x) = 1 THEN
x1 = x1 + 1
x2 = INSTR(x1, a$, ")")
fh2 = FREEFILE
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern void " + MID$(a$, x1, x2 - x1 + 1) + ";"
CLOSE #fh2
END IF
n = n + 1
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
IF n > 1 THEN a$ = "Unable to resolve multiple instances of sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
END IF
IF n = 0 THEN 'a C dynamic object library?
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x)
OPEN "internal\temp\nm_output_dynamic.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname
x1 = INSTR(a$, s$)
IF RIGHT$(a$, LEN(s$)) = s$ THEN
fh2 = FREEFILE
IF ResolveStaticFunction_Method(x) = 1 THEN
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #fh2, "extern void " + s$ + "(void);"
PRINT #fh2, "}"
ELSE
OPEN tmpdir$ + "externtype" + str2(x) + ".txt" FOR OUTPUT AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + " "
END IF
CLOSE #fh2
n = n + 1
EXIT DO
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
IF n = 0 THEN a$ = "Could not find sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
END IF
END IF
NEXT
IF inline_DATA = 0 THEN
IF DataOffset THEN
OPEN ".\internal\c\makedat_win.txt" FOR INPUT AS #150: LINE INPUT #150, a$: CLOSE #150
a$ = a$ + " " + tmpdir2$ + "data.bin " + tmpdir2$ + "data.o"
CHDIR ".\internal\c"
SHELL _HIDE a$
CHDIR "..\.."
END IF
END IF
OPEN ".\internal\c\makeline_win.txt" FOR INPUT AS #150
LINE INPUT #150, a$: a$ = GDB_Fix(a$)
CLOSE #150
IF RIGHT$(a$, 7) = " ..\..\" THEN a$ = LEFT$(a$, LEN(a$) - 6) 'makeline.txt patch (line will become unrequired in later versions)
'change qbx.cpp to qbx999.cpp?
x = INSTR(a$, "qbx.cpp"): IF x <> 0 AND tempfolderindex <> 1 THEN a$ = LEFT$(a$, x - 1) + "qbx" + str2$(tempfolderindex) + ".cpp" + RIGHT$(a$, LEN(a$) - (x + 6))
IF Console THEN
IF C_Core = 0 THEN
x = INSTR(a$, "-mwindows"): a$ = LEFT$(a$, x - 1) + "-mconsole " + RIGHT$(a$, LEN(a$) - x + 1)
END IF
IF C_Core = 1 THEN
x = INSTR(a$, " -s"): a$ = LEFT$(a$, x - 1) + " -mconsole" + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
IF inline_DATA = 0 THEN
'add data.o?
IF DataOffset THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 3
a$ = LEFT$(a$, x) + " " + tmpdir2$ + "data.o" + " " + RIGHT$(a$, LEN(a$) - x)
END IF
END IF
END IF
'add custom libraries
'mylib$="..\..\"+x$+".lib"
IF LEN(mylib$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 3
a$ = LEFT$(a$, x) + " " + mylib$ + " " + RIGHT$(a$, LEN(a$) - x)
END IF
END IF
'add dependent libraries
IF LEN(libs$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + libs$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
'add dependency defines
IF LEN(defines$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + defines$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
'add libqb
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + libqb$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
a$ = a$ + idezfilename$("..\..\" + file$ + extension$)
ffh = FREEFILE
OPEN tmpdir$ + "recompile_win.bat" FOR OUTPUT AS #ffh
PRINT #ffh, "@echo off"
PRINT #ffh, "cd %0\..\"
PRINT #ffh, "echo Recompiling..."
PRINT #ffh, "cd ../c"
PRINT #ffh, a$
PRINT #ffh, "pause"
CLOSE ffh
ffh = FREEFILE
OPEN tmpdir$ + "debug_win.bat" FOR OUTPUT AS #ffh
PRINT #ffh, "@echo off"
PRINT #ffh, "cd %0\..\"
PRINT #ffh, "cd ../.."
PRINT #ffh, "echo C++ Debugging: " + file$ + extension$ + " using gdb.exe"
PRINT #ffh, "echo Debugger commands:"
PRINT #ffh, "echo After the debugger launches type 'run' to start your program"
PRINT #ffh, "echo After your program crashes type 'list' to find where the problem is and fix/report it"
PRINT #ffh, "echo Type 'quit' to exit"
PRINT #ffh, "echo (the GDB debugger has many other useful commands, this advice is for beginners)"
PRINT #ffh, "pause"
PRINT #ffh, "internal\c\c_compiler\bin\gdb.exe " + CHR$(34) + file$ + extension$ + CHR$(34)
PRINT #ffh, "pause"
CLOSE ffh
IF No_C_Compile_Mode = 0 THEN
CHDIR ".\internal\c"
SHELL _HIDE a$
CHDIR "..\.."
END IF 'No_C_Compile_Mode=0
END IF
IF os$ = "LNX" THEN
FOR x = 1 TO ResolveStaticFunctions
IF LEN(ResolveStaticFunction_File(x)) THEN
n = 0
IF MacOSX = 0 THEN SHELL _HIDE "nm " + CHR$(34) + ResolveStaticFunction_File(x) + CHR$(34) + " --demangle -g >./internal/temp/nm_output.txt 2>./internal/temp/nm_error.txt"
IF MacOSX THEN SHELL _HIDE "nm " + CHR$(34) + ResolveStaticFunction_File(x) + CHR$(34) + " >./internal/temp/nm_output.txt 2>./internal/temp/nm_error.txt"
IF MacOSX = 0 THEN 'C++ name demangling not supported in MacOSX
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x) + "("
OPEN "internal\temp\nm_output.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname+LEFTBRACKET
x1 = INSTR(a$, s$)
IF x1 THEN
IF ResolveStaticFunction_Method(x) = 1 THEN
x1 = x1 + 1
x2 = INSTR(x1, a$, ")")
fh2 = FREEFILE
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern void " + MID$(a$, x1, x2 - x1 + 1) + ";"
CLOSE #fh2
END IF
n = n + 1
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
IF n > 1 THEN a$ = "Unable to resolve multiple instances of sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
END IF 'macosx=0
IF n = 0 THEN 'attempt to locate simple function name without brackets
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x): s2$ = s$
IF MacOSX THEN s$ = " _" + ResolveStaticFunction_Name(x) 'search for C mangled name
OPEN "internal\temp\nm_output.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname
x1 = INSTR(a$, s$)
IF RIGHT$(a$, LEN(s$)) = s$ THEN
fh2 = FREEFILE
IF ResolveStaticFunction_Method(x) = 1 THEN
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #fh2, "extern void " + s2$ + "(void);"
PRINT #fh2, "}"
ELSE
OPEN tmpdir$ + "externtype" + str2(x) + ".txt" FOR OUTPUT AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + " "
END IF
CLOSE #fh2
n = n + 1
EXIT DO
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
END IF
IF n = 0 THEN 'a C++ dynamic object library?
IF MacOSX THEN GOTO macosx_libfind_failed
SHELL _HIDE "nm " + CHR$(34) + ResolveStaticFunction_File(x) + CHR$(34) + " -D --demangle -g >./internal/temp/nm_output_dynamic.txt 2>./internal/temp/nm_error.txt"
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x) + "("
OPEN "internal\temp\nm_output_dynamic.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname+LEFTBRACKET
x1 = INSTR(a$, s$)
IF x1 THEN
IF ResolveStaticFunction_Method(x) = 1 THEN
x1 = x1 + 1
x2 = INSTR(x1, a$, ")")
fh2 = FREEFILE
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern void " + MID$(a$, x1, x2 - x1 + 1) + ";"
CLOSE #fh2
END IF
n = n + 1
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
IF n > 1 THEN a$ = "Unable to resolve multiple instances of sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
END IF
IF n = 0 THEN 'a C dynamic object library?
fh = FREEFILE
s$ = " " + ResolveStaticFunction_Name(x)
OPEN "internal\temp\nm_output_dynamic.txt" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, a$
IF LEN(a$) THEN
'search for SPACE+functionname
x1 = INSTR(a$, s$)
IF RIGHT$(a$, LEN(s$)) = s$ THEN
fh2 = FREEFILE
IF ResolveStaticFunction_Method(x) = 1 THEN
OPEN tmpdir$ + "global.txt" FOR APPEND AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + "{"
PRINT #fh2, "extern void " + s$ + "(void);"
PRINT #fh2, "}"
ELSE
OPEN tmpdir$ + "externtype" + str2(x) + ".txt" FOR OUTPUT AS #fh2
PRINT #fh2, "extern " + CHR$(34) + "C" + CHR$(34) + " "
END IF
CLOSE #fh2
n = n + 1
EXIT DO
END IF 'x1
END IF '<>""
LOOP
CLOSE #fh
macosx_libfind_failed:
IF n = 0 THEN a$ = "Could not find sub/function '" + ResolveStaticFunction_Name(x) + "' in '" + ResolveStaticFunction_File(x) + "'": GOTO errmes
END IF
END IF
NEXT
IF inline_DATA = 0 THEN
IF DataOffset THEN
IF INSTR(_OS$, "[32BIT]") THEN b$ = "32" ELSE b$ = "64"
OPEN ".\internal\c\makedat_lnx" + b$ + ".txt" FOR INPUT AS #150: LINE INPUT #150, a$: CLOSE #150
a$ = a$ + " " + tmpdir2$ + "data.bin " + tmpdir2$ + "data.o"
CHDIR ".\internal\c"
SHELL _HIDE a$
CHDIR "..\.."
END IF
END IF
IF INSTR(_OS$, "[MACOSX]") THEN
OPEN "./internal/c/makeline_osx.txt" FOR INPUT AS #150
ELSE
OPEN "./internal/c/makeline_lnx.txt" FOR INPUT AS #150
END IF
LINE INPUT #150, a$: a$ = GDB_Fix(a$)
CLOSE #150
'change qbx.cpp to qbx999.cpp?
x = INSTR(a$, "qbx.cpp"): IF x <> 0 AND tempfolderindex <> 1 THEN a$ = LEFT$(a$, x - 1) + "qbx" + str2$(tempfolderindex) + ".cpp" + RIGHT$(a$, LEN(a$) - (x + 6))
IF inline_DATA = 0 THEN
'add data.o?
IF DataOffset THEN
x = INSTR(a$, "-lX11")
IF x THEN
a$ = LEFT$(a$, x - 1) + " " + tmpdir2$ + "data.o " + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
END IF
'add custom libraries
IF LEN(mylib$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + " " + mylibopt$ + " " + mylib$ + " " + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
'add dependent libraries
IF LEN(libs$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + libs$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
'add dependency defines
IF LEN(defines$) THEN
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + defines$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
END IF
'add libqb
x = INSTR(a$, ".cpp ")
IF x THEN
x = x + 5
a$ = LEFT$(a$, x - 1) + libqb$ + RIGHT$(a$, LEN(a$) - x + 1)
END IF
a$ = a$ + idezfilename$("../../" + file$ + extension$)
IF INSTR(_OS$, "[MACOSX]") THEN
ffh = FREEFILE
OPEN tmpdir$ + "recompile_osx.command" FOR OUTPUT AS #ffh
PRINT #ffh, "cd " + CHR_QUOTE + "$(dirname " + CHR_QUOTE + "$0" + CHR_QUOTE + ")" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "Recompiling..." + CHR_QUOTE + CHR$(10);
PRINT #ffh, "cd ../c" + CHR$(10);
PRINT #ffh, a$ + CHR$(10);
PRINT #ffh, "read -p " + CHR_QUOTE + "Press ENTER to exit..." + CHR_QUOTE + CHR$(10);
CLOSE ffh
SHELL _HIDE "chmod +x " + tmpdir$ + "recompile_osx.command"
ffh = FREEFILE
OPEN tmpdir$ + "debug_osx.command" FOR OUTPUT AS #ffh
PRINT #ffh, "cd " + CHR_QUOTE + "$(dirname " + CHR_QUOTE + "$0" + CHR_QUOTE + ")" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "Pause()" + CHR$(10);
PRINT #ffh, "{" + CHR$(10);
PRINT #ffh, "OLDCONFIG=`stty -g`" + CHR$(10);
PRINT #ffh, "stty -icanon -echo min 1 time 0" + CHR$(10);
PRINT #ffh, "dd count=1 2>/dev/null" + CHR$(10);
PRINT #ffh, "stty $OLDCONFIG" + CHR$(10);
PRINT #ffh, "}" + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "C++ Debugging: " + file$ + extension$ + " using GDB" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "Debugger commands:" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "After the debugger launches type 'run' to start your program" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "After your program crashes type 'list' to find where the problem is and fix/report it" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "(the GDB debugger has many other useful commands, this advice is for beginners)" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "gdb " + CHR$(34) + "../../" + file$ + extension$ + CHR$(34) + CHR$(10);
PRINT #ffh, "Pause" + CHR$(10);
CLOSE ffh
SHELL _HIDE "chmod +x " + tmpdir$ + "debug_osx.command"
ELSE
ffh = FREEFILE
OPEN tmpdir$ + "recompile_lnx.sh" FOR OUTPUT AS #ffh
PRINT #ffh, "#!/bin/sh" + CHR$(10);
PRINT #ffh, "Pause()" + CHR$(10);
PRINT #ffh, "{" + CHR$(10);
PRINT #ffh, "OLDCONFIG=`stty -g`" + CHR$(10);
PRINT #ffh, "stty -icanon -echo min 1 time 0" + CHR$(10);
PRINT #ffh, "dd count=1 2>/dev/null" + CHR$(10);
PRINT #ffh, "stty $OLDCONFIG" + CHR$(10);
PRINT #ffh, "}" + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "Recompiling..." + CHR_QUOTE + CHR$(10);
PRINT #ffh, "cd ../c" + CHR$(10);
PRINT #ffh, a$ + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "Press ENTER to exit..." + CHR_QUOTE + CHR$(10);
PRINT #ffh, "Pause" + CHR$(10);
CLOSE ffh
SHELL _HIDE "chmod +x " + tmpdir$ + "recompile_lnx.sh"
ffh = FREEFILE
OPEN tmpdir$ + "debug_lnx.sh" FOR OUTPUT AS #ffh
PRINT #ffh, "#!/bin/sh" + CHR$(10);
PRINT #ffh, "Pause()" + CHR$(10);
PRINT #ffh, "{" + CHR$(10);
PRINT #ffh, "OLDCONFIG=`stty -g`" + CHR$(10);
PRINT #ffh, "stty -icanon -echo min 1 time 0" + CHR$(10);
PRINT #ffh, "dd count=1 2>/dev/null" + CHR$(10);
PRINT #ffh, "stty $OLDCONFIG" + CHR$(10);
PRINT #ffh, "}" + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "C++ Debugging: " + file$ + extension$ + " using GDB" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "Debugger commands:" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "After the debugger launches type 'run' to start your program" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "After your program crashes type 'list' to find where the problem is and fix/report it" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "echo " + CHR_QUOTE + "(the GDB debugger has many other useful commands, this advice is for beginners)" + CHR_QUOTE + CHR$(10);
PRINT #ffh, "gdb " + CHR$(34) + "../../" + file$ + extension$ + CHR$(34) + CHR$(10);
PRINT #ffh, "Pause" + CHR$(10);
CLOSE ffh
SHELL _HIDE "chmod +x " + tmpdir$ + "debug_lnx.sh"
END IF
IF No_C_Compile_Mode = 0 THEN
CHDIR "./internal/c"
SHELL _HIDE a$
CHDIR "../.."
END IF
IF INSTR(_OS$, "[MACOSX]") THEN
ff = FREEFILE
OPEN file$ + extension$ + "_start.command" FOR OUTPUT AS #ff
PRINT #ff, "cd " + CHR$(34) + "$(dirname " + CHR$(34) + "$0" + CHR$(34) + ")" + CHR$(34);
PRINT #ff, CHR$(10);
PRINT #ff, "./" + file$ + extension$;
PRINT #ff, CHR$(10);
CLOSE #ff
SHELL _HIDE "chmod +x " + file$ + extension$ + "_start.command"
END IF
END IF
IF No_C_Compile_Mode THEN compfailed = 0: GOTO No_C_Compile
IF _FILEEXISTS(file$ + extension$) THEN compfailed = 0 ELSE compfailed = 1 'detect compilation failure
IF compfailed THEN
IF idemode THEN
idemessage$ = "C++ Compilation failed"
GOTO ideerror
END IF
IF compfailed THEN PRINT "C++ COMPILATION FAILED!"
END IF
Skip_Build:
IF idemode THEN GOTO ideret6
No_C_Compile:
IF UpdateHandle THEN
ideupdatetimerval = TIMER
DO UNTIL ABS(TIMER - ideupdatetimerval) >= 3
ContinueDownloads
IF DL(UpdateHandle).State = 2 THEN 'download complete
update 2
UpdateHandle = 0
GOTO qb64updated
END IF
_LIMIT 10
LOOP
CLOSE DL(UpdateHandle).Handle: DL(UpdateHandle).State = 0: UpdateHandle = 0
qb64updated:
END IF 'updatehandle
IF compfailed <> 0 AND ConsoleMode = 0 THEN END 1
IF compfailed <> 0 THEN SYSTEM 1
SYSTEM 0
qberror_test:
E = 1
RESUME NEXT
qberror:
IF ideerror THEN 'error happened inside the IDE
fh = FREEFILE
OPEN "internal\temp\ideerror.txt" FOR OUTPUT AS #fh
PRINT #fh, ERR
PRINT #fh, _ERRORLINE
CLOSE #fh
sendc$ = CHR$(255) 'a runtime error has occurred
RESUME sendcommand 'allow IDE to handle error recovery
END IF
qberrorhappenedvalue = qberrorhappened
qberrorhappened = 1
IF Debug THEN PRINT #9, "QB ERROR!"
IF Debug THEN PRINT #9, "ERR="; ERR
IF Debug THEN PRINT #9, "ERL="; ERL
IF idemode AND qberrorhappenedvalue >= 0 THEN
'real qb error occurred
ideerrorline = linenumber
idemessage$ = "Compiler error (check for syntax errors) (Reference:" + str2$(ERR) + "-" + str2$(_ERRORLINE) + ")"
IF inclevel > 0 THEN idemessage$ = idemessage$ + incerror$
RESUME ideerror
END IF
IF qberrorhappenedvalue >= 0 THEN
a$ = "UNEXPECTED INTERNAL COMPILER ERROR!": GOTO errmes 'internal comiler error
END IF
qberrorcode = ERR
qberrorline = ERL
IF qberrorhappenedvalue = -1 THEN RESUME qberrorhappened1
IF qberrorhappenedvalue = -2 THEN RESUME qberrorhappened2
IF qberrorhappenedvalue = -3 THEN RESUME qberrorhappened3
END
errmes: 'set a$ to message
IF Error_Happened THEN a$ = Error_Message: Error_Happened = 0
layout$ = "": layoutok = 0 'invalidate layout
IF inclevel > 0 THEN a$ = a$ + incerror$
IF idemode THEN
ideerrorline = linenumber
idemessage$ = a$
GOTO ideerror 'infinitely preferable to RESUME
END IF
'non-ide mode output
PRINT
PRINT a$
FOR i = 1 TO LEN(linefragment)
IF MID$(linefragment, i, 1) = sp$ THEN MID$(linefragment, i, 1) = " "
NEXT
FOR i = 1 TO LEN(wholeline)
IF MID$(wholeline, i, 1) = sp$ THEN MID$(wholeline, i, 1) = " "
NEXT
PRINT "Caused by (or after):" + linefragment
PRINT "LINE " + str2(linenumber) + ":" + wholeline
IF UpdateHandle THEN
ideupdatetimerval = TIMER
DO UNTIL ABS(TIMER - ideupdatetimerval) >= 3
ContinueDownloads
IF DL(UpdateHandle).State = 2 THEN 'download complete
update 3
UpdateHandle = 0
GOTO qb64updated2
END IF
_LIMIT 10
LOOP
CLOSE DL(UpdateHandle).Handle: DL(UpdateHandle).State = 0: UpdateHandle = 0
qb64updated2:
END IF 'updatehandle
IF ConsoleMode THEN SYSTEM 1
END 1
FUNCTION Type2MemTypeValue (t1)
t = 0
IF t1 AND ISARRAY THEN t = t + 65536
IF t1 AND ISUDT THEN
IF (t1 AND 511) = 1 THEN
t = t + 4096 '_MEM type
ELSE
t = t + 32768
END IF
ELSE
IF t1 AND ISSTRING THEN
t = t + 512 'string
ELSE
IF t1 AND ISFLOAT THEN
t = t + 256 'float
ELSE
t = t + 128 'integer
IF t1 AND ISUNSIGNED THEN t = t + 1024
IF t1 AND ISOFFSET THEN t = t + 8192 'offset type
END IF
t1s = (t1 AND 511) \ 8
IF t1s = 1 THEN t = t + t1s
IF t1s = 2 THEN t = t + t1s
IF t1s = 4 THEN t = t + t1s
IF t1s = 8 THEN t = t + t1s
IF t1s = 16 THEN t = t + t1s
IF t1s = 32 THEN t = t + t1s
IF t1s = 64 THEN t = t + t1s
END IF
END IF
Type2MemTypeValue = t
END FUNCTION
FUNCTION FileHasExtension (f$)
FOR i = LEN(f$) TO 1 STEP -1
a = ASC(f$, i)
IF a = 47 OR a = 92 THEN EXIT FOR
IF a = 46 THEN FileHasExtension = -1: EXIT FUNCTION
NEXT
END FUNCTION
FUNCTION RemoveFileExtension$ (f$) 'returns f$ without extension
FOR i = LEN(f$) TO 1 STEP -1
a = ASC(f$, i)
IF a = 47 OR a = 92 THEN EXIT FOR
IF a = 46 THEN RemoveFileExtension$ = LEFT$(f$, i - 1): EXIT FUNCTION
NEXT
RemoveFileExtension$ = f$
END FUNCTION
SUB ideASCIIbox
'IF INSTR(_OS$, "WIN") THEN ret% = SHELL("internal\ASCII-Picker.exe") ELSE ret% = SHELL("internal/ASCII-Picker")
w = _WIDTH: h = _HEIGHT
temp = _NEWIMAGE(640, 480, 32)
temp1 = _NEWIMAGE(640, 480, 32)
ws = _NEWIMAGE(640, 480, 32)
SCREEN temp
DIM CurrentASC(1 TO 16, 1 TO 16)
DIM CurrentOne AS INTEGER
CLS , _RGB(100, 0, 200)
COLOR , _RGB(100, 0, 200)
FOR x = 1 TO 16
FOR y = 1 TO 16
LINE (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
LINE (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
IF counter THEN _PRINTSTRING (x * 40 - 28, y * 30 - 23), CHR$(counter)
counter = counter + 1
NEXT
NEXT
_DEST temp1
CLS , _RGB(100, 0, 200)
COLOR , _RGB(100, 0, 200)
counter = 0
FOR x = 1 TO 16
FOR y = 1 TO 16
LINE (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
LINE (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
text$ = LTRIM$(STR$(counter))
IF counter THEN _PRINTSTRING (x * 40 - 24 - (LEN(text$)) * 4, y * 30 - 23), text$
counter = counter + 1
NEXT
NEXT
_DEST temp
x = 1: y = 1
_PUTIMAGE , temp, ws
DO: LOOP WHILE _MOUSEINPUT 'clear the mouse input buffer
oldmousex = _MOUSEX: oldmousey = _MOUSEY
DO
_LIMIT 60
DO: LOOP WHILE _MOUSEINPUT
x = _MOUSEX \ 40 + 1 'If mouse moved, where are we now?
y = _MOUSEY \ 30 + 1
num = (x - 1) * 16 + y - 1
IF num = 0 THEN
text$ = ""
ELSE
flashcounter = flashcounter + 1
IF flashcounter > 30 THEN
COLOR _RGB32(255, 255, 255), _RGB(100, 0, 200)
text$ = CHR$(num)
IF LEN(text$) = 1 THEN text$ = " " + text$ + " "
ELSE
COLOR _RGB32(255, 0, 0), _RGB(100, 0, 200)
text$ = RTRIM$(LTRIM$(STR$(num)))
END IF
END IF
IF flashcounter = 60 THEN flashcounter = 1
CLS
IF toggle THEN _PUTIMAGE , temp1, temp ELSE _PUTIMAGE , ws, temp
_PRINTSTRING (x * 40 - 24 - (LEN(text$)) * 4, y * 30 - 23), text$
LINE (x * 40 - 40, y * 30 - 30)-(x * 40, y * 30), _RGBA32(255, 255, 255, 150), BF
k1 = _KEYHIT
SELECT CASE k1
CASE 13: EXIT DO
CASE 27
_AUTODISPLAY
SCREEN 0: WIDTH w, h: _DEST 0: _DELAY .2
IF _RESIZE THEN donothing = atall
EXIT SUB
CASE 32: toggle = NOT toggle
CASE 18432: y = y - 1
CASE 19200: x = x - 1
CASE 20480: y = y + 1
CASE 19712: x = x + 1
END SELECT
IF x < 1 THEN x = 1
IF x > 16 THEN x = 16
IF y < 1 THEN y = 1
IF y > 16 THEN y = 16
_DISPLAY
LOOP UNTIL _MOUSEBUTTON(1)
ret% = (x - 1) * 16 + y - 1
IF ret% > 0 AND ret% < 255 THEN
l = idecy
a$ = idegetline(l)
l$ = LEFT$(a$, idecx - 1): r$ = RIGHT$(a$, LEN(a$) - idecx + 1)
text$ = l$ + CHR$(ret%) + r$
textlen = LEN(text$)
l$ = LEFT$(idet$, ideli - 1)
m$ = MKL$(textlen) + text$ + MKL$(textlen)
r$ = RIGHT$(idet$, LEN(idet$) - ideli - LEN(a$) - 7)
idet$ = l$ + m$ + r$
idecx = idecx + 1
END IF
_AUTODISPLAY
SCREEN 0: WIDTH w, h: _DEST 0: _DELAY .2
IF _RESIZE THEN donothing = atall
END FUNCTION
FUNCTION idef1box$ (lnks$, lnks)
'-------- generic dialog box header --------
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM oo AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
'72,19
i = 0
idepar p, 40, lnks + 3, "F1"
i = i + 1
o(i).typ = 2
o(i).y = 1
'68
o(i).w = 36: o(i).h = lnks
o(i).txt = idenewtxt(lnks$)
o(i).sel = 1
o(i).nam = idenewtxt("Which?")
i = i + 1
o(i).typ = 3
o(i).y = lnks + 3
o(i).txt = idenewtxt("#OK")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF KSHIFT AND K$ = CHR$(9) THEN focus = focus - 1
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideupdateobj o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN
f$ = idetxt(o(1).stx)
idef1box$ = f$
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION Back2BackName$ (a$)
IF a$ = "Keyword Reference - Alphabetical" THEN Back2BackName$ = "Alphabetical": EXIT FUNCTION
IF a$ = "Keyword Reference - By usage" THEN Back2BackName$ = "By Usage": EXIT FUNCTION
IF a$ = "QB64 Help Menu" THEN Back2BackName$ = "Help": EXIT FUNCTION
IF a$ = "QB64 FAQ" THEN Back2BackName$ = "FAQ": EXIT FUNCTION
Back2BackName$ = a$
END FUNCTION
FUNCTION Wiki$ (PageName$)
Help_PageLoaded$ = PageName$
PageName2$ = PageName$
DO WHILE INSTR(PageName2$, " ")
ASC(PageName2$, INSTR(PageName2$, " ")) = 95
LOOP
DO WHILE INSTR(PageName2$, "&")
i = INSTR(PageName2$, "&")
PageName2$ = LEFT$(PageName2$, i - 1) + "%26" + RIGHT$(PageName2$, LEN(PageName2$) - i)
LOOP
DO WHILE INSTR(PageName2$, "/")
i = INSTR(PageName2$, "/")
PageName2$ = LEFT$(PageName2$, i - 1) + "%2F" + RIGHT$(PageName2$, LEN(PageName2$) - i)
LOOP
'Is this page in the cache?
IF Help_IgnoreCache = 0 THEN
IF _FILEEXISTS(Cache_Folder$ + "/" + PageName2$ + ".txt") THEN
fh = FREEFILE
OPEN Cache_Folder$ + "/" + PageName2$ + ".txt" FOR BINARY AS #fh
a$ = SPACE$(LOF(fh))
GET #fh, , a$
CLOSE #fh
Wiki$ = a$
EXIT FUNCTION
END IF
END IF
IF Help_Recaching = 0 THEN
a$ = "Downloading '" + PageName$ + "' page..."
IF LEN(a$) > 60 THEN a$ = LEFT$(a$, 57) + "úúú"
IF LEN(a$) < 60 THEN a$ = a$ + SPACE$(60 - LEN(a$))
COLOR 0, 3: LOCATE idewy + idesubwindow, 2
PRINT a$;
PCOPY 3, 0
END IF
url$ = "www.qb64.net/wiki/index.php?title=" + PageName2$ + "&action=edit"
url2$ = url$
x = INSTR(url2$, "/")
IF x THEN url2$ = LEFT$(url$, x - 1)
c = _OPENCLIENT("TCP/IP:80:" + url2$)
IF c = 0 THEN EXIT FUNCTION
e$ = CHR$(13) + CHR$(10)
url3$ = RIGHT$(url$, LEN(url$) - x + 1)
x$ = "GET " + url3$ + " HTTP/1.1" + e$
x$ = x$ + "Host: " + url2$ + e$ + e$
PUT #c, , x$
t! = TIMER
DO
_DELAY 0.1
GET #c, , a2$
IF LEN(a2$) THEN
a$ = a$ + a2$
IF INSTR(a$, "